lc, stlc-let: rewrite interpreter

2 files changed, 37 insertions, 30 deletions

diff --git a/lc.rkt b/lc.rkt
index 06fb7eb..cea86c8 100644
--- a/lc.rkt
+++ b/lc.rkt
@@ -1,21 +1,26 @@
-#lang racket
+#lang racket ; note: do NOT use racket/base
 (require "lib.rkt")
 
-;; the untyped lambda calculus
+;; The Untyped Lambda Calculus
 
-(define (interpret expr [ctx #hash()])
+; note: default arguments MUST all be at the end
+(define (interpret expr [ctx '()])
   (match expr
-    [val #:when (or (number? val) (string? val)) val]
-    [val #:when (symbol? val)
-      (with-handlers
-        ([exn:fail? (λ (exn) val)]) ; note: unbound identifiers are supported
-        (interpret (dict-ref ctx val) ctx))]
-    [`(λ ,id ,body) `(λ ,id ,body)]
+    [`(λ ,id ,body)
+      `(λ ,id ,(interpret body ctx))]
+    [`((λ ,id ,body) ,arg)
+      (interpret body (dict-set ctx id arg))]
+    [`(,id ,arg) #:when (dict-has-key? ctx id)
+      (interpret `(,(interpret (dict-ref ctx id) ctx) ,arg))]
     [`(,body ,arg)
-      (match (interpret body ctx)
-        [`(λ ,id ,body) (interpret body (dict-set ctx id (interpret arg ctx)))]
-        [expr `(,(interpret expr ctx) ,(interpret arg ctx))])]
-    [expr (err (format "unknown expression ~a" expr))]))
+      (let ([reduced (interpret body ctx)])
+        (if (equal? body reduced)
+          `(,reduced ,(interpret arg ctx))
+          (interpret `(,reduced ,arg) ctx)))]
+    [id #:when (dict-has-key? ctx id)
+      (interpret (dict-ref ctx id) ctx)]
+    [val #:when (symbol? val) val]
+    [_ (err (format "unknown expression ~a" expr))]))
 
 (require rackunit)
 (check-equal? (interpret '(λ x x)) '(λ x x))
diff --git a/stlc-let.rkt b/stlc-let.rkt
index 84bf588..b2de7c8 100644
--- a/stlc-let.rkt
+++ b/stlc-let.rkt
@@ -1,29 +1,31 @@
-#lang racket ; note: do NOT use racket/base
+#lang racket
 (require "lib.rkt")
 
-;; the simply-typed lambda calculus, with let sugar
+;; The Simply-Typed Lambda Calculus, with let sugar
 
-(define (value? val) (or (number? val) (string? val)))
+(define (value? val) (or (number? val) (string? val) (symbol? val)))
 
-; note: default arguments MUST all be at the end
-; no function overloading ;_;
+; note: no function overloading ;_;
 ;;      (interpret Expr Table[Sym, Expr]): Value
-(define (interpret expr [ctx #hash()]) (interpret- (strip expr) ctx))
+(define (interpret expr) (interpret- (strip expr) '()))
 (define (interpret- expr ctx)
   (match expr
-    [val #:when (value? val) val]
-    [val #:when (symbol? val)
-      (with-handlers
-        ([exn:fail? (λ (exn) val)])
-        (interpret- (dict-ref ctx val) ctx))]
     [`(λ ,id ,body) `(λ ,id ,body ,ctx)]
     [`(λ ,id ,body ,env) `(λ ,id ,body ,env)]
-    [`(,body ,arg)
-      (match (interpret- body ctx)
-        [`(λ ,id ,body) (interpret- body (dict-set ctx id (interpret- arg ctx)))]
-        [`(λ ,id ,body ,env) (interpret- body (dict-set env id (interpret- arg ctx)))]
-        [expr `(,(interpret- expr ctx) ,(interpret- arg ctx))])]
-    ; desugaring and error handling
+    [`((λ ,id ,body) ,arg)
+      (interpret- body (dict-set ctx id (interpret- arg ctx)))]
+    [`((λ ,id ,body ,env) ,arg)
+      (interpret- body (dict-set env id (interpret- arg ctx)))]
+    [`(,id ,arg) #:when (dict-has-key? ctx id)
+      (interpret- `(,(interpret- (dict-ref ctx id) ctx) ,arg) ctx)]
+    [`(,body ,arg) ; todo: how to recognize an irreducible term? this is kinda cheating, i think
+      (let ([reduced (interpret- body ctx)])
+        (if (equal? body reduced)
+          `(,reduced ,(interpret- arg ctx))
+          (interpret- `(,reduced ,arg) ctx)))]
+    [id #:when (dict-has-key? ctx id)
+      (interpret- (dict-ref ctx id) ctx)]
+    [val #:when (value? val) val]
     [`(let ,id ,expr ,body) (interpret- `((λ ,id ,body) ,expr) ctx)]
     [expr (err (format "interpreting an unknown expression ~a" expr))]))