diff options
| -rw-r--r-- | chickadee/graphics/seagull.scm | 33 |
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) |