Abandon de l'héritage multiple ; héritage simple mis en place.

5 files changed, 202 insertions, 119 deletions

diff --git a/src/ast.ml b/src/ast.ml
index c204ff8..48a2de3 100644
--- a/src/ast.ml
+++ b/src/ast.ml
@@ -84,8 +84,7 @@ type proto = {
 
 type cls_mem =
 	| CVar of var_type * ident
-	| CMethod of proto
-	| CVirtualMethod of proto
+	| CMethod of proto * bool (* is method virtual *)
 
 type cls = {
 	c_name : tident;
diff --git a/src/parser.mly b/src/parser.mly
index 2b50797..3d1eb22 100644
--- a/src/parser.mly
+++ b/src/parser.mly
@@ -103,9 +103,9 @@ member:
 |	k = typed_vars SEMICOLON
 	{ List.map (fun (x, y) -> CVar(x, y)) k }
 |	p = cls_proto SEMICOLON
-	{ [ CMethod(p) ] }
+	{ [ CMethod(p, false) ] }
 |	VIRTUAL p = cls_proto SEMICOLON
-	{ [ CVirtualMethod(p) ] }
+	{ [ CMethod(p, true) ] }
 ;
 
 cls_proto:
diff --git a/src/pretty.ml b/src/pretty.ml
index 4420ac1..6144cf3 100644
--- a/src/pretty.ml
+++ b/src/pretty.ml
@@ -146,8 +146,7 @@ let print_class_decl c =
 		(List.fold_left (fun x t -> x ^ " public " ^ t) "" s)) ^ " {\n");
 	List.iter (function
 		| CVar(t, i) -> print_string (" " ^ i ^ " : " ^ (var_type_str t) ^ "\n")
-		| CMethod(p) -> print_string (" " ^ (proto_str p) ^ "\n")
-		| CVirtualMethod(p) -> print_string (" virtual " ^ (proto_str p) ^ "\n")
+		| CMethod(p, v) -> print_string ((if v then " virtual " else " ") ^ (proto_str p) ^ "\n")
 		) c.c_members;
 	print_string "}\n"
 
diff --git a/src/pretty_typing.ml b/src/pretty_typing.ml
index 2e0d321..1da6f24 100644
--- a/src/pretty_typing.ml
+++ b/src/pretty_typing.ml
@@ -9,6 +9,15 @@ open Parser
 open Typing
 open Ast
 
+let repl_nl s =
+	let k = ref "" in
+	for i = 0 to String.length s - 1 do
+		if s.[i] = '\n' then
+			k := !k ^ "\\n"
+		else
+			k := !k ^ (String.make 1 s.[i])
+	done; !k
+
 let csl f l =
 	List.fold_left 
 	  (fun x t -> (if x = "" then "" else x ^ ", ") ^ (f t)) "" l
@@ -25,7 +34,7 @@ let unop_str = function
 let rec var_type_str = function
 	| T_Void -> "void" | T_Int -> "int"
 	| TPoint(k) -> "*" ^ (var_type_str k)
-	| TClass s -> ""
+	| TClass s -> s
 	| Typenull -> "NULL"
 let rec expr_string e = match e.te_desc with
 	| TEInt(i) -> string_of_int i
@@ -37,9 +46,12 @@ let rec expr_string e = match e.te_desc with
 (* 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, x) -> "(" ^ (expr_string e1) ^ ")." ^ x
-	| TENew(c, arg) -> "new " ^ c ^ " (" ^ (csl expr_string arg) ^ ")"*)
-	| _ -> ""
+	| 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, pos, args) ->
+		"(" ^ (expr_string exp) ^ ")#" ^  (string_of_int pos) ^ "(" ^ (csl expr_string args) ^ ")"
 
 let rec print_stmt l x =
 	for i = 1 to l do print_string " " done;
@@ -73,7 +85,7 @@ let rec print_stmt l x =
 					     (List.fold_left (fun x k -> x ^ " << " ^ (match k with
 					       | TSEExpr e -> expr_string e
 					       | TSEStr("\n") -> "std::endl" 
-					       | TSEStr s -> "`" ^ s ^ "`")) "" k) ^ "\n")
+					       | TSEStr s -> "\"" ^ (repl_nl s) ^ "\"")) "" k) ^ "\n")
 
 and print_block n b =
   let prefix = String.make n ' ' in
@@ -91,17 +103,20 @@ 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 -> " #" ^ (string_of_int k))
 
-(*let print_class_decl c =
-	print_string ("class " ^ c.c_name ^ 
-		(match c.c_supers with | None -> "" | Some(s) -> " : " ^
-		(List.fold_left (fun x t -> x ^ " public " ^ t) "" s)) ^ " {\n");
-	List.iter (function
-		| CVar(t, i) -> print_string (" " ^ i ^ " : " ^ (var_type_str t) ^ "\n")
-		| CMethod(p) -> print_string (" " ^ (proto_str p) ^ "\n")
-		| CVirtualMethod(p) -> print_string (" virtual " ^ (proto_str p) ^ "\n")
-		) c.c_members;
-	print_string "}\n"*)
+let print_class_decl c =
+	print_string ("class " ^ c.tc_name ^ " (size : " ^ (string_of_int c.tc_size) ^ ")"^
+		(match c.tc_super with | None -> "" | Some(k) -> " : "^ k) ^" {\n");
+	print_string " members:\n";
+	Smap.iter (fun name (t, pos) -> print_string ("  " ^ name ^ " : " ^ (var_type_str t)
+				^ " @" ^ (string_of_int pos) ^ "\n")) c.tc_members;
+	print_string " methods:\n";
+	List.iter(fun p -> print_string ("  " ^ (proto_str p) ^ "\n")) c.tc_methods;
+	print_string " vtable:\n";
+	List.iter(fun (i, p) -> print_string ("  #" ^ (string_of_int i) ^ ": ." ^ (p.tp_unique_ident) ^ "\n")) c.tc_vtable;
+	print_string "}\n"
 
 let print_prog p =
 	List.iter (function
@@ -109,7 +124,8 @@ let print_prog p =
 					print_string ("decl " ^ i ^ " : " ^ (var_type_str ty) ^ "\n")
 		| TDFunction(p,b) -> print_string (proto_str p ^"\n");
 			print_block 0 b
-		| TDClass(c) -> () (* print_class_decl c  *)
+		| TDClass(c) -> 
+			print_class_decl c
 		) 
 	p.prog_decls
 
diff --git a/src/typing.ml b/src/typing.ml
index a87bf16..110e2f8 100644
--- a/src/typing.ml
+++ b/src/typing.ml
@@ -3,6 +3,8 @@ open Ast
 (* Gestion des erreurs *)
 exception Error of string
 exception LocError of loc * string
+exception NoCorrespondingPrototype
+exception AmbiguousOverload
 let ty_assert x k = if not x then raise (Error (k))
 let ty_error k = raise (Error (k))
 let err_add_loc loc f =
@@ -16,6 +18,8 @@ let err_add_loc loc f =
 		| Invalid_argument(k) -> raise (LocError (loc, "(unexpected) Invalid argument: "^k))
 		| Match_failure(k, a, b) -> raise (LocError (loc,
 			"(unexpected) Match failure: "^k^" at "^(string_of_int a)^":"^(string_of_int b)))
+		| NoCorrespondingPrototype -> raise (LocError (loc, "No corresponding prototype"))
+		| AmbiguousOverload -> raise (LocError (loc, "Ambiguous overload"))
 		| _ -> raise (LocError (loc, "(unexpected) Other error"))
 
 (* AST typés *)
@@ -46,10 +50,10 @@ and texpr_desc =
   | TECallFun of ident * texpression list (* 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 * ident * texpression list (* TODO (c'est le bazar) *)
+  | TECallVirtual of texpression * int * texpression list (* object * index in vtable * arguments *)
   | TEUnary of unop * texpression
   | TEBinary of texpression * binop * texpression
-  | TEMember of texpression * ident
+  | TEMember of texpression * int	(* object * position of member *)
   | TENew of tcls * tproto option * texpression list
 
 and tstr_expression =
@@ -77,7 +81,9 @@ and ts_desc =
 and tblock = tstatement list
 
 and tproto = {
-	tp_virtual : bool;	(* only used for class methods *)
+	tp_virtual : 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_name : ident;	
 	tp_unique_ident : ident;	(* label de la fonction dans le code assembleur *)
@@ -88,8 +94,10 @@ and tproto = {
 
 and tcls = {
 	tc_name : tident;
-	tc_supers : tident list;
-	tc_members : typ Smap.t;
+	tc_size : int;
+	tc_super : tident option;
+	tc_vtable : (int * tproto) list;
+	tc_members : (typ * int) Smap.t;	(* type du membre * position du membre dans les données de l'objet *)
 	tc_methods : tproto list;
 }
 
@@ -164,12 +172,21 @@ let rec subtype env a b = match a, b with
 	| TClass(i), TClass(j) ->
 		if i = j then true
 		else let c = get_c env i in
-			List.exists (fun k -> subtype env (TClass k) (TClass j)) c.tc_supers
+			(* NOT DONE : multiple supers *)
+			begin match c.tc_super with
+			| None -> false
+			| Some(k) -> subtype env (TClass k) (TClass j)
+			end
 	| _ -> false
 
+let type_size env t = match t with
+	| T_Int | Typenull | TPoint(_) -> 4
+	| T_Void -> 0
+	| TClass(c) -> let c = get_c env c in c.tc_size
+
 (* pour la surcharge de fonctions *)
-let closest_proto env arg_type_list fun_list =
-	match List.filter
+let possible_protos env arg_type_list fun_list =
+	List.filter
 		(fun proto ->
 			try List.for_all2
 				(fun (t_a, t_a_ref) (t_p, t_p_ref) ->
@@ -178,10 +195,31 @@ let closest_proto env arg_type_list fun_list =
 				arg_type_list (List.map fst proto.tp_args)
 			with Invalid_argument _ -> false)
 		fun_list
-	with
-	| [] -> ty_error "No corresponding prototype"
+let closest_proto env arg_type_list fun_list =
+	match possible_protos env arg_type_list fun_list with
+	| [] -> raise NoCorrespondingPrototype
 	| [p] -> p
-	| _ -> ty_error "Ambiguous overload"
+	| _ -> raise AmbiguousOverload
+let find_proto_in_class env cls name arg_type_list =
+	let rec aux = function
+	| None -> raise NoCorrespondingPrototype
+	| Some(k) -> let c = get_c env k in
+		let f = List.filter (fun p -> p.tp_name = name) c.tc_methods in
+		begin try closest_proto env arg_type_list f
+		with NoCorrespondingPrototype -> aux c.tc_super
+		end
+	in aux (Some cls)
+	
+
+let find_cls_mem env cls_name mem_name =
+	let rec aux = function
+	| None -> raise Not_found
+	| Some(k) -> let c = get_c env k in
+		begin try let mty, mi = Smap.find mem_name c.tc_members in
+			mty, mi
+		with Not_found -> aux c.tc_super
+		end
+	in aux (Some cls_name)
 
 
 (* -------------------------------------------- *)
@@ -201,6 +239,7 @@ and get_expr env e = (* expression -> texpression,(ty,b) *)
   let (ty,b,_) = te.type_expr in
   (te,(ty,b))
 
+
 and compute_type env e =
 	let ttype = (TClass(match env.b_class with | Some c -> c.tc_name | None -> "#")) in
 	let e_this = 
@@ -223,9 +262,9 @@ and compute_type env e =
 			TEIdent i, (t, r, true)
 		with Not_found ->
 			try match env.b_class with
-			| Some k -> let ty = Smap.find i k.tc_members in
-				TEMember(e_this_not_ptr, i),
-				 (ty, false, true)
+			| Some k -> let mty, mi = find_cls_mem env.b_pe k.tc_name i in
+				TEMember(e_this_not_ptr, mi),
+				 (mty, false, true)
 			| None -> raise Not_found
 		with Not_found ->
 			try let t = Smap.find i env.b_pe.e_globals in
@@ -273,50 +312,47 @@ and compute_type env e =
 			    TEBinary(te1,op,te2),(T_Int,false,false)
     | ECall (e,e_list) ->
 		(* TODO : look also within parent classes *)
-			let obj, name, candidates = (match e.e_desc with
+			let args_values = List.map (get_expr0 env) e_list in
+			let args_types = List.map (fun (e, (t, r, l)) -> t, r||l) args_values in
+
+			let obj, tproto = (match e.e_desc with
 			    | EIdent i ->
 					let funs = List.filter (fun p -> p.tp_name = i) env.b_pe.e_funs in
 					begin match env.b_class with
-					| None -> None, i, funs
+					| None -> None, closest_proto env.b_pe args_types funs
 					| Some k ->
-						begin match List.filter (fun p -> p.tp_name = i) k.tc_methods with
-						| [] -> None, i, funs
-						| l -> Some e_this_not_ptr, i, l
+						begin try Some e_this_not_ptr, find_proto_in_class env.b_pe k.tc_name i args_types
+						with NoCorrespondingPrototype ->
+							None, closest_proto env.b_pe args_types funs
 						end
 					end
 				| EMember(e, i) ->
 					let e = type_expr env e in
-					let c = match e.type_expr with
-					| TClass(k), a, b when a || b -> get_c env.b_pe k
+					begin match e.type_expr with
+					| TClass(k), a, b when a || b ->
+						Some e, find_proto_in_class env.b_pe k i args_types
 					| _ -> ty_error "Invalid argument type for method call (not a class, or not a lvalue)"
-					in
-					Some e, i, List.filter (fun p -> p.tp_name = i) (c.tc_methods)
+					end
 			    | _ -> ty_error "Calling something that is neither a function nor a method") in
-			let args_values = List.map (get_expr0 env) e_list in
-			let tproto = match candidates with
-			| [] -> ty_error ("No such function: " ^ name)
-			| l ->
-				(* handle overload *)
-			  let args_types = List.map (fun (e, (t, r, l)) -> t, r||l) args_values in
-			  closest_proto env.b_pe args_types candidates
-			in
-			  let l_te = List.map fst args_values in 
-			  let l_te = match obj with
-			  	| None -> l_te
-				| Some(obj_e) -> obj_e :: l_te 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
-			  ty_assert (not tproto.tp_virtual) "Virtual methods not implemented yet.";
-			  TECallFun(tproto.tp_unique_ident,l_te),(ty,b,false)
+		  let l_te = List.map fst args_values 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)
+		  | None, Some(obj)->
+				TECallFun(tproto.tp_unique_ident,obj::l_te),(ty,b,false)
+		  | Some(idx), Some(obj) ->
+				TECallVirtual(obj, idx, l_te),(ty,b,false)
+		  | _ -> ty_error "(should not happen) Virtual function applied to no object..."
+		  end
     | EMember (e, id) ->
 		let e, (ty, r, l) = get_expr0 env e in
 		begin match ty with
 		| TClass(c_name) ->
-			let c = get_c env.b_pe c_name in
-			(* TODO : also look in super classes *)
-			begin try let mty = Smap.find id c.tc_members in
-				TEMember(e, id), (mty, false, true)
+			begin try let mty, mi = find_cls_mem env.b_pe c_name id in
+				TEMember(e, mi), (mty, false, true)
 			with | Not_found -> ty_error ("Class " ^ c_name ^ " has no member " ^ id)
 			end
 		| _ -> ty_error "Cannot get member of expression that is not a class"
@@ -490,7 +526,7 @@ let get_fun env p b = (* p : proto   b : block -> tp, tb, env2*)
 		tp_name = name ;
 		tp_unique_ident = name ^ (tproto_unique_number());
 		tp_class = None ;
-		tp_virtual = false ;
+		tp_virtual = None ;
 		tp_ret_type = Some ret_type ;
 		tp_args = ty_args; } in
   let env2 = 
@@ -509,62 +545,101 @@ let get_fun env p b = (* p : proto   b : block -> tp, tb, env2*)
 
 (* Déclarations de classes *)
 
-let rec compute_tclass env c = 
-	let name = c.c_name in
-	ty_assert (not (Smap.mem name env.e_classes)) ("Redeclaration of class " ^name^".");
-	let supers = match c.c_supers with | None -> [] | Some k -> k in
-	List.iter (fun n ->
-		ty_assert (Smap.mem n env.e_classes)
-				("Super " ^ n ^ " does not exist or is not a class.")) supers;
-	let cls_tmp = {tc_name = name; tc_supers = supers; tc_members = Smap.empty; tc_methods = [] } in
-	let t_env = {
+let compute_tclass env c = 
+	let cls_name = c.c_name in
+	ty_assert (not (Smap.mem cls_name env.e_classes)) ("Redeclaration of class " ^cls_name^".");
+	(* artifice pour que la classe en train d'être définie puisse être utilisée par elle-même *)
+	let forward_def = {tc_name = cls_name; tc_size = 0; tc_super = None; tc_members = Smap.empty; tc_methods = []; tc_vtable = [] } in
+	let forward_env = {
 		e_globals = env.e_globals;
 		e_funs = env.e_funs;
-		e_classes = (Smap.add name cls_tmp env.e_classes); } in
-	let mem, meth = List.fold_left
-		(fun (mem, meth) n -> match n with
+		e_classes = (Smap.add cls_name forward_def env.e_classes); } in
+
+	let super, vtable, used = match c.c_supers with
+		| Some [] | None -> None, ref [], 0
+		| Some [n] -> 
+			begin try let c = get_c env n in
+				Some n, ref c.tc_vtable, c.tc_size	(* copy parent vtable, will be modified when redefined members *)
+			with Not_found -> ty_error ("Super " ^ n ^ " does not exist or is not a class.")
+			end
+		| _ -> ty_error "Intentionnal sacrifice : multiple inheritance not supported."
+	in
+	let used = (if used = 0 then 4 else used) in	(* If no supers, reserve space for vtable pointer *)
+	let (mem, mem_u), meth = List.fold_left
+		(fun ((mem, mem_u), meth) n -> match n with
 			| CVar(t, i) ->
 				let t, r = build_type_or_ref t in
 				ty_assert (not r) "Class members cannot be references.";
-				ty_assert (bf t_env t) ("Malformed type for member " ^ i ^ ".");
-				ty_assert (t <> TClass(name)) "Class cannot contain itself as a member.";
-				ty_assert (not (Smap.mem i mem)) ("Redefinition of class member " ^ i ^ " in class " ^ name ^ ".");
-				(Smap.add i t mem, meth)
-			| CMethod(p) ->
-				let m = err_add_loc p.p_loc (fun () -> (build_method t_env name meth false p)) in
-				mem, m::meth
-			| CVirtualMethod(p) ->
-				let m = err_add_loc p.p_loc (fun () -> (build_method t_env name meth true p)) in
-				mem, m::meth
-		) (Smap.empty, []) c.c_members in
-	{	tc_name = name;
-		tc_supers = supers;
+				ty_assert (bf forward_env t) ("Malformed type for member " ^ i ^ ".");
+				ty_assert (t <> TClass(cls_name)) "Class cannot contain itself as a member.";
+				ty_assert (not (Smap.mem i mem)) ("Redefinition of class member " ^ i ^ " in class " ^ cls_name ^ ".");
+				let size = type_size env t in 
+				((Smap.add i (t, mem_u) mem, mem_u + size), meth)
+			| CMethod(proto, virt) ->
+				let m = err_add_loc proto.p_loc (fun () ->
+					ty_assert (proto.p_class = None) "Overqualification in prototype.";
+					ty_assert (proto.p_ret_type <> None || proto.p_name = cls_name) "Invalid name for constructor";
+					(* Make sure prototype is well formed *)
+					let args = parse_args forward_env proto.p_args in
+					(* Make sure method is compatible with other declarations in this class *)
+					ty_assert (not (List.exists
+							(fun p -> p.tp_name = proto.p_name && (List.map fst p.tp_args) = (List.map fst args)) meth))
+						("Redefinition of function " ^ proto.p_name ^ " with same argument types.");
+					(* Check return type *)
+					let ret_type = match proto.p_ret_type with
+						| Some k -> Some (build_type_or_ref k)
+						| None -> None in
+					(*	If method is redefined from a virtual method of a parent class, it becomes virtual with same offset
+						Else if method is virtual, it gets new offset !
+						Else method is not virtual, everything is simple. *)
+					let rec check_super = function
+					| None -> None
+					| Some(n) -> let c = get_c env n in
+						try let proto = List.find
+							(fun p -> p.tp_name = proto.p_name && p.tp_virtual <> None && (List.map fst p.tp_args) = (List.map fst args))
+							c.tc_methods
+						in Some (proto)
+						with Not_found -> check_super (c.tc_super)
+					in
+					let vproto_in_super = check_super super in
+					let virtl = match vproto_in_super with
+					| Some(k) -> k.tp_virtual
+					| None ->
+						if not virt then None
+						else 	(* allocate new spot in vtable *)
+							Some (List.fold_left (fun n (x, _) -> max n (x+4)) 0 !vtable)
+					in
+					(* Build proto *)
+					let tproto = 
+					{	tp_virtual = virtl;
+						tp_loc = proto.p_loc;
+						tp_name = proto.p_name;
+						tp_unique_ident = proto.p_name ^ (tproto_unique_number()) ;
+						tp_class = Some(cls_name);
+						tp_ret_type = ret_type;
+						tp_args = args;
+					} in
+					(* Add to vtable *)
+					begin match virtl with
+					| None -> ()
+					| Some i ->
+						vtable := (i, tproto)::(List.remove_assoc i !vtable)
+					end;
+					tproto) in
+				(mem, mem_u), m::meth
+		) ((Smap.empty, used), []) c.c_members in
+	{	tc_name = cls_name;
+		tc_vtable = !vtable;
+		tc_size = mem_u;
+		tc_super = super;
 		tc_members = mem;
 		tc_methods = meth; }
-and build_method env cls_name cls_mems virt proto =
-	ty_assert (proto.p_class = None) "Overqualification in prototype.";
-	ty_assert (proto.p_ret_type <> None || proto.p_name = cls_name) "Invalid name for constructor";
-	(* Make sure prototype is well formed *)
-	let args = parse_args env proto.p_args in
-	(* TODO Make sure method is compatible with parents and other declarations *)
-	(* Check return type *)
-	let ret_type = match proto.p_ret_type with
-		| Some k -> Some (build_type_or_ref k)
-		| None -> None in
-	{	tp_virtual = virt;
-		tp_loc = proto.p_loc;
-		tp_name = proto.p_name;
-		tp_unique_ident = proto.p_name ^ (tproto_unique_number()) ;
-		tp_class = Some(cls_name);
-		tp_ret_type = ret_type;
-		tp_args = args;
-	}
 
 let get_method env proto block = 	(* return : TDFunction *)
 	match proto.p_class with
 	| None -> assert false
 	| Some(cls_name) ->
-	try let c = Smap.find cls_name env.e_classes in
+	try let c = get_c env cls_name in
 		let args = parse_args env proto.p_args in
 		let ret_type = match proto.p_ret_type with
 			| Some k -> Some (build_type_or_ref k)
@@ -580,13 +655,7 @@ let get_method env proto block = 	(* return : TDFunction *)
 				b_locals = locals;
 				b_class = Some c; } in
 			let tb = get_block (match ret_type with | None -> T_Void, false | Some k -> k) contexte block in
-			{	tp_virtual = cproto.tp_virtual;
-				tp_loc = proto.p_loc;
-				tp_name = proto.p_name;
-				tp_unique_ident = proto.p_name ^ (tproto_unique_number()) ;
-				tp_class = proto.p_class;
-				tp_ret_type = ret_type;
-				tp_args = args }, tb
+				cproto, tb
 		with
 		| Not_found -> ty_error ("Implementation corresponds to no declared method of class " ^ cls_name)
 		end
@@ -639,7 +708,7 @@ let prog p =
 	  	(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 = decls; prog_env = env }
+  { prog_decls = List.rev decls; prog_env = env }