temp commitvm-syncase

1 files changed, 25 insertions, 0 deletions

diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 891902367..d4ea49424 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -167,6 +167,31 @@ time. Useful for supporting some forms of dynamic compilation. Returns
 #f if called from the interpreter."
   #f)
 
+(define* (compile-expressions producer #:key
+                              (env #f)
+                              (from (current-language))
+                              (to 'objcode)
+                              (opts '()))
+  (let lp ((in (reverse (or (lookup-compilation-order from to)
+                            (error "no way to compile" from "to" to))))
+           (join (ensure-language to))
+           (out '()))
+    (cond ((null? in)
+           (error "don't know how to to the multiple-expr thing"))
+          ((language-begin join)
+           (let ((leaf-passes (map cdr (reverse in)))
+                 (join (language-begin join))
+                 (trunk-passes (map cdr out)))
+             (receive (exp env)
+                  (join (map-in-order (lambda (x)
+                                        (compile-fold leaf-passes x env opts))
+                                      exps))
+                (compile-fold trunk-passes exp env opts))))
+          (else
+           (lp (cdr in)
+               (caar in)
+               (cons (car in) out))))))
+
 (define* (compile x #:key
                   (env #f)
                   (from (current-language))