mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

peval fix: (cons 1 #nil) is not (list 1)

Browse source 
* module/language/tree-il/peval.scm (peval): (cons FOO #nil) is not
  (cons FOO '()).

* test-suite/tests/tree-il.test ("partial evaluation"): Add a test.
This commit is contained in:
Andy Wingo 2011-12-21 22:04:18 -05:00
parent fff39e1aa5
commit cc8afa2b36
2 changed files with 6 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1040,7 +1040,7 @@ top-level bindings from ENV and return the resulting expression."
(match (cons name (map for-value orig-args)) (match (cons name (map for-value orig-args))
(('cons head tail) (('cons head tail)
(match tail (match tail
(($ <const> src ()) (($ <const> src (? (cut eq? <> '())))
(make-application src (make-primitive-ref #f 'list) (make-application src (make-primitive-ref #f 'list)
(list head))) (list head)))
(($ <application> src ($ <primitive-ref> _ 'list) elts) (($ <application> src ($ <primitive-ref> _ 'list) elts)

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

@ -1419,6 +1419,11 @@
(((x) #f #f #f () (_)) (((x) #f #f #f () (_))
(apply (toplevel top) (lexical x _))))))) (apply (toplevel top) (lexical x _)))))))
(pass-if-peval
;; Constant folding: cons of #nil does not make list
(cons 1 #nil)
(apply (primitive cons) (const 1) (const '#nil)))
(pass-if-peval (pass-if-peval
;; Constant folding: cons ;; Constant folding: cons
(begin (cons 1 2) #f) (begin (cons 1 2) #f)