Fuck yeah all tests pass.

4 files changed, 173 insertions, 106 deletions

diff --git a/src/codegen.ml b/src/codegen.ml
index 316caa6..b1501fd 100644
--- a/src/codegen.ml
+++ b/src/codegen.ml
@@ -12,7 +12,6 @@ type whereis_var =
 type cg_env = {
   c_penv : env;
   c_names : whereis_var Smap.t;
-  c_ret_lbl : string;
   c_ret_ref : bool;
   c_fp_used : int;
 }
@@ -36,7 +35,7 @@ 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
+    lw a0 areg (8, fp), false
   | TEIdent(i) ->
     begin match Smap.find i env.c_names with
     | VGlobal -> la a0 alab i, true
@@ -55,7 +54,7 @@ let rec gen_expr env e = match e.te_desc with
         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) ->
+  | TECallVirtual(obj, fi, args, b) ->
     let code = List.fold_left
       (fun code (arg, byref) ->
         let c, r = gen_expr env arg in
@@ -63,15 +62,15 @@ let rec gen_expr env e = match e.te_desc with
         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)
+    code ++ code2 ++ push a0 ++ lw a0 areg (0, 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.Plus -> t ++ cr a, false
+    | Ast.Minus -> t ++ cr a ++ neg a0 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
@@ -100,10 +99,10 @@ let rec gen_expr env e = match e.te_desc with
       | 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 
+        t1 ++ beqz a0 lazy_lbl ++ t2 ++ label lazy_lbl ++ sne a0 a0 zero
       | Ast.Lor -> 
         let lazy_lbl = id "_lazy" in
-        t1 ++ bnez a0 lazy_lbl ++ t2 ++ label lazy_lbl
+        t1 ++ bnez a0 lazy_lbl ++ t2 ++ label lazy_lbl ++ sne a0 a0 zero
     ), false
   | TEMember(e, i) ->
     let c, a = gen_expr env e in
@@ -112,20 +111,18 @@ let rec gen_expr env e = match e.te_desc with
       c ++ la a0 areg (i, a0), true
     end else
       c, a
+  | TEPointerCast(e, i) ->
+    let c, a = gen_expr env e in
+    c ++ cr a ++ (if i = 0 then nop else la a0 areg (i, a0)), false
   | 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 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 alloc = li v0 9 ++ li a0 cls.tc_size ++ syscall in
+    args_code ++ alloc ++ push v0 ++ jal constr  
+      ++ pop a0 ++ popn (4 * List.length args), false
     
 
 let rec gen_stmt env = function
@@ -134,8 +131,8 @@ let rec gen_stmt env = function
     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 l_else = id "_cond_then" in
+    let l_end = id "_cond_end" 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 ++
@@ -165,46 +162,45 @@ let rec gen_stmt env = function
     let c, d = gen_block env b in
     comment "block" ++ c, d, env
   | TSReturn (None) ->
-    comment "return" ++ b env.c_ret_lbl, nop, env
+    comment "return" ++ b "_return", 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
+    comment "return" ++ c ++ cr (not env.c_ret_ref && a) ++ b "_return", 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) ->
+      let c = get_c env.c_penv i in
+      let cproto = List.find (fun p -> p.tp_ret_type = None && p.tp_name =  i && p.tp_args = []) c.tc_methods in
       sub sp sp oi s ++
-      la v0 areg (pos, fp) ++
-      jal ("_c_" ^ i)
+      la a0 areg (pos, fp) ++
+      push a0 ++
+      jal cproto.tp_unique_ident
     | _ -> 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 code =
       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 ++
+      sub sp sp oi cls.tc_size ++ args_code ++ la a0 areg(pos, fp) ++ push a0 ++ jal constr ++
           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) ->
@@ -214,10 +210,9 @@ let rec gen_stmt env = function
     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, {
+    comment ("declare " ^ id) ++ sub sp sp oi 4 ++ code ++ cr (a && not r) ++ sw a0 areg (pos, fp), 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) ->
@@ -260,50 +255,71 @@ let gen_decl tenv decl = match decl with
     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)
+        lw v0 areg (8, fp) ++ jal ("_c_" ^ cls_name) in
+    let code_for_virtual = match proto.tp_virtual with
+      | Some (c, _) when c.h_pos <> 0 ->
+        lw a0 areg (8, fp) ++ la a0 areg (-c.h_pos, a0) ++ sw a0 areg (8, fp)
+      | _ -> nop
     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
+    push fp ++ push ra ++ move fp sp ++ code_for_constructor ++ code_for_virtual ++
+    text ++ b "_return", data
   | TDClass(c) ->
+    (* Call default constructor of parent classes *)
+    let code_parents = List.fold_left
+      (fun code parent ->
+          let cn = parent.h_class in
+          let c = get_c tenv cn in
+          let proto = List.find (fun p -> p.tp_ret_type = None && p.tp_args = [] && p.tp_name = cn) c.tc_methods in
+          code ++ lw v0 areg(0, sp) ++ la v0 areg(parent.h_pos, v0) ++push v0 ++ jal proto.tp_unique_ident ++ popn 4)
+      nop c.tc_hier.h_supers in
+    let code_parents = if code_parents <> nop then push v0 ++ code_parents ++ pop v0 else nop in
     (* Build vtables and build constructor *)
-    let rec mk_cls_code hh =
+    let rec make_vtables hh =
+      (* calculate vtable contents *)
       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)
+      (* code for vtable initialization *)
+      let vtable =
+        if vt_l = [] 
+          then nop 
+          else label ("_vt_" ^ c.tc_name ^ "_as_" ^ hh.h_class) ++ address vt_l in
+      let constructor_code = 
+        if vt_l = []
+          then sw zero areg (hh.h_pos, v0)
+          else 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
+      (* code for subclasses initialization *)
       List.fold_left
           (fun (vt, cc) sup ->
-            let mvt, mcc = mk_cls_code sup in
+            let mvt, mcc = make_vtables sup in
             vt ++ mvt, cc ++ mcc)
-          (vtable, constructor_code ++ init_code) hh.h_supers
+          (vtable, constructor_code) hh.h_supers
+    in
+    let vtables, vtable_init_code = make_vtables c.tc_hier in
+    let init_code_proper = Smap.fold
+      (fun _ (ty, pos) code ->
+        (match ty with
+          | TClass(s) ->
+            let cs = get_c tenv s in
+            let proto = List.find (fun p -> p.tp_ret_type = None && p.tp_args = [] && p.tp_name = s) cs.tc_methods in
+            push v0 ++
+              la a0 areg (pos, v0) ++ push a0 ++
+               jal proto.tp_unique_ident ++ popn 4 ++ pop v0
+          | _ -> sw zero areg (pos, v0)
+        ) ++ code) c.tc_members nop 
     in
-      let vt, cc = mk_cls_code c.tc_hier in
-      label ("_c_" ^ c.tc_name) ++ cc ++ jr ra, vt
+      label (c.tc_name ^ "0") ++ lw v0 areg (0, sp) ++ label ("_c_" ^ c.tc_name) 
+          ++ push ra ++ code_parents ++ vtable_init_code ++ init_code_proper ++ pop ra ++ jr ra, vtables
 
 
 let generate p =
@@ -314,6 +330,7 @@ let generate p =
     let text =
       label "main" ++ jal p.prog_main ++
       li v0 10 ++ syscall ++
+      label "_return" ++ move sp fp ++ pop ra ++ pop fp ++
       label "_nothing" ++ jr ra ++
       text in
     { text = text;
diff --git a/src/pretty_typing.ml b/src/pretty_typing.ml
index 3e5f144..a6ec2eb 100644
--- a/src/pretty_typing.ml
+++ b/src/pretty_typing.ml
@@ -47,11 +47,12 @@ let rec expr_string e = match e.te_desc with
 	| 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)
+	| TEPointerCast(e1, i) -> "(" ^ (expr_string e1) ^ ")+" ^ (string_of_int i)
 	| TENew(c, proto, arg) -> "new " ^ c.tc_name
-			^ (match proto with | None -> "" | Some p -> " ." ^ p)
+			^ " ." ^ proto
 			 ^ " (" ^ (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)) ^ ")"
+	| TECallVirtual(exp, pos2, args, _) ->
+		"(" ^ (expr_string exp) ^ ")#" ^  (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;
@@ -77,7 +78,8 @@ let rec print_stmt l x =
 	| 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(cls, i, c, a) -> print_string "XXX\n"
+	| TSDeclareAssignConstructor(cls, i, c, a) -> 
+    print_string (i ^ " : " ^ cls.tc_name ^ " = ." ^ c ^ " (" ^(csl expr_string (List.map fst a)) ^ ")\n")
 	| TSWriteCout(k) -> print_string ("std::cout" ^
 					     (List.fold_left (fun x k -> x ^ " << " ^ (match k with
 					       | TSEExpr e -> expr_string e
@@ -101,7 +103,7 @@ let proto_str p =
 	      p.tp_args)
   ^ ") : " ^ (match p.tp_ret_type with | Some (ty,b) -> var_type_str ty | None -> "constructor")
   	^ "  ." ^ p.tp_unique_ident
-  	^ (match p.tp_virtual with | None -> "" | Some (k, l) -> " @" ^ (string_of_int k) ^ "#" ^ (string_of_int l))
+  	^ (match p.tp_virtual with | None -> "" | Some (k, l) -> " @" ^ (string_of_int k.h_pos) ^ "#" ^ (string_of_int l))
 
 let print_class_decl c =
 	print_string ("class " ^ c.tc_name ^ " (size : " ^ (string_of_int c.tc_size) ^ ") {\n");
diff --git a/src/test.sh b/src/test.sh
index 4f84fd4..eaec94a 100755
--- a/src/test.sh
+++ b/src/test.sh
@@ -65,8 +65,8 @@ 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
+           mars-mips nc se1 ../tests/exec/`basename -s .cpp $a`.s  > /tmp/mips_out.txt
+           if diff -B /tmp/mips_out.txt ../tests/exec/`basename -s .cpp $a`.out > /dev/null
                then echo "OK    $a"
                else echo "FAIL  $a"
             fi
diff --git a/src/typing.ml b/src/typing.ml
index aa8ee4a..4c105da 100644
--- a/src/typing.ml
+++ b/src/typing.ml
@@ -53,12 +53,13 @@ and texpr_desc =
         the begining of the arguments expression list *)
     (* 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? *)
+  | TECallVirtual of texpression * int * (texpression * bool) list * bool
+    (* object * index in vtable * arguments * is return value a reference? *)
   | TEUnary of unop * texpression
   | TEBinary of texpression * binop * texpression
   | TEMember of texpression * int   (* object * position of member *)
-  | TENew of tcls * ident option * (texpression * bool) list
+  | TEPointerCast of texpression * int   (* object * position of member *)
+  | TENew of tcls * ident * (texpression * bool) list
 
 and tstr_expression =
     | TSEExpr of texpression
@@ -75,16 +76,13 @@ and tstatement =
     | TSReturn of texpression option
     | TSDeclare of typ * ident
     | TSDeclareAssignExpr of type_ref * ident * texpression
-    | TSDeclareAssignConstructor of tcls * ident * ident option * (texpression * bool) list
-(* Class name of variable, variable name, constructor class name, constructor arguments *)
+    | TSDeclareAssignConstructor of tcls * ident * ident * (texpression * bool) list
+(* Class name of variable, variable name, constructor name, constructor arguments *)
     | TSWriteCout of tstr_expression list
 and tblock = tstatement list
 
 and tproto = {
-    tp_virtual : (int * int) option;    (* only used for class methods ; if none then not virtual,
-                          if some then gives the index of the method in the vtable (same for all classes
-                          of the hierarchy that have that method) *)
-    tp_loc : loc;
+    tp_virtual : (tcls_hier * int) option;    (* only used for class methods ; if none then not virtual *)
     tp_name : ident;    
     tp_unique_ident : ident;    (* label de la fonction dans le code assembleur *)
     tp_class : tident option; (* p_class = none : standalone function *)
@@ -182,10 +180,45 @@ let rec subtype env a b = match a, b with
         let c = get_c env i in
         let rec find_in_hier h =
           h.h_class = j ||
-          (List.exists find_in_hier h.h_supers)
+          (List.length (List.filter find_in_hier h.h_supers) = 1)
         in find_in_hier c.tc_hier
     | _ -> false
 
+let relative_class_position env i j =
+  let c = get_c env i in
+  let rec find_in_hier h =
+    h.h_class = j ||
+    (List.length (List.filter find_in_hier h.h_supers) = 1)
+  and get_in_hier h =
+    if h.h_class = j
+      then h.h_pos
+      else match List.filter find_in_hier h.h_supers with
+        | [a] -> get_in_hier a
+        | _ -> assert false
+  in get_in_hier c.tc_hier
+
+let rec upcast env exp dt =   (* présupposé : exp.type_expr <= dt *)
+  match exp.type_expr, dt with
+  | (T_Int, _, _), T_Int -> exp
+  | (T_Void, _, _), T_Void -> exp
+  | (Typenull, _, _), TPoint(_) -> exp
+  | (TClass(i), a, b), TClass(j) when a||b ->
+    begin match relative_class_position env i j with
+    | 0 -> exp
+    | pos ->
+        { type_expr = (TClass(j), false, true); te_loc = exp.te_loc;
+          te_desc = TEMember(exp, pos) }
+    end
+  | (TPoint(TClass(i)), a, b), TPoint(TClass(j)) ->
+    begin match relative_class_position env i j with
+    | 0 -> exp
+    | pos ->
+        { type_expr = (TPoint(TClass(j)), false, true); te_loc = exp.te_loc;
+          te_desc = TEPointerCast(exp, pos) }
+    end
+  | (TPoint(ka), _, _), TPoint(kb) -> exp
+  | _ -> assert false
+
 let type_size env t = match t with
     | T_Int | Typenull | TPoint(_) -> 4
     | T_Void -> 0
@@ -290,7 +323,7 @@ and compute_type env e =
              ty_assert (num ty1) "Cannot assign to non-numeric type (pointer type is numeric)";
              ty_assert (subtype env.b_pe ty2 ty1) "Incompatible types in assign";
                     (* type num et ref compatibles ?*)
-             (TEAssign (te1,te2) ),(ty1,false,false)
+             (TEAssign (te1,upcast env.b_pe te2 ty1) ),(ty1,false,false)
     | EUnary (op,e) -> let te,(ty,b1,b2) = get_expr0 env e in
                (match op with
              | PreIncr | PostIncr | PreDecr | PostDecr ->
@@ -315,14 +348,17 @@ and compute_type env e =
                   | Equal | NotEqual -> 
                     ty_assert ((subtype env.b_pe ty1 ty2) || (subtype env.b_pe ty2 ty1)) 
                         "Can only apply == or != to two values of compatible type";
-                    ty_assert (num ty1) "Can only apply == or != to pointers"
+                    ty_assert (num ty1) "Can only apply == or != to pointers";
+                    let te1 = if subtype env.b_pe ty1 ty2 then upcast env.b_pe te1 ty2 else te1 in
+                    let te2 = if subtype env.b_pe ty2 ty1 then upcast env.b_pe te2 ty1 else te2 in
+                    TEBinary(te1,op,te2),(T_Int,false,false)
                   | Lt | Le | Gt | Ge
                   | Add | Sub | Mul | Div | Modulo
                   | Land | Lor ->
                     ty_assert (ty1 = T_Int) "Left operand of binop is not integer";
-                    ty_assert (ty2 = T_Int) "Right operand of binop is not integer"
-                ); (* vérifs *)
-                TEBinary(te1,op,te2),(T_Int,false,false)
+                    ty_assert (ty2 = T_Int) "Right operand of binop is not integer";
+                    TEBinary(te1,op,te2),(T_Int,false,false)
+                )
     | ECall (e,e_list) ->
         (* TODO : look also within parent classes *)
             let args_values = List.map (get_expr0 env) e_list in
@@ -334,8 +370,12 @@ and compute_type env e =
                     begin match env.b_class with
                     | None -> None, closest_proto env.b_pe args_types funs
                     | Some k ->
-                        begin try Some e_this_not_ptr,
-                            closest_proto env.b_pe args_types (find_protos_in_class env.b_pe k.tc_name i)
+                        begin try 
+                            let proto = closest_proto env.b_pe args_types (find_protos_in_class env.b_pe k.tc_name i) in
+                            let upcasted = if proto.tp_virtual = None then e_this_not_ptr
+                                  else upcast env.b_pe e_this_not_ptr 
+                                  (TClass (match proto.tp_class with | None -> assert false | Some k -> k)) in
+                            Some upcasted, proto
                         with NoCorrespondingPrototype ->
                             None, closest_proto env.b_pe args_types funs
                         end
@@ -344,12 +384,16 @@ and compute_type env e =
                     let e = type_expr env e in
                     begin match e.type_expr with
                     | TClass(k), a, b when a || b ->
-                        Some e, closest_proto env.b_pe args_types (find_protos_in_class env.b_pe k i)
+                        let proto = closest_proto env.b_pe args_types (find_protos_in_class env.b_pe k i) in
+                        let upcasted = if proto.tp_virtual = None then e
+                              else upcast env.b_pe e
+                              (TClass (match proto.tp_class with | None -> assert false | Some k -> k)) in
+                        Some upcasted, proto
                     | _ -> ty_error "Invalid argument type for method call (not a class, or not a lvalue)"
                     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 l_te = List.map2 (fun k ((ty, r), _) -> upcast env.b_pe k ty, 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
@@ -358,8 +402,8 @@ and compute_type env e =
                 TECallFun(tproto.tp_unique_ident,l_te,b),(ty,b,false)
           | None, Some(obj)->
                 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,b),(ty,b,false)
+          | Some(hier, idx), Some(obj) ->
+                TECallVirtual(upcast env.b_pe obj (TClass hier.h_class), idx, l_te,b),(ty,b,false)
           | _ -> ty_error "(should not happen) Virtual function applied to no object..."
           end
     | EMember (e, id) ->
@@ -378,15 +422,13 @@ and compute_type env e =
           let args_types = List.map (fun (e, (t, r, l)) -> t, r||l) args_values in
         let candidates = List.filter (fun p -> p.tp_ret_type = None) c.tc_methods in
         begin match candidates with
-        | [] ->
-            ty_assert (args = []) "Only default constructor exists and it has 0 arguments";
-            TENew(c, None, []), (TPoint(TClass(cls_name)), false, false)
+        | [] -> assert false (* default constructor should always be in list *)
         | _ ->
             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
-            TENew(c, Some p.tp_unique_ident, l_te), (TPoint(TClass(cls_name)), false, false)
+            let l_te = List.map2 (fun k ((ty, r), _) -> upcast env.b_pe k ty, r) l_te p.tp_args in
+            TENew(c, p.tp_unique_ident, l_te), (TPoint(TClass(cls_name)), false, false)
         end
     | EThis -> 
         begin match env.b_class with
@@ -455,7 +497,7 @@ and compute_type_stm ret_type env s = match s.s_desc with (* statement -> ts_des
           { b_pe = env.b_pe;
             b_locals = Smap.add i (ty,b) env.b_locals;
             b_class = env.b_class } in
-          TSDeclareAssignExpr( (ty,b) ,i,te) , env0
+          TSDeclareAssignExpr( (ty,b) ,i,upcast env.b_pe te ty) , env0
   | SDeclareAssignConstructor(vt,i,ti,e_l) ->
         let ty, b = build_type_or_ref vt in
         ty_assert (bf env.b_pe ty) "Malformed type";
@@ -467,19 +509,17 @@ and compute_type_stm ret_type env s = match s.s_desc with (* statement -> ts_des
           let args_types = List.map (fun (e, (t, r, l)) -> t, r||l) args_values in
         let candidates = List.filter (fun p -> p.tp_ret_type = None) c.tc_methods in
         begin match candidates with
-        | [] ->
-            ty_assert (e_l = []) "Only default constructor exists and it has 0 arguments";
-            TSDeclareAssignConstructor(c, i, None, []), env
+        | [] -> assert false (* ... *)
         | _ ->
             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 l_te = List.map2 (fun k ((ty, r), _) -> upcast env.b_pe k ty, 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(c, i, Some p.tp_unique_ident, l_te), env0
+            TSDeclareAssignConstructor(c, i, p.tp_unique_ident, l_te), env0
         end
   | SWriteCout(str_e_list) -> 
     let args = 
@@ -538,7 +578,6 @@ let get_fun env p b = (* p : proto   b : block -> tp, tb, env2*)
 
   (* Add to env *)
   let tproto = {
-        tp_loc = p.p_loc ;
         tp_name = name ;
         tp_unique_ident = name ^ (tproto_unique_number());
         tp_class = None ;
@@ -635,22 +674,19 @@ let compute_tclass env c =
                       | None ->
                         List.fold_left (fun f (i, p) -> 
                           if (p.tp_name = proto.p_name && (List.map fst p.tp_args) = (List.map fst args))
-                            then Some (i, s)
+                            then Some (s, i)
                             else f) None s.h_vtable
                     in let super = match check_in_super hier with
                     | None -> if virt then 
                           (*  allocate new spot in vtable of this object *)
-                          Some (List.fold_left (fun n (x, _) -> max n (x+4)) 0 hier.h_vtable, hier)
+                          Some (hier, List.fold_left (fun n (x, _) -> max n (x+4)) 0 hier.h_vtable)
                         else None
                     | Some k -> Some k
                     in
 
                     (* Build proto *)
                     let tproto = 
-                    {   tp_virtual = (match super with
-                          | Some(i, c) -> Some(c.h_pos, i)
-                          | None -> None);
-                        tp_loc = proto.p_loc;
+                    {   tp_virtual = super;
                         tp_name = proto.p_name;
                         tp_unique_ident = proto.p_name ^ (tproto_unique_number()) ;
                         tp_class = Some(cls_name);
@@ -660,12 +696,24 @@ let compute_tclass env c =
                     (* Add to vtable *)
                     begin match super with
                     | None -> ()
-                    | Some (i, c) ->
+                    | Some (c, i) ->
                         c.h_vtable <- (i, tproto)::(List.remove_assoc i c.h_vtable)
                     end;
                     tproto) in
                 (mem, mem_u), m::meth
         ) ((Smap.empty, used), []) c.c_members in
+    (* make sure class has default constructor *)
+    let meth = 
+      if List.exists (fun p -> p.tp_ret_type = None && p.tp_name = cls_name) meth
+        then meth
+        else
+          { tp_virtual = None;
+            tp_name = cls_name;
+            tp_unique_ident = cls_name ^ "0";
+            tp_class = Some cls_name;
+            tp_ret_type = None;
+            tp_args = [] }::meth
+    in
     {   tc_name = cls_name;
         tc_size = mem_u;
         tc_hier = hier;