summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2011-09-23 17:27:28 +0200
committerLudovic Courtès <ludo@gnu.org>2011-09-30 15:15:15 +0200
commit16d50b8e89d92f7aacea374802cb47c5ee373a33 (patch)
tree6d28e250aa4de6c30b2ffdcd7a9bf2f045c9cb64
parent014de9e25d87b7d3a13566aee4c271c1a11ea0b7 (diff)
downloadguile-16d50b8e89d92f7aacea374802cb47c5ee373a33.tar.gz
peval: Recognize module-refs to primitives.
* module/language/tree-il/optimize.scm (peval): Handle module-refs to primitives. * test-suite/tests/tree-il.test ("partial evaluation"): Add test, using `pmatch'.
-rw-r--r--module/language/tree-il/peval.scm9
-rw-r--r--test-suite/tests/tree-il.test13
2 files changed, 22 insertions, 0 deletions
diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index a097dd498..c05a2be15 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -708,6 +708,15 @@ it does not handle <fix> and <let-values>, it should be called before
(($ <toplevel-ref>)
;; todo: open private local bindings.
exp)
+ (($ <module-ref> src module (? effect-free-primitive? name) #f)
+ (let ((module (false-if-exception
+ (resolve-module module #:ensure #f))))
+ (if (module? module)
+ (let ((var (module-variable module name)))
+ (if (eq? var (module-variable the-scm-module name))
+ (make-primitive-ref src name)
+ exp))
+ exp)))
(($ <module-ref>)
exp)
(($ <module-set> src mod name public? exp)
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 1a11d354f..479b62a97 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -762,6 +762,19 @@
(const 10))
(pass-if-peval
+ ;; Primitives in module-refs are resolved (the expansion of `pmatch'
+ ;; below leads to calls to (@@ (system base pmatch) car) and
+ ;; similar, which is what we want to be inlined.)
+ (begin
+ (use-modules (system base pmatch))
+ (pmatch '(a b c d)
+ ((a b . _)
+ #t)))
+ (begin
+ (apply . _)
+ (const #t)))
+
+ (pass-if-peval
;; Mutability preserved.
((lambda (x y z) (list x y z)) 1 2 3)
(apply (primitive list) (const 1) (const 2) (const 3)))