Stuff.

13-bang/main.rkt

@@ -7,8 +7,9 @@
 #| The AST:
 <TOY> ::= <num>
        | <id>
-       | { bind {{ <id> <TOY> } ... } <TOY> }
-       | { fun { <id> ... } <TOY> }
+       | { bind {{ <id> <TOY> } ... } <TOY> ... }
+       | { bindrec {{ <id> <TOY> } ... } <TOY> ... }
+       | { fun { <id> ... } <TOY> ... }
        | { <TOY> <TOY> ... }
        | { if <TOY> <TOY> <TOY> }
        | { set! <id> <TOY> }
@@ -18,8 +19,9 @@
 (define-type TOY
   [Num  Number]
   [Id   Symbol]
-  [Bind (Listof Symbol) (Listof TOY) TOY]
-  [Fun  (Listof Symbol) TOY]
+  [Bind (Listof Symbol) (Listof TOY) (Listof TOY)]
+  [Bindrec (Listof Symbol) (Listof TOY) (Listof TOY)]
+  [Fun  (Listof Symbol) (Listof TOY)]
   [Call TOY (Listof TOY)]
   [If   TOY TOY TOY]
   [Set  Symbol TOY])
@@ -42,16 +44,19 @@
     [(number: n)    (Num n)]
     [(symbol: name) (Id name)]
 
-    ; Bind.
-    [(cons 'bind more)
+    ; Bindrec.
+    [(cons (and binder (or 'bind 'bindrec)) more) ; `binder` bound to 'bind or 'bindrec.
      (match sexpr
-       [(list 'bind (list (list (symbol: names) (sexpr: nameds))
-                          ...)
-              body)
-        (if (unique-list? names)
-            (Bind names (map parse-sexpr nameds) (parse-sexpr body))
-            (error 'parse-sexpr "duplicate `bind' names: ~s" names))]
-       [else (error 'parse-sexpr "bad `bind' syntax in ~s" sexpr)])]
+       [(list b (list (list (symbol: names) (sexpr: nameds)) ...) body ...)
+        (if (not (null? body))
+          (if (unique-list? names)
+              ((if (symbol=? b 'bind) Bind Bindrec)
+               names
+               (map parse-sexpr nameds)
+               (last (map parse-sexpr body)))
+              (error 'parse-sexpr "duplicate `~s' names: ~s" binder names))
+        (error 'parse-sexpr "bind expression missing body: ~s" sexpr))]
+       [else (error 'parse-sexpr "bad `~s' syntax in ~s" binder sexpr)])]
 
     ; Function definition.
     [(cons 'fun more)
@@ -120,6 +125,16 @@
                 env)
       (error 'extend "arity mismatch for names: ~s" names)))
 
+(: extend-rec : (Listof Symbol) (Listof TOY) ENV -> ENV)
+(define (extend-rec names vals env)
+  (define newenv (extend names (map (lambda (_) (VoidV)) vals) env))
+  (for-each (lambda ([name : Symbol] [val : TOY])
+              (set-box! (lookup name newenv) (eval val newenv)))
+            names vals)
+  newenv)
+
+
+
 (: lookup : Symbol ENV -> (Boxof VAL))
 ;; lookup a symbol in an environment, frame by frame,
 ;; return its value or throw an error if it isn't bound
@@ -181,6 +196,8 @@
     [(Id name) (unbox (lookup name env))]
     [(Bind names exprs bound-body)
      (eval bound-body (extend names (map eval* exprs) env))]
+    [(Bindrec names exprs bound-body)
+     (eval bound-body (extend-rec names exprs env))]
     [(Fun names bound-body)
      (FunV names bound-body env)]
     [(Call fun-expr arg-exprs)
@@ -214,6 +231,14 @@
 ;;; ----------------------------------------------------------------
 ;;; Tests
 
+(test (run "{bindrec {{fact {fun {n}
+{if {= 0 n}
+1
+{* n {fact {- n 1}}}}}}}
+
+{fact 5}}")
+=> 120)
+
 (test (run "
 {bind {{x 10}}
   {bind {{y {set! x 1}}}