core_ast: removed letrec. we now treat it as let + set.

bin/comp.ml

@@ -1,23 +1,4 @@
 
-open Parser.Ast;;
-
-let p = Printf.sprintf
-
-let rec dbg_print = function
-  | LSymbol s -> p "%s" s
-  | LCons (a, LNil) -> p "%s)" (dbg_print_start a)
-  | LCons (a, b) -> p "%s %s" (dbg_print_start a) (dbg_print b)
-  | LNil -> p "()"
-  | LInt i -> p "%d" i
-  | LDouble d -> p "%f" d
-  | LString s -> p "%s" s
-
-and dbg_print_start = function
-  | LCons (_, _) as l -> p "(%s" (dbg_print l)
-  | _ as x -> dbg_print x
-
-
-
 let def = Parser.parse_str "(define (f)
                              (let ((x 5))
                               (if t (set! x (+ x 1)))))
@@ -28,9 +9,6 @@ let def = Parser.parse_str "(define (f)
                              ((> 1 2) 0)
                              ((> 3 2) 3)
                              (t -1))";;
-let desugared = List.map Compiler.Sugar.desugar def
-let () = List.iter (fun x -> Printf.printf "%s\n" (dbg_print_start x) ) desugared
-let () = print_newline ()
 
 let ( let* ) = Result.bind;;
 let e =

lib/compiler/core_ast.ml

@@ -16,7 +16,7 @@ type expression =
   | Var of string
   | Apply of expression * expression
   | Lambda of string * expression
-  | LetRec of (string * expression) list * expression
+  (*| LetRec of (string * expression) list * expression   *)
   | If of expression * expression * expression
   | Set of string * expression
   | Begin of expression list
@@ -46,6 +46,7 @@ and make_apply f args =
     | arg :: [] -> Apply (f, arg)
     | arg :: args -> aux (Apply (f, arg)) args
   in aux f args
+
 (* desugars this...
   (let ((x 5) (y 4)) (f x y))
   ... into this...
@@ -58,6 +59,17 @@ and make_let bs body =
        Apply (Lambda (s, aux rest), e)
     | [] -> of_body body in
   aux bs
+
+(* The Core AST does not feature a letrec node. Instead, we desugar letrecs further
+   into a let that binds each symbol to nil, then `set!`s them to their real value
+   before running the body.
+ *)
+and make_letrec bs exprs =
+  let tmp_bs = List.map (fun (s, _) -> (s, Literal Nil)) bs in
+  let setters = List.fold_right (fun (s, e) acc -> (Set (s, e)) :: acc) bs [] in
+  let body = Begin ((List.rev setters) @ exprs) in
+  List.fold_right (fun (s, e) acc -> Apply (Lambda (s, acc), e)) tmp_bs body
+
 (* We convert a body into a regular letrec form.
    A body is defined as a series of definitions followed by a series
    of expressions. The definitions behave exactly as a letrec, so
@@ -70,8 +82,7 @@ and of_body : Syntactic_ast.body -> expression = function
   | (defs, exprs) ->
      let exprs = List.map of_expr exprs in
      let defs = List.map pair_of_def defs in
-     let b = Begin exprs in
-     LetRec (defs, b)
+     make_letrec defs exprs
 
 (* TODO: currently this ignores the "optional" part of the lambda list,
    fix this *)
@@ -90,7 +101,7 @@ and of_expr : Syntactic_ast.expr -> expression = function
   | Var x -> Var x
   | Lambda (ll, b) -> make_lambda (of_ll ll) b
   | Let (bindings, b) -> make_let bindings b
-  | LetRec (bindings, b) -> LetRec (List.map pair_of_binding bindings, of_body b)
+  | LetRec (bindings, b) -> make_letrec (List.map pair_of_binding bindings) [(of_body b)]
   | Cond (clauses) -> 
      List.fold_right
        (fun (e1, e2) acc -> If (e1, e2, acc))