diff --git a/bin/comp.ml b/bin/comp.ml index 1e1032e..145d8e9 100644 --- a/bin/comp.ml +++ b/bin/comp.ml @@ -18,7 +18,9 @@ and dbg_print_start = function -let def = Parser.parse_str "(define (f x) (+ x 1)) +let def = Parser.parse_str "(define (f) + (let ((x 5)) + (+ x 1))) (define (f) (define (g y) (* y 2)) (or (g 5) (g 6))) diff --git a/lib/compiler/syntactic_ast.ml b/lib/compiler/syntactic_ast.ml index f0fe6e5..b017b3e 100644 --- a/lib/compiler/syntactic_ast.ml +++ b/lib/compiler/syntactic_ast.ml @@ -78,6 +78,10 @@ let sexpr_caddr cons = let* cddr = sexpr_cddr cons in sexpr_car cddr +let expect_sym = function + | LSymbol s -> Ok s + | _ -> Error "Expected symbol!" + (* We must now transform the s-expression tree into a proper, typed AST First, we need some utilities for transforming proper lists and s-expr conses. @@ -150,6 +154,24 @@ and builtin_lambda cons = let* body = parse_body body in exp (Lambda (lambda_list, body)) +and parse_bindings cons = + let parse_one cons = + let* sym = sexpr_car cons in + let* sym = expect_sym sym in + let* expr = sexpr_cadr cons in + let* expr = unwrap_exp (transform expr) in + Ok (LetBinding (sym, expr)) + in + let* l = list_of_sexpr cons in + Result.map_l parse_one l + +and make_builtin_let f cons = + let* bindings = sexpr_cadr cons in + let* bindings = parse_bindings bindings in + let* body = sexpr_cddr cons in + let* body = parse_body body in + exp (f bindings body) + and apply f args = let* args = list_of_sexpr args in let* args = Result.map_l (fun x -> unwrap_exp (transform x)) args in @@ -159,6 +181,8 @@ and apply f args = and builtin_symbol = function | "define" -> builtin_define | "lambda" -> builtin_lambda + | "let" -> (make_builtin_let (fun x y -> Let (x,y))) + | "letrec" -> (make_builtin_let (fun x y -> LetRec (x,y))) | _ -> (function | LCons (f, args) -> apply f args | _ -> Error "Invalid function application!") @@ -191,6 +215,8 @@ and print_lambda_list = function and print_let_binding x = let (LetBinding (s, expr)) = x in pf "(%s %s)" s (print_expr expr) +and print_bindings l = + ("(" ^ (String.concat "\n" (map print_let_binding l)) ^ ")") and print_def = function | Define (s, expr) -> pf "(define %s @@ -221,7 +247,7 @@ and print_expr = function %s ; EXPRESSIONS %s)" - (String.concat "\n" (map print_let_binding binds)) + (print_bindings binds) (print_defs defs) (print_exprs exprs) | LetRec (binds, Body (defs, exprs)) -> @@ -232,7 +258,7 @@ and print_expr = function %s ; EXPRESSIONS %s)" - (String.concat "\n" (map print_let_binding binds)) + (print_bindings binds) (print_defs defs) (print_exprs exprs) | Var s -> s