summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/graphics/seagull.scm33
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)