diff options
Diffstat (limited to 'module/language/tree-il/peval.scm')
-rw-r--r-- | module/language/tree-il/peval.scm | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm index 937a797f0..1eb928f07 100644 --- a/module/language/tree-il/peval.scm +++ b/module/language/tree-il/peval.scm @@ -1350,6 +1350,35 @@ top-level bindings from ENV and return the resulting expression." (make-primcall src 'apply (cons (for-value proc) args)))))))) + (($ <primcall> src 'append (x z)) + (let ((x (for-value x))) + (match x + ((or ($ <const> _ ()) + ($ <primcall> _ 'list ())) + (for-value z)) + ((or ($ <const> _ (_ . _)) + ($ <primcall> _ 'cons) + ($ <primcall> _ 'list)) + (for-tail + (let lp ((x x)) + (match x + ((or ($ <const> csrc ()) + ($ <primcall> csrc 'list ())) + ;; Defer visiting z in value context to for-tail. + z) + (($ <const> csrc (x . y)) + (let ((x (make-const csrc x)) + (y (make-const csrc y))) + (make-primcall src 'cons (list x (lp y))))) + (($ <primcall> csrc 'cons (x y)) + (make-primcall src 'cons (list x (lp y)))) + (($ <primcall> csrc 'list (x . y)) + (let ((y (make-primcall csrc 'list y))) + (make-primcall src 'cons (list x (lp y))))) + (x (make-primcall src 'append (list x z))))))) + (else + (make-primcall src 'append (list x (for-value z))))))) + (($ <primcall> src (? constructor-primitive? name) args) (cond ((and (memq ctx '(effect test)) |