|
@@ -0,0 +1,1928 @@
|
|
|
+open Ast
|
|
|
+open Type
|
|
|
+open Error
|
|
|
+open Globals
|
|
|
+open CppExprUtils
|
|
|
+open CppTypeUtils
|
|
|
+open CppAst
|
|
|
+open CppAstTools
|
|
|
+open CppContext
|
|
|
+
|
|
|
+let cpp_type_of = CppRetyper.cpp_type_of
|
|
|
+
|
|
|
+let script_type t optional = if optional then begin
|
|
|
+ match type_string t with
|
|
|
+ | "::String" -> "String"
|
|
|
+ | _ -> "Object"
|
|
|
+ end else match type_string t with
|
|
|
+ | "bool" -> "Int"
|
|
|
+ | "int" | "::cpp::Int32" -> "Int"
|
|
|
+ | "Float" -> "Float"
|
|
|
+ | "::String" -> "String"
|
|
|
+ | "Null" -> "Void"
|
|
|
+ | "Void" -> "Void"
|
|
|
+ | "float" | "::cpp::Float32" | "::cpp::Float64" -> "Float"
|
|
|
+ | "::cpp::Int64" | "::cpp::UInt64" -> "Object"
|
|
|
+ | _ -> "Object"
|
|
|
+
|
|
|
+let script_signature t optional = match script_type t optional with
|
|
|
+ | "Bool" -> "b"
|
|
|
+ | "Int" -> "i"
|
|
|
+ | "Float" -> "f"
|
|
|
+ | "String" -> "s"
|
|
|
+ | "Void" -> "v"
|
|
|
+ | "void" -> "v"
|
|
|
+ | _ -> "o"
|
|
|
+
|
|
|
+let script_size_type t optional = match script_type t optional with
|
|
|
+ | "Object" -> "void *"
|
|
|
+ | "Int" -> "int"
|
|
|
+ | "Bool" -> "bool"
|
|
|
+ | x -> x
|
|
|
+
|
|
|
+let rec script_type_string haxe_type =
|
|
|
+ match haxe_type with
|
|
|
+ | TAbstract ({ a_path = [], "Null" }, [ t ]) -> (
|
|
|
+ match follow t with
|
|
|
+ | TAbstract ({ a_path = [], "Int" }, _)
|
|
|
+ | TAbstract ({ a_path = [], "Float" }, _)
|
|
|
+ | TAbstract ({ a_path = [], "Bool" }, _) ->
|
|
|
+ "Dynamic"
|
|
|
+ | _ -> script_type_string t)
|
|
|
+ | TInst ({ cl_path = [], "Null" }, [ t ]) -> (
|
|
|
+ match follow t with
|
|
|
+ | TAbstract ({ a_path = [], "Int" }, _)
|
|
|
+ | TAbstract ({ a_path = [], "Float" }, _)
|
|
|
+ | TAbstract ({ a_path = [], "Bool" }, _) ->
|
|
|
+ "Dynamic"
|
|
|
+ | _ -> script_type_string t)
|
|
|
+ | _ -> (
|
|
|
+ match follow haxe_type with
|
|
|
+ | TType ({ t_path = [], "Array" }, params) -> "Array"
|
|
|
+ | TInst ({ cl_path = [], "Array" }, params) -> (
|
|
|
+ match params with
|
|
|
+ | [ t ] -> (
|
|
|
+ match type_string_suff "" t false with
|
|
|
+ | "int" -> "Array.int"
|
|
|
+ | "Float" -> "Array.Float"
|
|
|
+ | "bool" -> "Array.bool"
|
|
|
+ | "::String" -> "Array.String"
|
|
|
+ | "unsigned char" -> "Array.unsigned char"
|
|
|
+ | "::cpp::UInt8" -> "Array.unsigned char"
|
|
|
+ | "Dynamic" -> "Array.Any"
|
|
|
+ | _ -> "Array.Object")
|
|
|
+ | _ -> "Array.Object")
|
|
|
+ | TAbstract (abs, pl) when abs.a_impl <> None ->
|
|
|
+ script_type_string (Abstract.get_underlying_type abs pl)
|
|
|
+ | _ -> type_string_suff "" haxe_type false)
|
|
|
+
|
|
|
+let rec script_cpptype_string cppType =
|
|
|
+ match cppType with
|
|
|
+ | TCppDynamic | TCppUnchanged | TCppWrapped _ | TCppObject -> "Dynamic"
|
|
|
+ | TCppObjectPtr -> ".*.hx.Object*"
|
|
|
+ | TCppReference t -> ".ref." ^ script_cpptype_string t
|
|
|
+ | TCppStruct t -> ".struct." ^ script_cpptype_string t
|
|
|
+ | TCppStar (t, _) -> "*." ^ script_cpptype_string t
|
|
|
+ | TCppVoid -> "void"
|
|
|
+ | TCppVoidStar -> "*.void"
|
|
|
+ | TCppRest _ -> "vaarg_list"
|
|
|
+ | TCppVarArg -> "vararg"
|
|
|
+ | TCppAutoCast -> ".cpp.AutoCast"
|
|
|
+ | TCppVariant -> ".cpp.Variant"
|
|
|
+ | TCppEnum enum -> join_class_path enum.e_path "."
|
|
|
+ | TCppScalar scalar -> scalar
|
|
|
+ | TCppString -> "String"
|
|
|
+ | TCppFastIterator it -> "cpp.FastIterator." ^ script_cpptype_string it
|
|
|
+ | TCppPointer (_, valueType) ->
|
|
|
+ "cpp.Pointer." ^ script_cpptype_string valueType
|
|
|
+ | TCppRawPointer (_, valueType) ->
|
|
|
+ "cpp.RawPointer." ^ script_cpptype_string valueType
|
|
|
+ | TCppFunction _ -> "cpp.Function"
|
|
|
+ | TCppObjCBlock _ -> "cpp.ObjCBlock"
|
|
|
+ | TCppDynamicArray -> "Array.Any"
|
|
|
+ | TCppObjectArray _ -> "Array.Object"
|
|
|
+ | TCppScalarArray value -> "Array." ^ script_cpptype_string value
|
|
|
+ | TCppObjC _ -> "cpp.ObjC"
|
|
|
+ | TCppProtocol _ -> "cpp.ObjC.Protocol"
|
|
|
+ | TCppNativePointer klass ->
|
|
|
+ "cpp.Pointer." ^ join_class_path klass.cl_path "."
|
|
|
+ | TCppInterface klass -> join_class_path klass.cl_path "."
|
|
|
+ | TCppInst (klass, _) -> join_class_path klass.cl_path "."
|
|
|
+ | TCppClass -> "Class"
|
|
|
+ | TCppGlobal -> "?global"
|
|
|
+ | TCppNull -> "null"
|
|
|
+ | TCppCode _ -> "Dynamic"
|
|
|
+
|
|
|
+type array_of =
|
|
|
+ | ArrayInterface of int
|
|
|
+ | ArrayData of string
|
|
|
+ | ArrayObject
|
|
|
+ | ArrayAny
|
|
|
+ | ArrayNone
|
|
|
+
|
|
|
+let is_template_type t = false
|
|
|
+
|
|
|
+type cppia_op =
|
|
|
+ | IaFunction
|
|
|
+ | IaVar
|
|
|
+ | IaToInterface
|
|
|
+ | IaToDynArray
|
|
|
+ | IaToDataArray
|
|
|
+ | IaToInterfaceArray
|
|
|
+ | IaFun
|
|
|
+ | IaCast
|
|
|
+ | IaTCast
|
|
|
+ | IaBlock
|
|
|
+ | IaBreak
|
|
|
+ | IaContinue
|
|
|
+ | IaIsNull
|
|
|
+ | IaNotNull
|
|
|
+ | IaSet
|
|
|
+ | IaCall
|
|
|
+ | IaCallGlobal
|
|
|
+ | IaCallStatic
|
|
|
+ | IaCallMember
|
|
|
+ | IaCallSuper
|
|
|
+ | IaCallThis
|
|
|
+ | IaCallSuperNew
|
|
|
+ | IaCreateEnum
|
|
|
+ | IaADef
|
|
|
+ | IaIf
|
|
|
+ | IaIfElse
|
|
|
+ | IaFStatic
|
|
|
+ | IaFName
|
|
|
+ | IaFThisInst
|
|
|
+ | IaFLink
|
|
|
+ | IaFThisName
|
|
|
+ | IaFEnum
|
|
|
+ | IaThrow
|
|
|
+ | IaArrayI
|
|
|
+ | IaPlusPlus
|
|
|
+ | IaPlusPlusPost
|
|
|
+ | IaMinusMinus
|
|
|
+ | IaMinusMinusPost
|
|
|
+ | IaNeg
|
|
|
+ | IaBitNot
|
|
|
+ | IaLogicNot
|
|
|
+ | IaTVars
|
|
|
+ | IaVarDecl
|
|
|
+ | IaVarDeclI
|
|
|
+ | IaNew
|
|
|
+ | IaReturn
|
|
|
+ | IaRetVal
|
|
|
+ | IaPosInfo
|
|
|
+ | IaObjDef
|
|
|
+ | IaClassOf
|
|
|
+ | IaWhile
|
|
|
+ | IaFor
|
|
|
+ | IaEnumI
|
|
|
+ | IaSwitch
|
|
|
+ | IaTry
|
|
|
+ | IaImplDynamic
|
|
|
+ | IaConstInt
|
|
|
+ | IaConstFloat
|
|
|
+ | IaConstString
|
|
|
+ | IaConstFalse
|
|
|
+ | IaConstTrue
|
|
|
+ | IaConstNull
|
|
|
+ | IaConsThis
|
|
|
+ | IaConstSuper
|
|
|
+ | IaCastInt
|
|
|
+ | IaCastBool
|
|
|
+ | IaInterface
|
|
|
+ | IaClass
|
|
|
+ | IaAccessNormal
|
|
|
+ | IaAccessNot
|
|
|
+ | IaAccessResolve
|
|
|
+ | IaAccessCall
|
|
|
+ | IaEnum
|
|
|
+ | IaInline
|
|
|
+ | IaMain
|
|
|
+ | IaNoMain
|
|
|
+ | IaResources
|
|
|
+ | IaReso
|
|
|
+ | IaNoCast
|
|
|
+ | IaAccessCallNative
|
|
|
+ | IaBinOp of Ast.binop
|
|
|
+
|
|
|
+let cppia_op_info = function
|
|
|
+ | IaFunction -> ("FUNCTION", 1)
|
|
|
+ | IaVar -> ("VAR", 2)
|
|
|
+ | IaToInterface -> ("TOINTERFACE", 3)
|
|
|
+ | IaToDynArray -> ("TODYNARRAY", 4)
|
|
|
+ | IaToDataArray -> ("TODATAARRAY", 5)
|
|
|
+ | IaToInterfaceArray -> ("TOINTERFACEARRAY", 6)
|
|
|
+ | IaFun -> ("FUN", 7)
|
|
|
+ | IaCast -> ("CAST", 8)
|
|
|
+ | IaBlock -> ("BLOCK", 9)
|
|
|
+ | IaBreak -> ("BREAK", 10)
|
|
|
+ | IaContinue -> ("CONTINUE", 11)
|
|
|
+ | IaIsNull -> ("ISNULL", 12)
|
|
|
+ | IaNotNull -> ("NOTNULL", 13)
|
|
|
+ | IaSet -> ("SET", 14)
|
|
|
+ | IaCall -> ("CALL", 15)
|
|
|
+ | IaCallGlobal -> ("CALLGLOBAL", 16)
|
|
|
+ | IaCallStatic -> ("CALLSTATIC", 17)
|
|
|
+ | IaCallMember -> ("CALLMEMBER", 18)
|
|
|
+ | IaCallSuper -> ("CALLSUPER", 19)
|
|
|
+ | IaCallThis -> ("CALLTHIS", 20)
|
|
|
+ | IaCallSuperNew -> ("CALLSUPERNEW", 21)
|
|
|
+ | IaCreateEnum -> ("CREATEENUM", 22)
|
|
|
+ | IaADef -> ("ADEF", 23)
|
|
|
+ | IaIf -> ("IF", 24)
|
|
|
+ | IaIfElse -> ("IFELSE", 25)
|
|
|
+ | IaFName -> ("FNAME", 27)
|
|
|
+ | IaFStatic -> ("FSTATIC", 28)
|
|
|
+ | IaFThisInst -> ("FTHISINST", 29)
|
|
|
+ | IaFLink -> ("FLINK", 30)
|
|
|
+ | IaFThisName -> ("FTHISNAME", 31)
|
|
|
+ | IaFEnum -> ("FENUM", 32)
|
|
|
+ | IaThrow -> ("THROW", 33)
|
|
|
+ | IaArrayI -> ("ARRAYI", 34)
|
|
|
+ | IaPlusPlus -> ("++", 35)
|
|
|
+ | IaPlusPlusPost -> ("+++", 36)
|
|
|
+ | IaMinusMinus -> ("--", 37)
|
|
|
+ | IaMinusMinusPost -> ("---", 38)
|
|
|
+ | IaNeg -> ("NEG", 39)
|
|
|
+ | IaBitNot -> ("~", 40)
|
|
|
+ | IaLogicNot -> ("!", 41)
|
|
|
+ | IaTVars -> ("TVARS", 42)
|
|
|
+ | IaVarDecl -> ("VARDECL", 43)
|
|
|
+ | IaVarDeclI -> ("VARDECLI", 44)
|
|
|
+ | IaNew -> ("NEW", 45)
|
|
|
+ | IaReturn -> ("RETURN", 46)
|
|
|
+ | IaRetVal -> ("RETVAL", 47)
|
|
|
+ | IaPosInfo -> ("POSINFO", 48)
|
|
|
+ | IaObjDef -> ("OBJDEF", 49)
|
|
|
+ | IaClassOf -> ("CLASSOF", 50)
|
|
|
+ | IaWhile -> ("WHILE", 51)
|
|
|
+ | IaFor -> ("FOR", 52)
|
|
|
+ | IaEnumI -> ("ENUMI", 53)
|
|
|
+ | IaSwitch -> ("SWITCH", 54)
|
|
|
+ | IaTry -> ("TRY", 55)
|
|
|
+ | IaImplDynamic -> ("IMPLDYNAMIC", 56)
|
|
|
+ | IaConstInt -> ("i", 57)
|
|
|
+ | IaConstFloat -> ("f", 58)
|
|
|
+ | IaConstString -> ("s", 59)
|
|
|
+ | IaConstFalse -> ("false", 60)
|
|
|
+ | IaConstTrue -> ("true", 61)
|
|
|
+ | IaConstNull -> ("NULL", 62)
|
|
|
+ | IaConsThis -> ("THIS", 63)
|
|
|
+ | IaConstSuper -> ("SUPER", 64)
|
|
|
+ | IaCastInt -> ("CASTINT", 65)
|
|
|
+ | IaCastBool -> ("CASTBOOL", 66)
|
|
|
+ | IaInterface -> ("INTERFACE", 67)
|
|
|
+ | IaClass -> ("CLASS", 68)
|
|
|
+ | IaAccessNormal -> ("N", 69)
|
|
|
+ | IaAccessNot -> ("n", 70)
|
|
|
+ | IaAccessResolve -> ("R", 71)
|
|
|
+ | IaAccessCall -> ("C", 72)
|
|
|
+ | IaEnum -> ("ENUM", 73)
|
|
|
+ | IaInline -> ("INLINE", 74)
|
|
|
+ | IaMain -> ("MAIN", 75)
|
|
|
+ | IaNoMain -> ("NOMAIN", 76)
|
|
|
+ | IaResources -> ("RESOURCES", 77)
|
|
|
+ | IaReso -> ("RESO", 78)
|
|
|
+ | IaNoCast -> ("NOCAST", 79)
|
|
|
+ | IaAccessCallNative -> ("V", 80)
|
|
|
+ | IaBinOp OpAdd -> ("+", 101)
|
|
|
+ | IaBinOp OpMult -> ("*", 102)
|
|
|
+ | IaBinOp OpDiv -> ("/", 103)
|
|
|
+ | IaBinOp OpSub -> ("-", 104)
|
|
|
+ | IaBinOp OpAssign -> ("=", 105)
|
|
|
+ | IaBinOp OpEq -> ("==", 106)
|
|
|
+ | IaBinOp OpNotEq -> ("!=", 107)
|
|
|
+ | IaBinOp OpGte -> (">=", 108)
|
|
|
+ | IaBinOp OpLte -> ("<=", 109)
|
|
|
+ | IaBinOp OpGt -> (">", 110)
|
|
|
+ | IaBinOp OpLt -> ("<", 111)
|
|
|
+ | IaBinOp OpAnd -> ("&", 112)
|
|
|
+ | IaBinOp OpOr -> ("|", 113)
|
|
|
+ | IaBinOp OpXor -> ("^", 114)
|
|
|
+ | IaBinOp OpBoolAnd -> ("&&", 115)
|
|
|
+ | IaBinOp OpBoolOr -> ("||", 116)
|
|
|
+ | IaBinOp OpShr -> (">>", 117)
|
|
|
+ | IaBinOp OpUShr -> (">>>", 118)
|
|
|
+ | IaBinOp OpShl -> ("<<", 119)
|
|
|
+ | IaBinOp OpMod -> ("%", 120)
|
|
|
+ | IaBinOp OpInterval -> ("...", 121)
|
|
|
+ | IaBinOp OpArrow -> ("=>", 122)
|
|
|
+ | IaBinOp OpIn -> (" in ", 123)
|
|
|
+ | IaBinOp OpNullCoal -> ("??", 124)
|
|
|
+ | IaBinOp (OpAssignOp OpAdd) -> ("+=", 201)
|
|
|
+ | IaBinOp (OpAssignOp OpMult) -> ("*=", 202)
|
|
|
+ | IaBinOp (OpAssignOp OpDiv) -> ("/=", 203)
|
|
|
+ | IaBinOp (OpAssignOp OpSub) -> ("-=", 204)
|
|
|
+ | IaBinOp (OpAssignOp OpAnd) -> ("&=", 212)
|
|
|
+ | IaBinOp (OpAssignOp OpOr) -> ("|=", 213)
|
|
|
+ | IaBinOp (OpAssignOp OpXor) -> ("^=", 214)
|
|
|
+ | IaBinOp (OpAssignOp OpBoolAnd) -> ("&&=", 215)
|
|
|
+ | IaBinOp (OpAssignOp OpBoolOr) -> ("||=", 216)
|
|
|
+ | IaBinOp (OpAssignOp OpShr) -> (">>=", 217)
|
|
|
+ | IaBinOp (OpAssignOp OpUShr) -> (">>>=", 218)
|
|
|
+ | IaBinOp (OpAssignOp OpShl) -> ("<<=", 219)
|
|
|
+ | IaBinOp (OpAssignOp OpMod) -> ("%=", 220)
|
|
|
+ | IaBinOp (OpAssignOp OpIn)
|
|
|
+ | IaBinOp (OpAssignOp OpNullCoal)
|
|
|
+ | IaBinOp (OpAssignOp OpInterval)
|
|
|
+ | IaBinOp (OpAssignOp OpAssign)
|
|
|
+ | IaBinOp (OpAssignOp OpEq)
|
|
|
+ | IaBinOp (OpAssignOp OpNotEq)
|
|
|
+ | IaBinOp (OpAssignOp OpGte)
|
|
|
+ | IaBinOp (OpAssignOp OpLte)
|
|
|
+ | IaBinOp (OpAssignOp OpGt)
|
|
|
+ | IaBinOp (OpAssignOp OpLt)
|
|
|
+ | IaBinOp (OpAssignOp (OpAssignOp _))
|
|
|
+ | IaBinOp (OpAssignOp OpArrow) ->
|
|
|
+ die "" __LOC__
|
|
|
+ | IaTCast -> ("TCAST", 221)
|
|
|
+
|
|
|
+let follow = Abstract.follow_with_abstracts
|
|
|
+
|
|
|
+let is_matching_interface_type t0 t1 =
|
|
|
+ match (follow t0, follow t1) with
|
|
|
+ | TInst (k0, _), TInst (k1, _) -> k0 == k1
|
|
|
+ | _ -> false
|
|
|
+
|
|
|
+let rec is_null expr =
|
|
|
+ match expr.eexpr with
|
|
|
+ | TConst TNull -> true
|
|
|
+ | TParenthesis expr | TMeta (_, expr) -> is_null expr
|
|
|
+ | TCast (e, None) -> is_null e
|
|
|
+ | _ -> false
|
|
|
+
|
|
|
+let is_virtual_array expr = type_string expr.etype = "cpp::VirtualArray"
|
|
|
+
|
|
|
+let is_this expression =
|
|
|
+ match (remove_parens expression).eexpr with
|
|
|
+ | TConst TThis -> true
|
|
|
+ | _ -> false
|
|
|
+
|
|
|
+let is_super expression =
|
|
|
+ match (remove_parens expression).eexpr with
|
|
|
+ | TConst TSuper -> true
|
|
|
+ | _ -> false
|
|
|
+
|
|
|
+let is_native_pointer expr =
|
|
|
+ let t = type_string expr.etype in
|
|
|
+ let l = String.length t in
|
|
|
+ l > 1 && String.sub t (l - 1) 1 = "*"
|
|
|
+
|
|
|
+let is_extern_class_instance obj =
|
|
|
+ match follow obj.etype with
|
|
|
+ | TInst (klass, params) -> has_class_flag klass CExtern
|
|
|
+ | _ -> false
|
|
|
+
|
|
|
+let rec is_dynamic_in_cpp ctx expr =
|
|
|
+ let expr_type =
|
|
|
+ type_string
|
|
|
+ (match follow expr.etype with TFun (args, ret) -> ret | _ -> expr.etype)
|
|
|
+ in
|
|
|
+ if expr_type = "Dynamic" || expr_type = "cpp::ArrayBase" then true
|
|
|
+ else
|
|
|
+ let result =
|
|
|
+ match expr.eexpr with
|
|
|
+ | TEnumParameter (obj, _, index) -> true (* TODO? *)
|
|
|
+ | TField (obj, field) ->
|
|
|
+ is_dynamic_member_lookup_in_cpp ctx obj field
|
|
|
+ || is_dynamic_member_return_in_cpp ctx obj field
|
|
|
+ | TArray (obj, index) -> is_dynamic_in_cpp ctx obj || is_virtual_array obj
|
|
|
+ | TTypeExpr _ -> false
|
|
|
+ | TCall (func, args) -> (
|
|
|
+ let is_IaCall =
|
|
|
+ match (remove_parens_cast func).eexpr with
|
|
|
+ | TField ({ eexpr = TIdent "__global__" }, field) -> false
|
|
|
+ | TField (obj, FStatic (class_def, field))
|
|
|
+ when is_real_function field ->
|
|
|
+ false
|
|
|
+ | TField (obj, FInstance (_, _, field))
|
|
|
+ when is_this obj && is_real_function field ->
|
|
|
+ false
|
|
|
+ | TField (obj, FInstance (_, _, field)) when is_super obj -> false
|
|
|
+ | TField (obj, FInstance (_, _, field))
|
|
|
+ when field.cf_name = "_hx_getIndex" ->
|
|
|
+ false
|
|
|
+ | TField (obj, FInstance (_, _, field))
|
|
|
+ when field.cf_name = "__Index"
|
|
|
+ || (not (is_dynamic_in_cppia ctx obj))
|
|
|
+ && is_real_function field ->
|
|
|
+ false
|
|
|
+ | TField (obj, FDynamic name)
|
|
|
+ when is_internal_member name
|
|
|
+ || (type_string obj.etype = "::String" && name = "cca") ->
|
|
|
+ false
|
|
|
+ | TConst TSuper -> false
|
|
|
+ | TField (_, FEnum (enum, field)) -> false
|
|
|
+ | _ -> true
|
|
|
+ in
|
|
|
+ if is_IaCall then true
|
|
|
+ else
|
|
|
+ match follow func.etype with
|
|
|
+ | TFun (args, ret) -> is_dynamic_in_cpp ctx func
|
|
|
+ | _ -> true)
|
|
|
+ | TParenthesis expr | TMeta (_, expr) -> is_dynamic_in_cpp ctx expr
|
|
|
+ | TCast (e, None) -> type_string expr.etype = "Dynamic"
|
|
|
+ | TIdent "__global__" -> false
|
|
|
+ | TConst TNull -> true
|
|
|
+ | _ -> false (* others ? *)
|
|
|
+ in
|
|
|
+ result
|
|
|
+
|
|
|
+and is_dynamic_member_lookup_in_cpp (ctx : context) field_object field =
|
|
|
+ let member = field_name field in
|
|
|
+ if is_internal_member member then false
|
|
|
+ else if is_native_pointer field_object then false
|
|
|
+ else if is_pointer field_object.etype true then false
|
|
|
+ else if match field_object.eexpr with TTypeExpr _ -> true | _ -> false then
|
|
|
+ false
|
|
|
+ else if is_dynamic_in_cpp ctx field_object then true
|
|
|
+ else if is_array field_object.etype then false
|
|
|
+ else
|
|
|
+ let tstr = type_string field_object.etype in
|
|
|
+ match tstr with
|
|
|
+ (* Internal classes have no dynamic members *)
|
|
|
+ | "::String" | "Null" | "::hx::Class" | "::Enum" | "::Math"
|
|
|
+ | "::ArrayAccess" ->
|
|
|
+ false
|
|
|
+ | "Dynamic" -> true
|
|
|
+ | name ->
|
|
|
+ let full_name = name ^ "." ^ member in
|
|
|
+ if Hashtbl.mem ctx.ctx_class_member_types full_name then false
|
|
|
+ else not (is_extern_class_instance field_object)
|
|
|
+
|
|
|
+and is_dynamic_member_return_in_cpp ctx field_object field =
|
|
|
+ let member = field_name field in
|
|
|
+ if is_array field_object.etype then false
|
|
|
+ else if is_pointer field_object.etype true then false
|
|
|
+ else if is_internal_member member then false
|
|
|
+ else
|
|
|
+ match field_object.eexpr with
|
|
|
+ | TTypeExpr t -> (
|
|
|
+ let full_name =
|
|
|
+ "::" ^ join_class_path_remap (t_path t) "::" ^ "." ^ member
|
|
|
+ in
|
|
|
+ try
|
|
|
+ let mem_type = Hashtbl.find ctx.ctx_class_member_types full_name in
|
|
|
+ mem_type = "Dynamic"
|
|
|
+ || mem_type = "cpp::ArrayBase"
|
|
|
+ || mem_type = "cpp::VirtualArray"
|
|
|
+ with Not_found -> true)
|
|
|
+ | _ -> (
|
|
|
+ let tstr = type_string field_object.etype in
|
|
|
+ match tstr with
|
|
|
+ (* Internal classes have no dynamic members *)
|
|
|
+ | "::String" | "Null" | "::hx::Class" | "::Enum" | "::Math"
|
|
|
+ | "::ArrayAccess" ->
|
|
|
+ false
|
|
|
+ | "Dynamic" | "cpp::ArrayBase" | "cpp::VirtualArray" -> true
|
|
|
+ | name -> (
|
|
|
+ let full_name = name ^ "." ^ member in
|
|
|
+ try
|
|
|
+ let mem_type =
|
|
|
+ Hashtbl.find ctx.ctx_class_member_types full_name
|
|
|
+ in
|
|
|
+ mem_type = "Dynamic"
|
|
|
+ || mem_type = "cpp::ArrayBase"
|
|
|
+ || mem_type = "cpp::VirtualArray"
|
|
|
+ with Not_found -> true))
|
|
|
+
|
|
|
+and is_dynamic_in_cppia ctx expr =
|
|
|
+ match expr.eexpr with
|
|
|
+ | TCast (_, None) -> true
|
|
|
+ | _ -> is_dynamic_in_cpp ctx expr
|
|
|
+
|
|
|
+class script_writer ctx filename asciiOut =
|
|
|
+ object (this)
|
|
|
+ val debug = asciiOut
|
|
|
+
|
|
|
+ val doComment =
|
|
|
+ asciiOut && Gctx.defined ctx.ctx_common Define.AnnotateSource
|
|
|
+
|
|
|
+ val indent_str = if asciiOut then "\t" else ""
|
|
|
+ val mutable indent = ""
|
|
|
+ val mutable indents = []
|
|
|
+ val mutable just_finished_block = false
|
|
|
+ val mutable classCount = 0
|
|
|
+ val mutable return_type = TMono (Monomorph.create ())
|
|
|
+ val buffer = Buffer.create 0
|
|
|
+ val identTable = Hashtbl.create 0
|
|
|
+ val fileTable = Hashtbl.create 0
|
|
|
+ val identBuffer = Buffer.create 0
|
|
|
+ val cppiaAst = not (Gctx.defined ctx.ctx_common Define.NoCppiaAst)
|
|
|
+
|
|
|
+ method stringId name =
|
|
|
+ try Hashtbl.find identTable name
|
|
|
+ with Not_found ->
|
|
|
+ let size = Hashtbl.length identTable in
|
|
|
+ Hashtbl.add identTable name size;
|
|
|
+ Buffer.add_string identBuffer
|
|
|
+ (string_of_int (String.length name) ^ " " ^ name ^ "\n");
|
|
|
+ size
|
|
|
+
|
|
|
+ method incClasses = classCount <- classCount + 1
|
|
|
+ method stringText name = string_of_int (this#stringId name) ^ " "
|
|
|
+ val typeTable = Hashtbl.create 0
|
|
|
+ val typeBuffer = Buffer.create 0
|
|
|
+
|
|
|
+ method typeId name =
|
|
|
+ let name = if name = "::hx::Class" then "::Class" else name in
|
|
|
+ try Hashtbl.find typeTable name
|
|
|
+ with Not_found ->
|
|
|
+ let size = Hashtbl.length typeTable in
|
|
|
+ Hashtbl.add typeTable name size;
|
|
|
+ Buffer.add_string typeBuffer
|
|
|
+ (string_of_int (String.length name) ^ " " ^ name ^ "\n");
|
|
|
+ size
|
|
|
+
|
|
|
+ method write str =
|
|
|
+ (if asciiOut then Buffer.add_string buffer str
|
|
|
+ else
|
|
|
+ let push i = Buffer.add_char buffer (Char.chr i) in
|
|
|
+ let pushI32 i =
|
|
|
+ push (Int32.to_int (Int32.logand i (Int32.of_int 255)))
|
|
|
+ in
|
|
|
+ List.iter
|
|
|
+ (fun i ->
|
|
|
+ if
|
|
|
+ Int32.compare i Int32.zero >= 0
|
|
|
+ && Int32.compare i (Int32.of_int 254) < 0
|
|
|
+ then pushI32 i
|
|
|
+ else if
|
|
|
+ Int32.compare i Int32.zero >= 0
|
|
|
+ && Int32.compare i (Int32.of_int 65536) < 0
|
|
|
+ then (
|
|
|
+ push 254;
|
|
|
+ pushI32 i;
|
|
|
+ pushI32 (Int32.shift_right i 8))
|
|
|
+ else (
|
|
|
+ push 255;
|
|
|
+ pushI32 i;
|
|
|
+ pushI32 (Int32.shift_right i 8);
|
|
|
+ pushI32 (Int32.shift_right i 16);
|
|
|
+ pushI32 (Int32.shift_right i 24)))
|
|
|
+ (List.map Int32.of_string (Str.split (Str.regexp "[\n\t ]+") str)));
|
|
|
+ just_finished_block <- false
|
|
|
+
|
|
|
+ method comment text = if doComment then this#write ("# " ^ text ^ "\n")
|
|
|
+ method commentOf text = if doComment then " # " ^ text else ""
|
|
|
+ method typeTextString typeName = string_of_int (this#typeId typeName) ^ " "
|
|
|
+
|
|
|
+ method typeText typeT =
|
|
|
+ let tname =
|
|
|
+ if cppiaAst then script_cpptype_string (cpp_type_of typeT)
|
|
|
+ else script_type_string typeT
|
|
|
+ in
|
|
|
+ string_of_int (this#typeId tname) ^ " "
|
|
|
+
|
|
|
+ method astType cppType =
|
|
|
+ string_of_int (this#typeId (script_cpptype_string cppType)) ^ " "
|
|
|
+
|
|
|
+ method writeType typeT = this#write (this#typeText typeT)
|
|
|
+
|
|
|
+ method toCppType etype =
|
|
|
+ string_of_int (this#typeId (script_cpptype_string (cpp_type_of etype)))
|
|
|
+ ^ " "
|
|
|
+
|
|
|
+ method boolText value = if value then "1" else "0"
|
|
|
+ method writeBool value = this#write (if value then "1 " else "0 ")
|
|
|
+ method staticText value = if value then "1" else "0"
|
|
|
+ method writeData str = Buffer.add_string buffer str
|
|
|
+ method wint ival = this#write (string_of_int ival ^ " ")
|
|
|
+ method ident name = this#wint (this#stringId name)
|
|
|
+
|
|
|
+ method cppInstText clazz =
|
|
|
+ match clazz.cl_path with
|
|
|
+ | [], "Array" -> this#typeTextString "Array"
|
|
|
+ | x -> this#typeTextString (join_class_path x ".")
|
|
|
+
|
|
|
+ method instText clazz =
|
|
|
+ match clazz.cl_path with
|
|
|
+ | [], "Array" -> string_of_int (this#typeId "Array< ::Dynamic >") ^ " "
|
|
|
+ | _ -> this#typeText (TInst (clazz, []))
|
|
|
+
|
|
|
+ method instName clazz =
|
|
|
+ this#write
|
|
|
+ (if cppiaAst then this#cppInstText clazz else this#instText clazz)
|
|
|
+
|
|
|
+ method enumText e = this#typeText (TEnum (e, []))
|
|
|
+
|
|
|
+ method close =
|
|
|
+ let out_file = open_out_bin filename in
|
|
|
+ output_string out_file (if asciiOut then "CPPIA\n" else "CPPIB\n");
|
|
|
+ let idents = Buffer.contents identBuffer in
|
|
|
+ output_string out_file (string_of_int (Hashtbl.length identTable) ^ "\n");
|
|
|
+ output_string out_file idents;
|
|
|
+ let types = Buffer.contents typeBuffer in
|
|
|
+ output_string out_file (string_of_int (Hashtbl.length typeTable) ^ "\n");
|
|
|
+ output_string out_file types;
|
|
|
+ output_string out_file (string_of_int classCount ^ "\n");
|
|
|
+ let contents = Buffer.contents buffer in
|
|
|
+ output_string out_file contents;
|
|
|
+ close_out out_file
|
|
|
+
|
|
|
+ method fileId file =
|
|
|
+ try Hashtbl.find fileTable file
|
|
|
+ with Not_found ->
|
|
|
+ let stripped_file = strip_file ctx.ctx_common file in
|
|
|
+ let result = this#stringId stripped_file in
|
|
|
+ Hashtbl.add fileTable file result;
|
|
|
+ result
|
|
|
+
|
|
|
+ method constText c =
|
|
|
+ match c with
|
|
|
+ | TInt i -> this#op IaConstInt ^ Printf.sprintf "%ld " i
|
|
|
+ | TFloat f ->
|
|
|
+ this#op IaConstFloat ^ this#stringText (Texpr.replace_separators f "")
|
|
|
+ | TString s -> this#op IaConstString ^ this#stringText s
|
|
|
+ | TBool true -> this#op IaConstTrue
|
|
|
+ | TBool false -> this#op IaConstFalse
|
|
|
+ | TNull -> this#op IaConstNull
|
|
|
+ | TThis -> this#op IaConsThis
|
|
|
+ | TSuper -> this#op IaConstSuper
|
|
|
+
|
|
|
+ method get_array_type t =
|
|
|
+ match follow t with
|
|
|
+ | TInst ({ cl_path = [], "Array" }, [ param ]) -> (
|
|
|
+ let typeName = type_string_suff "" param false in
|
|
|
+ match typeName with
|
|
|
+ | "::String" -> ArrayData "String"
|
|
|
+ | "int" | "Float" | "bool" | "String" | "unsigned char"
|
|
|
+ | "::cpp::UInt8" ->
|
|
|
+ ArrayData typeName
|
|
|
+ | "cpp::ArrayBase" | "cpp::VirtualArray" | "Dynamic" -> ArrayAny
|
|
|
+ | _ when is_interface_type param ->
|
|
|
+ ArrayInterface (this#typeId (script_type_string param))
|
|
|
+ | _ -> ArrayObject)
|
|
|
+ | TAbstract (abs, pl) when abs.a_impl <> None ->
|
|
|
+ this#get_array_type (Abstract.get_underlying_type abs pl)
|
|
|
+ | _ -> ArrayNone
|
|
|
+
|
|
|
+ method pushReturn inType =
|
|
|
+ let oldReturnType = return_type in
|
|
|
+ return_type <- inType;
|
|
|
+ fun () -> return_type <- oldReturnType
|
|
|
+
|
|
|
+ method fileText file = string_of_int (this#fileId file)
|
|
|
+ method indent_one = this#write indent_str
|
|
|
+
|
|
|
+ method push_indent =
|
|
|
+ indents <- indent_str :: indents;
|
|
|
+ indent <- String.concat "" indents
|
|
|
+
|
|
|
+ method pop_indent =
|
|
|
+ match indents with
|
|
|
+ | h :: tail ->
|
|
|
+ indents <- tail;
|
|
|
+ indent <- String.concat "" indents
|
|
|
+ | [] -> indent <- "/*?*/"
|
|
|
+
|
|
|
+ method write_i x = this#write (indent ^ x)
|
|
|
+ method get_indent = indent
|
|
|
+ method begin_expr = this#push_indent
|
|
|
+
|
|
|
+ method end_expr =
|
|
|
+ if not just_finished_block then this#write "\n";
|
|
|
+ this#pop_indent;
|
|
|
+ just_finished_block <- true
|
|
|
+
|
|
|
+ method op x =
|
|
|
+ match cppia_op_info x with
|
|
|
+ | name, index -> (if debug then name else string_of_int index) ^ " "
|
|
|
+
|
|
|
+ method writeOp o = this#write (this#op o)
|
|
|
+ method writeOpLine o = this#write (this#op o ^ "\n")
|
|
|
+
|
|
|
+ method voidFunc isStatic isDynamic funcName fieldExpression =
|
|
|
+ this#comment funcName;
|
|
|
+ this#write
|
|
|
+ (this#op IaFunction ^ this#staticText isStatic ^ " "
|
|
|
+ ^ this#boolText isDynamic ^ " " ^ this#stringText funcName ^ " ");
|
|
|
+ this#write (this#typeTextString "Void" ^ "0\n");
|
|
|
+ this#gen_expression fieldExpression
|
|
|
+
|
|
|
+ method func isStatic isDynamic funcName ret args isInterface fieldExpression
|
|
|
+ abstractPos =
|
|
|
+ this#comment funcName;
|
|
|
+ this#write
|
|
|
+ (this#op IaFunction ^ this#staticText isStatic ^ " "
|
|
|
+ ^ this#boolText isDynamic ^ " " ^ this#stringText funcName ^ " ");
|
|
|
+ this#write (this#typeText ret ^ string_of_int (List.length args) ^ " ");
|
|
|
+ List.iter
|
|
|
+ (fun (name, opt, typ) ->
|
|
|
+ this#write
|
|
|
+ (this#stringText name ^ this#boolText opt ^ " " ^ this#typeText typ
|
|
|
+ ^ " "))
|
|
|
+ args;
|
|
|
+ this#write "\n";
|
|
|
+ if not isInterface then
|
|
|
+ match fieldExpression with
|
|
|
+ | Some ({ eexpr = TFunction function_def } as e) ->
|
|
|
+ if cppiaAst then (
|
|
|
+ let args = List.map fst function_def.tf_args in
|
|
|
+ let cppExpr =
|
|
|
+ CppRetyper.expression ctx TCppVoid args function_def.tf_type
|
|
|
+ function_def.tf_expr false
|
|
|
+ in
|
|
|
+ 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");
|
|
|
+ let close = this#gen_func_args function_def.tf_args in
|
|
|
+ this#gen_expression_tree cppExpr;
|
|
|
+ this#end_expr;
|
|
|
+ close ())
|
|
|
+ else this#gen_expression e
|
|
|
+ | _ ->
|
|
|
+ (* Abstract function - dummp implementation that (should) not get called *)
|
|
|
+ this#begin_expr;
|
|
|
+ this#wpos abstractPos;
|
|
|
+ this#writeOpLine IaReturn;
|
|
|
+ this#end_expr
|
|
|
+
|
|
|
+ method var readAcc writeAcc isExtern isStatic name varType varExpr =
|
|
|
+ this#write
|
|
|
+ (this#op IaVar ^ this#staticText isStatic ^ " " ^ this#op readAcc
|
|
|
+ ^ this#op writeAcc ^ this#boolText isExtern ^ " " ^ this#stringText name
|
|
|
+ ^ this#typeText varType
|
|
|
+ ^ (match varExpr with Some _ -> "1" | _ -> "0")
|
|
|
+ ^ if doComment then " # " ^ name ^ "\n" else "\n");
|
|
|
+ match varExpr with
|
|
|
+ | Some expression ->
|
|
|
+ if cppiaAst then
|
|
|
+ let varType = cpp_type_of expression.etype in
|
|
|
+ let cppExpr =
|
|
|
+ CppRetyper.expression ctx varType [] t_dynamic expression false
|
|
|
+ in
|
|
|
+ this#gen_expression_tree cppExpr
|
|
|
+ else this#gen_expression expression
|
|
|
+ | _ -> ()
|
|
|
+
|
|
|
+ method implDynamic = this#writeOpLine IaImplDynamic
|
|
|
+
|
|
|
+ method writeVar v =
|
|
|
+ this#ident v.v_name;
|
|
|
+ this#wint v.v_id;
|
|
|
+ this#writeBool (has_var_flag v VCaptured);
|
|
|
+ this#writeType v.v_type
|
|
|
+
|
|
|
+ method writeList prefix len =
|
|
|
+ this#write (prefix ^ " " ^ string_of_int len ^ "\n")
|
|
|
+
|
|
|
+ method wpos p =
|
|
|
+ if debug then
|
|
|
+ this#write
|
|
|
+ (this#fileText p.pfile ^ "\t"
|
|
|
+ ^ string_of_int (Lexer.get_error_line p)
|
|
|
+ ^ indent)
|
|
|
+
|
|
|
+ method writePos expr = this#wpos expr.epos
|
|
|
+ method writeCppPos expr = this#wpos expr.cpppos
|
|
|
+
|
|
|
+ method checkCast toType expr forceCast fromGenExpression =
|
|
|
+ let write_cast text =
|
|
|
+ if not fromGenExpression then this#writePos expr;
|
|
|
+ this#write (text ^ "\n");
|
|
|
+ this#begin_expr;
|
|
|
+ this#gen_expression expr;
|
|
|
+ this#end_expr;
|
|
|
+ true
|
|
|
+ in
|
|
|
+ let was_cast =
|
|
|
+ if is_interface_type toType then
|
|
|
+ if is_dynamic_in_cppia ctx expr then
|
|
|
+ write_cast
|
|
|
+ (this#op IaToInterface ^ this#typeText toType ^ " "
|
|
|
+ ^ this#typeTextString "Dynamic")
|
|
|
+ else if not (is_matching_interface_type toType expr.etype) then
|
|
|
+ write_cast
|
|
|
+ (this#op IaToInterface ^ this#typeText toType ^ " "
|
|
|
+ ^ this#typeText expr.etype)
|
|
|
+ else false
|
|
|
+ else
|
|
|
+ let get_array_expr_type expr =
|
|
|
+ if is_dynamic_in_cppia ctx expr then ArrayNone
|
|
|
+ else this#get_array_type expr.etype
|
|
|
+ in
|
|
|
+ match (this#get_array_type toType, get_array_expr_type expr) with
|
|
|
+ | ArrayAny, _ -> false
|
|
|
+ | ArrayObject, ArrayData _ -> write_cast (this#op IaToDynArray)
|
|
|
+ | ArrayObject, ArrayObject -> false
|
|
|
+ | ArrayObject, ArrayNone | ArrayObject, ArrayAny ->
|
|
|
+ write_cast
|
|
|
+ (this#op IaToDataArray ^ this#typeTextString "Array.Object")
|
|
|
+ | ArrayData t, ArrayNone
|
|
|
+ | ArrayData t, ArrayObject
|
|
|
+ | ArrayData t, ArrayAny ->
|
|
|
+ write_cast
|
|
|
+ (this#op IaToDataArray ^ this#typeTextString ("Array." ^ t))
|
|
|
+ | ArrayInterface t, ArrayNone | ArrayInterface t, ArrayAny ->
|
|
|
+ write_cast (this#op IaToInterfaceArray ^ string_of_int t)
|
|
|
+ | _, _ ->
|
|
|
+ (* a0,a1 ->
|
|
|
+ let arrayString a =
|
|
|
+ match a with
|
|
|
+ | ArrayNone -> "ArrayNone"
|
|
|
+ | ArrayAny -> "ArrayAny"
|
|
|
+ | ArrayObject -> "ArrayObject"
|
|
|
+ | ArrayData _ -> "ArrayData"
|
|
|
+ | ArrayInterface _ -> "ArrayInterface"
|
|
|
+ in
|
|
|
+ this#write ("NOCAST " ^ (arrayString a0) ^ "=" ^ (arrayString a1)); *)
|
|
|
+ false
|
|
|
+ in
|
|
|
+
|
|
|
+ if not was_cast then (
|
|
|
+ (if forceCast then
|
|
|
+ let op =
|
|
|
+ match type_string expr.etype with
|
|
|
+ | "int" -> IaCastInt
|
|
|
+ | "bool" -> IaCastBool
|
|
|
+ | _ when is_interface_type toType -> IaNoCast
|
|
|
+ | _ -> IaCast
|
|
|
+ in
|
|
|
+ this#writeOpLine op);
|
|
|
+ this#gen_expression expr)
|
|
|
+
|
|
|
+ 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 const.etype in
|
|
|
+ if is_cpp_scalar argType || argType == TCppString then (
|
|
|
+ this#write "1 ";
|
|
|
+ this#gen_expression_only const;
|
|
|
+ this#write "\n")
|
|
|
+ else (
|
|
|
+ gen_inits := (arg, const) :: !gen_inits;
|
|
|
+ this#write "0\n")
|
|
|
+ | _ -> this#write "0\n")
|
|
|
+ args;
|
|
|
+
|
|
|
+ if List.length !gen_inits == 0 then fun () -> ()
|
|
|
+ else (
|
|
|
+ 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)
|
|
|
+
|
|
|
+ method gen_expression expr =
|
|
|
+ this#begin_expr;
|
|
|
+ this#writePos expr;
|
|
|
+ this#gen_expression_only expr;
|
|
|
+ this#end_expr
|
|
|
+
|
|
|
+ method gen_expression_only expr =
|
|
|
+ (* { *)
|
|
|
+ let expression = remove_parens expr in
|
|
|
+ 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");
|
|
|
+ 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)
|
|
|
+ | TBreak -> this#writeOp IaBreak
|
|
|
+ | TContinue -> this#writeOp IaContinue
|
|
|
+ | TBinop (op, e1, e2) when op = OpAssign ->
|
|
|
+ this#writeOpLine IaSet;
|
|
|
+ this#gen_expression e1;
|
|
|
+ this#checkCast e1.etype e2 false false
|
|
|
+ | TBinop (OpEq, e1, { eexpr = TConst TNull }) ->
|
|
|
+ this#writeOpLine IaIsNull;
|
|
|
+ this#gen_expression e1
|
|
|
+ | TBinop (OpNotEq, e1, { eexpr = TConst TNull }) ->
|
|
|
+ this#writeOpLine IaNotNull;
|
|
|
+ this#gen_expression e1
|
|
|
+ | TBinop (OpEq, { eexpr = TConst TNull }, e1) ->
|
|
|
+ this#writeOpLine IaIsNull;
|
|
|
+ this#gen_expression e1
|
|
|
+ | TBinop (OpNotEq, { eexpr = TConst TNull }, e1) ->
|
|
|
+ this#writeOpLine IaNotNull;
|
|
|
+ this#gen_expression e1
|
|
|
+ | TBinop (op, e1, e2) ->
|
|
|
+ this#writeOpLine (IaBinOp op);
|
|
|
+ this#gen_expression e1;
|
|
|
+ this#gen_expression e2
|
|
|
+ | TThrow e ->
|
|
|
+ this#writeOpLine IaThrow;
|
|
|
+ this#gen_expression e
|
|
|
+ | TArrayDecl expr_list ->
|
|
|
+ this#write
|
|
|
+ (this#op IaADef
|
|
|
+ ^ this#typeText expression.etype
|
|
|
+ ^ " "
|
|
|
+ ^ string_of_int (List.length expr_list)
|
|
|
+ ^ "\n");
|
|
|
+ List.iter this#gen_expression expr_list
|
|
|
+ | TIf (e, e1, e2) -> (
|
|
|
+ match e2 with
|
|
|
+ | None ->
|
|
|
+ this#writeOpLine IaIf;
|
|
|
+ this#gen_expression e;
|
|
|
+ this#gen_expression e1
|
|
|
+ | Some elze ->
|
|
|
+ this#writeOpLine IaIfElse;
|
|
|
+ this#gen_expression e;
|
|
|
+ this#gen_expression e1;
|
|
|
+ this#gen_expression elze)
|
|
|
+ | TCall (func, arg_list) -> (
|
|
|
+ let argN = string_of_int (List.length arg_list) ^ " " in
|
|
|
+ let gen_call () =
|
|
|
+ (match (remove_parens_cast func).eexpr with
|
|
|
+ | TField ({ eexpr = TIdent "__global__" }, field) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallGlobal
|
|
|
+ ^ this#stringText (field_name field)
|
|
|
+ ^ argN
|
|
|
+ ^ this#commentOf (field_name field)
|
|
|
+ ^ "\n")
|
|
|
+ | TField (obj, FStatic (class_def, field))
|
|
|
+ when is_real_function field ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallStatic ^ this#instText class_def ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ argN
|
|
|
+ ^ this#commentOf
|
|
|
+ (join_class_path class_def.cl_path "."
|
|
|
+ ^ "." ^ field.cf_name)
|
|
|
+ ^ "\n")
|
|
|
+ | TField (obj, FInstance (_, _, field))
|
|
|
+ when is_this obj && is_real_function field ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallThis ^ this#typeText obj.etype ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ argN
|
|
|
+ ^ this#commentOf field.cf_name
|
|
|
+ ^ "\n")
|
|
|
+ | TField (obj, FInstance (_, _, field)) when is_super obj ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallSuper ^ this#typeText obj.etype ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ argN
|
|
|
+ ^ this#commentOf field.cf_name
|
|
|
+ ^ "\n")
|
|
|
+ (* Cppia does not have a "GetEnumIndex" op code - must use IaCallMember ::hx::EnumBase.__Index *)
|
|
|
+ | TField (obj, FInstance (_, _, field))
|
|
|
+ when field.cf_name = "_hx_getIndex"
|
|
|
+ && script_type_string obj.etype = "::hx::EnumBase" ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallMember
|
|
|
+ ^ this#typeTextString "::hx::EnumBase"
|
|
|
+ ^ " " ^ this#stringText "__Index" ^ argN
|
|
|
+ ^ this#commentOf "Enum index"
|
|
|
+ ^ "\n");
|
|
|
+ this#gen_expression obj
|
|
|
+ | TField (obj, FInstance (_, _, field))
|
|
|
+ when field.cf_name = "__Index"
|
|
|
+ || (not (is_dynamic_in_cppia ctx obj))
|
|
|
+ && is_real_function field ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallMember ^ this#typeText obj.etype ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ argN
|
|
|
+ ^ this#commentOf field.cf_name
|
|
|
+ ^ "\n");
|
|
|
+ this#gen_expression obj
|
|
|
+ | TField (obj, FDynamic name)
|
|
|
+ when is_internal_member name
|
|
|
+ || (type_string obj.etype = "::String" && name = "cca") ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallMember ^ this#typeText obj.etype ^ " "
|
|
|
+ ^ this#stringText name ^ argN ^ this#commentOf name ^ "\n");
|
|
|
+ this#gen_expression obj
|
|
|
+ | TConst TSuper ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallSuperNew ^ this#typeText func.etype ^ " "
|
|
|
+ ^ argN ^ "\n")
|
|
|
+ | TField (_, FEnum (enum, field)) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCreateEnum ^ this#enumText enum ^ " "
|
|
|
+ ^ this#stringText field.ef_name
|
|
|
+ ^ argN
|
|
|
+ ^ this#commentOf field.ef_name
|
|
|
+ ^ "\n")
|
|
|
+ | _ ->
|
|
|
+ this#write (this#op IaCall ^ argN ^ "\n");
|
|
|
+ this#gen_expression func);
|
|
|
+ let matched_args =
|
|
|
+ match func.etype with
|
|
|
+ | TFun (args, _) -> (
|
|
|
+ try
|
|
|
+ List.iter2
|
|
|
+ (fun (_, _, protoT) arg ->
|
|
|
+ this#checkCast protoT arg false false)
|
|
|
+ args arg_list;
|
|
|
+ true
|
|
|
+ with Invalid_argument _ ->
|
|
|
+ (*print_endline "Bad count?";*) false)
|
|
|
+ | _ -> false
|
|
|
+ in
|
|
|
+ if not matched_args then List.iter this#gen_expression arg_list
|
|
|
+ in
|
|
|
+ match (remove_parens_cast func).eexpr with
|
|
|
+ | TField (obj, field)
|
|
|
+ when is_array_or_dyn_array obj.etype && field_name field = "map"
|
|
|
+ -> (
|
|
|
+ match this#get_array_type expression.etype with
|
|
|
+ | ArrayData t ->
|
|
|
+ this#write
|
|
|
+ (this#op IaToDataArray
|
|
|
+ ^ this#typeTextString ("Array." ^ t)
|
|
|
+ ^ "\n");
|
|
|
+ this#begin_expr;
|
|
|
+ this#writePos func;
|
|
|
+ gen_call ();
|
|
|
+ this#end_expr
|
|
|
+ | ArrayInterface t ->
|
|
|
+ this#write
|
|
|
+ (this#op IaToInterfaceArray ^ string_of_int t ^ "\n");
|
|
|
+ this#begin_expr;
|
|
|
+ this#writePos func;
|
|
|
+ gen_call ();
|
|
|
+ this#end_expr
|
|
|
+ | _ -> gen_call ())
|
|
|
+ | _ -> gen_call ())
|
|
|
+ | TField (obj, acc) -> (
|
|
|
+ let objType =
|
|
|
+ if is_dynamic_in_cppia ctx obj then "Dynamic"
|
|
|
+ else script_type_string obj.etype
|
|
|
+ in
|
|
|
+ let typeText =
|
|
|
+ if is_dynamic_in_cppia ctx obj then this#typeTextString "Dynamic"
|
|
|
+ else this#typeText obj.etype
|
|
|
+ in
|
|
|
+ match acc with
|
|
|
+ | FDynamic name ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFName ^ typeText ^ " " ^ this#stringText name
|
|
|
+ ^ this#commentOf name ^ "\n");
|
|
|
+ this#gen_expression obj
|
|
|
+ | FStatic (class_def, field) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFStatic ^ this#instText class_def ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ this#commentOf field.cf_name)
|
|
|
+ | FInstance (_, _, field) when is_this obj ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFThisInst ^ typeText ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ this#commentOf field.cf_name)
|
|
|
+ | FInstance (_, _, field) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFLink ^ typeText ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ this#commentOf (objType ^ "." ^ field.cf_name)
|
|
|
+ ^ "\n");
|
|
|
+ this#gen_expression obj
|
|
|
+ | FClosure (_, field) when is_this obj ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFThisName ^ typeText ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ "\n")
|
|
|
+ | FAnon field when is_this obj ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFThisName ^ typeText ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ this#commentOf field.cf_name
|
|
|
+ ^ "\n")
|
|
|
+ | FClosure (_, field) | FAnon field ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFName ^ typeText ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ this#commentOf field.cf_name
|
|
|
+ ^ "\n");
|
|
|
+ this#gen_expression obj
|
|
|
+ | FEnum (enum, field) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFEnum ^ this#enumText enum ^ " "
|
|
|
+ ^ this#stringText field.ef_name
|
|
|
+ ^ this#commentOf field.ef_name))
|
|
|
+ | TArray (e1, e2) ->
|
|
|
+ this#write (this#op IaArrayI ^ this#typeText e1.etype ^ "\n");
|
|
|
+ this#gen_expression e1;
|
|
|
+ this#gen_expression e2
|
|
|
+ | TUnop (op, flag, e) ->
|
|
|
+ this#writeOpLine
|
|
|
+ (match (op, flag) with
|
|
|
+ | Increment, Prefix -> IaPlusPlus
|
|
|
+ | Increment, _ -> IaPlusPlusPost
|
|
|
+ | Decrement, Prefix -> IaMinusMinus
|
|
|
+ | Decrement, _ -> IaMinusMinusPost
|
|
|
+ | Not, _ -> IaLogicNot
|
|
|
+ | Neg, _ -> IaNeg
|
|
|
+ | Spread, _ -> die ~p:e.epos "Unexpected spread operator" __LOC__
|
|
|
+ | NegBits, _ -> IaBitNot);
|
|
|
+ this#gen_expression e
|
|
|
+ (* TODO - lval op-assign local/member/array *)
|
|
|
+ | TLocal var ->
|
|
|
+ this#write
|
|
|
+ (this#op IaVar ^ string_of_int var.v_id ^ this#commentOf var.v_name)
|
|
|
+ | TVar (tvar, optional_init) -> (
|
|
|
+ this#write
|
|
|
+ (this#op IaTVars ^ string_of_int 1
|
|
|
+ ^ this#commentOf (tvar.v_name ^ ":" ^ script_type_string tvar.v_type)
|
|
|
+ ^ "\n");
|
|
|
+ this#write ("\t\t" ^ indent);
|
|
|
+ match optional_init with
|
|
|
+ | None ->
|
|
|
+ this#writeOp IaVarDecl;
|
|
|
+ this#writeVar tvar
|
|
|
+ | Some init ->
|
|
|
+ this#writeOp IaVarDeclI;
|
|
|
+ let init = remove_parens init in
|
|
|
+ this#writeVar tvar;
|
|
|
+ this#write (" " ^ this#typeText init.etype);
|
|
|
+ this#write "\n";
|
|
|
+ this#checkCast tvar.v_type init false false)
|
|
|
+ | TNew (clazz, params, arg_list) -> (
|
|
|
+ this#write
|
|
|
+ (this#op IaNew
|
|
|
+ ^ this#typeText (TInst (clazz, params))
|
|
|
+ ^ string_of_int (List.length arg_list)
|
|
|
+ ^ "\n");
|
|
|
+ try
|
|
|
+ match
|
|
|
+ OverloadResolution.maybe_resolve_constructor_overload clazz params
|
|
|
+ arg_list
|
|
|
+ with
|
|
|
+ | Some (_, { cf_type = TFun (args, _) }, _) ->
|
|
|
+ List.iter2
|
|
|
+ (fun (_, _, protoT) arg ->
|
|
|
+ this#checkCast protoT arg false false)
|
|
|
+ args arg_list
|
|
|
+ | _ -> raise (Invalid_argument "")
|
|
|
+ with Invalid_argument _ -> List.iter this#gen_expression arg_list)
|
|
|
+ | TReturn optval -> (
|
|
|
+ match optval with
|
|
|
+ | None -> this#writeOpLine IaReturn
|
|
|
+ | Some value ->
|
|
|
+ this#write (this#op IaRetVal ^ this#typeText value.etype ^ "\n");
|
|
|
+ this#checkCast return_type value false false)
|
|
|
+ | TObjectDecl
|
|
|
+ [
|
|
|
+ (("fileName", _, _), { eexpr = TConst (TString file) });
|
|
|
+ (("lineNumber", _, _), { eexpr = TConst (TInt line) });
|
|
|
+ (("className", _, _), { eexpr = TConst (TString class_name) });
|
|
|
+ (("methodName", _, _), { eexpr = TConst (TString meth) });
|
|
|
+ ] ->
|
|
|
+ this#write
|
|
|
+ (this#op IaPosInfo ^ this#stringText file
|
|
|
+ ^ Printf.sprintf "%ld" line ^ " " ^ this#stringText class_name ^ " "
|
|
|
+ ^ this#stringText meth)
|
|
|
+ | TObjectDecl values ->
|
|
|
+ this#write (this#op IaObjDef ^ string_of_int (List.length values));
|
|
|
+ this#write " ";
|
|
|
+ List.iter
|
|
|
+ (fun ((name, _, _), _) -> this#write (this#stringText name))
|
|
|
+ values;
|
|
|
+ this#write "\n";
|
|
|
+ List.iter (fun (_, e) -> this#gen_expression e) values
|
|
|
+ | TTypeExpr type_expr ->
|
|
|
+ let klass = "::" ^ join_class_path (t_path type_expr) "::" in
|
|
|
+ this#write (this#op IaClassOf ^ string_of_int (this#typeId klass))
|
|
|
+ | TWhile (e1, e2, flag) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaWhile ^ (if flag = NormalWhile then "1" else "0") ^ "\n");
|
|
|
+ this#gen_expression e1;
|
|
|
+ this#gen_expression e2
|
|
|
+ | TFor (tvar, init, loop) ->
|
|
|
+ this#writeOp IaFor;
|
|
|
+ this#writeVar tvar;
|
|
|
+ this#write "\n";
|
|
|
+ this#gen_expression init;
|
|
|
+ this#gen_expression loop
|
|
|
+ | TEnumParameter (expr, ef, i) ->
|
|
|
+ let enum =
|
|
|
+ match follow ef.ef_type with
|
|
|
+ | TEnum (en, _) | TFun (_, TEnum (en, _)) -> en
|
|
|
+ | _ -> die "" __LOC__
|
|
|
+ in
|
|
|
+ this#write
|
|
|
+ (this#op IaEnumI
|
|
|
+ ^ this#typeText (TEnum (enum, []))
|
|
|
+ ^ string_of_int i ^ "\n");
|
|
|
+ this#gen_expression expr
|
|
|
+ | TEnumIndex expr ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallMember
|
|
|
+ ^ this#typeTextString "::hx::EnumBase"
|
|
|
+ ^ " " ^ this#stringText "__Index" ^ "0"
|
|
|
+ ^ this#commentOf "Enum index"
|
|
|
+ ^ "\n");
|
|
|
+ this#gen_expression expr
|
|
|
+ | TSwitch
|
|
|
+ {
|
|
|
+ switch_subject = condition;
|
|
|
+ switch_cases = cases;
|
|
|
+ switch_default = optional_default;
|
|
|
+ } -> (
|
|
|
+ this#write
|
|
|
+ (this#op IaSwitch
|
|
|
+ ^ string_of_int (List.length cases)
|
|
|
+ ^ " "
|
|
|
+ ^ (match optional_default with None -> "0" | Some _ -> "1")
|
|
|
+ ^ "\n");
|
|
|
+ this#gen_expression condition;
|
|
|
+ List.iter
|
|
|
+ (fun { case_patterns = cases_list; case_expr = expression } ->
|
|
|
+ this#writeList ("\t\t\t" ^ indent) (List.length cases_list);
|
|
|
+ List.iter (fun value -> this#gen_expression value) cases_list;
|
|
|
+ this#gen_expression expression)
|
|
|
+ cases;
|
|
|
+ match optional_default with
|
|
|
+ | None -> ()
|
|
|
+ | Some expr -> this#gen_expression expr)
|
|
|
+ | TTry (e, catches) ->
|
|
|
+ this#writeList (this#op IaTry) (List.length catches);
|
|
|
+ this#gen_expression e;
|
|
|
+ List.iter
|
|
|
+ (fun (tvar, catch_expr) ->
|
|
|
+ this#write ("\t\t\t" ^ indent);
|
|
|
+ this#writeVar tvar;
|
|
|
+ this#write "\n";
|
|
|
+ this#gen_expression catch_expr)
|
|
|
+ catches
|
|
|
+ | TCast (cast, Some (TClassDecl t)) ->
|
|
|
+ this#write (this#op IaTCast ^ this#typeText (TInst (t, [])) ^ "\n");
|
|
|
+ this#gen_expression cast
|
|
|
+ | TCast (cast, _) -> this#checkCast expression.etype cast true true
|
|
|
+ | TParenthesis _ -> abort "Unexpected parens" expression.epos
|
|
|
+ | TMeta (_, _) -> abort "Unexpected meta" expression.epos
|
|
|
+ | TIdent _ -> abort "Unexpected ident" expression.epos
|
|
|
+
|
|
|
+ (* } *)
|
|
|
+ method gen_expression_tree expression_tree =
|
|
|
+ (* { *)
|
|
|
+ let rec gen_expression expression =
|
|
|
+ this#begin_expr;
|
|
|
+ this#writeCppPos expression;
|
|
|
+ let rec match_expr expression =
|
|
|
+ match expression.cppexpr with
|
|
|
+ | CppBlock (exprs, closures, _) ->
|
|
|
+ this#writeList (this#op IaBlock) (List.length exprs);
|
|
|
+ List.iter gen_expression exprs
|
|
|
+ | CppVarDecl (var, init) -> (
|
|
|
+ let name = CppGen.cpp_var_name_of var in
|
|
|
+ this#write
|
|
|
+ (this#op IaTVars ^ string_of_int 1
|
|
|
+ ^ this#commentOf (name ^ ":" ^ script_type_string var.v_type)
|
|
|
+ ^ "\n");
|
|
|
+ this#write ("\t\t" ^ indent);
|
|
|
+ match init with
|
|
|
+ | None ->
|
|
|
+ this#writeOp IaVarDecl;
|
|
|
+ this#writeVar var
|
|
|
+ | Some init ->
|
|
|
+ this#writeOp IaVarDeclI;
|
|
|
+ this#writeVar var;
|
|
|
+ this#write (" " ^ this#astType init.cpptype);
|
|
|
+ this#write "\n";
|
|
|
+ gen_expression init)
|
|
|
+ | CppInt i -> this#write (this#op IaConstInt ^ Printf.sprintf "%ld " i)
|
|
|
+ | CppFloat float_as_string ->
|
|
|
+ this#write (this#op IaConstFloat ^ this#stringText float_as_string)
|
|
|
+ | CppString s -> this#write (this#op IaConstString ^ this#stringText s)
|
|
|
+ | CppBool false -> this#writeOp IaConstFalse
|
|
|
+ | CppBool true -> this#writeOp IaConstTrue
|
|
|
+ | CppNull -> this#writeOp IaConstNull
|
|
|
+ | CppNil -> abort "Nil not supported in cppia" expression.cpppos
|
|
|
+ | CppThis _ -> this#writeOp IaConsThis
|
|
|
+ | CppSuper _ -> this#writeOp IaConstSuper
|
|
|
+ | CppBreak -> this#writeOp IaBreak
|
|
|
+ | CppContinue -> this#writeOp IaContinue
|
|
|
+ | CppGoto label ->
|
|
|
+ abort "Goto not supported in cppia" expression.cpppos
|
|
|
+ | CppReturn None -> this#writeOpLine IaReturn
|
|
|
+ | CppReturn (Some value) ->
|
|
|
+ this#write (this#op IaRetVal ^ this#astType value.cpptype ^ "\n");
|
|
|
+ gen_expression value
|
|
|
+ | CppWhile (condition, block, while_flag, _) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaWhile
|
|
|
+ ^ (if while_flag = NormalWhile then "1" else "0")
|
|
|
+ ^ "\n");
|
|
|
+ gen_expression condition;
|
|
|
+ gen_expression block
|
|
|
+ | CppIf (condition, block, None) ->
|
|
|
+ this#writeOpLine IaIf;
|
|
|
+ gen_expression condition;
|
|
|
+ gen_expression block
|
|
|
+ | CppIf (condition, block, Some elze) ->
|
|
|
+ this#writeOpLine IaIfElse;
|
|
|
+ gen_expression condition;
|
|
|
+ gen_expression block;
|
|
|
+ gen_expression elze
|
|
|
+ | CppBinop (op, left, right) ->
|
|
|
+ this#writeOpLine (IaBinOp op);
|
|
|
+ gen_expression left;
|
|
|
+ gen_expression right
|
|
|
+ | CppVar var -> gen_var_loc var
|
|
|
+ | CppExtern (name, _) ->
|
|
|
+ abort
|
|
|
+ ("Unexpected global '" ^ name ^ "' in cppia")
|
|
|
+ expression.cpppos
|
|
|
+ | CppSet (lvalue, rvalue) ->
|
|
|
+ this#writeOpLine IaSet;
|
|
|
+ gen_lvalue lvalue expression.cpppos;
|
|
|
+ gen_expression rvalue
|
|
|
+ | CppCall (func, args) ->
|
|
|
+ let argN = string_of_int (List.length args) ^ " " in
|
|
|
+ (match func with
|
|
|
+ | FuncThis (field, inst) ->
|
|
|
+ let name = field.cf_name in
|
|
|
+ this#write
|
|
|
+ (this#op IaCallThis ^ this#astType inst ^ " "
|
|
|
+ ^ this#stringText name ^ argN ^ this#commentOf name ^ "\n")
|
|
|
+ | FuncInstance (expr, _, field) | FuncInterface (expr, _, field)
|
|
|
+ ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallMember ^ this#astType expr.cpptype ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ argN
|
|
|
+ ^ this#commentOf field.cf_name
|
|
|
+ ^ "\n");
|
|
|
+ gen_expression expr
|
|
|
+ | FuncStatic (class_def, _, field) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallStatic ^ this#cppInstText class_def ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ argN
|
|
|
+ ^ this#commentOf
|
|
|
+ (join_class_path class_def.cl_path "."
|
|
|
+ ^ "." ^ field.cf_name)
|
|
|
+ ^ "\n")
|
|
|
+ | FuncTemplate _ ->
|
|
|
+ abort "Templated function call not supported in cppia"
|
|
|
+ expression.cpppos
|
|
|
+ | FuncFromStaticFunction ->
|
|
|
+ abort "Unexpected FuncFromStaticFunction" expression.cpppos
|
|
|
+ | FuncEnumConstruct (enum, field) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCreateEnum ^ this#enumText enum ^ " "
|
|
|
+ ^ this#stringText field.ef_name
|
|
|
+ ^ argN
|
|
|
+ ^ this#commentOf field.ef_name
|
|
|
+ ^ "\n")
|
|
|
+ | FuncSuperConstruct (TCppInst (klass, _))
|
|
|
+ when is_native_gen_class klass && is_native_class klass ->
|
|
|
+ abort "Unsupported super for native class constructor"
|
|
|
+ expression.cpppos
|
|
|
+ | FuncSuperConstruct childType ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallSuperNew ^ this#astType childType ^ " "
|
|
|
+ ^ argN ^ "\n")
|
|
|
+ | FuncSuper (_, TCppInst (klass, _), _)
|
|
|
+ when is_native_gen_class klass && is_native_class klass ->
|
|
|
+ abort "Unsupported super for native class method"
|
|
|
+ expression.cpppos
|
|
|
+ | FuncSuper (_, objType, field) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallSuper ^ this#astType objType ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ argN
|
|
|
+ ^ this#commentOf field.cf_name
|
|
|
+ ^ "\n")
|
|
|
+ | FuncExtern (name, _) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallGlobal ^ this#stringText name ^ argN
|
|
|
+ ^ this#commentOf name ^ "\n")
|
|
|
+ | FuncNew newType ->
|
|
|
+ this#write (this#op IaNew ^ this#astType newType ^ argN ^ "\n")
|
|
|
+ | FuncInternal (obj, "cca", ".") when obj.cpptype = TCppString ->
|
|
|
+ this#write
|
|
|
+ (this#op IaCallMember ^ this#astType obj.cpptype ^ " "
|
|
|
+ ^ this#stringText "cca" ^ argN ^ this#commentOf "cca" ^ "\n"
|
|
|
+ );
|
|
|
+ gen_expression obj
|
|
|
+ | FuncInternal (obj, name, join) ->
|
|
|
+ (* abort ("Internal function call '" ^ name ^ "' not supported in cppia") expression.cpppos; *)
|
|
|
+ this#write
|
|
|
+ (this#op IaCallMember ^ this#astType obj.cpptype ^ " "
|
|
|
+ ^ this#stringText name ^ argN ^ this#commentOf name ^ "\n");
|
|
|
+ gen_expression obj
|
|
|
+ | FuncExpression expr ->
|
|
|
+ this#write (this#op IaCall ^ argN ^ "\n");
|
|
|
+ gen_expression expr);
|
|
|
+ List.iter gen_expression args
|
|
|
+ | CppFunction (func, _) -> (
|
|
|
+ match func with
|
|
|
+ | FuncThis (field, inst) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFThisName ^ this#astType inst ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ this#commentOf
|
|
|
+ (script_cpptype_string inst ^ "." ^ field.cf_name))
|
|
|
+ | FuncInternal (expr, name, _) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFLink ^ this#astType expr.cpptype ^ " "
|
|
|
+ ^ this#stringText name
|
|
|
+ ^ this#commentOf
|
|
|
+ ("Internal "
|
|
|
+ ^ script_cpptype_string expr.cpptype
|
|
|
+ ^ "." ^ name)
|
|
|
+ ^ "\n");
|
|
|
+ gen_expression expr
|
|
|
+ | FuncInstance (expr, _, field) | FuncInterface (expr, _, field)
|
|
|
+ ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFName ^ this#astType expr.cpptype ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ this#commentOf
|
|
|
+ (script_cpptype_string expr.cpptype
|
|
|
+ ^ "." ^ field.cf_name)
|
|
|
+ ^ "\n");
|
|
|
+ gen_expression expr
|
|
|
+ | FuncStatic (class_def, _, field) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFStatic ^ this#cppInstText class_def ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ this#commentOf field.cf_name)
|
|
|
+ | FuncExpression expr -> match_expr expr
|
|
|
+ | FuncExtern (name, _) ->
|
|
|
+ abort
|
|
|
+ ("Can't create extern " ^ name ^ " closure")
|
|
|
+ expression.cpppos
|
|
|
+ | FuncSuper _ | FuncSuperConstruct _ ->
|
|
|
+ abort "Can't create super closure" expression.cpppos
|
|
|
+ | FuncNew _ -> abort "Can't create new closure" expression.cpppos
|
|
|
+ | FuncEnumConstruct _ ->
|
|
|
+ abort "Enum constructor outside of CppCall" expression.cpppos
|
|
|
+ | FuncFromStaticFunction ->
|
|
|
+ abort "Can't create cpp.Function.fromStaticFunction closure"
|
|
|
+ expression.cpppos
|
|
|
+ | FuncTemplate _ ->
|
|
|
+ abort "Can't create template function closure"
|
|
|
+ expression.cpppos)
|
|
|
+ | CppPosition (file, line, class_name, meth) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaPosInfo ^ this#stringText file
|
|
|
+ ^ Printf.sprintf "%ld" line ^ " " ^ this#stringText class_name
|
|
|
+ ^ " " ^ this#stringText meth)
|
|
|
+ | CppNullCompare ("IsNull", e) ->
|
|
|
+ this#writeOpLine IaIsNull;
|
|
|
+ gen_expression e
|
|
|
+ | CppNullCompare (_, e) ->
|
|
|
+ this#writeOpLine IaNotNull;
|
|
|
+ gen_expression e
|
|
|
+ | CppCompare (_, left, right, op) ->
|
|
|
+ this#writeOpLine (IaBinOp op);
|
|
|
+ gen_expression left;
|
|
|
+ gen_expression right
|
|
|
+ | CppArray arrayLoc -> gen_array arrayLoc expression.cpppos
|
|
|
+ | CppArrayDecl exprList ->
|
|
|
+ this#write
|
|
|
+ (this#op IaADef
|
|
|
+ ^ this#astType expression.cpptype
|
|
|
+ ^ " "
|
|
|
+ ^ string_of_int (List.length exprList)
|
|
|
+ ^ "\n");
|
|
|
+ List.iter gen_expression exprList
|
|
|
+ | CppEnumField (enum, field) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFEnum ^ this#enumText enum ^ " "
|
|
|
+ ^ this#stringText field.ef_name
|
|
|
+ ^ this#commentOf field.ef_name)
|
|
|
+ | CppEnumIndex obj ->
|
|
|
+ (* Cppia does not have a "GetEnumIndex" op code - must use IaCallMember ::hx::EnumBase.__Index *)
|
|
|
+ this#write
|
|
|
+ (this#op IaCallMember
|
|
|
+ ^ this#typeTextString "::hx::EnumBase"
|
|
|
+ ^ " " ^ this#stringText "__Index" ^ "0"
|
|
|
+ ^ this#commentOf "Enum index"
|
|
|
+ ^ "\n");
|
|
|
+ gen_expression obj
|
|
|
+ | CppDynamicField (obj, name) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFName
|
|
|
+ ^ this#typeTextString "Dynamic"
|
|
|
+ ^ " " ^ this#stringText name ^ this#commentOf name ^ "\n");
|
|
|
+ gen_expression obj
|
|
|
+ | CppClassOf (path, native) ->
|
|
|
+ let klass = join_class_path path "." in
|
|
|
+ this#write
|
|
|
+ (this#op IaClassOf ^ this#typeTextString klass
|
|
|
+ ^ this#commentOf klass)
|
|
|
+ | CppEnumParameter (obj, field, index) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaEnumI
|
|
|
+ ^ this#typeTextString "Dynamic"
|
|
|
+ ^ string_of_int index ^ "\n");
|
|
|
+ gen_expression obj
|
|
|
+ | CppClosure closure ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFun
|
|
|
+ ^ this#astType closure.close_type
|
|
|
+ ^ string_of_int (List.length closure.close_args)
|
|
|
+ ^ "\n");
|
|
|
+ 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 " ";
|
|
|
+ List.iter
|
|
|
+ (fun (name, _) -> this#write (this#stringText name))
|
|
|
+ values;
|
|
|
+ this#write "\n";
|
|
|
+ List.iter (fun (_, e) -> gen_expression e) values
|
|
|
+ | CppCrement (incFlag, preFlag, lvalue) ->
|
|
|
+ let op =
|
|
|
+ match (incFlag, preFlag) with
|
|
|
+ | CppIncrement, Prefix -> IaPlusPlus
|
|
|
+ | CppIncrement, Postfix -> IaPlusPlusPost
|
|
|
+ | CppDecrement, Prefix -> IaMinusMinus
|
|
|
+ | CppDecrement, Postfix -> IaMinusMinusPost
|
|
|
+ in
|
|
|
+ this#writeOpLine op;
|
|
|
+ gen_lvalue lvalue expression.cpppos
|
|
|
+ | CppModify (op, lvalue, rvalue) ->
|
|
|
+ this#writeOpLine (IaBinOp (OpAssignOp op));
|
|
|
+ gen_lvalue lvalue expression.cpppos;
|
|
|
+ gen_expression rvalue
|
|
|
+ | CppUnop (op, expr) ->
|
|
|
+ let op =
|
|
|
+ match op with
|
|
|
+ | CppNot -> IaLogicNot
|
|
|
+ | CppNeg -> IaNeg
|
|
|
+ | CppNegBits -> IaBitNot
|
|
|
+ in
|
|
|
+ this#writeOpLine op;
|
|
|
+ gen_expression expr
|
|
|
+ | CppThrow value ->
|
|
|
+ this#writeOpLine IaThrow;
|
|
|
+ gen_expression value
|
|
|
+ | CppTry (block, catches) ->
|
|
|
+ this#writeList (this#op IaTry) (List.length catches);
|
|
|
+ gen_expression block;
|
|
|
+ List.iter
|
|
|
+ (fun (tvar, catch_expr) ->
|
|
|
+ this#write ("\t\t\t" ^ indent);
|
|
|
+ this#writeVar tvar;
|
|
|
+ this#write "\n";
|
|
|
+ gen_expression catch_expr)
|
|
|
+ catches
|
|
|
+ | CppIntSwitch _ ->
|
|
|
+ abort "CppIntSwitch not supported in cppia" expression.cpppos
|
|
|
+ | CppSwitch (condition, _, cases, optional_default, _) -> (
|
|
|
+ this#write
|
|
|
+ (this#op IaSwitch
|
|
|
+ ^ string_of_int (List.length cases)
|
|
|
+ ^ " "
|
|
|
+ ^ (match optional_default with None -> "0" | Some _ -> "1")
|
|
|
+ ^ "\n");
|
|
|
+ gen_expression condition;
|
|
|
+ List.iter
|
|
|
+ (fun (cases_list, expression) ->
|
|
|
+ this#writeList ("\t\t\t" ^ indent) (List.length cases_list);
|
|
|
+ List.iter (fun value -> gen_expression value) cases_list;
|
|
|
+ gen_expression expression)
|
|
|
+ cases;
|
|
|
+ match optional_default with
|
|
|
+ | None -> ()
|
|
|
+ | Some expr -> gen_expression expr)
|
|
|
+ | CppTCast (expr, toType) ->
|
|
|
+ this#write (this#op IaTCast ^ this#astType toType ^ "\n");
|
|
|
+ gen_expression expr
|
|
|
+ | CppCast (expr, toType) -> (
|
|
|
+ match toType with
|
|
|
+ | TCppDynamicArray ->
|
|
|
+ this#write (this#op IaToDynArray ^ "\n");
|
|
|
+ gen_expression expr
|
|
|
+ | TCppObjectArray _ ->
|
|
|
+ this#write
|
|
|
+ (this#op IaToDataArray
|
|
|
+ ^ this#typeTextString "Array.Object"
|
|
|
+ ^ "\n");
|
|
|
+ gen_expression expr
|
|
|
+ | TCppScalarArray t ->
|
|
|
+ this#write
|
|
|
+ (this#op IaToDataArray
|
|
|
+ ^ this#typeTextString ("Array." ^ script_cpptype_string t)
|
|
|
+ ^ "\n");
|
|
|
+ gen_expression expr
|
|
|
+ | _ -> match_expr expr)
|
|
|
+ | CppCastScalar (expr, "bool") ->
|
|
|
+ this#writeOpLine IaCastBool;
|
|
|
+ gen_expression expr
|
|
|
+ | CppCastScalar (expr, "int") ->
|
|
|
+ this#writeOpLine IaCastInt;
|
|
|
+ gen_expression expr
|
|
|
+ | CppCastScalar (expr, "Float") ->
|
|
|
+ this#write
|
|
|
+ (this#op IaTCast ^ this#astType (TCppScalar "Float") ^ "\n");
|
|
|
+ gen_expression expr
|
|
|
+ | CppCastScalar (expr, _) -> match_expr expr
|
|
|
+ | CppCastVariant expr -> match_expr expr
|
|
|
+ | CppCastStatic (expr, _) -> match_expr expr
|
|
|
+ | CppNullAccess ->
|
|
|
+ this#writeOpLine IaThrow;
|
|
|
+ this#begin_expr;
|
|
|
+ this#writeCppPos expression;
|
|
|
+ this#write (this#op IaConstString ^ this#stringText "Null access");
|
|
|
+ this#end_expr
|
|
|
+ | CppCode _ | CppFunctionAddress _ | CppNewNative _ | CppDereference _
|
|
|
+ | CppAddressOf _ | CppFor _ | CppCastObjC _ | CppCastObjCBlock _
|
|
|
+ | CppCastProtocol _ | CppCastNative _ ->
|
|
|
+ abort
|
|
|
+ ("Unsupported operation in cppia :" ^ s_tcpp expression.cppexpr)
|
|
|
+ expression.cpppos
|
|
|
+ (*| x -> print_endline ("Unknown cppexpr " ^ (s_tcpp x) );*)
|
|
|
+ in
|
|
|
+
|
|
|
+ match_expr expression;
|
|
|
+ this#end_expr
|
|
|
+ and gen_array arrayLoc pos =
|
|
|
+ match arrayLoc with
|
|
|
+ | ArrayObject (arrayObj, index, _) | ArrayTyped (arrayObj, index, _) ->
|
|
|
+ this#write (this#op IaArrayI ^ this#astType arrayObj.cpptype ^ "\n");
|
|
|
+ gen_expression arrayObj;
|
|
|
+ gen_expression index
|
|
|
+ | ArrayPointer (_, _) | ArrayRawPointer (_, _) ->
|
|
|
+ abort "Unvalid array access in cppia" pos
|
|
|
+ | ArrayVirtual (arrayObj, index)
|
|
|
+ | ArrayImplements (_, arrayObj, index)
|
|
|
+ | ArrayDynamic (arrayObj, index) ->
|
|
|
+ this#write (this#op IaArrayI ^ this#astType arrayObj.cpptype ^ "\n");
|
|
|
+ gen_expression arrayObj;
|
|
|
+ gen_expression index
|
|
|
+ and gen_lvalue lvalue pos =
|
|
|
+ this#begin_expr;
|
|
|
+ this#wpos pos;
|
|
|
+ (match lvalue with
|
|
|
+ | CppVarRef varLoc -> gen_var_loc varLoc
|
|
|
+ | CppArrayRef arrayLoc -> gen_array arrayLoc pos
|
|
|
+ | CppExternRef (name, _) ->
|
|
|
+ abort ("Unsupported extern '" ^ name ^ "' in cppia") pos
|
|
|
+ | CppDynamicRef (expr, name) ->
|
|
|
+ let typeText = this#typeTextString "Dynamic" in
|
|
|
+ this#write
|
|
|
+ (this#op IaFName ^ typeText ^ " " ^ this#stringText name
|
|
|
+ ^ this#commentOf name ^ "\n");
|
|
|
+ gen_expression expr);
|
|
|
+ this#end_expr
|
|
|
+ and gen_var_loc loc =
|
|
|
+ match loc with
|
|
|
+ | VarClosure var | VarLocal var ->
|
|
|
+ this#write
|
|
|
+ (this#op IaVar ^ string_of_int var.v_id
|
|
|
+ ^ this#commentOf var.v_name)
|
|
|
+ | VarStatic (class_def, _, field) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFStatic ^ this#cppInstText class_def ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ this#commentOf field.cf_name)
|
|
|
+ | VarThis (field, thisType) ->
|
|
|
+ this#write
|
|
|
+ (this#op IaFThisInst ^ this#astType thisType ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ this#commentOf field.cf_name)
|
|
|
+ | VarInstance (obj, field, _, _) | VarInterface (obj, field) ->
|
|
|
+ let objType = script_cpptype_string obj.cpptype in
|
|
|
+ this#write
|
|
|
+ (this#op IaFLink ^ this#astType obj.cpptype ^ " "
|
|
|
+ ^ this#stringText field.cf_name
|
|
|
+ ^ this#commentOf (objType ^ "." ^ field.cf_name)
|
|
|
+ ^ "\n");
|
|
|
+ gen_expression obj
|
|
|
+ | VarInternal (obj, _, name) ->
|
|
|
+ let objType = script_cpptype_string obj.cpptype in
|
|
|
+ this#write
|
|
|
+ (this#op IaFLink ^ this#astType obj.cpptype ^ " "
|
|
|
+ ^ this#stringText name
|
|
|
+ ^ this#commentOf (objType ^ "." ^ name)
|
|
|
+ ^ "\n");
|
|
|
+ gen_expression obj
|
|
|
+ (*
|
|
|
+ and get_array_type elem =
|
|
|
+ this#stringText (script_cpptype_string elem.cpptype);
|
|
|
+ *)
|
|
|
+ in
|
|
|
+ gen_expression expression_tree
|
|
|
+ end
|
|
|
+
|
|
|
+let generate_script_class common_ctx script class_def =
|
|
|
+ script#incClasses;
|
|
|
+ let classText = join_class_path class_def.cl_path "." in
|
|
|
+ script#comment ("Class " ^ classText);
|
|
|
+ script#writeOp
|
|
|
+ (if has_class_flag class_def CInterface then IaInterface else IaClass);
|
|
|
+ script#instName class_def;
|
|
|
+ (match class_def.cl_super with
|
|
|
+ | None -> script#ident ""
|
|
|
+ | Some (c, _) -> script#instName c);
|
|
|
+ script#wint (List.length class_def.cl_implements);
|
|
|
+ List.iter (fun (c, _) -> script#instName c) class_def.cl_implements;
|
|
|
+ script#write "\n";
|
|
|
+ (* Looks like some map impl classes have their bodies discarded - not sure best way to filter *)
|
|
|
+ let non_dodgy_function allow_empty field =
|
|
|
+ has_class_flag class_def CInterface
|
|
|
+ ||
|
|
|
+ match (field.cf_kind, field.cf_expr) with
|
|
|
+ | Var _, _ -> true
|
|
|
+ | Method MethDynamic, _ -> true
|
|
|
+ | Method MethNormal, None when allow_empty -> true
|
|
|
+ | Method _, Some _ -> true
|
|
|
+ | _ -> false
|
|
|
+ in
|
|
|
+ let ordered_statics =
|
|
|
+ List.filter (non_dodgy_function false) class_def.cl_ordered_statics
|
|
|
+ in
|
|
|
+ let ordered_fields =
|
|
|
+ List.filter (non_dodgy_function true) class_def.cl_ordered_fields
|
|
|
+ in
|
|
|
+ script#write
|
|
|
+ (string_of_int
|
|
|
+ (List.length ordered_fields
|
|
|
+ + List.length ordered_statics
|
|
|
+ + (match class_def.cl_constructor with Some _ -> 1 | _ -> 0)
|
|
|
+ + match TClass.get_cl_init class_def with Some _ -> 1 | _ -> 0)
|
|
|
+ ^ "\n");
|
|
|
+
|
|
|
+ let generate_field isStatic field =
|
|
|
+ match (field.cf_kind, follow field.cf_type) with
|
|
|
+ | Var { v_read = AccInline; v_write = AccNever }, _ ->
|
|
|
+ script#writeOpLine IaInline
|
|
|
+ | Var v, _ ->
|
|
|
+ let mode_code mode =
|
|
|
+ match mode with
|
|
|
+ | AccNormal | AccCtor -> IaAccessNormal
|
|
|
+ | AccNo -> IaAccessNot
|
|
|
+ | AccNever -> IaAccessNot
|
|
|
+ | AccCall ->
|
|
|
+ if
|
|
|
+ Meta.has Meta.NativeProperty class_def.cl_meta
|
|
|
+ || Meta.has Meta.NativeProperty field.cf_meta
|
|
|
+ || Gctx.defined common_ctx Define.ForceNativeProperty
|
|
|
+ then IaAccessCallNative
|
|
|
+ else IaAccessCall
|
|
|
+ | AccInline -> IaAccessNormal
|
|
|
+ | AccRequire (_, _) -> IaAccessNormal
|
|
|
+ in
|
|
|
+ let isExtern = not (is_physical_field field) in
|
|
|
+ script#var (mode_code v.v_read) (mode_code v.v_write) isExtern isStatic
|
|
|
+ field.cf_name field.cf_type field.cf_expr
|
|
|
+ | Method MethDynamic, TFun (args, ret) ->
|
|
|
+ script#func isStatic true field.cf_name ret args
|
|
|
+ (has_class_flag class_def CInterface)
|
|
|
+ field.cf_expr field.cf_pos
|
|
|
+ | Method _, TFun (args, ret) when field.cf_name = "new" ->
|
|
|
+ script#func true false "new"
|
|
|
+ (TInst (class_def, []))
|
|
|
+ args false field.cf_expr field.cf_pos
|
|
|
+ | Method _, TFun (args, ret) ->
|
|
|
+ script#func isStatic false field.cf_name ret args
|
|
|
+ (has_class_flag class_def CInterface)
|
|
|
+ field.cf_expr field.cf_pos
|
|
|
+ | Method _, _ ->
|
|
|
+ print_endline
|
|
|
+ ("Unknown method type "
|
|
|
+ ^ join_class_path class_def.cl_path "."
|
|
|
+ ^ "." ^ field.cf_name)
|
|
|
+ in
|
|
|
+ (match class_def.cl_constructor with
|
|
|
+ | Some field -> generate_field true field
|
|
|
+ | _ -> ());
|
|
|
+ (match TClass.get_cl_init class_def with
|
|
|
+ | Some expression -> script#voidFunc true false "__init__" expression
|
|
|
+ | _ -> ());
|
|
|
+
|
|
|
+ List.iter (generate_field false) ordered_fields;
|
|
|
+ List.iter (generate_field true) ordered_statics;
|
|
|
+ script#write "\n"
|
|
|
+
|
|
|
+let generate_script_enum script enum_def meta =
|
|
|
+ script#incClasses;
|
|
|
+ let sorted_items =
|
|
|
+ List.sort
|
|
|
+ (fun f1 f2 -> f1.ef_index - f2.ef_index)
|
|
|
+ (pmap_values enum_def.e_constrs)
|
|
|
+ in
|
|
|
+ script#writeList
|
|
|
+ (script#op IaEnum ^ script#enumText enum_def)
|
|
|
+ (List.length sorted_items);
|
|
|
+
|
|
|
+ List.iter
|
|
|
+ (fun constructor ->
|
|
|
+ let name = script#stringText constructor.ef_name in
|
|
|
+ match constructor.ef_type with
|
|
|
+ | TFun (args, _) ->
|
|
|
+ script#write (name ^ " " ^ string_of_int (List.length args));
|
|
|
+ List.iter
|
|
|
+ (fun (arg, _, t) ->
|
|
|
+ script#write
|
|
|
+ (" " ^ script#stringText arg ^ " " ^ script#typeText t))
|
|
|
+ args;
|
|
|
+ script#write "\n"
|
|
|
+ | _ -> script#write (name ^ " 0\n"))
|
|
|
+ sorted_items;
|
|
|
+
|
|
|
+ match meta with
|
|
|
+ | Some expr ->
|
|
|
+ script#write "1\n";
|
|
|
+ script#gen_expression expr
|
|
|
+ | _ ->
|
|
|
+ script#write "0\n";
|
|
|
+ script#write "\n"
|
|
|
+
|
|
|
+let generate_cppia ctx =
|
|
|
+ let common_ctx = ctx.ctx_common in
|
|
|
+ let debug = ctx.ctx_debug_level in
|
|
|
+ Path.mkdir_from_path common_ctx.file;
|
|
|
+ let script = new script_writer ctx common_ctx.file common_ctx.debug in
|
|
|
+ ignore (script#stringId "");
|
|
|
+ ignore (script#typeId "");
|
|
|
+
|
|
|
+ List.iter
|
|
|
+ (fun object_def ->
|
|
|
+ match object_def with
|
|
|
+ | TClassDecl class_def when has_class_flag class_def CExtern ->
|
|
|
+ () (*if (gen_externs) then gen_extern_class common_ctx class_def;*)
|
|
|
+ | TClassDecl class_def ->
|
|
|
+ let is_internal = is_internal_class class_def.cl_path in
|
|
|
+ if is_internal || Meta.has Meta.Macro class_def.cl_meta then (
|
|
|
+ if debug >= 4 then
|
|
|
+ print_endline
|
|
|
+ (" internal class " ^ join_class_path class_def.cl_path "."))
|
|
|
+ else generate_script_class common_ctx script class_def
|
|
|
+ | TEnumDecl enum_def when has_enum_flag enum_def EnExtern -> ()
|
|
|
+ | TEnumDecl enum_def ->
|
|
|
+ let is_internal = is_internal_class enum_def.e_path in
|
|
|
+ if is_internal then (
|
|
|
+ if debug >= 4 then
|
|
|
+ print_endline
|
|
|
+ (" internal enum " ^ join_class_path enum_def.e_path "."))
|
|
|
+ else
|
|
|
+ let meta = Texpr.build_metadata common_ctx.basic object_def in
|
|
|
+ if has_enum_flag enum_def EnExtern then
|
|
|
+ if debug >= 4 then
|
|
|
+ print_endline
|
|
|
+ ("external enum " ^ join_class_path enum_def.e_path ".");
|
|
|
+ generate_script_enum script enum_def meta
|
|
|
+ | TTypeDecl _ | TAbstractDecl _ -> (* already done *) ())
|
|
|
+ common_ctx.types;
|
|
|
+
|
|
|
+ (match common_ctx.main.main_expr with
|
|
|
+ | None -> script#writeOpLine IaNoMain
|
|
|
+ | Some e ->
|
|
|
+ script#writeOpLine IaMain;
|
|
|
+ script#gen_expression e);
|
|
|
+
|
|
|
+ script#write
|
|
|
+ (script#op IaResources
|
|
|
+ ^ string_of_int (Hashtbl.length common_ctx.resources)
|
|
|
+ ^ "\n");
|
|
|
+ Hashtbl.iter
|
|
|
+ (fun name data ->
|
|
|
+ script#write
|
|
|
+ (script#op IaReso ^ script#stringText name
|
|
|
+ ^ string_of_int (String.length data)
|
|
|
+ ^ "\n"))
|
|
|
+ common_ctx.resources;
|
|
|
+ Hashtbl.iter (fun _ data -> script#writeData data) common_ctx.resources;
|
|
|
+
|
|
|
+ script#close
|