WIP: Loot with new AST

    Things left TODO:

      [x] Rewrite the defunctionalization in terms of the AST
      [ ] Allow arbitrary 'begin in the program (currently we only support
          top-level begin)

Author: jmct

www/notes/loot/ast.rkt

@@ -76,6 +76,15 @@
 ;; Expr that represents the value that will be bound to that variable
 (struct binding (v e) #:transparent)
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;; AST nodes for closures (used for pedagogical purposes)
+;;;;;;                        (see interp-defun.rkt)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(struct closure (fs e env) #:transparent)
+(struct rec-closure (lam fenv) #:transparent)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;; AST utility functions (predicates)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

www/notes/loot/interp-defun.rkt

@@ -1,6 +1,6 @@
 #lang racket
 (provide (all-defined-out))
-(require "syntax.rkt")
+(require "ast.rkt" "syntax.rkt")
 
 ;; type Expr =
 ;; ...
@@ -16,65 +16,68 @@
 
 ;; Expr -> Answer
 (define (interp e)
-  (interp-env (desugar e) '()))
+  (match (desugar-prog e)
+    [(prog _ e)
+      (interp-env e '())]))
 
 ;; Expr REnv -> Answer
 (define (interp-env e r)
   (match e
-    [''() '()]
-    [(? syntactic-value? v) v]
-    [(list (? prim? p) es ...)
+    [(nil-e) '()]
+    [(int-e i) i]
+    [(bool-e b) b]
+    [(prim-e p es)
      (match (interp-env* es r)
        [(list vs ...) (interp-prim p vs)]
        [_ 'err])]
-    [`(if ,e0 ,e1 ,e2)
+    [(if-e e0 e1 e2)
      (match (interp-env e0 r)
        ['err 'err]
        [v
         (if v
             (interp-env e1 r)
             (interp-env e2 r))])]
-    [(? symbol? x)
+    [(var-e x)
      (lookup r x)]
-    [`(let ((,x ,e0)) ,e1)
+    [(let-e (list (binding x e0)) e1)
      (match (interp-env e0 r)
        ['err 'err]
        [v
         (interp-env e1 (ext r x v))])]
-    [`(letrec ,bs ,e)
+    [(letr-e bs e)
      (letrec ((r* (λ ()
                     (append
-                     (zip (map first bs)
+                     (zip (get-vars bs)
                           ;; η-expansion to delay evaluating r*
                           ;; relies on RHSs being functions
-                          (map (λ (l) `(rec-closure ,l ,r*))
-                               (map second bs)))
+                          (map (λ (l) (rec-closure l r*))
+                               (get-defs bs)))
                      r))))
        (interp-env e (r*)))]
-    
-    [`(λ (,xs ...) ,e)
-     `(closure ,xs ,e ,r)]
-    [`(,e . ,es)
+    [(lam-e  xs e)
+     (closure xs e r)]
+    [(app-e e es)
      (match (interp-env* (cons e es) r)       
        [(list (? function? f) vs ...)
         (apply apply-function f vs)]        
        [_ 'err])]))
 
 (define (function? f)
   (match f
-    [`(closure . ,_) #t]
-    [`(rec-closure . ,_) #t]
+    [(closure _ _ _) #t]
+    [(rec-closure _ _) #t]
     [_ #f]))
 
 ;; Function Value ... -> Answer
 (define (apply-function f . vs)
   (match f
-    [`(closure ,xs ,e ,r)
+    [(closure xs e r)
      (if (= (length xs) (length vs))
          (interp-env e (append (zip xs vs) r))
          'err)]
-    [`(rec-closure (λ (,xs ...) ,e) ,r*)
-     (apply apply-function `(closure ,xs ,e ,(r*)) vs)]))
+    [(rec-closure (lam-e xs e) r*)
+      ; You've got to apply the the r* thunk
+     (apply apply-function (closure xs e (r*)) vs)]))
 
 
 ;; (Listof Expr) REnv -> (Listof Value) | 'err
@@ -94,9 +97,9 @@
 
 ;; Any -> Boolean
 (define (syntactic-value? x)
-  (or (integer? x)
-      (boolean? x)
-      (null? x)))
+  (or (int-e? x)
+      (bool-e? x)
+      (nil-e? x)))
 
 ;; Prim (Listof Value) -> Answer
 (define (interp-prim p vs)
@@ -123,7 +126,8 @@
     [(cons (list y i) env)
      (match (symbol=? x y)
        [#t i]
-       [#f (lookup env x)])]))
+       [#f (lookup env x)])]
+    [_ (error (~a "Lookup failed, var: " x "\n\tthe env: " env))]))
 
 ;; Env Variable Value -> Value
 (define (ext r x i)

www/notes/loot/test/interp.rkt

@@ -159,9 +159,8 @@
      [(? procedure?) 'procedure]
      [v v])))
 
-; TODO: Change the defunctionalization to work with AST
-;(test-suite
-;  (λ (e)
-;   (match (defun:interp e)
-;     [(? defun:function?) 'procedure]
-;     [v v])))
+(test-suite
+  (λ (e)
+   (match (defun:interp (sexpr->prog e))
+     [(? defun:function?) 'procedure]
+     [v v])))