Added gensym, and phases in the desugar module for logical and & or

bin/comp.ml

@@ -21,7 +21,7 @@ and dbg_print_start = function
 let def = Parser.parse_str "(define (f x) (+ x 1))
                             (define (f)
                               (define (g y) (* y 2))
-                              (g 5) (g 6))";;
+                              (or (g 5) (g 6)))";;
 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 ()

lib/compiler/gensym.ml

@@ -0,0 +1,8 @@
+
+
+let counter = ref 0
+
+let reset () = counter := 0
+let gensym base =
+  incr counter;
+  Printf.sprintf "__generated_%s_%d" base !counter

lib/compiler/sugar.ml

@@ -42,6 +42,20 @@ let make_letrec body =
   | LNil -> rest
   | _ -> LCons (LCons (LSymbol "letrec", LCons (defs, rest)), LNil)
 
+let make_single_let sym value body =
+  let val_list = LCons (sym, LCons (value, LNil)) in
+  let full_list = LCons (val_list, LNil) in
+  list_to_sexpr
+    [LSymbol "let"; full_list; body]
+
+let make_if cond t e =
+  list_to_sexpr
+    [LSymbol "if"; cond; t; e]
+
+let make_letif sym value cond t e =
+  make_single_let sym value
+    (make_if cond t e)
+
 (* (define (f ...) ...)
    into
    (define f (lambda (...) ...))
@@ -93,10 +107,44 @@ and beginize = function
      sexpr_map beginize expr
   | expr -> expr
 
+(*
+  (or a b)
+  turns into
+  (let ((__generated_or1 a))
+   (if __generated_or1
+    __generated_or1
+    (let ((__generated_or2 b))
+     (if __generated_or2
+       __generated_or2
+       ()))))
+ *)
+and desugar_logical_or = function
+  | LCons (LSymbol "or", LCons (f, rest)) ->
+     let sym = LSymbol (Gensym.gensym "or") in
+     let f = desugar_logical_or f in
+     let rest = LCons (LSymbol "or", rest) in
+     make_letif sym f sym sym (desugar_logical_or rest)
+  | LCons (LSymbol "or", LNil) ->
+     LNil (* TODO: Change this when/if you add #t/#f *)
+  | LCons (_, _) as expr ->
+     sexpr_map desugar_logical_or expr
+  | expr -> expr
 
-
+and desugar_logical_and = function
+  | LCons (LSymbol "and", LCons (first, rest)) ->
+     let sym = LSymbol (Gensym.gensym "and") in
+     let first = desugar_logical_and first in
+     let rest = LCons (LSymbol "and", rest) in
+     make_letif sym first sym (desugar_logical_and rest) sym
+  | LCons (LSymbol "and", LNil) ->
+     LSymbol "t" (* TODO: change this when/if you add #t/#f *)
+  | LCons (_, _) as expr ->
+     sexpr_map desugar_logical_and expr
+  | expr -> expr
 and desugar x =
   x
   |> desugar_define_function
   |> desugar_internal_define
   |> beginize
+  |> desugar_logical_or
+  |> desugar_logical_and