From a8004dcb4d7148ec66cbaa109a18715d757700eb Mon Sep 17 00:00:00 2001 From: BT Templeton Date: Sat, 10 Mar 2012 03:31:58 -0500 Subject: [PATCH] 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. --- module/language/tree-il/primitives.scm | 16 +++++++++------- test-suite/tests/tree-il.test | 10 +++++++++- 2 files changed, 18 insertions(+), 8 deletions(-) diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index c825d9a0a..2039faa63 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -240,13 +240,15 @@ (module-variable mod name)) (lambda (name) (make-primitive-ref src name)))) (( src mod name public?) - ;; for the moment, we're disabling primitive resolution for - ;; public refs because resolve-interface can raise errors. - (let ((m (and (not public?) (resolve-module mod)))) - (and m - (and=> (hashq-ref *interesting-primitive-vars* - (module-variable m name)) - (lambda (name) (make-primitive-ref src name)))))) + (and=> (and=> (resolve-module mod) + (if public? + module-public-interface + identity)) + (lambda (m) + (and=> (hashq-ref *interesting-primitive-vars* + (module-variable m name)) + (lambda (name) + (make-primitive-ref src name)))))) (else #f))) x)) diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test index 3d5989e06..0be563623 100644 --- a/test-suite/tests/tree-il.test +++ b/test-suite/tests/tree-il.test @@ -1585,7 +1585,15 @@ (lambda _ (lambda-case (((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)))