From 45268f70f737a7b212116ddd89ab9b29aec1586e Mon Sep 17 00:00:00 2001 From: Zeta <53486764+Apprentice-Alchemist@users.noreply.github.com> Date: Mon, 18 Dec 2023 17:32:49 +0100 Subject: [PATCH 001/125] [tests] Force link mbedtls@2 on macOS. (#11435) --- tests/runci/targets/Hl.hx | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/runci/targets/Hl.hx b/tests/runci/targets/Hl.hx index 07ff7999687..7bf6f207ae8 100644 --- a/tests/runci/targets/Hl.hx +++ b/tests/runci/targets/Hl.hx @@ -39,6 +39,7 @@ class Hl { case "Mac": runNetworkCommand("brew", ["update", '--preinstall']); runNetworkCommand("brew", ["bundle", '--file=${hlSrc}/Brewfile']); + runNetworkCommand("brew", ["link", "mbedtls@2", "--force"]); case "Windows": //pass } From 541259e4c3b93e96a6f2b826d512c41b93fe5de0 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 19 Dec 2023 19:47:48 +0100 Subject: [PATCH 002/125] Internal type parameter changes (#11436) * use tclass equality instead of Type.t * change type parameter handling * fix gencommon a bit * remove redundant name * fix gencommon param cloning * make sure lazies are resolved at some point --- src/codegen/codegen.ml | 9 +- src/codegen/gencommon/castDetect.ml | 2 +- src/codegen/gencommon/closuresToClass.ml | 15 +- src/codegen/gencommon/dynamicFieldAccess.ml | 8 +- src/codegen/gencommon/enumToClass.ml | 4 +- src/codegen/gencommon/gencommon.ml | 7 +- .../gencommon/overloadingConstructor.ml | 17 ++- src/codegen/gencommon/realTypeParams.ml | 15 +- src/codegen/gencommon/renameTypeParameters.ml | 14 +- src/codegen/overloads.ml | 9 +- src/context/abstractCast.ml | 7 +- src/context/display/displayFields.ml | 11 +- src/context/display/displayToplevel.ml | 6 +- src/context/typecore.ml | 4 +- src/core/display/completionItem.ml | 14 +- src/core/json/genjson.ml | 14 +- src/core/tFunctions.ml | 34 +++-- src/core/tPrinting.ml | 28 ++-- src/core/tType.ml | 4 +- src/core/tUnification.ml | 37 ++--- src/filters/filtersCommon.ml | 7 +- src/generators/gencs.ml | 11 +- src/generators/genhl.ml | 10 +- src/generators/genjava.ml | 13 +- src/generators/genjvm.ml | 22 ++- src/generators/genlua.ml | 2 +- src/generators/genswf.ml | 4 +- src/generators/genswf9.ml | 4 +- src/macro/macroApi.ml | 42 +----- src/optimization/dce.ml | 8 +- src/optimization/inline.ml | 2 +- src/typing/fields.ml | 4 +- src/typing/generic.ml | 35 +++-- src/typing/operators.ml | 4 +- src/typing/typeload.ml | 136 +++++++++--------- src/typing/typeloadCheck.ml | 43 +++--- src/typing/typer.ml | 4 +- src/typing/typerBase.ml | 4 +- src/typing/typerDisplay.ml | 6 +- 39 files changed, 279 insertions(+), 341 deletions(-) diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index b8d363ab4bc..5893255443e 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -122,8 +122,13 @@ let fix_override com c f fd = (* Flash generates type parameters with a single constraint as that constraint type, so we 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.exists (fun tp -> tp.ttp_name = (snd cp.cl_path)) c.cl_params then raise (Unify_error []) + | TInst({cl_kind = KTypeParameter ttp} as cp,_) when com.platform = Flash -> + begin match get_constraints ttp with + | [tc] -> + if List.exists (fun tp -> tp.ttp_name = (snd cp.cl_path)) c.cl_params then raise (Unify_error []) + | _ -> + () + end | _ -> () end; diff --git a/src/codegen/gencommon/castDetect.ml b/src/codegen/gencommon/castDetect.ml index af2350b9471..f301bf4f163 100644 --- a/src/codegen/gencommon/castDetect.ml +++ b/src/codegen/gencommon/castDetect.ml @@ -290,7 +290,7 @@ let do_unsafe_cast gen from_t to_t e = | _ -> raise Not_found in match gen.gfollow#run_f from_t, gen.gfollow#run_f to_t with - | TInst({ cl_kind = KTypeParameter tl },_), t2 when List.exists (fun t -> unifies t t2) tl -> + | TInst({ cl_kind = KTypeParameter ttp },_), t2 when List.exists (fun t -> unifies t t2) (get_constraints ttp) -> mk_cast to_t (mk_cast t_dynamic e) | from_t, to_t when gen.gspecial_needs_cast to_t from_t -> mk_cast to_t e diff --git a/src/codegen/gencommon/closuresToClass.ml b/src/codegen/gencommon/closuresToClass.ml index 7bc2b6cca69..d35bf652194 100644 --- a/src/codegen/gencommon/closuresToClass.ml +++ b/src/codegen/gencommon/closuresToClass.ml @@ -289,10 +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 tp -> match follow tp.ttp_type with - | TInst(c,_) -> c - | _ -> die "" __LOC__) cf.cf_params - in + let params = List.map (fun tp -> tp.ttp_class) cf.cf_params in List.filter (fun t -> not (List.memq t params)) (get_type_params acc cf.cf_type) ) a.a_fields acc | TType(_, []) @@ -396,7 +393,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 -> mk_type_param (snd cl.cl_path) (TInst(cl, [])) None) tparams in + let cltypes = List.map (fun cl -> mk_type_param cl None 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 @@ -613,14 +610,10 @@ let configure gen ft = let monos = List.map (fun t -> apply_params types (List.map (fun _ -> t_dynamic) types) t) monos in - let same_cl t1 t2 = match follow t1, follow t2 with - | TInst(c,_), TInst(c2,_) -> c == c2 - | _ -> false - in - let passoc = List.map2 (fun tp m -> tp.ttp_type,m) types monos in + let passoc = List.map2 (fun tp m -> tp.ttp_class,m) types monos in let cltparams = List.map (fun tp -> try - snd (List.find (fun (t2,_) -> same_cl tp.ttp_type t2) passoc) + snd (List.find (fun (t2,_) -> tp.ttp_class == t2) passoc) with | Not_found -> tp.ttp_type) cls.cl_params in { e with eexpr = TNew(cls, cltparams, List.rev captured) } diff --git a/src/codegen/gencommon/dynamicFieldAccess.ml b/src/codegen/gencommon/dynamicFieldAccess.ml index 408c9b9816c..78fc88c39ba 100644 --- a/src/codegen/gencommon/dynamicFieldAccess.ml +++ b/src/codegen/gencommon/dynamicFieldAccess.ml @@ -58,8 +58,8 @@ let priority = solve_deps name [DAfter DynamicOperators.priority] *) let configure gen (is_dynamic:texpr->Type.tfield_access->bool) (change_expr:texpr->texpr->string->texpr option->bool->texpr) (call_expr:texpr->texpr->string->texpr list->texpr) = let is_nondynamic_tparam fexpr f = match follow fexpr.etype with - | TInst({ cl_kind = KTypeParameter(tl) }, _) -> - List.exists (fun t -> not (is_dynamic { fexpr with etype = t } f)) tl + | TInst({ cl_kind = KTypeParameter(ttp) }, _) -> + List.exists (fun t -> not (is_dynamic { fexpr with etype = t } f)) (get_constraints ttp) | _ -> false in @@ -68,8 +68,8 @@ let configure gen (is_dynamic:texpr->Type.tfield_access->bool) (change_expr:texp (* class types *) | TField(fexpr, f) when is_nondynamic_tparam fexpr f -> (match follow fexpr.etype with - | TInst( ({ cl_kind = KTypeParameter(tl) } as tp_cl), tp_tl) -> - let t = apply_params tp_cl.cl_params tp_tl (List.find (fun t -> not (is_dynamic { fexpr with etype = t } f)) tl) in + | TInst( ({ cl_kind = KTypeParameter(ttp) } as tp_cl), tp_tl) -> + let t = apply_params tp_cl.cl_params tp_tl (List.find (fun t -> not (is_dynamic { fexpr with etype = t } f)) (get_constraints ttp)) in { e with eexpr = TField(mk_cast t (run fexpr), f) } | _ -> Globals.die "" __LOC__) diff --git a/src/codegen/gencommon/enumToClass.ml b/src/codegen/gencommon/enumToClass.ml index 229256a12e9..4c1051d43f7 100644 --- a/src/codegen/gencommon/enumToClass.ml +++ b/src/codegen/gencommon/enumToClass.ml @@ -102,7 +102,7 @@ struct | _ -> ()); let c_types = if handle_type_params then - List.map (fun tp -> {tp with ttp_type=TInst (map_param (get_cl_t tp.ttp_type), [])}) en.e_params + List.map clone_param en.e_params else [] in @@ -120,7 +120,7 @@ struct | TFun(params,ret) -> let dup_types = if handle_type_params then - List.map (fun tp -> {tp with ttp_type = TInst (map_param (get_cl_t tp.ttp_type), [])}) en.e_params + List.map clone_param en.e_params else [] in diff --git a/src/codegen/gencommon/gencommon.ml b/src/codegen/gencommon/gencommon.ml index 24e0b8c97f1..4dc998fc58e 100644 --- a/src/codegen/gencommon/gencommon.ml +++ b/src/codegen/gencommon/gencommon.ml @@ -1137,11 +1137,14 @@ let mk_class_field ?(static = false) name t public pos kind params = (* this helper just duplicates the type parameter class, which is assumed that cl is. *) (* This is so we can use class parameters on function parameters, without running the risk of name clash *) (* between both *) -let map_param cl = +let clone_param ttp = + let cl = ttp.ttp_class in let ret = mk_class cl.cl_module (fst cl.cl_path, snd cl.cl_path ^ "_c") cl.cl_pos null_pos in ret.cl_implements <- cl.cl_implements; ret.cl_kind <- cl.cl_kind; - ret + let ttp = mk_type_param ret ttp.ttp_default ttp.ttp_constraints in + ret.cl_kind <- KTypeParameter ttp; + ttp let get_cl_t t = match follow t with | TInst (cl,_) -> cl | _ -> die "" __LOC__ diff --git a/src/codegen/gencommon/overloadingConstructor.ml b/src/codegen/gencommon/overloadingConstructor.ml index db11eecf471..91fc5c6af5b 100644 --- a/src/codegen/gencommon/overloadingConstructor.ml +++ b/src/codegen/gencommon/overloadingConstructor.ml @@ -113,16 +113,15 @@ 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 tp -> {tp with ttp_type = TInst(map_param (get_cl_t tp.ttp_type), [])}) cl.cl_params in + let ctor_types = List.map clone_param 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 - let after = List.map (apply_params cl.cl_params ctor_type_params) (before) in - c.cl_kind <- KTypeParameter(after) - | _ -> ()) - | _ -> ()) ctor_types; + List.iter (fun ttp -> match get_constraints ttp with + | [] -> + () + | before -> + let after = List.map (apply_params cl.cl_params ctor_type_params) before in + ttp.ttp_constraints <- Some (lazy after) + ) ctor_types; let me = alloc_var "__hx_this" (TInst(cl, extract_param_types ctor_types)) in add_var_flag me VCaptured; diff --git a/src/codegen/gencommon/realTypeParams.ml b/src/codegen/gencommon/realTypeParams.ml index bac5e5b60eb..5ed9d19c339 100644 --- a/src/codegen/gencommon/realTypeParams.ml +++ b/src/codegen/gencommon/realTypeParams.ml @@ -308,10 +308,9 @@ let set_hxgeneric gen md = if not ret then begin match md with | TClassDecl c -> - let set_hxgeneric tp = match follow tp.ttp_type with - | TInst(c,_) -> - c.cl_meta <- (Meta.NativeGeneric, [], c.cl_pos) :: c.cl_meta - | _ -> () + let set_hxgeneric tp = + let c = tp.ttp_class in + c.cl_meta <- (Meta.NativeGeneric, [], c.cl_pos) :: c.cl_meta in List.iter set_hxgeneric c.cl_params; let rec handle_field cf = @@ -400,7 +399,7 @@ struct 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 tp -> {tp with ttp_type=TInst (map_param (get_cl_t tp.ttp_type), [])}) curcls.cl_params in + let cparams = List.map clone_param 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 @@ -459,7 +458,7 @@ struct let create_cast_cfield gen cl name = reset_temps(); let basic = gen.gcon.basic 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 cparams = List.map clone_param cl.cl_params in let cfield = mk_class_field name (TFun([], t_dynamic)) false cl.cl_pos (Method MethNormal) cparams in let params = extract_param_types cparams in @@ -590,7 +589,7 @@ 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 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 cparams = List.map clone_param 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 = extract_param_types cparams in @@ -637,7 +636,7 @@ 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 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 cparams = List.map clone_param 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, extract_param_types cthis.cl_params); epos = cthis.cl_pos } in field.cf_expr <- Some { diff --git a/src/codegen/gencommon/renameTypeParameters.ml b/src/codegen/gencommon/renameTypeParameters.ml index 3ec5b2f104e..dd3e0cbfbf6 100644 --- a/src/codegen/gencommon/renameTypeParameters.ml +++ b/src/codegen/gencommon/renameTypeParameters.ml @@ -41,22 +41,16 @@ let run types = end else found_types := PMap.add name true !found_types in - let get_cls t = - match follow t with - | TInst(cl,_) -> cl - | _ -> Globals.die "" __LOC__ - in - let iter_types tp = - let cls = get_cls tp.ttp_type in + let cls = tp.ttp_class 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 tp -> - let cls = get_cls tp.ttp_type in - (cls.cl_path,tp.ttp_type) :: save) save params + let cls = tp.ttp_class in + (cls.cl_path,tp.ttp_class) :: save) save params in List.iter (function @@ -82,7 +76,7 @@ let run types = cl.cl_restore <- (fun () -> res(); List.iter (fun (path,t) -> - let cls = get_cls t in + let cls = t in cls.cl_path <- path) save ); end diff --git a/src/codegen/overloads.ml b/src/codegen/overloads.ml index dfba3040a32..3657e537f31 100644 --- a/src/codegen/overloads.ml +++ b/src/codegen/overloads.ml @@ -13,13 +13,10 @@ let same_overload_args ?(get_vmtype) t1 t2 f1 f2 = | [],[] -> true | tp1 :: params1,tp2 :: params2 -> - let constraints_equal t1 t2 = match follow t1,follow t2 with - | TInst({cl_kind = KTypeParameter tl1},_),TInst({cl_kind = KTypeParameter tl2},_) -> - Ast.safe_for_all2 f_eq tl1 tl2 - | _ -> - false + let constraints_equal ttp1 ttp2 = + Ast.safe_for_all2 f_eq (get_constraints ttp2) (get_constraints ttp2) in - tp1.ttp_name = tp2.ttp_name && constraints_equal tp1.ttp_type tp2.ttp_type && loop params1 params2 + tp1.ttp_name = tp2.ttp_name && constraints_equal tp1 tp2 && loop params1 params2 | [],_ | _,[] -> false diff --git a/src/context/abstractCast.ml b/src/context/abstractCast.ml index 4a066a72121..62afbfc23ec 100644 --- a/src/context/abstractCast.ml +++ b/src/context/abstractCast.ml @@ -119,10 +119,11 @@ let prepare_array_access_field ctx a pl cf 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 tp -> match follow tp.ttp_type with - | TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] -> + List.iter2 (fun m ttp -> match get_constraints ttp with + | [] -> + () + | constr -> List.iter (fun tc -> match follow m with TMono _ -> raise (Unify_error []) | _ -> Type.unify m (map tc) ) constr - | _ -> () ) monos cf.cf_params; in let get_ta() = diff --git a/src/context/display/displayFields.ml b/src/context/display/displayFields.ml index 6c576642e66..929ea7b4d62 100644 --- a/src/context/display/displayFields.ml +++ b/src/context/display/displayFields.ml @@ -56,10 +56,11 @@ 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 tp -> match follow tp.ttp_type with - | TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] -> + List.iter2 (fun m ttp -> match get_constraints ttp with + | [] -> + () + | constr -> List.iter (fun tc -> unify_raise m (map tc) e.epos) constr - | _ -> () ) monos f.cf_params; if not (can_access ctx c f true) || follow e.etype == t_dynamic && follow t != t_dynamic then acc @@ -157,9 +158,9 @@ let collect ctx e_ast e dk with_type p = List.fold_left fold_constraints items l in fold_constraints items (Monomorph.classify_down_constraints m) - | TInst ({cl_kind = KTypeParameter tl},_) -> + | TInst ({cl_kind = KTypeParameter ttp},_) -> (* Type parameters can access the fields of their constraints *) - List.fold_left (fun acc t -> loop acc t) items tl + List.fold_left (fun acc t -> loop acc t) items (get_constraints ttp) | TInst(c0,tl) -> (* For classes, browse the hierarchy *) let fields = TClass.get_all_fields c0 tl in diff --git a/src/context/display/displayToplevel.ml b/src/context/display/displayToplevel.ml index 86bbcff00fd..a7c07716429 100644 --- a/src/context/display/displayToplevel.ml +++ b/src/context/display/displayToplevel.ml @@ -449,10 +449,8 @@ let collect ctx tk with_type sort = end; (* type params *) - List.iter (fun tp -> match follow tp.ttp_type with - | TInst(c,_) -> - add (make_ci_type_param c (tpair tp.ttp_type)) (Some (snd c.cl_path)) - | _ -> die "" __LOC__ + List.iter (fun tp -> + add (make_ci_type_param tp.ttp_class (tpair tp.ttp_type)) (Some (snd tp.ttp_class.cl_path)) ) ctx.type_params; (* module types *) diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 7ec1d34ccab..f0fcded97f9 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -616,8 +616,8 @@ let can_access ctx c cf stat = loop c (* access is also allowed of we access a type parameter which is constrained to our (base) class *) || (match c.cl_kind with - | KTypeParameter tl -> - List.exists (fun t -> match follow t with TInst(c,_) -> loop c | _ -> false) tl + | KTypeParameter ttp -> + List.exists (fun t -> match follow t with TInst(c,_) -> loop c | _ -> false) (get_constraints ttp) | _ -> false) || (Meta.has Meta.PrivateAccess ctx.meta) diff --git a/src/core/display/completionItem.ml b/src/core/display/completionItem.ml index 16f47d54c01..b9032ece4d8 100644 --- a/src/core/display/completionItem.ml +++ b/src/core/display/completionItem.ml @@ -223,16 +223,14 @@ 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 tp = match follow tp.ttp_type with - | TInst(c,_) -> { - tp_name = tp.ttp_name,null_pos; + let convert_type_param ttp = + { + tp_name = ttp.ttp_name,null_pos; tp_params = []; tp_constraints = None; (* TODO? *) tp_default = None; (* TODO? *) - tp_meta = c.cl_meta + tp_meta = ttp.ttp_class.cl_meta } - | _ -> - die "" __LOC__ in { pack = fst infos.mt_path; @@ -784,11 +782,11 @@ let to_json ctx index item = | ITExpression e -> "Expression",generate_texpr ctx e | ITTypeParameter c -> begin match c.cl_kind with - | KTypeParameter tl -> + | KTypeParameter ttp -> "TypeParameter",jobject [ "name",jstring (snd c.cl_path); "meta",generate_metadata ctx c.cl_meta; - "constraints",jlist (generate_type ctx) tl; + "constraints",jlist (generate_type ctx) (get_constraints ttp); ] | _ -> die "" __LOC__ end diff --git a/src/core/json/genjson.ml b/src/core/json/genjson.ml index 3006c2f3e7a..a6b1b9d529e 100644 --- a/src/core/json/genjson.ml +++ b/src/core/json/genjson.ml @@ -276,15 +276,11 @@ and generate_type_path_with_params ctx mpath tpath tl meta = (* type parameter *) -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 +and generate_type_parameter ctx ttp = jobject [ - "name",jstring tp.ttp_name; - "constraints",generate_constraints (); - "defaultType",jopt (generate_type ctx) tp.ttp_default; + "name",jstring ttp.ttp_name; + "constraints",generate_types ctx (get_constraints ttp); + "defaultType",jopt (generate_type ctx) ttp.ttp_default; ] (* texpr *) @@ -602,7 +598,7 @@ let generate_class ctx c = let generate_class_kind ck = let ctor,args = match ck with | KNormal -> "KNormal",None - | KTypeParameter tl -> "KTypeParameter",Some (generate_types ctx tl) + | KTypeParameter ttp -> "KTypeParameter",Some (generate_types ctx (get_constraints ttp)) | KExpr e -> "KExpr",Some (generate_expr ctx e) | KGeneric -> "KGeneric",None | KGenericInstance(c,tl) -> "KGenericInstance",Some (generate_type_path_with_params ctx c.cl_module.m_path c.cl_path tl c.cl_meta) diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index f9aec9853e3..9f3240a37f0 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -373,15 +373,11 @@ let apply_params ?stack cparams params t = let rec loop l1 l2 = match l1, l2 with | [] , [] -> [] - | {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 + | ttp :: l1 , t2 :: l2 -> (ttp.ttp_class,t2) :: loop l1 l2 | _ -> die "" __LOC__ in let subst = loop cparams params in let rec loop t = - try - List.assq t subst - with Not_found -> match t with | TMono r -> (match r.tm_type with @@ -444,6 +440,12 @@ let apply_params ?stack cparams params t = (match tl with | [] -> t | _ -> TAbstract (a,List.map loop tl)) + | TInst ({cl_kind = KTypeParameter _} as c,[]) -> + begin try + List.assq c subst + with Not_found -> + t + end | TInst (c,tl) -> (match tl with | [] -> @@ -653,9 +655,11 @@ let lookup_param n l = in loop l -let mk_type_param n t def = { - ttp_name = n; - ttp_type = t; +let mk_type_param c def constraints = { + ttp_name = snd c.cl_path; + ttp_type = TInst(c,[]); + ttp_class = c; + ttp_constraints = constraints; ttp_default = def; } @@ -687,13 +691,19 @@ let tconst_to_const = function | TThis -> Ident "this" | TSuper -> Ident "super" +let get_constraints ttp = match ttp.ttp_constraints with + | None -> + [] + | Some r -> + Lazy.force r + let has_ctor_constraint c = match c.cl_kind with - | KTypeParameter tl -> + | KTypeParameter ttp -> List.exists (fun t -> match follow t with | TAnon a when PMap.mem "new" a.a_fields -> true | TAbstract({a_path=["haxe"],"Constructible"},_) -> true | _ -> false - ) tl; + ) (get_constraints ttp); | _ -> false (* ======= Field utility ======= *) @@ -741,7 +751,7 @@ let rec raw_class_field build_type c tl i = c2, apply_params c.cl_params tl t , f with Not_found -> match c.cl_kind with - | KTypeParameter tl -> + | KTypeParameter ttp -> let rec loop = function | [] -> raise Not_found @@ -762,7 +772,7 @@ let rec raw_class_field build_type c tl i = | _ -> loop ctl in - loop tl + loop (get_constraints ttp) | _ -> if not (has_class_flag c CInterface) then raise Not_found; (* diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml index a7126d4d281..0757e7cda56 100644 --- a/src/core/tPrinting.ml +++ b/src/core/tPrinting.ml @@ -380,8 +380,8 @@ let s_types ?(sep = ", ") tl = let s_class_kind = function | KNormal -> "KNormal" - | KTypeParameter tl -> - Printf.sprintf "KTypeParameter [%s]" (s_types tl) + | KTypeParameter ttp -> + Printf.sprintf "KTypeParameter [%s]" (s_types (get_constraints ttp)) | KExpr _ -> "KExpr" | KGeneric -> @@ -441,19 +441,17 @@ module Printer = struct let s_metadata metadata = s_list " " s_metadata_entry metadata - let s_type_param tp = match follow tp.ttp_type with - | TInst({cl_kind = KTypeParameter tl1},tl2) -> - 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__ + let s_type_param ttp = + let s = match (get_constraints ttp) with + | [] -> ttp.ttp_name + | tl1 -> Printf.sprintf "%s:%s" ttp.ttp_name (String.concat " & " (List.map s_type tl1)) + in + begin match ttp.ttp_default with + | None -> + s + | Some t -> + Printf.sprintf "%s = %s" s (s_type t) + end let s_type_params tl = s_list ", " s_type_param tl diff --git a/src/core/tType.ml b/src/core/tType.ml index f313959a78a..2a5e8fb2723 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -93,6 +93,8 @@ and tparams = t list and typed_type_param = { ttp_name : string; ttp_type : t; + ttp_class : tclass; + mutable ttp_constraints : t list Lazy.t option; ttp_default : t option; } @@ -232,7 +234,7 @@ and tclass_field = { and tclass_kind = | KNormal - | KTypeParameter of t list + | KTypeParameter of typed_type_param | KExpr of Ast.expr | KGeneric | KGenericInstance of tclass * tparams diff --git a/src/core/tUnification.ml b/src/core/tUnification.ml index 6335fd4a5d7..25bad0a5f81 100644 --- a/src/core/tUnification.ml +++ b/src/core/tUnification.ml @@ -260,13 +260,13 @@ module Monomorph = struct let spawn_constrained_monos map params = let checks = DynArray.create () in - let monos = List.map (fun tp -> + let monos = List.map (fun ttp -> let mono = create () in - 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) - | _ -> + begin match get_constraints ttp with + | [] -> () + | constr -> + DynArray.add checks (mono,constr,s_type_path ttp.ttp_class.cl_path) end; TMono mono ) params in @@ -695,12 +695,13 @@ let rec unify (uctx : unification_context) a b = loop cs (List.map (apply_params c.cl_params tl) tls) ) c.cl_implements || (match c.cl_kind with - | KTypeParameter pl -> List.exists (fun t -> - match follow t with - | TInst (cs,tls) -> loop cs (List.map (apply_params c.cl_params tl) tls) - | TAbstract(aa,tl) -> unifies_to uctx a b aa tl - | _ -> false - ) pl + | KTypeParameter ttp -> + List.exists (fun t -> + match follow t with + | TInst (cs,tls) -> loop cs (List.map (apply_params c.cl_params tl) tls) + | TAbstract(aa,tl) -> unifies_to uctx a b aa tl + | _ -> false + ) (get_constraints ttp) | _ -> false) in if not (loop c1 tl1) then error [cannot_unify a b] @@ -722,9 +723,9 @@ let rec unify (uctx : unification_context) a b = error (cannot_unify a b :: msg :: l)) | TInst (c,tl) , TAnon an -> if PMap.is_empty an.a_fields then (match c.cl_kind with - | KTypeParameter pl -> + | KTypeParameter ttp -> (* one of the constraints must unify with { } *) - if not (List.exists (fun t -> match follow t with TInst _ | TAnon _ -> true | _ -> false) pl) then error [cannot_unify a b] + if not (List.exists (fun t -> match follow t with TInst _ | TAnon _ -> true | _ -> false) (get_constraints ttp)) then error [cannot_unify a b] | _ -> ()); ignore(c.cl_build()); (try @@ -824,9 +825,9 @@ let rec unify (uctx : unification_context) a b = | TInst(c,tl),TAbstract({a_path = ["haxe"],"Constructible"},[t1]) -> begin try begin match c.cl_kind with - | KTypeParameter tl -> + | KTypeParameter ttp -> (* type parameters require an equal Constructible constraint *) - if not (List.exists (fun t -> match follow t with TAbstract({a_path = ["haxe"],"Constructible"},[t2]) -> type_iseq uctx t1 t2 | _ -> false) tl) then error [cannot_unify a b] + if not (List.exists (fun t -> match follow t with TAbstract({a_path = ["haxe"],"Constructible"},[t2]) -> type_iseq uctx t1 t2 | _ -> false) (get_constraints ttp)) then error [cannot_unify a b] | _ -> let _,t,cf = class_field c tl "new" in if not (has_class_field_flag cf CfPublic) then error [invalid_visibility "new"]; @@ -884,12 +885,12 @@ let rec unify (uctx : unification_context) a b = end | TAbstract (aa,tl), _ -> unify_to uctx a b aa tl - | TInst ({ cl_kind = KTypeParameter ctl } as c,pl), TAbstract (bb,tl) -> + | TInst ({ cl_kind = KTypeParameter ttp } as c,pl), TAbstract (bb,tl) -> (* one of the constraints must satisfy the abstract *) if not (List.exists (fun t -> let t = apply_params c.cl_params pl t in try unify uctx t b; true with Unify_error _ -> false - ) ctl) then unify_from uctx a b bb tl + ) (get_constraints ttp)) then unify_from uctx a b bb tl | _, TAbstract (bb,tl) -> unify_from uctx a b bb tl | _ , _ -> @@ -1136,7 +1137,7 @@ module UnifyMinT = struct let rec loop t = (match t with | TInst(cl, params) -> (match cl.cl_kind with - | KTypeParameter tl -> List.iter loop tl + | KTypeParameter ttp -> List.iter loop (get_constraints ttp) | _ -> ()); List.iter (fun (ic, ip) -> let t = apply_params cl.cl_params params (TInst (ic,ip)) in diff --git a/src/filters/filtersCommon.ml b/src/filters/filtersCommon.ml index cddaf31a10a..aa862dd718d 100644 --- a/src/filters/filtersCommon.ml +++ b/src/filters/filtersCommon.ml @@ -27,11 +27,8 @@ let rec is_removable_class c = (match c.cl_super with | Some (c,_) -> is_removable_class c | _ -> false) || - List.exists (fun tp -> match follow tp.ttp_type with - | TInst(c,_) -> - has_ctor_constraint c || Meta.has Meta.Const c.cl_meta - | _ -> - false + List.exists (fun tp -> + has_ctor_constraint tp.ttp_class || Meta.has Meta.Const tp.ttp_class.cl_meta ) c.cl_params) | KTypeParameter _ -> (* this shouldn't happen, have to investigate (see #4092) *) diff --git a/src/generators/gencs.ml b/src/generators/gencs.ml index cb474ed7168..08002d807ef 100644 --- a/src/generators/gencs.ml +++ b/src/generators/gencs.ml @@ -2009,18 +2009,17 @@ let generate con = let hxgen = is_hxgen (TClassDecl cl) in match cl_params with | (_ :: _) when not (erase_generics && is_hxgeneric (TClassDecl cl)) -> - let get_param_name t = match follow t with TInst(cl, _) -> snd cl.cl_path | _ -> die "" __LOC__ in 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 tp -> get_param_name tp.ttp_type) cl_params)) in + let params = sprintf "<%s>" (String.concat ", " (List.map (fun tp -> snd tp.ttp_class.cl_path) cl_params)) in let params_extends = if hxgen || not (Meta.has (Meta.NativeGen) cl.cl_meta) then [""] else List.fold_left (fun acc {ttp_name=name;ttp_type=t} -> - match run_follow gen t with - | TInst({cl_kind = KTypeParameter constraints}, _) when constraints <> [] -> + match t with + | TInst({cl_kind = KTypeParameter ttp} as c,_) when get_constraints ttp <> [] -> (* base class should come before interface constraints *) let base_class_constraints = ref [] in let other_constraints = List.fold_left (fun acc t -> @@ -2069,7 +2068,7 @@ let generate con = (* skip anything other *) | _ -> acc - ) [] constraints in + ) [] (get_constraints ttp ) in let s_constraints = (List.sort (* C# expects some ordering for built-in constraints: *) @@ -2085,7 +2084,7 @@ let generate con = ) (!base_class_constraints @ other_constraints)) in if s_constraints <> [] then - (sprintf " where %s : %s" (get_param_name t) (String.concat ", " (List.map get_constraint s_constraints)) :: acc) + (sprintf " where %s : %s" (snd c.cl_path) (String.concat ", " (List.map get_constraint s_constraints)) :: acc) else acc; | _ -> acc diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml index cff859dcf9f..16b04edb53d 100644 --- a/src/generators/genhl.ml +++ b/src/generators/genhl.ml @@ -361,7 +361,7 @@ let make_debug ctx arr = let fake_tnull = {null_abstract with a_path = [],"Null"; - a_params = [{ttp_name = "T"; ttp_type = t_dynamic; ttp_default = None}]; + a_params = [mk_type_param null_class None None]; } let get_rec_cache ctx t none_callback not_found_callback = @@ -435,7 +435,7 @@ let rec to_type ?tref ctx t = HAbstract (name, alloc_string ctx name) | TInst (c,pl) -> (match c.cl_kind with - | KTypeParameter tl -> + | KTypeParameter ttp -> let rec loop = function | [] -> HDyn | t :: tl -> @@ -443,7 +443,7 @@ let rec to_type ?tref ctx t = | TInst (c,_) as t when not (has_class_flag c CInterface) -> to_type ?tref ctx t | _ -> loop tl in - loop tl + loop (get_constraints ttp) | _ -> class_type ~tref ctx c pl false) | TAbstract ({a_path = [],"Null"},[t1]) -> let t = to_type ?tref ctx t1 in @@ -2173,9 +2173,9 @@ and eval_expr ctx e = match follow t with | TFun (_,rt) -> (match follow rt with - | TInst({ cl_kind = KTypeParameter tl },_) -> + | TInst({ cl_kind = KTypeParameter ttp },_) -> (* don't allow if we have a constraint virtual, see hxbit.Serializer.getRef *) - not (List.exists (fun t -> match to_type ctx t with HVirtual _ -> true | _ -> false) tl) + not (List.exists (fun t -> match to_type ctx t with HVirtual _ -> true | _ -> false) (get_constraints ttp)) | _ -> false) | _ -> false diff --git a/src/generators/genjava.ml b/src/generators/genjava.ml index c80a388eb1d..71e199d6cb8 100644 --- a/src/generators/genjava.ml +++ b/src/generators/genjava.ml @@ -1904,17 +1904,8 @@ let generate con = | [] -> ("","") | _ -> - 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 - | [] -> acc - | _ -> acc) (* TODO - | _ -> (sprintf " where %s : %s" name (String.concat ", " (List.map (fun (cl,p) -> path_param_s (TClassDecl cl) cl.cl_path p) cl.cl_implements))) :: acc ) *) - | _ -> trace (t_s null_pos t); die "" __LOC__ (* FIXME it seems that a cl_params will never be anything other than cl.cl_params. I'll take the risk and fail if not, just to see if that confirms *) - ) [] cl_params in - (params, String.concat " " params_extends) + let params = sprintf "<%s>" (String.concat ", " (List.map (fun tp -> snd tp.ttp_class.cl_path) cl_params)) in + (params, "") in let write_parts w parts = diff --git a/src/generators/genjvm.ml b/src/generators/genjvm.ml index 952f9920e19..7efa5cd4968 100644 --- a/src/generators/genjvm.ml +++ b/src/generators/genjvm.ml @@ -202,8 +202,11 @@ let rec jsignature_of_type gctx stack t = TObject((["haxe";"root"],"Array"),[TType(WNone,t)]) | TInst({cl_path = (["java"],"NativeArray")},[t]) -> TArray(jsignature_of_type t,None) - | TInst({cl_kind = KTypeParameter [t]},_) when t != t_dynamic -> jsignature_of_type t - | TInst({cl_kind = KTypeParameter _; cl_path = (_,name)},_) -> TTypeParameter name + | TInst({cl_kind = KTypeParameter ttp; cl_path = (_,name)},_) -> + begin match get_constraints ttp with + | [t] when t != t_dynamic -> jsignature_of_type t + | _ -> TTypeParameter name + end | TInst({cl_path = ["_Class"],"Class_Impl_"},_) -> java_class_sig | TInst({cl_path = ["_Enum"],"Enum_Impl_"},_) -> java_class_sig | TInst(c,tl) -> TObject(c.cl_path,List.map jtype_argument_of_type tl) @@ -2640,16 +2643,11 @@ class tclass_to_jvm gctx c = object(self) end method private generate_signature = - 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) - ) tl - | _ -> - [] - in - (tp.ttp_name,jsigs) + jc#set_type_parameters (List.map (fun ttp -> + let jsigs = List.map (fun t -> + get_boxed_type (jsignature_of_type gctx t) + ) (get_constraints ttp) in + (ttp.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/genlua.ml b/src/generators/genlua.ml index 79b2d703af4..3bbd314104e 100644 --- a/src/generators/genlua.ml +++ b/src/generators/genlua.ml @@ -281,7 +281,7 @@ let mk_mr_select com e ecall name = (* from genphp *) let rec is_string_type t = match follow t with - | TInst ({cl_kind = KTypeParameter constraints}, _) -> List.exists is_string_type constraints + | TInst ({cl_kind = KTypeParameter ttp}, _) -> List.exists is_string_type (get_constraints ttp) | TInst ({cl_path = ([], "String")}, _) -> true | TAnon a -> (match !(a.a_status) with diff --git a/src/generators/genswf.ml b/src/generators/genswf.ml index 4b44acc271c..c37632448a6 100644 --- a/src/generators/genswf.ml +++ b/src/generators/genswf.ml @@ -149,9 +149,7 @@ let build_dependencies t = | Some x -> add_inherit x); List.iter (fun tp -> (* add type-parameters constraints dependencies *) - match follow tp.ttp_type with - | TInst (c,_) -> List.iter add_inherit c.cl_implements - | _ -> () + List.iter add_inherit tp.ttp_class.cl_implements ) c.cl_params; List.iter add_inherit c.cl_implements; | TEnumDecl e when not e.e_extern -> diff --git a/src/generators/genswf9.ml b/src/generators/genswf9.ml index 4403837e1f0..b689717e5fc 100644 --- a/src/generators/genswf9.ml +++ b/src/generators/genswf9.ml @@ -238,8 +238,8 @@ let rec type_id ctx t = | _ -> def()) | TInst (c,_) -> (match c.cl_kind with - | KTypeParameter l -> - (match l with + | KTypeParameter ttp -> + (match get_constraints ttp with | [t] -> type_id ctx t | _ -> type_path ctx ([],"Object")) | _ -> diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index 78cb4d4286e..69871e0629d 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -1143,7 +1143,7 @@ and encode_method_kind m = and encode_class_kind k = let tag, pl = (match k with | KNormal -> 0, [] - | KTypeParameter pl -> 1, [encode_tparams pl] + | KTypeParameter ttp -> 1, [encode_tparams (get_constraints ttp)] (* TTPTODO *) | KModuleFields m -> 2, [encode_string (s_type_path m.m_path)] | KExpr e -> 3, [encode_expr e] | KGeneric -> 4, [] @@ -1443,14 +1443,6 @@ let decode_tconst c = | 6, [] -> TSuper | _ -> raise Invalid_expr -let decode_type_params 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) @@ -1479,31 +1471,6 @@ let decode_field_kind v = | 1, [m] -> Method (decode_method_kind m) | _ -> raise Invalid_expr -let decode_cfield v = - let public = decode_bool (field v "isPublic") in - let extern = decode_bool (field v "isExtern") in - let final = decode_bool (field v "isFinal") in - let abstract = decode_bool (field v "isAbstract") in - let cf = { - cf_name = decode_string (field v "name"); - cf_type = decode_type (field v "type"); - cf_pos = decode_pos (field v "pos"); - cf_name_pos = decode_pos (field v "namePos"); - cf_doc = decode_doc (field v "doc"); - cf_meta = []; (* TODO *) - cf_kind = decode_field_kind (field v "kind"); - cf_params = decode_type_params (field v "params"); - cf_expr = None; - cf_expr_unoptimized = None; - cf_overloads = decode_ref (field v "overloads"); - cf_flags = 0; - } in - if public then add_class_field_flag cf CfPublic; - if extern then add_class_field_flag cf CfExtern; - if final then add_class_field_flag cf CfFinal; - if abstract then add_class_field_flag cf CfAbstract; - cf - let decode_efield v = let rec get_enum t = match follow t with @@ -2304,10 +2271,13 @@ 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 -> - 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 + let c = match t with + | TInst(c,_) -> c + | _ -> die "" __LOC__ + in + mk_type_param c default None ) (decode_array tpl) in let rec map t = match t with | TInst({cl_kind = KTypeParameter _},_) -> diff --git a/src/optimization/dce.ml b/src/optimization/dce.ml index 498887fb14d..b4a1a7b4944 100644 --- a/src/optimization/dce.ml +++ b/src/optimization/dce.ml @@ -247,10 +247,10 @@ and mark_t dce p t = if not (List.exists (fun t2 -> Type.fast_eq t t2) dce.t_stack) then begin dce.t_stack <- t :: dce.t_stack; begin match follow t with - | TInst({cl_kind = KTypeParameter tl} as c,pl) -> + | TInst({cl_kind = KTypeParameter ttp} as c,pl) -> if not (Meta.has Meta.Used c.cl_meta) then begin c.cl_meta <- (mk_used_meta c.cl_pos) :: c.cl_meta; - List.iter (mark_t dce p) tl; + List.iter (mark_t dce p) (get_constraints ttp); end; List.iter (mark_t dce p) pl | TInst(c,pl) -> @@ -358,7 +358,7 @@ and field dce c n kind = end else match c.cl_super with Some (csup,_) -> field dce csup n kind | None -> raise Not_found with Not_found -> try match c.cl_kind with - | KTypeParameter tl -> + | KTypeParameter ttp -> let rec loop tl = match tl with | [] -> raise Not_found | TInst(c,_) :: cl -> @@ -366,7 +366,7 @@ and field dce c n kind = | t :: tl -> loop tl in - loop tl + loop (get_constraints ttp) | _ -> raise Not_found with Not_found -> if dce.debug then prerr_endline ("[DCE] Field " ^ n ^ " not found on " ^ (s_type_path c.cl_path)) else ()) diff --git a/src/optimization/inline.ml b/src/optimization/inline.ml index ab1ee4733da..d953b689a4f 100644 --- a/src/optimization/inline.ml +++ b/src/optimization/inline.ml @@ -234,7 +234,7 @@ let inline_default_config cf t = c.cl_params @ ct, pl @ cpl in let rec loop t = match follow t with - | TInst({cl_kind = KTypeParameter tl},_) -> List.fold_left (fun (params',tl') (params,tl) -> (params @ params',tl @ tl')) ([],[]) (List.map loop tl) + | TInst({cl_kind = KTypeParameter ttp},_) -> List.fold_left (fun (params',tl') (params,tl) -> (params @ params',tl @ tl')) ([],[]) (List.map loop (get_constraints ttp)) | TInst (c,pl) -> get_params c pl | _ -> ([],[]) in diff --git a/src/typing/fields.ml b/src/typing/fields.ml index 523d42e6f16..5ed4aba0f2e 100644 --- a/src/typing/fields.ml +++ b/src/typing/fields.ml @@ -319,11 +319,11 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) = snd (class_field_with_access e c tl) with Not_found -> try match c.cl_kind with - | KTypeParameter tl -> + | KTypeParameter ttp -> type_field_by_list (fun t -> match follow t with | TAbstract _ -> type_field_by_e type_field_by_type (mk_cast e t p); | _ -> raise Not_found - ) tl + ) (get_constraints ttp) | _ -> raise Not_found with Not_found -> type_field_by_interfaces e c diff --git a/src/typing/generic.ml b/src/typing/generic.ml index 131bec204b9..70bc96890d7 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -62,7 +62,7 @@ let make_generic ctx ps pt debug p = let rec loop acc_name acc_subst ttpl tl = match ttpl,tl with | ttp :: ttpl,t :: tl -> let name,t = try process t with Exit -> raise_typing_error ("Could not determine type for parameter " ^ ttp.ttp_name) p in - loop (name :: acc_name) ((follow ttp.ttp_type,t) :: acc_subst) ttpl tl + loop (name :: acc_name) ((ttp.ttp_type,t) :: acc_subst) ttpl tl | [],[] -> let name = String.concat "_" (List.rev acc_name) in name,acc_subst @@ -239,8 +239,9 @@ let build_generic_class ctx c p tl = | TInst (c2,tl) -> (match c2.cl_kind with | KTypeParameter tl -> - if not (TypeloadCheck.is_generic_parameter ctx c2) && has_ctor_constraint c2 then - raise_typing_error "Type parameters with a constructor cannot be used non-generically" p; + (* TPTODO *) + (* if not (TypeloadCheck.is_generic_parameter ctx c2) && has_ctor_constraint c2 then + raise_typing_error "Type parameters with a constructor cannot be used non-generically" p; *) recurse := true | _ -> ()); List.iter check_recursive tl; @@ -306,24 +307,20 @@ let build_generic_class ctx c p tl = add_dependency ctx.m.curmod mg; set_type_parameter_dependencies mg 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) 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,({tp with ttp_type=t2}) :: params - | _ -> die "" __LOC__ - ) ([],[]) cf_old.cf_params in + let params = List.map (fun ttp -> + let c = {ttp.ttp_class with cl_module = mg} in + let def = Option.map (generic_substitute_type gctx) ttp.ttp_default in + let constraints = match ttp.ttp_constraints with + | None -> None + | Some constraints -> Some (lazy (List.map (generic_substitute_type gctx) (Lazy.force constraints))) + in + let ttp' = mk_type_param c def constraints in + (ttp.ttp_type,ttp') + ) cf_old.cf_params in + let param_subst = List.map (fun (t,ttp) -> t,(ttp.ttp_type,None)) params in let gctx = {gctx with subst = param_subst @ gctx.subst} in let cf_new = {cf_old with cf_pos = cf_old.cf_pos; cf_expr_unoptimized = None} in (* copy *) - (* Type parameter constraints are substituted here. *) - 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; - tp (* TPTODO: weird mapping *) - | _ -> die "" __LOC__ - ) params; + cf_new.cf_params <- List.map (fun (_,ttp) -> ttp) params; let f () = ignore(follow cf_old.cf_type); (* We update here because the follow could resolve some TLazy things that end up modifying flags, such as diff --git a/src/typing/operators.ml b/src/typing/operators.ml index c297650c1a3..b9f0b7c927b 100644 --- a/src/typing/operators.ml +++ b/src/typing/operators.ml @@ -118,9 +118,9 @@ let rec classify t = | TAbstract ({ a_path = [],"Int" },[]) -> KInt | TAbstract ({ a_path = [],"Float" },[]) -> KFloat | TAbstract (a,[]) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) a.a_to -> KNumParam t - | TInst ({ cl_kind = KTypeParameter ctl },_) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) ctl -> KNumParam t + | TInst ({ cl_kind = KTypeParameter ttp },_) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) (get_constraints ttp) -> KNumParam t | TAbstract (a,[]) when List.exists (fun t -> match classify t with KString -> true | _ -> false) a.a_to -> KStrParam t - | TInst ({ cl_kind = KTypeParameter ctl },_) when List.exists (fun t -> match classify t with KString -> true | _ -> false) ctl -> KStrParam t + | TInst ({ cl_kind = KTypeParameter ttp },_) when List.exists (fun t -> match classify t with KString -> true | _ -> false) (get_constraints ttp) -> KStrParam t | TMono r when r.tm_type = None -> KUnk | TDynamic _ -> KDyn | _ -> KOther diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index e748a1d5271..66ee7d44d8a 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -286,28 +286,24 @@ let make_extension_type ctx tl = let ta = mk_anon ~fields (ref (Extend tl)) in ta -let check_param_constraints ctx t map c p = - match follow t with - | TMono _ -> () - | _ -> - let ctl = (match c.cl_kind with KTypeParameter l -> l | _ -> []) in - List.iter (fun ti -> - let ti = map ti in - try - unify_raise t ti p - with Error ({ err_message = Unify l } as err) -> - let fail() = - if not ctx.untyped then display_error_ext ctx.com { err with err_message = (Unify (Constraint_failure (s_type_path c.cl_path) :: l)) } - in - match follow t with - | TInst({cl_kind = KExpr e},_) -> - let e = type_expr {ctx with locals = PMap.empty} e (WithType.with_type ti) in - begin try unify_raise e.etype ti p - with Error { err_message = Unify _ } -> fail() end - | _ -> - fail() +let check_param_constraints ctx t map ttp p = + List.iter (fun ti -> + let ti = map ti in + try + unify_raise t ti p + with Error ({ err_message = Unify l } as err) -> + let fail() = + if not ctx.untyped then display_error_ext ctx.com { err with err_message = (Unify (Constraint_failure (s_type_path ttp.ttp_class.cl_path) :: l)) } + in + match follow t with + | TInst({cl_kind = KExpr e},_) -> + let e = type_expr {ctx with locals = PMap.empty} e (WithType.with_type ti) in + begin try unify_raise e.etype ti p + with Error { err_message = Unify _ } -> fail() end + | _ -> + fail() - ) ctl + ) (get_constraints ttp) type load_instance_param_mode = | ParamNormal @@ -357,7 +353,8 @@ let rec load_params ctx info params p = in let checks = DynArray.create () in let rec loop tl1 tl2 is_rest = match tl1,tl2 with - | t :: tl1,({ttp_name=name;ttp_type=t2}) :: tl2 -> + | t :: tl1,ttp:: tl2 -> + let name = ttp.ttp_name in let t,pt = load_param t in let check_const c = let is_expression = (match t with TInst ({ cl_kind = KExpr _ },_) -> true | _ -> false) in @@ -370,15 +367,14 @@ let rec load_params ctx info params p = raise_typing_error "Type parameter is expected to be a constant value" p in let is_rest = is_rest || name = "Rest" && info.build_kind = BuildGenericBuild in - let t = match follow t2 with - | TInst ({ cl_kind = KTypeParameter [] } as c, []) when (match info.build_kind with BuildGeneric _ -> false | _ -> true) -> - check_const c; + let t = match ttp.ttp_constraints with + | None when (match info.build_kind with BuildGeneric _ -> false | _ -> true) -> + check_const ttp.ttp_class; t - | TInst (c,[]) -> - check_const c; - DynArray.add checks (t,c,pt); + | _ -> + check_const ttp.ttp_class; + DynArray.add checks (t,ttp,pt); t - | _ -> die "" __LOC__ in t :: loop tl1 tl2 is_rest | [],[] -> @@ -753,7 +749,6 @@ 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 host c.cl_path get_params p tp.tp_params; - c.cl_kind <- KTypeParameter []; c.cl_meta <- tp.Ast.tp_meta; 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 @@ -777,32 +772,36 @@ let rec type_type_param ctx host path get_params p tp = ) "default" in Some (TLazy r) in - match tp.tp_constraints with - | None -> - mk_type_param n t default - | Some th -> - let r = make_lazy ctx t (fun r -> - let ctx = { ctx with type_params = ctx.type_params @ get_params() } in - let rec loop th = match fst th with - | CTIntersection tl -> List.map (load_complex_type ctx true) tl - | CTParent ct -> loop ct - | _ -> [load_complex_type ctx true th] - in - let constr = loop th in - (* check against direct recursion *) - let rec loop t = - match follow t with - | TInst (c2,_) when c == c2 -> raise_typing_error "Recursive constraint parameter is not allowed" p - | TInst ({ cl_kind = KTypeParameter cl },_) -> - List.iter loop cl - | _ -> - () - in - List.iter loop constr; - c.cl_kind <- KTypeParameter constr; - t - ) "constraint" in - mk_type_param n (TLazy r) default + let ttp = match tp.tp_constraints with + | None -> + mk_type_param c default None + | Some th -> + let constraints = lazy ( + let ctx = { ctx with type_params = ctx.type_params @ get_params() } in + let rec loop th = match fst th with + | CTIntersection tl -> List.map (load_complex_type ctx true) tl + | CTParent ct -> loop ct + | _ -> [load_complex_type ctx true th] + in + let constr = loop th in + (* check against direct recursion *) + let rec loop t = + match follow t with + | TInst (c2,_) when c == c2 -> + raise_typing_error "Recursive constraint parameter is not allowed" p + | TInst ({ cl_kind = KTypeParameter ttp },_) -> + List.iter loop (get_constraints ttp) + | _ -> + () + in + List.iter loop constr; + constr + ) in + delay ctx PConnectField (fun () -> ignore (Lazy.force constraints)); + mk_type_param c default (Some constraints) + in + c.cl_kind <- KTypeParameter ttp; + ttp and type_type_params ctx host path get_params p tpl = let names = ref [] in @@ -845,21 +844,16 @@ 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 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 - with - | Invalid_argument _ -> - raise_typing_error "Type parameters must have the same number of constraints as core type" c.cl_pos - | Unify_error l -> - (* TODO send as one call with sub errors *) - display_error ctx.com ("Type parameter " ^ tp2.ttp_name ^ " has different constraint than in core type") c.cl_pos; - display_error ctx.com (error_msg (Unify l)) c.cl_pos; - end - | t1,t2 -> - Printf.printf "%s %s" (s_type (print_context()) t1) (s_type (print_context()) t2); - die "" __LOC__ + List.iter2 (fun ttp1 ttp2 -> + try + List.iter2 (fun t1 t2 -> type_eq EqCoreType t2 t1) (get_constraints ttp1) (get_constraints ttp2) + with + | Invalid_argument _ -> + raise_typing_error "Type parameters must have the same number of constraints as core type" c.cl_pos + | Unify_error l -> + (* TODO send as one call with sub errors *) + display_error ctx.com ("Type parameter " ^ ttp2.ttp_name ^ " has different constraint than in core type") c.cl_pos; + display_error ctx.com (error_msg (Unify l)) c.cl_pos; ) ccore.cl_params c.cl_params; with Invalid_argument _ -> raise_typing_error "Class must have the same number of type parameters as core type" c.cl_pos diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index b9030afd9c5..a144dcace14 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -62,28 +62,27 @@ let valid_redefinition ctx map1 map2 f1 t1 f2 t2 = (* child, parent *) | l1, l2 when List.length l1 = List.length l2 -> let to_check = ref [] in (* 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 - | [], [] -> () - | _, _ when List.length ct1 = List.length ct2 -> - (* if same constraints, they are the same type *) - let check monos = - List.iter2 (fun t1 t2 -> - try - let t1 = apply_params l1 monos (apply_params c1.cl_params pl1 (map2 t1)) in - let t2 = apply_params l2 monos (apply_params c2.cl_params pl2 (map1 t2)) in - type_eq EqStrict t1 t2 - with Unify_error l -> - raise (Unify_error (Unify_custom "Constraints differ" :: l)) - ) ct1 ct2 - in - to_check := check :: !to_check; - | _ -> - raise (Unify_error [Unify_custom "Different number of constraints"])) - | _ -> ()); - TInst (mk_class null_module ([],tp1.ttp_name) null_pos null_pos,[]) + let monos = List.map2 (fun ttp1 ttp2 -> + let ct1 = get_constraints ttp1 in + let ct2 = get_constraints ttp2 in + (match ct1, ct2 with + | [], [] -> () + | _, _ when List.length ct1 = List.length ct2 -> + (* if same constraints, they are the same type *) + let check monos = + List.iter2 (fun t1 t2 -> + try + let t1 = apply_params l1 monos (map2 t1) in + let t2 = apply_params l2 monos (map1 t2) in + type_eq EqStrict t1 t2 + with Unify_error l -> + raise (Unify_error (Unify_custom "Constraints differ" :: l)) + ) ct1 ct2 + in + to_check := check :: !to_check; + | _ -> + raise (Unify_error [Unify_custom "Different number of constraints"])); + TInst (mk_class null_module ([],ttp1.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/typer.ml b/src/typing/typer.ml index 3b2a53ffad8..f8f69f69da9 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -1046,9 +1046,9 @@ and type_new ctx ptp el with_type force_inline p = unify_constructor_call c fa in try begin match Abstract.follow_with_forward_ctor t with - | TInst ({cl_kind = KTypeParameter tl} as c,params) -> + | TInst ({cl_kind = KTypeParameter ttp} as c,params) -> if not (TypeloadCheck.is_generic_parameter ctx c) then raise_typing_error "Only generic type parameters can be constructed" p; - begin match get_constructible_constraint ctx tl p with + begin match get_constructible_constraint ctx (get_constraints ttp) p with | None -> raise_typing_error_ext (make_error (No_constructor (TClassDecl c)) p) | Some(tl,tr) -> diff --git a/src/typing/typerBase.ml b/src/typing/typerBase.ml index 3dea5bf637a..b03fce5ebe2 100644 --- a/src/typing/typerBase.ml +++ b/src/typing/typerBase.ml @@ -309,8 +309,8 @@ let get_constructible_constraint ctx tl p = end; | TAbstract({a_path = ["haxe"],"Constructible"},[t1]) -> Some (extract_function t1) - | TInst({cl_kind = KTypeParameter tl1},_) -> - begin match loop tl1 with + | TInst({cl_kind = KTypeParameter ttp},_) -> + begin match loop (get_constraints ttp) with | None -> loop tl | Some _ as t -> t end diff --git a/src/typing/typerDisplay.ml b/src/typing/typerDisplay.ml index b0070783990..d22316512af 100644 --- a/src/typing/typerDisplay.ml +++ b/src/typing/typerDisplay.ml @@ -251,14 +251,14 @@ let rec handle_signature_display ctx e_ast with_type = l in let find_constructor_types t = match follow t with - | TInst ({cl_kind = KTypeParameter tl} as c,_) -> + | TInst ({cl_kind = KTypeParameter ttp} as c,_) -> let rec loop tl = match tl with | [] -> raise_typing_error_ext (make_error (No_constructor (TClassDecl c)) p) | t :: tl -> match follow t with | TAbstract({a_path = ["haxe"],"Constructible"},[t]) -> t | _ -> loop tl in - [loop tl,None,PMap.empty] + [loop (get_constraints ttp),None,PMap.empty] | TInst (c,tl) | TAbstract({a_impl = Some c},tl) -> Display.merge_core_doc ctx (TClassDecl c); let fa = get_constructor_access c tl p in @@ -628,7 +628,7 @@ let handle_display ctx e_ast dk mode with_type = false end end - | ITTypeParameter {cl_kind = KTypeParameter tl} when get_constructible_constraint ctx tl null_pos <> None -> + | ITTypeParameter {cl_kind = KTypeParameter ttp} when get_constructible_constraint ctx (get_constraints ttp) null_pos <> None -> true | _ -> false ) r.fitems in From 048fca21744bc441efc368c7cf29cc62ad446ba2 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Wed, 20 Dec 2023 08:30:27 +0100 Subject: [PATCH 003/125] [messageReporting] Add config to use absolute positions (#11439) * [messageReporting] add -D message.absolute-positions * [tests] add test for -D message.absolute-positions --- src-json/define.json | 5 ++ src/compiler/messageReporting.ml | 49 ++++++++++++------- src/macro/eval/evalLuv.ml | 3 +- tests/misc/projects/Issue11439/Main.hx | 5 ++ .../projects/Issue11439/compile-fail.hxml | 2 + .../Issue11439/compile-fail.hxml.stderr | 1 + .../projects/Issue11439/compile2-fail.hxml | 3 ++ .../Issue11439/compile2-fail.hxml.stderr | 1 + .../projects/Issue11439/compile3-fail.hxml | 4 ++ .../Issue11439/compile3-fail.hxml.stderr | 6 +++ 10 files changed, 60 insertions(+), 19 deletions(-) create mode 100644 tests/misc/projects/Issue11439/Main.hx create mode 100644 tests/misc/projects/Issue11439/compile-fail.hxml create mode 100644 tests/misc/projects/Issue11439/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue11439/compile2-fail.hxml create mode 100644 tests/misc/projects/Issue11439/compile2-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue11439/compile3-fail.hxml create mode 100644 tests/misc/projects/Issue11439/compile3-fail.hxml.stderr diff --git a/src-json/define.json b/src-json/define.json index a898ca75e68..e95cc7ff095 100644 --- a/src-json/define.json +++ b/src-json/define.json @@ -790,6 +790,11 @@ "define": "message.no-color", "doc": "Disable ANSI color codes in message reporting." }, + { + "name": "MessageAbsolutePositions", + "define": "message.absolute-positions", + "doc": "Use absolute character positions instead of line/columns for message reporting." + }, { "name": "MessageLogFile", "define": "message.log-file", diff --git a/src/compiler/messageReporting.ml b/src/compiler/messageReporting.ml index 4094ae5cb7c..8bd6e986367 100644 --- a/src/compiler/messageReporting.ml +++ b/src/compiler/messageReporting.ml @@ -65,13 +65,15 @@ let resolve_file ctx f = let error_printer file line = Printf.sprintf "%s:%d:" file line type error_context = { + absolute_positions : bool; mutable last_positions : pos IntMap.t; mutable max_lines : int IntMap.t; mutable gutter : int IntMap.t; mutable previous : (pos * MessageSeverity.t * int) option; } -let create_error_context () = { +let create_error_context absolute_positions = { + absolute_positions = absolute_positions; last_positions = IntMap.empty; max_lines = IntMap.empty; gutter = IntMap.empty; @@ -97,7 +99,10 @@ let compiler_pretty_message_string com ectx cm = let f = Common.find_file com f in let l1, p1, l2, p2 = Lexer.get_pos_coords cm.cm_pos in let lines = resolve_source f l1 p1 l2 p2 in - let epos = Lexer.get_error_pos error_printer cm.cm_pos in + let epos = + if ectx.absolute_positions then TPrinting.Printer.s_pos cm.cm_pos + else Lexer.get_error_pos error_printer cm.cm_pos + in (l1, p1, l2, p2, epos, lines) end with Not_found | Sys_error _ -> (1, 1, 1, 1, cm.cm_pos.pfile, []) @@ -243,7 +248,7 @@ let compiler_pretty_message_string com ectx cm = ) end -let compiler_message_string cm = +let compiler_message_string ectx cm = let str = match cm.cm_severity with | MessageSeverity.Warning -> "Warning : " ^ cm.cm_message | Information | Error | Hint -> cm.cm_message @@ -252,7 +257,10 @@ let compiler_message_string cm = if cm.cm_pos = null_pos then Some str else begin - let epos = Lexer.get_error_pos error_printer cm.cm_pos in + let epos = + if ectx.absolute_positions then TPrinting.Printer.s_pos cm.cm_pos + else Lexer.get_error_pos error_printer cm.cm_pos + in let str = let lines = match (ExtString.String.nsplit str "\n") with @@ -264,7 +272,7 @@ let compiler_message_string cm = Some (Printf.sprintf "%s : %s" epos str) end -let compiler_indented_message_string cm = +let compiler_indented_message_string ectx cm = match cm.cm_message with (* Filter some messages that don't add much when using this message renderer *) | "End of overload failure reasons" -> None @@ -278,7 +286,10 @@ let compiler_indented_message_string cm = if cm.cm_pos = null_pos then Some str else begin - let epos = Lexer.get_error_pos error_printer cm.cm_pos in + let epos = + if ectx.absolute_positions then TPrinting.Printer.s_pos cm.cm_pos + else Lexer.get_error_pos error_printer cm.cm_pos + in let lines = match (ExtString.String.nsplit str "\n") with | first :: rest -> (cm.cm_depth, first) :: List.map (fun msg -> (cm.cm_depth+1, msg)) rest @@ -299,10 +310,10 @@ let get_max_line max_lines messages = exception ConfigError of string -let get_formatter com ectx def default = +let get_formatter com def default = let format_mode = Define.defined_value_safe ~default com.defines def in match format_mode with - | "pretty" -> compiler_pretty_message_string com ectx + | "pretty" -> compiler_pretty_message_string com | "indent" -> compiler_indented_message_string | "classic" -> compiler_message_string | m -> begin @@ -318,11 +329,12 @@ let print_error (err : Error.error) = !ret let format_messages com messages = - let ectx = create_error_context () in + let absolute_positions = Define.defined com.defines Define.MessageAbsolutePositions in + let ectx = create_error_context absolute_positions in ectx.max_lines <- get_max_line ectx.max_lines messages; - let message_formatter = get_formatter com ectx Define.MessageReporting "classic" in + let message_formatter = get_formatter com Define.MessageReporting "classic" in let lines = List.rev ( - List.fold_left (fun lines cm -> match (message_formatter cm) with + List.fold_left (fun lines cm -> match (message_formatter ectx cm) with | None -> lines | Some str -> str :: lines ) [] messages @@ -330,18 +342,19 @@ let format_messages com messages = ExtLib.String.join "\n" lines let display_messages ctx on_message = begin - let ectx = create_error_context () in + let absolute_positions = Define.defined ctx.com.defines Define.MessageAbsolutePositions in + let ectx = create_error_context absolute_positions in ectx.max_lines <- get_max_line ectx.max_lines ctx.messages; - let get_formatter _ _ def default = - try get_formatter ctx.com ectx def default + let get_formatter _ def default = + try get_formatter ctx.com def default with | ConfigError s -> error ctx s null_pos; compiler_message_string in - let message_formatter = get_formatter ctx.com ectx Define.MessageReporting "classic" in - let log_formatter = get_formatter ctx.com ectx Define.MessageLogFormat "indent" in + let message_formatter = get_formatter ctx.com Define.MessageReporting "classic" in + let log_formatter = get_formatter ctx.com Define.MessageLogFormat "indent" in let log_messages = ref (Define.defined ctx.com.defines Define.MessageLogFile) in let log_message = ref None in @@ -358,7 +371,7 @@ let display_messages ctx on_message = begin in log_message := (Some (fun msg -> - match (log_formatter msg) with + match (log_formatter ectx msg) with | None -> () | Some str -> Rbuffer.add_string buf (str ^ "\n"))); @@ -378,7 +391,7 @@ let display_messages ctx on_message = begin List.iter (fun cm -> if !log_messages then (Option.get !log_message) cm; - match (message_formatter cm) with + match (message_formatter ectx cm) with | None -> () | Some str -> on_message cm.cm_severity str ) (List.rev ctx.messages); diff --git a/src/macro/eval/evalLuv.ml b/src/macro/eval/evalLuv.ml index 800d58020b6..12099b5f6b9 100644 --- a/src/macro/eval/evalLuv.ml +++ b/src/macro/eval/evalLuv.ml @@ -554,7 +554,8 @@ let uv_error_fields = [ let messages = ref [] in HaxeError.recurse_error (fun depth err -> let cm = make_compiler_message ~from_macro:err.err_from_macro (HaxeError.error_msg err.err_message) err.err_pos depth DKCompilerMessage Error in - match MessageReporting.compiler_message_string cm with + let ectx = MessageReporting.create_error_context false in + match MessageReporting.compiler_message_string ectx cm with | None -> () | Some str -> messages := str :: !messages ) err; diff --git a/tests/misc/projects/Issue11439/Main.hx b/tests/misc/projects/Issue11439/Main.hx new file mode 100644 index 00000000000..f33318b918b --- /dev/null +++ b/tests/misc/projects/Issue11439/Main.hx @@ -0,0 +1,5 @@ +class Main { + static function main() { + var foo:Int = "whoops"; + } +} diff --git a/tests/misc/projects/Issue11439/compile-fail.hxml b/tests/misc/projects/Issue11439/compile-fail.hxml new file mode 100644 index 00000000000..d0162e592e8 --- /dev/null +++ b/tests/misc/projects/Issue11439/compile-fail.hxml @@ -0,0 +1,2 @@ +-main Main +-D message.absolute-positions diff --git a/tests/misc/projects/Issue11439/compile-fail.hxml.stderr b/tests/misc/projects/Issue11439/compile-fail.hxml.stderr new file mode 100644 index 00000000000..93a7f572059 --- /dev/null +++ b/tests/misc/projects/Issue11439/compile-fail.hxml.stderr @@ -0,0 +1 @@ +Main.hx: 41-64 : String should be Int diff --git a/tests/misc/projects/Issue11439/compile2-fail.hxml b/tests/misc/projects/Issue11439/compile2-fail.hxml new file mode 100644 index 00000000000..7b3a30f767c --- /dev/null +++ b/tests/misc/projects/Issue11439/compile2-fail.hxml @@ -0,0 +1,3 @@ +-main Main +-D message.reporting=indent +-D message.absolute-positions diff --git a/tests/misc/projects/Issue11439/compile2-fail.hxml.stderr b/tests/misc/projects/Issue11439/compile2-fail.hxml.stderr new file mode 100644 index 00000000000..93a7f572059 --- /dev/null +++ b/tests/misc/projects/Issue11439/compile2-fail.hxml.stderr @@ -0,0 +1 @@ +Main.hx: 41-64 : String should be Int diff --git a/tests/misc/projects/Issue11439/compile3-fail.hxml b/tests/misc/projects/Issue11439/compile3-fail.hxml new file mode 100644 index 00000000000..930fd2b7043 --- /dev/null +++ b/tests/misc/projects/Issue11439/compile3-fail.hxml @@ -0,0 +1,4 @@ +-main Main +-D message.reporting=pretty +-D message.no-color +-D message.absolute-positions diff --git a/tests/misc/projects/Issue11439/compile3-fail.hxml.stderr b/tests/misc/projects/Issue11439/compile3-fail.hxml.stderr new file mode 100644 index 00000000000..30c05894b98 --- /dev/null +++ b/tests/misc/projects/Issue11439/compile3-fail.hxml.stderr @@ -0,0 +1,6 @@ +[ERROR] Main.hx: 41-64 + + 3 | var foo:Int = "whoops"; + | ^^^^^^^^^^^^^^^^^^^^^^^ + | String should be Int + From 4a175dfdb42d994221c2bf1413a0a2a8c4386cc7 Mon Sep 17 00:00:00 2001 From: Aidan Lee Date: Thu, 21 Dec 2023 18:11:11 +0000 Subject: [PATCH 004/125] [cpp] Enum Type Checking (#11444) * Give enums a unique class ID * Add more type check scaffolding * Add test * Use Int32.zero --- src/generators/gencpp.ml | 26 +++++++++++++++++++++--- tests/unit/src/unit/issues/Issue11442.hx | 22 ++++++++++++++++++++ 2 files changed, 45 insertions(+), 3 deletions(-) create mode 100644 tests/unit/src/unit/issues/Issue11442.hx diff --git a/src/generators/gencpp.ml b/src/generators/gencpp.ml index 2bc1a5b3913..264bb28276b 100644 --- a/src/generators/gencpp.ml +++ b/src/generators/gencpp.ml @@ -3442,7 +3442,7 @@ let cpp_class_hash interface = let rec is_constant_zero expr = match expr.cppexpr with | CppFloat x when (float_of_string x) = 0.0 -> true - | CppInt i when i = Int32.of_int 0 -> true + | CppInt i when i = Int32.zero -> true | CppCastScalar(expr,_) -> is_constant_zero(expr) | _ -> false ;; @@ -5238,6 +5238,9 @@ let generate_enum_files baseCtx enum_def super_deps meta = let ctx = file_context baseCtx cpp_file debug false in let strq = strq ctx.ctx_common in + let classId = try Hashtbl.find baseCtx.ctx_type_ids (class_text enum_def.e_path) with Not_found -> Int32.zero in + let classIdTxt = Printf.sprintf "0x%08lx" classId in + if (debug>1) then print_endline ("Found enum definition:" ^ (join_class_path class_path "::" )); @@ -5279,6 +5282,10 @@ let generate_enum_files baseCtx enum_def super_deps meta = output_cpp ("HX_DEFINE_CREATE_ENUM(" ^ class_name ^ ")\n\n"); + output_cpp ("bool " ^ class_name ^ "::_hx_isInstanceOf(int inClassId) {\n"); + output_cpp ("\treturn inClassId == (int)0x00000001 || inClassId == ::hx::EnumBase_obj::_hx_ClassId || inClassId == _hx_ClassId;\n"); + output_cpp ("}\n"); + output_cpp ("int " ^ class_name ^ "::__FindIndex(::String inName)\n{\n"); PMap.iter (fun _ constructor -> let name = constructor.ef_name in @@ -5390,13 +5397,15 @@ let generate_enum_files baseCtx enum_def super_deps meta = output_h ("{\n\ttypedef " ^ super ^ " super;\n"); output_h ("\t\ttypedef " ^ class_name ^ " OBJ_;\n"); output_h "\n\tpublic:\n"; + output_h ("\t\tenum { _hx_ClassId = " ^ classIdTxt ^ " };\n\n"); output_h ("\t\t" ^ class_name ^ "() {};\n"); output_h ("\t\tHX_DO_ENUM_RTTI;\n"); output_h ("\t\tstatic void __boot();\n"); output_h ("\t\tstatic void __register();\n"); output_h ("\t\tstatic bool __GetStatic(const ::String &inName, Dynamic &outValue, ::hx::PropertyAccess inCallProp);\n"); output_h ("\t\t::String GetEnumName( ) const { return " ^ (strq (join_class_path class_path ".")) ^ "; }\n" ); - output_h ("\t\t::String __ToString() const { return " ^ (strq (just_class_name ^ ".") )^ " + _hx_tag; }\n\n"); + output_h ("\t\t::String __ToString() const { return " ^ (strq (just_class_name ^ ".") )^ " + _hx_tag; }\n"); + output_h ("\t\tbool _hx_isInstanceOf(int inClassId);\n\n"); PMap.iter (fun _ constructor -> @@ -5761,7 +5770,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta then 0 else 1 in let scriptable = inScriptable && not class_def.cl_private in - let classId = try Hashtbl.find baseCtx.ctx_type_ids (class_text class_def.cl_path) with Not_found -> Int32.of_int 0 in + let classId = try Hashtbl.find baseCtx.ctx_type_ids (class_text class_def.cl_path) with Not_found -> Int32.zero in let classIdTxt = Printf.sprintf "0x%08lx" classId in (* Config *) @@ -8564,6 +8573,17 @@ let generate_source ctx = if (is_internal) then (if (debug>1) then print_endline (" internal enum " ^ name )) else begin + let rec makeId enum_name seed = + let id = gen_hash32 seed enum_name in + (* reserve first 100 ids for runtime *) + if id < Int32.of_int 100 || Hashtbl.mem existingIds id then + makeId enum_name (seed+100) + else begin + Hashtbl.add existingIds id true; + Hashtbl.add ctx.ctx_type_ids enum_name id; + end in + makeId name 0; + let meta = Texpr.build_metadata common_ctx.basic object_def in if (enum_def.e_extern) then (if (debug>1) then print_endline ("external enum " ^ name )); diff --git a/tests/unit/src/unit/issues/Issue11442.hx b/tests/unit/src/unit/issues/Issue11442.hx new file mode 100644 index 00000000000..77921d7d869 --- /dev/null +++ b/tests/unit/src/unit/issues/Issue11442.hx @@ -0,0 +1,22 @@ +package unit.issues; + +import utest.Assert; + +enum Dummy { + DummyCtor; +} + +class Issue11442 extends Test { + function test() { + f(Std.isOfType(DummyCtor, haxe.ds.Option)); + t(Std.isOfType(DummyCtor, Dummy)); + + try { + throw DummyCtor; + } catch(e:haxe.ds.Option) { + Assert.fail("wrong catch"); + } catch(e:Dummy) { + Assert.pass("correct catch"); + } + } +} \ No newline at end of file From 2b22ff950f8092a9efe370ebf1fd1b37c7323c1a Mon Sep 17 00:00:00 2001 From: Zeta <53486764+Apprentice-Alchemist@users.noreply.github.com> Date: Thu, 21 Dec 2023 19:20:35 +0100 Subject: [PATCH 005/125] [display] Insert EDisplay in the proper position when parsing a call expression. (#11441) --- src/syntax/grammar.mly | 20 ++++++++++++++++++-- tests/display/src/cases/Signature.hx | 16 ++++++++++++++++ 2 files changed, 34 insertions(+), 2 deletions(-) diff --git a/src/syntax/grammar.mly b/src/syntax/grammar.mly index 9ac02cebc88..cce1e22bfa3 100644 --- a/src/syntax/grammar.mly +++ b/src/syntax/grammar.mly @@ -1715,8 +1715,24 @@ and parse_call_params f p1 s = let e = check_signature_mark e p1 p2 in f (List.rev (e :: acc)) p2 | [< '(Comma,p2); '(PClose,p3) >] -> - let e = check_signature_mark e p1 p3 in - f (List.rev (e :: acc)) p3 + if (is_signature_display()) then begin + let prev_arg_pos = punion p1 p2 in + let comma_paren_pos = punion p2 p3 in + (* first check wether the display position is within the previous argument *) + if encloses_position_gt display_position#get prev_arg_pos then begin + (* wrap the argument that was just parsed *) + let e = mk_display_expr e DKMarked in + f (List.rev (e :: acc)) p3 + (* then check wether the display position is between the comma and the closing parenthesis *) + end else if encloses_position_gt display_position#get comma_paren_pos then begin + (* add a dummy final argument *) + let e2 = mk_display_expr (mk_null_expr comma_paren_pos) DKMarked in + f (List.rev (e2 :: e :: acc)) p3 + end else f (List.rev (e :: acc)) p3 + end else begin + (* if not in signature display mode don't check anything *) + f (List.rev (e :: acc)) p3 + end | [< '(Comma,p2) >] -> let e = check_signature_mark e p1 p2 in parse_next_param (e :: acc) p2 diff --git a/tests/display/src/cases/Signature.hx b/tests/display/src/cases/Signature.hx index d8914e51642..ef10b6f770a 100644 --- a/tests/display/src/cases/Signature.hx +++ b/tests/display/src/cases/Signature.hx @@ -282,4 +282,20 @@ class Signature extends DisplayTestCase { function testStaticVisibility() { sigEq(0, [["s:String"]], signature(pos(1))); } + + /** + class Foo { + public static function foo(a:Int, b:Int) {} + } + + class Main { + static function main() { + Foo.foo(1{-1-},{-2-}); + } + } + **/ + function testTrailingCommaEdgeCase() { + sigEq(0, [["a:Int","b:Int"]], signature(pos(1))); + sigEq(1, [["a:Int","b:Int"]], signature(pos(2))); + } } From ed838d789588487e817a326b60d31c4397ce9012 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sun, 24 Dec 2023 09:52:49 +0100 Subject: [PATCH 006/125] [matcher] follow when looking for GADT return types closes #11446 --- src/generators/genjvm.ml | 6 +++++- src/typing/matcher/exprToPattern.ml | 6 +++++- tests/unit/src/unit/issues/Issue11446.hx | 19 +++++++++++++++++++ 3 files changed, 29 insertions(+), 2 deletions(-) create mode 100644 tests/unit/src/unit/issues/Issue11446.hx diff --git a/src/generators/genjvm.ml b/src/generators/genjvm.ml index 7efa5cd4968..1fa8a737d7e 100644 --- a/src/generators/genjvm.ml +++ b/src/generators/genjvm.ml @@ -2116,7 +2116,11 @@ class texpr_to_jvm | TEnumParameter(e1,ef,i) -> self#texpr rvalue_any e1; let path,name,jsig_arg = match follow ef.ef_type with - | TFun(tl,TEnum(en,_)) -> + | TFun(tl,tr) -> + let en = match follow tr with + | TEnum(en,_) -> en + | _ -> die "" __LOC__ + in let n,_,t = List.nth tl i in en.e_path,n,self#vtype t | _ -> die "" __LOC__ diff --git a/src/typing/matcher/exprToPattern.ml b/src/typing/matcher/exprToPattern.ml index 0f787760903..3cb8edf06f4 100644 --- a/src/typing/matcher/exprToPattern.ml +++ b/src/typing/matcher/exprToPattern.ml @@ -252,7 +252,11 @@ let rec make pctx toplevel t e = | ECall(e1,el) -> let e1 = type_expr ctx e1 (WithType.with_type t) in begin match e1.eexpr,follow e1.etype with - | TField(_, FEnum(en,ef)),TFun(_,TEnum(_,tl)) -> + | TField(_, FEnum(en,ef)),TFun(_,tr) -> + let tl = match follow tr with + | TEnum(_,tl) -> tl + | _ -> fail() + in let map = apply_params en.e_params tl in let monos = Monomorph.spawn_constrained_monos map ef.ef_params in let map t = map (apply_params ef.ef_params monos t) in diff --git a/tests/unit/src/unit/issues/Issue11446.hx b/tests/unit/src/unit/issues/Issue11446.hx new file mode 100644 index 00000000000..fd24f4b1a5b --- /dev/null +++ b/tests/unit/src/unit/issues/Issue11446.hx @@ -0,0 +1,19 @@ +package unit.issues; + +typedef Td = E; + +private enum E { + C(s:String):Td; +} + +private function match(e:E) { + return switch (e) { + case C(s): s; + } +} + +class Issue11446 extends Test { + function test() { + eq("foo", match(C("foo"))); + } +} From 5ddfcc84f7ee27c9df14f82f27d01ddf51e92df7 Mon Sep 17 00:00:00 2001 From: Nicolas Cannasse Date: Sun, 24 Dec 2023 10:36:48 +0100 Subject: [PATCH 007/125] [hl] added OAsm --- src/generators/genhl.ml | 22 ++++++++++++++++++++++ src/generators/hl2c.ml | 2 ++ src/generators/hlcode.ml | 13 +++++++++++++ src/generators/hlinterp.ml | 4 ++++ src/generators/hlopt.ml | 11 +++++++++++ 5 files changed, 52 insertions(+) diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml index 16b04edb53d..8ed3abbc49b 100644 --- a/src/generators/genhl.ml +++ b/src/generators/genhl.ml @@ -2086,6 +2086,28 @@ and eval_expr ctx e = let r = alloc_tmp ctx (to_type ctx e.etype) in op ctx (OUnsafeCast (r, eval_expr ctx value)); r + | "$asm", [mode; value] -> + let mode = (match get_const mode with + | TInt m -> Int32.to_int m + | _ -> abort "Constant mode required" e.epos + ) in + let value = (match get_const value with + | TInt m -> Int32.to_int m + | _ -> abort "Constant value required" e.epos + ) in + op ctx (OAsm (mode, value, 0)); + alloc_tmp ctx HVoid + | "$asm", [mode; value; reg] -> + let mode = (match get_const mode with + | TInt m -> Int32.to_int m + | _ -> abort "Constant mode required" e.epos + ) in + let value = (match get_const value with + | TInt m -> Int32.to_int m + | _ -> abort "Constant value required" e.epos + ) in + op ctx (OAsm (mode, value, (eval_expr ctx reg) + 1)); + alloc_tmp ctx HVoid | _ -> abort ("Unknown native call " ^ s) e.epos) | TEnumIndex v -> diff --git a/src/generators/hl2c.ml b/src/generators/hl2c.ml index 1e62c48e602..035b9838be5 100644 --- a/src/generators/hl2c.ml +++ b/src/generators/hl2c.ml @@ -1110,6 +1110,8 @@ let generate_function ctx f = Globals.die "" __LOC__ )) in sexpr "__hl_prefetch_m%d(%s)" mode expr + | OAsm _ -> + sexpr "UNSUPPORTED ASM OPCODE"; ) f.code; flush_options (Array.length f.code); unblock(); diff --git a/src/generators/hlcode.ml b/src/generators/hlcode.ml index d40313f9c26..1636c2546db 100644 --- a/src/generators/hlcode.ml +++ b/src/generators/hlcode.ml @@ -202,6 +202,7 @@ type opcode = | ORefOffset of reg * reg * reg | ONop of string | OPrefetch of reg * field index * int + | OAsm of int * int * reg type fundecl = { fpath : string * string; @@ -574,6 +575,18 @@ let ostr fstr o = | ORefOffset (r,r2,off) -> Printf.sprintf "refoffset %d, %d, %d" r r2 off | ONop s -> if s = "" then "nop" else "nop " ^ s | OPrefetch (r,f,mode) -> Printf.sprintf "prefetch %d[%d] %d" r f mode + | OAsm (mode, value, reg) -> + match mode with + | 0 when reg = 0 -> + Printf.sprintf "asm %.2X" value + | 1 when reg = 0 -> + Printf.sprintf "asm scratch R%d" value + | 2 -> + Printf.sprintf "asm R%d := %d" value (reg - 1) + | 3 -> + Printf.sprintf "asm %d := R%d" (reg - 1) value + | _ -> + Printf.sprintf "asm[%d] %d%s" mode value (if reg = 0 then "" else ", " ^ string_of_int (reg-1)) let fundecl_name f = if snd f.fpath = "" then "fun$" ^ (string_of_int f.findex) else (fst f.fpath) ^ "." ^ (snd f.fpath) diff --git a/src/generators/hlinterp.ml b/src/generators/hlinterp.ml index 8979dcb1c01..c60b06cf30c 100644 --- a/src/generators/hlinterp.ml +++ b/src/generators/hlinterp.ml @@ -1154,6 +1154,8 @@ let interp ctx f args = (match get r2, get off with | VRef (RArray (a,pos),t), VInt i -> set r (VRef (RArray (a,pos + Int32.to_int i),t)) | _ -> Globals.die "" __LOC__) + | OAsm _ -> + throw_msg ctx "Unsupported ASM" | ONop _ | OPrefetch _ -> () ); @@ -2545,6 +2547,8 @@ let check code macros = (); | OPrefetch (r,f,_) -> if f = 0 then ignore(rtype r) else ignore(tfield r (f - 1) false) + | OAsm (_,_,r) -> + if r > 0 then ignore(rtype (r - 1)) ) f.code (* TODO : check that all path correctly initialize NULL values and reach a return *) in diff --git a/src/generators/hlopt.ml b/src/generators/hlopt.ml index c11db0161aa..5081c31c9f5 100644 --- a/src/generators/hlopt.ml +++ b/src/generators/hlopt.ml @@ -166,6 +166,12 @@ let opcode_fx frw op = () | OPrefetch (r,_,_) -> read r + | OAsm (_,_,r) -> + if r > 0 then begin + (* assume both *) + read (r - 1); + write (r - 1); + end let opcode_eq a b = match a, b with @@ -437,6 +443,11 @@ let opcode_map read write op = | OPrefetch (r, fid, mode) -> let r2 = read r in OPrefetch (r2, fid, mode) + | OAsm (_, _, 0) -> + op + | OAsm (mode, value, r) -> + let r2 = read (r - 1) in + OAsm (mode, value, (write r2) + 1) (* build code graph *) From 8ab63f13ac09c2b4288437d3c6cdbcf563b1bac9 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sun, 24 Dec 2023 14:27:24 +0100 Subject: [PATCH 008/125] [dump] fix module lookup closes #11447 --- src/codegen/codegen.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index 5893255443e..b9ff78439eb 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -393,7 +393,7 @@ module Dump = struct List.iter (fun m -> print "%s:\n" (Path.UniqueKey.lazy_path m.m_extra.m_file); PMap.iter (fun _ (sign,mpath) -> - let m2 = (com.cs#get_context sign)#find_module mpath in + let m2 = com.module_lut#find mpath in let file = Path.UniqueKey.lazy_path m2.m_extra.m_file in print "\t%s\n" file; let l = try Hashtbl.find dep file with Not_found -> [] in From bc660af559b3d77ebd7274904c98b0e23ebcd7eb Mon Sep 17 00:00:00 2001 From: Nicolas Cannasse Date: Sun, 24 Dec 2023 19:39:11 +0100 Subject: [PATCH 009/125] [hl] make sure -dce full will not remove @:struct fields as they match native code --- src/optimization/dce.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/optimization/dce.ml b/src/optimization/dce.ml index b4a1a7b4944..96c198cd7e0 100644 --- a/src/optimization/dce.ml +++ b/src/optimization/dce.ml @@ -622,7 +622,7 @@ and expr dce e = check_op dce op; check_and_add_feature dce "dynamic_array_write"; expr dce e1; - expr dce e2; + expr dce e2; | TArray(({etype = t} as e1),e2) when is_array t -> check_and_add_feature dce "array_read"; expr dce e1; @@ -733,8 +733,9 @@ let collect_entry_points dce com = match t with | TClassDecl c -> let keep_class = keep_whole_class dce c && (not (has_class_flag c CExtern) || (has_class_flag c CInterface)) in + let is_struct = dce.com.platform = Hl && Meta.has Meta.Struct c.cl_meta in let loop kind cf = - if keep_class || keep_field dce cf c kind then mark_field dce c cf kind + if keep_class || is_struct || keep_field dce cf c kind then mark_field dce c cf kind in List.iter (loop CfrStatic) c.cl_ordered_statics; List.iter (loop CfrMember) c.cl_ordered_fields; From 599e0ca4bf977f3cbb6936694b2bda674cd3fae1 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 27 Dec 2023 16:09:57 +0100 Subject: [PATCH 010/125] Internal dependency cleanup 2023 (#11451) * factor out field call candidate * load Std when creating typer instead of randomly when we need it * slightly split up exceptions.ml * lose genjs dependency on typeloadCheck * factor out expr preprocessing to lose a dependency between EvalDebugSocket and typecore * split up filters.ml a bit to lose macroContext -> filters because it brings a lot of other stuff * separate Typer.create from the rest to lose the macroContext dependency * lose some weird dependencies from string formatting * make Eval an isolated dependency * bring back catch that breaks tink --- src/codegen/codegen.ml | 1 + src/codegen/overloads.ml | 2 +- src/compiler/compiler.ml | 8 +- src/compiler/displayOutput.ml | 2 +- src/compiler/serverCompilationContext.ml | 8 +- src/context/common.ml | 101 +--------- src/context/display/display.ml | 231 +---------------------- src/context/display/displayEmitter.ml | 2 +- src/context/display/exprPreprocessing.ml | 224 ++++++++++++++++++++++ src/context/formatString.ml | 98 ++++++++++ src/context/memory.ml | 4 +- src/context/typecore.ml | 42 +---- src/core/naming.ml | 88 +++++++++ src/core/socket.ml | 13 +- src/filters/addFieldInits.ml | 68 +++++++ src/filters/exceptionFunctions.ml | 22 +++ src/filters/exceptions.ml | 27 +-- src/filters/filters.ml | 212 +-------------------- src/filters/filtersCommon.ml | 15 ++ src/filters/localStatic.ml | 63 +++++++ src/filters/renameVars.ml | 6 +- src/generators/genjs.ml | 4 +- src/generators/genjvm.ml | 4 +- src/generators/genswf9.ml | 4 +- src/macro/eval/eval.ml | 5 + src/macro/eval/evalContext.ml | 5 - src/macro/eval/evalDebugSocket.ml | 2 +- src/macro/eval/evalExceptions.ml | 1 - src/macro/eval/evalMain.ml | 3 +- src/macro/eval/evalStdLib.ml | 2 +- src/macro/eval/evalThread.ml | 2 +- src/macro/eval/evalTypes.ml | 1 + src/optimization/inline.ml | 4 +- src/typing/callUnification.ml | 1 + src/typing/fieldCallCandidate.ml | 39 ++++ src/typing/functionArguments.ml | 2 +- src/typing/generic.ml | 1 + src/typing/macroContext.ml | 24 +-- src/typing/overloadResolution.ml | 2 +- src/typing/typeload.ml | 11 -- src/typing/typeloadCheck.ml | 22 +-- src/typing/typeloadFields.ml | 2 +- src/typing/typeloadFunction.ml | 2 +- src/typing/typeloadModule.ml | 6 +- src/typing/typer.ml | 161 +--------------- src/typing/typerEntry.ml | 154 +++++++++++++++ 46 files changed, 865 insertions(+), 836 deletions(-) create mode 100644 src/context/display/exprPreprocessing.ml create mode 100644 src/context/formatString.ml create mode 100644 src/core/naming.ml create mode 100644 src/filters/addFieldInits.ml create mode 100644 src/filters/exceptionFunctions.ml create mode 100644 src/filters/localStatic.ml create mode 100644 src/macro/eval/eval.ml create mode 100644 src/macro/eval/evalTypes.ml create mode 100644 src/typing/fieldCallCandidate.ml create mode 100644 src/typing/typerEntry.ml diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index b9ff78439eb..0fb322c9f88 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -520,3 +520,4 @@ module ExtClass = struct let e_assign = mk (TBinop(OpAssign,ef1,e)) e.etype p in add_cl_init c e_assign end + \ No newline at end of file diff --git a/src/codegen/overloads.ml b/src/codegen/overloads.ml index 3657e537f31..5d326efdbe9 100644 --- a/src/codegen/overloads.ml +++ b/src/codegen/overloads.ml @@ -1,6 +1,6 @@ open Globals open Type -open Typecore +open FieldCallCandidate let same_overload_args ?(get_vmtype) t1 t2 f1 f2 = let f_transform = match get_vmtype with diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml index ceb60f839a0..26860dfe498 100644 --- a/src/compiler/compiler.ml +++ b/src/compiler/compiler.ml @@ -178,7 +178,7 @@ module Setup = struct let fl = List.map (fun (file,extern) -> NativeLibraryHandler.add_native_lib com file extern) (List.rev native_libs) in (* Native lib pass 2: Initialize *) List.iter (fun f -> f()) fl; - Typer.create com macros + TyperEntry.create com macros let executable_path() = Extc.executable_path() @@ -424,7 +424,7 @@ with error ctx ("Error: No completion point was found") null_pos | DisplayException.DisplayException dex -> DisplayOutput.handle_display_exception ctx dex - | Out_of_memory | EvalExceptions.Sys_exit _ | Hlinterp.Sys_exit _ | DisplayProcessingGlobals.Completion _ as exc -> + | Out_of_memory | EvalTypes.Sys_exit _ | Hlinterp.Sys_exit _ | DisplayProcessingGlobals.Completion _ as exc -> (* We don't want these to be caught by the catchall below *) raise exc | e when (try Sys.getenv "OCAMLRUNPARAM" <> "b" with _ -> true) && not Helper.is_debug_run -> @@ -450,7 +450,7 @@ let catch_completion_and_exit ctx callbacks run = ServerMessage.completion str; ctx.comm.write_err str; 0 - | EvalExceptions.Sys_exit i | Hlinterp.Sys_exit i -> + | EvalTypes.Sys_exit i | Hlinterp.Sys_exit i -> if i <> 0 then ctx.has_error <- true; finalize ctx; i @@ -483,7 +483,7 @@ let compile_ctx callbacks ctx = catch_completion_and_exit ctx callbacks run let create_context comm cs compilation_step params = { - com = Common.create compilation_step cs version params; + com = Common.create compilation_step cs version params (DisplayTypes.DisplayMode.create !Parser.display_mode); messages = []; has_next = false; has_error = false; diff --git a/src/compiler/displayOutput.ml b/src/compiler/displayOutput.ml index c1ddb3bf4d0..99ba1280bbd 100644 --- a/src/compiler/displayOutput.ml +++ b/src/compiler/displayOutput.ml @@ -344,7 +344,7 @@ let handle_type_path_exception ctx p c is_import pos = | None -> DisplayPath.TypePathHandler.complete_type_path com p | Some (c,cur_package) -> - let ctx = Typer.create com None in + let ctx = TyperEntry.create com None in DisplayPath.TypePathHandler.complete_type_path_inner ctx p c cur_package is_import end with Error.Fatal_error err -> error_ext ctx err; diff --git a/src/compiler/serverCompilationContext.ml b/src/compiler/serverCompilationContext.ml index bec9724e4c3..0f65f22c154 100644 --- a/src/compiler/serverCompilationContext.ml +++ b/src/compiler/serverCompilationContext.ml @@ -70,5 +70,9 @@ let ensure_macro_setup sctx = end let cleanup () = match !MacroContext.macro_interp_cache with - | Some interp -> EvalContext.GlobalState.cleanup interp - | None -> () \ No newline at end of file + | Some interp -> + (* curapi holds a reference to the typing context which we don't want to persist. Let's unset it so the + context can be collected. *) + interp.curapi <- Obj.magic "" + | None -> + () \ No newline at end of file diff --git a/src/context/common.ml b/src/context/common.ml index 10c6e484f40..401e51e974f 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -798,7 +798,7 @@ let get_config com = let memory_marker = [|Unix.time()|] -let create compilation_step cs version args = +let create compilation_step cs version args display_mode = let m = Type.mk_mono() in let rec com = { compilation_step = compilation_step; @@ -819,7 +819,7 @@ let create compilation_step cs version args = }; sys_args = args; debug = false; - display = DisplayTypes.DisplayMode.create !Parser.display_mode; + display = display_mode; verbose = false; foptimize = true; features = Hashtbl.create 0; @@ -1326,100 +1326,3 @@ let get_entry_point com = let e = Option.get com.main in (* must be present at this point *) (snd path, c, e) ) com.main_class - -let format_string com s p process_expr = - let e = ref None in - let pmin = ref p.pmin in - let min = ref (p.pmin + 1) in - let add_expr (enext,p) len = - min := !min + len; - let enext = process_expr enext p in - match !e with - | None -> e := Some enext - | Some prev -> - e := Some (EBinop (OpAdd,prev,enext),punion (pos prev) p) - in - let add enext len = - let p = { p with pmin = !min; pmax = !min + len } in - add_expr (enext,p) len - in - let add_sub start pos = - let len = pos - start in - if len > 0 || !e = None then add (EConst (String (String.sub s start len,SDoubleQuotes))) len - in - let len = String.length s in - let rec parse start pos = - if pos = len then add_sub start pos else - let c = String.unsafe_get s pos in - let pos = pos + 1 in - if c = '\'' then begin - incr pmin; - incr min; - end; - if c <> '$' || pos = len then parse start pos else - match String.unsafe_get s pos with - | '$' -> - (* double $ *) - add_sub start pos; - parse (pos + 1) (pos + 1) - | '{' -> - parse_group start pos '{' '}' "brace" - | 'a'..'z' | 'A'..'Z' | '_' -> - add_sub start (pos - 1); - incr min; - let rec loop i = - if i = len then i else - let c = String.unsafe_get s i in - match c with - | 'a'..'z' | 'A'..'Z' | '0'..'9' | '_' -> loop (i+1) - | _ -> i - in - let iend = loop (pos + 1) in - let len = iend - pos in - add (EConst (Ident (String.sub s pos len))) len; - parse (pos + len) (pos + len) - | _ -> - (* keep as-it *) - parse start pos - and parse_group start pos gopen gclose gname = - add_sub start (pos - 1); - let rec loop groups i = - if i = len then - match groups with - | [] -> die "" __LOC__ - | g :: _ -> Error.raise_typing_error ("Unclosed " ^ gname) { p with pmin = !pmin + g + 1; pmax = !pmin + g + 2 } - else - let c = String.unsafe_get s i in - if c = gopen then - loop (i :: groups) (i + 1) - else if c = gclose then begin - let groups = List.tl groups in - if groups = [] then i else loop groups (i + 1) - end else - loop groups (i + 1) - in - let send = loop [pos] (pos + 1) in - let slen = send - pos - 1 in - let scode = String.sub s (pos + 1) slen in - min := !min + 2; - begin - let e = - let ep = { p with pmin = !pmin + pos + 2; pmax = !pmin + send + 1 } in - let error msg pos = - if Lexer.string_is_whitespace scode then Error.raise_typing_error "Expression cannot be empty" ep - else Error.raise_typing_error msg pos - in - match ParserEntry.parse_expr_string com.defines scode ep error true with - | ParseSuccess(data,_,_) -> data - | ParseError(_,(msg,p),_) -> error (Parser.error_msg msg) p - in - add_expr e slen - end; - min := !min + 1; - parse (send + 1) (send + 1) - in - parse 0 0; - match !e with - | None -> die "" __LOC__ - | Some e -> e - diff --git a/src/context/display/display.ml b/src/context/display/display.ml index b6e865564d0..075839bbe12 100644 --- a/src/context/display/display.ml +++ b/src/context/display/display.ml @@ -30,233 +30,10 @@ module ReferencePosition = struct let reset () = reference_position := ("",null_pos,SKOther) end -module ExprPreprocessing = struct - let find_before_pos dm e = - let display_pos = ref (DisplayPosition.display_position#get) in - let was_annotated = ref false in - let is_annotated,is_completion = match dm with - | DMDefault -> (fun p -> not !was_annotated && encloses_position !display_pos p),true - | DMHover -> (fun p -> not !was_annotated && encloses_position_gt !display_pos p),false - | _ -> (fun p -> not !was_annotated && encloses_position !display_pos p),false - in - let annotate e dk = - was_annotated := true; - (EDisplay(e,dk),pos e) - in - let annotate_marked e = annotate e DKMarked in - let mk_null p = annotate_marked ((EConst(Ident "null")),p) in - let loop_el el = - let pr = DisplayPosition.display_position#with_pos (pos e) in - let rec loop el = match el with - | [] -> [mk_null pr] - | e :: el -> - if (pos e).pmin >= pr.pmax then (mk_null pr) :: e :: el - else e :: loop el - in - (* print_endline (Printf.sprintf "%i-%i: PR" pr.pmin pr.pmax); - List.iter (fun e -> - print_endline (Printf.sprintf "%i-%i: %s" (pos e).pmin (pos e).pmax (Ast.s_expr e)); - ) el; *) - match el with - | [] -> [mk_null pr] - | e :: el -> - if (pos e).pmin >= pr.pmax then (mk_null pr) :: e :: el - else loop (e :: el) - in - let in_pattern = ref false in - let loop e = - (* print_endline (Printf.sprintf "%i-%i: %s" (pos e).pmin (pos e).pmax (Ast.s_expr e)); *) - match fst e with - | EFunction(FKNamed((_,p),_),_) when is_annotated p && is_completion -> - raise Exit - | EVars vl when is_annotated (pos e) && is_completion -> - let rec loop2 acc mark vl = match vl with - | v :: vl -> - if mark then - loop2 (v :: acc) mark vl - else if is_annotated (snd v.ev_name) then - (* If the name is the display position, mark the expression *) - loop2 (v :: acc) true vl - else begin match v.ev_expr with - | None -> - (* If there is no expression, we don't have to do anything. - Should the display position be on the type-hint, it will - be picked up while loading the type. *) - loop2 (v :: acc) mark vl - | Some e -> - (* Determine the area between the `|` in `var x| = | e`. This is not really - correct because we don't want completion on the left side of the `=`, but - we cannot determine that correctly without knowing its position. - Note: We know `e` itself isn't the display position because this entire - algorithm is bottom-up and it would be marked already if it was. *) - let p0 = match v.ev_type with - | Some (_,pt) -> pt - | None -> snd v.ev_name - in - let p = {p0 with pmax = (pos e).pmin} in - let e = if is_annotated p then annotate_marked e else e in - loop2 ({ v with ev_expr = Some e } :: acc) mark vl - end - | [] -> - List.rev acc,mark - in - let vl,mark = loop2 [] false vl in - let e = EVars (List.rev vl),pos e in - if !was_annotated then e else raise Exit - | EBinop((OpAssign | OpAssignOp _) as op,e1,e2) when is_annotated (pos e) && is_completion -> - (* Special case for assign ops: If the expression is marked, but none of its operands are, - we are "probably" interested in the rhs. Like with EVars, this isn't accurate because we - could be on the left side of the `=`. I don't think there's a reason for requesting - completion there though. *) - (EBinop(op,e1,annotate_marked e2)),(pos e) - | EBinop(OpOr,e1,(EIf(_,(EConst(Ident "null"),_),None),p1)) when is_annotated (pos e) && is_completion && !in_pattern -> - (* This HAS TO come from an attempted `case pattern | guard:` completion (issue #7068). *) - let p = { p1 with pmin = (pos e1).pmax; pmax = p1.pmin } in - EBinop(OpOr,e1,mk_null p),(pos e) - | EIf(_,(EConst(Ident "null"),_),None) when is_completion && !in_pattern -> - (* This is fine. *) - mk_null (pos e) - | EBlock [] when is_annotated (pos e) -> - annotate e DKStructure - | EBlock [EDisplay((EConst(Ident s),pn),DKMarked),_] when is_completion -> - let e = EObjectDecl [(s,pn,NoQuotes),(EConst (Ident "null"),null_pos)],(pos e) in - annotate e DKStructure - | EBlock el when is_annotated (pos e) && is_completion -> - let el = loop_el el in - EBlock el,(pos e) - | ECall(e1,el) when is_annotated (pos e) && is_completion -> - let el = loop_el el in - ECall(e1,el),(pos e) - | ENew(ptp,el) when is_annotated (pos e) && is_completion -> - if is_annotated ptp.pos_full || ptp.pos_full.pmax >= (DisplayPosition.display_position#get).pmax then - annotate_marked e - else begin - let el = loop_el el in - ENew(ptp,el),(pos e) - end - | EArrayDecl el when is_annotated (pos e) && is_completion -> - let el = loop_el el in - EArrayDecl el,(pos e) - | EObjectDecl fl when is_annotated (pos e) && is_completion -> - annotate e DKStructure - | ESwitch(e1,cases,def) when is_annotated (pos e) -> - (* We must be "between" two cases, or at the end of the last case. - Let's find the last case which has a position that is < the display - position and mark it. *) - let did_mark = ref false in - let mark_case ec p = - did_mark := true; - let ep = mk_null p in - match ec with - | Some ec -> - let ec = match fst ec with - | EBlock el -> (EBlock (el @ [ep]),p) - | _ -> (EBlock [ec;ep],p) - in - Some ec - | None -> - Some (mk_null p) - in - let rec loop cases = match cases with - | [el,eg,ec,p1] -> - let ec = match def with - | None when (pos e).pmax > !display_pos.pmin -> (* this is so we don't trigger if we're on the } *) - mark_case ec p1 (* no default, must be the last case *) - | Some (_,p2) when p1.pmax <= !display_pos.pmin && p2.pmin >= !display_pos.pmax -> - mark_case ec p1 (* default is beyond display position, mark *) - | _ -> - ec (* default contains display position, don't mark *) - in - [el,eg,ec,p1] - | (el1,eg1,ec1,p1) :: (el2,eg2,ec2,p2) :: cases -> - if p1.pmax <= !display_pos.pmin && p2.pmin >= !display_pos.pmax then - (el1,eg1,mark_case ec1 p1,p1) :: (el2,eg2,ec2,p2) :: cases - else - (el1,eg1,ec1,p1) :: loop ((el2,eg2,ec2,p2) :: cases) - | [] -> - [] - in - let cases = loop cases in - let def = if !did_mark then - def - else match def with - | Some(eo,p) when (pos e).pmax > !display_pos.pmin -> Some (mark_case eo p,p) - | _ -> def - in - ESwitch(e1,cases,def),pos e - | EDisplay _ -> - raise Exit - | EMeta((Meta.Markup,_,_),(EConst(String _),p)) when is_annotated p -> - annotate_marked e - | EConst (String (_,q)) when ((q <> SSingleQuotes) || !Parser.was_auto_triggered) && is_annotated (pos e) && is_completion -> - (* TODO: check if this makes any sense *) - raise Exit - | EConst(Regexp _) when is_annotated (pos e) && is_completion -> - raise Exit - | EVars vl when is_annotated (pos e) -> - (* We only want to mark EVars if we're on a var name. *) - if List.exists (fun v -> is_annotated (snd v.ev_name)) vl then - annotate_marked e - else - raise Exit - | _ -> - if is_annotated (pos e) then - annotate_marked e - else - e - in - let opt f o = - match o with None -> None | Some v -> Some (f v) - in - let rec map e = match fst e with - | ESwitch(e1,cases,def) when is_annotated (pos e) -> - let e1 = map e1 in - let cases = List.map (fun (el,eg,e,p) -> - let old = !in_pattern in - in_pattern := true; - let el = List.map map el in - in_pattern := old; - let eg = opt map eg in - let e = opt map e in - el,eg,e,p - ) cases in - let def = opt (fun (eo,p) -> opt map eo,p) def in - loop (ESwitch (e1, cases, def),(pos e)) - | _ -> - loop (Ast.map_expr map e) - in - try map e with Exit -> e - - let find_display_call e = - let found = ref false in - let handle_el e el = - let call_arg_is_marked () = - el = [] || List.exists (fun (e,_) -> match e with EDisplay(_,DKMarked) -> true | _ -> false) el - in - if not !Parser.was_auto_triggered || call_arg_is_marked () then begin - found := true; - Parser.mk_display_expr e DKCall - end else - e - in - let loop e = match fst e with - | ECall(_,el) | ENew(_,el) when not !found && display_position#enclosed_in (pos e) -> - handle_el e el - | EArray(e1,e2) when not !found && display_position#enclosed_in (pos e2) -> - handle_el e [e2] - | EDisplay(_,DKCall) -> - raise Exit - | _ -> e - in - let rec map e = loop (Ast.map_expr map e) in - try map e with Exit -> e - - - let process_expr com e = match com.display.dms_kind with - | DMDefinition | DMTypeDefinition | DMUsage _ | DMImplementation | DMHover | DMDefault -> find_before_pos com.display.dms_kind e - | DMSignature -> find_display_call e - | _ -> e -end +let preprocess_expr com e = match com.display.dms_kind with + | DMDefinition | DMTypeDefinition | DMUsage _ | DMImplementation | DMHover | DMDefault -> ExprPreprocessing.find_before_pos com.display.dms_kind e + | DMSignature -> ExprPreprocessing.find_display_call e + | _ -> e let get_expected_name with_type = match with_type with | WithType.Value (Some src) | WithType.WithType(_,Some src) -> diff --git a/src/context/display/displayEmitter.ml b/src/context/display/displayEmitter.ml index 681f807736f..e77bdd333c3 100644 --- a/src/context/display/displayEmitter.ml +++ b/src/context/display/displayEmitter.ml @@ -168,7 +168,7 @@ let check_display_metadata ctx meta = if display_position#enclosed_in p then display_meta ctx.com meta p; List.iter (fun e -> if display_position#enclosed_in (pos e) then begin - let e = ExprPreprocessing.process_expr ctx.com e in + let e = preprocess_expr ctx.com e in delay ctx PTypeField (fun _ -> ignore(type_expr ctx e WithType.value)); end ) args diff --git a/src/context/display/exprPreprocessing.ml b/src/context/display/exprPreprocessing.ml new file mode 100644 index 00000000000..2f5f7166028 --- /dev/null +++ b/src/context/display/exprPreprocessing.ml @@ -0,0 +1,224 @@ +open Globals +open Ast +open DisplayTypes.DisplayMode +open DisplayPosition + +let find_before_pos dm e = + let display_pos = ref (DisplayPosition.display_position#get) in + let was_annotated = ref false in + let is_annotated,is_completion = match dm with + | DMDefault -> (fun p -> not !was_annotated && encloses_position !display_pos p),true + | DMHover -> (fun p -> not !was_annotated && encloses_position_gt !display_pos p),false + | _ -> (fun p -> not !was_annotated && encloses_position !display_pos p),false + in + let annotate e dk = + was_annotated := true; + (EDisplay(e,dk),pos e) + in + let annotate_marked e = annotate e DKMarked in + let mk_null p = annotate_marked ((EConst(Ident "null")),p) in + let loop_el el = + let pr = DisplayPosition.display_position#with_pos (pos e) in + let rec loop el = match el with + | [] -> [mk_null pr] + | e :: el -> + if (pos e).pmin >= pr.pmax then (mk_null pr) :: e :: el + else e :: loop el + in + (* print_endline (Printf.sprintf "%i-%i: PR" pr.pmin pr.pmax); + List.iter (fun e -> + print_endline (Printf.sprintf "%i-%i: %s" (pos e).pmin (pos e).pmax (Ast.s_expr e)); + ) el; *) + match el with + | [] -> [mk_null pr] + | e :: el -> + if (pos e).pmin >= pr.pmax then (mk_null pr) :: e :: el + else loop (e :: el) + in + let in_pattern = ref false in + let loop e = + (* print_endline (Printf.sprintf "%i-%i: %s" (pos e).pmin (pos e).pmax (Ast.s_expr e)); *) + match fst e with + | EFunction(FKNamed((_,p),_),_) when is_annotated p && is_completion -> + raise Exit + | EVars vl when is_annotated (pos e) && is_completion -> + let rec loop2 acc mark vl = match vl with + | v :: vl -> + if mark then + loop2 (v :: acc) mark vl + else if is_annotated (snd v.ev_name) then + (* If the name is the display position, mark the expression *) + loop2 (v :: acc) true vl + else begin match v.ev_expr with + | None -> + (* If there is no expression, we don't have to do anything. + Should the display position be on the type-hint, it will + be picked up while loading the type. *) + loop2 (v :: acc) mark vl + | Some e -> + (* Determine the area between the `|` in `var x| = | e`. This is not really + correct because we don't want completion on the left side of the `=`, but + we cannot determine that correctly without knowing its position. + Note: We know `e` itself isn't the display position because this entire + algorithm is bottom-up and it would be marked already if it was. *) + let p0 = match v.ev_type with + | Some (_,pt) -> pt + | None -> snd v.ev_name + in + let p = {p0 with pmax = (pos e).pmin} in + let e = if is_annotated p then annotate_marked e else e in + loop2 ({ v with ev_expr = Some e } :: acc) mark vl + end + | [] -> + List.rev acc,mark + in + let vl,mark = loop2 [] false vl in + let e = EVars (List.rev vl),pos e in + if !was_annotated then e else raise Exit + | EBinop((OpAssign | OpAssignOp _) as op,e1,e2) when is_annotated (pos e) && is_completion -> + (* Special case for assign ops: If the expression is marked, but none of its operands are, + we are "probably" interested in the rhs. Like with EVars, this isn't accurate because we + could be on the left side of the `=`. I don't think there's a reason for requesting + completion there though. *) + (EBinop(op,e1,annotate_marked e2)),(pos e) + | EBinop(OpOr,e1,(EIf(_,(EConst(Ident "null"),_),None),p1)) when is_annotated (pos e) && is_completion && !in_pattern -> + (* This HAS TO come from an attempted `case pattern | guard:` completion (issue #7068). *) + let p = { p1 with pmin = (pos e1).pmax; pmax = p1.pmin } in + EBinop(OpOr,e1,mk_null p),(pos e) + | EIf(_,(EConst(Ident "null"),_),None) when is_completion && !in_pattern -> + (* This is fine. *) + mk_null (pos e) + | EBlock [] when is_annotated (pos e) -> + annotate e DKStructure + | EBlock [EDisplay((EConst(Ident s),pn),DKMarked),_] when is_completion -> + let e = EObjectDecl [(s,pn,NoQuotes),(EConst (Ident "null"),null_pos)],(pos e) in + annotate e DKStructure + | EBlock el when is_annotated (pos e) && is_completion -> + let el = loop_el el in + EBlock el,(pos e) + | ECall(e1,el) when is_annotated (pos e) && is_completion -> + let el = loop_el el in + ECall(e1,el),(pos e) + | ENew(ptp,el) when is_annotated (pos e) && is_completion -> + if is_annotated ptp.pos_full || ptp.pos_full.pmax >= (DisplayPosition.display_position#get).pmax then + annotate_marked e + else begin + let el = loop_el el in + ENew(ptp,el),(pos e) + end + | EArrayDecl el when is_annotated (pos e) && is_completion -> + let el = loop_el el in + EArrayDecl el,(pos e) + | EObjectDecl fl when is_annotated (pos e) && is_completion -> + annotate e DKStructure + | ESwitch(e1,cases,def) when is_annotated (pos e) -> + (* We must be "between" two cases, or at the end of the last case. + Let's find the last case which has a position that is < the display + position and mark it. *) + let did_mark = ref false in + let mark_case ec p = + did_mark := true; + let ep = mk_null p in + match ec with + | Some ec -> + let ec = match fst ec with + | EBlock el -> (EBlock (el @ [ep]),p) + | _ -> (EBlock [ec;ep],p) + in + Some ec + | None -> + Some (mk_null p) + in + let rec loop cases = match cases with + | [el,eg,ec,p1] -> + let ec = match def with + | None when (pos e).pmax > !display_pos.pmin -> (* this is so we don't trigger if we're on the } *) + mark_case ec p1 (* no default, must be the last case *) + | Some (_,p2) when p1.pmax <= !display_pos.pmin && p2.pmin >= !display_pos.pmax -> + mark_case ec p1 (* default is beyond display position, mark *) + | _ -> + ec (* default contains display position, don't mark *) + in + [el,eg,ec,p1] + | (el1,eg1,ec1,p1) :: (el2,eg2,ec2,p2) :: cases -> + if p1.pmax <= !display_pos.pmin && p2.pmin >= !display_pos.pmax then + (el1,eg1,mark_case ec1 p1,p1) :: (el2,eg2,ec2,p2) :: cases + else + (el1,eg1,ec1,p1) :: loop ((el2,eg2,ec2,p2) :: cases) + | [] -> + [] + in + let cases = loop cases in + let def = if !did_mark then + def + else match def with + | Some(eo,p) when (pos e).pmax > !display_pos.pmin -> Some (mark_case eo p,p) + | _ -> def + in + ESwitch(e1,cases,def),pos e + | EDisplay _ -> + raise Exit + | EMeta((Meta.Markup,_,_),(EConst(String _),p)) when is_annotated p -> + annotate_marked e + | EConst (String (_,q)) when ((q <> SSingleQuotes) || !Parser.was_auto_triggered) && is_annotated (pos e) && is_completion -> + (* TODO: check if this makes any sense *) + raise Exit + | EConst(Regexp _) when is_annotated (pos e) && is_completion -> + raise Exit + | EVars vl when is_annotated (pos e) -> + (* We only want to mark EVars if we're on a var name. *) + if List.exists (fun v -> is_annotated (snd v.ev_name)) vl then + annotate_marked e + else + raise Exit + | _ -> + if is_annotated (pos e) then + annotate_marked e + else + e + in + let opt f o = + match o with None -> None | Some v -> Some (f v) + in + let rec map e = match fst e with + | ESwitch(e1,cases,def) when is_annotated (pos e) -> + let e1 = map e1 in + let cases = List.map (fun (el,eg,e,p) -> + let old = !in_pattern in + in_pattern := true; + let el = List.map map el in + in_pattern := old; + let eg = opt map eg in + let e = opt map e in + el,eg,e,p + ) cases in + let def = opt (fun (eo,p) -> opt map eo,p) def in + loop (ESwitch (e1, cases, def),(pos e)) + | _ -> + loop (Ast.map_expr map e) + in + try map e with Exit -> e + +let find_display_call e = + let found = ref false in + let handle_el e el = + let call_arg_is_marked () = + el = [] || List.exists (fun (e,_) -> match e with EDisplay(_,DKMarked) -> true | _ -> false) el + in + if not !Parser.was_auto_triggered || call_arg_is_marked () then begin + found := true; + Parser.mk_display_expr e DKCall + end else + e + in + let loop e = match fst e with + | ECall(_,el) | ENew(_,el) when not !found && display_position#enclosed_in (pos e) -> + handle_el e el + | EArray(e1,e2) when not !found && display_position#enclosed_in (pos e2) -> + handle_el e [e2] + | EDisplay(_,DKCall) -> + raise Exit + | _ -> e + in + let rec map e = loop (Ast.map_expr map e) in + try map e with Exit -> e \ No newline at end of file diff --git a/src/context/formatString.ml b/src/context/formatString.ml new file mode 100644 index 00000000000..69d255f58fd --- /dev/null +++ b/src/context/formatString.ml @@ -0,0 +1,98 @@ +open Globals +open Ast + +let format_string defines s p process_expr = + let e = ref None in + let pmin = ref p.pmin in + let min = ref (p.pmin + 1) in + let add_expr (enext,p) len = + min := !min + len; + let enext = process_expr enext p in + match !e with + | None -> e := Some enext + | Some prev -> + e := Some (EBinop (OpAdd,prev,enext),punion (pos prev) p) + in + let add enext len = + let p = { p with pmin = !min; pmax = !min + len } in + add_expr (enext,p) len + in + let add_sub start pos = + let len = pos - start in + if len > 0 || !e = None then add (EConst (String (String.sub s start len,SDoubleQuotes))) len + in + let len = String.length s in + let rec parse start pos = + if pos = len then add_sub start pos else + let c = String.unsafe_get s pos in + let pos = pos + 1 in + if c = '\'' then begin + incr pmin; + incr min; + end; + if c <> '$' || pos = len then parse start pos else + match String.unsafe_get s pos with + | '$' -> + (* double $ *) + add_sub start pos; + parse (pos + 1) (pos + 1) + | '{' -> + parse_group start pos '{' '}' "brace" + | 'a'..'z' | 'A'..'Z' | '_' -> + add_sub start (pos - 1); + incr min; + let rec loop i = + if i = len then i else + let c = String.unsafe_get s i in + match c with + | 'a'..'z' | 'A'..'Z' | '0'..'9' | '_' -> loop (i+1) + | _ -> i + in + let iend = loop (pos + 1) in + let len = iend - pos in + add (EConst (Ident (String.sub s pos len))) len; + parse (pos + len) (pos + len) + | _ -> + (* keep as-it *) + parse start pos + and parse_group start pos gopen gclose gname = + add_sub start (pos - 1); + let rec loop groups i = + if i = len then + match groups with + | [] -> die "" __LOC__ + | g :: _ -> Error.raise_typing_error ("Unclosed " ^ gname) { p with pmin = !pmin + g + 1; pmax = !pmin + g + 2 } + else + let c = String.unsafe_get s i in + if c = gopen then + loop (i :: groups) (i + 1) + else if c = gclose then begin + let groups = List.tl groups in + if groups = [] then i else loop groups (i + 1) + end else + loop groups (i + 1) + in + let send = loop [pos] (pos + 1) in + let slen = send - pos - 1 in + let scode = String.sub s (pos + 1) slen in + min := !min + 2; + begin + let e = + let ep = { p with pmin = !pmin + pos + 2; pmax = !pmin + send + 1 } in + let error msg pos = + if Lexer.string_is_whitespace scode then Error.raise_typing_error "Expression cannot be empty" ep + else Error.raise_typing_error msg pos + in + match ParserEntry.parse_expr_string defines scode ep error true with + | ParseSuccess(data,_,_) -> data + | ParseError(_,(msg,p),_) -> error (Parser.error_msg msg) p + in + add_expr e slen + end; + min := !min + 1; + parse (send + 1) (send + 1) + in + parse 0 0; + match !e with + | None -> die "" __LOC__ + | Some e -> e diff --git a/src/context/memory.ml b/src/context/memory.ml index 8d16ca17ffe..58eab29cdc5 100644 --- a/src/context/memory.ml +++ b/src/context/memory.ml @@ -122,8 +122,8 @@ let get_memory_json (cs : CompilationCache.t) mreq = "nativeLibCache",jint (mem_size cache_mem.(3)); "additionalSizes",jarray [ jobject ["name",jstring "macro interpreter";"size",jint (mem_size (MacroContext.macro_interp_cache))]; - jobject ["name",jstring "macro stdlib";"size",jint (mem_size (EvalContext.GlobalState.stdlib))]; - jobject ["name",jstring "macro macro_lib";"size",jint (mem_size (EvalContext.GlobalState.macro_lib))]; + (* jobject ["name",jstring "macro stdlib";"size",jint (mem_size (EvalContext.GlobalState.stdlib))]; + jobject ["name",jstring "macro macro_lib";"size",jint (mem_size (EvalContext.GlobalState.macro_lib))]; *) jobject ["name",jstring "last completion result";"size",jint (mem_size (DisplayException.last_completion_result))]; jobject ["name",jstring "Lexer file cache";"size",jint (mem_size (Lexer.all_files))]; jobject ["name",jstring "GC heap words";"size",jint (int_of_float size)]; diff --git a/src/context/typecore.ml b/src/context/typecore.ml index f0fcded97f9..9597863c742 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -23,6 +23,7 @@ open Common open Type open Error open Resolution +open FieldCallCandidate type type_patch = { mutable tp_type : complex_type option; @@ -98,7 +99,8 @@ type typer_globals = { retain_meta : bool; mutable core_api : typer option; mutable macros : ((unit -> unit) * typer) option; - mutable std : module_def; + mutable std : tclass; + mutable std_types : module_def; type_patches : (path, (string * bool, type_patch) Hashtbl.t * type_patch) Hashtbl.t; mutable module_check_policies : (string list * module_check_policy list * bool) list; mutable global_using : (tclass * pos) list; @@ -162,24 +164,6 @@ and monomorphs = { mutable perfunction : (tmono * pos) list; } -(* This record holds transient information about an (attempted) call on a field. It is created when resolving - field calls and is passed to overload filters. *) -type 'a field_call_candidate = { - (* The argument expressions for this call and whether or not the argument is optional on the - target function. *) - fc_args : texpr list; - (* The applied return type. *) - fc_ret : Type.t; - (* The applied function type. *) - fc_type : Type.t; - (* The class field being called. *) - fc_field : tclass_field; - (* The field monomorphs that were created for this call. *) - fc_monos : Type.t list; - (* The custom data associated with this call. *) - fc_data : 'a; -} - type field_host = | FHStatic of tclass | FHInstance of tclass * tparams @@ -698,26 +682,6 @@ let safe_mono_close ctx m p = Unify_error l -> raise_or_display ctx l p -let make_field_call_candidate args ret monos t cf data = { - fc_args = args; - fc_type = t; - fc_field = cf; - fc_data = data; - fc_ret = ret; - fc_monos = monos; -} - -let s_field_call_candidate fcc = - let pctx = print_context() in - let se = s_expr_pretty false "" false (s_type pctx) in - let sl_args = List.map se fcc.fc_args in - Printer.s_record_fields "" [ - "fc_args",String.concat ", " sl_args; - "fc_type",s_type pctx fcc.fc_type; - "fc_field",Printf.sprintf "%s: %s" fcc.fc_field.cf_name (s_type pctx fcc.fc_field.cf_type) - ] - - let relative_path ctx file = let slashes path = String.concat "/" (ExtString.String.nsplit path "\\") in let fpath = slashes (Path.get_full_path file) in diff --git a/src/core/naming.ml b/src/core/naming.ml new file mode 100644 index 00000000000..05b9bedb4ef --- /dev/null +++ b/src/core/naming.ml @@ -0,0 +1,88 @@ +open Globals +open Ast +open Meta +open Type +open Error + +(** retrieve string from @:native metadata or raise Not_found *) +let get_native_name meta = + let rec get_native meta = match meta with + | [] -> raise Not_found + | (Meta.Native,[v],p as meta) :: _ -> + meta + | _ :: meta -> + get_native meta + in + let (_,e,mp) = get_native meta in + match e with + | [Ast.EConst (Ast.String(name,_)),p] -> + name,p + | [] -> + raise Not_found + | _ -> + Error.raise_typing_error "String expected" mp + +(* Rewrites class or enum paths if @:native metadata is set *) +let apply_native_paths t = + let get_real_name meta name = + let name',p = get_native_name meta in + (Meta.RealPath,[Ast.EConst (Ast.String (name,SDoubleQuotes)), p], p), name' + in + let get_real_path meta path = + let name,p = get_native_name meta in + (Meta.RealPath,[Ast.EConst (Ast.String (s_type_path path,SDoubleQuotes)), p], p), parse_path name + in + try + (match t with + | TClassDecl c -> + let did_change = ref false in + let field cf = try + let meta,name = get_real_name cf.cf_meta cf.cf_name in + cf.cf_name <- name; + cf.cf_meta <- meta :: cf.cf_meta; + List.iter (fun cf -> cf.cf_name <- name) cf.cf_overloads; + did_change := true + with Not_found -> + () + in + let fields cfs old_map = + did_change := false; + List.iter field cfs; + if !did_change then + List.fold_left (fun map f -> PMap.add f.cf_name f map) PMap.empty cfs + else + old_map + in + c.cl_fields <- fields c.cl_ordered_fields c.cl_fields; + c.cl_statics <- fields c.cl_ordered_statics c.cl_statics; + let meta,path = get_real_path c.cl_meta c.cl_path in + c.cl_meta <- meta :: c.cl_meta; + c.cl_path <- path; + | TEnumDecl e -> + let did_change = ref false in + let field _ ef = try + let meta,name = get_real_name ef.ef_meta ef.ef_name in + ef.ef_name <- name; + ef.ef_meta <- meta :: ef.ef_meta; + did_change := true; + with Not_found -> + () + in + PMap.iter field e.e_constrs; + if !did_change then begin + let names = ref [] in + e.e_constrs <- PMap.fold + (fun ef map -> + names := ef.ef_name :: !names; + PMap.add ef.ef_name ef map + ) + e.e_constrs PMap.empty; + e.e_names <- !names; + end; + let meta,path = get_real_path e.e_meta e.e_path in + e.e_meta <- meta :: e.e_meta; + e.e_path <- path; + | _ -> + ()) + with Not_found -> + () \ No newline at end of file diff --git a/src/core/socket.ml b/src/core/socket.ml index 58888134db8..f037c3e6a6c 100644 --- a/src/core/socket.ml +++ b/src/core/socket.ml @@ -37,6 +37,17 @@ let read_string socket = let _ = recv socket buf 0 i [] in Bytes.to_string buf +let write_byte this i v = + Bytes.set this i (Char.unsafe_chr v) + +let write_i32 this i v = + let base = Int32.to_int v in + let big = Int32.to_int (Int32.shift_right_logical v 24) in + write_byte this i base; + write_byte this (i + 1) (base lsr 8); + write_byte this (i + 2) (base lsr 16); + write_byte this (i + 3) big + let send_string socket s = match socket.socket with | None -> @@ -45,7 +56,7 @@ let send_string socket s = let b = Bytes.unsafe_of_string s in let l = Bytes.length b in let buf = Bytes.make 4 ' ' in - EvalBytes.write_i32 buf 0 (Int32.of_int l); + write_i32 buf 0 (Int32.of_int l); ignore(send socket buf 0 4 []); let rec loop length offset = if length <= 0 then diff --git a/src/filters/addFieldInits.ml b/src/filters/addFieldInits.ml new file mode 100644 index 00000000000..91e302294b1 --- /dev/null +++ b/src/filters/addFieldInits.ml @@ -0,0 +1,68 @@ +open Globals +open Common +open Type + + +let add_field_inits cl_path locals com t = + let apply c = + 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 + let inits,fields = List.fold_left (fun (inits,fields) cf -> + match cf.cf_kind,cf.cf_expr with + | Var _, Some _ -> (cf :: inits, cf :: fields) + | _ -> (inits, cf :: fields) + ) ([],[]) c.cl_ordered_fields in + c.cl_ordered_fields <- (List.rev fields); + match inits with + | [] -> () + | _ -> + let el = List.map (fun cf -> + match cf.cf_expr with + | None -> die "" __LOC__ + | Some e -> + 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 + let el = if !need_this then (mk (TVar((v, Some ethis))) ethis.etype ethis.epos) :: el else el in + let cf = match c.cl_constructor with + | None -> + let ct = TFun([],com.basic.tvoid) in + let ce = mk (TFunction { + tf_args = []; + tf_type = com.basic.tvoid; + tf_expr = mk (TBlock el) com.basic.tvoid c.cl_pos; + }) ct c.cl_pos in + let ctor = mk_field "new" ct c.cl_pos null_pos in + ctor.cf_kind <- Method MethNormal; + { ctor with cf_expr = Some ce } + | Some cf -> + match cf.cf_expr with + | Some { eexpr = TFunction f } -> + let bl = match f.tf_expr with {eexpr = TBlock b } -> b | x -> [x] in + let ce = mk (TFunction {f with tf_expr = mk (TBlock (el @ bl)) com.basic.tvoid c.cl_pos }) cf.cf_type cf.cf_pos in + {cf with cf_expr = Some ce }; + | _ -> + die "" __LOC__ + in + let config = AnalyzerConfig.get_field_config com c cf in + remove_class_field_flag cf CfPostProcessed; + Analyzer.Run.run_on_field com config c cf; + add_class_field_flag cf CfPostProcessed; + (match cf.cf_expr with + | Some e -> + (* This seems a bit expensive, but hopefully constructor expressions aren't that massive. *) + let e = RenameVars.run cl_path locals e in + let e = Optimizer.sanitize com e in + cf.cf_expr <- Some e + | _ -> + ()); + c.cl_constructor <- Some cf + in + match t with + | TClassDecl c -> + apply c + | _ -> + () \ No newline at end of file diff --git a/src/filters/exceptionFunctions.ml b/src/filters/exceptionFunctions.ml new file mode 100644 index 00000000000..8c6d061a41c --- /dev/null +++ b/src/filters/exceptionFunctions.ml @@ -0,0 +1,22 @@ +open Type + +let haxe_exception_type_path = (["haxe"],"Exception") +let value_exception_type_path = (["haxe"],"ValueException") + +(** + Check if `cls` is or extends (if `check_parent=true`) `haxe.Exception` +*) + let rec is_haxe_exception_class ?(check_parent=true) cls = + cls.cl_path = haxe_exception_type_path + || (check_parent && match cls.cl_super with + | None -> false + | Some (cls, _) -> is_haxe_exception_class ~check_parent cls + ) + + (** + Check if `t` is or extends `haxe.Exception` + *) + let is_haxe_exception ?(check_parent=true) (t:Type.t) = + match Abstract.follow_with_abstracts t with + | TInst (cls, _) -> is_haxe_exception_class ~check_parent cls + | _ -> false \ No newline at end of file diff --git a/src/filters/exceptions.ml b/src/filters/exceptions.ml index 40be2a218ce..98003ee7e9f 100644 --- a/src/filters/exceptions.ml +++ b/src/filters/exceptions.ml @@ -4,9 +4,7 @@ open Type open Common open Typecore open Error - -let haxe_exception_type_path = (["haxe"],"Exception") -let value_exception_type_path = (["haxe"],"ValueException") +open ExceptionFunctions type context = { typer : typer; @@ -65,11 +63,7 @@ let haxe_exception_instance_call ctx haxe_exception method_name args p = *) let std_is ctx e t p = let t = follow t in - let std_cls = - match Typeload.load_type_raise ctx.typer ([],"Std") "Std" p with - | TClassDecl cls -> cls - | _ -> raise_typing_error "Std is expected to be a class" p - in + let std_cls = ctx.typer.g.std in let isOfType_field = try PMap.find "isOfType" std_cls.cl_statics with Not_found -> raise_typing_error ("Std has no field isOfType") p @@ -122,23 +116,6 @@ let is_haxe_wildcard_catch ctx t = let t = Abstract.follow_with_abstracts t in t == t_dynamic || fast_eq ctx.haxe_exception_type t -(** - Check if `cls` is or extends (if `check_parent=true`) `haxe.Exception` -*) -let rec is_haxe_exception_class ?(check_parent=true) cls = - cls.cl_path = haxe_exception_type_path - || (check_parent && match cls.cl_super with - | None -> false - | Some (cls, _) -> is_haxe_exception_class ~check_parent cls - ) - -(** - Check if `t` is or extends `haxe.Exception` -*) -let is_haxe_exception ?(check_parent=true) (t:Type.t) = - match Abstract.follow_with_abstracts t with - | TInst (cls, _) -> is_haxe_exception_class ~check_parent cls - | _ -> false (** Check if `v` variable is used in `e` expression diff --git a/src/filters/filters.ml b/src/filters/filters.ml index 37f5bc5ec5e..e3ab6478d7c 100644 --- a/src/filters/filters.ml +++ b/src/filters/filters.ml @@ -25,7 +25,7 @@ open Error open Globals open FiltersCommon -let get_native_name = TypeloadCheck.get_native_name +let get_native_name = Naming.get_native_name (* PASS 1 begin *) @@ -66,66 +66,6 @@ let rec add_final_return e = { e with eexpr = TFunction f } | _ -> e -module LocalStatic = struct - let promote_local_static ctx lut v eo = - let name = Printf.sprintf "%s_%s" ctx.curfield.cf_name v.v_name in - begin try - let cf = PMap.find name ctx.curclass.cl_statics in - display_error ctx.com (Printf.sprintf "The expanded name of this local (%s) conflicts with another static field" name) v.v_pos; - raise_typing_error ~depth:1 "Conflicting field was found here" cf.cf_name_pos; - with Not_found -> - let cf = mk_field name ~static:true v.v_type v.v_pos v.v_pos in - cf.cf_meta <- v.v_meta; - begin match eo with - | None -> - () - | Some e -> - let rec loop e = match e.eexpr with - | TLocal _ | TFunction _ -> - raise_typing_error "Accessing local variables in static initialization is not allowed" e.epos - | TConst (TThis | TSuper) -> - raise_typing_error "Accessing `this` in static initialization is not allowed" e.epos - | TReturn _ | TBreak | TContinue -> - raise_typing_error "This kind of control flow in static initialization is not allowed" e.epos - | _ -> - iter loop e - in - loop e; - cf.cf_expr <- Some e - end; - TClass.add_field ctx.curclass cf; - Hashtbl.add lut v.v_id cf - end - - let find_local_static lut v = - Hashtbl.find lut v.v_id - - let run ctx e = - let local_static_lut = Hashtbl.create 0 in - let c = ctx.curclass in - let rec run e = match e.eexpr with - | TBlock el -> - let el = ExtList.List.filter_map (fun e -> match e.eexpr with - | TVar(v,eo) when has_var_flag v VStatic -> - promote_local_static ctx local_static_lut v eo; - None - | _ -> - Some (run e) - ) el in - { e with eexpr = TBlock el } - | TLocal v when has_var_flag v VStatic -> - begin try - let cf = find_local_static local_static_lut v in - Texpr.Builder.make_static_field c cf e.epos - with Not_found -> - raise_typing_error (Printf.sprintf "Could not find local static %s (id %i)" v.v_name v.v_id) e.epos - end - | _ -> - Type.map_expr run e - in - run e -end - (* -------------------------------------------------------------------------- *) (* CHECK LOCAL VARS INIT *) @@ -356,12 +296,6 @@ let check_abstract_as_value e = (* PASS 2 begin *) -let remove_generic_base t = match t with - | TClassDecl c when is_removable_class c -> - add_class_flag c CExtern; - | _ -> - () - (* Removes extern and macro fields, also checks for Void fields *) let remove_extern_fields com t = match t with @@ -393,71 +327,6 @@ let check_private_path com t = match t with | _ -> () -(* Rewrites class or enum paths if @:native metadata is set *) -let apply_native_paths t = - let get_real_name meta name = - let name',p = get_native_name meta in - (Meta.RealPath,[Ast.EConst (Ast.String (name,SDoubleQuotes)), p], p), name' - in - let get_real_path meta path = - let name,p = get_native_name meta in - (Meta.RealPath,[Ast.EConst (Ast.String (s_type_path path,SDoubleQuotes)), p], p), parse_path name - in - try - (match t with - | TClassDecl c -> - let did_change = ref false in - let field cf = try - let meta,name = get_real_name cf.cf_meta cf.cf_name in - cf.cf_name <- name; - cf.cf_meta <- meta :: cf.cf_meta; - List.iter (fun cf -> cf.cf_name <- name) cf.cf_overloads; - did_change := true - with Not_found -> - () - in - let fields cfs old_map = - did_change := false; - List.iter field cfs; - if !did_change then - List.fold_left (fun map f -> PMap.add f.cf_name f map) PMap.empty cfs - else - old_map - in - c.cl_fields <- fields c.cl_ordered_fields c.cl_fields; - c.cl_statics <- fields c.cl_ordered_statics c.cl_statics; - let meta,path = get_real_path c.cl_meta c.cl_path in - c.cl_meta <- meta :: c.cl_meta; - c.cl_path <- path; - | TEnumDecl e -> - let did_change = ref false in - let field _ ef = try - let meta,name = get_real_name ef.ef_meta ef.ef_name in - ef.ef_name <- name; - ef.ef_meta <- meta :: ef.ef_meta; - did_change := true; - with Not_found -> - () - in - PMap.iter field e.e_constrs; - if !did_change then begin - let names = ref [] in - e.e_constrs <- PMap.fold - (fun ef map -> - names := ef.ef_name :: !names; - PMap.add ef.ef_name ef map - ) - e.e_constrs PMap.empty; - e.e_names <- !names; - end; - let meta,path = get_real_path e.e_meta e.e_path in - e.e_meta <- meta :: e.e_meta; - e.e_path <- path; - | _ -> - ()) - with Not_found -> - () - (* Adds the __rtti field if required *) let add_rtti com t = let rec has_rtti c = @@ -473,71 +342,6 @@ let add_rtti com t = | _ -> () -(* Adds member field initializations as assignments to the constructor *) -let add_field_inits cl_path locals com t = - let apply c = - 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 - let inits,fields = List.fold_left (fun (inits,fields) cf -> - match cf.cf_kind,cf.cf_expr with - | Var _, Some _ -> (cf :: inits, cf :: fields) - | _ -> (inits, cf :: fields) - ) ([],[]) c.cl_ordered_fields in - c.cl_ordered_fields <- (List.rev fields); - match inits with - | [] -> () - | _ -> - let el = List.map (fun cf -> - match cf.cf_expr with - | None -> die "" __LOC__ - | Some e -> - 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 - let el = if !need_this then (mk (TVar((v, Some ethis))) ethis.etype ethis.epos) :: el else el in - let cf = match c.cl_constructor with - | None -> - let ct = TFun([],com.basic.tvoid) in - let ce = mk (TFunction { - tf_args = []; - tf_type = com.basic.tvoid; - tf_expr = mk (TBlock el) com.basic.tvoid c.cl_pos; - }) ct c.cl_pos in - let ctor = mk_field "new" ct c.cl_pos null_pos in - ctor.cf_kind <- Method MethNormal; - { ctor with cf_expr = Some ce } - | Some cf -> - match cf.cf_expr with - | Some { eexpr = TFunction f } -> - let bl = match f.tf_expr with {eexpr = TBlock b } -> b | x -> [x] in - let ce = mk (TFunction {f with tf_expr = mk (TBlock (el @ bl)) com.basic.tvoid c.cl_pos }) cf.cf_type cf.cf_pos in - {cf with cf_expr = Some ce }; - | _ -> - die "" __LOC__ - in - let config = AnalyzerConfig.get_field_config com c cf in - remove_class_field_flag cf CfPostProcessed; - Analyzer.Run.run_on_field com config c cf; - add_class_field_flag cf CfPostProcessed; - (match cf.cf_expr with - | Some e -> - (* This seems a bit expensive, but hopefully constructor expressions aren't that massive. *) - let e = RenameVars.run cl_path locals e in - let e = Optimizer.sanitize com e in - cf.cf_expr <- Some e - | _ -> - ()); - c.cl_constructor <- Some cf - in - match t with - | TClassDecl c -> - apply c - | _ -> - () - (* Adds the __meta__ field if required *) let add_meta_field com t = match t with | TClassDecl c -> @@ -667,14 +471,6 @@ let check_reserved_type_paths com t = (* PASS 3 end *) -let is_cached com t = - let m = (t_infos t).mt_module.m_extra in - m.m_processed <> 0 && m.m_processed < com.compilation_step - -let apply_filters_once ctx filters t = - let detail_times = (try int_of_string (Common.defined_value_safe ctx.com ~default:"0" Define.FilterTimes) with _ -> 0) in - if not (is_cached ctx.com t) then run_expression_filters ctx detail_times filters t - let iter_expressions fl mt = match mt with | TClassDecl c -> @@ -715,7 +511,7 @@ let destruction tctx detail_times main locals = with_timer detail_times "type 2" None (fun () -> (* PASS 2: type filters pre-DCE *) List.iter (fun t -> - remove_generic_base t; + FiltersCommon.remove_generic_base t; remove_extern_fields com t; (* check @:remove metadata before DCE so it is ignored there (issue #2923) *) check_remove_metadata t; @@ -747,9 +543,9 @@ let destruction tctx detail_times main locals = let type_filters = [ Exceptions.patch_constructors tctx; (* TODO: I don't believe this should load_instance anything at this point... *) check_private_path com; - apply_native_paths; + Naming.apply_native_paths; add_rtti com; - (match com.platform with | Java | Cs -> (fun _ -> ()) | _ -> (fun mt -> add_field_inits tctx.curclass.cl_path locals com mt)); + (match com.platform with | Java | Cs -> (fun _ -> ()) | _ -> (fun mt -> AddFieldInits.add_field_inits tctx.curclass.cl_path locals com mt)); (match com.platform with Hl -> (fun _ -> ()) | _ -> add_meta_field com); check_void_field; (match com.platform with | Cpp -> promote_first_interface_to_super | _ -> (fun _ -> ())); diff --git a/src/filters/filtersCommon.ml b/src/filters/filtersCommon.ml index aa862dd718d..0905404f2f4 100644 --- a/src/filters/filtersCommon.ml +++ b/src/filters/filtersCommon.ml @@ -18,6 +18,7 @@ *) open Globals open Type +open Common open Typecore let rec is_removable_class c = @@ -36,6 +37,12 @@ let rec is_removable_class c = | _ -> false +let remove_generic_base t = match t with + | TClassDecl c when is_removable_class c -> + add_class_flag c CExtern; + | _ -> + () + (** Check if `field` is overridden in subclasses *) @@ -82,3 +89,11 @@ let run_expression_filters ?(ignore_processed_status=false) ctx detail_times fil | TEnumDecl _ -> () | TTypeDecl _ -> () | TAbstractDecl _ -> () + +let is_cached com t = + let m = (t_infos t).mt_module.m_extra in + m.m_processed <> 0 && m.m_processed < com.compilation_step + +let apply_filters_once ctx filters t = + let detail_times = (try int_of_string (Common.defined_value_safe ctx.com ~default:"0" Define.FilterTimes) with _ -> 0) in + if not (is_cached ctx.com t) then run_expression_filters ctx detail_times filters t \ No newline at end of file diff --git a/src/filters/localStatic.ml b/src/filters/localStatic.ml new file mode 100644 index 00000000000..ce1f5dbaf9b --- /dev/null +++ b/src/filters/localStatic.ml @@ -0,0 +1,63 @@ +open Global +open Common +open Type +open Typecore +open Error + +let promote_local_static ctx lut v eo = + let name = Printf.sprintf "%s_%s" ctx.curfield.cf_name v.v_name in + begin try + let cf = PMap.find name ctx.curclass.cl_statics in + display_error ctx.com (Printf.sprintf "The expanded name of this local (%s) conflicts with another static field" name) v.v_pos; + raise_typing_error ~depth:1 "Conflicting field was found here" cf.cf_name_pos; + with Not_found -> + let cf = mk_field name ~static:true v.v_type v.v_pos v.v_pos in + cf.cf_meta <- v.v_meta; + begin match eo with + | None -> + () + | Some e -> + let rec loop e = match e.eexpr with + | TLocal _ | TFunction _ -> + raise_typing_error "Accessing local variables in static initialization is not allowed" e.epos + | TConst (TThis | TSuper) -> + raise_typing_error "Accessing `this` in static initialization is not allowed" e.epos + | TReturn _ | TBreak | TContinue -> + raise_typing_error "This kind of control flow in static initialization is not allowed" e.epos + | _ -> + iter loop e + in + loop e; + cf.cf_expr <- Some e + end; + TClass.add_field ctx.curclass cf; + Hashtbl.add lut v.v_id cf + end + +let find_local_static lut v = + Hashtbl.find lut v.v_id + +let run ctx e = + let local_static_lut = Hashtbl.create 0 in + let c = ctx.curclass in + let rec run e = match e.eexpr with + | TBlock el -> + let el = ExtList.List.filter_map (fun e -> match e.eexpr with + | TVar(v,eo) when has_var_flag v VStatic -> + promote_local_static ctx local_static_lut v eo; + None + | _ -> + Some (run e) + ) el in + { e with eexpr = TBlock el } + | TLocal v when has_var_flag v VStatic -> + begin try + let cf = find_local_static local_static_lut v in + Texpr.Builder.make_static_field c cf e.epos + with Not_found -> + raise_typing_error (Printf.sprintf "Could not find local static %s (id %i)" v.v_name v.v_id) e.epos + end + | _ -> + Type.map_expr run e + in + run e \ No newline at end of file diff --git a/src/filters/renameVars.ml b/src/filters/renameVars.ml index b7c8b882c3e..5306ccd9ff9 100644 --- a/src/filters/renameVars.ml +++ b/src/filters/renameVars.ml @@ -28,17 +28,17 @@ let reserve_init ri name = let reserve_all_types ri com path_to_name = List.iter (fun mt -> let tinfos = t_infos mt in - let native_name = try fst (TypeloadCheck.get_native_name tinfos.mt_meta) with Not_found -> path_to_name tinfos.mt_path in + let native_name = try fst (Naming.get_native_name tinfos.mt_meta) with Not_found -> path_to_name tinfos.mt_path in match mt with | TClassDecl c when native_name = "" -> List.iter (fun cf -> - let native_name = try fst (TypeloadCheck.get_native_name cf.cf_meta) with Not_found -> cf.cf_name in + let native_name = try fst (Naming.get_native_name cf.cf_meta) with Not_found -> cf.cf_name in reserve_init ri native_name ) c.cl_ordered_statics | TClassDecl { cl_kind = KModuleFields m; cl_ordered_statics = fl } -> let prefix = Path.flat_path m.m_path ^ "_" in List.iter (fun cf -> - let name = try fst (TypeloadCheck.get_native_name cf.cf_meta) with Not_found -> prefix ^ cf.cf_name in + let name = try fst (Naming.get_native_name cf.cf_meta) with Not_found -> prefix ^ cf.cf_name in reserve_init ri name ) fl | _ -> diff --git a/src/generators/genjs.ml b/src/generators/genjs.ml index 37ef20c887c..02a90e3427d 100644 --- a/src/generators/genjs.ml +++ b/src/generators/genjs.ml @@ -154,13 +154,13 @@ let static_field ctx c f = let module_field m f = try - fst (TypeloadCheck.get_native_name f.cf_meta) + fst (Naming.get_native_name f.cf_meta) with Not_found -> Path.flat_path m.m_path ^ "_" ^ f.cf_name let module_field_expose_path mpath f = try - fst (TypeloadCheck.get_native_name f.cf_meta) + fst (Naming.get_native_name f.cf_meta) with Not_found -> (dot_path mpath) ^ "." ^ f.cf_name diff --git a/src/generators/genjvm.ml b/src/generators/genjvm.ml index 1fa8a737d7e..6e6c7e358e6 100644 --- a/src/generators/genjvm.ml +++ b/src/generators/genjvm.ml @@ -395,7 +395,7 @@ let is_interface_var_access c cf = let follow = Abstract.follow_with_abstracts class haxe_exception gctx (t : Type.t) = - let is_haxe_exception = Exceptions.is_haxe_exception t + let is_haxe_exception = ExceptionFunctions.is_haxe_exception t and native_type = jsignature_of_type gctx t in object(self) val native_path = (match native_type with TObject(path,_) -> path | _ -> die "" __LOC__) @@ -2134,7 +2134,7 @@ class texpr_to_jvm self#texpr rvalue_any e1; (* There could be something like `throw throw`, so we should only throw if we aren't terminated (issue #10363) *) if not (jm#is_terminated) then begin - if not (Exceptions.is_haxe_exception e1.etype) && not (does_unify e1.etype gctx.t_runtime_exception) then begin + if not (ExceptionFunctions.is_haxe_exception e1.etype) && not (does_unify e1.etype gctx.t_runtime_exception) then begin let exc = new haxe_exception gctx e1.etype in if not (List.exists (fun exc' -> exc#is_assignable_to exc') caught_exceptions) then jm#add_thrown_exception exc#get_native_path; diff --git a/src/generators/genswf9.ml b/src/generators/genswf9.ml index b689717e5fc..d34ba33fc47 100644 --- a/src/generators/genswf9.ml +++ b/src/generators/genswf9.ml @@ -1066,7 +1066,7 @@ let rec gen_expr_content ctx retval e = gen_constant ctx c e.etype e.epos | TThrow e -> ctx.infos.icond <- true; - if has_feature ctx.com "haxe.CallStack.exceptionStack" && not (Exceptions.is_haxe_exception e.etype) then begin + if has_feature ctx.com "haxe.CallStack.exceptionStack" && not (ExceptionFunctions.is_haxe_exception e.etype) then begin getvar ctx (VGlobal (type_path ctx (["flash"],"Boot"))); let id = type_path ctx (["flash";"errors"],"Error") in write ctx (HFindPropStrict id); @@ -1240,7 +1240,7 @@ let rec gen_expr_content ctx retval e = | _ -> Type.iter call_loop e in let has_call = (try call_loop e; false with Exit -> true) in - if has_call && has_feature ctx.com "haxe.CallStack.exceptionStack" && not (Exceptions.is_haxe_exception v.v_type) then begin + if has_call && has_feature ctx.com "haxe.CallStack.exceptionStack" && not (ExceptionFunctions.is_haxe_exception v.v_type) then begin getvar ctx (gen_local_access ctx v e.epos Read); write ctx (HAsType (type_path ctx (["flash";"errors"],"Error"))); let j = jump ctx J3False in diff --git a/src/macro/eval/eval.ml b/src/macro/eval/eval.ml new file mode 100644 index 00000000000..132547972ab --- /dev/null +++ b/src/macro/eval/eval.ml @@ -0,0 +1,5 @@ +include EvalEncode +include EvalDecode +include EvalValue +include EvalContext +include EvalMain \ No newline at end of file diff --git a/src/macro/eval/evalContext.ml b/src/macro/eval/evalContext.ml index 9842d4c321d..9249f6f3034 100644 --- a/src/macro/eval/evalContext.ml +++ b/src/macro/eval/evalContext.ml @@ -302,11 +302,6 @@ module GlobalState = struct let stdlib : builtins option ref = ref None let macro_lib : (string,value) Hashtbl.t = Hashtbl.create 0 - - let cleanup ctx = - (* curapi holds a reference to the typing context which we don't want to persist. Let's unset it so the - context can be collected. *) - ctx.curapi <- Obj.magic "" end let get_ctx () = (!GlobalState.get_ctx_ref)() diff --git a/src/macro/eval/evalDebugSocket.ml b/src/macro/eval/evalDebugSocket.ml index 2d135169ef8..55be0d1cb98 100644 --- a/src/macro/eval/evalDebugSocket.ml +++ b/src/macro/eval/evalDebugSocket.ml @@ -486,7 +486,7 @@ module ValueCompletion = struct DisplayPosition.display_position#set {p with pmin = offset; pmax = offset}; begin try let e = parse_expr ctx text p in - let e = Display.ExprPreprocessing.find_before_pos DMDefault e in + let e = ExprPreprocessing.find_before_pos DMDefault e in save(); let rec loop e = match fst e with | EDisplay(e1,DKDot) -> diff --git a/src/macro/eval/evalExceptions.ml b/src/macro/eval/evalExceptions.ml index 6603195dcd7..f1c146d98d6 100644 --- a/src/macro/eval/evalExceptions.ml +++ b/src/macro/eval/evalExceptions.ml @@ -27,7 +27,6 @@ open EvalField exception Break exception Continue exception Return of value -exception Sys_exit of int let s_value_kind = function | VNull -> "VNull" diff --git a/src/macro/eval/evalMain.ml b/src/macro/eval/evalMain.ml index 20db1dbf6d3..a69afdef6a6 100644 --- a/src/macro/eval/evalMain.ml +++ b/src/macro/eval/evalMain.ml @@ -145,7 +145,8 @@ let create com api is_macro = Which is printing an error to stderr and exiting with code 2 *) Luv.Error.set_on_unhandled_exception (fun ex -> match ex with - | Sys_exit _ -> raise ex + | EvalTypes.Sys_exit _ -> + raise ex | _ -> let msg = match ex with | Error.Error err -> diff --git a/src/macro/eval/evalStdLib.ml b/src/macro/eval/evalStdLib.ml index ae09bcbfef8..7cdb911bb58 100644 --- a/src/macro/eval/evalStdLib.ml +++ b/src/macro/eval/evalStdLib.ml @@ -2590,7 +2590,7 @@ module StdSys = struct ) let exit = vfun1 (fun code -> - raise (Sys_exit(decode_int code)); + raise (EvalTypes.Sys_exit(decode_int code)); ) let getChar = vfun1 (fun echo -> diff --git a/src/macro/eval/evalThread.ml b/src/macro/eval/evalThread.ml index 708b7e9e350..6230122a3cb 100644 --- a/src/macro/eval/evalThread.ml +++ b/src/macro/eval/evalThread.ml @@ -100,7 +100,7 @@ let run ctx f thread = let msg = get_exc_error_message ctx v stack p in prerr_endline msg; close(); - | Sys_exit i -> + | EvalTypes.Sys_exit i -> close(); exit i; | exc -> diff --git a/src/macro/eval/evalTypes.ml b/src/macro/eval/evalTypes.ml new file mode 100644 index 00000000000..8f8c2a11887 --- /dev/null +++ b/src/macro/eval/evalTypes.ml @@ -0,0 +1 @@ +exception Sys_exit of int \ No newline at end of file diff --git a/src/optimization/inline.ml b/src/optimization/inline.ml index d953b689a4f..a51f6a1d8b4 100644 --- a/src/optimization/inline.ml +++ b/src/optimization/inline.ml @@ -6,6 +6,8 @@ open Common open Typecore open Error +let maybe_reapply_overload_call_ref = ref (fun _ _ -> assert false) + let mk_untyped_call name p params = { eexpr = TCall({ eexpr = TIdent name; etype = t_dynamic; epos = p }, params); @@ -627,7 +629,7 @@ class inline_state ctx ethis params cf f p = object(self) else map_type in let e = Type.map_expr_type (map_expr_type map_type) map_type (map_var map_type) e in - CallUnification.maybe_reapply_overload_call ctx e + (!maybe_reapply_overload_call_ref) ctx e in let e = map_expr_type map_type e in let rec drop_unused_vars e = diff --git a/src/typing/callUnification.ml b/src/typing/callUnification.ml index a5d82477854..913beb90c2f 100644 --- a/src/typing/callUnification.ml +++ b/src/typing/callUnification.ml @@ -5,6 +5,7 @@ open Common open Typecore open Error open FieldAccess +open FieldCallCandidate let unify_call_args ctx el args r callp inline force_inline in_overload = let call_error err p = raise_error_msg (Call_error err) p in diff --git a/src/typing/fieldCallCandidate.ml b/src/typing/fieldCallCandidate.ml new file mode 100644 index 00000000000..e43a68226c9 --- /dev/null +++ b/src/typing/fieldCallCandidate.ml @@ -0,0 +1,39 @@ + +open Type + +(* This record holds transient information about an (attempted) call on a field. It is created when resolving + field calls and is passed to overload filters. *) + type 'a field_call_candidate = { + (* The argument expressions for this call and whether or not the argument is optional on the + target function. *) + fc_args : texpr list; + (* The applied return type. *) + fc_ret : Type.t; + (* The applied function type. *) + fc_type : Type.t; + (* The class field being called. *) + fc_field : tclass_field; + (* The field monomorphs that were created for this call. *) + fc_monos : Type.t list; + (* The custom data associated with this call. *) + fc_data : 'a; +} + +let make_field_call_candidate args ret monos t cf data = { + fc_args = args; + fc_type = t; + fc_field = cf; + fc_data = data; + fc_ret = ret; + fc_monos = monos; +} + +let s_field_call_candidate fcc = + let pctx = print_context() in + let se = s_expr_pretty false "" false (s_type pctx) in + let sl_args = List.map se fcc.fc_args in + Printer.s_record_fields "" [ + "fc_args",String.concat ", " sl_args; + "fc_type",s_type pctx fcc.fc_type; + "fc_field",Printf.sprintf "%s: %s" fcc.fc_field.cf_name (s_type pctx fcc.fc_field.cf_type) + ] diff --git a/src/typing/functionArguments.ml b/src/typing/functionArguments.ml index 80c9c161a75..4baf7402020 100644 --- a/src/typing/functionArguments.ml +++ b/src/typing/functionArguments.ml @@ -22,7 +22,7 @@ let type_function_arg_value ctx t c do_display = | None -> None | Some e -> let p = pos e in - let e = if do_display then Display.ExprPreprocessing.process_expr ctx.com e else e in + let e = if do_display then Display.preprocess_expr ctx.com e else e in let e = Optimizer.reduce_expression ctx (type_expr ctx e (WithType.with_type t)) in unify ctx e.etype t p; let rec loop e = match e.eexpr with diff --git a/src/typing/generic.ml b/src/typing/generic.ml index 70bc96890d7..c9dcf4d3713 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -5,6 +5,7 @@ open Ast open Type open Typecore open Error +open FieldCallCandidate type generic_context = { ctx : typer; diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index be211c9f133..96a3c07e5ff 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -26,14 +26,6 @@ open Resolution open Error open Globals -module Eval = struct - include EvalEncode - include EvalDecode - include EvalValue - include EvalContext - include EvalMain -end - module InterpImpl = Eval (* Hlmacro *) module Interp = struct @@ -48,7 +40,7 @@ let macro_interp_cache = ref None let safe_decode com v expected t p f = try f () - with MacroApi.Invalid_expr | EvalContext.RunTimeException _ -> + with MacroApi.Invalid_expr -> let path = [dump_path com;"decoding_error"] in let ch = Path.create_file false ".txt" [] path in let errors = Interp.handle_decoding_error (output_string ch) v t in @@ -282,7 +274,7 @@ let make_macro_com_api com mcom p = !macro_enable_cache ); format_string = (fun s p -> - Common.format_string com s p (fun e p -> (e,p)) + FormatString.format_string com.defines s p (fun e p -> (e,p)) ); cast_or_unify = (fun t e p -> Interp.exc_string "unsupported" @@ -632,7 +624,7 @@ and flush_macro_context mint mctx = (* we should maybe ensure that all filters in Main are applied. Not urgent atm *) let expr_filters = [ "handle_abstract_casts",AbstractCast.handle_abstract_casts mctx; - "local_statics",Filters.LocalStatic.run mctx; + "local_statics",LocalStatic.run mctx; "Exceptions",Exceptions.filter mctx; "captured_vars",CapturedVars.captured_vars mctx.com; ] in @@ -668,14 +660,14 @@ and flush_macro_context mint mctx = () in let type_filters = [ - Filters.remove_generic_base; + FiltersCommon.remove_generic_base; Exceptions.patch_constructors mctx; - (fun mt -> Filters.add_field_inits mctx.curclass.cl_path (RenameVars.init mctx.com) mctx.com mt); + (fun mt -> AddFieldInits.add_field_inits mctx.curclass.cl_path (RenameVars.init mctx.com) mctx.com mt); minimal_restore; - Filters.apply_native_paths + Naming.apply_native_paths ] in let ready = fun t -> - Filters.apply_filters_once mctx expr_filters t; + FiltersCommon.apply_filters_once mctx expr_filters t; List.iter (fun f -> f t) type_filters in (try Interp.add_types mint types ready @@ -996,7 +988,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p = else try let ct = Interp.decode_ctype v in Typeload.load_complex_type ctx false ct; - with MacroApi.Invalid_expr | EvalContext.RunTimeException _ -> + with MacroApi.Invalid_expr | EvalContext.RunTimeException _ -> Interp.decode_type v in ctx.ret <- t; diff --git a/src/typing/overloadResolution.ml b/src/typing/overloadResolution.ml index bd16f135f02..456623bbf09 100644 --- a/src/typing/overloadResolution.ml +++ b/src/typing/overloadResolution.ml @@ -1,7 +1,7 @@ -open Typecore open TType open TUnification open TFunctions +open FieldCallCandidate let unify_cf map_type c cf el = let monos = List.map (fun _ -> mk_mono()) cf.cf_params in diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index 66ee7d44d8a..04b98056ffd 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -102,17 +102,6 @@ let find_type_in_module_raise ctx m tname p = with Not_found -> raise_typing_error_ext (make_error (Type_not_found (m.m_path,tname,Not_defined)) p) -(* raises Module_not_found or Type_not_found *) -let load_type_raise ctx mpath tname p = - let m = ctx.g.do_load_module ctx mpath p in - find_type_in_module_raise ctx m tname p - -(* raises Not_found *) -let load_type ctx mpath tname p = try - load_type_raise ctx mpath tname p -with Error { err_message = (Module_not_found _ | Type_not_found _); err_pos = p2 } when p = p2 -> - raise Not_found - (** since load_type_def and load_instance are used in PASS2, they should not access the structure of a type **) let find_type_in_current_module_context ctx pack name = diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index a144dcace14..e343c1414e2 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -130,24 +130,6 @@ let copy_meta meta_src meta_target sl = ) meta_src; !meta -(** retrieve string from @:native metadata or raise Not_found *) -let get_native_name meta = - let rec get_native meta = match meta with - | [] -> raise Not_found - | (Meta.Native,[v],p as meta) :: _ -> - meta - | _ :: meta -> - get_native meta - in - let (_,e,mp) = get_native meta in - match e with - | [Ast.EConst (Ast.String(name,_)),p] -> - name,p - | [] -> - raise Not_found - | _ -> - raise_typing_error "String expected" mp - let check_native_name_override ctx child base = let error base_pos child_pos = (* TODO construct error *) @@ -155,9 +137,9 @@ let check_native_name_override ctx child base = display_error ~depth:1 ctx.com (compl_msg "Base field is defined here") base_pos in try - let child_name, child_pos = get_native_name child.cf_meta in + let child_name, child_pos = Naming.get_native_name child.cf_meta in try - let base_name, base_pos = get_native_name base.cf_meta in + let base_name, base_pos = Naming.get_native_name base.cf_meta in if base_name <> child_name then error base_pos child_pos with Not_found -> diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index f95f6fbe888..a0536851016 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -706,7 +706,7 @@ let transform_field (ctx,cctx) c f fields p = let type_var_field ctx t e stat do_display p = if stat then ctx.curfun <- FunStatic else ctx.curfun <- FunMember; - let e = if do_display then Display.ExprPreprocessing.process_expr ctx.com e else e in + let e = if do_display then Display.preprocess_expr ctx.com e else e in let e = type_expr ctx e (WithType.with_type t) in let e = AbstractCast.cast_or_unify ctx t e p in match t with diff --git a/src/typing/typeloadFunction.ml b/src/typing/typeloadFunction.ml index 175540be1ca..3709c1798d2 100644 --- a/src/typing/typeloadFunction.ml +++ b/src/typing/typeloadFunction.ml @@ -78,7 +78,7 @@ let type_function ctx (args : function_arguments) ret fmode e do_display p = end else begin let is_display_debug = Meta.has (Meta.Custom ":debug.display") ctx.curfield.cf_meta in if is_display_debug then print_endline ("before processing:\n" ^ (Expr.dump_with_pos e)); - let e = if !Parser.had_resume then e else Display.ExprPreprocessing.process_expr ctx.com e in + let e = if !Parser.had_resume then e else Display.preprocess_expr ctx.com e in if is_display_debug then print_endline ("after processing:\n" ^ (Expr.dump_with_pos e)); type_expr ctx e NoValue end in diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index a12549deee7..4a10021b50c 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -707,7 +707,7 @@ let make_curmod ctx m = let rl = new resolution_list ["import";s_type_path m.m_path] in List.iter (fun mt -> rl#add (module_type_resolution mt None null_pos)) - (List.rev ctx.g.std.m_types); + (List.rev ctx.g.std_types.m_types); { curmod = m; import_resolution = rl; @@ -764,8 +764,8 @@ let type_types_into_module ctx m tdecls p = List.iter (TypeloadCheck.check_module_types ctx m p) types; m.m_types <- m.m_types @ types; (* define the per-module context for the next pass *) - if ctx.g.std != null_module then begin - add_dependency m ctx.g.std; + if ctx.g.std_types != null_module then begin + add_dependency m ctx.g.std_types; (* this will ensure both String and (indirectly) Array which are basic types which might be referenced *) ignore(load_instance ctx (make_ptp (mk_type_path (["std"],"String")) null_pos) ParamNormal) end; diff --git a/src/typing/typer.ml b/src/typing/typer.ml index f8f69f69da9..31438deb0b2 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -750,9 +750,9 @@ and type_vars ctx vl p = mk (TMeta((Meta.MergeBlock,[],p), e)) e.etype e.epos and format_string ctx s p = - Common.format_string ctx.com s p (fun enext p -> + FormatString.format_string ctx.com.defines s p (fun enext p -> if ctx.in_display && DisplayPosition.display_position#enclosed_in p then - Display.ExprPreprocessing.process_expr ctx.com (enext,p) + Display.preprocess_expr ctx.com (enext,p) else enext,p ) @@ -2015,160 +2015,18 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) = DisplayEmitter.display_module_type ctx mt p_t; let e_t = type_module_type ctx mt p_t in let e_Std_isOfType = - match Typeload.load_type_raise ctx ([],"Std") "Std" p with - | TClassDecl c -> - let cf = - try PMap.find "isOfType" c.cl_statics - with Not_found -> die "" __LOC__ - in - Texpr.Builder.make_static_field c cf (mk_zero_range_pos p) - | _ -> die "" __LOC__ + ignore(ctx.g.std.cl_build()); + let cf = try + PMap.find "isOfType" ctx.g.std.cl_statics + with Not_found -> + die "" __LOC__ + in + Texpr.Builder.make_static_field ctx.g.std cf (mk_zero_range_pos p) in mk (TCall (e_Std_isOfType, [e; e_t])) ctx.com.basic.tbool p | _ -> display_error ctx.com "Unsupported type for `is` operator" p_t; Texpr.Builder.make_bool ctx.com.basic false p - -(* ---------------------------------------------------------------------- *) -(* TYPER INITIALIZATION *) - -let create com macros = - let ctx = { - com = com; - t = com.basic; - g = { - core_api = None; - macros = macros; - type_patches = Hashtbl.create 0; - module_check_policies = []; - delayed = []; - debug_delayed = []; - doinline = com.display.dms_inline && not (Common.defined com Define.NoInline); - retain_meta = Common.defined com Define.RetainUntypedMeta; - std = null_module; - global_using = []; - complete = false; - type_hints = []; - load_only_cached_modules = false; - functional_interface_lut = new pmap_lookup; - do_macro = MacroContext.type_macro; - do_load_macro = MacroContext.load_macro'; - do_load_module = TypeloadModule.load_module; - do_load_type_def = Typeload.load_type_def; - get_build_info = InstanceBuilder.get_build_info; - do_format_string = format_string; - do_load_core_class = Typeload.load_core_class; - }; - m = { - curmod = null_module; - import_resolution = new resolution_list ["import";"typer"]; - own_resolution = None; - enum_with_type = None; - module_using = []; - import_statements = []; - }; - is_display_file = false; - bypass_accessor = 0; - meta = []; - with_type_stack = []; - call_argument_stack = []; - pass = PBuildModule; - macro_depth = 0; - untyped = false; - curfun = FunStatic; - in_function = false; - in_loop = false; - in_display = false; - allow_inline = true; - allow_transform = true; - get_build_infos = (fun() -> None); - ret = mk_mono(); - locals = PMap.empty; - type_params = []; - curclass = null_class; - curfield = null_field; - tthis = mk_mono(); - opened = []; - vthis = None; - in_call_args = false; - in_overload_call_args = false; - delayed_display = None; - monomorphs = { - perfunction = []; - }; - memory_marker = Typecore.memory_marker; - } in - ctx.g.std <- (try - TypeloadModule.load_module ctx ([],"StdTypes") null_pos - with - Error { err_message = Module_not_found ([],"StdTypes") } -> - try - let std_path = Sys.getenv "HAXE_STD_PATH" in - raise_typing_error ("Standard library not found. Please check your `HAXE_STD_PATH` environment variable (current value: \"" ^ std_path ^ "\")") null_pos - with Not_found -> - raise_typing_error "Standard library not found. You may need to set your `HAXE_STD_PATH` environment variable" null_pos - ); - (* We always want core types to be available so we add them as default imports (issue #1904 and #3131). *) - List.iter (fun mt -> - ctx.m.import_resolution#add (module_type_resolution mt None null_pos)) - (List.rev ctx.g.std.m_types); - List.iter (fun t -> - match t with - | TAbstractDecl a -> - (match snd a.a_path with - | "Void" -> ctx.t.tvoid <- TAbstract (a,[]); - | "Float" -> ctx.t.tfloat <- TAbstract (a,[]); - | "Int" -> ctx.t.tint <- TAbstract (a,[]) - | "Bool" -> ctx.t.tbool <- TAbstract (a,[]) - | "Dynamic" -> t_dynamic_def := TAbstract(a,extract_param_types a.a_params); - | "Null" -> - let mk_null t = - try - if not (is_null ~no_lazy:true t || is_explicit_null t) then TAbstract (a,[t]) else t - with Exit -> - (* don't force lazy evaluation *) - let r = ref (lazy_available t_dynamic) in - r := lazy_wait (fun() -> - let t = (if not (is_null t) then TAbstract (a,[t]) else t) in - r := lazy_available t; - t - ); - TLazy r - in - ctx.t.tnull <- mk_null; - | _ -> ()) - | TEnumDecl _ | TClassDecl _ | TTypeDecl _ -> - () - ) ctx.g.std.m_types; - let m = TypeloadModule.load_module ctx ([],"String") null_pos in - List.iter (fun mt -> match mt with - | TClassDecl c -> ctx.t.tstring <- TInst (c,[]) - | _ -> () - ) m.m_types; - let m = TypeloadModule.load_module ctx ([],"Array") null_pos in - (try - List.iter (fun t -> ( - match t with - | TClassDecl ({cl_path = ([],"Array")} as c) -> - ctx.t.tarray <- (fun t -> TInst (c,[t])); - raise Exit - | _ -> () - )) m.m_types; - die "" __LOC__ - with Exit -> ()); - let m = TypeloadModule.load_module ctx (["haxe"],"EnumTools") null_pos in - (match m.m_types with - | [TClassDecl c1;TClassDecl c2] -> ctx.g.global_using <- (c1,c1.cl_pos) :: (c2,c2.cl_pos) :: ctx.g.global_using - | [TClassDecl c1] -> - let m = TypeloadModule.load_module ctx (["haxe"],"EnumWithType.valueTools") null_pos in - (match m.m_types with - | [TClassDecl c2 ] -> ctx.g.global_using <- (c1,c1.cl_pos) :: (c2,c2.cl_pos) :: ctx.g.global_using - | _ -> die "" __LOC__); - | _ -> die "" __LOC__); - ignore(TypeloadModule.load_module ctx (["haxe"],"Exception") null_pos); - ctx.g.complete <- true; - ctx - ;; unify_min_ref := unify_min; unify_min_for_type_source_ref := unify_min_for_type_source; @@ -2176,5 +2034,4 @@ make_call_ref := make_call; type_call_target_ref := type_call_target; type_access_ref := type_access; type_block_ref := type_block; -create_context_ref := create; type_expr_ref := (fun ?(mode=MGet) ctx e with_type -> type_expr ~mode ctx e with_type); diff --git a/src/typing/typerEntry.ml b/src/typing/typerEntry.ml new file mode 100644 index 00000000000..f7a854fd3c5 --- /dev/null +++ b/src/typing/typerEntry.ml @@ -0,0 +1,154 @@ +open Globals +open Common +open Type +open Typecore +open Typer +open Resolution +open Error + +let create com macros = + let ctx = { + com = com; + t = com.basic; + g = { + core_api = None; + macros = macros; + type_patches = Hashtbl.create 0; + module_check_policies = []; + delayed = []; + debug_delayed = []; + doinline = com.display.dms_inline && not (Common.defined com Define.NoInline); + retain_meta = Common.defined com Define.RetainUntypedMeta; + std_types = null_module; + std = null_class; + global_using = []; + complete = false; + type_hints = []; + load_only_cached_modules = false; + functional_interface_lut = new pmap_lookup; + do_macro = MacroContext.type_macro; + do_load_macro = MacroContext.load_macro'; + do_load_module = TypeloadModule.load_module; + do_load_type_def = Typeload.load_type_def; + get_build_info = InstanceBuilder.get_build_info; + do_format_string = format_string; + do_load_core_class = Typeload.load_core_class; + }; + m = { + curmod = null_module; + import_resolution = new resolution_list ["import";"typer"]; + own_resolution = None; + enum_with_type = None; + module_using = []; + import_statements = []; + }; + is_display_file = false; + bypass_accessor = 0; + meta = []; + with_type_stack = []; + call_argument_stack = []; + pass = PBuildModule; + macro_depth = 0; + untyped = false; + curfun = FunStatic; + in_function = false; + in_loop = false; + in_display = false; + allow_inline = true; + allow_transform = true; + get_build_infos = (fun() -> None); + ret = mk_mono(); + locals = PMap.empty; + type_params = []; + curclass = null_class; + curfield = null_field; + tthis = mk_mono(); + opened = []; + vthis = None; + in_call_args = false; + in_overload_call_args = false; + delayed_display = None; + monomorphs = { + perfunction = []; + }; + memory_marker = Typecore.memory_marker; + } in + ctx.g.std_types <- (try + TypeloadModule.load_module ctx ([],"StdTypes") null_pos + with + Error { err_message = Module_not_found ([],"StdTypes") } -> + try + let std_path = Sys.getenv "HAXE_STD_PATH" in + raise_typing_error ("Standard library not found. Please check your `HAXE_STD_PATH` environment variable (current value: \"" ^ std_path ^ "\")") null_pos + with Not_found -> + raise_typing_error "Standard library not found. You may need to set your `HAXE_STD_PATH` environment variable" null_pos + ); + (* We always want core types to be available so we add them as default imports (issue #1904 and #3131). *) + List.iter (fun mt -> + ctx.m.import_resolution#add (module_type_resolution mt None null_pos)) + (List.rev ctx.g.std_types.m_types); + List.iter (fun t -> + match t with + | TAbstractDecl a -> + (match snd a.a_path with + | "Void" -> ctx.t.tvoid <- TAbstract (a,[]); + | "Float" -> ctx.t.tfloat <- TAbstract (a,[]); + | "Int" -> ctx.t.tint <- TAbstract (a,[]) + | "Bool" -> ctx.t.tbool <- TAbstract (a,[]) + | "Dynamic" -> t_dynamic_def := TAbstract(a,extract_param_types a.a_params); + | "Null" -> + let mk_null t = + try + if not (is_null ~no_lazy:true t || is_explicit_null t) then TAbstract (a,[t]) else t + with Exit -> + (* don't force lazy evaluation *) + let r = ref (lazy_available t_dynamic) in + r := lazy_wait (fun() -> + let t = (if not (is_null t) then TAbstract (a,[t]) else t) in + r := lazy_available t; + t + ); + TLazy r + in + ctx.t.tnull <- mk_null; + | _ -> ()) + | TEnumDecl _ | TClassDecl _ | TTypeDecl _ -> + () + ) ctx.g.std_types.m_types; + let m = TypeloadModule.load_module ctx ([],"String") null_pos in + List.iter (fun mt -> match mt with + | TClassDecl c -> ctx.t.tstring <- TInst (c,[]) + | _ -> () + ) m.m_types; + let m = TypeloadModule.load_module ctx ([],"Std") null_pos in + List.iter (fun mt -> match mt with + | TClassDecl c -> ctx.g.std <- c; + | _ -> () + ) m.m_types; + let m = TypeloadModule.load_module ctx ([],"Array") null_pos in + (try + List.iter (fun t -> ( + match t with + | TClassDecl ({cl_path = ([],"Array")} as c) -> + ctx.t.tarray <- (fun t -> TInst (c,[t])); + raise Exit + | _ -> () + )) m.m_types; + die "" __LOC__ + with Exit -> ()); + let m = TypeloadModule.load_module ctx (["haxe"],"EnumTools") null_pos in + (match m.m_types with + | [TClassDecl c1;TClassDecl c2] -> ctx.g.global_using <- (c1,c1.cl_pos) :: (c2,c2.cl_pos) :: ctx.g.global_using + | [TClassDecl c1] -> + let m = TypeloadModule.load_module ctx (["haxe"],"EnumWithType.valueTools") null_pos in + (match m.m_types with + | [TClassDecl c2 ] -> ctx.g.global_using <- (c1,c1.cl_pos) :: (c2,c2.cl_pos) :: ctx.g.global_using + | _ -> die "" __LOC__); + | _ -> die "" __LOC__); + ignore(TypeloadModule.load_module ctx (["haxe"],"Exception") null_pos); + ctx.g.complete <- true; + ctx + +;; +create_context_ref := create; +Inline.maybe_reapply_overload_call_ref := CallUnification.maybe_reapply_overload_call; \ No newline at end of file From db4e612a1fb37a247a2a39c974290215b77f3274 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 27 Dec 2023 16:48:43 +0100 Subject: [PATCH 011/125] respect anon_status when identifying --- src/typing/tanon_identification.ml | 54 +++++++++++++++++++----------- 1 file changed, 35 insertions(+), 19 deletions(-) diff --git a/src/typing/tanon_identification.ml b/src/typing/tanon_identification.ml index 8af805fe9ee..4e76f5c4152 100644 --- a/src/typing/tanon_identification.ml +++ b/src/typing/tanon_identification.ml @@ -135,29 +135,26 @@ object(self) in loop td.t_type - method identify (accept_anons : bool) (t : Type.t) = - match t with - | TType(td,tl) -> - begin try - Some (Hashtbl.find pfms td.t_path) - with Not_found -> - self#identify accept_anons (apply_typedef td tl) - end - | TMono {tm_type = Some t} -> - self#identify accept_anons t - | TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) -> - self#identify accept_anons (Abstract.get_underlying_type a tl) - | TAbstract({a_path=([],"Null")},[t]) -> - self#identify accept_anons t - | TLazy f -> - self#identify accept_anons (lazy_type f) - | TAnon an when accept_anons && not (PMap.is_empty an.a_fields) -> + method identity_anon (an : tanon) = + let make_pfm path = { + pfm_path = path; + pfm_params = []; + pfm_fields = an.a_fields; + pfm_converted = None; + pfm_arity = count_fields an.a_fields; + } in + match !(an.a_status) with + | ClassStatics {cl_path = path} | EnumStatics {e_path = path} | AbstractStatics {a_path = path} -> + let pfm = make_pfm path in + self#add_pfm path pfm; + Some pfm + | _ -> let arity = PMap.fold (fun cf i -> replace_mono cf.cf_type; i + 1 ) an.a_fields 0 in begin try - Some (self#find_compatible arity t) + Some (self#find_compatible arity (TAnon an)) with Not_found -> let id = num in num <- num + 1; @@ -171,7 +168,26 @@ object(self) } in self#add_pfm path pfm; Some pfm - end; + end + + method identify (accept_anons : bool) (t : Type.t) = + match t with + | TType(td,tl) -> + begin try + Some (Hashtbl.find pfms td.t_path) + with Not_found -> + self#identify accept_anons (apply_typedef td tl) + end + | TMono {tm_type = Some t} -> + self#identify accept_anons t + | TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) -> + self#identify accept_anons (Abstract.get_underlying_type a tl) + | TAbstract({a_path=([],"Null")},[t]) -> + self#identify accept_anons t + | TLazy f -> + self#identify accept_anons (lazy_type f) + | TAnon an when accept_anons && not (PMap.is_empty an.a_fields) -> + self#identity_anon an | _ -> None end \ No newline at end of file From 6f8f567db7c0eb10faa062f909c11d3a17411805 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 27 Dec 2023 19:34:17 +0100 Subject: [PATCH 012/125] [typer] purge all rogue ClassStatics --- src/codegen/codegen.ml | 10 ++---- src/context/typecore.ml | 6 +--- src/core/tFunctions.ml | 15 ++++++++ src/core/tOther.ml | 56 +++++++++++++++++++++++------- src/core/texpr.ml | 9 +++-- src/generators/genpy.ml | 3 +- src/optimization/inline.ml | 4 +-- src/typing/finalization.ml | 2 +- src/typing/tanon_identification.ml | 10 ++++-- 9 files changed, 76 insertions(+), 39 deletions(-) diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index 0fb322c9f88..a40ab712126 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -419,16 +419,10 @@ end *) let default_cast ?(vtmp="$t") com e texpr t p = let api = com.basic in - let mk_texpr = function - | TClassDecl c -> mk_anon (ref (ClassStatics c)) - | TEnumDecl e -> mk_anon (ref (EnumStatics e)) - | TAbstractDecl a -> mk_anon (ref (AbstractStatics a)) - | TTypeDecl _ -> die "" __LOC__ - in let vtmp = alloc_var VGenerated vtmp e.etype e.epos in let var = mk (TVar (vtmp,Some e)) api.tvoid p in let vexpr = mk (TLocal vtmp) e.etype p in - let texpr = mk (TTypeExpr texpr) (mk_texpr texpr) p in + let texpr = Texpr.Builder.make_typeexpr texpr p in let std = (try List.find (fun t -> t_path t = ([],"Std")) com.types with Not_found -> die "" __LOC__) in let fis = (try let c = (match std with TClassDecl c -> c | _ -> die "" __LOC__) in @@ -436,7 +430,7 @@ let default_cast ?(vtmp="$t") com e texpr t p = with Not_found -> die "" __LOC__ ) in - let std = mk (TTypeExpr std) (mk_texpr std) p in + let std = Texpr.Builder.make_typeexpr std p in let is = mk (TField (std,fis)) (tfun [t_dynamic;t_dynamic] api.tbool) p in let is = mk (TCall (is,[vexpr;texpr])) api.tbool p in let enull = Texpr.Builder.make_null vexpr.etype p in diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 9597863c742..56769dad5c6 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -257,12 +257,8 @@ let spawn_monomorph' ctx p = let spawn_monomorph ctx p = TMono (spawn_monomorph' ctx p) -let make_static_this c p = - let ta = mk_anon ~fields:c.cl_statics (ref (ClassStatics c)) in - mk (TTypeExpr (TClassDecl c)) ta p - let make_static_field_access c cf t p = - let ethis = make_static_this c p in + let ethis = Texpr.Builder.make_static_this c p in mk (TField (ethis,(FStatic (c,cf)))) t p let make_static_call ctx c cf map args t p = diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index 9f3240a37f0..cea0faabb0c 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -878,3 +878,18 @@ let var_extra params e = { v_params = params; v_expr = e; } + +let class_module_type c = + let path = ([],"Class<" ^ (s_type_path c.cl_path) ^ ">") in + let t = mk_anon ~fields:c.cl_statics (ref (ClassStatics c)) in + { (mk_typedef c.cl_module path c.cl_pos null_pos t) with t_private = true} + +let enum_module_type m path p = + let path = ([], "Enum<" ^ (s_type_path path) ^ ">") in + let t = mk_mono() in + {(mk_typedef m path p null_pos t) with t_private = true} + +let abstract_module_type a tl = + let path = ([],Printf.sprintf "Abstract<%s>" (s_type_path a.a_path)) in + let t = mk_anon (ref (AbstractStatics a)) in + {(mk_typedef a.a_module path a.a_pos null_pos t) with t_private = true} diff --git a/src/core/tOther.ml b/src/core/tOther.ml index dcb5c2b9ea7..2366b731a9a 100644 --- a/src/core/tOther.ml +++ b/src/core/tOther.ml @@ -263,20 +263,50 @@ end let no_meta = [] -let class_module_type c = - let path = ([],"Class<" ^ (s_type_path c.cl_path) ^ ">") in - let t = mk_anon ~fields:c.cl_statics (ref (ClassStatics c)) in - { (mk_typedef c.cl_module path c.cl_pos null_pos t) with t_private = true} +let mk_enum m path pos name_pos = + { + e_path = path; + e_module = m; + e_pos = pos; + e_name_pos = name_pos; + e_doc = None; + e_meta = []; + e_params = []; + e_using = []; + e_restore = (fun () -> ()); + e_private = false; + e_extern = false; + e_constrs = PMap.empty; + e_names = []; + e_type = enum_module_type m path pos; + } -let enum_module_type m path p = - let path = ([], "Enum<" ^ (s_type_path path) ^ ">") in - let t = mk_mono() in - {(mk_typedef m path p null_pos t) with t_private = true} - -let abstract_module_type a tl = - let path = ([],Printf.sprintf "Abstract<%s%s>" (s_type_path a.a_path) (s_type_params (ref []) tl)) in - let t = mk_anon (ref (AbstractStatics a)) in - {(mk_typedef a.a_module path a.a_pos null_pos t) with t_private = true} +let mk_abstract m path pos name_pos = + { + a_path = path; + a_private = false; + a_module = m; + a_pos = pos; + a_name_pos = name_pos; + a_doc = None; + a_params = []; + a_using = []; + a_restore = (fun () -> ()); + a_meta = []; + a_from = []; + a_to = []; + a_from_field = []; + a_to_field = []; + a_ops = []; + a_unops = []; + a_impl = None; + a_array = []; + a_this = mk_mono(); + a_read = None; + a_write = None; + a_enum = false; + a_call = None; + } module TClass = struct let get_member_fields' self_too c0 tl = diff --git a/src/core/texpr.ml b/src/core/texpr.ml index 433e5ddf654..848c1bebc1c 100644 --- a/src/core/texpr.ml +++ b/src/core/texpr.ml @@ -486,15 +486,14 @@ let foldmap f acc e = (* Collection of functions that return expressions *) module Builder = struct let make_static_this c p = - let ta = mk_anon ~fields:c.cl_statics (ref (ClassStatics c)) in - mk (TTypeExpr (TClassDecl c)) ta p + mk (TTypeExpr (TClassDecl c)) (TType(TFunctions.class_module_type c,[])) p let make_typeexpr mt pos = let t = match resolve_typedef mt with - | TClassDecl c -> mk_anon ~fields:c.cl_statics (ref (ClassStatics c)) - | TEnumDecl e -> mk_anon (ref (EnumStatics e)) - | TAbstractDecl a -> mk_anon (ref (AbstractStatics a)) + | TClassDecl c -> TType(class_module_type c,[]) + | TEnumDecl e -> TType(e.e_type,[]) + | TAbstractDecl a -> TType(abstract_module_type a [],[]) | _ -> die "" __LOC__ in mk (TTypeExpr mt) t pos diff --git a/src/generators/genpy.ml b/src/generators/genpy.ml index 715c8b8d262..3e42aa58628 100644 --- a/src/generators/genpy.ml +++ b/src/generators/genpy.ml @@ -38,8 +38,7 @@ module Utils = struct abort (Printf.sprintf "Could not find type %s\n" (s_type_path path)) null_pos let mk_static_field c cf p = - let ta = mk_anon ~fields:c.cl_statics (ref (ClassStatics c)) in - let ethis = mk (TTypeExpr (TClassDecl c)) ta p in + let ethis = Texpr.Builder.make_static_this c p in let t = monomorphs cf.cf_params cf.cf_type in mk (TField (ethis,(FStatic (c,cf)))) t p diff --git a/src/optimization/inline.ml b/src/optimization/inline.ml index a51f6a1d8b4..a9709f37040 100644 --- a/src/optimization/inline.ml +++ b/src/optimization/inline.ml @@ -113,7 +113,7 @@ let api_inline ctx c field params p = let m = (try ctx.com.module_lut#find path with Not_found -> die "" __LOC__) in add_dependency ctx.m.curmod m; Option.get (ExtList.List.find_map (function - | TClassDecl cl when cl.cl_path = path -> Some (make_static_this cl p) + | TClassDecl cl when cl.cl_path = path -> Some (Texpr.Builder.make_static_this cl p) | _ -> None ) m.m_types) in @@ -173,7 +173,7 @@ let api_inline ctx c field params p = None) | (["js"],"Boot"),"__downcastCheck",[o; {eexpr = TTypeExpr (TClassDecl cls) } as t] when ctx.com.platform = Js -> if (has_class_flag cls CInterface) then - Some (Texpr.Builder.fcall (make_static_this c p) "__implements" [o;t] tbool p) + Some (Texpr.Builder.fcall (Texpr.Builder.make_static_this c p) "__implements" [o;t] tbool p) else Some (Texpr.Builder.fcall (eJsSyntax()) "instanceof" [o;t] tbool p) | (["cs" | "java"],"Lib"),("nativeArray"),[{ eexpr = TArrayDecl args } as edecl; _] diff --git a/src/typing/finalization.ml b/src/typing/finalization.ml index 92a02d7303e..1cba3d378fc 100644 --- a/src/typing/finalization.ml +++ b/src/typing/finalization.ml @@ -49,7 +49,7 @@ let get_main ctx types = let et = List.find (fun t -> t_path t = path) types in let ec = (match et with TClassDecl c -> c | _ -> die "" __LOC__) in let ef = PMap.find method_name ec.cl_statics in - let et = mk (TTypeExpr et) (mk_anon (ref (ClassStatics ec))) null_pos in + let et = Texpr.Builder.make_typeexpr et null_pos in mk (TCall (mk (TField (et,FStatic (ec,ef))) ef.cf_type null_pos,[])) ctx.t.tvoid null_pos in (* add haxe.EntryPoint.run() call *) diff --git a/src/typing/tanon_identification.ml b/src/typing/tanon_identification.ml index 4e76f5c4152..4a57293cf93 100644 --- a/src/typing/tanon_identification.ml +++ b/src/typing/tanon_identification.ml @@ -145,9 +145,13 @@ object(self) } in match !(an.a_status) with | ClassStatics {cl_path = path} | EnumStatics {e_path = path} | AbstractStatics {a_path = path} -> - let pfm = make_pfm path in - self#add_pfm path pfm; - Some pfm + begin try + Some (Hashtbl.find pfms path) + with Not_found -> + let pfm = make_pfm path in + self#add_pfm path pfm; + Some pfm + end | _ -> let arity = PMap.fold (fun cf i -> replace_mono cf.cf_type; From f1b7c7c1bb27d67fe7b11854717f4200cb57918b Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 27 Dec 2023 20:28:06 +0100 Subject: [PATCH 013/125] [typer] handle e_type like a human being would --- src/core/tFunctions.ml | 8 ++++---- src/core/tOther.ml | 2 +- src/core/tPrinting.ml | 2 +- src/core/tType.ml | 2 +- src/core/texpr.ml | 2 +- src/typing/typeloadModule.ml | 14 ++------------ src/typing/typerBase.ml | 3 +-- 7 files changed, 11 insertions(+), 22 deletions(-) diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index cea0faabb0c..ae2c980a69d 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -884,10 +884,10 @@ let class_module_type c = let t = mk_anon ~fields:c.cl_statics (ref (ClassStatics c)) in { (mk_typedef c.cl_module path c.cl_pos null_pos t) with t_private = true} -let enum_module_type m path p = - let path = ([], "Enum<" ^ (s_type_path path) ^ ">") in - let t = mk_mono() in - {(mk_typedef m path p null_pos t) with t_private = true} +let enum_module_type en fields = + let path = ([], "Enum<" ^ (s_type_path en.e_path) ^ ">") in + let t = mk_anon ~fields (ref (EnumStatics en)) in + {(mk_typedef en.e_module path en.e_pos null_pos t) with t_private = true} let abstract_module_type a tl = let path = ([],Printf.sprintf "Abstract<%s>" (s_type_path a.a_path)) in diff --git a/src/core/tOther.ml b/src/core/tOther.ml index 2366b731a9a..8c0a11e469b 100644 --- a/src/core/tOther.ml +++ b/src/core/tOther.ml @@ -278,7 +278,7 @@ let mk_enum m path pos name_pos = e_extern = false; e_constrs = PMap.empty; e_names = []; - e_type = enum_module_type m path pos; + e_type = mk_mono(); } let mk_abstract m path pos name_pos = diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml index 0757e7cda56..ea3a44a988f 100644 --- a/src/core/tPrinting.ml +++ b/src/core/tPrinting.ml @@ -528,7 +528,7 @@ module Printer = struct "d_doc",s_doc en.e_doc; "e_meta",s_metadata en.e_meta; "e_params",s_type_params en.e_params; - "e_type",s_tdef "\t" en.e_type; + "e_type",s_type_kind en.e_type; "e_extern",string_of_bool en.e_extern; "e_constrs",s_list "\n\t" (s_tenum_field (tabs ^ "\t")) (PMap.fold (fun ef acc -> ef :: acc) en.e_constrs []); "e_names",String.concat ", " en.e_names diff --git a/src/core/tType.ml b/src/core/tType.ml index 2a5e8fb2723..2a78187d734 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -314,7 +314,7 @@ and tenum = { mutable e_using : (tclass * pos) list; mutable e_restore : unit -> unit; (* do not insert any fields above *) - e_type : tdef; + e_type : t; mutable e_extern : bool; mutable e_constrs : (string , tenum_field) PMap.t; mutable e_names : string list; diff --git a/src/core/texpr.ml b/src/core/texpr.ml index 848c1bebc1c..3082e210b04 100644 --- a/src/core/texpr.ml +++ b/src/core/texpr.ml @@ -492,7 +492,7 @@ module Builder = struct let t = match resolve_typedef mt with | TClassDecl c -> TType(class_module_type c,[]) - | TEnumDecl e -> TType(e.e_type,[]) + | TEnumDecl e -> e.e_type | TAbstractDecl a -> TType(abstract_module_type a [],[]) | _ -> die "" __LOC__ in diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 4a10021b50c..41d1738ce50 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -132,20 +132,11 @@ module ModuleLevel = struct let path = make_path name priv d.d_meta p in if Meta.has (Meta.Custom ":fakeEnum") d.d_meta then raise_typing_error "@:fakeEnum enums is no longer supported in Haxe 4, use extern enum abstract instead" p; let e = { - e_path = path; - e_module = m; - e_pos = p; - e_name_pos = (pos d.d_name); + (mk_enum m path p (pos d.d_name)) with e_doc = d.d_doc; e_meta = d.d_meta; - e_params = []; - e_using = []; - e_restore = (fun () -> ()); e_private = priv; e_extern = List.mem EExtern d.d_flags; - e_constrs = PMap.empty; - e_names = []; - e_type = enum_module_type m path p; } in if not e.e_extern then check_type_name name d.d_meta; decls := (TEnumDecl e, decl) :: !decls; @@ -535,8 +526,7 @@ module TypeLevel = struct ) (!constructs); e.e_names <- List.rev !names; e.e_extern <- e.e_extern; - e.e_type.t_params <- e.e_params; - e.e_type.t_type <- mk_anon ~fields:!fields (ref (EnumStatics e)); + unify ctx (TType(enum_module_type e !fields,[])) e.e_type p; if !is_flat then e.e_meta <- (Meta.FlatEnum,[],null_pos) :: e.e_meta; if Meta.has Meta.InheritDoc e.e_meta then delay ctx PConnectField (fun() -> InheritDoc.build_enum_doc ctx e); diff --git a/src/typing/typerBase.ml b/src/typing/typerBase.ml index b03fce5ebe2..ddfbb114991 100644 --- a/src/typing/typerBase.ml +++ b/src/typing/typerBase.ml @@ -210,8 +210,7 @@ let type_module_type ctx t p = let t_tmp = class_module_type c in mk (TTypeExpr (TClassDecl c)) (TType (t_tmp,[])) p | TEnumDecl e -> - let types = (match tparams with None -> Monomorph.spawn_constrained_monos (fun t -> t) e.e_params | Some l -> l) in - mk (TTypeExpr (TEnumDecl e)) (TType (e.e_type,types)) p + mk (TTypeExpr (TEnumDecl e)) e.e_type p | TTypeDecl s -> let t = apply_typedef s (List.map (fun _ -> spawn_monomorph ctx p) s.t_params) in DeprecationCheck.check_typedef (create_deprecation_context ctx) s p; From 798e0c0000402fdcc3956388ef0d0fa2908787b7 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 28 Dec 2023 09:00:51 +0100 Subject: [PATCH 014/125] [typer] don't die so hard if we cannot locate the length field for iteration This can happen in some display situations when the type is incomplete. --- src/typing/forLoop.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/typing/forLoop.ml b/src/typing/forLoop.ml index a14f796c81b..65b67979cd5 100644 --- a/src/typing/forLoop.ml +++ b/src/typing/forLoop.ml @@ -267,7 +267,7 @@ module IterationKind = struct let t_void = ctx.t.tvoid in let t_int = ctx.t.tint in let mk_field e n = - TField (e,try quick_field e.etype n with Not_found -> die "" __LOC__) + TField (e,try quick_field e.etype n with Not_found -> Error.raise_msg (Printf.sprintf "Could not find field %s on %s" n (s_type_kind e.etype)) e.epos) in let get_array_length arr p = mk (mk_field arr "length") ctx.com.basic.tint p From d847c9c76b068513f05baf5cd0ad7cfc09806f3c Mon Sep 17 00:00:00 2001 From: Zorbn <70043176+Zorbn@users.noreply.github.com> Date: Thu, 28 Dec 2023 00:22:08 -0800 Subject: [PATCH 015/125] [lua] Fix unnecessary _hx_do_first (#11453) --- src/generators/genlua.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/generators/genlua.ml b/src/generators/genlua.ml index 3bbd314104e..4dda9564ddd 100644 --- a/src/generators/genlua.ml +++ b/src/generators/genlua.ml @@ -582,9 +582,10 @@ and gen_loop ctx cond do_while e = if do_while then print ctx " or _hx_do_first_%i" ctx.break_depth; print ctx " do "; - if do_while then + if do_while then begin newline ctx; println ctx "_hx_do_first_%i = false;" ctx.break_depth; + end; if will_continue then print ctx "repeat "; gen_block_element ctx e; if will_continue then begin From 0ee63b352e8c3eea063dac51790b9137edb5d83b Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 28 Dec 2023 10:01:40 +0100 Subject: [PATCH 016/125] [typer] merge module_lut and type_to_module --- src/compiler/displayProcessing.ml | 4 ++-- src/context/common.ml | 20 ++++++++++++++------ src/filters/filters.ml | 2 +- src/optimization/dce.ml | 3 +-- src/typing/finalization.ml | 2 +- src/typing/generic.ml | 4 ++-- src/typing/macroContext.ml | 2 +- src/typing/typeloadCheck.ml | 4 ++-- src/typing/typeloadFields.ml | 2 +- 9 files changed, 25 insertions(+), 18 deletions(-) diff --git a/src/compiler/displayProcessing.ml b/src/compiler/displayProcessing.ml index 70c217d91fe..8bfc95efab8 100644 --- a/src/compiler/displayProcessing.ml +++ b/src/compiler/displayProcessing.ml @@ -200,11 +200,11 @@ let load_display_module_in_macro tctx display_file_dot_path clear = match displa begin try let m = mctx.com.module_lut#find cpath in mctx.com.module_lut#remove cpath; - mctx.com.type_to_module#remove cpath; + mctx.com.module_lut#get_type_lut#remove cpath; List.iter (fun mt -> let ti = Type.t_infos mt in mctx.com.module_lut#remove ti.mt_path; - mctx.com.type_to_module#remove ti.mt_path; + mctx.com.module_lut#get_type_lut#remove ti.mt_path; ) m.m_types with Not_found -> () diff --git a/src/context/common.ml b/src/context/common.ml index 401e51e974f..a856808dbed 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -355,6 +355,17 @@ class ['key,'value] hashtbl_lookup = object(self) Hashtbl.clear lut end +class module_lut = object(self) + inherit [path,module_def] hashtbl_lookup as super + + val type_lut : (path,path) lookup = new hashtbl_lookup + + method find_by_type (path : path) = + self#find (type_lut#find path) + + method get_type_lut = type_lut +end + type context = { compilation_step : int; mutable stage : compiler_stage; @@ -408,9 +419,8 @@ type context = { cached_macros : (path * string,(((string * bool * t) list * t * tclass * Type.tclass_field) * module_def)) lookup; stored_typed_exprs : (int, texpr) lookup; overload_cache : ((path * string),(Type.t * tclass_field) list) lookup; - module_lut : (path,module_def) lookup; + module_lut : module_lut; module_nonexistent_lut : (path,bool) lookup; - type_to_module : (path,path) lookup; mutable has_error : bool; pass_debug_messages : string DynArray.t; (* output *) @@ -837,9 +847,8 @@ let create compilation_step cs version args display_mode = callbacks = new compiler_callbacks; global_metadata = []; modules = []; - module_lut = new hashtbl_lookup; + module_lut = new module_lut; module_nonexistent_lut = new hashtbl_lookup; - type_to_module = new hashtbl_lookup; main = None; flash_version = 10.; resources = Hashtbl.create 0; @@ -928,8 +937,7 @@ let clone com is_macro_context = parser_cache = new hashtbl_lookup; module_to_file = new hashtbl_lookup; overload_cache = new hashtbl_lookup; - module_lut = new hashtbl_lookup; - type_to_module = new hashtbl_lookup; + module_lut = new module_lut; } let file_time file = Extc.filetime file diff --git a/src/filters/filters.ml b/src/filters/filters.ml index e3ab6478d7c..0ee097c09ae 100644 --- a/src/filters/filters.ml +++ b/src/filters/filters.ml @@ -323,7 +323,7 @@ let remove_extern_fields com t = match t with let check_private_path com t = match t with | TClassDecl c when c.cl_private -> let rpath = (fst c.cl_module.m_path,"_" ^ snd c.cl_module.m_path) in - if com.type_to_module#mem rpath then raise_typing_error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos; + if com.module_lut#get_type_lut#mem rpath then raise_typing_error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos; | _ -> () diff --git a/src/optimization/dce.ml b/src/optimization/dce.ml index 96c198cd7e0..0d1a4970899 100644 --- a/src/optimization/dce.ml +++ b/src/optimization/dce.ml @@ -61,8 +61,7 @@ let find_field c name kind = let resolve_class_field_ref ctx cfr = let ctx = if cfr.cfr_is_macro && not ctx.is_macro_context then Option.get (ctx.get_macros()) else ctx in - let path = ctx.type_to_module#find cfr.cfr_path in - let m = ctx.module_lut#find path in + let m = ctx.module_lut#find_by_type cfr.cfr_path in Option.get (ExtList.List.find_map (fun mt -> match mt with | TClassDecl c when c.cl_path = cfr.cfr_path -> diff --git a/src/typing/finalization.ml b/src/typing/finalization.ml index 1cba3d378fc..806cfd678b8 100644 --- a/src/typing/finalization.ml +++ b/src/typing/finalization.ml @@ -101,7 +101,7 @@ type state = | Done | NotYet -let sort_types com (modules : (path,module_def) lookup) = +let sort_types com (modules : module_lut) = let types = ref [] in let states = Hashtbl.create 0 in let state p = try Hashtbl.find states p with Not_found -> NotYet in diff --git a/src/typing/generic.ml b/src/typing/generic.ml index c9dcf4d3713..dda73fc982d 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -175,7 +175,7 @@ let static_method_container gctx c cf p = | TInst(cg,_) -> cg | _ -> raise_typing_error ("Cannot specialize @:generic static method because the generated type name is already used: " ^ name) p with Error { err_message = Module_not_found path } when path = (pack,name) -> - let m = (try ctx.com.module_lut#find (ctx.com.type_to_module#find c.cl_path) with Not_found -> die "" __LOC__) in + let m = c.cl_module in let mg = { m_id = alloc_mid(); m_path = (pack,name); @@ -261,7 +261,7 @@ let build_generic_class ctx c p tl = | TInst({ cl_kind = KGenericInstance (csup,_) },_) when c == csup -> t | _ -> raise_typing_error ("Cannot specialize @:generic because the generated type name is already used: " ^ name) p with Error { err_message = Module_not_found path } when path = (pack,name) -> - let m = (try ctx.com.module_lut#find (ctx.com.type_to_module#find c.cl_path) with Not_found -> die "" __LOC__) in + let m = c.cl_module in if gctx.generic_debug then begin print_endline (Printf.sprintf "[GENERIC] Building @:generic class %s as %s with:" (s_type_path c.cl_path) name); List.iter (fun (t1,(t2,eo)) -> diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index 96a3c07e5ff..d5df49e80bb 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -739,7 +739,7 @@ let get_macro_context ctx = mctx let load_macro_module mctx com cpath display p = - let m = (try com.type_to_module#find cpath with Not_found -> cpath) in + let m = (try com.module_lut#get_type_lut#find cpath with Not_found -> cpath) in (* Temporarily enter display mode while typing the macro. *) let old = mctx.com.display in if display then mctx.com.display <- com.display; diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index e343c1414e2..d9189bb0519 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -337,7 +337,7 @@ let check_global_metadata ctx meta f_add mpath tpath so = let check_module_types ctx m p t = let t = t_infos t in try - let path2 = ctx.com.type_to_module#find t.mt_path in + let path2 = ctx.com.module_lut#get_type_lut#find t.mt_path in if m.m_path <> path2 && String.lowercase_ascii (s_type_path path2) = String.lowercase_ascii (s_type_path m.m_path) then raise_typing_error ("Module " ^ s_type_path path2 ^ " is loaded with a different case than " ^ s_type_path m.m_path) p; let m2 = ctx.com.module_lut#find path2 in let hex1 = Digest.to_hex m.m_extra.m_sign in @@ -346,7 +346,7 @@ let check_module_types ctx m p t = raise_typing_error (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path) (s_type_path path2) s) p with Not_found -> - ctx.com.type_to_module#add t.mt_path m.m_path + ctx.com.module_lut#get_type_lut#add t.mt_path m.m_path module Inheritance = struct let is_basic_class_path path = match path with diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index a0536851016..a34edc6c3e9 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -697,7 +697,7 @@ let transform_field (ctx,cctx) c f fields p = in if List.mem_assoc AMacro f.cff_access then (match ctx.g.macros with - | Some (_,mctx) when mctx.com.type_to_module#mem c.cl_path -> + | Some (_,mctx) when mctx.com.module_lut#get_type_lut#mem c.cl_path -> (* assume that if we had already a macro with the same name, it has not been changed during the @:build operation *) if not (List.exists (fun f2 -> f2.cff_name = f.cff_name && List.mem_assoc AMacro f2.cff_access) (!fields)) then raise_typing_error "Class build macro cannot return a macro function when the class has already been compiled into the macro context" p From a7df996294f0ac983dc600b0c8c74819ddea66c7 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 28 Dec 2023 12:57:31 +0100 Subject: [PATCH 017/125] pull some auxiliary changes from hxb branch --- src/compiler/serverCompilationContext.ml | 4 +- src/context/common.ml | 92 ++++++----------- src/context/feature.ml | 11 ++ src/context/lookup.ml | 113 +++++++++++++++++++++ src/context/typecore.ml | 1 + src/core/displayTypes.ml | 2 +- src/core/naming.ml | 4 +- src/core/tFunctions.ml | 65 ++++++++++-- src/core/tOther.ml | 48 ++++++++- src/core/tPrinting.ml | 2 +- src/core/tType.ml | 22 ++-- src/filters/localStatic.ml | 3 +- src/typing/finalization.ml | 1 + src/typing/matcher/exprToPattern.ml | 2 +- src/typing/typeload.ml | 2 +- src/typing/typeloadCheck.ml | 14 --- src/typing/typeloadFields.ml | 16 ++- src/typing/typeloadModule.ml | 16 +-- src/typing/typer.ml | 2 +- src/typing/typerEntry.ml | 6 +- tests/server/src/Main.hx | 2 +- tests/server/src/cases/issues/Issue9690.hx | 2 +- 22 files changed, 297 insertions(+), 133 deletions(-) create mode 100644 src/context/feature.ml create mode 100644 src/context/lookup.ml diff --git a/src/compiler/serverCompilationContext.ml b/src/compiler/serverCompilationContext.ml index 0f65f22c154..d0c87099acd 100644 --- a/src/compiler/serverCompilationContext.ml +++ b/src/compiler/serverCompilationContext.ml @@ -72,7 +72,7 @@ let ensure_macro_setup sctx = let cleanup () = match !MacroContext.macro_interp_cache with | Some interp -> (* curapi holds a reference to the typing context which we don't want to persist. Let's unset it so the - context can be collected. *) + context can be collected. *) interp.curapi <- Obj.magic "" | None -> - () \ No newline at end of file + () diff --git a/src/context/common.ml b/src/context/common.ml index a856808dbed..6fbfba69569 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -20,6 +20,7 @@ open Extlib_leftovers open Ast open Type open Globals +open Lookup open Define open NativeLibraries open Warning @@ -293,76 +294,43 @@ type report_mode = | RMDiagnostics of (Path.UniqueKey.t list) | RMStatistics -class virtual ['key,'value] lookup = object(self) - method virtual add : 'key -> 'value -> unit - method virtual remove : 'key -> unit - method virtual find : 'key -> 'value - method virtual iter : ('key -> 'value -> unit) -> unit - method virtual fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc - method virtual mem : 'key -> bool - method virtual clear : unit -end - -class ['key,'value] pmap_lookup = object(self) - inherit ['key,'value] lookup - val mutable lut : ('key,'value) PMap.t = PMap.empty - - method add (key : 'key) (value : 'value) = - lut <- PMap.add key value lut - - method remove (key : 'key) = - lut <- PMap.remove key lut - - method find (key : 'key) : 'value = - PMap.find key lut - - method iter (f : 'key -> 'value -> unit) = - PMap.iter f lut - - method fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc = fun f acc -> - PMap.foldi f lut acc - - method mem (key : 'key) = - PMap.mem key lut - - method clear = - lut <- PMap.empty -end - -class ['key,'value] hashtbl_lookup = object(self) - inherit ['key,'value] lookup - val lut : ('key,'value) Hashtbl.t = Hashtbl.create 0 - - method add (key : 'key) (value : 'value) = - Hashtbl.replace lut key value - - method remove (key : 'key) = - Hashtbl.remove lut key - - method find (key : 'key) : 'value = - Hashtbl.find lut key - - method iter (f : 'key -> 'value -> unit) = - Hashtbl.iter f lut - - method fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc = fun f acc -> - Hashtbl.fold f lut acc - - method mem (key : 'key) = - Hashtbl.mem lut key - - method clear = - Hashtbl.clear lut -end - class module_lut = object(self) inherit [path,module_def] hashtbl_lookup as super val type_lut : (path,path) lookup = new hashtbl_lookup + method add_module_type (m : module_def) (mt : module_type) = + let t = t_infos mt in + try + let path2 = type_lut#find t.mt_path in + let p = t.mt_pos in + if m.m_path <> path2 && String.lowercase_ascii (s_type_path path2) = String.lowercase_ascii (s_type_path m.m_path) then Error.raise_typing_error ("Module " ^ s_type_path path2 ^ " is loaded with a different case than " ^ s_type_path m.m_path) p; + let m2 = self#find path2 in + let hex1 = Digest.to_hex m.m_extra.m_sign in + let hex2 = Digest.to_hex m2.m_extra.m_sign in + let s = if hex1 = hex2 then hex1 else Printf.sprintf "was %s, is %s" hex2 hex1 in + Error.raise_typing_error (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path) (s_type_path path2) s) p + with Not_found -> + type_lut#add t.mt_path m.m_path + + method add (path : path) (m : module_def) = + super#add path m; + List.iter (fun mt -> self#add_module_type m mt) m.m_types + + method remove (path : path) = + try + List.iter (fun mt -> type_lut#remove (t_path mt)) (self#find path).m_types; + super#remove path; + with Not_found -> + () + method find_by_type (path : path) = self#find (type_lut#find path) + method clear = + super#clear; + type_lut#clear + method get_type_lut = type_lut end diff --git a/src/context/feature.ml b/src/context/feature.ml new file mode 100644 index 00000000000..647d03da10b --- /dev/null +++ b/src/context/feature.ml @@ -0,0 +1,11 @@ +open Ast +open Type +open Error + +let rec check_if_feature = function + | [] -> [] + | (Meta.IfFeature,el,_) :: _ -> List.map (fun (e,p) -> match e with EConst (String(s,_)) -> s | _ -> raise_typing_error "String expected" p) el + | _ :: l -> check_if_feature l + +let set_feature m cf_ref s = + m.m_extra.m_if_feature <- (s, cf_ref) :: m.m_extra.m_if_feature diff --git a/src/context/lookup.ml b/src/context/lookup.ml new file mode 100644 index 00000000000..73b639c1597 --- /dev/null +++ b/src/context/lookup.ml @@ -0,0 +1,113 @@ + +class virtual ['key,'value] lookup = object(self) + method virtual add : 'key -> 'value -> unit + method virtual remove : 'key -> unit + method virtual find : 'key -> 'value + method virtual iter : ('key -> 'value -> unit) -> unit + method virtual fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc + method virtual mem : 'key -> bool + method virtual clear : unit + + method virtual start_group : int + method virtual commit_group : int -> int + method virtual discard_group : int -> int +end + +class ['key,'value] pmap_lookup = object(self) + inherit ['key,'value] lookup + val mutable lut : ('key,'value) PMap.t = PMap.empty + + val mutable group_id : int ref = ref 0 + val mutable groups : (int,'key list) PMap.t = PMap.empty + + method add (key : 'key) (value : 'value) = + groups <- PMap.map (fun modules -> key :: modules) groups; + lut <- PMap.add key value lut + + method remove (key : 'key) = + lut <- PMap.remove key lut + + method find (key : 'key) : 'value = + PMap.find key lut + + method iter (f : 'key -> 'value -> unit) = + PMap.iter f lut + + method fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc = fun f acc -> + PMap.foldi f lut acc + + method mem (key : 'key) = + PMap.mem key lut + + method clear = + lut <- PMap.empty + + method start_group = + incr group_id; + let i = !group_id in + groups <- PMap.add i [] groups; + i + + method commit_group i = + let group = PMap.find i groups in + let n = List.length group in + groups <- PMap.remove i groups; + n + + method discard_group i = + let group = PMap.find i groups in + let n = List.length group in + List.iter (fun mpath -> self#remove mpath) group; + groups <- PMap.remove i groups; + n +end + +class ['key,'value] hashtbl_lookup = object(self) + inherit ['key,'value] lookup + val lut : ('key,'value) Hashtbl.t = Hashtbl.create 0 + + val mutable group_id : int ref = ref 0 + val mutable groups : (int,'key list) Hashtbl.t = Hashtbl.create 0 + + method add (key : 'key) (value : 'value) = + Hashtbl.iter (fun i modules -> Hashtbl.replace groups i (key :: modules)) groups; + Hashtbl.replace lut key value + + method remove (key : 'key) = + Hashtbl.remove lut key + + method find (key : 'key) : 'value = + Hashtbl.find lut key + + method iter (f : 'key -> 'value -> unit) = + Hashtbl.iter f lut + + method fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc = fun f acc -> + Hashtbl.fold f lut acc + + method mem (key : 'key) = + Hashtbl.mem lut key + + method clear = + Hashtbl.clear lut + + method start_group = + incr group_id; + let i = !group_id in + Hashtbl.replace groups i []; + i + + method commit_group i = + let group = Hashtbl.find groups i in + let n = List.length group in + Hashtbl.remove groups i; + n + + method discard_group i = + let group = Hashtbl.find groups i in + let n = List.length group in + List.iter (fun mpath -> self#remove mpath) group; + Hashtbl.remove groups i; + n +end + diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 56769dad5c6..87904211ae5 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -20,6 +20,7 @@ open Globals open Ast open Common +open Lookup open Type open Error open Resolution diff --git a/src/core/displayTypes.ml b/src/core/displayTypes.ml index b9bacf7f75e..5d8f0c3b706 100644 --- a/src/core/displayTypes.ml +++ b/src/core/displayTypes.ml @@ -352,4 +352,4 @@ type display_exception_kind = | DisplayPositions of pos list | DisplayFields of fields_result | DisplayPackage of string list - | DisplayNoResult \ No newline at end of file + | DisplayNoResult diff --git a/src/core/naming.ml b/src/core/naming.ml index 05b9bedb4ef..2a3b3641768 100644 --- a/src/core/naming.ml +++ b/src/core/naming.ml @@ -1,8 +1,6 @@ open Globals open Ast -open Meta open Type -open Error (** retrieve string from @:native metadata or raise Not_found *) let get_native_name meta = @@ -85,4 +83,4 @@ let apply_native_paths t = | _ -> ()) with Not_found -> - () \ No newline at end of file + () diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index ae2c980a69d..12913bafa59 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -199,19 +199,53 @@ let mk_field name ?(public = true) ?(static = false) t p name_pos = { } let null_module = { - m_id = alloc_mid(); - m_path = [] , ""; - m_types = []; - m_statics = None; - m_extra = module_extra "" "" 0. MFake []; - } + m_id = alloc_mid(); + m_path = [] , ""; + m_types = []; + m_statics = None; + m_extra = module_extra "" "" 0. MFake []; +} let null_class = let c = mk_class null_module ([],"") null_pos null_pos in c.cl_private <- true; c +let null_typedef = + let t = mk_typedef null_module ([],"") null_pos null_pos (TDynamic None) in + t.t_private <- true; + t + +let null_tanon = { a_fields = PMap.empty; a_status = ref Closed } + +let null_enum = { + e_path = ([],""); + e_module = null_module; + e_pos = null_pos; + e_name_pos = null_pos; + e_private = true; + e_doc = None; + e_meta = []; + e_params = []; + e_using = []; + e_restore = (fun () -> ()); + e_type = t_dynamic; + e_extern = false; + e_constrs = PMap.empty; + e_names = []; +} + let null_field = mk_field "" t_dynamic null_pos null_pos +let null_enum_field = { + ef_name = ""; + ef_type = TEnum (null_enum, []); + ef_pos = null_pos; + ef_name_pos = null_pos; + ef_doc = None; + ef_index = 0; + ef_params = []; + ef_meta = []; +} let null_abstract = { a_path = ([],""); @@ -518,6 +552,15 @@ let rec follow t = follow t | _ -> t +let rec follow_lazy t = + match t with + | TLazy f -> + (match !f with + | LAvailable t -> follow_lazy t + | _ -> follow_lazy (lazy_type f) + ) + | _ -> t + let follow_once t = match t with | TMono r -> @@ -893,3 +936,13 @@ let abstract_module_type a tl = let path = ([],Printf.sprintf "Abstract<%s>" (s_type_path a.a_path)) in let t = mk_anon (ref (AbstractStatics a)) in {(mk_typedef a.a_module path a.a_pos null_pos t) with t_private = true} + +let class_field_of_enum_field ef = { + (mk_field ef.ef_name ef.ef_type ef.ef_pos ef.ef_name_pos) with + cf_kind = (match follow ef.ef_type with + | TFun _ -> Method MethNormal + | _ -> Var { v_read = AccNormal; v_write = AccNo } + ); + cf_doc = ef.ef_doc; + cf_params = ef.ef_params; +} \ No newline at end of file diff --git a/src/core/tOther.ml b/src/core/tOther.ml index 8c0a11e469b..71bad6921ee 100644 --- a/src/core/tOther.ml +++ b/src/core/tOther.ml @@ -2,7 +2,6 @@ open Globals open Ast open TType open TFunctions -open TPrinting module TExprToExpr = struct let tpath path module_path params = @@ -263,6 +262,51 @@ end let no_meta = [] +let mk_enum m path pos name_pos = + { + e_path = path; + e_module = m; + e_pos = pos; + e_name_pos = name_pos; + e_doc = None; + e_meta = []; + e_params = []; + e_using = []; + e_restore = (fun () -> ()); + e_private = false; + e_extern = false; + e_constrs = PMap.empty; + e_names = []; + e_type = mk_mono(); + } + +let mk_abstract m path pos name_pos = + { + a_path = path; + a_private = false; + a_module = m; + a_pos = pos; + a_name_pos = name_pos; + a_doc = None; + a_params = []; + a_using = []; + a_restore = (fun () -> ()); + a_meta = []; + a_from = []; + a_to = []; + a_from_field = []; + a_to_field = []; + a_ops = []; + a_unops = []; + a_impl = None; + a_array = []; + a_this = mk_mono(); + a_read = None; + a_write = None; + a_enum = false; + a_call = None; + } + let mk_enum m path pos name_pos = { e_path = path; @@ -375,4 +419,4 @@ let s_class_path c = | KAbstractImpl a -> a.a_path | _ -> c.cl_path in - s_type_path path \ No newline at end of file + s_type_path path diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml index ea3a44a988f..4a3e1522ca8 100644 --- a/src/core/tPrinting.ml +++ b/src/core/tPrinting.ml @@ -441,7 +441,7 @@ module Printer = struct let s_metadata metadata = s_list " " s_metadata_entry metadata - let s_type_param ttp = + let s_type_param ttp = let s = match (get_constraints ttp) with | [] -> ttp.ttp_name | tl1 -> Printf.sprintf "%s:%s" ttp.ttp_name (String.concat " & " (List.map s_type tl1)) diff --git a/src/core/tType.ml b/src/core/tType.ml index 2a78187d734..0cd1e2c8d27 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -92,10 +92,10 @@ and tparams = t list and typed_type_param = { ttp_name : string; - ttp_type : t; ttp_class : tclass; + mutable ttp_type : t; mutable ttp_constraints : t list Lazy.t option; - ttp_default : t option; + mutable ttp_default : t option; } and type_params = typed_type_param list @@ -250,10 +250,10 @@ and tinfos = { mt_module : module_def; mt_pos : pos; mt_name_pos : pos; - mt_private : bool; - mt_doc : Ast.documentation; + mutable mt_private : bool; + mutable mt_doc : Ast.documentation; mutable mt_meta : metadata; - mt_params : type_params; + mutable mt_params : type_params; mutable mt_using : (tclass * pos) list; mutable mt_restore : unit -> unit; } @@ -307,14 +307,14 @@ and tenum = { e_module : module_def; e_pos : pos; e_name_pos : pos; - e_private : bool; + mutable e_private : bool; mutable e_doc : Ast.documentation; mutable e_meta : metadata; mutable e_params : type_params; mutable e_using : (tclass * pos) list; mutable e_restore : unit -> unit; (* do not insert any fields above *) - e_type : t; + mutable e_type : t; mutable e_extern : bool; mutable e_constrs : (string , tenum_field) PMap.t; mutable e_names : string list; @@ -325,8 +325,8 @@ and tdef = { t_module : module_def; t_pos : pos; t_name_pos : pos; - t_private : bool; - t_doc : Ast.documentation; + mutable t_private : bool; + mutable t_doc : Ast.documentation; mutable t_meta : metadata; mutable t_params : type_params; mutable t_using : (tclass * pos) list; @@ -340,7 +340,7 @@ and tabstract = { a_module : module_def; a_pos : pos; a_name_pos : pos; - a_private : bool; + mutable a_private : bool; mutable a_doc : Ast.documentation; mutable a_meta : metadata; mutable a_params : type_params; @@ -359,7 +359,7 @@ and tabstract = { mutable a_read : tclass_field option; mutable a_write : tclass_field option; mutable a_call : tclass_field option; - a_enum : bool; + mutable a_enum : bool; } and module_type = diff --git a/src/filters/localStatic.ml b/src/filters/localStatic.ml index ce1f5dbaf9b..50b5d759c8d 100644 --- a/src/filters/localStatic.ml +++ b/src/filters/localStatic.ml @@ -1,4 +1,3 @@ -open Global open Common open Type open Typecore @@ -60,4 +59,4 @@ let run ctx e = | _ -> Type.map_expr run e in - run e \ No newline at end of file + run e diff --git a/src/typing/finalization.ml b/src/typing/finalization.ml index 806cfd678b8..8dbb41268b1 100644 --- a/src/typing/finalization.ml +++ b/src/typing/finalization.ml @@ -1,5 +1,6 @@ open Globals open Common +open Lookup open Type open Error open TyperBase diff --git a/src/typing/matcher/exprToPattern.ml b/src/typing/matcher/exprToPattern.ml index 3cb8edf06f4..3d6446cb0f3 100644 --- a/src/typing/matcher/exprToPattern.ml +++ b/src/typing/matcher/exprToPattern.ml @@ -446,4 +446,4 @@ let rec make pctx toplevel t e = fail() in let pat = loop e in - pat,p \ No newline at end of file + pat,p diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index 04b98056ffd..ecad6ddf320 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -895,4 +895,4 @@ let init_core_api ctx c = | Some cf, _ when not (has_class_field_flag cf CfPublic) -> () | Some f, Some f2 -> compare_fields f f2 | None, Some cf when not (has_class_field_flag cf CfPublic) -> () - | _ -> raise_typing_error "Constructor differs from core type" c.cl_pos) \ No newline at end of file + | _ -> raise_typing_error "Constructor differs from core type" c.cl_pos) diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index d9189bb0519..14f3169c440 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -334,20 +334,6 @@ let check_global_metadata ctx meta f_add mpath tpath so = ) ctx.com.global_metadata; if ctx.is_display_file then delay ctx PCheckConstraint (fun () -> DisplayEmitter.check_display_metadata ctx meta) -let check_module_types ctx m p t = - let t = t_infos t in - try - let path2 = ctx.com.module_lut#get_type_lut#find t.mt_path in - if m.m_path <> path2 && String.lowercase_ascii (s_type_path path2) = String.lowercase_ascii (s_type_path m.m_path) then raise_typing_error ("Module " ^ s_type_path path2 ^ " is loaded with a different case than " ^ s_type_path m.m_path) p; - let m2 = ctx.com.module_lut#find path2 in - let hex1 = Digest.to_hex m.m_extra.m_sign in - let hex2 = Digest.to_hex m2.m_extra.m_sign in - let s = if hex1 = hex2 then hex1 else Printf.sprintf "was %s, is %s" hex2 hex1 in - raise_typing_error (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path) (s_type_path path2) s) p - with - Not_found -> - ctx.com.module_lut#get_type_lut#add t.mt_path m.m_path - module Inheritance = struct let is_basic_class_path path = match path with | ([],("Array" | "String" | "Date" | "Xml")) -> true diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index a34edc6c3e9..85d82c92926 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -957,7 +957,7 @@ module TypeBinding = struct | NothingToDo -> (fun () -> ()) | NormalOverride rctx -> - (fun () -> + (fun () -> TypeloadCheck.check_override_field ctx cf.cf_name_pos rctx ) | OverloadOverride f -> @@ -965,7 +965,7 @@ module TypeBinding = struct end | _ -> (fun () -> ()) - in + in let e = TypeloadFunction.type_function ctx args ret fmode e fctx.is_display_field p in f_check(); (* Disabled for now, see https://github.com/HaxeFoundation/haxe/issues/3033 *) @@ -1782,12 +1782,7 @@ let init_class ctx c p herits fields = | _ :: l -> check_require l in - let rec check_if_feature = function - | [] -> [] - | (Meta.IfFeature,el,_) :: _ -> List.map (fun (e,p) -> match e with EConst (String(s,_)) -> s | _ -> raise_typing_error "String expected" p) el - | _ :: l -> check_if_feature l - in - let cl_if_feature = check_if_feature c.cl_meta in + let cl_if_feature = Feature.check_if_feature c.cl_meta in let cl_req = check_require c.cl_meta in let has_init = ref false in List.iter (fun f -> @@ -1812,10 +1807,11 @@ let init_class ctx c p herits fields = | FKConstructor -> CfrConstructor | _ -> if fctx.is_static then CfrStatic else CfrMember in - ctx.m.curmod.m_extra.m_if_feature <- (s, (mk_class_field_ref c cf ref_kind fctx.is_macro)) :: ctx.m.curmod.m_extra.m_if_feature; + let cf_ref = mk_class_field_ref c cf ref_kind fctx.is_macro in + Feature.set_feature ctx.m.curmod cf_ref s; in List.iter set_feature cl_if_feature; - List.iter set_feature (check_if_feature cf.cf_meta); + List.iter set_feature (Feature.check_if_feature cf.cf_meta); let req = check_require f.cff_meta in let req = (match req with None -> if fctx.is_static || fctx.field_kind = FKConstructor then cl_req else None | _ -> req) in (match req with diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 41d1738ce50..626d60b69db 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -55,7 +55,6 @@ module ModuleLevel = struct m let add_module ctx m p = - List.iter (TypeloadCheck.check_module_types ctx m p) m.m_types; ctx.com.module_lut#add m.m_path m (* @@ -380,15 +379,7 @@ module TypeLevel = struct ef_meta = c.ec_meta; } in DeprecationCheck.check_is ctx.com e.e_meta f.ef_meta f.ef_name f.ef_meta f.ef_name_pos; - let cf = { - (mk_field f.ef_name f.ef_type p f.ef_name_pos) with - cf_kind = (match follow f.ef_type with - | TFun _ -> Method MethNormal - | _ -> Var { v_read = AccNormal; v_write = AccNo } - ); - cf_doc = f.ef_doc; - cf_params = f.ef_params; - } in + let cf = class_field_of_enum_field f in if ctx.is_display_file && DisplayPosition.display_position#enclosed_in f.ef_name_pos then DisplayEmitter.display_enum_field ctx e f p; f,cf @@ -751,7 +742,10 @@ let type_types_into_module ctx m tdecls p = let ctx = create_typer_context_for_module ctx m in let decls,tdecls = ModuleLevel.create_module_types ctx m tdecls p in let types = List.map fst decls in - List.iter (TypeloadCheck.check_module_types ctx m p) types; + (* During the initial module_lut#add in type_module, m has no m_types yet by design. + We manually add them here. This and module_lut#add itself should be the only places + in the compiler that call add_module_type. *) + List.iter (fun mt -> ctx.com.module_lut#add_module_type m mt) types; m.m_types <- m.m_types @ types; (* define the per-module context for the next pass *) if ctx.g.std_types != null_module then begin diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 31438deb0b2..745a8b6f702 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -1859,7 +1859,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) = else match e2.etype with | TAbstract({a_path = [],"Null"},[t]) -> tmin | _ -> follow_null tmin - in + in let e1 = vr#as_var "tmp" {e1 with etype = ctx.t.tnull tmin} in let e_null = Builder.make_null e1.etype e1.epos in let e_cond = mk (TBinop(OpNotEq,e1,e_null)) ctx.t.tbool e1.epos in diff --git a/src/typing/typerEntry.ml b/src/typing/typerEntry.ml index f7a854fd3c5..ff302b2e0c2 100644 --- a/src/typing/typerEntry.ml +++ b/src/typing/typerEntry.ml @@ -25,7 +25,7 @@ let create com macros = complete = false; type_hints = []; load_only_cached_modules = false; - functional_interface_lut = new pmap_lookup; + functional_interface_lut = new Lookup.pmap_lookup; do_macro = MacroContext.type_macro; do_load_macro = MacroContext.load_macro'; do_load_module = TypeloadModule.load_module; @@ -124,7 +124,7 @@ let create com macros = List.iter (fun mt -> match mt with | TClassDecl c -> ctx.g.std <- c; | _ -> () - ) m.m_types; + ) m.m_types; let m = TypeloadModule.load_module ctx ([],"Array") null_pos in (try List.iter (fun t -> ( @@ -151,4 +151,4 @@ let create com macros = ;; create_context_ref := create; -Inline.maybe_reapply_overload_call_ref := CallUnification.maybe_reapply_overload_call; \ No newline at end of file +Inline.maybe_reapply_overload_call_ref := CallUnification.maybe_reapply_overload_call; diff --git a/tests/server/src/Main.hx b/tests/server/src/Main.hx index e35a4cafcbe..77aa51ba3a0 100644 --- a/tests/server/src/Main.hx +++ b/tests/server/src/Main.hx @@ -13,4 +13,4 @@ class Main { report.displaySuccessResults = NeverShowSuccessResults; runner.run(); } -} \ No newline at end of file +} diff --git a/tests/server/src/cases/issues/Issue9690.hx b/tests/server/src/cases/issues/Issue9690.hx index 8faf398f559..f1bd5ca44f1 100644 --- a/tests/server/src/cases/issues/Issue9690.hx +++ b/tests/server/src/cases/issues/Issue9690.hx @@ -15,4 +15,4 @@ class Issue9690 extends TestCase { Assert.isTrue(lastResult.hasError); Assert.isTrue(lastResult.stderr.contains('Error: side effect!')); } -} \ No newline at end of file +} From 99bd8ef8fd4354b09b5efa420a8ad140b8580478 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Thu, 28 Dec 2023 22:09:37 +0100 Subject: [PATCH 018/125] [server] fix @:keep @:keep @:keep @:keep @:keep ... --- src/typing/finalization.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/typing/finalization.ml b/src/typing/finalization.ml index 8dbb41268b1..406f6590c4f 100644 --- a/src/typing/finalization.ml +++ b/src/typing/finalization.ml @@ -43,7 +43,7 @@ let get_main ctx types = | _ -> raise_typing_error ("Invalid -main : " ^ s_type_path path ^ " has invalid main function") c.cl_pos in if not (ExtType.is_void (follow r)) then raise_typing_error (Printf.sprintf "Return type of main function should be Void (found %s)" (s_type (print_context()) r)) f.cf_name_pos; - f.cf_meta <- (Dce.mk_keep_meta f.cf_pos) :: f.cf_meta; + if not (Meta.has Meta.Keep f.cf_meta) then f.cf_meta <- (Dce.mk_keep_meta f.cf_pos) :: f.cf_meta; let emain = type_module_type ctx (TClassDecl c) null_pos in let main = mk (TCall (mk (TField (emain,fmode)) ft null_pos,[])) r null_pos in let call_static path method_name = From 2d821854378dc0c7c9aa0be0fca5aa3a3747edd1 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Fri, 29 Dec 2023 07:34:13 +0100 Subject: [PATCH 019/125] fix warnings --- src/context/common.ml | 6 +++--- src/typing/finalization.ml | 1 - 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/context/common.ml b/src/context/common.ml index 6fbfba69569..2a94ab7c79a 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -313,11 +313,11 @@ class module_lut = object(self) with Not_found -> type_lut#add t.mt_path m.m_path - method add (path : path) (m : module_def) = + method! add (path : path) (m : module_def) = super#add path m; List.iter (fun mt -> self#add_module_type m mt) m.m_types - method remove (path : path) = + method! remove (path : path) = try List.iter (fun mt -> type_lut#remove (t_path mt)) (self#find path).m_types; super#remove path; @@ -327,7 +327,7 @@ class module_lut = object(self) method find_by_type (path : path) = self#find (type_lut#find path) - method clear = + method! clear = super#clear; type_lut#clear diff --git a/src/typing/finalization.ml b/src/typing/finalization.ml index 406f6590c4f..72b0847b5d0 100644 --- a/src/typing/finalization.ml +++ b/src/typing/finalization.ml @@ -1,6 +1,5 @@ open Globals open Common -open Lookup open Type open Error open TyperBase From 6f4a1071d28ef448fafa3f1d8f55dfc8e09c6ccc Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Fri, 29 Dec 2023 08:09:43 +0100 Subject: [PATCH 020/125] [typer] track type parameter hosts --- src/codegen/gencommon/closuresToClass.ml | 2 +- src/codegen/gencommon/gencommon.ml | 2 +- src/core/tFunctions.ml | 3 ++- src/core/tType.ml | 9 +++++++++ src/generators/genhl.ml | 2 +- src/macro/macroApi.ml | 2 +- src/typing/generic.ml | 2 +- src/typing/typeload.ml | 20 ++++++++------------ src/typing/typeloadFields.ml | 2 +- src/typing/typeloadFunction.ml | 6 +++--- src/typing/typer.ml | 2 +- 11 files changed, 29 insertions(+), 23 deletions(-) diff --git a/src/codegen/gencommon/closuresToClass.ml b/src/codegen/gencommon/closuresToClass.ml index d35bf652194..ed45fd75b44 100644 --- a/src/codegen/gencommon/closuresToClass.ml +++ b/src/codegen/gencommon/closuresToClass.ml @@ -393,7 +393,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 -> mk_type_param cl None None) tparams in + let cltypes = List.map (fun cl -> mk_type_param cl TPHType None 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 diff --git a/src/codegen/gencommon/gencommon.ml b/src/codegen/gencommon/gencommon.ml index 4dc998fc58e..d087d44ac3f 100644 --- a/src/codegen/gencommon/gencommon.ml +++ b/src/codegen/gencommon/gencommon.ml @@ -1142,7 +1142,7 @@ let clone_param ttp = let ret = mk_class cl.cl_module (fst cl.cl_path, snd cl.cl_path ^ "_c") cl.cl_pos null_pos in ret.cl_implements <- cl.cl_implements; ret.cl_kind <- cl.cl_kind; - let ttp = mk_type_param ret ttp.ttp_default ttp.ttp_constraints in + let ttp = mk_type_param ret ttp.ttp_host ttp.ttp_default ttp.ttp_constraints in ret.cl_kind <- KTypeParameter ttp; ttp diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index 12913bafa59..9b1ad7b0905 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -698,10 +698,11 @@ let lookup_param n l = in loop l -let mk_type_param c def constraints = { +let mk_type_param c host def constraints = { ttp_name = snd c.cl_path; ttp_type = TInst(c,[]); ttp_class = c; + ttp_host = host; ttp_constraints = constraints; ttp_default = def; } diff --git a/src/core/tType.ml b/src/core/tType.ml index 0cd1e2c8d27..3335a2ae77c 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -44,6 +44,14 @@ type module_cache_state = | MSBad of module_skip_reason | MSUnknown +type type_param_host = + | TPHType + | TPHConstructor + | TPHMethod + | TPHEnumConstructor + | TPHAnonField + | TPHLocal + type t = | TMono of tmono | TEnum of tenum * tparams @@ -93,6 +101,7 @@ and tparams = t list and typed_type_param = { ttp_name : string; ttp_class : tclass; + ttp_host : type_param_host; mutable ttp_type : t; mutable ttp_constraints : t list Lazy.t option; mutable ttp_default : t option; diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml index 8ed3abbc49b..c378ab4bfbd 100644 --- a/src/generators/genhl.ml +++ b/src/generators/genhl.ml @@ -361,7 +361,7 @@ let make_debug ctx arr = let fake_tnull = {null_abstract with a_path = [],"Null"; - a_params = [mk_type_param null_class None None]; + a_params = [mk_type_param null_class TPHType None None]; } let get_rec_cache ctx t none_callback not_found_callback = diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index 69871e0629d..e6138c5da2c 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -2277,7 +2277,7 @@ let macro_api ccom get_api = | TInst(c,_) -> c | _ -> die "" __LOC__ in - mk_type_param c default None + mk_type_param c TPHType default None ) (decode_array tpl) in let rec map t = match t with | TInst({cl_kind = KTypeParameter _},_) -> diff --git a/src/typing/generic.ml b/src/typing/generic.ml index dda73fc982d..0dba901d33a 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -315,7 +315,7 @@ let build_generic_class ctx c p tl = | None -> None | Some constraints -> Some (lazy (List.map (generic_substitute_type gctx) (Lazy.force constraints))) in - let ttp' = mk_type_param c def constraints in + let ttp' = mk_type_param c ttp.ttp_host def constraints in (ttp.ttp_type,ttp') ) cf_old.cf_params in let param_subst = List.map (fun (t,ttp) -> t,(ttp.ttp_type,None)) params in diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index ecad6ddf320..956582e1c2e 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -35,7 +35,7 @@ open Globals let build_count = ref 0 -let type_function_params_rec = ref (fun _ _ _ _ -> die "" __LOC__) +let type_function_params_ref = ref (fun _ _ _ _ _ -> die "" __LOC__) let check_field_access ctx cff = let display_access = ref None in @@ -576,7 +576,7 @@ and load_complex_type' ctx allow_display (t,p) = no_expr e; topt t, Var { v_read = AccNormal; v_write = AccNormal } | FFun fd -> - params := (!type_function_params_rec) ctx fd (fst f.cff_name) p; + params := (!type_function_params_ref) ctx fd TPHAnonField (fst f.cff_name) p; no_expr fd.f_expr; let old = ctx.type_params in ctx.type_params <- !params @ old; @@ -673,7 +673,7 @@ and init_meta_overloads ctx co cf = 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 + let params : type_params = (!type_function_params_ref) ctx f TPHMethod cf.cf_name p in ctx.type_params <- params @ ctx.type_params; let topt = function None -> raise_typing_error "Explicit type required" p | Some t -> load_complex_type ctx true t in let args = @@ -728,12 +728,6 @@ let load_type_hint ?(opt=false) ctx pcur t = (* ---------------------------------------------------------------------- *) (* PASS 1 & 2 : Module and Class Structure *) -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 @@ -754,7 +748,9 @@ let rec type_type_param ctx host path get_params p tp = () | TPHConstructor | TPHMethod - | TPHEnumConstructor -> + | TPHEnumConstructor + | TPHAnonField + | TPHLocal -> display_error ctx.com "Default type parameters are only supported on types" (pos ct) end; t @@ -763,7 +759,7 @@ let rec type_type_param ctx host path get_params p tp = in let ttp = match tp.tp_constraints with | None -> - mk_type_param c default None + mk_type_param c host default None | Some th -> let constraints = lazy ( let ctx = { ctx with type_params = ctx.type_params @ get_params() } in @@ -787,7 +783,7 @@ let rec type_type_param ctx host path get_params p tp = constr ) in delay ctx PConnectField (fun () -> ignore (Lazy.force constraints)); - mk_type_param c default (Some constraints) + mk_type_param c host default (Some constraints) in c.cl_kind <- KTypeParameter ttp; ttp diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index 85d82c92926..f8a45c83c9d 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -1295,7 +1295,7 @@ let setup_args_ret ctx cctx fctx name fd p = let create_method (ctx,cctx,fctx) c f fd p = let name = fst f.cff_name in - let params = TypeloadFunction.type_function_params ctx fd name p in + let params = TypeloadFunction.type_function_params ctx fd TPHMethod name p in if fctx.is_generic then begin if params = [] then raise_typing_error "Generic functions must have type parameters" p; end; diff --git a/src/typing/typeloadFunction.ml b/src/typing/typeloadFunction.ml index 3709c1798d2..48f106c30cf 100644 --- a/src/typing/typeloadFunction.ml +++ b/src/typing/typeloadFunction.ml @@ -43,9 +43,9 @@ let save_field_state ctx = ctx.in_function <- old_in_function; ) -let type_function_params ctx fd fname p = +let type_function_params ctx fd host fname p = let params = ref [] in - params := Typeload.type_type_params ctx TPHMethod ([],fname) (fun() -> !params) p fd.f_params; + params := Typeload.type_type_params ctx host ([],fname) (fun() -> !params) p fd.f_params; !params let type_function ctx (args : function_arguments) ret fmode e do_display p = @@ -257,4 +257,4 @@ let add_constructor ctx c force_constructor p = (* nothing to do *) () ;; -Typeload.type_function_params_rec := type_function_params +Typeload.type_function_params_ref := type_function_params diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 745a8b6f702..5eced0b8b64 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -1218,7 +1218,7 @@ and type_map_declaration ctx e1 el with_type p = and type_local_function ctx kind f with_type p = let name,inline = match kind with FKNamed (name,inline) -> Some name,inline | _ -> None,false in - let params = TypeloadFunction.type_function_params ctx f (match name with None -> "localfun" | Some (n,_) -> n) p in + let params = TypeloadFunction.type_function_params ctx f TPHLocal (match name with None -> "localfun" | Some (n,_) -> n) p in if params <> [] then begin if name = None then display_error ctx.com "Type parameters not supported in unnamed local functions" p; if with_type <> WithType.NoValue then raise_typing_error "Type parameters are not supported for rvalue functions" p From 3b068a1e66cdc51e5571cf17fec6950df1514017 Mon Sep 17 00:00:00 2001 From: Zorbn <70043176+Zorbn@users.noreply.github.com> Date: Fri, 29 Dec 2023 00:35:22 -0800 Subject: [PATCH 021/125] Allow generating sourcemaps for Lua in the same format as JS (#11454) --- src/generators/genjs.ml | 151 ++------------------------------ src/generators/genlua.ml | 40 ++++++++- src/generators/jsSourcemap.ml | 159 ++++++++++++++++++++++++++++++++++ 3 files changed, 205 insertions(+), 145 deletions(-) create mode 100644 src/generators/jsSourcemap.ml diff --git a/src/generators/genjs.ml b/src/generators/genjs.ml index 02a90e3427d..ba525b198e4 100644 --- a/src/generators/genjs.ml +++ b/src/generators/genjs.ml @@ -21,24 +21,7 @@ open Globals open Ast open Type open Common - -type sourcemap = { - sources : (string) DynArray.t; - sources_hash : (string, int) Hashtbl.t; - mappings : Rbuffer.t; - - mutable source_last_pos : sourcemap_pos; - mutable print_comma : bool; - mutable output_last_col : int; - mutable output_current_col : int; - mutable current_expr : sourcemap_pos option; -} - -and sourcemap_pos = { - file : int; - line : int; - col : int; -} +open JsSourcemap type ctx = { com : Common.context; @@ -169,98 +152,6 @@ let add_feature ctx = Common.add_feature ctx.com let unsupported p = abort "This expression cannot be compiled to Javascript" p -let encode_mapping smap pos = - if smap.print_comma then - Rbuffer.add_char smap.mappings ',' - else - smap.print_comma <- true; - - let base64_vlq number = - let encode_digit digit = - let chars = [| - 'A';'B';'C';'D';'E';'F';'G';'H';'I';'J';'K';'L';'M';'N';'O';'P'; - 'Q';'R';'S';'T';'U';'V';'W';'X';'Y';'Z';'a';'b';'c';'d';'e';'f'; - 'g';'h';'i';'j';'k';'l';'m';'n';'o';'p';'q';'r';'s';'t';'u';'v'; - 'w';'x';'y';'z';'0';'1';'2';'3';'4';'5';'6';'7';'8';'9';'+';'/' - |] in - Array.unsafe_get chars digit - in - let to_vlq number = - if number < 0 then - ((-number) lsl 1) + 1 - else - number lsl 1 - in - let rec loop vlq = - let shift = 5 in - let base = 1 lsl shift in - let mask = base - 1 in - let continuation_bit = base in - let digit = vlq land mask in - let next = vlq asr shift in - Rbuffer.add_char smap.mappings (encode_digit ( - if next > 0 then digit lor continuation_bit else digit)); - if next > 0 then loop next else () - in - loop (to_vlq number) - in - - base64_vlq (smap.output_current_col - smap.output_last_col); - base64_vlq (pos.file - smap.source_last_pos.file); - base64_vlq (pos.line - smap.source_last_pos.line); - base64_vlq (pos.col - smap.source_last_pos.col); - - smap.source_last_pos <- pos; - smap.output_last_col <- smap.output_current_col - -let noop () = () - -let add_mapping smap pos = - if pos.pmin < 0 then noop else - - let file = try - Hashtbl.find smap.sources_hash pos.pfile - with Not_found -> - let length = DynArray.length smap.sources in - Hashtbl.replace smap.sources_hash pos.pfile length; - DynArray.add smap.sources pos.pfile; - length - in - - let pos = - let line, col = Lexer.find_pos pos in - let line = line - 1 in - { file = file; line = line; col = col } - in - - if smap.source_last_pos <> pos then begin - let old_current_expr = smap.current_expr in - smap.current_expr <- Some pos; - encode_mapping smap pos; - (fun () -> smap.current_expr <- old_current_expr) - end else - noop - -let add_mapping ctx e = - Option.map_default (fun smap -> add_mapping smap e.epos) noop ctx.smap - -let handle_newlines ctx str = - Option.may (fun smap -> - let rec loop from = - try begin - let next = String.index_from str from '\n' + 1 in - Rbuffer.add_char smap.mappings ';'; - smap.output_last_col <- 0; - smap.output_current_col <- 0; - smap.print_comma <- false; - Option.may (encode_mapping smap) smap.current_expr; - loop next - end with Not_found -> - smap.output_current_col <- smap.output_current_col + (String.length str - from); - in - loop 0 - ) ctx.smap - let flush ctx = let chan = match ctx.chan with @@ -275,43 +166,16 @@ let flush ctx = let spr ctx s = ctx.separator <- false; - handle_newlines ctx s; + handle_newlines ctx.smap s; Rbuffer.add_string ctx.buf s let print ctx = ctx.separator <- false; Printf.kprintf (fun s -> begin - handle_newlines ctx s; + handle_newlines ctx.smap s; Rbuffer.add_string ctx.buf s end) -let write_mappings ctx smap = - let basefile = Filename.basename ctx.com.file in - print ctx "\n//# sourceMappingURL=%s.map" (url_encode_s basefile); - let channel = open_out_bin (ctx.com.file ^ ".map") in - let sources = DynArray.to_list smap.sources in - let to_url file = - ExtString.String.map (fun c -> if c == '\\' then '/' else c) (Path.get_full_path file) - in - output_string channel "{\n"; - output_string channel "\"version\":3,\n"; - output_string channel ("\"file\":\"" ^ (String.concat "\\\\" (ExtString.String.nsplit basefile "\\")) ^ "\",\n"); - output_string channel ("\"sourceRoot\":\"\",\n"); - output_string channel ("\"sources\":[" ^ - (String.concat "," (List.map (fun s -> "\"file:///" ^ to_url s ^ "\"") sources)) ^ - "],\n"); - if Common.defined ctx.com Define.SourceMapContent then begin - output_string channel ("\"sourcesContent\":[" ^ - (String.concat "," (List.map (fun s -> try "\"" ^ StringHelper.s_escape (Std.input_file ~bin:true s) ^ "\"" with _ -> "null") sources)) ^ - "],\n"); - end; - output_string channel "\"names\":[],\n"; - output_string channel "\"mappings\":\""; - Rbuffer.output_buffer channel smap.mappings; - output_string channel "\"\n"; - output_string channel "}"; - close_out channel - let newline ctx = match Rbuffer.nth ctx.buf (Rbuffer.length ctx.buf - 1) with | '}' | '{' | ':' | ';' when not ctx.separator -> print ctx "\n%s" ctx.tabs @@ -613,7 +477,7 @@ and add_objectdecl_parens e = loop e and gen_expr ctx e = - let clear_mapping = add_mapping ctx e in + let clear_mapping = add_mapping ctx.smap e in (match e.eexpr with | TConst c -> gen_constant ctx e.epos c | TLocal v -> spr ctx (ident v.v_name) @@ -978,7 +842,7 @@ and gen_block_element ?(newline_after=false) ?(keep_blocks=false) ctx e = if newline_after then newline ctx and gen_value ctx e = - let clear_mapping = add_mapping ctx e in + let clear_mapping = add_mapping ctx.smap e in let assign e = mk (TBinop (Ast.OpAssign, mk (TLocal (match ctx.in_value with None -> die "" __LOC__ | Some v -> v)) t_dynamic e.epos, @@ -2138,7 +2002,10 @@ let generate com = ); (match ctx.smap with - | Some smap -> write_mappings ctx smap + | Some smap -> + write_mappings ctx.com smap "file:///"; + let basefile = Filename.basename com.file in + print ctx "\n//# sourceMappingURL=%s.map" (url_encode_s basefile); | None -> try Sys.remove (com.file ^ ".map") with _ -> ()); flush ctx; Option.may (fun chan -> close_out chan) ctx.chan diff --git a/src/generators/genlua.ml b/src/generators/genlua.ml index 4dda9564ddd..4297cab5ed3 100644 --- a/src/generators/genlua.ml +++ b/src/generators/genlua.ml @@ -20,11 +20,13 @@ * DEALINGS IN THE SOFTWARE. *) +open Extlib_leftovers open Ast open Type open Common open ExtList open Error +open JsSourcemap type pos = Globals.pos @@ -32,6 +34,7 @@ type ctx = { com : Common.context; buf : Buffer.t; packages : (string list,unit) Hashtbl.t; + smap : sourcemap option; mutable current : tclass; mutable statics : (tclass * tclass_field * texpr) list; mutable inits : texpr list; @@ -143,11 +146,15 @@ let temp ctx = let spr ctx s = ctx.separator <- false; + handle_newlines ctx.smap s; Buffer.add_string ctx.buf s let print ctx = ctx.separator <- false; - Printf.kprintf (fun s -> Buffer.add_string ctx.buf s) + Printf.kprintf (fun s -> begin + handle_newlines ctx.smap s; + Buffer.add_string ctx.buf s + end) let newline ctx = print ctx "\n%s" ctx.tabs @@ -662,6 +669,7 @@ and lua_arg_name(a,_) = | _, _, _ -> ident a.v_name; and gen_expr ?(local=true) ctx e = begin + let clear_mapping = add_mapping ctx.smap e in match e.eexpr with TConst c -> gen_constant ctx e.epos c; @@ -1043,13 +1051,16 @@ and gen_expr ?(local=true) ctx e = begin | TCast (e1,None) -> gen_value ctx e1; | TIdent s -> - spr ctx s + spr ctx s; + + clear_mapping () end; (* gen_block_element handles expressions that map to "statements" in lua. *) (* It handles no-op situations, and ensures that expressions are formatted with newlines *) and gen_block_element ctx e = ctx.iife_assign <- false; + let clear_mapping = add_mapping ctx.smap e in begin match e.eexpr with | TTypeExpr _ | TConst _ | TLocal _ | TFunction _ -> () @@ -1109,6 +1120,7 @@ and gen_block_element ctx e = gen_expr ctx e; semicolon ctx; end; + clear_mapping () and is_const_null e = match e.eexpr with @@ -1147,6 +1159,7 @@ and gen_anon_value ctx e = gen_value ctx e and gen_value ctx e = + let clear_mapping = add_mapping ctx.smap e in let assign e = mk (TBinop (Ast.OpAssign, mk (TLocal (match ctx.in_value with None -> Globals.die "" __LOC__ | Some v -> v)) t_dynamic e.epos, @@ -1280,7 +1293,8 @@ and gen_value ctx e = gen_block_element ctx (mk (TTry (block (assign b), List.map (fun (v,e) -> v, block (assign e)) catchs )) e.etype e.epos); - v() + v(); + clear_mapping () and gen_tbinop ctx op e1 e2 = (match op, e1.eexpr, e2.eexpr with @@ -1866,10 +1880,26 @@ let generate_type_forward ctx = function | TTypeDecl _ | TAbstractDecl _ -> () let alloc_ctx com = + let smap = + if com.debug || Common.defined com Define.SourceMap then + Some { + source_last_pos = { file = 0; line = 0; col = 0}; + print_comma = false; + output_last_col = 0; + output_current_col = 0; + sources = DynArray.create(); + sources_hash = Hashtbl.create 0; + mappings = Rbuffer.create 16; + current_expr = None; + } + else + None + in let ctx = { com = com; buf = Buffer.create 16000; packages = Hashtbl.create 0; + smap = smap; statics = []; inits = []; current = null_class; @@ -2175,6 +2205,10 @@ let generate com = if anyExposed then println ctx "return _hx_exports"; + (match ctx.smap with + | Some smap -> write_mappings ctx.com smap "" + | None -> try Sys.remove (com.file ^ ".map") with _ -> ()); + let ch = open_out_bin com.file in output_string ch (Buffer.contents ctx.buf); close_out ch diff --git a/src/generators/jsSourcemap.ml b/src/generators/jsSourcemap.ml new file mode 100644 index 00000000000..ec81af7b375 --- /dev/null +++ b/src/generators/jsSourcemap.ml @@ -0,0 +1,159 @@ +(* + The Haxe Compiler + Copyright (C) 2005-2019 Haxe Foundation + + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + as published by the Free Software Foundation; either version 2 + of the License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + *) +open Extlib_leftovers +open Globals +open Ast +open Type +open Common + +type sourcemap = { + sources : (string) DynArray.t; + sources_hash : (string, int) Hashtbl.t; + mappings : Rbuffer.t; + + mutable source_last_pos : sourcemap_pos; + mutable print_comma : bool; + mutable output_last_col : int; + mutable output_current_col : int; + mutable current_expr : sourcemap_pos option; +} + +and sourcemap_pos = { + file : int; + line : int; + col : int; +} + +let encode_mapping smap pos = + if smap.print_comma then + Rbuffer.add_char smap.mappings ',' + else + smap.print_comma <- true; + + let base64_vlq number = + let encode_digit digit = + let chars = [| + 'A';'B';'C';'D';'E';'F';'G';'H';'I';'J';'K';'L';'M';'N';'O';'P'; + 'Q';'R';'S';'T';'U';'V';'W';'X';'Y';'Z';'a';'b';'c';'d';'e';'f'; + 'g';'h';'i';'j';'k';'l';'m';'n';'o';'p';'q';'r';'s';'t';'u';'v'; + 'w';'x';'y';'z';'0';'1';'2';'3';'4';'5';'6';'7';'8';'9';'+';'/' + |] in + Array.unsafe_get chars digit + in + let to_vlq number = + if number < 0 then + ((-number) lsl 1) + 1 + else + number lsl 1 + in + let rec loop vlq = + let shift = 5 in + let base = 1 lsl shift in + let mask = base - 1 in + let continuation_bit = base in + let digit = vlq land mask in + let next = vlq asr shift in + Rbuffer.add_char smap.mappings (encode_digit ( + if next > 0 then digit lor continuation_bit else digit)); + if next > 0 then loop next else () + in + loop (to_vlq number) + in + + base64_vlq (smap.output_current_col - smap.output_last_col); + base64_vlq (pos.file - smap.source_last_pos.file); + base64_vlq (pos.line - smap.source_last_pos.line); + base64_vlq (pos.col - smap.source_last_pos.col); + + smap.source_last_pos <- pos; + smap.output_last_col <- smap.output_current_col + +let noop () = () + +let add_mapping smap pos = + if pos.pmin < 0 then noop else + + let file = try + Hashtbl.find smap.sources_hash pos.pfile + with Not_found -> + let length = DynArray.length smap.sources in + Hashtbl.replace smap.sources_hash pos.pfile length; + DynArray.add smap.sources pos.pfile; + length + in + + let pos = + let line, col = Lexer.find_pos pos in + let line = line - 1 in + { file = file; line = line; col = col } + in + + if smap.source_last_pos <> pos then begin + let old_current_expr = smap.current_expr in + smap.current_expr <- Some pos; + encode_mapping smap pos; + (fun () -> smap.current_expr <- old_current_expr) + end else + noop + +let add_mapping smap e = + Option.map_default (fun smap -> add_mapping smap e.epos) noop smap + +let handle_newlines smap str = + Option.may (fun smap -> + let rec loop from = + try begin + let next = String.index_from str from '\n' + 1 in + Rbuffer.add_char smap.mappings ';'; + smap.output_last_col <- 0; + smap.output_current_col <- 0; + smap.print_comma <- false; + Option.may (encode_mapping smap) smap.current_expr; + loop next + end with Not_found -> + smap.output_current_col <- smap.output_current_col + (String.length str - from); + in + loop 0 + ) smap + +let write_mappings (com : Common.context) smap source_path_prefix = + let basefile = Filename.basename com.file in + let channel = open_out_bin (com.file ^ ".map") in + let sources = DynArray.to_list smap.sources in + let to_url file = + ExtString.String.map (fun c -> if c == '\\' then '/' else c) (Path.get_full_path file) + in + output_string channel "{\n"; + output_string channel "\"version\":3,\n"; + output_string channel ("\"file\":\"" ^ (String.concat "\\\\" (ExtString.String.nsplit basefile "\\")) ^ "\",\n"); + output_string channel ("\"sourceRoot\":\"\",\n"); + output_string channel ("\"sources\":[" ^ + (String.concat "," (List.map (fun s -> "\"" ^ source_path_prefix ^ to_url s ^ "\"") sources)) ^ + "],\n"); + if Common.defined com Define.SourceMapContent then begin + output_string channel ("\"sourcesContent\":[" ^ + (String.concat "," (List.map (fun s -> try "\"" ^ StringHelper.s_escape (Std.input_file ~bin:true s) ^ "\"" with _ -> "null") sources)) ^ + "],\n"); + end; + output_string channel "\"names\":[],\n"; + output_string channel "\"mappings\":\""; + Rbuffer.output_buffer channel smap.mappings; + output_string channel "\"\n"; + output_string channel "}"; + close_out channel \ No newline at end of file From 45f7252bf393eb3190f11060874ec40d7f5fc755 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Fri, 29 Dec 2023 13:14:57 +0100 Subject: [PATCH 022/125] [typer] fix type parameter resolution related to meta overloads --- src/typing/typeload.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index 956582e1c2e..21cbe64efb9 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -669,8 +669,8 @@ and init_meta_overloads ctx co cf = | [] -> () | l -> - ctx.type_params <- List.filter (fun t -> - not (List.mem t l) (* TODO: this still looks suspicious *) + ctx.type_params <- List.filter (fun ttp -> + ttp.ttp_host <> TPHMethod ) ctx.type_params end; let params : type_params = (!type_function_params_ref) ctx f TPHMethod cf.cf_name p in @@ -761,8 +761,9 @@ let rec type_type_param ctx host path get_params p tp = | None -> mk_type_param c host default None | Some th -> + let current_type_params = ctx.type_params in let constraints = lazy ( - let ctx = { ctx with type_params = ctx.type_params @ get_params() } in + let ctx = { ctx with type_params = get_params() @ current_type_params } in let rec loop th = match fst th with | CTIntersection tl -> List.map (load_complex_type ctx true) tl | CTParent ct -> loop ct From 5850ef1b14ece8446d561b7b919fc52fb7bfcf20 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Fri, 29 Dec 2023 14:23:19 +0100 Subject: [PATCH 023/125] [generic] point to the correct ttp and add ttp printer --- src/codegen/codegen.ml | 2 +- src/core/tPrinting.ml | 46 ++++++++++++++++++++++++------------------ src/typing/generic.ml | 1 + 3 files changed, 28 insertions(+), 21 deletions(-) diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index a40ab712126..5c945905bf4 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -244,7 +244,7 @@ module Dump = struct let s_type = s_type (Type.print_context()) in let params tl = match tl with | [] -> "" - | l -> Printf.sprintf "<%s>" (String.concat ", " (List.map Printer.s_type_param l)) + | l -> Printf.sprintf "<%s>" (String.concat ", " (List.map (Printer.s_type_param "") l)) in List.iter (fun mt -> let path = Type.t_path mt in diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml index 4a3e1522ca8..31399d79890 100644 --- a/src/core/tPrinting.ml +++ b/src/core/tPrinting.ml @@ -441,20 +441,26 @@ module Printer = struct let s_metadata metadata = s_list " " s_metadata_entry metadata - let s_type_param ttp = - let s = match (get_constraints ttp) with - | [] -> ttp.ttp_name - | tl1 -> Printf.sprintf "%s:%s" ttp.ttp_name (String.concat " & " (List.map s_type tl1)) - in - begin match ttp.ttp_default with - | None -> - s - | Some t -> - Printf.sprintf "%s = %s" s (s_type t) - end + let s_ttp_host = function + | TPHType -> "TPHType" + | TPHConstructor -> "TPHConstructor" + | TPHMethod -> "TPHMethod" + | TPHEnumConstructor -> "TPHEnumConstructor" + | TPHAnonField -> "TPHAnonField" + | TPHLocal -> "TPHLocal" + + let s_type_param tabs ttp = + s_record_fields tabs [ + "name",ttp.ttp_name; + "class",s_type_path ttp.ttp_class.cl_path; + "host",s_ttp_host ttp.ttp_host; + "type",s_type_kind ttp.ttp_type; + "constraints",s_list ", " s_type_kind (get_constraints ttp) ; + "default",s_opt s_type_kind ttp.ttp_default; + ] - let s_type_params tl = - s_list ", " s_type_param tl + let s_type_params tabs tl = + s_list ", " (s_type_param tabs) tl let s_tclass_field_flags flags = s_flags flags flag_tclass_field_names @@ -468,7 +474,7 @@ module Printer = struct "cf_name_pos",s_pos cf.cf_name_pos; "cf_meta",s_metadata cf.cf_meta; "cf_kind",s_kind cf.cf_kind; - "cf_params",s_type_params cf.cf_params; + "cf_params",s_type_params (tabs ^ "\t") cf.cf_params; "cf_expr",s_opt (s_expr_ast true "\t\t" s_type) cf.cf_expr; "cf_flags",s_tclass_field_flags cf.cf_flags; ] @@ -482,7 +488,7 @@ module Printer = struct "cl_private",string_of_bool c.cl_private; "cl_doc",s_doc c.cl_doc; "cl_meta",s_metadata c.cl_meta; - "cl_params",s_type_params c.cl_params; + "cl_params",s_type_params (tabs ^ "\t") c.cl_params; "cl_kind",s_class_kind c.cl_kind; "cl_super",s_opt (fun (c,tl) -> s_type (TInst(c,tl))) c.cl_super; "cl_implements",s_list ", " (fun (c,tl) -> s_type (TInst(c,tl))) c.cl_implements; @@ -502,7 +508,7 @@ module Printer = struct "t_private",string_of_bool t.t_private; "t_doc",s_doc t.t_doc; "t_meta",s_metadata t.t_meta; - "t_params",s_type_params t.t_params; + "t_params",s_type_params (tabs ^ "\t") t.t_params; "t_type",s_type_kind t.t_type ] @@ -514,7 +520,7 @@ module Printer = struct "ef_name_pos",s_pos ef.ef_name_pos; "ef_type",s_type_kind ef.ef_type; "ef_index",string_of_int ef.ef_index; - "ef_params",s_type_params ef.ef_params; + "ef_params",s_type_params (tabs ^ "\t") ef.ef_params; "ef_meta",s_metadata ef.ef_meta ] @@ -527,7 +533,7 @@ module Printer = struct "e_private",string_of_bool en.e_private; "d_doc",s_doc en.e_doc; "e_meta",s_metadata en.e_meta; - "e_params",s_type_params en.e_params; + "e_params",s_type_params (tabs ^ "\t") en.e_params; "e_type",s_type_kind en.e_type; "e_extern",string_of_bool en.e_extern; "e_constrs",s_list "\n\t" (s_tenum_field (tabs ^ "\t")) (PMap.fold (fun ef acc -> ef :: acc) en.e_constrs []); @@ -543,7 +549,7 @@ module Printer = struct "a_private",string_of_bool a.a_private; "a_doc",s_doc a.a_doc; "a_meta",s_metadata a.a_meta; - "a_params",s_type_params a.a_params; + "a_params",s_type_params (tabs ^ "\t") a.a_params; "a_ops",s_list ", " (fun (op,cf) -> Printf.sprintf "%s: %s" (s_binop op) cf.cf_name) a.a_ops; "a_unops",s_list ", " (fun (op,flag,cf) -> Printf.sprintf "%s (%s): %s" (s_unop op) (if flag = Postfix then "postfix" else "prefix") cf.cf_name) a.a_unops; "a_impl",s_opt (fun c -> s_type_path c.cl_path) a.a_impl; @@ -558,7 +564,7 @@ module Printer = struct ] let s_tvar_extra ve = - Printf.sprintf "Some(%s, %s)" (s_type_params ve.v_params) (s_opt (s_expr_ast true "" s_type) ve.v_expr) + Printf.sprintf "Some(%s, %s)" (s_type_params "" ve.v_params) (s_opt (s_expr_ast true "" s_type) ve.v_expr) let s_tvar v = s_record_fields "" [ diff --git a/src/typing/generic.ml b/src/typing/generic.ml index 0dba901d33a..a1e3fc7e411 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -316,6 +316,7 @@ let build_generic_class ctx c p tl = | Some constraints -> Some (lazy (List.map (generic_substitute_type gctx) (Lazy.force constraints))) in let ttp' = mk_type_param c ttp.ttp_host def constraints in + c.cl_kind <- KTypeParameter ttp'; (ttp.ttp_type,ttp') ) cf_old.cf_params in let param_subst = List.map (fun (t,ttp) -> t,(ttp.ttp_type,None)) params in From 22158007b0cc2961feb33dfab6098127172f2070 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Fri, 29 Dec 2023 17:59:46 +0100 Subject: [PATCH 024/125] fix type parameter pretty dumping --- src/codegen/codegen.ml | 13 +++++++++---- src/core/tPrinting.ml | 12 ++++++++++++ 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index 5c945905bf4..252d3a8cfce 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -240,11 +240,16 @@ module Dump = struct let buf,close = create_dumpfile [] ((dump_path com) :: (platform_name_macro com) :: fst path @ [snd path]) in buf,close - let dump_types com s_expr = + let dump_types com pretty = let s_type = s_type (Type.print_context()) in + let s_expr,s_type_param = if pretty then + (Type.s_expr_ast (not (Common.defined com Define.DumpIgnoreVarIds)) "\t"),(s_type_param s_type) + else + (Type.s_expr_pretty false "\t" true),(Printer.s_type_param "") + in let params tl = match tl with | [] -> "" - | l -> Printf.sprintf "<%s>" (String.concat ", " (List.map (Printer.s_type_param "") l)) + | l -> Printf.sprintf "<%s>" (String.concat ", " (List.map s_type_param l)) in List.iter (fun mt -> let path = Type.t_path mt in @@ -376,10 +381,10 @@ module Dump = struct let dump_types com = match Common.defined_value_safe com Define.Dump with - | "pretty" -> dump_types com (Type.s_expr_pretty false "\t" true) + | "pretty" -> dump_types com true | "record" -> dump_record com | "position" -> dump_position com - | _ -> dump_types com (Type.s_expr_ast (not (Common.defined com Define.DumpIgnoreVarIds)) "\t") + | _ -> dump_types com false let dump_dependencies ?(target_override=None) com = let target_name = match target_override with diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml index 31399d79890..23ea68ef515 100644 --- a/src/core/tPrinting.ml +++ b/src/core/tPrinting.ml @@ -128,6 +128,18 @@ and s_constraint = function | MOpenStructure -> "MOpenStructure" | MEmptyStructure -> "MEmptyStructure" +let s_type_param s_type ttp = + let s = match (get_constraints ttp) with + | [] -> ttp.ttp_name + | tl1 -> Printf.sprintf "%s:%s" ttp.ttp_name (String.concat " & " (List.map s_type tl1)) + in + begin match ttp.ttp_default with + | None -> + s + | Some t -> + Printf.sprintf "%s = %s" s (s_type t) + end + let s_access is_read = function | AccNormal -> "default" | AccNo -> "null" From ce7bb5d94dd932ea6499e540b61869ae5f688c95 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Fri, 29 Dec 2023 22:56:13 +0100 Subject: [PATCH 025/125] that's not pretty... --- src/codegen/codegen.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index 252d3a8cfce..393b5c88a31 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -242,10 +242,10 @@ module Dump = struct let dump_types com pretty = let s_type = s_type (Type.print_context()) in - let s_expr,s_type_param = if pretty then - (Type.s_expr_ast (not (Common.defined com Define.DumpIgnoreVarIds)) "\t"),(s_type_param s_type) + let s_expr,s_type_param = if not pretty then + (Type.s_expr_ast (not (Common.defined com Define.DumpIgnoreVarIds)) "\t"),(Printer.s_type_param "") else - (Type.s_expr_pretty false "\t" true),(Printer.s_type_param "") + (Type.s_expr_pretty false "\t" true),(s_type_param s_type) in let params tl = match tl with | [] -> "" From 64f141b9b3366d6af99f5fb7fc99302c5f720439 Mon Sep 17 00:00:00 2001 From: fourst4r Date: Sat, 30 Dec 2023 19:44:01 +1300 Subject: [PATCH 026/125] Update hxcpp defines (#11455) Still not a complete list of hxcpp defines, but these are some useful ones --- src-json/define.json | 108 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 108 insertions(+) diff --git a/src-json/define.json b/src-json/define.json index e95cc7ff095..dfc8de2f6ca 100644 --- a/src-json/define.json +++ b/src-json/define.json @@ -319,6 +319,114 @@ "doc": "Include additional information for hxcpp-debugger.", "platforms": ["cpp"] }, + { + "name": "HxcppGcMoving", + "define": "HXCPP-GC-MOVING", + "doc": "Allow garbage collector to move memory to reduce fragmentation", + "platforms": ["cpp"] + }, + { + "name": "HxcppGcSummary", + "define": "HXCPP-GC-SUMMARY", + "doc": "Print small profiling summary at end of program", + "platforms": ["cpp"] + }, + { + "name": "HxcppGcDynamicSize", + "define": "HXCPP-GC-DYNAMIC-SIZE", + "doc": "Monitor GC times and expand memory working space if required", + "platforms": ["cpp"] + }, + { + "name": "HxcppGcBigBlocks", + "define": "HXCPP-GC-BIG-BLOCKS", + "doc": "Allow working memory greater than 1 Gig", + "platforms": ["cpp"] + }, + { + "name": "HxcppGcDebugLevel", + "define": "HXCPP-GC-DEBUG-LEVEL", + "doc": "Number 1-4 indicating additional debugging in GC", + "platforms": ["cpp"] + }, + { + "name": "HxcppDebugLink", + "define": "HXCPP-DEBUG-LINK", + "doc": "Add symbols to final binary, even in release mode.", + "platforms": ["cpp"] + }, + { + "name": "HxcppStackTrace", + "define": "HXCPP-STACK-TRACE", + "doc": "Have valid function-level stack traces, even in release mode.", + "platforms": ["cpp"] + }, + { + "name": "HxcppStackLine", + "define": "HXCPP-STACK-LINE", + "doc": "Include line information in stack traces, even in release mode.", + "platforms": ["cpp"] + }, + { + "name": "HxcppCheckPointer", + "define": "HXCPP-CHECK-POINTER", + "doc": "Add null-pointer checks, even in release mode.", + "platforms": ["cpp"] + }, + { + "name": "HxcppProfiler", + "define": "HXCPP-PROFILER", + "doc": "Add profiler support", + "platforms": ["cpp"] + }, + { + "name": "HxcppTelemetry", + "define": "HXCPP-TELEMETRY", + "doc": "Add telemetry support", + "platforms": ["cpp"] + }, + { + "name": "HxcppCpp11", + "define": "HXCPP-CPP11", + "doc": "Use C++11 features and link libraries", + "platforms": ["cpp"] + }, + { + "name": "HxcppVerbose", + "define": "HXCPP-VERBOSE", + "doc": "Print extra output from build tool.", + "platforms": ["cpp"] + }, + { + "name": "HxcppTimes", + "define": "HXCPP-TIMES", + "doc": "Show some basic profiling information", + "platforms": ["cpp"] + }, + { + "name": "HxcppM32", + "define": "HXCPP-M32", + "doc": "Force 32-bit compile for current desktop", + "platforms": ["cpp"] + }, + { + "name": "HxcppM64", + "define": "HXCPP-M64", + "doc": "Force 64-bit compile for current desktop", + "platforms": ["cpp"] + }, + { + "name": "HxcppArm64", + "define": "HXCPP-ARM64", + "doc": "Compile arm-based devices for 64 bits", + "platforms": ["cpp"] + }, + { + "name": "HxcppLinuxArm64", + "define": "HXCPP-LINUX-ARM64", + "doc": "Run on a linux ARM64 device", + "platforms": ["cpp"] + }, { "name": "HxcppSmartStings", "define": "hxcpp-smart-strings", From 580cacd45ddc14c9c37c0a9d652f7f6ed79c48be Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sat, 30 Dec 2023 09:37:04 +0100 Subject: [PATCH 027/125] [server] generalize cache-bound object handling see #7851 --- src/compiler/server.ml | 12 ++++++++++-- src/core/tFunctions.ml | 2 +- src/core/tType.ml | 6 +++++- src/macro/macroApi.ml | 4 +++- 4 files changed, 19 insertions(+), 5 deletions(-) diff --git a/src/compiler/server.ml b/src/compiler/server.ml index de6edffc75c..48da21090f7 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -395,6 +395,14 @@ let check_module sctx ctx m p = end; state +let handle_cache_bound_objects com cbol = + List.iter (function + | Resource(name,data) -> + Hashtbl.replace com.resources name data + | IncludeFile(file,position) -> + com.include_files <- (file,position) :: com.include_files + ) cbol + (* Adds module [m] and all its dependencies (recursively) from the cache to the current compilation context. *) let add_modules sctx ctx m p = @@ -404,7 +412,7 @@ let add_modules sctx ctx m p = (match m0.m_extra.m_kind, m.m_extra.m_kind with | MCode, MMacro | MMacro, MCode -> (* this was just a dependency to check : do not add to the context *) - PMap.iter (Hashtbl.replace com.resources) m.m_extra.m_binded_res; + handle_cache_bound_objects com m.m_extra.m_cache_bound_objects; | _ -> m.m_extra.m_added <- ctx.com.compilation_step; ServerMessage.reusing com tabs m; @@ -412,7 +420,7 @@ let add_modules sctx ctx m p = (t_infos t).mt_restore() ) m.m_types; TypeloadModule.ModuleLevel.add_module ctx m p; - PMap.iter (Hashtbl.replace com.resources) m.m_extra.m_binded_res; + handle_cache_bound_objects com m.m_extra.m_cache_bound_objects; PMap.iter (fun _ (sign,mpath) -> let m2 = (com.cs#get_context sign)#find_module mpath in add_modules (tabs ^ " ") m0 m2 diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index 9b1ad7b0905..bbcb8a2db60 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -166,7 +166,7 @@ let module_extra file sign time kind policy = m_processed = 0; m_deps = PMap.empty; m_kind = kind; - m_binded_res = PMap.empty; + m_cache_bound_objects = []; m_if_feature = []; m_features = Hashtbl.create 0; m_check_policy = policy; diff --git a/src/core/tType.ml b/src/core/tType.ml index 3335a2ae77c..cbc53d9d781 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -52,6 +52,10 @@ type type_param_host = | TPHAnonField | TPHLocal +type cache_bound_object = + | Resource of string * string + | IncludeFile of string * string + type t = | TMono of tmono | TEnum of tenum * tparams @@ -403,7 +407,7 @@ and module_def_extra = { mutable m_processed : int; mutable m_deps : (int,(string (* sign *) * path)) PMap.t; mutable m_kind : module_kind; - mutable m_binded_res : (string, string) PMap.t; + mutable m_cache_bound_objects : cache_bound_object list; mutable m_if_feature : (string * class_field_ref) list; mutable m_features : (string,bool) Hashtbl.t; } diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index e6138c5da2c..0fa4dabe39d 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -2088,7 +2088,7 @@ let macro_api ccom get_api = if name = "" then failwith "Empty resource name"; Hashtbl.replace (ccom()).resources name data; let m = (get_api()).current_module() in - m.m_extra.m_binded_res <- PMap.add name data m.m_extra.m_binded_res; + m.m_extra.m_cache_bound_objects <- (Resource(name,data)) :: m.m_extra.m_cache_bound_objects; vnull ); "get_resources", vfun0 (fun() -> @@ -2301,6 +2301,8 @@ let macro_api ccom get_api = failwith ("unable to find file for inclusion: " ^ file) in (ccom()).include_files <- (file, position) :: (ccom()).include_files; + let m = (get_api()).current_module() in + m.m_extra.m_cache_bound_objects <- (IncludeFile(file,position)) :: m.m_extra.m_cache_bound_objects; vnull ); (* Compilation server *) From 94857d2b859385f51c5d657b61636e062a7dfa91 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Mon, 1 Jan 2024 11:29:54 +0100 Subject: [PATCH 028/125] Happy new year! --- src/compiler/args.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/compiler/args.ml b/src/compiler/args.ml index 4b6a17841e1..48f010f4c04 100644 --- a/src/compiler/args.ml +++ b/src/compiler/args.ml @@ -42,7 +42,7 @@ let process_args arg_spec = let parse_args com = let usage = Printf.sprintf - "Haxe Compiler %s - (C)2005-2023 Haxe Foundation\nUsage: haxe%s [options] [hxml files and dot paths...]\n" + "Haxe Compiler %s - (C)2005-2024 Haxe Foundation\nUsage: haxe%s [options] [hxml files and dot paths...]\n" s_version_full (if Sys.os_type = "Win32" then ".exe" else "") in let actx = { From 72252ad44e7780e4e43377a52f803710063d7a59 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Mon, 1 Jan 2024 17:29:45 +0100 Subject: [PATCH 029/125] [typer] fix functional interface type parameter leak see #11390 --- src/context/abstractCast.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/context/abstractCast.ml b/src/context/abstractCast.ml index 62afbfc23ec..b26f26d980d 100644 --- a/src/context/abstractCast.ml +++ b/src/context/abstractCast.ml @@ -88,7 +88,9 @@ and do_check_cast ctx uctx tleft eright p = end | TInst(c,tl), TFun _ when has_class_flag c CFunctionalInterface -> let cf = ctx.g.functional_interface_lut#find c.cl_path in - unify_raise_custom uctx eright.etype (apply_params c.cl_params tl cf.cf_type) p; + let map = apply_params c.cl_params tl in + let monos = Monomorph.spawn_constrained_monos map cf.cf_params in + unify_raise_custom uctx eright.etype (map (apply_params cf.cf_params monos cf.cf_type)) p; eright | _ -> raise Not_found From bc9c91d098492a5e4300816542cfd72073db68ea Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 2 Jan 2024 10:08:16 +0100 Subject: [PATCH 030/125] [display] file diagnostics should be DFPOnly --- src/compiler/displayProcessing.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/compiler/displayProcessing.ml b/src/compiler/displayProcessing.ml index 8bfc95efab8..aa25ae6008c 100644 --- a/src/compiler/displayProcessing.ml +++ b/src/compiler/displayProcessing.ml @@ -48,7 +48,7 @@ let handle_display_argument_old com file_pos actx = | "diagnostics" -> com.report_mode <- RMLegacyDiagnostics [file_unique]; let dm = create DMNone in - {dm with dms_display_file_policy = DFPAlso; dms_per_file = true; dms_populate_cache = !ServerConfig.populate_cache_from_display} + {dm with dms_display_file_policy = DFPOnly; dms_per_file = true; dms_populate_cache = !ServerConfig.populate_cache_from_display} | "statistics" -> com.report_mode <- RMStatistics; let dm = create DMNone in From eb3d93643ea7af643239a13f427dcbad56befc99 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 2 Jan 2024 10:24:49 +0100 Subject: [PATCH 031/125] [server] turn module_tainting_reason into a type --- src/context/display/displayJson.ml | 2 +- src/context/display/displayTexpr.ml | 2 +- src/core/tPrinting.ml | 7 ++++++- src/core/tType.ml | 7 ++++++- src/generators/jsSourcemap.ml | 1 - src/macro/macroApi.ml | 4 ++-- tests/server/src/cases/issues/Issue9690.hx | 2 +- tests/unit/src/unit/TestOverloads.hx | 1 + 8 files changed, 18 insertions(+), 8 deletions(-) diff --git a/src/context/display/displayJson.ml b/src/context/display/displayJson.ml index 986a86ee285..772fb15662b 100644 --- a/src/context/display/displayJson.ml +++ b/src/context/display/displayJson.ml @@ -378,7 +378,7 @@ let handler = let file = hctx.jsonrpc#get_string_param "file" in let fkey = hctx.com.file_keys#get file in let cs = hctx.display#get_cs in - cs#taint_modules fkey "server/invalidate"; + cs#taint_modules fkey ServerInvalidate; cs#remove_files fkey; hctx.send_result jnull ); diff --git a/src/context/display/displayTexpr.ml b/src/context/display/displayTexpr.ml index b6fa148e6b5..f5241cdb35c 100644 --- a/src/context/display/displayTexpr.ml +++ b/src/context/display/displayTexpr.ml @@ -178,7 +178,7 @@ let check_display_file ctx cs = let fkey = DisplayPosition.display_position#get_file_key in (* force parsing again : if the completion point have been changed *) cs#remove_files fkey; - cs#taint_modules fkey "check_display_file"; + cs#taint_modules fkey CheckDisplayFile; end | None -> () diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml index 23ea68ef515..6361b497d0a 100644 --- a/src/core/tPrinting.ml +++ b/src/core/tPrinting.ml @@ -610,11 +610,16 @@ module Printer = struct | MExtern -> "MExtern" | MImport -> "MImport" + let s_module_tainting_reason = function + | CheckDisplayFile -> "check_display_file" + | ServerInvalidate -> "server/invalidate" + | ServerInvalidateFiles -> "server_invalidate_files" + let s_module_skip_reason reason = let rec loop stack = function | DependencyDirty(path,reason) -> (Printf.sprintf "%s%s - %s" (if stack = [] then "DependencyDirty " else "") (s_type_path path) (if List.mem path stack then "rec" else loop (path :: stack) reason)) - | Tainted cause -> "Tainted " ^ cause + | Tainted cause -> "Tainted " ^ (s_module_tainting_reason cause) | FileChanged file -> "FileChanged " ^ file | Shadowed file -> "Shadowed " ^ file | LibraryChanged -> "LibraryChanged" diff --git a/src/core/tType.ml b/src/core/tType.ml index cbc53d9d781..d601575c77e 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -32,9 +32,14 @@ type module_check_policy = | NoCheckShadowing | Retype +type module_tainting_reason = + | CheckDisplayFile + | ServerInvalidate + | ServerInvalidateFiles + type module_skip_reason = | DependencyDirty of path * module_skip_reason - | Tainted of string + | Tainted of module_tainting_reason | FileChanged of string | Shadowed of string | LibraryChanged diff --git a/src/generators/jsSourcemap.ml b/src/generators/jsSourcemap.ml index ec81af7b375..f44a2029162 100644 --- a/src/generators/jsSourcemap.ml +++ b/src/generators/jsSourcemap.ml @@ -18,7 +18,6 @@ *) open Extlib_leftovers open Globals -open Ast open Type open Common diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index 0fa4dabe39d..952241ee0ba 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -2276,7 +2276,7 @@ let macro_api ccom get_api = let c = match t with | TInst(c,_) -> c | _ -> die "" __LOC__ - in + in mk_type_param c TPHType default None ) (decode_array tpl) in let rec map t = match t with @@ -2318,7 +2318,7 @@ let macro_api ccom get_api = List.iter (fun v -> let s = decode_string v in let s = com.file_keys#get s in - cs#taint_modules s "server_invalidate_files"; + cs#taint_modules s ServerInvalidateFiles; cs#remove_files s; ) (decode_array a); vnull diff --git a/tests/server/src/cases/issues/Issue9690.hx b/tests/server/src/cases/issues/Issue9690.hx index f1bd5ca44f1..8faf398f559 100644 --- a/tests/server/src/cases/issues/Issue9690.hx +++ b/tests/server/src/cases/issues/Issue9690.hx @@ -15,4 +15,4 @@ class Issue9690 extends TestCase { Assert.isTrue(lastResult.hasError); Assert.isTrue(lastResult.stderr.contains('Error: side effect!')); } -} +} \ No newline at end of file diff --git a/tests/unit/src/unit/TestOverloads.hx b/tests/unit/src/unit/TestOverloads.hx index 72d0db0ca6e..59e3161a5f7 100644 --- a/tests/unit/src/unit/TestOverloads.hx +++ b/tests/unit/src/unit/TestOverloads.hx @@ -2,6 +2,7 @@ package unit; import haxe.io.Bytes; import unit.HelperMacros.typeError; import unit.HelperMacros.typedAs; + using unit.TestOverloads.UsingTest2; using unit.TestOverloads.UsingTest3; From fa1b899070640e09c9781d2cdb660eff785e3379 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 2 Jan 2024 10:28:37 +0100 Subject: [PATCH 032/125] [server] turn warnings into CBOs --- src/compiler/server.ml | 4 +++- src/context/common.ml | 4 ++++ src/context/display/deprecationCheck.ml | 9 ++++++--- src/context/typecore.ml | 7 ++++++- src/core/tFunctions.ml | 4 ++-- src/core/tType.ml | 7 ++++--- src/macro/macroApi.ml | 4 ++-- src/typing/finalization.ml | 2 +- src/typing/typeloadFields.ml | 2 +- src/typing/typeloadModule.ml | 6 +++--- src/typing/typer.ml | 2 +- 11 files changed, 33 insertions(+), 18 deletions(-) diff --git a/src/compiler/server.ml b/src/compiler/server.ml index 48da21090f7..d911e4b2d59 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -396,11 +396,13 @@ let check_module sctx ctx m p = state let handle_cache_bound_objects com cbol = - List.iter (function + DynArray.iter (function | Resource(name,data) -> Hashtbl.replace com.resources name data | IncludeFile(file,position) -> com.include_files <- (file,position) :: com.include_files + | Warning(w,msg,p) -> + com.warning w [] msg p ) cbol (* Adds module [m] and all its dependencies (recursively) from the cache to the current compilation diff --git a/src/context/common.ml b/src/context/common.ml index 2a94ab7c79a..bfa4cf68504 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -421,6 +421,10 @@ let ignore_error com = if b then com.has_error <- true; b +let module_warning com m w options msg p = + DynArray.add m.m_extra.m_cache_bound_objects (Warning(w,msg,p)); + com.warning w options msg p + (* Defines *) module Define = Define diff --git a/src/context/display/deprecationCheck.ml b/src/context/display/deprecationCheck.ml index db6ee557c60..947da06e055 100644 --- a/src/context/display/deprecationCheck.ml +++ b/src/context/display/deprecationCheck.ml @@ -7,12 +7,14 @@ type deprecation_context = { com : Common.context; class_meta : metadata_entry list; field_meta : metadata_entry list; + curmod : module_def; } let create_context com = { com = com; class_meta = []; field_meta = []; + curmod = null_module; } let warned_positions = Hashtbl.create 0 @@ -23,7 +25,7 @@ let warn_deprecation dctx s p_usage = Hashtbl.add warned_positions (pkey p_usage) (s,p_usage); if not (is_diagnostics dctx.com) then begin let options = Warning.from_meta (dctx.class_meta @ dctx.field_meta) in - dctx.com.warning WDeprecated options s p_usage; + module_warning dctx.com dctx.curmod WDeprecated options s p_usage; end end @@ -103,7 +105,7 @@ let run com = let dctx = create_context com in List.iter (fun t -> match t with | TClassDecl c when not (Meta.has Meta.Deprecated c.cl_meta) -> - let dctx = {dctx with class_meta = c.cl_meta} in + let dctx = {dctx with class_meta = c.cl_meta; curmod = c.cl_module} in (match c.cl_constructor with None -> () | Some cf -> run_on_field dctx cf); (match c.cl_init with None -> () | Some e -> run_on_expr dctx e); List.iter (run_on_field dctx) c.cl_ordered_statics; @@ -112,11 +114,12 @@ let run com = () ) com.types -let check_is com cl_meta cf_meta name meta p = +let check_is com m cl_meta cf_meta name meta p = let dctx = { com = com; class_meta = cl_meta; field_meta = cf_meta; + curmod = m; } in if is_next dctx.com && name = "is" && not (Meta.has Meta.Deprecated meta) then warn_deprecation dctx "Using \"is\" as an identifier is deprecated" p \ No newline at end of file diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 87904211ae5..3cb6f859a2c 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -241,7 +241,11 @@ let pass_name = function let warning ?(depth=0) ctx w msg p = let options = (Warning.from_meta ctx.curclass.cl_meta) @ (Warning.from_meta ctx.curfield.cf_meta) in - ctx.com.warning ~depth w options msg p + match Warning.get_mode w options with + | WMEnable -> + module_warning ctx.com ctx.m.curmod w options msg p + | WMDisable -> + () let make_call ctx e el t p = (!make_call_ref) ctx e el t p @@ -751,6 +755,7 @@ let create_deprecation_context ctx = { (DeprecationCheck.create_context ctx.com) with class_meta = ctx.curclass.cl_meta; field_meta = ctx.curfield.cf_meta; + curmod = ctx.m.curmod; } (* -------------- debug functions to activate when debugging typer passes ------------------------------- *) diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index bbcb8a2db60..43aa9f5b26f 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -166,7 +166,7 @@ let module_extra file sign time kind policy = m_processed = 0; m_deps = PMap.empty; m_kind = kind; - m_cache_bound_objects = []; + m_cache_bound_objects = DynArray.create (); m_if_feature = []; m_features = Hashtbl.create 0; m_check_policy = policy; @@ -203,7 +203,7 @@ let null_module = { m_path = [] , ""; m_types = []; m_statics = None; - m_extra = module_extra "" "" 0. MFake []; + m_extra = module_extra "" (Digest.string "") 0. MFake 0 []; } let null_class = diff --git a/src/core/tType.ml b/src/core/tType.ml index d601575c77e..2ae0c85886b 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -60,6 +60,7 @@ type type_param_host = type cache_bound_object = | Resource of string * string | IncludeFile of string * string + | Warning of WarningList.warning * string * pos type t = | TMono of tmono @@ -402,7 +403,7 @@ and module_def_display = { and module_def_extra = { m_file : Path.UniqueKey.lazy_t; - m_sign : string; + m_sign : Digest.t; m_display : module_def_display; mutable m_check_policy : module_check_policy list; mutable m_time : float; @@ -410,9 +411,9 @@ and module_def_extra = { mutable m_added : int; mutable m_checked : int; mutable m_processed : int; - mutable m_deps : (int,(string (* sign *) * path)) PMap.t; + mutable m_deps : (int,(Digest.t (* sign *) * path)) PMap.t; mutable m_kind : module_kind; - mutable m_cache_bound_objects : cache_bound_object list; + mutable m_cache_bound_objects : cache_bound_object DynArray.t; mutable m_if_feature : (string * class_field_ref) list; mutable m_features : (string,bool) Hashtbl.t; } diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index 952241ee0ba..4b49dc2150d 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -2088,7 +2088,7 @@ let macro_api ccom get_api = if name = "" then failwith "Empty resource name"; Hashtbl.replace (ccom()).resources name data; let m = (get_api()).current_module() in - m.m_extra.m_cache_bound_objects <- (Resource(name,data)) :: m.m_extra.m_cache_bound_objects; + DynArray.add m.m_extra.m_cache_bound_objects (Resource(name,data)); vnull ); "get_resources", vfun0 (fun() -> @@ -2302,7 +2302,7 @@ let macro_api ccom get_api = in (ccom()).include_files <- (file, position) :: (ccom()).include_files; let m = (get_api()).current_module() in - m.m_extra.m_cache_bound_objects <- (IncludeFile(file,position)) :: m.m_extra.m_cache_bound_objects; + DynArray.add m.m_extra.m_cache_bound_objects (IncludeFile(file,position)); vnull ); (* Compilation server *) diff --git a/src/typing/finalization.ml b/src/typing/finalization.ml index 72b0847b5d0..8f27c9de0df 100644 --- a/src/typing/finalization.ml +++ b/src/typing/finalization.ml @@ -112,7 +112,7 @@ let sort_types com (modules : module_lut) = match state p with | Done -> () | Generating -> - com.warning WStaticInitOrder [] ("Warning : maybe loop in static generation of " ^ s_type_path p) (t_infos t).mt_pos; + module_warning com (t_infos t).mt_module WStaticInitOrder [] ("Warning : maybe loop in static generation of " ^ s_type_path p) (t_infos t).mt_pos; | NotYet -> Hashtbl.add states p Generating; let t = (match t with diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index f8a45c83c9d..9651bd3618b 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -638,7 +638,7 @@ let create_field_context ctx cctx cff is_display_file display_modifier = fctx let create_typer_context_for_field ctx cctx fctx cff = - DeprecationCheck.check_is ctx.com ctx.curclass.cl_meta cff.cff_meta (fst cff.cff_name) cff.cff_meta (snd cff.cff_name); + DeprecationCheck.check_is ctx.com ctx.m.curmod ctx.curclass.cl_meta cff.cff_meta (fst cff.cff_name) cff.cff_meta (snd cff.cff_name); let ctx = { ctx with pass = PBuildClass; (* will be set later to PTypeExpr *) diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 626d60b69db..8e6e182de34 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -65,7 +65,7 @@ module ModuleLevel = struct let decls = ref [] in let statics = ref [] in let check_name name meta also_statics p = - DeprecationCheck.check_is com meta [] name meta p; + DeprecationCheck.check_is com ctx.m.curmod meta [] name meta p; let error prev_pos = display_error ctx.com ("Name " ^ name ^ " is already defined in this module") p; raise_typing_error ~depth:1 (compl_msg "Previous declaration here") prev_pos; @@ -195,7 +195,7 @@ module ModuleLevel = struct | None -> () | Some p -> let options = Warning.from_meta d.d_meta in - ctx.com.warning WDeprecatedEnumAbstract options "`@:enum abstract` is deprecated in favor of `enum abstract`" p + module_warning ctx.com ctx.m.curmod WDeprecatedEnumAbstract options "`@:enum abstract` is deprecated in favor of `enum abstract`" p end; decls := (TAbstractDecl a, decl) :: !decls; match d.d_data with @@ -378,7 +378,7 @@ module TypeLevel = struct ef_params = params; ef_meta = c.ec_meta; } in - DeprecationCheck.check_is ctx.com e.e_meta f.ef_meta f.ef_name f.ef_meta f.ef_name_pos; + DeprecationCheck.check_is ctx.com ctx.m.curmod e.e_meta f.ef_meta f.ef_name f.ef_meta f.ef_name_pos; let cf = class_field_of_enum_field f in if ctx.is_display_file && DisplayPosition.display_position#enclosed_in f.ef_name_pos then DisplayEmitter.display_enum_field ctx e f p; diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 5eced0b8b64..ef95b897573 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -707,7 +707,7 @@ and type_vars ctx vl p = let vl = List.map (fun ev -> let n = fst ev.ev_name and pv = snd ev.ev_name in - DeprecationCheck.check_is ctx.com ctx.curclass.cl_meta ctx.curfield.cf_meta n ev.ev_meta pv; + DeprecationCheck.check_is ctx.com ctx.m.curmod ctx.curclass.cl_meta ctx.curfield.cf_meta n ev.ev_meta pv; try let t = Typeload.load_type_hint ctx p ev.ev_type in let e = (match ev.ev_expr with From 57d2a3f5604260c983836fa020eb2c7a10cf75cd Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 2 Jan 2024 10:31:39 +0100 Subject: [PATCH 033/125] [server] set the current m_added when creating m_extra --- src/codegen/gencommon/gencommon.ml | 4 ++-- src/context/typecore.ml | 2 +- src/core/tFunctions.ml | 4 ++-- src/typing/generic.ml | 4 ++-- src/typing/typeloadModule.ml | 2 +- 5 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/codegen/gencommon/gencommon.ml b/src/codegen/gencommon/gencommon.ml index d087d44ac3f..5324ae9c0f6 100644 --- a/src/codegen/gencommon/gencommon.ml +++ b/src/codegen/gencommon/gencommon.ml @@ -626,11 +626,11 @@ let new_ctx con = gadd_type = (fun md should_filter -> if should_filter then begin gen.gtypes_list <- md :: gen.gtypes_list; - gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_statics = None; m_extra = module_extra "" "" 0. MFake [] } :: gen.gmodules; + gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_statics = None; m_extra = module_extra "" "" 0. MFake gen.gcon.compilation_step [] } :: gen.gmodules; Hashtbl.add gen.gtypes (t_path md) md; end else gen.gafter_filters_ended <- (fun () -> gen.gtypes_list <- md :: gen.gtypes_list; - gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_statics = None; m_extra = module_extra "" "" 0. MFake [] } :: gen.gmodules; + gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_statics = None; m_extra = module_extra "" "" 0. MFake gen.gcon.compilation_step [] } :: gen.gmodules; Hashtbl.add gen.gtypes (t_path md) md; ) :: gen.gafter_filters_ended; ); diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 3cb6f859a2c..4560788cde2 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -480,7 +480,7 @@ let create_fake_module ctx file = m_path = (["$DEP"],file); m_types = []; m_statics = None; - m_extra = module_extra file (Define.get_signature ctx.com.defines) (file_time file) MFake []; + m_extra = module_extra file (Define.get_signature ctx.com.defines) (file_time file) MFake ctx.com.compilation_step []; } in Hashtbl.add fake_modules key mdep; mdep diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index 43aa9f5b26f..d707c936f23 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -150,7 +150,7 @@ let mk_typedef m path pos name_pos t = t_restore = (fun () -> ()); } -let module_extra file sign time kind policy = +let module_extra file sign time kind added policy = { m_file = Path.UniqueKey.create_lazy file; m_sign = sign; @@ -160,7 +160,7 @@ let module_extra file sign time kind policy = m_import_positions = PMap.empty; }; m_cache_state = MSGood; - m_added = 0; + m_added = added; m_checked = 0; m_time = time; m_processed = 0; diff --git a/src/typing/generic.ml b/src/typing/generic.ml index a1e3fc7e411..2c34510de40 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -181,7 +181,7 @@ let static_method_container gctx c cf p = m_path = (pack,name); m_types = []; m_statics = None; - m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake m.m_extra.m_check_policy; + m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake gctx.ctx.com.compilation_step m.m_extra.m_check_policy; } in gctx.mg <- Some mg; let cg = mk_class mg (pack,name) c.cl_pos c.cl_name_pos in @@ -282,7 +282,7 @@ let build_generic_class ctx c p tl = m_path = (pack,name); m_types = []; m_statics = None; - m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake m.m_extra.m_check_policy; + m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake gctx.ctx.com.compilation_step m.m_extra.m_check_policy; } in gctx.mg <- Some mg; let cg = mk_class mg (pack,name) c.cl_pos c.cl_name_pos in diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 8e6e182de34..e447f4721d8 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -50,7 +50,7 @@ module ModuleLevel = struct m_path = mpath; m_types = []; m_statics = None; - m_extra = module_extra (Path.get_full_path file) (Define.get_signature ctx.com.defines) (file_time file) (if ctx.com.is_macro_context then MMacro else MCode) (get_policy ctx.g mpath); + m_extra = module_extra (Path.get_full_path file) (Define.get_signature ctx.com.defines) (file_time file) (if ctx.com.is_macro_context then MMacro else MCode) ctx.com.compilation_step (get_policy ctx.g mpath); } in m From 03db008d5e6f4dfd210c24360251f7153ebf233e Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 2 Jan 2024 10:33:40 +0100 Subject: [PATCH 034/125] [typer] pull some random changes from hxb branch --- src/context/common.ml | 4 ++-- src/core/globals.ml | 10 ++++++++-- src/core/tFunctions.ml | 17 +++++++++++++++++ src/core/tPrinting.ml | 7 ++++--- src/optimization/dce.ml | 9 --------- src/typing/typeloadModule.ml | 2 +- 6 files changed, 32 insertions(+), 17 deletions(-) diff --git a/src/context/common.ml b/src/context/common.ml index bfa4cf68504..9dfdba92ff6 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -1115,7 +1115,7 @@ let cache_directory ctx class_path dir f_dir = in Option.may (Array.iter prepare_file) dir_listing -let find_file ctx f = +let find_file ctx ?(class_path=ctx.class_path) f = try match ctx.file_lookup_cache#find f with | None -> raise Exit @@ -1150,7 +1150,7 @@ let find_file ctx f = loop (had_empty || p = "") l end in - let r = try Some (loop false ctx.class_path) with Not_found -> None in + let r = try Some (loop false class_path) with Not_found -> None in ctx.file_lookup_cache#add f r; match r with | None -> raise Not_found diff --git a/src/core/globals.ml b/src/core/globals.ml index be184e3ecff..e7a834787cb 100644 --- a/src/core/globals.ml +++ b/src/core/globals.ml @@ -171,8 +171,14 @@ let die ?p msg ml_loc = in let ver = s_version_full and os_type = if Sys.unix then "unix" else "windows" in - Printf.eprintf "%s\nHaxe: %s; OS type: %s;\n%s\n%s" msg ver os_type ml_loc backtrace; - assert false + let s = Printf.sprintf "%s\nHaxe: %s; OS type: %s;\n%s\n%s" msg ver os_type ml_loc backtrace in + failwith s + +let dump_callstack () = + print_endline (Printexc.raw_backtrace_to_string (Printexc.get_callstack 200)) + +let dump_backtrace () = + print_endline (Printexc.raw_backtrace_to_string (Printexc.get_raw_backtrace ())) module MessageSeverity = struct type t = diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index d707c936f23..247970f5428 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -198,6 +198,15 @@ let mk_field name ?(public = true) ?(static = false) t p name_pos = { ); } +let find_field c name kind = + match kind with + | CfrConstructor -> + begin match c.cl_constructor with Some cf -> cf | None -> raise Not_found end + | CfrStatic -> + PMap.find name c.cl_statics + | CfrMember -> + PMap.find name c.cl_fields + let null_module = { m_id = alloc_mid(); m_path = [] , ""; @@ -598,6 +607,14 @@ let rec follow_without_type t = follow_without_type t | _ -> t +let rec follow_lazy_and_mono t = match t with + | TMono {tm_type = Some t} -> + follow_lazy_and_mono t + | TLazy f -> + follow_lazy_and_mono (lazy_type f) + | _ -> + t + let rec ambiguate_funs t = match follow t with | TFun _ -> TFun ([], t_dynamic) diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml index 6361b497d0a..5ac61c1d827 100644 --- a/src/core/tPrinting.ml +++ b/src/core/tPrinting.ml @@ -139,7 +139,7 @@ let s_type_param s_type ttp = | Some t -> Printf.sprintf "%s = %s" s (s_type t) end - + let s_access is_read = function | AccNormal -> "default" | AccNo -> "null" @@ -460,7 +460,7 @@ module Printer = struct | TPHEnumConstructor -> "TPHEnumConstructor" | TPHAnonField -> "TPHAnonField" | TPHLocal -> "TPHLocal" - + let s_type_param tabs ttp = s_record_fields tabs [ "name",ttp.ttp_name; @@ -477,7 +477,7 @@ module Printer = struct let s_tclass_field_flags flags = s_flags flags flag_tclass_field_names - let s_tclass_field tabs cf = + let rec s_tclass_field tabs cf = s_record_fields tabs [ "cf_name",cf.cf_name; "cf_doc",s_doc cf.cf_doc; @@ -489,6 +489,7 @@ module Printer = struct "cf_params",s_type_params (tabs ^ "\t") cf.cf_params; "cf_expr",s_opt (s_expr_ast true "\t\t" s_type) cf.cf_expr; "cf_flags",s_tclass_field_flags cf.cf_flags; + "cf_overloads",s_list "\n" (s_tclass_field (tabs ^ "\t")) cf.cf_overloads ] let s_tclass tabs c = diff --git a/src/optimization/dce.ml b/src/optimization/dce.ml index 0d1a4970899..03d3ba6a4c9 100644 --- a/src/optimization/dce.ml +++ b/src/optimization/dce.ml @@ -50,15 +50,6 @@ let push_class dce c = dce.curclass <- old ) -let find_field c name kind = - match kind with - | CfrConstructor -> - begin match c.cl_constructor with Some cf -> cf | None -> raise Not_found end - | CfrStatic -> - PMap.find name c.cl_statics - | CfrMember -> - PMap.find name c.cl_fields - let resolve_class_field_ref ctx cfr = let ctx = if cfr.cfr_is_macro && not ctx.is_macro_context then Option.get (ctx.get_macros()) else ctx in let m = ctx.module_lut#find_by_type cfr.cfr_path in diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index e447f4721d8..014eec7787c 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -573,7 +573,7 @@ module TypeLevel = struct | TMono r -> (match r.tm_type with | None -> Monomorph.bind r tt; - | Some _ -> die "" __LOC__); + | Some t' -> die (Printf.sprintf "typedef %s is already initialized to %s, but new init to %s was attempted" (s_type_path t.t_path) (s_type_kind t') (s_type_kind tt)) __LOC__); | _ -> die "" __LOC__); TypeloadFields.build_module_def ctx (TTypeDecl t) t.t_meta (fun _ -> []) (fun _ -> ()); if ctx.com.platform = Cs && t.t_meta <> [] then From 122ea09563d024ea4ffc005d82c50fa86d53f639 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 2 Jan 2024 10:35:29 +0100 Subject: [PATCH 035/125] [typer] change how we initialize basic types --- src/context/common.ml | 18 +++++++++++------- src/typing/typerEntry.ml | 23 ++++++++++++++++++----- 2 files changed, 29 insertions(+), 12 deletions(-) diff --git a/src/context/common.ml b/src/context/common.ml index 9dfdba92ff6..8f6f5bb4ac3 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -781,7 +781,6 @@ let get_config com = let memory_marker = [|Unix.time()|] let create compilation_step cs version args display_mode = - let m = Type.mk_mono() in let rec com = { compilation_step = compilation_step; cs = cs; @@ -848,12 +847,12 @@ let create compilation_step cs version args display_mode = filter_messages = (fun _ -> ()); pass_debug_messages = DynArray.create(); basic = { - tvoid = m; - tint = m; - tfloat = m; - tbool = m; + tvoid = mk_mono(); + tint = mk_mono(); + tfloat = mk_mono(); + tbool = mk_mono(); + tstring = mk_mono(); tnull = (fun _ -> die "Could use locate abstract Null (was it redefined?)" __LOC__); - tstring = m; tarray = (fun _ -> die "Could not locate class Array (was it redefined?)" __LOC__); }; file_lookup_cache = new hashtbl_lookup; @@ -889,7 +888,12 @@ let clone com is_macro_context = let t = com.basic in { com with cache = None; - basic = { t with tvoid = t.tvoid }; + basic = { t with + tint = mk_mono(); + tfloat = mk_mono(); + tbool = mk_mono(); + tstring = mk_mono(); + }; main_class = None; features = Hashtbl.create 0; callbacks = new compiler_callbacks; diff --git a/src/typing/typerEntry.ml b/src/typing/typerEntry.ml index ff302b2e0c2..6c90f4fb0a9 100644 --- a/src/typing/typerEntry.ml +++ b/src/typing/typerEntry.ml @@ -92,10 +92,20 @@ let create com macros = | TAbstractDecl a -> (match snd a.a_path with | "Void" -> ctx.t.tvoid <- TAbstract (a,[]); - | "Float" -> ctx.t.tfloat <- TAbstract (a,[]); - | "Int" -> ctx.t.tint <- TAbstract (a,[]) - | "Bool" -> ctx.t.tbool <- TAbstract (a,[]) - | "Dynamic" -> t_dynamic_def := TAbstract(a,extract_param_types a.a_params); + | "Float" -> + let t = (TAbstract (a,[])) in + Type.unify t ctx.t.tfloat; + ctx.t.tfloat <- t + | "Int" -> + let t = (TAbstract (a,[])) in + Type.unify t ctx.t.tint; + ctx.t.tint <- t + | "Bool" -> + let t = (TAbstract (a,[])) in + Type.unify t ctx.t.tbool; + ctx.t.tbool <- t + | "Dynamic" -> + t_dynamic_def := TAbstract(a,extract_param_types a.a_params); | "Null" -> let mk_null t = try @@ -117,7 +127,10 @@ let create com macros = ) ctx.g.std_types.m_types; let m = TypeloadModule.load_module ctx ([],"String") null_pos in List.iter (fun mt -> match mt with - | TClassDecl c -> ctx.t.tstring <- TInst (c,[]) + | TClassDecl c -> + let t = (TInst (c,[])) in + Type.unify t ctx.t.tstring; + ctx.t.tstring <- t | _ -> () ) m.m_types; let m = TypeloadModule.load_module ctx ([],"Std") null_pos in From c9e9459b6e9e9f42aa025fe03d46706064f01863 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Wed, 3 Jan 2024 08:31:15 +0100 Subject: [PATCH 036/125] [server] don't merge output lines (#11459) --- src/compiler/server.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/compiler/server.ml b/src/compiler/server.ml index d911e4b2d59..ac6fc9aca88 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -124,7 +124,7 @@ module Communication = struct let create_pipe sctx write = let rec self = { write_out = (fun s -> - write ("\x01" ^ String.concat "\x01" (ExtString.String.nsplit s "\n") ^ "\n") + write ("\x01" ^ String.concat "\n\x01" (ExtString.String.nsplit s "\n") ^ "\n") ); write_err = (fun s -> write s From f8d1caf7698c52dbae1fc4eecb67b9a5736001e1 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Wed, 3 Jan 2024 11:35:51 +0100 Subject: [PATCH 037/125] [tests] Compilation server vs defineModule/defineType (#11159) * [tests] server tests - basic support for @:variant * [tests] add server test for compilation server safe type building * [tests] server tests - error handling for @:variant * [tests] add debug info * [tests] temp change of build params * [tests] add more debug data * [tests] better debug data on failures * [tests] reenable other server tests --- tests/server/src/cases/CsSafeTypeBuilding.hx | 149 ++++++++++++++++++ .../src/utils/macro/TestBuilder.macro.hx | 125 +++++++++++---- .../test/templates/csSafeTypeBuilding/Bar.hx | 6 + .../test/templates/csSafeTypeBuilding/Baz.hx | 7 + .../test/templates/csSafeTypeBuilding/Foo.hx | 2 + .../csSafeTypeBuilding/Macro.macro.hx | 63 ++++++++ .../test/templates/csSafeTypeBuilding/Main.hx | 9 ++ 7 files changed, 333 insertions(+), 28 deletions(-) create mode 100644 tests/server/src/cases/CsSafeTypeBuilding.hx create mode 100644 tests/server/test/templates/csSafeTypeBuilding/Bar.hx create mode 100644 tests/server/test/templates/csSafeTypeBuilding/Baz.hx create mode 100644 tests/server/test/templates/csSafeTypeBuilding/Foo.hx create mode 100644 tests/server/test/templates/csSafeTypeBuilding/Macro.macro.hx create mode 100644 tests/server/test/templates/csSafeTypeBuilding/Main.hx diff --git a/tests/server/src/cases/CsSafeTypeBuilding.hx b/tests/server/src/cases/CsSafeTypeBuilding.hx new file mode 100644 index 00000000000..f8e15f96642 --- /dev/null +++ b/tests/server/src/cases/CsSafeTypeBuilding.hx @@ -0,0 +1,149 @@ +package cases; + +import haxe.display.Display; +import haxe.display.FsPath; +import haxe.display.Server; +import utest.Assert; + +using StringTools; +using Lambda; + +class CsSafeTypeBuilding extends TestCase { + var originalContent:String; + + override public function setup(async:utest.Async) { + super.setup(async); + + originalContent = ""; + vfs.putContent("Bar.hx", getTemplate("csSafeTypeBuilding/Bar.hx")); + vfs.putContent("Baz.hx", getTemplate("csSafeTypeBuilding/Baz.hx")); + vfs.putContent("Foo.hx", getTemplate("csSafeTypeBuilding/Foo.hx")); + vfs.putContent("Macro.macro.hx", getTemplate("csSafeTypeBuilding/Macro.macro.hx")); + vfs.putContent("Main.hx", getTemplate("csSafeTypeBuilding/Main.hx")); + } + + #if debug + var failed:Bool; + function _assertHasPrint(s:String, ?pos:haxe.PosInfos) { + if (!assertHasPrint(s)) { + failed = true; + haxe.Log.trace("Fail: doesn't contain \"" + s + "\"", pos); + } + } + #end + + function assertResult(target:String) { + #if debug + failed = false; + var assertHasPrint = _assertHasPrint; + #end + assertSuccess(); + + // Make sure all types are generated + assertHasPrint("[runtime] Hello from Bar"); + assertHasPrint("[runtime] Hello from Baz"); + assertHasPrint("[runtime] Hello from Foo__Bar__Bar"); + assertHasPrint("[runtime] Hello from Foo__Baz__Baz"); + assertHasPrint("[runtime] Hello from Foo__Main__Main"); + assertHasPrint("[runtime] Hello from Main"); + + #if debug + if (failed) messages.filter(m -> StringTools.startsWith(m, "Haxe print: ")).iter(m -> trace(m)); + #end + + // Disabled this check because types move around a bit so we get false negatives + // Kept for debugging purposes + if (false && target == "js") { + var content = sys.io.File.getContent(haxe.io.Path.join([testDir, "out.js"])); + Assert.isTrue(content == originalContent); + + // Needs https://github.com/kLabz/hxdiff for displaying diff + // if (content != originalContent) { + // final a = new diff.FileData(haxe.io.Bytes.ofString(originalContent), "expected", Date.now()); + // final b = new diff.FileData(haxe.io.Bytes.ofString(content), "actual", Date.now()); + // var ctx:diff.Context = { + // file1: a, + // file2: b, + // context: 10 + // } + + // final script = diff.Analyze.diff2Files(ctx); + // var diff = diff.Printer.printUnidiff(ctx, script); + // Sys.println(diff); + // } + } + } + + function assertBuilt(modules:Array, ?macroInvalidated:Bool = false) { + #if debug trace('Invalidated ${modules.join(",")} (macro invalidated: ${macroInvalidated ? "true" : "false"})'); #end + #if debug var assertHasPrint = _assertHasPrint; #end + + for (m in modules) { + assertHasPrint('Building $m.'); + + var t = 'Foo__${m}__${m}'; + if (!macroInvalidated) assertHasPrint('[$m] Previously generated type for $t has been discarded.'); + assertHasPrint('[$m] Generating type for $t.'); + + if (m == "Baz") { + assertHasPrint('[$m] Reusing previously generated type for Foo__Bar__Bar.'); + } + } + } + + @:variant("JsDefineModule", true, "js") + @:variant("JsDefineType", false, "js") + @:variant("InterpDefineModule", true, "interp") + @:variant("InterpDefineType", false, "interp") + function test(defineModule:Bool, target:String) { + var targetArgs = switch target { + case "js": ["-js", "out.js", "-lib", "hxnodejs", "-cmd", "node out.js"]; + case "interp": ["--interp"]; + case _: []; + } + + var args = ["-main", "Main", "Baz"]; + if (defineModule) args = args.concat(["-D", "config.defineModule"]); + args = args.concat(targetArgs); + + runHaxe(args); + if (target == "js") originalContent = sys.io.File.getContent(haxe.io.Path.join([testDir, "out.js"])); + assertBuilt(["Main", "Bar", "Baz"], true); + assertResult(target); + + #if debug trace("Rerun without invalidate"); #end + runHaxe(args); + assertResult(target); + + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Baz.hx")}); + runHaxe(args); + assertBuilt(["Baz"]); + assertResult(target); + + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Main.hx")}); + runHaxe(args); + assertBuilt(["Main"]); + assertResult(target); + + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Bar.hx")}); + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Main.hx")}); + runHaxe(args); + assertBuilt(["Main", "Bar"]); + assertResult(target); + + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Bar.hx")}); + runHaxe(args); + assertBuilt(["Main", "Bar", "Baz"]); + assertResult(target); + + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Foo.hx")}); + runHaxe(args); + assertBuilt(["Main", "Bar", "Baz"]); + assertResult(target); + + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Macro.macro.hx")}); + runHaxe(args); + assertBuilt(["Main", "Bar", "Baz"], true); + assertResult(target); + } +} diff --git a/tests/server/src/utils/macro/TestBuilder.macro.hx b/tests/server/src/utils/macro/TestBuilder.macro.hx index 1cfab11dea2..d28724d2179 100644 --- a/tests/server/src/utils/macro/TestBuilder.macro.hx +++ b/tests/server/src/utils/macro/TestBuilder.macro.hx @@ -2,11 +2,15 @@ package utils.macro; import haxe.macro.Expr; import haxe.macro.Context; +import haxe.macro.Type; using StringTools; class TestBuilder { static public function build(fields:Array):Array { + var removedFields = []; + var newFields = []; + for (field in fields) { if (!field.name.startsWith("test")) { continue; @@ -16,40 +20,105 @@ class TestBuilder { // Async is already manually handled, nothing to do case FFun(f): - var asyncName = switch f.args { - case []: - var name = "async"; - f.args.push({ - name: name, - type: macro:utest.Async - }); - name; - case [arg]: - if (arg.name == "_") { - arg.name = "async"; - arg.type = macro:utest.Async; + var variants = field.meta.filter(m -> m.name == ":variant"); + if (variants.length == 0) { + makeAsyncTest(f, field.pos); + } else { + // TODO: support functions that define their own async arg (not named `_` or `async`) + var args = f.args.copy(); + f.args = []; + makeAsyncTest(f, field.pos); + + // Ignore original field; generate variants instead + removedFields.push(field); + + for (variant in variants) { + if (variant.params.length == 0) { + Context.error('Unexpected amount of variant parameters.', variant.pos); } - arg.name; - case _: - Context.fatalError('Unexpected amount of test arguments', field.pos); - ""; - } - switch (f.expr.expr) { - case EBlock(el): - var posInfos = Context.getPosInfos(f.expr.pos); - var pos = Context.makePosition({min: posInfos.max, max: posInfos.max, file: posInfos.file}); - el.push(macro @:pos(pos) $i{asyncName}.done()); - f.expr = macro { - $i{asyncName}.setTimeout(20000); - ${transformHaxeCalls(asyncName, el)}; + + var nameParam = variant.params.shift(); + var name:String = try haxe.macro.ExprTools.getValue(nameParam) catch(e) { + Context.error('Variant first parameter should be a String (variant name)', nameParam.pos); + }; + + var inits = [for (arg in args) { + var name = arg.name; + var ct = arg.type; + + if (variant.params.length == 0) { + Context.error('Unexpected amount of variant parameters.', variant.pos); + } + + var param = variant.params.shift(); + macro @:pos(param.pos) var $name:$ct = (($name:$ct) -> $i{name})(${param}); + }]; + + if (variant.params.length > 0) { + Context.error('Unexpected amount of variant parameters.', variant.params[0].pos); } - case _: - Context.error("Block expression expected", f.expr.pos); + + switch (f.expr.expr) { + case EBlock(b): + var ff = { + ret: f.ret, + params: f.params, + expr: {pos: variant.pos, expr: EBlock(inits.concat(b))}, + args: [{name: "async", type: macro:utest.Async}] + }; + + newFields.push({ + pos: variant.pos, + name: field.name + name, + meta: field.meta.filter(m -> m.name != ":variant"), + kind: FFun(ff), + doc: field.doc, + access : field.access + }); + + case _: + } + } } case _: } } - return fields; + + for (f in removedFields) fields.remove(f); + return fields.concat(newFields); + } + + static function makeAsyncTest(f:Function, fpos:Position) { + var asyncName = switch f.args { + case []: + var name = "async"; + f.args.push({ + name: name, + type: macro:utest.Async + }); + name; + case [arg]: + if (arg.name == "_") { + arg.name = "async"; + arg.type = macro:utest.Async; + } + arg.name; + case _: + Context.fatalError('Unexpected amount of test arguments', fpos); + ""; + } + switch (f.expr.expr) { + case EBlock(el): + var posInfos = Context.getPosInfos(f.expr.pos); + var pos = Context.makePosition({min: posInfos.max, max: posInfos.max, file: posInfos.file}); + el.push(macro @:pos(pos) $i{asyncName}.done()); + f.expr = macro { + $i{asyncName}.setTimeout(20000); + ${transformHaxeCalls(asyncName, el)}; + } + case _: + Context.error("Block expression expected", f.expr.pos); + } } static function transformHaxeCalls(asyncName:String, el:Array) { diff --git a/tests/server/test/templates/csSafeTypeBuilding/Bar.hx b/tests/server/test/templates/csSafeTypeBuilding/Bar.hx new file mode 100644 index 00000000000..19434fb20b5 --- /dev/null +++ b/tests/server/test/templates/csSafeTypeBuilding/Bar.hx @@ -0,0 +1,6 @@ +#if !macro @:build(Macro.logBuild()) #end +class Bar { + static function __init__() Sys.println("[runtime] Hello from Bar"); +} + +typedef B = Foo; diff --git a/tests/server/test/templates/csSafeTypeBuilding/Baz.hx b/tests/server/test/templates/csSafeTypeBuilding/Baz.hx new file mode 100644 index 00000000000..574b0c41fa7 --- /dev/null +++ b/tests/server/test/templates/csSafeTypeBuilding/Baz.hx @@ -0,0 +1,7 @@ +#if !macro @:build(Macro.logBuild()) #end +class Baz { + static function __init__() Sys.println("[runtime] Hello from Baz"); +} + +typedef AA = Foo; +typedef BB = Foo; diff --git a/tests/server/test/templates/csSafeTypeBuilding/Foo.hx b/tests/server/test/templates/csSafeTypeBuilding/Foo.hx new file mode 100644 index 00000000000..64cac29e64b --- /dev/null +++ b/tests/server/test/templates/csSafeTypeBuilding/Foo.hx @@ -0,0 +1,2 @@ +#if !macro @:genericBuild(Macro.buildFoo()) #end +class Foo {} diff --git a/tests/server/test/templates/csSafeTypeBuilding/Macro.macro.hx b/tests/server/test/templates/csSafeTypeBuilding/Macro.macro.hx new file mode 100644 index 00000000000..b8a607ab6e1 --- /dev/null +++ b/tests/server/test/templates/csSafeTypeBuilding/Macro.macro.hx @@ -0,0 +1,63 @@ +import haxe.macro.Context; +import haxe.macro.Expr; +import haxe.macro.Type; +import haxe.macro.TypeTools; + +class Macro { + public static function logBuild() { + Sys.println('Building ${Context.getLocalClass().toString()}.'); + return null; + } + + @:persistent static var generated = new Map(); + + static function isAlive(ct:ComplexType, pos:Position):Bool { + // Null check is just there to make it a one liner + // Basically returning true if no exception is caught + return try Context.resolveType(ct, pos) != null catch(e) false; + } + + public static function buildFoo() { + var from = '[${Context.getLocalModule()}] '; + var print = s -> Sys.println(from + s); + + switch (Context.getLocalType()) { + case TInst(_, [target]): + var pos = Context.currentPos(); + var bt = TypeTools.toBaseType(target); + var key = ["Foo", bt.module, bt.name].join("__"); + var ct = TPath({pack: [], name: key}); + + if (generated.exists(key)) { + if (isAlive(ct, pos)) { + print('Reusing previously generated type for $key.'); + return ct; + } + + print('Previously generated type for $key has been discarded.'); + } + + var genDef = macro class $key { + static function __init__() Sys.println("[runtime] Hello from " + $v{key}); + }; + + // Not really needed but nicer + // genDef.pos = pos; + + // Not needed unless dce full + // genDef.meta.push({name: ":keep", params: [], pos: pos}); + + print('Generating type for $key.'); + #if config.defineModule + Context.defineModule(key, [genDef]); + #else + Context.defineType(genDef, bt.module); + #end + + generated.set(key, true); + return ct; + + case _: throw ""; + } + } +} diff --git a/tests/server/test/templates/csSafeTypeBuilding/Main.hx b/tests/server/test/templates/csSafeTypeBuilding/Main.hx new file mode 100644 index 00000000000..108036891c1 --- /dev/null +++ b/tests/server/test/templates/csSafeTypeBuilding/Main.hx @@ -0,0 +1,9 @@ +// Create a dependency to Bar +import Bar; + +typedef A = Foo
; + +#if !macro @:build(Macro.logBuild()) #end +class Main { + static function main() Sys.println("[runtime] Hello from Main"); +} From 8ce18536e763d070c71052fc40f3db5c161d4317 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 3 Jan 2024 14:51:58 +0100 Subject: [PATCH 038/125] [typer] make sure initialization actually picks up String and not any of its deadbeat inline children --- src/typing/typerEntry.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/typing/typerEntry.ml b/src/typing/typerEntry.ml index 6c90f4fb0a9..94f2c315287 100644 --- a/src/typing/typerEntry.ml +++ b/src/typing/typerEntry.ml @@ -127,7 +127,7 @@ let create com macros = ) ctx.g.std_types.m_types; let m = TypeloadModule.load_module ctx ([],"String") null_pos in List.iter (fun mt -> match mt with - | TClassDecl c -> + | TClassDecl ({cl_path = ([],"String")} as c) -> let t = (TInst (c,[])) in Type.unify t ctx.t.tstring; ctx.t.tstring <- t @@ -135,7 +135,7 @@ let create com macros = ) m.m_types; let m = TypeloadModule.load_module ctx ([],"Std") null_pos in List.iter (fun mt -> match mt with - | TClassDecl c -> ctx.g.std <- c; + | TClassDecl ({cl_path = ([],"Std")} as c) -> ctx.g.std <- c; | _ -> () ) m.m_types; let m = TypeloadModule.load_module ctx ([],"Array") null_pos in From e7800f66ed6f4dd904a75879c9de422cccf58883 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 4 Jan 2024 06:06:47 +0100 Subject: [PATCH 039/125] [compiler refactor native lib argument handling slightly --- src/compiler/args.ml | 15 +++++++++------ src/compiler/compilationContext.ml | 18 +++++++++++++++++- src/compiler/compiler.ml | 2 +- src/context/nativeLibraryHandler.ml | 14 ++++++++------ src/macro/macroApi.ml | 10 +++++++++- 5 files changed, 44 insertions(+), 15 deletions(-) diff --git a/src/compiler/args.ml b/src/compiler/args.ml index 48f010f4c04..b275f262f84 100644 --- a/src/compiler/args.ml +++ b/src/compiler/args.ml @@ -66,7 +66,10 @@ let parse_args com = let add_deprecation s = actx.deprecations <- s :: actx.deprecations in - let add_native_lib file extern = actx.native_libs <- (file,extern) :: actx.native_libs in + let add_native_lib file extern kind = + let lib = create_native_lib file extern kind in + actx.native_libs <- lib :: actx.native_libs + in let basic_args_spec = [ ("Target",["--js"],["-js"],Arg.String (set_platform com Js),"","generate JavaScript code into target file"); ("Target",["--lua"],["-lua"],Arg.String (set_platform com Lua),"","generate Lua code into target file"); @@ -206,22 +209,22 @@ let parse_args com = Common.define com Define.FlashStrict ), "","more type strict flash API"); ("Target-specific",["--swf-lib"],["-swf-lib"],Arg.String (fun file -> - add_native_lib file false; + add_native_lib file false SwfLib; ),"","add the SWF library to the compiled SWF"); ("Target-specific",[],["--neko-lib-path"],Arg.String (fun dir -> com.neko_lib_paths <- dir :: com.neko_lib_paths ),"","add the neko library path"); ("Target-specific",["--swf-lib-extern"],["-swf-lib-extern"],Arg.String (fun file -> - add_native_lib file true; + add_native_lib file true SwfLib; ),"","use the SWF library for type checking"); ("Target-specific",["--java-lib"],["-java-lib"],Arg.String (fun file -> - add_native_lib file false; + add_native_lib file false JavaLib; ),"","add an external JAR or directory of JAR files"); ("Target-specific",["--java-lib-extern"],[],Arg.String (fun file -> - add_native_lib file true; + add_native_lib file true JavaLib; ),"","use an external JAR or directory of JAR files for type checking"); ("Target-specific",["--net-lib"],["-net-lib"],Arg.String (fun file -> - add_native_lib file false; + add_native_lib file false NetLib; ),"[@std]","add an external .NET DLL file"); ("Target-specific",["--net-std"],["-net-std"],Arg.String (fun file -> Dotnet.add_net_std com file diff --git a/src/compiler/compilationContext.ml b/src/compiler/compilationContext.ml index 0e18bce18d1..53f99885e1a 100644 --- a/src/compiler/compilationContext.ml +++ b/src/compiler/compilationContext.ml @@ -7,6 +7,17 @@ type server_mode = | SMListen of string | SMConnect of string +type native_lib_kind = + | NetLib + | JavaLib + | SwfLib + +type native_lib_arg = { + lib_file : string; + lib_kind : native_lib_kind; + lib_extern : bool; +} + type arg_context = { mutable classes : Globals.path list; mutable xml_out : string option; @@ -20,7 +31,7 @@ type arg_context = { mutable interp : bool; mutable jvm_flag : bool; mutable swf_version : bool; - mutable native_libs : (string * bool) list; + mutable native_libs : native_lib_arg list; mutable raise_usage : unit -> unit; mutable display_arg : string option; mutable deprecations : string list; @@ -73,3 +84,8 @@ let error_ext ctx (err : Error.error) = error ~depth ~from_macro:err.err_from_macro ctx (Error.error_msg err.err_message) err.err_pos ) err +let create_native_lib file extern kind = { + lib_file = file; + lib_extern = extern; + lib_kind = kind; +} \ No newline at end of file diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml index 26860dfe498..9e9b61dc6f8 100644 --- a/src/compiler/compiler.ml +++ b/src/compiler/compiler.ml @@ -175,7 +175,7 @@ module Setup = struct Common.log com (Buffer.contents buffer); com.callbacks#run com.error_ext com.callbacks#get_before_typer_create; (* Native lib pass 1: Register *) - let fl = List.map (fun (file,extern) -> NativeLibraryHandler.add_native_lib com file extern) (List.rev native_libs) in + let fl = List.map (fun lib -> NativeLibraryHandler.add_native_lib com lib) (List.rev native_libs) in (* Native lib pass 2: Initialize *) List.iter (fun f -> f()) fl; TyperEntry.create com macros diff --git a/src/context/nativeLibraryHandler.ml b/src/context/nativeLibraryHandler.ml index db6837204cc..75e010635a5 100644 --- a/src/context/nativeLibraryHandler.ml +++ b/src/context/nativeLibraryHandler.ml @@ -19,11 +19,15 @@ open Globals open Common +open CompilationContext -let add_native_lib com file is_extern = match com.platform with - | Globals.Flash -> +let add_native_lib com lib = + let file = lib.lib_file in + let is_extern = lib.lib_extern in + match lib.lib_kind with + | SwfLib -> SwfLoader.add_swf_lib com file is_extern - | Globals.Java -> + | JavaLib -> let use_modern = Common.defined com Define.Jvm && not (Common.defined com Define.JarLegacyLoader) in let add file = let std = file = "lib/hxjava-std.jar" in @@ -36,7 +40,7 @@ let add_native_lib com file is_extern = match com.platform with ) (Sys.readdir file)) else add file - | Globals.Cs -> + | NetLib -> let file, is_std = match ExtString.String.nsplit file "@" with | [file] -> file,false @@ -45,5 +49,3 @@ let add_native_lib com file is_extern = match com.platform with | _ -> failwith ("unsupported file@`std` format: " ^ file) in Dotnet.add_net_lib com file is_std is_extern - | pf -> - failwith (Printf.sprintf "Target %s does not support native libraries (trying to load %s)" (platform_name pf) file); \ No newline at end of file diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index 4b49dc2150d..deb6553c1dd 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -2184,7 +2184,15 @@ let macro_api ccom get_api = "add_native_lib", vfun1 (fun file -> let file = decode_string file in let com = ccom() in - NativeLibraryHandler.add_native_lib com file false (); + let open CompilationContext in + let kind = match com.platform with + | Java -> JavaLib + | Cs -> NetLib + | Flash -> SwfLib + | _ -> failwith "Unsupported platform" + in + let lib = create_native_lib file false kind in + NativeLibraryHandler.add_native_lib com lib (); vnull ); "add_native_arg", vfun1 (fun arg -> From adef8b3ec30b5bf250d74cda43c9472ca1df0c4c Mon Sep 17 00:00:00 2001 From: Yuxiao Mao Date: Thu, 4 Jan 2024 12:52:28 +0100 Subject: [PATCH 040/125] [hl] Fix do-while loop in genhl+hlopt (#11461) * [hl] Fix do-while loop in genhl+hlopt * remove can_do --- src/generators/genhl.ml | 5 +---- src/generators/hlopt.ml | 13 ++++++++----- src/optimization/analyzerTexpr.ml | 5 ++--- 3 files changed, 11 insertions(+), 12 deletions(-) diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml index c378ab4bfbd..b57f56c127d 100644 --- a/src/generators/genhl.ml +++ b/src/generators/genhl.ml @@ -2698,13 +2698,10 @@ and eval_expr ctx e = ctx.m.mbreaks <- []; ctx.m.mcontinues <- []; ctx.m.mloop_trys <- ctx.m.mtrys; - let start = jump ctx (fun p -> OJAlways p) in let continue_pos = current_pos ctx in let ret = jump_back ctx in - let j = jump_expr ctx cond false in - start(); ignore(eval_expr ctx eloop); - set_curpos ctx (max_pos e); + let j = jump_expr ctx cond false in ret(); j(); List.iter (fun f -> f (current_pos ctx)) ctx.m.mbreaks; diff --git a/src/generators/hlopt.ml b/src/generators/hlopt.ml index 5081c31c9f5..79fb79203c0 100644 --- a/src/generators/hlopt.ml +++ b/src/generators/hlopt.ml @@ -947,8 +947,8 @@ let _optimize (f:fundecl) = (* loop : first pass does not recurse, second pass uses cache *) if b2.bloop && b2.bstart < b.bstart then (match b2.bneed_all with None -> acc | Some s -> ISet.union acc s) else ISet.union acc (live b2) - ) ISet.empty b.bnext in - let need_sub = ISet.filter (fun r -> + ) ISet.empty in + let need_sub bl = ISet.filter (fun r -> try let w = PMap.find r b.bwrite in set_live r (w + 1) b.bend; @@ -956,8 +956,8 @@ let _optimize (f:fundecl) = with Not_found -> set_live r b.bstart b.bend; true - ) need_sub in - let need = ISet.union b.bneed need_sub in + ) (need_sub bl) in + let need = ISet.union b.bneed (need_sub b.bnext) in b.bneed_all <- Some need; if b.bloop then begin (* @@ -974,8 +974,11 @@ let _optimize (f:fundecl) = in List.iter (fun b2 -> if b2.bstart > b.bstart then clear b2) b.bprev; List.iter (fun b -> ignore(live b)) b.bnext; + (* do-while loop : recompute self after recompute all next *) + let need = ISet.union b.bneed (need_sub b.bnext) in + b.bneed_all <- Some need; end; - need + Option.get b.bneed_all in ignore(live root); diff --git a/src/optimization/analyzerTexpr.ml b/src/optimization/analyzerTexpr.ml index 7631dfb7293..b5ac00f6c3a 100644 --- a/src/optimization/analyzerTexpr.ml +++ b/src/optimization/analyzerTexpr.ml @@ -1069,12 +1069,11 @@ module Cleanup = struct | TLocal v when IntMap.mem v.v_id !locals -> true | _ -> check_expr references_local e in - let can_do = match com.platform with Hl -> false | _ -> true in let rec loop2 el = match el with - | [{eexpr = TBreak}] when is_true_expr e1 && can_do && not has_continue -> + | [{eexpr = TBreak}] when is_true_expr e1 && not has_continue -> do_while := Some (Texpr.Builder.make_bool com.basic true e1.epos); [] - | [{eexpr = TIf(econd,{eexpr = TBlock[{eexpr = TBreak}]},None)}] when is_true_expr e1 && not (references_local econd) && can_do && not has_continue -> + | [{eexpr = TIf(econd,{eexpr = TBlock[{eexpr = TBreak}]},None)}] when is_true_expr e1 && not (references_local econd) && not has_continue -> do_while := Some econd; [] | {eexpr = TBreak | TContinue | TReturn _ | TThrow _} as e :: el -> From 584a42cb60370b6bf652061e7950603a7500e97e Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 4 Jan 2024 14:28:32 +0100 Subject: [PATCH 041/125] Only set cf_expr_unoptimized if we think we need it (#11462) * [typer] set cf_expr_unoptimized only if we think we need it closes #11460 * use server/invalidate like it's 2024 * actually just delete touchFile so I don't use it again * invalidate more because putContent doesn't do it... This is not a great testing experience I'm having but oh well... --- src-json/warning.json | 5 ++ src/filters/filters.ml | 16 ++++- src/typing/calls.ml | 28 ++++++--- tests/server/src/TestCase.hx | 4 ++ tests/server/src/cases/ServerTests.hx | 58 +++++++++++-------- tests/server/src/cases/issues/Issue11460.hx | 53 +++++++++++++++++ tests/server/src/cases/issues/Issue9358.hx | 2 +- tests/server/src/utils/Vfs.hx | 10 ---- .../test/templates/issues/Issue11460/C.hx | 5 ++ .../test/templates/issues/Issue11460/Main.hx | 3 + 10 files changed, 138 insertions(+), 46 deletions(-) create mode 100644 tests/server/src/cases/issues/Issue11460.hx create mode 100644 tests/server/test/templates/issues/Issue11460/C.hx create mode 100644 tests/server/test/templates/issues/Issue11460/Main.hx diff --git a/src-json/warning.json b/src-json/warning.json index 38a6474deee..54d544f3524 100644 --- a/src-json/warning.json +++ b/src-json/warning.json @@ -98,6 +98,11 @@ "doc": "A type path is being used that is supposed to be reserved on the current target", "parent": "WTyper" }, + { + "name": "WInlineOptimizedField", + "doc": "A cached field which was optimized might lead to different output when inlined", + "parent": "WTyper" + }, { "name": "WPatternMatcher", "doc": "Warnings related to the pattern matcher", diff --git a/src/filters/filters.ml b/src/filters/filters.ml index 0ee097c09ae..0006bd51ca2 100644 --- a/src/filters/filters.ml +++ b/src/filters/filters.ml @@ -708,6 +708,15 @@ let save_class_state com t = a.a_meta <- List.filter (fun (m,_,_) -> m <> Meta.ValueUsed) a.a_meta ) +let might_need_cf_unoptimized c cf = + match cf.cf_kind,c.cl_kind with + | Method MethInline,_ -> + true + | _,KGeneric -> + true + | _ -> + has_class_field_flag cf CfGeneric + let run tctx main before_destruction = let com = tctx.com in let detail_times = (try int_of_string (Common.defined_value_safe com ~default:"0" Define.FilterTimes) with _ -> 0) in @@ -723,8 +732,11 @@ let run tctx main before_destruction = (* Save cf_expr_unoptimized early: We want to inline with the original expression on the next compilation. *) if not cached then begin - let field cf = - cf.cf_expr_unoptimized <- cf.cf_expr + let field cf = match cf.cf_expr,cf.cf_expr_unoptimized with + | Some e,None when might_need_cf_unoptimized cls cf -> + cf.cf_expr_unoptimized <- Some e + | _ -> + () in List.iter field cls.cl_ordered_fields; List.iter field cls.cl_ordered_statics; diff --git a/src/typing/calls.ml b/src/typing/calls.ml index 91a2f2bbab7..2839847ec4a 100644 --- a/src/typing/calls.ml +++ b/src/typing/calls.ml @@ -67,17 +67,27 @@ let make_call ctx e params t ?(force_inline=false) p = ); let params = List.map (Optimizer.reduce_expression ctx) params in let force_inline = is_forced_inline cl f in - (match f.cf_expr_unoptimized,f.cf_expr with - | Some {eexpr = TFunction fd},_ - | None,Some { eexpr = TFunction fd } -> + let inline fd = Inline.type_inline ctx f fd ethis params t config p force_inline + in + begin match f.cf_expr_unoptimized with + | Some {eexpr = TFunction fd} -> + inline fd | _ -> - (* - we can't inline because there is most likely a loop in the typing. - this can be caused by mutually recursive vars/functions, some of them - being inlined or not. In that case simply ignore inlining. - *) - raise Exit) + if has_class_field_flag f CfPostProcessed then + warning ctx WInlineOptimizedField (Printf.sprintf "Inlining of cached field %s might lead to unexpected output" f.cf_name) p; + match f.cf_expr with + | Some ({ eexpr = TFunction fd } as e) -> + f.cf_expr_unoptimized <- Some (e); + inline fd + | _ -> + (* + we can't inline because there is most likely a loop in the typing. + this can be caused by mutually recursive vars/functions, some of them + being inlined or not. In that case simply ignore inlining. + *) + raise Exit + end with Exit -> mk (TCall (e,params)) t p diff --git a/tests/server/src/TestCase.hx b/tests/server/src/TestCase.hx index b4954a08a83..621dd1702bf 100644 --- a/tests/server/src/TestCase.hx +++ b/tests/server/src/TestCase.hx @@ -213,6 +213,10 @@ class TestCase implements ITest { } } + function assertSilence() { + return Assert.isTrue(lastResult.stderr == ""); + } + function assertSuccess(?p:haxe.PosInfos) { return Assert.isTrue(0 == errorMessages.length, p); } diff --git a/tests/server/src/cases/ServerTests.hx b/tests/server/src/cases/ServerTests.hx index 8605bc44ff1..130861863c5 100644 --- a/tests/server/src/cases/ServerTests.hx +++ b/tests/server/src/cases/ServerTests.hx @@ -150,10 +150,9 @@ class ServerTests extends TestCase { vfs.putContent("Other.hx", getTemplate("issues/Issue9134/Other.hx")); var args = ["-main", "Main", "Other"]; - runHaxeJsonCb(args, DisplayMethods.Diagnostics, {fileContents: [ - {file: new FsPath("Other.hx")}, - {file: new FsPath("Main.hx")}, - ]}, res -> { + runHaxeJsonCb(args, DisplayMethods.Diagnostics, { + fileContents: [{file: new FsPath("Other.hx")}, {file: new FsPath("Main.hx")},] + }, res -> { Assert.equals(1, res.length); Assert.equals(1, res[0].diagnostics.length); var arg = res[0].diagnostics[0].args; @@ -164,10 +163,12 @@ class ServerTests extends TestCase { runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Main.hx")}); runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Other.hx")}); - runHaxeJsonCb(args, DisplayMethods.Diagnostics, {fileContents: [ - {file: new FsPath("Main.hx"), contents: getTemplate("issues/Issue9134/Main2.hx")}, - {file: new FsPath("Other.hx"), contents: getTemplate("issues/Issue9134/Other2.hx")} - ]}, res -> { + runHaxeJsonCb(args, DisplayMethods.Diagnostics, { + fileContents: [ + {file: new FsPath("Main.hx"), contents: getTemplate("issues/Issue9134/Main2.hx")}, + {file: new FsPath("Other.hx"), contents: getTemplate("issues/Issue9134/Other2.hx")} + ] + }, res -> { Assert.equals(1, res.length); Assert.equals(1, res[0].diagnostics.length); var arg = res[0].diagnostics[0].args; @@ -178,10 +179,12 @@ class ServerTests extends TestCase { runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Main.hx")}); runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Other.hx")}); - runHaxeJsonCb(args, DisplayMethods.Diagnostics, {fileContents: [ - {file: new FsPath("Main.hx"), contents: getTemplate("issues/Issue9134/Main.hx")}, - {file: new FsPath("Other.hx"), contents: getTemplate("issues/Issue9134/Other2.hx")} - ]}, res -> { + runHaxeJsonCb(args, DisplayMethods.Diagnostics, { + fileContents: [ + {file: new FsPath("Main.hx"), contents: getTemplate("issues/Issue9134/Main.hx")}, + {file: new FsPath("Other.hx"), contents: getTemplate("issues/Issue9134/Other2.hx")} + ] + }, res -> { Assert.equals(2, res.length); for (i in 0...2) { @@ -206,9 +209,12 @@ class ServerTests extends TestCase { for (result in res) { var file = result.file.toString(); - if (StringTools.endsWith(file, "Main.hx")) hasMain = true; - else if (StringTools.endsWith(file, "Other.hx")) hasOther = true; - else continue; + if (StringTools.endsWith(file, "Main.hx")) + hasMain = true; + else if (StringTools.endsWith(file, "Other.hx")) + hasOther = true; + else + continue; var arg = result.diagnostics[0].args; Assert.equals("Unused variable", (cast arg).description); @@ -427,7 +433,7 @@ class ServerTests extends TestCase { vfs.putContent("haxe/ds/Vector.hx", getTemplate("issues/Issue10986/Vector.hx")); var args = ["-main", "Main", "--jvm", "Main.jar"]; runHaxe(args); - vfs.touchFile("haxe/ds/Vector.hx"); + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("haxe/ds/Vector.hx")}); runHaxe(args); assertSuccess(); } @@ -459,16 +465,18 @@ class ServerTests extends TestCase { var transform = Marker.extractMarkers(getTemplate("issues/Issue8368/MyMacro2.macro.hx")); var args = ["-main", "Main", "--macro", "define('whatever')"]; - vfs.putContent( - "MyMacro.macro.hx", - transform.source.substr(0, transform.markers[1]) - + transform.source.substr(transform.markers[2], transform.source.length) - ); + vfs.putContent("MyMacro.macro.hx", + transform.source.substr(0, transform.markers[1]) + transform.source.substr(transform.markers[2], transform.source.length)); runHaxe(args); runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("MyMacro.macro.hx")}); - var completionRequest = {file: new FsPath("MyMacro.macro.hx"), contents: transform.source, offset: transform.markers[2], wasAutoTriggered: false}; + var completionRequest = { + file: new FsPath("MyMacro.macro.hx"), + contents: transform.source, + offset: transform.markers[2], + wasAutoTriggered: false + }; runHaxeJson(args, DisplayMethods.Completion, completionRequest); Assert.isTrue(parseCompletion().result.items.length == 23); runHaxeJson(args, DisplayMethods.Completion, completionRequest); @@ -488,8 +496,10 @@ class ServerTests extends TestCase { function runLoop() { runHaxeJson(args, DisplayMethods.Diagnostics, {file: new FsPath("Empty.hx")}, () -> { runHaxe(args.concat(["-D", "compile-only-define"]), () -> { - if (assertSuccess() && ++runs < 20) runLoop(); - else async.done(); + if (assertSuccess() && ++runs < 20) + runLoop(); + else + async.done(); }); }); } diff --git a/tests/server/src/cases/issues/Issue11460.hx b/tests/server/src/cases/issues/Issue11460.hx new file mode 100644 index 00000000000..71cdbc51f9d --- /dev/null +++ b/tests/server/src/cases/issues/Issue11460.hx @@ -0,0 +1,53 @@ +package cases.issues; + +using StringTools; + +class Issue11460 extends TestCase { + function testClass(_) { + var mainContentWithInline = getTemplate("issues/Issue11460/Main.hx"); + var mainContentWithoutInline = mainContentWithInline.replace("inline", ""); + vfs.putContent("Main.hx", mainContentWithInline); + vfs.putContent("C.hx", getTemplate("issues/Issue11460/C.hx")); + var args = ["Main", "--interp"]; + + // initial cache + runHaxe(args); + assertSilence(); + + // touching Main doesn't do anything + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Main.hx")}); + runHaxe(args); + assertSilence(); + + // touching both doesn't do anything + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Main.hx")}); + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("C.hx")}); + runHaxe(args); + assertSilence(); + + // removing the inline is fine + vfs.putContent("Main.hx", mainContentWithoutInline); + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Main.hx")}); + runHaxe(args); + assertSilence(); + + // adding it back is fine too because C is still cached + vfs.putContent("Main.hx", mainContentWithInline); + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Main.hx")}); + runHaxe(args); + assertSilence(); + + // removing the inline and changing C is still fine + vfs.putContent("Main.hx", mainContentWithoutInline); + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Main.hx")}); + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("C.hx")}); + runHaxe(args); + assertSilence(); + + // but adding it now gives us the warning + vfs.putContent("Main.hx", mainContentWithInline); + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Main.hx")}); + runHaxe(args); + utest.Assert.match(~/WInlineOptimizedField/, lastResult.stderr); + } +} diff --git a/tests/server/src/cases/issues/Issue9358.hx b/tests/server/src/cases/issues/Issue9358.hx index 0cef1b5cd83..8e096a446ca 100644 --- a/tests/server/src/cases/issues/Issue9358.hx +++ b/tests/server/src/cases/issues/Issue9358.hx @@ -6,7 +6,7 @@ class Issue9358 extends TestCase { vfs.putContent("StateHandler.hx", getTemplate("issues/Issue9358/StateHandler.hx")); var args = ["-cp", "src", "-m", "Main", "-hl", "hl.hl"]; runHaxe(args); - vfs.touchFile("Main.hx"); + runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); runHaxe(args); assertSuccess(); } diff --git a/tests/server/src/utils/Vfs.hx b/tests/server/src/utils/Vfs.hx index 3aefc5ecae7..b73678aa4cc 100644 --- a/tests/server/src/utils/Vfs.hx +++ b/tests/server/src/utils/Vfs.hx @@ -17,16 +17,6 @@ class Vfs { FileSystem.createDirectory(physicalPath); } - public function touchFile(path:String) { - var path = getPhysicalPath(path); - FileSystem.createDirectory(path.dir); - var file = Fs.openSync(path.dir + "/" + path.file + "." + path.ext, 'a'); - var last = Fs.fstatSync(file).mtime; - var notNow = last.delta(1000); - Fs.futimesSync(file, notNow, notNow); - Fs.closeSync(file); - } - public function overwriteContent(path:String, content:String) { var path = getPhysicalPath(path).toString(); if (!FileSystem.exists(path)) { diff --git a/tests/server/test/templates/issues/Issue11460/C.hx b/tests/server/test/templates/issues/Issue11460/C.hx new file mode 100644 index 00000000000..0c336cfec11 --- /dev/null +++ b/tests/server/test/templates/issues/Issue11460/C.hx @@ -0,0 +1,5 @@ +class C { + static public function doSomething() { + trace("Ok I did something"); + } +} diff --git a/tests/server/test/templates/issues/Issue11460/Main.hx b/tests/server/test/templates/issues/Issue11460/Main.hx new file mode 100644 index 00000000000..84ba0c6639b --- /dev/null +++ b/tests/server/test/templates/issues/Issue11460/Main.hx @@ -0,0 +1,3 @@ +function main() { + inline C.doSomething(); +} From 29085f86c837d94d89a85d95d952d7a9c6fbc2ca Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sun, 7 Jan 2024 10:30:41 +0100 Subject: [PATCH 042/125] [opam] bump camlp5 version to 8.00.03 because that works with OCaml 4.14 --- haxe.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haxe.opam b/haxe.opam index e93455e01f1..6b8d4f8d8f1 100644 --- a/haxe.opam +++ b/haxe.opam @@ -20,7 +20,7 @@ install: [make "install" "INSTALL_DIR=%{prefix}%"] remove: [make "uninstall" "INSTALL_DIR=%{prefix}%"] depends: [ ("ocaml" {>= "5.0"} & ("camlp5" {build})) - | ("ocaml" {>= "4.08" & < "5.0"} & ("camlp5" {build & = "8.00"})) + | ("ocaml" {>= "4.08" & < "5.0"} & ("camlp5" {build & = "8.00.03"})) "ocamlfind" {build} "dune" {>= "1.11"} "sedlex" {>= "2.0"} From 938aaa95f0854b259180d97e414c4197c656ab7c Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sun, 7 Jan 2024 21:17:05 +0100 Subject: [PATCH 043/125] [filters] recurse into expressions of local statics closes #11469 --- src/filters/localStatic.ml | 51 +++++++++++++++++------- tests/unit/src/unit/issues/Issue11469.hx | 9 +++++ 2 files changed, 46 insertions(+), 14 deletions(-) create mode 100644 tests/unit/src/unit/issues/Issue11469.hx diff --git a/src/filters/localStatic.ml b/src/filters/localStatic.ml index 50b5d759c8d..b6d9c1d7d5f 100644 --- a/src/filters/localStatic.ml +++ b/src/filters/localStatic.ml @@ -3,11 +3,18 @@ open Type open Typecore open Error -let promote_local_static ctx lut v eo = - let name = Printf.sprintf "%s_%s" ctx.curfield.cf_name v.v_name in +type lscontext = { + ctx : typer; + lut : (int,tclass_field) Hashtbl.t; + mutable added_fields : tclass_field list; +} + +let promote_local_static lsctx run v eo = + let name = Printf.sprintf "%s_%s" lsctx.ctx.curfield.cf_name v.v_name in + let c = lsctx.ctx.curclass in begin try - let cf = PMap.find name ctx.curclass.cl_statics in - display_error ctx.com (Printf.sprintf "The expanded name of this local (%s) conflicts with another static field" name) v.v_pos; + let cf = PMap.find name c.cl_statics in + display_error lsctx.ctx.com (Printf.sprintf "The expanded name of this local (%s) conflicts with another static field" name) v.v_pos; raise_typing_error ~depth:1 "Conflicting field was found here" cf.cf_name_pos; with Not_found -> let cf = mk_field name ~static:true v.v_type v.v_pos v.v_pos in @@ -16,34 +23,45 @@ let promote_local_static ctx lut v eo = | None -> () | Some e -> + let no_local_in_static p = + raise_typing_error "Accessing local variables in static initialization is not allowed" p + in let rec loop e = match e.eexpr with - | TLocal _ | TFunction _ -> - raise_typing_error "Accessing local variables in static initialization is not allowed" e.epos + | TLocal v when has_var_flag v VStatic -> + run e + | TFunction _ | TLocal _ -> + no_local_in_static e.epos | TConst (TThis | TSuper) -> raise_typing_error "Accessing `this` in static initialization is not allowed" e.epos | TReturn _ | TBreak | TContinue -> raise_typing_error "This kind of control flow in static initialization is not allowed" e.epos | _ -> - iter loop e + map_expr loop e in - loop e; + let e = loop e in cf.cf_expr <- Some e end; - TClass.add_field ctx.curclass cf; - Hashtbl.add lut v.v_id cf + lsctx.added_fields <- cf :: lsctx.added_fields; + (* Add to lookup early so that the duplication check works. *) + c.cl_statics <- PMap.add cf.cf_name cf c.cl_statics; + Hashtbl.add lsctx.lut v.v_id cf end let find_local_static lut v = Hashtbl.find lut v.v_id let run ctx e = - let local_static_lut = Hashtbl.create 0 in + let lsctx = { + ctx = ctx; + lut = Hashtbl.create 0; + added_fields = []; + } in let c = ctx.curclass in let rec run e = match e.eexpr with | TBlock el -> let el = ExtList.List.filter_map (fun e -> match e.eexpr with | TVar(v,eo) when has_var_flag v VStatic -> - promote_local_static ctx local_static_lut v eo; + promote_local_static lsctx run v eo; None | _ -> Some (run e) @@ -51,7 +69,7 @@ let run ctx e = { e with eexpr = TBlock el } | TLocal v when has_var_flag v VStatic -> begin try - let cf = find_local_static local_static_lut v in + let cf = find_local_static lsctx.lut v in Texpr.Builder.make_static_field c cf e.epos with Not_found -> raise_typing_error (Printf.sprintf "Could not find local static %s (id %i)" v.v_name v.v_id) e.epos @@ -59,4 +77,9 @@ let run ctx e = | _ -> Type.map_expr run e in - run e + let e = run e in + (* Add to ordered list in reverse order *) + List.iter (fun cf -> + c.cl_ordered_statics <- cf :: c.cl_ordered_statics + ) lsctx.added_fields; + e diff --git a/tests/unit/src/unit/issues/Issue11469.hx b/tests/unit/src/unit/issues/Issue11469.hx new file mode 100644 index 00000000000..783bb17e352 --- /dev/null +++ b/tests/unit/src/unit/issues/Issue11469.hx @@ -0,0 +1,9 @@ +package unit.issues; + +class Issue11469 extends Test { + function test() { + static var c = 10; + static var d = c + 1; + eq(11, d); + } +} From 7665333b6c2a2fbcabd60a51d0bef21263822e46 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Mon, 8 Jan 2024 07:19:59 +0100 Subject: [PATCH 044/125] [jvm] fix functional interfaces some more closes #11390 --- src/generators/jvm/jvmFunctions.ml | 30 ++++++---- tests/misc/java/projects/Issue11390/Main.hx | 32 +++++++++++ tests/misc/java/projects/Issue11390/Setup.hx | 6 ++ .../java/projects/Issue11390/compile.hxml | 12 ++++ .../projects/Issue11390/compile.hxml.stdout | 10 ++++ .../Issue11390/project/test/Robot.java | 42 ++++++++++++++ .../Issue11390/project/test/RobotFactory.java | 56 +++++++++++++++++++ 7 files changed, 176 insertions(+), 12 deletions(-) create mode 100644 tests/misc/java/projects/Issue11390/Main.hx create mode 100644 tests/misc/java/projects/Issue11390/Setup.hx create mode 100644 tests/misc/java/projects/Issue11390/compile.hxml create mode 100644 tests/misc/java/projects/Issue11390/compile.hxml.stdout create mode 100644 tests/misc/java/projects/Issue11390/project/test/Robot.java create mode 100644 tests/misc/java/projects/Issue11390/project/test/RobotFactory.java diff --git a/src/generators/jvm/jvmFunctions.ml b/src/generators/jvm/jvmFunctions.ml index dec41deb5ca..1d4058db9f3 100644 --- a/src/generators/jvm/jvmFunctions.ml +++ b/src/generators/jvm/jvmFunctions.ml @@ -317,6 +317,8 @@ module JavaFunctionalInterfaces = struct let unify jfi args ret = let params = ref [] in let rec unify jsig1 jsig2 = match jsig1,jsig2 with + | TObject _,TObject((["java";"lang"],"Object"),[]) -> + true | TObject(path1,params1),TObject(path2,params2) -> path1 = path2 && unify_params params1 params2 @@ -362,7 +364,7 @@ module JavaFunctionalInterfaces = struct | None,None -> loop jfi.jargs args | Some jsig1,Some jsig2 -> - if unify jsig1 jsig2 then loop jfi.jargs args + if unify jsig2 jsig1 then loop jfi.jargs args else None | _ -> None @@ -441,24 +443,28 @@ class typed_function Hashtbl.add implemented_interfaces path true; end in + let spawn_invoke_next name msig is_bridge = + let flags = [MPublic] in + let flags = if is_bridge then MBridge :: MSynthetic :: flags else flags in + jc_closure#spawn_method name msig flags + in let spawn_forward_function meth_from meth_to is_bridge = let msig = method_sig meth_from.dargs meth_from.dret in if not (jc_closure#has_method meth_from.name msig) then begin - let flags = [MPublic] in - let flags = if is_bridge then MBridge :: MSynthetic :: flags else flags in - let jm_invoke_next = jc_closure#spawn_method meth_from.name msig flags in + let jm_invoke_next = spawn_invoke_next meth_from.name msig is_bridge in functions#make_forward_method jc_closure jm_invoke_next meth_from meth_to; end in let check_functional_interfaces meth = - try - let l = JavaFunctionalInterfaces.find_compatible meth.dargs meth.dret functional_interface_filter in - List.iter (fun (jfi,params) -> - add_interface jfi.jpath params; - spawn_forward_function {meth with name=jfi.jname} meth false; - ) l - with Not_found -> - () + let l = JavaFunctionalInterfaces.find_compatible meth.dargs meth.dret functional_interface_filter in + List.iter (fun (jfi,params) -> + add_interface jfi.jpath params; + let msig = method_sig jfi.jargs jfi.jret in + if not (jc_closure#has_method jfi.jname msig) then begin + let jm_invoke_next = spawn_invoke_next jfi.jname msig false in + functions#make_forward_method_jsig jc_closure jm_invoke_next meth.name jfi.jargs jfi.jret meth.dargs meth.dret + end + ) l in let rec loop meth = check_functional_interfaces meth; diff --git a/tests/misc/java/projects/Issue11390/Main.hx b/tests/misc/java/projects/Issue11390/Main.hx new file mode 100644 index 00000000000..202125d1a96 --- /dev/null +++ b/tests/misc/java/projects/Issue11390/Main.hx @@ -0,0 +1,32 @@ +package; + +import test.Robot; +import test.RobotFactory; + +class Main { + public static function main() { + var robot1 = RobotFactory.buildMathRobot(); + var robot2 = RobotFactory.buildGreetRobot(robot1); + var robot3 = RobotFactory.buildManufactureRobot(); + + robot1.performTask(add); + robot1.performTask(function(a:Int, b:Int):Int { + return a - b; + }); + + robot2.performTask(function (target:Robot) { + trace('Hello, ${target.toString()}!'); + }, () -> { + trace('Cleanup...'); + }); + + robot3.performTask(function (robotType:String) { + trace('Manufacturing ${robotType}...'); + return robot2; + }); + } + + static function add(a:Int, b:Int):Int { + return a + b; + } +} \ No newline at end of file diff --git a/tests/misc/java/projects/Issue11390/Setup.hx b/tests/misc/java/projects/Issue11390/Setup.hx new file mode 100644 index 00000000000..9bcd3e92511 --- /dev/null +++ b/tests/misc/java/projects/Issue11390/Setup.hx @@ -0,0 +1,6 @@ +function main() { + Sys.setCwd("./project"); + Sys.command("javac", ["-d", "out", "test/Robot.java", "test/RobotFactory.java", "-g"]); + Sys.setCwd("./out"); + Sys.command("jar", ["cf", "test.jar", "test/Robot.class", "test/Robot$CleanupTask.class", "test/Robot$MathOperation.class", "test/Robot$GreetRobot.class", "test/Robot$ManufactureRobot.class", "test/RobotFactory.class", "test/RobotFactory$1.class", "test/RobotFactory$2.class", "test/RobotFactory$3.class"]); +} diff --git a/tests/misc/java/projects/Issue11390/compile.hxml b/tests/misc/java/projects/Issue11390/compile.hxml new file mode 100644 index 00000000000..d8c28c7e442 --- /dev/null +++ b/tests/misc/java/projects/Issue11390/compile.hxml @@ -0,0 +1,12 @@ +--main Setup +--interp + +--next + +--main Main +--java-lib project/out/test.jar +--jvm run.jar + +--next + +--cmd java -jar run.jar diff --git a/tests/misc/java/projects/Issue11390/compile.hxml.stdout b/tests/misc/java/projects/Issue11390/compile.hxml.stdout new file mode 100644 index 00000000000..195016e1fab --- /dev/null +++ b/tests/misc/java/projects/Issue11390/compile.hxml.stdout @@ -0,0 +1,10 @@ +Robot.performTask() called! +Result: 7 +Robot.performTask() called! +Result: -1 +Robot.performTask() called! +Main.hx:18: Hello, Robot! +Main.hx:20: Cleanup... +Robot.performTask() called! +Main.hx:24: Manufacturing Greet... +Output: Robot \ No newline at end of file diff --git a/tests/misc/java/projects/Issue11390/project/test/Robot.java b/tests/misc/java/projects/Issue11390/project/test/Robot.java new file mode 100644 index 00000000000..4e11f9f6fdf --- /dev/null +++ b/tests/misc/java/projects/Issue11390/project/test/Robot.java @@ -0,0 +1,42 @@ +package test; + +public abstract class Robot { + public Robot() {} + + public void performTask(T listener) { + System.out.println("Robot.performTask() called!"); + } + + public void performTask(T listener, CleanupTask cleanupTask) { + System.out.println("Robot.performTask() called!"); + cleanupTask.cleanup(); + } + + /** + * MathOperation + */ + @FunctionalInterface + public interface MathOperation { + public int operate(int a, int b); + } + + @FunctionalInterface + public interface GreetRobot { + public void greet(Robot robot); + } + + @FunctionalInterface + public interface ManufactureRobot { + public T manufacture(String robotType); + } + + @FunctionalInterface + public interface CleanupTask { + public void cleanup(); + } + + @Override + public String toString() { + return "Robot"; + } +} diff --git a/tests/misc/java/projects/Issue11390/project/test/RobotFactory.java b/tests/misc/java/projects/Issue11390/project/test/RobotFactory.java new file mode 100644 index 00000000000..d7b58d7dcb5 --- /dev/null +++ b/tests/misc/java/projects/Issue11390/project/test/RobotFactory.java @@ -0,0 +1,56 @@ +package test; + +import test.Robot.GreetRobot; +import test.Robot.ManufactureRobot; +import test.Robot.MathOperation; + +public class RobotFactory { + public static Robot buildMathRobot() { + return new Robot() { + public void performTask(MathOperation listener) { + System.out.println("Robot.performTask() called!"); + int result = listener.operate(3, 4); + System.out.println("Result: " + result); + } + + public void performTask(MathOperation listener, CleanupTask cleanupTask) { + System.out.println("Robot.performTask() called!"); + int result = listener.operate(3, 4); + System.out.println("Result: " + result); + cleanupTask.cleanup(); + } + }; + } + + public static Robot buildGreetRobot(Robot target) { + return new Robot() { + public void performTask(GreetRobot listener) { + System.out.println("Robot.performTask() called!"); + listener.greet(target); + } + + public void performTask(GreetRobot listener, CleanupTask cleanupTask) { + System.out.println("Robot.performTask() called!"); + listener.greet(target); + cleanupTask.cleanup(); + } + }; + } + + public static Robot>> buildManufactureRobot() { + return new Robot>>() { + public void performTask(ManufactureRobot> listener) { + System.out.println("Robot.performTask() called!"); + Robot output = listener.manufacture("Greet"); + System.out.println("Output: " + output.toString()); + } + + public void performTask(ManufactureRobot> listener, CleanupTask cleanupTask) { + System.out.println("Robot.performTask() called!"); + Robot output = listener.manufacture("Greet"); + System.out.println("Output: " + output.toString()); + cleanupTask.cleanup(); + } + }; + } +} From d0527173f6065bdf1b4b41b6b0c797bad964195b Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Mon, 8 Jan 2024 08:07:52 +0100 Subject: [PATCH 045/125] [tests] create out dir because some javacs don't --- tests/misc/java/projects/Issue11390/Setup.hx | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/misc/java/projects/Issue11390/Setup.hx b/tests/misc/java/projects/Issue11390/Setup.hx index 9bcd3e92511..ce8c28d143d 100644 --- a/tests/misc/java/projects/Issue11390/Setup.hx +++ b/tests/misc/java/projects/Issue11390/Setup.hx @@ -1,5 +1,8 @@ +import sys.FileSystem; + function main() { Sys.setCwd("./project"); + FileSystem.createDirectory("./out"); Sys.command("javac", ["-d", "out", "test/Robot.java", "test/RobotFactory.java", "-g"]); Sys.setCwd("./out"); Sys.command("jar", ["cf", "test.jar", "test/Robot.class", "test/Robot$CleanupTask.class", "test/Robot$MathOperation.class", "test/Robot$GreetRobot.class", "test/Robot$ManufactureRobot.class", "test/RobotFactory.class", "test/RobotFactory$1.class", "test/RobotFactory$2.class", "test/RobotFactory$3.class"]); From 091b1a2e2d7555a2b818b3c03f028539a1835a75 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Mon, 8 Jan 2024 08:17:55 +0100 Subject: [PATCH 046/125] move some more things arounds to avoid nasty dependency chains --- src/codegen/codegen.ml | 12 +----------- src/codegen/overloads.ml | 10 +--------- src/context/typecore.ml | 8 ++++++++ src/core/stringHelper.ml | 11 ++++++++++- src/generators/gencs.ml | 2 +- src/generators/genjava.ml | 2 +- src/generators/genjvm.ml | 2 +- src/generators/genphp7.ml | 2 +- src/generators/genpy.ml | 2 +- src/typing/callUnification.ml | 2 +- src/typing/typeloadCheck.ml | 4 ++-- src/typing/typeloadFields.ml | 2 +- 12 files changed, 29 insertions(+), 30 deletions(-) diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index 393b5c88a31..9de5af5676e 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -65,15 +65,6 @@ let add_property_field com c = c.cl_statics <- PMap.add cf.cf_name cf c.cl_statics; c.cl_ordered_statics <- cf :: c.cl_ordered_statics -let escape_res_name name allowed = - ExtString.String.replace_chars (fun chr -> - if (chr >= 'a' && chr <= 'z') || (chr >= 'A' && chr <= 'Z') || (chr >= '0' && chr <= '9') || chr = '_' || chr = '.' then - Char.escaped chr - else if List.mem chr allowed then - Char.escaped chr - else - "-x" ^ (string_of_int (Char.code chr))) name - (* -------------------------------------------------------------------------- *) (* FIX OVERRIDES *) @@ -384,7 +375,7 @@ module Dump = struct | "pretty" -> dump_types com true | "record" -> dump_record com | "position" -> dump_position com - | _ -> dump_types com false + | _ -> dump_types com false let dump_dependencies ?(target_override=None) com = let target_name = match target_override with @@ -519,4 +510,3 @@ module ExtClass = struct let e_assign = mk (TBinop(OpAssign,ef1,e)) e.etype p in add_cl_init c e_assign end - \ No newline at end of file diff --git a/src/codegen/overloads.ml b/src/codegen/overloads.ml index 5d326efdbe9..b2096dfce58 100644 --- a/src/codegen/overloads.ml +++ b/src/codegen/overloads.ml @@ -13,7 +13,7 @@ let same_overload_args ?(get_vmtype) t1 t2 f1 f2 = | [],[] -> true | tp1 :: params1,tp2 :: params2 -> - let constraints_equal ttp1 ttp2 = + let constraints_equal ttp1 ttp2 = Ast.safe_for_all2 f_eq (get_constraints ttp2) (get_constraints ttp2) in tp1.ttp_name = tp2.ttp_name && constraints_equal tp1 tp2 && loop params1 params2 @@ -79,14 +79,6 @@ let collect_overloads map c i = loop map c; List.rev !acc -let get_overloads (com : Common.context) c i = - try - com.overload_cache#find (c.cl_path,i) - with Not_found -> - let l = collect_overloads (fun t -> t) c i in - com.overload_cache#add (c.cl_path,i) l; - l - (** Overload resolution **) module Resolution = struct diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 4560788cde2..53f6071c9ba 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -758,6 +758,14 @@ let create_deprecation_context ctx = { curmod = ctx.m.curmod; } +let get_overloads (com : Common.context) c i = + try + com.overload_cache#find (c.cl_path,i) + with Not_found -> + let l = Overloads.collect_overloads (fun t -> t) c i in + com.overload_cache#add (c.cl_path,i) l; + l + (* -------------- debug functions to activate when debugging typer passes ------------------------------- *) (* diff --git a/src/core/stringHelper.ml b/src/core/stringHelper.ml index 7890d599140..ab6c57df5cd 100644 --- a/src/core/stringHelper.ml +++ b/src/core/stringHelper.ml @@ -48,4 +48,13 @@ let s_escape ?(hex=true) s = | c when int_of_char c < 32 && hex -> Buffer.add_string b (Printf.sprintf "\\x%.2X" (int_of_char c)) | c -> Buffer.add_char b c done; - Buffer.contents b \ No newline at end of file + Buffer.contents b + +let escape_res_name name allowed = + ExtString.String.replace_chars (fun chr -> + if (chr >= 'a' && chr <= 'z') || (chr >= 'A' && chr <= 'Z') || (chr >= '0' && chr <= '9') || chr = '_' || chr = '.' then + Char.escaped chr + else if List.mem chr allowed then + Char.escaped chr + else + "-x" ^ (string_of_int (Char.code chr))) name \ No newline at end of file diff --git a/src/generators/gencs.ml b/src/generators/gencs.ml index 08002d807ef..77891fc7fe1 100644 --- a/src/generators/gencs.ml +++ b/src/generators/gencs.ml @@ -3420,7 +3420,7 @@ let generate con = gen.gcon.file ^ "/src/Resources" in Hashtbl.iter (fun name v -> - let name = Codegen.escape_res_name name ['/'] in + let name = StringHelper.escape_res_name name ['/'] in let full_path = src ^ "/" ^ name in Path.mkdir_from_path full_path; diff --git a/src/generators/genjava.ml b/src/generators/genjava.ml index 71e199d6cb8..806777b26e1 100644 --- a/src/generators/genjava.ml +++ b/src/generators/genjava.ml @@ -2652,7 +2652,7 @@ let generate con = let res = ref [] in Hashtbl.iter (fun name v -> res := { eexpr = TConst(TString name); etype = gen.gcon.basic.tstring; epos = null_pos } :: !res; - let name = Codegen.escape_res_name name ['/'] in + let name = StringHelper.escape_res_name name ['/'] in let full_path = gen.gcon.file ^ "/src/" ^ name in Path.mkdir_from_path full_path; diff --git a/src/generators/genjvm.ml b/src/generators/genjvm.ml index 6e6c7e358e6..657c594be02 100644 --- a/src/generators/genjvm.ml +++ b/src/generators/genjvm.ml @@ -3102,7 +3102,7 @@ let generate jvm_flag com = end ) com.native_libs.java_libs in Hashtbl.iter (fun name v -> - let filename = Codegen.escape_res_name name ['/';'-'] in + let filename = StringHelper.escape_res_name name ['/';'-'] in gctx.out#add_entry v filename; ) com.resources; let generate_real_types () = diff --git a/src/generators/genphp7.ml b/src/generators/genphp7.ml index 288a9168cd3..bd8fc426304 100644 --- a/src/generators/genphp7.ml +++ b/src/generators/genphp7.ml @@ -35,7 +35,7 @@ let write_resource dir name data = let rdir = dir ^ "/res" in if not (Sys.file_exists dir) then Unix.mkdir dir 0o755; if not (Sys.file_exists rdir) then Unix.mkdir rdir 0o755; - let name = Codegen.escape_res_name name [] in + let name = StringHelper.escape_res_name name [] in let ch = open_out_bin (rdir ^ "/" ^ name) in output_string ch data; close_out ch diff --git a/src/generators/genpy.ml b/src/generators/genpy.ml index 3e42aa58628..72abdd12e65 100644 --- a/src/generators/genpy.ml +++ b/src/generators/genpy.ml @@ -2269,7 +2269,7 @@ module Generator = struct end else "," in - let k_enc = Codegen.escape_res_name k [] in + let k_enc = StringHelper.escape_res_name k [] in print ctx "%s\"%s\": open('%%s.%%s'%%(_file,'%s'),'rb').read()" prefix (StringHelper.s_escape k) k_enc; let f = open_out_bin (ctx.com.file ^ "." ^ k_enc) in diff --git a/src/typing/callUnification.ml b/src/typing/callUnification.ml index 913beb90c2f..9beeb73bc08 100644 --- a/src/typing/callUnification.ml +++ b/src/typing/callUnification.ml @@ -228,7 +228,7 @@ let unify_field_call ctx fa el_typed el p inline = else List.map (fun (t,cf) -> cf - ) (Overloads.get_overloads ctx.com c cf.cf_name) + ) (get_overloads ctx.com c cf.cf_name) in cfl,Some c,false,TClass.get_map_function c tl,(fun t -> t) | FHAbstract(a,tl,c) -> diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index 14f3169c440..faaabe9ff12 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -243,7 +243,7 @@ let check_overriding ctx c f = let p = f.cf_name_pos in let i = f.cf_name in if has_class_field_flag f CfOverload then begin - let overloads = Overloads.get_overloads ctx.com csup i in + let overloads = get_overloads ctx.com csup i in List.iter (fun (t,f2) -> (* check if any super class fields are vars *) match f2.cf_kind with @@ -378,7 +378,7 @@ module Inheritance = struct let map2, t2, f2 = class_field_no_interf c f.cf_name in let t2, f2 = if f2.cf_overloads <> [] || has_class_field_flag f2 CfOverload then - let overloads = Overloads.get_overloads ctx.com c f.cf_name in + let overloads = get_overloads ctx.com c f.cf_name in is_overload := true; List.find (fun (t1,f1) -> Overloads.same_overload_args t t1 f f1) overloads else diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index 9651bd3618b..7d54adb071e 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -1475,7 +1475,7 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p = let cf = PMap.find m c.cl_statics in (cf.cf_type,cf) :: (List.map (fun cf -> cf.cf_type,cf) cf.cf_overloads) end else - Overloads.get_overloads ctx.com c m + get_overloads ctx.com c m in let cf = { (mk_field name ~public:(is_public (ctx,cctx) f.cff_access None) ret f.cff_pos (pos f.cff_name)) with From e6746636dfce03f793cfb00ad22091c1d31fe8f3 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Mon, 8 Jan 2024 08:39:36 +0100 Subject: [PATCH 047/125] move abort to Error no reason to depend on common.ml just for that --- src/codegen/gencommon/gencommon.ml | 2 +- src/context/common.ml | 4 +--- src/context/display/displayPath.ml | 4 ++-- src/core/error.ml | 2 ++ src/filters/ES6Ctors.ml | 2 +- src/generators/gencpp.ml | 1 + src/generators/gencs.ml | 6 +++--- src/generators/genhl.ml | 1 + src/generators/genjs.ml | 1 + src/generators/genneko.ml | 6 +++--- src/generators/genpy.ml | 1 + src/generators/genswf.ml | 1 + src/generators/genswf9.ml | 1 + src/generators/hlinterp.ml | 2 +- src/optimization/analyzerTypes.ml | 2 +- 15 files changed, 21 insertions(+), 15 deletions(-) diff --git a/src/codegen/gencommon/gencommon.ml b/src/codegen/gencommon/gencommon.ml index 5324ae9c0f6..c800e688c4b 100644 --- a/src/codegen/gencommon/gencommon.ml +++ b/src/codegen/gencommon/gencommon.ml @@ -819,7 +819,7 @@ let run_filters gen = reorder_modules gen; t(); - if !has_errors then abort "Compilation aborted with errors" null_pos + if !has_errors then Error.abort "Compilation aborted with errors" null_pos (* ******************************************* *) (* basic generation module that source code compilation implementations can use *) diff --git a/src/context/common.ml b/src/context/common.ml index 8f6f5bb4ac3..b972218db0a 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -1053,8 +1053,6 @@ let allow_package ctx s = with Not_found -> () -let abort ?(depth = 0) msg p = raise (Error.Fatal_error (Error.make_error ~depth (Custom msg) p)) - let platform ctx p = ctx.platform = p let platform_name_macro com = @@ -1208,7 +1206,7 @@ let to_utf8 str p = let ccount = ref 0 in UTF8.iter (fun c -> let c = UCharExt.code c in - if (c >= 0xD800 && c <= 0xDFFF) || c >= 0x110000 then abort "Invalid unicode char" p; + if (c >= 0xD800 && c <= 0xDFFF) || c >= 0x110000 then Error.abort "Invalid unicode char" p; incr ccount; if c > 0x10000 then incr ccount; ) u8; diff --git a/src/context/display/displayPath.ml b/src/context/display/displayPath.ml index 6ad580d420a..83f719fcea9 100644 --- a/src/context/display/displayPath.ml +++ b/src/context/display/displayPath.ml @@ -83,7 +83,7 @@ module TypePathHandler = struct let complete_type_path com p = let packs, modules = read_type_path com p in if packs = [] && modules = [] then - (abort ("No modules found in " ^ String.concat "." p) null_pos) + (Error.abort ("No modules found in " ^ String.concat "." p) null_pos) else let packs = List.map (fun n -> make_ci_package (p,n) []) packs in let modules = List.map (fun n -> make_ci_module (p,n)) modules in @@ -158,7 +158,7 @@ module TypePathHandler = struct in Some fields with _ -> - abort ("Could not load module " ^ (s_type_path (p,c))) null_pos + Error.abort ("Could not load module " ^ (s_type_path (p,c))) null_pos end let resolve_position_by_path ctx path p = diff --git a/src/core/error.ml b/src/core/error.ml index 872d9579e1d..c1b2232693c 100644 --- a/src/core/error.ml +++ b/src/core/error.ml @@ -51,6 +51,8 @@ let rec recurse_error ?(depth = 0) cb err = exception Fatal_error of error exception Error of error +let abort ?(depth = 0) msg p = raise (Fatal_error (make_error ~depth (Custom msg) p)) + let string_source t = match follow t with | TInst(c,tl) -> PMap.foldi (fun s _ acc -> s :: acc) (TClass.get_all_fields c tl) [] | TAnon a -> PMap.fold (fun cf acc -> cf.cf_name :: acc) a.a_fields [] diff --git a/src/filters/ES6Ctors.ml b/src/filters/ES6Ctors.ml index 9ba083d70fc..8dd2b526fcb 100644 --- a/src/filters/ES6Ctors.ml +++ b/src/filters/ES6Ctors.ml @@ -84,7 +84,7 @@ let rewrite_ctors com = let rec mark_needs_ctor_skipping cl = (* for non haxe-generated extern classes we can't generate any valid code, so just fail *) if (has_class_flag cl CExtern) && not (Meta.has Meta.HxGen cl.cl_meta) then begin - abort "Must call `super()` constructor before accessing `this` in classes derived from an extern class with constructor" p_this_access; + Error.abort "Must call `super()` constructor before accessing `this` in classes derived from an extern class with constructor" p_this_access; end; try Hashtbl.find needs_ctor_skipping cl.cl_path diff --git a/src/generators/gencpp.ml b/src/generators/gencpp.ml index 264bb28276b..4d034be9ad0 100644 --- a/src/generators/gencpp.ml +++ b/src/generators/gencpp.ml @@ -19,6 +19,7 @@ open Extlib_leftovers open Ast open Type +open Error open Common open Globals diff --git a/src/generators/gencs.ml b/src/generators/gencs.ml index 77891fc7fe1..e20b13400ba 100644 --- a/src/generators/gencs.ml +++ b/src/generators/gencs.ml @@ -1798,7 +1798,7 @@ let generate con = let code, code_pos = match code.eexpr with | TConst (TString s) -> s, code.epos - | _ -> abort "The `code` argument for cs.Syntax.code must be a string constant" code.epos + | _ -> Error.abort "The `code` argument for cs.Syntax.code must be a string constant" code.epos in begin let rec reveal_expr expr = @@ -1820,11 +1820,11 @@ let generate con = let code = match code.eexpr with | TConst (TString s) -> s - | _ -> abort "The `code` argument for cs.Syntax.plainCode must be a string constant" code.epos + | _ -> Error.abort "The `code` argument for cs.Syntax.plainCode must be a string constant" code.epos in write w (String.concat "\n" (ExtString.String.nsplit code "\r\n")) | _ -> - abort (Printf.sprintf "Unknown cs.Syntax method `%s` with %d arguments" meth (List.length args)) pos + Error.abort (Printf.sprintf "Unknown cs.Syntax method `%s` with %d arguments" meth (List.length args)) pos and do_call w e el = let params, el = extract_tparams [] el in let params = List.rev params in diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml index b57f56c127d..b00adbdf181 100644 --- a/src/generators/genhl.ml +++ b/src/generators/genhl.ml @@ -23,6 +23,7 @@ open Extlib_leftovers open Globals open Ast open Type +open Error open Common open Hlcode diff --git a/src/generators/genjs.ml b/src/generators/genjs.ml index ba525b198e4..53fe22012f3 100644 --- a/src/generators/genjs.ml +++ b/src/generators/genjs.ml @@ -20,6 +20,7 @@ open Extlib_leftovers open Globals open Ast open Type +open Error open Common open JsSourcemap diff --git a/src/generators/genneko.ml b/src/generators/genneko.ml index 85cf32bf27c..3830fc0ac3e 100644 --- a/src/generators/genneko.ml +++ b/src/generators/genneko.ml @@ -170,7 +170,7 @@ let gen_constant ctx pe c = if (h land 128 = 0) <> (h land 64 = 0) then raise Exit; int p (Int32.to_int i) with _ -> - if ctx.version < 2 then abort "This integer is too big to be compiled to a Neko 31-bit integer. Please use a Float instead" pe; + if ctx.version < 2 then Error.abort "This integer is too big to be compiled to a Neko 31-bit integer. Please use a Float instead" pe; (EConst (Int32 i),p)) | TFloat f -> (EConst (Float (Texpr.replace_separators f "")),p) | TString s -> call p (field p (ident p "String") "new") [gen_big_string ctx p s] @@ -237,7 +237,7 @@ and gen_expr ctx e = (match follow e.etype with | TFun (args,_) -> let n = List.length args in - if n > 5 then abort "Cannot create closure with more than 5 arguments" e.epos; + if n > 5 then Error.abort "Cannot create closure with more than 5 arguments" e.epos; let tmp = ident p "@tmp" in EBlock [ (EVars ["@tmp", Some (gen_expr ctx e2); "@fun", Some (field p tmp f.cf_name)] , p); @@ -798,7 +798,7 @@ let generate com = else loop (p + 1) in - abort msg (loop 0) + Error.abort msg (loop 0) end; let command cmd args = try com.run_command_args cmd args with _ -> -1 in let neko_file = (try Filename.chop_extension com.file with _ -> com.file) ^ ".neko" in diff --git a/src/generators/genpy.ml b/src/generators/genpy.ml index 72abdd12e65..d836c37695c 100644 --- a/src/generators/genpy.ml +++ b/src/generators/genpy.ml @@ -19,6 +19,7 @@ open Extlib_leftovers open Globals open Ast +open Error open Type open Common open Texpr.Builder diff --git a/src/generators/genswf.ml b/src/generators/genswf.ml index c37632448a6..c6b4f60765a 100644 --- a/src/generators/genswf.ml +++ b/src/generators/genswf.ml @@ -20,6 +20,7 @@ open Swf open As3hl open ExtString open Type +open Error open Common open Ast open Globals diff --git a/src/generators/genswf9.ml b/src/generators/genswf9.ml index d34ba33fc47..4ea67eddb7c 100644 --- a/src/generators/genswf9.ml +++ b/src/generators/genswf9.ml @@ -20,6 +20,7 @@ open Extlib_leftovers open Globals open Ast open Type +open Error open As3 open As3hl open Common diff --git a/src/generators/hlinterp.ml b/src/generators/hlinterp.ml index c60b06cf30c..8c32aced375 100644 --- a/src/generators/hlinterp.ml +++ b/src/generators/hlinterp.ml @@ -2209,7 +2209,7 @@ let check code macros = Globals.pmin = low; Globals.pmax = low + (dline lsr 20); } in - Common.abort msg pos + Error.abort msg pos end else failwith (Printf.sprintf "\n%s:%d: %s" file dline msg) in diff --git a/src/optimization/analyzerTypes.ml b/src/optimization/analyzerTypes.ml index 99ffb0cddcc..5a1fd0d6925 100644 --- a/src/optimization/analyzerTypes.ml +++ b/src/optimization/analyzerTypes.ml @@ -218,7 +218,7 @@ module BasicBlock = struct bb let in_scope bb bb' = match bb'.bb_scopes with - | [] -> abort (Printf.sprintf "Scope-less block (kind: %s)" (s_block_kind bb'.bb_kind)) bb'.bb_pos + | [] -> Error.abort (Printf.sprintf "Scope-less block (kind: %s)" (s_block_kind bb'.bb_kind)) bb'.bb_pos | scope :: _ -> List.mem scope bb.bb_scopes let terminator_map f term = match term with From 05631cdb2d4b513543f535b5881bd4a1effa22cc Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Mon, 8 Jan 2024 10:22:43 +0100 Subject: [PATCH 048/125] [typer] move std to common, avoid more explicit ([],"Std") --- src/codegen/codegen.ml | 11 +---------- src/context/common.ml | 3 +++ src/context/typecore.ml | 1 - src/core/texpr.ml | 15 +++++++++++++++ src/filters/exceptions.ml | 2 +- src/typing/operators.ml | 6 +----- src/typing/typer.ml | 11 +---------- src/typing/typerBase.ml | 3 --- src/typing/typerEntry.ml | 3 +-- 9 files changed, 23 insertions(+), 32 deletions(-) diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index 9de5af5676e..42fe3a04136 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -419,16 +419,7 @@ let default_cast ?(vtmp="$t") com e texpr t p = let var = mk (TVar (vtmp,Some e)) api.tvoid p in let vexpr = mk (TLocal vtmp) e.etype p in let texpr = Texpr.Builder.make_typeexpr texpr p in - let std = (try List.find (fun t -> t_path t = ([],"Std")) com.types with Not_found -> die "" __LOC__) in - let fis = (try - let c = (match std with TClassDecl c -> c | _ -> die "" __LOC__) in - FStatic (c, PMap.find "isOfType" c.cl_statics) - with Not_found -> - die "" __LOC__ - ) in - let std = Texpr.Builder.make_typeexpr std p in - let is = mk (TField (std,fis)) (tfun [t_dynamic;t_dynamic] api.tbool) p in - let is = mk (TCall (is,[vexpr;texpr])) api.tbool p in + let is = Texpr.Builder.resolve_and_make_static_call com.std "isOfType" [vexpr;texpr] p in let enull = Texpr.Builder.make_null vexpr.etype p in let eop = Texpr.Builder.binop OpEq vexpr enull api.tbool p in let echeck = Texpr.Builder.binop OpBoolOr is eop api.tbool p in diff --git a/src/context/common.ml b/src/context/common.ml index b972218db0a..4f7890f2da9 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -375,6 +375,7 @@ type context = { mutable user_metas : (string, Meta.user_meta) Hashtbl.t; mutable get_macros : unit -> context option; (* typing state *) + mutable std : tclass; mutable global_metadata : (string list * metadata_entry * (bool * bool * bool)) list; shared : shared_context; display_information : display_information; @@ -855,6 +856,7 @@ let create compilation_step cs version args display_mode = tnull = (fun _ -> die "Could use locate abstract Null (was it redefined?)" __LOC__); tarray = (fun _ -> die "Could not locate class Array (was it redefined?)" __LOC__); }; + std = null_class; file_lookup_cache = new hashtbl_lookup; file_keys = new file_keys; file_contents = []; @@ -914,6 +916,7 @@ let clone com is_macro_context = module_to_file = new hashtbl_lookup; overload_cache = new hashtbl_lookup; module_lut = new module_lut; + std = null_class; } let file_time file = Extc.filetime file diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 53f6071c9ba..1d5ac7e250d 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -100,7 +100,6 @@ type typer_globals = { retain_meta : bool; mutable core_api : typer option; mutable macros : ((unit -> unit) * typer) option; - mutable std : tclass; mutable std_types : module_def; type_patches : (path, (string * bool, type_patch) Hashtbl.t * type_patch) Hashtbl.t; mutable module_check_policies : (string list * module_check_policy list * bool) list; diff --git a/src/core/texpr.ml b/src/core/texpr.ml index 3082e210b04..8cb6b3061bb 100644 --- a/src/core/texpr.ml +++ b/src/core/texpr.ml @@ -561,6 +561,21 @@ module Builder = struct let index basic e index t p = mk (TArray (e,mk (TConst (TInt (Int32.of_int index))) basic.tint p)) t p + + let resolve_and_make_static_call c name args p = + ignore(c.cl_build()); + let cf = try + PMap.find name c.cl_statics + with Not_found -> + die "" __LOC__ + in + let ef = make_static_field c cf (mk_zero_range_pos p) in + let tret = match follow ef.etype with + | TFun(_,r) -> r + | _ -> assert false + in + mk (TCall (ef, args)) tret p + end let set_default basic a c p = diff --git a/src/filters/exceptions.ml b/src/filters/exceptions.ml index 98003ee7e9f..08347da7ebc 100644 --- a/src/filters/exceptions.ml +++ b/src/filters/exceptions.ml @@ -63,7 +63,7 @@ let haxe_exception_instance_call ctx haxe_exception method_name args p = *) let std_is ctx e t p = let t = follow t in - let std_cls = ctx.typer.g.std in + let std_cls = ctx.typer.com.std in let isOfType_field = try PMap.find "isOfType" std_cls.cl_statics with Not_found -> raise_typing_error ("Std has no field isOfType") p diff --git a/src/typing/operators.ml b/src/typing/operators.ml index b9f0b7c927b..ba188a434f2 100644 --- a/src/typing/operators.ml +++ b/src/typing/operators.ml @@ -201,11 +201,7 @@ let make_binop ctx op e1 e2 is_assign_op p = call_to_string ctx e | KInt | KFloat | KString -> e | KUnk | KDyn | KNumParam _ | KStrParam _ | KOther -> - let std = type_type ctx ([],"Std") e.epos in - let acc = acc_get ctx (type_field_default_cfg ctx std "string" e.epos (MCall []) WithType.value) in - ignore(follow acc.etype); - let acc = (match acc.eexpr with TField (e,FClosure (Some (c,tl),f)) -> { acc with eexpr = TField (e,FInstance (c,tl,f)) } | _ -> acc) in - make_call ctx acc [e] ctx.t.tstring e.epos + Texpr.Builder.resolve_and_make_static_call ctx.com.std "string" [e] e.epos | KAbstract (a,tl) -> try AbstractCast.cast_or_unify_raise ctx tstring e p diff --git a/src/typing/typer.ml b/src/typing/typer.ml index ef95b897573..6fad5ed24a5 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -2014,16 +2014,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) = if ctx.in_display && DisplayPosition.display_position#enclosed_in p_t then DisplayEmitter.display_module_type ctx mt p_t; let e_t = type_module_type ctx mt p_t in - let e_Std_isOfType = - ignore(ctx.g.std.cl_build()); - let cf = try - PMap.find "isOfType" ctx.g.std.cl_statics - with Not_found -> - die "" __LOC__ - in - Texpr.Builder.make_static_field ctx.g.std cf (mk_zero_range_pos p) - in - mk (TCall (e_Std_isOfType, [e; e_t])) ctx.com.basic.tbool p + Texpr.Builder.resolve_and_make_static_call ctx.com.std "isOfType" [e;e_t] p | _ -> display_error ctx.com "Unsupported type for `is` operator" p_t; Texpr.Builder.make_bool ctx.com.basic false p diff --git a/src/typing/typerBase.ml b/src/typing/typerBase.ml index ddfbb114991..48542971600 100644 --- a/src/typing/typerBase.ml +++ b/src/typing/typerBase.ml @@ -232,9 +232,6 @@ let type_module_type ctx t p = in loop t None -let type_type ctx tpath p = - type_module_type ctx (Typeload.load_type_def ctx p (mk_type_path tpath)) p - let mk_module_type_access ctx t p = AKExpr (type_module_type ctx t p) diff --git a/src/typing/typerEntry.ml b/src/typing/typerEntry.ml index 94f2c315287..0a57a36f729 100644 --- a/src/typing/typerEntry.ml +++ b/src/typing/typerEntry.ml @@ -20,7 +20,6 @@ let create com macros = doinline = com.display.dms_inline && not (Common.defined com Define.NoInline); retain_meta = Common.defined com Define.RetainUntypedMeta; std_types = null_module; - std = null_class; global_using = []; complete = false; type_hints = []; @@ -135,7 +134,7 @@ let create com macros = ) m.m_types; let m = TypeloadModule.load_module ctx ([],"Std") null_pos in List.iter (fun mt -> match mt with - | TClassDecl ({cl_path = ([],"Std")} as c) -> ctx.g.std <- c; + | TClassDecl ({cl_path = ([],"Std")} as c) -> ctx.com.std <- c; | _ -> () ) m.m_types; let m = TypeloadModule.load_module ctx ([],"Array") null_pos in From 26807acb412eb952f3a7923a8f3d68acb4ed9ee2 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Mon, 8 Jan 2024 19:10:52 +0100 Subject: [PATCH 049/125] [server] guard against the null module being added as a dependency closes #11463 --- src/compiler/server.ml | 6 +++++- src/core/tFunctions.ml | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/compiler/server.ml b/src/compiler/server.ml index ac6fc9aca88..e9c061af69c 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -312,7 +312,11 @@ let check_module sctx ctx m p = in let check_dependencies () = PMap.iter (fun _ (sign,mpath) -> - let m2 = (com.cs#get_context sign)#find_module mpath in + let m2 = try + (com.cs#get_context sign)#find_module mpath + with Not_found -> + die (Printf.sprintf "Could not find dependency %s of %s in the cache" (s_type_path mpath) (s_type_path m.m_path)) __LOC__; + in match check m2 with | None -> () | Some reason -> raise (Dirty (DependencyDirty(m2.m_path,reason))) diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index 247970f5428..862a994004e 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -283,7 +283,7 @@ let null_abstract = { } let add_dependency ?(skip_postprocess=false) m mdep = - if m != null_module && (m.m_path != mdep.m_path || m.m_extra.m_sign != mdep.m_extra.m_sign) then begin + if m != null_module && mdep != null_module && (m.m_path != mdep.m_path || m.m_extra.m_sign != mdep.m_extra.m_sign) then begin m.m_extra.m_deps <- PMap.add mdep.m_id (mdep.m_extra.m_sign, mdep.m_path) m.m_extra.m_deps; (* In case the module is cached, we'll have to run post-processing on it again (issue #10635) *) if not skip_postprocess then m.m_extra.m_processed <- 0 From 822dd87c1e7e56caac29aa3d42eb7879edeebade Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 9 Jan 2024 14:11:37 +0100 Subject: [PATCH 050/125] [typer] remove Directory package rule because it is unused --- src/context/common.ml | 1 - src/context/display/displayPath.ml | 2 -- src/context/display/displayToplevel.ml | 1 - src/macro/macroApi.ml | 1 - src/typing/typeloadParse.ml | 9 ++------- 5 files changed, 2 insertions(+), 12 deletions(-) diff --git a/src/context/common.ml b/src/context/common.ml index 4f7890f2da9..89d0444e83d 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -27,7 +27,6 @@ open Warning type package_rule = | Forbidden - | Directory of string | Remap of string type pos = Globals.pos diff --git a/src/context/display/displayPath.ml b/src/context/display/displayPath.ml index 83f719fcea9..6b233825fe5 100644 --- a/src/context/display/displayPath.ml +++ b/src/context/display/displayPath.ml @@ -26,7 +26,6 @@ module TypePathHandler = struct | x :: l -> (try match PMap.find x com.package_rules with - | Directory d -> d :: l | Remap s -> s :: l | _ -> p with @@ -47,7 +46,6 @@ module TypePathHandler = struct match PMap.find f com.package_rules with | Forbidden -> () | Remap f -> packages := f :: !packages - | Directory _ -> raise Not_found with Not_found -> packages := f :: !packages else diff --git a/src/context/display/displayToplevel.ml b/src/context/display/displayToplevel.ml index a7c07716429..f5959f19e3e 100644 --- a/src/context/display/displayToplevel.ml +++ b/src/context/display/displayToplevel.ml @@ -74,7 +74,6 @@ class explore_class_path_task com checked recursive f_pack f_module dir pack = o begin try begin match PMap.find file com.package_rules with | Forbidden | Remap _ -> () - | _ -> raise Not_found end with Not_found -> f_pack (List.rev pack,file); diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index deb6553c1dd..722b1d5c2c9 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -516,7 +516,6 @@ and encode_exceptions_config ec = and encode_package_rule pr = let tag, pl = match pr with | Forbidden -> 0, [] - | Directory (path) -> 1, [encode_string path] | Remap (path) -> 2, [encode_string path] in encode_enum ~pos:None IPackageRule tag pl diff --git a/src/typing/typeloadParse.ml b/src/typing/typeloadParse.ml index 481c451236d..29f99f48f5a 100644 --- a/src/typing/typeloadParse.ml +++ b/src/typing/typeloadParse.ml @@ -82,25 +82,20 @@ let parse_hook = ref parse_file let resolve_module_file com m remap p = let forbid = ref false in - let compose_path no_rename = + let compose_path = (match m with | [] , name -> name | x :: l , name -> let x = (try match PMap.find x com.package_rules with | Forbidden -> forbid := true; x - | Directory d -> if no_rename then x else d | Remap d -> remap := d :: l; d with Not_found -> x ) in String.concat "/" (x :: l) ^ "/" ^ name ) ^ ".hx" in - let file = try - Common.find_file com (compose_path false) - with Not_found -> - Common.find_file com (compose_path true) - in + let file = Common.find_file com compose_path in let file = (match ExtString.String.lowercase (snd m) with | "con" | "aux" | "prn" | "nul" | "com1" | "com2" | "com3" | "lpt1" | "lpt2" | "lpt3" when Sys.os_type = "Win32" -> (* these names are reserved by the OS - old DOS legacy, such files cannot be easily created but are reported as visible *) From 19517c00adda9dffe64c94265649aaca7ec256f4 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 9 Jan 2024 16:50:57 +0100 Subject: [PATCH 051/125] [typer] remove Forbid_package try/with This is from a time (issue #1152) when module resolution was reflected on the call stack. With the typer pass system it's unlikely to ever catch anything we want to catch. --- src/typing/typeloadModule.ml | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 014eec7787c..aebf0f032e6 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -809,10 +809,7 @@ let load_module' ctx g m p = loop ctx.com.load_extern_type in let is_extern = !is_extern in - try - type_module ctx m file ~is_extern decls p - with Forbid_package (inf,pl,pf) when p <> null_pos -> - raise (Forbid_package (inf,p::pl,pf)) + type_module ctx m file ~is_extern decls p let load_module ctx m p = let m2 = load_module' ctx ctx.g m p in From 944d4fdba9cce40d0e00c3a2495d0180e6e1f3c5 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 10 Jan 2024 10:33:46 +0100 Subject: [PATCH 052/125] [macro] don't apply @:native names closes #11481 --- src/typing/macroContext.ml | 1 - tests/misc/projects/Issue11481/Main.hx | 3 +++ tests/misc/projects/Issue11481/compile.hxml | 2 ++ tests/misc/projects/Issue11481/compile.hxml.stdout | 1 + tests/misc/projects/Issue11481/pack/OldClass.hx | 12 ++++++++++++ 5 files changed, 18 insertions(+), 1 deletion(-) create mode 100644 tests/misc/projects/Issue11481/Main.hx create mode 100644 tests/misc/projects/Issue11481/compile.hxml create mode 100644 tests/misc/projects/Issue11481/compile.hxml.stdout create mode 100644 tests/misc/projects/Issue11481/pack/OldClass.hx diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index d5df49e80bb..d349eb5be50 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -664,7 +664,6 @@ and flush_macro_context mint mctx = Exceptions.patch_constructors mctx; (fun mt -> AddFieldInits.add_field_inits mctx.curclass.cl_path (RenameVars.init mctx.com) mctx.com mt); minimal_restore; - Naming.apply_native_paths ] in let ready = fun t -> FiltersCommon.apply_filters_once mctx expr_filters t; diff --git a/tests/misc/projects/Issue11481/Main.hx b/tests/misc/projects/Issue11481/Main.hx new file mode 100644 index 00000000000..4d95c5f0be2 --- /dev/null +++ b/tests/misc/projects/Issue11481/Main.hx @@ -0,0 +1,3 @@ +function main() { + trace(pack.OldClass); +} \ No newline at end of file diff --git a/tests/misc/projects/Issue11481/compile.hxml b/tests/misc/projects/Issue11481/compile.hxml new file mode 100644 index 00000000000..5f82c470c12 --- /dev/null +++ b/tests/misc/projects/Issue11481/compile.hxml @@ -0,0 +1,2 @@ +-m Main +--interp \ No newline at end of file diff --git a/tests/misc/projects/Issue11481/compile.hxml.stdout b/tests/misc/projects/Issue11481/compile.hxml.stdout new file mode 100644 index 00000000000..a4310c6c4f8 --- /dev/null +++ b/tests/misc/projects/Issue11481/compile.hxml.stdout @@ -0,0 +1 @@ +Main.hx:2: Class \ No newline at end of file diff --git a/tests/misc/projects/Issue11481/pack/OldClass.hx b/tests/misc/projects/Issue11481/pack/OldClass.hx new file mode 100644 index 00000000000..163b567c747 --- /dev/null +++ b/tests/misc/projects/Issue11481/pack/OldClass.hx @@ -0,0 +1,12 @@ +package pack; + +@:native("NewClass") +class OldClass { + macro static function f2() { + return null; + } + + macro static function f1() { + return null; + } +} \ No newline at end of file From 682b8e3407cf04bb0b81275d6543cc9c45e00e89 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 10 Jan 2024 13:49:27 +0100 Subject: [PATCH 053/125] [server] remove retyper This didn't quite work the way I wanted it to, and it will become obsolete with a hxb-based cache anyway. --- src/compiler/retyper.ml | 277 ------------------------- src/compiler/server.ml | 14 -- src/core/tType.ml | 1 - std/haxe/macro/CompilationServer.hx | 4 - tests/server/src/cases/RetyperTests.hx | 203 ------------------ 5 files changed, 499 deletions(-) delete mode 100644 src/compiler/retyper.ml delete mode 100644 tests/server/src/cases/RetyperTests.hx diff --git a/src/compiler/retyper.ml b/src/compiler/retyper.ml deleted file mode 100644 index e5f313e98b6..00000000000 --- a/src/compiler/retyper.ml +++ /dev/null @@ -1,277 +0,0 @@ -open Globals -open Ast -open Typecore -open Type -open TypeloadModule -open TypeloadFields - -exception Fail of string - -type retyping_context = { - typer : typer; - print_stack : string list; -} - -let fail rctx s = - let stack = String.concat " " (List.rev rctx.print_stack) in - raise (Fail (Printf.sprintf "%s: %s" stack s)) - -let disable_typeloading rctx ctx f = - let old = ctx.g.load_only_cached_modules in - ctx.g.load_only_cached_modules <- true; - try - Std.finally (fun () -> ctx.g.load_only_cached_modules <- old) f () - with (Error.Error { err_message = Module_not_found path }) -> - fail rctx (Printf.sprintf "Could not load [Module %s]" (s_type_path path)) - -let pair_type th t = match th with - | None -> - TExprToExpr.convert_type t,null_pos - | Some t -> - t - -let pair_class_field rctx ctx cctx fctx cf cff p = - match cff.cff_kind with - | FFun fd -> - let targs,tret = match follow cf.cf_type with - | TFun(args,ret) -> - args,ret - | _ -> - fail rctx "Type change" - in - let args = try - List.map2 (fun (name,opt,meta,th,eo) (_,_,t) -> - (name,opt,meta,Some (pair_type th t),eo) - ) fd.f_args targs - with Invalid_argument _ -> - fail rctx "Type change" - in - let ret = pair_type fd.f_type tret in - let fd = { - fd with - f_args = args; - f_type = Some ret - } in - let load_args_ret () = - setup_args_ret ctx cctx fctx (fst cff.cff_name) fd p - in - let args,ret = disable_typeloading rctx ctx load_args_ret in - let t = TFun(args#for_type,ret) in - (fun () -> - (* This is the only part that should actually modify anything. *) - cf.cf_type <- t; - TypeBinding.bind_method ctx cctx fctx cf t args ret fd.f_expr (match fd.f_expr with Some e -> snd e | None -> cff.cff_pos); - if ctx.com.display.dms_full_typing then - remove_class_field_flag cf CfPostProcessed; - ) - | FVar(th,eo) | FProp(_,_,th,eo) -> - let th = Some (pair_type th cf.cf_type) in - let t = disable_typeloading rctx ctx (fun () -> load_variable_type_hint ctx fctx eo (pos cff.cff_name) th) in - (fun () -> - cf.cf_type <- t; - TypeBinding.bind_var ctx cctx fctx cf eo; - if ctx.com.display.dms_full_typing then - remove_class_field_flag cf CfPostProcessed; - ) - -let pair_classes rctx c d p = - let rctx = {rctx with - print_stack = (Printf.sprintf "[Class %s]" (s_type_path c.cl_path)) :: rctx.print_stack - } in - c.cl_restore(); - (* TODO: What do we do with build macros? *) - let cctx = create_class_context c p in - let ctx = create_typer_context_for_class rctx.typer cctx p in - let _ = - let rctx = {rctx with - print_stack = (Printf.sprintf "[Relations]") :: rctx.print_stack - } in - let has_extends = ref false in - let implements = ref c.cl_implements in - List.iter (function - | HExtends ptp -> - has_extends := true; - begin match c.cl_super with - | None -> - fail rctx (Printf.sprintf "parent %s appeared" (Ast.Printer.s_complex_type_path "" ptp)) - | Some(c,tl) -> - let th = pair_type (Some(CTPath ptp,ptp.pos_full)) (TInst(c,tl)) in - ignore (disable_typeloading rctx ctx (fun () -> Typeload.load_complex_type ctx false th)) - end - | HImplements ptp -> - begin match !implements with - | (c,tl) :: rest -> - (* TODO: I think this should somehow check if it's actually the same interface. There could be cases - where the order changes or something like that... Maybe we can compare the loaded type. - However, this doesn't matter until we start retyping invalidated modules. - *) - implements := rest; - let th = pair_type (Some(CTPath ptp,ptp.pos_full)) (TInst(c,tl)) in - ignore (disable_typeloading rctx ctx (fun () -> Typeload.load_complex_type ctx false th)); - | [] -> - fail rctx (Printf.sprintf "interface %s appeared" (Ast.Printer.s_complex_type_path "" ptp)) - end - | _ -> - () - ) d.d_flags; - (* TODO: There are probably cases where the compiler generates a cl_super even though it's not in syntax *) - if not !has_extends then begin match c.cl_super with - | None -> () - | Some(c,_) -> fail rctx (Printf.sprintf "parent %s disappeared" (s_type_path c.cl_path)) - end; - begin match !implements with - | (c,_) :: _ -> fail rctx (Printf.sprintf "interface %s disappeared" (s_type_path c.cl_path)) - | [] -> () - end - in - let fl = List.map (fun cff -> - let name = fst cff.cff_name in - let rctx = {rctx with - print_stack = (Printf.sprintf "[Field %s]" name) :: rctx.print_stack - } in - let display_modifier = Typeload.check_field_access ctx cff in - let fctx = create_field_context ctx cctx cff ctx.is_display_file display_modifier in - let cf = match fctx.field_kind with - | FKConstructor -> - begin match c.cl_constructor with - | None -> - fail rctx "Constructor not found" - | Some cf -> - cf - end - | FKNormal -> - begin try - PMap.find name (if fctx.is_static then c.cl_statics else c.cl_fields) - with Not_found -> - fail rctx "Field not found" - end - | FKInit -> - fail rctx "TODO" - in - pair_class_field rctx ctx cctx fctx cf cff p - ) d.d_data in - fl @ [fun () -> TypeloadFields.finalize_class ctx cctx] - -let pair_enums ctx rctx en d = - let ctx = { ctx with type_params = en.e_params } in - let rctx = {rctx with - print_stack = (Printf.sprintf "[Enum %s]" (s_type_path en.e_path)) :: rctx.print_stack - } in - List.iter (fun eff -> - let name = fst eff.ec_name in - let rctx = {rctx with - print_stack = (Printf.sprintf "[Field %s]" name) :: rctx.print_stack - } in - let ef = try - PMap.find name en.e_constrs - with Not_found -> - fail rctx "Field not found" - in - let th = pair_type eff.ec_type ef.ef_type in - ignore (disable_typeloading rctx ctx (fun () -> Typeload.load_complex_type ctx false th)) - ) d.d_data; - [] - -let pair_typedefs ctx rctx td d = - let rctx = {rctx with - print_stack = (Printf.sprintf "[Typedef %s]" (s_type_path td.t_path)) :: rctx.print_stack - } in - let ctx = { ctx with type_params = td.t_params } in - ignore (disable_typeloading rctx ctx (fun () -> Typeload.load_complex_type ctx false d.d_data)); - [] - -let pair_abstracts ctx rctx a d p = - let rctx = {rctx with - print_stack = (Printf.sprintf "[Abstract %s]" (s_type_path a.a_path)) :: rctx.print_stack - } in - match a.a_impl with - | Some c -> - c.cl_restore(); - let cctx = create_class_context c p in - let ctx = create_typer_context_for_class rctx.typer cctx p in - let fl = List.map (fun cff -> - let cff = TypeloadFields.transform_abstract_field2 ctx a cff in - let name = fst cff.cff_name in - let rctx = {rctx with - print_stack = (Printf.sprintf "[Field %s]" name) :: rctx.print_stack - } in - let display_modifier = Typeload.check_field_access ctx cff in - let fctx = create_field_context ctx cctx cff ctx.is_display_file display_modifier in - let cf = try - PMap.find name c.cl_statics - with Not_found -> - fail rctx "Field not found" - in - pair_class_field rctx ctx cctx fctx cf cff p - ) d.d_data in - fl @ [fun () -> TypeloadFields.finalize_class ctx cctx] - | None -> - (* ?*) - [] - -let attempt_retyping ctx m p = - let com = ctx.com in - let file,_,_,decls = TypeloadParse.parse_module' com m.m_path p in - let ctx = create_typer_context_for_module ctx m in - let rctx = { - typer = ctx; - print_stack = [Printf.sprintf "[Module %s]" (s_type_path m.m_path)]; - } in - (* log rctx 0 (Printf.sprintf "Retyping module %s" (s_type_path m.m_path)); *) - let find_type name = try - List.find (fun t -> snd (t_infos t).mt_path = name) ctx.m.curmod.m_types - with Not_found -> - fail rctx (Printf.sprintf "Type %s not found" name) - in - let rec loop acc decls = match decls with - | [] -> - List.rev acc - | (d,p) :: decls -> - begin match d with - | EImport (path,mode) -> - ImportHandling.init_import ctx path mode p; - ImportHandling.commit_import ctx path mode p; - loop acc decls - | EUsing path -> - ImportHandling.init_using ctx path p; - loop acc decls - | EClass c -> - let mt = find_type (fst c.d_name) in - loop ((d,mt) :: acc) decls - | EEnum en -> - let mt = find_type (fst en.d_name) in - loop ((d,mt) :: acc) decls - | ETypedef td -> - let mt = find_type (fst td.d_name) in - loop ((d,mt) :: acc) decls - | EAbstract a -> - let mt = find_type (fst a.d_name) in - loop ((d,mt) :: acc) decls - | _ -> - loop acc decls - end; - in - try - m.m_extra.m_cache_state <- MSUnknown; - let pairs = loop [] decls in - let fl = List.map (fun (d,mt) -> match d,mt with - | EClass d,TClassDecl c -> - pair_classes rctx c d p - | EEnum d,TEnumDecl en -> - pair_enums ctx rctx en d - | ETypedef d,TTypeDecl td -> - pair_typedefs ctx rctx td d - | EAbstract d,TAbstractDecl a -> - pair_abstracts ctx rctx a d p - | _ -> - fail rctx "?" - ) pairs in - (* If we get here we know that the everything is ok. *) - List.iter (fun fl -> - List.iter (fun f -> f()) fl - ) fl; - m.m_extra.m_cache_state <- MSGood; - m.m_extra.m_time <- Common.file_time file; - None - with Fail s -> - Some s diff --git a/src/compiler/server.ml b/src/compiler/server.ml index e9c061af69c..89939c1d175 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -353,20 +353,6 @@ let check_module sctx ctx m p = m.m_extra.m_cache_state <- MSUnknown; check () in - let dirty = match dirty with - | Some (DependencyDirty _) when has_policy Retype -> - let result = Retyper.attempt_retyping ctx m p in - begin match result with - | None -> - ServerMessage.retyper_ok com "" m; - None - | Some reason -> - ServerMessage.retyper_fail com "" m reason; - dirty - end - | _ -> - dirty - in (* Update the module now. It will use this dirty status for the remainder of this compilation. *) begin match dirty with | Some reason -> diff --git a/src/core/tType.ml b/src/core/tType.ml index 2ae0c85886b..faa40a8afba 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -30,7 +30,6 @@ type module_check_policy = | CheckFileContentModification | NoCheckDependencies | NoCheckShadowing - | Retype type module_tainting_reason = | CheckDisplayFile diff --git a/std/haxe/macro/CompilationServer.hx b/std/haxe/macro/CompilationServer.hx index 0cb50731bed..dbefb7ecdcf 100644 --- a/std/haxe/macro/CompilationServer.hx +++ b/std/haxe/macro/CompilationServer.hx @@ -52,10 +52,6 @@ enum abstract ModuleCheckPolicy(Int) { of the current module file. **/ var NoCheckShadowing = 3; - /** - Retype the module's contents if its file is invalidated. This is currently experimental. - **/ - var Retype = 4; } enum abstract ContextOptions(Int) { diff --git a/tests/server/src/cases/RetyperTests.hx b/tests/server/src/cases/RetyperTests.hx deleted file mode 100644 index 8a4db7a7140..00000000000 --- a/tests/server/src/cases/RetyperTests.hx +++ /dev/null @@ -1,203 +0,0 @@ -package cases; - -import haxe.display.FsPath; -import haxe.display.Server; -import utest.Assert; - -using StringTools; -using Lambda; - -class RetyperTests extends TestCase { - static function getBaseArgs(moduleName:String) { - return [ - moduleName + ".hx", - "--no-output", - "-js", - "no.js", - "--macro", - "haxe.macro.CompilationServer.setModuleCheckPolicy(['" + moduleName + "'], [Retype], false)" - ]; - } - - function testNonSignature() { - vfs.putContent("WithDependency.hx", getTemplate("WithDependency.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("WithDependency"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('retyped WithDependency')); - } - - function testSignature() { - vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependency.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("WithSignatureDependency"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('failed retyping WithSignatureDependency')); - Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]')); - } - - function testSignatureInferredArg() { - vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependencyInferredArg.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("WithSignatureDependency"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('failed retyping WithSignatureDependency')); - Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]')); - } - - function testSignatureInferredRet() { - vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependencyInferredRet.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("WithSignatureDependency"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('failed retyping WithSignatureDependency')); - Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]')); - } - - function testSignatureVariable() { - vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependencyVariable.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("WithSignatureDependency"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('failed retyping WithSignatureDependency')); - Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]')); - } - - function testSignatureInferredVariable() { - vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependencyInferredVariable.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("WithSignatureDependency"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('failed retyping WithSignatureDependency')); - Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]')); - } - - function testSignatureProperty() { - vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependencyProperty.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("WithSignatureDependency"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('failed retyping WithSignatureDependency')); - Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]')); - } - - function testSignatureInferredProperty() { - vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependencyInferredProperty.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("WithSignatureDependency"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('failed retyping WithSignatureDependency')); - Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]')); - } - - function testMutual() { - vfs.putContent("WithMutualDependency.hx", getTemplate("retyper/WithMutualDependency.hx")); - vfs.putContent("MutualDependency.hx", getTemplate("retyper/MutualDependency.hx")); - var args = getBaseArgs("WithMutualDependency"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("MutualDependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('retyped WithMutualDependency')); - } - - function testParent() { - vfs.putContent("WithParentDependency.hx", getTemplate("retyper/WithParentDependency.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("WithParentDependency"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('failed retyping WithParentDependency')); - Assert.isTrue(hasMessage('[Module WithParentDependency] [Class WithParentDependency] [Relations]: Could not load [Module Dependency]')); - } - - function testInterface() { - vfs.putContent("WithInterfaceDependency.hx", getTemplate("retyper/WithInterfaceDependency.hx")); - vfs.putContent("InterfaceDependency.hx", getTemplate("retyper/InterfaceDependency.hx")); - var args = getBaseArgs("WithInterfaceDependency"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("InterfaceDependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('failed retyping WithInterfaceDependency')); - Assert.isTrue(hasMessage('[Module WithInterfaceDependency] [Class WithInterfaceDependency] [Relations]: Could not load [Module InterfaceDependency]')); - } - - function testIndependentEnum() { - vfs.putContent("IndependentEnum.hx", getTemplate("retyper/IndependentEnum.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("IndependentEnum"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('retyped IndependentEnum')); - } - - function testDependentEnum() { - vfs.putContent("DependentEnum.hx", getTemplate("retyper/DependentEnum.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("DependentEnum"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('failed retyping DependentEnum')); - Assert.isTrue(hasMessage('[Module DependentEnum] [Enum DependentEnum] [Field Constructor]: Could not load [Module Dependency]')); - } - - function testIndependentTypedef() { - vfs.putContent("IndependentTypedef.hx", getTemplate("retyper/IndependentTypedef.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("IndependentTypedef"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('retyped IndependentTypedef')); - } - - function testDependentTypedef() { - vfs.putContent("DependentTypedef.hx", getTemplate("retyper/DependentTypedef.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("DependentTypedef"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('failed retyping DependentTypedef')); - Assert.isTrue(hasMessage('[Module DependentTypedef] [Typedef DependentTypedef]: Could not load [Module Dependency]')); - } - - function testAbstractNonSignature() { - vfs.putContent("AbstractWithDependency.hx", getTemplate("retyper/AbstractWithDependency.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("AbstractWithDependency"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('retyped AbstractWithDependency')); - } - - function testAbstractSignature() { - vfs.putContent("AbstractWithSignatureDependency.hx", getTemplate("retyper/AbstractWithSignatureDependency.hx")); - vfs.putContent("Dependency.hx", getTemplate("Dependency.hx")); - var args = getBaseArgs("AbstractWithSignatureDependency"); - runHaxe(args); - runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")}); - runHaxe(args); - Assert.isTrue(hasMessage('failed retyping AbstractWithSignatureDependency')); - Assert.isTrue(hasMessage('[Module AbstractWithSignatureDependency] [Abstract AbstractWithSignatureDependency] [Field test]: Could not load [Module Dependency]')); - } -} From caa3baa87edeef4acfd20431268c60aa1e027181 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 11 Jan 2024 06:33:17 +0100 Subject: [PATCH 054/125] [server] pull some changes from hxb branch --- src/compiler/server.ml | 89 +++++++++++---------- src/compiler/serverMessage.ml | 12 +-- src/core/ds/ring.ml | 15 ++++ tests/misc/java/projects/Issue10280/Main.hx | 5 +- tests/server/src/Main.hx | 2 +- tests/server/src/TestCase.hx | 7 +- 6 files changed, 76 insertions(+), 54 deletions(-) diff --git a/src/compiler/server.ml b/src/compiler/server.ml index 89939c1d175..c11b83060ff 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -225,27 +225,27 @@ let get_changed_directories sctx (ctx : Typecore.typer) = (* Checks if module [m] can be reused from the cache and returns None in that case. Otherwise, returns [Some m'] where [m'] is the module responsible for [m] not being reusable. *) -let check_module sctx ctx m p = +let check_module sctx ctx m_path m_extra p = let com = ctx.Typecore.com in let cc = CommonCache.get_cache com in - let content_changed m file = + let content_changed m_path file = let fkey = ctx.com.file_keys#get file in try let cfile = cc#find_file fkey in (* We must use the module path here because the file path is absolute and would cause positions in the parsed declarations to differ. *) - let new_data = TypeloadParse.parse_module ctx m.m_path p in + let new_data = TypeloadParse.parse_module ctx m_path p in cfile.c_decls <> snd new_data with Not_found -> true in - let check_module_shadowing paths m = + let check_module_shadowing paths m_path m_extra = List.iter (fun dir -> - let file = (dir.c_path ^ (snd m.m_path)) ^ ".hx" in + let file = (dir.c_path ^ (snd m_path)) ^ ".hx" in if Sys.file_exists file then begin let time = file_time file in - if time > m.m_extra.m_time then begin - ServerMessage.module_path_changed com "" (m,time,file); + if time > m_extra.m_time then begin + ServerMessage.module_path_changed com "" (m_path,m_extra,time,file); raise (Dirty (Shadowed file)) end end @@ -253,33 +253,33 @@ let check_module sctx ctx m p = in let start_mark = sctx.compilation_step in let unknown_state_modules = ref [] in - let rec check m = + let rec check m_path m_extra = let check_module_path () = let directories = get_changed_directories sctx ctx in - match m.m_extra.m_kind with + match m_extra.m_kind with | MFake | MImport -> () (* don't get classpath *) | MExtern -> (* if we have a file then this will override our extern type *) - check_module_shadowing directories m; + check_module_shadowing directories m_path m_extra; let rec loop = function | [] -> - if sctx.verbose then print_endline ("No library file was found for " ^ s_type_path m.m_path); (* TODO *) + if sctx.verbose then print_endline ("No library file was found for " ^ s_type_path m_path); (* TODO *) raise (Dirty LibraryChanged) | (file,load) :: l -> - match load m.m_path p with + match load m_path p with | None -> loop l | Some _ -> - if com.file_keys#get file <> (Path.UniqueKey.lazy_key m.m_extra.m_file) then begin - if sctx.verbose then print_endline ("Library file was changed for " ^ s_type_path m.m_path); (* TODO *) + if com.file_keys#get file <> (Path.UniqueKey.lazy_key m_extra.m_file) then begin + if sctx.verbose then print_endline ("Library file was changed for " ^ s_type_path m_path); (* TODO *) raise (Dirty LibraryChanged) end in loop com.load_extern_type | MCode -> - check_module_shadowing directories m + check_module_shadowing directories m_path m_extra | MMacro when com.is_macro_context -> - check_module_shadowing directories m + check_module_shadowing directories m_path m_extra | MMacro -> (* Creating another context while the previous one is incomplete means we have an infinite loop in the compiler. @@ -292,40 +292,43 @@ let check_module sctx ctx m p = ^ "Probably caused by shadowing a module of the standard library. " ^ "Make sure shadowed module does not pull macro context.")); let mctx = MacroContext.get_macro_context ctx in - check_module_shadowing (get_changed_directories sctx mctx) m + check_module_shadowing (get_changed_directories sctx mctx) m_path m_extra in - let has_policy policy = List.mem policy m.m_extra.m_check_policy || match policy with + let has_policy policy = List.mem policy m_extra.m_check_policy || match policy with | NoCheckShadowing | NoCheckFileTimeModification when !ServerConfig.do_not_check_modules && !Parser.display_mode <> DMNone -> true | _ -> false in let check_file () = - let file = Path.UniqueKey.lazy_path m.m_extra.m_file in - if file_time file <> m.m_extra.m_time then begin - if has_policy CheckFileContentModification && not (content_changed m file) then begin + let file = Path.UniqueKey.lazy_path m_extra.m_file in + if file_time file <> m_extra.m_time then begin + if has_policy CheckFileContentModification && not (content_changed m_path file) then begin ServerMessage.unchanged_content com "" file; end else begin - ServerMessage.not_cached com "" m; - if m.m_extra.m_kind = MFake then Hashtbl.remove Typecore.fake_modules (Path.UniqueKey.lazy_key m.m_extra.m_file); + ServerMessage.not_cached com "" m_path; + if m_extra.m_kind = MFake then Hashtbl.remove Typecore.fake_modules (Path.UniqueKey.lazy_key m_extra.m_file); raise (Dirty (FileChanged file)) end end in + let find_module_extra sign mpath = + ((com.cs#get_context sign)#find_module mpath).m_extra + in let check_dependencies () = PMap.iter (fun _ (sign,mpath) -> - let m2 = try - (com.cs#get_context sign)#find_module mpath + let m2_extra = try + find_module_extra sign mpath with Not_found -> - die (Printf.sprintf "Could not find dependency %s of %s in the cache" (s_type_path mpath) (s_type_path m.m_path)) __LOC__; + die (Printf.sprintf "Could not find dependency %s of %s in the cache" (s_type_path mpath) (s_type_path m_path)) __LOC__; in - match check m2 with + match check mpath m2_extra with | None -> () - | Some reason -> raise (Dirty (DependencyDirty(m2.m_path,reason))) - ) m.m_extra.m_deps; + | Some reason -> raise (Dirty (DependencyDirty(mpath,reason))) + ) m_extra.m_deps; in let check () = try if not (has_policy NoCheckShadowing) then check_module_path(); - if not (has_policy NoCheckFileTimeModification) || Path.file_extension (Path.UniqueKey.lazy_path m.m_extra.m_file) <> "hx" then check_file(); + if not (has_policy NoCheckFileTimeModification) || Path.file_extension (Path.UniqueKey.lazy_path m_extra.m_file) <> "hx" then check_file(); if not (has_policy NoCheckDependencies) then check_dependencies(); None with @@ -333,15 +336,15 @@ let check_module sctx ctx m p = Some reason in (* If the module mark matches our compilation mark, we are done *) - if m.m_extra.m_checked = start_mark then begin match m.m_extra.m_cache_state with + if m_extra.m_checked = start_mark then begin match m_extra.m_cache_state with | MSGood | MSUnknown -> None | MSBad reason -> Some reason end else begin (* Otherwise, set to current compilation mark for recursion *) - m.m_extra.m_checked <- start_mark; - let dirty = match m.m_extra.m_cache_state with + m_extra.m_checked <- start_mark; + let dirty = match m_extra.m_cache_state with | MSBad reason -> (* If we are already dirty, stick to it. *) Some reason @@ -350,35 +353,35 @@ let check_module sctx ctx m p = die "" __LOC__ | MSGood -> (* Otherwise, run the checks *) - m.m_extra.m_cache_state <- MSUnknown; + m_extra.m_cache_state <- MSUnknown; check () in (* Update the module now. It will use this dirty status for the remainder of this compilation. *) begin match dirty with | Some reason -> (* Update the state if we're dirty. *) - m.m_extra.m_cache_state <- MSBad reason; + m_extra.m_cache_state <- MSBad reason; | None -> (* We cannot update if we're clean because at this point it might just be an assumption. Instead We add the module to a list which is updated at the end of handling this subgraph. *) - unknown_state_modules := m :: !unknown_state_modules; + unknown_state_modules := m_extra :: !unknown_state_modules; end; dirty end in - let state = check m in + let state = check m_path m_extra in begin match state with | None -> (* If the entire subgraph is clean, we can set all modules to good state *) - List.iter (fun m -> m.m_extra.m_cache_state <- MSGood) !unknown_state_modules; + List.iter (fun m_extra -> m_extra.m_cache_state <- MSGood) !unknown_state_modules; | Some _ -> (* Otherwise, unknown state module may or may not be dirty. We didn't check everything eagerly, so we have to make sure that the module is checked again if it appears in a different check. This is achieved by setting m_checked to a lower value and assuming Good state again. *) - List.iter (fun m -> match m.m_extra.m_cache_state with + List.iter (fun m_extra -> match m_extra.m_cache_state with | MSUnknown -> - m.m_extra.m_checked <- start_mark - 1; - m.m_extra.m_cache_state <- MSGood; + m_extra.m_checked <- start_mark - 1; + m_extra.m_cache_state <- MSGood; | MSGood | MSBad _ -> () ) !unknown_state_modules @@ -431,10 +434,10 @@ let type_module sctx (ctx:Typecore.typer) mpath p = try let m = cc#find_module mpath in let tcheck = Timer.timer ["server";"module cache";"check"] in - begin match check_module sctx ctx m p with + begin match check_module sctx ctx m.m_path m.m_extra p with | None -> () | Some reason -> - ServerMessage.skipping_dep com "" (m,(Printer.s_module_skip_reason reason)); + ServerMessage.skipping_dep com "" (m.m_path,(Printer.s_module_skip_reason reason)); tcheck(); raise Not_found; end; diff --git a/src/compiler/serverMessage.ml b/src/compiler/serverMessage.ml index 18a3faeeefa..e82930c08bc 100644 --- a/src/compiler/serverMessage.ml +++ b/src/compiler/serverMessage.ml @@ -75,12 +75,12 @@ let found_directories com tabs dirs = let changed_directories com tabs dirs = if config.print_changed_directories then print_endline (Printf.sprintf "%schanged directories: [%s]" (sign_string com) (String.concat ", " (List.map (fun dir -> "\"" ^ dir.c_path ^ "\"") dirs))) -let module_path_changed com tabs (m,time,file) = +let module_path_changed com tabs (m_path,m_extra,time,file) = if config.print_module_path_changed then print_endline (Printf.sprintf "%smodule path might have changed: %s\n\twas: %2.0f %s\n\tnow: %2.0f %s" - (sign_string com) (s_type_path m.m_path) m.m_extra.m_time (Path.UniqueKey.lazy_path m.m_extra.m_file) time file) + (sign_string com) (s_type_path m_path) m_extra.m_time (Path.UniqueKey.lazy_path m_extra.m_file) time file) -let not_cached com tabs m = - if config.print_not_cached then print_endline (Printf.sprintf "%s%s not cached (%s)" (sign_string com) (s_type_path m.m_path) "modified") +let not_cached com tabs m_path = + if config.print_not_cached then print_endline (Printf.sprintf "%s%s not cached (%s)" (sign_string com) (s_type_path m_path) "modified") let parsed com tabs (ffile,info) = if config.print_parsed then print_endline (Printf.sprintf "%sparsed %s (%s)" (sign_string com) ffile info) @@ -100,8 +100,8 @@ let retyper_fail com tabs m reason = print_endline (Printf.sprintf "%s%s%s" (sign_string com) (tabs ^ " ") reason); end -let skipping_dep com tabs (m,reason) = - if config.print_skipping_dep then print_endline (Printf.sprintf "%sskipping %s (%s)" (sign_string com) (s_type_path m.m_path) reason) +let skipping_dep com tabs (mpath,reason) = + if config.print_skipping_dep then print_endline (Printf.sprintf "%sskipping %s (%s)" (sign_string com) (s_type_path mpath) reason) let unchanged_content com tabs file = if config.print_unchanged_content then print_endline (Printf.sprintf "%s%s changed time not but content, reusing" (sign_string com) file) diff --git a/src/core/ds/ring.ml b/src/core/ds/ring.ml index a98e7a59529..4ec861f727d 100644 --- a/src/core/ds/ring.ml +++ b/src/core/ds/ring.ml @@ -39,6 +39,21 @@ let fold r acc f = in loop 0 acc +let find r f = + let len = Array.length r.values in + let rec loop i = + if i = len then + raise Not_found + else begin + let v = r.values.(i) in + if f v then + v + else + loop (i + 1) + end + in + loop 0 + let is_filled r = r.num_filled >= Array.length r.values diff --git a/tests/misc/java/projects/Issue10280/Main.hx b/tests/misc/java/projects/Issue10280/Main.hx index 14bcefb7483..bf2044f98e2 100644 --- a/tests/misc/java/projects/Issue10280/Main.hx +++ b/tests/misc/java/projects/Issue10280/Main.hx @@ -29,12 +29,11 @@ class OldClass { public function new() {} } ); - - Compiler.exclude('OldClass'); - defined = true; }); + Context.onGenerate(_ -> Compiler.exclude('OldClass')); + return null; } } \ No newline at end of file diff --git a/tests/server/src/Main.hx b/tests/server/src/Main.hx index 77aa51ba3a0..e35a4cafcbe 100644 --- a/tests/server/src/Main.hx +++ b/tests/server/src/Main.hx @@ -13,4 +13,4 @@ class Main { report.displaySuccessResults = NeverShowSuccessResults; runner.run(); } -} +} \ No newline at end of file diff --git a/tests/server/src/TestCase.hx b/tests/server/src/TestCase.hx index 621dd1702bf..0d4b9d3a283 100644 --- a/tests/server/src/TestCase.hx +++ b/tests/server/src/TestCase.hx @@ -120,7 +120,12 @@ class TestCase implements ITest { errorMessages = []; server.rawRequest(args, null, function(result) { handleResult(result); - callback(Json.parse(result.stderr).result.result); + var json = Json.parse(result.stderr); + if (json.result != null) { + callback(json.result.result); + } else { + sendErrorMessage('Error: ' + json.error); + } done(); }, function(msg) { sendErrorMessage(msg); From cf2a77b4066874dffa38656177e3ead277076e07 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 11 Jan 2024 06:33:29 +0100 Subject: [PATCH 055/125] [jvm] factor out zip output --- src/core/zip_output.ml | 18 ++++++++++++++++++ src/generators/genjvm.ml | 25 +++---------------------- 2 files changed, 21 insertions(+), 22 deletions(-) create mode 100644 src/core/zip_output.ml diff --git a/src/core/zip_output.ml b/src/core/zip_output.ml new file mode 100644 index 00000000000..c2bf513d49d --- /dev/null +++ b/src/core/zip_output.ml @@ -0,0 +1,18 @@ +class virtual any_output = object(self) + method virtual add_entry : string -> string -> unit + method virtual close : unit +end + +class zip_output + (zip_path : string) + (compression_level : int) += object(self) + inherit any_output + val zip = Zip.open_out zip_path + + method add_entry (content : string) (name : string) = + Zip.add_entry ~level:compression_level content zip name + + method close = + Zip.close_out zip +end \ No newline at end of file diff --git a/src/generators/genjvm.ml b/src/generators/genjvm.ml index 657c594be02..158306a5079 100644 --- a/src/generators/genjvm.ml +++ b/src/generators/genjvm.ml @@ -50,16 +50,11 @@ let get_construction_mode c cf = if Meta.has Meta.HxGen cf.cf_meta then ConstructInitPlusNew else ConstructInit -class virtual jvm_output = object(self) - method virtual add_entry : string -> string -> unit - method virtual close : unit -end - (* Haxe *) type generation_context = { com : Common.context; - out : jvm_output; + out : Zip_output.any_output; t_runtime_exception : Type.t; entry_point : (tclass * texpr) option; t_exception : Type.t; @@ -109,24 +104,10 @@ let run_timed gctx detail name f = sub#run_finally f (fun () -> gctx.timer <- old) end -class jar_output - (jar_path : string) - (compression_level : int) -= object(self) - inherit jvm_output - val jar = Zip.open_out jar_path - - method add_entry (content : string) (name : string) = - Zip.add_entry ~level:compression_level content jar name - - method close = - Zip.close_out jar -end - class file_output (base_path : string) = object(self) - inherit jvm_output + inherit Zip_output.any_output method add_entry (content : string) (name : string) = let path = base_path ^ name in @@ -3031,7 +3012,7 @@ let generate jvm_flag com = in if compression_level < 0 || compression_level > 9 then failwith "Invalid value for -D jvm.compression-level: Must be >=0 and <= 9"; let create_jar path = - new jar_output path compression_level + new Zip_output.zip_output path compression_level in let out_dir,out = if jvm_flag then begin match path.file_name with From 074077e53c8bef41dcd0dd49908106487e91fbe0 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 11 Jan 2024 06:35:49 +0100 Subject: [PATCH 056/125] [compiler] split up native lib handling --- src/compiler/compiler.ml | 16 +++++++++------- src/compiler/serverCompilationContext.ml | 2 ++ 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml index 9e9b61dc6f8..da967e5fcc7 100644 --- a/src/compiler/compiler.ml +++ b/src/compiler/compiler.ml @@ -162,7 +162,13 @@ module Setup = struct add_std "eval"; "eval" - let create_typer_context ctx macros native_libs = + let init_native_libs com native_libs = + (* Native lib pass 1: Register *) + let fl = List.map (fun lib -> NativeLibraryHandler.add_native_lib com lib) (List.rev native_libs) in + (* Native lib pass 2: Initialize *) + List.iter (fun f -> f()) fl + + let create_typer_context ctx macros = let com = ctx.com in Common.log com ("Classpath: " ^ (String.concat ";" com.class_path)); let buffer = Buffer.create 64 in @@ -174,10 +180,6 @@ module Setup = struct Buffer.truncate buffer (Buffer.length buffer - 1); Common.log com (Buffer.contents buffer); com.callbacks#run com.error_ext com.callbacks#get_before_typer_create; - (* Native lib pass 1: Register *) - let fl = List.map (fun lib -> NativeLibraryHandler.add_native_lib com lib) (List.rev native_libs) in - (* Native lib pass 2: Initialize *) - List.iter (fun f -> f()) fl; TyperEntry.create com macros let executable_path() = @@ -279,7 +281,6 @@ let do_type ctx mctx actx display_file_dot_path macro_cache_enabled = CommonCache.maybe_add_context_sign cs com "before_init_macros"; enter_stage com CInitMacrosStart; ServerMessage.compiler_stage com; - let mctx = List.fold_left (fun mctx path -> Some (MacroContext.call_init_macro ctx.com mctx path) ) mctx (List.rev actx.config_macros) in @@ -288,7 +289,8 @@ let do_type ctx mctx actx display_file_dot_path macro_cache_enabled = MacroContext.macro_enable_cache := macro_cache_enabled; let macros = match mctx with None -> None | Some mctx -> mctx.g.macros in - let tctx = Setup.create_typer_context ctx macros actx.native_libs in + Setup.init_native_libs com actx.native_libs; + let tctx = Setup.create_typer_context ctx macros in let display_file_dot_path = DisplayProcessing.maybe_load_display_file_before_typing tctx display_file_dot_path in check_defines ctx.com; CommonCache.lock_signature com "after_init_macros"; diff --git a/src/compiler/serverCompilationContext.ml b/src/compiler/serverCompilationContext.ml index d0c87099acd..479ae5c768f 100644 --- a/src/compiler/serverCompilationContext.ml +++ b/src/compiler/serverCompilationContext.ml @@ -59,7 +59,9 @@ let reset sctx = let maybe_cache_context sctx com = if com.display.dms_full_typing && com.display.dms_populate_cache then begin + let t = Timer.timer ["server";"cache context"] in CommonCache.cache_context sctx.cs com; + t(); ServerMessage.cached_modules com "" (List.length com.modules); end From 3c07ce1569df6daf03a4fa4a8ab520af5273759a Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 11 Jan 2024 06:46:10 +0100 Subject: [PATCH 057/125] [generic] make type parameter cloning more accurate --- src/context/common.ml | 1 + src/context/typecore.ml | 12 +++++++++++ src/typing/generic.ml | 43 ++++++++++++++++++++++++++++++---------- src/typing/typerEntry.ml | 5 ++++- 4 files changed, 50 insertions(+), 11 deletions(-) diff --git a/src/context/common.ml b/src/context/common.ml index 89d0444e83d..fe49741dcb4 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -890,6 +890,7 @@ let clone com is_macro_context = { com with cache = None; basic = { t with + tvoid = mk_mono(); tint = mk_mono(); tfloat = mk_mono(); tbool = mk_mono(); diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 1d5ac7e250d..911d4270099 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -506,6 +506,18 @@ let is_forced_inline c cf = let needs_inline ctx c cf = cf.cf_kind = Method MethInline && ctx.allow_inline && (ctx.g.doinline || is_forced_inline c cf) +let clone_type_parameter map path ttp = + let c = ttp.ttp_class in + let c = {c with cl_path = path} in + let def = Option.map map ttp.ttp_default in + let constraints = match ttp.ttp_constraints with + | None -> None + | Some constraints -> Some (lazy (List.map map (Lazy.force constraints))) + in + let ttp' = mk_type_param c ttp.ttp_host def constraints in + c.cl_kind <- KTypeParameter ttp'; + ttp' + (** checks if we can access to a given class field using current context *) let can_access ctx c cf stat = if (has_class_field_flag cf CfPublic) then diff --git a/src/typing/generic.ml b/src/typing/generic.ml index 2c34510de40..90ba146a894 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -231,6 +231,10 @@ let build_instances ctx t p = in loop t +let clone_type_parameter gctx mg path ttp = + let ttp = clone_type_parameter (generic_substitute_type gctx) path ttp in + ttp.ttp_class.cl_module <- mg; + ttp let build_generic_class ctx c p tl = let pack = fst c.cl_path in @@ -309,14 +313,7 @@ let build_generic_class ctx c p tl = set_type_parameter_dependencies mg tl; let build_field cf_old = let params = List.map (fun ttp -> - let c = {ttp.ttp_class with cl_module = mg} in - let def = Option.map (generic_substitute_type gctx) ttp.ttp_default in - let constraints = match ttp.ttp_constraints with - | None -> None - | Some constraints -> Some (lazy (List.map (generic_substitute_type gctx) (Lazy.force constraints))) - in - let ttp' = mk_type_param c ttp.ttp_host def constraints in - c.cl_kind <- KTypeParameter ttp'; + let ttp' = clone_type_parameter gctx mg ([cf_old.cf_name],ttp.ttp_name) ttp in (ttp.ttp_type,ttp') ) cf_old.cf_params in let param_subst = List.map (fun (t,ttp) -> t,(ttp.ttp_type,None)) params in @@ -409,6 +406,17 @@ let build_generic_class ctx c p tl = TInst (cg,[]) end +let extract_type_parameters tl = + let params = DynArray.create () in + let rec loop t = match follow t with + | TInst({cl_kind = KTypeParameter ttp},[]) -> + DynArray.add params ttp; + | _ -> + TFunctions.iter loop t + in + List.iter loop tl; + DynArray.to_list params + let type_generic_function ctx fa fcc with_type p = let c,stat = match fa.fa_host with | FHInstance(c,tl) -> c,false @@ -432,8 +440,18 @@ let type_generic_function ctx fa fcc with_type p = ) monos; let el = fcc.fc_args in let gctx = make_generic ctx cf.cf_params monos (Meta.has (Meta.Custom ":debug.generic") cf.cf_meta) p in - let fc_type = build_instances ctx fcc.fc_type p in let name = cf.cf_name ^ "_" ^ gctx.name in + let params = extract_type_parameters monos in + let clones = List.map (fun ttp -> + let name_path = if (fst ttp.ttp_class.cl_path) = [cf.cf_name] then ([name],ttp.ttp_name) else ttp.ttp_class.cl_path in + clone_type_parameter gctx c.cl_module name_path ttp + ) params in + let param_subst = List.map2 (fun ttp ttp' -> + (ttp.ttp_type,ttp') + ) params clones in + let param_subst = List.map (fun (t,ttp) -> t,(ttp.ttp_type,None)) param_subst in + let gctx = {gctx with subst = param_subst @ gctx.subst} in + let fc_type = build_instances ctx (generic_substitute_type gctx fcc.fc_type) p in let unify_existing_field tcf pcf = try unify_raise tcf fc_type p with Error ({ err_message = Unify _; err_depth = depth } as err) -> @@ -484,7 +502,12 @@ let type_generic_function ctx fa fcc with_type p = ); cf2.cf_kind <- cf.cf_kind; if not (has_class_field_flag cf CfPublic) then remove_class_field_flag cf2 CfPublic; - cf2.cf_meta <- (Meta.NoCompletion,[],p) :: (Meta.NoUsing,[],p) :: (Meta.GenericInstance,[],p) :: cf.cf_meta + let meta = List.filter (fun (meta,_,_) -> match meta with + | Meta.Generic -> false + | _ -> true + ) cf.cf_meta in + cf2.cf_meta <- (Meta.NoCompletion,[],p) :: (Meta.NoUsing,[],p) :: (Meta.GenericInstance,[],p) :: meta; + cf2.cf_params <- clones in let mk_cf2 name = mk_field ~static:stat name fc_type cf.cf_pos cf.cf_name_pos diff --git a/src/typing/typerEntry.ml b/src/typing/typerEntry.ml index 0a57a36f729..096f5d7b2f0 100644 --- a/src/typing/typerEntry.ml +++ b/src/typing/typerEntry.ml @@ -90,7 +90,10 @@ let create com macros = match t with | TAbstractDecl a -> (match snd a.a_path with - | "Void" -> ctx.t.tvoid <- TAbstract (a,[]); + | "Void" -> + let t = TAbstract (a,[]) in + Type.unify t ctx.t.tvoid; + ctx.t.tvoid <- t; | "Float" -> let t = (TAbstract (a,[])) in Type.unify t ctx.t.tfloat; From 58e9e5245bf727a89c04de5b68b213a0fb50921a Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 11 Jan 2024 07:01:53 +0100 Subject: [PATCH 058/125] [typer] rework unify_anons --- src/core/tUnification.ml | 101 +++++++++++++++++++++++++-------------- 1 file changed, 64 insertions(+), 37 deletions(-) diff --git a/src/core/tUnification.ml b/src/core/tUnification.ml index 25bad0a5f81..055c1ecf562 100644 --- a/src/core/tUnification.ml +++ b/src/core/tUnification.ml @@ -338,6 +338,13 @@ let fast_eq_check type_param_check a b = c1 == c2 && List.for_all2 type_param_check l1 l2 | TAbstract (a1,l1), TAbstract (a2,l2) -> a1 == a2 && List.for_all2 type_param_check l1 l2 + | TAnon an1,TAnon an2 -> + begin match !(an1.a_status),!(an2.a_status) with + | ClassStatics c, ClassStatics c2 -> c == c2 + | EnumStatics e, EnumStatics e2 -> e == e2 + | AbstractStatics a, AbstractStatics a2 -> a == a2 + | _ -> false + end | _ , _ -> false @@ -386,9 +393,6 @@ let rec shallow_eq a b = loop (List.sort sort_compare fields1) (List.sort sort_compare fields2) in (match !(a2.a_status), !(a1.a_status) with - | ClassStatics c, ClassStatics c2 -> c == c2 - | EnumStatics e, EnumStatics e2 -> e == e2 - | AbstractStatics a, AbstractStatics a2 -> a == a2 | Extend tl1, Extend tl2 -> fields_eq() && List.for_all2 shallow_eq tl1 tl2 | Closed, Closed -> fields_eq() | Const, Const -> fields_eq() @@ -565,6 +569,10 @@ let rec type_eq uctx a b = | AbstractStatics a -> (match !(a1.a_status) with AbstractStatics a2 when a == a2 -> () | _ -> error []) | _ -> () ); + let fields = match !(a1.a_status) with + | ClassStatics c -> c.cl_statics + | _ -> a1.a_fields + in PMap.iter (fun n f1 -> try let f2 = PMap.find n a2.a_fields in @@ -575,9 +583,9 @@ let rec type_eq uctx a b = with Not_found -> error [has_no_field b n]; - ) a1.a_fields; + ) fields; PMap.iter (fun n f2 -> - if not (PMap.mem n a1.a_fields) then begin + if not (PMap.mem n fields) then begin error [has_no_field a n]; end; ) a2.a_fields; @@ -897,39 +905,58 @@ let rec unify (uctx : unification_context) a b = error [cannot_unify a b] and unify_anons uctx a b a1 a2 = - (try - PMap.iter (fun n f2 -> + let unify_field a1_fields f2 = + let n = f2.cf_name in + let f1 = PMap.find n a1_fields in + if not (unify_kind f1.cf_kind f2.cf_kind) then + error [invalid_kind n f1.cf_kind f2.cf_kind]; + if (has_class_field_flag f2 CfPublic) && not (has_class_field_flag f1 CfPublic) then + error [invalid_visibility n]; try - let f1 = PMap.find n a1.a_fields in - if not (unify_kind f1.cf_kind f2.cf_kind) then - error [invalid_kind n f1.cf_kind f2.cf_kind]; - if (has_class_field_flag f2 CfPublic) && not (has_class_field_flag f1 CfPublic) then error [invalid_visibility n]; - try - let f1_type = - if fast_eq f1.cf_type f2.cf_type then f1.cf_type - else field_type f1 - in - unify_with_access uctx f1 f1_type f2; - (match !(a1.a_status) with - | ClassStatics c when not (Meta.has Meta.MaybeUsed f1.cf_meta) -> f1.cf_meta <- (Meta.MaybeUsed,[],f1.cf_pos) :: f1.cf_meta - | _ -> ()); - with - Unify_error l -> error (invalid_field n :: l) - with - Not_found -> - match !(a1.a_status) with - | Const when Meta.has Meta.Optional f2.cf_meta -> - a1.a_fields <- PMap.add f2.cf_name f2 a1.a_fields - | _ -> - error [has_no_field a n]; - ) a2.a_fields; - (match !(a2.a_status) with - | ClassStatics c -> (match !(a1.a_status) with ClassStatics c2 when c == c2 -> () | _ -> error []) - | EnumStatics e -> (match !(a1.a_status) with EnumStatics e2 when e == e2 -> () | _ -> error []) - | AbstractStatics a -> (match !(a1.a_status) with AbstractStatics a2 when a == a2 -> () | _ -> error []) - | Const | Extend _ | Closed -> ()) - with - Unify_error l -> error (cannot_unify a b :: l)) + let f1_type = + if fast_eq f1.cf_type f2.cf_type then f1.cf_type + else field_type f1 + in + unify_with_access uctx f1 f1_type f2; + f1 + with Unify_error l -> + error (invalid_field n :: l) + in + let unify_fields a1_fields f_good f_bad = + try + PMap.iter (fun _ f2 -> + try + f_good (unify_field a1_fields f2) + with Not_found -> + if not (f_bad f2) then + error [has_no_field a f2.cf_name] + ) a2.a_fields + with Unify_error l -> + error (cannot_unify a b :: l) + in + begin match !(a1.a_status),!(a2.a_status) with + | ClassStatics c1,ClassStatics c2 when c1 == c2 -> + () + | EnumStatics en1,EnumStatics en2 when en1 == en2 -> + () + | AbstractStatics a1,AbstractStatics a2 when a1 == a2 -> + () + | Const,_ -> + unify_fields a1.a_fields (fun _ -> ()) (fun f2 -> + if Meta.has Meta.Optional f2.cf_meta then begin + a1.a_fields <- PMap.add f2.cf_name f2 a1.a_fields; + true + end else + false + ) + | ClassStatics c1,_ -> + unify_fields c1.cl_statics (fun f1 -> + if not (Meta.has Meta.MaybeUsed f1.cf_meta) then + f1.cf_meta <- (Meta.MaybeUsed,[],f1.cf_pos) :: f1.cf_meta + ) (fun _ -> false) + | _ -> + unify_fields a1.a_fields (fun _ -> ()) (fun _ -> false) + end and does_func_unify f = try f(); true with Unify_error _ -> false From dec37b31a0af73de9ec59db040ce73e6cc37b345 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 11 Jan 2024 08:42:55 +0100 Subject: [PATCH 059/125] [libs] delete things randomly --- libs/Makefile | 3 +- libs/ocamake/ocamake.dsp | 66 ---- libs/ocamake/ocamake.dsw | 29 -- libs/ocamake/ocamake.html | 94 ----- libs/ocamake/ocamake.ml | 661 ------------------------------- libs/swflib/swflib.sln | 21 - libs/swflib/swflib.vcproj | 80 ---- libs/ttflib/Makefile | 31 -- libs/ttflib/dune | 14 - libs/ttflib/main.ml | 139 ------- libs/ttflib/tTFCanvasWriter.ml | 50 --- libs/ttflib/tTFData.ml | 360 ----------------- libs/ttflib/tTFJsonWriter.ml | 49 --- libs/ttflib/tTFParser.ml | 688 --------------------------------- libs/ttflib/tTFSwfWriter.ml | 211 ---------- libs/ttflib/tTFTools.ml | 275 ------------- src/dune | 2 +- src/generators/genswf.ml | 55 --- 18 files changed, 2 insertions(+), 2826 deletions(-) delete mode 100644 libs/ocamake/ocamake.dsp delete mode 100644 libs/ocamake/ocamake.dsw delete mode 100644 libs/ocamake/ocamake.html delete mode 100644 libs/ocamake/ocamake.ml delete mode 100644 libs/swflib/swflib.sln delete mode 100644 libs/swflib/swflib.vcproj delete mode 100644 libs/ttflib/Makefile delete mode 100644 libs/ttflib/dune delete mode 100644 libs/ttflib/main.ml delete mode 100644 libs/ttflib/tTFCanvasWriter.ml delete mode 100644 libs/ttflib/tTFData.ml delete mode 100644 libs/ttflib/tTFJsonWriter.ml delete mode 100644 libs/ttflib/tTFParser.ml delete mode 100644 libs/ttflib/tTFSwfWriter.ml delete mode 100644 libs/ttflib/tTFTools.ml diff --git a/libs/Makefile b/libs/Makefile index d0b240a9d64..09637139c63 100644 --- a/libs/Makefile +++ b/libs/Makefile @@ -1,7 +1,7 @@ OCAMLOPT = ocamlopt OCAMLC = ocamlc TARGET_FLAG = all -LIBS=extlib-leftovers extc neko javalib ilib swflib ttflib objsize pcre2 ziplib +LIBS=extlib-leftovers extc neko javalib ilib swflib objsize pcre2 ziplib all: $(LIBS) $(LIBS): @@ -14,7 +14,6 @@ clean: $(MAKE) -C javalib clean $(MAKE) -C ilib clean $(MAKE) -C swflib clean - $(MAKE) -C ttflib clean $(MAKE) -C objsize clean $(MAKE) -C pcre2 clean $(MAKE) -C ziplib clean diff --git a/libs/ocamake/ocamake.dsp b/libs/ocamake/ocamake.dsp deleted file mode 100644 index 461ebd15741..00000000000 --- a/libs/ocamake/ocamake.dsp +++ /dev/null @@ -1,66 +0,0 @@ -# Microsoft Developer Studio Project File - Name="ocamake" - Package Owner=<4> -# Microsoft Developer Studio Generated Build File, Format Version 6.00 -# ** DO NOT EDIT ** - -# TARGTYPE "Win32 (x86) External Target" 0x0106 - -CFG=ocamake - Win32 Native code -!MESSAGE This is not a valid makefile. To build this project using NMAKE, -!MESSAGE use the Export Makefile command and run -!MESSAGE -!MESSAGE NMAKE /f "ocamake.mak". -!MESSAGE -!MESSAGE You can specify a configuration when running NMAKE -!MESSAGE by defining the macro CFG on the command line. For example: -!MESSAGE -!MESSAGE NMAKE /f "ocamake.mak" CFG="ocamake - Win32 Native code" -!MESSAGE -!MESSAGE Possible choices for configuration are: -!MESSAGE -!MESSAGE "ocamake - Win32 Native code" (based on "Win32 (x86) External Target") -!MESSAGE - -# Begin Project -# PROP AllowPerConfigDependencies 0 -# PROP Scc_ProjName "" -# PROP Scc_LocalPath "" -# PROP BASE Use_MFC 0 -# PROP BASE Use_Debug_Libraries 0 -# PROP BASE Output_Dir "" -# PROP BASE Intermediate_Dir "" -# PROP BASE Cmd_Line "ocamake -opt ocamake.dsp -o ocamake.exe" -# PROP BASE Rebuild_Opt "-all" -# PROP BASE Target_File "ocamake_opt.exe" -# PROP BASE Bsc_Name "" -# PROP BASE Target_Dir "" -# PROP Use_MFC 0 -# PROP Use_Debug_Libraries 0 -# PROP Output_Dir "" -# PROP Intermediate_Dir "" -# PROP Cmd_Line "ocamake str.cmxa unix.cmxa -opt ocamake.dsp -o ocadbg.exe" -# PROP Rebuild_Opt "-all" -# PROP Target_File "ocadbg.exe" -# PROP Bsc_Name "" -# PROP Target_Dir "" -# Begin Target - -# Name "ocamake - Win32 Native code" - -!IF "$(CFG)" == "ocamake - Win32 Native code" - -!ENDIF - -# Begin Group "ML Files" - -# PROP Default_Filter "ml;mly;mll" -# Begin Source File - -SOURCE=.\ocamake.ml -# End Source File -# End Group -# Begin Group "MLI Files" - -# PROP Default_Filter "mli" -# End Group -# End Target -# End Project diff --git a/libs/ocamake/ocamake.dsw b/libs/ocamake/ocamake.dsw deleted file mode 100644 index 620f4514a98..00000000000 --- a/libs/ocamake/ocamake.dsw +++ /dev/null @@ -1,29 +0,0 @@ -Microsoft Developer Studio Workspace File, Format Version 6.00 -# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE! - -############################################################################### - -Project: "ocamake"=.\ocamake.dsp - Package Owner=<4> - -Package=<5> -{{{ -}}} - -Package=<4> -{{{ -}}} - -############################################################################### - -Global: - -Package=<5> -{{{ -}}} - -Package=<3> -{{{ -}}} - -############################################################################### - diff --git a/libs/ocamake/ocamake.html b/libs/ocamake/ocamake.html deleted file mode 100644 index 9af8925b504..00000000000 --- a/libs/ocamake/ocamake.html +++ /dev/null @@ -1,94 +0,0 @@ - - -
OCamake
-
- - OCamake - Copyright (c)2002-2003 Nicolas Cannasse & Motion Twin.
- The last version of this software can be found at : http://tech.motion-twin.com

- This software is provided "AS IS" without any warranty of any kind, merchantability or fitness for a particular purpose. You should use it at your own risks, as the author and his company won't be responsible for any problem that the usage of this software could raise. - -
-
- -