* add condition

* fn can now return void
* fix a bug in type checking a
* fix a typo in the simplifier (Do/Return)

ast.ml

@@ -45,12 +45,18 @@ module Syntax = struct
         { expr : expr
         ; pos : Lexing.position
         }
+    | Cond of
+        { expr : expr
+        ; if_b : block
+        ; else_b : block
+        ; pos : Lexing.position
+        }
     | Return of
         { expr : expr
         ; pos : Lexing.position
         }
 
-  type block = instr list
+  and block = instr list
 
   type arg =
     | Arg of
@@ -104,9 +110,11 @@ module IR (P : Parameters) = struct
     | Decl of ident
     | Assign of ident * expr
     | Do of expr
+    | Cond of expr * block * block
     | Return of expr
 
-  type block = instr list
+  and block = instr list
+
   type def = Func of ident * ident list * block
   type prog = def list
 end

compiler.ml

@@ -36,18 +36,32 @@ let rec compile_expr env = function
     else [ Jal (puf ^ f); Addi (SP, SP, 4 * List.length args) ]
 ;;
 
-let compile_instr info = function
+let rec compile_instr info = function
   | Decl v ->
     { info with env = Env.add v (Mem (FP, -info.fpo)) info.env; fpo = info.fpo + 4 }
   | Assign (v, e) ->
     { info with
       asm = info.asm @ compile_expr info.env e @ [ Sw (V0, Env.find v info.env) ]
     }
+  | Cond (e, ib, eb) ->
+    let uniq = string_of_int info.cnt in
+    let cib = compile_block { info with asm = []; cnt = info.cnt + 1 } ib in
+    let ceb = compile_block { info with asm = []; cnt = cib.cnt } eb in
+    { info with
+      asm =
+        info.asm
+        @ compile_expr info.env e
+        @ [ Beqz (V0, "else" ^ uniq) ]
+        @ cib.asm
+        @ [ B ("endif" ^ uniq); Label ("else" ^ uniq) ]
+        @ ceb.asm
+        @ [ Label ("endif" ^ uniq) ]
+    ; cnt = ceb.cnt
+    }
   | Do e -> { info with asm = info.asm @ compile_expr info.env e }
   | Return e -> { info with asm = info.asm @ compile_expr info.env e @ [ B info.ret ] }
-;;
 
-let rec compile_block info = function
+and compile_block info = function
   | [] -> info
   | i :: b -> compile_block (compile_instr info i) b
 ;;

lexer.mll

@@ -20,6 +20,8 @@ rule token = parse
   | "bool"        { Ltype (Bool_t) }
   | "void"        { Ltype (Void_t) }
   | "str"         { Ltype (Str_t) }
+  | "if"          { Lif }
+  | "else"        { Lelse }
   | '{'           { Lbracedeb }
   | '}'           { Lbracefin }
   | '('           { Lpardeb }

parser.mly

@@ -12,11 +12,13 @@
 %token Lbracedeb Lbracefin
 %token Lpardeb Lparfin Lcomma
 %token Ladd Lsub Lmul Ldiv
+%token Lif Lelse
 
 %left Ladd Lsub Lmul Ldiv
 
 %left Lbracedeb Lparfin Lbracefin Lreturn
 %left Ltype Lbool Lint Lvar Lstr
+%left Lif
 
 %start prog
 
@@ -86,6 +88,12 @@ instr:
   /* return x; */
   | Lreturn ; e = expr ; Lsc { [ Return { expr = e ; pos = $startpos } ] }
 
+  /* return; */
+  | Lreturn ; Lsc {
+    [ Return { expr = Val { value = Void ; pos = $startpos }
+             ; pos = $startpos } ]
+    }
+
   /* type v; */
   | t = Ltype ; v = Lvar ; Lsc {
     [ Decl { name = v ; type_t = t ; pos = $startpos(t) } ]
@@ -107,6 +115,16 @@ instr:
     [ Do { expr = e ; pos = $startpos} ]
   }
 
+  /* if (e) {} else {} */
+  | Lif ; Lpardeb ; e = expr ; Lparfin ; b1 = block ; Lelse ; b2 = block {
+    [ Cond { expr = e ; if_b = b1 ; else_b = b2 ; pos = $startpos } ]
+  }
+
+  /* if (e) {} */
+  | Lif ; Lpardeb ; e = expr ; Lparfin ; b = block {
+    [ Cond { expr = e ; if_b = b ; else_b = [] ; pos = $startpos } ]
+  }
+
 expr:
   /* int */
   | n = Lint {

semantics.ml

@@ -14,7 +14,7 @@ let analyze_value = function
 let rec analyze_expr env ua t = function
   | Syntax.Val v ->
     let v2, new_t = analyze_value v.value in
-    if new_t != t then errt t new_t v.pos;
+    if new_t != t && t != Magic_t then errt t new_t v.pos;
     Val v2, new_t
   | Syntax.Var v ->
     if not (Env.mem v.name env)
@@ -58,7 +58,7 @@ let rec analyze_expr env ua t = function
     | _ -> raise (SemanticsError ("\"" ^ c.func ^ "\" isn't a function", c.pos)))
 ;;
 
-let analyze_instr env ua ret_t = function
+let rec analyze_instr env ua ret_t = function
   | Syntax.Decl d -> Decl d.name, Env.add d.name d.type_t env, [ d.name ] @ ua
   | Syntax.Assign a ->
     if not (Env.mem a.var env)
@@ -68,14 +68,19 @@ let analyze_instr env ua ret_t = function
   | Syntax.Do d ->
     let ae, _ = analyze_expr env ua Magic_t d.expr in
     Do ae, env, []
+  | Syntax.Cond c ->
+    let cond, _ = analyze_expr env ua Bool_t c.expr in
+    let if_b, _ = analyze_block env ua Magic_t c.pos c.if_b in
+    let else_b, _ = analyze_block env ua Magic_t c.pos c.else_b in
+    Cond (cond, if_b, else_b), env, []
   | Syntax.Return r ->
     let ae, _ = analyze_expr env ua ret_t r.expr in
     Return ae, env, []
-;;
 
-let rec analyze_block env ua ret_t pos = function
+and analyze_block env ua ret_t pos = function
   | [] ->
-    if ret_t != Void_t then warn "Non-void function without return" pos;
+    if ret_t != Void_t && ret_t != Magic_t
+    then warn "Non-void function without return" pos;
     [], ua
   | instr :: new_block ->
     let new_instr, new_env, ua1 = analyze_instr env ua ret_t instr in

simplifier.ml

@@ -19,34 +19,39 @@ let collect_constant_strings code =
   in
   let rec ccs_expr = function
     | IR1.Val v ->
-      let v2, cs = ccs_value v in
-      IR2.Val v2, cs
+      let v2, ccs = ccs_value v in
+      IR2.Val v2, ccs
     | IR1.Var v -> IR2.Var v, []
     | IR1.Call (fn, args) ->
       let args2 = List.map ccs_expr args in
       IR2.Call (fn, List.map fst args2), List.flatten (List.map snd args2)
   in
-  let ccs_instr = function
+  let rec ccs_instr = function
     | IR1.Decl v -> IR2.Decl v, []
     | IR1.Assign (lv, e) ->
-      let e2, cs = ccs_expr e in
-      IR2.Assign (lv, e2), cs
+      let e2, ccs = ccs_expr e in
+      IR2.Assign (lv, e2), ccs
     | IR1.Do e ->
-      let e2, cs = ccs_expr e in
-      IR2.Do e2, cs
+      let e2, ccs = ccs_expr e in
+      IR2.Do e2, ccs
+    | IR1.Cond (e, ib, eb) ->
+      let e2, ccs = ccs_expr e in
+      let ib2, ccs2 = ccs_block ib in
+      let eb2, ccs3 = ccs_block eb in
+      IR2.Cond (e2, ib2, eb2), List.flatten [ ccs; ccs2; ccs3 ]
     | IR1.Return e ->
-      let e2, cs = ccs_expr e in
-      IR2.Do e2, cs
-  in
-  let rec ccs_block acc_b acc_cs = function
-    | i :: b ->
-      let i2, cs = ccs_instr i in
-      ccs_block (i2 :: acc_b) (cs @ acc_cs) b
-    | [] -> List.rev acc_b, acc_cs
+      let e2, ccs = ccs_expr e in
+      IR2.Return e2, ccs
+  and ccs_block = function
+    | [] -> [], []
+    | i :: s ->
+      let i2, ccs_i = ccs_instr i in
+      let b, ccs_r = ccs_block s in
+      i2 :: b, List.flatten [ ccs_i; ccs_r ]
   in
   let ccs_def (IR1.Func (name, args, body)) =
-    let body2, cs = ccs_block [] [] body in
-    IR2.Func (name, args, body2), cs
+    let body2, ccs = ccs_block body in
+    IR2.Func (name, args, body2), ccs
   in
   let code2 = List.map ccs_def code in
   ( List.map fst code2

test.ml

@@ -18,6 +18,8 @@ let debug_parser oc parsed =
     | Syntax.Decl d -> "Decl(" ^ string_of_type_t d.type_t ^ ") \"" ^ d.name ^ "\""
     | Syntax.Assign d -> "Assign (\"" ^ d.var ^ "\", " ^ fmt_e d.expr ^ ")"
     | Syntax.Do d -> "Do (" ^ fmt_e d.expr ^ ")"
+    | Syntax.Cond c ->
+      "Cond (" ^ fmt_e c.expr ^ ", " ^ fmt_b c.if_b ^ ", " ^ fmt_b c.else_b ^ ")"
     | Syntax.Return d -> "Return (" ^ fmt_e d.expr ^ ")"
   and fmt_b b = " [ " ^ String.concat "\n ; " (List.map fmt_i b) ^ "\n ]"
   and fmt_f = function
@@ -56,6 +58,7 @@ let debug_semantics oc ast =
     | Decl v -> "Decl \"" ^ v ^ "\""
     | Assign (v, e) -> "Assign (\"" ^ v ^ "\", " ^ fmt_e e ^ ")"
     | Do e -> "Do (" ^ fmt_e e ^ ")"
+    | Cond (c, i, e) -> "Cond (" ^ fmt_e c ^ ", " ^ fmt_b i ^ ", " ^ fmt_b e ^ ")"
     | Return e -> "Return (" ^ fmt_e e ^ ")"
   and fmt_b b = "[ " ^ String.concat "\n; " (List.map fmt_i b) ^ " ]"
   and fmt_f = function