Skip to content

Commit

Permalink
reverted improved generics
Browse files Browse the repository at this point in the history
  • Loading branch information
@Simn
Simn committed Jul 26, 2012
1 parent a641859 commit a25f8b9
Show file tree
Hide file tree
Showing 7 changed files with 75 additions and 187 deletions.
164 changes: 66 additions & 98 deletions codegen.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -201,17 +201,55 @@ let extend_remoting ctx c t p async prot =
(* -------------------------------------------------------------------------- *)
(* HAXE.RTTI.GENERIC *)

(* updates class ct(arget) from cs(ource) by sustituting types from ps to pt *)
let rec build_generic ctx cs ct ps pt p =
let rec copy_class ctx cs ct ps pt p =
let rec build_generic ctx c p tl =
let pack = fst c.cl_path in
let recurse = ref false in
let rec check_recursive t =
match follow t with
| TInst (c,tl) ->
(match c.cl_kind with KTypeParameter _ -> recurse := true | _ -> ());
List.iter check_recursive tl;
| _ ->
()
in
let name = String.concat "_" (snd c.cl_path :: (List.map (fun t ->
check_recursive t;
let path = (match follow t with
| TInst (c,_) -> c.cl_path
| TEnum (e,_) -> e.e_path
| TMono _ -> error "Type parameter must be explicit when creating a generic instance" p
| _ -> error "Type parameter must be a class or enum instance" p
) in
match path with
| [] , name -> name
| l , name -> String.concat "_" l ^ "_" ^ name
) tl)) in
if !recurse then
TInst (c,tl) (* build a normal instance *)
else try
Typeload.load_instance ctx { tpackage = pack; tname = name; tparams = []; tsub = None } p false
with Error(Module_not_found path,_) when path = (pack,name) ->
let m = (try Hashtbl.find ctx.g.modules (Hashtbl.find ctx.g.types_module c.cl_path) with Not_found -> assert false) in
let ctx = { ctx with local_types = m.m_types @ ctx.local_types } in
let mg = {
m_id = alloc_mid();
m_path = (pack,name);
m_types = [];
m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake;
} in
let cg = mk_class mg (pack,name) c.cl_pos in
mg.m_types <- [TClassDecl cg];
Hashtbl.add ctx.g.modules mg.m_path mg;
add_dependency mg m;
add_dependency ctx.current mg;
let rec loop l1 l2 =
match l1, l2 with
| [] , [] -> []
| (x,TLazy f) :: l1, _ -> loop ((x,(!f)()) :: l1) l2
| (_,t1) :: l1 , t2 :: l2 -> (t1,t2) :: loop l1 l2
| _ -> assert false
in
let subst = loop ps pt in
let subst = loop c.cl_types tl in
let rec build_type t =
match t with
| TInst ({ cl_kind = KGeneric } as c2,tl2) ->
Expand All @@ -235,73 +273,37 @@ let rec build_generic ctx cs ct ps pt p =
let t = build_type f.cf_type in
{ f with cf_type = t; cf_expr = (match f.cf_expr with None -> None | Some e -> Some (build_expr e)) }
in
ct.cl_path <- cs.cl_path;
ct.cl_module <- cs.cl_module;
(* TODO: find a way to deal with this *)
(* ct.cl_super <- (match cs.cl_super with
if c.cl_init <> None || c.cl_dynamic <> None then error "This class can't be generic" p;
if c.cl_ordered_statics <> [] then error "A generic class can't have static fields" p;
cg.cl_super <- (match c.cl_super with
| None -> None
| Some (cs,params) ->
(match apply_params cs.cl_types pt (TInst (cs,params)) with
| TInst ({cl_kind = KGeneric },params) ->
build_generic ctx cs ps params p;
Some (cs,params)
| TInst (cs,params) -> Some (cs,params)
| Some (cs,pl) ->
(match apply_params c.cl_types tl (TInst (cs,pl)) with
| TInst (cs,pl) when cs.cl_kind = KGeneric ->
(match build_generic ctx cs p pl with
| TInst (cs,pl) -> Some (cs,pl)
| _ -> assert false)
| TInst (cs,pl) -> Some (cs,pl)
| _ -> assert false)
); *)
ct.cl_interface <- cs.cl_interface;
ct.cl_constructor <- (match cs.cl_constructor, cs.cl_super with
);
cg.cl_kind <- KGenericInstance (c,tl);
cg.cl_interface <- c.cl_interface;
cg.cl_constructor <- (match c.cl_constructor, c.cl_super with
| None, None -> None
| Some cs, _ -> Some (build_field cs)
| _ -> error "Please define a constructor for this class in order to use it as generic" cs.cl_pos
| Some c, _ -> Some (build_field c)
| _ -> error "Please define a constructor for this class in order to use it as generic" c.cl_pos
);
ct.cl_implements <- List.map (fun (i,tl) ->
cg.cl_implements <- List.map (fun (i,tl) ->
(match follow (build_type (TInst (i, List.map build_type tl))) with
| TInst (i,tl) -> i, tl
| _ -> assert false)
) cs.cl_implements;
ct.cl_ordered_fields <- List.map (fun f ->
) c.cl_implements;
cg.cl_ordered_fields <- List.map (fun f ->
let f = build_field f in
ct.cl_fields <- PMap.add f.cf_name f ct.cl_fields;
cg.cl_fields <- PMap.add f.cf_name f cg.cl_fields;
f
) cs.cl_ordered_fields;
ct.cl_extern <- false;
ct.cl_kind <- KNormal;
(* this is currently necessary *)
ct.cl_meta <- (":keep",[],p) :: ct.cl_meta
in
let pack = fst ct.cl_path in
let name = String.concat "_" (snd ct.cl_path :: (List.map2 (fun (s,_) t ->
let path = (match follow t with
| TInst({ cl_kind = KGenericInstance _} as c2,[]) ->
error ("Generic instance " ^ (s_type_path c2.cl_path) ^ " cannot be used as type parameter") p;
| TInst (ct,_) -> ct.cl_path
| TEnum (e,_) -> e.e_path
| TMono _ -> error ("Could not determine type for parameter " ^ s) p
| _ -> error "Type parameter must be a class or enum instance" p
) in
match path with
| [] , name -> name
| l , name -> String.concat "_" l ^ "_" ^ name
) ps pt)) in
try
(match Typeload.load_instance ctx { tpackage = pack; tname = name; tparams = []; tsub = None } p false with
| TInst(cs,[]) -> copy_class ctx cs ct ps pt p
| _ -> assert false)
with Error(Module_not_found path,_) when path = (pack,name) ->
let m = (try Hashtbl.find ctx.g.modules (Hashtbl.find ctx.g.types_module cs.cl_path) with Not_found -> assert false) in
let ctx = { ctx with local_types = m.m_types @ ctx.local_types } in
let mg = {
m_id = alloc_mid();
m_path = (pack,name);
m_types = [];
m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake;
} in
mg.m_types <- [TClassDecl ct];
Hashtbl.add ctx.g.modules mg.m_path mg;
copy_class ctx cs ct ps pt p;
ct.cl_path <- (pack,name);
ct.cl_module <- mg;
ctx.com.types <- TClassDecl ct :: ctx.com.types
) c.cl_ordered_fields;
TInst (cg,[])

(* -------------------------------------------------------------------------- *)
(* HAXE.XML.PROXY *)
Expand Down Expand Up @@ -431,38 +433,7 @@ let build_instance ctx mtype p =
let r = exc_protect ctx (fun r ->
let t = mk_mono() in
r := (fun() -> t);
if List.exists (fun t -> match t with
| TInst({cl_kind = KTypeParameter _},[]) -> true
| _ -> false
) pl then
(* we can't use generic if there's a type parameter involved *)
unify_raise ctx (TInst(c,pl)) t p
else begin
(* create the new generic instance *)
let c2 = mk_class c.cl_module c.cl_path p in
c2.cl_kind <- KGenericInstance (c,pl);
(* apply the class type parameters with all currently known types to all class fields *)
(* the remaining monos should be unified through calls, otherwise generic build fails *)
let apply_field cf =
{cf with cf_type = apply_params c.cl_types pl cf.cf_type; cf_expr = None }
in
(match c.cl_constructor with None -> () | Some ctor -> c2.cl_constructor <- Some (apply_field ctor));
List.iter (fun cf ->
let cf = apply_field cf in
c2.cl_ordered_statics <- cf :: c2.cl_ordered_statics;
c2.cl_statics <- PMap.add cf.cf_name cf c2.cl_statics;
) c.cl_ordered_statics;
List.iter (fun cf ->
let cf = apply_field cf in
c2.cl_ordered_fields <- cf :: c2.cl_ordered_fields;
c2.cl_fields <- PMap.add cf.cf_name cf c2.cl_fields;
) c.cl_ordered_fields;
(* at some point in the future the instance will actually be built *)
delay_late ctx (fun () ->
build_generic ctx c c2 c.cl_types pl p;
);
unify_raise ctx (TInst(c2,[])) t p;
end;
unify_raise ctx (build_generic ctx c p pl) t p;
t
) in
delay ctx (fun() -> ignore ((!r)()));
Expand Down Expand Up @@ -625,10 +596,7 @@ let on_generate ctx t =
let rpath = (fst c.cl_module.m_path,"_" ^ snd c.cl_module.m_path) in
if Hashtbl.mem ctx.g.types_module rpath then error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos;
end;
if c.cl_kind = KGeneric then begin
if c.cl_ordered_statics <> [] then error "A generic class can't have static fields" c.cl_pos;
c.cl_extern <- true
end;
if c.cl_kind = KGeneric then c.cl_extern <- true;
c.cl_restore <- restore c;
List.iter (fun m ->
match m with
Expand Down
28 changes: 5 additions & 23 deletions optimizer.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -458,8 +458,7 @@ let optimize_for_loop ctx i e1 e2 p =
NormalWhile
)) t_void p;
]
(* disabled for now due to problems with new generic implementation *)
(* | _ , TInst ({ cl_kind = KGenericInstance ({ cl_path = ["haxe"],"FastList" },[t]) } as c,[]) ->
| _ , TInst ({ cl_kind = KGenericInstance ({ cl_path = ["haxe"],"FastList" },[t]) } as c,[]) ->
let tcell = (try (PMap.find "head" c.cl_fields).cf_type with Not_found -> assert false) in
let i = add_local ctx i t in
let cell = gen_local ctx tcell in
Expand All @@ -478,7 +477,7 @@ let optimize_for_loop ctx i e1 e2 p =
block,
NormalWhile
)) t_void p
] *)
]
| _ ->
None

Expand Down Expand Up @@ -542,8 +541,7 @@ let rec add_final_return e t =
| _ ->
{ e with eexpr = TBlock [e;def_return e.epos] }

let sanitize_expr ctx e =
let com = ctx.com in
let sanitize_expr com e =
let parent e =
match e.eexpr with
| TParenthesis _ -> e
Expand Down Expand Up @@ -628,22 +626,6 @@ let sanitize_expr ctx e =
| _ -> { f with tf_expr = block f.tf_expr }
) in
{ e with eexpr = TFunction f }
(* we skipped inline on generic instances, so let's try to do it now *)
| TCall({eexpr = TField(ethis,fname)} as e2,args) ->
let def () = if need_parent e2 then { e with eexpr = TCall(parent e2,args) } else e in
(match follow ethis.etype with
| TInst({cl_kind = KGenericInstance _ } as c,[]) ->
(try
let f = snd (Type.class_field c fname) in
(match f.cf_expr with
| Some { eexpr = TFunction fd } ->
(match type_inline ctx f fd ethis args e.etype e.epos false with
| None -> def()
| Some e -> e)
| _ -> def())
with Not_found ->
def())
| _ -> def())
| TCall (e2,args) ->
if need_parent e2 then { e with eexpr = TCall(parent e2,args) } else e
| TField (e2,f) ->
Expand Down Expand Up @@ -694,7 +676,7 @@ let reduce_expr ctx e =
e

let rec sanitize ctx e =
sanitize_expr ctx (reduce_expr ctx (Type.map_expr (sanitize ctx) e))
sanitize_expr ctx.com (reduce_expr ctx (Type.map_expr (sanitize ctx) e))

(* ---------------------------------------------------------------------- *)
(* REDUCE *)
Expand All @@ -716,7 +698,7 @@ let rec reduce_loop ctx e =
let fstr = string_of_float f in
if (match classify_float f with FP_nan | FP_infinite -> false | _ -> float_of_string fstr = f) then { e with eexpr = TConst (TFloat fstr) } else e
in
sanitize_expr ctx (match e.eexpr with
sanitize_expr ctx.com (match e.eexpr with
| TIf ({ eexpr = TConst (TBool t) },e1,e2) ->
(if t then e1 else match e2 with None -> { e with eexpr = TBlock [] } | Some e -> e)
| TWhile ({ eexpr = TConst (TBool false) },sub,flag) ->
Expand Down
13 changes: 0 additions & 13 deletions tests/unit/MyClass.hx
View file
Original file line number Diff line number Diff line change
Expand Up @@ -193,17 +193,4 @@ class UsingUnrelated {
#end
return "foo".pupFunc() + "foo".siblingFunc();
}
}

class ClassWithBar {
public function new() { }
public var bar:Int;
}

@:generic class MyGeneric < S, T > {
public function new(s:S) { }
public function clone() {
return new S("foo");
}
public function bindT(t:T) { }
}
29 changes: 0 additions & 29 deletions tests/unit/TestType.hx
View file
Original file line number Diff line number Diff line change
Expand Up @@ -500,33 +500,4 @@ class TestType extends Test {
inline function inlineTest2(map:Array<Dynamic>) {
map[0];
}

public function testGeneric() {
var l = new haxe.FastList();
var l2 = new haxe.FastList<Int>();
var l3 = new haxe.FastList();
l.add(1);
l2 = l;
l3.remove("foo");

eq(Type.getClassName(Type.getClass(l)), "haxe.FastList_Int");
eq(Type.getClassName(Type.getClass(l2)), "haxe.FastList_Int");
eq(Type.getClassName(Type.getClass(l3)), "haxe.FastList_String");

var mg = new MyGeneric("foo");
eq(mg.clone(), "foo");
mg.bindT(1);
eq(Type.getClassName(Type.getClass(mg)), "unit.MyGeneric_String_Int");

var mg2 = new MyGeneric(new haxe.Template("bar"));
t(Std.is(mg2.clone(), haxe.Template));
mg2.bindT(true);
eq(Type.getClassName(Type.getClass(mg2)), "unit.MyGeneric_haxe_Template_Bool");

// error cases
//var missingT = new MyGeneric("foo"); // Could not determine type for parameter T
//var invalidS = new MyGeneric( { foo: 1 } ).bindT("foo"); // Type parameter must be a class or enum instance
//var invalidCtor = new MyGeneric(1).bindT("foo"); // Int should be { new : String -> Void }
//new MyGenericClass2().bindS(new ClassWithBar()); // unit.ClassWithBar should be { foo : Int }
}
}
12 changes: 0 additions & 12 deletions type.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -349,14 +349,6 @@ let print_context() = ref []

let is_closed a = !(a.a_status) <> Opened

let pos_t t = match t with
| TInst (c,_) -> c.cl_pos
| TEnum (e,_) -> e.e_pos
| TType (t,_) -> t.t_pos
| TAnon a when not (PMap.is_empty a.a_fields) ->
PMap.fold (fun cf pu -> if pu = Ast.null_pos then cf.cf_pos else punion pu cf.cf_pos) a.a_fields Ast.null_pos;
| _ -> Ast.null_pos

let rec s_type ctx t =
match t with
| TMono r ->
Expand Down Expand Up @@ -899,10 +891,6 @@ let rec unify a b =
| TEnum (ea,tl1) , TEnum (eb,tl2) ->
if ea != eb then error [cannot_unify a b];
unify_types a b tl1 tl2
| TInst({cl_kind = KGenericInstance (c1,pl1)},_), TInst({cl_kind = KGenericInstance (c2,pl2)},_) ->
(* unify generic instances by unifying their base classes and type parameters *)
unify (TInst(c1,[])) (TInst(c2,[]));
unify_types (TInst(c1,pl1)) (TInst(c2,pl2)) pl1 pl2
| TInst (c1,tl1) , TInst (c2,tl2) ->
let rec loop c tl =
if c == c2 then begin
Expand Down
11 changes: 3 additions & 8 deletions typeload.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -120,20 +120,15 @@ let rec load_type_def ctx p t =
let check_param_constraints ctx types t pl c p =
match follow t with
| TMono _ -> ()
| mt ->
| _ ->
let ctl = (match c.cl_kind with KTypeParameter l -> l | _ -> []) in
List.iter (fun ti ->
(*
what was that used for ?
let ti = try snd (List.find (fun (_,t) -> match follow t with TInst(i2,[]) -> i == i2 | _ -> false) types) with Not_found -> TInst (i,tl) in
*)
let ti = apply_params types pl ti in
try
unify_raise ctx t ti p
with Error (Unify l,p) ->
display_error ctx (error_msg (Unify (Constraint_failure (s_type (print_context()) mt) :: l))) p;
let pc = pos_t ti in
if pc <> Ast.null_pos then display_error ctx "Constraint was defined here" pc;
unify ctx t ti p
) ctl

(* build an instance from a full type *)
Expand All @@ -151,7 +146,7 @@ let rec load_instance ctx t p allow_no_params =
match follow t with
| TInst (c,_) ->
let t = mk_mono() in
if c.cl_kind <> KTypeParameter [] then delay_late ctx (fun() -> check_param_constraints ctx types t (!pl) c p);
delay_late ctx (fun() -> check_param_constraints ctx types t (!pl) c p);
t;
| _ -> assert false
) types;
Expand Down
Loading

0 comments on commit a25f8b9

Please sign in to comment.