diff --git a/bin/comp.ml b/bin/comp.ml index db0afb5..0ac222c 100644 --- a/bin/comp.ml +++ b/bin/comp.ml @@ -21,7 +21,11 @@ and dbg_print_start = function let def = Parser.parse_str "(define (f x) (+ x 1)) (define (f) (define (g y) (* y 2)) - (or (g 5) (g 6)))";; + (or (g 5) (g 6))) + (cond + ((> 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 () diff --git a/lib/compiler/sugar.ml b/lib/compiler/sugar.ml index a9ec8bd..616dfa5 100644 --- a/lib/compiler/sugar.ml +++ b/lib/compiler/sugar.ml @@ -22,7 +22,6 @@ let rec sexpr_map f = function | LNil -> LNil | _ -> failwith "Not proper list!!!" - (* This MUST be called after function definitions have been desugared, i.e. desugar_define_functions has been called *) @@ -42,20 +41,6 @@ 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,6 +78,7 @@ let rec desugar_internal_define = function | LCons (_, _) as expr -> sexpr_map desugar_internal_define expr | expr -> expr + (* Turn bodies of lambdas and letrec's *) let rec beginize = function | LCons (LSymbol "letrec" as sym, LCons (args, body)) @@ -107,6 +93,21 @@ let rec beginize = function sexpr_map beginize expr | expr -> expr +(* These are helper functions for the logical and/or desugars. *) +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) + (* (or a b) turns into @@ -142,6 +143,23 @@ let rec desugar_logical_and = function sexpr_map desugar_logical_and expr | expr -> expr +let rec cond_helper = function + | LCons (LCons (condition, then_), rest) -> + (* we need to desugar recursively, here as well. *) + let condition = desugar_cond condition in + let then_ = desugar_cond then_ in + make_if condition (LCons (LSymbol "begin", then_)) (cond_helper rest) + | LNil -> LNil + | _ -> failwith "improper cond!" + +and desugar_cond = function + | LCons (LSymbol "cond", (LCons (_, _) as conditions)) -> + cond_helper conditions + | LCons (_, _) as expr -> + sexpr_map desugar_cond expr + | expr -> expr + + let desugar x = x |> desugar_define_function @@ -149,3 +167,4 @@ let desugar x = |> beginize |> desugar_logical_or |> desugar_logical_and + |> desugar_cond