6 files changed, 409 insertions, 66 deletions

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 }