[cpp] Marshalling Extern Types

src-json/meta.json

@@ -1130,5 +1130,26 @@
 		"metadata": ":nativeArrayAccess",
 		"doc": "When used on an extern class which implements haxe.ArrayAccess native array access syntax will be generated",
 		"platforms": ["cpp"]
+	},
+	{
+		"name": "CppValueType",
+		"metadata": ":cpp.ValueType",
+		"doc": "",
+		"platforms": ["cpp"],
+		"targets": [ "TClass", "TAbstract" ]
+	},
+	{
+		"name": "CppPointerType",
+		"metadata": ":cpp.PointerType",
+		"doc": "",
+		"platforms": ["cpp"],
+		"targets": [ "TClass" ]
+	},
+	{
+		"name": "CppManagedType",
+		"metadata": ":cpp.ManagedType",
+		"doc": "",
+		"platforms": ["cpp"],
+		"targets": ["TClass"]
 	}
 ]

src/generators/cpp/cppAst.ml

@@ -40,7 +40,17 @@ module InterfaceSlots = struct
     StringMap.find_opt name slots.hash
 end
 
-type tcpp =
+type marshal_type_state =
+  | Stack
+  | Promoted
+  | Reference
+
+and native_type = 
+  | ValueClass of tclass * tcpp list
+  | ValueEnum of tabstract
+  | Pointer of tclass * tcpp list
+
+and tcpp =
   | TCppDynamic
   | TCppUnchanged
   | TCppObject
@@ -58,6 +68,8 @@ type tcpp =
   | TCppRest of tcpp
   | TCppReference of tcpp
   | TCppStruct of tcpp
+  | TCppMarshalNativeType of native_type * marshal_type_state
+  | TCppMarshalManagedType of tclass * tcpp list
   | TCppStar of tcpp * bool
   | TCppVoidStar
   | TCppVarArg
@@ -78,12 +90,19 @@ type tcpp =
 
 and tcppexpr = { cppexpr : tcpp_expr_expr; cpptype : tcpp; cpppos : pos }
 
+and tcppvar = {
+  tcppv_type : tcpp;
+  tcppv_var : tvar;
+  tcppv_name : string;
+  tcppv_debug_name : string;
+}
+
 and tcpp_closure = {
   close_type : tcpp;
-  close_args : (tvar * texpr option) list;
+  close_args : (tcppvar * texpr option) list;
   close_expr : tcppexpr;
   close_id : int;
-  close_undeclared : tvar StringMap.t;
+  close_undeclared : tcppvar StringMap.t;
   close_this : tcppthis option;
 }
 
@@ -92,8 +111,8 @@ and tcppunop = CppNeg | CppNegBits | CppNot
 and tcppthis = ThisReal | ThisFake | ThisDynamic
 
 and tcppvarloc =
-  | VarLocal of tvar
-  | VarClosure of tvar
+  | VarLocal of tcppvar
+  | VarClosure of tcppvar
   | VarThis of tclass_field * tcpp
   | VarInstance of tcppexpr * tclass_field * string * string
   | VarInterface of tcppexpr * tclass_field
@@ -166,15 +185,15 @@ and tcpp_expr_expr =
   | CppPosition of string * int32 * string * string
   | CppArrayDecl of tcppexpr list
   | CppUnop of tcppunop * tcppexpr
-  | CppVarDecl of tvar * tcppexpr option
+  | CppVarDecl of tcppvar * tcppexpr option
   | CppBlock of tcppexpr list * tcpp_closure list * bool
-  | CppFor of tvar * tcppexpr * tcppexpr
+  | CppFor of tcppvar * tcppexpr * tcppexpr
   | CppIf of tcppexpr * tcppexpr * tcppexpr option
   | CppWhile of tcppexpr * tcppexpr * Ast.while_flag * int
   | CppIntSwitch of tcppexpr * (Int32.t list * tcppexpr) list * tcppexpr option
   | CppSwitch of
       tcppexpr * tcpp * (tcppexpr list * tcppexpr) list * tcppexpr option * int
-  | CppTry of tcppexpr * (tvar * tcppexpr) list
+  | CppTry of tcppexpr * (tcppvar * tcppexpr) list
   | CppBreak
   | CppContinue
   | CppClassOf of path * bool
@@ -211,6 +230,8 @@ and tcpp_class_function = {
   tcf_field : tclass_field;
   tcf_name : string;
   tcf_func : tfunc;
+  tcf_args : (tcppvar * texpr option) list;
+  tcf_return : tcpp;
 
   tcf_is_virtual : bool;
   tcf_is_reflective : bool;
@@ -239,6 +260,7 @@ and tcpp_class = {
   tcl_debug_level : int;
   tcl_super : tcpp_class option;
   tcl_container : tcpp_class_container option;
+  tcl_constructor : tcpp_class_function option;
 
   tcl_haxe_interfaces : tcpp_interface list;
   tcl_native_interfaces : tcpp_interface list;
@@ -279,9 +301,16 @@ and tcpp_interface = {
   if_scriptable : bool;
 }
 
+and tcpp_tfun_arg = {
+  tfa_name : string;
+  tfa_type : tcpp;
+  tfa_optional : bool;
+}
+
 and tcpp_enum_field = {
   tef_field : tenum_field;
   tef_name : string;
+  tef_args : tcpp_tfun_arg list option;
   tef_hash : string;
 }
 

src/generators/cpp/cppAstTools.ml

@@ -1,6 +1,7 @@
 open Ast
 open Type
 open Globals
+open Error
 open CppAst
 open CppTypeUtils
 
@@ -249,6 +250,16 @@ let keyword_remap name =
       "_hx_" ^ name
     | x -> x
 
+let cpp_var_name_of var =
+   match get_meta_string var.v_meta Meta.Native with
+   | Some n -> n
+   | None -> keyword_remap var.v_name
+
+let cpp_var_debug_name_of v =
+   match get_meta_string v.v_meta Meta.RealPath with
+   | Some n -> n
+   | None -> v.v_name
+
 let remap_class_path class_path =
   let path_remap with_keywords name =
     let len = String.length name in
@@ -357,8 +368,11 @@ and tcpp_to_string_suffix suffix tcpp =
   | TCppUnchanged -> " ::Dynamic/*Unchanged*/"
   | TCppObject -> " ::Dynamic"
   | TCppObjectPtr -> " ::hx::Object *"
-  | TCppReference t -> tcpp_to_string t ^ " &"
   | TCppStruct t -> "cpp::Struct< " ^ tcpp_to_string t ^ " >"
+  | TCppReference (TCppMarshalNativeType (value_type, _)) -> Printf.sprintf "%s&" (get_native_marshalled_type value_type)
+  | TCppReference t -> tcpp_to_string t ^ " &"
+  | TCppStar (TCppMarshalNativeType (value_type, _), const) ->
+    Printf.sprintf "%s%s*" (if const then "const " else "") (get_native_marshalled_type value_type)
   | TCppStar (t, const) ->
       (if const then "const " else "") ^ tcpp_to_string t ^ " *"
   | TCppVoid -> "void"
@@ -372,8 +386,12 @@ and tcpp_to_string_suffix suffix tcpp =
   | TCppString -> "::String"
   | TCppFastIterator it ->
       "::cpp::FastIterator" ^ suffix ^ "< " ^ tcpp_to_string it ^ " >"
+  | TCppPointer (ptrType, TCppMarshalNativeType (value_type, _)) ->
+    Printf.sprintf "::cpp::%s< %s >" ptrType (get_native_marshalled_type value_type)
   | TCppPointer (ptrType, valueType) ->
       "::cpp::" ^ ptrType ^ "< " ^ tcpp_to_string valueType ^ " >"
+  | TCppRawPointer (constName, TCppMarshalNativeType (value_type, _)) ->
+    Printf.sprintf "%s%s*" constName (get_native_marshalled_type value_type)
   | TCppRawPointer (constName, valueType) ->
       constName ^ tcpp_to_string valueType ^ "*"
   | TCppFunction (argTypes, retType, abi) ->
@@ -411,6 +429,110 @@ and tcpp_to_string_suffix suffix tcpp =
   | TCppNull -> " ::Dynamic"
   | TCppCode _ -> "Code"
 
+  | TCppMarshalManagedType (cls, params) ->
+    let type_str, flags = build_type cls.cl_path cls.cl_pos params cls.cl_meta Meta.CppManagedType tcpp_to_string in
+    let standard_naming = List.exists (fun f -> f = "StandardNaming") flags in
+    let wrapped  =
+      if suffix = "_obj" then
+        if standard_naming then
+          type_str ^ suffix
+        else
+          type_str
+      else
+        if standard_naming then
+          type_str
+        else
+          Printf.sprintf "::hx::ObjectPtr< %s >" type_str
+      in
+    wrapped
+
+  | TCppMarshalNativeType (Pointer _ as value_type, Promoted) ->
+    get_native_marshalled_type value_type |> Printf.sprintf "::cpp::marshal::Boxed< %s* >"
+  | TCppMarshalNativeType (Pointer _ as value_type, Reference) ->
+    get_native_marshalled_type value_type |> Printf.sprintf "::cpp::marshal::PointerReference< %s >"
+  | TCppMarshalNativeType (Pointer _ as value_type, Stack) ->
+    get_native_marshalled_type value_type |> Printf.sprintf "::cpp::marshal::PointerType< %s >"
+
+  | TCppMarshalNativeType ((ValueClass _ | ValueEnum _) as value_type, Promoted) ->
+    get_native_marshalled_type value_type |> Printf.sprintf "::cpp::marshal::Boxed< %s >"
+  | TCppMarshalNativeType ((ValueClass _ | ValueEnum _) as value_type, Reference) ->
+    get_native_marshalled_type value_type |> Printf.sprintf "::cpp::marshal::ValueReference< %s >"
+  | TCppMarshalNativeType ((ValueClass _ | ValueEnum _) as value_type, Stack) ->
+    get_native_marshalled_type value_type |> Printf.sprintf "::cpp::marshal::ValueType< %s >"
+
+and build_type path pos params meta target parameter_handler =
+  let get_meta_field field =
+    match Meta.get target meta with
+    | _, [ (EObjectDecl decls, _) ], _ ->  
+      List.find_opt (fun ((n, _, _), _) -> n = field) decls
+    | _ ->
+      None
+  in
+  let typeParams =
+    match params with
+    | [] -> ""
+    | _ -> "< " ^ String.concat "," (List.map parameter_handler params) ^ " >"
+  in
+  let namespace_error pos =
+   abort "CPP0006: Namespace field must be an array declaration of string literals" pos
+  in
+  let flag_error pos =
+    abort "CPP0008: Flags field must be an array of identifiers" pos
+  in
+  let namespace =
+    match get_meta_field "namespace" with
+    | Some (_,( EArrayDecl ([]), _)) -> ""
+    | Some (_,( EArrayDecl (els), _)) ->
+      "::" ^ (els
+      |> List.filter_map (fun (e, pos) -> match e with | EConst (String (s, _)) -> Some s | _ -> namespace_error pos)
+      |> String.concat "::")
+    | Some ((_, pos, _), _) ->
+      namespace_error pos
+    | _ ->
+      ""
+  in
+  let t = match get_meta_field "type" with
+  | Some (_, (EConst (String (s, _)), _) ) ->
+    s ^ typeParams
+  | Some ((_, pos, _), _) ->
+    abort "CPP0007: Type field must be a string literal" pos
+  | _ ->
+    snd path ^ typeParams
+  in
+  let flags = match get_meta_field "flags" with
+  | Some (_, (EArrayDecl decls, _) ) ->
+    decls |> List.filter_map (fun (e, pos) -> match e with | EConst (Ident c) -> Some c | _ -> flag_error pos)
+  | Some ((_, pos, _), _) ->
+    flag_error pos
+  | _ ->
+    []
+  in
+
+  Printf.sprintf "%s::%s" namespace t, flags
+
+and get_native_marshalled_type value_type =
+  let marshal_type_parameter_to_string pos tcpp =
+    match tcpp with
+    | TCppMarshalNativeType (value_type, _) -> get_native_marshalled_type value_type
+    | TCppScalar _
+    | TCppPointer _
+    | TCppRawPointer _
+    | TCppStar _
+    | TCppVoidStar
+    | TCppStruct _ ->
+      tcpp_to_string_suffix "" tcpp
+    | _ ->
+      abort "CPP0003: Invalid parameter for a marshalling type" pos
+  in
+
+  match value_type with
+  | ValueClass (cls, params) ->
+    build_type cls.cl_path cls.cl_pos params cls.cl_meta Meta.CppValueType (marshal_type_parameter_to_string cls.cl_pos) |> fst
+  | ValueEnum abs ->
+    build_type abs.a_path abs.a_pos [] abs.a_meta Meta.CppValueType (marshal_type_parameter_to_string abs.a_pos) |> fst
+  | Pointer (cls, params) ->
+    build_type cls.cl_path cls.cl_pos params cls.cl_meta Meta.CppPointerType (marshal_type_parameter_to_string cls.cl_pos) |> fst
+
 and tcpp_objc_block_struct argTypes retType =
   let args = String.concat "," (List.map tcpp_to_string argTypes) in
   let ret = tcpp_to_string retType in
@@ -424,15 +546,18 @@ and tcpp_objc_block_struct argTypes retType =
 and tcpp_to_string tcpp = tcpp_to_string_suffix "" tcpp
 
 and cpp_class_path_of klass params =
-  match get_meta_string klass.cl_meta Meta.Native with
-  | Some s ->
-      let typeParams =
-        match params with
-        | [] -> ""
-        | _ -> "< " ^ String.concat "," (List.map tcpp_to_string params) ^ " >"
-      in
-      " " ^ join_class_path_remap klass.cl_path "::" ^ typeParams
-  | None -> " ::" ^ join_class_path_remap klass.cl_path "::"
+   if is_marshalling_native_value_class klass then
+    get_native_marshalled_type (ValueClass (klass, params))
+   else
+      match get_meta_string klass.cl_meta Meta.Native with
+      | Some s ->
+         let typeParams =
+            match params with
+            | [] -> ""
+            | _ -> "< " ^ String.concat "," (List.map tcpp_to_string params) ^ " >"
+            in
+         " " ^ join_class_path_remap klass.cl_path "::" ^ typeParams
+      | None -> " ::" ^ join_class_path_remap klass.cl_path "::"
 
 (*  Get a string to represent a type.
    The "suffix" will be nothing or "_obj", depending if we want the name of the
@@ -636,11 +761,13 @@ let rec cpp_is_struct_access t =
    | TCppFunction _ -> true
    | TCppStruct _-> false
    | TCppInst (class_def, _) -> Meta.has Meta.StructAccess class_def.cl_meta
+   | TCppReference (TCppMarshalNativeType _) -> true
    | TCppReference (r) -> cpp_is_struct_access r
    | _ -> false
 
 let rec cpp_is_native_array_access t =
    match t with
+   | TCppMarshalNativeType _ -> true
    | TCppStruct s -> cpp_is_native_array_access s
    | TCppReference s -> cpp_is_native_array_access s
    | TCppInst ({ cl_array_access = Some _ } as klass, _) when is_extern_class klass && Meta.has Meta.NativeArrayAccess klass.cl_meta -> true
@@ -654,6 +781,9 @@ let cpp_is_dynamic_type = function
 
 let is_object_element member_type =
   match member_type with
+   | TCppMarshalManagedType _
+   | TCppMarshalNativeType (_, Promoted) ->
+      true
    | TCppInst (x, _)
    | TCppInterface x
        -> not (is_extern_class x)
@@ -678,6 +808,8 @@ let cpp_variant_type_of t = match t with
   | TCppObjectPtr
   | TCppReference _
   | TCppStruct _
+  | TCppMarshalNativeType _
+  | TCppMarshalManagedType _
   | TCppStar _
   | TCppVoid
   | TCppFastIterator _
@@ -719,7 +851,8 @@ let cpp_cast_variant_type_of t = match t with
   | TCppDynamicArray
   | TCppClass
   | TCppEnum _
-  | TCppInst _ -> t
+  | TCppInst _
+  | TCppMarshalManagedType _ -> t
   | _ -> cpp_variant_type_of t
 
 let enum_getter_type t =

src/generators/cpp/cppMarshalling.ml

@@ -0,0 +1,12 @@
+open CppAst
+open CppAstTools
+
+let get_extern_value_type_boxed value_type =
+  let p = get_native_marshalled_type value_type in
+  let suffix =
+    match value_type with
+    | Pointer _ -> "*"
+    | _ -> ""
+  in
+
+  Printf.sprintf "::cpp::marshal::Boxed< %s%s >" p suffix, Printf.sprintf "::cpp::marshal::Boxed_obj< %s%s >" p suffix