summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlex AUVOLAT <alex.auvolat@ens.fr>2013-12-25 23:19:14 +0100
committerAlex AUVOLAT <alex.auvolat@ens.fr>2013-12-25 23:19:14 +0100
commit62d931b6b52bbb952a2c280823dcc8bb5bd591bd (patch)
tree1afdbb73acd089f7b38ec47ea4f2d4047e549bde
parent7ede04f410c1df7cfe3e96e4101db1570c2a16ae (diff)
downloadLPC-Projet-62d931b6b52bbb952a2c280823dcc8bb5bd591bd.tar.gz
LPC-Projet-62d931b6b52bbb952a2c280823dcc8bb5bd591bd.zip
Begin code generation (many bugs...)
-rw-r--r--doc.txt19
-rw-r--r--src/Makefile2
-rw-r--r--src/codegen.ml327
-rw-r--r--src/main.ml3
-rw-r--r--src/pretty_typing.ml19
-rwxr-xr-xsrc/test.sh73
-rw-r--r--src/typing.ml51
7 files changed, 428 insertions, 66 deletions
diff --git a/doc.txt b/doc.txt
new file mode 100644
index 0000000..44d3bd7
--- /dev/null
+++ b/doc.txt
@@ -0,0 +1,19 @@
+Pour une fonction f(x, y) on a sur la pile :
+
+ | ..... |
+ | y | construit par
+ | x | l'appelant
+ ----------------------------------
+ | sauv. $fp | construit par
+ $fp--> | sauv. $ra | l'appelé
+ | z |
+ | ..... |
+
+La valeur renvoyée par une fonction est passée dans le registre a0.
+
+
+---
+
+Tous les calculs se font en utilisant a0 comme sommet de pile (les seuls valeurs
+plus grosses qu'un registre ne sont jamais manipulées en tant que valeurs mais toujours
+en tant qu'adresses... donc tout va bien)
diff --git a/src/Makefile b/src/Makefile
index e9cde1c..529ad64 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -2,7 +2,7 @@ BIN=minic++
all: $(BIN)
-$(BIN): main.ml ast.ml parser.mly lexer.mll pretty.ml typing.ml pretty_typing.ml
+$(BIN): main.ml ast.ml parser.mly lexer.mll pretty.ml typing.ml pretty_typing.ml codegen.ml
ocamlbuild main.byte
mv main.byte minic++
diff --git a/src/codegen.ml b/src/codegen.ml
index 2709526..316caa6 100644
--- a/src/codegen.ml
+++ b/src/codegen.ml
@@ -1,6 +1,329 @@
open Mips
+open Typing
+
+exception Very_bad_error of string
+
+(* Environnement pour accéder aux variables *)
+type whereis_var =
+ | VGlobal
+ | VStack of int (* position relative à $fp *)
+ | VStackByRef of int
+
+type cg_env = {
+ c_penv : env;
+ c_names : whereis_var Smap.t;
+ c_ret_lbl : string;
+ c_ret_ref : bool;
+ c_fp_used : int;
+}
+
+let globals_env = ref Smap.empty
+
+let strings = Hashtbl.create 12 (* string -> label *)
+
+(* Identifiants uniques pour les machins - essentiellement labels *)
+let id =
+ let last = ref 0 in
+ fun prefix -> (last := !last + 1; prefix ^ (string_of_int !last))
+
+
+(* Génération de code des machins *)
+
+let cr a = if a then lw a0 areg (0, a0) else nop (* conditionnally read *)
+
+(* Convention : doit garder $sp invariant *)
+let rec gen_expr env e = match e.te_desc with
+ | TEInt(k) -> li a0 k, false
+ | TENull -> move a0 zero, false
+ | TEThis -> (* convention : this is always the last-pushed argument *)
+ la a0 areg (8, fp), false
+ | TEIdent(i) ->
+ begin match Smap.find i env.c_names with
+ | VGlobal -> la a0 alab i, true
+ | VStack(i) -> la a0 areg (i, fp), true
+ | VStackByRef(i) -> lw a0 areg (i, fp), true
+ end
+ | TEAssign(e1, e2) ->
+ let t1, ae1 = gen_expr env e1 in
+ assert ae1;
+ let t2, ae2 = gen_expr env e2 in
+ t1 ++ push a0 ++ t2 ++ cr ae2 ++ pop a1 ++ sw a0 areg (0, a1), false
+ | TECallFun(id, args, b) ->
+ let code = List.fold_left
+ (fun code (arg, byref) ->
+ let c, r = gen_expr env arg in
+ assert (r || not byref);
+ c ++ cr (r && not byref) ++ push a0 ++ code) nop args in
+ code ++ jal id ++ popn (4 * (List.length args)), b
+ | TECallVirtual(obj, ti, fi, args, b) ->
+ let code = List.fold_left
+ (fun code (arg, byref) ->
+ let c, r = gen_expr env arg in
+ assert (r || not byref);
+ c ++ cr (r && not byref) ++ push a0 ++ code) nop args in
+ let code2, a = gen_expr env obj in
+ assert a;
+ code ++ code2 ++ push a0 ++ lw a0 areg (ti, a0) ++ lw a0 areg (fi, a0)
+ ++ jalr a0 ++ popn (4 * (1 + List.length args)), b
+ | TEUnary (x, e) ->
+ let t, a = gen_expr env e in
+ begin match x with
+ | Ast.Deref -> t ++ cr a, true
+ | Ast.Ref -> assert a; t, false
+ | Ast.Plus -> t, a
+ | Ast.Minus -> t ++ cr a ++ sub a0 zero oreg a0, false
+ | Ast.Not -> t ++ cr a ++ not_ a0 a0, false
+ | Ast.PreIncr -> assert a; t ++ lw a1 areg (0, a0) ++ add a1 a1 oi 1 ++ sw a1 areg (0, a0), true
+ | Ast.PreDecr -> assert a; t ++ lw a1 areg (0, a0) ++ sub a1 a1 oi 1 ++ sw a1 areg (0, a0), true
+ | Ast.PostIncr -> assert a; t ++ move a1 a0 ++ lw a2 areg(0, a1) ++ move a0 a2 ++
+ add a2 a2 oi 1 ++ sw a2 areg(0, a1), false
+ | Ast.PostDecr -> assert a; t ++ move a1 a0 ++ lw a2 areg(0, a1) ++ move a0 a2 ++
+ sub a2 a2 oi 1 ++ sw a2 areg(0, a1), false
+ end
+ | TEBinary(e1, op, e2) ->
+ let t1, ae1 = gen_expr env e1 in
+ let t2, ae2 = gen_expr env e2 in
+ let t1 = t1 ++ cr ae1 in
+ let t2 = t2 ++ cr ae2 in
+ (
+ match op with
+ | Ast.Add -> t1 ++ push a0 ++ t2 ++ pop a1 ++ add a0 a1 oreg a0
+ | Ast.Sub -> t1 ++ push a0 ++ t2 ++ pop a1 ++ sub a0 a1 oreg a0
+ | Ast.Mul -> t1 ++ push a0 ++ t2 ++ pop a1 ++ mul a0 a1 oreg a0
+ | Ast.Div -> t1 ++ push a0 ++ t2 ++ pop a1 ++ div a0 a1 oreg a0
+ | Ast.Modulo -> t1 ++ push a0 ++ t2 ++ pop a1 ++ rem a0 a1 oreg a0
+ | Ast.Equal -> t1 ++ push a0 ++ t2 ++ pop a1 ++ seq a0 a1 a0
+ | Ast.NotEqual -> t1 ++ push a0 ++ t2 ++ pop a1 ++ sne a0 a1 a0
+ | Ast.Lt -> t1 ++ push a0 ++ t2 ++ pop a1 ++ slt a0 a1 a0
+ | Ast.Le -> t1 ++ push a0 ++ t2 ++ pop a1 ++ sle a0 a1 a0
+ | Ast.Gt -> t1 ++ push a0 ++ t2 ++ pop a1 ++ sgt a0 a1 a0
+ | Ast.Ge -> t1 ++ push a0 ++ t2 ++ pop a1 ++ sge a0 a1 a0
+ | Ast.Land ->
+ let lazy_lbl = id "_lazy" in
+ t1 ++ beqz a0 lazy_lbl ++ t2 ++ label lazy_lbl
+ | Ast.Lor ->
+ let lazy_lbl = id "_lazy" in
+ t1 ++ bnez a0 lazy_lbl ++ t2 ++ label lazy_lbl
+ ), false
+ | TEMember(e, i) ->
+ let c, a = gen_expr env e in
+ if i <> 0 then begin
+ assert a;
+ c ++ la a0 areg (i, a0), true
+ end else
+ c, a
+ | TENew(cls, constr, args) ->
+ let alloc =
+ li v0 9 ++ li a0 cls.tc_size ++ syscall in
+ begin match constr with
+ | None -> alloc ++ (jal ("_c_" ^ cls.tc_name)), false
+ | Some x ->
+ let args_code = List.fold_left
+ (fun code (arg, byref) ->
+ let c, r = gen_expr env arg in
+ assert (r || not byref);
+ c ++ cr (r && not byref) ++ push a0 ++ code) nop args in
+ let c = args_code ++ alloc ++ push v0 ++ jal x in
+ c ++ pop a0 ++ popn (4 * List.length args), false
+ end
+
+
+let rec gen_stmt env = function
+ | TSEmpty -> nop, nop, env
+ | TSExpr(e) ->
+ comment "expr" ++ (fst (gen_expr env e)), nop, env
+ | TSIf(cond, s1, s2) ->
+ let c, a = gen_expr env cond in
+ let l_else = id "_cond" in
+ let l_end = id "_cond" in
+ let c_then, d_then, _ = gen_stmt env s1 in
+ let c_else, d_else, _ = gen_stmt env s2 in
+ comment "if" ++ c ++ cr a ++ beqz a0 l_else ++ c_then ++ b l_end ++
+ label l_else ++ c_else ++ label l_end, d_then ++ d_else, env
+ | TSWhile(cond, body) ->
+ let c, a = gen_expr env cond in
+ let l_begin = id "_while_begin" in
+ let l_cond = id "_while_cond" in
+ let c_body, d_body, _ = gen_stmt env body in
+ comment "while" ++ b l_cond ++ label l_begin ++ c_body ++
+ label l_cond ++ c ++ cr a ++ bnez a0 l_begin, d_body, env
+ | TSFor(before, cond, after, body) ->
+ let l_begin = id "_for_begin" in
+ let l_cond = id "_for_cond" in
+ let c_before = List.fold_left
+ (fun code expr -> let c, _ = gen_expr env expr in code ++ c) nop before in
+ let c_after = List.fold_left
+ (fun code expr -> let c, _ = gen_expr env expr in code ++ c) nop after in
+ let c_cond = match cond with
+ | None -> b l_begin
+ | Some x -> let c, a = gen_expr env x in
+ c ++ cr a ++ bnez a0 l_begin in
+ let c_body, d_body, _ = gen_stmt env body in
+ comment "for" ++ c_before ++ b l_cond ++ label l_begin ++ c_body ++ c_after ++ label l_cond
+ ++ c_cond, d_body, env
+ | TSBlock(b) ->
+ let c, d = gen_block env b in
+ comment "block" ++ c, d, env
+ | TSReturn (None) ->
+ comment "return" ++ b env.c_ret_lbl, nop, env
+ | TSReturn (Some e) ->
+ let c, a = gen_expr env e in
+ assert (a || not env.c_ret_ref);
+ comment "return" ++ c ++ cr (not env.c_ret_ref && a) ++ b env.c_ret_lbl, nop, env
+ | TSDeclare (ty, id) ->
+ let s = type_size env.c_penv ty in
+ let new_fp_used = env.c_fp_used + s in
+ let pos = - new_fp_used in
+ let code = match ty with
+ | TClass(i) ->
+ sub sp sp oi s ++
+ la v0 areg (pos, fp) ++
+ jal ("_c_" ^ i)
+ | _ -> push zero
+ in
+ comment ("declare " ^ id) ++ code, nop, {
+ c_penv = env.c_penv;
+ c_names = Smap.add id (VStack pos) env.c_names;
+ c_ret_lbl = env.c_ret_lbl;
+ c_ret_ref = env.c_ret_ref;
+ c_fp_used = new_fp_used }
+ | TSDeclareAssignConstructor(cls, id, constr, args) ->
+ let new_fp_used = env.c_fp_used + cls.tc_size in
+ let pos = - new_fp_used in
+ let code = match constr with
+ | None -> sub sp sp oi cls.tc_size ++ move v0 sp ++ (jal ("_c_" ^ cls.tc_name))
+ | Some x ->
+ let args_code = List.fold_left
+ (fun code (arg, byref) ->
+ let c, r = gen_expr env arg in
+ assert (r || not byref);
+ c ++ cr (r && not byref) ++ push a0 ++ code) nop args in
+ sub sp sp oi cls.tc_size ++ args_code ++ la a0 areg(pos, fp) ++ push a0 ++ jal x ++
+ popn (4 * (List.length args + 1))
+ in
+ comment ("declare " ^ id) ++ code, nop, {
+ c_penv = env.c_penv;
+ c_names = Smap.add id (VStack pos) env.c_names;
+ c_ret_lbl = env.c_ret_lbl;
+ c_ret_ref = env.c_ret_ref;
+ c_fp_used = new_fp_used; }
+ | TSDeclareAssignExpr ((ty, r), id, e) ->
+ let s = if r then 4 else type_size env.c_penv ty in
+ assert (s = 4);
+ let new_fp_used = env.c_fp_used + 4 in
+ let pos = - new_fp_used in
+ let code, a = gen_expr env e in
+ assert (a || not r);
+ comment ("declare " ^ id) ++ code ++ cr (a && not r) ++ push a0, nop, {
+ c_penv = env.c_penv;
+ c_names = Smap.add id (if r then VStackByRef pos else VStack pos) env.c_names;
+ c_ret_lbl = env.c_ret_lbl;
+ c_ret_ref = env.c_ret_ref;
+ c_fp_used = new_fp_used }
+ | TSWriteCout(sl) ->
+ let text1, data1 = List.fold_left
+ (fun (text, data) s ->
+ match s with
+ | TSEExpr(e) ->
+ let t, a = gen_expr env e in
+ text ++ t ++ cr a ++ li v0 1 ++ syscall, data
+ | TSEStr(s) ->
+ let l, d =
+ if Hashtbl.mem strings s then
+ Hashtbl.find strings s, nop
+ else
+ let l = id "_s" in Hashtbl.add strings s l;
+ l, label l ++ asciiz s
+ in
+ text ++ la a0 alab l ++ li v0 4 ++ syscall, data ++ d) (nop, nop) sl in
+ comment "cout<<..." ++ text1, data1, env
+and gen_block env b =
+ let text, data, fin_env =
+ List.fold_left (fun (t, d, e) s ->
+ let tt, dd, e = gen_stmt e s in
+ t ++ tt, d ++ dd, e)
+ (nop, nop, env) b
+ in
+ let n = (fin_env.c_fp_used - env.c_fp_used) in
+ text ++ (if n = 0 then nop else popn n), data
+
+let gen_decl tenv decl = match decl with
+ | TDGlobal(ty, id) ->
+ globals_env := Smap.add id VGlobal !globals_env;
+ let bytes = type_size tenv ty in
+ nop, (label id) ++ (dword (let rec a n = if n > 0 then 0::(a (n-4)) else [] in a bytes))
+ | TDFunction(proto, block) ->
+ let names, _ = List.fold_left
+ (fun (env, p) ((ty, r), id) ->
+ Smap.add id (if r then VStackByRef p else VStack p) env, p + (type_size tenv ty))
+ (!globals_env, (match proto.tp_class with | None -> 8 | Some k -> 12)) proto.tp_args in
+ let env = {
+ c_penv = tenv;
+ c_names = names;
+ c_ret_lbl = id "_ret";
+ c_ret_ref = (match proto.tp_ret_type with | None -> false | Some(_, r) -> r);
+ c_fp_used = 0;
+ } in
+ let code_for_constructor = match proto.tp_ret_type with
+ | Some _ -> nop
+ | None -> let cls_name = (match proto.tp_class with | Some k -> k | None -> assert false) in
+ la v0 areg (8, fp) ++ jal ("_c_" ^ cls_name)
+ in
+ let text, data = gen_block env block in
+ label proto.tp_unique_ident ++
+ push fp ++ push ra ++ move fp sp ++ code_for_constructor ++
+ text ++ label env.c_ret_lbl ++
+ move sp fp ++ pop ra ++ pop fp ++ jr ra,
+ data
+ | TDClass(c) ->
+ (* Build vtables and build constructor *)
+ let rec mk_cls_code hh =
+ let vtable_size = List.fold_left (fun k (p, _) -> max k (p+4)) 0 hh.h_vtable in
+ let vtable_as_array = Array.make (vtable_size / 4) "_nothing" in
+ List.iter (fun (p, s) -> vtable_as_array.(p/4) <- s.tp_unique_ident) hh.h_vtable;
+ let vt_l = Array.to_list vtable_as_array in
+ let vtable = label ("_vt_" ^ c.tc_name ^ "_as_" ^ hh.h_class) ++
+ (if vt_l = [] then nop else address vt_l) in
+ let constructor_code = la a0 alab ("_vt_" ^ c.tc_name ^ "_as_" ^ hh.h_class)
+ ++ sw a0 areg (hh.h_pos, v0) in
+ let c = get_c tenv hh.h_class in
+ let init_code = Smap.fold
+ (fun _ (ty, pos) code ->
+ (match ty with
+ | TClass(s) ->
+ push ra ++ push v0 ++
+ la v0 areg (pos + hh.h_pos, v0) ++
+ jal ("_c_" ^ s) ++ pop v0 ++ pop ra
+ | _ -> sw zero areg (pos + hh.h_pos, v0)
+ ) ++ code) c.tc_members nop in
+ List.fold_left
+ (fun (vt, cc) sup ->
+ let mvt, mcc = mk_cls_code sup in
+ vt ++ mvt, cc ++ mcc)
+ (vtable, constructor_code ++ init_code) hh.h_supers
+ in
+ let vt, cc = mk_cls_code c.tc_hier in
+ label ("_c_" ^ c.tc_name) ++ cc ++ jr ra, vt
let generate p =
- { text = nop;
- data = nop }
+ try
+ let text, data = List.fold_left (fun (text, data) decl ->
+ let more_text, more_data = gen_decl p.prog_env decl in
+ text ++ more_text, data ++ more_data) (nop, nop) p.prog_decls in
+ let text =
+ label "main" ++ jal p.prog_main ++
+ li v0 10 ++ syscall ++
+ label "_nothing" ++ jr ra ++
+ text in
+ { text = text;
+ data = data }
+ with
+ | Assert_failure (k, a, b) -> raise (Very_bad_error (
+ "(unexpected) Assertion failure: "^k^" at "^(string_of_int a)^":"^(string_of_int b)))
+ | Not_found -> raise (Very_bad_error ("(unexpected) Not found"))
+ | Invalid_argument(k) -> raise (Very_bad_error ("(unexpected) Invalid argument: "^k))
+ | Match_failure(k, a, b) -> raise (Very_bad_error (
+ "(unexpected) Match failure: "^k^" at "^(string_of_int a)^":"^(string_of_int b)))
+ | Stack_overflow -> raise (Very_bad_error ("(unexpected) Stack overflow"))
+ | _ -> raise (Very_bad_error ("(unexpected) Other error"))
diff --git a/src/main.ml b/src/main.ml
index 976586f..a087cb5 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -78,6 +78,9 @@ let () =
localisation2 loc;
eprintf "%s@." msg;
exit 2
+ | Codegen.Very_bad_error(msg) ->
+ eprintf "Very bad error: %s@." msg;
+ exit 3;
| _ ->
eprintf "Unexpected error...@.";
diff --git a/src/pretty_typing.ml b/src/pretty_typing.ml
index f9e69ff..3e5f144 100644
--- a/src/pretty_typing.ml
+++ b/src/pretty_typing.ml
@@ -42,20 +42,20 @@ let rec expr_string e = match e.te_desc with
| TEThis -> "this"
| TEIdent(i) -> i
| TEAssign(k, p) -> "(" ^ (expr_string k) ^ " = " ^ (expr_string p) ^ ")"
- | TECallFun(i, f) -> i ^ "(" ^ (csl expr_string f) ^ ")"
+ | TECallFun(i, f, _) -> i ^ "(" ^ (csl expr_string (List.map fst f)) ^ ")"
(* ici, le second ast a changé par rapport au premier *)
| TEUnary(e, f) -> (unop_str e) ^ (expr_string f)
| TEBinary(e1, o, e2) -> "(" ^ (expr_string e1) ^ " " ^ (binop_str o) ^ " " ^ (expr_string e2) ^ ")"
| TEMember(e1, i) -> "(" ^ (expr_string e1) ^ ")@" ^ (string_of_int i)
| TENew(c, proto, arg) -> "new " ^ c.tc_name
- ^ (match proto with | None -> "" | Some p -> " ." ^ p.tp_unique_ident)
- ^ " (" ^ (csl expr_string arg) ^ ")"
- | TECallVirtual(exp, pos1, pos2, args) ->
- "(" ^ (expr_string exp) ^ ")@" ^ (string_of_int pos1) ^ "#" ^ (string_of_int pos2) ^ "(" ^ (csl expr_string args) ^ ")"
+ ^ (match proto with | None -> "" | Some p -> " ." ^ p)
+ ^ " (" ^ (csl expr_string (List.map fst arg)) ^ ")"
+ | TECallVirtual(exp, pos1, pos2, args, _) ->
+ "(" ^ (expr_string exp) ^ ")@" ^ (string_of_int pos1) ^ "#" ^ (string_of_int pos2) ^ "(" ^ (csl expr_string (List.map fst args)) ^ ")"
let rec print_stmt l x =
for i = 1 to l do print_string " " done;
- match x.ts_desc with
+ match x with
| TSEmpty -> print_string ";\n"
| TSExpr(e) -> print_string ((expr_string e) ^ "\n")
| TSIf(e, a, b) -> print_string ("if " ^ (expr_string e) ^ "\n");
@@ -74,13 +74,10 @@ let rec print_stmt l x =
| TSBlock(b) -> print_block l b
| TSReturn(None) -> print_string "return\n"
| TSReturn(Some k) -> print_string ("return " ^ (expr_string k) ^ "\n")
- | TSDeclare((ty,b), i) -> let addr = (if b then "&" else "") in
- print_string (addr ^ i ^ " : " ^ (var_type_str ty) ^ "\n")
+ | TSDeclare(ty, i) -> print_string (i ^ " : " ^ (var_type_str ty) ^ "\n")
| TSDeclareAssignExpr((ty,b), i, e) -> let addr = (if b then "&" else "") in
print_string (addr ^ i ^ " : " ^ (var_type_str ty) ^ " = " ^ (expr_string e) ^ "\n")
- | TSDeclareAssignConstructor(t, i, _, c, a) -> () (*print_string
- (i ^ " : " ^ (var_type_str t) ^ " = " ^ c ^ "(" ^
- (csl expr_string a) ^ ")\n")*)
+ | TSDeclareAssignConstructor(cls, i, c, a) -> print_string "XXX\n"
| TSWriteCout(k) -> print_string ("std::cout" ^
(List.fold_left (fun x k -> x ^ " << " ^ (match k with
| TSEExpr e -> expr_string e
diff --git a/src/test.sh b/src/test.sh
index 090dc6f..4f84fd4 100755
--- a/src/test.sh
+++ b/src/test.sh
@@ -4,58 +4,75 @@
echo "Testing SYNTAX/"
for a in ../tests/syntax/good/*.cpp; do
- if ./minic++ --parse-only $a;
- then echo "OK $a";
- else echo "FAIL $a";
- fi;
+ if ./minic++ --parse-only $a;
+ then echo "OK $a";
+ else echo "FAIL $a";
+ fi;
done;
for a in ../tests/syntax/bad/*.cpp; do
- if ./minic++ --parse-only $a 2> /dev/null;
- then echo "FAIL $a";
- else echo "OK $a";
- fi;
+ if ./minic++ --parse-only $a 2> /dev/null;
+ then echo "FAIL $a";
+ else echo "OK $a";
+ fi;
done;
echo "---"
echo "Testing TYPING/ only against parsing"
for a in ../tests/typing/*/*.cpp; do
- if ./minic++ --parse-only $a;
- then echo "OK $a";
- else echo "FAIL $a";
- fi;
+ if ./minic++ --parse-only $a;
+ then echo "OK $a";
+ else echo "FAIL $a";
+ fi;
done;
echo "---"
echo "Testing EXEC/ only against parsing"
for a in ../tests/exec/*.cpp; do
- if ./minic++ --parse-only $a;
- then echo "OK $a";
- else echo "FAIL $a";
- fi;
+ if ./minic++ --parse-only $a;
+ then echo "OK $a";
+ else echo "FAIL $a";
+ fi;
done;
echo "---"
echo "Testing TYPING/"
for a in ../tests/typing/good/*.cpp; do
- if ./minic++ --type-only $a;
- then echo "OK $a";
- else echo "FAIL $a";
- fi;
+ if ./minic++ --type-only $a;
+ then echo "OK $a";
+ else echo "FAIL $a";
+ fi;
done;
for a in ../tests/typing/bad/*.cpp; do
- if ./minic++ --type-only $a 2> /dev/null;
- then echo "FAIL $a";
- else echo "OK $a";
- fi;
+ if ./minic++ --type-only $a 2> /dev/null;
+ then echo "FAIL $a";
+ else echo "OK $a";
+ fi;
done;
echo "---"
echo "Testing EXEC/ only against typing"
for a in ../tests/exec/*.cpp; do
- if ./minic++ --type-only $a;
- then echo "OK $a";
- else echo "FAIL $a";
- fi;
+ if ./minic++ --type-only $a;
+ then echo "OK $a";
+ else echo "FAIL $a";
+ fi;
done;
+
+echo "---"
+echo "Testing EXEC/"
+for a in ../tests/exec/*.cpp; do
+ if ./minic++ $a;
+ then
+ spim -f ../tests/exec/`basename -s .cpp $a`.s | tail -n +6 > /tmp/spim_out.txt
+ if diff /tmp/spim_out.txt ../tests/exec/`basename -s .cpp $a`.out > /dev/null
+ then echo "OK $a"
+ else echo "FAIL $a"
+ fi
+ else echo "TODO $a";
+ fi;
+done;
+
+
+
diff --git a/src/typing.ml b/src/typing.ml
index 6b1c801..aa8ee4a 100644
--- a/src/typing.ml
+++ b/src/typing.ml
@@ -48,25 +48,24 @@ and texpr_desc =
| TEThis
| TEIdent of ident
| TEAssign of texpression * texpression
- | TECallFun of ident * texpression list (* changé : te -> ident *)
+ | TECallFun of ident * (texpression * bool) list * bool (* changé : te -> ident *)
(* calls to non-virtual methods are compiled using TECallFun, with the object cons'ed at
the begining of the arguments expression list *)
- | TECallVirtual of texpression * int * int * texpression list (* object * index in vtable * arguments *)
+ (* for each argument, bool is is argument passed by reference ? *)
+ (* final bool : is returned value a reference ? *)
+ | TECallVirtual of texpression * int * int * (texpression * bool) list * bool
+ (* object * index in vtable * arguments * is return value a bool? *)
| TEUnary of unop * texpression
| TEBinary of texpression * binop * texpression
| TEMember of texpression * int (* object * position of member *)
- | TENew of tcls * tproto option * texpression list
+ | TENew of tcls * ident option * (texpression * bool) list
and tstr_expression =
| TSEExpr of texpression
| TSEStr of string
-and tstatement = {
- ts_loc: loc;
- ts_desc: ts_desc;
- }
-and ts_desc =
+and tstatement =
| TSEmpty
| TSExpr of texpression
| TSIf of texpression * tstatement * tstatement
@@ -74,10 +73,10 @@ and ts_desc =
| TSFor of texpression list * texpression option * texpression list * tstatement
| TSBlock of tblock
| TSReturn of texpression option
- | TSDeclare of type_ref * ident
+ | TSDeclare of typ * ident
| TSDeclareAssignExpr of type_ref * ident * texpression
- | TSDeclareAssignConstructor of typ * ident * tproto option * tident * texpression list (* a faire *)
-(* Type of variable, variable name, constructor class name, constructor arguments *)
+ | TSDeclareAssignConstructor of tcls * ident * ident option * (texpression * bool) list
+(* Class name of variable, variable name, constructor class name, constructor arguments *)
| TSWriteCout of tstr_expression list
and tblock = tstatement list
@@ -136,6 +135,7 @@ type tdeclaration =
type tprogram = {
prog_decls : tdeclaration list;
prog_env : env;
+ prog_main : ident;
}
(* Quelques fonctions utiles : *)
@@ -349,16 +349,17 @@ and compute_type env e =
end
| _ -> ty_error "Calling something that is neither a function nor a method") in
let l_te = List.map fst args_values in
+ let l_te = List.map2 (fun k ((_, r), _) -> k, r) l_te tproto.tp_args in
let ty,b = match tproto.tp_ret_type with
| None -> ty_error "Constructor cannot be called as function"
| Some (ty,b) -> ty,b in
begin match tproto.tp_virtual, obj with
| None, None ->
- TECallFun(tproto.tp_unique_ident,l_te),(ty,b,false)
+ TECallFun(tproto.tp_unique_ident,l_te,b),(ty,b,false)
| None, Some(obj)->
- TECallFun(tproto.tp_unique_ident,obj::l_te),(ty,b,false)
+ TECallFun(tproto.tp_unique_ident,(obj, true)::l_te,b),(ty,b,false)
| Some(idx), Some(obj) ->
- TECallVirtual(obj, fst idx, snd idx, l_te),(ty,b,false)
+ TECallVirtual(obj, fst idx, snd idx, l_te,b),(ty,b,false)
| _ -> ty_error "(should not happen) Virtual function applied to no object..."
end
| EMember (e, id) ->
@@ -384,7 +385,8 @@ and compute_type env e =
let p = closest_proto env.b_pe args_types candidates in
(* closest_proto makes sure the prototypes match, no problem here *)
let l_te = List.map fst args_values in
- TENew(c, Some p, l_te), (TPoint(TClass(cls_name)), false, false)
+ let l_te = List.map2 (fun k ((_, r), _) -> k, r) l_te p.tp_args in
+ TENew(c, Some p.tp_unique_ident, l_te), (TPoint(TClass(cls_name)), false, false)
end
| EThis ->
begin match env.b_class with
@@ -396,9 +398,7 @@ and compute_type env e =
(* Statements *)
let rec type_stm ret_type env s =
- err_add_loc s.s_loc (fun () ->
- let d, ty = compute_type_stm ret_type env s in
- { ts_loc = s.s_loc; ts_desc = d }, ty)
+ err_add_loc s.s_loc (fun () -> compute_type_stm ret_type env s)
and compute_type_stm ret_type env s = match s.s_desc with (* statement -> ts_desc,stm_type *)
| SEmpty -> TSEmpty,env
@@ -438,12 +438,13 @@ and compute_type_stm ret_type env s = match s.s_desc with (* statement -> ts_des
(* pq while n'est pas dans les règles données ? *)
| SDeclare(vt,i) -> let ty,b = build_type_or_ref vt in
ty_assert (bf env.b_pe ty) "Malformed type";
+ ty_assert (not b) "Reference must be assigned at declaration";
ty_assert (not (Smap.mem i env.b_locals) ) "Variable redefinition";
let env0 =
{ b_pe = env.b_pe;
b_locals = Smap.add i (ty,b) env.b_locals;
b_class = env.b_class } in
- TSDeclare( (ty,b) ,i) , env0
+ TSDeclare( ty ,i) , env0
| SDeclareAssignExpr(vt,i,e) -> let ty,b = build_type_or_ref vt in
ty_assert (bf env.b_pe ty) "Malformed type";
ty_assert (not (Smap.mem i env.b_locals)) "Variable redefinition";
@@ -468,16 +469,17 @@ and compute_type_stm ret_type env s = match s.s_desc with (* statement -> ts_des
begin match candidates with
| [] ->
ty_assert (e_l = []) "Only default constructor exists and it has 0 arguments";
- TSDeclareAssignConstructor(ty, i, None, ti, []), env
+ TSDeclareAssignConstructor(c, i, None, []), env
| _ ->
let p = closest_proto env.b_pe args_types candidates in
(* closest_proto makes sure the prototypes match, no problem here *)
let l_te = List.map fst args_values in
+ let l_te = List.map2 (fun k ((_, r), _) -> k, r) l_te p.tp_args in
let env0 =
{ b_pe = env.b_pe;
b_locals = Smap.add i (ty,b) env.b_locals;
b_class = env.b_class } in
- TSDeclareAssignConstructor(ty, i, Some p, ti, l_te), env0
+ TSDeclareAssignConstructor(c, i, Some p.tp_unique_ident, l_te), env0
end
| SWriteCout(str_e_list) ->
let args =
@@ -739,11 +741,12 @@ let prog p =
([],{ e_globals = Smap.empty; e_funs = []; e_classes = Smap.empty })
p
) in
- ty_assert (List.exists
+ let p = try List.find
(fun tp -> tp.tp_class = None && tp.tp_name = "main"
&& tp.tp_args = [] && tp.tp_ret_type = Some (T_Int,false))
- env.e_funs) "No 'int main()' function defined in program...";
- { prog_decls = List.rev decls; prog_env = env }
+ env.e_funs
+ with Not_found -> ty_error "No correct main function in program." in
+ { prog_decls = List.rev decls; prog_env = env; prog_main = p.tp_unique_ident }