1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00

primitive resolution for public refs

* module/language/tree-il/primitives.scm (resolve-primitives!): Resolve
  public module-refs to primitives.

* test-suite/tests/tree-il.test: New tests for primitive resolution.
This commit is contained in:
BT Templeton 2012-03-10 03:31:58 -05:00
parent da03005a2a
commit a8004dcb4d
2 changed files with 18 additions and 8 deletions

View file

@ -240,13 +240,15 @@
(module-variable mod name)) (module-variable mod name))
(lambda (name) (make-primitive-ref src name)))) (lambda (name) (make-primitive-ref src name))))
((<module-ref> src mod name public?) ((<module-ref> src mod name public?)
;; for the moment, we're disabling primitive resolution for (and=> (and=> (resolve-module mod)
;; public refs because resolve-interface can raise errors. (if public?
(let ((m (and (not public?) (resolve-module mod)))) module-public-interface
(and m identity))
(and=> (hashq-ref *interesting-primitive-vars* (lambda (m)
(module-variable m name)) (and=> (hashq-ref *interesting-primitive-vars*
(lambda (name) (make-primitive-ref src name)))))) (module-variable m name))
(lambda (name)
(make-primitive-ref src name))))))
(else #f))) (else #f)))
x)) x))

View file

@ -1585,7 +1585,15 @@
(lambda _ (lambda _
(lambda-case (lambda-case
(((x y) #f #f #f () (_ _)) (((x y) #f #f #f () (_ _))
_))))) _))))
(pass-if-peval resolve-primitives
((@ (guile) car) '(1 2))
(const 1))
(pass-if-peval resolve-primitives
((@@ (guile) car) '(1 2))
(const 1)))