diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index 42818759120..a7dd0ebb6d6 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -169,7 +169,7 @@ let fix_override com c f fd = have to detect this case and change the variable (issue #2712). *) begin match follow v.v_type with | TInst({cl_kind = KTypeParameter [tc]} as cp,_) when com.platform = Flash -> - if List.mem_assoc (snd cp.cl_path) c.cl_params then raise (Unify_error []) + if List.exists (fun tp -> tp.ttp_name = (snd cp.cl_path)) c.cl_params then raise (Unify_error []) | _ -> () end; diff --git a/src/codegen/dotnet.ml b/src/codegen/dotnet.ml index 64ff7592ec9..6759c04196b 100644 --- a/src/codegen/dotnet.ml +++ b/src/codegen/dotnet.ml @@ -473,6 +473,7 @@ let convert_ilmethod ctx p is_interface m is_explicit_impl = tp_name = "M" ^ string_of_int t.tnumber,null_pos; tp_params = []; tp_constraints = None; + tp_default = None; tp_meta = []; } ) m.mtypes in @@ -643,6 +644,7 @@ let convert_delegate ctx p ilcls = tp_name = ("T" ^ string_of_int t.tnumber),null_pos; tp_params = []; tp_constraints = None; + tp_default = None; tp_meta = []; } ) ilcls.ctypes in @@ -816,6 +818,7 @@ let convert_ilclass ctx p ?(delegate=false) ilcls = match ilcls.csuper with tp_name = "T" ^ string_of_int p.tnumber,null_pos; tp_params = []; tp_constraints = None; + tp_default = None; tp_meta = []; }) ilcls.ctypes in diff --git a/src/codegen/gencommon/castDetect.ml b/src/codegen/gencommon/castDetect.ml index d2aff904e08..4d0a4afa997 100644 --- a/src/codegen/gencommon/castDetect.ml +++ b/src/codegen/gencommon/castDetect.ml @@ -741,7 +741,7 @@ let handle_type_parameter gen e e1 ef ~clean_ef ~overloads_cast_to_base f elist (* this function will receive the original function argument, the applied function argument and the original function parameters. *) (* from this info, it will infer the applied tparams for the function *) - let infer_params pos (original_args:((string * bool * t) list * t)) (applied_args:((string * bool * t) list * t)) (params:(string * t) list) calls_parameters_explicitly : tparams = + let infer_params pos (original_args:((string * bool * t) list * t)) (applied_args:((string * bool * t) list * t)) (params:typed_type_param list) calls_parameters_explicitly : tparams = match params with | [] -> [] | _ -> diff --git a/src/codegen/gencommon/closuresToClass.ml b/src/codegen/gencommon/closuresToClass.ml index 98b3fc9af9f..5d2f14c8fcf 100644 --- a/src/codegen/gencommon/closuresToClass.ml +++ b/src/codegen/gencommon/closuresToClass.ml @@ -289,7 +289,7 @@ let rec get_type_params acc t = get_type_params acc ( Abstract.get_underlying_type a pl) | TAnon a -> PMap.fold (fun cf acc -> - let params = List.map (fun (_,t) -> match follow t with + let params = List.map (fun tp -> match follow tp.ttp_type with | TInst(c,_) -> c | _ -> die "" __LOC__) cf.cf_params in @@ -396,7 +396,7 @@ let configure gen ft = in (*let cltypes = List.map (fun cl -> (snd cl.cl_path, TInst(map_param cl, []) )) tparams in*) - let cltypes = List.map (fun cl -> (snd cl.cl_path, TInst(cl, []) )) tparams in + let cltypes = List.map (fun cl -> mk_type_param (snd cl.cl_path) (TInst(cl, [])) None) tparams in (* create a new class that extends abstract function class, with a ctor implementation that will setup all captured variables *) let cfield = match gen.gcurrent_classfield with @@ -426,7 +426,7 @@ let configure gen ft = let mk_this v pos = { - (mk_field_access gen { eexpr = TConst TThis; etype = TInst(cls, List.map snd cls.cl_params); epos = pos } v.v_name pos) + (mk_field_access gen { eexpr = TConst TThis; etype = TInst(cls, extract_param_types cls.cl_params); epos = pos } v.v_name pos) with etype = v.v_type } in @@ -476,9 +476,9 @@ let configure gen ft = eexpr = TCall({ eexpr = TField({ eexpr = TConst TThis; - etype = TInst(cls, List.map snd cls.cl_params); + etype = TInst(cls, extract_param_types cls.cl_params); epos = pos; - }, FInstance(cls, List.map snd cls.cl_params, cf)); + }, FInstance(cls, extract_param_types cls.cl_params, cf)); etype = cf.cf_type; epos = pos; }, List.map (fun (v,_) -> mk_local v pos) tfunc.tf_args); @@ -617,11 +617,11 @@ let configure gen ft = | TInst(c,_), TInst(c2,_) -> c == c2 | _ -> false in - let passoc = List.map2 (fun (_,t) m -> t,m) types monos in - let cltparams = List.map (fun (_,t) -> + let passoc = List.map2 (fun tp m -> tp.ttp_type,m) types monos in + let cltparams = List.map (fun tp -> try - snd (List.find (fun (t2,_) -> same_cl t t2) passoc) - with | Not_found -> t) cls.cl_params + snd (List.find (fun (t2,_) -> same_cl tp.ttp_type t2) passoc) + with | Not_found -> tp.ttp_type) cls.cl_params in { e with eexpr = TNew(cls, cltparams, List.rev captured) } with @@ -899,7 +899,7 @@ struct let map_base_classfields cl map_fn = let pos = cl.cl_pos in - let this_t = TInst(cl,List.map snd cl.cl_params) in + let this_t = TInst(cl,extract_param_types cl.cl_params) in let this = { eexpr = TConst(TThis); etype = this_t; epos = pos } in let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in @@ -1091,7 +1091,7 @@ struct loop arity [] in - let this = mk (TConst TThis) (TInst (cl, List.map snd cl.cl_params)) pos in + let this = mk (TConst TThis) (TInst (cl, extract_param_types cl.cl_params)) pos in let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in let mk_invoke_switch i api = diff --git a/src/codegen/gencommon/enumToClass.ml b/src/codegen/gencommon/enumToClass.ml index 5814a920be6..875ae592df8 100644 --- a/src/codegen/gencommon/enumToClass.ml +++ b/src/codegen/gencommon/enumToClass.ml @@ -103,7 +103,7 @@ struct | _ -> ()); let c_types = if handle_type_params then - List.map (fun (s,t) -> (s, TInst (map_param (get_cl_t t), []))) en.e_params + List.map (fun tp -> {tp with ttp_type=TInst (map_param (get_cl_t tp.ttp_type), [])}) en.e_params else [] in @@ -121,13 +121,13 @@ struct | TFun(params,ret) -> let dup_types = if handle_type_params then - List.map (fun (s,t) -> (s, TInst (map_param (get_cl_t t), []))) en.e_params + List.map (fun tp -> {tp with ttp_type = TInst (map_param (get_cl_t tp.ttp_type), [])}) en.e_params else [] in let ef_type = - let fn, types = if handle_type_params then snd, dup_types else (fun _ -> t_dynamic), en.e_params in + let fn, types = if handle_type_params then extract_param_type, dup_types else (fun _ -> t_dynamic), en.e_params in let t = apply_params en.e_params (List.map fn types) ef.ef_type in apply_params ef.ef_params (List.map fn ef.ef_params) t in @@ -144,7 +144,7 @@ struct eexpr = TFunction({ tf_args = tf_args; tf_type = ret; - tf_expr = mk_block ( mk_return { eexpr = TNew(cl,List.map snd dup_types, [make_int gen.gcon.basic old_i pos; arr_decl] ); etype = TInst(cl, List.map snd dup_types); epos = pos } ); + tf_expr = mk_block ( mk_return { eexpr = TNew(cl,extract_param_types dup_types, [make_int gen.gcon.basic old_i pos; arr_decl] ); etype = TInst(cl, extract_param_types dup_types); epos = pos } ); }); etype = ef_type; epos = pos diff --git a/src/codegen/gencommon/fixOverrides.ml b/src/codegen/gencommon/fixOverrides.ml index f79195a5db8..43995535da5 100644 --- a/src/codegen/gencommon/fixOverrides.ml +++ b/src/codegen/gencommon/fixOverrides.ml @@ -61,7 +61,7 @@ let run ~explicit_fn_name ~get_vmtype gen = ) c.cl_ordered_fields; md | TClassDecl c when not (has_class_flag c CExtern) -> - let this = { eexpr = TConst TThis; etype = TInst(c,List.map snd c.cl_params); epos = c.cl_pos } in + let this = { eexpr = TConst TThis; etype = TInst(c,extract_param_types c.cl_params); epos = c.cl_pos } in (* look through all interfaces, and try to find a type that applies exactly *) let rec loop_iface (iface:tclass) itl = List.iter (fun (s,stl) -> loop_iface s (List.map (apply_params iface.cl_params itl) stl)) iface.cl_implements; @@ -81,19 +81,19 @@ let run ~explicit_fn_name ~get_vmtype gen = Overloads.same_overload_args ~get_vmtype ftype t f f2 ) overloads | _ :: _ -> - (match field_access gen (TInst(c, List.map snd c.cl_params)) f.cf_name with + (match field_access gen (TInst(c, extract_param_types c.cl_params)) f.cf_name with | FClassField(_,_,_,f2,false,t,_) -> t,f2 (* if it's not an overload, all functions should have the same signature *) | _ -> raise Not_found) | [] -> raise Not_found in replace_mono t2; (* if we find a function with the exact type of real_ftype, it means this interface has already been taken care of *) - if not (type_iseq (get_real_fun gen (apply_params f2.cf_params (List.map snd f.cf_params) t2)) real_ftype) then begin + if not (type_iseq (get_real_fun gen (apply_params f2.cf_params (extract_param_types f.cf_params) t2)) real_ftype) then begin (match f.cf_kind with | Method (MethNormal | MethInline) -> () | _ -> raise Not_found); let t2 = get_real_fun gen t2 in if List.length f.cf_params <> List.length f2.cf_params then raise Not_found; replace_mono t2; - match follow (apply_params f2.cf_params (List.map snd f.cf_params) t2), follow real_ftype with + match follow (apply_params f2.cf_params (extract_param_types f.cf_params) t2), follow real_ftype with | TFun(a1,r1), TFun(a2,r2) when not implement_explicitly && not (type_iseq r1 r2) && Overloads.same_overload_args ~get_vmtype real_ftype t2 f f2 -> (* different return types are the trickiest cases to deal with *) (* check for covariant return type *) @@ -107,7 +107,7 @@ let run ~explicit_fn_name ~get_vmtype gen = (* we only have to worry about non-covariant issues *) if not is_covariant then begin (* override return type and cast implemented function *) - let args, newr = match follow t2, follow (apply_params f.cf_params (List.map snd f2.cf_params) real_ftype) with + let args, newr = match follow t2, follow (apply_params f.cf_params (extract_param_types f2.cf_params) real_ftype) with | TFun(a,_), TFun(_,r) -> a,r | _ -> Globals.die "" __LOC__ in @@ -133,7 +133,7 @@ let run ~explicit_fn_name ~get_vmtype gen = let vars = List.map (fun (n,_,t) -> alloc_var n t) a2 in let args = List.map2 (fun v (_,_,t) -> mk_cast t (mk_local v f2.cf_pos)) vars a1 in - let field = { eexpr = TField(this, FInstance(c,List.map snd c.cl_params,f2)); etype = TFun(a1,r1); epos = p } in + let field = { eexpr = TField(this, FInstance(c,extract_param_types c.cl_params,f2)); etype = TFun(a1,r1); epos = p } in let call = { eexpr = TCall(field, args); etype = r1; epos = p } in (* let call = gen.gparam_func_call call field (List.map snd f.cf_params) args in *) let is_void = ExtType.is_void r2 in @@ -221,8 +221,8 @@ let run ~explicit_fn_name ~get_vmtype gen = eexpr = TCall( { eexpr = TField( - { eexpr = TConst TThis; etype = TInst(c, List.map snd c.cl_params); epos = p }, - FInstance(c,List.map snd c.cl_params,f)); + { eexpr = TConst TThis; etype = TInst(c, extract_param_types c.cl_params); epos = p }, + FInstance(c,extract_param_types c.cl_params,f)); etype = f.cf_type; epos = p }, diff --git a/src/codegen/gencommon/gencommon.ml b/src/codegen/gencommon/gencommon.ml index 527598a86f5..120697198aa 100644 --- a/src/codegen/gencommon/gencommon.ml +++ b/src/codegen/gencommon/gencommon.ml @@ -1068,7 +1068,7 @@ let follow_module follow_func md = match md with | TClassDecl _ | TEnumDecl _ | TAbstractDecl _ -> md - | TTypeDecl tdecl -> match (follow_func (TType(tdecl, List.map snd tdecl.t_params))) with + | TTypeDecl tdecl -> match (follow_func (TType(tdecl, extract_param_types tdecl.t_params))) with | TInst(cl,_) -> TClassDecl cl | TEnum(e,_) -> TEnumDecl e | TType(t,_) -> TTypeDecl t @@ -1188,7 +1188,7 @@ let find_first_declared_field gen orig_cl ?get_vmtype ?exact_field field = loop_cl (depth+1) sup tl tlch ) c.cl_implements in - loop_cl 0 orig_cl (List.map snd orig_cl.cl_params) (List.map snd orig_cl.cl_params); + loop_cl 0 orig_cl (extract_param_types orig_cl.cl_params) (extract_param_types orig_cl.cl_params); match !chosen with | None -> None @@ -1296,7 +1296,7 @@ let field_access_esp gen t field = match field with in let p = match follow (run_follow gen t) with | TInst(_,p) -> p - | _ -> List.map snd cl.cl_params + | _ -> extract_param_types cl.cl_params in FClassField(cl,p,cl,cf,static,cf.cf_type,cf.cf_type) | _ -> field_access gen t (field_name field) diff --git a/src/codegen/gencommon/initFunction.ml b/src/codegen/gencommon/initFunction.ml index c31b6165150..661c054be9c 100644 --- a/src/codegen/gencommon/initFunction.ml +++ b/src/codegen/gencommon/initFunction.ml @@ -123,7 +123,7 @@ let handle_class com cl = let is_var = match cf.cf_kind with Var _ -> true | _ -> false in (match cf.cf_expr, cf.cf_params with | Some e, [] -> - let var = mk (TField ((mk (TConst TThis) (TInst (cl, List.map snd cl.cl_params)) cf.cf_pos), FInstance(cl, List.map snd cl.cl_params, cf))) cf.cf_type cf.cf_pos in + let var = mk (TField ((mk (TConst TThis) (TInst (cl, extract_param_types cl.cl_params)) cf.cf_pos), FInstance(cl, extract_param_types cl.cl_params, cf))) cf.cf_type cf.cf_pos in let ret = binop Ast.OpAssign var e cf.cf_type cf.cf_pos in cf.cf_expr <- None; let is_override = has_class_field_flag cf CfOverride in @@ -139,7 +139,7 @@ let handle_class com cl = | Some e, _ -> let params = List.map (fun _ -> t_dynamic) cf.cf_params in let fn = apply_params cf.cf_params params in - let var = mk (TField ((mk (TConst TThis) (TInst (cl, List.map snd cl.cl_params)) cf.cf_pos), FInstance(cl, List.map snd cl.cl_params, cf))) cf.cf_type cf.cf_pos in + let var = mk (TField ((mk (TConst TThis) (TInst (cl, extract_param_types cl.cl_params)) cf.cf_pos), FInstance(cl, extract_param_types cl.cl_params, cf))) cf.cf_type cf.cf_pos in let rec change_expr e = Type.map_expr_type (change_expr) fn (fun v -> v.v_type <- fn v.v_type; v) e in @@ -173,7 +173,7 @@ let handle_class com cl = ctor | None -> try - let sctor, sup, stl = OverloadingConstructor.prev_ctor cl (List.map snd cl.cl_params) in + let sctor, sup, stl = OverloadingConstructor.prev_ctor cl (extract_param_types cl.cl_params) in let ctor = OverloadingConstructor.clone_ctors com sctor sup stl cl in cl.cl_constructor <- Some ctor; ctor diff --git a/src/codegen/gencommon/interfaceVarsDeleteModf.ml b/src/codegen/gencommon/interfaceVarsDeleteModf.ml index dd93cc5aa25..9c78af2916e 100644 --- a/src/codegen/gencommon/interfaceVarsDeleteModf.ml +++ b/src/codegen/gencommon/interfaceVarsDeleteModf.ml @@ -71,7 +71,7 @@ let configure gen = cl.cl_ordered_fields <- fields; List.iter (fun cf -> - match field_access gen (TInst(cl,List.map snd cl.cl_params)) cf.cf_name with + match field_access gen (TInst(cl,extract_param_types cl.cl_params)) cf.cf_name with | FNotFound | FDynamicField _ -> cl.cl_ordered_fields <- cf :: cl.cl_ordered_fields; cl.cl_fields <- PMap.add cf.cf_name cf cl.cl_fields diff --git a/src/codegen/gencommon/overloadingConstructor.ml b/src/codegen/gencommon/overloadingConstructor.ml index 2421202e4f3..ef99d9f7a55 100644 --- a/src/codegen/gencommon/overloadingConstructor.ml +++ b/src/codegen/gencommon/overloadingConstructor.ml @@ -114,9 +114,9 @@ let create_static_ctor com ~empty_ctor_expr cl ctor follow_type = | false -> let static_ctor_name = make_static_ctor_name cl in (* create the static constructor *) - let ctor_types = List.map (fun (s,t) -> (s, TInst(map_param (get_cl_t t), []))) cl.cl_params in - let ctor_type_params = List.map snd ctor_types in - List.iter (function (_,TInst(c,[])) -> ( + let ctor_types = List.map (fun tp -> {tp with ttp_type = TInst(map_param (get_cl_t tp.ttp_type), [])}) cl.cl_params in + let ctor_type_params = extract_param_types ctor_types in + List.iter (function {ttp_type=TInst(c,[])} -> ( match c.cl_kind with | KTypeParameter (hd :: tail) -> let before = hd :: tail in @@ -124,11 +124,11 @@ let create_static_ctor com ~empty_ctor_expr cl ctor follow_type = c.cl_kind <- KTypeParameter(after) | _ -> ()) | _ -> ()) ctor_types; - let me = alloc_var "__hx_this" (TInst(cl, List.map snd ctor_types)) in + let me = alloc_var "__hx_this" (TInst(cl, extract_param_types ctor_types)) in add_var_flag me VCaptured; let fn_args, _ = get_fun ctor.cf_type in - let ctor_params = List.map snd ctor_types in + let ctor_params = extract_param_types ctor_types in let fn_type = TFun((me.v_name,false, me.v_type) :: List.map (fun (n,o,t) -> (n,o,apply_params cl.cl_params ctor_params t)) fn_args, com.basic.tvoid) in let cur_tf_args = match ctor.cf_expr with | Some { eexpr = TFunction(tf) } -> tf.tf_args @@ -223,10 +223,10 @@ let create_static_ctor com ~empty_ctor_expr cl ctor follow_type = eexpr = TField( Texpr.Builder.make_static_this cl p, FStatic(cl, static_ctor)); - etype = apply_params static_ctor.cf_params (List.map snd cl.cl_params) static_ctor.cf_type; + etype = apply_params static_ctor.cf_params (extract_param_types cl.cl_params) static_ctor.cf_type; epos = p }, - [{ eexpr = TConst TThis; etype = TInst(cl, List.map snd cl.cl_params); epos = p }] + [{ eexpr = TConst TThis; etype = TInst(cl, extract_param_types cl.cl_params); epos = p }] @ el_args ); etype = com.basic.tvoid; @@ -250,7 +250,7 @@ let clone_ctors com ctor sup stl cl = let super_call = { eexpr = TCall( - { eexpr = TConst TSuper; etype = TInst(cl, List.map snd cl.cl_params); epos = ctor.cf_pos }, + { eexpr = TConst TSuper; etype = TInst(cl, extract_param_types cl.cl_params); epos = ctor.cf_pos }, List.map (fun (v,_) -> mk_local v ctor.cf_pos) tf_args); etype = com.basic.tvoid; epos = ctor.cf_pos; @@ -328,7 +328,7 @@ let init com (empty_ctor_type : t) (empty_ctor_expr : texpr) (follow_type : t -> ctor | None -> try - let sctor, sup, stl = prev_ctor cl (List.map snd cl.cl_params) in + let sctor, sup, stl = prev_ctor cl (extract_param_types cl.cl_params) in (* we'll make constructors that will only call super() *) let ctor = clone_ctors com sctor sup stl cl in cl.cl_constructor <- Some ctor; @@ -383,12 +383,12 @@ let init com (empty_ctor_type : t) (empty_ctor_expr : texpr) (follow_type : t -> | Some (sup,_) -> try ignore (get_last_empty sup); - let esuper = mk (TConst TSuper) (TInst (cl, List.map snd cl.cl_params)) cl.cl_pos in + let esuper = mk (TConst TSuper) (TInst (cl, extract_param_types cl.cl_params)) cl.cl_pos in [mk (TCall (esuper, [empty_ctor_expr])) basic.tvoid cl.cl_pos] with Not_found -> try (* super type is native: find super constructor with least arguments *) - let sctor, sup, stl = prev_ctor cl (List.map snd cl.cl_params) in + let sctor, sup, stl = prev_ctor cl (extract_param_types cl.cl_params) in let rec loop remaining (best,n) = match remaining with | [] -> best diff --git a/src/codegen/gencommon/realTypeParams.ml b/src/codegen/gencommon/realTypeParams.ml index e213faeacd2..f1d0ea9ea74 100644 --- a/src/codegen/gencommon/realTypeParams.ml +++ b/src/codegen/gencommon/realTypeParams.ml @@ -94,15 +94,15 @@ let rec has_type_params t = let rec follow_all_md md = let t = match md with | TClassDecl { cl_kind = KAbstractImpl a } -> - TAbstract(a, List.map snd a.a_params) + TAbstract(a, extract_param_types a.a_params) | TClassDecl c -> - TInst(c, List.map snd c.cl_params) + TInst(c, extract_param_types c.cl_params) | TEnumDecl e -> - TEnum(e, List.map snd e.e_params) + TEnum(e, extract_param_types e.e_params) | TTypeDecl t -> - TType(t, List.map snd t.t_params) + TType(t, extract_param_types t.t_params) | TAbstractDecl a -> - TAbstract(a, List.map snd a.a_params) + TAbstract(a, extract_param_types a.a_params) in Abstract.follow_with_abstracts t @@ -309,7 +309,7 @@ let set_hxgeneric gen md = if not ret then begin match md with | TClassDecl c -> - let set_hxgeneric (_,param) = match follow param with + let set_hxgeneric tp = match follow tp.ttp_type with | TInst(c,_) -> c.cl_meta <- (Meta.NativeGeneric, [], c.cl_pos) :: c.cl_meta | _ -> () @@ -397,16 +397,16 @@ struct let create_stub_casts gen cl cast_cfield = (* go through superclasses and interfaces *) let p = cl.cl_pos in - let this = { eexpr = TConst TThis; etype = (TInst(cl, List.map snd cl.cl_params)); epos = p } in + let this = { eexpr = TConst TThis; etype = (TInst(cl, extract_param_types cl.cl_params)); epos = p } in let rec loop curcls params level reverse_params = if (level <> 0 || (has_class_flag curcls CInterface) || (has_class_flag curcls CAbstract) ) && params <> [] && is_hxgeneric (TClassDecl curcls) then begin - let cparams = List.map (fun (s,t) -> (s, TInst (map_param (get_cl_t t), []))) curcls.cl_params in + let cparams = List.map (fun tp -> {tp with ttp_type=TInst (map_param (get_cl_t tp.ttp_type), [])}) curcls.cl_params in let name = get_cast_name curcls in if not (PMap.mem name cl.cl_fields) then begin let reverse_params = List.map (apply_params curcls.cl_params params) reverse_params in let cfield = mk_class_field name (TFun([], t_dynamic)) false cl.cl_pos (Method MethNormal) cparams in - let field = { eexpr = TField(this, FInstance(cl,List.map snd cl.cl_params, cast_cfield)); etype = apply_params cast_cfield.cf_params reverse_params cast_cfield.cf_type; epos = p } in + let field = { eexpr = TField(this, FInstance(cl,extract_param_types cl.cl_params, cast_cfield)); etype = apply_params cast_cfield.cf_params reverse_params cast_cfield.cf_type; epos = p } in let call = { eexpr = TCall(field, []); @@ -446,7 +446,7 @@ struct loop iface (iface_params) level (get_reverse iface iface_params); ) curcls.cl_implements in - loop cl (List.map snd cl.cl_params) 0 (List.map snd cl.cl_params) + loop cl (extract_param_types cl.cl_params) 0 (extract_param_types cl.cl_params) (* Creates a cast classfield, with the desired name @@ -460,11 +460,11 @@ struct let create_cast_cfield gen cl name = reset_temps(); let basic = gen.gcon.basic in - let cparams = List.map (fun (s,t) -> (s, TInst (map_param (get_cl_t t), []))) cl.cl_params in + let cparams = List.map (fun tp -> {tp with ttp_type = TInst (map_param (get_cl_t tp.ttp_type), [])}) cl.cl_params in let cfield = mk_class_field name (TFun([], t_dynamic)) false cl.cl_pos (Method MethNormal) cparams in - let params = List.map snd cparams in + let params = extract_param_types cparams in - let fields = get_fields gen cl (List.map snd cl.cl_params) params [] in + let fields = get_fields gen cl (extract_param_types cl.cl_params) params [] in let fields = List.filter (fun (cf,_,_) -> Type.is_physical_field cf) fields in (* now create the contents of the function *) @@ -490,7 +490,7 @@ struct let new_me_var = alloc_var "new_me" (TInst (cl, params)) in let local_new_me = mk_local new_me_var pos in - let this = mk (TConst TThis) (TInst (cl, List.map snd cl.cl_params)) pos in + let this = mk (TConst TThis) (TInst (cl, extract_param_types cl.cl_params)) pos in let field_var = alloc_var "field" basic.tstring in let local_field = mk_local field_var pos in let i_var = alloc_var "i" basic.tint in @@ -510,11 +510,11 @@ struct in List.map (fun (cf, t_cl, t_cf) -> let t_cf = follow (gen.greal_type t_cf) in - let this_field = mk (TField (this, FInstance (cl, List.map snd cl.cl_params, cf))) t_cl pos in + let this_field = mk (TField (this, FInstance (cl, extract_param_types cl.cl_params, cf))) t_cl pos in let expr = binop OpAssign - (mk (TField (local_new_me, FInstance(cl, List.map snd cl.cl_params, cf))) t_cf pos) + (mk (TField (local_new_me, FInstance(cl, extract_param_types cl.cl_params, cf))) t_cf pos) (try (Hashtbl.find gen.gtparam_cast (get_path t_cf)) this_field t_cf with Not_found -> (* if not found tparam cast, it shouldn't be a valid hxgeneric *) print_endline ("Could not find a gtparam_cast for " ^ (String.concat "." (fst (get_path t_cf)) ^ "." ^ (snd (get_path t_cf)))); @@ -551,7 +551,7 @@ struct tf_type = t_dynamic; tf_expr = mk (TBlock [ (* if (typeof(T) == typeof(T2)) return this *) - mk (TIf (mk_typehandle_cond (List.map snd cl.cl_params) params, mk_return this, None)) basic.tvoid pos; + mk (TIf (mk_typehandle_cond (extract_param_types cl.cl_params) params, mk_return this, None)) basic.tvoid pos; (* var new_me = /*special create empty with tparams construct*/ *) mk (TVar (new_me_var, Some (gen.gtools.r_create_empty cl params pos))) basic.tvoid pos; (* var fields = Reflect.fields(this); *) @@ -587,13 +587,13 @@ struct let create_static_cast_cf gen iface cf = let p = iface.cl_pos in let basic = gen.gcon.basic in - let cparams = List.map (fun (s,t) -> ("To_" ^ s, TInst (map_param (get_cl_t t), []))) cf.cf_params in + let cparams = List.map (fun tp -> {tp with ttp_name = "To_" ^ tp.ttp_name;ttp_type = TInst (map_param (get_cl_t tp.ttp_type), [])}) cf.cf_params in let me_type = TInst(iface,[]) in let cfield = mk_class_field ~static:true "__hx_cast" (TFun(["me",false,me_type], t_dynamic)) false iface.cl_pos (Method MethNormal) (cparams) in - let params = List.map snd cparams in + let params = extract_param_types cparams in let me = alloc_var "me" me_type in - let field = { eexpr = TField(mk_local me p, FInstance(iface, List.map snd iface.cl_params, cf)); etype = apply_params cf.cf_params params cf.cf_type; epos = p } in + let field = { eexpr = TField(mk_local me p, FInstance(iface, extract_param_types iface.cl_params, cf)); etype = apply_params cf.cf_params params cf.cf_type; epos = p } in let call = { eexpr = TCall(field, []); @@ -634,9 +634,9 @@ struct let implement_stub_cast cthis iface tl = let name = get_cast_name iface in if not (PMap.mem name cthis.cl_fields) then begin - let cparams = List.map (fun (s,t) -> ("To_" ^ s, TInst(map_param (get_cl_t t), []))) iface.cl_params in + let cparams = List.map (fun tp -> {tp with ttp_name = "To_" ^ tp.ttp_name;ttp_type = TInst(map_param (get_cl_t tp.ttp_type), [])}) iface.cl_params in let field = mk_class_field name (TFun([],t_dynamic)) false iface.cl_pos (Method MethNormal) cparams in - let this = { eexpr = TConst TThis; etype = TInst(cthis, List.map snd cthis.cl_params); epos = cthis.cl_pos } in + let this = { eexpr = TConst TThis; etype = TInst(cthis, extract_param_types cthis.cl_params); epos = cthis.cl_pos } in field.cf_expr <- Some { etype = TFun([],t_dynamic); epos = this.epos; diff --git a/src/codegen/gencommon/reflectionCFs.ml b/src/codegen/gencommon/reflectionCFs.ml index 0e9457aa84d..b045494ac1d 100644 --- a/src/codegen/gencommon/reflectionCFs.ml +++ b/src/codegen/gencommon/reflectionCFs.ml @@ -246,7 +246,7 @@ let switch_case ctx pos field_name = let call_super ctx fn_args ret_t cf cl this_t pos = { eexpr = TCall({ - eexpr = TField({ eexpr = TConst(TSuper); etype = this_t; epos = pos }, FInstance(cl,List.map snd cl.cl_params,cf)); + eexpr = TField({ eexpr = TConst(TSuper); etype = this_t; epos = pos }, FInstance(cl,extract_param_types cl.cl_params,cf)); etype = TFun(fun_args fn_args, ret_t); epos = pos; }, List.map (fun (v,_) -> mk_local v pos) fn_args); @@ -280,7 +280,7 @@ let enumerate_dynamic_fields ctx cl when_found base_arr = ] in - let this_t = TInst(cl, List.map snd cl.cl_params) in + let this_t = TInst(cl, extract_param_types cl.cl_params) in let this = { eexpr = TConst(TThis); etype = this_t; epos = pos } in let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in @@ -467,7 +467,7 @@ let abstract_dyn_lookup_implementation ctx this field_local hash_local may_value let get_delete_field ctx cl is_dynamic = let pos = cl.cl_pos in - let this_t = TInst(cl, List.map snd cl.cl_params) in + let this_t = TInst(cl, extract_param_types cl.cl_params) in let this = { eexpr = TConst(TThis); etype = this_t; epos = pos } in let gen = ctx.rcf_gen in let basic = gen.gcon.basic in @@ -687,7 +687,7 @@ let implement_final_lookup ctx cl = let pos = cl.cl_pos in let is_override = is_override cl in - (* let this = { eexpr = TConst(TThis); etype = TInst(cl, List.map snd cl.cl_params); epos = pos } in *) + (* let this = { eexpr = TConst(TThis); etype = TInst(cl, extract_param_types cl.cl_params); epos = pos } in *) let mk_throw str pos = let e = ctx.rcf_mk_exception str pos in @@ -806,7 +806,7 @@ let implement_get_set ctx cl = let handle_prop = alloc_var "handleProperties" basic.tbool in let handle_prop_local = mk_local handle_prop pos in - let this = { eexpr = TConst TThis; etype = TInst(cl, List.map snd cl.cl_params); epos = pos } in + let this = { eexpr = TConst TThis; etype = TInst(cl, extract_param_types cl.cl_params); epos = pos } in let mk_this_call_raw name fun_t params = { eexpr = TCall( { (mk_field_access gen this name pos) with etype = fun_t; }, params ); etype = snd (get_fun fun_t); epos = pos } in @@ -817,7 +817,7 @@ let implement_get_set ctx cl = let maybe_cast e = e in - let t = TInst(cl, List.map snd cl.cl_params) in + let t = TInst(cl, extract_param_types cl.cl_params) in (* if it's not latest hxgen class -> check super *) let mk_do_default args do_default = @@ -829,7 +829,7 @@ let implement_get_set ctx cl = fun () -> mk_return { eexpr = TCall( - { eexpr = TField({ eexpr = TConst TSuper; etype = t; epos = pos }, FInstance(cl, List.map snd cl.cl_params, cfield)); etype = !fun_type; epos = pos }, + { eexpr = TField({ eexpr = TConst TSuper; etype = t; epos = pos }, FInstance(cl, extract_param_types cl.cl_params, cfield)); etype = !fun_type; epos = pos }, (List.map (fun (v,_) -> mk_local v pos) args) ); etype = if is_float then basic.tfloat else t_dynamic; epos = pos; @@ -849,7 +849,7 @@ let implement_get_set ctx cl = in let do_field cf cf_type = - let get_field ethis = { eexpr = TField (ethis, FInstance(cl, List.map snd cl.cl_params, cf)); etype = cf_type; epos = pos } in + let get_field ethis = { eexpr = TField (ethis, FInstance(cl, extract_param_types cl.cl_params, cf)); etype = cf_type; epos = pos } in let this = { eexpr = TConst(TThis); etype = t; epos = pos } in let value_local = if is_float then match follow cf_type with | TInst({ cl_kind = KTypeParameter _ }, _) -> @@ -936,15 +936,15 @@ let implement_get_set ctx cl = eexpr = TIf( handle_prop_local, mk_this_call_raw ("get_" ^ cf.cf_name) (TFun(["value",false,cf.cf_type], cf.cf_type)) [], - Some { eexpr = TField (ethis, FInstance(cl, List.map snd cl.cl_params, cf)); etype = cf_type; epos = pos } + Some { eexpr = TField (ethis, FInstance(cl, extract_param_types cl.cl_params, cf)); etype = cf_type; epos = pos } ); etype = cf_type; epos = pos; } | Var _ - | Method MethDynamic -> { eexpr = TField (ethis, FInstance(cl,List.map snd cl.cl_params,cf)); etype = cf_type; epos = pos } + | Method MethDynamic -> { eexpr = TField (ethis, FInstance(cl,extract_param_types cl.cl_params,cf)); etype = cf_type; epos = pos } | _ -> - { eexpr = TField (this, FClosure(Some (cl,List.map snd cl.cl_params), cf)); etype = cf_type; epos = pos } + { eexpr = TField (this, FClosure(Some (cl,extract_param_types cl.cl_params), cf)); etype = cf_type; epos = pos } in let do_field cf cf_type = @@ -1077,7 +1077,7 @@ let implement_getFields ctx cl = *) let exprs = if is_override cl then - let tparams = List.map snd cl.cl_params in + let tparams = extract_param_types cl.cl_params in let esuper = mk (TConst TSuper) (TInst(cl, tparams)) pos in let efield = mk (TField (esuper, FInstance (cl, tparams, cf))) t pos in [mk (TCall (efield, [base_arr])) basic.tvoid pos] @@ -1140,7 +1140,7 @@ let implement_invokeField ctx slow_invoke cl = let all_args = field_args @ [ dynamic_arg, None ] in let fun_t = TFun(fun_args all_args, t_dynamic) in - let this_t = TInst(cl, List.map snd cl.cl_params) in + let this_t = TInst(cl, extract_param_types cl.cl_params) in let this = { eexpr = TConst(TThis); etype = this_t; epos = pos } in let mk_this_call_raw name fun_t params = @@ -1280,7 +1280,7 @@ let implement_varargs_cl ctx cl = let pos = cl.cl_pos in let gen = ctx.rcf_gen in - let this_t = TInst(cl, List.map snd cl.cl_params) in + let this_t = TInst(cl, extract_param_types cl.cl_params) in let this = { eexpr = TConst(TThis); etype = this_t ; epos = pos } in let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in @@ -1339,7 +1339,7 @@ let implement_closure_cl ctx cl = let field_args, _ = field_type_args ctx pos in let obj_arg = alloc_var "target" (TInst(ctx.rcf_object_iface, [])) in - let this_t = TInst(cl, List.map snd cl.cl_params) in + let this_t = TInst(cl, extract_param_types cl.cl_params) in let this = { eexpr = TConst(TThis); etype = this_t ; epos = pos } in let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in diff --git a/src/codegen/gencommon/renameTypeParameters.ml b/src/codegen/gencommon/renameTypeParameters.ml index 2383da1d491..3ec5b2f104e 100644 --- a/src/codegen/gencommon/renameTypeParameters.ml +++ b/src/codegen/gencommon/renameTypeParameters.ml @@ -47,16 +47,16 @@ let run types = | _ -> Globals.die "" __LOC__ in - let iter_types (nt,t) = - let cls = get_cls t in + let iter_types tp = + let cls = get_cls tp.ttp_type in let orig = cls.cl_path in check_type (snd orig) (fun name -> cls.cl_path <- (fst orig, name)) in let save_params save params = - List.fold_left (fun save (_,t) -> - let cls = get_cls t in - (cls.cl_path,t) :: save) save params + List.fold_left (fun save tp -> + let cls = get_cls tp.ttp_type in + (cls.cl_path,tp.ttp_type) :: save) save params in List.iter (function diff --git a/src/codegen/genxml.ml b/src/codegen/genxml.ml index 95824dcc821..79ead614f1f 100644 --- a/src/codegen/genxml.ml +++ b/src/codegen/genxml.ml @@ -157,7 +157,7 @@ and gen_field att f = in att,get_value_meta f.cf_meta ) in - let att = (match f.cf_params with [] -> att | l -> ("params", String.concat ":" (List.map (fun (n,_) -> n) l)) :: att) in + let att = (match f.cf_params with [] -> att | l -> ("params", String.concat ":" (List.map extract_param_name l)) :: att) in let overloads = match List.map (gen_field []) f.cf_overloads with | [] -> [] | nl -> [node "overloads" [] nl] @@ -200,7 +200,7 @@ let gen_type_params ipos priv path params pos m = let mpriv = (if priv then [("private","1")] else []) in let mpath = (if m.m_path <> path then [("module",snd (gen_path m.m_path false))] else []) in let file = (if ipos && pos <> null_pos then [("file",pos.pfile)] else []) in - gen_path path priv :: ("params", String.concat ":" (List.map fst params)) :: (file @ mpriv @ mpath) + gen_path path priv :: ("params", String.concat ":" (List.map extract_param_name params)) :: (file @ mpriv @ mpath) let gen_class_path name (c,pl) = node name [("path",s_type_path (tpath (TClassDecl c)))] (List.map gen_type pl) diff --git a/src/codegen/java.ml b/src/codegen/java.ml index 3554a507430..3f8768b1824 100644 --- a/src/codegen/java.ml +++ b/src/codegen/java.ml @@ -192,6 +192,7 @@ let convert_param ctx p parent param = tp_name = jname_to_hx name,null_pos; tp_params = []; tp_constraints = convert_constraints ctx p constraints; + tp_default = None; tp_meta = []; } @@ -373,6 +374,7 @@ let convert_java_enum ctx p pe = tp_name = name,null_pos; tp_params = []; tp_constraints = convert_constraints ctx p (ext :: impl); + tp_default = None; tp_meta = []; } | (name, None, impl) -> @@ -380,6 +382,7 @@ let convert_java_enum ctx p pe = tp_name = name,null_pos; tp_params = []; tp_constraints = convert_constraints ctx p impl; + tp_default = None; tp_meta = []; } ) field.jf_types in diff --git a/src/codegen/javaModern.ml b/src/codegen/javaModern.ml index 5372227b843..13cc53172f3 100644 --- a/src/codegen/javaModern.ml +++ b/src/codegen/javaModern.ml @@ -720,9 +720,10 @@ module Converter = struct tp_name = (name,p); tp_params = []; tp_meta = []; + tp_default = None; tp_constraints = match constraints with | [] -> None - | _ -> Some (CTIntersection constraints,p) + | _ -> Some (CTIntersection constraints,p); } in tp diff --git a/src/codegen/overloads.ml b/src/codegen/overloads.ml index 4f537062724..a2055e10d2e 100644 --- a/src/codegen/overloads.ml +++ b/src/codegen/overloads.ml @@ -12,14 +12,14 @@ let same_overload_args ?(get_vmtype) t1 t2 f1 f2 = let rec loop params1 params2 = match params1,params2 with | [],[] -> true - | (n1,t1) :: params1,(n2,t2) :: params2 -> + | tp1 :: params1,tp2 :: params2 -> let constraints_equal t1 t2 = match follow t1,t2 with | TInst({cl_kind = KTypeParameter tl1},_),TInst({cl_kind = KTypeParameter tl2},_) -> Ast.safe_for_all2 f_eq tl1 tl2 | _ -> false in - n1 = n2 && constraints_equal t1 t2 && loop params1 params2 + tp1.ttp_name = tp2.ttp_name && constraints_equal tp1.ttp_type tp2.ttp_type && loop params1 params2 | [],_ | _,[] -> false @@ -39,7 +39,7 @@ let same_overload_args ?(get_vmtype) t1 t2 f1 f2 = loop tl1 tl2 in let compare_types () = - let t1 = follow (apply_params f1.cf_params (List.map (fun (_,t) -> t) f2.cf_params) t1) in + let t1 = follow (apply_params f1.cf_params (extract_param_types f2.cf_params) t1) in match t1,follow t2 with | TFun(tl1,_),TFun(tl2,_) -> compare_arguments tl1 tl2 diff --git a/src/context/abstractCast.ml b/src/context/abstractCast.ml index 144f7fed920..c5c20a51337 100644 --- a/src/context/abstractCast.ml +++ b/src/context/abstractCast.ml @@ -122,7 +122,7 @@ let find_array_access_raise ctx a pl e1 e2o p = let monos = List.map (fun _ -> spawn_monomorph ctx p) cf.cf_params in let map t = apply_params a.a_params pl (apply_params cf.cf_params monos t) in let check_constraints () = - List.iter2 (fun m (name,t) -> match follow t with + List.iter2 (fun m tp -> match follow tp.ttp_type with | TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] -> List.iter (fun tc -> match follow m with TMono _ -> raise (Unify_error []) | _ -> Type.unify m (map tc) ) constr | _ -> () diff --git a/src/context/display/displayEmitter.ml b/src/context/display/displayEmitter.ml index 0b7bc5d9bee..08c3ea3d19b 100644 --- a/src/context/display/displayEmitter.ml +++ b/src/context/display/displayEmitter.ml @@ -121,7 +121,7 @@ let display_field ctx origin scope cf p = match ctx.com.display.dms_kind with cf in let cf = match origin,scope,follow cf.cf_type with - | Self (TClassDecl c),CFSConstructor,TFun(tl,_) -> {cf with cf_type = TFun(tl,TInst(c,List.map snd c.cl_params))} + | Self (TClassDecl c),CFSConstructor,TFun(tl,_) -> {cf with cf_type = TFun(tl,TInst(c,extract_param_types c.cl_params))} | _ -> cf in let ct = CompletionType.from_type (get_import_status ctx) ~values:(get_value_meta cf.cf_meta) cf.cf_type in diff --git a/src/context/display/displayFields.ml b/src/context/display/displayFields.ml index cb83cd0e3d8..17f7ff90cf8 100644 --- a/src/context/display/displayFields.ml +++ b/src/context/display/displayFields.ml @@ -56,7 +56,7 @@ let collect_static_extensions ctx items e p = | TFun((_,_,t) :: args, ret) -> begin try let e = TyperBase.unify_static_extension ctx {e with etype = dup e.etype} t p in - List.iter2 (fun m (name,t) -> match follow t with + List.iter2 (fun m tp -> match follow tp.ttp_type with | TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] -> List.iter (fun tc -> unify_raise ctx m (map tc) e.epos) constr | _ -> () diff --git a/src/context/display/displayTexpr.ml b/src/context/display/displayTexpr.ml index e7a686d1ad1..b4738c3f827 100644 --- a/src/context/display/displayTexpr.ml +++ b/src/context/display/displayTexpr.ml @@ -77,7 +77,7 @@ let check_display_class ctx cc cfile c = List.iter check_field c.cl_ordered_statics; | _ -> let sc = find_class_by_position cfile c.cl_name_pos in - ignore(Typeload.type_type_params ctx c.cl_path (fun() -> c.cl_params) null_pos sc.d_params); + ignore(Typeload.type_type_params ctx TPHType c.cl_path (fun() -> c.cl_params) null_pos sc.d_params); List.iter (function | (HExtends(ct,p) | HImplements(ct,p)) when display_position#enclosed_in p -> ignore(Typeload.load_instance ~allow_display:true ctx (ct,p) false) @@ -91,22 +91,22 @@ let check_display_class ctx cc cfile c = let check_display_enum ctx cc cfile en = let se = find_enum_by_position cfile en.e_name_pos in - ignore(Typeload.type_type_params ctx en.e_path (fun() -> en.e_params) null_pos se.d_params); + ignore(Typeload.type_type_params ctx TPHType en.e_path (fun() -> en.e_params) null_pos se.d_params); PMap.iter (fun _ ef -> if display_position#enclosed_in ef.ef_pos then begin let sef = find_enum_field_by_position se ef.ef_name_pos in - ignore(TypeloadModule.load_enum_field ctx en (TEnum (en,List.map snd en.e_params)) (ref false) (ref 0) sef) + ignore(TypeloadModule.load_enum_field ctx en (TEnum (en,extract_param_types en.e_params)) (ref false) (ref 0) sef) end ) en.e_constrs let check_display_typedef ctx cc cfile td = let st = find_typedef_by_position cfile td.t_name_pos in - ignore(Typeload.type_type_params ctx td.t_path (fun() -> td.t_params) null_pos st.d_params); + ignore(Typeload.type_type_params ctx TPHType td.t_path (fun() -> td.t_params) null_pos st.d_params); ignore(Typeload.load_complex_type ctx true st.d_data) let check_display_abstract ctx cc cfile a = let sa = find_abstract_by_position cfile a.a_name_pos in - ignore(Typeload.type_type_params ctx a.a_path (fun() -> a.a_params) null_pos sa.d_params); + ignore(Typeload.type_type_params ctx TPHType a.a_path (fun() -> a.a_params) null_pos sa.d_params); List.iter (function | (AbOver(ct,p) | AbFrom(ct,p) | AbTo(ct,p)) when display_position#enclosed_in p -> ignore(Typeload.load_complex_type ctx true (ct,p)) diff --git a/src/context/display/displayToplevel.ml b/src/context/display/displayToplevel.ml index 840d259b990..0d140625729 100644 --- a/src/context/display/displayToplevel.ml +++ b/src/context/display/displayToplevel.ml @@ -329,7 +329,7 @@ let collect ctx tk with_type sort = in (* member fields *) if ctx.curfun <> FunStatic then begin - let all_fields = Type.TClass.get_all_fields ctx.curclass (List.map snd ctx.curclass.cl_params) in + let all_fields = Type.TClass.get_all_fields ctx.curclass (extract_param_types ctx.curclass.cl_params) in PMap.iter (fun _ (c,cf) -> let origin = if c == ctx.curclass then Self (TClassDecl c) else Parent (TClassDecl c) in maybe_add_field CFSMember origin cf @@ -424,7 +424,7 @@ let collect ctx tk with_type sort = add (make_ci_literal "false" (tpair ctx.com.basic.tbool)) (Some "false"); begin match ctx.curfun with | FunMember | FunConstructor | FunMemberClassLocal -> - let t = TInst(ctx.curclass,List.map snd ctx.curclass.cl_params) in + let t = TInst(ctx.curclass,extract_param_types ctx.curclass.cl_params) in add (make_ci_literal "this" (tpair t)) (Some "this"); begin match ctx.curclass.cl_super with | Some(c,tl) -> add (make_ci_literal "super" (tpair (TInst(c,tl)))) (Some "super") @@ -448,9 +448,9 @@ let collect ctx tk with_type sort = end; (* type params *) - List.iter (fun (s,t) -> match follow t with + List.iter (fun tp -> match follow tp.ttp_type with | TInst(c,_) -> - add (make_ci_type_param c (tpair t)) (Some (snd c.cl_path)) + add (make_ci_type_param c (tpair tp.ttp_type)) (Some (snd c.cl_path)) | _ -> die "" __LOC__ ) ctx.type_params; diff --git a/src/context/typecore.ml b/src/context/typecore.ml index a551c878ed0..e27d074eb22 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -92,7 +92,7 @@ type typer_globals = { do_load_module : typer -> path -> pos -> module_def; do_load_type_def : typer -> pos -> type_path -> module_type; do_optimize : typer -> texpr -> texpr; - do_build_instance : typer -> module_type -> pos -> ((string * t) list * path * (t list -> t)); + do_build_instance : typer -> module_type -> pos -> (typed_type_param list * path * (t list -> t)); do_format_string : typer -> string -> pos -> Ast.expr; do_finalize : typer -> unit; do_generate : typer -> (texpr option * module_type list * module_def list); @@ -117,7 +117,7 @@ and typer = { (* per-class *) mutable curclass : tclass; mutable tthis : t; - mutable type_params : (string * t) list; + mutable type_params : type_params; mutable get_build_infos : unit -> (module_type * t list * class_field list) option; (* per-function *) mutable curfield : tclass_field; @@ -562,7 +562,7 @@ let prepare_using_field cf = match follow cf.cf_type with | TFun((_,_,tf) :: args,ret) -> let rec loop acc overloads = match overloads with | ({cf_type = TFun((_,_,tfo) :: args,ret)} as cfo) :: l -> - let tfo = apply_params cfo.cf_params (List.map snd cfo.cf_params) tfo in + let tfo = apply_params cfo.cf_params (extract_param_types cfo.cf_params) tfo in (* ignore overloads which have a different first argument *) if type_iseq tf tfo then loop ({cfo with cf_type = TFun(args,ret)} :: acc) l else loop acc l | _ :: l -> diff --git a/src/core/abstract.ml b/src/core/abstract.ml index 1a11e1eba03..409fe735f97 100644 --- a/src/core/abstract.ml +++ b/src/core/abstract.ml @@ -88,9 +88,9 @@ let rec find_multitype_params a pl = loop (fun t -> t) e ) el; let definitive_types = ref [] in - let tl = List.map2 (fun (n,_) t -> + let tl = List.map2 (fun tp t -> try - let t = (Hashtbl.find relevant n) t in + let t = (Hashtbl.find relevant tp.ttp_name) t in definitive_types := t :: !definitive_types; t with Not_found -> diff --git a/src/core/ast.ml b/src/core/ast.ml index 0417c04d1bd..9293aa1b627 100644 --- a/src/core/ast.ml +++ b/src/core/ast.ml @@ -233,6 +233,7 @@ and type_param = { tp_name : placed_name; tp_params : type_param list; tp_constraints : type_hint option; + tp_default : type_hint option; tp_meta : metadata; } @@ -693,8 +694,9 @@ let map_expr loop (e,p) = ),p and tparamdecl t = let constraints = opt type_hint t.tp_constraints in + let default = opt type_hint t.tp_default in let params = List.map tparamdecl t.tp_params in - { tp_name = t.tp_name; tp_constraints = constraints; tp_params = params; tp_meta = t.tp_meta } + { tp_name = t.tp_name; tp_constraints = constraints; tp_default = default; tp_params = params; tp_meta = t.tp_meta } and func f = let params = List.map tparamdecl f.f_params in let args = List.map (fun (n,o,m,t,e) -> diff --git a/src/core/display/completionItem.ml b/src/core/display/completionItem.ml index 26c1dc15b05..bcac02ff167 100644 --- a/src/core/display/completionItem.ml +++ b/src/core/display/completionItem.ml @@ -214,7 +214,7 @@ module CompletionModuleType = struct false,false,false,kind,ctor | TAbstractDecl a -> let kind = if a.a_enum then EnumAbstract else Abstract in - let is_extern,is_final,is_abstract,ctor = match Abstract.follow_with_forward_ctor (TAbstract(a,List.map snd a.a_params)) with + let is_extern,is_final,is_abstract,ctor = match Abstract.follow_with_forward_ctor (TAbstract(a,extract_param_types a.a_params)) with | TInst(c,_) -> let is_extern,is_final,is_abstract,_,ctor = ctor_info (TClassDecl c) in is_extern,is_final,is_abstract,ctor | TAbstract(a,_) -> false,false,false,actor a | _ -> false,false,false,No @@ -223,11 +223,12 @@ module CompletionModuleType = struct in let is_extern,is_final,is_abstract,kind,ctor = ctor_info mt in let infos = t_infos mt in - let convert_type_param (s,t) = match follow t with + let convert_type_param tp = match follow tp.ttp_type with | TInst(c,_) -> { - tp_name = s,null_pos; + tp_name = tp.ttp_name,null_pos; tp_params = []; tp_constraints = None; (* TODO? *) + tp_default = None; (* TODO? *) tp_meta = c.cl_meta } | _ -> diff --git a/src/core/json/genjson.ml b/src/core/json/genjson.ml index e41b9351fc1..3bcce36e048 100644 --- a/src/core/json/genjson.ml +++ b/src/core/json/genjson.ml @@ -274,14 +274,15 @@ and generate_type_path_with_params ctx mpath tpath tl meta = (* type parameter *) -and generate_type_parameter ctx (s,t) = - let generate_constraints () = match follow t with +and generate_type_parameter ctx tp = + let generate_constraints () = match follow tp.ttp_type with | TInst({cl_kind = KTypeParameter tl},_) -> generate_types ctx tl | _ -> die "" __LOC__ in jobject [ - "name",jstring s; + "name",jstring tp.ttp_name; "constraints",generate_constraints (); + "defaultType",jopt (generate_type ctx) tp.ttp_default; ] (* texpr *) diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index 257b55dc27f..45c37cec83c 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -344,8 +344,8 @@ let apply_params ?stack cparams params t = let rec loop l1 l2 = match l1, l2 with | [] , [] -> [] - | (x,TLazy f) :: l1, _ -> loop ((x,lazy_type f) :: l1) l2 - | (_,t1) :: l1 , t2 :: l2 -> (t1,t2) :: loop l1 l2 + | {ttp_type = TLazy f} as tp :: l1, _ -> loop ({tp with ttp_type = lazy_type f} :: l1) l2 + | tp :: l1 , t2 :: l2 -> (tp.ttp_type,t2) :: loop l1 l2 | _ -> die "" __LOC__ in let subst = loop cparams params in @@ -610,11 +610,29 @@ let concat e1 e2 = ) in mk e e2.etype (punion e1.epos e2.epos) +let extract_param_type tp = tp.ttp_type +let extract_param_types = List.map extract_param_type +let extract_param_name tp = tp.ttp_name +let lookup_param n l = + let rec loop l = match l with + | [] -> + raise Not_found + | tp :: l -> + if n = tp.ttp_name then tp.ttp_type else loop l + in + loop l + +let mk_type_param n t def = { + ttp_name = n; + ttp_type = t; + ttp_default = def; +} + let type_of_module_type = function - | TClassDecl c -> TInst (c,List.map snd c.cl_params) - | TEnumDecl e -> TEnum (e,List.map snd e.e_params) - | TTypeDecl t -> TType (t,List.map snd t.t_params) - | TAbstractDecl a -> TAbstract (a,List.map snd a.a_params) + | TClassDecl c -> TInst (c,extract_param_types c.cl_params) + | TEnumDecl e -> TEnum (e,extract_param_types e.e_params) + | TTypeDecl t -> TType (t,extract_param_types t.t_params) + | TAbstractDecl a -> TAbstract (a,extract_param_types a.a_params) let rec module_type_of_type = function | TInst(c,_) -> TClassDecl c diff --git a/src/core/tOther.ml b/src/core/tOther.ml index 4dd5134b1f4..e68e0b5ddb5 100644 --- a/src/core/tOther.ml +++ b/src/core/tOther.ml @@ -263,7 +263,7 @@ module TClass = struct loop PMap.empty c0 tl let get_all_super_fields c = - get_member_fields' false c (List.map snd c.cl_params) + get_member_fields' false c (extract_param_types c.cl_params) let get_all_fields c tl = get_member_fields' true c tl diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml index c02ddaea6f6..286dcee8373 100644 --- a/src/core/tPrinting.ml +++ b/src/core/tPrinting.ml @@ -487,11 +487,17 @@ module Printer = struct let s_metadata metadata = s_list " " s_metadata_entry metadata - let s_type_param (s,t) = match follow t with + let s_type_param tp = match follow tp.ttp_type with | TInst({cl_kind = KTypeParameter tl1},tl2) -> - begin match tl1 with - | [] -> s - | _ -> Printf.sprintf "%s:%s" s (String.concat " & " (List.map s_type tl1)) + let s = match tl1 with + | [] -> tp.ttp_name + | _ -> Printf.sprintf "%s:%s" tp.ttp_name (String.concat " & " (List.map s_type tl1)) + in + begin match tp.ttp_default with + | None -> + s + | Some t -> + Printf.sprintf "%s = %s" s (s_type t) end | _ -> die "" __LOC__ diff --git a/src/core/tType.ml b/src/core/tType.ml index c305274f637..82ca94fac19 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -77,7 +77,13 @@ and tsignature = (string * bool * t) list * t and tparams = t list -and type_params = (string * t) list +and typed_type_param = { + ttp_name : string; + ttp_type : t; + ttp_default : t option; +} + +and type_params = typed_type_param list and tconstant = | TInt of int32 diff --git a/src/core/tUnification.ml b/src/core/tUnification.ml index c7b7621454e..38dd2b82018 100644 --- a/src/core/tUnification.ml +++ b/src/core/tUnification.ml @@ -260,9 +260,9 @@ module Monomorph = struct let spawn_constrained_monos map params = let checks = DynArray.create () in - let monos = List.map (fun (s,t) -> + let monos = List.map (fun tp -> let mono = create () in - begin match follow t with + begin match follow tp.ttp_type with | TInst ({ cl_kind = KTypeParameter constr; cl_path = path },_) when constr <> [] -> DynArray.add checks (mono,constr,s_type_path path) | _ -> diff --git a/src/filters/filters.ml b/src/filters/filters.ml index 2e1453951f0..80f2c7879c3 100644 --- a/src/filters/filters.ml +++ b/src/filters/filters.ml @@ -469,7 +469,7 @@ let add_rtti ctx t = (* Adds member field initializations as assignments to the constructor *) let add_field_inits locals ctx t = let apply c = - let ethis = mk (TConst TThis) (TInst (c,List.map snd c.cl_params)) c.cl_pos in + let ethis = mk (TConst TThis) (TInst (c,extract_param_types c.cl_params)) c.cl_pos in (* TODO: we have to find a variable name which is not used in any of the functions *) let v = alloc_var VGenerated "_g" ethis.etype ethis.epos in let need_this = ref false in @@ -486,7 +486,7 @@ let add_field_inits locals ctx t = match cf.cf_expr with | None -> die "" __LOC__ | Some e -> - let lhs = mk (TField({ ethis with epos = cf.cf_pos },FInstance (c,List.map snd c.cl_params,cf))) cf.cf_type cf.cf_pos in + let lhs = mk (TField({ ethis with epos = cf.cf_pos },FInstance (c,extract_param_types c.cl_params,cf))) cf.cf_type cf.cf_pos in cf.cf_expr <- None; mk (TBinop(OpAssign,lhs,e)) cf.cf_type e.epos ) inits in diff --git a/src/filters/filtersCommon.ml b/src/filters/filtersCommon.ml index c29bdb2006d..9bf69cd94bc 100644 --- a/src/filters/filtersCommon.ml +++ b/src/filters/filtersCommon.ml @@ -26,7 +26,7 @@ let rec is_removable_class c = (match c.cl_super with | Some (c,_) -> is_removable_class c | _ -> false) || - List.exists (fun (_,t) -> match follow t with + List.exists (fun tp -> match follow tp.ttp_type with | TInst(c,_) -> has_ctor_constraint c || Meta.has Meta.Const c.cl_meta | _ -> diff --git a/src/generators/gencs.ml b/src/generators/gencs.ml index 4126a8ab601..77b86683579 100644 --- a/src/generators/gencs.ml +++ b/src/generators/gencs.ml @@ -158,7 +158,7 @@ let get_overloads_for_optional_args gen cl cf is_static = | [],Method (MethNormal | MethDynamic | MethInline) -> (match cf.cf_expr, follow cf.cf_type with | Some ({ eexpr = TFunction fn } as method_expr), TFun (args, return_type) -> - let type_params = List.map snd cl.cl_params in + let type_params = extract_param_types cl.cl_params in let rec collect_overloads tf_args_rev args_rev default_values_rev = match tf_args_rev, args_rev with | (_, Some default_value) :: rest_tf_args_rev, _ :: rest_args_rev -> @@ -2013,12 +2013,12 @@ let generate con = let combination_error c1 c2 = gen.gcon.error ("The " ^ (get_constraint c1) ^ " constraint cannot be combined with the " ^ (get_constraint c2) ^ " constraint.") cl.cl_pos in - let params = sprintf "<%s>" (String.concat ", " (List.map (fun (_, tcl) -> get_param_name tcl) cl_params)) in + let params = sprintf "<%s>" (String.concat ", " (List.map (fun tp -> get_param_name tp.ttp_type) cl_params)) in let params_extends = if hxgen || not (Meta.has (Meta.NativeGen) cl.cl_meta) then [""] else - List.fold_left (fun acc (name, t) -> + List.fold_left (fun acc {ttp_name=name;ttp_type=t} -> match run_follow gen t with | TInst({cl_kind = KTypeParameter constraints}, _) when constraints <> [] -> (* base class should come before interface constraints *) @@ -2327,7 +2327,7 @@ let generate con = let modifiers = if is_abstract then "abstract" :: modifiers else modifiers in let visibility, is_virtual = if is_explicit_iface then "",false else if visibility = "private" then "private",false else visibility, is_virtual in let v_n = if is_static then "static" else if is_override && not is_interface then "override" else if is_virtual then "virtual" else "" in - let cf_type = if is_override && not is_overload && not (has_class_field_flag cf CfOverload) then match field_access gen (TInst(cl, List.map snd cl.cl_params)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> die "" __LOC__ else cf.cf_type in + let cf_type = if is_override && not is_overload && not (has_class_field_flag cf CfOverload) then match field_access gen (TInst(cl, extract_param_types cl.cl_params)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> die "" __LOC__ else cf.cf_type in let ret_type, args = match follow cf_type with | TFun (strbtl, t) -> (t, strbtl) | _ -> die "" __LOC__ in gen_nocompletion w cf.cf_meta; @@ -2568,7 +2568,7 @@ let generate con = let this = if static then make_static_this cl f.cf_pos else - { eexpr = TConst TThis; etype = TInst(cl,List.map snd cl.cl_params); epos = f.cf_pos } + { eexpr = TConst TThis; etype = TInst(cl,extract_param_types cl.cl_params); epos = f.cf_pos } in print w "public %s%s %s" (if static then "static " else "") (t_s f.cf_type) (Dotnet.netname_to_hx f.cf_name); begin_block w; @@ -2755,11 +2755,11 @@ let generate con = let events, nonprops = !events, !nonprops in - let t = TInst(cl, List.map snd cl.cl_params) in + let t = TInst(cl, extract_param_types cl.cl_params) in let find_prop name = try List.assoc name !props with | Not_found -> match field_access gen t name with - | FClassField (_,_,decl,v,_,t,_) when is_extern_prop (TInst(cl,List.map snd cl.cl_params)) name -> + | FClassField (_,_,decl,v,_,t,_) when is_extern_prop (TInst(cl,extract_param_types cl.cl_params)) name -> let ret = ref (v,t,None,None) in props := (name, ret) :: !props; ret diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml index 2b21d1b4f62..917f8647690 100644 --- a/src/generators/genhl.ml +++ b/src/generators/genhl.ml @@ -355,7 +355,7 @@ let make_debug ctx arr = let fake_tnull = {null_abstract with a_path = [],"Null"; - a_params = ["T",t_dynamic]; + a_params = [{ttp_name = "T"; ttp_type = t_dynamic; ttp_default = None}]; } let get_rec_cache ctx t none_callback not_found_callback = @@ -395,7 +395,7 @@ let rec to_type ?tref ctx t = | TAnon a when (match !(a.a_status) with Statics _ | EnumStatics _ -> true | _ -> false) -> (match !(a.a_status) with | Statics c -> - class_type ctx c (List.map snd c.cl_params) true + class_type ctx c (extract_param_types c.cl_params) true | EnumStatics e -> enum_class ctx e | _ -> die "" __LOC__) @@ -761,7 +761,7 @@ and alloc_global ctx name t = and class_global ?(resolve=true) ctx c = let static = c != ctx.base_class in let c = if resolve && is_array_type (HObj { null_proto with pname = s_type_path c.cl_path }) then ctx.array_impl.abase else c in - let c = resolve_class ctx c (List.map snd c.cl_params) static in + let c = resolve_class ctx c (extract_param_types c.cl_params) static in let t = class_type ctx c [] static in alloc_global ctx ("$" ^ s_type_path c.cl_path) t, t @@ -3346,7 +3346,7 @@ let rec generate_member ctx c f = | Method m -> let gen_content = if f.cf_name <> "new" then None else Some (fun() -> - let o = (match class_type ctx c (List.map snd c.cl_params) false with + let o = (match class_type ctx c (extract_param_types c.cl_params) false with | HObj o | HStruct o -> o | _ -> die "" __LOC__ ) in @@ -3388,8 +3388,8 @@ let rec generate_member ctx c f = if f.cf_name = "toString" && not (has_class_field_flag f CfOverride) && not (PMap.mem "__string" c.cl_fields) && is_to_string f.cf_type then begin let p = f.cf_pos in (* function __string() return this.toString().bytes *) - let ethis = mk (TConst TThis) (TInst (c,List.map snd c.cl_params)) p in - let tstr = mk (TCall (mk (TField (ethis,FInstance(c,List.map snd c.cl_params,f))) f.cf_type p,[])) ctx.com.basic.tstring p in + let ethis = mk (TConst TThis) (TInst (c,extract_param_types c.cl_params)) p in + let tstr = mk (TCall (mk (TField (ethis,FInstance(c,extract_param_types c.cl_params,f))) f.cf_type p,[])) ctx.com.basic.tstring p in let cstr, cf_bytes = (try (match ctx.com.basic.tstring with TInst(c,_) -> c, PMap.find "bytes" c.cl_fields | _ -> die "" __LOC__) with Not_found -> die "" __LOC__) in let estr = mk (TReturn (Some (mk (TField (tstr,FInstance (cstr,[],cf_bytes))) cf_bytes.cf_type p))) ctx.com.basic.tvoid p in ignore(make_fun ctx (s_type_path c.cl_path,"__string") (alloc_fun_path ctx c.cl_path "__string") { tf_expr = estr; tf_args = []; tf_type = cf_bytes.cf_type; } (Some c) None) @@ -3448,7 +3448,7 @@ let generate_static_init ctx types main = let g, ct = class_global ~resolve:false ctx c in let ctype = if c == ctx.array_impl.abase then ctx.array_impl.aall else c in - let t = class_type ctx ctype (List.map snd ctype.cl_params) false in + let t = class_type ctx ctype (extract_param_types ctype.cl_params) false in let index name = match ct with diff --git a/src/generators/genhxold.ml b/src/generators/genhxold.ml index fced695323a..a96e3c599b4 100644 --- a/src/generators/genhxold.ml +++ b/src/generators/genhxold.ml @@ -198,7 +198,7 @@ let generate_type com t = | _ -> die "" __LOC__ ) in - let tparams = (match f.cf_params with [] -> "" | l -> "<" ^ String.concat "," (List.map fst l) ^ ">") in + let tparams = (match f.cf_params with [] -> "" | l -> "<" ^ String.concat "," (List.map extract_param_name l) ^ ">") in p "function %s%s(%s) : %s" name tparams (String.concat ", " (List.map sparam params)) (stype ret); ); p ";\n"; @@ -208,7 +208,7 @@ let generate_type com t = | TClassDecl c -> print_meta c.cl_meta; let finalmod = if (has_class_flag c CFinal) then "final " else "" in - p "extern %s%s %s" finalmod (if (has_class_flag c CInterface) then "interface" else "class") (stype (TInst (c,List.map snd c.cl_params))); + p "extern %s%s %s" finalmod (if (has_class_flag c CInterface) then "interface" else "class") (stype (TInst (c,extract_param_types c.cl_params))); let ext = (match c.cl_super with | None -> [] | Some (c,pl) -> [" extends " ^ stype (TInst (c,pl))] @@ -249,7 +249,7 @@ let generate_type com t = p "}\n"; | TEnumDecl e -> print_meta e.e_meta; - p "extern enum %s {\n" (stype (TEnum(e,List.map snd e.e_params))); + p "extern enum %s {\n" (stype (TEnum(e,extract_param_types e.e_params))); List.iter (fun n -> let c = PMap.find n e.e_constrs in p "\t%s" c.ef_name; @@ -261,7 +261,7 @@ let generate_type com t = p "}\n" | TTypeDecl t -> print_meta t.t_meta; - p "typedef %s = " (stype (TType (t,List.map snd t.t_params))); + p "typedef %s = " (stype (TType (t,extract_param_types t.t_params))); p "%s" (stype t.t_type); p "\n"; | TAbstractDecl a -> @@ -270,7 +270,7 @@ let generate_type com t = p "extern "; let is_enum = a.a_enum in if is_enum then p "enum "; - p "abstract %s" (stype (TAbstract (a,List.map snd a.a_params))); + p "abstract %s" (stype (TAbstract (a,extract_param_types a.a_params))); if not (Meta.has Meta.CoreType a.a_meta) then p "(%s)" (stype a.a_this); p " {\n"; Option.may (fun c -> diff --git a/src/generators/genjava.ml b/src/generators/genjava.ml index b1bee10d600..d11e9864954 100644 --- a/src/generators/genjava.ml +++ b/src/generators/genjava.ml @@ -1909,8 +1909,8 @@ let generate con = | [] -> ("","") | _ -> - let params = sprintf "<%s>" (String.concat ", " (List.map (fun (_, tcl) -> match follow tcl with | TInst(cl, _) -> snd cl.cl_path | _ -> die "" __LOC__) cl_params)) in - let params_extends = List.fold_left (fun acc (name, t) -> + let params = sprintf "<%s>" (String.concat ", " (List.map (fun tp -> match follow tp.ttp_type with | TInst(cl, _) -> snd cl.cl_path | _ -> die "" __LOC__) cl_params)) in + let params_extends = List.fold_left (fun acc {ttp_name=name;ttp_type=t} -> match run_follow gen t with | TInst (cl, p) -> (match cl.cl_implements with @@ -2001,9 +2001,9 @@ let generate con = let modifiers = if is_abstract then "abstract" :: modifiers else modifiers in let visibility, is_virtual = if is_explicit_iface then "",false else visibility, is_virtual in let v_n = if is_static then "static" else if is_override && not is_interface then "" else if not is_virtual then "final" else "" in - let cf_type = if is_override && not is_overload && not (has_class_field_flag cf CfOverload) then match field_access gen (TInst(cl, List.map snd cl.cl_params)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> die "" __LOC__ else cf.cf_type in + let cf_type = if is_override && not is_overload && not (has_class_field_flag cf CfOverload) then match field_access gen (TInst(cl, extract_param_types cl.cl_params)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> die "" __LOC__ else cf.cf_type in - let params = List.map snd cl.cl_params in + let params = extract_param_types cl.cl_params in let ret_type, args, has_rest_args = match follow cf_type, follow cf.cf_type with | TFun (strbtl, t), TFun(rargs, _) -> let ret_type = apply_params cl.cl_params params (real_type t) diff --git a/src/generators/genjvm.ml b/src/generators/genjvm.ml index 8b1ee685744..c49566a4713 100644 --- a/src/generators/genjvm.ml +++ b/src/generators/genjvm.ml @@ -2268,7 +2268,7 @@ class tclass_to_jvm gctx c = object(self) | None -> () end else begin - let _,_,cf_super = raw_class_field (fun cf -> cf.cf_type) c_sup (List.map snd c_sup.cl_params) cf.cf_name in + let _,_,cf_super = raw_class_field (fun cf -> cf.cf_type) c_sup (extract_param_types c_sup.cl_params) cf.cf_name in compare_fields cf cf_super end in @@ -2428,8 +2428,8 @@ class tclass_to_jvm gctx c = object(self) | [] when c.cl_params = [] -> () | _ -> - let stl = String.concat "" (List.map (fun (n,_) -> - Printf.sprintf "%s:Ljava/lang/Object;" n + let stl = String.concat "" (List.map (fun tp -> + Printf.sprintf "%s:Ljava/lang/Object;" tp.ttp_name ) cf.cf_params) in let ssig = generate_method_signature true (jsignature_of_type gctx cf.cf_type) in let s = if cf.cf_params = [] then ssig else Printf.sprintf "<%s>%s" stl ssig in @@ -2463,7 +2463,7 @@ class tclass_to_jvm gctx c = object(self) default e; end; | Some e when mtype <> MStatic -> - let tl = List.map snd c.cl_params in + let tl = extract_param_types c.cl_params in let ethis = mk (TConst TThis) (TInst(c,tl)) null_pos in let efield = mk (TField(ethis,FInstance(c,tl,cf))) cf.cf_type null_pos in let eop = mk (TBinop(OpAssign,efield,e)) cf.cf_type null_pos in @@ -2531,8 +2531,8 @@ class tclass_to_jvm gctx c = object(self) end method private generate_signature = - jc#set_type_parameters (List.map (fun (n,t) -> - let jsigs = match follow t with + jc#set_type_parameters (List.map (fun tp -> + let jsigs = match follow tp.ttp_type with | TInst({cl_kind = KTypeParameter tl},_) -> List.map (fun t -> get_boxed_type (jsignature_of_type gctx t) @@ -2540,7 +2540,7 @@ class tclass_to_jvm gctx c = object(self) | _ -> [] in - (n,jsigs) + (tp.ttp_name,jsigs) ) c.cl_params); match c.cl_super with | Some(c,tl) -> jc#set_super_parameters (List.map (jtype_argument_of_type gctx []) tl) diff --git a/src/generators/genpy.ml b/src/generators/genpy.ml index 7f58398cea7..9c52b7ec4e8 100644 --- a/src/generators/genpy.ml +++ b/src/generators/genpy.ml @@ -1891,7 +1891,7 @@ module Generator = struct let py_metas = filter_py_metas cf.cf_meta in begin match cf.cf_expr with | Some ({eexpr = TFunction f} as ef) -> - let ethis = mk (TConst TThis) (TInst(c,List.map snd c.cl_params)) cf.cf_pos in + let ethis = mk (TConst TThis) (TInst(c,extract_param_types c.cl_params)) cf.cf_pos in let assigned_fields = ref [] in (* Collect all fields that are assigned to but panic out as soon as `this`, `super`, `return` or `throw` appears (regardless of control flow). *) diff --git a/src/generators/genshared.ml b/src/generators/genshared.ml index 6aef312e533..573bb520533 100644 --- a/src/generators/genshared.ml +++ b/src/generators/genshared.ml @@ -450,7 +450,7 @@ class ['a] typedef_interfaces (infos : 'a info_context) (anon_identification : ' | Some(c,_) -> self#process_class c | None -> () end; - let tc = TInst(c,List.map snd c.cl_params) in + let tc = TInst(c,extract_param_types c.cl_params) in let l = Hashtbl.fold (fun _ pfm acc -> let path = pfm.pfm_path in let path_inner = (fst path,snd path ^ "$Interface") in diff --git a/src/generators/genswf.ml b/src/generators/genswf.ml index 3480f1062ce..68eae9af6c5 100644 --- a/src/generators/genswf.ml +++ b/src/generators/genswf.ml @@ -148,9 +148,9 @@ let build_dependencies t = (match c.cl_super with | None -> add_path ([],"Object") DKInherit; | Some x -> add_inherit x); - List.iter (fun (_,t) -> + List.iter (fun tp -> (* add type-parameters constraints dependencies *) - match follow t with + match follow tp.ttp_type with | TInst (c,_) -> List.iter add_inherit c.cl_implements | _ -> () ) c.cl_params; diff --git a/src/generators/genswf9.ml b/src/generators/genswf9.ml index 1f144dbbf9a..5c521db6c7c 100644 --- a/src/generators/genswf9.ml +++ b/src/generators/genswf9.ml @@ -2253,7 +2253,7 @@ let mk_instance_getter_func c tl accessor_cl accessor_tl accessor_cf prop_cf = } let maybe_gen_instance_getter ctx c f acc alloc_slot = - let tl = List.map snd c.cl_params in + let tl = extract_param_types c.cl_params in maybe_gen_instance_accessor ctx c tl f acc alloc_slot MK3Getter (mk_instance_getter_func c tl c tl f) (fun prop_cf -> ([],prop_cf.cf_type)) @@ -2274,7 +2274,7 @@ let mk_instance_setter_func com c tl accessor_cl accessor_tl accessor_cf prop_cf } let maybe_gen_instance_setter ctx c f acc alloc_slot = - let tl = List.map snd c.cl_params in + let tl = extract_param_types c.cl_params in maybe_gen_instance_accessor ctx c tl f acc alloc_slot MK3Setter (mk_instance_setter_func ctx.com c tl c tl f) (fun prop_cf -> ([(mk_varg prop_cf.cf_type,None)],ctx.com.basic.tvoid)) @@ -2376,7 +2376,7 @@ let realize_required_accessors ctx cl = | _ -> false in - let tl = List.map snd cl.cl_params in + let tl = extract_param_types cl.cl_params in let fields = ref [] in Hashtbl.iter (fun name (read, write, native) -> match Type.class_field cl tl name with @@ -2526,7 +2526,7 @@ let generate_class ctx c = if read = AccCall then begin try begin - let tl = List.map snd c.cl_params in + let tl = extract_param_types c.cl_params in match Type.class_field c tl ("get_" ^ f.cf_name) with | Some (actual_cl, actual_tl), _, getter_cf when actual_cl != c -> let func = mk_instance_getter_func c tl actual_cl actual_tl getter_cf f in @@ -2551,7 +2551,7 @@ let generate_class ctx c = if write = AccCall then begin try begin - let tl = List.map snd c.cl_params in + let tl = extract_param_types c.cl_params in match Type.class_field c tl ("set_" ^ f.cf_name) with | Some (actual_cl, actual_tl), _, setter_cf when actual_cl != c -> let func = mk_instance_setter_func ctx.com c tl actual_cl actual_tl setter_cf f in diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index 688d5b7bf0e..cfa1282012c 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -643,6 +643,7 @@ and decode_tparams v = and decode_tparam_decl v = let vconstraints = field v "constraints" in + let vdefault = field v "defaultType" in { tp_name = decode_placed_name (field v "name_pos") (field v "name"); tp_constraints = if vconstraints = vnull then None else (match decode_array vconstraints with @@ -650,6 +651,7 @@ and decode_tparam_decl v = | [t] -> Some (decode_ctype t) | tl -> Some (CTIntersection (List.map decode_ctype tl),Globals.null_pos) ); + tp_default = opt decode_ctype vdefault; tp_params = decode_tparams (field v "params"); tp_meta = decode_meta_content (field v "meta"); } @@ -910,7 +912,13 @@ let rec encode_mtype t fields = ] @ fields) and encode_type_params tl = - encode_array (List.map (fun (n,t) -> encode_obj ["name",encode_string n;"t",encode_type t]) tl) + encode_array (List.map (fun tp -> + encode_obj [ + "name",encode_string tp.ttp_name; + "t",encode_type tp.ttp_type; + "defaultType",(match tp.ttp_default with None -> vnull | Some t -> encode_type t); + ] + ) tl) and encode_tenum e = encode_mtype (TEnumDecl e) [ @@ -1292,7 +1300,12 @@ let decode_tconst c = | _ -> raise Invalid_expr let decode_type_params v = - List.map (fun v -> decode_string (field v "name"),decode_type (field v "t")) (decode_array v) + List.map (fun v -> + let name = decode_string (field v "name") in + let t = decode_type (field v "t") in + let default = opt decode_type (field v "defaultType") in + mk_type_param name t default + ) (decode_array v) let decode_tvar v = (Obj.obj (decode_unsafe (field v "$")) : tvar) @@ -1942,12 +1955,17 @@ let macro_api ccom get_api = ); "apply_params", vfun3 (fun tpl tl t -> let tl = List.map decode_type (decode_array tl) in - let tpl = List.map (fun v -> decode_string (field v "name"), decode_type (field v "t")) (decode_array tpl) in + let tpl = List.map (fun v -> + let name = decode_string (field v "name") in + let t = decode_type (field v "t") in + let default = None in (* we don't care here *) + mk_type_param name t default + ) (decode_array tpl) in let rec map t = match t with | TInst({cl_kind = KTypeParameter _},_) -> begin try (* use non-physical equality check here to make apply_params work *) - snd (List.find (fun (_,t2) -> type_iseq t t2) tpl) + extract_param_type (List.find (fun tp2 -> type_iseq t tp2.ttp_type) tpl) with Not_found -> Type.map map t end diff --git a/src/optimization/inline.ml b/src/optimization/inline.ml index 193b5196804..8b093921cfd 100644 --- a/src/optimization/inline.ml +++ b/src/optimization/inline.ml @@ -864,7 +864,7 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f (* Same as type_inline, but modifies the function body to add field inits *) and type_inline_ctor ctx c cf tf ethis el po = let field_inits = - let cparams = List.map snd c.cl_params in + let cparams = extract_param_types c.cl_params in let ethis = mk (TConst TThis) (TInst (c,cparams)) c.cl_pos in let el = List.fold_left (fun acc cf -> match cf.cf_kind,cf.cf_expr with diff --git a/src/syntax/grammar.mly b/src/syntax/grammar.mly index 3dfb2bfd056..83180cc854f 100644 --- a/src/syntax/grammar.mly +++ b/src/syntax/grammar.mly @@ -1035,10 +1035,18 @@ and parse_constraint_param s = | [< >] -> serror()) | [< >] -> None ) in + let default = (match s with parser + | [< '(Binop OpAssign,_); s >] -> + (match s with parser + | [< t = parse_complex_type >] -> Some t + | [< >] -> serror()) + | [< >] -> None + ) in { tp_name = name; tp_params = []; tp_constraints = cto; + tp_default = default; tp_meta = meta; } | [< >] -> diff --git a/src/syntax/reification.ml b/src/syntax/reification.ml index c1756b1360f..447307fa8d2 100644 --- a/src/syntax/reification.ml +++ b/src/syntax/reification.ml @@ -376,7 +376,8 @@ let reify in_macro = "name", to_placed_name t.tp_name; "params", (EArrayDecl (List.map (to_tparam_decl p) t.tp_params),p); "meta", to_meta t.tp_meta p; - "constraints", (EArrayDecl (match t.tp_constraints with None -> [] | Some th -> [to_ctype th p]),p) + "constraints", (EArrayDecl (match t.tp_constraints with None -> [] | Some th -> [to_ctype th p]),p); + "defaultType", to_opt to_ctype t.tp_default p; ] p and to_type_def (t,p) = match t with diff --git a/src/typing/generic.ml b/src/typing/generic.ml index f1b96df0588..b99b182bb86 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -27,14 +27,14 @@ let make_generic ctx ps pt p = let rec loop l1 l2 = match l1, l2 with | [] , [] -> [] - | (x,TLazy f) :: l1, _ -> loop ((x,lazy_type f) :: l1) l2 - | (_,t1) :: l1 , t2 :: l2 -> + | ({ttp_type=TLazy f} as tp) :: l1, _ -> loop ({tp with ttp_type=lazy_type f} :: l1) l2 + | tp1 :: l1 , t2 :: l2 -> let t,eo = generic_check_const_expr ctx t2 in - (t1,(t,eo)) :: loop l1 l2 + (tp1.ttp_type,(t,eo)) :: loop l1 l2 | _ -> die "" __LOC__ in let name = - String.concat "_" (List.map2 (fun (s,_) t -> + String.concat "_" (List.map2 (fun {ttp_name=s} t -> let rec subst s = "_" ^ string_of_int (Char.code (String.get (Str.matched_string s) 0)) ^ "_" in let ident_safe = Str.global_substitute (Str.regexp "[^a-zA-Z0-9_]") subst in let s_type_path_underscore (p,s) = match p with [] -> s | _ -> String.concat "_" p ^ "_" ^ s in @@ -249,20 +249,20 @@ let rec build_generic ctx c p tl = let build_field cf_old = (* We have to clone the type parameters (issue #4672). We cannot substitute the constraints immediately because we need the full substitution list first. *) - let param_subst,params = List.fold_left (fun (subst,params) (s,t) -> match follow t with + let param_subst,params = List.fold_left (fun (subst,params) tp -> match follow tp.ttp_type with | TInst(c,tl) as t -> let t2 = TInst({c with cl_module = mg;},tl) in - (t,(t2,None)) :: subst,(s,t2) :: params + (t,(t2,None)) :: subst,({tp with ttp_type=t2}) :: params | _ -> die "" __LOC__ ) ([],[]) cf_old.cf_params in let gctx = {gctx with subst = param_subst @ gctx.subst} in let cf_new = {cf_old with cf_pos = cf_old.cf_pos} in (* copy *) (* Type parameter constraints are substituted here. *) - cf_new.cf_params <- List.rev_map (fun (s,t) -> match follow t with + cf_new.cf_params <- List.rev_map (fun tp -> match follow tp.ttp_type with | TInst({cl_kind = KTypeParameter tl1} as c,_) -> let tl1 = List.map (generic_substitute_type gctx) tl1 in c.cl_kind <- KTypeParameter tl1; - s,t + tp (* TPTODO: weird mapping *) | _ -> die "" __LOC__ ) params; let f () = diff --git a/src/typing/matcher.ml b/src/typing/matcher.ml index 84308f30c06..7819613b638 100644 --- a/src/typing/matcher.ml +++ b/src/typing/matcher.ml @@ -43,11 +43,11 @@ let type_field_access ctx ?(resume=false) e name = let unapply_type_parameters params monos = let unapplied = ref [] in - List.iter2 (fun (_,t1) t2 -> + List.iter2 (fun tp1 t2 -> match t2,follow t2 with | TMono m1,TMono m2 -> unapplied := (m1,m1.tm_type) :: !unapplied; - Monomorph.bind m1 t1; + Monomorph.bind m1 tp1.ttp_type; | _ -> () ) params monos; !unapplied @@ -1361,7 +1361,7 @@ module TexprConverter = struct t_dynamic in let t = match fst con with - | ConEnum(en,_) -> TEnum(en,List.map snd en.e_params) + | ConEnum(en,_) -> TEnum(en,extract_param_types en.e_params) | ConArray _ -> ctx.t.tarray t_dynamic | ConConst ct -> begin match ct with @@ -1371,7 +1371,7 @@ module TexprConverter = struct | TBool _ -> ctx.t.tbool | _ -> fail() end - | ConStatic({cl_kind = KAbstractImpl a},_) -> (TAbstract(a,List.map snd a.a_params)) + | ConStatic({cl_kind = KAbstractImpl a},_) -> (TAbstract(a,extract_param_types a.a_params)) | ConTypeExpr mt -> get_general_module_type ctx mt e.epos | ConFields _ | ConStatic _ -> fail() in @@ -1652,7 +1652,7 @@ module TexprConverter = struct dt.dt_texpr <- e; e in - let params = List.map snd ctx.type_params in + let params = extract_param_types ctx.type_params in let e = loop Toplevel params dt in match e with | None -> diff --git a/src/typing/overloadResolution.ml b/src/typing/overloadResolution.ml index 5d1a8308493..bd16f135f02 100644 --- a/src/typing/overloadResolution.ml +++ b/src/typing/overloadResolution.ml @@ -92,7 +92,7 @@ let maybe_resolve_instance_overload is_ctor map_type c cf el = resolve_instance_overload is_ctor map_type c cf.cf_name el else match unify_cf map_type c cf el with | Some fcc -> Some (fcc.fc_data) - | None -> Some(c,cf,List.map snd cf.cf_params) + | None -> Some(c,cf,extract_param_types cf.cf_params) let maybe_resolve_constructor_overload c tl el = let cf,c,tl = get_constructor_class c tl in diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index 9daf7e6a42b..d2a4c4f818b 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -304,7 +304,7 @@ let check_param_constraints ctx t map c p = let rec load_instance' ctx (t,p) allow_no_params = let t = try if t.tpackage <> [] || t.tsub <> None then raise Not_found; - let pt = List.assoc t.tname ctx.type_params in + let pt = lookup_param t.tname ctx.type_params in if t.tparams <> [] then typing_error ("Class type parameter " ^ t.tname ^ " can't have parameters") p; pt with Not_found -> @@ -328,7 +328,7 @@ let rec load_instance' ctx (t,p) allow_no_params = | _ -> false,false,false in let types , path , f = ctx.g.do_build_instance ctx mt p in - let is_rest = is_generic_build && (match types with ["Rest",_] -> true | _ -> false) in + let is_rest = is_generic_build && (match types with [{ttp_name="Rest"}] -> true | _ -> false) in if allow_no_params && t.tparams = [] && not is_rest then begin let monos = Monomorph.spawn_constrained_monos (fun t -> t) types in f (monos) @@ -359,7 +359,7 @@ let rec load_instance' ctx (t,p) allow_no_params = in let checks = DynArray.create () in let rec loop tl1 tl2 is_rest = match tl1,tl2 with - | t :: tl1,(name,t2) :: tl2 -> + | t :: tl1,({ttp_name=name;ttp_type=t2}) :: tl2 -> let t,pt = load_param t in let check_const c = let is_expression = (match t with TInst ({ cl_kind = KExpr _ },_) -> true | _ -> false) in @@ -385,15 +385,19 @@ let rec load_instance' ctx (t,p) allow_no_params = t :: loop tl1 tl2 is_rest | [],[] -> [] - | [],["Rest",_] when is_generic_build -> + | [],[{ttp_name="Rest"}] when is_generic_build -> [] - | [],(_,t) :: tl -> + | [],({ttp_type=t;ttp_default=def}) :: tl -> if is_java_rest then t_dynamic :: loop [] tl is_rest else if ctx.com.display.dms_error_policy = EPIgnore then t :: loop [] tl is_rest - else - typing_error ("Not enough type parameters for " ^ s_type_path path) p + else begin match def with + | None -> + typing_error ("Not enough type parameters for " ^ s_type_path path) p + | Some t -> + t :: loop [] tl is_rest + end | t :: tl,[] -> let t,pt = load_param t in if is_rest then @@ -647,10 +651,15 @@ and init_meta_overloads ctx co cf = | Method MethInline -> typing_error "Cannot @:overload inline function" p | _ -> ()); let old = ctx.type_params in - (match cf.cf_params with - | [] -> () - | l -> ctx.type_params <- List.filter (fun t -> not (List.mem t l)) ctx.type_params); - let params = (!type_function_params_rec) ctx f cf.cf_name p in + begin match cf.cf_params with + | [] -> + () + | l -> + ctx.type_params <- List.filter (fun t -> + not (List.mem t l) (* TODO: this still looks suspicious *) + ) ctx.type_params + end; + let params : type_params = (!type_function_params_rec) ctx f cf.cf_name p in ctx.type_params <- params @ ctx.type_params; let topt = function None -> typing_error "Explicit type required" p | Some t -> load_complex_type ctx true t in let args = @@ -777,19 +786,40 @@ let field_to_type_path ctx e = in loop e [] [] -let rec type_type_param ?(enum_constructor=false) ctx path get_params p tp = +type type_param_host = + | TPHType + | TPHConstructor + | TPHMethod + | TPHEnumConstructor + +let rec type_type_param ctx host path get_params p tp = let n = fst tp.tp_name in let c = mk_class ctx.m.curmod (fst path @ [snd path],n) (pos tp.tp_name) (pos tp.tp_name) in - c.cl_params <- type_type_params ctx c.cl_path get_params p tp.tp_params; + c.cl_params <- type_type_params ctx host c.cl_path get_params p tp.tp_params; c.cl_kind <- KTypeParameter []; c.cl_meta <- tp.Ast.tp_meta; - if enum_constructor then c.cl_meta <- (Meta.EnumConstructorParam,[],null_pos) :: c.cl_meta; - let t = TInst (c,List.map snd c.cl_params) in + if host = TPHEnumConstructor then c.cl_meta <- (Meta.EnumConstructorParam,[],null_pos) :: c.cl_meta; + let t = TInst (c,extract_param_types c.cl_params) in if ctx.is_display_file && DisplayPosition.display_position#enclosed_in (pos tp.tp_name) then DisplayEmitter.display_type ctx t (pos tp.tp_name); + let default = match tp.tp_default with + | None -> + None + | Some ct -> + let t = load_complex_type ctx true ct in + begin match host with + | TPHType -> + () + | TPHConstructor + | TPHMethod + | TPHEnumConstructor -> + display_error ctx "Default type parameters are only supported on types" (pos ct) + end; + Some t + in match tp.tp_constraints with | None -> - n, t + mk_type_param n t default | Some th -> let r = exc_protect ctx (fun r -> r := lazy_processing (fun() -> t); @@ -813,14 +843,14 @@ let rec type_type_param ?(enum_constructor=false) ctx path get_params p tp = c.cl_kind <- KTypeParameter constr; t ) "constraint" in - n, TLazy r + mk_type_param n (TLazy r) default -and type_type_params ?(enum_constructor=false) ctx path get_params p tpl = +and type_type_params ctx host path get_params p tpl = let names = ref [] in List.map (fun tp -> if List.exists (fun name -> name = fst tp.tp_name) !names then display_error ctx ("Duplicate type parameter name: " ^ fst tp.tp_name) (pos tp.tp_name); names := (fst tp.tp_name) :: !names; - type_type_param ~enum_constructor ctx path get_params p tp + type_type_param ctx host path get_params p tp ) tpl let load_core_class ctx c = @@ -856,7 +886,7 @@ let load_core_class ctx c = let init_core_api ctx c = let ccore = load_core_class ctx c in begin try - List.iter2 (fun (n1,t1) (n2,t2) -> match follow t1, follow t2 with + List.iter2 (fun tp1 tp2 -> match follow tp1.ttp_type, follow tp2.ttp_type with | TInst({cl_kind = KTypeParameter l1},_),TInst({cl_kind = KTypeParameter l2},_) -> begin try List.iter2 (fun t1 t2 -> type_eq EqCoreType t2 t1) l1 l2 @@ -864,7 +894,7 @@ let init_core_api ctx c = | Invalid_argument _ -> typing_error "Type parameters must have the same number of constraints as core type" c.cl_pos | Unify_error l -> - display_error ctx ("Type parameter " ^ n2 ^ " has different constraint than in core type") c.cl_pos; + display_error ctx ("Type parameter " ^ tp2.ttp_name ^ " has different constraint than in core type") c.cl_pos; display_error ctx (error_msg (Unify l)) c.cl_pos end | t1,t2 -> @@ -880,7 +910,7 @@ let init_core_api ctx c = let compare_fields f f2 = let p = (match f2.cf_expr with None -> c.cl_pos | Some e -> e.epos) in (try - type_eq EqCoreType (apply_params ccore.cl_params (List.map snd c.cl_params) f.cf_type) f2.cf_type + type_eq EqCoreType (apply_params ccore.cl_params (extract_param_types c.cl_params) f.cf_type) f2.cf_type with Unify_error l -> display_error ctx ("Field " ^ f.cf_name ^ " has different type than in core type") p; display_error ctx (error_msg (Unify l)) p); diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index 590d31014f3..950824a373b 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -37,11 +37,12 @@ exception Build_canceled of build_state let is_generic_parameter ctx c = (* first check field parameters, then class parameters *) + let name = snd c.cl_path in try - ignore (List.assoc (snd c.cl_path) ctx.curfield.cf_params); + ignore(lookup_param name ctx.curfield.cf_params); has_class_field_flag ctx.curfield CfGeneric with Not_found -> try - ignore(List.assoc (snd c.cl_path) ctx.type_params); + ignore(lookup_param name ctx.type_params); (match ctx.curclass.cl_kind with | KGeneric -> true | _ -> false); with Not_found -> false @@ -61,8 +62,9 @@ let valid_redefinition ctx map1 map2 f1 t1 f2 t2 = (* child, parent *) | [], [] -> t1, t2 | l1, l2 when List.length l1 = List.length l2 -> let to_check = ref [] in - let monos = List.map2 (fun (name,p1) (_,p2) -> - (match follow p1, follow p2 with + (* TPTODO: defaults *) + let monos = List.map2 (fun tp1 tp2 -> + (match follow tp1.ttp_type, follow tp2.ttp_type with | TInst ({ cl_kind = KTypeParameter ct1 } as c1,pl1), TInst ({ cl_kind = KTypeParameter ct2 } as c2,pl2) -> (match ct1, ct2 with | [], [] -> () @@ -82,7 +84,7 @@ let valid_redefinition ctx map1 map2 f1 t1 f2 t2 = (* child, parent *) | _ -> raise (Unify_error [Unify_custom "Different number of constraints"])) | _ -> ()); - TInst (mk_class null_module ([],name) null_pos null_pos,[]) + TInst (mk_class null_module ([],tp1.ttp_name) null_pos null_pos,[]) ) l1 l2 in List.iter (fun f -> f monos) !to_check; apply_params l1 monos t1, apply_params l2 monos t2 diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index edfdccf770a..cd9fc112724 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -176,7 +176,7 @@ let ensure_struct_init_constructor ctx c ast_fields p = ast_fields in let super_args,super_expr,super_tl = get_struct_init_super_info ctx c p in - let params = List.map snd c.cl_params in + let params = extract_param_types c.cl_params in let ethis = mk (TConst TThis) (TInst(c,params)) p in let doc_buf = Buffer.create 0 in let args,el,tl = List.fold_left (fun (args,el,tl) cf -> match cf.cf_kind with @@ -410,7 +410,7 @@ let build_enum_abstract ctx c a fields p = field.cff_meta <- (Meta.Enum,[],null_pos) :: field.cff_meta; let ct = match ct with | Some _ -> ct - | None -> Some (TExprToExpr.convert_type (TAbstract(a,List.map snd a.a_params)),null_pos) + | None -> Some (TExprToExpr.convert_type (TAbstract(a,extract_param_types a.a_params)),null_pos) in begin match eo with | None -> @@ -459,7 +459,7 @@ let build_module_def ctx mt meta fvars context_init fbuild = let s = try String.concat "." (List.rev (string_list_of_expr_path epath)) with Error (_,p) -> typing_error "Build call parameter must be a class path" p in if ctx.in_macro then typing_error "You cannot use @:build inside a macro : make sure that your type is not used in macro" p; let old = ctx.get_build_infos in - ctx.get_build_infos <- (fun() -> Some (mt, List.map snd (t_infos mt).mt_params, fvars())); + ctx.get_build_infos <- (fun() -> Some (mt, extract_param_types (t_infos mt).mt_params, fvars())); context_init#run; let r = try apply_macro ctx MBuild s el p with e -> ctx.get_build_infos <- old; raise e in ctx.get_build_infos <- old; @@ -526,9 +526,9 @@ let create_class_context ctx c context_init p = tthis = (match abstract with | Some a -> (match a.a_this with - | TMono r when r.tm_type = None -> TAbstract (a,List.map snd c.cl_params) + | TMono r when r.tm_type = None -> TAbstract (a,extract_param_types c.cl_params) | t -> t) - | None -> TInst (c,List.map snd c.cl_params)); + | None -> TInst (c,extract_param_types c.cl_params)); on_error = (fun ctx msg ep -> ctx.com.error msg ep; (* macros expressions might reference other code, let's recall which class we are actually compiling *) @@ -667,7 +667,7 @@ let rec get_parent c name = let transform_field (ctx,cctx) c f fields p = let f = match cctx.abstract with | Some a -> - let a_t = TExprToExpr.convert_type' (TAbstract(a,List.map snd a.a_params)) in + let a_t = TExprToExpr.convert_type' (TAbstract(a,extract_param_types a.a_params)) in let this_t = TExprToExpr.convert_type' a.a_this in (* TODO: better pos? *) transform_abstract_field ctx.com this_t a_t a f | None -> @@ -1340,7 +1340,7 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p = let t_get,t_set = match cctx.abstract with | Some a when fctx.is_abstract_member -> if Meta.has Meta.IsVar f.cff_meta then typing_error (name ^ ": Abstract properties cannot be real variables") f.cff_pos; - let ta = apply_params a.a_params (List.map snd a.a_params) a.a_this in + let ta = apply_params a.a_params (extract_param_types a.a_params) a.a_this in tfun [ta] ret, tfun [ta;ret] ret | _ -> tfun [] ret, TFun(["value",false,ret],ret) in @@ -1420,7 +1420,7 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p = display.module_diagnostics <- MissingFields diag :: display.module_diagnostics end else if not (has_class_flag c CExtern) then begin try - let _, _, f2 = (if not fctx.is_static then let f = PMap.find m c.cl_statics in None, f.cf_type, f else class_field c (List.map snd c.cl_params) m) in + let _, _, f2 = (if not fctx.is_static then let f = PMap.find m c.cl_statics in None, f.cf_type, f else class_field c (extract_param_types c.cl_params) m) in display_error ctx (Printf.sprintf "Method %s is no valid accessor for %s because it is %sstatic" m (name) (if fctx.is_static then "not " else "")) f2.cf_pos with Not_found -> display_error ctx ("Method " ^ m ^ " required by property " ^ name ^ " is missing") p diff --git a/src/typing/typeloadFunction.ml b/src/typing/typeloadFunction.ml index 071110071f9..027151e8afe 100644 --- a/src/typing/typeloadFunction.ml +++ b/src/typing/typeloadFunction.ml @@ -47,7 +47,7 @@ let save_field_state ctx = let type_function_params ctx fd fname p = let params = ref [] in - params := Typeload.type_type_params ctx ([],fname) (fun() -> !params) p fd.f_params; + params := Typeload.type_type_params ctx TPHMethod ([],fname) (fun() -> !params) p fd.f_params; !params let type_function ctx (args : function_arguments) ret fmode e do_display p = @@ -183,7 +183,7 @@ let type_function ctx args ret fmode e do_display p = let add_constructor ctx c force_constructor p = if c.cl_constructor <> None then () else - let constructor = try Some (Type.get_constructor_class c (List.map snd c.cl_params)) with Not_found -> None in + let constructor = try Some (Type.get_constructor_class c (extract_param_types c.cl_params)) with Not_found -> None in match constructor with | Some(cfsup,csup,cparams) when not (has_class_flag c CExtern) -> let cf = { diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 905557f56f3..2857d1a8615 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -407,7 +407,7 @@ let module_pass_1 ctx m tdecls loadp = let load_enum_field ctx e et is_flat index c = let p = c.ec_pos in let params = ref [] in - params := type_type_params ~enum_constructor:true ctx ([],fst c.ec_name) (fun() -> !params) c.ec_pos c.ec_params; + params := type_type_params ctx TPHEnumConstructor ([],fst c.ec_name) (fun() -> !params) c.ec_pos c.ec_params; let params = !params in let ctx = { ctx with type_params = params @ ctx.type_params } in let rt = (match c.ec_type with @@ -510,7 +510,7 @@ let init_module_type ctx context_init (decl,p) = let _, _, f = ctx.g.do_build_instance ctx t p_type in (* create a temp private typedef, does not register it in module *) let t_path = (fst md.m_path @ ["_" ^ snd md.m_path],name) in - let t_type = f (List.map snd (t_infos t).mt_params) in + let t_type = f (extract_param_types (t_infos t).mt_params) in let mt = TTypeDecl {(mk_typedef ctx.m.curmod t_path p p t_type) with t_private = true; t_params = (t_infos t).mt_params @@ -660,7 +660,7 @@ let init_module_type ctx context_init (decl,p) = TypeloadFields.init_class ctx c p context_init d.d_flags d.d_data; c.cl_build <- (fun()-> Built); incr build_count; - List.iter (fun (_,t) -> ignore(follow t)) c.cl_params; + List.iter (fun tp -> ignore(follow tp.ttp_type)) c.cl_params; Built; with TypeloadCheck.Build_canceled state -> c.cl_build <- make_pass ctx build; @@ -757,7 +757,7 @@ let init_module_type ctx context_init (decl,p) = ) fields | _ -> typing_error "Enum build macro must return a single variable with anonymous object fields" p ); - let et = TEnum (e,List.map snd e.e_params) in + let et = TEnum (e,extract_param_types e.e_params) in let names = ref [] in let index = ref 0 in let is_flat = ref true in @@ -896,7 +896,7 @@ let init_module_type ctx context_init (decl,p) = a.a_to <- List.rev a.a_to; if not !is_type then begin if Meta.has Meta.CoreType a.a_meta then - a.a_this <- TAbstract(a,List.map snd a.a_params) + a.a_this <- TAbstract(a,extract_param_types a.a_params) else typing_error "Abstract is missing underlying type declaration" a.a_pos end; @@ -912,7 +912,7 @@ let module_pass_2 ctx m decls tdecls p = List.iter (fun d -> match d with | (TClassDecl c, (EClass d, p)) -> - c.cl_params <- type_type_params ctx c.cl_path (fun() -> c.cl_params) p d.d_params; + c.cl_params <- type_type_params ctx TPHType c.cl_path (fun() -> c.cl_params) p d.d_params; if Meta.has Meta.Generic c.cl_meta && c.cl_params <> [] then c.cl_kind <- KGeneric; if Meta.has Meta.GenericBuild c.cl_meta then begin if ctx.in_macro then typing_error "@:genericBuild cannot be used in macros" c.cl_pos; @@ -920,11 +920,11 @@ let module_pass_2 ctx m decls tdecls p = end; if c.cl_path = (["haxe";"macro"],"MacroType") then c.cl_kind <- KMacroType; | (TEnumDecl e, (EEnum d, p)) -> - e.e_params <- type_type_params ctx e.e_path (fun() -> e.e_params) p d.d_params; + e.e_params <- type_type_params ctx TPHType e.e_path (fun() -> e.e_params) p d.d_params; | (TTypeDecl t, (ETypedef d, p)) -> - t.t_params <- type_type_params ctx t.t_path (fun() -> t.t_params) p d.d_params; + t.t_params <- type_type_params ctx TPHType t.t_path (fun() -> t.t_params) p d.d_params; | (TAbstractDecl a, (EAbstract d, p)) -> - a.a_params <- type_type_params ctx a.a_path (fun() -> a.a_params) p d.d_params; + a.a_params <- type_type_params ctx TPHType a.a_path (fun() -> a.a_params) p d.d_params; | _ -> die "" __LOC__ ) decls; diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 6e5b20a9ed0..2d8c4faf27d 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -325,7 +325,7 @@ let rec type_ident_raise ctx i p mode with_type = with Not_found -> try (* member variable lookup *) if ctx.curfun = FunStatic then raise Not_found; - let c , t , f = class_field ctx ctx.curclass (List.map snd ctx.curclass.cl_params) i p in + let c , t , f = class_field ctx ctx.curclass (extract_param_types ctx.curclass.cl_params) i p in field_access ctx mode f (match c with None -> FHAnon | Some (c,tl) -> FHInstance (c,tl)) (get_this ctx p) p with Not_found -> try (* static variable lookup *) @@ -336,7 +336,7 @@ let rec type_ident_raise ctx i p mode with_type = typing_error (Printf.sprintf "Cannot access non-static field %s from static method" f.cf_name) p; let e,fa = match ctx.curclass.cl_kind with | KAbstractImpl a when is_impl && not is_enum -> - let tl = List.map snd a.a_params in + let tl = extract_param_types a.a_params in let e = get_this ctx p in let e = {e with etype = TAbstract(a,tl)} in e,FHAbstract(a,tl,ctx.curclass) @@ -377,7 +377,7 @@ let rec type_ident_raise ctx i p mode with_type = | Var {v_read = AccInline} -> true | _ -> false in - let fa = FieldAccess.create et cf (FHAbstract(a,List.map snd a.a_params,c)) inline p in + let fa = FieldAccess.create et cf (FHAbstract(a,extract_param_types a.a_params,c)) inline p in ImportHandling.mark_import_position ctx pt; AKField fa end @@ -419,12 +419,12 @@ and type_ident ctx i p mode with_type = with Not_found -> let resolved_to_type_parameter = ref false in try - let t = List.find (fun (i2,_) -> i2 = i) ctx.type_params in + let t = List.find (fun tp -> tp.ttp_name = i) ctx.type_params in resolved_to_type_parameter := true; - let c = match follow (snd t) with TInst(c,_) -> c | _ -> die "" __LOC__ in + let c = match follow (extract_param_type t) with TInst(c,_) -> c | _ -> die "" __LOC__ in if TypeloadCheck.is_generic_parameter ctx c && Meta.has Meta.Const c.cl_meta then begin let e = type_module_type ctx (TClassDecl c) None p in - AKExpr {e with etype = (snd t)} + AKExpr {e with etype = (extract_param_type t)} end else raise Not_found with Not_found -> @@ -1955,7 +1955,7 @@ let rec create com = | "Float" -> ctx.t.tfloat <- TAbstract (a,[]); | "Int" -> ctx.t.tint <- TAbstract (a,[]) | "Bool" -> ctx.t.tbool <- TAbstract (a,[]) - | "Dynamic" -> t_dynamic_def := TAbstract(a,List.map snd a.a_params); + | "Dynamic" -> t_dynamic_def := TAbstract(a,extract_param_types a.a_params); | "Null" -> let mk_null t = try diff --git a/src/typing/typerDisplay.ml b/src/typing/typerDisplay.ml index df0cb0a2793..3ca9eb95a6d 100644 --- a/src/typing/typerDisplay.ml +++ b/src/typing/typerDisplay.ml @@ -87,7 +87,7 @@ let completion_item_of_expr ctx e = end | TTypeExpr (TClassDecl {cl_kind = KAbstractImpl a}) -> Display.merge_core_doc ctx (TAbstractDecl a); - let t = TType(abstract_module_type a (List.map snd a.a_params),[]) in + let t = TType(abstract_module_type a (extract_param_types a.a_params),[]) in let t = tpair t in make_ci_type (CompletionModuleType.of_module_type (TAbstractDecl a)) ImportStatus.Imported (Some t) | TTypeExpr mt -> @@ -569,7 +569,7 @@ let handle_display ctx e_ast dk mode with_type = let mt = ctx.g.do_load_type_def ctx null_pos {tpackage=mt.pack;tname=mt.module_name;tsub=Some mt.name;tparams=[]} in begin match resolve_typedef mt with | TClassDecl c -> has_constructor c - | TAbstractDecl a -> (match Abstract.follow_with_forward_ctor ~build:true (TAbstract(a,List.map snd a.a_params)) with + | TAbstractDecl a -> (match Abstract.follow_with_forward_ctor ~build:true (TAbstract(a,extract_param_types a.a_params)) with | TInst(c,_) -> has_constructor c | TAbstract({a_impl = Some c},_) -> PMap.mem "_new" c.cl_statics | _ -> false) diff --git a/std/haxe/macro/Expr.hx b/std/haxe/macro/Expr.hx index d7d72fbe4ca..976a1758602 100644 --- a/std/haxe/macro/Expr.hx +++ b/std/haxe/macro/Expr.hx @@ -676,6 +676,11 @@ typedef TypeParamDecl = { **/ var ?constraints:Array; + /** + The optional default type of the type parameter. + **/ + var ?defaultType:Null; + /** The optional parameters of the type parameter. **/ diff --git a/std/haxe/macro/Printer.hx b/std/haxe/macro/Printer.hx index e7a70b83e8e..a34efec4867 100644 --- a/std/haxe/macro/Printer.hx +++ b/std/haxe/macro/Printer.hx @@ -195,7 +195,8 @@ class Printer { return (tpd.meta != null && tpd.meta.length > 0 ? tpd.meta.map(printMetadata).join(" ") + " " : "") + tpd.name + (tpd.params != null && tpd.params.length > 0 ? "<" + tpd.params.map(printTypeParamDecl).join(", ") + ">" : "") - + (tpd.constraints != null && tpd.constraints.length > 0 ? ":(" + tpd.constraints.map(printComplexType).join(", ") + ")" : ""); + + (tpd.constraints != null && tpd.constraints.length > 0 ? ":(" + tpd.constraints.map(printComplexType).join(", ") + ")" : "") + + (tpd.defaultType != null ? "=" + printComplexType(tpd.defaultType) : ""); public function printFunctionArg(arg:FunctionArg) return (arg.opt ? "?" : "") + arg.name + opt(arg.type, printComplexType, ":") + opt(arg.value, printExpr, " = "); diff --git a/std/haxe/macro/Type.hx b/std/haxe/macro/Type.hx index f55cf81a352..4e2a20deb8b 100644 --- a/std/haxe/macro/Type.hx +++ b/std/haxe/macro/Type.hx @@ -180,6 +180,11 @@ typedef TypeParameter = { `KTypeParameter` kind. **/ var t:Type; + + /** + The default type for this type parameter. + **/ + var ?defaultType:Null; } /** diff --git a/tests/misc/projects/default_type_params/Ctor.hx b/tests/misc/projects/default_type_params/Ctor.hx new file mode 100644 index 00000000000..a37f7f1f47d --- /dev/null +++ b/tests/misc/projects/default_type_params/Ctor.hx @@ -0,0 +1,3 @@ +class C { + function new(){} +} \ No newline at end of file diff --git a/tests/misc/projects/default_type_params/EnumCtor.hx b/tests/misc/projects/default_type_params/EnumCtor.hx new file mode 100644 index 00000000000..3a8ec87213e --- /dev/null +++ b/tests/misc/projects/default_type_params/EnumCtor.hx @@ -0,0 +1,3 @@ +enum E { + C(); +} \ No newline at end of file diff --git a/tests/misc/projects/default_type_params/Method.hx b/tests/misc/projects/default_type_params/Method.hx new file mode 100644 index 00000000000..8b7a37731e0 --- /dev/null +++ b/tests/misc/projects/default_type_params/Method.hx @@ -0,0 +1 @@ +function method() {} \ No newline at end of file diff --git a/tests/misc/projects/default_type_params/compile-ctor-fail.hxml b/tests/misc/projects/default_type_params/compile-ctor-fail.hxml new file mode 100644 index 00000000000..ebbf54b25c3 --- /dev/null +++ b/tests/misc/projects/default_type_params/compile-ctor-fail.hxml @@ -0,0 +1 @@ +--main Ctor \ No newline at end of file diff --git a/tests/misc/projects/default_type_params/compile-ctor-fail.hxml.stderr b/tests/misc/projects/default_type_params/compile-ctor-fail.hxml.stderr new file mode 100644 index 00000000000..6f610732936 --- /dev/null +++ b/tests/misc/projects/default_type_params/compile-ctor-fail.hxml.stderr @@ -0,0 +1 @@ +Ctor.hx:2: characters 17-23 : Default type parameters are only supported on types \ No newline at end of file diff --git a/tests/misc/projects/default_type_params/compile-enum-ctor-fail.hxml b/tests/misc/projects/default_type_params/compile-enum-ctor-fail.hxml new file mode 100644 index 00000000000..d13ee0506d1 --- /dev/null +++ b/tests/misc/projects/default_type_params/compile-enum-ctor-fail.hxml @@ -0,0 +1 @@ +--main EnumCtor \ No newline at end of file diff --git a/tests/misc/projects/default_type_params/compile-enum-ctor-fail.hxml.stderr b/tests/misc/projects/default_type_params/compile-enum-ctor-fail.hxml.stderr new file mode 100644 index 00000000000..0f1086b0582 --- /dev/null +++ b/tests/misc/projects/default_type_params/compile-enum-ctor-fail.hxml.stderr @@ -0,0 +1 @@ +EnumCtor.hx:2: characters 6-12 : Default type parameters are only supported on types \ No newline at end of file diff --git a/tests/misc/projects/default_type_params/compile-method-fail.hxml b/tests/misc/projects/default_type_params/compile-method-fail.hxml new file mode 100644 index 00000000000..0417028b747 --- /dev/null +++ b/tests/misc/projects/default_type_params/compile-method-fail.hxml @@ -0,0 +1 @@ +--main Method \ No newline at end of file diff --git a/tests/misc/projects/default_type_params/compile-method-fail.hxml.stderr b/tests/misc/projects/default_type_params/compile-method-fail.hxml.stderr new file mode 100644 index 00000000000..da8abbd07ec --- /dev/null +++ b/tests/misc/projects/default_type_params/compile-method-fail.hxml.stderr @@ -0,0 +1 @@ +Method.hx:1: characters 19-25 : Default type parameters are only supported on types \ No newline at end of file diff --git a/tests/unit/src/unit/TestDefaultTypeParameters.hx b/tests/unit/src/unit/TestDefaultTypeParameters.hx new file mode 100644 index 00000000000..44fd5ad74bd --- /dev/null +++ b/tests/unit/src/unit/TestDefaultTypeParameters.hx @@ -0,0 +1,44 @@ +package unit; + +import utest.Assert; + +using StringTools; + +private class DefaultTPClass_y {} +private class DefaultTPClass_yn {} +private class DefaultTPClass_ny {} +private class DefaultTPClass_yy {} + +class TestDefaultTypeParameters extends Test { + function test() { + t(HelperMacros.typeString((null : DefaultTPClass_y)).endsWith("DefaultTPClass_y")); + t(HelperMacros.typeString((null : DefaultTPClass_y)).endsWith("DefaultTPClass_y")); + t(HelperMacros.typeString((null : DefaultTPClass_yn)).endsWith("DefaultTPClass_yn")); + t(HelperMacros.typeString((null : DefaultTPClass_ny)).endsWith("DefaultTPClass_ny")); + t(HelperMacros.typeString((null : DefaultTPClass_ny)).endsWith("DefaultTPClass_ny")); + t(HelperMacros.typeString((null : DefaultTPClass_yy)).endsWith("DefaultTPClass_yy")); + t(HelperMacros.typeString((null : DefaultTPClass_yy)).endsWith("DefaultTPClass_yy")); + t(HelperMacros.typeString((null : DefaultTPClass_yy)).endsWith("DefaultTPClass_yy")); + } + + macro static function printThings() { + var pr = new haxe.macro.Printer(); + var tds = [ + macro class DefaultTPClass_y {}, + macro class DefaultTPClass_yn {}, + macro class DefaultTPClass_ny {}, + macro class DefaultTPClass_yy {}, + ]; + return macro $v{[for (td in tds) pr.printTypeDefinition(td).replace("\r", "").replace("\n", "")]}; + } + + function testPrinting() { + var expected = [ + "class DefaultTPClass_y {}", + "class DefaultTPClass_yn {}", + "class DefaultTPClass_ny {}", + "class DefaultTPClass_yy {}" + ]; + Assert.same(expected, printThings()); + } +} diff --git a/tests/unit/src/unit/TestMain.hx b/tests/unit/src/unit/TestMain.hx index 0580041d81a..bfff2aedfeb 100644 --- a/tests/unit/src/unit/TestMain.hx +++ b/tests/unit/src/unit/TestMain.hx @@ -1,9 +1,9 @@ package unit; -import utest.ui.Report; -import utest.Runner; -import unit.Test.*; import haxe.ds.List; +import unit.Test.*; +import utest.Runner; +import utest.ui.Report; final asyncWaits = new Array(); final asyncCache = new Array<() -> Void>(); @@ -25,25 +25,25 @@ function main() { } #end - var verbose = #if ( cpp || neko || php ) Sys.args().indexOf("-v") >= 0 #else false #end; + var verbose = #if (cpp || neko || php) Sys.args().indexOf("-v") >= 0 #else false #end; - #if cs //"Turkey Test" - Issue #996 + #if cs // "Turkey Test" - Issue #996 cs.system.threading.Thread.CurrentThread.CurrentCulture = new cs.system.globalization.CultureInfo('tr-TR'); cs.Lib.applyCultureChanges(); #end #if neko - if( neko.Web.isModNeko ) - neko.Web.setHeader("Content-Type","text/plain"); + if (neko.Web.isModNeko) + neko.Web.setHeader("Content-Type", "text/plain"); #elseif php - if( php.Web.isModNeko ) - php.Web.setHeader("Content-Type","text/plain"); + if (php.Web.isModNeko) + php.Web.setHeader("Content-Type", "text/plain"); #end #if !macro trace("Generated at: " + HelperMacros.getCompilationDate()); #end trace("START"); #if flash - var tf : flash.text.TextField = untyped flash.Boot.getTrace(); + var tf:flash.text.TextField = untyped flash.Boot.getTrace(); tf.selectable = true; tf.mouseEnabled = true; #end @@ -76,8 +76,7 @@ function main() { new TestNumericCasts(), new TestHashMap(), new TestRest(), - #if (!no_http && (!github || !(php && Windows))) - new TestHttp(), + #if (!no_http && (!github || !(php && Windows))) new TestHttp(), #end #if !no_pattern_matching new TestMatch(), @@ -106,15 +105,15 @@ function main() { new TestOverloadsForEveryone(), new TestInterface(), new TestNaN(), - #if ((dce == "full") && !interp) - new TestDCE(), + #if ((dce == "full") && !interp) new TestDCE(), #end new TestMapComprehension(), new TestMacro(), new TestKeyValueIterator(), new TestFieldVariance(), - new TestConstrainedMonomorphs() - //new TestUnspecified(), + new TestConstrainedMonomorphs(), + new TestDefaultTypeParameters(), + // new TestUnspecified(), ]; for (specClass in unit.UnitBuilder.generateSpec("src/unitstd")) { @@ -132,12 +131,13 @@ function main() { report.displaySuccessResults = NeverShowSuccessResults; var success = true; runner.onProgress.add(function(e) { - for(a in e.result.assertations) { + for (a in e.result.assertations) { switch a { case Success(pos): case Warning(msg): case Ignore(reason): - case _: success = false; + case _: + success = false; } } #if js