|
|
@@ -24,103 +24,133 @@ open JData
|
|
|
open Unix
|
|
|
open Ast
|
|
|
open Common
|
|
|
+open Type
|
|
|
open Gencommon
|
|
|
open Gencommon.SourceWriter
|
|
|
-open Type
|
|
|
open Printf
|
|
|
open Option
|
|
|
open ExtString
|
|
|
+module SS = Set.Make(String)
|
|
|
|
|
|
let is_boxed_type t = match follow t with
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Boolean") }, [])
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Double") }, [])
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Integer") }, [])
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Byte") }, [])
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Short") }, [])
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Character") }, [])
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Float") }, []) -> true
|
|
|
- | _ -> false
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Boolean") }, [])
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Double") }, [])
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Integer") }, [])
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Byte") }, [])
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Short") }, [])
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Character") }, [])
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Float") }, []) -> true
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Boolean") }, [])
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Double") }, [])
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Integer") }, [])
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Byte") }, [])
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Short") }, [])
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Character") }, [])
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Float") }, []) -> true
|
|
|
+ | _ -> false
|
|
|
|
|
|
let unboxed_type gen t tbyte tshort tchar tfloat = match follow t with
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Boolean") }, []) -> gen.gcon.basic.tbool
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Double") }, []) -> gen.gcon.basic.tfloat
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Integer") }, []) -> gen.gcon.basic.tint
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Byte") }, []) -> tbyte
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Short") }, []) -> tshort
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Character") }, []) -> tchar
|
|
|
- | TInst ({ cl_path = (["java";"lang"], "Float") }, []) -> tfloat
|
|
|
- | _ -> assert false
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Boolean") }, []) -> gen.gcon.basic.tbool
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Double") }, []) -> gen.gcon.basic.tfloat
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Integer") }, []) -> gen.gcon.basic.tint
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Byte") }, []) -> tbyte
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Short") }, []) -> tshort
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Character") }, []) -> tchar
|
|
|
+ | TInst ({ cl_path = (["java";"lang"], "Float") }, []) -> tfloat
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Boolean") }, []) -> gen.gcon.basic.tbool
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Double") }, []) -> gen.gcon.basic.tfloat
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Integer") }, []) -> gen.gcon.basic.tint
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Byte") }, []) -> tbyte
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Short") }, []) -> tshort
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Character") }, []) -> tchar
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"], "Float") }, []) -> tfloat
|
|
|
+ | _ -> assert false
|
|
|
|
|
|
let rec t_has_type_param t = match follow t with
|
|
|
- | TInst({ cl_kind = KTypeParameter _ }, []) -> true
|
|
|
- | TEnum(_, params)
|
|
|
- | TInst(_, params) -> List.exists t_has_type_param params
|
|
|
- | TFun(f,ret) -> t_has_type_param ret || List.exists (fun (_,_,t) -> t_has_type_param t) f
|
|
|
- | _ -> false
|
|
|
+ | TInst({ cl_kind = KTypeParameter _ }, []) -> true
|
|
|
+ | TEnum(_, params)
|
|
|
+ | TAbstract(_, params)
|
|
|
+ | TInst(_, params) -> List.exists t_has_type_param params
|
|
|
+ | TFun(f,ret) -> t_has_type_param ret || List.exists (fun (_,_,t) -> t_has_type_param t) f
|
|
|
+ | _ -> false
|
|
|
|
|
|
let is_type_param t = match follow t with
|
|
|
- | TInst({ cl_kind = KTypeParameter _ }, _) -> true
|
|
|
- | _ -> false
|
|
|
+ | TInst({ cl_kind = KTypeParameter _ }, _) -> true
|
|
|
+ | _ -> false
|
|
|
|
|
|
let rec t_has_type_param_shallow last t = match follow t with
|
|
|
- | TInst({ cl_kind = KTypeParameter _ }, []) -> true
|
|
|
- | TEnum(_, params)
|
|
|
- | TInst(_, params) when not last -> List.exists (t_has_type_param_shallow true) params
|
|
|
- | TFun(f,ret) when not last -> t_has_type_param_shallow true ret || List.exists (fun (_,_,t) -> t_has_type_param_shallow true t) f
|
|
|
- | _ -> false
|
|
|
+ | TInst({ cl_kind = KTypeParameter _ }, []) -> true
|
|
|
+ | TEnum(_, params)
|
|
|
+ | TAbstract(_, params)
|
|
|
+ | TInst(_, params) when not last -> List.exists (t_has_type_param_shallow true) params
|
|
|
+ | TFun(f,ret) when not last -> t_has_type_param_shallow true ret || List.exists (fun (_,_,t) -> t_has_type_param_shallow true t) f
|
|
|
+ | _ -> false
|
|
|
+
|
|
|
+let rec replace_type_param t = match follow t with
|
|
|
+ | TInst({ cl_kind = KTypeParameter _ }, []) -> t_dynamic
|
|
|
+ | TEnum(e, params) -> TEnum(e, List.map replace_type_param params)
|
|
|
+ | TAbstract(a, params) -> TAbstract(a, List.map replace_type_param params)
|
|
|
+ | TInst(cl, params) -> TInst(cl, List.map replace_type_param params)
|
|
|
+ | _ -> t
|
|
|
|
|
|
let is_java_basic_type t =
|
|
|
- match follow t with
|
|
|
- | TInst( { cl_path = (["haxe"], "Int32") }, [] )
|
|
|
- | TInst( { cl_path = (["haxe"], "Int64") }, [] )
|
|
|
- | TAbstract( { a_path = ([], "Single") }, [] )
|
|
|
- | TAbstract( { a_path = (["java"], ("Int8" | "Int16" | "Char16")) }, [] )
|
|
|
- | TInst( { cl_path = ([], "Int") }, [] ) | TAbstract( { a_path = ([], "Int") }, [] )
|
|
|
- | TInst( { cl_path = ([], "Float") }, [] ) | TAbstract( { a_path = ([], "Float") }, [] )
|
|
|
- | TEnum( { e_path = ([], "Bool") }, [] ) | TAbstract( { a_path = ([], "Bool") }, [] ) ->
|
|
|
- true
|
|
|
- | _ -> false
|
|
|
+ match follow t with
|
|
|
+ | TInst( { cl_path = (["haxe"], "Int32") }, [] )
|
|
|
+ | TInst( { cl_path = (["haxe"], "Int64") }, [] )
|
|
|
+ | TAbstract( { a_path = ([], "Single") }, [] )
|
|
|
+ | TAbstract( { a_path = (["java"], ("Int8" | "Int16" | "Char16" | "Int64")) }, [] )
|
|
|
+ | TAbstract( { a_path = ([], "Int") }, [] )
|
|
|
+ | TAbstract( { a_path = ([], "Float") }, [] )
|
|
|
+ | TAbstract( { a_path = ([], "Bool") }, [] ) ->
|
|
|
+ true
|
|
|
+ | _ -> false
|
|
|
|
|
|
let is_bool t =
|
|
|
- match follow t with
|
|
|
- | TEnum( { e_path = ([], "Bool") }, [] )
|
|
|
- | TAbstract ({ a_path = ([], "Bool") },[]) ->
|
|
|
- true
|
|
|
- | _ -> false
|
|
|
+ match follow t with
|
|
|
+ | TAbstract ({ a_path = ([], "Bool") },[]) ->
|
|
|
+ true
|
|
|
+ | _ -> false
|
|
|
+
|
|
|
+let like_bool t =
|
|
|
+ match follow t with
|
|
|
+ | TAbstract ({ a_path = ([], "Bool") },[])
|
|
|
+ | TAbstract ({ a_path = (["java";"lang"],"Boolean") },[])
|
|
|
+ | TInst ({ cl_path = (["java";"lang"],"Boolean") },[]) ->
|
|
|
+ true
|
|
|
+ | _ -> false
|
|
|
|
|
|
let is_int_float gen t =
|
|
|
- match follow (gen.greal_type t) with
|
|
|
- | TInst( { cl_path = (["haxe"], "Int64") }, [] )
|
|
|
- | TInst( { cl_path = (["haxe"], "Int32") }, [] )
|
|
|
- | TInst( { cl_path = ([], "Int") }, [] ) | TAbstract( { a_path = ([], "Int") }, [] )
|
|
|
- | TInst( { cl_path = ([], "Float") }, [] ) | TAbstract( { a_path = ([], "Float") }, [] ) ->
|
|
|
- true
|
|
|
- | (TAbstract _ as t) when like_float t -> true
|
|
|
- | _ -> false
|
|
|
+ match follow (gen.greal_type t) with
|
|
|
+ | TInst( { cl_path = (["haxe"], "Int32") }, [] )
|
|
|
+ | TAbstract( { a_path = ([], "Int") }, [] )
|
|
|
+ | TAbstract( { a_path = ([], "Float") }, [] ) ->
|
|
|
+ true
|
|
|
+ | (TAbstract _ as t) when like_float t && not (like_i64 t)-> true
|
|
|
+ | _ -> false
|
|
|
|
|
|
let parse_explicit_iface =
|
|
|
- let regex = Str.regexp "\\." in
|
|
|
- let parse_explicit_iface str =
|
|
|
- let split = Str.split regex str in
|
|
|
- let rec get_iface split pack =
|
|
|
- match split with
|
|
|
- | clname :: fn_name :: [] -> fn_name, (List.rev pack, clname)
|
|
|
- | pack_piece :: tl -> get_iface tl (pack_piece :: pack)
|
|
|
- | _ -> assert false
|
|
|
- in
|
|
|
- get_iface split []
|
|
|
- in parse_explicit_iface
|
|
|
+ let regex = Str.regexp "\\." in
|
|
|
+ let parse_explicit_iface str =
|
|
|
+ let split = Str.split regex str in
|
|
|
+ let rec get_iface split pack =
|
|
|
+ match split with
|
|
|
+ | clname :: fn_name :: [] -> fn_name, (List.rev pack, clname)
|
|
|
+ | pack_piece :: tl -> get_iface tl (pack_piece :: pack)
|
|
|
+ | _ -> assert false
|
|
|
+ in
|
|
|
+ get_iface split []
|
|
|
+ in parse_explicit_iface
|
|
|
|
|
|
let is_string t =
|
|
|
- match follow t with
|
|
|
- | TInst( { cl_path = ([], "String") }, [] ) -> true
|
|
|
- | _ -> false
|
|
|
+ match follow t with
|
|
|
+ | TInst( { cl_path = ([], "String") }, [] ) -> true
|
|
|
+ | _ -> false
|
|
|
|
|
|
let is_cl t = match follow t with
|
|
|
- | TInst({ cl_path = ["java";"lang"],"Class" },_)
|
|
|
- | TAbstract({ a_path = [], ("Class"|"Enum") },_) -> true
|
|
|
- | TAnon(a) when is_some (anon_class t) -> true
|
|
|
- | _ -> false
|
|
|
+ | TInst({ cl_path = ["java";"lang"],"Class" },_)
|
|
|
+ | TAbstract({ a_path = [], ("Class"|"Enum") },_) -> true
|
|
|
+ | TAnon(a) when is_some (anon_class t) -> true
|
|
|
+ | _ -> false
|
|
|
|
|
|
(* ******************************************* *)
|
|
|
(* JavaSpecificESynf *)
|
|
|
@@ -128,3071 +158,3503 @@ let is_cl t = match follow t with
|
|
|
|
|
|
(*
|
|
|
|
|
|
- Some Java-specific syntax filters that must run before ExpressionUnwrap
|
|
|
+ Some Java-specific syntax filters that must run before ExpressionUnwrap
|
|
|
|
|
|
- dependencies:
|
|
|
- It must run before ExprUnwrap, as it may not return valid Expr/Statement expressions
|
|
|
- It must run before ClassInstance, as it will detect expressions that need unchanged TTypeExpr
|
|
|
- It must run after CastDetect, as it changes casts
|
|
|
- It must run after TryCatchWrapper, to change Std.is() calls inside there
|
|
|
+ dependencies:
|
|
|
+ It must run before ExprUnwrap, as it may not return valid Expr/Statement expressions
|
|
|
+ It must run before ClassInstance, as it will detect expressions that need unchanged TTypeExpr
|
|
|
+ It must run after CastDetect, as it changes casts
|
|
|
+ It must run after TryCatchWrapper, to change Std.is() calls inside there
|
|
|
|
|
|
*)
|
|
|
module JavaSpecificESynf =
|
|
|
struct
|
|
|
|
|
|
- let name = "java_specific_e"
|
|
|
-
|
|
|
- let priority = solve_deps name [ DBefore ExpressionUnwrap.priority; DBefore ClassInstance.priority; DAfter CastDetect.priority; DAfter TryCatchWrapper.priority ]
|
|
|
-
|
|
|
- let get_cl_from_t t =
|
|
|
- match follow t with
|
|
|
- | TInst(cl,_) -> cl
|
|
|
- | _ -> assert false
|
|
|
-
|
|
|
- let traverse gen runtime_cl =
|
|
|
- let basic = gen.gcon.basic in
|
|
|
- let float_cl = get_cl ( get_type gen (["java";"lang"], "Double")) in
|
|
|
- let i8_md = ( get_type gen (["java";"lang"], "Byte")) in
|
|
|
- let i16_md = ( get_type gen (["java";"lang"], "Short")) in
|
|
|
- let i64_md = ( get_type gen (["java";"lang"], "Long")) in
|
|
|
- let c16_md = ( get_type gen (["java";"lang"], "Character")) in
|
|
|
- let f_md = ( get_type gen (["java";"lang"], "Float")) in
|
|
|
- let bool_md = get_type gen (["java";"lang"], "Boolean") in
|
|
|
-
|
|
|
- let is_var = alloc_var "__is__" t_dynamic in
|
|
|
-
|
|
|
- let rec run e =
|
|
|
- match e.eexpr with
|
|
|
- (* Math changes *)
|
|
|
- | TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "NaN" }) ) ->
|
|
|
- mk_static_field_access_infer float_cl "NaN" e.epos []
|
|
|
- | TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "NEGATIVE_INFINITY" }) ) ->
|
|
|
- mk_static_field_access_infer float_cl "NEGATIVE_INFINITY" e.epos []
|
|
|
- | TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "POSITIVE_INFINITY" }) ) ->
|
|
|
- mk_static_field_access_infer float_cl "POSITIVE_INFINITY" e.epos []
|
|
|
- | TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "isNaN"}) ) ->
|
|
|
- mk_static_field_access_infer float_cl "_isNaN" e.epos []
|
|
|
- | TCall( ({ eexpr = TField( (_ as ef), FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = ("ffloor" as f) }) ) } as fe), p)
|
|
|
- | TCall( ({ eexpr = TField( (_ as ef), FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = ("fceil" as f) }) ) } as fe), p) ->
|
|
|
- Type.map_expr run { e with eexpr = TCall({ fe with eexpr = TField(ef, FDynamic (String.sub f 1 (String.length f - 1))) }, p) }
|
|
|
- | TCall( ({ eexpr = TField( (_ as ef), FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = ("fround") }) ) } as fe), p) ->
|
|
|
- Type.map_expr run { e with eexpr = TCall({ fe with eexpr = TField(ef, FDynamic "rint") }, p) }
|
|
|
- | TCall( { eexpr = TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "floor" }) ) }, _)
|
|
|
- | TCall( { eexpr = TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "round" }) ) }, _)
|
|
|
- | TCall( { eexpr = TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "ceil" }) ) }, _) ->
|
|
|
- mk_cast basic.tint (Type.map_expr run { e with etype = basic.tfloat })
|
|
|
- | TCall( ( { eexpr = TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "isFinite" }) ) } as efield ), [v]) ->
|
|
|
- { e with eexpr = TCall( mk_static_field_access_infer runtime_cl "isFinite" efield.epos [], [run v] ) }
|
|
|
- (* end of math changes *)
|
|
|
-
|
|
|
- (* Std.is() *)
|
|
|
- | TCall(
|
|
|
- { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = "is" })) },
|
|
|
- [ obj; { eexpr = TTypeExpr(md) } ]
|
|
|
- ) ->
|
|
|
- let mk_is is_basic obj md =
|
|
|
- let obj = if is_basic then mk_cast t_dynamic obj else obj in
|
|
|
- { e with eexpr = TCall( { eexpr = TLocal is_var; etype = t_dynamic; epos = e.epos }, [
|
|
|
- run obj;
|
|
|
- { eexpr = TTypeExpr md; etype = t_dynamic (* this is after all a syntax filter *); epos = e.epos }
|
|
|
- ] ) }
|
|
|
- in
|
|
|
- (match follow_module follow md with
|
|
|
- | TClassDecl({ cl_path = ([], "Float") })
|
|
|
- | TAbstractDecl({ a_path = ([], "Float") }) ->
|
|
|
- {
|
|
|
- eexpr = TCall(
|
|
|
- mk_static_field_access_infer runtime_cl "isDouble" e.epos [],
|
|
|
- [ run obj ]
|
|
|
- );
|
|
|
- etype = basic.tbool;
|
|
|
- epos = e.epos
|
|
|
- }
|
|
|
- | TClassDecl{ cl_path = ([], "Int") }
|
|
|
- | TAbstractDecl{ a_path = ([], "Int") } ->
|
|
|
- {
|
|
|
- eexpr = TCall(
|
|
|
- mk_static_field_access_infer runtime_cl "isInt" e.epos [],
|
|
|
- [ run obj ]
|
|
|
- );
|
|
|
- etype = basic.tbool;
|
|
|
- epos = e.epos
|
|
|
- }
|
|
|
- | TAbstractDecl{ a_path = ([], "Bool") }
|
|
|
- | TEnumDecl{ e_path = ([], "Bool") } ->
|
|
|
- mk_is true obj bool_md
|
|
|
- | TAbstractDecl{ a_path = ([], "Single") } ->
|
|
|
- mk_is true obj f_md
|
|
|
- | TAbstractDecl{ a_path = (["java"], "Int8") } ->
|
|
|
- mk_is true obj i8_md
|
|
|
- | TAbstractDecl{ a_path = (["java"], "Int16") } ->
|
|
|
- mk_is true obj i16_md
|
|
|
- | TAbstractDecl{ a_path = (["java"], "Char16") } ->
|
|
|
- mk_is true obj c16_md
|
|
|
- | TClassDecl{ cl_path = (["haxe"], "Int64") } ->
|
|
|
- mk_is true obj i64_md
|
|
|
- | TAbstractDecl{ a_path = ([], "Dynamic") }
|
|
|
- | TClassDecl{ cl_path = ([], "Dynamic") } ->
|
|
|
- (match obj.eexpr with
|
|
|
- | TLocal _ | TConst _ -> { e with eexpr = TConst(TBool true) }
|
|
|
- | _ -> { e with eexpr = TBlock([run obj; { e with eexpr = TConst(TBool true) }]) }
|
|
|
- )
|
|
|
- | _ ->
|
|
|
- mk_is false obj md
|
|
|
- )
|
|
|
- (* end Std.is() *)
|
|
|
- | _ -> Type.map_expr run e
|
|
|
- in
|
|
|
- run
|
|
|
-
|
|
|
- let configure gen (mapping_func:texpr->texpr) =
|
|
|
- let map e = Some(mapping_func e) in
|
|
|
- gen.gsyntax_filters#add ~name:name ~priority:(PCustom priority) map
|
|
|
+ let name = "java_specific_e"
|
|
|
+
|
|
|
+ let priority = solve_deps name [ DBefore ExpressionUnwrap.priority; DBefore ClassInstance.priority; DAfter CastDetect.priority; DAfter TryCatchWrapper.priority ]
|
|
|
+
|
|
|
+ let get_cl_from_t t =
|
|
|
+ match follow t with
|
|
|
+ | TInst(cl,_) -> cl
|
|
|
+ | _ -> assert false
|
|
|
+
|
|
|
+ let traverse gen runtime_cl =
|
|
|
+ let basic = gen.gcon.basic in
|
|
|
+ let float_cl = get_cl ( get_type gen (["java";"lang"], "Double")) in
|
|
|
+ let i8_md = ( get_type gen (["java";"lang"], "Byte")) in
|
|
|
+ let i16_md = ( get_type gen (["java";"lang"], "Short")) in
|
|
|
+ let i64_md = ( get_type gen (["java";"lang"], "Long")) in
|
|
|
+ let c16_md = ( get_type gen (["java";"lang"], "Character")) in
|
|
|
+ let f_md = ( get_type gen (["java";"lang"], "Float")) in
|
|
|
+ let bool_md = get_type gen (["java";"lang"], "Boolean") in
|
|
|
+
|
|
|
+ let is_var = alloc_var "__is__" t_dynamic in
|
|
|
+
|
|
|
+ let rec run e =
|
|
|
+ match e.eexpr with
|
|
|
+ (* Math changes *)
|
|
|
+ | TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "NaN" }) ) ->
|
|
|
+ mk_static_field_access_infer float_cl "NaN" e.epos []
|
|
|
+ | TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "NEGATIVE_INFINITY" }) ) ->
|
|
|
+ mk_static_field_access_infer float_cl "NEGATIVE_INFINITY" e.epos []
|
|
|
+ | TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "POSITIVE_INFINITY" }) ) ->
|
|
|
+ mk_static_field_access_infer float_cl "POSITIVE_INFINITY" e.epos []
|
|
|
+ | TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "isNaN"}) ) ->
|
|
|
+ mk_static_field_access_infer float_cl "isNaN" e.epos []
|
|
|
+ | TCall( ({ eexpr = TField( (_ as ef), FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = ("ffloor" as f) }) ) } as fe), p)
|
|
|
+ | TCall( ({ eexpr = TField( (_ as ef), FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = ("fceil" as f) }) ) } as fe), p) ->
|
|
|
+ Type.map_expr run { e with eexpr = TCall({ fe with eexpr = TField(ef, FDynamic (String.sub f 1 (String.length f - 1))) }, p) }
|
|
|
+ | TCall( ({ eexpr = TField( (_ as ef), FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = ("fround") }) ) } as fe), p) ->
|
|
|
+ Type.map_expr run { e with eexpr = TCall({ fe with eexpr = TField(ef, FDynamic "rint") }, p) }
|
|
|
+ | TCall( { eexpr = TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "floor" }) ) }, _)
|
|
|
+ | TCall( { eexpr = TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "round" }) ) }, _)
|
|
|
+ | TCall( { eexpr = TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "ceil" }) ) }, _) ->
|
|
|
+ mk_cast basic.tint (Type.map_expr run { e with etype = basic.tfloat })
|
|
|
+ | TCall( ( { eexpr = TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "isFinite" }) ) } as efield ), [v]) ->
|
|
|
+ { e with eexpr = TCall( mk_static_field_access_infer runtime_cl "isFinite" efield.epos [], [run v] ) }
|
|
|
+ (* end of math changes *)
|
|
|
+
|
|
|
+ (* Std.is() *)
|
|
|
+ | TCall(
|
|
|
+ { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = "is" })) },
|
|
|
+ [ obj; { eexpr = TTypeExpr(md) } ]
|
|
|
+ ) ->
|
|
|
+ let mk_is is_basic obj md =
|
|
|
+ let obj = if is_basic then mk_cast t_dynamic obj else obj in
|
|
|
+ { e with eexpr = TCall( { eexpr = TLocal is_var; etype = t_dynamic; epos = e.epos }, [
|
|
|
+ run obj;
|
|
|
+ { eexpr = TTypeExpr md; etype = t_dynamic (* this is after all a syntax filter *); epos = e.epos }
|
|
|
+ ] ) }
|
|
|
+ in
|
|
|
+ (match follow_module follow md with
|
|
|
+ | TAbstractDecl({ a_path = ([], "Float") }) ->
|
|
|
+ {
|
|
|
+ eexpr = TCall(
|
|
|
+ mk_static_field_access_infer runtime_cl "isDouble" e.epos [],
|
|
|
+ [ run obj ]
|
|
|
+ );
|
|
|
+ etype = basic.tbool;
|
|
|
+ epos = e.epos
|
|
|
+ }
|
|
|
+ | TAbstractDecl{ a_path = ([], "Int") } ->
|
|
|
+ {
|
|
|
+ eexpr = TCall(
|
|
|
+ mk_static_field_access_infer runtime_cl "isInt" e.epos [],
|
|
|
+ [ run obj ]
|
|
|
+ );
|
|
|
+ etype = basic.tbool;
|
|
|
+ epos = e.epos
|
|
|
+ }
|
|
|
+ | TAbstractDecl{ a_path = ([], "Bool") } ->
|
|
|
+ mk_is true obj bool_md
|
|
|
+ | TAbstractDecl{ a_path = ([], "Single") } ->
|
|
|
+ mk_is true obj f_md
|
|
|
+ | TAbstractDecl{ a_path = (["java"], "Int8") } ->
|
|
|
+ mk_is true obj i8_md
|
|
|
+ | TAbstractDecl{ a_path = (["java"], "Int16") } ->
|
|
|
+ mk_is true obj i16_md
|
|
|
+ | TAbstractDecl{ a_path = (["java"], "Char16") } ->
|
|
|
+ mk_is true obj c16_md
|
|
|
+ | TAbstractDecl{ a_path = (["java"], "Int64") } ->
|
|
|
+ mk_is true obj i64_md
|
|
|
+ | TClassDecl{ cl_path = (["haxe"], "Int64") } ->
|
|
|
+ mk_is true obj i64_md
|
|
|
+ | TAbstractDecl{ a_path = ([], "Dynamic") }
|
|
|
+ | TClassDecl{ cl_path = ([], "Dynamic") } ->
|
|
|
+ (match obj.eexpr with
|
|
|
+ | TLocal _ | TConst _ -> { e with eexpr = TConst(TBool true) }
|
|
|
+ | _ -> { e with eexpr = TBlock([run obj; { e with eexpr = TConst(TBool true) }]) }
|
|
|
+ )
|
|
|
+ | _ ->
|
|
|
+ mk_is false obj md
|
|
|
+ )
|
|
|
+ (* end Std.is() *)
|
|
|
+ | _ -> Type.map_expr run e
|
|
|
+ in
|
|
|
+ run
|
|
|
+
|
|
|
+ let configure gen (mapping_func:texpr->texpr) =
|
|
|
+ let map e = Some(mapping_func e) in
|
|
|
+ gen.gsyntax_filters#add ~name:name ~priority:(PCustom priority) map
|
|
|
|
|
|
end;;
|
|
|
|
|
|
-
|
|
|
(* ******************************************* *)
|
|
|
(* JavaSpecificSynf *)
|
|
|
(* ******************************************* *)
|
|
|
|
|
|
(*
|
|
|
|
|
|
- Some Java-specific syntax filters that can run after ExprUnwrap
|
|
|
+ Some Java-specific syntax filters that can run after ExprUnwrap
|
|
|
|
|
|
- dependencies:
|
|
|
- Runs after ExprUnwarp
|
|
|
+ dependencies:
|
|
|
+ Runs after ExprUnwarp
|
|
|
|
|
|
*)
|
|
|
|
|
|
module JavaSpecificSynf =
|
|
|
struct
|
|
|
|
|
|
- let name = "java_specific"
|
|
|
-
|
|
|
- let priority = solve_deps name [ DAfter ExpressionUnwrap.priority; DAfter ObjectDeclMap.priority; DAfter ArrayDeclSynf.priority; DBefore IntDivisionSynf.priority ]
|
|
|
-
|
|
|
- let java_hash s =
|
|
|
- let h = ref Int32.zero in
|
|
|
- let thirtyone = Int32.of_int 31 in
|
|
|
- for i = 0 to String.length s - 1 do
|
|
|
- h := Int32.add (Int32.mul thirtyone !h) (Int32.of_int (int_of_char (String.unsafe_get s i)));
|
|
|
- done;
|
|
|
- !h
|
|
|
-
|
|
|
- let rec is_final_return_expr is_switch e =
|
|
|
- let is_final_return_expr = is_final_return_expr is_switch in
|
|
|
- match e.eexpr with
|
|
|
- | TReturn _
|
|
|
- | TThrow _ -> true
|
|
|
- (* this is hack to not use 'break' on switch cases *)
|
|
|
- | TLocal { v_name = "__fallback__" } when is_switch -> true
|
|
|
- | TCall( { eexpr = TLocal { v_name = "__goto__" } }, _ ) -> true
|
|
|
- | TParenthesis p | TMeta (_,p) -> is_final_return_expr p
|
|
|
- | TBlock bl -> is_final_return_block is_switch bl
|
|
|
- | TSwitch (_, el_e_l, edef) ->
|
|
|
- List.for_all (fun (_,e) -> is_final_return_expr e) el_e_l && Option.map_default is_final_return_expr false edef
|
|
|
-(* | TMatch (_, _, il_vl_e_l, edef) ->
|
|
|
- List.for_all (fun (_,_,e) -> is_final_return_expr e)il_vl_e_l && Option.map_default is_final_return_expr false edef *)
|
|
|
- | TIf (_,eif, Some eelse) ->
|
|
|
- is_final_return_expr eif && is_final_return_expr eelse
|
|
|
- | TFor (_,_,e) ->
|
|
|
- is_final_return_expr e
|
|
|
- | TWhile (_,e,_) ->
|
|
|
- is_final_return_expr e
|
|
|
- | TFunction tf ->
|
|
|
- is_final_return_expr tf.tf_expr
|
|
|
- | TTry (e, ve_l) ->
|
|
|
- is_final_return_expr e && List.for_all (fun (_,e) -> is_final_return_expr e) ve_l
|
|
|
- | _ -> false
|
|
|
-
|
|
|
- and is_final_return_block is_switch el =
|
|
|
- match el with
|
|
|
- | [] -> false
|
|
|
- | final :: [] -> is_final_return_expr is_switch final
|
|
|
- | hd :: tl -> is_final_return_block is_switch tl
|
|
|
-
|
|
|
- let is_null e = match e.eexpr with | TConst(TNull) -> true | _ -> false
|
|
|
-
|
|
|
- let rec is_equatable gen t =
|
|
|
- match follow t with
|
|
|
- | TInst(cl,_) ->
|
|
|
- if cl.cl_path = (["haxe";"lang"], "IEquatable") then
|
|
|
- true
|
|
|
- else
|
|
|
- List.exists (fun (cl,p) -> is_equatable gen (TInst(cl,p))) cl.cl_implements
|
|
|
- || (match cl.cl_super with | Some(cl,p) -> is_equatable gen (TInst(cl,p)) | None -> false)
|
|
|
- | _ -> false
|
|
|
-
|
|
|
- (*
|
|
|
- Changing string switch
|
|
|
- will take an expression like
|
|
|
- switch(str)
|
|
|
- {
|
|
|
- case "a":
|
|
|
- case "b":
|
|
|
- }
|
|
|
-
|
|
|
- and modify it to:
|
|
|
- {
|
|
|
- var execute_def = true;
|
|
|
- switch(str.hashCode())
|
|
|
- {
|
|
|
- case (hashcode of a):
|
|
|
- if (str == "a")
|
|
|
- {
|
|
|
- execute_def = false;
|
|
|
- ..code here
|
|
|
- } //else if (str == otherVariableWithSameHashCode) {
|
|
|
- ...
|
|
|
- }
|
|
|
- ...
|
|
|
- }
|
|
|
- if (execute_def)
|
|
|
- {
|
|
|
- ..default code
|
|
|
- }
|
|
|
- }
|
|
|
-
|
|
|
- this might actually be slower in some cases than a if/else approach, but it scales well and as a bonus,
|
|
|
- hashCode in java are cached, so we only have the performance hit once to cache it.
|
|
|
- *)
|
|
|
- let change_string_switch gen eswitch e1 ecases edefault =
|
|
|
- let basic = gen.gcon.basic in
|
|
|
- let is_final_ret = is_final_return_expr false eswitch in
|
|
|
-
|
|
|
- let has_default = is_some edefault in
|
|
|
- let block = ref [] in
|
|
|
- let local = match e1.eexpr with
|
|
|
- | TLocal _ -> e1
|
|
|
- | _ ->
|
|
|
- let var = mk_temp gen "svar" e1.etype in
|
|
|
- let added = { e1 with eexpr = TVar(var, Some(e1)); etype = basic.tvoid } in
|
|
|
- let local = mk_local var e1.epos in
|
|
|
- block := added :: !block;
|
|
|
- local
|
|
|
- in
|
|
|
- let execute_def_var = mk_temp gen "executeDef" gen.gcon.basic.tbool in
|
|
|
- let execute_def = mk_local execute_def_var e1.epos in
|
|
|
- let execute_def_set = { eexpr = TBinop(Ast.OpAssign, execute_def, { eexpr = TConst(TBool false); etype = basic.tbool; epos = e1.epos }); etype = basic.tbool; epos = e1.epos } in
|
|
|
-
|
|
|
- let hash_cache = ref None in
|
|
|
-
|
|
|
- let local_hashcode = ref { local with
|
|
|
- eexpr = TCall({ local with
|
|
|
- eexpr = TField(local, FDynamic "hashCode");
|
|
|
- etype = TFun([], basic.tint);
|
|
|
- }, []);
|
|
|
- etype = basic.tint
|
|
|
- } in
|
|
|
-
|
|
|
- let get_hash_cache () =
|
|
|
- match !hash_cache with
|
|
|
- | Some c -> c
|
|
|
- | None ->
|
|
|
- let var = mk_temp gen "hash" basic.tint in
|
|
|
- let cond = !local_hashcode in
|
|
|
- block := { eexpr = TVar(var, Some cond); etype = basic.tvoid; epos = local.epos } :: !block;
|
|
|
- let local = mk_local var local.epos in
|
|
|
- local_hashcode := local;
|
|
|
- hash_cache := Some local;
|
|
|
- local
|
|
|
- in
|
|
|
-
|
|
|
- let has_case = ref false in
|
|
|
- (* first we need to reorder all cases so all collisions are close to each other *)
|
|
|
-
|
|
|
- let get_str e = match e.eexpr with | TConst(TString s) -> s | _ -> assert false in
|
|
|
- let has_conflict = ref false in
|
|
|
-
|
|
|
- let rec reorder_cases unordered ordered =
|
|
|
- match unordered with
|
|
|
- | [] -> ordered
|
|
|
- | (el, e) :: tl ->
|
|
|
- let current = Hashtbl.create 1 in
|
|
|
- List.iter (fun e ->
|
|
|
- let str = get_str e in
|
|
|
- let hash = java_hash str in
|
|
|
- Hashtbl.add current hash true
|
|
|
- ) el;
|
|
|
-
|
|
|
- let rec extract_fields cases found_cases ret_cases =
|
|
|
- match cases with
|
|
|
- | [] -> found_cases, ret_cases
|
|
|
- | (el, e) :: tl ->
|
|
|
- if List.exists (fun e -> Hashtbl.mem current (java_hash (get_str e)) ) el then begin
|
|
|
- has_conflict := true;
|
|
|
- List.iter (fun e -> Hashtbl.add current (java_hash (get_str e)) true) el;
|
|
|
- extract_fields tl ( (el, e) :: found_cases ) ret_cases
|
|
|
- end else
|
|
|
- extract_fields tl found_cases ( (el, e) :: ret_cases )
|
|
|
- in
|
|
|
- let found, remaining = extract_fields tl [] [] in
|
|
|
- let ret = if found <> [] then
|
|
|
- let ret = List.sort (fun (e1,_) (e2,_) -> compare (List.length e2) (List.length e1) ) ( (el, e) :: found ) in
|
|
|
- let rec loop ret acc =
|
|
|
- match ret with
|
|
|
- | (el, e) :: ( (_,_) :: _ as tl ) -> loop tl ( (true, el, e) :: acc )
|
|
|
- | (el, e) :: [] -> ( (false, el, e) :: acc )
|
|
|
- | _ -> assert false
|
|
|
- in
|
|
|
- List.rev (loop ret [])
|
|
|
- else
|
|
|
- (false, el, e) :: []
|
|
|
- in
|
|
|
-
|
|
|
- reorder_cases remaining (ordered @ ret)
|
|
|
- in
|
|
|
-
|
|
|
- let already_in_cases = Hashtbl.create 0 in
|
|
|
- let change_case (has_fallback, el, e) =
|
|
|
- let conds, el = List.fold_left (fun (conds,el) e ->
|
|
|
- has_case := true;
|
|
|
- match e.eexpr with
|
|
|
- | TConst(TString s) ->
|
|
|
- let hashed = java_hash s in
|
|
|
- let equals_test = {
|
|
|
- eexpr = TCall({ e with eexpr = TField(local, FDynamic "equals"); etype = TFun(["obj",false,t_dynamic],basic.tbool) }, [ e ]);
|
|
|
- etype = basic.tbool;
|
|
|
- epos = e.epos
|
|
|
- } in
|
|
|
-
|
|
|
- let hashed_expr = { eexpr = TConst(TInt hashed); etype = basic.tint; epos = e.epos } in
|
|
|
- let hashed_exprs = if !has_conflict then begin
|
|
|
- if Hashtbl.mem already_in_cases hashed then
|
|
|
- el
|
|
|
- else begin
|
|
|
- Hashtbl.add already_in_cases hashed true;
|
|
|
- hashed_expr :: el
|
|
|
- end
|
|
|
- end else hashed_expr :: el in
|
|
|
-
|
|
|
- let conds = match conds with
|
|
|
- | None -> equals_test
|
|
|
- | Some c ->
|
|
|
- (*
|
|
|
- if there is more than one case, we should test first if hash equals to the one specified.
|
|
|
- This way we can save a heavier string compare
|
|
|
- *)
|
|
|
- let equals_test = mk_paren {
|
|
|
- eexpr = TBinop(Ast.OpBoolAnd, { eexpr = TBinop(Ast.OpEq, get_hash_cache(), hashed_expr); etype = basic.tbool; epos = e.epos }, equals_test);
|
|
|
- etype = basic.tbool;
|
|
|
- epos = e.epos;
|
|
|
- } in
|
|
|
-
|
|
|
- { eexpr = TBinop(Ast.OpBoolOr, equals_test, c); etype = basic.tbool; epos = e1.epos }
|
|
|
- in
|
|
|
-
|
|
|
- Some conds, hashed_exprs
|
|
|
- | _ -> assert false
|
|
|
- ) (None,[]) el in
|
|
|
- let e = if has_default then Type.concat execute_def_set e else e in
|
|
|
- let e = if !has_conflict then Type.concat e { e with eexpr = TBreak; etype = basic.tvoid } else e in
|
|
|
- let e = {
|
|
|
- eexpr = TIf(get conds, e, None);
|
|
|
- etype = basic.tvoid;
|
|
|
- epos = e.epos
|
|
|
- } in
|
|
|
-
|
|
|
- let e = if has_fallback then { e with eexpr = TBlock([ e; mk_local (alloc_var "__fallback__" t_dynamic) e.epos]) } else e in
|
|
|
-
|
|
|
- (el, e)
|
|
|
- in
|
|
|
-
|
|
|
- let switch = { eswitch with
|
|
|
- eexpr = TSwitch(!local_hashcode, List.map change_case (reorder_cases ecases []), None);
|
|
|
- } in
|
|
|
- (if !has_case then begin
|
|
|
- (if has_default then block := { e1 with eexpr = TVar(execute_def_var, Some({ e1 with eexpr = TConst(TBool true); etype = basic.tbool })); etype = basic.tvoid } :: !block);
|
|
|
- block := switch :: !block
|
|
|
- end);
|
|
|
- (match edefault with
|
|
|
- | None -> ()
|
|
|
- | Some edef when not !has_case ->
|
|
|
- block := edef :: !block
|
|
|
- | Some edef ->
|
|
|
- let eelse = if is_final_ret then Some { eexpr = TThrow { eexpr = TConst(TNull); etype = t_dynamic; epos = edef.epos }; etype = basic.tvoid; epos = edef.epos } else None in
|
|
|
- block := { edef with eexpr = TIf(execute_def, edef, eelse); etype = basic.tvoid } :: !block
|
|
|
- );
|
|
|
- { eswitch with eexpr = TBlock(List.rev !block) }
|
|
|
-
|
|
|
-
|
|
|
- let get_cl_from_t t =
|
|
|
- match follow t with
|
|
|
- | TInst(cl,_) -> cl
|
|
|
- | _ -> assert false
|
|
|
-
|
|
|
- let traverse gen runtime_cl =
|
|
|
- let basic = gen.gcon.basic in
|
|
|
- let tchar = mt_to_t_dyn ( get_type gen (["java"], "Char16") ) in
|
|
|
- let tbyte = mt_to_t_dyn ( get_type gen (["java"], "Int8") ) in
|
|
|
- let tshort = mt_to_t_dyn ( get_type gen (["java"], "Int16") ) in
|
|
|
- let tsingle = mt_to_t_dyn ( get_type gen ([], "Single") ) in
|
|
|
- let string_ext = get_cl ( get_type gen (["haxe";"lang"], "StringExt")) in
|
|
|
-
|
|
|
- let is_string t = match follow t with | TInst({ cl_path = ([], "String") }, []) -> true | _ -> false in
|
|
|
-
|
|
|
- let rec run e =
|
|
|
- match e.eexpr with
|
|
|
- (* for new NativeArray<T> issues *)
|
|
|
- | TNew(({ cl_path = (["java"], "NativeArray") } as cl), [t], el) when is_type_param t ->
|
|
|
- mk_cast (TInst(cl,[t])) (mk_cast t_dynamic ({ e with eexpr = TNew(cl, [t_empty], List.map run el) }))
|
|
|
-
|
|
|
- (* Std.int() *)
|
|
|
- | TCall(
|
|
|
- { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = "int" })) },
|
|
|
- [obj]
|
|
|
- ) ->
|
|
|
- run (mk_cast basic.tint obj)
|
|
|
- (* end Std.int() *)
|
|
|
-
|
|
|
- | TField( ef, FInstance({ cl_path = ([], "String") }, { cf_name = "length" }) ) ->
|
|
|
- { e with eexpr = TCall(Type.map_expr run e, []) }
|
|
|
- | TField( ef, field ) when field_name field = "length" && is_string ef.etype ->
|
|
|
- { e with eexpr = TCall(Type.map_expr run e, []) }
|
|
|
- | TCall( ( { eexpr = TField(ef, field) } as efield ), args ) when is_string ef.etype && String.get (field_name field) 0 = '_' ->
|
|
|
- let field = field_name field in
|
|
|
- { e with eexpr = TCall({ efield with eexpr = TField(run ef, FDynamic (String.sub field 1 ( (String.length field) - 1)) )}, List.map run args) }
|
|
|
- | TCall( ( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, field )) } as efield ), args ) ->
|
|
|
- let field = field.cf_name in
|
|
|
- (match field with
|
|
|
- | "charAt" | "charCodeAt" | "split" | "indexOf"
|
|
|
- | "lastIndexOf" | "substring" | "substr" ->
|
|
|
- { e with eexpr = TCall(mk_static_field_access_infer string_ext field e.epos [], [run ef] @ (List.map run args)) }
|
|
|
- | _ ->
|
|
|
- { e with eexpr = TCall(run efield, List.map run args) }
|
|
|
- )
|
|
|
-(* | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, { cf_name = ("toString") })) }, [] ) ->
|
|
|
- run ef *)
|
|
|
-
|
|
|
- | TCast(expr, m) when is_boxed_type e.etype ->
|
|
|
- (* let unboxed_type gen t tbyte tshort tchar tfloat = match follow t with *)
|
|
|
- run { e with etype = unboxed_type gen e.etype tbyte tshort tchar tsingle }
|
|
|
-
|
|
|
- | TCast(expr, _) when is_bool e.etype ->
|
|
|
- {
|
|
|
- eexpr = TCall(
|
|
|
- mk_static_field_access_infer runtime_cl "toBool" expr.epos [],
|
|
|
- [ run expr ]
|
|
|
- );
|
|
|
- etype = basic.tbool;
|
|
|
- epos = e.epos
|
|
|
- }
|
|
|
-
|
|
|
- | TCast(expr, _) when is_int_float gen e.etype && not (is_int_float gen expr.etype) ->
|
|
|
- let needs_cast = match gen.gfollow#run_f e.etype with
|
|
|
- | TInst _ -> false
|
|
|
- | _ -> true
|
|
|
- in
|
|
|
-
|
|
|
- let fun_name = if like_int e.etype then "toInt" else "toDouble" in
|
|
|
-
|
|
|
- let ret = {
|
|
|
- eexpr = TCall(
|
|
|
- mk_static_field_access_infer runtime_cl fun_name expr.epos [],
|
|
|
- [ run expr ]
|
|
|
- );
|
|
|
- etype = if fun_name = "toDouble" then basic.tfloat else basic.tint;
|
|
|
- epos = expr.epos
|
|
|
- } in
|
|
|
-
|
|
|
- if needs_cast then mk_cast e.etype ret else ret
|
|
|
-
|
|
|
- (*| TCast(expr, c) when is_int_float gen e.etype ->
|
|
|
- (* cases when float x = (float) (java.lang.Double val); *)
|
|
|
- (* FIXME: this fix is broken since it will fail on cases where float x = (float) (java.lang.Float val) or similar. FIX THIS *)
|
|
|
- let need_second_cast = match gen.gfollow#run_f e.etype with
|
|
|
- | TInst _ -> false
|
|
|
- | _ -> true
|
|
|
- in
|
|
|
- if need_second_cast then { e with eexpr = TCast(mk_cast (follow e.etype) (run expr), c) } else Type.map_expr run e*)
|
|
|
- | TBinop( (Ast.OpAssignOp OpAdd as op), e1, e2)
|
|
|
- | TBinop( (Ast.OpAdd as op), e1, e2) when is_string e.etype || is_string e1.etype || is_string e2.etype ->
|
|
|
- let is_assign = match op with Ast.OpAssignOp _ -> true | _ -> false in
|
|
|
- let mk_to_string e = { e with eexpr = TCall( mk_static_field_access_infer runtime_cl "toString" e.epos [], [run e] ); etype = gen.gcon.basic.tstring } in
|
|
|
- let check_cast e = match gen.greal_type e.etype with
|
|
|
- | TDynamic _
|
|
|
- | TAbstract({ a_path = ([], "Float") }, [])
|
|
|
- | TAbstract({ a_path = ([], "Single") }, []) ->
|
|
|
- mk_to_string e
|
|
|
- | _ -> run e
|
|
|
- in
|
|
|
-
|
|
|
- { e with eexpr = TBinop(op, (if is_assign then run e1 else check_cast e1), check_cast e2) }
|
|
|
- | TCast(expr, _) when is_string e.etype ->
|
|
|
- { e with eexpr = TCall( mk_static_field_access_infer runtime_cl "toString" expr.epos [], [run expr] ) }
|
|
|
-
|
|
|
- | TSwitch(cond, ecases, edefault) when is_string cond.etype ->
|
|
|
- (*let change_string_switch gen eswitch e1 ecases edefault =*)
|
|
|
- change_string_switch gen e (run cond) (List.map (fun (el,e) -> (el, run e)) ecases) (Option.map run edefault)
|
|
|
-
|
|
|
- | TBinop( (Ast.OpNotEq as op), e1, e2)
|
|
|
- | TBinop( (Ast.OpEq as op), e1, e2) when not (is_null e2 || is_null e1) && (is_string e1.etype || is_string e2.etype || is_equatable gen e1.etype || is_equatable gen e2.etype) ->
|
|
|
- let static = mk_static_field_access_infer (runtime_cl) "valEq" e1.epos [] in
|
|
|
- let eret = { eexpr = TCall(static, [run e1; run e2]); etype = gen.gcon.basic.tbool; epos=e.epos } in
|
|
|
- if op = Ast.OpNotEq then { eret with eexpr = TUnop(Ast.Not, Ast.Prefix, eret) } else eret
|
|
|
-
|
|
|
- | TBinop( (Ast.OpNotEq | Ast.OpEq as op), e1, e2) when is_cl e1.etype && is_cl e2.etype ->
|
|
|
- { e with eexpr = TBinop(op, mk_cast t_empty (run e1), mk_cast t_empty (run e2)) }
|
|
|
- | _ -> Type.map_expr run e
|
|
|
- in
|
|
|
- run
|
|
|
-
|
|
|
- let configure gen (mapping_func:texpr->texpr) =
|
|
|
- (if java_hash "Testing string hashCode implementation from haXe" <> (Int32.of_int 545883604) then assert false);
|
|
|
- let map e = Some(mapping_func e) in
|
|
|
- gen.gsyntax_filters#add ~name:name ~priority:(PCustom priority) map
|
|
|
+ let name = "java_specific"
|
|
|
+
|
|
|
+ let priority = solve_deps name [ DAfter ExpressionUnwrap.priority; DAfter ObjectDeclMap.priority; DAfter ArrayDeclSynf.priority; DBefore IntDivisionSynf.priority ]
|
|
|
+
|
|
|
+ let java_hash s =
|
|
|
+ let h = ref Int32.zero in
|
|
|
+ let thirtyone = Int32.of_int 31 in
|
|
|
+ for i = 0 to String.length s - 1 do
|
|
|
+ h := Int32.add (Int32.mul thirtyone !h) (Int32.of_int (int_of_char (String.unsafe_get s i)));
|
|
|
+ done;
|
|
|
+ !h
|
|
|
+
|
|
|
+ let rec is_final_return_expr is_switch e =
|
|
|
+ let is_final_return_expr = is_final_return_expr is_switch in
|
|
|
+ match e.eexpr with
|
|
|
+ | TReturn _
|
|
|
+ | TThrow _ -> true
|
|
|
+ (* this is hack to not use 'break' on switch cases *)
|
|
|
+ | TLocal { v_name = "__fallback__" } when is_switch -> true
|
|
|
+ | TCall( { eexpr = TLocal { v_name = "__goto__" } }, _ ) -> true
|
|
|
+ | TParenthesis p | TMeta (_,p) -> is_final_return_expr p
|
|
|
+ | TBlock bl -> is_final_return_block is_switch bl
|
|
|
+ | TSwitch (_, el_e_l, edef) ->
|
|
|
+ List.for_all (fun (_,e) -> is_final_return_expr e) el_e_l && Option.map_default is_final_return_expr false edef
|
|
|
+(* | TMatch (_, _, il_vl_e_l, edef) ->
|
|
|
+ List.for_all (fun (_,_,e) -> is_final_return_expr e)il_vl_e_l && Option.map_default is_final_return_expr false edef *)
|
|
|
+ | TIf (_,eif, Some eelse) ->
|
|
|
+ is_final_return_expr eif && is_final_return_expr eelse
|
|
|
+ | TFor (_,_,e) ->
|
|
|
+ is_final_return_expr e
|
|
|
+ | TWhile (_,e,_) ->
|
|
|
+ is_final_return_expr e
|
|
|
+ | TFunction tf ->
|
|
|
+ is_final_return_expr tf.tf_expr
|
|
|
+ | TTry (e, ve_l) ->
|
|
|
+ is_final_return_expr e && List.for_all (fun (_,e) -> is_final_return_expr e) ve_l
|
|
|
+ | _ -> false
|
|
|
+
|
|
|
+ and is_final_return_block is_switch el =
|
|
|
+ match el with
|
|
|
+ | [] -> false
|
|
|
+ | final :: [] -> is_final_return_expr is_switch final
|
|
|
+ | hd :: tl -> is_final_return_block is_switch tl
|
|
|
+
|
|
|
+ let is_null e = match e.eexpr with | TConst(TNull) -> true | _ -> false
|
|
|
+
|
|
|
+ let rec is_equatable gen t =
|
|
|
+ match follow t with
|
|
|
+ | TInst(cl,_) ->
|
|
|
+ if cl.cl_path = (["haxe";"lang"], "IEquatable") then
|
|
|
+ true
|
|
|
+ else
|
|
|
+ List.exists (fun (cl,p) -> is_equatable gen (TInst(cl,p))) cl.cl_implements
|
|
|
+ || (match cl.cl_super with | Some(cl,p) -> is_equatable gen (TInst(cl,p)) | None -> false)
|
|
|
+ | _ -> false
|
|
|
+
|
|
|
+ (*
|
|
|
+ Changing string switch
|
|
|
+ will take an expression like
|
|
|
+ switch(str)
|
|
|
+ {
|
|
|
+ case "a":
|
|
|
+ case "b":
|
|
|
+ }
|
|
|
+
|
|
|
+ and modify it to:
|
|
|
+ {
|
|
|
+ var execute_def = true;
|
|
|
+ switch(str.hashCode())
|
|
|
+ {
|
|
|
+ case (hashcode of a):
|
|
|
+ if (str == "a")
|
|
|
+ {
|
|
|
+ execute_def = false;
|
|
|
+ ..code here
|
|
|
+ } //else if (str == otherVariableWithSameHashCode) {
|
|
|
+ ...
|
|
|
+ }
|
|
|
+ ...
|
|
|
+ }
|
|
|
+ if (execute_def)
|
|
|
+ {
|
|
|
+ ..default code
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ this might actually be slower in some cases than a if/else approach, but it scales well and as a bonus,
|
|
|
+ hashCode in java are cached, so we only have the performance hit once to cache it.
|
|
|
+ *)
|
|
|
+ let change_string_switch gen eswitch e1 ecases edefault =
|
|
|
+ let basic = gen.gcon.basic in
|
|
|
+ let is_final_ret = is_final_return_expr false eswitch in
|
|
|
+
|
|
|
+ let has_default = is_some edefault in
|
|
|
+ let block = ref [] in
|
|
|
+ let local = match e1.eexpr with
|
|
|
+ | TLocal _ -> e1
|
|
|
+ | _ ->
|
|
|
+ let var = mk_temp gen "svar" e1.etype in
|
|
|
+ let added = { e1 with eexpr = TVar(var, Some(e1)); etype = basic.tvoid } in
|
|
|
+ let local = mk_local var e1.epos in
|
|
|
+ block := added :: !block;
|
|
|
+ local
|
|
|
+ in
|
|
|
+ let execute_def_var = mk_temp gen "executeDef" gen.gcon.basic.tbool in
|
|
|
+ let execute_def = mk_local execute_def_var e1.epos in
|
|
|
+ let execute_def_set = { eexpr = TBinop(Ast.OpAssign, execute_def, { eexpr = TConst(TBool false); etype = basic.tbool; epos = e1.epos }); etype = basic.tbool; epos = e1.epos } in
|
|
|
+
|
|
|
+ let hash_cache = ref None in
|
|
|
+
|
|
|
+ let local_hashcode = ref { local with
|
|
|
+ eexpr = TCall({ local with
|
|
|
+ eexpr = TField(local, FDynamic "hashCode");
|
|
|
+ etype = TFun([], basic.tint);
|
|
|
+ }, []);
|
|
|
+ etype = basic.tint
|
|
|
+ } in
|
|
|
+
|
|
|
+ let get_hash_cache () =
|
|
|
+ match !hash_cache with
|
|
|
+ | Some c -> c
|
|
|
+ | None ->
|
|
|
+ let var = mk_temp gen "hash" basic.tint in
|
|
|
+ let cond = !local_hashcode in
|
|
|
+ block := { eexpr = TVar(var, Some cond); etype = basic.tvoid; epos = local.epos } :: !block;
|
|
|
+ let local = mk_local var local.epos in
|
|
|
+ local_hashcode := local;
|
|
|
+ hash_cache := Some local;
|
|
|
+ local
|
|
|
+ in
|
|
|
+
|
|
|
+ let has_case = ref false in
|
|
|
+ (* first we need to reorder all cases so all collisions are close to each other *)
|
|
|
+
|
|
|
+ let get_str e = match e.eexpr with | TConst(TString s) -> s | _ -> assert false in
|
|
|
+ let has_conflict = ref false in
|
|
|
+
|
|
|
+ let rec reorder_cases unordered ordered =
|
|
|
+ match unordered with
|
|
|
+ | [] -> ordered
|
|
|
+ | (el, e) :: tl ->
|
|
|
+ let current = Hashtbl.create 1 in
|
|
|
+ List.iter (fun e ->
|
|
|
+ let str = get_str e in
|
|
|
+ let hash = java_hash str in
|
|
|
+ Hashtbl.add current hash true
|
|
|
+ ) el;
|
|
|
+
|
|
|
+ let rec extract_fields cases found_cases ret_cases =
|
|
|
+ match cases with
|
|
|
+ | [] -> found_cases, ret_cases
|
|
|
+ | (el, e) :: tl ->
|
|
|
+ if List.exists (fun e -> Hashtbl.mem current (java_hash (get_str e)) ) el then begin
|
|
|
+ has_conflict := true;
|
|
|
+ List.iter (fun e -> Hashtbl.add current (java_hash (get_str e)) true) el;
|
|
|
+ extract_fields tl ( (el, e) :: found_cases ) ret_cases
|
|
|
+ end else
|
|
|
+ extract_fields tl found_cases ( (el, e) :: ret_cases )
|
|
|
+ in
|
|
|
+ let found, remaining = extract_fields tl [] [] in
|
|
|
+ let ret = if found <> [] then
|
|
|
+ let ret = List.sort (fun (e1,_) (e2,_) -> compare (List.length e2) (List.length e1) ) ( (el, e) :: found ) in
|
|
|
+ let rec loop ret acc =
|
|
|
+ match ret with
|
|
|
+ | (el, e) :: ( (_,_) :: _ as tl ) -> loop tl ( (true, el, e) :: acc )
|
|
|
+ | (el, e) :: [] -> ( (false, el, e) :: acc )
|
|
|
+ | _ -> assert false
|
|
|
+ in
|
|
|
+ List.rev (loop ret [])
|
|
|
+ else
|
|
|
+ (false, el, e) :: []
|
|
|
+ in
|
|
|
+
|
|
|
+ reorder_cases remaining (ordered @ ret)
|
|
|
+ in
|
|
|
+
|
|
|
+ let already_in_cases = Hashtbl.create 0 in
|
|
|
+ let change_case (has_fallback, el, e) =
|
|
|
+ let conds, el = List.fold_left (fun (conds,el) e ->
|
|
|
+ has_case := true;
|
|
|
+ match e.eexpr with
|
|
|
+ | TConst(TString s) ->
|
|
|
+ let hashed = java_hash s in
|
|
|
+ let equals_test = {
|
|
|
+ eexpr = TCall({ e with eexpr = TField(local, FDynamic "equals"); etype = TFun(["obj",false,t_dynamic],basic.tbool) }, [ e ]);
|
|
|
+ etype = basic.tbool;
|
|
|
+ epos = e.epos
|
|
|
+ } in
|
|
|
+
|
|
|
+ let hashed_expr = { eexpr = TConst(TInt hashed); etype = basic.tint; epos = e.epos } in
|
|
|
+ let hashed_exprs = if !has_conflict then begin
|
|
|
+ if Hashtbl.mem already_in_cases hashed then
|
|
|
+ el
|
|
|
+ else begin
|
|
|
+ Hashtbl.add already_in_cases hashed true;
|
|
|
+ hashed_expr :: el
|
|
|
+ end
|
|
|
+ end else hashed_expr :: el in
|
|
|
+
|
|
|
+ let conds = match conds with
|
|
|
+ | None -> equals_test
|
|
|
+ | Some c ->
|
|
|
+ (*
|
|
|
+ if there is more than one case, we should test first if hash equals to the one specified.
|
|
|
+ This way we can save a heavier string compare
|
|
|
+ *)
|
|
|
+ let equals_test = mk_paren {
|
|
|
+ eexpr = TBinop(Ast.OpBoolAnd, { eexpr = TBinop(Ast.OpEq, get_hash_cache(), hashed_expr); etype = basic.tbool; epos = e.epos }, equals_test);
|
|
|
+ etype = basic.tbool;
|
|
|
+ epos = e.epos;
|
|
|
+ } in
|
|
|
+
|
|
|
+ { eexpr = TBinop(Ast.OpBoolOr, equals_test, c); etype = basic.tbool; epos = e1.epos }
|
|
|
+ in
|
|
|
+
|
|
|
+ Some conds, hashed_exprs
|
|
|
+ | _ -> assert false
|
|
|
+ ) (None,[]) el in
|
|
|
+ let e = if has_default then Type.concat execute_def_set e else e in
|
|
|
+ let e = if !has_conflict then Type.concat e { e with eexpr = TBreak; etype = basic.tvoid } else e in
|
|
|
+ let e = {
|
|
|
+ eexpr = TIf(get conds, e, None);
|
|
|
+ etype = basic.tvoid;
|
|
|
+ epos = e.epos
|
|
|
+ } in
|
|
|
+
|
|
|
+ let e = if has_fallback then { e with eexpr = TBlock([ e; mk_local (alloc_var "__fallback__" t_dynamic) e.epos]) } else e in
|
|
|
+
|
|
|
+ (el, e)
|
|
|
+ in
|
|
|
+
|
|
|
+ let switch = { eswitch with
|
|
|
+ eexpr = TSwitch(!local_hashcode, List.map change_case (reorder_cases ecases []), None);
|
|
|
+ } in
|
|
|
+ (if !has_case then begin
|
|
|
+ (if has_default then block := { e1 with eexpr = TVar(execute_def_var, Some({ e1 with eexpr = TConst(TBool true); etype = basic.tbool })); etype = basic.tvoid } :: !block);
|
|
|
+ block := switch :: !block
|
|
|
+ end);
|
|
|
+ (match edefault with
|
|
|
+ | None -> ()
|
|
|
+ | Some edef when not !has_case ->
|
|
|
+ block := edef :: !block
|
|
|
+ | Some edef ->
|
|
|
+ let eelse = if is_final_ret then Some { eexpr = TThrow { eexpr = TConst(TNull); etype = t_dynamic; epos = edef.epos }; etype = basic.tvoid; epos = edef.epos } else None in
|
|
|
+ block := { edef with eexpr = TIf(execute_def, edef, eelse); etype = basic.tvoid } :: !block
|
|
|
+ );
|
|
|
+ { eswitch with eexpr = TBlock(List.rev !block) }
|
|
|
+
|
|
|
+
|
|
|
+ let get_cl_from_t t =
|
|
|
+ match follow t with
|
|
|
+ | TInst(cl,_) -> cl
|
|
|
+ | _ -> assert false
|
|
|
+
|
|
|
+ let traverse gen runtime_cl =
|
|
|
+ let basic = gen.gcon.basic in
|
|
|
+ (* let tchar = mt_to_t_dyn ( get_type gen (["java"], "Char16") ) in *)
|
|
|
+ (* let tbyte = mt_to_t_dyn ( get_type gen (["java"], "Int8") ) in *)
|
|
|
+ (* let tshort = mt_to_t_dyn ( get_type gen (["java"], "Int16") ) in *)
|
|
|
+ (* let tsingle = mt_to_t_dyn ( get_type gen ([], "Single") ) in *)
|
|
|
+ let string_ext = get_cl ( get_type gen (["haxe";"lang"], "StringExt")) in
|
|
|
+
|
|
|
+ let is_string t = match follow t with | TInst({ cl_path = ([], "String") }, []) -> true | _ -> false in
|
|
|
+
|
|
|
+ let rec run e =
|
|
|
+ match e.eexpr with
|
|
|
+ (* for new NativeArray<T> issues *)
|
|
|
+ | TNew(({ cl_path = (["java"], "NativeArray") } as cl), [t], el) when is_type_param t ->
|
|
|
+ mk_cast (TInst(cl,[t])) (mk_cast t_dynamic ({ e with eexpr = TNew(cl, [t_empty], List.map run el) }))
|
|
|
+
|
|
|
+ (* Std.int() *)
|
|
|
+ | TCall(
|
|
|
+ { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = "int" })) },
|
|
|
+ [obj]
|
|
|
+ ) ->
|
|
|
+ run (mk_cast basic.tint obj)
|
|
|
+ (* end Std.int() *)
|
|
|
+
|
|
|
+ | TField( ef, FInstance({ cl_path = ([], "String") }, _, { cf_name = "length" }) ) ->
|
|
|
+ { e with eexpr = TCall(Type.map_expr run e, []) }
|
|
|
+ | TField( ef, field ) when field_name field = "length" && is_string ef.etype ->
|
|
|
+ { e with eexpr = TCall(Type.map_expr run e, []) }
|
|
|
+ | TCall( ( { eexpr = TField(ef, field) } as efield ), args ) when is_string ef.etype && String.get (field_name field) 0 = '_' ->
|
|
|
+ let field = field_name field in
|
|
|
+ { e with eexpr = TCall({ efield with eexpr = TField(run ef, FDynamic (String.sub field 1 ( (String.length field) - 1)) )}, List.map run args) }
|
|
|
+ | TCall( ( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, field )) } as efield ), args ) ->
|
|
|
+ let field = field.cf_name in
|
|
|
+ (match field with
|
|
|
+ | "charAt" | "charCodeAt" | "split" | "indexOf"
|
|
|
+ | "lastIndexOf" | "substring" | "substr" ->
|
|
|
+ { e with eexpr = TCall(mk_static_field_access_infer string_ext field e.epos [], [run ef] @ (List.map run args)) }
|
|
|
+ | _ ->
|
|
|
+ { e with eexpr = TCall(run efield, List.map run args) }
|
|
|
+ )
|
|
|
+(* | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, { cf_name = ("toString") })) }, [] ) ->
|
|
|
+ run ef *)
|
|
|
+
|
|
|
+ (* | TCast(expr, m) when is_boxed_type e.etype -> *)
|
|
|
+ (* (* let unboxed_type gen t tbyte tshort tchar tfloat = match follow t with *) *)
|
|
|
+ (* run { e with etype = unboxed_type gen e.etype tbyte tshort tchar tsingle } *)
|
|
|
+
|
|
|
+ | TCast(expr, _) when is_bool e.etype ->
|
|
|
+ {
|
|
|
+ eexpr = TCall(
|
|
|
+ mk_static_field_access_infer runtime_cl "toBool" expr.epos [],
|
|
|
+ [ run expr ]
|
|
|
+ );
|
|
|
+ etype = basic.tbool;
|
|
|
+ epos = e.epos
|
|
|
+ }
|
|
|
+
|
|
|
+ | TCast(expr, _) when is_int_float gen e.etype && not (is_int_float gen expr.etype) ->
|
|
|
+ let needs_cast = match gen.gfollow#run_f e.etype with
|
|
|
+ | TInst _ -> false
|
|
|
+ | _ -> true
|
|
|
+ in
|
|
|
+
|
|
|
+ let fun_name = if like_int e.etype then "toInt" else "toDouble" in
|
|
|
+
|
|
|
+ let ret = {
|
|
|
+ eexpr = TCall(
|
|
|
+ mk_static_field_access_infer runtime_cl fun_name expr.epos [],
|
|
|
+ [ run expr ]
|
|
|
+ );
|
|
|
+ etype = if fun_name = "toDouble" then basic.tfloat else basic.tint;
|
|
|
+ epos = expr.epos
|
|
|
+ } in
|
|
|
+
|
|
|
+ if needs_cast then mk_cast e.etype ret else ret
|
|
|
+
|
|
|
+ (*| TCast(expr, c) when is_int_float gen e.etype ->
|
|
|
+ (* cases when float x = (float) (java.lang.Double val); *)
|
|
|
+ (* FIXME: this fix is broken since it will fail on cases where float x = (float) (java.lang.Float val) or similar. FIX THIS *)
|
|
|
+ let need_second_cast = match gen.gfollow#run_f e.etype with
|
|
|
+ | TInst _ -> false
|
|
|
+ | _ -> true
|
|
|
+ in
|
|
|
+ if need_second_cast then { e with eexpr = TCast(mk_cast (follow e.etype) (run expr), c) } else Type.map_expr run e*)
|
|
|
+ | TBinop( (Ast.OpAssignOp OpAdd as op), e1, e2)
|
|
|
+ | TBinop( (Ast.OpAdd as op), e1, e2) when is_string e.etype || is_string e1.etype || is_string e2.etype ->
|
|
|
+ let is_assign = match op with Ast.OpAssignOp _ -> true | _ -> false in
|
|
|
+ let mk_to_string e = { e with eexpr = TCall( mk_static_field_access_infer runtime_cl "toString" e.epos [], [run e] ); etype = gen.gcon.basic.tstring } in
|
|
|
+ let check_cast e = match gen.greal_type e.etype with
|
|
|
+ | TDynamic _
|
|
|
+ | TAbstract({ a_path = ([], "Float") }, [])
|
|
|
+ | TAbstract({ a_path = ([], "Single") }, []) ->
|
|
|
+ mk_to_string e
|
|
|
+ | _ -> run e
|
|
|
+ in
|
|
|
+
|
|
|
+ { e with eexpr = TBinop(op, (if is_assign then run e1 else check_cast e1), check_cast e2) }
|
|
|
+ | TCast(expr, _) when is_string e.etype ->
|
|
|
+ { e with eexpr = TCall( mk_static_field_access_infer runtime_cl "toString" expr.epos [], [run expr] ) }
|
|
|
+
|
|
|
+ | TSwitch(cond, ecases, edefault) when is_string cond.etype ->
|
|
|
+ (*let change_string_switch gen eswitch e1 ecases edefault =*)
|
|
|
+ change_string_switch gen e (run cond) (List.map (fun (el,e) -> (el, run e)) ecases) (Option.map run edefault)
|
|
|
+
|
|
|
+ | TBinop( (Ast.OpNotEq as op), e1, e2)
|
|
|
+ | TBinop( (Ast.OpEq as op), e1, e2) when not (is_null e2 || is_null e1) && (is_string e1.etype || is_string e2.etype || is_equatable gen e1.etype || is_equatable gen e2.etype) ->
|
|
|
+ let static = mk_static_field_access_infer (runtime_cl) "valEq" e1.epos [] in
|
|
|
+ let eret = { eexpr = TCall(static, [run e1; run e2]); etype = gen.gcon.basic.tbool; epos=e.epos } in
|
|
|
+ if op = Ast.OpNotEq then { eret with eexpr = TUnop(Ast.Not, Ast.Prefix, eret) } else eret
|
|
|
+
|
|
|
+ | TBinop( (Ast.OpNotEq | Ast.OpEq as op), e1, e2) when is_cl e1.etype && is_cl e2.etype ->
|
|
|
+ { e with eexpr = TBinop(op, mk_cast t_empty (run e1), mk_cast t_empty (run e2)) }
|
|
|
+ | _ -> Type.map_expr run e
|
|
|
+ in
|
|
|
+ run
|
|
|
+
|
|
|
+ let configure gen (mapping_func:texpr->texpr) =
|
|
|
+ (if java_hash "Testing string hashCode implementation from haXe" <> (Int32.of_int 545883604) then assert false);
|
|
|
+ let map e = Some(mapping_func e) in
|
|
|
+ gen.gsyntax_filters#add ~name:name ~priority:(PCustom priority) map
|
|
|
|
|
|
end;;
|
|
|
|
|
|
+
|
|
|
+(* ******************************************* *)
|
|
|
+(* handle @:throws *)
|
|
|
+(* ******************************************* *)
|
|
|
+let rec is_checked_exc cl =
|
|
|
+ match cl.cl_path with
|
|
|
+ | ["java";"lang"],"RuntimeException" ->
|
|
|
+ false
|
|
|
+ | ["java";"lang"],"Throwable" ->
|
|
|
+ true
|
|
|
+ | _ -> match cl.cl_super with
|
|
|
+ | None -> false
|
|
|
+ | Some(c,_) -> is_checked_exc c
|
|
|
+
|
|
|
+let rec cls_any_super cl supers =
|
|
|
+ PMap.mem cl.cl_path supers || match cl.cl_super with
|
|
|
+ | None -> false
|
|
|
+ | Some(c,_) -> cls_any_super c supers
|
|
|
+
|
|
|
+let rec handle_throws gen cf =
|
|
|
+ List.iter (handle_throws gen) cf.cf_overloads;
|
|
|
+ match cf.cf_expr with
|
|
|
+ | Some ({ eexpr = TFunction(tf) } as e) ->
|
|
|
+ let rec collect_throws acc = function
|
|
|
+ | (Meta.Throws, [Ast.EConst (Ast.String path), _],_) :: meta -> (try
|
|
|
+ collect_throws (get_cl ( get_type gen (parse_path path)) :: acc) meta
|
|
|
+ with | Not_found | TypeNotFound _ ->
|
|
|
+ collect_throws acc meta)
|
|
|
+ | [] ->
|
|
|
+ acc
|
|
|
+ | _ :: meta ->
|
|
|
+ collect_throws acc meta
|
|
|
+ in
|
|
|
+ let cf_throws = collect_throws [] cf.cf_meta in
|
|
|
+ let throws = ref (List.fold_left (fun map cl ->
|
|
|
+ PMap.add cl.cl_path cl map
|
|
|
+ ) PMap.empty cf_throws) in
|
|
|
+ let rec iter e = match e.eexpr with
|
|
|
+ | TTry(etry,ecatches) ->
|
|
|
+ let old = !throws in
|
|
|
+ let needs_check_block = ref true in
|
|
|
+ List.iter (fun (v,e) ->
|
|
|
+ Type.iter iter e;
|
|
|
+ match follow (run_follow gen v.v_type) with
|
|
|
+ | TInst({ cl_path = ["java";"lang"],"Throwable" },_)
|
|
|
+ | TDynamic _ ->
|
|
|
+ needs_check_block := false
|
|
|
+ | TInst(c,_) when is_checked_exc c ->
|
|
|
+ throws := PMap.add c.cl_path c !throws
|
|
|
+ | _ ->()
|
|
|
+ ) ecatches;
|
|
|
+ if !needs_check_block then Type.iter iter etry;
|
|
|
+ throws := old
|
|
|
+ | TField(e, (FInstance(_,_,f) | FStatic(_,f) | FClosure(_,f))) ->
|
|
|
+ let tdefs = collect_throws [] f.cf_meta in
|
|
|
+ if tdefs <> [] && not (List.for_all (fun c -> cls_any_super c !throws) tdefs) then
|
|
|
+ raise Exit;
|
|
|
+ Type.iter iter e
|
|
|
+ | TThrow e -> (match follow (run_follow gen e.etype) with
|
|
|
+ | TInst(c,_) when is_checked_exc c && not (cls_any_super c !throws) ->
|
|
|
+ raise Exit
|
|
|
+ | _ -> iter e)
|
|
|
+ | _ -> Type.iter iter e
|
|
|
+ in
|
|
|
+ (try
|
|
|
+ Type.iter iter e
|
|
|
+ with | Exit -> (* needs typed exception to be caught *)
|
|
|
+ let throwable = get_cl (get_type gen (["java";"lang"],"Throwable")) in
|
|
|
+ let catch_var = alloc_var "typedException" (TInst(throwable,[])) in
|
|
|
+ let rethrow = mk_local catch_var e.epos in
|
|
|
+ let hx_exception = get_cl (get_type gen (["haxe";"lang"], "HaxeException")) in
|
|
|
+ let wrap_static = mk_static_field_access (hx_exception) "wrap" (TFun([("obj",false,t_dynamic)], t_dynamic)) rethrow.epos in
|
|
|
+ let wrapped = { rethrow with eexpr = TThrow { rethrow with eexpr = TCall(wrap_static, [rethrow]) }; } in
|
|
|
+ let map_throws cl =
|
|
|
+ let var = alloc_var "typedException" (TInst(cl,List.map (fun _ -> t_dynamic) cl.cl_params)) in
|
|
|
+ var, { tf.tf_expr with eexpr = TThrow (mk_local var e.epos) }
|
|
|
+ in
|
|
|
+ cf.cf_expr <- Some { e with
|
|
|
+ eexpr = TFunction({ tf with
|
|
|
+ tf_expr = mk_block { tf.tf_expr with eexpr = TTry(tf.tf_expr, List.map (map_throws) cf_throws @ [catch_var, wrapped]) }
|
|
|
+ })
|
|
|
+ })
|
|
|
+ | _ -> ()
|
|
|
+
|
|
|
+
|
|
|
let connecting_string = "?" (* ? see list here http://www.fileformat.info/info/unicode/category/index.htm and here for C# http://msdn.microsoft.com/en-us/library/aa664670.aspx *)
|
|
|
-let default_package = "java" (* I'm having this separated as I'm still not happy with having a cs package. Maybe dotnet would be better? *)
|
|
|
+let default_package = "java"
|
|
|
let strict_mode = ref false (* strict mode is so we can check for unexpected information *)
|
|
|
|
|
|
-(* reserved c# words *)
|
|
|
+(* reserved java words *)
|
|
|
let reserved = let res = Hashtbl.create 120 in
|
|
|
- List.iter (fun lst -> Hashtbl.add res lst ("_" ^ lst)) ["abstract"; "assert"; "boolean"; "break"; "byte"; "case"; "catch"; "char"; "class";
|
|
|
- "const"; "continue"; "default"; "do"; "double"; "else"; "enum"; "extends"; "final";
|
|
|
- "false"; "finally"; "float"; "for"; "goto"; "if"; "implements"; "import"; "instanceof"; "int";
|
|
|
- "interface"; "long"; "native"; "new"; "null"; "package"; "private"; "protected"; "public"; "return"; "short";
|
|
|
- "static"; "strictfp"; "super"; "switch"; "synchronized"; "this"; "throw"; "throws"; "transient"; "true"; "try";
|
|
|
- "void"; "volatile"; "while"; ];
|
|
|
- res
|
|
|
+ List.iter (fun lst -> Hashtbl.add res lst ("_" ^ lst)) ["abstract"; "assert"; "boolean"; "break"; "byte"; "case"; "catch"; "char"; "class";
|
|
|
+ "const"; "continue"; "default"; "do"; "double"; "else"; "enum"; "extends"; "final";
|
|
|
+ "false"; "finally"; "float"; "for"; "goto"; "if"; "implements"; "import"; "instanceof"; "int";
|
|
|
+ "interface"; "long"; "native"; "new"; "null"; "package"; "private"; "protected"; "public"; "return"; "short";
|
|
|
+ "static"; "strictfp"; "super"; "switch"; "synchronized"; "this"; "throw"; "throws"; "transient"; "true"; "try";
|
|
|
+ "void"; "volatile"; "while"; ];
|
|
|
+ res
|
|
|
|
|
|
let dynamic_anon = TAnon( { a_fields = PMap.empty; a_status = ref Closed } )
|
|
|
|
|
|
let rec get_class_modifiers meta cl_type cl_access cl_modifiers =
|
|
|
- match meta with
|
|
|
- | [] -> cl_type,cl_access,cl_modifiers
|
|
|
- (*| (Meta.Struct,[],_) :: meta -> get_class_modifiers meta "struct" cl_access cl_modifiers*)
|
|
|
- | (Meta.Protected,[],_) :: meta -> get_class_modifiers meta cl_type "protected" cl_modifiers
|
|
|
- | (Meta.Internal,[],_) :: meta -> get_class_modifiers meta cl_type "" cl_modifiers
|
|
|
- (* no abstract for now | (":abstract",[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("abstract" :: cl_modifiers)
|
|
|
- | (Meta.Static,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("static" :: cl_modifiers) TODO: support those types *)
|
|
|
- | (Meta.Final,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("final" :: cl_modifiers)
|
|
|
- | _ :: meta -> get_class_modifiers meta cl_type cl_access cl_modifiers
|
|
|
+ match meta with
|
|
|
+ | [] -> cl_type,cl_access,cl_modifiers
|
|
|
+ (*| (Meta.Struct,[],_) :: meta -> get_class_modifiers meta "struct" cl_access cl_modifiers*)
|
|
|
+ | (Meta.Protected,[],_) :: meta -> get_class_modifiers meta cl_type "protected" cl_modifiers
|
|
|
+ | (Meta.Internal,[],_) :: meta -> get_class_modifiers meta cl_type "" cl_modifiers
|
|
|
+ (* no abstract for now | (":abstract",[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("abstract" :: cl_modifiers)
|
|
|
+ | (Meta.Static,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("static" :: cl_modifiers) TODO: support those types *)
|
|
|
+ | (Meta.Final,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("final" :: cl_modifiers)
|
|
|
+ | _ :: meta -> get_class_modifiers meta cl_type cl_access cl_modifiers
|
|
|
|
|
|
let rec get_fun_modifiers meta access modifiers =
|
|
|
- match meta with
|
|
|
- | [] -> access,modifiers
|
|
|
- | (Meta.Protected,[],_) :: meta -> get_fun_modifiers meta "protected" modifiers
|
|
|
- | (Meta.Internal,[],_) :: meta -> get_fun_modifiers meta "" modifiers
|
|
|
- (*| (Meta.ReadOnly,[],_) :: meta -> get_fun_modifiers meta access ("readonly" :: modifiers)*)
|
|
|
- (*| (Meta.Unsafe,[],_) :: meta -> get_fun_modifiers meta access ("unsafe" :: modifiers)*)
|
|
|
- | (Meta.Volatile,[],_) :: meta -> get_fun_modifiers meta access ("volatile" :: modifiers)
|
|
|
- | (Meta.Transient,[],_) :: meta -> get_fun_modifiers meta access ("transient" :: modifiers)
|
|
|
- | (Meta.Native,[],_) :: meta -> get_fun_modifiers meta access ("native" :: modifiers)
|
|
|
- | _ :: meta -> get_fun_modifiers meta access modifiers
|
|
|
+ match meta with
|
|
|
+ | [] -> access,modifiers
|
|
|
+ | (Meta.Protected,[],_) :: meta -> get_fun_modifiers meta "protected" modifiers
|
|
|
+ | (Meta.Internal,[],_) :: meta -> get_fun_modifiers meta "" modifiers
|
|
|
+ | (Meta.ReadOnly,[],_) :: meta -> get_fun_modifiers meta access ("final" :: modifiers)
|
|
|
+ (*| (Meta.Unsafe,[],_) :: meta -> get_fun_modifiers meta access ("unsafe" :: modifiers)*)
|
|
|
+ | (Meta.Volatile,[],_) :: meta -> get_fun_modifiers meta access ("volatile" :: modifiers)
|
|
|
+ | (Meta.Transient,[],_) :: meta -> get_fun_modifiers meta access ("transient" :: modifiers)
|
|
|
+ | (Meta.Native,[],_) :: meta -> get_fun_modifiers meta access ("native" :: modifiers)
|
|
|
+ | _ :: meta -> get_fun_modifiers meta access modifiers
|
|
|
|
|
|
(* this was the way I found to pass the generator context to be accessible across all functions here *)
|
|
|
(* so 'configure' is almost 'top-level' and will have all functions needed to make this work *)
|
|
|
let configure gen =
|
|
|
- let basic = gen.gcon.basic in
|
|
|
-
|
|
|
- let fn_cl = get_cl (get_type gen (["haxe";"lang"],"Function")) in
|
|
|
-
|
|
|
- let runtime_cl = get_cl (get_type gen (["haxe";"lang"],"Runtime")) in
|
|
|
-
|
|
|
- (*let string_ref = get_cl ( get_type gen (["haxe";"lang"], "StringRefl")) in*)
|
|
|
-
|
|
|
- let ti64 = match ( get_type gen (["haxe";"_Int64"], "NativeInt64") ) with | TTypeDecl t -> TType(t,[]) | _ -> assert false in
|
|
|
-
|
|
|
- let has_tdynamic params =
|
|
|
- List.exists (fun e -> match run_follow gen e with | TDynamic _ -> true | _ -> false) params
|
|
|
- in
|
|
|
-
|
|
|
- (*
|
|
|
- The type parameters always need to be changed to their boxed counterparts
|
|
|
- *)
|
|
|
- let change_param_type md params =
|
|
|
- match md with
|
|
|
- | TClassDecl( { cl_path = (["java"], "NativeArray") } ) -> params
|
|
|
- | _ ->
|
|
|
- match params with
|
|
|
- | [] -> []
|
|
|
- | _ ->
|
|
|
- if has_tdynamic params then List.map (fun _ -> t_dynamic) params else
|
|
|
- List.map (fun t ->
|
|
|
- let f_t = gen.gfollow#run_f t in
|
|
|
- match f_t with
|
|
|
- | TEnum ({ e_path = ([], "Bool") }, [])
|
|
|
- | TAbstract ({ a_path = ([], "Bool") },[])
|
|
|
- | TInst ({ cl_path = ([],"Float") },[])
|
|
|
- | TAbstract ({ a_path = ([],"Float") },[])
|
|
|
- | TInst ({ cl_path = ["haxe"],"Int32" },[])
|
|
|
- | TInst ({ cl_path = ["haxe"],"Int64" },[])
|
|
|
- | TInst ({ cl_path = ([],"Int") },[])
|
|
|
- | TAbstract ({ a_path = ([],"Int") },[])
|
|
|
- | TType ({ t_path = ["haxe";"_Int64"], "NativeInt64" },[])
|
|
|
- | TAbstract ({ a_path = ["haxe";"_Int64"], "NativeInt64" },[])
|
|
|
- | TType ({ t_path = ["java"],"Int8" },[])
|
|
|
- | TAbstract ({ a_path = ["java"],"Int8" },[])
|
|
|
- | TType ({ t_path = ["java"],"Int16" },[])
|
|
|
- | TAbstract ({ a_path = ["java"],"Int16" },[])
|
|
|
- | TType ({ t_path = ["java"],"Char16" },[])
|
|
|
- | TAbstract ({ a_path = ["java"],"Char16" },[])
|
|
|
- | TType ({ t_path = [],"Single" },[])
|
|
|
- | TAbstract ({ a_path = [],"Single" },[]) ->
|
|
|
- basic.tnull f_t
|
|
|
- (*| TType ({ t_path = [], "Null"*)
|
|
|
- | TInst (cl, ((_ :: _) as p)) ->
|
|
|
- TInst(cl, List.map (fun _ -> t_dynamic) p)
|
|
|
- | TEnum (e, ((_ :: _) as p)) ->
|
|
|
- TEnum(e, List.map (fun _ -> t_dynamic) p)
|
|
|
- | _ -> t
|
|
|
- ) params
|
|
|
- in
|
|
|
-
|
|
|
- let change_clname name =
|
|
|
- String.map (function | '$' -> '.' | c -> c) name
|
|
|
- in
|
|
|
- let change_id name = try Hashtbl.find reserved name with | Not_found -> name in
|
|
|
- let rec change_ns ns = match ns with
|
|
|
- | [] -> ["haxe"; "root"]
|
|
|
- | _ -> List.map change_id ns
|
|
|
- in
|
|
|
- let change_field = change_id in
|
|
|
-
|
|
|
- let write_id w name = write w (change_id name) in
|
|
|
-
|
|
|
- let write_field w name = write w (change_field name) in
|
|
|
-
|
|
|
- gen.gfollow#add ~name:"follow_basic" (fun t -> match t with
|
|
|
- | TEnum ({ e_path = ([], "Bool") }, [])
|
|
|
- | TAbstract ({ a_path = ([], "Bool") },[])
|
|
|
- | TEnum ({ e_path = ([], "Void") }, [])
|
|
|
- | TAbstract ({ a_path = ([], "Void") },[])
|
|
|
- | TInst ({ cl_path = ([],"Float") },[])
|
|
|
- | TAbstract ({ a_path = ([],"Float") },[])
|
|
|
- | TInst ({ cl_path = ([],"Int") },[])
|
|
|
- | TAbstract ({ a_path = ([],"Int") },[])
|
|
|
- | TInst( { cl_path = (["haxe"], "Int32") }, [] )
|
|
|
- | TInst( { cl_path = (["haxe"], "Int64") }, [] )
|
|
|
- | TType ({ t_path = ["haxe";"_Int64"], "NativeInt64" },[])
|
|
|
- | TAbstract ({ a_path = ["haxe";"_Int64"], "NativeInt64" },[])
|
|
|
- | TType ({ t_path = ["java"],"Int8" },[])
|
|
|
- | TAbstract ({ a_path = ["java"],"Int8" },[])
|
|
|
- | TType ({ t_path = ["java"],"Int16" },[])
|
|
|
- | TAbstract ({ a_path = ["java"],"Int16" },[])
|
|
|
- | TType ({ t_path = ["java"],"Char16" },[])
|
|
|
- | TAbstract ({ a_path = ["java"],"Char16" },[])
|
|
|
- | TType ({ t_path = [],"Single" },[])
|
|
|
- | TAbstract ({ a_path = [],"Single" },[])
|
|
|
- | TType ({ t_path = [],"Null" },[_]) -> Some t
|
|
|
- | TAbstract ({ a_impl = Some _ } as a, pl) ->
|
|
|
- Some (gen.gfollow#run_f ( Codegen.Abstract.get_underlying_type a pl) )
|
|
|
- | TAbstract( { a_path = ([], "EnumValue") }, _ )
|
|
|
- | TInst( { cl_path = ([], "EnumValue") }, _ ) -> Some t_dynamic
|
|
|
- | _ -> None);
|
|
|
-
|
|
|
- let change_path path = (change_ns (fst path), change_clname (snd path)) in
|
|
|
-
|
|
|
- let path_s path = match path with
|
|
|
- | (ns,clname) -> path_s (change_ns ns, change_clname clname)
|
|
|
- in
|
|
|
-
|
|
|
- let cl_cl = get_cl (get_type gen (["java";"lang"],"Class")) in
|
|
|
-
|
|
|
- let rec real_type t =
|
|
|
- let t = gen.gfollow#run_f t in
|
|
|
- match t with
|
|
|
- | TAbstract ({ a_impl = Some _ } as a, pl) ->
|
|
|
- real_type (Codegen.Abstract.get_underlying_type a pl)
|
|
|
- | TInst( { cl_path = (["haxe"], "Int32") }, [] ) -> gen.gcon.basic.tint
|
|
|
- | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> ti64
|
|
|
- | TAbstract( { a_path = ([], "Class") }, p )
|
|
|
- | TAbstract( { a_path = ([], "Enum") }, p )
|
|
|
- | TInst( { cl_path = ([], "Class") }, p )
|
|
|
- | TInst( { cl_path = ([], "Enum") }, p ) -> TInst(cl_cl,p)
|
|
|
- | TEnum(e,params) -> TEnum(e, List.map (fun _ -> t_dynamic) params)
|
|
|
- | TInst(c,params) when Meta.has Meta.Enum c.cl_meta ->
|
|
|
- TInst(c, List.map (fun _ -> t_dynamic) params)
|
|
|
- | TInst _ -> t
|
|
|
- | TType({ t_path = ([], "Null") }, [t]) when is_java_basic_type t -> t_dynamic
|
|
|
- | TType({ t_path = ([], "Null") }, [t]) ->
|
|
|
- (match follow t with
|
|
|
- | TInst( { cl_kind = KTypeParameter _ }, []) ->
|
|
|
- (* t_dynamic *)
|
|
|
- real_type t
|
|
|
- | _ -> real_type t
|
|
|
- )
|
|
|
- | TType _ | TAbstract _ -> t
|
|
|
- | TAnon (anon) -> (match !(anon.a_status) with
|
|
|
- | Statics _ | EnumStatics _ | AbstractStatics _ -> t
|
|
|
- | _ -> t_dynamic)
|
|
|
- | TFun _ -> TInst(fn_cl,[])
|
|
|
- | _ -> t_dynamic
|
|
|
- in
|
|
|
-
|
|
|
- let scope = ref PMap.empty in
|
|
|
- let imports = ref [] in
|
|
|
-
|
|
|
- let clear_scope () =
|
|
|
- scope := PMap.empty;
|
|
|
- imports := [];
|
|
|
- in
|
|
|
-
|
|
|
- let add_scope name =
|
|
|
- scope := PMap.add name () !scope
|
|
|
- in
|
|
|
-
|
|
|
- let add_import pos path =
|
|
|
- let name = snd path in
|
|
|
- let rec loop = function
|
|
|
- | (pack, n) :: _ when name = n ->
|
|
|
- if path <> (pack,n) then
|
|
|
- gen.gcon.error ("This expression cannot be generated because " ^ path_s path ^ " is shadowed by the current scope and ") pos
|
|
|
- | _ :: tl ->
|
|
|
- loop tl
|
|
|
- | [] ->
|
|
|
- (* add import *)
|
|
|
- imports := path :: !imports
|
|
|
- in
|
|
|
- loop !imports
|
|
|
- in
|
|
|
-
|
|
|
- let path_s_import pos path = match path with
|
|
|
- | [], name when PMap.mem name !scope ->
|
|
|
- gen.gcon.error ("This expression cannot be generated because " ^ name ^ " is shadowed by the current scope") pos;
|
|
|
- name
|
|
|
- | pack1 :: _, name when PMap.mem pack1 !scope -> (* exists in scope *)
|
|
|
- add_import pos path;
|
|
|
- (* check if name exists in scope *)
|
|
|
- if PMap.mem name !scope then
|
|
|
- gen.gcon.error ("This expression cannot be generated because " ^ pack1 ^ " and " ^ name ^ " are both shadowed by the current scope") pos;
|
|
|
- name
|
|
|
- | _ -> path_s path
|
|
|
- in
|
|
|
-
|
|
|
- let is_dynamic t = match real_type t with
|
|
|
- | TMono _ | TDynamic _
|
|
|
- | TInst({ cl_kind = KTypeParameter _ }, _) -> true
|
|
|
- | TAnon anon ->
|
|
|
- (match !(anon.a_status) with
|
|
|
- | EnumStatics _ | Statics _ | AbstractStatics _ -> false
|
|
|
- | _ -> true
|
|
|
- )
|
|
|
- | _ -> false
|
|
|
- in
|
|
|
-
|
|
|
- let rec t_s pos t =
|
|
|
- match real_type t with
|
|
|
- (* basic types *)
|
|
|
- | TEnum ({ e_path = ([], "Bool") }, [])
|
|
|
- | TAbstract ({ a_path = ([], "Bool") },[]) -> "boolean"
|
|
|
- | TEnum ({ e_path = ([], "Void") }, [])
|
|
|
- | TAbstract ({ a_path = ([], "Void") },[]) ->
|
|
|
- path_s_import pos (["java";"lang"], "Object")
|
|
|
- | TInst ({ cl_path = ([],"Float") },[])
|
|
|
- | TAbstract ({ a_path = ([],"Float") },[]) -> "double"
|
|
|
- | TInst ({ cl_path = ([],"Int") },[])
|
|
|
- | TAbstract ({ a_path = ([],"Int") },[]) -> "int"
|
|
|
- | TType ({ t_path = ["haxe";"_Int64"], "NativeInt64" },[])
|
|
|
- | TAbstract ({ a_path = ["haxe";"_Int64"], "NativeInt64" },[]) -> "long"
|
|
|
- | TType ({ t_path = ["java"],"Int8" },[])
|
|
|
- | TAbstract ({ a_path = ["java"],"Int8" },[]) -> "byte"
|
|
|
- | TType ({ t_path = ["java"],"Int16" },[])
|
|
|
- | TAbstract ({ a_path = ["java"],"Int16" },[]) -> "short"
|
|
|
- | TType ({ t_path = ["java"],"Char16" },[])
|
|
|
- | TAbstract ({ a_path = ["java"],"Char16" },[]) -> "char"
|
|
|
- | TType ({ t_path = [],"Single" },[])
|
|
|
- | TAbstract ({ a_path = [],"Single" },[]) -> "float"
|
|
|
- | TInst ({ cl_path = ["haxe"],"Int32" },[])
|
|
|
- | TAbstract ({ a_path = ["haxe"],"Int32" },[]) -> "int"
|
|
|
- | TInst ({ cl_path = ["haxe"],"Int64" },[])
|
|
|
- | TAbstract ({ a_path = ["haxe"],"Int64" },[]) -> "long"
|
|
|
- | TInst({ cl_path = (["java"], "NativeArray") }, [param]) ->
|
|
|
- let rec check_t_s t =
|
|
|
- match real_type t with
|
|
|
- | TInst({ cl_path = (["java"], "NativeArray") }, [param]) ->
|
|
|
- (check_t_s param) ^ "[]"
|
|
|
- | _ -> t_s pos (run_follow gen t)
|
|
|
- in
|
|
|
- (check_t_s param) ^ "[]"
|
|
|
-
|
|
|
- (* end of basic types *)
|
|
|
- | TInst ({ cl_kind = KTypeParameter _; cl_path=p }, []) -> snd p
|
|
|
- | TAbstract ({ a_path = [], "Dynamic" },[]) ->
|
|
|
- path_s_import pos (["java";"lang"], "Object")
|
|
|
- | TMono r -> (match !r with | None -> "java.lang.Object" | Some t -> t_s pos (run_follow gen t))
|
|
|
- | TInst ({ cl_path = [], "String" }, []) ->
|
|
|
- path_s_import pos (["java";"lang"], "String")
|
|
|
- | TAbstract ({ a_path = [], "Class" }, [p]) | TAbstract ({ a_path = [], "Enum" }, [p])
|
|
|
- | TInst ({ cl_path = [], "Class" }, [p]) | TInst ({ cl_path = [], "Enum" }, [p]) ->
|
|
|
- path_param_s pos (TClassDecl cl_cl) (["java";"lang"], "Class") [p]
|
|
|
- | TAbstract ({ a_path = [], "Class" }, _) | TAbstract ({ a_path = [], "Enum" }, _)
|
|
|
- | TInst ({ cl_path = [], "Class" }, _) | TInst ({ cl_path = [], "Enum" }, _) ->
|
|
|
- path_s_import pos (["java";"lang"], "Class")
|
|
|
- | TEnum ({e_path = p}, _) ->
|
|
|
- path_s_import pos p
|
|
|
- | TInst (({cl_path = p;} as cl), _) when Meta.has Meta.Enum cl.cl_meta ->
|
|
|
- path_s_import pos p
|
|
|
- | TInst (({cl_path = p;} as cl), params) -> (path_param_s pos (TClassDecl cl) p params)
|
|
|
- | TType (({t_path = p;} as t), params) -> (path_param_s pos (TTypeDecl t) p params)
|
|
|
- | TAnon (anon) ->
|
|
|
- (match !(anon.a_status) with
|
|
|
- | Statics _ | EnumStatics _ | AbstractStatics _ ->
|
|
|
- path_s_import pos (["java";"lang"], "Class")
|
|
|
- | _ ->
|
|
|
- path_s_import pos (["java";"lang"], "Object"))
|
|
|
- | TDynamic _ ->
|
|
|
- path_s_import pos (["java";"lang"], "Object")
|
|
|
- (* No Lazy type nor Function type made. That's because function types will be at this point be converted into other types *)
|
|
|
- | _ -> if !strict_mode then begin trace ("[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]"); assert false end else "[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]"
|
|
|
-
|
|
|
- and param_t_s pos t =
|
|
|
- match run_follow gen t with
|
|
|
- | TEnum ({ e_path = ([], "Bool") }, [])
|
|
|
- | TAbstract ({ a_path = ([], "Bool") },[]) ->
|
|
|
- path_s_import pos (["java";"lang"], "Boolean")
|
|
|
- | TInst ({ cl_path = ([],"Float") },[])
|
|
|
- | TAbstract ({ a_path = ([],"Float") },[]) ->
|
|
|
- path_s_import pos (["java";"lang"], "Double")
|
|
|
- | TInst ({ cl_path = ([],"Int") },[])
|
|
|
- | TAbstract ({ a_path = ([],"Int") },[]) ->
|
|
|
- path_s_import pos (["java";"lang"], "Integer")
|
|
|
- | TType ({ t_path = ["haxe";"_Int64"], "NativeInt64" },[])
|
|
|
- | TAbstract ({ a_path = ["haxe";"_Int64"], "NativeInt64" },[]) ->
|
|
|
- path_s_import pos (["java";"lang"], "Long")
|
|
|
- | TInst ({ cl_path = ["haxe"],"Int64" },[])
|
|
|
- | TAbstract ({ a_path = ["haxe"],"Int64" },[]) ->
|
|
|
- path_s_import pos (["java";"lang"], "Long")
|
|
|
- | TInst ({ cl_path = ["haxe"],"Int32" },[])
|
|
|
- | TAbstract ({ a_path = ["haxe"],"Int32" },[]) ->
|
|
|
- path_s_import pos (["java";"lang"], "Integer")
|
|
|
- | TType ({ t_path = ["java"],"Int8" },[])
|
|
|
- | TAbstract ({ a_path = ["java"],"Int8" },[]) ->
|
|
|
- path_s_import pos (["java";"lang"], "Byte")
|
|
|
- | TType ({ t_path = ["java"],"Int16" },[])
|
|
|
- | TAbstract ({ a_path = ["java"],"Int16" },[]) ->
|
|
|
- path_s_import pos (["java";"lang"], "Short")
|
|
|
- | TType ({ t_path = ["java"],"Char16" },[])
|
|
|
- | TAbstract ({ a_path = ["java"],"Char16" },[]) ->
|
|
|
- path_s_import pos (["java";"lang"], "Character")
|
|
|
- | TType ({ t_path = [],"Single" },[])
|
|
|
- | TAbstract ({ a_path = [],"Single" },[]) ->
|
|
|
- path_s_import pos (["java";"lang"], "Float")
|
|
|
- | TDynamic _ -> "?"
|
|
|
- | TInst (cl, params) -> t_s pos (TInst(cl, change_param_type (TClassDecl cl) params))
|
|
|
- | TType (cl, params) -> t_s pos (TType(cl, change_param_type (TTypeDecl cl) params))
|
|
|
- | TEnum (e, params) -> t_s pos (TEnum(e, change_param_type (TEnumDecl e) params))
|
|
|
- | _ -> t_s pos t
|
|
|
-
|
|
|
- and path_param_s pos md path params =
|
|
|
- match params with
|
|
|
- | [] -> path_s_import pos path
|
|
|
- | _ when has_tdynamic (change_param_type md params) -> path_s_import pos path
|
|
|
- | _ -> sprintf "%s<%s>" (path_s_import pos path) (String.concat ", " (List.map (fun t -> param_t_s pos t) (change_param_type md params)))
|
|
|
- in
|
|
|
-
|
|
|
- let rett_s pos t =
|
|
|
- match t with
|
|
|
- | TEnum ({e_path = ([], "Void")}, [])
|
|
|
- | TAbstract ({ a_path = ([], "Void") },[]) -> "void"
|
|
|
- | _ -> t_s pos t
|
|
|
- in
|
|
|
-
|
|
|
- let high_surrogate c = (c lsr 10) + 0xD7C0 in
|
|
|
- let low_surrogate c = (c land 0x3FF) lor 0xDC00 in
|
|
|
-
|
|
|
- let escape ichar b =
|
|
|
- match ichar with
|
|
|
- | 92 (* \ *) -> Buffer.add_string b "\\\\"
|
|
|
- | 39 (* ' *) -> Buffer.add_string b "\\\'"
|
|
|
- | 34 -> Buffer.add_string b "\\\""
|
|
|
- | 13 (* \r *) -> Buffer.add_string b "\\r"
|
|
|
- | 10 (* \n *) -> Buffer.add_string b "\\n"
|
|
|
- | 9 (* \t *) -> Buffer.add_string b "\\t"
|
|
|
- | c when c < 32 || (c >= 127 && c <= 0xFFFF) -> Buffer.add_string b (Printf.sprintf "\\u%.4x" c)
|
|
|
- | c when c > 0xFFFF -> Buffer.add_string b (Printf.sprintf "\\u%.4x\\u%.4x" (high_surrogate c) (low_surrogate c))
|
|
|
- | c -> Buffer.add_char b (Char.chr c)
|
|
|
- in
|
|
|
-
|
|
|
- let escape s =
|
|
|
- let b = Buffer.create 0 in
|
|
|
- (try
|
|
|
- UTF8.validate s;
|
|
|
- UTF8.iter (fun c -> escape (UChar.code c) b) s
|
|
|
- with
|
|
|
- UTF8.Malformed_code ->
|
|
|
- String.iter (fun c -> escape (Char.code c) b) s
|
|
|
- );
|
|
|
- Buffer.contents b
|
|
|
- in
|
|
|
-
|
|
|
- let has_semicolon e =
|
|
|
- match e.eexpr with
|
|
|
- | TLocal { v_name = "__fallback__" }
|
|
|
- | TCall ({ eexpr = TLocal( { v_name = "__label__" } ) }, [ { eexpr = TConst(TInt _) } ] ) -> false
|
|
|
- | TBlock _ | TFor _ | TSwitch _ | TPatMatch _ | TTry _ | TIf _ -> false
|
|
|
- | TWhile (_,_,flag) when flag = Ast.NormalWhile -> false
|
|
|
- | _ -> true
|
|
|
- in
|
|
|
-
|
|
|
- let in_value = ref false in
|
|
|
-
|
|
|
- let rec md_s pos md =
|
|
|
- let md = follow_module (gen.gfollow#run_f) md in
|
|
|
- match md with
|
|
|
- | TClassDecl (cl) ->
|
|
|
- t_s pos (TInst(cl,[]))
|
|
|
- | TEnumDecl (e) ->
|
|
|
- t_s pos (TEnum(e,[]))
|
|
|
- | TTypeDecl t ->
|
|
|
- t_s pos (TType(t, []))
|
|
|
- | TAbstractDecl a ->
|
|
|
- t_s pos (TAbstract(a, []))
|
|
|
- in
|
|
|
-
|
|
|
- (*
|
|
|
- it seems that Java doesn't like when you create a new array with the type parameter defined
|
|
|
- so we'll just ignore all type parameters, and hope for the best!
|
|
|
- *)
|
|
|
- let rec transform_nativearray_t t = match real_type t with
|
|
|
- | TInst( ({ cl_path = (["java"], "NativeArray") } as narr), [t]) ->
|
|
|
- TInst(narr, [transform_nativearray_t t])
|
|
|
- | TInst(cl, params) -> TInst(cl, List.map (fun _ -> t_dynamic) params)
|
|
|
- | TEnum(e, params) -> TEnum(e, List.map (fun _ -> t_dynamic) params)
|
|
|
- | TType(t, params) -> TType(t, List.map (fun _ -> t_dynamic) params)
|
|
|
- | _ -> t
|
|
|
- in
|
|
|
-
|
|
|
- let expr_s w e =
|
|
|
- in_value := false;
|
|
|
- let rec expr_s w e =
|
|
|
- let was_in_value = !in_value in
|
|
|
- in_value := true;
|
|
|
- match e.eexpr with
|
|
|
- | TConst c ->
|
|
|
- (match c with
|
|
|
- | TInt i32 ->
|
|
|
- print w "%ld" i32;
|
|
|
- (match real_type e.etype with
|
|
|
- | TType( { t_path = (["haxe";"_Int64"], "NativeInt64") }, [] ) -> write w "L";
|
|
|
- | _ -> ()
|
|
|
- )
|
|
|
- | TFloat s ->
|
|
|
- write w s;
|
|
|
- (* fix for Int notation, which only fit in a Float *)
|
|
|
- (if not (String.contains s '.' || String.contains s 'e' || String.contains s 'E') then write w ".0");
|
|
|
- (match real_type e.etype with
|
|
|
- | TType( { t_path = ([], "Single") }, [] ) -> write w "f"
|
|
|
- | _ -> ()
|
|
|
- )
|
|
|
- | TString s -> print w "\"%s\"" (escape s)
|
|
|
- | TBool b -> write w (if b then "true" else "false")
|
|
|
- | TNull ->
|
|
|
- (match real_type e.etype with
|
|
|
- | TType( { t_path = (["haxe";"_Int64"], "NativeInt64") }, [] )
|
|
|
- | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> write w "0L"
|
|
|
- | TInst( { cl_path = (["haxe"], "Int32") }, [] )
|
|
|
- | TInst({ cl_path = ([], "Int") },[])
|
|
|
- | TAbstract ({ a_path = ([], "Int") },[]) -> expr_s w ({ e with eexpr = TConst(TInt Int32.zero) })
|
|
|
- | TInst({ cl_path = ([], "Float") },[])
|
|
|
- | TAbstract ({ a_path = ([], "Float") },[]) -> expr_s w ({ e with eexpr = TConst(TFloat "0.0") })
|
|
|
- | TEnum({ e_path = ([], "Bool") }, [])
|
|
|
- | TAbstract ({ a_path = ([], "Bool") },[]) -> write w "false"
|
|
|
- | TAbstract _ when like_int e.etype ->
|
|
|
- expr_s w { e with eexpr = TConst(TInt Int32.zero) }
|
|
|
- | TAbstract _ when like_float e.etype ->
|
|
|
- expr_s w { e with eexpr = TConst(TFloat "0.0") }
|
|
|
- | _ -> write w "null")
|
|
|
- | TThis -> write w "this"
|
|
|
- | TSuper -> write w "super")
|
|
|
- | TLocal { v_name = "__fallback__" } -> ()
|
|
|
- | TLocal { v_name = "__sbreak__" } -> write w "break"
|
|
|
- | TLocal { v_name = "__undefined__" } ->
|
|
|
- write w (t_s e.epos (TInst(runtime_cl, List.map (fun _ -> t_dynamic) runtime_cl.cl_types)));
|
|
|
- write w ".undefined";
|
|
|
- | TLocal var ->
|
|
|
- write_id w var.v_name
|
|
|
- | TField(_, FEnum(en,ef)) ->
|
|
|
- let s = ef.ef_name in
|
|
|
- print w "%s." (path_s_import e.epos en.e_path); write_field w s
|
|
|
- | TArray (e1, e2) ->
|
|
|
- expr_s w e1; write w "["; expr_s w e2; write w "]"
|
|
|
- | TBinop ((Ast.OpAssign as op), e1, e2)
|
|
|
- | TBinop ((Ast.OpAssignOp _ as op), e1, e2) ->
|
|
|
- expr_s w e1; write w ( " " ^ (Ast.s_binop op) ^ " " ); expr_s w e2
|
|
|
- | TBinop (op, e1, e2) ->
|
|
|
- write w "( ";
|
|
|
- expr_s w e1; write w ( " " ^ (Ast.s_binop op) ^ " " ); expr_s w e2;
|
|
|
- write w " )"
|
|
|
- | TField (e, FStatic(_, cf)) when Meta.has Meta.Native cf.cf_meta ->
|
|
|
- let rec loop meta = match meta with
|
|
|
- | (Meta.Native, [EConst (String s), _],_) :: _ ->
|
|
|
- expr_s w e; write w "."; write_field w s
|
|
|
- | _ :: tl -> loop tl
|
|
|
- | [] -> expr_s w e; write w "."; write_field w (cf.cf_name)
|
|
|
- in
|
|
|
- loop cf.cf_meta
|
|
|
- | TField (e, s) ->
|
|
|
- expr_s w e; write w "."; write_field w (field_name s)
|
|
|
- | TTypeExpr (TClassDecl { cl_path = (["haxe"], "Int32") }) ->
|
|
|
- write w (path_s_import e.epos (["haxe"], "Int32"))
|
|
|
- | TTypeExpr (TClassDecl { cl_path = (["haxe"], "Int64") }) ->
|
|
|
- write w (path_s_import e.epos (["haxe"], "Int64"))
|
|
|
- | TTypeExpr mt -> write w (md_s e.epos mt)
|
|
|
- | TParenthesis e ->
|
|
|
- write w "("; expr_s w e; write w ")"
|
|
|
- | TMeta (_,e) ->
|
|
|
- expr_s w e
|
|
|
- | TArrayDecl el when t_has_type_param_shallow false e.etype ->
|
|
|
- print w "( (%s) (new java.lang.Object[] " (t_s e.epos e.etype);
|
|
|
- write w "{";
|
|
|
- ignore (List.fold_left (fun acc e ->
|
|
|
- (if acc <> 0 then write w ", ");
|
|
|
- expr_s w e;
|
|
|
- acc + 1
|
|
|
- ) 0 el);
|
|
|
- write w "}) )"
|
|
|
- | TArrayDecl el ->
|
|
|
- print w "new %s" (param_t_s e.epos (transform_nativearray_t e.etype));
|
|
|
- let is_double = match follow e.etype with
|
|
|
- | TInst(_,[ t ]) -> if like_float t && not (like_int t) then Some t else None
|
|
|
- | _ -> None
|
|
|
- in
|
|
|
-
|
|
|
- write w "{";
|
|
|
- ignore (List.fold_left (fun acc e ->
|
|
|
- (if acc <> 0 then write w ", ");
|
|
|
- (* this is a hack so we are able to convert ints to boxed Double / Float when needed *)
|
|
|
- let e = if is_some is_double then mk_cast (get is_double) e else e in
|
|
|
-
|
|
|
- expr_s w e;
|
|
|
- acc + 1
|
|
|
- ) 0 el);
|
|
|
- write w "}"
|
|
|
- | TCall( ( { eexpr = TField(_, FStatic({ cl_path = ([], "String") }, { cf_name = "fromCharCode" })) } ), [cc] ) ->
|
|
|
- write w "Character.toString((char) ";
|
|
|
- expr_s w cc;
|
|
|
- write w ")"
|
|
|
- | TCall ({ eexpr = TLocal( { v_name = "__is__" } ) }, [ expr; { eexpr = TTypeExpr(md) } ] ) ->
|
|
|
- write w "( ";
|
|
|
- expr_s w expr;
|
|
|
- write w " instanceof ";
|
|
|
- write w (md_s e.epos md);
|
|
|
- write w " )"
|
|
|
- | TCall ({ eexpr = TLocal( { v_name = "__java__" } ) }, [ { eexpr = TConst(TString(s)) } ] ) ->
|
|
|
- write w s
|
|
|
- | TCall ({ eexpr = TLocal( { v_name = "__lock__" } ) }, [ eobj; eblock ] ) ->
|
|
|
- write w "synchronized(";
|
|
|
- expr_s w eobj;
|
|
|
- write w ")";
|
|
|
- (match eblock.eexpr with
|
|
|
- | TBlock(_ :: _) ->
|
|
|
- expr_s w eblock
|
|
|
- | _ ->
|
|
|
- begin_block w;
|
|
|
- expr_s w eblock;
|
|
|
- if has_semicolon eblock then write w ";";
|
|
|
- end_block w;
|
|
|
- )
|
|
|
- | TCall ({ eexpr = TLocal( { v_name = "__goto__" } ) }, [ { eexpr = TConst(TInt v) } ] ) ->
|
|
|
- print w "break label%ld" v
|
|
|
- | TCall ({ eexpr = TLocal( { v_name = "__label__" } ) }, [ { eexpr = TConst(TInt v) } ] ) ->
|
|
|
- print w "label%ld:" v
|
|
|
- | TCall ({ eexpr = TLocal( { v_name = "__typeof__" } ) }, [ { eexpr = TTypeExpr md } as expr ] ) ->
|
|
|
- expr_s w expr;
|
|
|
- write w ".class"
|
|
|
- | TCall (e, el) ->
|
|
|
- let rec extract_tparams params el =
|
|
|
- match el with
|
|
|
- | ({ eexpr = TLocal({ v_name = "$type_param" }) } as tp) :: tl ->
|
|
|
- extract_tparams (tp.etype :: params) tl
|
|
|
- | _ -> (params, el)
|
|
|
- in
|
|
|
- let params, el = extract_tparams [] el in
|
|
|
-
|
|
|
- expr_s w e;
|
|
|
-
|
|
|
- (*(match params with
|
|
|
- | [] -> ()
|
|
|
- | params ->
|
|
|
- let md = match e.eexpr with
|
|
|
- | TField(ef, _) -> t_to_md (run_follow gen ef.etype)
|
|
|
- | _ -> assert false
|
|
|
- in
|
|
|
- write w "<";
|
|
|
- ignore (List.fold_left (fun acc t ->
|
|
|
- (if acc <> 0 then write w ", ");
|
|
|
- write w (param_t_s (change_param_type md t));
|
|
|
- acc + 1
|
|
|
- ) 0 params);
|
|
|
- write w ">"
|
|
|
- );*)
|
|
|
-
|
|
|
- write w "(";
|
|
|
- ignore (List.fold_left (fun acc e ->
|
|
|
- (if acc <> 0 then write w ", ");
|
|
|
- expr_s w e;
|
|
|
- acc + 1
|
|
|
- ) 0 el);
|
|
|
- write w ")"
|
|
|
- | TNew (({ cl_path = (["java"], "NativeArray") } as cl), params, [ size ]) ->
|
|
|
- let rec check_t_s t times =
|
|
|
- match real_type t with
|
|
|
- | TInst({ cl_path = (["java"], "NativeArray") }, [param]) ->
|
|
|
- (check_t_s param (times+1))
|
|
|
- | _ ->
|
|
|
- print w "new %s[" (t_s e.epos (transform_nativearray_t t));
|
|
|
- expr_s w size;
|
|
|
- print w "]";
|
|
|
- let rec loop i =
|
|
|
- if i <= 0 then () else (write w "[]"; loop (i-1))
|
|
|
- in
|
|
|
- loop (times - 1)
|
|
|
- in
|
|
|
- check_t_s (TInst(cl, params)) 0
|
|
|
- | TNew ({ cl_path = ([], "String") } as cl, [], el) ->
|
|
|
- write w "new ";
|
|
|
- write w (t_s e.epos (TInst(cl, [])));
|
|
|
- write w "(";
|
|
|
- ignore (List.fold_left (fun acc e ->
|
|
|
- (if acc <> 0 then write w ", ");
|
|
|
- expr_s w e;
|
|
|
- acc + 1
|
|
|
- ) 0 el);
|
|
|
- write w ")"
|
|
|
- | TNew ({ cl_kind = KTypeParameter _ } as cl, params, el) ->
|
|
|
- print w "null /* This code should never be reached. It was produced by the use of @:generic on a new type parameter instance: %s */" (path_param_s e.epos (TClassDecl cl) cl.cl_path params)
|
|
|
- | TNew (cl, params, el) ->
|
|
|
- write w "new ";
|
|
|
- write w (path_param_s e.epos (TClassDecl cl) cl.cl_path params);
|
|
|
- write w "(";
|
|
|
- ignore (List.fold_left (fun acc e ->
|
|
|
- (if acc <> 0 then write w ", ");
|
|
|
- expr_s w e;
|
|
|
- acc + 1
|
|
|
- ) 0 el);
|
|
|
- write w ")"
|
|
|
- | TUnop ((Ast.Increment as op), flag, e)
|
|
|
- | TUnop ((Ast.Decrement as op), flag, e) ->
|
|
|
- (match flag with
|
|
|
- | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " " ); expr_s w e
|
|
|
- | Ast.Postfix -> expr_s w e; write w (Ast.s_unop op))
|
|
|
- | TUnop (op, flag, e) ->
|
|
|
- (match flag with
|
|
|
- | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " (" ); expr_s w e; write w ") "
|
|
|
- | Ast.Postfix -> write w "("; expr_s w e; write w (") " ^ Ast.s_unop op))
|
|
|
- | TVar (var, eopt) ->
|
|
|
- print w "%s " (t_s e.epos var.v_type);
|
|
|
- write_id w var.v_name;
|
|
|
- (match eopt with
|
|
|
- | None ->
|
|
|
- write w " = ";
|
|
|
- expr_s w (null var.v_type e.epos)
|
|
|
- | Some e ->
|
|
|
- write w " = ";
|
|
|
- expr_s w e
|
|
|
- )
|
|
|
- | TBlock [e] when was_in_value ->
|
|
|
- expr_s w e
|
|
|
- | TBlock el ->
|
|
|
- begin_block w;
|
|
|
- (*let last_line = ref (-1) in
|
|
|
- let line_directive p =
|
|
|
- let cur_line = Lexer.get_error_line p in
|
|
|
- let is_relative_path = (String.sub p.pfile 0 1) = "." in
|
|
|
- let file = if is_relative_path then "../" ^ p.pfile else p.pfile in
|
|
|
- if cur_line <> ((!last_line)+1) then begin print w "//#line %d \"%s\"" cur_line (Ast.s_escape file); newline w end;
|
|
|
- last_line := cur_line in*)
|
|
|
- List.iter (fun e ->
|
|
|
- (*line_directive e.epos;*)
|
|
|
- in_value := false;
|
|
|
- (match e.eexpr with
|
|
|
- | TConst _ -> ()
|
|
|
- | _ ->
|
|
|
- expr_s w e;
|
|
|
- (if has_semicolon e then write w ";");
|
|
|
- newline w);
|
|
|
- ) el;
|
|
|
- end_block w
|
|
|
- | TIf (econd, e1, Some(eelse)) when was_in_value ->
|
|
|
- write w "( ";
|
|
|
- expr_s w (mk_paren econd);
|
|
|
- write w " ? ";
|
|
|
- expr_s w (mk_paren e1);
|
|
|
- write w " : ";
|
|
|
- expr_s w (mk_paren eelse);
|
|
|
- write w " )";
|
|
|
- | TIf (econd, e1, eelse) ->
|
|
|
- write w "if ";
|
|
|
- expr_s w (mk_paren econd);
|
|
|
- write w " ";
|
|
|
- in_value := false;
|
|
|
- expr_s w (mk_block e1);
|
|
|
- (match eelse with
|
|
|
- | None -> ()
|
|
|
- | Some e ->
|
|
|
- write w " else ";
|
|
|
- in_value := false;
|
|
|
- expr_s w (mk_block e)
|
|
|
- )
|
|
|
- | TWhile (econd, eblock, flag) ->
|
|
|
- (match flag with
|
|
|
- | Ast.NormalWhile ->
|
|
|
- write w "while ";
|
|
|
- expr_s w (mk_paren econd);
|
|
|
- write w "";
|
|
|
- in_value := false;
|
|
|
- expr_s w (mk_block eblock)
|
|
|
- | Ast.DoWhile ->
|
|
|
- write w "do ";
|
|
|
- in_value := false;
|
|
|
- expr_s w (mk_block eblock);
|
|
|
- write w "while ";
|
|
|
- in_value := true;
|
|
|
- expr_s w (mk_paren econd);
|
|
|
- )
|
|
|
- | TSwitch (econd, ele_l, default) ->
|
|
|
- write w "switch ";
|
|
|
- expr_s w (mk_paren econd);
|
|
|
- begin_block w;
|
|
|
- List.iter (fun (el, e) ->
|
|
|
- List.iter (fun e ->
|
|
|
- write w "case ";
|
|
|
- in_value := true;
|
|
|
- expr_s w e;
|
|
|
- write w ":";
|
|
|
- ) el;
|
|
|
- newline w;
|
|
|
- in_value := false;
|
|
|
- expr_s w (mk_block e);
|
|
|
- newline w;
|
|
|
- newline w
|
|
|
- ) ele_l;
|
|
|
- if is_some default then begin
|
|
|
- write w "default:";
|
|
|
- newline w;
|
|
|
- in_value := false;
|
|
|
- expr_s w (get default);
|
|
|
- newline w;
|
|
|
- end;
|
|
|
- end_block w
|
|
|
- | TTry (tryexpr, ve_l) ->
|
|
|
- write w "try ";
|
|
|
- in_value := false;
|
|
|
- expr_s w (mk_block tryexpr);
|
|
|
- let pos = e.epos in
|
|
|
- List.iter (fun (var, e) ->
|
|
|
- print w "catch (%s %s)" (t_s pos var.v_type) (var.v_name);
|
|
|
- in_value := false;
|
|
|
- expr_s w (mk_block e);
|
|
|
- newline w
|
|
|
- ) ve_l
|
|
|
- | TReturn eopt ->
|
|
|
- write w "return ";
|
|
|
- if is_some eopt then expr_s w (get eopt)
|
|
|
- | TBreak -> write w "break"
|
|
|
- | TContinue -> write w "continue"
|
|
|
- | TThrow e ->
|
|
|
- write w "throw ";
|
|
|
- expr_s w e
|
|
|
- | TCast (e1,md_t) ->
|
|
|
- ((*match gen.gfollow#run_f e.etype with
|
|
|
- | TType({ t_path = ([], "UInt") }, []) ->
|
|
|
- write w "( unchecked ((uint) ";
|
|
|
- expr_s w e1;
|
|
|
- write w ") )"
|
|
|
- | _ ->*)
|
|
|
- (* FIXME I'm ignoring module type *)
|
|
|
- print w "((%s) (" (t_s e.epos e.etype);
|
|
|
- expr_s w e1;
|
|
|
- write w ") )"
|
|
|
- )
|
|
|
- | TFor (_,_,content) ->
|
|
|
- write w "[ for not supported ";
|
|
|
- expr_s w content;
|
|
|
- write w " ]";
|
|
|
- if !strict_mode then assert false
|
|
|
- | TObjectDecl _ -> write w "[ obj decl not supported ]"; if !strict_mode then assert false
|
|
|
- | TFunction _ -> write w "[ func decl not supported ]"; if !strict_mode then assert false
|
|
|
- | TPatMatch _ -> write w "[ match not supported ]"; if !strict_mode then assert false
|
|
|
- | TEnumParameter _ -> write w "[ enum parameter not supported ]"; if !strict_mode then assert false
|
|
|
- in
|
|
|
- expr_s w e
|
|
|
- in
|
|
|
-
|
|
|
- let get_string_params cl_types =
|
|
|
- match cl_types with
|
|
|
- | [] ->
|
|
|
- ("","")
|
|
|
- | _ ->
|
|
|
- let params = sprintf "<%s>" (String.concat ", " (List.map (fun (_, tcl) -> match follow tcl with | TInst(cl, _) -> snd cl.cl_path | _ -> assert false) cl_types)) in
|
|
|
- let params_extends = List.fold_left (fun acc (name, t) ->
|
|
|
- match run_follow gen t with
|
|
|
- | TInst (cl, p) ->
|
|
|
- (match cl.cl_implements with
|
|
|
- | [] -> acc
|
|
|
- | _ -> acc) (* TODO
|
|
|
- | _ -> (sprintf " where %s : %s" name (String.concat ", " (List.map (fun (cl,p) -> path_param_s (TClassDecl cl) cl.cl_path p) cl.cl_implements))) :: acc ) *)
|
|
|
- | _ -> trace (t_s Ast.null_pos t); assert false (* FIXME it seems that a cl_types will never be anything other than cl.cl_types. I'll take the risk and fail if not, just to see if that confirms *)
|
|
|
- ) [] cl_types in
|
|
|
- (params, String.concat " " params_extends)
|
|
|
- in
|
|
|
-
|
|
|
- let rec gen_class_field w ?(is_overload=false) is_static cl is_final cf =
|
|
|
- let is_interface = cl.cl_interface in
|
|
|
- let name, is_new, is_explicit_iface = match cf.cf_name with
|
|
|
- | "new" -> snd cl.cl_path, true, false
|
|
|
- | name when String.contains name '.' ->
|
|
|
- let fn_name, path = parse_explicit_iface name in
|
|
|
- (path_s path) ^ "." ^ fn_name, false, true
|
|
|
- | name -> name, false, false
|
|
|
- in
|
|
|
- (match cf.cf_kind with
|
|
|
- | Var _
|
|
|
- | Method (MethDynamic) when not (Type.is_extern_field cf) ->
|
|
|
- (if is_overload || List.exists (fun cf -> cf.cf_expr <> None) cf.cf_overloads then
|
|
|
- gen.gcon.error "Only normal (non-dynamic) methods can be overloaded" cf.cf_pos);
|
|
|
- if not is_interface then begin
|
|
|
- let access, modifiers = get_fun_modifiers cf.cf_meta "public" [] in
|
|
|
- print w "%s %s%s %s %s" access (if is_static then "static " else "") (String.concat " " modifiers) (t_s cf.cf_pos (run_follow gen cf.cf_type)) (change_field name);
|
|
|
- (match cf.cf_expr with
|
|
|
- | Some e ->
|
|
|
- write w " = ";
|
|
|
- expr_s w e;
|
|
|
- write w ";"
|
|
|
- | None -> write w ";"
|
|
|
- )
|
|
|
- end (* TODO see how (get,set) variable handle when they are interfaces *)
|
|
|
- | Method _ when Type.is_extern_field cf || (match cl.cl_kind, cf.cf_expr with | KAbstractImpl _, None -> true | _ -> false) ->
|
|
|
- List.iter (fun cf -> if cl.cl_interface || cf.cf_expr <> None then
|
|
|
- gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
|
|
|
- ) cf.cf_overloads
|
|
|
- | Var _ | Method MethDynamic -> ()
|
|
|
- | Method mkind ->
|
|
|
- List.iter (fun cf ->
|
|
|
- if cl.cl_interface || cf.cf_expr <> None then
|
|
|
- gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
|
|
|
- ) cf.cf_overloads;
|
|
|
- let is_virtual = is_new || (not is_final && match mkind with | MethInline -> false | _ when not is_new -> true | _ -> false) in
|
|
|
- let is_override = match cf.cf_name with
|
|
|
- | "equals" when not is_static ->
|
|
|
- (match cf.cf_type with
|
|
|
- | TFun([_,_,t], ret) ->
|
|
|
- (match (real_type t, real_type ret) with
|
|
|
- | TDynamic _, TEnum( { e_path = ([], "Bool") }, [])
|
|
|
- | TDynamic _, TAbstract ({ a_path = ([], "Bool") },[])
|
|
|
- | TAnon _, TEnum( { e_path = ([], "Bool") }, [])
|
|
|
- | TAnon _, TAbstract ({ a_path = ([], "Bool") },[]) -> true
|
|
|
- | _ -> List.memq cf cl.cl_overrides
|
|
|
- )
|
|
|
- | _ -> List.memq cf cl.cl_overrides)
|
|
|
- | "toString" when not is_static ->
|
|
|
- (match cf.cf_type with
|
|
|
- | TFun([], ret) ->
|
|
|
- (match real_type ret with
|
|
|
- | TInst( { cl_path = ([], "String") }, []) -> true
|
|
|
- | _ -> gen.gcon.error "A toString() function should return a String!" cf.cf_pos; false
|
|
|
- )
|
|
|
- | _ -> List.memq cf cl.cl_overrides
|
|
|
- )
|
|
|
- | "hashCode" when not is_static ->
|
|
|
- (match cf.cf_type with
|
|
|
- | TFun([], ret) ->
|
|
|
- (match real_type ret with
|
|
|
- | TInst( { cl_path = ([], "Int") }, [])
|
|
|
- | TAbstract ({ a_path = ([], "Int") },[]) ->
|
|
|
- true
|
|
|
- | _ -> gen.gcon.error "A hashCode() function should return an Int!" cf.cf_pos; false
|
|
|
- )
|
|
|
- | _ -> List.memq cf cl.cl_overrides
|
|
|
- )
|
|
|
- | _ -> List.memq cf cl.cl_overrides
|
|
|
- in
|
|
|
- let visibility = if is_interface then "" else "public" in
|
|
|
-
|
|
|
- let visibility, modifiers = get_fun_modifiers cf.cf_meta visibility [] in
|
|
|
- let visibility, is_virtual = if is_explicit_iface then "",false else visibility, is_virtual in
|
|
|
- let v_n = if is_static then "static " else if is_override && not is_interface then "" else if not is_virtual then "final " else "" in
|
|
|
- let cf_type = if is_override && not is_overload && not (Meta.has Meta.Overload cf.cf_meta) then match field_access gen (TInst(cl, List.map snd cl.cl_types)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> assert false else cf.cf_type in
|
|
|
-
|
|
|
- let params = List.map snd cl.cl_types in
|
|
|
- let ret_type, args = match follow cf_type, follow cf.cf_type with
|
|
|
- | TFun (strbtl, t), TFun(rargs, _) ->
|
|
|
- (apply_params cl.cl_types params (real_type t), List.map2 (fun(_,_,t) (n,o,_) -> (n,o,apply_params cl.cl_types params (real_type t))) strbtl rargs)
|
|
|
- | _ -> assert false
|
|
|
- in
|
|
|
-
|
|
|
- (if is_override && not is_interface then write w "@Override ");
|
|
|
- (* public static void funcName *)
|
|
|
- let params, _ = get_string_params cf.cf_params in
|
|
|
- print w "%s %s%s %s %s %s" (visibility) v_n (String.concat " " modifiers) params (if is_new then "" else rett_s cf.cf_pos (run_follow gen ret_type)) (change_field name);
|
|
|
-
|
|
|
- (* <T>(string arg1, object arg2) with T : object *)
|
|
|
- (match cf.cf_expr with
|
|
|
- | Some { eexpr = TFunction tf } ->
|
|
|
- print w "(%s)" (String.concat ", " (List.map2 (fun (var,_) (_,_,t) -> sprintf "%s %s" (t_s cf.cf_pos (run_follow gen t)) (change_id var.v_name)) tf.tf_args args))
|
|
|
- | _ ->
|
|
|
- print w "(%s)" (String.concat ", " (List.map (fun (name, _, t) -> sprintf "%s %s" (t_s cf.cf_pos (run_follow gen t)) (change_id name)) args))
|
|
|
- );
|
|
|
- if is_interface || List.mem "native" modifiers then
|
|
|
- write w ";"
|
|
|
- else begin
|
|
|
- let rec loop meta =
|
|
|
- match meta with
|
|
|
- | [] ->
|
|
|
- let expr = match cf.cf_expr with
|
|
|
- | None -> mk (TBlock([])) t_dynamic Ast.null_pos
|
|
|
- | Some s ->
|
|
|
- match s.eexpr with
|
|
|
- | TFunction tf ->
|
|
|
- mk_block (tf.tf_expr)
|
|
|
- | _ -> assert false (* FIXME *)
|
|
|
- in
|
|
|
- (if is_new then begin
|
|
|
- (*let rec get_super_call el =
|
|
|
- match el with
|
|
|
- | ( { eexpr = TCall( { eexpr = TConst(TSuper) }, _) } as call) :: rest ->
|
|
|
- Some call, rest
|
|
|
- | ( { eexpr = TBlock(bl) } as block ) :: rest ->
|
|
|
- let ret, mapped = get_super_call bl in
|
|
|
- ret, ( { block with eexpr = TBlock(mapped) } :: rest )
|
|
|
- | _ ->
|
|
|
- None, el
|
|
|
- in*)
|
|
|
- expr_s w expr
|
|
|
- end else begin
|
|
|
- expr_s w expr;
|
|
|
- end)
|
|
|
- | (Meta.Throws, [Ast.EConst (Ast.String t), _], _) :: tl ->
|
|
|
- print w " throws %s" t;
|
|
|
- loop tl
|
|
|
- | (Meta.FunctionCode, [Ast.EConst (Ast.String contents),_],_) :: tl ->
|
|
|
- begin_block w;
|
|
|
- write w contents;
|
|
|
- end_block w
|
|
|
- | _ :: tl -> loop tl
|
|
|
- in
|
|
|
- loop cf.cf_meta
|
|
|
-
|
|
|
- end);
|
|
|
- newline w;
|
|
|
- newline w
|
|
|
- in
|
|
|
-
|
|
|
- let gen_class w cl =
|
|
|
- let should_close = match change_ns (fst cl.cl_path) with
|
|
|
- | [] -> false
|
|
|
- | ns ->
|
|
|
- print w "package %s;" (String.concat "." (change_ns ns));
|
|
|
- newline w;
|
|
|
- false
|
|
|
- in
|
|
|
-
|
|
|
- let rec loop_meta meta acc =
|
|
|
- match meta with
|
|
|
- | (Meta.SuppressWarnings, [Ast.EConst (Ast.String w),_],_) :: meta -> loop_meta meta (w :: acc)
|
|
|
- | _ :: meta -> loop_meta meta acc
|
|
|
- | _ -> acc
|
|
|
- in
|
|
|
-
|
|
|
- let suppress_warnings = loop_meta cl.cl_meta [ "rawtypes"; "unchecked" ] in
|
|
|
-
|
|
|
- write w "import haxe.root.*;";
|
|
|
- newline w;
|
|
|
- let w_header = w in
|
|
|
- let w = new_source_writer () in
|
|
|
- clear_scope();
|
|
|
-
|
|
|
- (* add all haxe.root.* to imports *)
|
|
|
- List.iter (function
|
|
|
- | TClassDecl { cl_path = ([],c) } ->
|
|
|
- imports := ([],c) :: !imports
|
|
|
- | TEnumDecl { e_path = ([],c) } ->
|
|
|
- imports := ([],c) :: !imports
|
|
|
- | TAbstractDecl { a_path = ([],c) } ->
|
|
|
- imports := ([],c) :: !imports
|
|
|
- | _ -> ()
|
|
|
- ) gen.gcon.types;
|
|
|
-
|
|
|
- newline w;
|
|
|
- write w "@SuppressWarnings(value={";
|
|
|
- let first = ref true in
|
|
|
- List.iter (fun s ->
|
|
|
- (if !first then first := false else write w ", ");
|
|
|
- print w "\"%s\"" (escape s)
|
|
|
- ) suppress_warnings;
|
|
|
- write w "})";
|
|
|
- newline w;
|
|
|
-
|
|
|
- let clt, access, modifiers = get_class_modifiers cl.cl_meta (if cl.cl_interface then "interface" else "class") "public" [] in
|
|
|
- let is_final = Meta.has Meta.Final cl.cl_meta in
|
|
|
-
|
|
|
- print w "%s %s %s %s" access (String.concat " " modifiers) clt (change_clname (snd cl.cl_path));
|
|
|
- (* type parameters *)
|
|
|
- let params, _ = get_string_params cl.cl_types in
|
|
|
- let cl_p_to_string (c,p) =
|
|
|
- let p = List.map (fun t -> match follow t with
|
|
|
- | TMono _ | TDynamic _ -> t_empty
|
|
|
- | _ -> t) p
|
|
|
- in
|
|
|
- path_param_s cl.cl_pos (TClassDecl c) c.cl_path p
|
|
|
- in
|
|
|
- print w "%s" params;
|
|
|
- (if is_some cl.cl_super then print w " extends %s" (cl_p_to_string (get cl.cl_super)));
|
|
|
- (match cl.cl_implements with
|
|
|
- | [] -> ()
|
|
|
- | _ -> print w " %s %s" (if cl.cl_interface then "extends" else "implements") (String.concat ", " (List.map cl_p_to_string cl.cl_implements))
|
|
|
- );
|
|
|
- (* class head ok: *)
|
|
|
- (* public class Test<A> : X, Y, Z where A : Y *)
|
|
|
- begin_block w;
|
|
|
- (* our constructor is expected to be a normal "new" function *
|
|
|
- if !strict_mode && is_some cl.cl_constructor then assert false;*)
|
|
|
-
|
|
|
- let rec loop cl =
|
|
|
- List.iter (fun cf -> add_scope cf.cf_name) cl.cl_ordered_fields;
|
|
|
- List.iter (fun cf -> add_scope cf.cf_name) cl.cl_ordered_statics;
|
|
|
- match cl.cl_super with
|
|
|
- | Some(c,_) -> loop c
|
|
|
- | None -> ()
|
|
|
- in
|
|
|
- loop cl;
|
|
|
-
|
|
|
- let rec loop meta =
|
|
|
- match meta with
|
|
|
- | [] -> ()
|
|
|
- | (Meta.ClassCode, [Ast.EConst (Ast.String contents),_],_) :: tl ->
|
|
|
- write w contents
|
|
|
- | _ :: tl -> loop tl
|
|
|
- in
|
|
|
- loop cl.cl_meta;
|
|
|
-
|
|
|
- (match gen.gcon.main_class with
|
|
|
- | Some path when path = cl.cl_path ->
|
|
|
- write w "public static void main(String[] args)";
|
|
|
- begin_block w;
|
|
|
- (try
|
|
|
- let t = Hashtbl.find gen.gtypes ([], "Sys") in
|
|
|
- match t with
|
|
|
- | TClassDecl(cl) when PMap.mem "_args" cl.cl_statics ->
|
|
|
- write w "Sys._args = args;"; newline w
|
|
|
- | _ -> ()
|
|
|
- with | Not_found -> ()
|
|
|
- );
|
|
|
- write w "main();";
|
|
|
- end_block w
|
|
|
- | _ -> ()
|
|
|
- );
|
|
|
-
|
|
|
- (match cl.cl_init with
|
|
|
- | None -> ()
|
|
|
- | Some init ->
|
|
|
- write w "static ";
|
|
|
- expr_s w (mk_block init));
|
|
|
- (if is_some cl.cl_constructor then gen_class_field w false cl is_final (get cl.cl_constructor));
|
|
|
- (if not cl.cl_interface then
|
|
|
- List.iter (gen_class_field w true cl is_final) cl.cl_ordered_statics);
|
|
|
- List.iter (gen_class_field w false cl is_final) cl.cl_ordered_fields;
|
|
|
- end_block w;
|
|
|
- if should_close then end_block w;
|
|
|
-
|
|
|
- (* add imports *)
|
|
|
- List.iter (function
|
|
|
- | ["haxe";"root"], _ | [], _ -> ()
|
|
|
- | path ->
|
|
|
- write w_header "import ";
|
|
|
- write w_header (path_s path);
|
|
|
- write w_header ";\n"
|
|
|
- ) !imports;
|
|
|
- add_writer w w_header
|
|
|
- in
|
|
|
-
|
|
|
-
|
|
|
- let gen_enum w e =
|
|
|
- let should_close = match change_ns (fst e.e_path) with
|
|
|
- | [] -> false
|
|
|
- | ns ->
|
|
|
- print w "package %s;" (String.concat "." (change_ns ns));
|
|
|
- newline w;
|
|
|
- false
|
|
|
- in
|
|
|
-
|
|
|
- print w "public enum %s" (change_clname (snd e.e_path));
|
|
|
- begin_block w;
|
|
|
- write w (String.concat ", " (List.map (change_id) e.e_names));
|
|
|
- end_block w;
|
|
|
-
|
|
|
- if should_close then end_block w
|
|
|
- in
|
|
|
-
|
|
|
- let module_type_gen w md_tp =
|
|
|
- match md_tp with
|
|
|
- | TClassDecl cl ->
|
|
|
- if not cl.cl_extern then begin
|
|
|
- gen_class w cl;
|
|
|
- newline w;
|
|
|
- newline w
|
|
|
- end;
|
|
|
- (not cl.cl_extern)
|
|
|
- | TEnumDecl e ->
|
|
|
- if not e.e_extern then begin
|
|
|
- gen_enum w e;
|
|
|
- newline w;
|
|
|
- newline w
|
|
|
- end;
|
|
|
- (not e.e_extern)
|
|
|
- | TTypeDecl e ->
|
|
|
- false
|
|
|
- | TAbstractDecl a ->
|
|
|
- false
|
|
|
- in
|
|
|
-
|
|
|
- let module_gen w md =
|
|
|
- module_type_gen w md
|
|
|
- in
|
|
|
-
|
|
|
- (* generate source code *)
|
|
|
- init_ctx gen;
|
|
|
-
|
|
|
- Hashtbl.add gen.gspecial_vars "__label__" true;
|
|
|
- Hashtbl.add gen.gspecial_vars "__goto__" true;
|
|
|
- Hashtbl.add gen.gspecial_vars "__is__" true;
|
|
|
- Hashtbl.add gen.gspecial_vars "__typeof__" true;
|
|
|
- Hashtbl.add gen.gspecial_vars "__java__" true;
|
|
|
- Hashtbl.add gen.gspecial_vars "__lock__" true;
|
|
|
-
|
|
|
- gen.greal_type <- real_type;
|
|
|
- gen.greal_type_param <- change_param_type;
|
|
|
-
|
|
|
- SetHXGen.run_filter gen SetHXGen.default_hxgen_func;
|
|
|
-
|
|
|
- (* before running the filters, follow all possible types *)
|
|
|
- (* this is needed so our module transformations don't break some core features *)
|
|
|
- (* like multitype selection *)
|
|
|
- let run_follow_gen = run_follow gen in
|
|
|
- let rec type_map e = Type.map_expr_type (fun e->type_map e) (run_follow_gen) (fun tvar-> tvar.v_type <- (run_follow_gen tvar.v_type); tvar) e in
|
|
|
- let super_map (cl,tl) = (cl, List.map run_follow_gen tl) in
|
|
|
- List.iter (function
|
|
|
- | TClassDecl cl ->
|
|
|
- let all_fields = (Option.map_default (fun cf -> [cf]) [] cl.cl_constructor) @ cl.cl_ordered_fields @ cl.cl_ordered_statics in
|
|
|
- List.iter (fun cf ->
|
|
|
- cf.cf_type <- run_follow_gen cf.cf_type;
|
|
|
- cf.cf_expr <- Option.map type_map cf.cf_expr
|
|
|
- ) all_fields;
|
|
|
- cl.cl_dynamic <- Option.map run_follow_gen cl.cl_dynamic;
|
|
|
- cl.cl_array_access <- Option.map run_follow_gen cl.cl_array_access;
|
|
|
- cl.cl_init <- Option.map type_map cl.cl_init;
|
|
|
- cl.cl_super <- Option.map super_map cl.cl_super;
|
|
|
- cl.cl_implements <- List.map super_map cl.cl_implements
|
|
|
- | _ -> ()
|
|
|
- ) gen.gcon.types;
|
|
|
-
|
|
|
- let closure_t = ClosuresToClass.DoubleAndDynamicClosureImpl.get_ctx gen 6 in
|
|
|
-
|
|
|
- (*let closure_t = ClosuresToClass.create gen 10 float_cl
|
|
|
- (fun l -> l)
|
|
|
- (fun l -> l)
|
|
|
- (fun args -> args)
|
|
|
- (fun args -> [])
|
|
|
- in
|
|
|
- ClosuresToClass.configure gen (ClosuresToClass.default_implementation closure_t (fun e _ _ -> e));
|
|
|
-
|
|
|
- StubClosureImpl.configure gen (StubClosureImpl.default_implementation gen float_cl 10 (fun e _ _ -> e));*)
|
|
|
-
|
|
|
- FixOverrides.configure gen;
|
|
|
- Normalize.configure gen ~metas:(Hashtbl.create 0);
|
|
|
- AbstractImplementationFix.configure gen;
|
|
|
-
|
|
|
- IteratorsInterface.configure gen (fun e -> e);
|
|
|
-
|
|
|
- ClosuresToClass.configure gen (ClosuresToClass.default_implementation closure_t (get_cl (get_type gen (["haxe";"lang"],"Function")) ));
|
|
|
-
|
|
|
- EnumToClass.configure gen (None) false true (get_cl (get_type gen (["haxe";"lang"],"Enum")) ) false false;
|
|
|
-
|
|
|
- InterfaceVarsDeleteModf.configure gen;
|
|
|
-
|
|
|
- let dynamic_object = (get_cl (get_type gen (["haxe";"lang"],"DynamicObject")) ) in
|
|
|
-
|
|
|
- let object_iface = get_cl (get_type gen (["haxe";"lang"],"IHxObject")) in
|
|
|
-
|
|
|
- (*fixme: THIS IS A HACK. take this off *)
|
|
|
- let empty_e = match (get_type gen (["haxe";"lang"], "EmptyObject")) with | TEnumDecl e -> e | _ -> assert false in
|
|
|
- (*OverloadingCtor.set_new_create_empty gen ({eexpr=TEnumField(empty_e, "EMPTY"); etype=TEnum(empty_e,[]); epos=null_pos;});*)
|
|
|
-
|
|
|
- let empty_expr = { eexpr = (TTypeExpr (TEnumDecl empty_e)); etype = (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics empty_e) }); epos = null_pos } in
|
|
|
- let empty_ef =
|
|
|
- try
|
|
|
- PMap.find "EMPTY" empty_e.e_constrs
|
|
|
- with Not_found -> gen.gcon.error "Required enum field EMPTY was not found" empty_e.e_pos; assert false
|
|
|
- in
|
|
|
- OverloadingConstructor.configure ~empty_ctor_type:(TEnum(empty_e, [])) ~empty_ctor_expr:({ eexpr=TField(empty_expr, FEnum(empty_e, empty_ef)); etype=TEnum(empty_e,[]); epos=null_pos; }) ~supports_ctor_inheritance:false gen;
|
|
|
-
|
|
|
- let rcf_static_find = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "findHash" Ast.null_pos [] in
|
|
|
- (*let rcf_static_lookup = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "lookupHash" Ast.null_pos [] in*)
|
|
|
-
|
|
|
- let can_be_float t = like_float (real_type t) in
|
|
|
-
|
|
|
- let rcf_on_getset_field main_expr field_expr field may_hash may_set is_unsafe =
|
|
|
- let is_float = can_be_float (if is_none may_set then main_expr.etype else (get may_set).etype) in
|
|
|
- let fn_name = if is_some may_set then "setField" else "getField" in
|
|
|
- let fn_name = if is_float then fn_name ^ "_f" else fn_name in
|
|
|
- let pos = field_expr.epos in
|
|
|
-
|
|
|
- let is_unsafe = { eexpr = TConst(TBool is_unsafe); etype = basic.tbool; epos = pos } in
|
|
|
-
|
|
|
- let should_cast = match main_expr.etype with | TInst({ cl_path = ([], "Float") }, []) -> false | _ -> true in
|
|
|
- let infer = mk_static_field_access_infer runtime_cl fn_name field_expr.epos [] in
|
|
|
- let first_args =
|
|
|
- [ field_expr; { eexpr = TConst(TString field); etype = basic.tstring; epos = pos } ]
|
|
|
- @ if is_some may_hash then [ { eexpr = TConst(TInt (get may_hash)); etype = basic.tint; epos = pos } ] else []
|
|
|
- in
|
|
|
- let args = first_args @ match is_float, may_set with
|
|
|
- | true, Some(set) ->
|
|
|
- [ if should_cast then mk_cast basic.tfloat set else set ]
|
|
|
- | false, Some(set) ->
|
|
|
- [ set ]
|
|
|
- | _ ->
|
|
|
- [ is_unsafe ]
|
|
|
- in
|
|
|
-
|
|
|
- let call = { main_expr with eexpr = TCall(infer,args) } in
|
|
|
- let call = if is_float && should_cast then mk_cast main_expr.etype call else call in
|
|
|
- call
|
|
|
- in
|
|
|
-
|
|
|
- let rcf_on_call_field ecall field_expr field may_hash args =
|
|
|
- let infer = mk_static_field_access_infer runtime_cl "callField" field_expr.epos [] in
|
|
|
-
|
|
|
- let hash_arg = match may_hash with
|
|
|
- | None -> []
|
|
|
- | Some h -> [ { eexpr = TConst(TInt h); etype = basic.tint; epos = field_expr.epos } ]
|
|
|
- in
|
|
|
-
|
|
|
- let arr_call = if args <> [] then
|
|
|
- { eexpr = TArrayDecl args; etype = basic.tarray t_dynamic; epos = ecall.epos }
|
|
|
- else
|
|
|
- null (basic.tarray t_dynamic) ecall.epos
|
|
|
- in
|
|
|
-
|
|
|
-
|
|
|
- let call_args =
|
|
|
- [field_expr; { field_expr with eexpr = TConst(TString field); etype = basic.tstring } ]
|
|
|
- @ hash_arg
|
|
|
- @ [ arr_call ]
|
|
|
- in
|
|
|
-
|
|
|
- mk_cast ecall.etype { ecall with eexpr = TCall(infer, call_args); etype = t_dynamic }
|
|
|
- in
|
|
|
-
|
|
|
- let rcf_ctx = ReflectionCFs.new_ctx gen closure_t object_iface false rcf_on_getset_field rcf_on_call_field (fun hash hash_array ->
|
|
|
- { hash with eexpr = TCall(rcf_static_find, [hash; hash_array]); etype=basic.tint }
|
|
|
- ) (fun hash -> hash ) false in
|
|
|
-
|
|
|
- ReflectionCFs.UniversalBaseClass.default_config gen (get_cl (get_type gen (["haxe";"lang"],"HxObject")) ) object_iface dynamic_object;
|
|
|
-
|
|
|
- ReflectionCFs.configure_dynamic_field_access rcf_ctx false;
|
|
|
-
|
|
|
- (* let closure_func = ReflectionCFs.implement_closure_cl rcf_ctx ( get_cl (get_type gen (["haxe";"lang"],"Closure")) ) in *)
|
|
|
- let closure_cl = get_cl (get_type gen (["haxe";"lang"],"Closure")) in
|
|
|
-
|
|
|
- let closure_func = ReflectionCFs.get_closure_func rcf_ctx closure_cl in
|
|
|
-
|
|
|
- ReflectionCFs.implement_varargs_cl rcf_ctx ( get_cl (get_type gen (["haxe";"lang"], "VarArgsBase")) );
|
|
|
-
|
|
|
- let slow_invoke = mk_static_field_access_infer (runtime_cl) "slowCallField" Ast.null_pos [] in
|
|
|
- ReflectionCFs.configure rcf_ctx ~slow_invoke:(fun ethis efield eargs -> {
|
|
|
- eexpr = TCall(slow_invoke, [ethis; efield; eargs]);
|
|
|
- etype = t_dynamic;
|
|
|
- epos = ethis.epos;
|
|
|
- } ) object_iface;
|
|
|
-
|
|
|
- let objdecl_fn = ReflectionCFs.implement_dynamic_object_ctor rcf_ctx dynamic_object in
|
|
|
-
|
|
|
- ObjectDeclMap.configure gen (ObjectDeclMap.traverse gen objdecl_fn);
|
|
|
-
|
|
|
- InitFunction.configure gen true;
|
|
|
- TArrayTransform.configure gen (TArrayTransform.default_implementation gen (
|
|
|
- fun e _ ->
|
|
|
- match e.eexpr with
|
|
|
- | TArray ({ eexpr = TLocal { v_extra = Some( _ :: _, _) } }, _) -> (* captured transformation *)
|
|
|
- false
|
|
|
- | TArray(e1, e2) ->
|
|
|
- ( match run_follow gen (follow e1.etype) with
|
|
|
- | TInst({ cl_path = (["java"], "NativeArray") }, _) -> false
|
|
|
- | _ -> true )
|
|
|
- | _ -> assert false
|
|
|
- ) "__get" "__set" );
|
|
|
-
|
|
|
- let field_is_dynamic t field =
|
|
|
- match field_access_esp gen (gen.greal_type t) field with
|
|
|
- | FClassField (cl,p,_,_,_,t,_) ->
|
|
|
- is_dynamic (apply_params cl.cl_types p t)
|
|
|
- | FEnumField _ -> false
|
|
|
- | _ -> true
|
|
|
- in
|
|
|
-
|
|
|
- let is_type_param e = match follow e with
|
|
|
- | TInst( { cl_kind = KTypeParameter _ },[]) -> true
|
|
|
- | _ -> false
|
|
|
- in
|
|
|
-
|
|
|
- let is_dynamic_expr e = is_dynamic e.etype || match e.eexpr with
|
|
|
- | TField(tf, f) -> field_is_dynamic tf.etype f
|
|
|
- | _ -> false
|
|
|
- in
|
|
|
-
|
|
|
- let may_nullable t = match gen.gfollow#run_f t with
|
|
|
- | TType({ t_path = ([], "Null") }, [t]) ->
|
|
|
- (match follow t with
|
|
|
- | TInst({ cl_path = ([], "String") }, [])
|
|
|
- | TInst({ cl_path = ([], "Float") }, [])
|
|
|
- | TAbstract ({ a_path = ([], "Float") },[])
|
|
|
- | TInst({ cl_path = (["haxe"], "Int32")}, [] )
|
|
|
- | TInst({ cl_path = (["haxe"], "Int64")}, [] )
|
|
|
- | TInst({ cl_path = ([], "Int") }, [])
|
|
|
- | TAbstract ({ a_path = ([], "Int") },[])
|
|
|
- | TEnum({ e_path = ([], "Bool") }, [])
|
|
|
- | TAbstract ({ a_path = ([], "Bool") },[]) -> Some t
|
|
|
- | _ -> None )
|
|
|
- | _ -> None
|
|
|
- in
|
|
|
-
|
|
|
- let is_double t = like_float t && not (like_int t) in
|
|
|
- let is_int t = like_int t in
|
|
|
-
|
|
|
- DynamicOperators.configure gen
|
|
|
- (DynamicOperators.abstract_implementation gen (fun e -> match e.eexpr with
|
|
|
- | TBinop (Ast.OpEq, e1, e2)
|
|
|
- | TBinop (Ast.OpAdd, e1, e2)
|
|
|
- | TBinop (Ast.OpNotEq, e1, e2) -> is_dynamic e1.etype || is_dynamic e2.etype || is_type_param e1.etype || is_type_param e2.etype
|
|
|
- | TBinop (Ast.OpLt, e1, e2)
|
|
|
- | TBinop (Ast.OpLte, e1, e2)
|
|
|
- | TBinop (Ast.OpGte, e1, e2)
|
|
|
- | TBinop (Ast.OpGt, e1, e2) -> is_dynamic e.etype || is_dynamic_expr e1 || is_dynamic_expr e2 || is_string e1.etype || is_string e2.etype
|
|
|
- | TBinop (_, e1, e2) -> is_dynamic e.etype || is_dynamic_expr e1 || is_dynamic_expr e2
|
|
|
- | TUnop (_, _, e1) -> is_dynamic_expr e1
|
|
|
- | _ -> false)
|
|
|
- (fun e1 e2 ->
|
|
|
- let is_null e = match e.eexpr with | TConst(TNull) | TLocal({ v_name = "__undefined__" }) -> true | _ -> false in
|
|
|
-
|
|
|
- if is_null e1 || is_null e2 then
|
|
|
- match e1.eexpr, e2.eexpr with
|
|
|
- | TConst c1, TConst c2 ->
|
|
|
- { e1 with eexpr = TConst(TBool (c1 = c2)); etype = basic.tbool }
|
|
|
- | _ ->
|
|
|
- { e1 with eexpr = TBinop(Ast.OpEq, e1, e2); etype = basic.tbool }
|
|
|
- else begin
|
|
|
- let is_ref = match follow e1.etype, follow e2.etype with
|
|
|
- | TDynamic _, _
|
|
|
- | _, TDynamic _
|
|
|
- | TInst({ cl_path = ([], "Float") },[]), _
|
|
|
- | TAbstract ({ a_path = ([], "Float") },[]) , _
|
|
|
- | TInst( { cl_path = (["haxe"], "Int32") }, [] ), _
|
|
|
- | TInst( { cl_path = (["haxe"], "Int64") }, [] ), _
|
|
|
- | TInst({ cl_path = ([], "Int") },[]), _
|
|
|
- | TAbstract ({ a_path = ([], "Int") },[]) , _
|
|
|
- | TEnum({ e_path = ([], "Bool") },[]), _
|
|
|
- | TAbstract ({ a_path = ([], "Bool") },[]) , _
|
|
|
- | _, TInst({ cl_path = ([], "Float") },[])
|
|
|
- | _, TAbstract ({ a_path = ([], "Float") },[])
|
|
|
- | _, TInst({ cl_path = ([], "Int") },[])
|
|
|
- | _, TAbstract ({ a_path = ([], "Int") },[])
|
|
|
- | _, TInst( { cl_path = (["haxe"], "Int32") }, [] )
|
|
|
- | _, TInst( { cl_path = (["haxe"], "Int64") }, [] )
|
|
|
- | _, TEnum({ e_path = ([], "Bool") },[])
|
|
|
- | _, TAbstract ({ a_path = ([], "Bool") },[])
|
|
|
- | TInst( { cl_kind = KTypeParameter _ }, [] ), _
|
|
|
- | _, TInst( { cl_kind = KTypeParameter _ }, [] ) -> false
|
|
|
- | _, _ -> true
|
|
|
- in
|
|
|
-
|
|
|
- let static = mk_static_field_access_infer (runtime_cl) (if is_ref then "refEq" else "eq") e1.epos [] in
|
|
|
- { eexpr = TCall(static, [e1; e2]); etype = gen.gcon.basic.tbool; epos=e1.epos }
|
|
|
- end
|
|
|
- )
|
|
|
- (fun e e1 e2 ->
|
|
|
- match may_nullable e1.etype, may_nullable e2.etype with
|
|
|
- | Some t1, Some t2 ->
|
|
|
- let t1, t2 = if is_string t1 || is_string t2 then
|
|
|
- basic.tstring, basic.tstring
|
|
|
- else if is_double t1 || is_double t2 then
|
|
|
- basic.tfloat, basic.tfloat
|
|
|
- else if is_int t1 || is_int t2 then
|
|
|
- basic.tint, basic.tint
|
|
|
- else t1, t2 in
|
|
|
- { eexpr = TBinop(Ast.OpAdd, mk_cast t1 e1, mk_cast t2 e2); etype = e.etype; epos = e1.epos }
|
|
|
- | _ ->
|
|
|
- let static = mk_static_field_access_infer (runtime_cl) "plus" e1.epos [] in
|
|
|
- mk_cast e.etype { eexpr = TCall(static, [e1; e2]); etype = t_dynamic; epos=e1.epos })
|
|
|
- (fun e1 e2 ->
|
|
|
- if is_string e1.etype then begin
|
|
|
- { e1 with eexpr = TCall(mk_field_access gen e1 "compareTo" e1.epos, [ e2 ]); etype = gen.gcon.basic.tint }
|
|
|
- end else begin
|
|
|
- let static = mk_static_field_access_infer (runtime_cl) "compare" e1.epos [] in
|
|
|
- { eexpr = TCall(static, [e1; e2]); etype = gen.gcon.basic.tint; epos=e1.epos }
|
|
|
- end));
|
|
|
-
|
|
|
- FilterClosures.configure gen (FilterClosures.traverse gen (fun e1 s -> true) closure_func);
|
|
|
-
|
|
|
- let base_exception = get_cl (get_type gen (["java"; "lang"], "Throwable")) in
|
|
|
- let base_exception_t = TInst(base_exception, []) in
|
|
|
-
|
|
|
- let hx_exception = get_cl (get_type gen (["haxe";"lang"], "HaxeException")) in
|
|
|
- let hx_exception_t = TInst(hx_exception, []) in
|
|
|
-
|
|
|
- let rec is_exception t =
|
|
|
- match follow t with
|
|
|
- | TInst(cl,_) ->
|
|
|
- if cl == base_exception then
|
|
|
- true
|
|
|
- else
|
|
|
- (match cl.cl_super with | None -> false | Some (cl,arg) -> is_exception (TInst(cl,arg)))
|
|
|
- | _ -> false
|
|
|
- in
|
|
|
-
|
|
|
- TryCatchWrapper.configure gen
|
|
|
- (
|
|
|
- TryCatchWrapper.traverse gen
|
|
|
- (fun t -> not (is_exception (real_type t)))
|
|
|
- (fun throwexpr expr ->
|
|
|
- let wrap_static = mk_static_field_access (hx_exception) "wrap" (TFun([("obj",false,t_dynamic)], base_exception_t)) expr.epos in
|
|
|
- { throwexpr with eexpr = TThrow { expr with eexpr = TCall(wrap_static, [expr]); etype = hx_exception_t }; etype = gen.gcon.basic.tvoid }
|
|
|
- )
|
|
|
- (fun v_to_unwrap pos ->
|
|
|
- let local = mk_cast hx_exception_t { eexpr = TLocal(v_to_unwrap); etype = v_to_unwrap.v_type; epos = pos } in
|
|
|
- mk_field_access gen local "obj" pos
|
|
|
- )
|
|
|
- (fun rethrow ->
|
|
|
- let wrap_static = mk_static_field_access (hx_exception) "wrap" (TFun([("obj",false,t_dynamic)], base_exception_t)) rethrow.epos in
|
|
|
- { rethrow with eexpr = TThrow { rethrow with eexpr = TCall(wrap_static, [rethrow]) }; }
|
|
|
- )
|
|
|
- (base_exception_t)
|
|
|
- (hx_exception_t)
|
|
|
- (fun v e -> e)
|
|
|
- );
|
|
|
-
|
|
|
- let get_typeof e =
|
|
|
- { e with eexpr = TCall( { eexpr = TLocal( alloc_var "__typeof__" t_dynamic ); etype = t_dynamic; epos = e.epos }, [e] ) }
|
|
|
- in
|
|
|
-
|
|
|
- ClassInstance.configure gen (ClassInstance.traverse gen (fun e mt -> get_typeof e));
|
|
|
-
|
|
|
- (*let v = alloc_var "$type_param" t_dynamic in*)
|
|
|
- TypeParams.configure gen (fun ecall efield params elist ->
|
|
|
- { ecall with eexpr = TCall(efield, elist) }
|
|
|
- );
|
|
|
-
|
|
|
- CastDetect.configure gen (CastDetect.default_implementation gen ~native_string_cast:false (Some (TEnum(empty_e, []))) false);
|
|
|
-
|
|
|
- (*FollowAll.configure gen;*)
|
|
|
-
|
|
|
- SwitchToIf.configure gen (SwitchToIf.traverse gen (fun e ->
|
|
|
- match e.eexpr with
|
|
|
- | TSwitch(cond, cases, def) ->
|
|
|
- (match gen.gfollow#run_f cond.etype with
|
|
|
- | TInst( { cl_path = (["haxe"], "Int32") }, [] )
|
|
|
- | TInst({ cl_path = ([], "Int") },[])
|
|
|
- | TAbstract ({ a_path = ([], "Int") },[])
|
|
|
- | TInst({ cl_path = ([], "String") },[]) ->
|
|
|
- (List.exists (fun (c,_) ->
|
|
|
- List.exists (fun expr -> match expr.eexpr with | TConst _ -> false | _ -> true ) c
|
|
|
- ) cases)
|
|
|
- | _ -> true
|
|
|
- )
|
|
|
- | _ -> assert false
|
|
|
- ) true );
|
|
|
-
|
|
|
- let native_arr_cl = get_cl ( get_type gen (["java"], "NativeArray") ) in
|
|
|
-
|
|
|
- ExpressionUnwrap.configure gen (ExpressionUnwrap.traverse gen (fun e -> Some { eexpr = TVar(mk_temp gen "expr" e.etype, Some e); etype = gen.gcon.basic.tvoid; epos = e.epos }));
|
|
|
-
|
|
|
- UnnecessaryCastsRemoval.configure gen;
|
|
|
-
|
|
|
- IntDivisionSynf.configure gen (IntDivisionSynf.default_implementation gen true);
|
|
|
-
|
|
|
- UnreachableCodeEliminationSynf.configure gen (UnreachableCodeEliminationSynf.traverse gen false true true true);
|
|
|
-
|
|
|
- ArrayDeclSynf.configure gen (ArrayDeclSynf.default_implementation gen native_arr_cl);
|
|
|
-
|
|
|
- let goto_special = alloc_var "__goto__" t_dynamic in
|
|
|
- let label_special = alloc_var "__label__" t_dynamic in
|
|
|
- SwitchBreakSynf.configure gen (SwitchBreakSynf.traverse gen
|
|
|
- (fun e_loop n api ->
|
|
|
- { e_loop with eexpr = TBlock( { eexpr = TCall( mk_local label_special e_loop.epos, [ mk_int gen n e_loop.epos ] ); etype = t_dynamic; epos = e_loop.epos } :: [e_loop] ) };
|
|
|
- )
|
|
|
- (fun e_break n api ->
|
|
|
- { eexpr = TCall( mk_local goto_special e_break.epos, [ mk_int gen n e_break.epos ] ); etype = t_dynamic; epos = e_break.epos }
|
|
|
- )
|
|
|
- );
|
|
|
-
|
|
|
- DefaultArguments.configure gen (DefaultArguments.traverse gen);
|
|
|
-
|
|
|
- JavaSpecificSynf.configure gen (JavaSpecificSynf.traverse gen runtime_cl);
|
|
|
- JavaSpecificESynf.configure gen (JavaSpecificESynf.traverse gen runtime_cl);
|
|
|
-
|
|
|
- (* add native String as a String superclass *)
|
|
|
- let str_cl = match gen.gcon.basic.tstring with | TInst(cl,_) -> cl | _ -> assert false in
|
|
|
- str_cl.cl_super <- Some (get_cl (get_type gen (["haxe";"lang"], "NativeString")), []);
|
|
|
-
|
|
|
- let mkdir dir = if not (Sys.file_exists dir) then Unix.mkdir dir 0o755 in
|
|
|
- mkdir gen.gcon.file;
|
|
|
- mkdir (gen.gcon.file ^ "/src");
|
|
|
-
|
|
|
- (* add resources array *)
|
|
|
- (try
|
|
|
- let res = get_cl (Hashtbl.find gen.gtypes (["haxe"], "Resource")) in
|
|
|
- let cf = PMap.find "content" res.cl_statics in
|
|
|
- let res = ref [] in
|
|
|
- Hashtbl.iter (fun name v ->
|
|
|
- res := { eexpr = TConst(TString name); etype = gen.gcon.basic.tstring; epos = Ast.null_pos } :: !res;
|
|
|
-
|
|
|
- let full_path = gen.gcon.file ^ "/src/" ^ name in
|
|
|
- let parts = Str.split_delim (Str.regexp "[\\/]+") full_path in
|
|
|
- let dir_list = List.rev (List.tl (List.rev parts)) in
|
|
|
-
|
|
|
- Common.mkdir_recursive "" dir_list;
|
|
|
-
|
|
|
- let f = open_out full_path in
|
|
|
- output_string f v;
|
|
|
- close_out f
|
|
|
- ) gen.gcon.resources;
|
|
|
- cf.cf_expr <- Some ({ eexpr = TArrayDecl(!res); etype = gen.gcon.basic.tarray gen.gcon.basic.tstring; epos = Ast.null_pos })
|
|
|
- with | Not_found -> ());
|
|
|
-
|
|
|
- run_filters gen;
|
|
|
-
|
|
|
- TypeParams.RenameTypeParameters.run gen;
|
|
|
+ let native_arr_cl = get_cl ( get_type gen (["java"], "NativeArray") ) in
|
|
|
+ gen.gclasses.nativearray <- (fun t -> TInst(native_arr_cl,[t]));
|
|
|
+ gen.gclasses.nativearray_type <- (function TInst(_,[t]) -> t | _ -> assert false);
|
|
|
+ gen.gclasses.nativearray_len <- (fun e p -> mk_field_access gen e "length" p);
|
|
|
+
|
|
|
+ let basic = gen.gcon.basic in
|
|
|
+
|
|
|
+ let fn_cl = get_cl (get_type gen (["haxe";"lang"],"Function")) in
|
|
|
+
|
|
|
+ let runtime_cl = get_cl (get_type gen (["haxe";"lang"],"Runtime")) in
|
|
|
+ let nulltdef = get_tdef (get_type gen ([],"Null")) in
|
|
|
+
|
|
|
+ (*let string_ref = get_cl ( get_type gen (["haxe";"lang"], "StringRefl")) in*)
|
|
|
+
|
|
|
+ let ti64 = match ( get_type gen (["java"], "Int64") ) with | TAbstractDecl a -> TAbstract(a,[]) | _ -> assert false in
|
|
|
+
|
|
|
+ let has_tdynamic params =
|
|
|
+ List.exists (fun e -> match run_follow gen e with | TDynamic _ -> true | _ -> false) params
|
|
|
+ in
|
|
|
+
|
|
|
+ (*
|
|
|
+ The type parameters always need to be changed to their boxed counterparts
|
|
|
+ *)
|
|
|
+ let change_param_type md params =
|
|
|
+ match md with
|
|
|
+ | TClassDecl( { cl_path = (["java"], "NativeArray") } ) -> params
|
|
|
+ | TAbstractDecl { a_path=[],("Class" | "Enum") } | TClassDecl { cl_path = (["java";"lang"],("Class"|"Enum")) } ->
|
|
|
+ List.map (fun _ -> t_dynamic) params
|
|
|
+ | _ ->
|
|
|
+ match params with
|
|
|
+ | [] -> []
|
|
|
+ | _ ->
|
|
|
+ if has_tdynamic params then List.map (fun _ -> t_dynamic) params else
|
|
|
+ List.map (fun t ->
|
|
|
+ let f_t = gen.gfollow#run_f t in
|
|
|
+ match f_t with
|
|
|
+ | TAbstract ({ a_path = ([], "Bool") },[])
|
|
|
+ | TAbstract ({ a_path = ([],"Float") },[])
|
|
|
+ | TInst ({ cl_path = ["haxe"],"Int32" },[])
|
|
|
+ | TInst ({ cl_path = ["haxe"],"Int64" },[])
|
|
|
+ | TAbstract ({ a_path = ([],"Int") },[])
|
|
|
+ | TType ({ t_path = ["java"], "Int64" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"], "Int64" },[])
|
|
|
+ | TType ({ t_path = ["java"],"Int8" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"],"Int8" },[])
|
|
|
+ | TType ({ t_path = ["java"],"Int16" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"],"Int16" },[])
|
|
|
+ | TType ({ t_path = ["java"],"Char16" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"],"Char16" },[])
|
|
|
+ | TType ({ t_path = [],"Single" },[])
|
|
|
+ | TAbstract ({ a_path = [],"Single" },[]) ->
|
|
|
+ TType(nulltdef, [f_t])
|
|
|
+ (*| TType ({ t_path = [], "Null"*)
|
|
|
+ | TInst (cl, ((_ :: _) as p)) when cl.cl_path <> (["java"],"NativeArray") ->
|
|
|
+ (* TInst(cl, List.map (fun _ -> t_dynamic) p) *)
|
|
|
+ TInst(cl,p)
|
|
|
+ | TEnum (e, ((_ :: _) as p)) ->
|
|
|
+ TEnum(e, List.map (fun _ -> t_dynamic) p)
|
|
|
+ | _ -> t
|
|
|
+ ) params
|
|
|
+ in
|
|
|
+
|
|
|
+ let change_clname name =
|
|
|
+ String.map (function | '$' -> '.' | c -> c) name
|
|
|
+ in
|
|
|
+ let change_id name = try Hashtbl.find reserved name with | Not_found -> name in
|
|
|
+ let rec change_ns ns = match ns with
|
|
|
+ | [] -> ["haxe"; "root"]
|
|
|
+ | _ -> List.map change_id ns
|
|
|
+ in
|
|
|
+ let change_field = change_id in
|
|
|
+
|
|
|
+ let write_id w name = write w (change_id name) in
|
|
|
+
|
|
|
+ let write_field w name = write w (change_field name) in
|
|
|
+
|
|
|
+ gen.gfollow#add ~name:"follow_basic" (fun t -> match t with
|
|
|
+ | TAbstract ({ a_path = ([], "Bool") },[])
|
|
|
+ | TAbstract ({ a_path = ([], "Void") },[])
|
|
|
+ | TAbstract ({ a_path = ([],"Float") },[])
|
|
|
+ | TAbstract ({ a_path = ([],"Int") },[])
|
|
|
+ | TInst( { cl_path = (["haxe"], "Int32") }, [] )
|
|
|
+ | TInst( { cl_path = (["haxe"], "Int64") }, [] )
|
|
|
+ | TType ({ t_path = ["java"], "Int64" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"], "Int64" },[])
|
|
|
+ | TType ({ t_path = ["java"],"Int8" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"],"Int8" },[])
|
|
|
+ | TType ({ t_path = ["java"],"Int16" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"],"Int16" },[])
|
|
|
+ | TType ({ t_path = ["java"],"Char16" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"],"Char16" },[])
|
|
|
+ | TType ({ t_path = [],"Single" },[])
|
|
|
+ | TAbstract ({ a_path = [],"Single" },[]) ->
|
|
|
+ Some t
|
|
|
+ | TType (({ t_path = [],"Null" } as tdef),[t2]) ->
|
|
|
+ Some (TType(tdef,[gen.gfollow#run_f t2]))
|
|
|
+ | TAbstract (a, pl) when not (Meta.has Meta.CoreType a.a_meta) ->
|
|
|
+ Some (gen.gfollow#run_f ( Abstract.get_underlying_type a pl) )
|
|
|
+ | TAbstract( { a_path = ([], "EnumValue") }, _ )
|
|
|
+ | TInst( { cl_path = ([], "EnumValue") }, _ ) -> Some t_dynamic
|
|
|
+ | _ -> None);
|
|
|
+
|
|
|
+ let change_path path = (change_ns (fst path), change_clname (snd path)) in
|
|
|
+
|
|
|
+ let path_s path meta = try
|
|
|
+ match Meta.get Meta.JavaCanonical meta with
|
|
|
+ | (Meta.JavaCanonical, [EConst(String pack), _; EConst(String name), _], _) ->
|
|
|
+ if pack = "" then
|
|
|
+ name
|
|
|
+ else
|
|
|
+ pack ^ "." ^ name
|
|
|
+ | _ -> raise Not_found
|
|
|
+ with Not_found -> match path with
|
|
|
+ | (ns,clname) -> path_s (change_ns ns, change_clname clname)
|
|
|
+ in
|
|
|
+
|
|
|
+ let cl_cl = get_cl (get_type gen (["java";"lang"],"Class")) in
|
|
|
+
|
|
|
+ let rec real_type t =
|
|
|
+ let t = gen.gfollow#run_f t in
|
|
|
+ match t with
|
|
|
+ | TAbstract (a, pl) when not (Meta.has Meta.CoreType a.a_meta) ->
|
|
|
+ real_type (Abstract.get_underlying_type a pl)
|
|
|
+ | TInst( { cl_path = (["haxe"], "Int32") }, [] ) -> gen.gcon.basic.tint
|
|
|
+ | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> ti64
|
|
|
+ | TAbstract( { a_path = ([], "Class") }, p )
|
|
|
+ | TAbstract( { a_path = ([], "Enum") }, p )
|
|
|
+ | TInst( { cl_path = ([], "Class") }, p )
|
|
|
+ | TInst( { cl_path = ([], "Enum") }, p ) -> TInst(cl_cl,[t_dynamic])
|
|
|
+ | TEnum(e,params) -> TEnum(e, List.map (fun _ -> t_dynamic) params)
|
|
|
+ | TInst(c,params) when Meta.has Meta.Enum c.cl_meta ->
|
|
|
+ TInst(c, List.map (fun _ -> t_dynamic) params)
|
|
|
+ | TInst _ -> t
|
|
|
+ | TType({ t_path = ([], "Null") }, [t]) when is_java_basic_type (gen.gfollow#run_f t) -> t_dynamic
|
|
|
+ | TType({ t_path = ([], "Null") }, [t]) ->
|
|
|
+ (match follow t with
|
|
|
+ | TInst( { cl_kind = KTypeParameter _ }, []) ->
|
|
|
+ t_dynamic
|
|
|
+ (* real_type t *)
|
|
|
+ | _ -> real_type t
|
|
|
+ )
|
|
|
+ | TType _ | TAbstract _ -> t
|
|
|
+ | TAnon (anon) -> (match !(anon.a_status) with
|
|
|
+ | Statics _ | EnumStatics _ | AbstractStatics _ -> t
|
|
|
+ | _ -> t_dynamic)
|
|
|
+ | TFun _ -> TInst(fn_cl,[])
|
|
|
+ | _ -> t_dynamic
|
|
|
+ in
|
|
|
+
|
|
|
+ let scope = ref PMap.empty in
|
|
|
+ let imports = ref [] in
|
|
|
+
|
|
|
+ let clear_scope () =
|
|
|
+ scope := PMap.empty;
|
|
|
+ imports := [];
|
|
|
+ in
|
|
|
+
|
|
|
+ let add_scope name =
|
|
|
+ scope := PMap.add name () !scope
|
|
|
+ in
|
|
|
+
|
|
|
+ let add_import pos path meta =
|
|
|
+ let name = snd path in
|
|
|
+ let rec loop = function
|
|
|
+ | (pack, n) :: _ when name = n ->
|
|
|
+ if path <> (pack,n) then
|
|
|
+ gen.gcon.error ("This expression cannot be generated because " ^ path_s path meta ^ " is shadowed by the current scope and ") pos
|
|
|
+ | _ :: tl ->
|
|
|
+ loop tl
|
|
|
+ | [] ->
|
|
|
+ (* add import *)
|
|
|
+ imports := path :: !imports
|
|
|
+ in
|
|
|
+ loop !imports
|
|
|
+ in
|
|
|
+
|
|
|
+ let path_s_import pos path meta = match path with
|
|
|
+ | [], name when PMap.mem name !scope ->
|
|
|
+ gen.gcon.error ("This expression cannot be generated because " ^ name ^ " is shadowed by the current scope") pos;
|
|
|
+ name
|
|
|
+ | pack1 :: _, name when PMap.mem pack1 !scope -> (* exists in scope *)
|
|
|
+ add_import pos path meta;
|
|
|
+ (* check if name exists in scope *)
|
|
|
+ if PMap.mem name !scope then
|
|
|
+ gen.gcon.error ("This expression cannot be generated because " ^ pack1 ^ " and " ^ name ^ " are both shadowed by the current scope") pos;
|
|
|
+ name
|
|
|
+ | _ -> path_s path meta
|
|
|
+ in
|
|
|
+
|
|
|
+ let is_dynamic t = match real_type t with
|
|
|
+ | TMono _ | TDynamic _
|
|
|
+ | TInst({ cl_kind = KTypeParameter _ }, _) -> true
|
|
|
+ | TAnon anon ->
|
|
|
+ (match !(anon.a_status) with
|
|
|
+ | EnumStatics _ | Statics _ | AbstractStatics _ -> false
|
|
|
+ | _ -> true
|
|
|
+ )
|
|
|
+ | _ -> false
|
|
|
+ in
|
|
|
+
|
|
|
+ let rec t_s pos t =
|
|
|
+ match real_type t with
|
|
|
+ (* basic types *)
|
|
|
+ | TAbstract ({ a_path = ([], "Bool") },[]) -> "boolean"
|
|
|
+ | TAbstract ({ a_path = ([], "Void") },[]) ->
|
|
|
+ path_s_import pos (["java";"lang"], "Object") []
|
|
|
+ | TAbstract ({ a_path = ([],"Float") },[]) -> "double"
|
|
|
+ | TAbstract ({ a_path = ([],"Int") },[]) -> "int"
|
|
|
+ | TType ({ t_path = ["java"], "Int64" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"], "Int64" },[]) -> "long"
|
|
|
+ | TType ({ t_path = ["java"],"Int8" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"],"Int8" },[]) -> "byte"
|
|
|
+ | TType ({ t_path = ["java"],"Int16" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"],"Int16" },[]) -> "short"
|
|
|
+ | TType ({ t_path = ["java"],"Char16" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"],"Char16" },[]) -> "char"
|
|
|
+ | TType ({ t_path = [],"Single" },[])
|
|
|
+ | TAbstract ({ a_path = [],"Single" },[]) -> "float"
|
|
|
+ | TInst ({ cl_path = ["haxe"],"Int32" },[])
|
|
|
+ | TAbstract ({ a_path = ["haxe"],"Int32" },[]) -> "int"
|
|
|
+ | TInst ({ cl_path = ["haxe"],"Int64" },[])
|
|
|
+ | TAbstract ({ a_path = ["haxe"],"Int64" },[]) -> "long"
|
|
|
+ | TInst({ cl_path = (["java"], "NativeArray") }, [param]) ->
|
|
|
+ let rec check_t_s t =
|
|
|
+ match real_type t with
|
|
|
+ | TInst({ cl_path = (["java"], "NativeArray") }, [param]) ->
|
|
|
+ (check_t_s param) ^ "[]"
|
|
|
+ | _ -> t_s pos (run_follow gen t)
|
|
|
+ in
|
|
|
+ (check_t_s param) ^ "[]"
|
|
|
+
|
|
|
+ (* end of basic types *)
|
|
|
+ | TInst ({ cl_kind = KTypeParameter _; cl_path=p }, []) -> snd p
|
|
|
+ | TAbstract ({ a_path = [], "Dynamic" },[]) ->
|
|
|
+ path_s_import pos (["java";"lang"], "Object") []
|
|
|
+ | TMono r -> (match !r with | None -> "java.lang.Object" | Some t -> t_s pos (run_follow gen t))
|
|
|
+ | TInst ({ cl_path = [], "String" }, []) ->
|
|
|
+ path_s_import pos (["java";"lang"], "String") []
|
|
|
+ | TAbstract ({ a_path = [], "Class" }, [p]) | TAbstract ({ a_path = [], "Enum" }, [p])
|
|
|
+ | TInst ({ cl_path = [], "Class" }, [p]) | TInst ({ cl_path = [], "Enum" }, [p]) ->
|
|
|
+ path_param_s pos (TClassDecl cl_cl) (["java";"lang"], "Class") [p] []
|
|
|
+ | TAbstract ({ a_path = [], "Class" }, _) | TAbstract ({ a_path = [], "Enum" }, _)
|
|
|
+ | TInst ({ cl_path = [], "Class" }, _) | TInst ({ cl_path = [], "Enum" }, _) ->
|
|
|
+ path_s_import pos (["java";"lang"], "Class") []
|
|
|
+ | TEnum ({e_path = p; e_meta = meta}, _) ->
|
|
|
+ path_s_import pos p meta
|
|
|
+ | TInst (({cl_path = p; cl_meta = meta} as cl), _) when Meta.has Meta.Enum cl.cl_meta ->
|
|
|
+ path_s_import pos p meta
|
|
|
+ | TInst (({cl_path = p; cl_meta = meta} as cl), params) -> (path_param_s pos (TClassDecl cl) p params meta)
|
|
|
+ | TType (({t_path = p; t_meta = meta} as t), params) -> (path_param_s pos (TTypeDecl t) p params meta)
|
|
|
+ | TAnon (anon) ->
|
|
|
+ (match !(anon.a_status) with
|
|
|
+ | Statics _ | EnumStatics _ | AbstractStatics _ ->
|
|
|
+ path_s_import pos (["java";"lang"], "Class") []
|
|
|
+ | _ ->
|
|
|
+ path_s_import pos (["java";"lang"], "Object") [])
|
|
|
+ | TDynamic _ ->
|
|
|
+ path_s_import pos (["java";"lang"], "Object") []
|
|
|
+ (* No Lazy type nor Function type made. That's because function types will be at this point be converted into other types *)
|
|
|
+ | _ -> if !strict_mode then begin trace ("[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]"); assert false end else "[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]"
|
|
|
+
|
|
|
+ and param_t_s pos t =
|
|
|
+ match run_follow gen t with
|
|
|
+ | TAbstract ({ a_path = ([], "Bool") },[]) ->
|
|
|
+ path_s_import pos (["java";"lang"], "Boolean") []
|
|
|
+ | TAbstract ({ a_path = ([],"Float") },[]) ->
|
|
|
+ path_s_import pos (["java";"lang"], "Double") []
|
|
|
+ | TAbstract ({ a_path = ([],"Int") },[]) ->
|
|
|
+ path_s_import pos (["java";"lang"], "Integer") []
|
|
|
+ | TType ({ t_path = ["java"], "Int64" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"], "Int64" },[]) ->
|
|
|
+ path_s_import pos (["java";"lang"], "Long") []
|
|
|
+ | TInst ({ cl_path = ["haxe"],"Int64" },[])
|
|
|
+ | TAbstract ({ a_path = ["haxe"],"Int64" },[]) ->
|
|
|
+ path_s_import pos (["java";"lang"], "Long") []
|
|
|
+ | TInst ({ cl_path = ["haxe"],"Int32" },[])
|
|
|
+ | TAbstract ({ a_path = ["haxe"],"Int32" },[]) ->
|
|
|
+ path_s_import pos (["java";"lang"], "Integer") []
|
|
|
+ | TType ({ t_path = ["java"],"Int8" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"],"Int8" },[]) ->
|
|
|
+ path_s_import pos (["java";"lang"], "Byte") []
|
|
|
+ | TType ({ t_path = ["java"],"Int16" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"],"Int16" },[]) ->
|
|
|
+ path_s_import pos (["java";"lang"], "Short") []
|
|
|
+ | TType ({ t_path = ["java"],"Char16" },[])
|
|
|
+ | TAbstract ({ a_path = ["java"],"Char16" },[]) ->
|
|
|
+ path_s_import pos (["java";"lang"], "Character") []
|
|
|
+ | TType ({ t_path = [],"Single" },[])
|
|
|
+ | TAbstract ({ a_path = [],"Single" },[]) ->
|
|
|
+ path_s_import pos (["java";"lang"], "Float") []
|
|
|
+ | TDynamic _ -> "?"
|
|
|
+ | TInst (cl, params) -> t_s pos (TInst(cl, change_param_type (TClassDecl cl) params))
|
|
|
+ | TType (cl, params) -> t_s pos (TType(cl, change_param_type (TTypeDecl cl) params))
|
|
|
+ | TEnum (e, params) -> t_s pos (TEnum(e, change_param_type (TEnumDecl e) params))
|
|
|
+ | _ -> t_s pos t
|
|
|
+
|
|
|
+ and path_param_s pos md path params meta =
|
|
|
+ match params with
|
|
|
+ | [] -> path_s_import pos path meta
|
|
|
+ | _ when has_tdynamic (change_param_type md params) -> path_s_import pos path meta
|
|
|
+ | _ -> sprintf "%s<%s>" (path_s_import pos path meta) (String.concat ", " (List.map (fun t -> param_t_s pos t) (change_param_type md params)))
|
|
|
+ in
|
|
|
+
|
|
|
+ let rett_s pos t =
|
|
|
+ match t with
|
|
|
+ | TAbstract ({ a_path = ([], "Void") },[]) -> "void"
|
|
|
+ | _ -> t_s pos t
|
|
|
+ in
|
|
|
+
|
|
|
+ let high_surrogate c = (c lsr 10) + 0xD7C0 in
|
|
|
+ let low_surrogate c = (c land 0x3FF) lor 0xDC00 in
|
|
|
+
|
|
|
+ let escape ichar b =
|
|
|
+ match ichar with
|
|
|
+ | 92 (* \ *) -> Buffer.add_string b "\\\\"
|
|
|
+ | 39 (* ' *) -> Buffer.add_string b "\\\'"
|
|
|
+ | 34 -> Buffer.add_string b "\\\""
|
|
|
+ | 13 (* \r *) -> Buffer.add_string b "\\r"
|
|
|
+ | 10 (* \n *) -> Buffer.add_string b "\\n"
|
|
|
+ | 9 (* \t *) -> Buffer.add_string b "\\t"
|
|
|
+ | c when c < 32 || (c >= 127 && c <= 0xFFFF) -> Buffer.add_string b (Printf.sprintf "\\u%.4x" c)
|
|
|
+ | c when c > 0xFFFF -> Buffer.add_string b (Printf.sprintf "\\u%.4x\\u%.4x" (high_surrogate c) (low_surrogate c))
|
|
|
+ | c -> Buffer.add_char b (Char.chr c)
|
|
|
+ in
|
|
|
+
|
|
|
+ let escape s =
|
|
|
+ let b = Buffer.create 0 in
|
|
|
+ (try
|
|
|
+ UTF8.validate s;
|
|
|
+ UTF8.iter (fun c -> escape (UChar.code c) b) s
|
|
|
+ with
|
|
|
+ UTF8.Malformed_code ->
|
|
|
+ String.iter (fun c -> escape (Char.code c) b) s
|
|
|
+ );
|
|
|
+ Buffer.contents b
|
|
|
+ in
|
|
|
+
|
|
|
+ let has_semicolon e =
|
|
|
+ match e.eexpr with
|
|
|
+ | TLocal { v_name = "__fallback__" }
|
|
|
+ | TCall ({ eexpr = TLocal( { v_name = "__label__" } ) }, [ { eexpr = TConst(TInt _) } ] ) -> false
|
|
|
+ | TCall ({ eexpr = TLocal( { v_name = "__lock__" } ) }, _ ) -> false
|
|
|
+ | TBlock _ | TFor _ | TSwitch _ | TTry _ | TIf _ -> false
|
|
|
+ | TWhile (_,_,flag) when flag = Ast.NormalWhile -> false
|
|
|
+ | _ -> true
|
|
|
+ in
|
|
|
+
|
|
|
+ let in_value = ref false in
|
|
|
+
|
|
|
+ let rec md_s pos md =
|
|
|
+ let md = follow_module (gen.gfollow#run_f) md in
|
|
|
+ match md with
|
|
|
+ | TClassDecl (cl) ->
|
|
|
+ t_s pos (TInst(cl,[]))
|
|
|
+ | TEnumDecl (e) ->
|
|
|
+ t_s pos (TEnum(e,[]))
|
|
|
+ | TTypeDecl t ->
|
|
|
+ t_s pos (TType(t, []))
|
|
|
+ | TAbstractDecl a ->
|
|
|
+ t_s pos (TAbstract(a, []))
|
|
|
+ in
|
|
|
+
|
|
|
+ (*
|
|
|
+ it seems that Java doesn't like when you create a new array with the type parameter defined
|
|
|
+ so we'll just ignore all type parameters, and hope for the best!
|
|
|
+ *)
|
|
|
+ let rec transform_nativearray_t t = match real_type t with
|
|
|
+ | TInst( ({ cl_path = (["java"], "NativeArray") } as narr), [t]) ->
|
|
|
+ TInst(narr, [transform_nativearray_t t])
|
|
|
+ | TInst(cl, params) -> TInst(cl, List.map (fun _ -> t_dynamic) params)
|
|
|
+ | TEnum(e, params) -> TEnum(e, List.map (fun _ -> t_dynamic) params)
|
|
|
+ | TType(t, params) -> TType(t, List.map (fun _ -> t_dynamic) params)
|
|
|
+ | _ -> t
|
|
|
+ in
|
|
|
+
|
|
|
+ let rec extract_tparams params el =
|
|
|
+ match el with
|
|
|
+ | ({ eexpr = TLocal({ v_name = "$type_param" }) } as tp) :: tl ->
|
|
|
+ extract_tparams (tp.etype :: params) tl
|
|
|
+ | _ -> (params, el)
|
|
|
+ in
|
|
|
+
|
|
|
+ let line_directive =
|
|
|
+ if Common.defined gen.gcon Define.RealPosition then
|
|
|
+ fun w p -> ()
|
|
|
+ else fun w p ->
|
|
|
+ let cur_line = Lexer.get_error_line p in
|
|
|
+ let file = Common.get_full_path p.pfile in
|
|
|
+ print w "//line %d \"%s\"" cur_line (Ast.s_escape file); newline w
|
|
|
+ in
|
|
|
+
|
|
|
+ let extract_statements expr =
|
|
|
+ let ret = ref [] in
|
|
|
+ let rec loop expr = match expr.eexpr with
|
|
|
+ | TCall ({ eexpr = TLocal {
|
|
|
+ v_name = "__is__" | "__typeof__" | "__array__"
|
|
|
+ } }, el) ->
|
|
|
+ List.iter loop el
|
|
|
+ | TNew ({ cl_path = (["java"], "NativeArray") }, params, [ size ]) ->
|
|
|
+ ()
|
|
|
+ | TUnop (Ast.Increment, _, _)
|
|
|
+ | TUnop (Ast.Decrement, _, _)
|
|
|
+ | TBinop (Ast.OpAssign, _, _)
|
|
|
+ | TBinop (Ast.OpAssignOp _, _, _)
|
|
|
+ | TLocal { v_name = "__fallback__" }
|
|
|
+ | TLocal { v_name = "__sbreak__" } ->
|
|
|
+ ret := expr :: !ret
|
|
|
+ | TConst _
|
|
|
+ | TLocal _
|
|
|
+ | TArray _
|
|
|
+ | TBinop _
|
|
|
+ | TField _
|
|
|
+ | TEnumParameter _
|
|
|
+ | TTypeExpr _
|
|
|
+ | TObjectDecl _
|
|
|
+ | TArrayDecl _
|
|
|
+ | TCast _
|
|
|
+ | TMeta _
|
|
|
+ | TParenthesis _
|
|
|
+ | TUnop _ ->
|
|
|
+ Type.iter loop expr
|
|
|
+ | TFunction _ -> () (* do not extract parameters from inside of it *)
|
|
|
+ | _ ->
|
|
|
+ ret := expr :: !ret
|
|
|
+ in
|
|
|
+ loop expr;
|
|
|
+ (* [expr] *)
|
|
|
+ List.rev !ret
|
|
|
+ in
|
|
|
+
|
|
|
+ let expr_s w e =
|
|
|
+ in_value := false;
|
|
|
+ let rec expr_s w e =
|
|
|
+ let was_in_value = !in_value in
|
|
|
+ in_value := true;
|
|
|
+ match e.eexpr with
|
|
|
+ | TConst c ->
|
|
|
+ (match c with
|
|
|
+ | TInt i32 ->
|
|
|
+ print w "%ld" i32;
|
|
|
+ (match real_type e.etype with
|
|
|
+ | TType( { t_path = (["java"], "Int64") }, [] ) -> write w "L";
|
|
|
+ | _ -> ()
|
|
|
+ )
|
|
|
+ | TFloat s ->
|
|
|
+ write w s;
|
|
|
+ (* fix for Int notation, which only fit in a Float *)
|
|
|
+ (if not (String.contains s '.' || String.contains s 'e' || String.contains s 'E') then write w ".0");
|
|
|
+ (match real_type e.etype with
|
|
|
+ | TType( { t_path = ([], "Single") }, [] ) -> write w "f"
|
|
|
+ | _ -> ()
|
|
|
+ )
|
|
|
+ | TString s -> print w "\"%s\"" (escape s)
|
|
|
+ | TBool b -> write w (if b then "true" else "false")
|
|
|
+ | TNull ->
|
|
|
+ (match real_type e.etype with
|
|
|
+ | TAbstract( { a_path = (["java"], "Int64") }, [] )
|
|
|
+ | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> write w "0L"
|
|
|
+ | TInst( { cl_path = (["haxe"], "Int32") }, [] )
|
|
|
+ | TAbstract ({ a_path = ([], "Int") },[]) -> expr_s w ({ e with eexpr = TConst(TInt Int32.zero) })
|
|
|
+ | TAbstract ({ a_path = ([], "Float") },[]) -> expr_s w ({ e with eexpr = TConst(TFloat "0.0") })
|
|
|
+ | TAbstract ({ a_path = ([], "Bool") },[]) -> write w "false"
|
|
|
+ | TAbstract _ when like_int e.etype ->
|
|
|
+ expr_s w (mk_cast e.etype { e with eexpr = TConst(TInt Int32.zero) })
|
|
|
+ | TAbstract _ when like_float e.etype ->
|
|
|
+ expr_s w (mk_cast e.etype { e with eexpr = TConst(TFloat "0.0") } )
|
|
|
+ | t -> write w ("null") )
|
|
|
+ | TThis -> write w "this"
|
|
|
+ | TSuper -> write w "super")
|
|
|
+ | TLocal { v_name = "__fallback__" } -> ()
|
|
|
+ | TLocal { v_name = "__sbreak__" } -> write w "break"
|
|
|
+ | TLocal { v_name = "__undefined__" } ->
|
|
|
+ write w (t_s e.epos (TInst(runtime_cl, List.map (fun _ -> t_dynamic) runtime_cl.cl_params)));
|
|
|
+ write w ".undefined";
|
|
|
+ | TLocal var ->
|
|
|
+ write_id w var.v_name
|
|
|
+ | TField(_, FEnum(en,ef)) ->
|
|
|
+ let s = ef.ef_name in
|
|
|
+ print w "%s." (path_s_import e.epos en.e_path en.e_meta); write_field w s
|
|
|
+ | TArray (e1, e2) ->
|
|
|
+ expr_s w e1; write w "["; expr_s w e2; write w "]"
|
|
|
+ | TBinop ((Ast.OpAssign as op), e1, e2)
|
|
|
+ | TBinop ((Ast.OpAssignOp _ as op), e1, e2) ->
|
|
|
+ expr_s w e1; write w ( " " ^ (Ast.s_binop op) ^ " " ); expr_s w e2
|
|
|
+ | TBinop (op, e1, e2) ->
|
|
|
+ write w "( ";
|
|
|
+ expr_s w e1; write w ( " " ^ (Ast.s_binop op) ^ " " ); expr_s w e2;
|
|
|
+ write w " )"
|
|
|
+ | TField (e, FStatic(_, cf)) when Meta.has Meta.Native cf.cf_meta ->
|
|
|
+ let rec loop meta = match meta with
|
|
|
+ | (Meta.Native, [EConst (String s), _],_) :: _ ->
|
|
|
+ expr_s w e; write w "."; write_field w s
|
|
|
+ | _ :: tl -> loop tl
|
|
|
+ | [] -> expr_s w e; write w "."; write_field w (cf.cf_name)
|
|
|
+ in
|
|
|
+ loop cf.cf_meta
|
|
|
+ | TField (e, s) ->
|
|
|
+ expr_s w e; write w "."; write_field w (field_name s)
|
|
|
+ | TTypeExpr (TClassDecl { cl_path = (["haxe"], "Int32") }) ->
|
|
|
+ write w (path_s_import e.epos (["haxe"], "Int32") [])
|
|
|
+ | TTypeExpr (TClassDecl { cl_path = (["haxe"], "Int64") }) ->
|
|
|
+ write w (path_s_import e.epos (["haxe"], "Int64") [])
|
|
|
+ | TTypeExpr mt -> write w (md_s e.epos mt)
|
|
|
+ | TParenthesis e ->
|
|
|
+ write w "("; expr_s w e; write w ")"
|
|
|
+ | TMeta (_,e) ->
|
|
|
+ expr_s w e
|
|
|
+ | TCall ({ eexpr = TLocal { v_name = "__array__" } }, el)
|
|
|
+ | TCall ({ eexpr = TField(_, FStatic({ cl_path = (["java"],"NativeArray") }, { cf_name = "make" })) }, el)
|
|
|
+ | TArrayDecl el when t_has_type_param e.etype ->
|
|
|
+ let _, el = extract_tparams [] el in
|
|
|
+ print w "( (%s) (new %s " (t_s e.epos e.etype) (t_s e.epos (replace_type_param e.etype));
|
|
|
+ write w "{";
|
|
|
+ ignore (List.fold_left (fun acc e ->
|
|
|
+ (if acc <> 0 then write w ", ");
|
|
|
+ expr_s w e;
|
|
|
+ acc + 1
|
|
|
+ ) 0 el);
|
|
|
+ write w "}) )"
|
|
|
+ | TCall ({ eexpr = TLocal { v_name = "__array__" } }, el)
|
|
|
+ | TCall ({ eexpr = TField(_, FStatic({ cl_path = (["java"],"NativeArray") }, { cf_name = "make" })) }, el)
|
|
|
+ | TArrayDecl el ->
|
|
|
+ let _, el = extract_tparams [] el in
|
|
|
+ print w "new %s" (param_t_s e.epos (transform_nativearray_t e.etype));
|
|
|
+ let is_double = match follow e.etype with
|
|
|
+ | TInst(_,[ t ]) -> if like_float t && not (like_int t) then Some t else None
|
|
|
+ | _ -> None
|
|
|
+ in
|
|
|
+
|
|
|
+ write w "{";
|
|
|
+ ignore (List.fold_left (fun acc e ->
|
|
|
+ (if acc <> 0 then write w ", ");
|
|
|
+ (* this is a hack so we are able to convert ints to boxed Double / Float when needed *)
|
|
|
+ let e = if is_some is_double then mk_cast (get is_double) e else e in
|
|
|
+
|
|
|
+ expr_s w e;
|
|
|
+ acc + 1
|
|
|
+ ) 0 el);
|
|
|
+ write w "}"
|
|
|
+ | TCall( ( { eexpr = TField(_, FStatic({ cl_path = ([], "String") }, { cf_name = "fromCharCode" })) } ), [cc] ) ->
|
|
|
+ write w "Character.toString((char) ";
|
|
|
+ expr_s w cc;
|
|
|
+ write w ")"
|
|
|
+ | TCall ({ eexpr = TLocal( { v_name = "__is__" } ) }, [ expr; { eexpr = TTypeExpr(md) } ] ) ->
|
|
|
+ write w "( ";
|
|
|
+ expr_s w expr;
|
|
|
+ write w " instanceof ";
|
|
|
+ write w (md_s e.epos md);
|
|
|
+ write w " )"
|
|
|
+ | TCall ({ eexpr = TLocal( { v_name = "__java__" } ) }, [ { eexpr = TConst(TString(s)) } ] ) ->
|
|
|
+ write w s
|
|
|
+ | TCall ({ eexpr = TLocal( { v_name = "__java__" } ) }, { eexpr = TConst(TString(s)) } :: tl ) ->
|
|
|
+ Codegen.interpolate_code gen.gcon s tl (write w) (expr_s w) e.epos
|
|
|
+ | TCall ({ eexpr = TLocal( { v_name = "__lock__" } ) }, [ eobj; eblock ] ) ->
|
|
|
+ write w "synchronized(";
|
|
|
+ let rec loop eobj = match eobj.eexpr with
|
|
|
+ | TTypeExpr md ->
|
|
|
+ expr_s w eobj;
|
|
|
+ write w ".class"
|
|
|
+ | TMeta(_,e) | TParenthesis(e) ->
|
|
|
+ loop e
|
|
|
+ | _ ->
|
|
|
+ expr_s w eobj
|
|
|
+ in
|
|
|
+ loop eobj;
|
|
|
+ write w ")";
|
|
|
+ (match eblock.eexpr with
|
|
|
+ | TBlock(_ :: _) ->
|
|
|
+ expr_s w eblock
|
|
|
+ | _ ->
|
|
|
+ begin_block w;
|
|
|
+ expr_s w eblock;
|
|
|
+ if has_semicolon eblock then write w ";";
|
|
|
+ end_block w;
|
|
|
+ )
|
|
|
+ | TCall ({ eexpr = TLocal( { v_name = "__goto__" } ) }, [ { eexpr = TConst(TInt v) } ] ) ->
|
|
|
+ print w "break label%ld" v
|
|
|
+ | TCall ({ eexpr = TLocal( { v_name = "__label__" } ) }, [ { eexpr = TConst(TInt v) } ] ) ->
|
|
|
+ print w "label%ld:" v
|
|
|
+ | TCall ({ eexpr = TLocal( { v_name = "__typeof__" } ) }, [ { eexpr = TTypeExpr md } as expr ] ) ->
|
|
|
+ expr_s w expr;
|
|
|
+ write w ".class"
|
|
|
+ | TCall (e, el) ->
|
|
|
+ let params, el = extract_tparams [] el in
|
|
|
+
|
|
|
+ expr_s w e;
|
|
|
+
|
|
|
+ (*(match params with
|
|
|
+ | [] -> ()
|
|
|
+ | params ->
|
|
|
+ let md = match e.eexpr with
|
|
|
+ | TField(ef, _) -> t_to_md (run_follow gen ef.etype)
|
|
|
+ | _ -> assert false
|
|
|
+ in
|
|
|
+ write w "<";
|
|
|
+ ignore (List.fold_left (fun acc t ->
|
|
|
+ (if acc <> 0 then write w ", ");
|
|
|
+ write w (param_t_s (change_param_type md t));
|
|
|
+ acc + 1
|
|
|
+ ) 0 params);
|
|
|
+ write w ">"
|
|
|
+ );*)
|
|
|
+
|
|
|
+ write w "(";
|
|
|
+ ignore (List.fold_left (fun acc e ->
|
|
|
+ (if acc <> 0 then write w ", ");
|
|
|
+ expr_s w e;
|
|
|
+ acc + 1
|
|
|
+ ) 0 el);
|
|
|
+ write w ")"
|
|
|
+ | TNew (({ cl_path = (["java"], "NativeArray") } as cl), params, [ size ]) ->
|
|
|
+ let rec check_t_s t times =
|
|
|
+ match real_type t with
|
|
|
+ | TInst({ cl_path = (["java"], "NativeArray") }, [param]) ->
|
|
|
+ (check_t_s param (times+1))
|
|
|
+ | _ ->
|
|
|
+ print w "new %s[" (t_s e.epos (transform_nativearray_t t));
|
|
|
+ expr_s w size;
|
|
|
+ print w "]";
|
|
|
+ let rec loop i =
|
|
|
+ if i <= 0 then () else (write w "[]"; loop (i-1))
|
|
|
+ in
|
|
|
+ loop (times - 1)
|
|
|
+ in
|
|
|
+ check_t_s (TInst(cl, params)) 0
|
|
|
+ | TNew ({ cl_path = ([], "String") } as cl, [], el) ->
|
|
|
+ write w "new ";
|
|
|
+ write w (t_s e.epos (TInst(cl, [])));
|
|
|
+ write w "(";
|
|
|
+ ignore (List.fold_left (fun acc e ->
|
|
|
+ (if acc <> 0 then write w ", ");
|
|
|
+ expr_s w e;
|
|
|
+ acc + 1
|
|
|
+ ) 0 el);
|
|
|
+ write w ")"
|
|
|
+ | TNew ({ cl_kind = KTypeParameter _ } as cl, params, el) ->
|
|
|
+ print w "null /* This code should never be reached. It was produced by the use of @:generic on a new type parameter instance: %s */" (path_param_s e.epos (TClassDecl cl) cl.cl_path params cl.cl_meta)
|
|
|
+ | TNew (cl, params, el) ->
|
|
|
+ write w "new ";
|
|
|
+ write w (path_param_s e.epos (TClassDecl cl) cl.cl_path params cl.cl_meta);
|
|
|
+ write w "(";
|
|
|
+ ignore (List.fold_left (fun acc e ->
|
|
|
+ (if acc <> 0 then write w ", ");
|
|
|
+ expr_s w e;
|
|
|
+ acc + 1
|
|
|
+ ) 0 el);
|
|
|
+ write w ")"
|
|
|
+ | TUnop ((Ast.Increment as op), flag, e)
|
|
|
+ | TUnop ((Ast.Decrement as op), flag, e) ->
|
|
|
+ (match flag with
|
|
|
+ | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " " ); expr_s w e
|
|
|
+ | Ast.Postfix -> expr_s w e; write w (Ast.s_unop op))
|
|
|
+ | TUnop (op, flag, e) ->
|
|
|
+ (match flag with
|
|
|
+ | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " (" ); expr_s w e; write w ") "
|
|
|
+ | Ast.Postfix -> write w "("; expr_s w e; write w (") " ^ Ast.s_unop op))
|
|
|
+ | TVar (var, eopt) ->
|
|
|
+ print w "%s " (t_s e.epos var.v_type);
|
|
|
+ write_id w var.v_name;
|
|
|
+ (match eopt with
|
|
|
+ | None ->
|
|
|
+ write w " = ";
|
|
|
+ expr_s w (null var.v_type e.epos)
|
|
|
+ | Some e ->
|
|
|
+ write w " = ";
|
|
|
+ expr_s w e
|
|
|
+ )
|
|
|
+ | TBlock [e] when was_in_value ->
|
|
|
+ expr_s w e
|
|
|
+ | TBlock el ->
|
|
|
+ begin_block w;
|
|
|
+ List.iter (fun e ->
|
|
|
+ List.iter (fun e ->
|
|
|
+ in_value := false;
|
|
|
+ line_directive w e.epos;
|
|
|
+ expr_s w e;
|
|
|
+ if has_semicolon e then write w ";";
|
|
|
+ newline w;
|
|
|
+ ) (extract_statements e)
|
|
|
+ ) el;
|
|
|
+ end_block w
|
|
|
+ | TIf (econd, e1, Some(eelse)) when was_in_value ->
|
|
|
+ write w "( ";
|
|
|
+ expr_s w (mk_paren econd);
|
|
|
+ write w " ? ";
|
|
|
+ expr_s w (mk_paren e1);
|
|
|
+ write w " : ";
|
|
|
+ expr_s w (mk_paren eelse);
|
|
|
+ write w " )";
|
|
|
+ | TIf (econd, e1, eelse) ->
|
|
|
+ write w "if ";
|
|
|
+ expr_s w (mk_paren econd);
|
|
|
+ write w " ";
|
|
|
+ in_value := false;
|
|
|
+ expr_s w (mk_block e1);
|
|
|
+ (match eelse with
|
|
|
+ | None -> ()
|
|
|
+ | Some e ->
|
|
|
+ write w "else";
|
|
|
+ in_value := false;
|
|
|
+ expr_s w (mk_block e)
|
|
|
+ )
|
|
|
+ | TWhile (econd, eblock, flag) ->
|
|
|
+ (match flag with
|
|
|
+ | Ast.NormalWhile ->
|
|
|
+ write w "while ";
|
|
|
+ expr_s w (mk_paren econd);
|
|
|
+ write w "";
|
|
|
+ in_value := false;
|
|
|
+ expr_s w (mk_block eblock)
|
|
|
+ | Ast.DoWhile ->
|
|
|
+ write w "do ";
|
|
|
+ in_value := false;
|
|
|
+ expr_s w (mk_block eblock);
|
|
|
+ write w "while ";
|
|
|
+ in_value := true;
|
|
|
+ expr_s w (mk_paren econd);
|
|
|
+ )
|
|
|
+ | TSwitch (econd, ele_l, default) ->
|
|
|
+ write w "switch ";
|
|
|
+ expr_s w (mk_paren econd);
|
|
|
+ begin_block w;
|
|
|
+ List.iter (fun (el, e) ->
|
|
|
+ List.iter (fun e ->
|
|
|
+ write w "case ";
|
|
|
+ in_value := true;
|
|
|
+ (match e.eexpr with
|
|
|
+ | TField(_,FEnum(e,ef)) ->
|
|
|
+ write w ef.ef_name
|
|
|
+ | _ ->
|
|
|
+ expr_s w e);
|
|
|
+ write w ":";
|
|
|
+ newline w;
|
|
|
+ ) el;
|
|
|
+ in_value := false;
|
|
|
+ expr_s w (mk_block e);
|
|
|
+ newline w;
|
|
|
+ newline w
|
|
|
+ ) ele_l;
|
|
|
+ if is_some default then begin
|
|
|
+ write w "default:";
|
|
|
+ newline w;
|
|
|
+ in_value := false;
|
|
|
+ expr_s w (get default);
|
|
|
+ newline w;
|
|
|
+ end;
|
|
|
+ end_block w
|
|
|
+ | TTry (tryexpr, ve_l) ->
|
|
|
+ write w "try ";
|
|
|
+ in_value := false;
|
|
|
+ expr_s w (mk_block tryexpr);
|
|
|
+ let pos = e.epos in
|
|
|
+ List.iter (fun (var, e) ->
|
|
|
+ print w "catch (%s %s)" (t_s pos var.v_type) (var.v_name);
|
|
|
+ in_value := false;
|
|
|
+ expr_s w (mk_block e);
|
|
|
+ newline w
|
|
|
+ ) ve_l
|
|
|
+ | TReturn eopt ->
|
|
|
+ write w "return ";
|
|
|
+ if is_some eopt then expr_s w (get eopt)
|
|
|
+ | TBreak -> write w "break"
|
|
|
+ | TContinue -> write w "continue"
|
|
|
+ | TThrow e ->
|
|
|
+ write w "throw ";
|
|
|
+ expr_s w e
|
|
|
+ | TCast (e1,md_t) ->
|
|
|
+ ((*match gen.gfollow#run_f e.etype with
|
|
|
+ | TType({ t_path = ([], "UInt") }, []) ->
|
|
|
+ write w "( unchecked ((uint) ";
|
|
|
+ expr_s w e1;
|
|
|
+ write w ") )"
|
|
|
+ | _ ->*)
|
|
|
+ (* FIXME I'm ignoring module type *)
|
|
|
+ print w "((%s) (" (t_s e.epos e.etype);
|
|
|
+ expr_s w e1;
|
|
|
+ write w ") )"
|
|
|
+ )
|
|
|
+ | TFor (_,_,content) ->
|
|
|
+ write w "[ for not supported ";
|
|
|
+ expr_s w content;
|
|
|
+ write w " ]";
|
|
|
+ if !strict_mode then assert false
|
|
|
+ | TObjectDecl _ -> write w "[ obj decl not supported ]"; if !strict_mode then assert false
|
|
|
+ | TFunction _ -> write w "[ func decl not supported ]"; if !strict_mode then assert false
|
|
|
+ | TEnumParameter _ -> write w "[ enum parameter not supported ]"; if !strict_mode then assert false
|
|
|
+ in
|
|
|
+ expr_s w e
|
|
|
+ in
|
|
|
+
|
|
|
+ let rec gen_fpart_attrib w = function
|
|
|
+ | EConst( Ident i ), _ ->
|
|
|
+ write w i
|
|
|
+ | EField( ef, f ), _ ->
|
|
|
+ gen_fpart_attrib w ef;
|
|
|
+ write w ".";
|
|
|
+ write w f
|
|
|
+ | _, p ->
|
|
|
+ gen.gcon.error "Invalid expression inside @:meta metadata" p
|
|
|
+ in
|
|
|
+
|
|
|
+ let rec gen_spart w = function
|
|
|
+ | EConst c, p -> (match c with
|
|
|
+ | Int s | Float s | Ident s ->
|
|
|
+ write w s
|
|
|
+ | String s ->
|
|
|
+ write w "\"";
|
|
|
+ write w (escape s);
|
|
|
+ write w "\""
|
|
|
+ | _ -> gen.gcon.error "Invalid expression inside @:meta metadata" p)
|
|
|
+ | EField( ef, f ), _ ->
|
|
|
+ gen_spart w ef;
|
|
|
+ write w ".";
|
|
|
+ write w f
|
|
|
+ | EBinop( Ast.OpAssign, (EConst (Ident s), _), e2 ), _ ->
|
|
|
+ write w s;
|
|
|
+ write w " = ";
|
|
|
+ gen_spart w e2
|
|
|
+ | EArrayDecl( el ), _ ->
|
|
|
+ write w "{";
|
|
|
+ let fst = ref true in
|
|
|
+ List.iter (fun e ->
|
|
|
+ if !fst then fst := false else write w ", ";
|
|
|
+ gen_spart w e
|
|
|
+ ) el;
|
|
|
+ write w "}"
|
|
|
+ | ECall(fpart,args), _ ->
|
|
|
+ gen_fpart_attrib w fpart;
|
|
|
+ write w "(";
|
|
|
+ let fst = ref true in
|
|
|
+ List.iter (fun e ->
|
|
|
+ if !fst then fst := false else write w ", ";
|
|
|
+ gen_spart w e
|
|
|
+ ) args;
|
|
|
+ write w ")"
|
|
|
+ | _, p ->
|
|
|
+ gen.gcon.error "Invalid expression inside @:meta metadata" p
|
|
|
+ in
|
|
|
+
|
|
|
+ let gen_annotations w ?(add_newline=true) metadata =
|
|
|
+ List.iter (function
|
|
|
+ | Meta.Meta, [meta], _ ->
|
|
|
+ write w "@";
|
|
|
+ gen_spart w meta;
|
|
|
+ if add_newline then newline w else write w " ";
|
|
|
+ | _ -> ()
|
|
|
+ ) metadata
|
|
|
+ in
|
|
|
+
|
|
|
+ let argt_s p t =
|
|
|
+ let w = new_source_writer () in
|
|
|
+ let rec run t =
|
|
|
+ match t with
|
|
|
+ | TType (tdef,p) ->
|
|
|
+ gen_annotations w ~add_newline:false tdef.t_meta;
|
|
|
+ run (follow_once t)
|
|
|
+ | TMono r ->
|
|
|
+ (match !r with
|
|
|
+ | Some t -> run t
|
|
|
+ | _ -> () (* avoid infinite loop / should be the same in this context *))
|
|
|
+ | TLazy f ->
|
|
|
+ run (!f())
|
|
|
+ | _ -> ()
|
|
|
+ in
|
|
|
+ run t;
|
|
|
+ let ret = t_s p t in
|
|
|
+ let c = contents w in
|
|
|
+ if c <> "" then
|
|
|
+ c ^ " " ^ ret
|
|
|
+ else
|
|
|
+ ret
|
|
|
+ in
|
|
|
+
|
|
|
+ let get_string_params cl_params =
|
|
|
+ match cl_params with
|
|
|
+ | [] ->
|
|
|
+ ("","")
|
|
|
+ | _ ->
|
|
|
+ let params = sprintf "<%s>" (String.concat ", " (List.map (fun (_, tcl) -> match follow tcl with | TInst(cl, _) -> snd cl.cl_path | _ -> assert false) cl_params)) in
|
|
|
+ let params_extends = List.fold_left (fun acc (name, t) ->
|
|
|
+ match run_follow gen t with
|
|
|
+ | TInst (cl, p) ->
|
|
|
+ (match cl.cl_implements with
|
|
|
+ | [] -> acc
|
|
|
+ | _ -> acc) (* TODO
|
|
|
+ | _ -> (sprintf " where %s : %s" name (String.concat ", " (List.map (fun (cl,p) -> path_param_s (TClassDecl cl) cl.cl_path p) cl.cl_implements))) :: acc ) *)
|
|
|
+ | _ -> trace (t_s Ast.null_pos t); assert false (* FIXME it seems that a cl_params will never be anything other than cl.cl_params. I'll take the risk and fail if not, just to see if that confirms *)
|
|
|
+ ) [] cl_params in
|
|
|
+ (params, String.concat " " params_extends)
|
|
|
+ in
|
|
|
+
|
|
|
+ let write_parts w parts =
|
|
|
+ let parts = List.filter (fun s -> s <> "") parts in
|
|
|
+ write w (String.concat " " parts)
|
|
|
+ in
|
|
|
+
|
|
|
+ let rec gen_class_field w ?(is_overload=false) is_static cl is_final cf =
|
|
|
+ let is_interface = cl.cl_interface in
|
|
|
+ let name, is_new, is_explicit_iface = match cf.cf_name with
|
|
|
+ | "new" -> snd cl.cl_path, true, false
|
|
|
+ | name when String.contains name '.' ->
|
|
|
+ let fn_name, path = parse_explicit_iface name in
|
|
|
+ (path_s path cl.cl_meta) ^ "." ^ fn_name, false, true
|
|
|
+ | name -> name, false, false
|
|
|
+ in
|
|
|
+ (match cf.cf_kind with
|
|
|
+ | Var _
|
|
|
+ | Method (MethDynamic) when not (Type.is_extern_field cf) ->
|
|
|
+ (if is_overload || List.exists (fun cf -> cf.cf_expr <> None) cf.cf_overloads then
|
|
|
+ gen.gcon.error "Only normal (non-dynamic) methods can be overloaded" cf.cf_pos);
|
|
|
+ if not is_interface then begin
|
|
|
+ let access, modifiers = get_fun_modifiers cf.cf_meta "public" [] in
|
|
|
+ write_parts w (access :: (if is_static then "static" else "") :: modifiers @ [(t_s cf.cf_pos (run_follow gen cf.cf_type)); (change_field name)]);
|
|
|
+ (match cf.cf_expr with
|
|
|
+ | Some e ->
|
|
|
+ write w " = ";
|
|
|
+ expr_s w e;
|
|
|
+ write w ";"
|
|
|
+ | None -> write w ";"
|
|
|
+ )
|
|
|
+ end (* TODO see how (get,set) variable handle when they are interfaces *)
|
|
|
+ | Method _ when Type.is_extern_field cf || (match cl.cl_kind, cf.cf_expr with | KAbstractImpl _, None -> true | _ -> false) ->
|
|
|
+ List.iter (fun cf -> if cl.cl_interface || cf.cf_expr <> None then
|
|
|
+ gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
|
|
|
+ ) cf.cf_overloads
|
|
|
+ | Var _ | Method MethDynamic -> ()
|
|
|
+ | Method mkind ->
|
|
|
+ List.iter (fun cf ->
|
|
|
+ if cl.cl_interface || cf.cf_expr <> None then
|
|
|
+ gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
|
|
|
+ ) cf.cf_overloads;
|
|
|
+ let is_virtual = is_new || (not is_final && match mkind with | MethInline -> false | _ when not is_new -> true | _ -> false) in
|
|
|
+ let is_override = match cf.cf_name with
|
|
|
+ | "equals" when not is_static ->
|
|
|
+ (match cf.cf_type with
|
|
|
+ | TFun([_,_,t], ret) ->
|
|
|
+ (match (real_type t, real_type ret) with
|
|
|
+ | TDynamic _, TAbstract ({ a_path = ([], "Bool") },[])
|
|
|
+ | TAnon _, TAbstract ({ a_path = ([], "Bool") },[]) -> true
|
|
|
+ | _ -> List.memq cf cl.cl_overrides
|
|
|
+ )
|
|
|
+ | _ -> List.memq cf cl.cl_overrides)
|
|
|
+ | "toString" when not is_static ->
|
|
|
+ (match cf.cf_type with
|
|
|
+ | TFun([], ret) ->
|
|
|
+ (match real_type ret with
|
|
|
+ | TInst( { cl_path = ([], "String") }, []) -> true
|
|
|
+ | _ -> gen.gcon.error "A toString() function should return a String!" cf.cf_pos; false
|
|
|
+ )
|
|
|
+ | _ -> List.memq cf cl.cl_overrides
|
|
|
+ )
|
|
|
+ | "hashCode" when not is_static ->
|
|
|
+ (match cf.cf_type with
|
|
|
+ | TFun([], ret) ->
|
|
|
+ (match real_type ret with
|
|
|
+ | TAbstract ({ a_path = ([], "Int") },[]) ->
|
|
|
+ true
|
|
|
+ | _ -> gen.gcon.error "A hashCode() function should return an Int!" cf.cf_pos; false
|
|
|
+ )
|
|
|
+ | _ -> List.memq cf cl.cl_overrides
|
|
|
+ )
|
|
|
+ | _ -> List.memq cf cl.cl_overrides
|
|
|
+ in
|
|
|
+ let visibility = if is_interface then "" else "public" in
|
|
|
+
|
|
|
+ let visibility, modifiers = get_fun_modifiers cf.cf_meta visibility [] in
|
|
|
+ let visibility, is_virtual = if is_explicit_iface then "",false else visibility, is_virtual in
|
|
|
+ let v_n = if is_static then "static" else if is_override && not is_interface then "" else if not is_virtual then "final" else "" in
|
|
|
+ let cf_type = if is_override && not is_overload && not (Meta.has Meta.Overload cf.cf_meta) then match field_access gen (TInst(cl, List.map snd cl.cl_params)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> assert false else cf.cf_type in
|
|
|
+
|
|
|
+ let params = List.map snd cl.cl_params in
|
|
|
+ let ret_type, args = match follow cf_type, follow cf.cf_type with
|
|
|
+ | TFun (strbtl, t), TFun(rargs, _) ->
|
|
|
+ (apply_params cl.cl_params params (real_type t), List.map2 (fun(_,_,t) (n,o,_) -> (n,o,apply_params cl.cl_params params (real_type t))) strbtl rargs)
|
|
|
+ | _ -> assert false
|
|
|
+ in
|
|
|
+
|
|
|
+ (if is_override && not is_interface then write w "@Override ");
|
|
|
+ gen_annotations w cf.cf_meta;
|
|
|
+ (* public static void funcName *)
|
|
|
+ let params, _ = get_string_params cf.cf_params in
|
|
|
+
|
|
|
+ write_parts w (visibility :: v_n :: modifiers @ [params; (if is_new then "" else rett_s cf.cf_pos (run_follow gen ret_type)); (change_field name)]);
|
|
|
+
|
|
|
+ (* <T>(string arg1, object arg2) with T : object *)
|
|
|
+ (match cf.cf_expr with
|
|
|
+ | Some { eexpr = TFunction tf } ->
|
|
|
+ print w "(%s)" (String.concat ", " (List.map2 (fun (var,_) (_,_,t) -> sprintf "%s %s" (argt_s cf.cf_pos (run_follow gen t)) (change_id var.v_name)) tf.tf_args args))
|
|
|
+ | _ ->
|
|
|
+ print w "(%s)" (String.concat ", " (List.map (fun (name, _, t) -> sprintf "%s %s" (argt_s cf.cf_pos (run_follow gen t)) (change_id name)) args))
|
|
|
+ );
|
|
|
+ if is_interface || List.mem "native" modifiers then
|
|
|
+ write w ";"
|
|
|
+ else begin
|
|
|
+ let rec loop meta =
|
|
|
+ match meta with
|
|
|
+ | [] ->
|
|
|
+ let expr = match cf.cf_expr with
|
|
|
+ | None -> mk (TBlock([])) t_dynamic Ast.null_pos
|
|
|
+ | Some s ->
|
|
|
+ match s.eexpr with
|
|
|
+ | TFunction tf ->
|
|
|
+ mk_block (tf.tf_expr)
|
|
|
+ | _ -> assert false (* FIXME *)
|
|
|
+ in
|
|
|
+ (if is_new then begin
|
|
|
+ (*let rec get_super_call el =
|
|
|
+ match el with
|
|
|
+ | ( { eexpr = TCall( { eexpr = TConst(TSuper) }, _) } as call) :: rest ->
|
|
|
+ Some call, rest
|
|
|
+ | ( { eexpr = TBlock(bl) } as block ) :: rest ->
|
|
|
+ let ret, mapped = get_super_call bl in
|
|
|
+ ret, ( { block with eexpr = TBlock(mapped) } :: rest )
|
|
|
+ | _ ->
|
|
|
+ None, el
|
|
|
+ in*)
|
|
|
+ expr_s w expr
|
|
|
+ end else begin
|
|
|
+ expr_s w expr;
|
|
|
+ end)
|
|
|
+ | (Meta.Throws, [Ast.EConst (Ast.String t), _], _) :: tl ->
|
|
|
+ print w " throws %s" t;
|
|
|
+ loop tl
|
|
|
+ | (Meta.FunctionCode, [Ast.EConst (Ast.String contents),_],_) :: tl ->
|
|
|
+ begin_block w;
|
|
|
+ write w contents;
|
|
|
+ end_block w
|
|
|
+ | _ :: tl -> loop tl
|
|
|
+ in
|
|
|
+ loop cf.cf_meta
|
|
|
+
|
|
|
+ end);
|
|
|
+ newline w;
|
|
|
+ newline w
|
|
|
+ in
|
|
|
+
|
|
|
+ let gen_class w cl =
|
|
|
+ let cf_filters = [ handle_throws ] in
|
|
|
+ List.iter (fun f -> List.iter (f gen) cl.cl_ordered_fields) cf_filters;
|
|
|
+ List.iter (fun f -> List.iter (f gen) cl.cl_ordered_statics) cf_filters;
|
|
|
+ let should_close = match change_ns (fst cl.cl_path) with
|
|
|
+ | [] -> false
|
|
|
+ | ns ->
|
|
|
+ print w "package %s;" (String.concat "." (change_ns ns));
|
|
|
+ newline w;
|
|
|
+ newline w;
|
|
|
+ false
|
|
|
+ in
|
|
|
+
|
|
|
+ let rec loop_meta meta acc =
|
|
|
+ match meta with
|
|
|
+ | (Meta.SuppressWarnings, [Ast.EConst (Ast.String w),_],_) :: meta -> loop_meta meta (w :: acc)
|
|
|
+ | _ :: meta -> loop_meta meta acc
|
|
|
+ | _ -> acc
|
|
|
+ in
|
|
|
+
|
|
|
+ let suppress_warnings = loop_meta cl.cl_meta [ "rawtypes"; "unchecked" ] in
|
|
|
+
|
|
|
+ write w "import haxe.root.*;";
|
|
|
+ newline w;
|
|
|
+ let w_header = w in
|
|
|
+ let w = new_source_writer () in
|
|
|
+ clear_scope();
|
|
|
+
|
|
|
+ (* add all haxe.root.* to imports *)
|
|
|
+ List.iter (function
|
|
|
+ | TClassDecl { cl_path = ([],c) } ->
|
|
|
+ imports := ([],c) :: !imports
|
|
|
+ | TEnumDecl { e_path = ([],c) } ->
|
|
|
+ imports := ([],c) :: !imports
|
|
|
+ | TAbstractDecl { a_path = ([],c) } ->
|
|
|
+ imports := ([],c) :: !imports
|
|
|
+ | _ -> ()
|
|
|
+ ) gen.gtypes_list;
|
|
|
+
|
|
|
+ newline w;
|
|
|
+ write w "@SuppressWarnings(value={";
|
|
|
+ let first = ref true in
|
|
|
+ List.iter (fun s ->
|
|
|
+ (if !first then first := false else write w ", ");
|
|
|
+ print w "\"%s\"" (escape s)
|
|
|
+ ) suppress_warnings;
|
|
|
+ write w "})";
|
|
|
+ newline w;
|
|
|
+ gen_annotations w cl.cl_meta;
|
|
|
+
|
|
|
+ let clt, access, modifiers = get_class_modifiers cl.cl_meta (if cl.cl_interface then "interface" else "class") "public" [] in
|
|
|
+ let is_final = Meta.has Meta.Final cl.cl_meta in
|
|
|
+
|
|
|
+ write_parts w (access :: modifiers @ [clt; (change_clname (snd cl.cl_path))]);
|
|
|
+
|
|
|
+ (* type parameters *)
|
|
|
+ let params, _ = get_string_params cl.cl_params in
|
|
|
+ let cl_p_to_string (c,p) =
|
|
|
+ let p = List.map (fun t -> match follow t with
|
|
|
+ | TMono _ | TDynamic _ -> t_empty
|
|
|
+ | _ -> t) p
|
|
|
+ in
|
|
|
+ path_param_s cl.cl_pos (TClassDecl c) c.cl_path p c.cl_meta
|
|
|
+ in
|
|
|
+ print w "%s" params;
|
|
|
+ (if is_some cl.cl_super then print w " extends %s" (cl_p_to_string (get cl.cl_super)));
|
|
|
+ (match cl.cl_implements with
|
|
|
+ | [] -> ()
|
|
|
+ | _ -> print w " %s %s" (if cl.cl_interface then "extends" else "implements") (String.concat ", " (List.map cl_p_to_string cl.cl_implements))
|
|
|
+ );
|
|
|
+ (* class head ok: *)
|
|
|
+ (* public class Test<A> : X, Y, Z where A : Y *)
|
|
|
+ begin_block w;
|
|
|
+ (* our constructor is expected to be a normal "new" function *
|
|
|
+ if !strict_mode && is_some cl.cl_constructor then assert false;*)
|
|
|
+
|
|
|
+ let rec loop cl =
|
|
|
+ List.iter (fun cf -> add_scope cf.cf_name) cl.cl_ordered_fields;
|
|
|
+ List.iter (fun cf -> add_scope cf.cf_name) cl.cl_ordered_statics;
|
|
|
+ match cl.cl_super with
|
|
|
+ | Some(c,_) -> loop c
|
|
|
+ | None -> ()
|
|
|
+ in
|
|
|
+ loop cl;
|
|
|
+
|
|
|
+ let rec loop meta =
|
|
|
+ match meta with
|
|
|
+ | [] -> ()
|
|
|
+ | (Meta.ClassCode, [Ast.EConst (Ast.String contents),_],_) :: tl ->
|
|
|
+ write w contents
|
|
|
+ | _ :: tl -> loop tl
|
|
|
+ in
|
|
|
+ loop cl.cl_meta;
|
|
|
+
|
|
|
+ (match gen.gcon.main_class with
|
|
|
+ | Some path when path = cl.cl_path ->
|
|
|
+ write w "public static void main(String[] args)";
|
|
|
+ begin_block w;
|
|
|
+ (try
|
|
|
+ let t = Hashtbl.find gen.gtypes ([], "Sys") in
|
|
|
+ match t with
|
|
|
+ | TClassDecl(cl) when PMap.mem "_args" cl.cl_statics ->
|
|
|
+ write w "Sys._args = args;"; newline w
|
|
|
+ | _ -> ()
|
|
|
+ with | Not_found -> ()
|
|
|
+ );
|
|
|
+ write w "main();";
|
|
|
+ end_block w;
|
|
|
+ newline w
|
|
|
+ | _ -> ()
|
|
|
+ );
|
|
|
+
|
|
|
+ (match cl.cl_init with
|
|
|
+ | None -> ()
|
|
|
+ | Some init ->
|
|
|
+ write w "static";
|
|
|
+ expr_s w (mk_block init);
|
|
|
+ newline w
|
|
|
+ );
|
|
|
+
|
|
|
+ (if is_some cl.cl_constructor then gen_class_field w false cl is_final (get cl.cl_constructor));
|
|
|
+ (if not cl.cl_interface then List.iter (gen_class_field w true cl is_final) cl.cl_ordered_statics);
|
|
|
+ List.iter (gen_class_field w false cl is_final) cl.cl_ordered_fields;
|
|
|
+
|
|
|
+ end_block w;
|
|
|
+ if should_close then end_block w;
|
|
|
+
|
|
|
+ (* add imports *)
|
|
|
+ List.iter (function
|
|
|
+ | ["haxe";"root"], _ | [], _ -> ()
|
|
|
+ | path ->
|
|
|
+ write w_header "import ";
|
|
|
+ write w_header (path_s path []);
|
|
|
+ write w_header ";\n"
|
|
|
+ ) !imports;
|
|
|
+ add_writer w w_header
|
|
|
+ in
|
|
|
+
|
|
|
+
|
|
|
+ let gen_enum w e =
|
|
|
+ let should_close = match change_ns (fst e.e_path) with
|
|
|
+ | [] -> false
|
|
|
+ | ns ->
|
|
|
+ print w "package %s;" (String.concat "." (change_ns ns));
|
|
|
+ newline w;
|
|
|
+ newline w;
|
|
|
+ false
|
|
|
+ in
|
|
|
+
|
|
|
+ gen_annotations w e.e_meta;
|
|
|
+ print w "public enum %s" (change_clname (snd e.e_path));
|
|
|
+ begin_block w;
|
|
|
+ write w (String.concat ", " (List.map (change_id) e.e_names));
|
|
|
+ end_block w;
|
|
|
+
|
|
|
+ if should_close then end_block w
|
|
|
+ in
|
|
|
+
|
|
|
+ let module_type_gen w md_tp =
|
|
|
+ match md_tp with
|
|
|
+ | TClassDecl cl ->
|
|
|
+ if not cl.cl_extern then begin
|
|
|
+ gen_class w cl;
|
|
|
+ newline w;
|
|
|
+ newline w
|
|
|
+ end;
|
|
|
+ (not cl.cl_extern)
|
|
|
+ | TEnumDecl e ->
|
|
|
+ if not e.e_extern && not (Meta.has Meta.Class e.e_meta) then begin
|
|
|
+ gen_enum w e;
|
|
|
+ newline w;
|
|
|
+ newline w
|
|
|
+ end;
|
|
|
+ (not e.e_extern)
|
|
|
+ | TTypeDecl e ->
|
|
|
+ false
|
|
|
+ | TAbstractDecl a ->
|
|
|
+ false
|
|
|
+ in
|
|
|
+
|
|
|
+ let module_gen w md =
|
|
|
+ module_type_gen w md
|
|
|
+ in
|
|
|
+
|
|
|
+ (* generate source code *)
|
|
|
+ init_ctx gen;
|
|
|
+
|
|
|
+ Hashtbl.add gen.gspecial_vars "__label__" true;
|
|
|
+ Hashtbl.add gen.gspecial_vars "__goto__" true;
|
|
|
+ Hashtbl.add gen.gspecial_vars "__is__" true;
|
|
|
+ Hashtbl.add gen.gspecial_vars "__typeof__" true;
|
|
|
+ Hashtbl.add gen.gspecial_vars "__java__" true;
|
|
|
+ Hashtbl.add gen.gspecial_vars "__lock__" true;
|
|
|
+ Hashtbl.add gen.gspecial_vars "__array__" true;
|
|
|
+
|
|
|
+ gen.greal_type <- real_type;
|
|
|
+ gen.greal_type_param <- change_param_type;
|
|
|
+
|
|
|
+ SetHXGen.run_filter gen SetHXGen.default_hxgen_func;
|
|
|
+
|
|
|
+ (* before running the filters, follow all possible types *)
|
|
|
+ (* this is needed so our module transformations don't break some core features *)
|
|
|
+ (* like multitype selection *)
|
|
|
+ let run_follow_gen = run_follow gen in
|
|
|
+ let rec type_map e = Type.map_expr_type (fun e->type_map e) (run_follow_gen) (fun tvar-> tvar.v_type <- (run_follow_gen tvar.v_type); tvar) e in
|
|
|
+ let super_map (cl,tl) = (cl, List.map run_follow_gen tl) in
|
|
|
+ List.iter (function
|
|
|
+ | TClassDecl cl ->
|
|
|
+ let all_fields = (Option.map_default (fun cf -> [cf]) [] cl.cl_constructor) @ cl.cl_ordered_fields @ cl.cl_ordered_statics in
|
|
|
+ List.iter (fun cf ->
|
|
|
+ cf.cf_type <- run_follow_gen cf.cf_type;
|
|
|
+ cf.cf_expr <- Option.map type_map cf.cf_expr
|
|
|
+ ) all_fields;
|
|
|
+ cl.cl_dynamic <- Option.map run_follow_gen cl.cl_dynamic;
|
|
|
+ cl.cl_array_access <- Option.map run_follow_gen cl.cl_array_access;
|
|
|
+ cl.cl_init <- Option.map type_map cl.cl_init;
|
|
|
+ cl.cl_super <- Option.map super_map cl.cl_super;
|
|
|
+ cl.cl_implements <- List.map super_map cl.cl_implements
|
|
|
+ | _ -> ()
|
|
|
+ ) gen.gtypes_list;
|
|
|
+
|
|
|
+ let closure_t = ClosuresToClass.DoubleAndDynamicClosureImpl.get_ctx gen 6 in
|
|
|
+
|
|
|
+ (*let closure_t = ClosuresToClass.create gen 10 float_cl
|
|
|
+ (fun l -> l)
|
|
|
+ (fun l -> l)
|
|
|
+ (fun args -> args)
|
|
|
+ (fun args -> [])
|
|
|
+ in
|
|
|
+ ClosuresToClass.configure gen (ClosuresToClass.default_implementation closure_t (fun e _ _ -> e));
|
|
|
+
|
|
|
+ StubClosureImpl.configure gen (StubClosureImpl.default_implementation gen float_cl 10 (fun e _ _ -> e));*)
|
|
|
+
|
|
|
+ let get_vmtype t = match real_type t with
|
|
|
+ | TInst({ cl_path = ["java"],"NativeArray" }, tl) -> t
|
|
|
+ | TInst(c,tl) -> TInst(c,List.map (fun _ -> t_dynamic) tl)
|
|
|
+ | TEnum(e,tl) -> TEnum(e, List.map (fun _ -> t_dynamic) tl)
|
|
|
+ | TType(t,tl) -> TType(t, List.map (fun _ -> t_dynamic) tl)
|
|
|
+ | TAbstract(a,tl) -> TAbstract(a, List.map (fun _ -> t_dynamic) tl)
|
|
|
+ | t -> t
|
|
|
+ in
|
|
|
+
|
|
|
+ FixOverrides.configure ~get_vmtype gen;
|
|
|
+ Normalize.configure gen ~metas:(Hashtbl.create 0);
|
|
|
+ AbstractImplementationFix.configure gen;
|
|
|
+
|
|
|
+ IteratorsInterface.configure gen (fun e -> e);
|
|
|
+
|
|
|
+ ClosuresToClass.configure gen (ClosuresToClass.default_implementation closure_t (get_cl (get_type gen (["haxe";"lang"],"Function")) ));
|
|
|
+
|
|
|
+ let enum_base = (get_cl (get_type gen (["haxe";"lang"],"Enum")) ) in
|
|
|
+ let param_enum_base = (get_cl (get_type gen (["haxe";"lang"],"ParamEnum")) ) in
|
|
|
+ EnumToClass.configure gen (None) false true enum_base param_enum_base false false;
|
|
|
+
|
|
|
+ InterfaceVarsDeleteModf.configure gen;
|
|
|
+
|
|
|
+ let dynamic_object = (get_cl (get_type gen (["haxe";"lang"],"DynamicObject")) ) in
|
|
|
+
|
|
|
+ let object_iface = get_cl (get_type gen (["haxe";"lang"],"IHxObject")) in
|
|
|
+
|
|
|
+ (*fixme: THIS IS A HACK. take this off *)
|
|
|
+ let empty_e = match (get_type gen (["haxe";"lang"], "EmptyObject")) with | TEnumDecl e -> e | _ -> assert false in
|
|
|
+ (*OverloadingCtor.set_new_create_empty gen ({eexpr=TEnumField(empty_e, "EMPTY"); etype=TEnum(empty_e,[]); epos=null_pos;});*)
|
|
|
+
|
|
|
+ let empty_expr = { eexpr = (TTypeExpr (TEnumDecl empty_e)); etype = (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics empty_e) }); epos = null_pos } in
|
|
|
+ let empty_ef =
|
|
|
+ try
|
|
|
+ PMap.find "EMPTY" empty_e.e_constrs
|
|
|
+ with Not_found -> gen.gcon.error "Required enum field EMPTY was not found" empty_e.e_pos; assert false
|
|
|
+ in
|
|
|
+ OverloadingConstructor.configure ~empty_ctor_type:(TEnum(empty_e, [])) ~empty_ctor_expr:({ eexpr=TField(empty_expr, FEnum(empty_e, empty_ef)); etype=TEnum(empty_e,[]); epos=null_pos; }) ~supports_ctor_inheritance:false gen;
|
|
|
+
|
|
|
+ let rcf_static_find = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "findHash" Ast.null_pos [] in
|
|
|
+ (*let rcf_static_lookup = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "lookupHash" Ast.null_pos [] in*)
|
|
|
+ let get_specialized_postfix t = match t with
|
|
|
+ | TAbstract({a_path = [],"Float"}, _) -> "Float"
|
|
|
+ | TInst({cl_path = [],"String"},_) -> "String"
|
|
|
+ | TAnon _ | TDynamic _ -> "Dynamic"
|
|
|
+ | _ -> print_endline (debug_type t); assert false
|
|
|
+ in
|
|
|
+ let rcf_static_insert t = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) ("insert" ^ get_specialized_postfix t) Ast.null_pos [] in
|
|
|
+ let rcf_static_remove t = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) ("remove" ^ get_specialized_postfix t) Ast.null_pos [] in
|
|
|
+
|
|
|
+ let can_be_float t = like_float (real_type t) in
|
|
|
+
|
|
|
+ let rcf_on_getset_field main_expr field_expr field may_hash may_set is_unsafe =
|
|
|
+ let is_float = can_be_float (if is_none may_set then main_expr.etype else (get may_set).etype) in
|
|
|
+ let fn_name = if is_some may_set then "setField" else "getField" in
|
|
|
+ let fn_name = if is_float then fn_name ^ "_f" else fn_name in
|
|
|
+ let pos = field_expr.epos in
|
|
|
+
|
|
|
+ let is_unsafe = { eexpr = TConst(TBool is_unsafe); etype = basic.tbool; epos = pos } in
|
|
|
+
|
|
|
+ let should_cast = match main_expr.etype with | TAbstract({ a_path = ([], "Float") }, []) -> false | _ -> true in
|
|
|
+ let infer = mk_static_field_access_infer runtime_cl fn_name field_expr.epos [] in
|
|
|
+ let first_args =
|
|
|
+ [ field_expr; { eexpr = TConst(TString field); etype = basic.tstring; epos = pos } ]
|
|
|
+ @ if is_some may_hash then [ { eexpr = TConst(TInt (get may_hash)); etype = basic.tint; epos = pos } ] else []
|
|
|
+ in
|
|
|
+ let args = first_args @ match is_float, may_set with
|
|
|
+ | true, Some(set) ->
|
|
|
+ [ if should_cast then mk_cast basic.tfloat set else set ]
|
|
|
+ | false, Some(set) ->
|
|
|
+ [ set ]
|
|
|
+ | _ ->
|
|
|
+ [ is_unsafe ]
|
|
|
+ in
|
|
|
+
|
|
|
+ let call = { main_expr with eexpr = TCall(infer,args) } in
|
|
|
+ let call = if is_float && should_cast then mk_cast main_expr.etype call else call in
|
|
|
+ call
|
|
|
+ in
|
|
|
+
|
|
|
+ let rcf_on_call_field ecall field_expr field may_hash args =
|
|
|
+ let infer = mk_static_field_access_infer runtime_cl "callField" field_expr.epos [] in
|
|
|
+
|
|
|
+ let hash_arg = match may_hash with
|
|
|
+ | None -> []
|
|
|
+ | Some h -> [ { eexpr = TConst(TInt h); etype = basic.tint; epos = field_expr.epos } ]
|
|
|
+ in
|
|
|
+
|
|
|
+ let arr_call = if args <> [] then
|
|
|
+ { eexpr = TArrayDecl args; etype = basic.tarray t_dynamic; epos = ecall.epos }
|
|
|
+ else
|
|
|
+ null (basic.tarray t_dynamic) ecall.epos
|
|
|
+ in
|
|
|
+
|
|
|
+
|
|
|
+ let call_args =
|
|
|
+ [field_expr; { field_expr with eexpr = TConst(TString field); etype = basic.tstring } ]
|
|
|
+ @ hash_arg
|
|
|
+ @ [ arr_call ]
|
|
|
+ in
|
|
|
+
|
|
|
+ mk_cast ecall.etype { ecall with eexpr = TCall(infer, call_args); etype = t_dynamic }
|
|
|
+ in
|
|
|
+
|
|
|
+ let rcf_ctx =
|
|
|
+ ReflectionCFs.new_ctx
|
|
|
+ gen
|
|
|
+ closure_t
|
|
|
+ object_iface
|
|
|
+ false
|
|
|
+ rcf_on_getset_field
|
|
|
+ rcf_on_call_field
|
|
|
+ (fun hash hash_array length -> { hash with eexpr = TCall(rcf_static_find, [hash; hash_array; length]); etype=basic.tint })
|
|
|
+ (fun hash -> hash)
|
|
|
+ (fun hash_array length pos value ->
|
|
|
+ { hash_array with
|
|
|
+ eexpr = TBinop(OpAssign,
|
|
|
+ hash_array,
|
|
|
+ mk (TCall(rcf_static_insert value.etype, [hash_array; length; pos; value])) hash_array.etype hash_array.epos)
|
|
|
+ })
|
|
|
+ (fun hash_array length pos ->
|
|
|
+ let t = gen.gclasses.nativearray_type hash_array.etype in
|
|
|
+ { hash_array with eexpr = TCall(rcf_static_remove t, [hash_array; length; pos]); etype = gen.gcon.basic.tvoid }
|
|
|
+ )
|
|
|
+ false
|
|
|
+ in
|
|
|
+
|
|
|
+ ReflectionCFs.UniversalBaseClass.default_config gen (get_cl (get_type gen (["haxe";"lang"],"HxObject")) ) object_iface dynamic_object;
|
|
|
+
|
|
|
+ ReflectionCFs.configure_dynamic_field_access rcf_ctx false;
|
|
|
+
|
|
|
+ (* let closure_func = ReflectionCFs.implement_closure_cl rcf_ctx ( get_cl (get_type gen (["haxe";"lang"],"Closure")) ) in *)
|
|
|
+ let closure_cl = get_cl (get_type gen (["haxe";"lang"],"Closure")) in
|
|
|
+
|
|
|
+ let closure_func = ReflectionCFs.get_closure_func rcf_ctx closure_cl in
|
|
|
+
|
|
|
+ ReflectionCFs.implement_varargs_cl rcf_ctx ( get_cl (get_type gen (["haxe";"lang"], "VarArgsBase")) );
|
|
|
+
|
|
|
+ let slow_invoke = mk_static_field_access_infer (runtime_cl) "slowCallField" Ast.null_pos [] in
|
|
|
+ ReflectionCFs.configure rcf_ctx ~slow_invoke:(fun ethis efield eargs -> {
|
|
|
+ eexpr = TCall(slow_invoke, [ethis; efield; eargs]);
|
|
|
+ etype = t_dynamic;
|
|
|
+ epos = ethis.epos;
|
|
|
+ } ) object_iface;
|
|
|
+
|
|
|
+ let objdecl_fn = ReflectionCFs.implement_dynamic_object_ctor rcf_ctx dynamic_object in
|
|
|
+
|
|
|
+ ObjectDeclMap.configure gen (ObjectDeclMap.traverse gen objdecl_fn);
|
|
|
+
|
|
|
+ InitFunction.configure gen true true;
|
|
|
+ TArrayTransform.configure gen (TArrayTransform.default_implementation gen (
|
|
|
+ fun e _ ->
|
|
|
+ match e.eexpr with
|
|
|
+ | TArray ({ eexpr = TLocal { v_extra = Some( _ :: _, _) } }, _) -> (* captured transformation *)
|
|
|
+ false
|
|
|
+ | TArray(e1, e2) ->
|
|
|
+ ( match run_follow gen (follow e1.etype) with
|
|
|
+ | TInst({ cl_path = (["java"], "NativeArray") }, _) -> false
|
|
|
+ | _ -> true )
|
|
|
+ | _ -> assert false
|
|
|
+ ) "__get" "__set" );
|
|
|
+
|
|
|
+ let field_is_dynamic t field =
|
|
|
+ match field_access_esp gen (gen.greal_type t) field with
|
|
|
+ | FClassField (cl,p,_,_,_,t,_) ->
|
|
|
+ let p = change_param_type (TClassDecl cl) p in
|
|
|
+ is_dynamic (apply_params cl.cl_params p t)
|
|
|
+ | FEnumField _ -> false
|
|
|
+ | _ -> true
|
|
|
+ in
|
|
|
+
|
|
|
+ let is_type_param e = match follow e with
|
|
|
+ | TInst( { cl_kind = KTypeParameter _ },[]) -> true
|
|
|
+ | _ -> false
|
|
|
+ in
|
|
|
+
|
|
|
+ let is_dynamic_expr e =
|
|
|
+ is_dynamic e.etype || match e.eexpr with
|
|
|
+ | TField(tf, f) ->
|
|
|
+ field_is_dynamic tf.etype f
|
|
|
+ | _ ->
|
|
|
+ false
|
|
|
+ in
|
|
|
+
|
|
|
+ let may_nullable t = match gen.gfollow#run_f t with
|
|
|
+ | TType({ t_path = ([], "Null") }, [t]) ->
|
|
|
+ (match follow t with
|
|
|
+ | TInst({ cl_path = ([], "String") }, [])
|
|
|
+ | TAbstract ({ a_path = ([], "Float") },[])
|
|
|
+ | TInst({ cl_path = (["haxe"], "Int32")}, [] )
|
|
|
+ | TInst({ cl_path = (["haxe"], "Int64")}, [] )
|
|
|
+ | TAbstract ({ a_path = ([], "Int") },[])
|
|
|
+ | TAbstract ({ a_path = ([], "Bool") },[]) -> Some t
|
|
|
+ | t when is_java_basic_type t -> Some t
|
|
|
+ | _ -> None )
|
|
|
+ | _ -> None
|
|
|
+ in
|
|
|
+
|
|
|
+ let is_double t = like_float t && not (like_int t) in
|
|
|
+ let is_int t = like_int t in
|
|
|
+
|
|
|
+ DynamicOperators.configure gen
|
|
|
+ (DynamicOperators.abstract_implementation gen (fun e -> match e.eexpr with
|
|
|
+ | TBinop (Ast.OpEq, e1, e2) ->
|
|
|
+ is_dynamic e1.etype || is_dynamic e2.etype || is_type_param e1.etype || is_type_param e2.etype
|
|
|
+ | TBinop (Ast.OpAdd, e1, e2)
|
|
|
+ | TBinop (Ast.OpNotEq, e1, e2) -> is_dynamic e1.etype || is_dynamic e2.etype || is_type_param e1.etype || is_type_param e2.etype
|
|
|
+ | TBinop (Ast.OpLt, e1, e2)
|
|
|
+ | TBinop (Ast.OpLte, e1, e2)
|
|
|
+ | TBinop (Ast.OpGte, e1, e2)
|
|
|
+ | TBinop (Ast.OpGt, e1, e2) -> is_dynamic e.etype || is_dynamic_expr e1 || is_dynamic_expr e2 || is_string e1.etype || is_string e2.etype
|
|
|
+ | TBinop (_, e1, e2) -> is_dynamic e.etype || is_dynamic_expr e1 || is_dynamic_expr e2
|
|
|
+ | TUnop (_, _, e1) ->
|
|
|
+ is_dynamic_expr e1
|
|
|
+ | _ -> false)
|
|
|
+ (fun e1 e2 ->
|
|
|
+ let is_null e = match e.eexpr with | TConst(TNull) | TLocal({ v_name = "__undefined__" }) -> true | _ -> false in
|
|
|
+
|
|
|
+ match e1.eexpr, e2.eexpr with
|
|
|
+ | TConst c1, TConst c2 when is_null e1 || is_null e2 ->
|
|
|
+ { e1 with eexpr = TConst(TBool (c1 = c2)); etype = basic.tbool }
|
|
|
+ | _ when is_null e1 || is_null e2 && not (is_java_basic_type e1.etype || is_java_basic_type e2.etype) ->
|
|
|
+ { e1 with eexpr = TBinop(Ast.OpEq, e1, e2); etype = basic.tbool }
|
|
|
+ | _ ->
|
|
|
+ let is_ref = match follow e1.etype, follow e2.etype with
|
|
|
+ | TDynamic _, _
|
|
|
+ | _, TDynamic _
|
|
|
+ | TAbstract ({ a_path = ([], "Float") },[]) , _
|
|
|
+ | TInst( { cl_path = (["haxe"], "Int32") }, [] ), _
|
|
|
+ | TInst( { cl_path = (["haxe"], "Int64") }, [] ), _
|
|
|
+ | TAbstract ({ a_path = ([], "Int") },[]) , _
|
|
|
+ | TAbstract ({ a_path = ([], "Bool") },[]) , _
|
|
|
+ | _, TAbstract ({ a_path = ([], "Float") },[])
|
|
|
+ | _, TAbstract ({ a_path = ([], "Int") },[])
|
|
|
+ | _, TInst( { cl_path = (["haxe"], "Int32") }, [] )
|
|
|
+ | _, TInst( { cl_path = (["haxe"], "Int64") }, [] )
|
|
|
+ | _, TAbstract ({ a_path = ([], "Bool") },[])
|
|
|
+ | TInst( { cl_kind = KTypeParameter _ }, [] ), _
|
|
|
+ | _, TInst( { cl_kind = KTypeParameter _ }, [] ) -> false
|
|
|
+ | _, _ -> true
|
|
|
+ in
|
|
|
+
|
|
|
+ let static = mk_static_field_access_infer (runtime_cl) (if is_ref then "refEq" else "eq") e1.epos [] in
|
|
|
+ { eexpr = TCall(static, [e1; e2]); etype = gen.gcon.basic.tbool; epos=e1.epos }
|
|
|
+ )
|
|
|
+ (fun e e1 e2 ->
|
|
|
+ match may_nullable e1.etype, may_nullable e2.etype with
|
|
|
+ | Some t1, Some t2 ->
|
|
|
+ let t1, t2 = if is_string t1 || is_string t2 then
|
|
|
+ basic.tstring, basic.tstring
|
|
|
+ else if is_double t1 || is_double t2 then
|
|
|
+ basic.tfloat, basic.tfloat
|
|
|
+ else if is_int t1 || is_int t2 then
|
|
|
+ basic.tint, basic.tint
|
|
|
+ else t1, t2 in
|
|
|
+ { eexpr = TBinop(Ast.OpAdd, mk_cast t1 e1, mk_cast t2 e2); etype = e.etype; epos = e1.epos }
|
|
|
+ | _ ->
|
|
|
+ let static = mk_static_field_access_infer (runtime_cl) "plus" e1.epos [] in
|
|
|
+ mk_cast e.etype { eexpr = TCall(static, [e1; e2]); etype = t_dynamic; epos=e1.epos })
|
|
|
+ (fun e1 e2 ->
|
|
|
+ if is_string e1.etype then begin
|
|
|
+ { e1 with eexpr = TCall(mk_field_access gen e1 "compareTo" e1.epos, [ e2 ]); etype = gen.gcon.basic.tint }
|
|
|
+ end else begin
|
|
|
+ let static = mk_static_field_access_infer (runtime_cl) "compare" e1.epos [] in
|
|
|
+ { eexpr = TCall(static, [e1; e2]); etype = gen.gcon.basic.tint; epos=e1.epos }
|
|
|
+ end));
|
|
|
+
|
|
|
+ FilterClosures.configure gen (FilterClosures.traverse gen (fun e1 s -> true) closure_func);
|
|
|
+
|
|
|
+ let base_exception = get_cl (get_type gen (["java"; "lang"], "Throwable")) in
|
|
|
+ let base_exception_t = TInst(base_exception, []) in
|
|
|
+
|
|
|
+ let hx_exception = get_cl (get_type gen (["haxe";"lang"], "HaxeException")) in
|
|
|
+ let hx_exception_t = TInst(hx_exception, []) in
|
|
|
+
|
|
|
+ let rec is_exception t =
|
|
|
+ match follow t with
|
|
|
+ | TInst(cl,_) ->
|
|
|
+ if cl == base_exception then
|
|
|
+ true
|
|
|
+ else
|
|
|
+ (match cl.cl_super with | None -> false | Some (cl,arg) -> is_exception (TInst(cl,arg)))
|
|
|
+ | _ -> false
|
|
|
+ in
|
|
|
+
|
|
|
+ TryCatchWrapper.configure gen
|
|
|
+ (
|
|
|
+ TryCatchWrapper.traverse gen
|
|
|
+ (fun t -> not (is_exception (real_type t)))
|
|
|
+ (fun throwexpr expr ->
|
|
|
+ let wrap_static = mk_static_field_access (hx_exception) "wrap" (TFun([("obj",false,t_dynamic)], hx_exception_t)) expr.epos in
|
|
|
+ { throwexpr with eexpr = TThrow { expr with eexpr = TCall(wrap_static, [expr]); etype = hx_exception_t }; etype = gen.gcon.basic.tvoid }
|
|
|
+ )
|
|
|
+ (fun v_to_unwrap pos ->
|
|
|
+ let local = mk_cast hx_exception_t { eexpr = TLocal(v_to_unwrap); etype = v_to_unwrap.v_type; epos = pos } in
|
|
|
+ mk_field_access gen local "obj" pos
|
|
|
+ )
|
|
|
+ (fun rethrow ->
|
|
|
+ let wrap_static = mk_static_field_access (hx_exception) "wrap" (TFun([("obj",false,t_dynamic)], hx_exception_t)) rethrow.epos in
|
|
|
+ { rethrow with eexpr = TThrow { rethrow with eexpr = TCall(wrap_static, [rethrow]); etype = hx_exception_t }; }
|
|
|
+ )
|
|
|
+ (base_exception_t)
|
|
|
+ (hx_exception_t)
|
|
|
+ (fun v e ->
|
|
|
+
|
|
|
+ let exc_cl = get_cl (get_type gen (["haxe";"lang"],"Exceptions")) in
|
|
|
+ let exc_field = mk_static_field_access_infer exc_cl "setException" e.epos [] in
|
|
|
+ let esetstack = { eexpr = TCall(exc_field,[mk_local v e.epos]); etype = gen.gcon.basic.tvoid; epos = e.epos } in
|
|
|
+
|
|
|
+ Type.concat esetstack e;
|
|
|
+ )
|
|
|
+ );
|
|
|
+
|
|
|
+ let get_typeof e =
|
|
|
+ { e with eexpr = TCall( { eexpr = TLocal( alloc_var "__typeof__" t_dynamic ); etype = t_dynamic; epos = e.epos }, [e] ) }
|
|
|
+ in
|
|
|
+
|
|
|
+ ClassInstance.configure gen (ClassInstance.traverse gen (fun e mt -> get_typeof e));
|
|
|
+
|
|
|
+ (*let v = alloc_var "$type_param" t_dynamic in*)
|
|
|
+ TypeParams.configure gen (fun ecall efield params elist ->
|
|
|
+ { ecall with eexpr = TCall(efield, elist) }
|
|
|
+ );
|
|
|
+
|
|
|
+ CastDetect.configure gen (CastDetect.default_implementation gen ~native_string_cast:false (Some (TEnum(empty_e, []))) false);
|
|
|
+
|
|
|
+ (*FollowAll.configure gen;*)
|
|
|
+
|
|
|
+ SwitchToIf.configure gen (SwitchToIf.traverse gen (fun e ->
|
|
|
+ match e.eexpr with
|
|
|
+ | TSwitch(cond, cases, def) ->
|
|
|
+ (match gen.gfollow#run_f cond.etype with
|
|
|
+ | TInst( { cl_path = (["haxe"], "Int32") }, [] )
|
|
|
+ | TAbstract ({ a_path = ([], "Int") },[])
|
|
|
+ | TInst({ cl_path = ([], "String") },[]) ->
|
|
|
+ (List.exists (fun (c,_) ->
|
|
|
+ List.exists (fun expr -> match expr.eexpr with | TConst _ -> false | _ -> true ) c
|
|
|
+ ) cases)
|
|
|
+ | _ -> true
|
|
|
+ )
|
|
|
+ | _ -> assert false
|
|
|
+ ) true );
|
|
|
+
|
|
|
+ ExpressionUnwrap.configure gen (ExpressionUnwrap.traverse gen (fun e -> Some { eexpr = TVar(mk_temp gen "expr" e.etype, Some e); etype = gen.gcon.basic.tvoid; epos = e.epos }));
|
|
|
+
|
|
|
+ UnnecessaryCastsRemoval.configure gen;
|
|
|
+
|
|
|
+ IntDivisionSynf.configure gen (IntDivisionSynf.default_implementation gen true);
|
|
|
+
|
|
|
+ UnreachableCodeEliminationSynf.configure gen (UnreachableCodeEliminationSynf.traverse gen false true true true);
|
|
|
+
|
|
|
+ ArrayDeclSynf.configure gen (ArrayDeclSynf.default_implementation gen native_arr_cl);
|
|
|
+
|
|
|
+ let goto_special = alloc_var "__goto__" t_dynamic in
|
|
|
+ let label_special = alloc_var "__label__" t_dynamic in
|
|
|
+ SwitchBreakSynf.configure gen (SwitchBreakSynf.traverse gen
|
|
|
+ (fun e_loop n api ->
|
|
|
+ { e_loop with eexpr = TBlock( { eexpr = TCall( mk_local label_special e_loop.epos, [ mk_int gen n e_loop.epos ] ); etype = t_dynamic; epos = e_loop.epos } :: [e_loop] ) };
|
|
|
+ )
|
|
|
+ (fun e_break n api ->
|
|
|
+ { eexpr = TCall( mk_local goto_special e_break.epos, [ mk_int gen n e_break.epos ] ); etype = t_dynamic; epos = e_break.epos }
|
|
|
+ )
|
|
|
+ );
|
|
|
+
|
|
|
+ DefaultArguments.configure gen (DefaultArguments.traverse gen);
|
|
|
+ InterfaceMetas.configure gen;
|
|
|
+
|
|
|
+ JavaSpecificSynf.configure gen (JavaSpecificSynf.traverse gen runtime_cl);
|
|
|
+ JavaSpecificESynf.configure gen (JavaSpecificESynf.traverse gen runtime_cl);
|
|
|
+
|
|
|
+ (* add native String as a String superclass *)
|
|
|
+ let str_cl = match gen.gcon.basic.tstring with | TInst(cl,_) -> cl | _ -> assert false in
|
|
|
+ str_cl.cl_super <- Some (get_cl (get_type gen (["haxe";"lang"], "NativeString")), []);
|
|
|
+
|
|
|
+ let mkdir dir = if not (Sys.file_exists dir) then Unix.mkdir dir 0o755 in
|
|
|
+ mkdir gen.gcon.file;
|
|
|
+ mkdir (gen.gcon.file ^ "/src");
|
|
|
+
|
|
|
+ let out_files = ref [] in
|
|
|
+
|
|
|
+ (* add resources array *)
|
|
|
+ let res = ref [] in
|
|
|
+ Hashtbl.iter (fun name v ->
|
|
|
+ res := { eexpr = TConst(TString name); etype = gen.gcon.basic.tstring; epos = Ast.null_pos } :: !res;
|
|
|
+ let name = Codegen.escape_res_name name true in
|
|
|
+ let full_path = gen.gcon.file ^ "/src/" ^ name in
|
|
|
+ mkdir_from_path full_path;
|
|
|
+
|
|
|
+ let f = open_out_bin full_path in
|
|
|
+ output_string f v;
|
|
|
+ close_out f;
|
|
|
+
|
|
|
+ out_files := (unique_full_path full_path) :: !out_files
|
|
|
+ ) gen.gcon.resources;
|
|
|
+ (try
|
|
|
+ let c = get_cl (Hashtbl.find gen.gtypes (["haxe"], "Resource")) in
|
|
|
+ let cf = PMap.find "content" c.cl_statics in
|
|
|
+ cf.cf_expr <- Some ({ eexpr = TArrayDecl(!res); etype = gen.gcon.basic.tarray gen.gcon.basic.tstring; epos = Ast.null_pos })
|
|
|
+ with | Not_found -> ());
|
|
|
+
|
|
|
+ run_filters gen;
|
|
|
+
|
|
|
+ TypeParams.RenameTypeParameters.run gen;
|
|
|
|
|
|
- let t = Common.timer "code generation" in
|
|
|
+ let t = Common.timer "code generation" in
|
|
|
|
|
|
- generate_modules_t gen "java" "src" change_path module_gen;
|
|
|
+ let parts = Str.split_delim (Str.regexp "[\\/]+") gen.gcon.file in
|
|
|
+ mkdir_recursive "" parts;
|
|
|
+ generate_modules_t gen "java" "src" change_path module_gen out_files;
|
|
|
|
|
|
- dump_descriptor gen ("hxjava_build.txt") path_s (fun md -> path_s (t_infos md).mt_path);
|
|
|
+ if not (Common.defined gen.gcon Define.KeepOldOutput) then
|
|
|
+ clean_files (gen.gcon.file ^ "/src") !out_files gen.gcon.verbose;
|
|
|
+
|
|
|
+ let path_s_desc path = path_s path [] in
|
|
|
+ dump_descriptor gen ("hxjava_build.txt") path_s_desc (fun md -> path_s_desc (t_infos md).mt_path);
|
|
|
if ( not (Common.defined gen.gcon Define.NoCompilation) ) then begin
|
|
|
let old_dir = Sys.getcwd() in
|
|
|
Sys.chdir gen.gcon.file;
|
|
|
- let cmd = "haxelib run hxjava hxjava_build.txt --haxe-version " ^ (string_of_int gen.gcon.version) in
|
|
|
+ let cmd = "haxelib run hxjava hxjava_build.txt --haxe-version " ^ (string_of_int gen.gcon.version) ^ " --feature-level 1" in
|
|
|
print_endline cmd;
|
|
|
if gen.gcon.run_command cmd <> 0 then failwith "Build failed";
|
|
|
Sys.chdir old_dir;
|
|
|
end;
|
|
|
|
|
|
- t()
|
|
|
+ t()
|
|
|
|
|
|
(* end of configure function *)
|
|
|
|
|
|
let before_generate con =
|
|
|
- let java_ver = try
|
|
|
- int_of_string (PMap.find "java_ver" con.defines)
|
|
|
- with | Not_found ->
|
|
|
- Common.define_value con Define.JavaVer "7";
|
|
|
- 7
|
|
|
- in
|
|
|
+ let java_ver = try
|
|
|
+ int_of_string (PMap.find "java_ver" con.defines)
|
|
|
+ with | Not_found ->
|
|
|
+ Common.define_value con Define.JavaVer "7";
|
|
|
+ 7
|
|
|
+ in
|
|
|
if java_ver < 5 then failwith ("Java version is defined to target Java " ^ string_of_int java_ver ^ ", but the compiler can only output code to versions equal or superior to Java 5");
|
|
|
- let rec loop i =
|
|
|
- Common.raw_define con ("java" ^ (string_of_int i));
|
|
|
- if i > 0 then loop (i - 1)
|
|
|
- in
|
|
|
- loop java_ver;
|
|
|
- ()
|
|
|
+ let rec loop i =
|
|
|
+ Common.raw_define con ("java" ^ (string_of_int i));
|
|
|
+ if i > 0 then loop (i - 1)
|
|
|
+ in
|
|
|
+ loop java_ver;
|
|
|
+ ()
|
|
|
|
|
|
let generate con =
|
|
|
- let exists = ref false in
|
|
|
- con.java_libs <- List.map (fun (file,std,close,la,gr) ->
|
|
|
- if String.ends_with file "hxjava-std.jar" then begin
|
|
|
- exists := true;
|
|
|
- (file,true,close,la,gr)
|
|
|
- end else
|
|
|
- (file,std,close,la,gr)) con.java_libs;
|
|
|
- if not !exists then
|
|
|
- failwith "Your version of hxjava is outdated. Please update it by running: `haxelib update hxjava`";
|
|
|
- let gen = new_ctx con in
|
|
|
- gen.gallow_tp_dynamic_conversion <- true;
|
|
|
-
|
|
|
- let basic = con.basic in
|
|
|
- (* make the basic functions in java *)
|
|
|
- let basic_fns =
|
|
|
- [
|
|
|
- mk_class_field "equals" (TFun(["obj",false,t_dynamic], basic.tbool)) true Ast.null_pos (Method MethNormal) [];
|
|
|
- mk_class_field "toString" (TFun([], basic.tstring)) true Ast.null_pos (Method MethNormal) [];
|
|
|
- mk_class_field "hashCode" (TFun([], basic.tint)) true Ast.null_pos (Method MethNormal) [];
|
|
|
- mk_class_field "wait" (TFun([], basic.tvoid)) true Ast.null_pos (Method MethNormal) [];
|
|
|
- mk_class_field "notify" (TFun([], basic.tvoid)) true Ast.null_pos (Method MethNormal) [];
|
|
|
- mk_class_field "notifyAll" (TFun([], basic.tvoid)) true Ast.null_pos (Method MethNormal) [];
|
|
|
- ] in
|
|
|
- List.iter (fun cf -> gen.gbase_class_fields <- PMap.add cf.cf_name cf gen.gbase_class_fields) basic_fns;
|
|
|
-
|
|
|
- (try
|
|
|
- configure gen
|
|
|
- with | TypeNotFound path -> con.error ("Error. Module '" ^ (path_s path) ^ "' is required and was not included in build.") Ast.null_pos);
|
|
|
- debug_mode := false
|
|
|
+ let exists = ref false in
|
|
|
+ con.java_libs <- List.map (fun (file,std,close,la,gr) ->
|
|
|
+ if String.ends_with file "hxjava-std.jar" then begin
|
|
|
+ exists := true;
|
|
|
+ (file,true,close,la,gr)
|
|
|
+ end else
|
|
|
+ (file,std,close,la,gr)) con.java_libs;
|
|
|
+ if not !exists then
|
|
|
+ failwith "Your version of hxjava is outdated. Please update it by running: `haxelib update hxjava`";
|
|
|
+ let gen = new_ctx con in
|
|
|
+ gen.gallow_tp_dynamic_conversion <- true;
|
|
|
+
|
|
|
+ let basic = con.basic in
|
|
|
+ (* make the basic functions in java *)
|
|
|
+ let cl_cl = get_cl (get_type gen (["java";"lang"],"Class")) in
|
|
|
+ let basic_fns =
|
|
|
+ [
|
|
|
+ mk_class_field "equals" (TFun(["obj",false,t_dynamic], basic.tbool)) true Ast.null_pos (Method MethNormal) [];
|
|
|
+ mk_class_field "toString" (TFun([], basic.tstring)) true Ast.null_pos (Method MethNormal) [];
|
|
|
+ mk_class_field "hashCode" (TFun([], basic.tint)) true Ast.null_pos (Method MethNormal) [];
|
|
|
+ mk_class_field "getClass" (TFun([], (TInst(cl_cl,[t_dynamic])))) true Ast.null_pos (Method MethNormal) [];
|
|
|
+ mk_class_field "wait" (TFun([], basic.tvoid)) true Ast.null_pos (Method MethNormal) [];
|
|
|
+ mk_class_field "notify" (TFun([], basic.tvoid)) true Ast.null_pos (Method MethNormal) [];
|
|
|
+ mk_class_field "notifyAll" (TFun([], basic.tvoid)) true Ast.null_pos (Method MethNormal) [];
|
|
|
+ ] in
|
|
|
+ List.iter (fun cf -> gen.gbase_class_fields <- PMap.add cf.cf_name cf gen.gbase_class_fields) basic_fns;
|
|
|
+
|
|
|
+ (try
|
|
|
+ configure gen
|
|
|
+ with | TypeNotFound path -> con.error ("Error. Module '" ^ (path_s path) ^ "' is required and was not included in build.") Ast.null_pos);
|
|
|
+ debug_mode := false
|
|
|
|
|
|
(** Java lib *)
|
|
|
|
|
|
open JData
|
|
|
|
|
|
type java_lib_ctx = {
|
|
|
- jcom : Common.context;
|
|
|
- (* current tparams context *)
|
|
|
- mutable jtparams : jtypes list;
|
|
|
+ jcom : Common.context;
|
|
|
+ (* current tparams context *)
|
|
|
+ mutable jtparams : jtypes list;
|
|
|
}
|
|
|
|
|
|
exception ConversionError of string * pos
|
|
|
|
|
|
let error s p = raise (ConversionError (s, p))
|
|
|
|
|
|
+let is_haxe_keyword = function
|
|
|
+ | "callback" | "cast" | "extern" | "function" | "in" | "typedef" | "using" | "var" | "untyped" | "inline" -> true
|
|
|
+ | _ -> false
|
|
|
+
|
|
|
let jname_to_hx name =
|
|
|
- let name =
|
|
|
- if name <> "" && (String.get name 0 < 'A' || String.get name 0 > 'Z') then
|
|
|
- Char.escaped (Char.uppercase (String.get name 0)) ^ String.sub name 1 (String.length name - 1)
|
|
|
- else
|
|
|
- name
|
|
|
- in
|
|
|
- (* handle non-inner classes with same final name as non-inner *)
|
|
|
- let name = String.concat "__" (String.nsplit name "_") in
|
|
|
- (* handle with inner classes *)
|
|
|
- String.map (function | '$' -> '_' | c -> c) name
|
|
|
+ let name =
|
|
|
+ if name <> "" && (String.get name 0 < 'A' || String.get name 0 > 'Z') then
|
|
|
+ Char.escaped (Char.uppercase (String.get name 0)) ^ String.sub name 1 (String.length name - 1)
|
|
|
+ else
|
|
|
+ name
|
|
|
+ in
|
|
|
+ let name = String.concat "__" (String.nsplit name "_") in
|
|
|
+ String.map (function | '$' -> '_' | c -> c) name
|
|
|
|
|
|
let normalize_pack pack =
|
|
|
- List.map (function
|
|
|
- | "" -> ""
|
|
|
- | str when String.get str 0 >= 'A' && String.get str 0 <= 'Z' ->
|
|
|
- String.lowercase str
|
|
|
- | str -> str
|
|
|
- ) pack
|
|
|
+ List.map (function
|
|
|
+ | "" -> ""
|
|
|
+ | str when String.get str 0 >= 'A' && String.get str 0 <= 'Z' ->
|
|
|
+ String.lowercase str
|
|
|
+ | str -> str
|
|
|
+ ) pack
|
|
|
|
|
|
let jpath_to_hx (pack,name) = match pack, name with
|
|
|
- | ["haxe";"root"], name -> [], name
|
|
|
- | "com" :: ("oracle" | "sun") :: _, _
|
|
|
- | "javax" :: _, _
|
|
|
- | "org" :: ("ietf" | "jcp" | "omg" | "w3c" | "xml") :: _, _
|
|
|
- | "sun" :: _, _
|
|
|
- | "sunw" :: _, _ -> "java" :: normalize_pack pack, jname_to_hx name
|
|
|
- | pack, name -> normalize_pack pack, jname_to_hx name
|
|
|
-
|
|
|
-let hxname_to_j name =
|
|
|
- let name = String.implode (List.rev (String.explode name)) in
|
|
|
- let fl = String.nsplit name "__" in
|
|
|
- let fl = List.map (String.map (fun c -> if c = '_' then '$' else c)) fl in
|
|
|
- let ret = String.concat "_" fl in
|
|
|
- String.implode (List.rev (String.explode ret))
|
|
|
-
|
|
|
-let hxpath_to_j (pack,name) = match pack, name with
|
|
|
- | "java" :: "com" :: ("oracle" | "sun") :: _, _
|
|
|
- | "java" :: "javax" :: _, _
|
|
|
- | "java" :: "org" :: ("ietf" | "jcp" | "omg" | "w3c" | "xml") :: _, _
|
|
|
- | "java" :: "sun" :: _, _
|
|
|
- | "java" :: "sunw" :: _, _ -> List.tl pack, hxname_to_j name
|
|
|
- | pack, name -> pack, hxname_to_j name
|
|
|
+ | ["haxe";"root"], name -> [], name
|
|
|
+ | "com" :: ("oracle" | "sun") :: _, _
|
|
|
+ | "javax" :: _, _
|
|
|
+ | "org" :: ("ietf" | "jcp" | "omg" | "w3c" | "xml") :: _, _
|
|
|
+ | "sun" :: _, _
|
|
|
+ | "sunw" :: _, _ -> "java" :: normalize_pack pack, jname_to_hx name
|
|
|
+ | pack, name -> normalize_pack pack, jname_to_hx name
|
|
|
|
|
|
let real_java_path ctx (pack,name) =
|
|
|
- path_s (pack, name)
|
|
|
+ path_s (pack, name)
|
|
|
|
|
|
let lookup_jclass com path =
|
|
|
- let path = jpath_to_hx path in
|
|
|
- List.fold_right (fun (_,_,_,_,get_raw_class) acc ->
|
|
|
- match acc with
|
|
|
- | None -> get_raw_class path
|
|
|
- | Some p -> Some p
|
|
|
- ) com.java_libs None
|
|
|
+ let path = jpath_to_hx path in
|
|
|
+ List.fold_right (fun (_,_,_,_,get_raw_class) acc ->
|
|
|
+ match acc with
|
|
|
+ | None -> get_raw_class path
|
|
|
+ | Some p -> Some p
|
|
|
+ ) com.java_libs None
|
|
|
|
|
|
let mk_type_path ctx path params =
|
|
|
- let name, sub = try
|
|
|
- let p, _ = String.split (snd path) "$" in
|
|
|
- jname_to_hx p, Some (jname_to_hx (snd path))
|
|
|
- with | Invalid_string ->
|
|
|
- jname_to_hx (snd path), None
|
|
|
- in
|
|
|
- CTPath {
|
|
|
- tpackage = fst (jpath_to_hx path);
|
|
|
- tname = name;
|
|
|
- tparams = params;
|
|
|
- tsub = sub;
|
|
|
- }
|
|
|
+ let name, sub = try
|
|
|
+ let p, _ = String.split (snd path) "$" in
|
|
|
+ jname_to_hx p, Some (jname_to_hx (snd path))
|
|
|
+ with | Invalid_string ->
|
|
|
+ jname_to_hx (snd path), None
|
|
|
+ in
|
|
|
+ let pack = fst (jpath_to_hx path) in
|
|
|
+ let pack, sub, name = match path with
|
|
|
+ | [], ("Float" as c)
|
|
|
+ | [], ("Int" as c)
|
|
|
+ | [], ("Single" as c)
|
|
|
+ | [], ("Bool" as c)
|
|
|
+ | [], ("Dynamic" as c)
|
|
|
+ | [], ("Iterator" as c)
|
|
|
+ | [], ("ArrayAccess" as c)
|
|
|
+ | [], ("Iterable" as c) ->
|
|
|
+ [], Some c, "StdTypes"
|
|
|
+ | [], ("String" as c) ->
|
|
|
+ ["std"], None, c
|
|
|
+ | _ ->
|
|
|
+ pack, sub, name
|
|
|
+ in
|
|
|
+ CTPath {
|
|
|
+ tpackage = pack;
|
|
|
+ tname = name;
|
|
|
+ tparams = params;
|
|
|
+ tsub = sub;
|
|
|
+ }
|
|
|
|
|
|
let has_tparam name params = List.exists(fun (n,_,_) -> n = name) params
|
|
|
|
|
|
let rec convert_arg ctx p arg =
|
|
|
- match arg with
|
|
|
- | TAny | TType (WSuper, _) -> TPType (mk_type_path ctx ([], "Dynamic") [])
|
|
|
- | TType (_, jsig) -> TPType (convert_signature ctx p jsig)
|
|
|
+ match arg with
|
|
|
+ | TAny | TType (WSuper, _) -> TPType (mk_type_path ctx ([], "Dynamic") [])
|
|
|
+ | TType (_, jsig) -> TPType (convert_signature ctx p jsig)
|
|
|
|
|
|
and convert_signature ctx p jsig =
|
|
|
- match jsig with
|
|
|
- | TByte -> mk_type_path ctx (["java"; "types"], "Int8") []
|
|
|
- | TChar -> mk_type_path ctx (["java"; "types"], "Char16") []
|
|
|
- | TDouble -> mk_type_path ctx ([], "Float") []
|
|
|
- | TFloat -> mk_type_path ctx ([], "Single") []
|
|
|
- | TInt -> mk_type_path ctx ([], "Int") []
|
|
|
- | TLong -> mk_type_path ctx (["haxe"], "Int64") []
|
|
|
- | TShort -> mk_type_path ctx (["java"; "types"], "Int16") []
|
|
|
- | TBool -> mk_type_path ctx ([], "Bool") []
|
|
|
- | TObject ( (["haxe";"root"], name), args ) -> mk_type_path ctx ([], name) (List.map (convert_arg ctx p) args)
|
|
|
- (** nullable types *)
|
|
|
- | TObject ( (["java";"lang"], "Integer"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Int") []) ]
|
|
|
- | TObject ( (["java";"lang"], "Double"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Float") []) ]
|
|
|
- | TObject ( (["java";"lang"], "Single"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Single") []) ]
|
|
|
- | TObject ( (["java";"lang"], "Boolean"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Bool") []) ]
|
|
|
- | TObject ( (["java";"lang"], "Byte"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["java";"types"], "Int8") []) ]
|
|
|
- | TObject ( (["java";"lang"], "Character"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["java";"types"], "Char16") []) ]
|
|
|
- | TObject ( (["java";"lang"], "Short"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["java";"types"], "Int16") []) ]
|
|
|
- | TObject ( (["java";"lang"], "Long"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["haxe"], "Int64") []) ]
|
|
|
- (** other std types *)
|
|
|
- | TObject ( (["java";"lang"], "Object"), [] ) -> mk_type_path ctx ([], "Dynamic") []
|
|
|
- | TObject ( (["java";"lang"], "String"), [] ) -> mk_type_path ctx ([], "String") []
|
|
|
- (** other types *)
|
|
|
- | TObject ( path, [] ) ->
|
|
|
- (match lookup_jclass ctx.jcom path with
|
|
|
- | Some (jcl, _, _) -> mk_type_path ctx path (List.map (fun _ -> convert_arg ctx p TAny) jcl.ctypes)
|
|
|
- | None -> mk_type_path ctx path [])
|
|
|
- | TObject ( path, args ) -> mk_type_path ctx path (List.map (convert_arg ctx p) args)
|
|
|
- | TObjectInner (pack, (name, params) :: inners) ->
|
|
|
- let actual_param = match List.rev inners with
|
|
|
- | (_, p) :: _ -> p
|
|
|
- | _ -> assert false in
|
|
|
- mk_type_path ctx (pack, name ^ "$" ^ String.concat "$" (List.map fst inners)) (List.map (fun param -> convert_arg ctx p param) actual_param)
|
|
|
- | TObjectInner (pack, inners) -> assert false
|
|
|
- | TArray (jsig, _) -> mk_type_path ctx (["java"], "NativeArray") [ TPType (convert_signature ctx p jsig) ]
|
|
|
- | TMethod _ -> JReader.error "TMethod cannot be converted directly into Complex Type"
|
|
|
- | TTypeParameter s -> (match ctx.jtparams with
|
|
|
- | cur :: others ->
|
|
|
- if has_tparam s cur then
|
|
|
- mk_type_path ctx ([], s) []
|
|
|
- else begin
|
|
|
- if ctx.jcom.verbose && not(List.exists (has_tparam s) others) then print_endline ("Type parameter " ^ s ^ " was not found while building type!");
|
|
|
- mk_type_path ctx ([], "Dynamic") []
|
|
|
- end
|
|
|
- | _ ->
|
|
|
- if ctx.jcom.verbose then print_endline ("Empty type parameter stack!");
|
|
|
- mk_type_path ctx ([], "Dynamic") [])
|
|
|
+ match jsig with
|
|
|
+ | TByte -> mk_type_path ctx (["java"; "types"], "Int8") []
|
|
|
+ | TChar -> mk_type_path ctx (["java"; "types"], "Char16") []
|
|
|
+ | TDouble -> mk_type_path ctx ([], "Float") []
|
|
|
+ | TFloat -> mk_type_path ctx ([], "Single") []
|
|
|
+ | TInt -> mk_type_path ctx ([], "Int") []
|
|
|
+ | TLong -> mk_type_path ctx (["haxe"], "Int64") []
|
|
|
+ | TShort -> mk_type_path ctx (["java"; "types"], "Int16") []
|
|
|
+ | TBool -> mk_type_path ctx ([], "Bool") []
|
|
|
+ | TObject ( (["haxe";"root"], name), args ) -> mk_type_path ctx ([], name) (List.map (convert_arg ctx p) args)
|
|
|
+ (** nullable types *)
|
|
|
+ (* replaced from Null<Type> to the actual abstract type to fix #2738 *)
|
|
|
+ (* | TObject ( (["java";"lang"], "Integer"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Int") []) ] *)
|
|
|
+ (* | TObject ( (["java";"lang"], "Double"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Float") []) ] *)
|
|
|
+ (* | TObject ( (["java";"lang"], "Float"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Single") []) ] *)
|
|
|
+ (* | TObject ( (["java";"lang"], "Boolean"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Bool") []) ] *)
|
|
|
+ (* | TObject ( (["java";"lang"], "Byte"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["java";"types"], "Int8") []) ] *)
|
|
|
+ (* | TObject ( (["java";"lang"], "Character"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["java";"types"], "Char16") []) ] *)
|
|
|
+ (* | TObject ( (["java";"lang"], "Short"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["java";"types"], "Int16") []) ] *)
|
|
|
+ (* | TObject ( (["java";"lang"], "Long"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["haxe"], "Int64") []) ] *)
|
|
|
+ (** other std types *)
|
|
|
+ | TObject ( (["java";"lang"], "Object"), [] ) -> mk_type_path ctx ([], "Dynamic") []
|
|
|
+ | TObject ( (["java";"lang"], "String"), [] ) -> mk_type_path ctx ([], "String") []
|
|
|
+ | TObject ( (["java";"lang"], "Enum"), [_] ) -> mk_type_path ctx ([], "EnumValue") []
|
|
|
+ (** other types *)
|
|
|
+ | TObject ( path, [] ) ->
|
|
|
+ (match lookup_jclass ctx.jcom path with
|
|
|
+ | Some (jcl, _, _) -> mk_type_path ctx path (List.map (fun _ -> convert_arg ctx p TAny) jcl.ctypes)
|
|
|
+ | None -> mk_type_path ctx path [])
|
|
|
+ | TObject ( path, args ) -> mk_type_path ctx path (List.map (convert_arg ctx p) args)
|
|
|
+ | TObjectInner (pack, (name, params) :: inners) ->
|
|
|
+ let actual_param = match List.rev inners with
|
|
|
+ | (_, p) :: _ -> p
|
|
|
+ | _ -> assert false in
|
|
|
+ mk_type_path ctx (pack, name ^ "$" ^ String.concat "$" (List.map fst inners)) (List.map (fun param -> convert_arg ctx p param) actual_param)
|
|
|
+ | TObjectInner (pack, inners) -> assert false
|
|
|
+ | TArray (jsig, _) -> mk_type_path ctx (["java"], "NativeArray") [ TPType (convert_signature ctx p jsig) ]
|
|
|
+ | TMethod _ -> JReader.error "TMethod cannot be converted directly into Complex Type"
|
|
|
+ | TTypeParameter s -> (match ctx.jtparams with
|
|
|
+ | cur :: others ->
|
|
|
+ if has_tparam s cur then
|
|
|
+ mk_type_path ctx ([], s) []
|
|
|
+ else begin
|
|
|
+ if ctx.jcom.verbose && not(List.exists (has_tparam s) others) then print_endline ("Type parameter " ^ s ^ " was not found while building type!");
|
|
|
+ mk_type_path ctx ([], "Dynamic") []
|
|
|
+ end
|
|
|
+ | _ ->
|
|
|
+ if ctx.jcom.verbose then print_endline ("Empty type parameter stack!");
|
|
|
+ mk_type_path ctx ([], "Dynamic") [])
|
|
|
|
|
|
let convert_constant ctx p const =
|
|
|
- Option.map_default (function
|
|
|
- | ConstString s -> Some (EConst (String s), p)
|
|
|
- | ConstInt i -> Some (EConst (Int (Printf.sprintf "%ld" i)), p)
|
|
|
- | ConstFloat f | ConstDouble f -> Some (EConst (Float (Printf.sprintf "%E" f)), p)
|
|
|
- | _ -> None) None const
|
|
|
+ Option.map_default (function
|
|
|
+ | ConstString s -> Some (EConst (String s), p)
|
|
|
+ | ConstInt i -> Some (EConst (Int (Printf.sprintf "%ld" i)), p)
|
|
|
+ | ConstFloat f | ConstDouble f -> Some (EConst (Float (Printf.sprintf "%E" f)), p)
|
|
|
+ | _ -> None) None const
|
|
|
|
|
|
let rec same_sig parent jsig =
|
|
|
- match jsig with
|
|
|
- | TObject (p,targs) -> parent = p || List.exists (function | TType (_,s) -> same_sig parent s | _ -> false) targs
|
|
|
- | TObjectInner(p, ntargs) ->
|
|
|
- parent = (p, String.concat "$" (List.map fst ntargs)) ||
|
|
|
- List.exists (fun (_,targs) -> List.exists (function | TType(_,s) -> same_sig parent s | _ -> false) targs) ntargs
|
|
|
- | TArray(s,_) -> same_sig parent s
|
|
|
- | _ -> false
|
|
|
+ match jsig with
|
|
|
+ | TObject (p,targs) -> parent = p || List.exists (function | TType (_,s) -> same_sig parent s | _ -> false) targs
|
|
|
+ | TObjectInner(p, ntargs) ->
|
|
|
+ parent = (p, String.concat "$" (List.map fst ntargs)) ||
|
|
|
+ List.exists (fun (_,targs) -> List.exists (function | TType(_,s) -> same_sig parent s | _ -> false) targs) ntargs
|
|
|
+ | TArray(s,_) -> same_sig parent s
|
|
|
+ | _ -> false
|
|
|
|
|
|
let convert_param ctx p parent param =
|
|
|
- let name, constraints = match param with
|
|
|
- | (name, Some extends_sig, implem_sig) ->
|
|
|
- name, extends_sig :: implem_sig
|
|
|
- | (name, None, implemem_sig) ->
|
|
|
- name, implemem_sig
|
|
|
- in
|
|
|
- let constraints = List.map (fun s -> if same_sig parent s then (TObject( (["java";"lang"], "Object"), [])) else s) constraints in
|
|
|
- {
|
|
|
- tp_name = name;
|
|
|
- tp_params = [];
|
|
|
- tp_constraints = List.map (convert_signature ctx p) constraints;
|
|
|
- }
|
|
|
+ let name, constraints = match param with
|
|
|
+ | (name, Some extends_sig, implem_sig) ->
|
|
|
+ name, extends_sig :: implem_sig
|
|
|
+ | (name, None, implemem_sig) ->
|
|
|
+ name, implemem_sig
|
|
|
+ in
|
|
|
+ let constraints = List.map (fun s -> if same_sig parent s then (TObject( (["java";"lang"], "Object"), [])) else s) constraints in
|
|
|
+ {
|
|
|
+ tp_name = name;
|
|
|
+ tp_params = [];
|
|
|
+ tp_constraints = List.map (convert_signature ctx p) constraints;
|
|
|
+ }
|
|
|
|
|
|
let get_type_path ctx ct = match ct with | CTPath p -> p | _ -> assert false
|
|
|
|
|
|
let is_override field =
|
|
|
- List.exists (function | AttrVisibleAnnotations [{ ann_type = TObject( (["java";"lang"], "Override"), _ ) }] -> true | _ -> false) field.jf_attributes
|
|
|
+ List.exists (function | AttrVisibleAnnotations [{ ann_type = TObject( (["java";"lang"], "Override"), _ ) }] -> true | _ -> false) field.jf_attributes
|
|
|
|
|
|
let mk_override field =
|
|
|
- { field with jf_attributes = ((AttrVisibleAnnotations [{ ann_type = TObject( (["java";"lang"], "Override"), [] ); ann_elements = [] }]) :: field.jf_attributes) }
|
|
|
+ { field with jf_attributes = ((AttrVisibleAnnotations [{ ann_type = TObject( (["java";"lang"], "Override"), [] ); ann_elements = [] }]) :: field.jf_attributes) }
|
|
|
|
|
|
let del_override field =
|
|
|
- { field with jf_attributes = List.filter (fun a -> not (is_override_attrib a)) field.jf_attributes }
|
|
|
+ { field with jf_attributes = List.filter (fun a -> not (is_override_attrib a)) field.jf_attributes }
|
|
|
+
|
|
|
+let get_canonical ctx p pack name =
|
|
|
+ (Meta.JavaCanonical, [EConst (String (String.concat "." pack)), p; EConst (String name), p], p)
|
|
|
|
|
|
let convert_java_enum ctx p pe =
|
|
|
- let meta = ref [Meta.Native, [EConst (String (real_java_path ctx pe.cpath) ), p], p ] in
|
|
|
- let data = ref [] in
|
|
|
- List.iter (fun f ->
|
|
|
- (* if List.mem JEnum f.jf_flags then *)
|
|
|
- match f.jf_vmsignature with
|
|
|
- | TObject( path, [] ) when path = pe.cpath && List.mem JStatic f.jf_flags && List.mem JFinal f.jf_flags ->
|
|
|
- data := { ec_name = f.jf_name; ec_doc = None; ec_meta = []; ec_args = []; ec_pos = p; ec_params = []; ec_type = None; } :: !data;
|
|
|
- | _ -> ()
|
|
|
- ) pe.cfields;
|
|
|
-
|
|
|
- EEnum {
|
|
|
- d_name = jname_to_hx (snd pe.cpath);
|
|
|
- d_doc = None;
|
|
|
- d_params = []; (* enums never have type parameters *)
|
|
|
- d_meta = !meta;
|
|
|
- d_flags = [EExtern];
|
|
|
- d_data = List.rev !data;
|
|
|
- }
|
|
|
-
|
|
|
- let convert_java_field ctx p jc field =
|
|
|
- let p = { p with pfile = p.pfile ^" (" ^field.jf_name ^")" } in
|
|
|
- let cff_doc = None in
|
|
|
- let cff_pos = p in
|
|
|
- let cff_meta = ref [] in
|
|
|
- let cff_access = ref [] in
|
|
|
- let cff_name = match field.jf_name with
|
|
|
- | "<init>" -> "new"
|
|
|
- | "<clinit>"-> raise Exit (* __init__ field *)
|
|
|
- | name when String.length name > 5 ->
|
|
|
- (match String.sub name 0 5 with
|
|
|
- | "__hx_" | "this$" -> raise Exit
|
|
|
- | _ -> name)
|
|
|
- | name -> name
|
|
|
- in
|
|
|
- let jf_constant = ref field.jf_constant in
|
|
|
- let readonly = ref false in
|
|
|
-
|
|
|
- List.iter (function
|
|
|
- | JPublic -> cff_access := APublic :: !cff_access
|
|
|
- | JPrivate -> raise Exit (* private instances aren't useful on externs *)
|
|
|
- | JProtected -> cff_access := APrivate :: !cff_access
|
|
|
- | JStatic -> cff_access := AStatic :: !cff_access
|
|
|
- | JFinal ->
|
|
|
- cff_meta := (Meta.Final, [], p) :: !cff_meta;
|
|
|
- (match field.jf_kind, field.jf_vmsignature, field.jf_constant with
|
|
|
- | JKField, TObject _, _ ->
|
|
|
- jf_constant := None
|
|
|
- | JKField, _, Some _ ->
|
|
|
- readonly := true;
|
|
|
- jf_constant := None;
|
|
|
- | _ -> jf_constant := None)
|
|
|
- (* | JSynchronized -> cff_meta := (Meta.Synchronized, [], p) :: !cff_meta *)
|
|
|
- | JVolatile -> cff_meta := (Meta.Volatile, [], p) :: !cff_meta
|
|
|
- | JTransient -> cff_meta := (Meta.Transient, [], p) :: !cff_meta
|
|
|
- (* | JVarArgs -> cff_meta := (Meta.VarArgs, [], p) :: !cff_meta *)
|
|
|
- | _ -> ()
|
|
|
- ) field.jf_flags;
|
|
|
-
|
|
|
- List.iter (function
|
|
|
- | AttrDeprecated when jc.cpath <> (["java";"util"],"Date") -> cff_meta := (Meta.Deprecated, [], p) :: !cff_meta
|
|
|
- (* TODO: pass anotations as @:meta *)
|
|
|
- | AttrVisibleAnnotations ann ->
|
|
|
- List.iter (function
|
|
|
- | { ann_type = TObject( (["java";"lang"], "Override"), [] ) } ->
|
|
|
- cff_access := AOverride :: !cff_access
|
|
|
- | _ -> ()
|
|
|
- ) ann
|
|
|
- | _ -> ()
|
|
|
- ) field.jf_attributes;
|
|
|
-
|
|
|
- let kind = match field.jf_kind with
|
|
|
- | JKField when !readonly ->
|
|
|
- FProp ("default", "null", Some (convert_signature ctx p field.jf_signature), None)
|
|
|
- | JKField ->
|
|
|
- FVar (Some (convert_signature ctx p field.jf_signature), None)
|
|
|
- | JKMethod ->
|
|
|
- match field.jf_signature with
|
|
|
- | TMethod (args, ret) ->
|
|
|
- let old_types = ctx.jtparams in
|
|
|
- (match ctx.jtparams with
|
|
|
- | c :: others -> ctx.jtparams <- (c @ field.jf_types) :: others
|
|
|
- | [] -> ctx.jtparams <- field.jf_types :: []);
|
|
|
- let i = ref 0 in
|
|
|
- let args = List.map (fun s ->
|
|
|
- incr i;
|
|
|
- "param" ^ string_of_int !i, false, Some(convert_signature ctx p s), None
|
|
|
- ) args in
|
|
|
- let t = Option.map_default (convert_signature ctx p) (mk_type_path ctx ([], "Void") []) ret in
|
|
|
- cff_meta := (Meta.Overload, [], p) :: !cff_meta;
|
|
|
-
|
|
|
- let types = List.map (function
|
|
|
- | (name, Some ext, impl) ->
|
|
|
- {
|
|
|
- tp_name = name;
|
|
|
- tp_params = [];
|
|
|
- tp_constraints = List.map (convert_signature ctx p) (ext :: impl);
|
|
|
- }
|
|
|
- | (name, None, impl) ->
|
|
|
- {
|
|
|
- tp_name = name;
|
|
|
- tp_params = [];
|
|
|
- tp_constraints = List.map (convert_signature ctx p) (impl);
|
|
|
- }
|
|
|
- ) field.jf_types in
|
|
|
- ctx.jtparams <- old_types;
|
|
|
-
|
|
|
- FFun ({
|
|
|
- f_params = types;
|
|
|
- f_args = args;
|
|
|
- f_type = Some t;
|
|
|
- f_expr = None
|
|
|
- })
|
|
|
- | _ -> error "Method signature was expected" p
|
|
|
- in
|
|
|
- let cff_name, cff_meta =
|
|
|
- if String.get cff_name 0 = '%' then
|
|
|
- let name = (String.sub cff_name 1 (String.length cff_name - 1)) in
|
|
|
- "_" ^ name,
|
|
|
- (Meta.Native, [EConst (String (name) ), cff_pos], cff_pos) :: !cff_meta
|
|
|
- else
|
|
|
- cff_name, !cff_meta
|
|
|
- in
|
|
|
-
|
|
|
- {
|
|
|
- cff_name = cff_name;
|
|
|
- cff_doc = cff_doc;
|
|
|
- cff_pos = cff_pos;
|
|
|
- cff_meta = cff_meta;
|
|
|
- cff_access = !cff_access;
|
|
|
- cff_kind = kind
|
|
|
- }
|
|
|
-
|
|
|
- let rec japply_params params jsig = match params with
|
|
|
- | [] -> jsig
|
|
|
- | _ -> match jsig with
|
|
|
- | TTypeParameter s -> (try
|
|
|
- List.assoc s params
|
|
|
- with | Not_found -> jsig)
|
|
|
- | TObject(p,tl) ->
|
|
|
- TObject(p, args params tl)
|
|
|
- | TObjectInner(sl, stll) ->
|
|
|
- TObjectInner(sl, List.map (fun (s,tl) -> (s, args params tl)) stll)
|
|
|
- | TArray(s,io) ->
|
|
|
- TArray(japply_params params s, io)
|
|
|
- | TMethod(sl, sopt) ->
|
|
|
- TMethod(List.map (japply_params params) sl, Option.map (japply_params params) sopt)
|
|
|
- | _ -> jsig
|
|
|
-
|
|
|
- and args params tl = match params with
|
|
|
- | [] -> tl
|
|
|
- | _ -> List.map (function
|
|
|
- | TAny -> TAny
|
|
|
- | TType(w,s) -> TType(w,japply_params params s)) tl
|
|
|
-
|
|
|
- let mk_params jtypes = List.map (fun (s,_,_) -> (s,TTypeParameter s)) jtypes
|
|
|
-
|
|
|
- let convert_java_class ctx p jc =
|
|
|
- match List.mem JEnum jc.cflags with
|
|
|
- | true -> (* is enum *)
|
|
|
- convert_java_enum ctx p jc
|
|
|
- | false ->
|
|
|
- let flags = ref [HExtern] in
|
|
|
- (* todo: instead of JavaNative, use more specific definitions *)
|
|
|
- let meta = ref [Meta.JavaNative, [], p; Meta.Native, [EConst (String (real_java_path ctx jc.cpath) ), p], p] in
|
|
|
-
|
|
|
- let is_interface = ref false in
|
|
|
- List.iter (fun f -> match f with
|
|
|
- | JFinal -> meta := (Meta.Final, [], p) :: !meta
|
|
|
- | JInterface ->
|
|
|
- is_interface := true;
|
|
|
- flags := HInterface :: !flags
|
|
|
- | JAbstract -> meta := (Meta.Abstract, [], p) :: !meta
|
|
|
- | JAnnotation -> meta := (Meta.Annotation, [], p) :: !meta
|
|
|
- | _ -> ()
|
|
|
- ) jc.cflags;
|
|
|
-
|
|
|
- (match jc.csuper with
|
|
|
- | TObject( (["java";"lang"], "Object"), _ ) -> ()
|
|
|
- | TObject( (["haxe";"lang"], "HxObject"), _ ) -> meta := (Meta.HxGen,[],p) :: !meta
|
|
|
- | _ -> flags := HExtends (get_type_path ctx (convert_signature ctx p jc.csuper)) :: !flags
|
|
|
- );
|
|
|
-
|
|
|
- List.iter (fun i ->
|
|
|
- match i with
|
|
|
- | TObject ( (["haxe";"lang"], "IHxObject"), _ ) -> meta := (Meta.HxGen,[],p) :: !meta
|
|
|
- | _ -> flags :=
|
|
|
- if !is_interface then
|
|
|
- HExtends (get_type_path ctx (convert_signature ctx p i)) :: !flags
|
|
|
- else
|
|
|
- HImplements (get_type_path ctx (convert_signature ctx p i)) :: !flags
|
|
|
- ) jc.cinterfaces;
|
|
|
-
|
|
|
- let fields = ref [] in
|
|
|
- let jfields = ref [] in
|
|
|
-
|
|
|
- if jc.cpath <> (["java";"lang"], "CharSequence") then
|
|
|
- List.iter (fun f ->
|
|
|
- try
|
|
|
- if !is_interface && List.mem JStatic f.jf_flags then
|
|
|
- ()
|
|
|
- else begin
|
|
|
- fields := convert_java_field ctx p jc f :: !fields;
|
|
|
- jfields := f :: !jfields
|
|
|
- end
|
|
|
- with
|
|
|
- | Exit -> ()
|
|
|
- ) (jc.cfields @ jc.cmethods);
|
|
|
-
|
|
|
- EClass {
|
|
|
- d_name = jname_to_hx (snd jc.cpath);
|
|
|
- d_doc = None;
|
|
|
- d_params = List.map (convert_param ctx p jc.cpath) jc.ctypes;
|
|
|
- d_meta = !meta;
|
|
|
- d_flags = !flags;
|
|
|
- d_data = !fields;
|
|
|
- }
|
|
|
-
|
|
|
- let create_ctx com =
|
|
|
- {
|
|
|
- jcom = com;
|
|
|
- jtparams = [];
|
|
|
- }
|
|
|
-
|
|
|
- let rec has_type_param = function
|
|
|
- | TTypeParameter _ -> true
|
|
|
- | TMethod (lst, opt) -> List.exists has_type_param lst || Option.map_default has_type_param false opt
|
|
|
- | TArray (s,_) -> has_type_param s
|
|
|
- | TObjectInner (_, stpl) -> List.exists (fun (_,sigs) -> List.exists has_type_param_arg sigs) stpl
|
|
|
- | TObject(_, pl) -> List.exists has_type_param_arg pl
|
|
|
- | _ -> false
|
|
|
-
|
|
|
- and has_type_param_arg = function | TType(_,s) -> has_type_param s | _ -> false
|
|
|
+ let meta = ref (get_canonical ctx p (fst pe.cpath) (snd pe.cpath) :: [Meta.Native, [EConst (String (real_java_path ctx pe.cpath) ), p], p ]) in
|
|
|
+ let data = ref [] in
|
|
|
+ List.iter (fun f ->
|
|
|
+ (* if List.mem JEnum f.jf_flags then *)
|
|
|
+ match f.jf_vmsignature with
|
|
|
+ | TObject( path, [] ) when path = pe.cpath && List.mem JStatic f.jf_flags && List.mem JFinal f.jf_flags ->
|
|
|
+ data := { ec_name = f.jf_name; ec_doc = None; ec_meta = []; ec_args = []; ec_pos = p; ec_params = []; ec_type = None; } :: !data;
|
|
|
+ | _ -> ()
|
|
|
+ ) pe.cfields;
|
|
|
+
|
|
|
+ EEnum {
|
|
|
+ d_name = jname_to_hx (snd pe.cpath);
|
|
|
+ d_doc = None;
|
|
|
+ d_params = []; (* enums never have type parameters *)
|
|
|
+ d_meta = !meta;
|
|
|
+ d_flags = [EExtern];
|
|
|
+ d_data = List.rev !data;
|
|
|
+ }
|
|
|
+
|
|
|
+ let convert_java_field ctx p jc field =
|
|
|
+ let p = { p with pfile = p.pfile ^" (" ^field.jf_name ^")" } in
|
|
|
+ let cff_doc = None in
|
|
|
+ let cff_pos = p in
|
|
|
+ let cff_meta = ref [] in
|
|
|
+ let cff_access = ref [] in
|
|
|
+ let cff_name = match field.jf_name with
|
|
|
+ | "<init>" -> "new"
|
|
|
+ | "<clinit>"-> raise Exit (* __init__ field *)
|
|
|
+ | name when String.length name > 5 ->
|
|
|
+ (match String.sub name 0 5 with
|
|
|
+ | "__hx_" | "this$" -> raise Exit
|
|
|
+ | _ -> name)
|
|
|
+ | name -> name
|
|
|
+ in
|
|
|
+ let jf_constant = ref field.jf_constant in
|
|
|
+ let readonly = ref false in
|
|
|
+
|
|
|
+ List.iter (function
|
|
|
+ | JPublic -> cff_access := APublic :: !cff_access
|
|
|
+ | JPrivate -> raise Exit (* private instances aren't useful on externs *)
|
|
|
+ | JProtected -> cff_access := APrivate :: !cff_access
|
|
|
+ | JStatic -> cff_access := AStatic :: !cff_access
|
|
|
+ | JFinal ->
|
|
|
+ cff_meta := (Meta.Final, [], p) :: !cff_meta;
|
|
|
+ (match field.jf_kind, field.jf_vmsignature, field.jf_constant with
|
|
|
+ | JKField, TObject _, _ ->
|
|
|
+ jf_constant := None
|
|
|
+ | JKField, _, Some _ ->
|
|
|
+ readonly := true;
|
|
|
+ jf_constant := None;
|
|
|
+ | _ -> jf_constant := None)
|
|
|
+ (* | JSynchronized -> cff_meta := (Meta.Synchronized, [], p) :: !cff_meta *)
|
|
|
+ | JVolatile -> cff_meta := (Meta.Volatile, [], p) :: !cff_meta
|
|
|
+ | JTransient -> cff_meta := (Meta.Transient, [], p) :: !cff_meta
|
|
|
+ (* | JVarArgs -> cff_meta := (Meta.VarArgs, [], p) :: !cff_meta *)
|
|
|
+ | _ -> ()
|
|
|
+ ) field.jf_flags;
|
|
|
+
|
|
|
+ List.iter (function
|
|
|
+ | AttrDeprecated when jc.cpath <> (["java";"util"],"Date") -> cff_meta := (Meta.Deprecated, [], p) :: !cff_meta
|
|
|
+ (* TODO: pass anotations as @:meta *)
|
|
|
+ | AttrVisibleAnnotations ann ->
|
|
|
+ List.iter (function
|
|
|
+ | { ann_type = TObject( (["java";"lang"], "Override"), [] ) } ->
|
|
|
+ cff_access := AOverride :: !cff_access
|
|
|
+ | _ -> ()
|
|
|
+ ) ann
|
|
|
+ | _ -> ()
|
|
|
+ ) field.jf_attributes;
|
|
|
+
|
|
|
+ List.iter (fun jsig ->
|
|
|
+ match convert_signature ctx p jsig with
|
|
|
+ | CTPath path ->
|
|
|
+ cff_meta := (Meta.Throws, [Ast.EConst (Ast.String (path_s (path.tpackage,path.tname))), p],p) :: !cff_meta
|
|
|
+ | _ -> ()
|
|
|
+ ) field.jf_throws;
|
|
|
+
|
|
|
+ let kind = match field.jf_kind with
|
|
|
+ | JKField when !readonly ->
|
|
|
+ FProp ("default", "null", Some (convert_signature ctx p field.jf_signature), None)
|
|
|
+ | JKField ->
|
|
|
+ FVar (Some (convert_signature ctx p field.jf_signature), None)
|
|
|
+ | JKMethod ->
|
|
|
+ match field.jf_signature with
|
|
|
+ | TMethod (args, ret) ->
|
|
|
+ let old_types = ctx.jtparams in
|
|
|
+ (match ctx.jtparams with
|
|
|
+ | c :: others -> ctx.jtparams <- (c @ field.jf_types) :: others
|
|
|
+ | [] -> ctx.jtparams <- field.jf_types :: []);
|
|
|
+ let i = ref 0 in
|
|
|
+ let args = List.map (fun s ->
|
|
|
+ incr i;
|
|
|
+ "param" ^ string_of_int !i, false, Some(convert_signature ctx p s), None
|
|
|
+ ) args in
|
|
|
+ let t = Option.map_default (convert_signature ctx p) (mk_type_path ctx ([], "Void") []) ret in
|
|
|
+ cff_meta := (Meta.Overload, [], p) :: !cff_meta;
|
|
|
+
|
|
|
+ let types = List.map (function
|
|
|
+ | (name, Some ext, impl) ->
|
|
|
+ {
|
|
|
+ tp_name = name;
|
|
|
+ tp_params = [];
|
|
|
+ tp_constraints = List.map (convert_signature ctx p) (ext :: impl);
|
|
|
+ }
|
|
|
+ | (name, None, impl) ->
|
|
|
+ {
|
|
|
+ tp_name = name;
|
|
|
+ tp_params = [];
|
|
|
+ tp_constraints = List.map (convert_signature ctx p) (impl);
|
|
|
+ }
|
|
|
+ ) field.jf_types in
|
|
|
+ ctx.jtparams <- old_types;
|
|
|
+
|
|
|
+ FFun ({
|
|
|
+ f_params = types;
|
|
|
+ f_args = args;
|
|
|
+ f_type = Some t;
|
|
|
+ f_expr = None
|
|
|
+ })
|
|
|
+ | _ -> error "Method signature was expected" p
|
|
|
+ in
|
|
|
+ let cff_name, cff_meta =
|
|
|
+ match String.get cff_name 0 with
|
|
|
+ | '%' ->
|
|
|
+ let name = (String.sub cff_name 1 (String.length cff_name - 1)) in
|
|
|
+ if not (is_haxe_keyword name) then
|
|
|
+ cff_meta := (Meta.Deprecated, [EConst(String(
|
|
|
+ "This static field `_" ^ name ^ "` is deprecated and will be removed in later versions. Please use `" ^ name ^ "` instead")
|
|
|
+ ),p], p) :: !cff_meta;
|
|
|
+ "_" ^ name,
|
|
|
+ (Meta.Native, [EConst (String (name) ), cff_pos], cff_pos) :: !cff_meta
|
|
|
+ | _ ->
|
|
|
+ match String.nsplit cff_name "$" with
|
|
|
+ | [ no_dollar ] ->
|
|
|
+ cff_name, !cff_meta
|
|
|
+ | parts ->
|
|
|
+ String.concat "_" parts,
|
|
|
+ (Meta.Native, [EConst (String (cff_name) ), cff_pos], cff_pos) :: !cff_meta
|
|
|
+ in
|
|
|
+ if PMap.mem "java_loader_debug" ctx.jcom.defines then
|
|
|
+ Printf.printf "\t%s%sfield %s : %s\n" (if List.mem AStatic !cff_access then "static " else "") (if List.mem AOverride !cff_access then "override " else "") cff_name (s_sig field.jf_signature);
|
|
|
+
|
|
|
+ {
|
|
|
+ cff_name = cff_name;
|
|
|
+ cff_doc = cff_doc;
|
|
|
+ cff_pos = cff_pos;
|
|
|
+ cff_meta = cff_meta;
|
|
|
+ cff_access = !cff_access;
|
|
|
+ cff_kind = kind
|
|
|
+ }
|
|
|
+
|
|
|
+ let rec japply_params params jsig = match params with
|
|
|
+ | [] -> jsig
|
|
|
+ | _ -> match jsig with
|
|
|
+ | TTypeParameter s -> (try
|
|
|
+ List.assoc s params
|
|
|
+ with | Not_found -> jsig)
|
|
|
+ | TObject(p,tl) ->
|
|
|
+ TObject(p, args params tl)
|
|
|
+ | TObjectInner(sl, stll) ->
|
|
|
+ TObjectInner(sl, List.map (fun (s,tl) -> (s, args params tl)) stll)
|
|
|
+ | TArray(s,io) ->
|
|
|
+ TArray(japply_params params s, io)
|
|
|
+ | TMethod(sl, sopt) ->
|
|
|
+ TMethod(List.map (japply_params params) sl, Option.map (japply_params params) sopt)
|
|
|
+ | _ -> jsig
|
|
|
+
|
|
|
+ and args params tl = match params with
|
|
|
+ | [] -> tl
|
|
|
+ | _ -> List.map (function
|
|
|
+ | TAny -> TAny
|
|
|
+ | TType(w,s) -> TType(w,japply_params params s)) tl
|
|
|
+
|
|
|
+ let mk_params jtypes = List.map (fun (s,_,_) -> (s,TTypeParameter s)) jtypes
|
|
|
+
|
|
|
+ let convert_java_class ctx p jc =
|
|
|
+ match List.mem JEnum jc.cflags with
|
|
|
+ | true -> (* is enum *)
|
|
|
+ [convert_java_enum ctx p jc]
|
|
|
+ | false ->
|
|
|
+ let flags = ref [HExtern] in
|
|
|
+ if PMap.mem "java_loader_debug" ctx.jcom.defines then begin
|
|
|
+ let sup = jc.csuper :: jc.cinterfaces in
|
|
|
+ print_endline ("converting " ^ (if List.mem JAbstract jc.cflags then "abstract " else "") ^ JData.path_s jc.cpath ^ " : " ^ (String.concat ", " (List.map s_sig sup)));
|
|
|
+ end;
|
|
|
+ (* todo: instead of JavaNative, use more specific definitions *)
|
|
|
+ let meta = ref [Meta.JavaNative, [], p; Meta.Native, [EConst (String (real_java_path ctx jc.cpath) ), p], p; get_canonical ctx p (fst jc.cpath) (snd jc.cpath)] in
|
|
|
+ let force_check = Common.defined ctx.jcom Define.ForceLibCheck in
|
|
|
+ if not force_check then
|
|
|
+ meta := (Meta.LibType,[],p) :: !meta;
|
|
|
+
|
|
|
+ let is_interface = ref false in
|
|
|
+ List.iter (fun f -> match f with
|
|
|
+ | JFinal -> meta := (Meta.Final, [], p) :: !meta
|
|
|
+ | JInterface ->
|
|
|
+ is_interface := true;
|
|
|
+ flags := HInterface :: !flags
|
|
|
+ | JAbstract -> meta := (Meta.Abstract, [], p) :: !meta
|
|
|
+ | JAnnotation -> meta := (Meta.Annotation, [], p) :: !meta
|
|
|
+ | _ -> ()
|
|
|
+ ) jc.cflags;
|
|
|
+
|
|
|
+ (match jc.csuper with
|
|
|
+ | TObject( (["java";"lang"], "Object"), _ ) -> ()
|
|
|
+ | TObject( (["haxe";"lang"], "HxObject"), _ ) -> meta := (Meta.HxGen,[],p) :: !meta
|
|
|
+ | _ -> flags := HExtends (get_type_path ctx (convert_signature ctx p jc.csuper)) :: !flags
|
|
|
+ );
|
|
|
+
|
|
|
+ List.iter (fun i ->
|
|
|
+ match i with
|
|
|
+ | TObject ( (["haxe";"lang"], "IHxObject"), _ ) -> meta := (Meta.HxGen,[],p) :: !meta
|
|
|
+ | _ -> flags :=
|
|
|
+ if !is_interface then
|
|
|
+ HExtends (get_type_path ctx (convert_signature ctx p i)) :: !flags
|
|
|
+ else
|
|
|
+ HImplements (get_type_path ctx (convert_signature ctx p i)) :: !flags
|
|
|
+ ) jc.cinterfaces;
|
|
|
+
|
|
|
+ let fields = ref [] in
|
|
|
+ let jfields = ref [] in
|
|
|
+
|
|
|
+ if jc.cpath <> (["java";"lang"], "CharSequence") then
|
|
|
+ List.iter (fun f ->
|
|
|
+ try
|
|
|
+ if !is_interface && List.mem JStatic f.jf_flags then
|
|
|
+ ()
|
|
|
+ else begin
|
|
|
+ fields := convert_java_field ctx p jc f :: !fields;
|
|
|
+ jfields := f :: !jfields
|
|
|
+ end
|
|
|
+ with
|
|
|
+ | Exit -> ()
|
|
|
+ ) (jc.cfields @ jc.cmethods);
|
|
|
+
|
|
|
+ (* make sure the throws types are imported correctly *)
|
|
|
+ let imports = List.concat (List.map (fun f ->
|
|
|
+ List.map (fun jsig ->
|
|
|
+ match convert_signature ctx p jsig with
|
|
|
+ | CTPath path ->
|
|
|
+ let pos = { p with pfile = p.pfile ^ " (" ^ f.jf_name ^" @:throws)" } in
|
|
|
+ EImport( List.map (fun s -> s,pos) (path.tpackage @ [path.tname]), INormal )
|
|
|
+ | _ -> assert false
|
|
|
+ ) f.jf_throws
|
|
|
+ ) jc.cmethods) in
|
|
|
+
|
|
|
+ (EClass {
|
|
|
+ d_name = jname_to_hx (snd jc.cpath);
|
|
|
+ d_doc = None;
|
|
|
+ d_params = List.map (convert_param ctx p jc.cpath) jc.ctypes;
|
|
|
+ d_meta = !meta;
|
|
|
+ d_flags = !flags;
|
|
|
+ d_data = !fields;
|
|
|
+ }) :: imports
|
|
|
+
|
|
|
+ let create_ctx com =
|
|
|
+ {
|
|
|
+ jcom = com;
|
|
|
+ jtparams = [];
|
|
|
+ }
|
|
|
+
|
|
|
+ let rec has_type_param = function
|
|
|
+ | TTypeParameter _ -> true
|
|
|
+ | TMethod (lst, opt) -> List.exists has_type_param lst || Option.map_default has_type_param false opt
|
|
|
+ | TArray (s,_) -> has_type_param s
|
|
|
+ | TObjectInner (_, stpl) -> List.exists (fun (_,sigs) -> List.exists has_type_param_arg sigs) stpl
|
|
|
+ | TObject(_, pl) -> List.exists has_type_param_arg pl
|
|
|
+ | _ -> false
|
|
|
+
|
|
|
+ and has_type_param_arg = function | TType(_,s) -> has_type_param s | _ -> false
|
|
|
|
|
|
let rec japply_params jparams jsig = match jparams with
|
|
|
- | [] -> jsig
|
|
|
- | _ ->
|
|
|
- match jsig with
|
|
|
- | TObject(path,p) ->
|
|
|
- TObject(path, List.map (japply_params_tp jparams ) p)
|
|
|
- | TObjectInner(sl,stargl) ->
|
|
|
- TObjectInner(sl,List.map (fun (s,targ) -> (s, List.map (japply_params_tp jparams) targ)) stargl)
|
|
|
- | TArray(jsig,io) ->
|
|
|
- TArray(japply_params jparams jsig,io)
|
|
|
- | TMethod(args,ret) ->
|
|
|
- TMethod(List.map (japply_params jparams ) args, Option.map (japply_params jparams ) ret)
|
|
|
- | TTypeParameter s -> (try
|
|
|
- List.assoc s jparams
|
|
|
- with | Not_found -> jsig)
|
|
|
- | _ -> jsig
|
|
|
+ | [] -> jsig
|
|
|
+ | _ ->
|
|
|
+ match jsig with
|
|
|
+ | TObject(path,p) ->
|
|
|
+ TObject(path, List.map (japply_params_tp jparams ) p)
|
|
|
+ | TObjectInner(sl,stargl) ->
|
|
|
+ TObjectInner(sl,List.map (fun (s,targ) -> (s, List.map (japply_params_tp jparams) targ)) stargl)
|
|
|
+ | TArray(jsig,io) ->
|
|
|
+ TArray(japply_params jparams jsig,io)
|
|
|
+ | TMethod(args,ret) ->
|
|
|
+ TMethod(List.map (japply_params jparams ) args, Option.map (japply_params jparams ) ret)
|
|
|
+ | TTypeParameter s -> (try
|
|
|
+ List.assoc s jparams
|
|
|
+ with | Not_found -> jsig)
|
|
|
+ | _ -> jsig
|
|
|
|
|
|
|
|
|
and japply_params_tp jparams jtype_argument = match jtype_argument with
|
|
|
- | TAny -> TAny
|
|
|
- | TType(w,jsig) -> TType(w,japply_params jparams jsig)
|
|
|
+ | TAny -> TAny
|
|
|
+ | TType(w,jsig) -> TType(w,japply_params jparams jsig)
|
|
|
|
|
|
let mk_jparams jtypes params = match jtypes, params with
|
|
|
- | [], [] -> []
|
|
|
- | _, [] -> List.map (fun (s,_,_) -> s, TObject( (["java";"lang"], "Object"), [] ) ) jtypes
|
|
|
- | _ -> List.map2 (fun (s,_,_) jt -> match jt with
|
|
|
- | TAny -> s, TObject((["java";"lang"],"Object"),[])
|
|
|
- | TType(_,jsig) -> s, jsig) jtypes params
|
|
|
+ | [], [] -> []
|
|
|
+ | _, [] -> List.map (fun (s,_,_) -> s, TObject( (["java";"lang"], "Object"), [] ) ) jtypes
|
|
|
+ | _ -> List.map2 (fun (s,_,_) jt -> match jt with
|
|
|
+ | TAny -> s, TObject((["java";"lang"],"Object"),[])
|
|
|
+ | TType(_,jsig) -> s, jsig) jtypes params
|
|
|
|
|
|
let rec compatible_signature_arg ?arg_test f1 f2 =
|
|
|
- let arg_test = match arg_test with
|
|
|
- | None -> (fun _ _ -> true)
|
|
|
- | Some a -> a
|
|
|
- in
|
|
|
- if f1 = f2 then
|
|
|
- true
|
|
|
- else match f1, f2 with
|
|
|
- | TObject(p,a), TObject(p2,a2) -> p = p2 && arg_test a a2
|
|
|
- | TObjectInner(sl, stal), TObjectInner(sl2, stal2) -> sl = sl2 && List.map fst stal = List.map fst stal2
|
|
|
- | TArray(s,_) , TArray(s2,_) -> compatible_signature_arg s s2
|
|
|
- | TTypeParameter t1 , TTypeParameter t2 -> t1 = t2
|
|
|
- | _ -> false
|
|
|
+ let arg_test = match arg_test with
|
|
|
+ | None -> (fun _ _ -> true)
|
|
|
+ | Some a -> a
|
|
|
+ in
|
|
|
+ if f1 = f2 then
|
|
|
+ true
|
|
|
+ else match f1, f2 with
|
|
|
+ | TObject(p,a), TObject(p2,a2) -> p = p2 && arg_test a a2
|
|
|
+ | TObjectInner(sl, stal), TObjectInner(sl2, stal2) -> sl = sl2 && List.map fst stal = List.map fst stal2
|
|
|
+ | TArray(s,_) , TArray(s2,_) -> compatible_signature_arg s s2
|
|
|
+ | TTypeParameter t1 , TTypeParameter t2 -> t1 = t2
|
|
|
+ | _ -> false
|
|
|
|
|
|
let rec compatible_param p1 p2 = match p1, p2 with
|
|
|
- | TType (_,s1), TType(_,s2) -> compatible_signature_arg ~arg_test:compatible_tparams s1 s2
|
|
|
- | TAny, TType(_, TObject( (["java";"lang"],"Object"), _ )) -> true
|
|
|
- | TType(_, TObject( (["java";"lang"],"Object"), _ )), TAny -> true
|
|
|
- | _ -> false
|
|
|
+ | TType (_,s1), TType(_,s2) -> compatible_signature_arg ~arg_test:compatible_tparams s1 s2
|
|
|
+ | TAny, TType(_, TObject( (["java";"lang"],"Object"), _ )) -> true
|
|
|
+ | TType(_, TObject( (["java";"lang"],"Object"), _ )), TAny -> true
|
|
|
+ | _ -> false
|
|
|
|
|
|
and compatible_tparams p1 p2 = try match p1, p2 with
|
|
|
- | [], [] -> true
|
|
|
- | _, [] ->
|
|
|
- let p2 = List.map (fun _ -> TAny) p1 in
|
|
|
- List.for_all2 compatible_param p1 p2
|
|
|
- | [], _ ->
|
|
|
- let p1 = List.map (fun _ -> TAny) p2 in
|
|
|
- List.for_all2 compatible_param p1 p2
|
|
|
- | _, _ ->
|
|
|
- List.for_all2 compatible_param p1 p2
|
|
|
- with | Invalid_argument("List.for_all2") -> false
|
|
|
+ | [], [] -> true
|
|
|
+ | _, [] ->
|
|
|
+ let p2 = List.map (fun _ -> TAny) p1 in
|
|
|
+ List.for_all2 compatible_param p1 p2
|
|
|
+ | [], _ ->
|
|
|
+ let p1 = List.map (fun _ -> TAny) p2 in
|
|
|
+ List.for_all2 compatible_param p1 p2
|
|
|
+ | _, _ ->
|
|
|
+ List.for_all2 compatible_param p1 p2
|
|
|
+ with | Invalid_argument("List.for_all2") -> false
|
|
|
|
|
|
let get_adapted_sig f f2 = match f.jf_types with
|
|
|
- | [] ->
|
|
|
- f.jf_signature
|
|
|
- | _ ->
|
|
|
- let jparams = mk_jparams f.jf_types (List.map (fun (s,_,_) -> TType(WNone, TTypeParameter s)) f2.jf_types) in
|
|
|
- japply_params jparams f.jf_signature
|
|
|
+ | [] ->
|
|
|
+ f.jf_signature
|
|
|
+ | _ ->
|
|
|
+ let jparams = mk_jparams f.jf_types (List.map (fun (s,_,_) -> TType(WNone, TTypeParameter s)) f2.jf_types) in
|
|
|
+ japply_params jparams f.jf_signature
|
|
|
|
|
|
let compatible_methods f1 f2 =
|
|
|
- if List.length f1.jf_types <> List.length f2.jf_types then
|
|
|
- false
|
|
|
- else match (get_adapted_sig f1 f2), f2.jf_signature with
|
|
|
- | TMethod(a1,_), TMethod(a2,_) when List.length a1 = List.length a2 ->
|
|
|
- List.for_all2 compatible_signature_arg a1 a2
|
|
|
- | _ -> false
|
|
|
+ if List.length f1.jf_types <> List.length f2.jf_types then
|
|
|
+ false
|
|
|
+ else match (get_adapted_sig f1 f2), f2.jf_signature with
|
|
|
+ | TMethod(a1,_), TMethod(a2,_) when List.length a1 = List.length a2 ->
|
|
|
+ List.for_all2 compatible_signature_arg a1 a2
|
|
|
+ | _ -> false
|
|
|
|
|
|
let jcl_from_jsig com jsig =
|
|
|
- let path, params = match jsig with
|
|
|
- | TObject(path, params) ->
|
|
|
- path,params
|
|
|
- | TObjectInner(sl, stll) ->
|
|
|
- let last_params = ref [] in
|
|
|
- let real_path = sl, String.concat "$" (List.map (fun (s,p) -> last_params := p; s) stll) in
|
|
|
- real_path, !last_params
|
|
|
- | _ -> raise Not_found
|
|
|
- in
|
|
|
- match lookup_jclass com path with
|
|
|
- | None -> raise Not_found
|
|
|
- | Some(c,_,_) -> c,params
|
|
|
+ let path, params = match jsig with
|
|
|
+ | TObject(path, params) ->
|
|
|
+ path,params
|
|
|
+ | TObjectInner(sl, stll) ->
|
|
|
+ let last_params = ref [] in
|
|
|
+ let real_path = sl, String.concat "$" (List.map (fun (s,p) -> last_params := p; s) stll) in
|
|
|
+ real_path, !last_params
|
|
|
+ | _ -> raise Not_found
|
|
|
+ in
|
|
|
+ match lookup_jclass com path with
|
|
|
+ | None -> raise Not_found
|
|
|
+ | Some(c,_,_) -> c,params
|
|
|
|
|
|
let jclass_with_params com cls params = try
|
|
|
- match cls.ctypes with
|
|
|
- | [] -> cls
|
|
|
- | _ ->
|
|
|
- let jparams = mk_jparams cls.ctypes params in
|
|
|
- { cls with
|
|
|
- cfields = List.map (fun f -> { f with jf_signature = japply_params jparams f.jf_signature }) cls.cfields;
|
|
|
- cmethods = List.map (fun f -> { f with jf_signature = japply_params jparams f.jf_signature }) cls.cmethods;
|
|
|
- csuper = japply_params jparams cls.csuper;
|
|
|
- cinterfaces = List.map (japply_params jparams) cls.cinterfaces;
|
|
|
- }
|
|
|
- with Invalid_argument("List.map2") ->
|
|
|
- if com.verbose then prerr_endline ("Differing parameters for class: " ^ path_s cls.cpath);
|
|
|
- cls
|
|
|
+ match cls.ctypes with
|
|
|
+ | [] -> cls
|
|
|
+ | _ ->
|
|
|
+ let jparams = mk_jparams cls.ctypes params in
|
|
|
+ { cls with
|
|
|
+ cfields = List.map (fun f -> { f with jf_signature = japply_params jparams f.jf_signature }) cls.cfields;
|
|
|
+ cmethods = List.map (fun f -> { f with jf_signature = japply_params jparams f.jf_signature }) cls.cmethods;
|
|
|
+ csuper = japply_params jparams cls.csuper;
|
|
|
+ cinterfaces = List.map (japply_params jparams) cls.cinterfaces;
|
|
|
+ }
|
|
|
+ with Invalid_argument("List.map2") ->
|
|
|
+ if com.verbose then prerr_endline ("Differing parameters for class: " ^ path_s cls.cpath);
|
|
|
+ cls
|
|
|
|
|
|
let is_object = function | TObject( (["java";"lang"], "Object"), [] ) -> true | _ -> false
|
|
|
|
|
|
let is_tobject = function | TObject _ | TObjectInner _ -> true | _ -> false
|
|
|
|
|
|
let simplify_args args =
|
|
|
- if List.for_all (function | TAny -> true | _ -> false) args then [] else args
|
|
|
+ if List.for_all (function | TAny -> true | _ -> false) args then [] else args
|
|
|
|
|
|
let compare_type com s1 s2 =
|
|
|
- if s1 = s2 then
|
|
|
- 0
|
|
|
- else if not (is_tobject s1) then
|
|
|
- if is_tobject s2 then (* Dynamic *)
|
|
|
- 1
|
|
|
- else if compatible_signature_arg s1 s2 then
|
|
|
- 0
|
|
|
- else
|
|
|
- raise Exit
|
|
|
- else if not (is_tobject s2) then
|
|
|
- -1
|
|
|
- else begin
|
|
|
- let rec loop ?(first_error=true) s1 s2 : bool =
|
|
|
- if is_object s1 then
|
|
|
- s1 = s2
|
|
|
- else if compatible_signature_arg s1 s2 then begin
|
|
|
- let p1, p2 = match s1, s2 with
|
|
|
- | TObject(_, p1), TObject(_,p2) ->
|
|
|
- p1, p2
|
|
|
- | TObjectInner(_, npl1), TObjectInner(_, npl2) ->
|
|
|
- snd (List.hd (List.rev npl1)), snd (List.hd (List.rev npl2))
|
|
|
- | _ -> assert false (* not tobject *)
|
|
|
- in
|
|
|
- let p1, p2 = simplify_args p1, simplify_args p2 in
|
|
|
- let lp1 = List.length p1 in
|
|
|
- let lp2 = List.length p2 in
|
|
|
- if lp1 > lp2 then
|
|
|
- true
|
|
|
- else if lp2 > lp1 then
|
|
|
- false
|
|
|
- else begin
|
|
|
- (* if compatible tparams, it's fine *)
|
|
|
- if not (compatible_tparams p1 p2) then
|
|
|
- raise Exit; (* meaning: found, but incompatible type parameters *)
|
|
|
- true
|
|
|
- end
|
|
|
- end else try
|
|
|
- let c, p = jcl_from_jsig com s1 in
|
|
|
- let jparams = mk_jparams c.ctypes p in
|
|
|
- let super = japply_params jparams c.csuper in
|
|
|
- let implements = List.map (japply_params jparams) c.cinterfaces in
|
|
|
- loop ~first_error:first_error super s2 || List.exists (fun super -> loop ~first_error:first_error super s2) implements
|
|
|
- with | Not_found ->
|
|
|
- if com.verbose then begin
|
|
|
- prerr_endline ("-java-lib: The type " ^ (s_sig s1) ^ " is referred but was not found. Compilation may not occur correctly.");
|
|
|
- prerr_endline "Did you forget to include a needed lib?"
|
|
|
- end;
|
|
|
- if first_error then
|
|
|
- not (loop ~first_error:false s2 s1)
|
|
|
- else
|
|
|
- false
|
|
|
- in
|
|
|
- if loop s1 s2 then
|
|
|
- if loop s2 s1 then
|
|
|
- 0
|
|
|
- else
|
|
|
- 1
|
|
|
- else
|
|
|
- if loop s2 s1 then
|
|
|
- -1
|
|
|
- else
|
|
|
- -2
|
|
|
- end
|
|
|
+ if s1 = s2 then
|
|
|
+ 0
|
|
|
+ else if not (is_tobject s1) then
|
|
|
+ if is_tobject s2 then (* Dynamic *)
|
|
|
+ 1
|
|
|
+ else if compatible_signature_arg s1 s2 then
|
|
|
+ 0
|
|
|
+ else
|
|
|
+ raise Exit
|
|
|
+ else if not (is_tobject s2) then
|
|
|
+ -1
|
|
|
+ else begin
|
|
|
+ let rec loop ?(first_error=true) s1 s2 : bool =
|
|
|
+ if is_object s1 then
|
|
|
+ s1 = s2
|
|
|
+ else if compatible_signature_arg s1 s2 then begin
|
|
|
+ let p1, p2 = match s1, s2 with
|
|
|
+ | TObject(_, p1), TObject(_,p2) ->
|
|
|
+ p1, p2
|
|
|
+ | TObjectInner(_, npl1), TObjectInner(_, npl2) ->
|
|
|
+ snd (List.hd (List.rev npl1)), snd (List.hd (List.rev npl2))
|
|
|
+ | _ -> assert false (* not tobject *)
|
|
|
+ in
|
|
|
+ let p1, p2 = simplify_args p1, simplify_args p2 in
|
|
|
+ let lp1 = List.length p1 in
|
|
|
+ let lp2 = List.length p2 in
|
|
|
+ if lp1 > lp2 then
|
|
|
+ true
|
|
|
+ else if lp2 > lp1 then
|
|
|
+ false
|
|
|
+ else begin
|
|
|
+ (* if compatible tparams, it's fine *)
|
|
|
+ if not (compatible_tparams p1 p2) then
|
|
|
+ raise Exit; (* meaning: found, but incompatible type parameters *)
|
|
|
+ true
|
|
|
+ end
|
|
|
+ end else try
|
|
|
+ let c, p = jcl_from_jsig com s1 in
|
|
|
+ let jparams = mk_jparams c.ctypes p in
|
|
|
+ let super = japply_params jparams c.csuper in
|
|
|
+ let implements = List.map (japply_params jparams) c.cinterfaces in
|
|
|
+ loop ~first_error:first_error super s2 || List.exists (fun super -> loop ~first_error:first_error super s2) implements
|
|
|
+ with | Not_found ->
|
|
|
+ prerr_endline ("-java-lib: The type " ^ (s_sig s1) ^ " is referred but was not found. Compilation may not occur correctly.");
|
|
|
+ prerr_endline "Did you forget to include a needed lib?";
|
|
|
+ if first_error then
|
|
|
+ not (loop ~first_error:false s2 s1)
|
|
|
+ else
|
|
|
+ false
|
|
|
+ in
|
|
|
+ if loop s1 s2 then
|
|
|
+ if loop s2 s1 then
|
|
|
+ 0
|
|
|
+ else
|
|
|
+ 1
|
|
|
+ else
|
|
|
+ if loop s2 s1 then
|
|
|
+ -1
|
|
|
+ else
|
|
|
+ -2
|
|
|
+ end
|
|
|
|
|
|
(* given a list of same overload functions, choose the best (or none) *)
|
|
|
let select_best com flist =
|
|
|
- let rec loop cur_best = function
|
|
|
- | [] ->
|
|
|
- Some cur_best
|
|
|
- | f :: flist -> match get_adapted_sig f cur_best, cur_best.jf_signature with
|
|
|
- | TMethod(_,Some r), TMethod(_, Some r2) -> (try
|
|
|
- match compare_type com r r2 with
|
|
|
- | 0 -> (* same type - select any of them *)
|
|
|
- loop cur_best flist
|
|
|
- | 1 ->
|
|
|
- loop f flist
|
|
|
- | -1 ->
|
|
|
- loop cur_best flist
|
|
|
- | -2 -> (* error - no type is compatible *)
|
|
|
- if com.verbose then prerr_endline (f.jf_name ^ ": The types " ^ (s_sig r) ^ " and " ^ (s_sig r2) ^ " are incompatible");
|
|
|
- (* bet that the current best has "beaten" other types *)
|
|
|
- loop cur_best flist
|
|
|
- | _ -> assert false
|
|
|
- with | Exit -> (* incompatible type parameters *)
|
|
|
- (* error mode *)
|
|
|
- if com.verbose then prerr_endline (f.jf_name ^ ": Incompatible argument return signatures: " ^ (s_sig r) ^ " and " ^ (s_sig r2));
|
|
|
- None)
|
|
|
- | TMethod _, _ -> (* select the method *)
|
|
|
- loop f flist
|
|
|
- | _ ->
|
|
|
- loop cur_best flist
|
|
|
- in
|
|
|
- match loop (List.hd flist) (List.tl flist) with
|
|
|
- | Some f ->
|
|
|
- Some f
|
|
|
- | None -> match List.filter (fun f -> not (is_override f)) flist with
|
|
|
- (* error mode; take off all override methods *)
|
|
|
- | [] -> None
|
|
|
- | f :: [] -> Some f
|
|
|
- | f :: flist -> Some f (* pick one *)
|
|
|
+ let rec loop cur_best = function
|
|
|
+ | [] ->
|
|
|
+ Some cur_best
|
|
|
+ | f :: flist -> match get_adapted_sig f cur_best, cur_best.jf_signature with
|
|
|
+ | TMethod(_,Some r), TMethod(_, Some r2) -> (try
|
|
|
+ match compare_type com r r2 with
|
|
|
+ | 0 -> (* same type - select any of them *)
|
|
|
+ loop cur_best flist
|
|
|
+ | 1 ->
|
|
|
+ loop f flist
|
|
|
+ | -1 ->
|
|
|
+ loop cur_best flist
|
|
|
+ | -2 -> (* error - no type is compatible *)
|
|
|
+ if com.verbose then prerr_endline (f.jf_name ^ ": The types " ^ (s_sig r) ^ " and " ^ (s_sig r2) ^ " are incompatible");
|
|
|
+ (* bet that the current best has "beaten" other types *)
|
|
|
+ loop cur_best flist
|
|
|
+ | _ -> assert false
|
|
|
+ with | Exit -> (* incompatible type parameters *)
|
|
|
+ (* error mode *)
|
|
|
+ if com.verbose then prerr_endline (f.jf_name ^ ": Incompatible argument return signatures: " ^ (s_sig r) ^ " and " ^ (s_sig r2));
|
|
|
+ None)
|
|
|
+ | TMethod _, _ -> (* select the method *)
|
|
|
+ loop f flist
|
|
|
+ | _ ->
|
|
|
+ loop cur_best flist
|
|
|
+ in
|
|
|
+ match loop (List.hd flist) (List.tl flist) with
|
|
|
+ | Some f ->
|
|
|
+ Some f
|
|
|
+ | None -> match List.filter (fun f -> not (is_override f)) flist with
|
|
|
+ (* error mode; take off all override methods *)
|
|
|
+ | [] -> None
|
|
|
+ | f :: [] -> Some f
|
|
|
+ | f :: flist -> Some f (* pick one *)
|
|
|
+
|
|
|
+(**** begin normalize_jclass helpers ****)
|
|
|
+
|
|
|
+let fix_overrides_jclass com cls =
|
|
|
+ let force_check = Common.defined com Define.ForceLibCheck in
|
|
|
+ let methods = if force_check then List.map (fun f -> del_override f) cls.cmethods else cls.cmethods in
|
|
|
+ let cmethods = methods in
|
|
|
+ let super_fields = [] in
|
|
|
+ let super_methods = [] in
|
|
|
+ let nonstatics = List.filter (fun f -> not (List.mem JStatic f.jf_flags)) (cls.cfields @ cls.cmethods) in
|
|
|
+
|
|
|
+ let is_pub = fun f -> List.exists (function | JPublic | JProtected -> true | _ -> false) f.jf_flags in
|
|
|
+ let cmethods, super_fields = if not (List.mem JInterface cls.cflags) then
|
|
|
+ List.filter is_pub cmethods,
|
|
|
+ List.filter is_pub super_fields
|
|
|
+ else
|
|
|
+ cmethods,super_fields
|
|
|
+ in
|
|
|
+
|
|
|
+ let rec loop cls super_methods super_fields cmethods nonstatics = try
|
|
|
+ match cls.csuper with
|
|
|
+ | TObject((["java";"lang"],"Object"),_) ->
|
|
|
+ super_methods,super_fields,cmethods,nonstatics
|
|
|
+ | _ ->
|
|
|
+ let cls, params = jcl_from_jsig com cls.csuper in
|
|
|
+ let cls = jclass_with_params com cls params in
|
|
|
+ let nonstatics = (List.filter (fun f -> (List.mem JStatic f.jf_flags)) (cls.cfields @ cls.cmethods)) @ nonstatics in
|
|
|
+ let super_methods = cls.cmethods @ super_methods in
|
|
|
+ let super_fields = cls.cfields @ super_fields in
|
|
|
+ let cmethods = if force_check then begin
|
|
|
+ let overriden = ref [] in
|
|
|
+ let cmethods = List.map (fun jm ->
|
|
|
+ (* TODO rewrite/standardize empty spaces *)
|
|
|
+ if not (is_override jm) && not (List.mem JStatic jm.jf_flags) && List.exists (fun msup ->
|
|
|
+ let ret = msup.jf_name = jm.jf_name && not(List.mem JStatic msup.jf_flags) && compatible_methods msup jm in
|
|
|
+ if ret then begin
|
|
|
+ let f = mk_override msup in
|
|
|
+ overriden := { f with jf_flags = jm.jf_flags } :: !overriden
|
|
|
+ end;
|
|
|
+ ret
|
|
|
+ ) cls.cmethods then
|
|
|
+ mk_override jm
|
|
|
+ else
|
|
|
+ jm
|
|
|
+ ) cmethods in
|
|
|
+ !overriden @ cmethods
|
|
|
+ end else
|
|
|
+ cmethods
|
|
|
+ in
|
|
|
+ loop cls super_methods super_fields cmethods nonstatics
|
|
|
+ with | Not_found ->
|
|
|
+ super_methods,super_fields,cmethods,nonstatics
|
|
|
+ in
|
|
|
+ loop cls super_methods super_fields cmethods nonstatics
|
|
|
|
|
|
let normalize_jclass com cls =
|
|
|
- (* search static / non-static name clash *)
|
|
|
- let nonstatics = ref [] in
|
|
|
- List.iter (fun f ->
|
|
|
- if not(List.mem JStatic f.jf_flags) then nonstatics := f :: !nonstatics
|
|
|
- ) (cls.cfields @ cls.cmethods);
|
|
|
- (* we won't be able to deal correctly with field's type parameters *)
|
|
|
- (* since java sometimes overrides / implements crude (ie no type parameters) versions *)
|
|
|
- (* and interchanges between them *)
|
|
|
- (* let methods = List.map (fun f -> let f = del_override f in if f.jf_types <> [] then { f with jf_types = []; jf_signature = f.jf_vmsignature } else f ) cls.cmethods in *)
|
|
|
- (* let pth = path_s cls.cpath in *)
|
|
|
- let methods = List.map (fun f -> del_override f ) cls.cmethods in
|
|
|
- (* take off duplicate overload signature class fields from current class *)
|
|
|
- let cmethods = ref methods in
|
|
|
- let all_methods = ref methods in
|
|
|
- let all_fields = ref cls.cfields in
|
|
|
- let super_fields = ref [] in
|
|
|
- let super_methods = ref [] in
|
|
|
- (* fix overrides *)
|
|
|
- let rec loop cls = try
|
|
|
- match cls.csuper with
|
|
|
- | TObject((["java";"lang"],"Object"),_) -> ()
|
|
|
- | _ ->
|
|
|
- let cls, params = jcl_from_jsig com cls.csuper in
|
|
|
- let cls = jclass_with_params com cls params in
|
|
|
- List.iter (fun f -> if not (List.mem JStatic f.jf_flags) then nonstatics := f :: !nonstatics) (cls.cfields @ cls.cmethods);
|
|
|
- super_methods := cls.cmethods @ !super_methods;
|
|
|
- all_methods := cls.cmethods @ !all_methods;
|
|
|
- all_fields := cls.cfields @ !all_fields;
|
|
|
- super_fields := cls.cfields @ !super_fields;
|
|
|
- let overriden = ref [] in
|
|
|
- cmethods := List.map (fun jm ->
|
|
|
- (* TODO rewrite/standardize empty spaces *)
|
|
|
- if not (is_override jm) && not(List.mem JStatic jm.jf_flags) && List.exists (fun msup ->
|
|
|
- let ret = msup.jf_name = jm.jf_name && not(List.mem JStatic msup.jf_flags) && compatible_methods msup jm in
|
|
|
- if ret then begin
|
|
|
- let f = mk_override msup in
|
|
|
- overriden := { f with jf_flags = jm.jf_flags } :: !overriden
|
|
|
- end;
|
|
|
- ret
|
|
|
- ) cls.cmethods then
|
|
|
- mk_override jm
|
|
|
- else
|
|
|
- jm
|
|
|
- ) !cmethods;
|
|
|
- cmethods := !overriden @ !cmethods;
|
|
|
- loop cls
|
|
|
- with | Not_found -> ()
|
|
|
- in
|
|
|
- if not (List.mem JInterface cls.cflags) then begin
|
|
|
- cmethods := List.filter (fun f -> List.exists (function | JPublic | JProtected -> true | _ -> false) f.jf_flags) !cmethods;
|
|
|
- all_fields := List.filter (fun f -> List.exists (function | JPublic | JProtected -> true | _ -> false) f.jf_flags) !all_fields;
|
|
|
- super_fields := List.filter (fun f -> List.exists (function | JPublic | JProtected -> true | _ -> false) f.jf_flags) !super_fields;
|
|
|
- end;
|
|
|
- loop cls;
|
|
|
- (* look for interfaces and add missing implementations (may happen on abstracts or by vmsig differences *)
|
|
|
- let added_interface_fields = ref [] in
|
|
|
- let rec loop_interface abstract cls iface = try
|
|
|
- match iface with
|
|
|
- | TObject ((["java";"lang"],"Object"), _) -> ()
|
|
|
- | TObject (path,_) when path = cls.cpath -> ()
|
|
|
- | _ ->
|
|
|
- let cif, params = jcl_from_jsig com iface in
|
|
|
- let cif = jclass_with_params com cif params in
|
|
|
- List.iter (fun jf ->
|
|
|
- if not(List.mem JStatic jf.jf_flags) && not (List.exists (fun jf2 -> jf.jf_name = jf2.jf_name && not (List.mem JStatic jf2.jf_flags) && jf.jf_signature = jf2.jf_signature) !all_methods) then begin
|
|
|
- let jf = if abstract then del_override jf else jf in
|
|
|
- let jf = { jf with jf_flags = JPublic :: jf.jf_flags } in (* interfaces implementations are always public *)
|
|
|
-
|
|
|
- added_interface_fields := jf :: !added_interface_fields;
|
|
|
- cmethods := jf :: !cmethods;
|
|
|
- all_methods := jf :: !all_methods;
|
|
|
- nonstatics := jf :: !nonstatics;
|
|
|
- end
|
|
|
- ) cif.cmethods;
|
|
|
- List.iter (loop_interface abstract cif) cif.cinterfaces;
|
|
|
- with Not_found -> ()
|
|
|
- in
|
|
|
- (* another pass: *)
|
|
|
- (* if List.mem JAbstract cls.cflags then List.iter loop_interface cls.cinterfaces; *)
|
|
|
- (* if not (List.mem JInterface cls.cflags) then *)
|
|
|
- List.iter (loop_interface (List.mem JAbstract cls.cflags) cls) cls.cinterfaces;
|
|
|
- (* for each added field in the interface, lookup in super_methods possible methods to include *)
|
|
|
- (* so we can choose the better method still *)
|
|
|
-
|
|
|
- List.iter (fun im ->
|
|
|
- let f = List.find_all (fun jf -> jf.jf_name = im.jf_name && compatible_methods jf im) !super_methods in
|
|
|
- let f = List.map mk_override f in
|
|
|
- cmethods := f @ !cmethods
|
|
|
- ) !added_interface_fields;
|
|
|
- (* take off equals, hashCode and toString from interface *)
|
|
|
- if List.mem JInterface cls.cflags then cmethods := List.filter (fun jf -> match jf.jf_name, jf.jf_vmsignature with
|
|
|
- | "equals", TMethod([TObject( (["java";"lang"],"Object"), _)],_)
|
|
|
- | "hashCode", TMethod([], _)
|
|
|
- | "toString", TMethod([], _) -> false
|
|
|
- | _ -> true
|
|
|
- ) !cmethods;
|
|
|
- (* change field name to not collide with haxe keywords *)
|
|
|
- let map_field f =
|
|
|
- let change = match f.jf_name with
|
|
|
- | "callback" | "cast" | "extern" | "function" | "in" | "typedef" | "using" | "var" | "untyped" | "inline" -> true
|
|
|
- | _ when List.mem JStatic f.jf_flags && List.exists (fun f2 -> f.jf_name = f2.jf_name) !nonstatics -> true
|
|
|
- | _ -> false
|
|
|
- in
|
|
|
- if change then
|
|
|
- { f with jf_name = "%" ^ f.jf_name }
|
|
|
- else
|
|
|
- f
|
|
|
- in
|
|
|
- (* change static fields that have the same name as methods *)
|
|
|
- let cfields = List.map map_field cls.cfields in
|
|
|
- let cmethods = List.map map_field !cmethods in
|
|
|
- (* take off variable fields that have the same name as methods *)
|
|
|
- (* and take off variables that already have been declared *)
|
|
|
- let filter_field f f2 = f != f2 && (List.mem JStatic f.jf_flags = List.mem JStatic f2.jf_flags) && f.jf_name = f2.jf_name && f2.jf_kind <> f.jf_kind in
|
|
|
- let cfields = List.filter (fun f ->
|
|
|
- if List.mem JStatic f.jf_flags then
|
|
|
- not (List.exists (filter_field f) cmethods)
|
|
|
- else
|
|
|
- not (List.exists (filter_field f) !nonstatics) && not (List.exists (fun f2 -> f != f2 && f.jf_name = f2.jf_name && not (List.mem JStatic f2.jf_flags)) !all_fields) ) cfields
|
|
|
- in
|
|
|
- (* now filter any method that clashes with a field - on a superclass *)
|
|
|
- let cmethods = List.filter (fun f ->
|
|
|
- if List.mem JStatic f.jf_flags then
|
|
|
- true
|
|
|
- else
|
|
|
- not (List.exists (filter_field f) !super_fields) ) cmethods
|
|
|
- in
|
|
|
- (* removing duplicate fields. They are there because of return type covariance in Java *)
|
|
|
- (* Also, if a method overrides a previous definition, and changes a type parameters' variance, *)
|
|
|
- (* we will take it off *)
|
|
|
- (* this means that some rare codes will never compile on Haxe, but unless Haxe adds variance support *)
|
|
|
- (* I can't see how this can be any different *)
|
|
|
- let rec loop acc = function
|
|
|
- | [] -> acc
|
|
|
- | f :: cmeths ->
|
|
|
- match List.partition (fun f2 -> f.jf_name = f2.jf_name && compatible_methods f f2) cmeths with
|
|
|
- | [], cmeths ->
|
|
|
- loop (f :: acc) cmeths
|
|
|
- | flist, cmeths -> match select_best com (f :: flist) with
|
|
|
- | None ->
|
|
|
- loop acc cmeths
|
|
|
- | Some f ->
|
|
|
- loop (f :: acc) cmeths
|
|
|
- in
|
|
|
- (* last pass: take off all cfields that are internal / private (they won't be accessible anyway) *)
|
|
|
- let cfields = List.filter(fun f -> List.exists (fun f -> f = JPublic || f = JProtected) f.jf_flags) cfields in
|
|
|
- let cmethods = loop [] cmethods in
|
|
|
- { cls with cfields = cfields; cmethods = cmethods }
|
|
|
-
|
|
|
-let rec get_classes_dir pack dir ret =
|
|
|
- Array.iter (fun f -> match (Unix.stat (dir ^"/"^ f)).st_kind with
|
|
|
- | S_DIR ->
|
|
|
- get_classes_dir (pack @ [f]) (dir ^"/"^ f) ret
|
|
|
- | _ when (String.sub (String.uncapitalize f) (String.length f - 6) 6) = ".class" ->
|
|
|
- let path = jpath_to_hx (pack,f) in
|
|
|
- ret := path :: !ret;
|
|
|
- | _ -> ()
|
|
|
- ) (Sys.readdir dir)
|
|
|
+ (* after adding the noCheck metadata, this option will annotate what changes were needed *)
|
|
|
+ (* and that are now deprecated *)
|
|
|
+ let force_check = Common.defined com Define.ForceLibCheck in
|
|
|
+ (* fix overrides *)
|
|
|
+ let super_methods, super_fields, cmethods, nonstatics = fix_overrides_jclass com cls in
|
|
|
+ let all_methods = cmethods @ super_methods in
|
|
|
+
|
|
|
+ (* look for interfaces and add missing implementations (may happen on abstracts or by vmsig differences *)
|
|
|
+ (* (libType): even with libType enabled, we need to add these missing fields - otherwise we won't be able to use them from Haxe *)
|
|
|
+ let added_interface_fields = ref [] in
|
|
|
+ let rec loop_interface abstract cls iface = try
|
|
|
+ match iface with
|
|
|
+ | TObject ((["java";"lang"],"Object"), _) -> ()
|
|
|
+ | TObject (path,_) when path = cls.cpath -> ()
|
|
|
+ | _ ->
|
|
|
+ let cif, params = jcl_from_jsig com iface in
|
|
|
+ let cif = jclass_with_params com cif params in
|
|
|
+ List.iter (fun jf ->
|
|
|
+ if not(List.mem JStatic jf.jf_flags) && not (List.exists (fun jf2 -> jf.jf_name = jf2.jf_name && not (List.mem JStatic jf2.jf_flags) && jf.jf_signature = jf2.jf_signature) all_methods) then begin
|
|
|
+ let jf = if abstract && force_check then del_override jf else jf in
|
|
|
+ let jf = { jf with jf_flags = JPublic :: jf.jf_flags } in (* interfaces implementations are always public *)
|
|
|
+
|
|
|
+ added_interface_fields := jf :: !added_interface_fields;
|
|
|
+ end
|
|
|
+ ) cif.cmethods;
|
|
|
+ (* we don't need to loop again in the interface unless we are in an abstract class, since these interfaces are already normalized *)
|
|
|
+ if abstract then List.iter (loop_interface abstract cif) cif.cinterfaces;
|
|
|
+ with Not_found -> ()
|
|
|
+ in
|
|
|
+ List.iter (loop_interface (List.mem JAbstract cls.cflags) cls) cls.cinterfaces;
|
|
|
+ let nonstatics = !added_interface_fields @ nonstatics in
|
|
|
+ let cmethods = !added_interface_fields @ cmethods in
|
|
|
+
|
|
|
+ (* for each added field in the interface, lookup in super_methods possible methods to include *)
|
|
|
+ (* so we can choose the better method still *)
|
|
|
+ let cmethods = if not force_check then
|
|
|
+ cmethods
|
|
|
+ else
|
|
|
+ List.fold_left (fun cmethods im ->
|
|
|
+ (* see if any of the added_interface_fields need to be declared as override *)
|
|
|
+ let f = List.find_all (fun jf -> jf.jf_name = im.jf_name && compatible_methods jf im) super_methods in
|
|
|
+ let f = List.map mk_override f in
|
|
|
+ f @ cmethods
|
|
|
+ ) cmethods !added_interface_fields;
|
|
|
+ in
|
|
|
+
|
|
|
+ (* take off equals, hashCode and toString from interface *)
|
|
|
+ let cmethods = if List.mem JInterface cls.cflags then List.filter (fun jf -> match jf.jf_name, jf.jf_vmsignature with
|
|
|
+ | "equals", TMethod([TObject( (["java";"lang"],"Object"), _)],_)
|
|
|
+ | "hashCode", TMethod([], _)
|
|
|
+ | "toString", TMethod([], _) -> false
|
|
|
+ | _ -> true
|
|
|
+ ) cmethods
|
|
|
+ else
|
|
|
+ cmethods
|
|
|
+ in
|
|
|
+
|
|
|
+ (* change field name to not collide with haxe keywords and with static/non-static members *)
|
|
|
+ let fold_field acc f =
|
|
|
+ let change, both = match f.jf_name with
|
|
|
+ | _ when List.mem JStatic f.jf_flags && List.exists (fun f2 -> f.jf_name = f2.jf_name) nonstatics -> true, true
|
|
|
+ | _ -> is_haxe_keyword f.jf_name, false
|
|
|
+ in
|
|
|
+ let f2 = if change then
|
|
|
+ { f with jf_name = "%" ^ f.jf_name }
|
|
|
+ else
|
|
|
+ f
|
|
|
+ in
|
|
|
+ if both then f :: f2 :: acc else f2 :: acc
|
|
|
+ in
|
|
|
+
|
|
|
+ (* change static fields that have the same name as methods *)
|
|
|
+ let cfields = List.fold_left fold_field [] cls.cfields in
|
|
|
+ let cmethods = List.fold_left fold_field [] cmethods in
|
|
|
+ (* take off variable fields that have the same name as methods *)
|
|
|
+ (* and take off variables that already have been declared *)
|
|
|
+ let filter_field f f2 = f != f2 && (List.mem JStatic f.jf_flags = List.mem JStatic f2.jf_flags) && f.jf_name = f2.jf_name && f2.jf_kind <> f.jf_kind in
|
|
|
+ let cfields = List.filter (fun f ->
|
|
|
+ if List.mem JStatic f.jf_flags then
|
|
|
+ not (List.exists (filter_field f) cmethods)
|
|
|
+ else
|
|
|
+ not (List.exists (filter_field f) nonstatics) && not (List.exists (fun f2 -> f != f2 && f.jf_name = f2.jf_name && not (List.mem JStatic f2.jf_flags)) super_fields) ) cfields
|
|
|
+ in
|
|
|
+ (* now filter any method that clashes with a field - on a superclass *)
|
|
|
+ let cmethods = if force_check then List.filter (fun f ->
|
|
|
+ if List.mem JStatic f.jf_flags then
|
|
|
+ true
|
|
|
+ else
|
|
|
+ not (List.exists (filter_field f) super_fields) ) cmethods
|
|
|
+ else
|
|
|
+ cmethods
|
|
|
+ in
|
|
|
+ (* removing duplicate fields. They are there because of return type covariance in Java *)
|
|
|
+ (* Also, if a method overrides a previous definition, and changes a type parameters' variance, *)
|
|
|
+ (* we will take it off *)
|
|
|
+ (* this means that some rare codes will never compile on Haxe, but unless Haxe adds variance support *)
|
|
|
+ (* I can't see how this can be any different *)
|
|
|
+ let rec loop acc = function
|
|
|
+ | [] -> acc
|
|
|
+ | f :: cmeths ->
|
|
|
+ match List.partition (fun f2 -> f.jf_name = f2.jf_name && compatible_methods f f2) cmeths with
|
|
|
+ | [], cmeths ->
|
|
|
+ loop (f :: acc) cmeths
|
|
|
+ | flist, cmeths -> match select_best com (f :: flist) with
|
|
|
+ | None ->
|
|
|
+ loop acc cmeths
|
|
|
+ | Some f ->
|
|
|
+ loop (f :: acc) cmeths
|
|
|
+ in
|
|
|
+ (* last pass: take off all cfields that are internal / private (they won't be accessible anyway) *)
|
|
|
+ let cfields = List.filter(fun f -> List.exists (fun f -> f = JPublic || f = JProtected) f.jf_flags) cfields in
|
|
|
+ let cmethods = loop [] cmethods in
|
|
|
+ { cls with cfields = cfields; cmethods = cmethods }
|
|
|
+
|
|
|
+(**** end normalize_jclass helpers ****)
|
|
|
|
|
|
let get_classes_zip zip =
|
|
|
- let ret = ref [] in
|
|
|
- List.iter (function
|
|
|
- | { Zip.is_directory = false; Zip.filename = f } when (String.sub (String.uncapitalize f) (String.length f - 6) 6) = ".class" ->
|
|
|
- (match List.rev (String.nsplit f "/") with
|
|
|
- | clsname :: pack ->
|
|
|
- let path = jpath_to_hx (List.rev pack, clsname) in
|
|
|
- ret := path :: !ret
|
|
|
- | _ ->
|
|
|
- ret := ([], jname_to_hx f) :: !ret)
|
|
|
- | _ -> ()
|
|
|
- ) (Zip.entries zip);
|
|
|
- !ret
|
|
|
+ let ret = ref [] in
|
|
|
+ List.iter (function
|
|
|
+ | { Zip.is_directory = false; Zip.filename = f } when (String.sub (String.uncapitalize f) (String.length f - 6) 6) = ".class" && not (String.exists f "$") ->
|
|
|
+ (match List.rev (String.nsplit f "/") with
|
|
|
+ | clsname :: pack ->
|
|
|
+ if not (String.contains clsname '$') then begin
|
|
|
+ let path = jpath_to_hx (List.rev pack, String.sub clsname 0 (String.length clsname - 6)) in
|
|
|
+ ret := path :: !ret
|
|
|
+ end
|
|
|
+ | _ ->
|
|
|
+ ret := ([], jname_to_hx f) :: !ret)
|
|
|
+ | _ -> ()
|
|
|
+ ) (Zip.entries zip);
|
|
|
+ !ret
|
|
|
|
|
|
let add_java_lib com file std =
|
|
|
- let file = if Sys.file_exists file then
|
|
|
+ let file = if Sys.file_exists file then
|
|
|
file
|
|
|
else try Common.find_file com file with
|
|
|
- | Not_found -> try Common.find_file com (file ^ ".jar") with
|
|
|
- | Not_found ->
|
|
|
- failwith ("Java lib " ^ file ^ " not found")
|
|
|
- in
|
|
|
- let hxpack_to_jpack = Hashtbl.create 16 in
|
|
|
- let get_raw_class, close, list_all_files =
|
|
|
- (* check if it is a directory or jar file *)
|
|
|
- match (Unix.stat file).st_kind with
|
|
|
- | S_DIR -> (* open classes directly from directory *)
|
|
|
- let rec iter_files pack dir path = try
|
|
|
- let file = Unix.readdir dir in
|
|
|
- if String.ends_with file ".class" then
|
|
|
- let file = String.sub file 0 (String.length file - 6) in
|
|
|
- Hashtbl.add hxpack_to_jpack (jpath_to_hx(pack,file)) (pack,file)
|
|
|
- else if (Unix.stat file).st_kind = S_DIR then
|
|
|
- let path = path ^"/"^ file in
|
|
|
- let pack = pack @ [file] in
|
|
|
- iter_files (pack @ [file]) (Unix.opendir path) path
|
|
|
- with | End_of_file | Unix.Unix_error _ ->
|
|
|
- Unix.closedir dir
|
|
|
- in
|
|
|
- iter_files [] (Unix.opendir file) file;
|
|
|
-
|
|
|
- (fun (pack, name) ->
|
|
|
- (* let pack, name = hxpath_to_j (pack,name) in *)
|
|
|
- let real_path = file ^ "/" ^ (String.concat "/" pack) ^ "/" ^ (name ^ ".class") in
|
|
|
- try
|
|
|
- let data = Std.input_file ~bin:true real_path in
|
|
|
- Some(JReader.parse_class (IO.input_string data), real_path, real_path)
|
|
|
- with
|
|
|
- | _ -> None), (fun () -> ()), (fun () -> let ret = ref [] in get_classes_dir [] file ret; !ret)
|
|
|
- | _ -> (* open zip file *)
|
|
|
- let closed = ref false in
|
|
|
- let zip = ref (Zip.open_in file) in
|
|
|
- let check_open () =
|
|
|
- if !closed then begin
|
|
|
- prerr_endline ("JAR file " ^ file ^ " already closed"); (* if this happens, find when *)
|
|
|
- zip := Zip.open_in file;
|
|
|
- closed := false
|
|
|
- end
|
|
|
- in
|
|
|
- List.iter (function
|
|
|
- | { Zip.is_directory = false; Zip.filename = filename } when String.ends_with filename ".class" ->
|
|
|
- let pack = String.nsplit filename "/" in
|
|
|
- (match List.rev pack with
|
|
|
- | [] -> ()
|
|
|
- | name :: pack ->
|
|
|
- let name = String.sub name 0 (String.length name - 6) in
|
|
|
- let pack = List.rev pack in
|
|
|
- Hashtbl.add hxpack_to_jpack (jpath_to_hx (pack,name)) (pack,name))
|
|
|
- | _ -> ()
|
|
|
- ) (Zip.entries !zip);
|
|
|
- (fun (pack, name) ->
|
|
|
- (* let pack, name = hxpath_to_j (pack,name) in *)
|
|
|
- check_open();
|
|
|
- try
|
|
|
- let location = (String.concat "/" (pack @ [name]) ^ ".class") in
|
|
|
- let entry = Zip.find_entry !zip location in
|
|
|
- let data = Zip.read_entry !zip entry in
|
|
|
- Some(JReader.parse_class (IO.input_string data), file, file ^ "@" ^ location)
|
|
|
- with
|
|
|
- | Not_found ->
|
|
|
- None),
|
|
|
- (fun () -> if not !closed then begin closed := true; Zip.close_in !zip end),
|
|
|
- (fun () -> check_open(); get_classes_zip !zip)
|
|
|
- in
|
|
|
- let cached_types = Hashtbl.create 12 in
|
|
|
- let get_raw_class path =
|
|
|
- try
|
|
|
- Hashtbl.find cached_types path
|
|
|
- with | Not_found ->
|
|
|
- let pack, name = hxpath_to_j path in
|
|
|
- let try_file (pack,name) =
|
|
|
- match get_raw_class (pack,name) with
|
|
|
- | None ->
|
|
|
- Hashtbl.add cached_types path None;
|
|
|
- None
|
|
|
- | Some (i, p1, p2) ->
|
|
|
- Hashtbl.add cached_types path (Some(i,p1,p2)); (* type loop normalization *)
|
|
|
- let ret = Some (normalize_jclass com i, p1, p2) in
|
|
|
- Hashtbl.replace cached_types path ret;
|
|
|
- ret
|
|
|
- in
|
|
|
- let ret = try_file (pack,name) in
|
|
|
- if ret = None && Hashtbl.mem hxpack_to_jpack path then
|
|
|
- try_file (Hashtbl.find hxpack_to_jpack path)
|
|
|
- else
|
|
|
- ret
|
|
|
- in
|
|
|
- let rec build ctx path p types =
|
|
|
- try
|
|
|
- if List.mem path !types then
|
|
|
- None
|
|
|
- else begin
|
|
|
- types := path :: !types;
|
|
|
- match get_raw_class path, path with
|
|
|
- | None, ([], c) -> build ctx (["haxe";"root"], c) p types
|
|
|
- | None, _ -> None
|
|
|
- | Some (cls, real_path, pos_path), _ ->
|
|
|
- if com.verbose then print_endline ("Parsed Java class " ^ (path_s cls.cpath));
|
|
|
- let old_types = ctx.jtparams in
|
|
|
- ctx.jtparams <- cls.ctypes :: ctx.jtparams;
|
|
|
-
|
|
|
- let pos = { pfile = pos_path; pmin = 0; pmax = 0; } in
|
|
|
-
|
|
|
- let pack = match fst path with | ["haxe";"root"] -> [] | p -> p in
|
|
|
-
|
|
|
- let ppath = hxpath_to_j path in
|
|
|
- let inner = List.fold_left (fun acc (path,out,_,_) ->
|
|
|
- let path = jpath_to_hx path in
|
|
|
- (if out <> Some ppath then
|
|
|
- acc
|
|
|
- else match build ctx path p types with
|
|
|
- | Some(_,(_, classes)) ->
|
|
|
- classes @ acc
|
|
|
- | _ -> acc);
|
|
|
- ) [] cls.cinner_types in
|
|
|
-
|
|
|
- (* build anonymous classes also *
|
|
|
- let rec loop inner n =
|
|
|
- match build ctx (fst path, snd path ^ "$" ^ (string_of_int n)) p types with
|
|
|
- | Some(_,(_, classes)) ->
|
|
|
- loop (classes @ inner) (n + 1)
|
|
|
- | _ -> inner
|
|
|
- in
|
|
|
- let inner = loop inner 1 in*)
|
|
|
- (* add _Statics class *)
|
|
|
- let inner = try
|
|
|
- if not (List.mem JInterface cls.cflags) then raise Not_found;
|
|
|
- let smethods = List.filter (fun f -> List.mem JStatic f.jf_flags) cls.cmethods in
|
|
|
- let sfields = List.filter (fun f -> List.mem JStatic f.jf_flags) cls.cfields in
|
|
|
- if not (smethods <> [] || sfields <> []) then raise Not_found;
|
|
|
- let obj = TObject( (["java";"lang"],"Object"), []) in
|
|
|
- let ncls = convert_java_class ctx pos { cls with cmethods = smethods; cfields = sfields; cflags = []; csuper = obj; cinterfaces = []; cinner_types = []; ctypes = [] } in
|
|
|
- match ncls with
|
|
|
- | EClass c ->
|
|
|
- (EClass { c with d_name = c.d_name ^ "_Statics" }, pos) :: inner
|
|
|
- | _ -> assert false
|
|
|
- with | Not_found ->
|
|
|
- inner
|
|
|
- in
|
|
|
- let ret = Some ( real_path, (pack, (convert_java_class ctx pos cls, pos) :: inner) ) in
|
|
|
- ctx.jtparams <- old_types;
|
|
|
- ret
|
|
|
- end
|
|
|
- with
|
|
|
- | JReader.Error_message msg ->
|
|
|
- if com.verbose then prerr_endline ("Class reader failed: " ^ msg);
|
|
|
- None
|
|
|
- | e ->
|
|
|
- if com.verbose then begin
|
|
|
- (* prerr_endline (Printexc.get_backtrace ()); requires ocaml 3.11 *)
|
|
|
- prerr_endline (Printexc.to_string e)
|
|
|
- end;
|
|
|
- None
|
|
|
- in
|
|
|
- let build path p = build (create_ctx com) path p (ref [["java";"lang"], "String"]) in
|
|
|
- let cached_files = ref None in
|
|
|
- let list_all_files () = match !cached_files with
|
|
|
- | None ->
|
|
|
- let ret = list_all_files () in
|
|
|
- cached_files := Some ret;
|
|
|
- ret
|
|
|
- | Some r -> r
|
|
|
- in
|
|
|
-
|
|
|
- (* TODO: add_dependency m mdep *)
|
|
|
- com.load_extern_type <- com.load_extern_type @ [build];
|
|
|
- com.java_libs <- (file, std, close, list_all_files, get_raw_class) :: com.java_libs
|
|
|
+ | Not_found -> try Common.find_file com (file ^ ".jar") with
|
|
|
+ | Not_found ->
|
|
|
+ failwith ("Java lib " ^ file ^ " not found")
|
|
|
+ in
|
|
|
+ let hxpack_to_jpack = Hashtbl.create 16 in
|
|
|
+ let get_raw_class, close, list_all_files =
|
|
|
+ (* check if it is a directory or jar file *)
|
|
|
+ match (Unix.stat file).st_kind with
|
|
|
+ | S_DIR -> (* open classes directly from directory *)
|
|
|
+ let all = ref [] in
|
|
|
+ let rec iter_files pack dir path = try
|
|
|
+ let file = Unix.readdir dir in
|
|
|
+ let filepath = path ^ "/" ^ file in
|
|
|
+ (if String.ends_with file ".class" && not (String.exists file "$") then
|
|
|
+ let file = String.sub file 0 (String.length file - 6) in
|
|
|
+ let path = jpath_to_hx (pack,file) in
|
|
|
+ all := path :: !all;
|
|
|
+ Hashtbl.add hxpack_to_jpack path (pack,file)
|
|
|
+ else if (Unix.stat filepath).st_kind = S_DIR && file <> "." && file <> ".." then
|
|
|
+ let pack = pack @ [file] in
|
|
|
+ iter_files (pack) (Unix.opendir filepath) filepath);
|
|
|
+ iter_files pack dir path
|
|
|
+ with | End_of_file | Unix.Unix_error _ ->
|
|
|
+ Unix.closedir dir
|
|
|
+ in
|
|
|
+ iter_files [] (Unix.opendir file) file;
|
|
|
+ let all = !all in
|
|
|
+
|
|
|
+ (fun (pack, name) ->
|
|
|
+ let real_path = file ^ "/" ^ (String.concat "/" pack) ^ "/" ^ (name ^ ".class") in
|
|
|
+ try
|
|
|
+ let data = Std.input_file ~bin:true real_path in
|
|
|
+ Some(JReader.parse_class (IO.input_string data), real_path, real_path)
|
|
|
+ with
|
|
|
+ | _ -> None), (fun () -> ()), (fun () -> all)
|
|
|
+ | _ -> (* open zip file *)
|
|
|
+ let closed = ref false in
|
|
|
+ let zip = ref (Zip.open_in file) in
|
|
|
+ let check_open () =
|
|
|
+ if !closed then begin
|
|
|
+ prerr_endline ("JAR file " ^ file ^ " already closed"); (* if this happens, find when *)
|
|
|
+ zip := Zip.open_in file;
|
|
|
+ closed := false
|
|
|
+ end
|
|
|
+ in
|
|
|
+ List.iter (function
|
|
|
+ | { Zip.is_directory = false; Zip.filename = filename } when String.ends_with filename ".class" ->
|
|
|
+ let pack = String.nsplit filename "/" in
|
|
|
+ (match List.rev pack with
|
|
|
+ | [] -> ()
|
|
|
+ | name :: pack ->
|
|
|
+ let name = String.sub name 0 (String.length name - 6) in
|
|
|
+ let pack = List.rev pack in
|
|
|
+ Hashtbl.add hxpack_to_jpack (jpath_to_hx (pack,name)) (pack,name))
|
|
|
+ | _ -> ()
|
|
|
+ ) (Zip.entries !zip);
|
|
|
+ (fun (pack, name) ->
|
|
|
+ check_open();
|
|
|
+ try
|
|
|
+ let location = (String.concat "/" (pack @ [name]) ^ ".class") in
|
|
|
+ let entry = Zip.find_entry !zip location in
|
|
|
+ let data = Zip.read_entry !zip entry in
|
|
|
+ Some(JReader.parse_class (IO.input_string data), file, file ^ "@" ^ location)
|
|
|
+ with
|
|
|
+ | Not_found ->
|
|
|
+ None),
|
|
|
+ (fun () -> if not !closed then begin closed := true; Zip.close_in !zip end),
|
|
|
+ (fun () -> check_open(); get_classes_zip !zip)
|
|
|
+ in
|
|
|
+ let cached_types = Hashtbl.create 12 in
|
|
|
+ let get_raw_class path =
|
|
|
+ try
|
|
|
+ Hashtbl.find cached_types path
|
|
|
+ with | Not_found -> try
|
|
|
+ let pack, name = Hashtbl.find hxpack_to_jpack path in
|
|
|
+ let try_file (pack,name) =
|
|
|
+ match get_raw_class (pack,name) with
|
|
|
+ | None ->
|
|
|
+ Hashtbl.add cached_types path None;
|
|
|
+ None
|
|
|
+ | Some (i, p1, p2) ->
|
|
|
+ Hashtbl.add cached_types path (Some(i,p1,p2)); (* type loop normalization *)
|
|
|
+ let ret = Some (normalize_jclass com i, p1, p2) in
|
|
|
+ Hashtbl.replace cached_types path ret;
|
|
|
+ ret
|
|
|
+ in
|
|
|
+ try_file (pack,name)
|
|
|
+ with Not_found ->
|
|
|
+ None
|
|
|
+ in
|
|
|
+ let replace_canonical_name p pack name_original name_replace decl =
|
|
|
+ let mk_meta name = (Meta.JavaCanonical, [EConst (String (String.concat "." pack)), p; EConst(String name), p], p) in
|
|
|
+ let add_meta name metas =
|
|
|
+ if Meta.has Meta.JavaCanonical metas then
|
|
|
+ List.map (function
|
|
|
+ | (Meta.JavaCanonical,[EConst (String cpack), _; EConst(String cname), _],_) ->
|
|
|
+ let did_replace,name = String.replace cname name_original name_replace in
|
|
|
+ if not did_replace then print_endline (cname ^ " -> " ^ name_original ^ " -> " ^ name_replace);
|
|
|
+ mk_meta name
|
|
|
+ | m -> m
|
|
|
+ ) metas
|
|
|
+ else
|
|
|
+ mk_meta name :: metas
|
|
|
+ in
|
|
|
+ match decl with
|
|
|
+ | EClass c ->
|
|
|
+ EClass { c with d_meta = add_meta c.d_name c.d_meta }
|
|
|
+ | EEnum e ->
|
|
|
+ EEnum { e with d_meta = add_meta e.d_name e.d_meta }
|
|
|
+ | EAbstract a ->
|
|
|
+ EAbstract { a with d_meta = add_meta a.d_name a.d_meta }
|
|
|
+ | d -> d
|
|
|
+ in
|
|
|
+ let rec build ctx path p types =
|
|
|
+ try
|
|
|
+ if List.mem path !types then
|
|
|
+ None
|
|
|
+ else begin
|
|
|
+ let first = match !types with
|
|
|
+ | [ ["java";"lang"], "String" ] | [] -> true
|
|
|
+ | p :: _ ->
|
|
|
+ false
|
|
|
+ in
|
|
|
+ types := path :: !types;
|
|
|
+ match get_raw_class path, path with
|
|
|
+ | None, ([], c) -> build ctx (["haxe";"root"], c) p types
|
|
|
+ | None, _ -> None
|
|
|
+ | Some (cls, real_path, pos_path), _ ->
|
|
|
+ let is_disallowed_inner = first && String.exists (snd cls.cpath) "$" in
|
|
|
+ let is_disallowed_inner = if is_disallowed_inner then begin
|
|
|
+ let outer, inner = String.split (snd cls.cpath) "$" in
|
|
|
+ match get_raw_class (fst path, outer) with
|
|
|
+ | None -> false
|
|
|
+ | _ -> true
|
|
|
+ end else
|
|
|
+ false
|
|
|
+ in
|
|
|
+ if is_disallowed_inner then
|
|
|
+ None
|
|
|
+ else begin
|
|
|
+ if com.verbose then print_endline ("Parsed Java class " ^ (path_s cls.cpath));
|
|
|
+ let old_types = ctx.jtparams in
|
|
|
+ ctx.jtparams <- cls.ctypes :: ctx.jtparams;
|
|
|
+
|
|
|
+ let pos = { pfile = pos_path; pmin = 0; pmax = 0; } in
|
|
|
+
|
|
|
+ let pack = match fst path with | ["haxe";"root"] -> [] | p -> p in
|
|
|
+
|
|
|
+ let ppath = Hashtbl.find hxpack_to_jpack path in
|
|
|
+ let inner = List.fold_left (fun acc (path,out,_,_) ->
|
|
|
+ let path = jpath_to_hx path in
|
|
|
+ (if out <> Some ppath then
|
|
|
+ acc
|
|
|
+ else match build ctx path p types with
|
|
|
+ | Some(_,(_, classes)) ->
|
|
|
+ let base = snd ppath ^ "$" in
|
|
|
+ (List.map (fun (def,p) ->
|
|
|
+ replace_canonical_name p (fst ppath) base (snd ppath ^ ".") def, p) classes) @ acc
|
|
|
+ | _ -> acc);
|
|
|
+ ) [] cls.cinner_types in
|
|
|
+
|
|
|
+ (* add _Statics class *)
|
|
|
+ let inner = try
|
|
|
+ if not (List.mem JInterface cls.cflags) then raise Not_found;
|
|
|
+ let smethods = List.filter (fun f -> List.mem JStatic f.jf_flags) cls.cmethods in
|
|
|
+ let sfields = List.filter (fun f -> List.mem JStatic f.jf_flags) cls.cfields in
|
|
|
+ if not (smethods <> [] || sfields <> []) then raise Not_found;
|
|
|
+ let obj = TObject( (["java";"lang"],"Object"), []) in
|
|
|
+ let ncls = convert_java_class ctx pos { cls with cmethods = smethods; cfields = sfields; cflags = []; csuper = obj; cinterfaces = []; cinner_types = []; ctypes = [] } in
|
|
|
+ match ncls with
|
|
|
+ | EClass c :: imports ->
|
|
|
+ (EClass { c with d_name = c.d_name ^ "_Statics" }, pos) :: inner @ List.map (fun i -> i,pos) imports
|
|
|
+ | _ -> assert false
|
|
|
+ with | Not_found ->
|
|
|
+ inner
|
|
|
+ in
|
|
|
+ let inner_alias = ref SS.empty in
|
|
|
+ List.iter (fun x ->
|
|
|
+ match fst x with
|
|
|
+ | EClass c ->
|
|
|
+ inner_alias := SS.add c.d_name !inner_alias;
|
|
|
+ | _ -> ()
|
|
|
+ ) inner;
|
|
|
+ let alias_list = ref [] in
|
|
|
+ List.iter (fun x ->
|
|
|
+ match x with
|
|
|
+ | (EClass c, pos) -> begin
|
|
|
+ let parts = String.nsplit c.d_name "_24" in
|
|
|
+ match parts with
|
|
|
+ | _ :: _ ->
|
|
|
+ let alias_name = String.concat "_" parts in
|
|
|
+ if (not (SS.mem alias_name !inner_alias)) && (not (String.exists (snd path) "_24")) then begin
|
|
|
+ let alias_def = ETypedef {
|
|
|
+ d_name = alias_name;
|
|
|
+ d_doc = None;
|
|
|
+ d_params = c.d_params;
|
|
|
+ d_meta = [];
|
|
|
+ d_flags = [];
|
|
|
+ d_data = CTPath {
|
|
|
+ tpackage = pack;
|
|
|
+ tname = snd path;
|
|
|
+ tparams = List.map (fun tp ->
|
|
|
+ TPType (CTPath {
|
|
|
+ tpackage = [];
|
|
|
+ tname = tp.tp_name;
|
|
|
+ tparams = [];
|
|
|
+ tsub = None;
|
|
|
+ })
|
|
|
+ ) c.d_params;
|
|
|
+ tsub = Some(c.d_name);
|
|
|
+ };
|
|
|
+ } in
|
|
|
+ inner_alias := SS.add alias_name !inner_alias;
|
|
|
+ alias_list := (alias_def, pos) :: !alias_list;
|
|
|
+ end
|
|
|
+ | _ -> ()
|
|
|
+ end
|
|
|
+ | _ -> ()
|
|
|
+ ) inner;
|
|
|
+ let inner = List.concat [!alias_list ; inner] in
|
|
|
+ let classes = List.map (fun t -> t,pos) (convert_java_class ctx pos cls) in
|
|
|
+ let imports, defs = List.partition (function | (EImport(_),_) -> true | _ -> false) (classes @ inner) in
|
|
|
+ let ret = Some ( real_path, (pack, imports @ defs) ) in
|
|
|
+ ctx.jtparams <- old_types;
|
|
|
+ ret
|
|
|
+ end
|
|
|
+ end
|
|
|
+ with
|
|
|
+ | JReader.Error_message msg ->
|
|
|
+ prerr_endline ("Class reader failed: " ^ msg);
|
|
|
+ None
|
|
|
+ | e ->
|
|
|
+ if com.verbose then begin
|
|
|
+ (* prerr_endline (Printexc.get_backtrace ()); requires ocaml 3.11 *)
|
|
|
+ prerr_endline (Printexc.to_string e)
|
|
|
+ end;
|
|
|
+ None
|
|
|
+ in
|
|
|
+ let build path p = build (create_ctx com) path p (ref [["java";"lang"], "String"]) in
|
|
|
+ let cached_files = ref None in
|
|
|
+ let list_all_files () = match !cached_files with
|
|
|
+ | None ->
|
|
|
+ let ret = list_all_files () in
|
|
|
+ cached_files := Some ret;
|
|
|
+ ret
|
|
|
+ | Some r -> r
|
|
|
+ in
|
|
|
+
|
|
|
+ (* TODO: add_dependency m mdep *)
|
|
|
+ com.load_extern_type <- com.load_extern_type @ [build];
|
|
|
+ com.java_libs <- (file, std, close, list_all_files, get_raw_class) :: com.java_libs
|
Simon Krajewski