WIP Function implementation

* Add basic support of function
* move debug function to test file
* add a test who need to pass to end the implementation

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

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 = [] }
 ;;

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

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 }

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

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

parser.mly

@@ -8,45 +8,111 @@
 %token <Ast.type_t> Ltype
 %token <string> 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 <Ast.Syntax.block> prog
+%type <Ast.Syntax.block> block
+%type <Ast.Syntax.prog> prog
+%type <Ast.Syntax.ident list> args_ident
+%type <Ast.Syntax.expr list> 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 {

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

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)
+;;

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();
+}