diff --git a/ast.ml b/ast.ml index 20f2eb0..f27437c 100644 --- a/ast.ml +++ b/ast.ml @@ -38,12 +38,27 @@ module Syntax = struct ; expr : expr ; pos : Lexing.position } + | Do of + { expr : expr + ; pos : Lexing.position + } | Return of { expr : expr ; pos : Lexing.position } - and block = instr list + type block = instr list + + type def = + | Func of + { func : ident + ; type_t : type_t + ; args : ident list + ; code : block + ; pos : Lexing.position + } + + type prog = def list end module IR = struct @@ -62,7 +77,10 @@ module IR = struct type instr = | Decl of ident | Assign of ident * expr + | Do of expr | Return of expr - and block = instr list + type 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 dd8a355..9fb4514 100644 --- a/compiler.ml +++ b/compiler.ml @@ -35,6 +35,7 @@ let compile_instr info = function { info with asm = info.asm @ compile_expr info.env e @ [ Sw (V0, Env.find v info.env) ] } + | 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 ] } ;; @@ -43,7 +44,7 @@ let rec compile_block info = function | i :: b -> compile_block (compile_instr info i) b ;; -let compile_body body counter = +let compile_def (Func (name, args, body)) counter = let compiled = compile_block { asm = [] @@ -54,21 +55,30 @@ let compile_body body counter = } body in - [ Addi (SP, SP, -compiled.fpo) - ; Sw (RA, Mem (SP, compiled.fpo - 4)) - ; Sw (FP, Mem (SP, compiled.fpo - 8)) - ; Addi (FP, SP, compiled.fpo - 4) - ] - @ compiled.asm - @ [ Label compiled.ret - ; Addi (SP, SP, compiled.fpo) - ; Lw (RA, Mem (FP, 0)) - ; Lw (FP, Mem (FP, -4)) - ; Jr RA + ( compiled.cnt + , [ Label name + ; Addi (SP, SP, -compiled.fpo) + ; Sw (RA, Mem (SP, compiled.fpo - 4)) + ; Sw (FP, Mem (SP, compiled.fpo - 8)) + ; Addi (FP, SP, compiled.fpo - 4) ] + @ compiled.asm + @ [ Label compiled.ret + ; Addi (SP, SP, compiled.fpo) + ; Lw (RA, Mem (FP, 0)) + ; Lw (FP, Mem (FP, -4)) + ; Jr RA + ] ) +;; + +let rec compile_prog counter = function + | [] -> [] + | d :: r -> + let new_counter, cd = compile_def d counter in + cd @ compile_prog new_counter r ;; let compile ir = - let asm = compile_body ir 0 in + let asm = compile_prog 0 ir in { text = asm; data = [] } ;; diff --git a/errors.ml b/errors.ml index fa3ff31..d813f9e 100644 --- a/errors.ml +++ b/errors.ml @@ -13,18 +13,19 @@ let err msg pos = exit 1 ;; +let rec string_of_type_t = function + | Void_t -> "void" + | Int_t -> "int" + | Bool_t -> "bool" + | Func_t (r, a) -> + (if List.length a > 1 then "(" else "") + ^ String.concat ", " (List.map string_of_type_t a) + ^ (if List.length a > 1 then ")" else "") + ^ " -> " + ^ string_of_type_t r +;; + let errt expected given pos = - let rec string_of_type_t = function - | Void_t -> "void" - | Int_t -> "int" - | Bool_t -> "bool" - | Func_t (r, a) -> - (if List.length a > 1 then "(" else "") - ^ String.concat ", " (List.map string_of_type_t a) - ^ (if List.length a > 1 then ")" else "") - ^ " -> " - ^ string_of_type_t r - in raise (SemanticsError ( Printf.sprintf diff --git a/lexer.mll b/lexer.mll index c6a34d5..49e8f78 100644 --- a/lexer.mll +++ b/lexer.mll @@ -19,6 +19,11 @@ rule token = parse | "int" { Ltype (Int_t) } | "bool" { Ltype (Bool_t) } | "void" { Ltype (Void_t) } +| '{' { Lbracedeb } +| '}' { Lbracefin } +| '(' { Lpardeb } +| ')' { Lparfin } +| ',' { Lcomma } | '=' { Lassign } | ';' { Lsc } | '+' { Ladd } diff --git a/main.ml b/main.ml index a1a4d10..e0942ab 100644 --- a/main.ml +++ b/main.ml @@ -10,8 +10,9 @@ let () = try let parsed = Parser.prog Lexer.token buf in close_in f; + Test.debug_parser Stdlib.stderr parsed; let ast = Semantics.analyze parsed in - (* Semantics.emit Stdlib.stderr ast; *) + (* Test.debug_semantics Stdlib.stderr ast; *) let asm = Compiler.compile ast in Mips.emit Stdlib.stdout asm with diff --git a/mips.ml b/mips.ml index f335d2e..d6d9abb 100644 --- a/mips.ml +++ b/mips.ml @@ -152,7 +152,7 @@ let fmt_dir = function ;; let emit oc asm = - Printf.fprintf oc ".text\n.globl main\nmain:\n"; + Printf.fprintf oc ".text\n.globl main\n"; List.iter (fun i -> Printf.fprintf oc "%s\n" (fmt_instr i)) asm.text; Printf.fprintf oc diff --git a/parser.mly b/parser.mly index 27471ab..8818c06 100644 --- a/parser.mly +++ b/parser.mly @@ -8,45 +8,111 @@ %token Ltype %token Lvar %token Lend Lassign Lsc Lreturn +%token Lbracedeb Lbracefin +%token Lpardeb Lparfin Lcomma %token Ladd Lsub Lmul Ldiv -%left Ladd Lsub -%left Lmul Ldiv +%left Ladd Lsub Lmul Ldiv %start prog -%type prog +%type block +%type prog +%type args_ident +%type args_expr %% prog: + /* Liste des définitions de fonction */ + | i = def ; b = prog { i @ b } /* Fin de programme */ | Lend { [] } - /* instr; */ - | i = instr ; Lsc ; b = prog { i @ b } +def: + /* Définition fonction : type fonction (args) block */ + | t = Ltype + ; f = Lvar + ; a = args_ident + ; b = block { + [ Func { func = f ; type_t = t ; args = a ; code = b ; pos = $startpos(f) } ] + } + + /* Définition fonction : type fonction () block */ + | t = Ltype + ; f = Lvar + ; Lpardeb + ; Lparfin + ; b = block { + [ Func { func = f ; type_t = t ; args = [] ; code = b ; pos = $startpos(f) } ] + } + +args_ident: + /* ( */ + | Lpardeb ; s = args_ident { s } + + /* a, ... */ + | a = arg_ident ; Lcomma ; s = args_ident { a @ s } + + /* ..., c) */ + | a = arg_ident ; Lparfin { a } + + /* ..., c) */ + | Lparfin { [] } + +arg_ident: + /* Argument */ + | a = Lvar { [ a ] } + +block: + /* { */ + | Lbracedeb ; b = block { b } + + /* instr; ... */ + | i = instr ; b = block { i @ b } + + /* } */ + | Lbracefin { [] } ; instr: /* return x */ - | Lreturn ; e = expr { [ Return { expr = e ; pos = $startpos } ] } + | Lreturn ; e = expr ; Lsc { [ Return { expr = e ; pos = $startpos } ] } /* type v */ - | t = Ltype ; v = Lvar { + | t = Ltype ; v = Lvar ; Lsc { [ Decl { name = v ; type_t = t ; pos = $startpos(t) } ] } /* type v = e */ - | t = Ltype ; v = Lvar ; Lassign ; e = expr + | t = Ltype ; v = Lvar ; Lassign ; e = expr ; Lsc { [ Decl { name = v ; type_t = t ; pos = $startpos(t) } ; Assign { var = v ; expr = e ; pos = $startpos(v) } ] } /* v = e */ - | v = Lvar ; Lassign ; e = expr { + | v = Lvar ; Lassign ; e = expr ; Lsc { [ Assign { var = v ; expr = e ; pos = $startpos($2) } ] } + /* function() */ + | f = Lvar ; a = args_expr ; Lsc { + [ Do { expr = Call { func = f ; args = a ; pos = $startpos(a) } ; pos = $startpos} ] + } + +args_expr: + /* ( */ + | Lpardeb ; s = args_expr { s } + + /* a, ... */ + | a = expr ; Lcomma ; s = args_expr { a :: s } + + /* ..., c) */ + | a = expr ; Lparfin { [ a ] } + + /* ..., c) */ + | Lparfin { [] } + expr: /* int */ | n = Lint { diff --git a/semantics.ml b/semantics.ml index e627958..406cb4a 100644 --- a/semantics.ml +++ b/semantics.ml @@ -53,6 +53,9 @@ let analyze_instr env ua = function then raise (SemanticsError ("Unbound variable \"" ^ a.var ^ "\"", a.pos)); let ae, et = analyze_expr env ua (Env.find a.var env) a.expr in Assign (a.var, ae), env, List.filter (fun x -> x <> a.var) ua + | Syntax.Do d -> + let ae, _ = analyze_expr env ua Int_t d.expr in + Do ae, env, [] | Syntax.Return r -> let ae, _ = analyze_expr env ua Int_t r.expr in Return ae, env, [] @@ -65,22 +68,13 @@ let rec analyze_block env ua = function new_instr :: analyze_block new_env new_ua new_block ;; -let analyze parsed = analyze_block _types_ [] parsed - -let emit oc ast = - let rec fmt_v = function - | Void -> "Void" - | Int n -> "Int " ^ string_of_int n - | Bool b -> "Bool " ^ string_of_bool b - and fmt_e = function - | Val v -> "Val (" ^ fmt_v v ^ ")" - | Var v -> "Var \"" ^ v ^ "\"" - | Call (f, a) -> - "Call (\"" ^ f ^ "\", [ " ^ String.concat " ; " (List.map fmt_e a) ^ " ])" - and fmt_i = function - | Decl v -> "Decl \"" ^ v ^ "\"" - | Assign (v, e) -> "Assign (\"" ^ v ^ "\", " ^ fmt_e e ^ ")" - | Return e -> "Return (" ^ fmt_e e ^ ")" - and fmt_b b = "[ " ^ String.concat "\n; " (List.map fmt_i b) ^ " ]" in - Printf.fprintf oc "%s\n" (fmt_b ast) +let analyze_func env ua = function + | Syntax.Func f -> Func (f.func, f.args, analyze_block env ua f.code) ;; + +let rec analyze_prog env ua = function + | [] -> [] + | fn :: suite -> analyze_func env ua fn :: analyze_prog env ua suite +;; + +let analyze parsed = analyze_prog _types_ [] parsed diff --git a/test.ml b/test.ml new file mode 100644 index 0000000..f1d9b39 --- /dev/null +++ b/test.ml @@ -0,0 +1,53 @@ +open Ast +open Ast.IR +open Errors + +let debug_parser oc parsed = + let rec fmt_v = function + | Syntax.Void -> "Void" + | Syntax.Int d -> "Int " ^ string_of_int d + | Syntax.Bool d -> "Bool " ^ string_of_bool d + and fmt_e = function + | Syntax.Val d -> "Val (" ^ fmt_v d.value ^ ")" + | Syntax.Var d -> "Var \"" ^ d.name ^ "\"" + | Syntax.Call d -> + "Call (\"" ^ d.func ^ "\", [ " ^ String.concat " ; " (List.map fmt_e d.args) ^ " ])" + and fmt_i = function + | 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.Return d -> "Return (" ^ fmt_e d.expr ^ ")" + and fmt_b b = "[ " ^ String.concat "\n; " (List.map fmt_i b) ^ " ]" + and fmt_f = function + | Syntax.Func d -> + "Func ( " + ^ string_of_type_t d.type_t + ^ ", \"" + ^ d.func + ^ ", [" + ^ String.concat "\n; " d.args + ^ "], [" + ^ fmt_b d.code + ^ "])\n" + and fmt_p p = "[ " ^ String.concat "\n; " (List.map fmt_f p) ^ "]" in + Printf.fprintf oc "%s\n" (fmt_p parsed) +;; + +let debug_semantics oc ast = + let rec fmt_v = function + | Void -> "Void" + | Int n -> "Int " ^ string_of_int n + | Bool b -> "Bool " ^ string_of_bool b + and fmt_e = function + | Val v -> "Val (" ^ fmt_v v ^ ")" + | Var v -> "Var \"" ^ v ^ "\"" + | Call (f, a) -> + "Call (\"" ^ f ^ "\", [ " ^ String.concat " ; " (List.map fmt_e a) ^ " ])" + and fmt_i = function + | Decl v -> "Decl \"" ^ v ^ "\"" + | Assign (v, e) -> "Assign (\"" ^ v ^ "\", " ^ fmt_e e ^ ")" + | Do e -> "Do (" ^ fmt_e e ^ ")" + | Return e -> "Return (" ^ fmt_e e ^ ")" + and fmt_b b = "[ " ^ String.concat "\n; " (List.map fmt_i b) ^ " ]" in + Printf.fprintf oc "%s\n" (fmt_b ast) +;; diff --git a/tests/11_def.test b/tests/11_def.test new file mode 100644 index 0000000..80c7e77 --- /dev/null +++ b/tests/11_def.test @@ -0,0 +1,8 @@ +int cops_calculator () { + int res = 13 * 100 + 20 - 8; + return res * 2 / 2; +} + +void main () { + cops_calculator(); +}