diff --git a/src/codegen/gencommon/closuresToClass.ml b/src/codegen/gencommon/closuresToClass.ml index 13c3b8ca84c..373bbe6d53a 100644 --- a/src/codegen/gencommon/closuresToClass.ml +++ b/src/codegen/gencommon/closuresToClass.ml @@ -730,7 +730,7 @@ struct | Some const -> { eexpr = TIf( { elocal with eexpr = TBinop(Ast.OpEq, elocal, null elocal.etype elocal.epos); etype = basic.tbool }, - { elocal with eexpr = TConst(const); etype = const_type basic const t }, + const, Some ( mk_cast t elocal ) ); etype = t; epos = elocal.epos } in diff --git a/src/codegen/gencommon/enumToClass.ml b/src/codegen/gencommon/enumToClass.ml index 8890f4b3672..91828a46fb7 100644 --- a/src/codegen/gencommon/enumToClass.ml +++ b/src/codegen/gencommon/enumToClass.ml @@ -138,7 +138,7 @@ struct let cf = mk_class_field name ef_type true pos (Method MethNormal) cf_params in cf.cf_meta <- []; - let tf_args = List.map (fun (name,opt,t) -> (alloc_var name t, if opt then Some TNull else None) ) params in + let tf_args = List.map (fun (name,opt,t) -> (alloc_var name t, if opt then Some (Texpr.Builder.make_null t null_pos) else None) ) params in let arr_decl = mk_nativearray_decl gen t_dynamic (List.map (fun (v,_) -> mk_local v pos) tf_args) pos in let expr = { eexpr = TFunction({ diff --git a/src/codegen/gencommon/gencommon.ml b/src/codegen/gencommon/gencommon.ml index 2e47247ea2a..bc1bd3f96d1 100644 --- a/src/codegen/gencommon/gencommon.ml +++ b/src/codegen/gencommon/gencommon.ml @@ -1315,6 +1315,6 @@ let get_type gen path = try Hashtbl.find gen.gtypes path with | Not_found -> raise (TypeNotFound path) -let fun_args (l : (tvar * tconstant option) list)= +let fun_args l = List.map (fun (v,s) -> (v.v_name, (s <> None), v.v_type)) l diff --git a/src/core/json/genjson.ml b/src/core/json/genjson.ml index a33ab7e7ffa..fa9620d3c37 100644 --- a/src/core/json/genjson.ml +++ b/src/core/json/genjson.ml @@ -300,7 +300,7 @@ and generate_tconstant ctx ct = and generate_tfunction ctx tf = let generate_arg (v,cto) = jobject [ "v",generate_tvar ctx v; - "value",jopt (generate_tconstant ctx) cto; + "value",jopt (generate_texpr ctx) cto; ] in jobject [ "args",jlist generate_arg tf.tf_args; diff --git a/src/core/texpr.ml b/src/core/texpr.ml index 8bfd5576ba6..4d91a4d4516 100644 --- a/src/core/texpr.ml +++ b/src/core/texpr.ml @@ -284,7 +284,7 @@ let set_default basic a c p = let t = a.v_type in let ve = mk (TLocal a) t p in let cond = TBinop (OpEq,ve,mk (TConst TNull) t p) in - mk (TIf (Builder.mk_parent (mk cond basic.tbool p), mk (TBinop (OpAssign,ve,mk (TConst c) t p)) t p,None)) basic.tvoid p + mk (TIf (Builder.mk_parent (mk cond basic.tbool p), mk (TBinop (OpAssign,ve,c)) t p,None)) basic.tvoid p (* Tells if the constructor might be called without any issue whatever its parameters diff --git a/src/core/type.ml b/src/core/type.ml index df89a0ada3b..7a9445adbba 100644 --- a/src/core/type.ml +++ b/src/core/type.ml @@ -112,7 +112,7 @@ and tvar = { } and tfunc = { - tf_args : (tvar * tconstant option) list; + tf_args : (tvar * texpr option) list; tf_type : t; tf_expr : texpr; } @@ -1166,7 +1166,7 @@ let rec s_expr s_type e = | Prefix -> sprintf "(%s %s)" (s_unop op) (loop e) | Postfix -> sprintf "(%s %s)" (loop e) (s_unop op)) | TFunction f -> - let args = slist (fun (v,o) -> sprintf "%s : %s%s" (s_var v) (s_type v.v_type) (match o with None -> "" | Some c -> " = " ^ s_const c)) f.tf_args in + let args = slist (fun (v,o) -> sprintf "%s : %s%s" (s_var v) (s_type v.v_type) (match o with None -> "" | Some c -> " = " ^ loop c)) f.tf_args in sprintf "Function(%s) : %s = %s" args (s_type f.tf_type) (loop f.tf_expr) | TVar (v,eo) -> sprintf "Vars %s" (sprintf "%s : %s%s" (s_var v) (s_type v.v_type) (match eo with None -> "" | Some e -> " = " ^ loop e)) @@ -1229,7 +1229,7 @@ let rec s_expr_pretty print_var_ids tabs top_level s_type e = | Prefix -> sprintf "%s %s" (s_unop op) (loop e) | Postfix -> sprintf "%s %s" (loop e) (s_unop op)) | TFunction f -> - let args = clist (fun (v,o) -> sprintf "%s:%s%s" (local v) (s_type v.v_type) (match o with None -> "" | Some c -> " = " ^ s_const c)) f.tf_args in + let args = clist (fun (v,o) -> sprintf "%s:%s%s" (local v) (s_type v.v_type) (match o with None -> "" | Some c -> " = " ^ loop c)) f.tf_args in sprintf "%s(%s) %s" (if top_level then "" else "function") args (loop f.tf_expr) | TVar (v,eo) -> sprintf "var %s" (sprintf "%s%s" (local v) (match eo with None -> "" | Some e -> " = " ^ loop e)) @@ -1320,7 +1320,7 @@ let rec s_expr_ast print_var_ids tabs s_type e = | TNew (c,tl,el) -> tag "New" ((s_type (TInst(c,tl))) :: (List.map loop el)) | TFunction f -> let arg (v,cto) = - tag "Arg" ~t:(Some v.v_type) ~extra_tabs:"\t" (match cto with None -> [local v None] | Some ct -> [local v None;const ct None]) + tag "Arg" ~t:(Some v.v_type) ~extra_tabs:"\t" (match cto with None -> [local v None] | Some ct -> [local v None;loop ct]) in tag "Function" ((List.map arg f.tf_args) @ [loop f.tf_expr]) | TVar (v,eo) -> var v (match eo with None -> [] | Some e -> [loop e]) @@ -2697,7 +2697,7 @@ module TExprToExpr = struct | TNew (c,pl,el) -> ENew ((match (try convert_type (TInst (c,pl)) with Exit -> convert_type (TInst (c,[]))) with CTPath p -> p,null_pos | _ -> assert false),List.map convert_expr el) | TUnop (op,p,e) -> EUnop (op,p,convert_expr e) | TFunction f -> - let arg (v,c) = (v.v_name,v.v_pos), false, v.v_meta, mk_type_hint v.v_type null_pos, (match c with None -> None | Some c -> Some (EConst (tconst_to_const c),e.epos)) in + let arg (v,c) = (v.v_name,v.v_pos), false, v.v_meta, mk_type_hint v.v_type null_pos, (match c with None -> None | Some c -> Some (convert_expr c)) in EFunction (None,{ f_params = []; f_args = List.map arg f.tf_args; f_type = mk_type_hint f.tf_type null_pos; f_expr = Some (convert_expr f.tf_expr) }) | TVar (v,eo) -> EVars ([(v.v_name,v.v_pos), v.v_final, mk_type_hint v.v_type v.v_pos, eopt eo]) diff --git a/src/filters/defaultArguments.ml b/src/filters/defaultArguments.ml index 8b63843dd57..1b398ca7aa0 100644 --- a/src/filters/defaultArguments.ml +++ b/src/filters/defaultArguments.ml @@ -33,8 +33,7 @@ let gen_check basic t nullable_var const pos = (is_null t1) <> (is_null t2) in - let const_t = const_type basic const t in - let const = mk (TConst const) const_t pos in + let const_t = const.etype in let const = if needs_cast t const_t then mk_cast const t pos else const in let arg = make_local nullable_var pos in @@ -45,10 +44,10 @@ let gen_check basic t nullable_var const pos = let add_opt com block pos (var,opt) = match opt with - | None | Some TNull -> + | None | Some {eexpr = TConst TNull} -> (var,opt) - | Some (TString str) -> - block := Texpr.set_default com.basic var (TString str) pos :: !block; + | Some ({eexpr = TConst (TString str)} as e) -> + block := Texpr.set_default com.basic var e pos :: !block; (var, opt) | Some const -> let basic = com.basic in diff --git a/src/generators/genas3.ml b/src/generators/genas3.ml index cad14721237..9b6d7fa65e9 100644 --- a/src/generators/genas3.ml +++ b/src/generators/genas3.ml @@ -374,7 +374,7 @@ let gen_constant ctx p = function | TThis -> spr ctx (this ctx) | TSuper -> spr ctx "super" -let gen_function_header ctx name f params p = +let rec gen_function_header ctx name f params p = let old = ctx.in_value in let old_t = ctx.local_types in let old_bi = ctx.block_inits in @@ -382,10 +382,10 @@ let gen_function_header ctx name f params p = ctx.local_types <- List.map snd params @ ctx.local_types; let init () = List.iter (fun (v,o) -> match o with - | Some c when is_nullable v.v_type && c <> TNull -> + | Some c when is_nullable v.v_type && c.eexpr <> TConst TNull -> newline ctx; print ctx "if(%s==null) %s=" v.v_name v.v_name; - gen_constant ctx p c; + gen_expr ctx c; | _ -> () ) f.tf_args; ctx.block_inits <- None; @@ -410,9 +410,11 @@ let gen_function_header ctx name f params p = match c with | None -> if ctx.constructor_block then print ctx " = %s" (default_value tstr); - | Some c -> + | Some ({eexpr = TConst _ } as e) -> spr ctx " = "; - gen_constant ctx p c + gen_expr ctx e + | _ -> + spr ctx " = null" ) f.tf_args; print ctx ") : %s " (type_str ctx f.tf_type p); (fun () -> @@ -421,7 +423,7 @@ let gen_function_header ctx name f params p = ctx.block_inits <- old_bi; ) -let rec gen_call ctx e el r = +and gen_call ctx e el r = match e.eexpr , el with | TCall (x,_) , el -> spr ctx "("; diff --git a/src/generators/gencpp.ml b/src/generators/gencpp.ml index 19f0582d9d2..5caa94388f8 100644 --- a/src/generators/gencpp.ml +++ b/src/generators/gencpp.ml @@ -1260,17 +1260,6 @@ let is_matching_interface_type t0 t1 = -let default_value_string ctx value = -match value with - | TInt i -> Printf.sprintf "%ld" i - | TFloat float_as_string -> "((Float)" ^ float_as_string ^ ")" - | TString s -> strq ctx s - | TBool b -> (if b then "true" else "false") - | TNull -> "null()" - | _ -> "/* Hmmm */" -;; - - let get_nth_type field index = match follow field.ef_type with @@ -1287,12 +1276,6 @@ let get_nth_type field index = -let has_default_values args = - List.exists ( fun (_,o) -> match o with - | Some TNull -> false - | Some _ -> true - | _ -> false ) args ;; - exception PathFound of string;; @@ -1389,7 +1372,7 @@ and tcppexpr = { and tcpp_closure = { close_type : tcpp; - close_args : (tvar * tconstant option) list; + close_args : (tvar * texpr option) list; close_expr : tcppexpr; close_id : int; close_undeclared : (string,tvar) Hashtbl.t; @@ -2093,7 +2076,7 @@ let ctx_arg_type_name ctx name default_val arg_type prefix = let remap_name = keyword_remap name in let type_str = (ctx_type_string ctx arg_type) in match default_val with - | Some TNull -> (type_str,remap_name) + | Some {eexpr = TConst TNull} -> (type_str,remap_name) | Some constant when (ctx_cant_be_null ctx arg_type) -> ("hx::Null< " ^ type_str ^ " > ",prefix ^ remap_name) | Some constant -> (type_str,prefix ^ remap_name) | _ -> (type_str,remap_name);; @@ -3270,24 +3253,55 @@ let cpp_arg_type_name ctx tvar default_val prefix = let remap_name = (cpp_var_name_of tvar) in let type_str = (cpp_var_type_of ctx tvar) in match default_val with - | Some TNull -> (tcpp_to_string (cpp_type_of_null ctx tvar.v_type)),remap_name + | Some {eexpr = TConst TNull} -> (tcpp_to_string (cpp_type_of_null ctx tvar.v_type)),remap_name | Some constant -> (tcpp_to_string (cpp_type_of_null ctx tvar.v_type)),prefix ^ remap_name | _ -> type_str,remap_name ;; + +let string_of_path path = + "::" ^ (join_class_path_remap path "::") ^ "_obj" +;; + +let default_value_string ctx value = +match value.eexpr with + | TConst (TInt i) -> Printf.sprintf "%ld" i + | TConst (TFloat float_as_string) -> "((Float)" ^ float_as_string ^ ")" + | TConst (TString s) -> strq ctx s + | TConst (TBool b) -> (if b then "true" else "false") + | TConst TNull -> "null()" + | TField (_, FEnum(enum,field) ) -> (string_of_path enum.e_path) ^ "::" ^ (cpp_enum_name_of field) ^ "_dyn()" + | _ -> "/* Hmmm " ^ (s_expr_kind value) ^ " */" +;; + + + let cpp_gen_default_values ctx args prefix = List.iter ( fun (tvar,o) -> + let vtype = cpp_type_of ctx tvar.v_type in + let not_null = (type_has_meta_key tvar.v_type Meta.NotNull) || (is_cpp_scalar vtype) in match o with - | Some TNull -> () + | Some {eexpr = TConst TNull} -> () | Some const -> let name = cpp_var_name_of tvar in - ctx.ctx_output ((cpp_var_type_of ctx tvar) ^ " " ^ name ^ " = " ^ prefix ^ name ^ ".Default(" ^ - (default_value_string ctx.ctx_common const) ^ ");\n") + let spacer = if (ctx.ctx_debug_level>0) then " \t" else "" in + let pname = prefix ^ name in + ctx.ctx_output ( spacer ^ "\t" ^ (tcpp_to_string vtype) ^ " " ^ name ^ " = " ^ pname ); + ctx.ctx_output ( if not_null then + ".Default(" ^ (default_value_string ctx.ctx_common const) ^ ");\n" + else + ";\n" ^ spacer ^ "\tif (hx::IsNull(" ^ pname ^ ")) " ^ name ^ " = " ^ (default_value_string ctx.ctx_common const) ^ ";\n" + ); | _ -> () ) args; ;; +let ctx_default_values ctx args prefix = + cpp_gen_default_values ctx args prefix +;; + + let rec is_constant_zero expr = match expr.cppexpr with | CppFloat x when (float_of_string x) = 0.0 -> true @@ -3319,11 +3333,6 @@ let cpp_arg_list ctx args prefix = ;; -let ctx_default_values ctx args prefix = - cpp_gen_default_values ctx args prefix -;; - - let gen_type ctx haxe_type = ctx.ctx_output (ctx_type_string ctx haxe_type) ;; @@ -4110,8 +4119,6 @@ let gen_cpp_ast_expression_tree ctx class_name func_name function_args function_ | OpArrow -> "->" | OpIn -> " in " | OpAssign | OpAssignOp _ -> abort "Unprocessed OpAssign" pos - and string_of_path path = - "::" ^ (join_class_path_remap path "::") ^ "_obj" and gen_closure closure = let argc = Hashtbl.length closure.close_undeclared in @@ -7271,15 +7278,10 @@ class script_writer ctx filename asciiOut = this#begin_expr; this#writePos function_def.tf_expr; this#write ( (this#op IaFun) ^ (this#typeText function_def.tf_type) ^ (string_of_int (List.length args)) ^ "\n" ); - List.iter (fun(arg,init) -> - this#write (indent ^ indent_str ); - this#writeVar arg; - match init with - | Some const -> this#write ("1 " ^ (this#constText const) ^ "\n") - | _ -> this#write "0\n"; - ) function_def.tf_args; + let close = this#gen_func_args function_def.tf_args in this#gen_expression_tree cppExpr; this#end_expr; + close() end else this#gen_expression e | _ -> print_endline ("Missing function body for " ^ funcName ); @@ -7372,25 +7374,72 @@ class script_writer ctx filename asciiOut = this#gen_expression expr; end + method gen_func_args args = + let gen_inits = ref [] in + List.iter (fun(arg,init) -> + this#write (indent ^ indent_str ); + this#writeVar arg; + match init with + | Some ({eexpr = TConst TNull}) -> this#write "0\n" + | Some const -> + let argType = (cpp_type_of ctx const.etype) in + if (is_cpp_scalar argType || argType==TCppString ) then begin + this#write ("1 "); + this#gen_expression_only const; + this#write "\n"; + end else begin + gen_inits := (arg, const) :: !gen_inits; + this#write "0\n"; + end + | _ -> this#write "0\n"; + ) args; + + if (List.length !gen_inits)==0 then begin + fun () -> ( ) + end else begin + this#begin_expr; + this#writePos (snd (List.hd !gen_inits) ); + this#writeList (this#op IaBlock) ((List.length !gen_inits) + 1); + List.iter (fun(arg,const) -> + let start_expr( ) = this#begin_expr; this#writePos const; in + let local_var( ) = + this#begin_expr; + this#writePos const; + this#write ((this#op IaVar) ^ (string_of_int arg.v_id) ^ (this#commentOf arg.v_name) ); + this#end_expr; + in + + start_expr(); + this#writeOpLine IaIf; + start_expr(); + this#writeOpLine IaIsNull; + local_var(); + this#end_expr; + start_expr(); + this#writeOpLine IaSet; + local_var(); + this#gen_expression const; + this#end_expr; + this#begin_expr; + ) !gen_inits; + fun () -> this#end_expr; + end + method gen_expression expr = + this#begin_expr; + this#writePos expr; + this#gen_expression_only expr; + this#end_expr; - method gen_expression expr = (* { *) + method gen_expression_only expr = (* { *) let expression = remove_parens expr in - this#begin_expr; - (*this#write ( (this#fileText expression.epos.pfile) ^ "\t" ^ (string_of_int (Lexer.get_error_line expression.epos) ) ^ indent);*) - this#writePos expression; (match expression.eexpr with | TFunction function_def -> this#write ( (this#op IaFun) ^ (this#typeText function_def.tf_type) ^ (string_of_int (List.length function_def.tf_args)) ^ "\n" ); - List.iter (fun(arg,init) -> - this#write (indent ^ indent_str ); - this#writeVar arg; - match init with - | Some const -> this#write ("1 " ^ (this#constText const) ^ "\n") - | _ -> this#write "0\n"; - ) function_def.tf_args; + let close = this#gen_func_args function_def.tf_args in let pop = this#pushReturn function_def.tf_type in this#gen_expression function_def.tf_expr; pop (); + close() | TBlock expr_list -> this#writeList (this#op IaBlock) (List.length expr_list); List.iter this#gen_expression expr_list; | TConst const -> this#write (this#constText const) @@ -7626,7 +7675,6 @@ class script_writer ctx filename asciiOut = | TMeta(_,_) -> abort "Unexpected meta" expression.epos | TIdent _ -> abort "Unexpected ident" expression.epos ); - this#end_expr; (* } *) method gen_expression_tree expression_tree = (* { *) let rec gen_expression expression = @@ -7817,14 +7865,9 @@ class script_writer ctx filename asciiOut = | CppClosure closure -> this#write ( (this#op IaFun) ^ (this#astType closure.close_type) ^ (string_of_int (List.length closure.close_args)) ^ "\n" ); - List.iter (fun(arg,init) -> - this#write (indent ^ indent_str ); - this#writeVar arg; - match init with - | Some const -> this#write ("1 " ^ (this#constText const) ^ "\n") - | _ -> this#write "0\n"; - ) closure.close_args; + let close = this#gen_func_args closure.close_args in gen_expression closure.close_expr; + close() | CppObjectDecl (values,isStruct) ->this#write ( (this#op IaObjDef) ^ (string_of_int (List.length values))); this#write " "; diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml index 2f526a6fc18..2d6e94426cc 100644 --- a/src/generators/genhl.ml +++ b/src/generators/genhl.ml @@ -2149,7 +2149,7 @@ and eval_expr ctx e = let eargs, et = (match follow ef.ef_type with TFun (args,ret) -> args, ret | _ -> assert false) in let ct = ctx.com.basic in let p = ef.ef_pos in - let eargs = List.map (fun (n,o,t) -> Type.alloc_var VGenerated n t en.e_pos, if o then Some TNull else None) eargs in + let eargs = List.map (fun (n,o,t) -> Type.alloc_var VGenerated n t en.e_pos, if o then Some (mk (TConst TNull) t_dynamic null_pos) else None) eargs in let ecall = mk (TCall (e,List.map (fun (v,_) -> mk (TLocal v) v.v_type p) eargs)) et p in let f = { tf_args = eargs; @@ -3101,25 +3101,25 @@ and make_fun ?gen_content ctx name fidx f cthis cparent = let vt = to_type ctx v.v_type in let capt = captured_index ctx v in (match o with - | None | Some TNull -> () + | None | Some {eexpr = TConst TNull} -> () | Some c when not (is_nullable vt) -> (* if optional but not null, turn into a not nullable here *) let j = jump ctx (fun n -> OJNotNull (r,n)) in let t = alloc_tmp ctx vt in (match vt with | HUI8 | HUI16 | HI32 | HI64 -> - (match c with - | TInt i -> op ctx (OInt (t,alloc_i32 ctx i)) - | TFloat s -> op ctx (OInt (t,alloc_i32 ctx (Int32.of_float (float_of_string s)))) + (match c.eexpr with + | TConst (TInt i) -> op ctx (OInt (t,alloc_i32 ctx i)) + | TConst (TFloat s) -> op ctx (OInt (t,alloc_i32 ctx (Int32.of_float (float_of_string s)))) | _ -> assert false) | HF32 | HF64 -> - (match c with - | TInt i -> op ctx (OFloat (t,alloc_float ctx (Int32.to_float i))) - | TFloat s -> op ctx (OFloat (t,alloc_float ctx (float_of_string s))) + (match c.eexpr with + | TConst (TInt i) -> op ctx (OFloat (t,alloc_float ctx (Int32.to_float i))) + | TConst (TFloat s) -> op ctx (OFloat (t,alloc_float ctx (float_of_string s))) | _ -> assert false) | HBool -> - (match c with - | TBool b -> op ctx (OBool (t,b)) + (match c.eexpr with + | TConst (TBool b) -> op ctx (OBool (t,b)) | _ -> assert false) | _ -> assert false); @@ -3134,30 +3134,32 @@ and make_fun ?gen_content ctx name fidx f cthis cparent = hold ctx t | Some c -> let j = jump ctx (fun n -> OJNotNull (r,n)) in - (match c with - | TNull | TThis | TSuper -> assert false - | TInt i when (match to_type ctx (Abstract.follow_with_abstracts v.v_type) with HUI8 | HUI16 | HI32 | HI64 | HDyn -> true | _ -> false) -> + (match c.eexpr with + | TConst (TNull | TThis | TSuper) -> assert false + | TConst (TInt i) when (match to_type ctx (Abstract.follow_with_abstracts v.v_type) with HUI8 | HUI16 | HI32 | HI64 | HDyn -> true | _ -> false) -> let tmp = alloc_tmp ctx HI32 in op ctx (OInt (tmp, alloc_i32 ctx i)); op ctx (OToDyn (r, tmp)); - | TFloat s when (match to_type ctx (Abstract.follow_with_abstracts v.v_type) with HUI8 | HUI16 | HI32 | HI64 -> true | _ -> false) -> + | TConst (TFloat s) when (match to_type ctx (Abstract.follow_with_abstracts v.v_type) with HUI8 | HUI16 | HI32 | HI64 -> true | _ -> false) -> let tmp = alloc_tmp ctx HI32 in op ctx (OInt (tmp, alloc_i32 ctx (Int32.of_float (float_of_string s)))); op ctx (OToDyn (r, tmp)); - | TInt i -> + | TConst (TInt i) -> let tmp = alloc_tmp ctx HF64 in op ctx (OFloat (tmp, alloc_float ctx (Int32.to_float i))); op ctx (OToDyn (r, tmp)); - | TFloat s -> + | TConst (TFloat s) -> let tmp = alloc_tmp ctx HF64 in op ctx (OFloat (tmp, alloc_float ctx (float_of_string s))); op ctx (OToDyn (r, tmp)); - | TBool b -> + | TConst (TBool b) -> let tmp = alloc_tmp ctx HBool in op ctx (OBool (tmp, b)); op ctx (OToDyn (r, tmp)); - | TString s -> + | TConst (TString s) -> op ctx (OMov (r, make_string ctx s f.tf_expr.epos)) + | _ -> + op ctx (OMov (r, eval_to ctx c vt)) ); j(); ); diff --git a/src/generators/genjs.ml b/src/generators/genjs.ml index 27c6d6c4a67..5dd3785f7e3 100644 --- a/src/generators/genjs.ml +++ b/src/generators/genjs.ml @@ -303,7 +303,7 @@ let rec concat ctx s f = function let fun_block ctx f p = let e = List.fold_left (fun e (a,c) -> match c with - | None | Some TNull -> e + | None | Some {eexpr = TConst TNull} -> e | Some c -> Type.concat (Texpr.set_default ctx.com.basic a c p) e ) f.tf_expr f.tf_args in e diff --git a/src/generators/genlua.ml b/src/generators/genlua.ml index f64e3dac215..150ae969901 100644 --- a/src/generators/genlua.ml +++ b/src/generators/genlua.ml @@ -190,7 +190,7 @@ let rec concat ctx s f = function let fun_block ctx f p = let e = List.fold_left (fun e (a,c) -> match c with - | None | Some TNull -> e + | None | Some {eexpr = TConst TNull} -> e | Some c -> Type.concat (Texpr.set_default ctx.com.basic a c p) e ) f.tf_expr f.tf_args in e diff --git a/src/generators/genneko.ml b/src/generators/genneko.ml index bca47e84a93..e8b1858dc0c 100644 --- a/src/generators/genneko.ml +++ b/src/generators/genneko.ml @@ -295,7 +295,7 @@ and gen_expr ctx e = acc in match c with - | None | Some TNull -> acc + | None | Some {eexpr = TConst TNull} -> acc | Some c -> gen_expr ctx (Texpr.set_default ctx.com.basic a c e.epos) :: acc ) [] f.tf_args in let e = gen_expr ctx f.tf_expr in diff --git a/src/generators/genphp7.ml b/src/generators/genphp7.ml index 47e8a3b87f1..849c89633aa 100644 --- a/src/generators/genphp7.ml +++ b/src/generators/genphp7.ml @@ -642,7 +642,7 @@ let inject_defaults (ctx:Common.context) (func:tfunc) = match args with | [] -> body_exprs | (_, None) :: rest -> inject rest body_exprs - | (_, Some TNull) :: rest -> inject rest body_exprs + | (_, Some {eexpr = TConst TNull}) :: rest -> inject rest body_exprs | (var, Some const) :: rest -> let expr = Texpr.set_default ctx.basic var const func.tf_expr.epos in expr :: (inject rest body_exprs) @@ -2817,9 +2817,11 @@ class code_writer (ctx:Common.context) hx_type_path php_name = self#write ("$" ^ arg_name); match default_value with | None -> () - | Some const -> + | Some expr -> self#write " = "; - self#write_expr_const const + match expr.eexpr with + | TConst _ -> self#write_expr expr + | _ -> self#write "null" (** Write an access to a field of dynamic value *) diff --git a/src/generators/genpy.ml b/src/generators/genpy.ml index 5faa8ee4edf..eb2f6700d09 100644 --- a/src/generators/genpy.ml +++ b/src/generators/genpy.ml @@ -312,13 +312,13 @@ module Transformer = struct let assigns = List.fold_left (fun acc (v,value) -> KeywordHandler.check_var_declaration v; match value with - | None | Some TNull -> + | None | Some {eexpr = TConst TNull} -> acc | Some ct -> let a_local = mk (TLocal v) v.v_type p in let a_null = mk (TConst TNull) v.v_type p in let a_cmp = mk (TBinop(OpEq,a_local,a_null)) !t_bool p in - let a_value = mk (TConst(ct)) v.v_type p in + let a_value = ct in let a_assign = mk (TBinop(OpAssign,a_local,a_value)) v.v_type p in let a_if = mk (TIf(a_cmp,a_assign,None)) !t_void p in a_if :: acc @@ -1122,7 +1122,7 @@ module Printer = struct | TMeta(_,e) -> remove_outer_parens e | _ -> e - let print_args args p = + let rec print_args pctx args p = let had_value = ref false in let had_var_args = ref false in let had_kw_args = ref false in @@ -1145,11 +1145,11 @@ module Printer = struct | None -> "" | Some ct -> had_value := true; - Printf.sprintf " = %s" (print_constant ct) + Printf.sprintf " = %s" (print_expr pctx ct) ) args in String.concat "," sl - let rec print_op_assign_right pctx e = + and print_op_assign_right pctx e = match e.eexpr with | TIf({eexpr = TParenthesis econd},eif,Some eelse) | TIf(econd,eif,Some eelse) -> @@ -1173,7 +1173,7 @@ module Printer = struct | None -> pctx.pc_next_anon_func() | Some s -> handle_keywords s in - let s_args = print_args tf.tf_args p in + let s_args = print_args pctx tf.tf_args p in let s_expr = print_expr {pctx with pc_indent = " " ^ pctx.pc_indent} tf.tf_expr in Printf.sprintf "def %s(%s):\n%s %s" s_name s_args pctx.pc_indent s_expr diff --git a/src/generators/genswf9.ml b/src/generators/genswf9.ml index e0a88748074..a2ecc9f9968 100644 --- a/src/generators/genswf9.ml +++ b/src/generators/genswf9.ml @@ -672,6 +672,9 @@ let end_fun ctx args dparams tret = hlmt_function = None; } +let gen_expr_ref = ref (fun _ _ _ -> assert false) +let gen_expr ctx e retval = (!gen_expr_ref) ctx e retval + let begin_fun ctx args tret el stat p = let old_locals = ctx.locals in let old_code = ctx.code in @@ -708,18 +711,18 @@ let begin_fun ctx args tret el stat p = let v = (match classify ctx t, c with | _, None -> HVNone | (KInt | KFloat | KUInt | KBool) as kind, Some c -> - (match c with - | TInt i -> if kind = KUInt then HVUInt i else HVInt i - | TFloat s -> HVFloat (float_of_string s) - | TBool b -> HVBool b - | TNull -> abort ("In Flash9, null can't be used as basic type " ^ s_type (print_context()) t) p + (match c.eexpr with + | TConst (TInt i) -> if kind = KUInt then HVUInt i else HVInt i + | TConst (TFloat s) -> HVFloat (float_of_string s) + | TConst (TBool b) -> HVBool b + | TConst TNull -> abort ("In Flash9, null can't be used as basic type " ^ s_type (print_context()) t) p | _ -> assert false) - | _, Some TNull -> HVNone + | _, Some {eexpr = TConst TNull} -> HVNone | k, Some c -> write ctx (HReg r.rid); write ctx HNull; let j = jump ctx J3Neq in - gen_constant ctx c t p; + gen_expr ctx true c; coerce ctx k; write ctx (HSetReg r.rid); j(); @@ -867,9 +870,6 @@ let pop_value ctx retval = branch value *) if retval then ctx.infos.istack <- ctx.infos.istack - 1 -let gen_expr_ref = ref (fun _ _ _ -> assert false) -let gen_expr ctx e retval = (!gen_expr_ref) ctx e retval - let rec gen_access ctx e (forset : 'a) : 'a access = match e.eexpr with | TLocal v -> @@ -1777,10 +1777,10 @@ let generate_construct ctx fdata c = let cargs = if not ctx.need_ctor_skip then fdata.tf_args else List.map (fun (v,c) -> let c = (match c with Some _ -> c | None -> Some (match classify ctx v.v_type with - | KInt | KUInt -> TInt 0l - | KFloat -> TFloat "0" - | KBool -> TBool false - | KType _ | KDynamic | KNone -> TNull) + | KInt | KUInt -> mk (TConst (TInt 0l)) ctx.com.basic.tint v.v_pos + | KFloat -> mk (TConst (TFloat "0")) ctx.com.basic.tfloat v.v_pos + | KBool -> mk (TConst (TBool false)) ctx.com.basic.tbool v.v_pos + | KType _ | KDynamic | KNone -> mk (TConst TNull) t_dynamic v.v_pos) ) in v,c ) fdata.tf_args in @@ -2230,7 +2230,7 @@ let generate_enum ctx e meta = hlf_slot = !st_count; hlf_kind = (match f.ef_type with | TFun (args,_) -> - let fdata = begin_fun ctx (List.map (fun (a,opt,t) -> alloc_var VGenerated a t e.e_pos, (if opt then Some TNull else None)) args) (TEnum (e,[])) [] true f.ef_pos in + let fdata = begin_fun ctx (List.map (fun (a,opt,t) -> alloc_var VGenerated a t e.e_pos, (if opt then Some (mk (TConst TNull) t_dynamic null_pos) else None)) args) (TEnum (e,[])) [] true f.ef_pos in write ctx (HFindPropStrict name_id); write ctx (HString f.ef_name); write ctx (HInt f.ef_index); diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index e085bcabaca..7addfa7f405 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -1123,7 +1123,7 @@ and encode_tfunc func = "args",encode_array (List.map (fun (v,c) -> encode_obj [ "v",encode_tvar v; - "value",match c with None -> vnull | Some c -> encode_tconst c + "value",match c with None -> vnull | Some c -> encode_texpr c ] ) func.tf_args); "t",encode_type func.tf_type; @@ -1306,7 +1306,7 @@ let decode_module_type v = let rec decode_tfunc v = { - tf_args = List.map (fun v -> decode_tvar (field v "v"),opt decode_tconst (field v "value")) (decode_array (field v "args")); + tf_args = List.map (fun v -> decode_tvar (field v "v"),opt decode_texpr (field v "value")) (decode_array (field v "args")); tf_type = decode_type (field v "t"); tf_expr = decode_texpr (field v "expr") } diff --git a/src/optimization/inline.ml b/src/optimization/inline.ml index 91d44646585..eedfd94e6bd 100644 --- a/src/optimization/inline.ml +++ b/src/optimization/inline.ml @@ -386,7 +386,7 @@ class inline_state ctx ethis params cf f p = object(self) let dynamic_e = follow e.etype == t_dynamic in let e = if dynamic_v <> dynamic_e then mk (TCast(e,None)) v.v_type e.epos else e in let e = match e.eexpr, opt with - | TConst TNull , Some c -> mk (TConst c) v.v_type e.epos + | TConst TNull , Some c -> c | _ -> e in if has_side_effect e then begin @@ -398,7 +398,10 @@ class inline_state ctx ethis params cf f p = object(self) loop ((l,e) :: acc) pl al false | [], (v,opt) :: al -> let l = self#declare v in - let e = mk (TConst (match opt with None -> TNull | Some c -> c)) v.v_type p in + let e = match opt with + | None -> mk (TConst TNull) v.v_type v.v_pos + | Some e -> e + in loop ((l,e) :: acc) [] al false in (* diff --git a/src/typing/calls.ml b/src/typing/calls.ml index 7e2fc1b2f58..f5c15daa427 100644 --- a/src/typing/calls.ml +++ b/src/typing/calls.ml @@ -435,7 +435,7 @@ let rec acc_get ctx g p = let ve = alloc_var VGenerated "_e" e.etype e.epos in let ecall = make_call ctx et (List.map (fun v -> mk (TLocal v) v.v_type p) (ve :: List.map snd args)) ret p in let ecallb = mk (TFunction { - tf_args = List.map (fun (o,v) -> v,if o then Some TNull else None) args; + tf_args = List.map (fun (o,v) -> v,if o then Some (Texpr.Builder.make_null v.v_type v.v_pos) else None) args; tf_type = ret; tf_expr = (match follow ret with | TAbstract ({a_path = [],"Void"},_) -> ecall | _ -> mk (TReturn (Some ecall)) t_dynamic p); }) tcallb p in @@ -705,7 +705,7 @@ let type_bind ctx (e : texpr) (args,ret) params p = mk (TReturn (Some call)) t_dynamic p; in let func = mk (TFunction { - tf_args = List.map (fun (v,o) -> v, if o then Some TNull else None) missing_args; + tf_args = List.map (fun (v,o) -> v, if o then Some (Texpr.Builder.make_null v.v_type null_pos) else None) missing_args; tf_type = ret; tf_expr = e_ret; }) t_inner p in diff --git a/src/typing/typeloadFunction.ml b/src/typing/typeloadFunction.ml index db2003db146..04445f46a07 100644 --- a/src/typing/typeloadFunction.ml +++ b/src/typing/typeloadFunction.ml @@ -75,7 +75,8 @@ let type_function_arg_value ctx t c do_display = let e = ctx.g.do_optimize ctx (type_expr ctx e (WithType.with_type t)) in unify ctx e.etype t p; let rec loop e = match e.eexpr with - | TConst c -> Some c + | TConst _ -> Some e + | TField({eexpr = TTypeExpr _},FEnum _) -> Some e | TCast(e,None) -> loop e | _ -> if ctx.com.display.dms_kind = DMNone || ctx.com.display.dms_inline && ctx.com.display.dms_error_policy = EPCollect then @@ -227,11 +228,12 @@ let add_constructor ctx c force_constructor p = let's optimize a bit the output by not always copying the default value into the inherited constructor when it's not necessary for the platform *) + let null () = Some (Texpr.Builder.make_null v.v_type v.v_pos) in match ctx.com.platform, def with - | _, Some _ when not ctx.com.config.pf_static -> v, (Some TNull) - | Flash, Some (TString _) -> v, (Some TNull) - | Cpp, Some (TString _) -> v, def - | Cpp, Some _ -> { v with v_type = ctx.t.tnull v.v_type }, (Some TNull) + | _, Some _ when not ctx.com.config.pf_static -> v, null() + | Flash, Some ({eexpr = TConst (TString _)}) -> v, null() + | Cpp, Some ({eexpr = TConst (TString _)}) -> v, def + | Cpp, Some _ -> { v with v_type = ctx.t.tnull v.v_type }, null() | _ -> v, def in let args = (match cfsup.cf_expr with @@ -242,7 +244,11 @@ let add_constructor ctx c force_constructor p = match follow cfsup.cf_type with | TFun (args,_) -> List.map (fun (n,o,t) -> - let def = try type_function_arg_value ctx t (Some (PMap.find n values)) false with Not_found -> if o then Some TNull else None in + let def = try + type_function_arg_value ctx t (Some (PMap.find n values)) false + with Not_found -> + if o then Some (Texpr.Builder.make_null t null_pos) else None + in map_arg (alloc_var (VUser TVOArgument) n (if o then ctx.t.tnull t else t) p,def) (* TODO: var pos *) ) args | _ -> assert false diff --git a/std/haxe/macro/Type.hx b/std/haxe/macro/Type.hx index faa20562f9a..89a0a6b8525 100644 --- a/std/haxe/macro/Type.hx +++ b/std/haxe/macro/Type.hx @@ -795,7 +795,7 @@ typedef TFunc = { A list of function arguments identified by an argument variable `v` and an optional initialization `value`. **/ - var args: Array<{v:TVar, value:Null}>; + var args: Array<{v:TVar, value:Null}>; /** The return type of the function. diff --git a/tests/unit/src/unit/issues/Issue4287.hx b/tests/unit/src/unit/issues/Issue4287.hx new file mode 100644 index 00000000000..5d58cb60f9f --- /dev/null +++ b/tests/unit/src/unit/issues/Issue4287.hx @@ -0,0 +1,16 @@ +package unit.issues; + +import haxe.ds.Option; + +class Issue4287 extends unit.Test { + @:analyzer(no_user_var_fusion) + function test() { + eq(None, getNone()); + var local = function(t = None) return t; + eq(None, local()); + } + + static function getNone(t = None) { + return t; + } +} \ No newline at end of file