diff options
author | Ludovic Courtès <ludo@gnu.org> | 2011-09-23 17:27:28 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2011-09-30 15:15:15 +0200 |
commit | 16d50b8e89d92f7aacea374802cb47c5ee373a33 (patch) | |
tree | 6d28e250aa4de6c30b2ffdcd7a9bf2f045c9cb64 | |
parent | 014de9e25d87b7d3a13566aee4c271c1a11ea0b7 (diff) | |
download | guile-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.scm | 9 | ||||
-rw-r--r-- | test-suite/tests/tree-il.test | 13 |
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))) |