mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

fix the peval merge and a test

Browse source 
* module/language/tree-il/peval.scm (peval): Accessor primitives applied
  to constants are pure if the call type-checks.  Also, fold constants
  in accessor primcalls.

* test-suite/tests/tree-il.test ("partial evaluation"): Fix the "yo"
  test.
This commit is contained in:
Andy Wingo 2011-10-27 14:09:47 +02:00
parent 549333efd8
commit 175955725e
2 changed files with 5 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

7
module/language/tree-il/peval.scm
View file

@ -542,9 +542,10 @@ top-level bindings from ENV and return the resulting expression."
(($ <primcall> _ name args) (($ <primcall> _ name args)
(and (effect-free-primitive? name) (and (effect-free-primitive? name)
(not (constructor-primitive? name)) (not (constructor-primitive? name))
(not (accessor-primitive? name))
(types-check? name args) (types-check? name args)
(every loop args))) (if (accessor-primitive? name)
(every const? args)
(every loop args))))
(($ <call> _ ($ <lambda> _ _ body) args) (($ <call> _ ($ <lambda> _ _ body) args)
(and (loop body) (every loop args))) (and (loop body) (every loop args)))
(($ <seq> _ head tail) (($ <seq> _ head tail)
@ -1003,7 +1004,7 @@ top-level bindings from ENV and return the resulting expression."
(else (else
(make-primcall src name (list k (make-const #f elts)))))))) (make-primcall src name (list k (make-const #f elts))))))))
((name . args) ((name . args)
(make-primcall src name args)))) (fold-constants src name args ctx))))
(($ <primcall> src (? effect-free-primitive? name) args) (($ <primcall> src (? effect-free-primitive? name) args)
(fold-constants src name (map for-value args) ctx)) (fold-constants src name (map for-value args) ctx))

2
test-suite/tests/tree-il.test
View file

@ -785,7 +785,7 @@
(loop (1+ i))) (loop (1+ i)))
'()))))) '())))))
(string->chars "yo")) (string->chars "yo"))
(apply (primitive list) (const #\y) (const #\o))) (primcall list (const #\y) (const #\o)))
(pass-if-peval (pass-if-peval
;; Primitives in module-refs are resolved (the expansion of `pmatch' ;; Primitives in module-refs are resolved (the expansion of `pmatch'