|
|
@@ -1,1279 +0,0 @@
|
|
|
-(*
|
|
|
- The Haxe Compiler
|
|
|
- Copyright (C) 2005-2019 Haxe Foundation
|
|
|
-
|
|
|
- This program is free software; you can redistribute it and/or
|
|
|
- modify it under the terms of the GNU General Public License
|
|
|
- as published by the Free Software Foundation; either version 2
|
|
|
- of the License, or (at your option) any later version.
|
|
|
-
|
|
|
- This program is distributed in the hope that it will be useful,
|
|
|
- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
- GNU General Public License for more details.
|
|
|
-
|
|
|
- You should have received a copy of the GNU General Public License
|
|
|
- along with this program; if not, write to the Free Software
|
|
|
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|
|
-*)
|
|
|
-open Unix
|
|
|
-open ExtString
|
|
|
-open NativeLibraries
|
|
|
-open Common
|
|
|
-open Globals
|
|
|
-open Ast
|
|
|
-open JData
|
|
|
-
|
|
|
-(** Java lib *)
|
|
|
-
|
|
|
-module SS = Set.Make(String)
|
|
|
-
|
|
|
-type java_lib_ctx = {
|
|
|
- jcom : Common.context;
|
|
|
- (* current tparams context *)
|
|
|
- mutable jtparams : jtypes list;
|
|
|
- is_std : bool;
|
|
|
-}
|
|
|
-
|
|
|
-exception ConversionError of located
|
|
|
-
|
|
|
-let error s p = raise (ConversionError (located s p))
|
|
|
-
|
|
|
-let is_haxe_keyword = function
|
|
|
- | "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
|
|
|
- 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
|
|
|
-
|
|
|
-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 real_java_path ctx (pack,name) =
|
|
|
- s_type_path (pack, name)
|
|
|
-
|
|
|
-let lookup_jclass com path =
|
|
|
- let path = jpath_to_hx path in
|
|
|
- List.fold_right (fun java_lib acc ->
|
|
|
- match acc with
|
|
|
- | None -> java_lib#lookup path
|
|
|
- | Some p -> Some p
|
|
|
- ) com.native_libs.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
|
|
|
- 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") [],null_pos)
|
|
|
- | TType (_, jsig) -> TPType (convert_signature ctx p jsig,null_pos)
|
|
|
-
|
|
|
-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 *)
|
|
|
- (* 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
|
|
|
- | _ -> die "" __LOC__ 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) -> die "" __LOC__
|
|
|
- | TArray (jsig, _) -> mk_type_path ctx (["java"], "NativeArray") [ TPType (convert_signature ctx p jsig,null_pos) ]
|
|
|
- | 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,SDoubleQuotes)), p)
|
|
|
- | ConstInt i -> Some (EConst (Int (Printf.sprintf "%ld" i, None)), p)
|
|
|
- | ConstFloat f | ConstDouble f -> Some (EConst (Float (Printf.sprintf "%E" f, None)), p)
|
|
|
- | _ -> None) None const
|
|
|
-
|
|
|
-let convert_constraints ctx p tl = match tl with
|
|
|
- | [] -> None
|
|
|
- | [t] -> Some (convert_signature ctx p t,null_pos)
|
|
|
- | tl -> Some (CTIntersection(List.map (fun t -> convert_signature ctx p t,null_pos) tl),null_pos)
|
|
|
-
|
|
|
-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
|
|
|
- {
|
|
|
- tp_name = jname_to_hx name,null_pos;
|
|
|
- tp_params = [];
|
|
|
- tp_constraints = convert_constraints ctx p constraints;
|
|
|
- tp_default = None;
|
|
|
- tp_meta = [];
|
|
|
- }
|
|
|
-
|
|
|
-let get_type_path ctx ct = match ct with | CTPath p -> p | _ -> die "" __LOC__
|
|
|
-
|
|
|
-let is_override field =
|
|
|
- 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) }
|
|
|
-
|
|
|
-let del_override field =
|
|
|
- { 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,SDoubleQuotes)), p; EConst (String (name,SDoubleQuotes)), p], p)
|
|
|
-
|
|
|
-let show_in_completion ctx jc =
|
|
|
- if not ctx.is_std then true
|
|
|
- else match fst jc.cpath with
|
|
|
- | ("java" | "javax" | "org") :: _ -> true
|
|
|
- | _ -> false
|
|
|
-
|
|
|
-(**
|
|
|
- `haxe.Rest<T>` auto-boxes primitive types.
|
|
|
- That means we can't use it as varargs for extern methods.
|
|
|
- E.g externs with `int` varargs are represented as `int[]` at run time
|
|
|
- while `haxe.Rest<Int>` is actually `java.lang.Integer[]`.
|
|
|
-*)
|
|
|
-let is_eligible_for_haxe_rest_args arg_type =
|
|
|
- match arg_type with
|
|
|
- | TByte | TChar | TDouble | TFloat | TInt | TLong | TShort | TBool -> false
|
|
|
- | _ -> true
|
|
|
-
|
|
|
-let convert_java_enum ctx p pe =
|
|
|
- let meta = ref (get_canonical ctx p (fst pe.cpath) (snd pe.cpath) :: [Meta.Native, [EConst (String (real_java_path ctx pe.cpath,SDoubleQuotes) ), 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,null_pos; ec_doc = None; ec_meta = []; ec_args = []; ec_pos = p; ec_params = []; ec_type = None; } :: !data;
|
|
|
- | _ -> ()
|
|
|
- ) pe.cfields;
|
|
|
-
|
|
|
- if not (show_in_completion ctx pe) then meta := (Meta.NoCompletion,[],null_pos) :: !meta;
|
|
|
-
|
|
|
- EEnum {
|
|
|
- d_name = jname_to_hx (snd pe.cpath),null_pos;
|
|
|
- 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 is_interface 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
|
|
|
- let is_varargs = ref false in
|
|
|
-
|
|
|
- List.iter (function
|
|
|
- | JPublic -> cff_access := (APublic,null_pos) :: !cff_access
|
|
|
- | JPrivate -> raise Exit (* private instances aren't useful on externs *)
|
|
|
- | JProtected ->
|
|
|
- cff_meta := (Meta.Protected, [], p) :: !cff_meta;
|
|
|
- cff_access := (APrivate,null_pos) :: !cff_access
|
|
|
- | JStatic -> cff_access := (AStatic,null_pos) :: !cff_access
|
|
|
- | JFinal ->
|
|
|
- cff_access := (AFinal, p) :: !cff_access;
|
|
|
- (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 -> is_varargs := true
|
|
|
- | JAbstract when not is_interface ->
|
|
|
- cff_access := (AAbstract, p) :: !cff_access
|
|
|
- | _ -> ()
|
|
|
- ) 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,null_pos) :: !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 (s_type_path (path.tpackage,path.tname),SDoubleQuotes)), p],p) :: !cff_meta
|
|
|
- | _ -> ()
|
|
|
- ) field.jf_throws;
|
|
|
-
|
|
|
- let extract_local_names () =
|
|
|
- let default i =
|
|
|
- "param" ^ string_of_int i
|
|
|
- in
|
|
|
- match field.jf_code with
|
|
|
- | None ->
|
|
|
- default
|
|
|
- | Some attribs -> try
|
|
|
- let rec loop attribs = match attribs with
|
|
|
- | AttrLocalVariableTable locals :: _ ->
|
|
|
- locals
|
|
|
- | _ :: attribs ->
|
|
|
- loop attribs
|
|
|
- | [] ->
|
|
|
- raise Not_found
|
|
|
- in
|
|
|
- let locals = loop attribs in
|
|
|
- let h = Hashtbl.create 0 in
|
|
|
- List.iter (fun local ->
|
|
|
- Hashtbl.replace h local.ld_index local.ld_name
|
|
|
- ) locals;
|
|
|
- (fun i ->
|
|
|
- try Hashtbl.find h (i - 1) (* they are 1-based *)
|
|
|
- with Not_found -> "param" ^ string_of_int i
|
|
|
- )
|
|
|
- with Not_found ->
|
|
|
- default
|
|
|
- in
|
|
|
- let kind = match field.jf_kind with
|
|
|
- | JKField when !readonly ->
|
|
|
- FProp (("default",null_pos), ("null",null_pos), Some (convert_signature ctx p field.jf_signature,null_pos), None)
|
|
|
- | JKField ->
|
|
|
- FVar (Some (convert_signature ctx p field.jf_signature,null_pos), None)
|
|
|
- | JKMethod ->
|
|
|
- match field.jf_signature with
|
|
|
- | TMethod (args, ret) ->
|
|
|
- let local_names = extract_local_names() in
|
|
|
- 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_count = List.length args in
|
|
|
- let args = List.map (fun s ->
|
|
|
- incr i;
|
|
|
- let hx_sig =
|
|
|
- match s with
|
|
|
- | TArray (s1,_) when !is_varargs && !i = args_count && is_eligible_for_haxe_rest_args s1 ->
|
|
|
- mk_type_path ctx (["haxe"], "Rest") [TPType (convert_signature ctx p s1,null_pos)]
|
|
|
- | _ ->
|
|
|
- convert_signature ctx null_pos s
|
|
|
- in
|
|
|
- (local_names !i,null_pos), false, [], Some(hx_sig,null_pos), None
|
|
|
- ) args in
|
|
|
- let t = Option.map_default (convert_signature ctx p) (mk_type_path ctx ([], "Void") []) ret in
|
|
|
- cff_access := (AOverload,p) :: !cff_access;
|
|
|
- let types = List.map (function
|
|
|
- | (name, Some ext, impl) ->
|
|
|
- {
|
|
|
- tp_name = name,null_pos;
|
|
|
- tp_params = [];
|
|
|
- tp_constraints = convert_constraints ctx p (ext :: impl);
|
|
|
- tp_default = None;
|
|
|
- tp_meta = [];
|
|
|
- }
|
|
|
- | (name, None, impl) ->
|
|
|
- {
|
|
|
- tp_name = name,null_pos;
|
|
|
- tp_params = [];
|
|
|
- tp_constraints = convert_constraints ctx p impl;
|
|
|
- tp_default = None;
|
|
|
- tp_meta = [];
|
|
|
- }
|
|
|
- ) field.jf_types in
|
|
|
- ctx.jtparams <- old_types;
|
|
|
-
|
|
|
- FFun ({
|
|
|
- f_params = types;
|
|
|
- f_args = args;
|
|
|
- f_type = Some (t,null_pos);
|
|
|
- f_expr = None
|
|
|
- })
|
|
|
- | _ -> error "Method signature was expected" p
|
|
|
- in
|
|
|
- if field.jf_code <> None && is_interface then cff_meta := (Meta.JavaDefault,[],cff_pos) :: !cff_meta;
|
|
|
- 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",SDoubleQuotes)
|
|
|
- ),p], p) :: !cff_meta;
|
|
|
- "_" ^ name,
|
|
|
- (Meta.Native, [EConst (String (name,SDoubleQuotes) ), 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,SDoubleQuotes) ), cff_pos], cff_pos) :: !cff_meta
|
|
|
- in
|
|
|
- if Common.raw_defined ctx.jcom "java_loader_debug" then
|
|
|
- Printf.printf "\t%s%sfield %s : %s\n" (if List.mem_assoc AStatic !cff_access then "static " else "") (if List.mem_assoc AOverride !cff_access then "override " else "") cff_name (s_sig field.jf_signature);
|
|
|
-
|
|
|
- {
|
|
|
- cff_name = cff_name,null_pos;
|
|
|
- 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 Common.raw_defined ctx.jcom "java_loader_debug" 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,SDoubleQuotes) ), 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
|
|
|
- let is_abstract = ref false in
|
|
|
- List.iter (fun f -> match f with
|
|
|
- | JFinal -> flags := HFinal :: !flags
|
|
|
- | JInterface ->
|
|
|
- is_interface := true;
|
|
|
- flags := HInterface :: !flags
|
|
|
- | JAbstract ->
|
|
|
- meta := (Meta.Abstract, [], p) :: !meta;
|
|
|
- is_abstract := true;
|
|
|
- | JAnnotation -> meta := (Meta.Annotation, [], p) :: !meta
|
|
|
- | _ -> ()
|
|
|
- ) jc.cflags;
|
|
|
-
|
|
|
- if !is_abstract && not !is_interface then flags := HAbstract :: !flags;
|
|
|
- (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),null_pos) :: !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),null_pos) :: !flags
|
|
|
- else
|
|
|
- HImplements (get_type_path ctx (convert_signature ctx p i),null_pos) :: !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 !is_interface 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 )
|
|
|
- | _ -> die "" __LOC__
|
|
|
- ) f.jf_throws
|
|
|
- ) jc.cmethods) in
|
|
|
-
|
|
|
- if not (show_in_completion ctx jc) then meta := (Meta.NoCompletion,[],null_pos) :: !meta;
|
|
|
-
|
|
|
- (EClass {
|
|
|
- d_name = jname_to_hx (snd jc.cpath),null_pos;
|
|
|
- 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 is_std =
|
|
|
- {
|
|
|
- jcom = com;
|
|
|
- jtparams = [];
|
|
|
- is_std = is_std;
|
|
|
- }
|
|
|
-
|
|
|
- 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
|
|
|
-
|
|
|
-
|
|
|
-and japply_params_tp jparams jtype_argument = match jtype_argument with
|
|
|
- | 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
|
|
|
-
|
|
|
-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 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
|
|
|
-
|
|
|
-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 _ -> 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
|
|
|
-
|
|
|
-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
|
|
|
-
|
|
|
-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 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 _ ->
|
|
|
- if com.verbose then print_endline ("Differing parameters for class: " ^ s_type_path 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
|
|
|
-
|
|
|
-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))
|
|
|
- | _ -> die "" __LOC__ (* 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 ->
|
|
|
- print_endline ("--java-lib: The type " ^ (s_sig s1) ^ " is referred but was not found. Compilation may not occur correctly.");
|
|
|
- print_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 print_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
|
|
|
- | _ -> die "" __LOC__
|
|
|
- with | Exit -> (* incompatible type parameters *)
|
|
|
- (* error mode *)
|
|
|
- if com.verbose then print_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 overridden = 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
|
|
|
- overridden := { f with jf_flags = jm.jf_flags } :: !overridden
|
|
|
- end;
|
|
|
- ret
|
|
|
- ) cls.cmethods then
|
|
|
- mk_override jm
|
|
|
- else
|
|
|
- jm
|
|
|
- ) cmethods in
|
|
|
- !overridden @ 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 =
|
|
|
- (* 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 = if not (List.mem JPublic jf.jf_flags) then { jf with jf_flags = JPublic :: jf.jf_flags } else jf 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" && 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
|
|
|
-
|
|
|
-class virtual java_library com name file_path = object(self)
|
|
|
- inherit [java_lib_type,unit] native_library name file_path as super
|
|
|
-
|
|
|
- val hxpack_to_jpack = Hashtbl.create 16
|
|
|
-
|
|
|
- method convert_path (path : path) : path =
|
|
|
- Hashtbl.find hxpack_to_jpack path
|
|
|
-
|
|
|
- method private replace_canonical_name p pack name_original name_replace decl =
|
|
|
- let mk_meta name = (Meta.JavaCanonical, [EConst (String (String.concat "." pack,SDoubleQuotes)), p; EConst(String (name,SDoubleQuotes)), 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 (fst c.d_name) c.d_meta }
|
|
|
- | EEnum e ->
|
|
|
- EEnum { e with d_meta = add_meta (fst e.d_name) e.d_meta }
|
|
|
- | EAbstract a ->
|
|
|
- EAbstract { a with d_meta = add_meta (fst a.d_name) a.d_meta }
|
|
|
- | d -> d
|
|
|
-
|
|
|
- method build path (p : pos) : Ast.package option =
|
|
|
- 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 self#lookup 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 self#lookup (fst path, outer) with
|
|
|
- | None -> false
|
|
|
- | _ -> true
|
|
|
- end else
|
|
|
- false
|
|
|
- in
|
|
|
- if is_disallowed_inner then
|
|
|
- None
|
|
|
- else begin
|
|
|
- if ctx.jcom.verbose then print_endline ("Parsed Java class " ^ (s_type_path 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 = self#convert_path 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) ->
|
|
|
- self#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 = (fst c.d_name ^ "_Statics"),snd c.d_name }, pos) :: inner @ List.map (fun i -> i,pos) imports
|
|
|
- | _ -> die "" __LOC__
|
|
|
- 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 (fst 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 (fst 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,null_pos;
|
|
|
- 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 = fst tp.tp_name;
|
|
|
- tparams = [];
|
|
|
- tsub = None;
|
|
|
- },null_pos)
|
|
|
- ) c.d_params;
|
|
|
- tsub = Some(fst c.d_name);
|
|
|
- },null_pos;
|
|
|
- } 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 (pack, imports @ defs) in
|
|
|
- ctx.jtparams <- old_types;
|
|
|
- ret
|
|
|
- end
|
|
|
- end
|
|
|
- with
|
|
|
- | JReader.Error_message msg ->
|
|
|
- print_endline ("Class reader failed: " ^ msg);
|
|
|
- None
|
|
|
- | e ->
|
|
|
- if ctx.jcom.verbose then begin
|
|
|
- (* print_endline (Printexc.get_backtrace ()); requires ocaml 3.11 *)
|
|
|
- print_endline (Printexc.to_string e)
|
|
|
- end;
|
|
|
- None
|
|
|
- in
|
|
|
- build (create_ctx com (self#has_flag FlagIsStd)) path p (ref [["java";"lang"], "String"])
|
|
|
-
|
|
|
- method get_data = ()
|
|
|
-end
|
|
|
-
|
|
|
-class java_library_jar com name file_path = object(self)
|
|
|
- inherit java_library com name file_path
|
|
|
-
|
|
|
- val zip = lazy (Zip.open_in file_path)
|
|
|
- val mutable cached_files = None
|
|
|
- val cached_types = Hashtbl.create 12
|
|
|
- val mutable loaded = false
|
|
|
- val mutable closed = false
|
|
|
-
|
|
|
- method load =
|
|
|
- if not loaded then begin
|
|
|
- loaded <- true;
|
|
|
- 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 (Lazy.force zip))
|
|
|
- end
|
|
|
-
|
|
|
- method private lookup' ((pack,name) : path) : java_lib_type =
|
|
|
- try
|
|
|
- let zip = Lazy.force zip in
|
|
|
- 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_path, file_path ^ "@" ^ location)
|
|
|
- with
|
|
|
- | Not_found ->
|
|
|
- None
|
|
|
-
|
|
|
- method lookup (path : path) : java_lib_type =
|
|
|
- try
|
|
|
- Hashtbl.find cached_types path
|
|
|
- with | Not_found -> try
|
|
|
- self#load;
|
|
|
- let pack, name = self#convert_path path in
|
|
|
- let try_file (pack,name) =
|
|
|
- match self#lookup' (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
|
|
|
-
|
|
|
- method close =
|
|
|
- if not closed then begin
|
|
|
- closed <- true;
|
|
|
- Zip.close_in (Lazy.force zip)
|
|
|
- end
|
|
|
-
|
|
|
- method private list_modules' : path list =
|
|
|
- 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 (Lazy.force zip));
|
|
|
- !ret
|
|
|
-
|
|
|
- method list_modules : path list = match cached_files with
|
|
|
- | None ->
|
|
|
- let ret = self#list_modules' in
|
|
|
- cached_files <- Some ret;
|
|
|
- ret
|
|
|
- | Some r ->
|
|
|
- r
|
|
|
-end
|
|
|
-
|
|
|
-class java_library_dir com name file_path = object(self)
|
|
|
- inherit java_library com name file_path
|
|
|
-
|
|
|
- val mutable files = []
|
|
|
-
|
|
|
- method load =
|
|
|
- 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" then
|
|
|
- let name = String.sub file 0 (String.length file - 6) in
|
|
|
- let path = jpath_to_hx (pack,name) in
|
|
|
- if not (String.exists file "$") then all := path :: !all;
|
|
|
- Hashtbl.add hxpack_to_jpack path (pack,name)
|
|
|
- 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_path) file_path;
|
|
|
- files <- !all
|
|
|
-
|
|
|
- method close =
|
|
|
- ()
|
|
|
-
|
|
|
- method list_modules =
|
|
|
- files
|
|
|
-
|
|
|
- method lookup (pack,name) : java_lib_type =
|
|
|
- let real_path = file_path ^ "/" ^ (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
|
|
|
-end
|
|
|
-
|
|
|
-let add_java_lib com name std extern modern =
|
|
|
- let file = if Sys.file_exists name then
|
|
|
- name
|
|
|
- else try Common.find_file com name with
|
|
|
- | Not_found -> try Common.find_file com (name ^ ".jar") with
|
|
|
- | Not_found ->
|
|
|
- failwith ("Java lib " ^ name ^ " not found")
|
|
|
- in
|
|
|
- let java_lib =
|
|
|
- if modern then
|
|
|
- (new JavaModern.java_library_modern com name file :> (java_lib_type,unit) native_library)
|
|
|
- else match (Unix.stat file).st_kind with
|
|
|
- | S_DIR ->
|
|
|
- (new java_library_dir com name file :> (java_lib_type,unit) native_library)
|
|
|
- | _ ->
|
|
|
- (new java_library_jar com name file :> (java_lib_type,unit) native_library)
|
|
|
- in
|
|
|
- if std then java_lib#add_flag FlagIsStd;
|
|
|
- if extern then java_lib#add_flag FlagIsExtern;
|
|
|
- com.native_libs.java_libs <- (java_lib :> (java_lib_type,unit) native_library) :: com.native_libs.java_libs;
|
|
|
- CommonCache.handle_native_lib com java_lib
|
|
|
-
|
|
|
-let before_generate con =
|
|
|
- let java_ver = try
|
|
|
- int_of_string (Common.defined_value con Define.JavaVer)
|
|
|
- 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
|
Simon Krajewski