Fix hoisting.

1 files changed, 26 insertions, 7 deletions

diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index e46ebf8..677e02d 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -651,19 +651,38 @@
           (compose-envs predicate-env consequent-env alternate-env)))
 
 (define (hoist:let names exps body)
-  (define-values (exps* exps-env) (hoist:list exps))
+  (define-values (exps* exps-env)
+    (hoist:list exps))
   (define-values (body* body-env)
     (hoist-functions body))
-  (values `(let ,(map list names exps*) ,body*)
-          (compose-envs exps-env body-env)))
+  ;; Remove all lambda bindings...
+  (define bindings
+    (filter-map (lambda (name exp)
+                  (match exp
+                    (('lambda _ _)
+                     #f)
+                    (_ (list name exp))))
+                names exps*))
+  ;; ...and add them to the top-level environment.
+  (define env*
+    (fold (lambda (name exp env)
+            (match exp
+              (('lambda _ _)
+               (extend-env name exp env))
+              (_ env)))
+          (compose-envs exps-env body-env)
+          names exps*))
+  ;; If there are no bindings left, remove the 'let'.
+  (values (if (null? bindings)
+              body*
+              `(let ,bindings ,body*))
+          env*))
 
 (define (hoist:lambda params body)
-  (define var (unique-identifier))
   (define-values (body* body-env)
     (hoist-functions body))
-  (define lambda* `(lambda ,params ,body*))
-  (values `(var ,var #f)
-          (extend-env var lambda* body-env)))
+  (values `(lambda ,params ,body*)
+          body-env))
 
 (define (hoist:values exps)
   (define-values (exps* exp-env)