java.ml 46 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276
  1. (*
  2. The Haxe Compiler
  3. Copyright (C) 2005-2019 Haxe Foundation
  4. This program is free software; you can redistribute it and/or
  5. modify it under the terms of the GNU General Public License
  6. as published by the Free Software Foundation; either version 2
  7. of the License, or (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  15. *)
  16. open Unix
  17. open ExtString
  18. open NativeLibraries
  19. open Common
  20. open Globals
  21. open Ast
  22. open JData
  23. (** Java lib *)
  24. module SS = Set.Make(String)
  25. type java_lib_ctx = {
  26. jcom : Common.context;
  27. (* current tparams context *)
  28. mutable jtparams : jtypes list;
  29. is_std : bool;
  30. }
  31. exception ConversionError of string * pos
  32. let error s p = raise (ConversionError (s, p))
  33. let is_haxe_keyword = function
  34. | "cast" | "extern" | "function" | "in" | "typedef" | "using" | "var" | "untyped" | "inline" -> true
  35. | _ -> false
  36. let jname_to_hx name =
  37. let name =
  38. if name <> "" && (String.get name 0 < 'A' || String.get name 0 > 'Z') then
  39. Char.escaped (Char.uppercase (String.get name 0)) ^ String.sub name 1 (String.length name - 1)
  40. else
  41. name
  42. in
  43. let name = String.concat "__" (String.nsplit name "_") in
  44. String.map (function | '$' -> '_' | c -> c) name
  45. let normalize_pack pack =
  46. List.map (function
  47. | "" -> ""
  48. | str when String.get str 0 >= 'A' && String.get str 0 <= 'Z' ->
  49. String.lowercase str
  50. | str -> str
  51. ) pack
  52. let jpath_to_hx (pack,name) = match pack, name with
  53. | ["haxe";"root"], name -> [], name
  54. | "com" :: ("oracle" | "sun") :: _, _
  55. | "javax" :: _, _
  56. | "org" :: ("ietf" | "jcp" | "omg" | "w3c" | "xml") :: _, _
  57. | "sun" :: _, _
  58. | "sunw" :: _, _ -> "java" :: normalize_pack pack, jname_to_hx name
  59. | pack, name -> normalize_pack pack, jname_to_hx name
  60. let real_java_path ctx (pack,name) =
  61. s_type_path (pack, name)
  62. let lookup_jclass com path =
  63. let path = jpath_to_hx path in
  64. List.fold_right (fun java_lib acc ->
  65. match acc with
  66. | None -> java_lib#lookup path
  67. | Some p -> Some p
  68. ) com.native_libs.java_libs None
  69. let mk_type_path ctx path params =
  70. let name, sub = try
  71. let p, _ = String.split (snd path) "$" in
  72. jname_to_hx p, Some (jname_to_hx (snd path))
  73. with | Invalid_string ->
  74. jname_to_hx (snd path), None
  75. in
  76. let pack = fst (jpath_to_hx path) in
  77. let pack, sub, name = match path with
  78. | [], ("Float" as c)
  79. | [], ("Int" as c)
  80. | [], ("Single" as c)
  81. | [], ("Bool" as c)
  82. | [], ("Dynamic" as c)
  83. | [], ("Iterator" as c)
  84. | [], ("ArrayAccess" as c)
  85. | [], ("Iterable" as c) ->
  86. [], Some c, "StdTypes"
  87. | [], ("String" as c) ->
  88. ["std"], None, c
  89. | _ ->
  90. pack, sub, name
  91. in
  92. CTPath {
  93. tpackage = pack;
  94. tname = name;
  95. tparams = params;
  96. tsub = sub;
  97. }
  98. let has_tparam name params = List.exists(fun (n,_,_) -> n = name) params
  99. let rec convert_arg ctx p arg =
  100. match arg with
  101. | TAny | TType (WSuper, _) -> TPType (mk_type_path ctx ([], "Dynamic") [],null_pos)
  102. | TType (_, jsig) -> TPType (convert_signature ctx p jsig,null_pos)
  103. and convert_signature ctx p jsig =
  104. match jsig with
  105. | TByte -> mk_type_path ctx (["java"; "types"], "Int8") []
  106. | TChar -> mk_type_path ctx (["java"; "types"], "Char16") []
  107. | TDouble -> mk_type_path ctx ([], "Float") []
  108. | TFloat -> mk_type_path ctx ([], "Single") []
  109. | TInt -> mk_type_path ctx ([], "Int") []
  110. | TLong -> mk_type_path ctx (["haxe"], "Int64") []
  111. | TShort -> mk_type_path ctx (["java"; "types"], "Int16") []
  112. | TBool -> mk_type_path ctx ([], "Bool") []
  113. | TObject ( (["haxe";"root"], name), args ) -> mk_type_path ctx ([], name) (List.map (convert_arg ctx p) args)
  114. (** nullable types *)
  115. (* replaced from Null<Type> to the actual abstract type to fix #2738 *)
  116. (* | TObject ( (["java";"lang"], "Integer"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Int") []) ] *)
  117. (* | TObject ( (["java";"lang"], "Double"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Float") []) ] *)
  118. (* | TObject ( (["java";"lang"], "Float"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Single") []) ] *)
  119. (* | TObject ( (["java";"lang"], "Boolean"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Bool") []) ] *)
  120. (* | TObject ( (["java";"lang"], "Byte"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["java";"types"], "Int8") []) ] *)
  121. (* | TObject ( (["java";"lang"], "Character"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["java";"types"], "Char16") []) ] *)
  122. (* | TObject ( (["java";"lang"], "Short"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["java";"types"], "Int16") []) ] *)
  123. (* | TObject ( (["java";"lang"], "Long"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["haxe"], "Int64") []) ] *)
  124. (** other std types *)
  125. | TObject ( (["java";"lang"], "Object"), [] ) -> mk_type_path ctx ([], "Dynamic") []
  126. | TObject ( (["java";"lang"], "String"), [] ) -> mk_type_path ctx ([], "String") []
  127. | TObject ( (["java";"lang"], "Enum"), [_] ) -> mk_type_path ctx ([], "EnumValue") []
  128. (** other types *)
  129. | TObject ( path, [] ) ->
  130. (match lookup_jclass ctx.jcom path with
  131. | Some (jcl, _, _) -> mk_type_path ctx path (List.map (fun _ -> convert_arg ctx p TAny) jcl.ctypes)
  132. | None -> mk_type_path ctx path [])
  133. | TObject ( path, args ) -> mk_type_path ctx path (List.map (convert_arg ctx p) args)
  134. | TObjectInner (pack, (name, params) :: inners) ->
  135. let actual_param = match List.rev inners with
  136. | (_, p) :: _ -> p
  137. | _ -> die "" __LOC__ in
  138. mk_type_path ctx (pack, name ^ "$" ^ String.concat "$" (List.map fst inners)) (List.map (fun param -> convert_arg ctx p param) actual_param)
  139. | TObjectInner (pack, inners) -> die "" __LOC__
  140. | TArray (jsig, _) -> mk_type_path ctx (["java"], "NativeArray") [ TPType (convert_signature ctx p jsig,null_pos) ]
  141. | TMethod _ -> JReader.error "TMethod cannot be converted directly into Complex Type"
  142. | TTypeParameter s -> (match ctx.jtparams with
  143. | cur :: others ->
  144. if has_tparam s cur then
  145. mk_type_path ctx ([], s) []
  146. else begin
  147. if ctx.jcom.verbose && not(List.exists (has_tparam s) others) then print_endline ("Type parameter " ^ s ^ " was not found while building type!");
  148. mk_type_path ctx ([], "Dynamic") []
  149. end
  150. | _ ->
  151. if ctx.jcom.verbose then print_endline ("Empty type parameter stack!");
  152. mk_type_path ctx ([], "Dynamic") [])
  153. let convert_constant ctx p const =
  154. Option.map_default (function
  155. | ConstString s -> Some (EConst (String(s,SDoubleQuotes)), p)
  156. | ConstInt i -> Some (EConst (Int (Printf.sprintf "%ld" i)), p)
  157. | ConstFloat f | ConstDouble f -> Some (EConst (Float (Printf.sprintf "%E" f)), p)
  158. | _ -> None) None const
  159. let convert_constraints ctx p tl = match tl with
  160. | [] -> None
  161. | [t] -> Some (convert_signature ctx p t,null_pos)
  162. | tl -> Some (CTIntersection(List.map (fun t -> convert_signature ctx p t,null_pos) tl),null_pos)
  163. let convert_param ctx p parent param =
  164. let name, constraints = match param with
  165. | (name, Some extends_sig, implem_sig) ->
  166. name, extends_sig :: implem_sig
  167. | (name, None, implemem_sig) ->
  168. name, implemem_sig
  169. in
  170. {
  171. tp_name = jname_to_hx name,null_pos;
  172. tp_params = [];
  173. tp_constraints = convert_constraints ctx p constraints;
  174. tp_meta = [];
  175. }
  176. let get_type_path ctx ct = match ct with | CTPath p -> p | _ -> die "" __LOC__
  177. let is_override field =
  178. List.exists (function | AttrVisibleAnnotations [{ ann_type = TObject( (["java";"lang"], "Override"), _ ) }] -> true | _ -> false) field.jf_attributes
  179. let mk_override field =
  180. { field with jf_attributes = ((AttrVisibleAnnotations [{ ann_type = TObject( (["java";"lang"], "Override"), [] ); ann_elements = [] }]) :: field.jf_attributes) }
  181. let del_override field =
  182. { field with jf_attributes = List.filter (fun a -> not (is_override_attrib a)) field.jf_attributes }
  183. let get_canonical ctx p pack name =
  184. (Meta.JavaCanonical, [EConst (String (String.concat "." pack,SDoubleQuotes)), p; EConst (String (name,SDoubleQuotes)), p], p)
  185. let show_in_completion ctx jc =
  186. if not ctx.is_std then true
  187. else match fst jc.cpath with
  188. | ("java" | "javax" | "org") :: _ -> true
  189. | _ -> false
  190. (**
  191. `haxe.Rest<T>` auto-boxes primitive types.
  192. That means we can't use it as varargs for extern methods.
  193. E.g externs with `int` varargs are represented as `int[]` at run time
  194. while `haxe.Rest<Int>` is actually `java.lang.Integer[]`.
  195. *)
  196. let is_eligible_for_haxe_rest_args arg_type =
  197. match arg_type with
  198. | TByte | TChar | TDouble | TFloat | TInt | TLong | TShort | TBool -> false
  199. | _ -> true
  200. let convert_java_enum ctx p pe =
  201. 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
  202. let data = ref [] in
  203. List.iter (fun f ->
  204. (* if List.mem JEnum f.jf_flags then *)
  205. match f.jf_vmsignature with
  206. | TObject( path, [] ) when path = pe.cpath && List.mem JStatic f.jf_flags && List.mem JFinal f.jf_flags ->
  207. data := { ec_name = f.jf_name,null_pos; ec_doc = None; ec_meta = []; ec_args = []; ec_pos = p; ec_params = []; ec_type = None; } :: !data;
  208. | _ -> ()
  209. ) pe.cfields;
  210. if not (show_in_completion ctx pe) then meta := (Meta.NoCompletion,[],null_pos) :: !meta;
  211. EEnum {
  212. d_name = jname_to_hx (snd pe.cpath),null_pos;
  213. d_doc = None;
  214. d_params = []; (* enums never have type parameters *)
  215. d_meta = !meta;
  216. d_flags = [EExtern];
  217. d_data = List.rev !data;
  218. }
  219. let convert_java_field ctx p jc is_interface field =
  220. let p = { p with pfile = p.pfile ^" (" ^field.jf_name ^")" } in
  221. let cff_doc = None in
  222. let cff_pos = p in
  223. let cff_meta = ref [] in
  224. let cff_access = ref [] in
  225. let cff_name = match field.jf_name with
  226. | "<init>" -> "new"
  227. | "<clinit>"-> raise Exit (* __init__ field *)
  228. | name when String.length name > 5 ->
  229. (match String.sub name 0 5 with
  230. | "__hx_" | "this$" -> raise Exit
  231. | _ -> name)
  232. | name -> name
  233. in
  234. let jf_constant = ref field.jf_constant in
  235. let readonly = ref false in
  236. let is_varargs = ref false in
  237. List.iter (function
  238. | JPublic -> cff_access := (APublic,null_pos) :: !cff_access
  239. | JPrivate -> raise Exit (* private instances aren't useful on externs *)
  240. | JProtected ->
  241. cff_meta := (Meta.Protected, [], p) :: !cff_meta;
  242. cff_access := (APrivate,null_pos) :: !cff_access
  243. | JStatic -> cff_access := (AStatic,null_pos) :: !cff_access
  244. | JFinal ->
  245. cff_access := (AFinal, p) :: !cff_access;
  246. (match field.jf_kind, field.jf_vmsignature, field.jf_constant with
  247. | JKField, TObject _, _ ->
  248. jf_constant := None
  249. | JKField, _, Some _ ->
  250. readonly := true;
  251. jf_constant := None;
  252. | _ -> jf_constant := None)
  253. (* | JSynchronized -> cff_meta := (Meta.Synchronized, [], p) :: !cff_meta *)
  254. | JVolatile -> cff_meta := (Meta.Volatile, [], p) :: !cff_meta
  255. | JTransient -> cff_meta := (Meta.Transient, [], p) :: !cff_meta
  256. | JVarArgs -> is_varargs := true
  257. | JAbstract when not is_interface ->
  258. cff_access := (AAbstract, p) :: !cff_access
  259. | _ -> ()
  260. ) field.jf_flags;
  261. List.iter (function
  262. | AttrDeprecated when jc.cpath <> (["java";"util"],"Date") -> cff_meta := (Meta.Deprecated, [], p) :: !cff_meta
  263. (* TODO: pass anotations as @:meta *)
  264. | AttrVisibleAnnotations ann ->
  265. List.iter (function
  266. | { ann_type = TObject( (["java";"lang"], "Override"), [] ) } ->
  267. cff_access := (AOverride,null_pos) :: !cff_access
  268. | _ -> ()
  269. ) ann
  270. | _ -> ()
  271. ) field.jf_attributes;
  272. List.iter (fun jsig ->
  273. match convert_signature ctx p jsig with
  274. | CTPath path ->
  275. cff_meta := (Meta.Throws, [Ast.EConst (Ast.String (s_type_path (path.tpackage,path.tname),SDoubleQuotes)), p],p) :: !cff_meta
  276. | _ -> ()
  277. ) field.jf_throws;
  278. let extract_local_names () =
  279. let default i =
  280. "param" ^ string_of_int i
  281. in
  282. match field.jf_code with
  283. | None ->
  284. default
  285. | Some attribs -> try
  286. let rec loop attribs = match attribs with
  287. | AttrLocalVariableTable locals :: _ ->
  288. locals
  289. | _ :: attribs ->
  290. loop attribs
  291. | [] ->
  292. raise Not_found
  293. in
  294. let locals = loop attribs in
  295. let h = Hashtbl.create 0 in
  296. List.iter (fun local ->
  297. Hashtbl.replace h local.ld_index local.ld_name
  298. ) locals;
  299. (fun i ->
  300. try Hashtbl.find h (i - 1) (* they are 1-based *)
  301. with Not_found -> "param" ^ string_of_int i
  302. )
  303. with Not_found ->
  304. default
  305. in
  306. let kind = match field.jf_kind with
  307. | JKField when !readonly ->
  308. FProp (("default",null_pos), ("null",null_pos), Some (convert_signature ctx p field.jf_signature,null_pos), None)
  309. | JKField ->
  310. FVar (Some (convert_signature ctx p field.jf_signature,null_pos), None)
  311. | JKMethod ->
  312. match field.jf_signature with
  313. | TMethod (args, ret) ->
  314. let local_names = extract_local_names() in
  315. let old_types = ctx.jtparams in
  316. (match ctx.jtparams with
  317. | c :: others -> ctx.jtparams <- (c @ field.jf_types) :: others
  318. | [] -> ctx.jtparams <- field.jf_types :: []);
  319. let i = ref 0 in
  320. let args_count = List.length args in
  321. let args = List.map (fun s ->
  322. incr i;
  323. let hx_sig =
  324. match s with
  325. | TArray (s1,_) when !is_varargs && !i = args_count && is_eligible_for_haxe_rest_args s1 ->
  326. mk_type_path ctx (["haxe"], "Rest") [TPType (convert_signature ctx p s1,null_pos)]
  327. | _ ->
  328. convert_signature ctx null_pos s
  329. in
  330. (local_names !i,null_pos), false, [], Some(hx_sig,null_pos), None
  331. ) args in
  332. let t = Option.map_default (convert_signature ctx p) (mk_type_path ctx ([], "Void") []) ret in
  333. cff_access := (AOverload,p) :: !cff_access;
  334. let types = List.map (function
  335. | (name, Some ext, impl) ->
  336. {
  337. tp_name = name,null_pos;
  338. tp_params = [];
  339. tp_constraints = convert_constraints ctx p (ext :: impl);
  340. tp_meta = [];
  341. }
  342. | (name, None, impl) ->
  343. {
  344. tp_name = name,null_pos;
  345. tp_params = [];
  346. tp_constraints = convert_constraints ctx p impl;
  347. tp_meta = [];
  348. }
  349. ) field.jf_types in
  350. ctx.jtparams <- old_types;
  351. FFun ({
  352. f_params = types;
  353. f_args = args;
  354. f_type = Some (t,null_pos);
  355. f_expr = None
  356. })
  357. | _ -> error "Method signature was expected" p
  358. in
  359. if field.jf_code <> None && is_interface then cff_meta := (Meta.JavaDefault,[],cff_pos) :: !cff_meta;
  360. let cff_name, cff_meta =
  361. match String.get cff_name 0 with
  362. | '%' ->
  363. let name = (String.sub cff_name 1 (String.length cff_name - 1)) in
  364. if not (is_haxe_keyword name) then
  365. cff_meta := (Meta.Deprecated, [EConst(String(
  366. "This static field `_" ^ name ^ "` is deprecated and will be removed in later versions. Please use `" ^ name ^ "` instead",SDoubleQuotes)
  367. ),p], p) :: !cff_meta;
  368. "_" ^ name,
  369. (Meta.Native, [EConst (String (name,SDoubleQuotes) ), cff_pos], cff_pos) :: !cff_meta
  370. | _ ->
  371. match String.nsplit cff_name "$" with
  372. | [ no_dollar ] ->
  373. cff_name, !cff_meta
  374. | parts ->
  375. String.concat "_" parts,
  376. (Meta.Native, [EConst (String (cff_name,SDoubleQuotes) ), cff_pos], cff_pos) :: !cff_meta
  377. in
  378. if Common.raw_defined ctx.jcom "java_loader_debug" then
  379. 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);
  380. {
  381. cff_name = cff_name,null_pos;
  382. cff_doc = cff_doc;
  383. cff_pos = cff_pos;
  384. cff_meta = cff_meta;
  385. cff_access = !cff_access;
  386. cff_kind = kind
  387. }
  388. let rec japply_params params jsig = match params with
  389. | [] -> jsig
  390. | _ -> match jsig with
  391. | TTypeParameter s -> (try
  392. List.assoc s params
  393. with | Not_found -> jsig)
  394. | TObject(p,tl) ->
  395. TObject(p, args params tl)
  396. | TObjectInner(sl, stll) ->
  397. TObjectInner(sl, List.map (fun (s,tl) -> (s, args params tl)) stll)
  398. | TArray(s,io) ->
  399. TArray(japply_params params s, io)
  400. | TMethod(sl, sopt) ->
  401. TMethod(List.map (japply_params params) sl, Option.map (japply_params params) sopt)
  402. | _ -> jsig
  403. and args params tl = match params with
  404. | [] -> tl
  405. | _ -> List.map (function
  406. | TAny -> TAny
  407. | TType(w,s) -> TType(w,japply_params params s)) tl
  408. let mk_params jtypes = List.map (fun (s,_,_) -> (s,TTypeParameter s)) jtypes
  409. let convert_java_class ctx p jc =
  410. match List.mem JEnum jc.cflags with
  411. | true -> (* is enum *)
  412. [convert_java_enum ctx p jc]
  413. | false ->
  414. let flags = ref [HExtern] in
  415. if Common.raw_defined ctx.jcom "java_loader_debug" then begin
  416. let sup = jc.csuper :: jc.cinterfaces in
  417. print_endline ("converting " ^ (if List.mem JAbstract jc.cflags then "abstract " else "") ^ JData.path_s jc.cpath ^ " : " ^ (String.concat ", " (List.map s_sig sup)));
  418. end;
  419. (* todo: instead of JavaNative, use more specific definitions *)
  420. 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
  421. let force_check = Common.defined ctx.jcom Define.ForceLibCheck in
  422. if not force_check then
  423. meta := (Meta.LibType,[],p) :: !meta;
  424. let is_interface = ref false in
  425. let is_abstract = ref false in
  426. List.iter (fun f -> match f with
  427. | JFinal -> flags := HFinal :: !flags
  428. | JInterface ->
  429. is_interface := true;
  430. flags := HInterface :: !flags
  431. | JAbstract ->
  432. meta := (Meta.Abstract, [], p) :: !meta;
  433. is_abstract := true;
  434. | JAnnotation -> meta := (Meta.Annotation, [], p) :: !meta
  435. | _ -> ()
  436. ) jc.cflags;
  437. if !is_abstract && not !is_interface then flags := HAbstract :: !flags;
  438. (match jc.csuper with
  439. | TObject( (["java";"lang"], "Object"), _ ) -> ()
  440. | TObject( (["haxe";"lang"], "HxObject"), _ ) -> meta := (Meta.HxGen,[],p) :: !meta
  441. | _ -> flags := HExtends (get_type_path ctx (convert_signature ctx p jc.csuper),null_pos) :: !flags
  442. );
  443. List.iter (fun i ->
  444. match i with
  445. | TObject ( (["haxe";"lang"], "IHxObject"), _ ) -> meta := (Meta.HxGen,[],p) :: !meta
  446. | _ -> flags :=
  447. if !is_interface then
  448. HExtends (get_type_path ctx (convert_signature ctx p i),null_pos) :: !flags
  449. else
  450. HImplements (get_type_path ctx (convert_signature ctx p i),null_pos) :: !flags
  451. ) jc.cinterfaces;
  452. let fields = ref [] in
  453. let jfields = ref [] in
  454. if jc.cpath <> (["java";"lang"], "CharSequence") then
  455. List.iter (fun f ->
  456. try
  457. if !is_interface && List.mem JStatic f.jf_flags then
  458. ()
  459. else begin
  460. fields := convert_java_field ctx p jc !is_interface f :: !fields;
  461. jfields := f :: !jfields
  462. end
  463. with
  464. | Exit -> ()
  465. ) (jc.cfields @ jc.cmethods);
  466. (* make sure the throws types are imported correctly *)
  467. let imports = List.concat (List.map (fun f ->
  468. List.map (fun jsig ->
  469. match convert_signature ctx p jsig with
  470. | CTPath path ->
  471. let pos = { p with pfile = p.pfile ^ " (" ^ f.jf_name ^" @:throws)" } in
  472. EImport( List.map (fun s -> s,pos) (path.tpackage @ [path.tname]), INormal )
  473. | _ -> die "" __LOC__
  474. ) f.jf_throws
  475. ) jc.cmethods) in
  476. if not (show_in_completion ctx jc) then meta := (Meta.NoCompletion,[],null_pos) :: !meta;
  477. (EClass {
  478. d_name = jname_to_hx (snd jc.cpath),null_pos;
  479. d_doc = None;
  480. d_params = List.map (convert_param ctx p jc.cpath) jc.ctypes;
  481. d_meta = !meta;
  482. d_flags = !flags;
  483. d_data = !fields;
  484. }) :: imports
  485. let create_ctx com is_std =
  486. {
  487. jcom = com;
  488. jtparams = [];
  489. is_std = is_std;
  490. }
  491. let rec has_type_param = function
  492. | TTypeParameter _ -> true
  493. | TMethod (lst, opt) -> List.exists has_type_param lst || Option.map_default has_type_param false opt
  494. | TArray (s,_) -> has_type_param s
  495. | TObjectInner (_, stpl) -> List.exists (fun (_,sigs) -> List.exists has_type_param_arg sigs) stpl
  496. | TObject(_, pl) -> List.exists has_type_param_arg pl
  497. | _ -> false
  498. and has_type_param_arg = function | TType(_,s) -> has_type_param s | _ -> false
  499. let rec japply_params jparams jsig = match jparams with
  500. | [] -> jsig
  501. | _ ->
  502. match jsig with
  503. | TObject(path,p) ->
  504. TObject(path, List.map (japply_params_tp jparams ) p)
  505. | TObjectInner(sl,stargl) ->
  506. TObjectInner(sl,List.map (fun (s,targ) -> (s, List.map (japply_params_tp jparams) targ)) stargl)
  507. | TArray(jsig,io) ->
  508. TArray(japply_params jparams jsig,io)
  509. | TMethod(args,ret) ->
  510. TMethod(List.map (japply_params jparams ) args, Option.map (japply_params jparams ) ret)
  511. | TTypeParameter s -> (try
  512. List.assoc s jparams
  513. with | Not_found -> jsig)
  514. | _ -> jsig
  515. and japply_params_tp jparams jtype_argument = match jtype_argument with
  516. | TAny -> TAny
  517. | TType(w,jsig) -> TType(w,japply_params jparams jsig)
  518. let mk_jparams jtypes params = match jtypes, params with
  519. | [], [] -> []
  520. | _, [] -> List.map (fun (s,_,_) -> s, TObject( (["java";"lang"], "Object"), [] ) ) jtypes
  521. | _ -> List.map2 (fun (s,_,_) jt -> match jt with
  522. | TAny -> s, TObject((["java";"lang"],"Object"),[])
  523. | TType(_,jsig) -> s, jsig) jtypes params
  524. let rec compatible_signature_arg ?arg_test f1 f2 =
  525. let arg_test = match arg_test with
  526. | None -> (fun _ _ -> true)
  527. | Some a -> a
  528. in
  529. if f1 = f2 then
  530. true
  531. else match f1, f2 with
  532. | TObject(p,a), TObject(p2,a2) -> p = p2 && arg_test a a2
  533. | TObjectInner(sl, stal), TObjectInner(sl2, stal2) -> sl = sl2 && List.map fst stal = List.map fst stal2
  534. | TArray(s,_) , TArray(s2,_) -> compatible_signature_arg s s2
  535. | TTypeParameter t1 , TTypeParameter t2 -> t1 = t2
  536. | _ -> false
  537. let rec compatible_param p1 p2 = match p1, p2 with
  538. | TType (_,s1), TType(_,s2) -> compatible_signature_arg ~arg_test:compatible_tparams s1 s2
  539. | TAny, TType(_, TObject( (["java";"lang"],"Object"), _ )) -> true
  540. | TType(_, TObject( (["java";"lang"],"Object"), _ )), TAny -> true
  541. | _ -> false
  542. and compatible_tparams p1 p2 = try match p1, p2 with
  543. | [], [] -> true
  544. | _, [] ->
  545. let p2 = List.map (fun _ -> TAny) p1 in
  546. List.for_all2 compatible_param p1 p2
  547. | [], _ ->
  548. let p1 = List.map (fun _ -> TAny) p2 in
  549. List.for_all2 compatible_param p1 p2
  550. | _, _ ->
  551. List.for_all2 compatible_param p1 p2
  552. with | Invalid_argument _ -> false
  553. let get_adapted_sig f f2 = match f.jf_types with
  554. | [] ->
  555. f.jf_signature
  556. | _ ->
  557. let jparams = mk_jparams f.jf_types (List.map (fun (s,_,_) -> TType(WNone, TTypeParameter s)) f2.jf_types) in
  558. japply_params jparams f.jf_signature
  559. let compatible_methods f1 f2 =
  560. if List.length f1.jf_types <> List.length f2.jf_types then
  561. false
  562. else match (get_adapted_sig f1 f2), f2.jf_signature with
  563. | TMethod(a1,_), TMethod(a2,_) when List.length a1 = List.length a2 ->
  564. List.for_all2 compatible_signature_arg a1 a2
  565. | _ -> false
  566. let jcl_from_jsig com jsig =
  567. let path, params = match jsig with
  568. | TObject(path, params) ->
  569. path,params
  570. | TObjectInner(sl, stll) ->
  571. let last_params = ref [] in
  572. let real_path = sl, String.concat "$" (List.map (fun (s,p) -> last_params := p; s) stll) in
  573. real_path, !last_params
  574. | _ -> raise Not_found
  575. in
  576. match lookup_jclass com path with
  577. | None -> raise Not_found
  578. | Some(c,_,_) -> c,params
  579. let jclass_with_params com cls params = try
  580. match cls.ctypes with
  581. | [] -> cls
  582. | _ ->
  583. let jparams = mk_jparams cls.ctypes params in
  584. { cls with
  585. cfields = List.map (fun f -> { f with jf_signature = japply_params jparams f.jf_signature }) cls.cfields;
  586. cmethods = List.map (fun f -> { f with jf_signature = japply_params jparams f.jf_signature }) cls.cmethods;
  587. csuper = japply_params jparams cls.csuper;
  588. cinterfaces = List.map (japply_params jparams) cls.cinterfaces;
  589. }
  590. with Invalid_argument _ ->
  591. if com.verbose then print_endline ("Differing parameters for class: " ^ s_type_path cls.cpath);
  592. cls
  593. let is_object = function | TObject( (["java";"lang"], "Object"), [] ) -> true | _ -> false
  594. let is_tobject = function | TObject _ | TObjectInner _ -> true | _ -> false
  595. let simplify_args args =
  596. if List.for_all (function | TAny -> true | _ -> false) args then [] else args
  597. let compare_type com s1 s2 =
  598. if s1 = s2 then
  599. 0
  600. else if not (is_tobject s1) then
  601. if is_tobject s2 then (* Dynamic *)
  602. 1
  603. else if compatible_signature_arg s1 s2 then
  604. 0
  605. else
  606. raise Exit
  607. else if not (is_tobject s2) then
  608. -1
  609. else begin
  610. let rec loop ?(first_error=true) s1 s2 : bool =
  611. if is_object s1 then
  612. s1 = s2
  613. else if compatible_signature_arg s1 s2 then begin
  614. let p1, p2 = match s1, s2 with
  615. | TObject(_, p1), TObject(_,p2) ->
  616. p1, p2
  617. | TObjectInner(_, npl1), TObjectInner(_, npl2) ->
  618. snd (List.hd (List.rev npl1)), snd (List.hd (List.rev npl2))
  619. | _ -> die "" __LOC__ (* not tobject *)
  620. in
  621. let p1, p2 = simplify_args p1, simplify_args p2 in
  622. let lp1 = List.length p1 in
  623. let lp2 = List.length p2 in
  624. if lp1 > lp2 then
  625. true
  626. else if lp2 > lp1 then
  627. false
  628. else begin
  629. (* if compatible tparams, it's fine *)
  630. if not (compatible_tparams p1 p2) then
  631. raise Exit; (* meaning: found, but incompatible type parameters *)
  632. true
  633. end
  634. end else try
  635. let c, p = jcl_from_jsig com s1 in
  636. let jparams = mk_jparams c.ctypes p in
  637. let super = japply_params jparams c.csuper in
  638. let implements = List.map (japply_params jparams) c.cinterfaces in
  639. loop ~first_error:first_error super s2 || List.exists (fun super -> loop ~first_error:first_error super s2) implements
  640. with | Not_found ->
  641. print_endline ("--java-lib: The type " ^ (s_sig s1) ^ " is referred but was not found. Compilation may not occur correctly.");
  642. print_endline "Did you forget to include a needed lib?";
  643. if first_error then
  644. not (loop ~first_error:false s2 s1)
  645. else
  646. false
  647. in
  648. if loop s1 s2 then
  649. if loop s2 s1 then
  650. 0
  651. else
  652. 1
  653. else
  654. if loop s2 s1 then
  655. -1
  656. else
  657. -2
  658. end
  659. (* given a list of same overload functions, choose the best (or none) *)
  660. let select_best com flist =
  661. let rec loop cur_best = function
  662. | [] ->
  663. Some cur_best
  664. | f :: flist -> match get_adapted_sig f cur_best, cur_best.jf_signature with
  665. | TMethod(_,Some r), TMethod(_, Some r2) -> (try
  666. match compare_type com r r2 with
  667. | 0 -> (* same type - select any of them *)
  668. loop cur_best flist
  669. | 1 ->
  670. loop f flist
  671. | -1 ->
  672. loop cur_best flist
  673. | -2 -> (* error - no type is compatible *)
  674. if com.verbose then print_endline (f.jf_name ^ ": The types " ^ (s_sig r) ^ " and " ^ (s_sig r2) ^ " are incompatible");
  675. (* bet that the current best has "beaten" other types *)
  676. loop cur_best flist
  677. | _ -> die "" __LOC__
  678. with | Exit -> (* incompatible type parameters *)
  679. (* error mode *)
  680. if com.verbose then print_endline (f.jf_name ^ ": Incompatible argument return signatures: " ^ (s_sig r) ^ " and " ^ (s_sig r2));
  681. None)
  682. | TMethod _, _ -> (* select the method *)
  683. loop f flist
  684. | _ ->
  685. loop cur_best flist
  686. in
  687. match loop (List.hd flist) (List.tl flist) with
  688. | Some f ->
  689. Some f
  690. | None -> match List.filter (fun f -> not (is_override f)) flist with
  691. (* error mode; take off all override methods *)
  692. | [] -> None
  693. | f :: [] -> Some f
  694. | f :: flist -> Some f (* pick one *)
  695. (**** begin normalize_jclass helpers ****)
  696. let fix_overrides_jclass com cls =
  697. let force_check = Common.defined com Define.ForceLibCheck in
  698. let methods = if force_check then List.map (fun f -> del_override f) cls.cmethods else cls.cmethods in
  699. let cmethods = methods in
  700. let super_fields = [] in
  701. let super_methods = [] in
  702. let nonstatics = List.filter (fun f -> not (List.mem JStatic f.jf_flags)) (cls.cfields @ cls.cmethods) in
  703. let is_pub = fun f -> List.exists (function | JPublic | JProtected -> true | _ -> false) f.jf_flags in
  704. let cmethods, super_fields = if not (List.mem JInterface cls.cflags) then
  705. List.filter is_pub cmethods,
  706. List.filter is_pub super_fields
  707. else
  708. cmethods,super_fields
  709. in
  710. let rec loop cls super_methods super_fields cmethods nonstatics = try
  711. match cls.csuper with
  712. | TObject((["java";"lang"],"Object"),_) ->
  713. super_methods,super_fields,cmethods,nonstatics
  714. | _ ->
  715. let cls, params = jcl_from_jsig com cls.csuper in
  716. let cls = jclass_with_params com cls params in
  717. let nonstatics = (List.filter (fun f -> (List.mem JStatic f.jf_flags)) (cls.cfields @ cls.cmethods)) @ nonstatics in
  718. let super_methods = cls.cmethods @ super_methods in
  719. let super_fields = cls.cfields @ super_fields in
  720. let cmethods = if force_check then begin
  721. let overridden = ref [] in
  722. let cmethods = List.map (fun jm ->
  723. (* TODO rewrite/standardize empty spaces *)
  724. if not (is_override jm) && not (List.mem JStatic jm.jf_flags) && List.exists (fun msup ->
  725. let ret = msup.jf_name = jm.jf_name && not(List.mem JStatic msup.jf_flags) && compatible_methods msup jm in
  726. if ret then begin
  727. let f = mk_override msup in
  728. overridden := { f with jf_flags = jm.jf_flags } :: !overridden
  729. end;
  730. ret
  731. ) cls.cmethods then
  732. mk_override jm
  733. else
  734. jm
  735. ) cmethods in
  736. !overridden @ cmethods
  737. end else
  738. cmethods
  739. in
  740. loop cls super_methods super_fields cmethods nonstatics
  741. with | Not_found ->
  742. super_methods,super_fields,cmethods,nonstatics
  743. in
  744. loop cls super_methods super_fields cmethods nonstatics
  745. let normalize_jclass com cls =
  746. (* after adding the noCheck metadata, this option will annotate what changes were needed *)
  747. (* and that are now deprecated *)
  748. let force_check = Common.defined com Define.ForceLibCheck in
  749. (* fix overrides *)
  750. let super_methods, super_fields, cmethods, nonstatics = fix_overrides_jclass com cls in
  751. let all_methods = cmethods @ super_methods in
  752. (* look for interfaces and add missing implementations (may happen on abstracts or by vmsig differences *)
  753. (* (libType): even with libType enabled, we need to add these missing fields - otherwise we won't be able to use them from Haxe *)
  754. let added_interface_fields = ref [] in
  755. let rec loop_interface abstract cls iface = try
  756. match iface with
  757. | TObject ((["java";"lang"],"Object"), _) -> ()
  758. | TObject (path,_) when path = cls.cpath -> ()
  759. | _ ->
  760. let cif, params = jcl_from_jsig com iface in
  761. let cif = jclass_with_params com cif params in
  762. List.iter (fun jf ->
  763. 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
  764. let jf = if abstract && force_check then del_override jf else jf in
  765. 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 *)
  766. added_interface_fields := jf :: !added_interface_fields;
  767. end
  768. ) cif.cmethods;
  769. (* we don't need to loop again in the interface unless we are in an abstract class, since these interfaces are already normalized *)
  770. if abstract then List.iter (loop_interface abstract cif) cif.cinterfaces;
  771. with Not_found -> ()
  772. in
  773. List.iter (loop_interface (List.mem JAbstract cls.cflags) cls) cls.cinterfaces;
  774. let nonstatics = !added_interface_fields @ nonstatics in
  775. let cmethods = !added_interface_fields @ cmethods in
  776. (* for each added field in the interface, lookup in super_methods possible methods to include *)
  777. (* so we can choose the better method still *)
  778. let cmethods = if not force_check then
  779. cmethods
  780. else
  781. List.fold_left (fun cmethods im ->
  782. (* see if any of the added_interface_fields need to be declared as override *)
  783. let f = List.find_all (fun jf -> jf.jf_name = im.jf_name && compatible_methods jf im) super_methods in
  784. let f = List.map mk_override f in
  785. f @ cmethods
  786. ) cmethods !added_interface_fields;
  787. in
  788. (* take off equals, hashCode and toString from interface *)
  789. let cmethods = if List.mem JInterface cls.cflags then List.filter (fun jf -> match jf.jf_name, jf.jf_vmsignature with
  790. | "equals", TMethod([TObject( (["java";"lang"],"Object"), _)],_)
  791. | "hashCode", TMethod([], _)
  792. | "toString", TMethod([], _) -> false
  793. | _ -> true
  794. ) cmethods
  795. else
  796. cmethods
  797. in
  798. (* change field name to not collide with haxe keywords and with static/non-static members *)
  799. let fold_field acc f =
  800. let change, both = match f.jf_name with
  801. | _ when List.mem JStatic f.jf_flags && List.exists (fun f2 -> f.jf_name = f2.jf_name) nonstatics -> true, true
  802. | _ -> is_haxe_keyword f.jf_name, false
  803. in
  804. let f2 = if change then
  805. { f with jf_name = "%" ^ f.jf_name }
  806. else
  807. f
  808. in
  809. if both then f :: f2 :: acc else f2 :: acc
  810. in
  811. (* change static fields that have the same name as methods *)
  812. let cfields = List.fold_left fold_field [] cls.cfields in
  813. let cmethods = List.fold_left fold_field [] cmethods in
  814. (* take off variable fields that have the same name as methods *)
  815. (* and take off variables that already have been declared *)
  816. 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
  817. let cfields = List.filter (fun f ->
  818. if List.mem JStatic f.jf_flags then
  819. not (List.exists (filter_field f) cmethods)
  820. else
  821. 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
  822. in
  823. (* now filter any method that clashes with a field - on a superclass *)
  824. let cmethods = if force_check then List.filter (fun f ->
  825. if List.mem JStatic f.jf_flags then
  826. true
  827. else
  828. not (List.exists (filter_field f) super_fields) ) cmethods
  829. else
  830. cmethods
  831. in
  832. (* removing duplicate fields. They are there because of return type covariance in Java *)
  833. (* Also, if a method overrides a previous definition, and changes a type parameters' variance, *)
  834. (* we will take it off *)
  835. (* this means that some rare codes will never compile on Haxe, but unless Haxe adds variance support *)
  836. (* I can't see how this can be any different *)
  837. let rec loop acc = function
  838. | [] -> acc
  839. | f :: cmeths ->
  840. match List.partition (fun f2 -> f.jf_name = f2.jf_name && compatible_methods f f2) cmeths with
  841. | [], cmeths ->
  842. loop (f :: acc) cmeths
  843. | flist, cmeths -> match select_best com (f :: flist) with
  844. | None ->
  845. loop acc cmeths
  846. | Some f ->
  847. loop (f :: acc) cmeths
  848. in
  849. (* last pass: take off all cfields that are internal / private (they won't be accessible anyway) *)
  850. let cfields = List.filter(fun f -> List.exists (fun f -> f = JPublic || f = JProtected) f.jf_flags) cfields in
  851. let cmethods = loop [] cmethods in
  852. { cls with cfields = cfields; cmethods = cmethods }
  853. (**** end normalize_jclass helpers ****)
  854. let get_classes_zip zip =
  855. let ret = ref [] in
  856. List.iter (function
  857. | { Zip.is_directory = false; Zip.filename = f } when (String.sub (String.uncapitalize f) (String.length f - 6) 6) = ".class" && not (String.exists f "$") ->
  858. (match List.rev (String.nsplit f "/") with
  859. | clsname :: pack ->
  860. if not (String.contains clsname '$') then begin
  861. let path = jpath_to_hx (List.rev pack, String.sub clsname 0 (String.length clsname - 6)) in
  862. ret := path :: !ret
  863. end
  864. | _ ->
  865. ret := ([], jname_to_hx f) :: !ret)
  866. | _ -> ()
  867. ) (Zip.entries zip);
  868. !ret
  869. class virtual java_library com name file_path = object(self)
  870. inherit [java_lib_type,unit] native_library name file_path as super
  871. val hxpack_to_jpack = Hashtbl.create 16
  872. method convert_path (path : path) : path =
  873. Hashtbl.find hxpack_to_jpack path
  874. method private replace_canonical_name p pack name_original name_replace decl =
  875. let mk_meta name = (Meta.JavaCanonical, [EConst (String (String.concat "." pack,SDoubleQuotes)), p; EConst(String (name,SDoubleQuotes)), p], p) in
  876. let add_meta name metas =
  877. if Meta.has Meta.JavaCanonical metas then
  878. List.map (function
  879. | (Meta.JavaCanonical,[EConst (String(cpack,_)), _; EConst(String(cname,_)), _],_) ->
  880. let did_replace,name = String.replace cname name_original name_replace in
  881. if not did_replace then print_endline (cname ^ " -> " ^ name_original ^ " -> " ^ name_replace);
  882. mk_meta name
  883. | m -> m
  884. ) metas
  885. else
  886. mk_meta name :: metas
  887. in
  888. match decl with
  889. | EClass c ->
  890. EClass { c with d_meta = add_meta (fst c.d_name) c.d_meta }
  891. | EEnum e ->
  892. EEnum { e with d_meta = add_meta (fst e.d_name) e.d_meta }
  893. | EAbstract a ->
  894. EAbstract { a with d_meta = add_meta (fst a.d_name) a.d_meta }
  895. | d -> d
  896. method build path (p : pos) : Ast.package option =
  897. let rec build ctx path p types =
  898. try
  899. if List.mem path !types then
  900. None
  901. else begin
  902. let first = match !types with
  903. | [ ["java";"lang"], "String" ] | [] -> true
  904. | p :: _ ->
  905. false
  906. in
  907. types := path :: !types;
  908. match self#lookup path, path with
  909. | None, ([], c) -> build ctx (["haxe";"root"], c) p types
  910. | None, _ -> None
  911. | Some (cls, real_path, pos_path), _ ->
  912. let is_disallowed_inner = first && String.exists (snd cls.cpath) "$" in
  913. let is_disallowed_inner = if is_disallowed_inner then begin
  914. let outer, inner = String.split (snd cls.cpath) "$" in
  915. match self#lookup (fst path, outer) with
  916. | None -> false
  917. | _ -> true
  918. end else
  919. false
  920. in
  921. if is_disallowed_inner then
  922. None
  923. else begin
  924. if ctx.jcom.verbose then print_endline ("Parsed Java class " ^ (s_type_path cls.cpath));
  925. let old_types = ctx.jtparams in
  926. ctx.jtparams <- cls.ctypes :: ctx.jtparams;
  927. let pos = { pfile = pos_path; pmin = 0; pmax = 0; } in
  928. let pack = match fst path with | ["haxe";"root"] -> [] | p -> p in
  929. let ppath = self#convert_path path in
  930. let inner = List.fold_left (fun acc (path,out,_,_) ->
  931. let path = jpath_to_hx path in
  932. (if out <> Some ppath then
  933. acc
  934. else match build ctx path p types with
  935. | Some(_, classes) ->
  936. let base = snd ppath ^ "$" in
  937. (List.map (fun (def,p) ->
  938. self#replace_canonical_name p (fst ppath) base (snd ppath ^ ".") def, p) classes) @ acc
  939. | _ -> acc);
  940. ) [] cls.cinner_types in
  941. (* add _Statics class *)
  942. let inner = try
  943. if not (List.mem JInterface cls.cflags) then raise Not_found;
  944. let smethods = List.filter (fun f -> List.mem JStatic f.jf_flags) cls.cmethods in
  945. let sfields = List.filter (fun f -> List.mem JStatic f.jf_flags) cls.cfields in
  946. if not (smethods <> [] || sfields <> []) then raise Not_found;
  947. let obj = TObject( (["java";"lang"],"Object"), []) in
  948. let ncls = convert_java_class ctx pos { cls with cmethods = smethods; cfields = sfields; cflags = []; csuper = obj; cinterfaces = []; cinner_types = []; ctypes = [] } in
  949. match ncls with
  950. | EClass c :: imports ->
  951. (EClass { c with d_name = (fst c.d_name ^ "_Statics"),snd c.d_name }, pos) :: inner @ List.map (fun i -> i,pos) imports
  952. | _ -> die "" __LOC__
  953. with | Not_found ->
  954. inner
  955. in
  956. let inner_alias = ref SS.empty in
  957. List.iter (fun x ->
  958. match fst x with
  959. | EClass c ->
  960. inner_alias := SS.add (fst c.d_name) !inner_alias;
  961. | _ -> ()
  962. ) inner;
  963. let alias_list = ref [] in
  964. List.iter (fun x ->
  965. match x with
  966. | (EClass c, pos) -> begin
  967. let parts = String.nsplit (fst c.d_name) "_24" in
  968. match parts with
  969. | _ :: _ ->
  970. let alias_name = String.concat "_" parts in
  971. if (not (SS.mem alias_name !inner_alias)) && (not (String.exists (snd path) "_24")) then begin
  972. let alias_def = ETypedef {
  973. d_name = alias_name,null_pos;
  974. d_doc = None;
  975. d_params = c.d_params;
  976. d_meta = [];
  977. d_flags = [];
  978. d_data = CTPath {
  979. tpackage = pack;
  980. tname = snd path;
  981. tparams = List.map (fun tp ->
  982. TPType (CTPath {
  983. tpackage = [];
  984. tname = fst tp.tp_name;
  985. tparams = [];
  986. tsub = None;
  987. },null_pos)
  988. ) c.d_params;
  989. tsub = Some(fst c.d_name);
  990. },null_pos;
  991. } in
  992. inner_alias := SS.add alias_name !inner_alias;
  993. alias_list := (alias_def, pos) :: !alias_list;
  994. end
  995. | _ -> ()
  996. end
  997. | _ -> ()
  998. ) inner;
  999. let inner = List.concat [!alias_list ; inner] in
  1000. let classes = List.map (fun t -> t,pos) (convert_java_class ctx pos cls) in
  1001. let imports, defs = List.partition (function | (EImport(_),_) -> true | _ -> false) (classes @ inner) in
  1002. let ret = Some (pack, imports @ defs) in
  1003. ctx.jtparams <- old_types;
  1004. ret
  1005. end
  1006. end
  1007. with
  1008. | JReader.Error_message msg ->
  1009. print_endline ("Class reader failed: " ^ msg);
  1010. None
  1011. | e ->
  1012. if ctx.jcom.verbose then begin
  1013. (* print_endline (Printexc.get_backtrace ()); requires ocaml 3.11 *)
  1014. print_endline (Printexc.to_string e)
  1015. end;
  1016. None
  1017. in
  1018. build (create_ctx com (self#has_flag FlagIsStd)) path p (ref [["java";"lang"], "String"])
  1019. method get_data = ()
  1020. end
  1021. class java_library_jar com name file_path = object(self)
  1022. inherit java_library com name file_path
  1023. val zip = lazy (Zip.open_in file_path)
  1024. val mutable cached_files = None
  1025. val cached_types = Hashtbl.create 12
  1026. val mutable loaded = false
  1027. val mutable closed = false
  1028. method load =
  1029. if not loaded then begin
  1030. loaded <- true;
  1031. List.iter (function
  1032. | { Zip.is_directory = false; Zip.filename = filename } when String.ends_with filename ".class" ->
  1033. let pack = String.nsplit filename "/" in
  1034. (match List.rev pack with
  1035. | [] -> ()
  1036. | name :: pack ->
  1037. let name = String.sub name 0 (String.length name - 6) in
  1038. let pack = List.rev pack in
  1039. Hashtbl.add hxpack_to_jpack (jpath_to_hx (pack,name)) (pack,name))
  1040. | _ -> ()
  1041. ) (Zip.entries (Lazy.force zip))
  1042. end
  1043. method private lookup' ((pack,name) : path) : java_lib_type =
  1044. try
  1045. let zip = Lazy.force zip in
  1046. let location = (String.concat "/" (pack @ [name]) ^ ".class") in
  1047. let entry = Zip.find_entry zip location in
  1048. let data = Zip.read_entry zip entry in
  1049. Some(JReader.parse_class (IO.input_string data), file_path, file_path ^ "@" ^ location)
  1050. with
  1051. | Not_found ->
  1052. None
  1053. method lookup (path : path) : java_lib_type =
  1054. try
  1055. Hashtbl.find cached_types path
  1056. with | Not_found -> try
  1057. self#load;
  1058. let pack, name = self#convert_path path in
  1059. let try_file (pack,name) =
  1060. match self#lookup' (pack,name) with
  1061. | None ->
  1062. Hashtbl.add cached_types path None;
  1063. None
  1064. | Some (i, p1, p2) ->
  1065. Hashtbl.add cached_types path (Some(i,p1,p2)); (* type loop normalization *)
  1066. let ret = Some (normalize_jclass com i, p1, p2) in
  1067. Hashtbl.replace cached_types path ret;
  1068. ret
  1069. in
  1070. try_file (pack,name)
  1071. with Not_found ->
  1072. None
  1073. method close =
  1074. if not closed then begin
  1075. closed <- true;
  1076. Zip.close_in (Lazy.force zip)
  1077. end
  1078. method private list_modules' : path list =
  1079. let ret = ref [] in
  1080. List.iter (function
  1081. | { Zip.is_directory = false; Zip.filename = f } when (String.sub (String.uncapitalize f) (String.length f - 6) 6) = ".class" && not (String.exists f "$") ->
  1082. (match List.rev (String.nsplit f "/") with
  1083. | clsname :: pack ->
  1084. if not (String.contains clsname '$') then begin
  1085. let path = jpath_to_hx (List.rev pack, String.sub clsname 0 (String.length clsname - 6)) in
  1086. ret := path :: !ret
  1087. end
  1088. | _ ->
  1089. ret := ([], jname_to_hx f) :: !ret)
  1090. | _ -> ()
  1091. ) (Zip.entries (Lazy.force zip));
  1092. !ret
  1093. method list_modules : path list = match cached_files with
  1094. | None ->
  1095. let ret = self#list_modules' in
  1096. cached_files <- Some ret;
  1097. ret
  1098. | Some r ->
  1099. r
  1100. end
  1101. class java_library_dir com name file_path = object(self)
  1102. inherit java_library com name file_path
  1103. val mutable files = []
  1104. method load =
  1105. let all = ref [] in
  1106. let rec iter_files pack dir path = try
  1107. let file = Unix.readdir dir in
  1108. let filepath = path ^ "/" ^ file in
  1109. (if String.ends_with file ".class" then
  1110. let name = String.sub file 0 (String.length file - 6) in
  1111. let path = jpath_to_hx (pack,name) in
  1112. if not (String.exists file "$") then all := path :: !all;
  1113. Hashtbl.add hxpack_to_jpack path (pack,name)
  1114. else if (Unix.stat filepath).st_kind = S_DIR && file <> "." && file <> ".." then
  1115. let pack = pack @ [file] in
  1116. iter_files (pack) (Unix.opendir filepath) filepath);
  1117. iter_files pack dir path
  1118. with | End_of_file | Unix.Unix_error _ ->
  1119. Unix.closedir dir
  1120. in
  1121. iter_files [] (Unix.opendir file_path) file_path;
  1122. files <- !all
  1123. method close =
  1124. ()
  1125. method list_modules =
  1126. files
  1127. method lookup (pack,name) : java_lib_type =
  1128. let real_path = file_path ^ "/" ^ (String.concat "/" pack) ^ "/" ^ (name ^ ".class") in
  1129. try
  1130. let data = Std.input_file ~bin:true real_path in
  1131. Some(JReader.parse_class (IO.input_string data), real_path, real_path)
  1132. with
  1133. | _ -> None
  1134. end
  1135. let add_java_lib com name std extern modern =
  1136. let file = if Sys.file_exists name then
  1137. name
  1138. else try Common.find_file com name with
  1139. | Not_found -> try Common.find_file com (name ^ ".jar") with
  1140. | Not_found ->
  1141. failwith ("Java lib " ^ name ^ " not found")
  1142. in
  1143. let java_lib =
  1144. if modern then
  1145. (new JavaModern.java_library_modern com name file :> (java_lib_type,unit) native_library)
  1146. else match (Unix.stat file).st_kind with
  1147. | S_DIR ->
  1148. (new java_library_dir com name file :> (java_lib_type,unit) native_library)
  1149. | _ ->
  1150. (new java_library_jar com name file :> (java_lib_type,unit) native_library)
  1151. in
  1152. if std then java_lib#add_flag FlagIsStd;
  1153. if extern then java_lib#add_flag FlagIsExtern;
  1154. com.native_libs.java_libs <- (java_lib :> (java_lib_type,unit) native_library) :: com.native_libs.java_libs;
  1155. CommonCache.handle_native_lib com java_lib
  1156. let before_generate con =
  1157. let java_ver = try
  1158. int_of_string (Common.defined_value con Define.JavaVer)
  1159. with | Not_found ->
  1160. Common.define_value con Define.JavaVer "7";
  1161. 7
  1162. in
  1163. 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");
  1164. let rec loop i =
  1165. Common.raw_define con ("java" ^ (string_of_int i));
  1166. if i > 0 then loop (i - 1)
  1167. in
  1168. loop java_ver