Types : mutual recursive functions

expr_grammar_action.g

@@ -13,7 +13,7 @@ non-terminals CMP_EXPRS CMP_EXPR
 non-terminals EQ_EXPRS EQ_EXPR
 
 non-terminals AFTER_IDENTIFIER_INSTR AFTER_IDENTIFIER_FACTOR LARGS REST_ARGS
-non-terminals TYPE AFTER_IDENTIFIER_DEC CHARACTER
+non-terminals TYPE AFTER_IDENTIFIER_DEC CHARACTER FUN_INSTR
 
 axiom S
 {
@@ -42,7 +42,7 @@ rules
 S -> FUNDEFS SYM_EOF { Node(Tlistglobdef, $1) }
 FUNDEFS -> FUNDEF FUNDEFS { $1::$2 }
 FUNDEFS -> { [] }
-FUNDEF -> TYPE IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS INSTR { Node(Tfundef, [Node(Tfuntype, [$1]); Node(Tfunname, [$2]); Node(Tfunargs, $4); Node(Tfunbody, [$6])]) }
+FUNDEF -> TYPE IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS FUN_INSTR { Node(Tfundef, [Node(Tfuntype, [$1]); Node(Tfunname, [$2]); Node(Tfunargs, $4); Node(Tfunbody, [$6])]) }
 
 TYPE -> SYM_INT { TypeLeaf Tint }
 TYPE -> SYM_CHAR { TypeLeaf Tchar }
@@ -58,6 +58,9 @@ LARGS -> { [] }
 REST_ARGS -> SYM_COMMA EXPR REST_ARGS { $2::$3 }
 REST_ARGS -> { [] }
 
+FUN_INSTR -> SYM_LBRACE LINSTRS SYM_RBRACE { $2 }
+FUN_INSTR -> SYM_SEMICOLON { NullLeaf }
+
 LINSTRS -> INSTR INSTRS { Node(Tblock, $1::$2) }
 LINSTRS -> { NullLeaf }
 INSTRS -> INSTR INSTRS { $1::$2 }

src/elang_gen.ml

@@ -48,7 +48,7 @@ let rec type_expr (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ lis
       type_expr typ_var typ_fun e1 >>= fun t1 ->
       type_expr typ_var typ_fun e2 >>= fun t2 ->
       if t1 != Tvoid && t2 != Tvoid
-        then OK Tint
+        then OK Tint (* à vérifier *)
         else Error "E: Binop is not defined on void type."
   | Eunop (u, e) -> 
       type_expr typ_var typ_fun e >>= fun t ->
@@ -195,7 +195,13 @@ let make_eprog_of_ast (a: tree) : eprog res =
     Hashtbl.replace fun_typ "print" ([Tint], Tvoid);
     Hashtbl.replace fun_typ "print_int" ([Tint], Tvoid);
     Hashtbl.replace fun_typ "print_char" ([Tchar], Tvoid);
-    list_map_res (fun a -> make_fundef_of_ast fun_typ a >>= fun (fname, efun) -> OK (fname, Gfun efun)) l
+    List.fold_left (fun acc a -> 
+    acc >>= fun f_list ->
+    make_fundef_of_ast fun_typ a >>= fun (fname, efun) -> 
+    match List.assoc_opt fname f_list with
+    | None -> OK (f_list@[fname, Gfun efun])
+    | Some (Gfun dec) when dec.funbody = Iblock [] -> OK (List.remove_assoc fname f_list @ [fname, Gfun efun])
+    | _ -> Error (Format.sprintf "E: Multiple definitions of function %s." fname)) (OK []) l
   | _ ->
     Error (Printf.sprintf "make_fundef_of_ast: Expected a Tlistglobdef, got %s."
              (string_of_ast a))

src/elang_print.ml

@@ -27,7 +27,7 @@ let rec dump_eexpr = function
   | Eint i -> Printf.sprintf "%d" i
   | Evar s -> Printf.sprintf "%s" s
   | Ecall (f, args) -> Printf.sprintf "%s(%s)" f (String.concat ", " (List.map dump_eexpr args))
-  | Echar c -> Printf.sprintf "%c" c
+  | Echar c -> Printf.sprintf "'%c'" c
 let indent_size = 2
 let spaces n =
   range (indent_size*n) |> List.map (fun _ -> ' ') |> String.of_list
@@ -66,8 +66,9 @@ let rec dump_einstr_rec indent oc i =
 let dump_einstr oc i = dump_einstr_rec 0 oc i
 
 
-let dump_efun oc funname {funargs; funbody} =
-  Format.fprintf oc "%s(%s) {\n%a\n}\n"
+let dump_efun oc funname {funargs; funbody; funrettype} =
+  Format.fprintf oc "%s %s(%s) %a\n"
+    (string_of_typ funrettype)
     funname
     (String.concat "," (List.map (fun (s, t) -> Printf.sprintf "%s %s" (string_of_typ t) s) funargs))
     dump_einstr funbody

tests/Makefile

 # if make is launched with a DIR variable, pass it as the -f option to test.py
 # 'make DIR=basic/mul*.e' launches all the files starting with mul in the basic directory
 # otherwise, use basic/*.e as a default
-FILES := $(if $(DIR),$(DIR),type_basic/*.e)
+FILES := $(if $(DIR),$(DIR),type_funcall/*.e)
 
 OPTS := $(if $(OPTS), $(OPTS),)