diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index aa9c2aebe97..71967c57544 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -476,10 +476,6 @@ let interpolate_code com code tl f_string f_expr p = i := !i + String.length txt; f_string txt; loop tl - | Str.Delim a :: Str.Delim b :: tl when a = b -> - i := !i + 2; - f_string a; - loop tl | Str.Delim "{" :: Str.Text n :: Str.Delim "}" :: tl -> begin try let expr = Array.get exprs (int_of_string n) in diff --git a/src/compiler/messageReporting.ml b/src/compiler/messageReporting.ml index 88548d5a480..ae065d2d8fa 100644 --- a/src/compiler/messageReporting.ml +++ b/src/compiler/messageReporting.ml @@ -21,39 +21,36 @@ let resolve_source file l1 p1 l2 p2 = end in - try - let read_char line = match input_char_or_done ch line with - | '\n' -> inc 1 line - | '\r' -> - ignore(input_char_or_done ch line); - inc 2 line - | c -> begin - let line = ref (line ^ (String.make 1 c)) in - let rec skip n = - if n > 0 then begin - let c = input_char_or_done ch !line in - line := !line ^ (String.make 1 c); - skip (n - 1) - end - in - - let code = int_of_char c in - if code < 0xC0 then () - else if code < 0xE0 then skip 1 - else if code < 0xF0 then skip 2 - else skip 3; - - (1, !line) - end - in + let read_char line = match input_char_or_done ch line with + | '\n' -> inc 1 line + | '\r' -> + ignore(input_char_or_done ch line); + inc 2 line + | c -> begin + let line = ref (line ^ (String.make 1 c)) in + let rec skip n = + if n > 0 then begin + let c = input_char_or_done ch !line in + line := !line ^ (String.make 1 c); + skip (n - 1) + end + in + + let code = int_of_char c in + if code < 0xC0 then () + else if code < 0xE0 then skip 1 + else if code < 0xF0 then skip 2 + else skip 3; + + (1, !line) + end + in - let (delta, line) = read_char line in - loop (p + delta) line - with End_of_file -> - close_in ch; + let (delta, line) = read_char line in + loop (p + delta) line in - loop 0 ""; + try loop 0 ""; with End_of_file -> close_in ch; List.rev !lines let resolve_file ctx f = diff --git a/src/context/display/diagnostics.ml b/src/context/display/diagnostics.ml index 26ee74a52aa..a9db7478f8a 100644 --- a/src/context/display/diagnostics.ml +++ b/src/context/display/diagnostics.ml @@ -44,18 +44,18 @@ let check_other_things com e = let pointless_compound s p = add_diagnostics_message com (Printf.sprintf "This %s has no effect, but some of its sub-expressions do" s) p DKCompilerMessage Warning; in - let rec compound s el p = + let rec compound compiler_generated s el p = let old = !had_effect in had_effect := false; - List.iter (loop true) el; - if not !had_effect then no_effect p else pointless_compound s p; + List.iter (loop true compiler_generated) el; + if not !had_effect then no_effect p else if not compiler_generated then pointless_compound s p; had_effect := old; - and loop in_value e = match e.eexpr with + and loop in_value compiler_generated e = match e.eexpr with | TBlock el -> let rec loop2 el = match el with | [] -> () - | [e] -> loop in_value e - | e :: el -> loop false e; loop2 el + | [e] -> loop in_value compiler_generated e + | e :: el -> loop false compiler_generated e; loop2 el in loop2 el | TMeta((Meta.Extern,_,_),_) -> @@ -67,27 +67,29 @@ let check_other_things com e = () | TField (_, fa) when PurityState.is_explicitly_impure fa -> () | TFunction tf -> - loop false tf.tf_expr - | TCall({eexpr = TField(e1,fa)},el) when not in_value && PurityState.is_pure_field_access fa -> compound "call" el e.epos + loop false compiler_generated tf.tf_expr + | TCall({eexpr = TField(e1,fa)},el) when not in_value && PurityState.is_pure_field_access fa -> compound compiler_generated "call" el e.epos | TNew _ | TCall _ | TBinop ((Ast.OpAssignOp _ | Ast.OpAssign),_,_) | TUnop ((Ast.Increment | Ast.Decrement),_,_) | TReturn _ | TBreak | TContinue | TThrow _ | TCast (_,Some _) | TIf _ | TTry _ | TSwitch _ | TWhile _ | TFor _ -> had_effect := true; - Type.iter (loop true) e + Type.iter (loop true compiler_generated) e + | TMeta((Meta.CompilerGenerated,_,_),e1) -> + loop in_value true e1 | TParenthesis e1 | TMeta(_,e1) -> - loop in_value e1 + loop in_value compiler_generated e1 | TArray _ | TCast (_,None) | TBinop _ | TUnop _ | TField _ | TArrayDecl _ | TObjectDecl _ when in_value -> - Type.iter (loop true) e; - | TArray(e1,e2) -> compound "array access" [e1;e2] e.epos - | TCast(e1,None) -> compound "cast" [e1] e.epos - | TBinop(op,e1,e2) -> compound (Printf.sprintf "'%s' operator" (s_binop op)) [e1;e2] e.epos - | TUnop(op,_,e1) -> compound (Printf.sprintf "'%s' operator" (s_unop op)) [e1] e.epos - | TField(e1,_) -> compound "field access" [e1] e.epos - | TArrayDecl el -> compound "array declaration" el e.epos - | TObjectDecl fl -> compound "object declaration" (List.map snd fl) e.epos + Type.iter (loop true compiler_generated) e; + | TArray(e1,e2) -> compound compiler_generated "array access" [e1;e2] e.epos + | TCast(e1,None) -> compound compiler_generated "cast" [e1] e.epos + | TBinop(op,e1,e2) -> compound compiler_generated (Printf.sprintf "'%s' operator" (s_binop op)) [e1;e2] e.epos + | TUnop(op,_,e1) -> compound compiler_generated (Printf.sprintf "'%s' operator" (s_unop op)) [e1] e.epos + | TField(e1,_) -> compound compiler_generated "field access" [e1] e.epos + | TArrayDecl el -> compound compiler_generated "array declaration" el e.epos + | TObjectDecl fl -> compound compiler_generated "object declaration" (List.map snd fl) e.epos in - loop true e + loop true false e let prepare_field dctx dectx com cf = match cf.cf_expr with | None -> () @@ -176,9 +178,7 @@ let prepare com = dctx let secure_generated_code ctx e = - (* This causes problems and sucks in general... need a different solution. But I forgot which problem this solved anyway. *) - (* mk (TMeta((Meta.Extern,[],e.epos),e)) e.etype e.epos *) - e + if is_diagnostics ctx then mk (TMeta((Meta.CompilerGenerated,[],e.epos),e)) e.etype e.epos else e let print com = let dctx = prepare com in diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 561bd9e3004..158825e6931 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -374,7 +374,7 @@ let add_local_with_origin ctx origin n t p = check_local_variable_name ctx n origin p; add_local ctx (VUser origin) n t p -let gen_local_prefix = "_g" +let gen_local_prefix = "`" let gen_local ctx t p = add_local ctx VGenerated gen_local_prefix t p diff --git a/src/filters/renameVars.ml b/src/filters/renameVars.ml index 33a6fba1a00..b23c61139f9 100644 --- a/src/filters/renameVars.ml +++ b/src/filters/renameVars.ml @@ -358,11 +358,17 @@ and collect_ignore_block ?(in_block=false) rc scope e = (** Rename `v` if needed *) +let trailing_numbers = Str.regexp "[0-9]+$" let maybe_rename_var rc reserved (v,overlaps) = let commit name = v.v_meta <- (Meta.RealPath,[EConst (String(v.v_name,SDoubleQuotes)),null_pos],null_pos) :: v.v_meta; v.v_name <- name in + (* chop escape char for all local variables generated *) + if String.unsafe_get v.v_name 0 = String.unsafe_get Typecore.gen_local_prefix 0 then begin + let name = String.sub v.v_name 1 (String.length v.v_name - 1) in + commit ("_g" ^ (Str.replace_first trailing_numbers "" name)) + end; let rec loop name count = if StringMap.mem name !reserved || Overlaps.has_name name overlaps then begin let count = count + 1 in diff --git a/src/optimization/inline.ml b/src/optimization/inline.ml index 1291af0f4bc..5157d03e78a 100644 --- a/src/optimization/inline.ml +++ b/src/optimization/inline.ml @@ -589,7 +589,7 @@ class inline_state ctx ethis params cf f p = object(self) mk (TBlock (DynArray.to_list el)) tret e.epos in let e = inline_metadata e cf.cf_meta in - let e = Diagnostics.secure_generated_code ctx e in + let e = Diagnostics.secure_generated_code ctx.com e in if has_params then begin let mt = map_type cf.cf_type in let unify_func () = unify_raise mt (TFun (tl,tret)) p in @@ -656,7 +656,7 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f ) in (match api_inline ctx cl cf.cf_name params p with | None -> raise Exit - | Some e -> Some e) + | Some e -> e) with Exit -> let has_params,map_type = match config with Some config -> config | None -> inline_default_config cf ethis.etype in let params = inline_rest_params ctx f params map_type p in @@ -831,10 +831,8 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f state#set_side_effect; begin match follow t with | TInst({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some ({eexpr = TFunction tf})} as cf)} as c,_) -> - begin match type_inline_ctor ctx c cf tf ethis el po with - | Some e -> map term false e - | None -> raise_typing_error "Could not inline super constructor call" po - end + let e = type_inline_ctor ctx c cf tf ethis el po in + map term false e | _ -> raise_typing_error "Cannot inline function containing super" po end | TCall(e1,el) -> @@ -876,7 +874,7 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f (se "\t" e) ); end; - Some e + e (* Same as type_inline, but modifies the function body to add field inits *) and type_inline_ctor ctx c cf tf ethis el po = diff --git a/src/optimization/inlineConstructors.ml b/src/optimization/inlineConstructors.ml index 3c629c0f948..63cc3f926f5 100644 --- a/src/optimization/inlineConstructors.ml +++ b/src/optimization/inlineConstructors.ml @@ -374,34 +374,29 @@ let inline_constructors ctx original_e = let argvs, pl = analyze_call_args pl in let _, cname = c.cl_path in let v = alloc_var VGenerated ("inl"^cname) e.etype e.epos in - match Inline.type_inline_ctor ctx c cf tf (mk (TLocal v) (TInst (c,tl)) e.epos) pl e.epos with - | Some inlined_expr -> - let inlined_expr = mark_ctors inlined_expr in - let has_untyped = (Meta.has Meta.HasUntyped cf.cf_meta) in - let forced = is_extern_ctor c cf || force_inline in - let io = mk_io (IOKCtor{ioc_class=c; ioc_tparams=tl; ioc_field=cf; ioc_forced=forced}) io_id inlined_expr ~has_untyped:has_untyped in - io.io_dependent_vars <- argvs; - let rec loop (c:tclass) (tl:t list) = - let apply = apply_params c.cl_params tl in - List.iter (fun cf -> - match cf.cf_kind,cf.cf_expr with - | Var _, _ -> - let fieldt = apply cf.cf_type in - ignore(alloc_io_field io cf.cf_name fieldt v.v_pos); - | _ -> () - ) c.cl_ordered_fields; - match c.cl_super with - | Some (c,tl) -> loop c (List.map apply tl) - | None -> () - in loop c tl; - let iv = add v IVKLocal in - set_iv_alias iv io; - ignore(analyze_aliases_in_ctor cf true io.io_expr); - Some iv - | _ -> - List.iter (fun v -> cancel_v v v.v_pos) argvs; - if is_extern_ctor c cf then display_error ctx.com "Extern constructor could not be inlined" e.epos; - None + let inlined_expr = Inline.type_inline_ctor ctx c cf tf (mk (TLocal v) (TInst (c,tl)) e.epos) pl e.epos in + let inlined_expr = mark_ctors inlined_expr in + let has_untyped = (Meta.has Meta.HasUntyped cf.cf_meta) in + let forced = is_extern_ctor c cf || force_inline in + let io = mk_io (IOKCtor{ioc_class=c; ioc_tparams=tl; ioc_field=cf; ioc_forced=forced}) io_id inlined_expr ~has_untyped:has_untyped in + io.io_dependent_vars <- argvs; + let rec loop (c:tclass) (tl:t list) = + let apply = apply_params c.cl_params tl in + List.iter (fun cf -> + match cf.cf_kind,cf.cf_expr with + | Var _, _ -> + let fieldt = apply cf.cf_type in + ignore(alloc_io_field io cf.cf_name fieldt v.v_pos); + | _ -> () + ) c.cl_ordered_fields; + match c.cl_super with + | Some (c,tl) -> loop c (List.map apply tl) + | None -> () + in loop c tl; + let iv = add v IVKLocal in + set_iv_alias iv io; + ignore(analyze_aliases_in_ctor cf true io.io_expr); + Some iv end | TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some _} as cf)} as c,_,pl),_ when is_extern_ctor c cf -> raise_typing_error "Extern constructor could not be inlined" e.epos; @@ -501,29 +496,24 @@ let inline_constructors ctx original_e = let argvs, pl = analyze_call_args call_args in io.io_dependent_vars <- io.io_dependent_vars @ argvs; io.io_has_untyped <- io.io_has_untyped or (Meta.has Meta.HasUntyped cf.cf_meta); - begin match Inline.type_inline ctx cf tf (mk (TLocal io_var.iv_var) (TInst (c,tl)) e.epos) pl e.etype None e.epos true with - | Some e -> - let e = mark_ctors e in - io.io_inline_methods <- io.io_inline_methods @ [e]; - begin match analyze_aliases captured e with - | Some(iv) -> - (* - The parent inline object might have been cancelled while analyzing the inlined method body - If the parent inline object is cancelled the inlining of this method will no longer happen, - so the return value must be cancelled. - *) - if io.io_cancelled then begin - cancel_iv iv e.epos; - None - end else begin - io.io_dependent_vars <- iv.iv_var :: io.io_dependent_vars; - Some(iv) - end - | None -> None - end - | None -> - cancel_io io e.epos; - None + let e = Inline.type_inline ctx cf tf (mk (TLocal io_var.iv_var) (TInst (c,tl)) e.epos) pl e.etype None e.epos true in + let e = mark_ctors e in + io.io_inline_methods <- io.io_inline_methods @ [e]; + begin match analyze_aliases captured e with + | Some(iv) -> + (* + The parent inline object might have been cancelled while analyzing the inlined method body + If the parent inline object is cancelled the inlining of this method will no longer happen, + so the return value must be cancelled. + *) + if io.io_cancelled then begin + cancel_iv iv e.epos; + None + end else begin + io.io_dependent_vars <- iv.iv_var :: io.io_dependent_vars; + Some(iv) + end + | None -> None end | IOFInlineVar(iv) -> cancel_iv iv e.epos; diff --git a/src/optimization/optimizer.ml b/src/optimization/optimizer.ml index 38ac0723096..838611a9bd9 100644 --- a/src/optimization/optimizer.ml +++ b/src/optimization/optimizer.ml @@ -224,6 +224,8 @@ let reduce_expr com e = ) l with | [] -> ec | l -> { e with eexpr = TBlock (List.rev (ec :: l)) }) + | TMeta ((Meta.CompilerGenerated,_,_),ec) -> + { ec with epos = e.epos } | TParenthesis ec -> { ec with epos = e.epos } | TTry (e,[]) -> @@ -350,20 +352,23 @@ let rec reduce_loop ctx e = let cf = mk_field "" ef.etype e.epos null_pos in let ethis = mk (TConst TThis) t_dynamic e.epos in let rt = (match follow ef.etype with TFun (_,rt) -> rt | _ -> die "" __LOC__) in - let inl = (try type_inline ctx cf func ethis el rt None e.epos ~self_calling_closure:true false with Error { err_message = Custom _ } -> None) in - (match inl with - | None -> reduce_expr ctx e - | Some e -> reduce_loop ctx e) + begin try + let e = type_inline ctx cf func ethis el rt None e.epos ~self_calling_closure:true false in + reduce_loop ctx e + with Error { err_message = Custom _ } -> + reduce_expr ctx e + end; | {eexpr = TField(ef,(FStatic(cl,cf) | FInstance(cl,_,cf)))} when needs_inline ctx (Some cl) cf && not (rec_stack_memq cf inline_stack) -> begin match cf.cf_expr with | Some {eexpr = TFunction tf} -> let config = inline_config (Some cl) cf el e.etype in let rt = (match Abstract.follow_with_abstracts e1.etype with TFun (_,rt) -> rt | _ -> die "" __LOC__) in - let inl = (try type_inline ctx cf tf ef el rt config e.epos false with Error { err_message = Custom _ } -> None) in - (match inl with - | None -> reduce_expr ctx e - | Some e -> - rec_stack_default inline_stack cf (fun cf' -> cf' == cf) (fun () -> reduce_loop ctx e) e) + begin try + let e = type_inline ctx cf tf ef el rt config e.epos false in + rec_stack_default inline_stack cf (fun cf' -> cf' == cf) (fun () -> reduce_loop ctx e) e + with Error { err_message = Custom _ } -> + reduce_expr ctx e + end | _ -> reduce_expr ctx e end diff --git a/src/typing/callUnification.ml b/src/typing/callUnification.ml index 1c23197e15a..2d5e44aab54 100644 --- a/src/typing/callUnification.ml +++ b/src/typing/callUnification.ml @@ -493,7 +493,7 @@ object(self) !ethis_f(); raise exc in - let e = Diagnostics.secure_generated_code ctx e in + let e = Diagnostics.secure_generated_code ctx.com e in ctx.com.error_ext <- old; !ethis_f(); e diff --git a/src/typing/calls.ml b/src/typing/calls.ml index 4159527e6a4..ef39f73a99c 100644 --- a/src/typing/calls.ml +++ b/src/typing/calls.ml @@ -70,11 +70,7 @@ let make_call ctx e params t ?(force_inline=false) p = (match f.cf_expr_unoptimized,f.cf_expr with | Some {eexpr = TFunction fd},_ | None,Some { eexpr = TFunction fd } -> - (match Inline.type_inline ctx f fd ethis params t config p force_inline with - | None -> - if force_inline then raise_typing_error "Inline could not be done" p; - raise Exit; - | Some e -> e) + Inline.type_inline ctx f fd ethis params t config p force_inline | _ -> (* we can't inline because there is most likely a loop in the typing. diff --git a/src/typing/operators.ml b/src/typing/operators.ml index 3778c3fe2b7..e399bd42c2a 100644 --- a/src/typing/operators.ml +++ b/src/typing/operators.ml @@ -88,7 +88,7 @@ module BinopResult = struct | BinopSpecial(_,needs_assign) -> needs_assign end -let check_assign ctx e = +let rec check_assign ctx e = match e.eexpr with | TLocal v when has_var_flag v VFinal && not (Common.ignore_error ctx.com) -> raise_typing_error "Cannot assign to final" e.epos @@ -96,6 +96,8 @@ let check_assign ctx e = () | TConst TThis | TTypeExpr _ when ctx.untyped -> () + | TMeta ((Meta.CompilerGenerated,_,_),e1) -> + check_assign ctx e1 | _ -> if not (Common.ignore_error ctx.com) then invalid_assign e.epos diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index 614294287d6..86bee7419da 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -1052,165 +1052,179 @@ let create_variable (ctx,cctx,fctx) c f t eo p = TypeBinding.bind_var ctx cctx fctx cf eo; cf -let check_abstract (ctx,cctx,fctx) c cf fd t ret p = - match cctx.abstract with - | Some a -> - let m = mk_mono() in - let ta = TAbstract(a,List.map (fun _ -> mk_mono()) a.a_params) in - let tthis = if fctx.is_abstract_member || Meta.has Meta.To cf.cf_meta then monomorphs a.a_params a.a_this else a.a_this in - let allows_no_expr = ref (Meta.has Meta.CoreType a.a_meta) in - let allow_no_expr () = if not (has_class_field_flag cf CfExtern) then begin - allows_no_expr := true; - fctx.expr_presence_matters <- true; - end in - let rec loop ml = - (match ml with - | (Meta.From,_,_) :: _ -> - let r = exc_protect ctx (fun r -> - r := lazy_processing (fun () -> t); - (* the return type of a from-function must be the abstract, not the underlying type *) - if not fctx.is_macro then (try type_eq EqStrict ret ta with Unify_error l -> raise_typing_error_ext (make_error (Unify l) p)); - match t with - | TFun([_,_,t],_) -> t - | TFun([(_,_,t1);(_,true,t2)],_) when is_pos_infos t2 -> t1 - | _ -> raise_typing_error ("@:from cast functions must accept exactly one argument") p - ) "@:from" in - a.a_from_field <- (TLazy r,cf) :: a.a_from_field; - | (Meta.To,_,_) :: _ -> - if fctx.is_macro then invalid_modifier ctx.com fctx "macro" "cast function" p; - let are_valid_args args = - match args with - | [_] -> true - | [_; (_,true,t)] when is_pos_infos t -> true - | _ -> false - in - (match cf.cf_kind, cf.cf_type with - | Var _, _ -> - raise_typing_error "Invalid metadata: @:to must be used on method of abstract" p - | Method _, TFun(args, _) when not fctx.is_abstract_member && not (are_valid_args args) -> - if not (Meta.has Meta.MultiType a.a_meta) then (* TODO: get rid of this check once multitype is removed *) - raise_typing_error "static @:to method should have one argument" p - | Method _, TFun(args, _) when fctx.is_abstract_member && not (are_valid_args args) -> - if not (Meta.has Meta.MultiType a.a_meta) then (* TODO: get rid of this check once multitype is removed *) - raise_typing_error "@:to method should have no arguments" p - | _ -> () - ); - (* TODO: this doesn't seem quite right... *) - if not (has_class_field_flag cf CfImpl) then add_class_field_flag cf CfImpl; - let resolve_m args = - (try unify_raise t (tfun (tthis :: args) m) cf.cf_pos with Error ({ err_message = Unify l; } as err) -> raise_typing_error_ext err); - match follow m with - | TMono _ when (match t with TFun(_,r) -> r == t_dynamic | _ -> false) -> t_dynamic - | m -> m - in - let is_multitype_cast = Meta.has Meta.MultiType a.a_meta && not fctx.is_abstract_member in - if is_multitype_cast && not (Meta.has Meta.MultiType cf.cf_meta) then - cf.cf_meta <- (Meta.MultiType,[],null_pos) :: cf.cf_meta; - let r = exc_protect ctx (fun r -> - r := lazy_processing (fun () -> t); - let args = if is_multitype_cast then begin - let ctor = try - PMap.find "_new" c.cl_statics - with Not_found -> - raise_typing_error "Constructor of multi-type abstract must be defined before the individual @:to-functions are" cf.cf_pos - in - (* delay ctx PFinal (fun () -> unify ctx m tthis f.cff_pos); *) - let args = match follow (monomorphs a.a_params ctor.cf_type) with - | TFun(args,_) -> List.map (fun (_,_,t) -> t) args - | _ -> die "" __LOC__ - in - args - end else - match cf.cf_type with - | TFun([_;(_,true,t)],_) when is_pos_infos t -> [t] - | _ -> [] - in - let t = resolve_m args in - t - ) "@:to" in - a.a_to_field <- (TLazy r, cf) :: a.a_to_field - | ((Meta.ArrayAccess,_,_) | (Meta.Op,[(EArrayDecl _),_],_)) :: _ -> - if fctx.is_macro then invalid_modifier ctx.com fctx "macro" "array-access function" p; - a.a_array <- cf :: a.a_array; - allow_no_expr(); - | (Meta.Op,[EBinop(OpAssign,_,_),_],_) :: _ -> - raise_typing_error "Assignment overloading is not supported" p; - | (Meta.Op,[EBinop(OpAssignOp OpNullCoal,_,_),_],_) :: _ - | (Meta.Op,[EBinop(OpNullCoal,_,_),_],_) :: _ -> - raise_typing_error "Null coalescing overloading is not supported" p; - | (Meta.Op,[ETernary(_,_,_),_],_) :: _ -> - raise_typing_error "Ternary overloading is not supported" p; - | (Meta.Op,[EBinop(op,_,_),_],_) :: _ -> - if fctx.is_macro then invalid_modifier ctx.com fctx "macro" "operator function" p; - let targ = if fctx.is_abstract_member then tthis else ta in - let left_eq,right_eq = - match follow t with - | TFun([(_,_,t1);(_,_,t2)],_) -> - type_iseq targ t1,type_iseq targ t2 - | TFun([(_,_,t1);(_,_,t2);(_,true,t3)],_) when is_pos_infos t3 -> - type_iseq targ t1,type_iseq targ t2 - | _ -> - if fctx.is_abstract_member then - raise_typing_error ("Member @:op functions must accept exactly one argument") cf.cf_pos - else - raise_typing_error ("Static @:op functions must accept exactly two arguments") cf.cf_pos - in - if not (left_eq || right_eq) then raise_typing_error ("The left or right argument type must be " ^ (s_type (print_context()) targ)) cf.cf_pos; - if right_eq && Meta.has Meta.Commutative cf.cf_meta then raise_typing_error ("Invalid metadata: @:commutative is only allowed if the right argument is not " ^ (s_type (print_context()) targ)) cf.cf_pos; - a.a_ops <- (op,cf) :: a.a_ops; - allow_no_expr(); - | (Meta.Op,[EUnop(op,flag,_),_],_) :: _ -> - if fctx.is_macro then invalid_modifier ctx.com fctx "macro" "operator function" p; - let targ = if fctx.is_abstract_member then tthis else ta in - (try type_eq EqStrict t (tfun [targ] (mk_mono())) with Unify_error l -> raise_error_msg (Unify l) cf.cf_pos); - a.a_unops <- (op,flag,cf) :: a.a_unops; - allow_no_expr(); - | (Meta.Op,[ECall _,_],_) :: _ -> - begin match a.a_call with - | None -> - a.a_call <- Some cf - | Some cf' -> - cf'.cf_overloads <- cf :: cf'.cf_overloads - end; - allow_no_expr(); - | ((Meta.Resolve,_,_) | (Meta.Op,[EField _,_],_)) :: _ -> - let targ = if fctx.is_abstract_member then tthis else ta in - let check_fun t1 t2 = - if not fctx.is_macro then begin - if not (type_iseq targ t1) then raise_typing_error ("First argument type must be " ^ (s_type (print_context()) targ)) cf.cf_pos; - if not (type_iseq ctx.t.tstring t2) then raise_typing_error ("Second argument type must be String") cf.cf_pos - end - in - begin match follow t with - | TFun((_,_,t1) :: (_,_,t2) :: args,_) when is_empty_or_pos_infos args -> - if a.a_read <> None then raise_typing_error "Multiple resolve-read methods are not supported" cf.cf_pos; - check_fun t1 t2; - a.a_read <- Some cf; - | TFun((_,_,t1) :: (_,_,t2) :: (_,_,t3) :: args,_) when is_empty_or_pos_infos args -> - if a.a_write <> None then raise_typing_error "Multiple resolve-write methods are not supported" cf.cf_pos; - check_fun t1 t2; - a.a_write <- Some cf; - | _ -> - raise_typing_error ("Field type of resolve must be " ^ (s_type (print_context()) targ) ^ " -> String -> T") cf.cf_pos - end; - | _ -> ()); - match ml with - | _ :: ml -> loop ml - | [] -> () +let check_abstract (ctx,cctx,fctx) a c cf fd t ret p = + let m = mk_mono() in + let ta = TAbstract(a,List.map (fun _ -> mk_mono()) a.a_params) in + let tthis = if fctx.is_abstract_member || Meta.has Meta.To cf.cf_meta then monomorphs a.a_params a.a_this else a.a_this in + let allows_no_expr = ref (Meta.has Meta.CoreType a.a_meta) in + let allow_no_expr () = if not (has_class_field_flag cf CfExtern) then begin + allows_no_expr := true; + fctx.expr_presence_matters <- true; + end in + let handle_from () = + let r = exc_protect ctx (fun r -> + r := lazy_processing (fun () -> t); + (* the return type of a from-function must be the abstract, not the underlying type *) + if not fctx.is_macro then (try type_eq EqStrict ret ta with Unify_error l -> raise_typing_error_ext (make_error (Unify l) p)); + match t with + | TFun([_,_,t],_) -> t + | TFun([(_,_,t1);(_,true,t2)],_) when is_pos_infos t2 -> t1 + | _ -> raise_typing_error ("@:from cast functions must accept exactly one argument") p + ) "@:from" in + a.a_from_field <- (TLazy r,cf) :: a.a_from_field; + in + let handle_to () = + if fctx.is_macro then invalid_modifier ctx.com fctx "macro" "cast function" p; + let are_valid_args args = + match args with + | [_] -> true + | [_; (_,true,t)] when is_pos_infos t -> true + | _ -> false + in + (match cf.cf_kind, cf.cf_type with + | Var _, _ -> + raise_typing_error "Invalid metadata: @:to must be used on method of abstract" p + | Method _, TFun(args, _) when not fctx.is_abstract_member && not (are_valid_args args) -> + if not (Meta.has Meta.MultiType a.a_meta) then (* TODO: get rid of this check once multitype is removed *) + raise_typing_error "static @:to method should have one argument" p + | Method _, TFun(args, _) when fctx.is_abstract_member && not (are_valid_args args) -> + if not (Meta.has Meta.MultiType a.a_meta) then (* TODO: get rid of this check once multitype is removed *) + raise_typing_error "@:to method should have no arguments" p + | _ -> () + ); + (* TODO: this doesn't seem quite right... *) + if not (has_class_field_flag cf CfImpl) then add_class_field_flag cf CfImpl; + let resolve_m args = + (try unify_raise t (tfun (tthis :: args) m) cf.cf_pos with Error ({ err_message = Unify l; } as err) -> raise_typing_error_ext err); + match follow m with + | TMono _ when (match t with TFun(_,r) -> r == t_dynamic | _ -> false) -> t_dynamic + | m -> m + in + let is_multitype_cast = Meta.has Meta.MultiType a.a_meta && not fctx.is_abstract_member in + if is_multitype_cast && not (Meta.has Meta.MultiType cf.cf_meta) then + cf.cf_meta <- (Meta.MultiType,[],null_pos) :: cf.cf_meta; + let r = exc_protect ctx (fun r -> + r := lazy_processing (fun () -> t); + let args = if is_multitype_cast then begin + let ctor = try + PMap.find "_new" c.cl_statics + with Not_found -> + raise_typing_error "Constructor of multi-type abstract must be defined before the individual @:to-functions are" cf.cf_pos + in + (* delay ctx PFinal (fun () -> unify ctx m tthis f.cff_pos); *) + let args = match follow (monomorphs a.a_params ctor.cf_type) with + | TFun(args,_) -> List.map (fun (_,_,t) -> t) args + | _ -> die "" __LOC__ + in + args + end else + match cf.cf_type with + | TFun([_;(_,true,t)],_) when is_pos_infos t -> [t] + | _ -> [] in - loop cf.cf_meta; - if cf.cf_name = "_new" && Meta.has Meta.MultiType a.a_meta then fctx.do_bind <- false; - if fd.f_expr = None then begin - if fctx.is_inline then missing_expression ctx.com fctx "Inline functions must have an expression" cf.cf_pos; - if fd.f_type = None then raise_typing_error ("Functions without expressions must have an explicit return type") cf.cf_pos; - if !allows_no_expr then begin - cf.cf_meta <- (Meta.NoExpr,[],null_pos) :: cf.cf_meta; - fctx.do_bind <- false; - if not (Meta.has Meta.CoreType a.a_meta) then fctx.do_add <- false; - end + let t = resolve_m args in + t + ) "@:to" in + a.a_to_field <- (TLazy r, cf) :: a.a_to_field + in + let handle_array_access () = + if fctx.is_macro then invalid_modifier ctx.com fctx "macro" "array-access function" p; + a.a_array <- cf :: a.a_array; + allow_no_expr(); + in + let handle_resolve () = + let targ = if fctx.is_abstract_member then tthis else ta in + let check_fun t1 t2 = + if not fctx.is_macro then begin + if not (type_iseq targ t1) then raise_typing_error ("First argument type must be " ^ (s_type (print_context()) targ)) cf.cf_pos; + if not (type_iseq ctx.t.tstring t2) then raise_typing_error ("Second argument type must be String") cf.cf_pos end + in + begin match follow t with + | TFun((_,_,t1) :: (_,_,t2) :: args,_) when is_empty_or_pos_infos args -> + if a.a_read <> None then raise_typing_error "Multiple resolve-read methods are not supported" cf.cf_pos; + check_fun t1 t2; + a.a_read <- Some cf; + | TFun((_,_,t1) :: (_,_,t2) :: (_,_,t3) :: args,_) when is_empty_or_pos_infos args -> + if a.a_write <> None then raise_typing_error "Multiple resolve-write methods are not supported" cf.cf_pos; + check_fun t1 t2; + a.a_write <- Some cf; + | _ -> + raise_typing_error ("Field type of resolve must be " ^ (s_type (print_context()) targ) ^ " -> String -> T") cf.cf_pos + end; + in + let handle_op e = match fst e with + | (EArrayDecl _) -> + handle_array_access() + | EBinop(OpAssign,_,_) -> + raise_typing_error "Assignment overloading is not supported" p; + | EBinop(OpAssignOp OpNullCoal,_,_) + | EBinop(OpNullCoal,_,_) -> + raise_typing_error "Null coalescing overloading is not supported" p; + | ETernary(_,_,_) -> + raise_typing_error "Ternary overloading is not supported" p; + | EBinop(op,_,_) -> + if fctx.is_macro then invalid_modifier ctx.com fctx "macro" "operator function" p; + let targ = if fctx.is_abstract_member then tthis else ta in + let left_eq,right_eq = + match follow t with + | TFun([(_,_,t1);(_,_,t2)],_) -> + type_iseq targ t1,type_iseq targ t2 + | TFun([(_,_,t1);(_,_,t2);(_,true,t3)],_) when is_pos_infos t3 -> + type_iseq targ t1,type_iseq targ t2 + | _ -> + if fctx.is_abstract_member then + raise_typing_error ("Member @:op functions must accept exactly one argument") cf.cf_pos + else + raise_typing_error ("Static @:op functions must accept exactly two arguments") cf.cf_pos + in + if not (left_eq || right_eq) then raise_typing_error ("The left or right argument type must be " ^ (s_type (print_context()) targ)) cf.cf_pos; + if right_eq && Meta.has Meta.Commutative cf.cf_meta then raise_typing_error ("Invalid metadata: @:commutative is only allowed if the right argument is not " ^ (s_type (print_context()) targ)) cf.cf_pos; + a.a_ops <- (op,cf) :: a.a_ops; + allow_no_expr(); + | EUnop(op,flag,_) -> + if fctx.is_macro then invalid_modifier ctx.com fctx "macro" "operator function" p; + let targ = if fctx.is_abstract_member then tthis else ta in + (try type_eq EqStrict t (tfun [targ] (mk_mono())) with Unify_error l -> raise_error_msg (Unify l) cf.cf_pos); + a.a_unops <- (op,flag,cf) :: a.a_unops; + allow_no_expr(); + | ECall _ -> + begin match a.a_call with + | None -> + a.a_call <- Some cf + | Some cf' -> + cf'.cf_overloads <- cf :: cf'.cf_overloads + end; + allow_no_expr(); + | EField _ -> + handle_resolve() | _ -> - () + raise_typing_error ("Invalid @:op expresssions, should be an operator or a call") (pos e) + in + let check_meta m = match m with + | (Meta.From,_,_) -> + handle_from() + | (Meta.To,_,_) -> + handle_to() + | (Meta.Op,[e],_) -> + handle_op e + | (Meta.ArrayAccess,_,_) -> + handle_array_access() + | (Meta.Resolve,_,_) -> + handle_resolve() + | _ -> (); + in + List.iter check_meta cf.cf_meta; + if cf.cf_name = "_new" && Meta.has Meta.MultiType a.a_meta then fctx.do_bind <- false; + if fd.f_expr = None then begin + if fctx.is_inline then missing_expression ctx.com fctx "Inline functions must have an expression" cf.cf_pos; + if fd.f_type = None then raise_typing_error ("Functions without expressions must have an explicit return type") cf.cf_pos; + if !allows_no_expr then begin + cf.cf_meta <- (Meta.NoExpr,[],null_pos) :: cf.cf_meta; + fctx.do_bind <- false; + if not (Meta.has Meta.CoreType a.a_meta) then fctx.do_add <- false; + end + end let type_opt (ctx,cctx,fctx) p t = let c = cctx.tclass in @@ -1428,7 +1442,12 @@ let create_method (ctx,cctx,fctx) c f fd p = () ) parent; generate_args_meta ctx.com (Some c) (fun meta -> cf.cf_meta <- meta :: cf.cf_meta) fd.f_args; - check_abstract (ctx,cctx,fctx) c cf fd t ret p; + begin match cctx.abstract with + | Some a -> + check_abstract (ctx,cctx,fctx) a c cf fd t ret p; + | _ -> + () + end; init_meta_overloads ctx (Some c) cf; ctx.curfield <- cf; if fctx.do_bind then diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 489257046e1..55f7d010ae3 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -1123,7 +1123,7 @@ and type_new ctx path el with_type force_inline p = raise_typing_error (s_type (print_context()) t ^ " cannot be constructed") p end with Error ({ err_message = No_constructor _ } as err) when ctx.com.display.dms_kind <> DMNone -> display_error_ext ctx.com err; - Diagnostics.secure_generated_code ctx (mk (TConst TNull) t p) + Diagnostics.secure_generated_code ctx.com (mk (TConst TNull) t p) and type_try ctx e1 catches with_type p = let e1 = type_expr ctx (Expr.ensure_block e1) with_type in @@ -1790,7 +1790,7 @@ and type_call_builtin ctx e el mode with_type p = | _ -> let e = type_expr ctx e WithType.value in warning ctx WInfo (s_type (print_context()) e.etype) e.epos; - let e = Diagnostics.secure_generated_code ctx e in + let e = Diagnostics.secure_generated_code ctx.com e in e end | (EField(e,"match",efk_todo),p), [epat] -> diff --git a/std/eval/_std/sys/thread/EventLoop.hx b/std/eval/_std/sys/thread/EventLoop.hx index d5ef5e97c89..5b25958b499 100644 --- a/std/eval/_std/sys/thread/EventLoop.hx +++ b/std/eval/_std/sys/thread/EventLoop.hx @@ -196,11 +196,8 @@ class EventLoop { if (started && isMainThread) { var next = @:privateAccess MainLoop.tick(); - if (haxe.MainLoop.hasEvents()) { - wakeup.send(); - } else { - refUnref(); - } + if (haxe.MainLoop.hasEvents()) wakeup.send(); + refUnref(); } } } diff --git a/tests/display/src/cases/Issue11203.hx b/tests/display/src/cases/Issue11203.hx new file mode 100644 index 00000000000..2ed05d41ec4 --- /dev/null +++ b/tests/display/src/cases/Issue11203.hx @@ -0,0 +1,24 @@ +package cases; + +class Issue11203 extends DisplayTestCase { + /** + class Main { + static function main() { + var future = new Future(); + future.eager(); + } + } + + abstract Future({}) from {} { + public function new() this = {}; + + public inline function eager():Future { + trace("much side effect!"); + return this; + } + } + **/ + function test() { + arrayEq([], diagnostics()); + } +} diff --git a/tests/misc/projects/Issue11176/Main.hx b/tests/misc/projects/Issue11176/Main.hx new file mode 100644 index 00000000000..cfa04d5a61e --- /dev/null +++ b/tests/misc/projects/Issue11176/Main.hx @@ -0,0 +1,6 @@ +function main() { + var cost = [1, 2, 3]; + var _g = []; + for (x in cost) _g.push("" + x); + _g.join(" "); +} diff --git a/tests/misc/projects/Issue11176/compile.hxml b/tests/misc/projects/Issue11176/compile.hxml new file mode 100644 index 00000000000..42409e72918 --- /dev/null +++ b/tests/misc/projects/Issue11176/compile.hxml @@ -0,0 +1 @@ +-main Main diff --git a/tests/misc/projects/Issue11237/Main.hx b/tests/misc/projects/Issue11237/Main.hx new file mode 100644 index 00000000000..b5015c372cb --- /dev/null +++ b/tests/misc/projects/Issue11237/Main.hx @@ -0,0 +1,5 @@ +abstract A(Int) { + @:op(a) function bar() {} +} + +function main() {} diff --git a/tests/misc/projects/Issue11237/compile-fail.hxml b/tests/misc/projects/Issue11237/compile-fail.hxml new file mode 100644 index 00000000000..fab0aeecc3d --- /dev/null +++ b/tests/misc/projects/Issue11237/compile-fail.hxml @@ -0,0 +1 @@ +--main Main \ No newline at end of file diff --git a/tests/misc/projects/Issue11237/compile-fail.hxml.stderr b/tests/misc/projects/Issue11237/compile-fail.hxml.stderr new file mode 100644 index 00000000000..dfe2ad519b1 --- /dev/null +++ b/tests/misc/projects/Issue11237/compile-fail.hxml.stderr @@ -0,0 +1 @@ +Main.hx:2: characters 7-8 : Invalid @:op expresssions, should be an operator or a call \ No newline at end of file diff --git a/tests/misc/projects/eventLoop/Main2.hx b/tests/misc/projects/eventLoop/Main2.hx new file mode 100644 index 00000000000..34cea2d4666 --- /dev/null +++ b/tests/misc/projects/eventLoop/Main2.hx @@ -0,0 +1,14 @@ +class Main2 { + static function main() { + var event : haxe.MainLoop.MainEvent = null; + var count = 0; + event = haxe.MainLoop.add(function() { + trace(count++); + if( count == 10 ) { + event.stop(); + trace(haxe.MainLoop.hasEvents()); + } + }); + } + +} diff --git a/tests/misc/projects/eventLoop/compile2.hxml b/tests/misc/projects/eventLoop/compile2.hxml new file mode 100644 index 00000000000..504702ea8a2 --- /dev/null +++ b/tests/misc/projects/eventLoop/compile2.hxml @@ -0,0 +1,3 @@ +--main Main2 +--dce full +--interp