From b5d13ab1d6bd63d4cf08c9db708adb898db53aea Mon Sep 17 00:00:00 2001 From: Mylloon Date: Tue, 13 Dec 2022 16:09:25 +0100 Subject: [PATCH] * add condition * fn can now return void * fix a bug in type checking a * fix a typo in the simplifier (Do/Return) --- ast.ml | 12 ++++++++++-- compiler.ml | 20 +++++++++++++++++--- lexer.mll | 2 ++ parser.mly | 18 ++++++++++++++++++ semantics.ml | 15 ++++++++++----- simplifier.ml | 39 ++++++++++++++++++++++----------------- test.ml | 3 +++ 7 files changed, 82 insertions(+), 27 deletions(-) diff --git a/ast.ml b/ast.ml index 39e56df..82f8570 100644 --- a/ast.ml +++ b/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 diff --git a/compiler.ml b/compiler.ml index 6a3ff6d..1c8a15f 100644 --- a/compiler.ml +++ b/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 ;; diff --git a/lexer.mll b/lexer.mll index 670e97e..6931692 100644 --- a/lexer.mll +++ 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 } diff --git a/parser.mly b/parser.mly index 8e09441..6de2da9 100644 --- a/parser.mly +++ b/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 { diff --git a/semantics.ml b/semantics.ml index cef7b7b..f21d7ad 100644 --- a/semantics.ml +++ b/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 diff --git a/simplifier.ml b/simplifier.ml index 3822d60..85c1af2 100644 --- a/simplifier.ml +++ b/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 diff --git a/test.ml b/test.ml index da94735..24b830f 100644 --- a/test.ml +++ b/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