1 files changed, 43 insertions, 5 deletions

diff --git a/main.scm b/main.scm
index dd60662..1781255 100644
--- a/main.scm
+++ b/main.scm
@@ -76,7 +76,9 @@
 (define (lambda-form? expr) (tagged? expr 'lambda))
 (define (lambda-params expr) (cadr expr))
 (define (lambda-body expr) (cddr expr))
-(define (make-lambda params body) (cons 'lambda (cons params body)))
+(define (make-lambda params body) 
+  (cons 'lambda
+        (cons params (scan-out-defines body))))
 
 ;;; begin
 (define (begin-form? expr) (tagged? expr 'begin))
@@ -92,6 +94,11 @@
 ;;; let
 (define (let-form? expr) (tagged? expr 'let))
 (define (let*-form? expr) (tagged? expr 'let*))
+(define (named-let-variable expr) (cadr expr))
+(define (named-let-form? expr) (and (tagged? expr 'let)
+                                    (variable? (named-let-variable expr))))
+(define (named-let-bindings expr) (caddr expr))
+(define (named-let-body expr) (cdddr expr))
 (define (let-bindings expr) (cadr expr))
 (define (last-binding? bindings) (null? (cdr bindings)))
 (define (let-body expr) (cddr expr))
@@ -110,22 +117,50 @@
       [(last-binding? bindings) (make-let bindings body)]
       [else (make-let (list (car bindings))
                       (let*->let (make-let* (cdr bindings) body)))])))
+(define (named-let->let expr)
+  (let ([name (named-let-variable expr)]
+        [body (sequence->expr (named-let-body expr))]
+        [bindings (named-let-bindings expr)])
+    (let ([new-binding (make-lambda (let-binding-variables bindings)
+                                     body)])
+      (make-let (cons (list name new-binding)
+                      bindings)
+                body))))
+
+;;; handle internal definitions
+(define (define->set statements)
+  (map (lambda (d)
+         (cons 'set! (cdr d)))
+       statements))
+(define (make-unassigned-bindings internal-defines)
+  (map (lambda (d)
+         (list (definition-name d) '*unassigned*)) internal-defines))
+(define (scan-out-defines body)
+  (let ([internal-defines (filter definition? body)]
+        [rest (filter (lambda (n) (not (definition? n))) body)])
+    (cond 
+      [(null? internal-defines) body]
+      [else 
+        (let ([variables (make-unassigned-bindings internal-defines)])
+          (let ([new-bindings (define->set internal-defines)])
+            (list (cons 'let (cons variables (append new-bindings rest))))))])))
 
 
 (define (eval-expr expr env)
   (cond
     [(self-evaluating? expr) expr]
     [(variable? expr) (lookup-variable-value expr env)]
+    [(assignment? expr) (eval-assignment expr env)]
+    [(definition? expr) (eval-definition expr env)]
+    [(quote-form? expr) (quotation-text expr)]
     [(if-else? expr) (eval-if expr env)]
     [(begin-form? expr) (eval-sequence (begin-actions expr) env)]
     [(lambda-form? expr) (make-lambda (lambda-params expr)
                                       (lambda-body expr))]
+    [(named-let-form? expr) 'false]
     [(let-form? expr) (eval-let expr env)]
     [(let*-form? expr) (eval-let* expr env)]
-    [(assignment? expr) (eval-assignment expr env)]
-    [(definition? expr) (eval-definition expr env)]
     [(cond-form? expr) (eval-cond expr env)]
-    [(quote-form? expr) (quotation-text expr)]
     [(function-application? expr) (eval-function-application expr env)]))
 
 (define (eval-if expr env)
@@ -143,6 +178,9 @@
             (eval-expr (car exprs) env)
             (eval-sequence (cdr exprs) env))]))
 
+(define (eval-named-let expr env)
+  (eval-let (named-let->let expr) env))
+
 (define (eval-let expr env)
   (eval-function-application 
     (cons (let->lambda expr)
@@ -153,7 +191,7 @@
   (eval-expr (let*->let expr) env))
 
 (define (eval-assignment expr env)
-  (set-variable-value! 
+  (set-variable-value!
     (assignment-name expr)
     (eval-expr (assignment-value expr) env)
     env))