syntactic_ast: fix issue in set! parsing, add set! to the test case.

bin/comp.ml

@@ -20,7 +20,7 @@ and dbg_print_start = function
 
 let def = Parser.parse_str "(define (f)
                              (let ((x 5))
-                              (if t (+ x 1))))
+                              (if t (set! x (+ x 1)))))
                             (define (f)
                               (define (g y) (* y 2))
                               (or (g 5) (g 6)))

lib/compiler/syntactic_ast.ml

@@ -35,6 +35,7 @@ type _ t =
   | Cond : clause t list -> expression t
 
   | If : expression t * expression t * expression t -> expression t
+  | Set : string * expression t -> expression t
 
   | Var : symbol -> expression t
   | Apply : expression t * expression t list -> expression t
@@ -147,7 +148,7 @@ and builtin_define cons =
      let* body = sexpr_cddr cons in
      let* body = parse_body body in
      def (Define (sym, Lambda (lambda_list, body)))
-  | _ -> Error "lmao"
+  | _ -> Error "invalid definition!"
 
 and builtin_lambda cons =
   let* lambda_list = sexpr_cadr cons in
@@ -186,7 +187,7 @@ and parse_clauses cons =
   Result.map_l parse_one l
 
 and builtin_cond cons =
-  let* clauses = sexpr_cadr cons in
+  let* clauses = sexpr_cdr cons in
   let* clauses = parse_clauses clauses in
   exp (Cond clauses)
 
@@ -202,6 +203,16 @@ and builtin_if cons =
   let* else_branch = unwrap_exp (transform else_branch) in
   exp (If (test, then_branch, else_branch))
 
+and builtin_set cons =
+  let* cons = sexpr_cdr cons in
+  let* sym = sexpr_car cons in
+  let* sym = (match sym with
+             | LSymbol s -> Ok s
+             | _ -> Error "cannot (set!) a non-symbol") in
+  let* expr = sexpr_cadr cons in
+  let* expr = unwrap_exp (transform expr) in
+  exp (Set (sym, expr))
+
 and apply f args =
   let* args = list_of_sexpr args in
   let* args = Result.map_l (fun x -> unwrap_exp (transform x)) args in
@@ -215,6 +226,7 @@ and builtin_symbol = function
   | "letrec" -> (make_builtin_let (fun x y -> LetRec (x,y)))
   | "cond" -> builtin_cond
   | "if" -> builtin_if
+  | "set!" -> builtin_set
   | _ -> (function
        | LCons (f, args) -> apply f args
        | _ -> Error "Invalid function application!")
@@ -253,7 +265,7 @@ and print_clause x =
   let (CondClause (test, expr)) = x in
   pf "(%s %s)" (print_expr test) (print_expr expr)
 and print_clauses l =
-  ("(" ^ (String.concat "\n" (map print_clause l)) ^ ")")
+  (String.concat "\n" (map print_clause l))
 and  print_def = function
   | Define (s, expr) ->
      pf "(define %s
@@ -305,6 +317,8 @@ and print_expr = function
   | Var s -> s
   | If (e1, e2, e3) ->
      pf "(if %s %s %s)" (print_expr e1) (print_expr e2) (print_expr e3)
+  | Set (s, expr) ->
+     pf "(set! %s %s)" s (print_expr expr)
   | Apply (f, exprs) ->
      pf "(apply %s %s)"
        (print_expr f)

lib/compiler/syntactic_ast.mli

@@ -29,6 +29,7 @@ type _ t =
   | Cond : clause t list -> expression t
 
   | If : expression t * expression t * expression t -> expression t
+  | Set : string * expression t -> expression t
 
   | Var : symbol -> expression t
   | Apply : expression t * expression t list -> expression t