From 319b84b18e50eb990747d10223ccaac4ce54d9d7 Mon Sep 17 00:00:00 2001 From: Aidan Lee Date: Sat, 8 Feb 2025 14:06:28 +0000 Subject: [PATCH 1/8] Update to latest gencpp changes --- src/compiler/compiler.ml | 2 +- src/generators/cpp/cppAst.ml | 12 +- src/generators/cpp/cppAstTools.ml | 23 ++- src/generators/cpp/cppRetyper.ml | 126 +++++++++--- src/generators/cpp/gen/cppCppia.ml | 6 +- src/generators/cpp/gen/cppGen.ml | 115 ++++++----- src/generators/cpp/gen/cppGenClassHeader.ml | 8 +- .../cpp/gen/cppGenClassImplementation.ml | 189 +++++++++--------- 8 files changed, 285 insertions(+), 196 deletions(-) diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml index 73f4aae41a0..63c65e45a18 100644 --- a/src/compiler/compiler.ml +++ b/src/compiler/compiler.ml @@ -133,7 +133,7 @@ module Setup = struct add_std "php"; "php" | Cpp -> - Common.define_value com Define.HxcppApiLevel "430"; + Common.define_value com Define.HxcppApiLevel "500"; add_std "cpp"; if Common.defined com Define.Cppia then actx.classes <- (Path.parse_path "cpp.cppia.HostClasses" ) :: actx.classes; diff --git a/src/generators/cpp/cppAst.ml b/src/generators/cpp/cppAst.ml index f30a0bd0cfc..03ab697c0ee 100644 --- a/src/generators/cpp/cppAst.ml +++ b/src/generators/cpp/cppAst.ml @@ -64,11 +64,11 @@ type tcpp = | TCppAutoCast | TCppDynamicArray | TCppObjectArray of tcpp - | TCppWrapped of tcpp + | TCppCallable of tcpp list * tcpp | TCppScalarArray of tcpp | TCppObjC of tclass | TCppNativePointer of tclass - | TCppVariant + | TCppVariant of tcpp option | TCppCode of tcpp | TCppInst of tclass * tcpp list | TCppInterface of tclass @@ -100,7 +100,10 @@ and tcppvarloc = | VarStatic of tclass * bool * tclass_field | VarInternal of tcppexpr * string * string -and tcppinst = InstPtr | InstObjC | InstStruct +and tcppinst = + | InstPtr of tcpp + | InstObjC + | InstStruct and tcppfuncloc = | FuncThis of tclass_field * tcpp @@ -143,7 +146,7 @@ and tcpp_expr_expr = | CppThis of tcppthis | CppSuper of tcppthis | CppCode of string * tcppexpr list - | CppClosure of tcpp_closure + | CppCallable of tcpp_closure | CppVar of tcppvarloc | CppExtern of string * bool | CppDynamicField of tcppexpr * string @@ -211,6 +214,7 @@ and tcpp_class_function = { tcf_field : tclass_field; tcf_name : string; tcf_func : tfunc; + tcf_callable : tcpp; tcf_is_virtual : bool; tcf_is_reflective : bool; diff --git a/src/generators/cpp/cppAstTools.ml b/src/generators/cpp/cppAstTools.ml index 705e9c33a54..8d01be5eca1 100644 --- a/src/generators/cpp/cppAstTools.ml +++ b/src/generators/cpp/cppAstTools.ml @@ -276,7 +276,7 @@ let rec s_tcpp = function | CppThis _ -> "CppThis" | CppSuper _ -> "CppSuper" | CppCode _ -> "CppCode" - | CppClosure _ -> "CppClosure" + | CppCallable _ -> "CppCallable" | CppVar (VarLocal _) -> "CppVarLocal" | CppVar (VarClosure _) -> "CppVarClosure" | CppVar (VarThis _) -> "CppVarThis" @@ -296,7 +296,7 @@ let rec s_tcpp = function | CppCall (FuncInstance (obj, inst, field), _) -> (match inst with | InstObjC -> "CppCallObjCInstance(" - | InstPtr -> "CppCallInstance(" + | InstPtr _ -> "CppCallInstance(" | _ -> "CppCallStruct(") ^ tcpp_to_string obj.cpptype ^ "," ^ field.cf_name ^ ")" | CppCall (FuncInterface _, _) -> "CppCallInterface" @@ -366,7 +366,13 @@ and tcpp_to_string_suffix suffix tcpp = | TCppRest _ -> "vaarg_list" | TCppVarArg -> "vararg" | TCppAutoCast -> "::cpp::AutoCast" - | TCppVariant -> "::cpp::Variant" + | TCppVariant None -> "::cpp::Variant" + | TCppVariant Some t -> Printf.sprintf "::cpp::Variant( %s )" (tcpp_to_string t) + | TCppCallable (arguments, return) -> + let return_str = tcpp_to_string return in + let arguments_str = arguments |> List.map tcpp_to_string |> String.concat "," in + + Printf.sprintf "::hx::Callable< %s ( %s ) >" return_str arguments_str | TCppEnum enum -> " ::" ^ join_class_path_remap enum.e_path "::" ^ suffix | TCppScalar scalar -> scalar | TCppString -> "::String" @@ -384,7 +390,6 @@ and tcpp_to_string_suffix suffix tcpp = tcpp_objc_block_struct argTypes retType ^ "::t" | TCppDynamicArray -> "::cpp::VirtualArray" ^ suffix | TCppObjectArray _ -> "::Array" ^ suffix ^ "< ::Dynamic>" - | TCppWrapped _ -> " ::Dynamic" | TCppScalarArray value -> "::Array" ^ suffix ^ "< " ^ tcpp_to_string value ^ " >" | TCppObjC klass -> @@ -647,7 +652,7 @@ let rec cpp_is_native_array_access t = | _ -> false let cpp_is_dynamic_type = function - | TCppDynamic | TCppObject | TCppVariant | TCppWrapped _ | TCppGlobal | TCppNull + | TCppDynamic | TCppObject | TCppVariant _ | TCppGlobal | TCppNull | TCppInterface _ -> true | _ -> false @@ -665,10 +670,10 @@ let is_object_element member_type = | TCppFunction _ | TCppDynamicArray | TCppObjectArray _ - | TCppWrapped _ | TCppScalarArray _ | TCppClass - -> true + | TCppCallable _ + -> true | _ -> false let cpp_variant_type_of t = match t with @@ -684,7 +689,6 @@ let cpp_variant_type_of t = match t with | TCppDynamicArray | TCppObjectArray _ | TCppScalarArray _ - | TCppWrapped _ | TCppObjC _ | TCppObjCBlock _ | TCppRest _ @@ -695,6 +699,7 @@ let cpp_variant_type_of t = match t with | TCppClass | TCppGlobal | TCppNull + | TCppCallable _ | TCppEnum _ -> TCppDynamic | TCppString -> TCppString | TCppFunction _ @@ -711,7 +716,7 @@ let cpp_variant_type_of t = match t with | TCppScalar "double" | TCppScalar "float" -> TCppScalar("Float") | TCppScalar _ -> TCppScalar("int") - | TCppVariant -> TCppVariant + | TCppVariant v -> TCppVariant v let cpp_cast_variant_type_of t = match t with | TCppObjectArray _ diff --git a/src/generators/cpp/cppRetyper.ml b/src/generators/cpp/cppRetyper.ml index 945c4160c36..618ff0ddc65 100644 --- a/src/generators/cpp/cppRetyper.ml +++ b/src/generators/cpp/cppRetyper.ml @@ -8,7 +8,8 @@ open CppAstTools open CppContext let rec cpp_type_of stack haxe_type = - if List.exists (fast_eq haxe_type) stack then TCppDynamic + if List.exists (fast_eq haxe_type) stack then + TCppDynamic else let stack = haxe_type :: stack in match haxe_type with @@ -33,9 +34,49 @@ let rec cpp_type_of stack haxe_type = | None -> TCppScalar (join_class_path a.a_path "::") else TCppDynamic) | TType (type_def, params) -> - cpp_type_from_path stack type_def.t_path params (fun () -> - cpp_type_of stack (apply_typedef type_def params)) - | TFun _ -> TCppObject + (* Can't really remember why / what this is doing *) + (* I only have vague memories of nightmares about trying to stop recursive typedefs turning stuff dynamic *) + let rec find s t = + if List.exists (fast_eq t) s then begin + true + end else + let s = t :: s in + match t with + | TMono r -> + (match r.tm_type with + | None -> false + | Some t -> find s t) + | TEnum (_,tl) | TInst (_,tl) -> + List.exists (find s) tl + | TAbstract (abs,tl) -> + if not (Meta.has Meta.CoreType abs.a_meta) && (find s (Abstract.get_underlying_type ~return_first:true abs tl)) then + true + else + List.exists (find s) tl + | TType (tdef,tl) -> + find s (apply_typedef tdef tl) + | TFun (tl,r) -> + if (find s r) then + true + else begin + List.exists (fun (_,_,targ) -> (find s targ)) tl + end + | TLazy f -> + find s (lazy_type f) + | TDynamic (Some t2) -> + find s t2 + | _ -> + false + in + if find [] haxe_type then + cpp_type_from_path stack type_def.t_path params (fun () -> TCppDynamic) + else + cpp_type_from_path stack type_def.t_path params (fun () -> cpp_type_of stack (apply_typedef type_def params)) + | TFun (arguments, return) -> + let retyped_arguments = List.map (fun (_, o, t) -> cpp_tfun_arg_type_of stack o t) arguments in + let retyped_return = cpp_type_of stack return in + + TCppCallable (retyped_arguments, retyped_return) | TAnon _ -> TCppObject | TDynamic _ -> TCppDynamic | TLazy func -> cpp_type_of stack (lazy_type func) @@ -104,7 +145,7 @@ and cpp_type_from_path stack path params default = | TCppVoid (* ? *) | TCppDynamic -> TCppDynamicArray | TCppObject | TCppObjectPtr | TCppReference _ | TCppStruct _ | TCppStar _ | TCppEnum _ | TCppInst _ | TCppInterface _ | TCppProtocol _ | TCppClass - | TCppDynamicArray | TCppObjectArray _ | TCppScalarArray _ -> + | TCppDynamicArray | TCppObjectArray _ | TCppScalarArray _ | TCppCallable _ -> TCppObjectArray arrayOf | _ -> TCppScalarArray arrayOf) | ([], "Null"), [ p ] -> cpp_type_of_null stack p @@ -121,10 +162,10 @@ and cpp_type_of_pointer stack p = | x -> cpp_type_of stack x (* Optional types are Dynamic if they norally could not be null *) -and cpp_fun_arg_type_of stack tvar opt = +and cpp_fun_arg_type_of tvar opt = match opt with - | Some _ -> cpp_type_of_null stack tvar.t_type - | _ -> cpp_type_of stack tvar.t_type + | Some _ -> cpp_type_of_null [] tvar.v_type + | _ -> cpp_type_of [] tvar.v_type and cpp_tfun_arg_type_of stack opt t = if opt then cpp_type_of_null stack t else cpp_type_of stack t @@ -478,10 +519,10 @@ let expression ctx request_type function_args function_type expression_tree forI else if retypedObj.cpptype = TCppDynamic && not (has_class_flag clazz CInterface) then if is_internal_member member.cf_name then ( retyper_ctx, - CppFunction (FuncInstance (retypedObj, InstPtr, member), funcReturn), + CppFunction (FuncInstance (retypedObj, InstPtr clazzType, member), funcReturn), exprType ) else - (retyper_ctx, CppDynamicField (retypedObj, member.cf_name), TCppVariant) + (retyper_ctx, CppDynamicField (retypedObj, member.cf_name), TCppVariant (Some (cpp_type_of member.cf_type))) else if cpp_is_struct_access retypedObj.cpptype then match retypedObj.cppexpr with | CppThis ThisReal -> @@ -523,7 +564,7 @@ let expression ctx request_type function_args function_type expression_tree forI | TCppInterface _, _ | TCppDynamic, _ -> ( retyper_ctx, CppDynamicField (retypedObj, member.cf_name), - TCppVariant ) + TCppVariant (Some (cpp_type_of member.cf_type)) ) | TCppObjC _, _ -> ( retyper_ctx, CppVar (VarInstance ( retypedObj, member, tcpp_to_string clazzType, "." )), @@ -554,10 +595,16 @@ let expression ctx request_type function_args function_type expression_tree forI let funcReturn = if isArrayObj then match member.cf_name with - | "map" -> TCppDynamicArray + | "map" -> + (match expr.etype with + | TFun (_, return) -> + cpp_type_of return + | _ -> + die "map expr type was not TFun" __LOC__) | "splice" | "slice" | "concat" | "copy" | "filter" -> retypedObj.cpptype - | _ -> funcReturn + | _ -> + funcReturn else match (retypedObj.cpptype, funcReturn) with | TCppPointer (_, t), TCppDynamic @@ -581,7 +628,7 @@ let expression ctx request_type function_args function_type expression_tree forI CppFunction ( FuncInstance ( retypedObj, - (if is_objc then InstObjC else InstPtr), + (if is_objc then InstObjC else InstPtr clazzType), member ), funcReturn ), exprType )) @@ -615,7 +662,7 @@ let expression ctx request_type function_args function_type expression_tree forI ( retyper_ctx, CppFunction (FuncInternal (obj, fieldName, "->"), cppType), cppType ) - else (retyper_ctx, CppDynamicField (obj, field.cf_name), TCppVariant) + else (retyper_ctx, CppDynamicField (obj, field.cf_name), TCppVariant (Some (cpp_type_of field.cf_type))) | FDynamic fieldName -> let retyper_ctx, obj = retype retyper_ctx TCppDynamic obj in if obj.cpptype = TCppNull then (retyper_ctx, CppNullAccess, TCppDynamic) @@ -651,7 +698,7 @@ let expression ctx request_type function_args function_type expression_tree forI ( retyper_ctx, CppVar (VarInternal (obj, "->", fieldName)), cpp_type_of expr.etype ) - else (retyper_ctx, CppDynamicField (obj, fieldName), TCppVariant) + else (retyper_ctx, CppDynamicField (obj, fieldName), TCppVariant None) | FEnum (enum, enum_field) -> (retyper_ctx, CppEnumField (enum, enum_field), TCppEnum enum)) | TCall ({ eexpr = TIdent "__cpp__" }, arg_list) -> @@ -678,6 +725,10 @@ let expression ctx request_type function_args function_type expression_tree forI | TCppObjCBlock (argTypes, retType) -> let retyper_ctx, retypedArgs = retype_function_args retyper_ctx args argTypes in (retyper_ctx, CppCall (FuncExpression retypedFunc, retypedArgs), retType) + | TCppVariant Some TCppCallable (argTypes, retType) -> + let retyper_ctx, retypedArgs = retype_function_args retyper_ctx args argTypes in + let retyper_ctx, retypedCall = retype retyper_ctx (TCppCallable (argTypes, retType)) func in + (retyper_ctx, CppCall (FuncExpression retypedCall, retypedArgs), retType) | _ -> ( let cppType = cpp_type_of expr.etype in match retypedFunc.cppexpr with @@ -701,19 +752,19 @@ let expression ctx request_type function_args function_type expression_tree forI | CppEnumIndex _ -> (* Not actually a TCall...*) (retyper_ctx, retypedFunc.cppexpr, retypedFunc.cpptype) - | CppFunction (FuncInstance (obj, InstPtr, member), _) + | CppFunction (FuncInstance (obj, InstPtr tcpp, member), _) when (not forCppia) && return_type = TCppVoid && is_array_splice_call obj member -> let arg_types = List.map (fun _ -> TCppDynamic) args in let retyper_ctx, retypedArgs = retype_function_args retyper_ctx args arg_types in ( retyper_ctx, - CppCall ( FuncInstance (obj, InstPtr, { member with cf_name = "removeRange" }), retypedArgs ), + CppCall ( FuncInstance (obj, InstPtr tcpp, { member with cf_name = "removeRange" }), retypedArgs ), TCppVoid ) - | CppFunction (FuncInstance (obj, InstPtr, member), _) + | CppFunction (FuncInstance (obj, InstPtr tcpp, member), _) when is_array_concat_call obj member -> let arg_types = List.map (fun _ -> obj.cpptype) args in let retyper_ctx, retypedArgs = retype_function_args retyper_ctx args arg_types in ( retyper_ctx, - CppCall (FuncInstance (obj, InstPtr, member), retypedArgs), + CppCall (FuncInstance (obj, InstPtr tcpp, member), retypedArgs), return_type ) | CppFunction (FuncStatic (obj, false, member), _) when member.cf_name = "::hx::AddressOf" -> @@ -751,7 +802,7 @@ let expression ctx request_type function_args function_type expression_tree forI abort "First parameter of template function must be a Class" retypedFunc.cpppos) - | CppFunction (FuncInstance (obj, InstPtr, member), _) + | CppFunction (FuncInstance (obj, InstPtr tcpp, member), _) when is_map_get_call obj member -> let arg_types = List.map (fun _ -> TCppDynamic) args in let retyper_ctx, retypedArgs = retype_function_args retyper_ctx args arg_types in @@ -774,7 +825,7 @@ let expression ctx request_type function_args function_type expression_tree forI | _ -> ("get", TCppDynamic) in let func = - FuncInstance (obj, InstPtr, { member with cf_name = fname }) + FuncInstance (obj, InstPtr tcpp, { member with cf_name = fname }) in (* if cpp_can_static_cast cppType return_type then begin @@ -783,7 +834,7 @@ let expression ctx request_type function_args function_type expression_tree forI end else *) (retyper_ctx, CppCall (func, retypedArgs), cppType) - | CppFunction (FuncInstance (obj, InstPtr, member), _) + | CppFunction (FuncInstance (obj, InstPtr tcpp, member), _) when forCppia && is_map_set_call obj member -> let arg_types = List.map (fun _ -> TCppDynamic) args in let retyper_ctx, retypedArgs = retype_function_args retyper_ctx args arg_types in @@ -797,10 +848,10 @@ let expression ctx request_type function_args function_type expression_tree forI | [ _; { cpptype = TCppString } ] -> "setString" | _ -> "set" in - let func = FuncInstance (obj, InstPtr, { member with cf_name = fname }) in + let func = FuncInstance (obj, InstPtr tcpp, { member with cf_name = fname }) in (retyper_ctx, CppCall (func, retypedArgs), cppType) | CppFunction - ((FuncInstance (obj, InstPtr, member) as func), returnType) + ((FuncInstance (obj, InstPtr tcpp, member) as func), returnType) when cpp_can_static_cast returnType cppType -> let arg_types = List.map (fun _ -> TCppDynamic) args in let retyper_ctx, retypedArgs = retype_function_args retyper_ctx args arg_types in @@ -945,8 +996,10 @@ let expression ctx request_type function_args function_type expression_tree forI undeclared = new_undeclared; uses_this = if new_ctx.uses_this != None then Some retyper_ctx.this_real else retyper_ctx.uses_this; } in + let fargs = List.map (fun (v,o) -> cpp_fun_arg_type_of v o) result.close_args in + let fret = cpp_type_of func.tf_type in - (retyper_ctx, CppClosure result, TCppDynamic) + (retyper_ctx, CppCallable result, TCppCallable (fargs, fret)) | TArray (e1, e2) -> let retyper_ctx, arrayExpr, elemType = match cpp_is_native_array_access (cpp_type_of e1.etype) with @@ -1068,8 +1121,9 @@ let expression ctx request_type function_args function_type expression_tree forI in match (op, e1.cpptype, e2.cpptype) with (* Variant + Variant = Variant *) - | OpAdd, _, TCppVariant | OpAdd, TCppVariant, _ -> - (retyper_ctx, reference, TCppVariant) + | OpAdd, _, TCppVariant o + | OpAdd, TCppVariant o, _ -> + (retyper_ctx, reference, TCppVariant o) | _, _, _ -> (retyper_ctx, reference, cpp_type_of expr.etype)) | TUnop (op, pre, e1) -> @@ -1344,6 +1398,11 @@ let expression ctx request_type function_args function_type expression_tree forI (retyper_ctx, CppTCast (baseCpp, return_type), return_type)) in let cppExpr = mk_cppexpr retypedExpr retypedType in + let is_variant t = + match t with + | TCppVariant _ -> true + | _ -> false + in (* Autocast rules... *) if return_type = TCppVoid then @@ -1362,7 +1421,7 @@ let expression ctx request_type function_args function_type expression_tree forI in retyper_ctx, mk_cppexpr (CppCastNative toDynamic) TCppVoidStar else if - cppExpr.cpptype = TCppVariant + is_variant cppExpr.cpptype || cppExpr.cpptype = TCppDynamic || cppExpr.cpptype == TCppObject then @@ -1375,7 +1434,7 @@ let expression ctx request_type function_args function_type expression_tree forI in retyper_ctx, mk_cppexpr (CppCast (structCast, TCppInst (t, []))) (TCppInst (t, [])) | TCppObjectArray _ | TCppScalarArray _ | TCppNativePointer _ - | TCppDynamicArray | TCppObjectPtr | TCppVarArg | TCppInst _ -> + | TCppDynamicArray | TCppObjectPtr | TCppVarArg | TCppInst _ | TCppCallable _ -> retyper_ctx, mk_cppexpr (CppCast (cppExpr, return_type)) return_type | TCppObjC k -> retyper_ctx, mk_cppexpr (CppCastObjC (cppExpr, k)) return_type | TCppObjCBlock (ret, args) -> @@ -1384,9 +1443,9 @@ let expression ctx request_type function_args function_type expression_tree forI retyper_ctx, mk_cppexpr (CppCastScalar (cppExpr, scalar)) return_type | TCppString -> retyper_ctx, mk_cppexpr (CppCastScalar (cppExpr, "::String")) return_type - | TCppInterface _ when cppExpr.cpptype = TCppVariant -> + | TCppInterface _ when is_variant cppExpr.cpptype -> retyper_ctx, mk_cppexpr (CppCastVariant cppExpr) return_type - | TCppDynamic when cppExpr.cpptype = TCppVariant -> + | TCppDynamic when is_variant cppExpr.cpptype -> retyper_ctx, mk_cppexpr (CppCastVariant cppExpr) return_type | TCppStar (t, const) -> let ptrType = @@ -1515,7 +1574,7 @@ let native_field_name_remap field = let rec tcpp_class_from_tclass ctx ids slots class_def class_params = let scriptable = Gctx.defined ctx.ctx_common Define.Scriptable in - + let create_function field func = { tcf_field = field; tcf_name = native_field_name_remap field; @@ -1525,6 +1584,7 @@ let rec tcpp_class_from_tclass ctx ids slots class_def class_params = tcf_is_external = not (is_internal_member field.cf_name); tcf_is_overriding = is_override field; tcf_is_scriptable = scriptable; + tcf_callable = cpp_type_of field.cf_type; } in let create_variable field = { diff --git a/src/generators/cpp/gen/cppCppia.ml b/src/generators/cpp/gen/cppCppia.ml index 1581322c1f4..70f3d0e1c29 100644 --- a/src/generators/cpp/gen/cppCppia.ml +++ b/src/generators/cpp/gen/cppCppia.ml @@ -77,7 +77,7 @@ let rec script_type_string haxe_type = let rec script_cpptype_string cppType = match cppType with - | TCppDynamic | TCppUnchanged | TCppWrapped _ | TCppObject -> "Dynamic" + | TCppDynamic | TCppUnchanged | TCppObject | TCppCallable _ -> "Dynamic" | TCppObjectPtr -> ".*.hx.Object*" | TCppReference t -> ".ref." ^ script_cpptype_string t | TCppStruct t -> ".struct." ^ script_cpptype_string t @@ -87,7 +87,7 @@ let rec script_cpptype_string cppType = | TCppRest _ -> "vaarg_list" | TCppVarArg -> "vararg" | TCppAutoCast -> ".cpp.AutoCast" - | TCppVariant -> ".cpp.Variant" + | TCppVariant _ -> ".cpp.Variant" | TCppEnum enum -> join_class_path enum.e_path "." | TCppScalar scalar -> scalar | TCppString -> "String" @@ -1559,7 +1559,7 @@ class script_writer ctx filename asciiOut = ^ this#typeTextString "Dynamic" ^ string_of_int index ^ "\n"); gen_expression obj - | CppClosure closure -> + | CppCallable closure -> this#write (this#op IaFun ^ this#astType closure.close_type diff --git a/src/generators/cpp/gen/cppGen.ml b/src/generators/cpp/gen/cppGen.ml index 4d382805c6d..4f1453a2cf1 100644 --- a/src/generators/cpp/gen/cppGen.ml +++ b/src/generators/cpp/gen/cppGen.ml @@ -111,6 +111,22 @@ let cpp_debug_name_of var = keyword_remap var.v_name let cpp_debug_var_visible ctx var = not (cpp_no_debug_synbol ctx (fst var)) let cpp_var_type_of var = tcpp_to_string (cpp_type_of var.v_type) +let callable_args arguments prefix = + let make_arg (v, o) = + let name = keyword_remap v.v_name in + let return = tcpp_to_string (CppRetyper.cpp_fun_arg_type_of v o) in + let prefixed = match o with + | Some {eexpr = TConst TNull} -> name + | Some _ -> prefix ^ name + | None -> name in + return ^ " " ^ prefixed in + arguments |> List.map make_arg |> String.concat "," + +let cpp_closure_signature closure = + let return = tcpp_to_string closure.close_type in + let arguments = callable_args closure.close_args "" in + Printf.sprintf "%s(%s)" return arguments + let mk_injection prologue set_var tail = Some { inj_prologue = prologue; inj_setvar = set_var; inj_tail = tail } @@ -179,28 +195,24 @@ let default_value_string ctx value = let cpp_gen_default_values ctx args prefix = List.iter (fun (tvar, o) -> - let vtype = cpp_type_of tvar.v_type in - let not_null = - type_has_meta_key Meta.NotNull tvar.v_type || is_cpp_scalar vtype - in match o with | Some { eexpr = TConst TNull } -> () | Some const -> - let name = cpp_var_name_of tvar in - 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") + let name = cpp_var_name_of tvar in + let spacer = if ctx.ctx_debug_level > 0 then " \t" else "" in + let vtype = cpp_type_of tvar.v_type in + let not_null = type_has_meta_key Meta.NotNull tvar.v_type || is_cpp_scalar vtype 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 @@ -547,16 +559,39 @@ let gen_cpp_ast_expression_tree ctx class_name func_name function_args out ".StaticCast< ::hx::EnumBase >()"; out "->_hx_getIndex()" | CppNullAccess -> out ("::hx::Throw(" ^ strq "Null access" ^ ")") - | CppFunction (func, _) -> ( + | CppFunction (func, tcpp) -> ( match func with | FuncThis (field, _) -> out ("this->" ^ cpp_member_name_of field ^ "_dyn()") | FuncInstance (expr, inst, field) -> + (* array map is a special case as it is implemented as a templated function *) + (* so we need to figure out the target array type of the map function to generate the template params *) + let template_extra = + if (field.cf_name="map") then + match inst with + | InstPtr (TCppObjectArray _) + | InstPtr (TCppScalarArray _) + | InstPtr TCppDynamicArray -> + (match tcpp with + | TCppObjectArray el + | TCppScalarArray el -> + "< " ^ (tcpp_to_string el) ^ " >" + | TCppDynamicArray -> + tcpp_to_string TCppDynamic + | _ -> + die "map return type should be an array" __LOC__) + | _ -> + "" + else + "" in + let access = if expr.cpptype = TCppString || inst = InstStruct then + "." + else + "->" + in + gen expr; - out - ((if expr.cpptype = TCppString || inst = InstStruct then "." - else "->") - ^ cpp_member_name_of field ^ "_dyn()") + out (Printf.sprintf "%s%s_dyn%s()" access (cpp_member_name_of field) template_extra) | FuncInterface (expr, _, field) -> gen expr; out ("->__Field(" ^ strq field.cf_name ^ ", ::hx::paccDynamic)") @@ -933,15 +968,9 @@ let gen_cpp_ast_expression_tree ctx class_name func_name function_args else if path = "::Array" then out "::hx::ArrayBase::__mClass" else out ("::hx::ClassOf< " ^ path ^ " >()") | CppVar loc -> gen_val_loc loc false - | CppClosure closure -> - out - (" ::Dynamic(new _hx_Closure_" ^ string_of_int closure.close_id ^ "("); + | CppCallable closure -> + Printf.sprintf "::hx::Callable< %s >(new _hx_Closure_%i(" (cpp_closure_signature closure) closure.close_id |> out; let separator = ref "" in - (match closure.close_this with - | Some this -> - out (if this = ThisReal then "this" else "__this"); - separator := "," - | _ -> ()); StringMap.iter (fun name value -> @@ -1390,7 +1419,7 @@ let gen_cpp_ast_expression_tree ctx class_name func_name function_args out name | CppDynamicRef (expr, name) -> let objPtr = - match expr.cpptype with TCppVariant -> "getObject()" | _ -> ".mPtr" + match expr.cpptype with TCppVariant _ -> "getObject()" | _ -> ".mPtr" in out "::hx::FieldRef(("; gen expr; @@ -1469,16 +1498,14 @@ let gen_cpp_ast_expression_tree ctx class_name func_name function_args if argc >= 20 || List.length closure.close_args >= 20 then writer#add_big_closures; let argsCount = list_num closure.close_args in + let signature = cpp_closure_signature closure in output_i ("HX_BEGIN_LOCAL_FUNC_S" ^ size ^ "("); - out - (if closure.close_this != None then "::hx::LocalThisFunc," - else "::hx::LocalFunc,"); - out ("_hx_Closure_" ^ string_of_int closure.close_id); + Printf.sprintf "::hx::Callable_obj<%s>, _hx_Closure_%i" signature closure.close_id |> out; StringMap.iter (fun name var -> out ("," ^ cpp_macro_var_type_of var ^ "," ^ keyword_remap name)) closure.close_undeclared; - out (") HXARGC(" ^ argsCount ^ ")\n"); + out ")\n"; let func_type = tcpp_to_string closure.close_type in output_i @@ -1490,20 +1517,18 @@ let gen_cpp_ast_expression_tree ctx class_name func_name function_args hx_stack_push ctx output_i class_name func_name closure.close_expr.cpppos gc_stack; if ctx.ctx_debug_level >= 2 then ( - if closure.close_this != None then - output_i "HX_STACK_THIS(__this.mPtr)\n"; List.iter - (fun (v, _) -> - output_i - ("HX_STACK_ARG(" ^ cpp_var_name_of v ^ ",\"" - ^ cpp_debug_name_of v ^ "\")\n")) - (List.filter (cpp_debug_var_visible ctx) closure.close_args); + (fun (v,_) -> output_i ("HX_STACK_ARG(" ^ (cpp_var_name_of v) ^ ",\"" ^ (cpp_debug_name_of v) ^"\")\n") ) + (List.filter (cpp_debug_var_visible ctx) closure.close_args); let line = Lexer.get_error_line closure.close_expr.cpppos in let lineName = Printf.sprintf "%4d" line in out ("HXLINE(" ^ lineName ^ ")\n")) in gen_with_injection (mk_injection prologue "" "") closure.close_expr true; + output_i "int __Compare(const ::hx::Object* inRhs) const override {\n"; + output_i (Printf.sprintf "\treturn dynamic_cast(inRhs) ? 0 : -1;\n" closure.close_id); + output_i "}\n"; let return = match closure.close_type with TCppVoid -> "(void)" | _ -> "return" diff --git a/src/generators/cpp/gen/cppGenClassHeader.ml b/src/generators/cpp/gen/cppGenClassHeader.ml index dd9961b0d84..9126fc4d042 100644 --- a/src/generators/cpp/gen/cppGenClassHeader.ml +++ b/src/generators/cpp/gen/cppGenClassHeader.ml @@ -30,8 +30,9 @@ let gen_member_variable ctx class_def is_static (var:tcpp_class_variable) = let gen_dynamic_function ctx class_def is_static func = let output = ctx.ctx_output in let prefix = if is_static then "\t\tstatic " else "\t\t" in + let signature = tcpp_to_string func.tcf_callable in - Printf.sprintf "%sinline ::Dynamic& %s_dyn() { return %s; }\n" prefix func.tcf_name func.tcf_name |> output + Printf.sprintf "%sinline %s& %s_dyn() { return %s; }\n" prefix signature func.tcf_name func.tcf_name |> output let gen_member_function ctx class_def is_static func = let output = ctx.ctx_output in @@ -61,7 +62,10 @@ let gen_member_function ctx class_def is_static func = Printf.sprintf "\t\t%s %s %s(%s);\n" attributes return_type_str func.tcf_name (print_arg_list func.tcf_func.tf_args "") |> output; if (not func.tcf_is_virtual || not func.tcf_is_overriding) && func.tcf_is_reflective then - Printf.sprintf "\t\t%s::Dynamic %s_dyn();\n" (if is_static then "static " else "") func.tcf_name |> output; + let prefix = if is_static then "static " else "" in + let signature = tcpp_to_string func.tcf_callable in + + Printf.sprintf "\t\t%s%s %s_dyn();\n" prefix signature func.tcf_name |> output; output "\n" diff --git a/src/generators/cpp/gen/cppGenClassImplementation.ml b/src/generators/cpp/gen/cppGenClassImplementation.ml index de271c6a77d..7227f23780c 100644 --- a/src/generators/cpp/gen/cppGenClassImplementation.ml +++ b/src/generators/cpp/gen/cppGenClassImplementation.ml @@ -10,22 +10,58 @@ open CppSourceWriter open CppContext open CppGen -let gen_function ctx class_def class_name is_static func = +let write_closure_header callable_name captures_obj func class_name return_type_str prefix output = + + let func_signature = + match func.tcf_callable with + | TCppCallable (arguments, return) -> + Printf.sprintf "%s(%s)" (tcpp_to_string return) (arguments |> List.map tcpp_to_string |> String.concat ", ") + | _ -> + die (Printf.sprintf "tcf_callable should be a TCppCalllable but was %s" (tcpp_to_string func.tcf_callable)) __LOC__ + in + + Printf.sprintf "struct %s final : public ::hx::Callable_obj< %s > {\n" callable_name func_signature |> output; + + if captures_obj then begin + let obj_ptr_class_name = Printf.sprintf "::hx::ObjectPtr< %s >" class_name in + + Printf.sprintf "\t%s __this;\n" obj_ptr_class_name |> output; + Printf.sprintf "\t%s(%sobj = null()) : __this(obj) {} \n" callable_name obj_ptr_class_name |> output; + end else begin + Printf.sprintf "\t%s() {}\n" callable_name |> output + end; + + output "\tint __Compare(const ::hx::Object* inRhs) const override {\n"; + Printf.sprintf "\t\tauto casted = dynamic_cast(inRhs);\n" callable_name |> output; + output "\t\tif (!casted) { return -1; }\n"; + if captures_obj then + output "\t\tif (__this != casted->__this) return 1;\n"; + output "\t\treturn 0;\n"; + output "\t}\n"; + + Printf.sprintf "\t%s HX_LOCAL_RUN(%s) override {\n" return_type_str (callable_args func.tcf_func.tf_args prefix) |> output + +let write_closure_trailer captures_obj output = + output "\t}\n"; + if captures_obj then begin + output "\tvoid __Mark(hx::MarkContext* __inCtx) override { HX_MARK_MEMBER(__this); }\n"; + output "#ifdef HXCPP_VISIT_ALLOCS\n"; + output "\tvoid __Visit(hx::VisitContext* __inCtx) override { HX_VISIT_MEMBER(__this); }\n"; + output "#endif\n"; + end; + + output "};\n\n" + +let gen_function ctx tcpp_class is_static func = let output = ctx.ctx_output in let return_type_str = type_to_string func.tcf_func.tf_type in let return_type = cpp_type_of func.tcf_func.tf_type in let is_void = return_type = TCppVoid in let ret = if is_void then "(void)" else "return " in - let needsWrapper t = - match t with - | TCppStar _ -> true - | TCppInst (t, _) -> Meta.has Meta.StructAccess t.cl_meta - | _ -> false - in (* The actual function definition *) output (if is_void then "void" else return_type_str); - output (" " ^ class_name ^ "::" ^ func.tcf_name ^ "("); + output (" " ^ tcpp_class.tcl_name ^ "::" ^ func.tcf_name ^ "("); output (print_arg_list func.tcf_func.tf_args "__o_"); output ")"; ctx.ctx_real_this_ptr <- true; @@ -44,98 +80,55 @@ let gen_function ctx class_def class_name is_static func = with_debug ctx func.tcf_field.cf_meta - (gen_cpp_function_body ctx class_def is_static func.tcf_field.cf_name func.tcf_func code tail_code); + (gen_cpp_function_body ctx tcpp_class.tcl_class is_static func.tcf_field.cf_name func.tcf_func code tail_code); output "\n\n"; (* generate dynamic version too ... *) if (not func.tcf_is_virtual || not func.tcf_is_overriding) && func.tcf_is_reflective then - let tcpp_args = List.map (fun (v, _) -> cpp_type_of v.v_type) func.tcf_func.tf_args in - let wrap = needsWrapper return_type || List.exists needsWrapper tcpp_args in - - if wrap then ( - let wrapName = "_hx_wrap" ^ class_name ^ "_" ^ func.tcf_name in - output ("static ::Dynamic " ^ wrapName ^ "( "); - - let initial = if is_static then [] else [ "::hx::Object *obj" ] in - - initial @ (List.init (List.length tcpp_args) (fun idx -> Printf.sprintf "const ::Dynamic &a%i" idx)) - |> String.concat "," - |> output; - - output ") {\n\t"; - (if not is_void then - match return_type with - | TCppStar _ -> output "return (cpp::Pointer) " - | TCppInst (t, _) when Meta.has Meta.StructAccess t.cl_meta - -> - output ("return (cpp::Struct< " ^ tcpp_to_string return_type ^ " >) ") - | _ -> output "return "); - - if is_static then - output (class_name ^ "::" ^ func.tcf_name ^ "(") - else - output ("reinterpret_cast< " ^ class_name ^ " *>(obj)->" ^ func.tcf_name ^ "("); - - let cast_prefix idx arg = - match arg with - | TCppStar (t, const) -> - Printf.sprintf "(::cpp::%sPointer< %s >) a%i" (if const then "Const" else "") (tcpp_to_string t) idx - | TCppInst (t, _) when Meta.has Meta.StructAccess t.cl_meta -> - Printf.sprintf "(::cpp::Struct< %s >) a%i" (tcpp_to_string arg) idx - | _ -> - Printf.sprintf "a%i" idx in - - tcpp_args - |> ExtList.List.mapi cast_prefix - |> String.concat ", " - |> output; - - output ");\n"; - - if is_void then output "\treturn null();\n"; - output "}\n"; - let nName = string_of_int (List.length tcpp_args) in - output - ("::Dynamic " ^ class_name ^ "::" ^ func.tcf_name ^ "_dyn() {\n\treturn "); - if is_static then - output - ("::hx::CreateStaticFunction" ^ nName ^ "(\"" ^ func.tcf_name ^ "\"," ^ wrapName ^ ");") - else - output - ("::hx::CreateMemberFunction" ^ nName ^ "(\"" ^ func.tcf_name ^ "\",this," ^ wrapName ^ ");"); - output "}\n") + let callable_name = Printf.sprintf "__%s%s" tcpp_class.tcl_name func.tcf_name in + + write_closure_header callable_name (not is_static) func tcpp_class.tcl_name return_type_str "" output; + + let arg_name (tvar, _) = cpp_var_name_of tvar in + let args_pass = func.tcf_func.tf_args |> List.map arg_name |> String.concat ", " in + let prefix = if is_void then "\t\t" else "\t\treturn " in + if is_static then + Printf.sprintf "%s%s::%s(%s);\n" prefix tcpp_class.tcl_name func.tcf_name args_pass |> output else - let prefix = if is_static then "STATIC_" else "" in - Printf.sprintf "%sHX_DEFINE_DYNAMIC_FUNC%i(%s, %s, %s)\n\n" prefix (List.length func.tcf_func.tf_args) class_name func.tcf_name ret |> output + Printf.sprintf "%s__this->%s(%s);\n" prefix func.tcf_name args_pass |> output; -let gen_dynamic_function ctx class_def class_name is_static is_for_static_var (func:tcpp_class_function) = - let output = ctx.ctx_output in - let func_name = "__default_" ^ func.tcf_name in - let nargs = string_of_int (List.length func.tcf_func.tf_args) in + write_closure_trailer (not is_static) output; + + Printf.sprintf + "%s %s::%s_dyn() { return new %s(%s); }\n\n" + (tcpp_to_string func.tcf_callable) + tcpp_class.tcl_name + func.tcf_name + callable_name + (if is_static then "" else "this") |> output + +let gen_dynamic_function ctx tcpp_class is_static func = + let output = ctx.ctx_output in + let func_name = "__default_" ^ tcpp_class.tcl_name ^ func.tcf_name in + let no_debug = Meta.has Meta.NoDebug func.tcf_field.cf_meta in let return_type_str = type_to_string func.tcf_func.tf_type in - let return_type = cpp_type_of func.tcf_func.tf_type in - let no_debug = Meta.has Meta.NoDebug func.tcf_field.cf_meta in - let is_void = return_type = TCppVoid in - let ret = if is_void then "(void)" else "return " in - ctx.ctx_real_this_ptr <- false; - Printf.sprintf "HX_BEGIN_DEFAULT_FUNC(%s, %s)\n" func_name class_name |> output; - Printf.sprintf "%s _hx_run(%s)" return_type_str (print_arg_list func.tcf_func.tf_args "__o_") |> output; + write_closure_header func_name true func tcpp_class.tcl_name return_type_str "__o_" output; - gen_cpp_function_body ctx class_def is_static func_name func.tcf_func "" "" no_debug; + ctx.ctx_real_this_ptr <- false; + gen_cpp_function_body ctx tcpp_class.tcl_class is_static func_name func.tcf_func "" "" no_debug; - output ("HX_END_LOCAL_FUNC" ^ nargs ^ "(" ^ ret ^ ")\n"); - output "HX_END_DEFAULT_FUNC\n\n" + write_closure_trailer true output -let gen_static_variable ctx class_def class_name (var:tcpp_class_variable) = +let gen_static_variable ctx tcpp_class var = let output = ctx.ctx_output in - Printf.sprintf "%s %s::%s;\n\n" (type_to_string var.tcv_type) class_name var.tcv_name |> output + Printf.sprintf "%s %s::%s;\n\n" (type_to_string var.tcv_type) tcpp_class.tcl_name var.tcv_name |> output -let gen_dynamic_function_init ctx class_def func = +let gen_dynamic_function_init ctx tcpp_class func = match func.tcf_field.cf_expr with | Some { eexpr = TFunction function_def } -> - Printf.sprintf "\t%s = new %s;\n\n" func.tcf_name ("__default_" ^ func.tcf_name) |> ctx.ctx_output + Printf.sprintf "\t%s = new %s;\n\n" func.tcf_name ("__default_" ^ tcpp_class.tcl_name ^ func.tcf_name) |> ctx.ctx_output | _ -> () @@ -160,7 +153,7 @@ let gen_boot_field ctx output_cpp tcpp_class = | None -> ()); List.iter (gen_var_init ctx tcpp_class.tcl_class) tcpp_class.tcl_static_variables; - List.iter (gen_dynamic_function_init ctx tcpp_class.tcl_class) tcpp_class.tcl_static_dynamic_functions; + List.iter (gen_dynamic_function_init ctx tcpp_class) tcpp_class.tcl_static_dynamic_functions; output_cpp "}\n\n") @@ -178,7 +171,7 @@ let gen_dynamic_function_allocator ctx output_cpp tcpp_class = | [] -> () | functions -> let mapper func = - Printf.sprintf "\tif (!_hx_obj->%s.mPtr) { _hx_obj->%s = new __default_%s(_hx_obj); }" func.tcf_name func.tcf_name func.tcf_name in + Printf.sprintf "\tif (!_hx_obj->%s.mPtr) { _hx_obj->%s = new __default_%s(_hx_obj); }" func.tcf_name func.tcf_name (tcpp_class.tcl_name ^ func.tcf_name) in let rec folder acc class_def = if has_dynamic_member_functions class_def then let super_name = join_class_path_remap class_def.cl_path "::" ^ "_obj" in @@ -259,16 +252,14 @@ let generate_native_class base_ctx tcpp_class = output_cpp (get_class_code class_def Meta.CppNamespaceCode); - let class_name = tcpp_class.tcl_name in - gen_init_function ctx output_cpp tcpp_class; - List.iter (gen_function ctx class_def class_name false) tcpp_class.tcl_functions; - List.iter (gen_dynamic_function ctx class_def class_name false false) tcpp_class.tcl_dynamic_functions; + List.iter (gen_function ctx tcpp_class false) tcpp_class.tcl_functions; + List.iter (gen_dynamic_function ctx tcpp_class false) tcpp_class.tcl_dynamic_functions; - List.iter (gen_function ctx class_def class_name true) tcpp_class.tcl_static_functions; - List.iter (gen_dynamic_function ctx class_def class_name true false) tcpp_class.tcl_static_dynamic_functions; - List.iter (gen_static_variable ctx class_def class_name) tcpp_class.tcl_static_variables; + List.iter (gen_function ctx tcpp_class true) tcpp_class.tcl_static_functions; + List.iter (gen_dynamic_function ctx tcpp_class true) tcpp_class.tcl_static_dynamic_functions; + List.iter (gen_static_variable ctx tcpp_class) tcpp_class.tcl_static_variables; output_cpp "\n"; @@ -484,12 +475,12 @@ let generate_managed_class base_ctx tcpp_class = gen_init_function ctx output_cpp tcpp_class; - List.iter (gen_function ctx class_def class_name false) tcpp_class.tcl_functions; - List.iter (gen_dynamic_function ctx class_def class_name false false) tcpp_class.tcl_dynamic_functions; + List.iter (gen_function ctx tcpp_class false) tcpp_class.tcl_functions; + List.iter (gen_dynamic_function ctx tcpp_class false) tcpp_class.tcl_dynamic_functions; - List.iter (gen_function ctx class_def class_name true) tcpp_class.tcl_static_functions; - List.iter (gen_dynamic_function ctx class_def class_name true false) tcpp_class.tcl_static_dynamic_functions; - List.iter (gen_static_variable ctx class_def class_name) tcpp_class.tcl_static_variables; + List.iter (gen_function ctx tcpp_class true) tcpp_class.tcl_static_functions; + List.iter (gen_dynamic_function ctx tcpp_class true) tcpp_class.tcl_static_dynamic_functions; + List.iter (gen_static_variable ctx tcpp_class) tcpp_class.tcl_static_variables; output_cpp "\n"; @@ -504,7 +495,7 @@ let generate_managed_class base_ctx tcpp_class = (* Initialise non-static variables *) output_cpp (class_name ^ "::" ^ class_name ^ "()\n{\n"); List.iter - (fun func -> output_cpp ("\t" ^ func.tcf_name ^ " = new __default_" ^ func.tcf_name ^ "(this);\n")) + (fun func -> output_cpp ("\t" ^ func.tcf_name ^ " = new __default_" ^ class_name ^ func.tcf_name ^ "(this);\n")) tcpp_class.tcl_dynamic_functions; output_cpp "}\n\n"; From 9a9c4714a158c233ece9bf7c985653246bb7b89e Mon Sep 17 00:00:00 2001 From: Aidan Lee Date: Sat, 8 Feb 2025 17:40:35 +0000 Subject: [PATCH 2/8] simplify closure header writer --- .../cpp/gen/cppGenClassImplementation.ml | 40 ++++++++++--------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/src/generators/cpp/gen/cppGenClassImplementation.ml b/src/generators/cpp/gen/cppGenClassImplementation.ml index 7227f23780c..d2ed125b307 100644 --- a/src/generators/cpp/gen/cppGenClassImplementation.ml +++ b/src/generators/cpp/gen/cppGenClassImplementation.ml @@ -10,7 +10,7 @@ open CppSourceWriter open CppContext open CppGen -let write_closure_header callable_name captures_obj func class_name return_type_str prefix output = +let write_closure_header callable_name captures func return_type_str prefix output = let func_signature = match func.tcf_callable with @@ -22,28 +22,27 @@ let write_closure_header callable_name captures_obj func class_name return_type_ Printf.sprintf "struct %s final : public ::hx::Callable_obj< %s > {\n" callable_name func_signature |> output; - if captures_obj then begin - let obj_ptr_class_name = Printf.sprintf "::hx::ObjectPtr< %s >" class_name in + (match captures with + | Some obj_name -> - Printf.sprintf "\t%s __this;\n" obj_ptr_class_name |> output; - Printf.sprintf "\t%s(%sobj = null()) : __this(obj) {} \n" callable_name obj_ptr_class_name |> output; - end else begin - Printf.sprintf "\t%s() {}\n" callable_name |> output - end; + Printf.sprintf "\t::hx::ObjectPtr<%s> __this;\n" obj_name |> output; + Printf.sprintf "\t%s(::hx::ObjectPtr<%s> obj = null()) : __this(obj) {} \n" callable_name obj_name |> output + | None -> + Printf.sprintf "\t%s() {}\n" callable_name |> output); output "\tint __Compare(const ::hx::Object* inRhs) const override {\n"; Printf.sprintf "\t\tauto casted = dynamic_cast(inRhs);\n" callable_name |> output; output "\t\tif (!casted) { return -1; }\n"; - if captures_obj then + if Option.is_some captures then output "\t\tif (__this != casted->__this) return 1;\n"; output "\t\treturn 0;\n"; output "\t}\n"; Printf.sprintf "\t%s HX_LOCAL_RUN(%s) override {\n" return_type_str (callable_args func.tcf_func.tf_args prefix) |> output -let write_closure_trailer captures_obj output = +let write_closure_trailer captures output = output "\t}\n"; - if captures_obj then begin + if Option.is_some captures then begin output "\tvoid __Mark(hx::MarkContext* __inCtx) override { HX_MARK_MEMBER(__this); }\n"; output "#ifdef HXCPP_VISIT_ALLOCS\n"; output "\tvoid __Visit(hx::VisitContext* __inCtx) override { HX_VISIT_MEMBER(__this); }\n"; @@ -64,9 +63,6 @@ let gen_function ctx tcpp_class is_static func = output (" " ^ tcpp_class.tcl_name ^ "::" ^ func.tcf_name ^ "("); output (print_arg_list func.tcf_func.tf_args "__o_"); output ")"; - ctx.ctx_real_this_ptr <- true; - let code = get_code func.tcf_field.cf_meta Meta.FunctionCode in - let tail_code = get_code func.tcf_field.cf_meta Meta.FunctionTailCode in match get_meta_string func.tcf_field.cf_meta Meta.Native with | Some nativeImpl when is_static -> @@ -77,6 +73,10 @@ let gen_function ctx tcpp_class is_static func = ^ ");\n"); output "}\n\n" | _ -> + ctx.ctx_real_this_ptr <- true; + let code = get_code func.tcf_field.cf_meta Meta.FunctionCode in + let tail_code = get_code func.tcf_field.cf_meta Meta.FunctionTailCode in + with_debug ctx func.tcf_field.cf_meta @@ -86,9 +86,10 @@ let gen_function ctx tcpp_class is_static func = (* generate dynamic version too ... *) if (not func.tcf_is_virtual || not func.tcf_is_overriding) && func.tcf_is_reflective then - let callable_name = Printf.sprintf "__%s%s" tcpp_class.tcl_name func.tcf_name in + let callable_name = Printf.sprintf "__%s%s" tcpp_class.tcl_name func.tcf_name in + let captures = if is_static then None else Some ((tcpp_class.tcl_class.cl_path |> remap_class_path |> fst |> String.concat "::") ^ "::" ^ tcpp_class.tcl_name) in - write_closure_header callable_name (not is_static) func tcpp_class.tcl_name return_type_str "" output; + write_closure_header callable_name captures func return_type_str "" output; let arg_name (tvar, _) = cpp_var_name_of tvar in let args_pass = func.tcf_func.tf_args |> List.map arg_name |> String.concat ", " in @@ -98,7 +99,7 @@ let gen_function ctx tcpp_class is_static func = else Printf.sprintf "%s__this->%s(%s);\n" prefix func.tcf_name args_pass |> output; - write_closure_trailer (not is_static) output; + write_closure_trailer captures output; Printf.sprintf "%s %s::%s_dyn() { return new %s(%s); }\n\n" @@ -113,13 +114,14 @@ let gen_dynamic_function ctx tcpp_class is_static func = let func_name = "__default_" ^ tcpp_class.tcl_name ^ func.tcf_name in let no_debug = Meta.has Meta.NoDebug func.tcf_field.cf_meta in let return_type_str = type_to_string func.tcf_func.tf_type in + let captures = Some ((tcpp_class.tcl_class.cl_path |> remap_class_path |> fst |> String.concat "::") ^ "::" ^ tcpp_class.tcl_name) in - write_closure_header func_name true func tcpp_class.tcl_name return_type_str "__o_" output; + write_closure_header func_name captures func return_type_str "__o_" output; ctx.ctx_real_this_ptr <- false; gen_cpp_function_body ctx tcpp_class.tcl_class is_static func_name func.tcf_func "" "" no_debug; - write_closure_trailer true output + write_closure_trailer captures output let gen_static_variable ctx tcpp_class var = let output = ctx.ctx_output in From 14896e4536e16bd28e313467b24f577d73427cd4 Mon Sep 17 00:00:00 2001 From: Aidan Lee Date: Sun, 9 Feb 2025 11:23:11 +0000 Subject: [PATCH 3/8] move function closures to the anonymous namespace --- .../cpp/gen/cppGenClassImplementation.ml | 60 ++++++++++++++----- 1 file changed, 45 insertions(+), 15 deletions(-) diff --git a/src/generators/cpp/gen/cppGenClassImplementation.ml b/src/generators/cpp/gen/cppGenClassImplementation.ml index d2ed125b307..5fdd24802fc 100644 --- a/src/generators/cpp/gen/cppGenClassImplementation.ml +++ b/src/generators/cpp/gen/cppGenClassImplementation.ml @@ -86,20 +86,7 @@ let gen_function ctx tcpp_class is_static func = (* generate dynamic version too ... *) if (not func.tcf_is_virtual || not func.tcf_is_overriding) && func.tcf_is_reflective then - let callable_name = Printf.sprintf "__%s%s" tcpp_class.tcl_name func.tcf_name in - let captures = if is_static then None else Some ((tcpp_class.tcl_class.cl_path |> remap_class_path |> fst |> String.concat "::") ^ "::" ^ tcpp_class.tcl_name) in - - write_closure_header callable_name captures func return_type_str "" output; - - let arg_name (tvar, _) = cpp_var_name_of tvar in - let args_pass = func.tcf_func.tf_args |> List.map arg_name |> String.concat ", " in - let prefix = if is_void then "\t\t" else "\t\treturn " in - if is_static then - Printf.sprintf "%s%s::%s(%s);\n" prefix tcpp_class.tcl_name func.tcf_name args_pass |> output - else - Printf.sprintf "%s__this->%s(%s);\n" prefix func.tcf_name args_pass |> output; - - write_closure_trailer captures output; + let callable_name = Printf.sprintf "__%s%s" tcpp_class.tcl_name func.tcf_name in Printf.sprintf "%s %s::%s_dyn() { return new %s(%s); }\n\n" @@ -109,12 +96,39 @@ let gen_function ctx tcpp_class is_static func = callable_name (if is_static then "" else "this") |> output +let gen_function_closures ctx tcpp_class is_static func = + match get_meta_string func.tcf_field.cf_meta Meta.Native with + | Some nativeImpl when is_static -> + () + | _ when (not func.tcf_is_virtual || not func.tcf_is_overriding) && func.tcf_is_reflective -> + let output = ctx.ctx_output in + let return_type_str = type_to_string func.tcf_func.tf_type in + let return_type = cpp_type_of func.tcf_func.tf_type in + let is_void = return_type = TCppVoid in + let callable_name = Printf.sprintf "__%s%s" tcpp_class.tcl_name func.tcf_name in + let full_name = (tcpp_class.tcl_class.cl_path |> fst |> List.map keyword_remap |> String.concat "::") ^ "::" ^ tcpp_class.tcl_name in + let captures = if is_static then None else Some full_name in + + write_closure_header callable_name captures func return_type_str "" output; + + let arg_name (tvar, _) = cpp_var_name_of tvar in + let args_pass = func.tcf_func.tf_args |> List.map arg_name |> String.concat ", " in + let prefix = if is_void then "\t\t" else "\t\treturn " in + if is_static then + Printf.sprintf "%s%s::%s(%s);\n" prefix full_name func.tcf_name args_pass |> output + else + Printf.sprintf "%s__this->%s(%s);\n" prefix func.tcf_name args_pass |> output; + + write_closure_trailer captures output + | _ -> + () + let gen_dynamic_function ctx tcpp_class is_static func = let output = ctx.ctx_output in let func_name = "__default_" ^ tcpp_class.tcl_name ^ func.tcf_name in let no_debug = Meta.has Meta.NoDebug func.tcf_field.cf_meta in let return_type_str = type_to_string func.tcf_func.tf_type in - let captures = Some ((tcpp_class.tcl_class.cl_path |> remap_class_path |> fst |> String.concat "::") ^ "::" ^ tcpp_class.tcl_name) in + let captures = Some ((tcpp_class.tcl_class.cl_path |> fst |> List.map keyword_remap |> String.concat "::") ^ "::" ^ tcpp_class.tcl_name) in write_closure_header func_name captures func return_type_str "__o_" output; @@ -249,6 +263,14 @@ let generate_native_class base_ctx tcpp_class = let printer inc = output_cpp ("#include \"" ^ inc ^ "\"\n") in List.iter printer includes; + output_cpp "\n"; + output_cpp "namespace {\n\n"; + + List.iter (gen_function_closures ctx tcpp_class false) tcpp_class.tcl_functions; + List.iter (gen_function_closures ctx tcpp_class true) tcpp_class.tcl_static_functions; + + output_cpp "}\n\n"; + begin_namespace output_cpp class_path; output_cpp "\n"; @@ -310,6 +332,14 @@ let generate_managed_class base_ctx tcpp_class = let printer inc = output_cpp ("#include \"" ^ inc ^ "\"\n") in List.iter printer includes; + output_cpp "\n"; + output_cpp "namespace {\n\n"; + + List.iter (gen_function_closures ctx tcpp_class false) tcpp_class.tcl_functions; + List.iter (gen_function_closures ctx tcpp_class true) tcpp_class.tcl_static_functions; + + output_cpp "}\n\n"; + begin_namespace output_cpp class_path; output_cpp "\n"; From eade6f65d7df17ae0da24bb009be56265c964c47 Mon Sep 17 00:00:00 2001 From: Aidan Lee Date: Sun, 9 Feb 2025 12:02:13 +0000 Subject: [PATCH 4/8] move default dynamic functions to anonymous namespace --- .../cpp/gen/cppGenClassImplementation.ml | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/generators/cpp/gen/cppGenClassImplementation.ml b/src/generators/cpp/gen/cppGenClassImplementation.ml index 5fdd24802fc..205ff1e70f8 100644 --- a/src/generators/cpp/gen/cppGenClassImplementation.ml +++ b/src/generators/cpp/gen/cppGenClassImplementation.ml @@ -266,6 +266,9 @@ let generate_native_class base_ctx tcpp_class = output_cpp "\n"; output_cpp "namespace {\n\n"; + List.iter (gen_dynamic_function ctx tcpp_class false) tcpp_class.tcl_dynamic_functions; + List.iter (gen_dynamic_function ctx tcpp_class true) tcpp_class.tcl_static_dynamic_functions; + List.iter (gen_function_closures ctx tcpp_class false) tcpp_class.tcl_functions; List.iter (gen_function_closures ctx tcpp_class true) tcpp_class.tcl_static_functions; @@ -279,10 +282,8 @@ let generate_native_class base_ctx tcpp_class = gen_init_function ctx output_cpp tcpp_class; List.iter (gen_function ctx tcpp_class false) tcpp_class.tcl_functions; - List.iter (gen_dynamic_function ctx tcpp_class false) tcpp_class.tcl_dynamic_functions; List.iter (gen_function ctx tcpp_class true) tcpp_class.tcl_static_functions; - List.iter (gen_dynamic_function ctx tcpp_class true) tcpp_class.tcl_static_dynamic_functions; List.iter (gen_static_variable ctx tcpp_class) tcpp_class.tcl_static_variables; output_cpp "\n"; @@ -338,6 +339,9 @@ let generate_managed_class base_ctx tcpp_class = List.iter (gen_function_closures ctx tcpp_class false) tcpp_class.tcl_functions; List.iter (gen_function_closures ctx tcpp_class true) tcpp_class.tcl_static_functions; + List.iter (gen_dynamic_function ctx tcpp_class false) tcpp_class.tcl_dynamic_functions; + List.iter (gen_dynamic_function ctx tcpp_class true) tcpp_class.tcl_static_dynamic_functions; + output_cpp "}\n\n"; begin_namespace output_cpp class_path; @@ -356,8 +360,10 @@ let generate_managed_class base_ctx tcpp_class = output_cpp ("void " ^ class_name ^ "::__construct(" ^ constructor_type_args ^ ")"); (match class_def.cl_constructor with - | Some ({ cf_expr = Some { eexpr = TFunction function_def } } as definition) - -> + | Some ({ cf_expr = Some { eexpr = TFunction function_def } } as definition) -> + (* Ensure we reset this real this ptr flag, it may have been set to false in the above gen_dynamic_function *) + ctx.ctx_real_this_ptr <- true; + with_debug ctx definition.cf_meta (fun no_debug -> gen_cpp_function_body ctx class_def false "new" function_def "" "" no_debug; @@ -508,10 +514,8 @@ let generate_managed_class base_ctx tcpp_class = gen_init_function ctx output_cpp tcpp_class; List.iter (gen_function ctx tcpp_class false) tcpp_class.tcl_functions; - List.iter (gen_dynamic_function ctx tcpp_class false) tcpp_class.tcl_dynamic_functions; List.iter (gen_function ctx tcpp_class true) tcpp_class.tcl_static_functions; - List.iter (gen_dynamic_function ctx tcpp_class true) tcpp_class.tcl_static_dynamic_functions; List.iter (gen_static_variable ctx tcpp_class) tcpp_class.tcl_static_variables; output_cpp "\n"; From 9a532c1805e15d58bf20ec00b0e4cccdd24e466a Mon Sep 17 00:00:00 2001 From: Aidan Lee Date: Sun, 9 Feb 2025 14:00:30 +0000 Subject: [PATCH 5/8] initial pre-allocation of static function lambdas --- src/generators/cpp/cppRetyper.ml | 15 +++++++- .../cpp/gen/cppGenClassImplementation.ml | 34 ++++++++++++++++--- src/generators/gencpp.ml | 8 ++--- 3 files changed, 48 insertions(+), 9 deletions(-) diff --git a/src/generators/cpp/cppRetyper.ml b/src/generators/cpp/cppRetyper.ml index 618ff0ddc65..5cbb76ccfdf 100644 --- a/src/generators/cpp/cppRetyper.ml +++ b/src/generators/cpp/cppRetyper.ml @@ -1768,6 +1768,19 @@ let rec tcpp_class_from_tclass ctx ids slots class_def class_params = gc_container variables parent Current in + let wants_closures = + let needs_closure func = + match get_meta_string func.tcf_field.cf_meta Meta.Native with + | Some _ -> + false + | _ when (not func.tcf_is_virtual || not func.tcf_is_overriding) && func.tcf_is_reflective -> + true + | _ -> + false + in + List.exists needs_closure static_functions + in + let flags = 0 |> (fun f -> if scriptable && not class_def.cl_private then set_tcpp_class_flag f Scriptable else f) |> (fun f -> if can_quick_alloc class_def then set_tcpp_class_flag f QuickAlloc else f) @@ -1777,7 +1790,7 @@ let rec tcpp_class_from_tclass ctx ids slots class_def class_params = |> (fun f -> if has_set_static_field class_def then set_tcpp_class_flag f StaticSet else f) |> (fun f -> if has_get_fields class_def then set_tcpp_class_flag f GetFields else f) |> (fun f -> if has_compare_field class_def then set_tcpp_class_flag f Compare else f) - |> (fun f -> if has_boot_field class_def then set_tcpp_class_flag f Boot else f) + |> (fun f -> if has_boot_field class_def || wants_closures then set_tcpp_class_flag f Boot else f) in let meta_field = List.find_opt (fun field -> field.cf_name = "__meta__") class_def.cl_ordered_statics |> Option.map (fun f -> Option.get f.cf_expr) in diff --git a/src/generators/cpp/gen/cppGenClassImplementation.ml b/src/generators/cpp/gen/cppGenClassImplementation.ml index 205ff1e70f8..76749a2a5ba 100644 --- a/src/generators/cpp/gen/cppGenClassImplementation.ml +++ b/src/generators/cpp/gen/cppGenClassImplementation.ml @@ -86,9 +86,17 @@ let gen_function ctx tcpp_class is_static func = (* generate dynamic version too ... *) if (not func.tcf_is_virtual || not func.tcf_is_overriding) && func.tcf_is_reflective then - let callable_name = Printf.sprintf "__%s%s" tcpp_class.tcl_name func.tcf_name in + let callable_name = Printf.sprintf "__%s%s" tcpp_class.tcl_name func.tcf_name in - Printf.sprintf + if is_static then + Printf.sprintf + "%s %s::%s_dyn() { return _hx_alloc%s; }\n\n" + (tcpp_to_string func.tcf_callable) + tcpp_class.tcl_name + func.tcf_name + callable_name |> output + else + Printf.sprintf "%s %s::%s_dyn() { return new %s(%s); }\n\n" (tcpp_to_string func.tcf_callable) tcpp_class.tcl_name @@ -98,7 +106,7 @@ let gen_function ctx tcpp_class is_static func = let gen_function_closures ctx tcpp_class is_static func = match get_meta_string func.tcf_field.cf_meta Meta.Native with - | Some nativeImpl when is_static -> + | Some _ when is_static -> () | _ when (not func.tcf_is_virtual || not func.tcf_is_overriding) && func.tcf_is_reflective -> let output = ctx.ctx_output in @@ -119,7 +127,21 @@ let gen_function_closures ctx tcpp_class is_static func = else Printf.sprintf "%s__this->%s(%s);\n" prefix func.tcf_name args_pass |> output; - write_closure_trailer captures output + write_closure_trailer captures output; + + if is_static then + Printf.sprintf "%s _hx_alloc%s;\n\n" (tcpp_to_string func.tcf_callable) callable_name |> output + | _ -> + () + +let gen_static_closure_alloc ctx tcpp_class func = + match get_meta_string func.tcf_field.cf_meta Meta.Native with + | Some _ -> + () + | _ when (not func.tcf_is_virtual || not func.tcf_is_overriding) && func.tcf_is_reflective -> + let output = ctx.ctx_output in + let callable_name = Printf.sprintf "__%s%s" tcpp_class.tcl_name func.tcf_name in + Printf.sprintf "_hx_alloc%s = new (::hx::NewObjectType::NewObjConst) %s();\n\n" callable_name callable_name |> output | _ -> () @@ -168,6 +190,10 @@ let gen_boot_field ctx output_cpp tcpp_class = | Some expr -> gen_cpp_init ctx dot_name "boot" "__mClass->__rtti__ = " expr | None -> ()); + (* Allocating static function lambdas must be done first *) + (* Init functionality might depend on these being assigned *) + List.iter (gen_static_closure_alloc ctx tcpp_class) tcpp_class.tcl_static_functions; + List.iter (gen_var_init ctx tcpp_class.tcl_class) tcpp_class.tcl_static_variables; List.iter (gen_dynamic_function_init ctx tcpp_class) tcpp_class.tcl_static_dynamic_functions; diff --git a/src/generators/gencpp.ml b/src/generators/gencpp.ml index a63a2d073ad..ef0f58455ab 100644 --- a/src/generators/gencpp.ml +++ b/src/generators/gencpp.ml @@ -301,19 +301,19 @@ let generate_source ctx = | TClassDecl class_def -> let native_gen = Meta.has Meta.NativeGen class_def.cl_meta in - let decl, slots, ids = + let bootable, decl, slots, ids = match has_class_flag class_def CInterface with | true -> let (slots, iface) = CppRetyper.tcpp_interface_from_tclass ctx acc.slots class_def in - if native_gen then (NativeInterface iface, slots, acc.ids) else (ManagedInterface iface, acc.slots, acc.ids) + if native_gen then (has_boot_field class_def, NativeInterface iface, slots, acc.ids) else (has_boot_field class_def, ManagedInterface iface, acc.slots, acc.ids) | false -> let (slots, ids, cls) = CppRetyper.tcpp_class_from_tclass ctx acc.ids acc.slots class_def [] in - if native_gen then (NativeClass cls, slots, ids) else (ManagedClass cls, slots, ids) in + if native_gen then (has_tcpp_class_flag cls Boot, NativeClass cls, slots, ids) else (has_tcpp_class_flag cls Boot, ManagedClass cls, slots, ids) in let acc_decls = decl :: acc.decls in let acc_build_xml = acc.build_xml ^ (CppGen.get_class_code class_def Meta.BuildXml) in let acc_init_classes = if has_init_field class_def then class_def.cl_path :: acc.init_classes else acc.init_classes in - let acc_boot_classes = if has_boot_field class_def then class_def.cl_path :: acc.boot_classes else acc.boot_classes in + let acc_boot_classes = if bootable then class_def.cl_path :: acc.boot_classes else acc.boot_classes in let acc_nonboot_classes = if Meta.has Meta.NativeGen class_def.cl_meta then acc.nonboot_classes else class_def.cl_path :: acc.nonboot_classes in let acc_exe_classes = if (has_class_flag class_def CInterface) && (is_native_gen_class class_def) then From d9e0cfa320f02cf0f7c345e9569b28cf6ee9b4e2 Mon Sep 17 00:00:00 2001 From: Aidan Lee Date: Mon, 10 Feb 2025 19:12:27 +0000 Subject: [PATCH 6/8] Only cast when is variant --- src/generators/cpp/cppRetyper.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/generators/cpp/cppRetyper.ml b/src/generators/cpp/cppRetyper.ml index 5cbb76ccfdf..e1e2483c590 100644 --- a/src/generators/cpp/cppRetyper.ml +++ b/src/generators/cpp/cppRetyper.ml @@ -1434,7 +1434,7 @@ let expression ctx request_type function_args function_type expression_tree forI in retyper_ctx, mk_cppexpr (CppCast (structCast, TCppInst (t, []))) (TCppInst (t, [])) | TCppObjectArray _ | TCppScalarArray _ | TCppNativePointer _ - | TCppDynamicArray | TCppObjectPtr | TCppVarArg | TCppInst _ | TCppCallable _ -> + | TCppDynamicArray | TCppObjectPtr | TCppVarArg | TCppInst _ -> retyper_ctx, mk_cppexpr (CppCast (cppExpr, return_type)) return_type | TCppObjC k -> retyper_ctx, mk_cppexpr (CppCastObjC (cppExpr, k)) return_type | TCppObjCBlock (ret, args) -> @@ -1447,6 +1447,8 @@ let expression ctx request_type function_args function_type expression_tree forI retyper_ctx, mk_cppexpr (CppCastVariant cppExpr) return_type | TCppDynamic when is_variant cppExpr.cpptype -> retyper_ctx, mk_cppexpr (CppCastVariant cppExpr) return_type + | TCppCallable _ when is_variant cppExpr.cpptype -> + retyper_ctx, mk_cppexpr (CppCast (cppExpr, return_type)) return_type | TCppStar (t, const) -> let ptrType = TCppPointer ((if const then "ConstPointer" else "Pointer"), t) From 8164beffdf9313c4f4262adde8eb8f490d6d1c6c Mon Sep 17 00:00:00 2001 From: Aidan Lee Date: Fri, 14 Mar 2025 22:34:40 +0000 Subject: [PATCH 7/8] move interface static implementations out of the header --- src/generators/cpp/gen/cppGenClassHeader.ml | 13 +++++------ .../cpp/gen/cppGenInterfaceHeader.ml | 13 +---------- .../cpp/gen/cppGenInterfaceImplementation.ml | 23 +++++++++++++++++++ 3 files changed, 30 insertions(+), 19 deletions(-) diff --git a/src/generators/cpp/gen/cppGenClassHeader.ml b/src/generators/cpp/gen/cppGenClassHeader.ml index 9126fc4d042..c746d5933f2 100644 --- a/src/generators/cpp/gen/cppGenClassHeader.ml +++ b/src/generators/cpp/gen/cppGenClassHeader.ml @@ -87,19 +87,18 @@ let gen_class_header ctx tcpp_class h_file scriptable parents = else h_file#add_include klass.cl_path | _ -> ()); - (* And any interfaces ... *) + (* And any native interfaces ... *) List.iter - (fun imp -> - let interface = fst imp in + (fun interface -> let include_files = - get_all_meta_string_path interface.cl_meta Meta.Include + get_all_meta_string_path interface.if_class.cl_meta Meta.Include in if List.length include_files > 0 then List.iter (fun inc -> h_file#add_include (path_of_string inc)) include_files - else h_file#add_include interface.cl_path) - (real_interfaces tcpp_class.tcl_class.cl_implements); + else h_file#add_include interface.if_class.cl_path) + tcpp_class.tcl_native_interfaces; (* Only need to forward-declare classes that are mentioned in the header file (ie, not the implementation) *) @@ -325,7 +324,7 @@ let generate_managed_header base_ctx tcpp_class = let alreadyGlued = Hashtbl.create 0 in List.iter (fun src -> - let rec check_interface (interface:tcpp_interface) = + let rec check_interface interface = let check_field func = let cast = cpp_tfun_signature false func.iff_args func.iff_return in let class_implementation = find_class_implementation func tcpp_class diff --git a/src/generators/cpp/gen/cppGenInterfaceHeader.ml b/src/generators/cpp/gen/cppGenInterfaceHeader.ml index 5013952be57..9786ab97119 100644 --- a/src/generators/cpp/gen/cppGenInterfaceHeader.ml +++ b/src/generators/cpp/gen/cppGenInterfaceHeader.ml @@ -32,21 +32,10 @@ let gen_function ctx interface func = let output = ctx.ctx_output in let argList = print_tfun_arg_list true func.iff_args in let returnType = type_to_string func.iff_return in - let returnStr = if returnType = "void" then "" else "return " in let commaArgList = if argList = "" then argList else "," ^ argList in - let cast = Printf.sprintf "::hx::interface_cast< ::%s_obj *>" (join_class_path_remap interface.if_class.cl_path "::") in Printf.sprintf "\t\t%s (::hx::Object :: *_hx_%s)(%s);\n" returnType func.iff_name argList |> output; - Printf.sprintf "\t\tstatic inline %s %s( ::Dynamic _hx_%s ){\n" returnType func.iff_name commaArgList |> output; - output "\t\t\t#ifdef HXCPP_CHECK_POINTER\n"; - output "\t\t\tif (::hx::IsNull(_hx_)) ::hx::NullReference(\"Object\", false);\n"; - output "\t\t\t#ifdef HXCPP_GC_CHECK_POINTER\n"; - output "\t\t\t\tGCCheckPointer(_hx_.mPtr);\n"; - output "\t\t\t#endif\n"; - output "\t\t\t#endif\n"; - Printf.sprintf - "\t\t\t%s( _hx_.mPtr->*( %s(_hx_.mPtr->_hx_getInterface(%s)))->_hx_%s )(%s);\n\t\t}\n" - returnStr cast interface.if_hash func.iff_name (print_arg_names func.iff_args) |> output + Printf.sprintf "\t\tstatic %s %s( ::Dynamic _hx_%s );\n" returnType func.iff_name commaArgList |> output let gen_includes h_file interface_def = let add_class_includes cls = diff --git a/src/generators/cpp/gen/cppGenInterfaceImplementation.ml b/src/generators/cpp/gen/cppGenInterfaceImplementation.ml index 8d1c1a9ed5d..5d7c0968869 100644 --- a/src/generators/cpp/gen/cppGenInterfaceImplementation.ml +++ b/src/generators/cpp/gen/cppGenInterfaceImplementation.ml @@ -104,6 +104,29 @@ let generate_managed_interface base_ctx tcpp_interface = begin_namespace output_cpp class_path; output_cpp "\n"; + let gen_function func = + let argList = print_tfun_arg_list true func.iff_args in + let returnType = type_to_string func.iff_return in + let returnStr = if returnType = "void" then "" else "return " in + let commaArgList = if argList = "" then argList else "," ^ argList in + let cast = Printf.sprintf "::hx::interface_cast< %s *>" tcpp_interface.if_name in + + Printf.sprintf "%s %s::%s( ::Dynamic _hx_%s ) {\n" returnType tcpp_interface.if_name func.iff_name commaArgList |> output_cpp; + output_cpp "#ifdef HXCPP_CHECK_POINTER\n"; + output_cpp "\tif (::hx::IsNull(_hx_)) ::hx::NullReference(\"Object\", false);\n"; + output_cpp "#ifdef HXCPP_GC_CHECK_POINTER\n"; + output_cpp "\tGCCheckPointer(_hx_.mPtr);\n"; + output_cpp "#endif\n"; + output_cpp "#endif\n"; + Printf.sprintf + "\t%s( _hx_.mPtr->*( %s(_hx_.mPtr->_hx_getInterface(%s)))->_hx_%s )(%s);\n}\n" + returnStr cast tcpp_interface.if_hash func.iff_name (print_arg_names func.iff_args) |> output_cpp + in + + all_interface_functions tcpp_interface |> List.iter gen_function; + + output_cpp "\n"; + output_cpp (get_class_code tcpp_interface.if_class Meta.CppNamespaceCode); output_cpp "\n"; From 25612543986894fbf05b27815dc244236182807d Mon Sep 17 00:00:00 2001 From: Aidan Lee Date: Sat, 15 Mar 2025 15:51:22 +0000 Subject: [PATCH 8/8] Generate functions using new AutoCallable intermediate --- src/generators/cpp/gen/cppGen.ml | 2 +- src/generators/cpp/gen/cppGenClassImplementation.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/generators/cpp/gen/cppGen.ml b/src/generators/cpp/gen/cppGen.ml index 4f1453a2cf1..e6d0f192dab 100644 --- a/src/generators/cpp/gen/cppGen.ml +++ b/src/generators/cpp/gen/cppGen.ml @@ -1500,7 +1500,7 @@ let gen_cpp_ast_expression_tree ctx class_name func_name function_args let argsCount = list_num closure.close_args in let signature = cpp_closure_signature closure in output_i ("HX_BEGIN_LOCAL_FUNC_S" ^ size ^ "("); - Printf.sprintf "::hx::Callable_obj<%s>, _hx_Closure_%i" signature closure.close_id |> out; + Printf.sprintf "::hx::AutoCallable_obj<%s>, _hx_Closure_%i" signature closure.close_id |> out; StringMap.iter (fun name var -> out ("," ^ cpp_macro_var_type_of var ^ "," ^ keyword_remap name)) diff --git a/src/generators/cpp/gen/cppGenClassImplementation.ml b/src/generators/cpp/gen/cppGenClassImplementation.ml index 76749a2a5ba..066c4ae11cf 100644 --- a/src/generators/cpp/gen/cppGenClassImplementation.ml +++ b/src/generators/cpp/gen/cppGenClassImplementation.ml @@ -20,7 +20,7 @@ let write_closure_header callable_name captures func return_type_str prefix outp die (Printf.sprintf "tcf_callable should be a TCppCalllable but was %s" (tcpp_to_string func.tcf_callable)) __LOC__ in - Printf.sprintf "struct %s final : public ::hx::Callable_obj< %s > {\n" callable_name func_signature |> output; + Printf.sprintf "struct %s final : public ::hx::AutoCallable_obj< %s > {\n" callable_name func_signature |> output; (match captures with | Some obj_name ->