java.ml 44 KB

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