HaxeFoundation.haxe/src/codegen/javaModern.ml

open Globals
open Ast
open ExtString
open NativeLibraries

module AccessFlags = struct
	type t =
		| MPublic
		| MPrivate
		| MProtected
		| MStatic
		| MFinal
		| MSynchronized
		| MBridge
		| MVarargs
		| MNative
		| MInterface
		| MAbstract
		| MStrict
		| MSynthetic
		| MAnnotation
		| MEnum

	let to_int = function
		| MPublic -> 0x1
		| MPrivate -> 0x2
		| MProtected -> 0x4
		| MStatic -> 0x8
		| MFinal -> 0x10
		| MSynchronized -> 0x20
		| MBridge -> 0x40
		| MVarargs -> 0x80
		| MNative -> 0x100
		| MInterface -> 0x200
		| MAbstract -> 0x400
		| MStrict -> 0x800
		| MSynthetic -> 0x1000
		| MAnnotation -> 0x2000
		| MEnum -> 0x4000

	let has_flag b flag =
		b land (to_int flag) <> 0
end

module JDataHoldovers = struct
	type jwildcard =
		| WExtends (* + *)
		| WSuper (* -  *)
		| WNone

	type jtype_argument =
		| TType of jwildcard * jsignature
		| TAny (* * *)

	and jsignature =
		| TByte (* B *)
		| TChar (* C *)
		| TDouble (* D *)
		| TFloat (* F *)
		| TInt (* I *)
		| TLong (* J *)
		| TShort (* S *)
		| TBool (* Z *)
		| TObject of path * jtype_argument list (* L Classname *)
		| TObjectInner of (string list) * (string * jtype_argument list) list (* L Classname ClassTypeSignatureSuffix *)
		| TArray of jsignature * int option (* [ *)
		| TMethod of jmethod_signature (* ( *)
		| TTypeParameter of string (* T *)

	(* ( jsignature list ) ReturnDescriptor (| V | jsignature) *)
	and jmethod_signature = jsignature list * jsignature option

	type jtypes = (string * jsignature option * jsignature list) list

	type jannotation = {
		ann_type : jsignature;
		ann_elements : (string * jannotation_value) list;
	}

	and jannotation_value =
		| ValConst of jsignature * int
		| ValEnum of jsignature * string (* e *)
		| ValClass of jsignature (* c *) (* V -> Void *)
		| ValAnnotation of jannotation (* @ *)
		| ValArray of jannotation_value list (* [ *)
end

open JDataHoldovers

module JReaderHoldovers = struct
	open JDataHoldovers

	let rec parse_type_parameter_part s = match s.[0] with
		| '*' -> TAny, 1
		| c ->
			let wildcard, i = match c with
			| '+' -> WExtends, 1
			| '-' -> WSuper, 1
			| _ -> WNone, 0
			in
			let jsig, l = parse_signature_part (String.sub s i (String.length s - 1)) in
			(TType (wildcard, jsig), l + i)

	and parse_signature_part s =
		let len = String.length s in
		if len = 0 then raise Exit;
		match s.[0] with
		| 'B' -> TByte, 1
		| 'C' -> TChar, 1
		| 'D' -> TDouble, 1
		| 'F' -> TFloat, 1
		| 'I' -> TInt, 1
		| 'J' -> TLong, 1
		| 'S' -> TShort, 1
		| 'Z' -> TBool, 1
		| 'L' ->
			(try
			let orig_s = s in
			let rec loop start i acc =
				match s.[i] with
				| '/' -> loop (i + 1) (i + 1) (String.sub s start (i - start) :: acc)
				| ';' | '.' -> List.rev acc, (String.sub s start (i - start)), [], (i)
				| '<' ->
				let name = String.sub s start (i - start) in
				let rec loop_params i acc =
					let s = String.sub s i (len - i) in
					match s.[0] with
					| '>' -> List.rev acc, i + 1
					| _ ->
					let tp, l = parse_type_parameter_part s in
					loop_params (l + i) (tp :: acc)
				in
				let params, _end = loop_params (i + 1) [] in
				List.rev acc, name, params, (_end)
				| _ -> loop start (i+1) acc
			in
			let pack, name, params, _end = loop 1 1 [] in
			let rec loop_inner i acc =
				match s.[i] with
				| '.' ->
				let pack, name, params, _end = loop (i+1) (i+1) [] in
				if pack <> [] then failwith ("Inner types must not define packages. For '" ^ orig_s ^ "'.");
				loop_inner _end ( (name,params) :: acc )
				| ';' -> List.rev acc, i + 1
				| c -> failwith ("End of complex type signature expected after type parameter. Got '" ^ Char.escaped c ^ "' for '" ^ orig_s ^ "'." );
			in
			let inners, _end = loop_inner _end [] in
			match inners with
			| [] -> TObject((pack,name), params), _end
			| _ -> TObjectInner( pack, (name,params) :: inners ), _end
			with
			Invalid_string -> raise Exit)
		| '[' ->
			let p = ref 1 in
			while !p < String.length s && s.[!p] >= '0' && s.[!p] <= '9' do
			incr p;
			done;
			let size = (if !p > 1 then Some (int_of_string (String.sub s 1 (!p - 1))) else None) in
			let s , l = parse_signature_part (String.sub s !p (String.length s - !p)) in
			TArray (s,size) , l + !p
		| '(' ->
			let p = ref 1 in
			let args = ref [] in
			while !p < String.length s && s.[!p] <> ')' do
			let a , l = parse_signature_part (String.sub s !p (String.length s - !p)) in
			args := a :: !args;
			p := !p + l;
			done;
			incr p;
			if !p >= String.length s then raise Exit;
			let ret , l = (match s.[!p] with 'V' -> None , 1 | _ ->
			let s, l = parse_signature_part (String.sub s !p (String.length s - !p)) in
			Some s, l
			) in
			TMethod (List.rev !args,ret) , !p + l
		| 'T' ->
			(try
			let s1 , _ = String.split s ";" in
			let len = String.length s1 in
			TTypeParameter (String.sub s1 1 (len - 1)) , len + 1
			with
			Invalid_string -> raise Exit)
		| _ ->
			raise Exit

	let parse_signature s =
		try
			let sign , l = parse_signature_part s in
			if String.length s <> l then raise Exit;
			sign
		with
			Exit -> failwith ("Invalid signature '" ^ s ^ "'")

	let parse_method_signature s =
		match parse_signature s with
		| (TMethod m) -> m
		| _ -> failwith ("Unexpected signature '" ^ s ^ "'. Expecting method")

	let parse_formal_type_params s = match s.[0] with
		| '<' ->
			let rec read_id i = match s.[i] with
				| ':' | '>' -> i
				| _ -> read_id (i + 1)
			in
			let len = String.length s in
			let rec parse_params idx acc =
				let idi = read_id (idx + 1) in
				let id = String.sub s (idx + 1) (idi - idx - 1) in
				(* next must be a : *)
				(match s.[idi] with | ':' -> () | _ -> failwith ("Invalid formal type signature character: " ^ Char.escaped s.[idi] ^ " ; from " ^ s));
				let ext, l = match s.[idi + 1] with
					| ':' | '>' ->
						None, idi + 1
					| _ ->
						let sgn, l = parse_signature_part (String.sub s (idi + 1) (len - idi - 1)) in
						Some sgn, l + idi + 1
				in
				let rec loop idx acc =
					match s.[idx] with
					| ':' ->
						let ifacesig, ifacei = parse_signature_part (String.sub s (idx + 1) (len - idx - 1)) in
						loop (idx + ifacei + 1) (ifacesig :: acc)
					| _ ->
						acc, idx
				in
				let ifaces, idx = loop l [] in
				let acc = (id, ext, ifaces) :: acc in
				if s.[idx] = '>' then List.rev acc, idx + 1 else parse_params (idx - 1) acc
			in
			parse_params 0 []
		| _ -> [], 0

	let parse_throws s =
		let len = String.length s in
		let rec loop idx acc =
			if idx > len then raise Exit
			else if idx = len then acc, idx
			else match s.[idx] with
			| '^' ->
			let tsig, l = parse_signature_part (String.sub s (idx+1) (len - idx - 1)) in
			loop (idx + l + 1) (tsig :: acc)
			| _ -> acc, idx
		in
		loop 0 []

	let parse_complete_method_signature s =
		try
			let len = String.length s in
			let tparams, i = parse_formal_type_params s in
			let sign, l = parse_signature_part (String.sub s i (len - i)) in
			let throws, l2 = parse_throws (String.sub s (i+l) (len - i - l)) in
			if (i + l + l2) <> len then raise Exit;

			match sign with
			| TMethod msig -> tparams, msig, throws
			| _ -> raise Exit
		with
			Exit -> failwith ("Invalid method extended signature '" ^ s ^ "'")
end

module JReaderModern = struct
	open IO
	open IO.BigEndian

	open JReaderHoldovers

	type constant_pool = {
		strings : string array;
		paths : path array;
		name_and_types : (string * string) array;
	}

	type jlocal = {
		ld_start_pc : int;
		ld_length : int;
		ld_name : string;
		ld_descriptor : string;
		ld_index : int;
	}

	type jattribute =
		| AttrCode of jattribute list
		| AttrDeprecated
		| AttrLocalVariableTable of jlocal list
  		| AttrMethodParameters of (string * int) list
		| AttrSignature of string
		| AttrVisibleAnnotations of jannotation list
  		| AttrOther

	type jfield = {
		jf_name : string;
		jf_flags : int;
		jf_types : jtypes;
		jf_descriptor : jsignature;
		jf_attributes : jattribute list;
		jf_code : jattribute list option;
	}

	type jclass = {
		jc_path : path;
		jc_flags : int;
		jc_super : jsignature;
		jc_interfaces : jsignature list;
		jc_types : jtypes;
		jc_fields : jfield list;
		jc_methods : jfield list;
		jc_attributes : jattribute list;
	}

	let read_constant_pool ch =
		let count = read_ui16 ch in
		let strings = Array.make count "" in
		let paths = Array.make count 0 in
		let name_and_types = Array.make count (0,0) in
		let i = ref 1 in
		while !i < count do
			begin match read_byte ch with
			| 1 ->
				strings.(!i) <- nread_string ch (read_ui16 ch)
			| 3 ->
				ignore(read_real_i32 ch)
			| 4 ->
				ignore(read_float32 ch)
			| 5 ->
				incr i;
				ignore(read_i64 ch)
			| 6 ->
				incr i;
				ignore(read_double ch)
			| 7 ->
				paths.(!i) <- read_ui16 ch
			| 8 ->
				ignore(read_ui16 ch)
			| 9 | 10 | 11 ->
				ignore(read_ui16 ch);
				ignore(read_ui16 ch);
			| 12 ->
				let name = read_ui16 ch in
				let t = read_ui16 ch in
				name_and_types.(!i) <- (name,t);
			| 15 ->
				ignore(read_byte ch);
				ignore(read_ui16 ch);
			| 16 ->
				ignore(read_ui16 ch);
			| 17 | 18 ->
				ignore(read_ui16 ch);
				ignore(read_ui16 ch);
			| 19 | 20 ->
				ignore(read_ui16 ch);
			| i ->
				failwith (Printf.sprintf "Invalid constant pool byte: %i" i);
			end;
			incr i;
		done;
		let as_path s = match List.rev (String.nsplit s "/") with
			| [x] -> [],x
			| x :: l -> List.rev l,x
			| [] -> assert false
		in
		let paths = Array.map (fun index ->
			if index > 0 then as_path (strings.(index))
			else ([],"")
		) paths in
		let name_and_types = Array.map (fun (name,t) ->
			let name = if name > 0 then strings.(name) else "" in
			let t = if t > 0 then strings.(t) else "" in
			(name,t)
		) name_and_types in
		{strings;paths;name_and_types}


	let rec parse_element_value consts ch =
		let tag = IO.read_byte ch in
		match Char.chr tag with
		| 'B' | 'C' | 'D' | 'F' | 'I' | 'J' | 'S' | 'Z' | 's' ->
			let jsig = match (Char.chr tag) with
				| 's' ->
					TObject( (["java";"lang"],"String"), [] )
				| tag ->
					fst (parse_signature_part (Char.escaped tag))
			in
			ValConst(jsig,(read_ui16 ch))
		| 'e' ->
			let path = parse_signature (consts.strings.(read_ui16 ch)) in
			let name = consts.strings.(read_ui16 ch) in
			ValEnum (path, name)
		| 'c' ->
			let name = consts.strings.(read_ui16 ch) in
			let jsig = if name = "V" then
				TObject(([], "Void"), [])
			else
				parse_signature name
			in
			ValClass jsig
		| '@' ->
			ValAnnotation (parse_annotation consts ch)
		| '[' ->
			let num_vals = read_ui16 ch in
			ValArray (ExtList.List.init (num_vals) (fun _ -> parse_element_value consts ch))
		| tag ->
			failwith ("Invalid element value: '" ^  Char.escaped tag ^ "'")

	and parse_ann_element consts ch =
		let name = consts.strings.(read_ui16 ch) in
		let element_value = parse_element_value consts ch in
		name, element_value

	and parse_annotation consts ch =
		let anntype = parse_signature (consts.strings.(read_ui16 ch)) in
		let count = read_ui16 ch in
		{
			ann_type = anntype;
			ann_elements = ExtList.List.init count (fun _ -> parse_ann_element consts ch)
		}

	let rec parse_attribute consts ch =
		let name = consts.strings.(read_ui16 ch) in
		let length = read_i32 ch in
		match name with
		| "Code" ->
			ignore(read_ui16 ch); (* max stack *)
			ignore(read_ui16 ch); (* max locals *)
			let len = read_i32 ch in
			ignore(IO.nread_string ch len); (* code *)
			let len = read_ui16 ch in
			for _ = 0 to len - 1 do
				ignore(IO.nread_string ch 8);
			done; (* exceptions *)
			let attribs = parse_attributes consts ch in
			AttrCode attribs
		| "Deprecated" ->
			AttrDeprecated
		| "LocalVariableTable" ->
			let len = read_ui16 ch in
			let locals = ExtList.List.init len (fun _ ->
				let start_pc = read_ui16 ch in
				let length = read_ui16 ch in
				let name = consts.strings.(read_ui16 ch) in
				let descriptor = consts.strings.(read_ui16 ch) in
				let index = read_ui16 ch in
				{
					ld_start_pc = start_pc;
					ld_length = length;
					ld_name = name;
					ld_descriptor = descriptor;
					ld_index = index
				}
			) in
			AttrLocalVariableTable locals
		| "MethodParameters" ->
			let len = IO.read_byte ch in
			let parameters = ExtList.List.init len (fun _ ->
				let name = consts.strings.(read_ui16 ch) in
				let flags = read_ui16 ch in
				(name,flags)
			) in
			AttrMethodParameters parameters
		| "RuntimeVisibleAnnotations" ->
    		let count = read_ui16 ch in
    		AttrVisibleAnnotations (ExtList.List.init count (fun _ -> parse_annotation consts ch))
		| "Signature" ->
			let s = consts.strings.(read_ui16 ch) in
			AttrSignature s
		| _ ->
			ignore(nread ch length);
			AttrOther

	and parse_attributes consts ch =
		Array.to_list (Array.init (read_ui16 ch) (fun _ ->
			parse_attribute consts ch
		))

	let parse_field consts is_method ch =
		let flags = read_ui16 ch in
		let name = consts.strings.(read_ui16 ch) in
		let descriptor = consts.strings.(read_ui16 ch) in
		let attributes = parse_attributes consts ch in
		let types = ref [] in
		let jsig = ref None in
		let code = ref None in
		List.iter (function
			| AttrCode code' ->
				code := Some code'
			| AttrSignature s ->
				if is_method then begin
					let tp, sgn, thr = parse_complete_method_signature s in
					types := tp;
					jsig := Some (TMethod(sgn));
				end else
					jsig := Some (parse_signature s)
			| _ ->
				()
		) attributes;
		{
			jf_name = name;
			jf_flags = flags;
			jf_types = !types;
			jf_descriptor = (match !jsig with
				| None -> parse_signature descriptor;
				| Some jsig -> jsig);
			jf_attributes = attributes;
			jf_code = !code;
		}

	let parse_class ch =
		if read_real_i32 ch <> 0xCAFEBABEl then failwith "Invalid header";
		let _ = read_ui16 ch in
		let _ = read_ui16 ch in
		let consts = read_constant_pool ch in
		let flags = read_ui16 ch in
		let this = consts.paths.(read_ui16 ch) in
		let super = TObject(consts.paths.(read_ui16 ch),[]) in
		let interfaces = ExtList.List.init (read_ui16 ch) (fun _ ->
			TObject(consts.paths.(read_ui16 ch),[])
		) in
		let fields = ExtList.List.init (read_ui16 ch) (fun _ -> parse_field consts false ch) in
		let methods = ExtList.List.init (read_ui16 ch) (fun _ -> parse_field consts true ch) in
		let attributes = parse_attributes consts ch in
		let types = ref [] in
		let interfaces = ref interfaces in
		let super = ref super in
		List.iter (function
			| AttrSignature s ->
				let formal, idx = parse_formal_type_params s in
				types := formal;
				let s = String.sub s idx (String.length s - idx) in
				let len = String.length s in
				let sup, idx = parse_signature_part s in
				let rec loop idx acc =
					if idx = len then
					acc
					else begin
					let s = String.sub s idx (len - idx) in
					let iface, i2 = parse_signature_part s in
					loop (idx + i2) (iface :: acc)
					end
				in
				interfaces := loop idx [];
				super := sup;
			| _ ->
				()
		) attributes;
		{
			jc_path = this;
			jc_flags = flags;
			jc_super = !super;
			jc_interfaces = !interfaces;
			jc_types = !types;
			jc_fields = fields;
			jc_methods = methods;
			jc_attributes = attributes;
		}
end

module PathConverter = struct
	let jname_to_hx name =
		let name =
			if name <> "" && (String.get name 0 < 'A' || String.get name 0 > 'Z') then
				Char.escaped (Char.uppercase_ascii (String.get name 0)) ^ String.sub name 1 (String.length name - 1)
			else
				name
		in
		let name = String.concat "__" (String.nsplit name "_") in
		match String.nsplit name "$" with
		| [] ->
			die "" __LOC__
		| [_] ->
			None,name
		| [x;""] ->
			None,x ^ "_" (* trailing $ *)
		| x :: l ->
			let name = String.concat "_" (x :: l) in
			if x = "" then None,name (* leading $ *)
			else Some x,name

	let normalize_pack pack =
		List.map (function
			| "" -> ""
			| str when String.get str 0 >= 'A' && String.get str 0 <= 'Z' ->
				String.lowercase str
			| str -> str
		) pack

	let jpath_to_hx (pack,name) =
		let pack,name = match pack,name with
		| ["haxe";"root"],name ->
			[],name
		| "com" :: ("oracle" | "sun") :: _, _
		| "javax" :: _, _
		| "org" :: ("ietf" | "jcp" | "omg" | "w3c" | "xml") :: _, _
		| "sun" :: _, _
		| "sunw" :: _, _ ->
			"java" :: pack,name
		| _ ->
			pack,name
		in
		let pack = normalize_pack pack in
		pack,jname_to_hx name

	let jpath_to_path (pack,(mname,name)) =
		let pack,name = match mname with
			| None -> pack,name
			| Some mname -> pack @ [mname],name
		in
		pack,name

	let is_haxe_keyword = function
		| "cast" | "extern" | "function" | "in" | "typedef" | "using" | "var" | "untyped" | "inline" -> true
		| _ -> false
end

type java_lib_ctx = {
	type_params : (string,complex_type) PMap.t;
}

module SignatureConverter = struct
	open PathConverter

	let mk_type_path path params p =
		let pack,(mname,name) = jpath_to_hx path in
		let path = match mname with
		| None ->
			{
				tpackage = pack;
				tname = name;
				tparams = params;
				tsub = None;
			}
		| Some mname ->
			{
				tpackage = pack;
				tname = mname;
				tparams = params;
				tsub = Some name;
			}
		in
		make_ptp_ct path p

	let ct_type_param name = make_ptp_ct_null {
		tpackage = [];
		tname = name;
		tparams = [];
		tsub = None
	}

	let ct_void = make_ptp_ct_null {
		tpackage = [];
		tname = "Void";
		tparams = [];
		tsub = None;
	}

	let ct_dynamic = make_ptp_ct_null {
		tpackage = [];
		tname = "Dynamic";
		tparams = [];
		tsub = None;
	}

	let ct_string = make_ptp_ct_null {
		tpackage = [];
		tname = "String";
		tparams = [];
		tsub = None;
	}

	let rec convert_arg ctx p arg =
		match arg with
		| TAny | TType (WSuper, _) -> TPType (mk_type_path ([], "Dynamic") [] p,p)
		| TType (_, jsig) -> TPType (convert_signature ctx p jsig,p)

	and convert_signature ctx p jsig =
		match jsig with
		| TByte -> mk_type_path (["java"; "types"], "Int8") [] p
		| TChar -> mk_type_path (["java"; "types"], "Char16") [] p
		| TDouble -> mk_type_path ([], "Float") [] p
		| TFloat -> mk_type_path ([], "Single") [] p
		| TInt -> mk_type_path ([], "Int") [] p
		| TLong -> mk_type_path (["haxe"], "Int64") [] p
		| TShort -> mk_type_path (["java"; "types"], "Int16") [] p
		| TBool -> mk_type_path ([], "Bool") [] p
		| TObject ( (["haxe";"root"], name), args ) -> mk_type_path ([], name) (List.map (convert_arg ctx p) args) p
		| TObject ( (["java";"lang"], "Object"), [] ) -> mk_type_path ([], "Dynamic") [] p
		| TObject ( (["java";"lang"], "String"), [] ) -> mk_type_path ([], "String") [] p
		| TObject ( (["java";"lang"], "Enum"), [_] ) -> mk_type_path ([], "EnumValue") [] p
		| TObject ( path, [] ) ->
			mk_type_path path [] p
		| TObject ( path, args ) -> mk_type_path path (List.map (convert_arg ctx p) args) p
		| TObjectInner (pack, (name, params) :: inners) ->
			let actual_param = match List.rev inners with
			| (_, p) :: _ -> p
			| _ -> die "" __LOC__ in
			mk_type_path (pack, name ^ "$" ^ String.concat "$" (List.map fst inners)) (List.map (fun param -> convert_arg ctx p param) actual_param) p
		| TObjectInner (pack, inners) -> die "" __LOC__
		| TArray (jsig, _) -> mk_type_path (["java"], "NativeArray") [ TPType (convert_signature ctx p jsig,p) ] p
		| TMethod _ -> failwith "TMethod cannot be converted directly into Complex Type"
		| TTypeParameter s ->
			try
				PMap.find s ctx.type_params
			with Not_found ->
				ct_dynamic
end

let get_type_path ct = match ct with | CTPath ptp -> ptp | _ -> die "" __LOC__

module Converter = struct

	open JReaderModern
	open PathConverter
	open SignatureConverter

	let extract_retention_policy l =
		let rec loop2 l = match l with
			| [] ->
				None
			| ann :: l ->
				match ann.ann_type,ann.ann_elements with
				| TObject((["java";"lang";"annotation"],"Retention"),_),[("value",ValEnum(_,name))] ->
					Some name
				| _ ->
					loop2 l
		in
		let rec loop l = match l with
			| [] ->
				None
			| AttrVisibleAnnotations l :: _ ->
				loop2 l
			| _ :: l ->
				loop l
		in
		loop l

	let convert_type_parameter ctx (name,extends,implements) p =
		let jsigs = match extends with
			| Some jsig -> jsig :: implements
			| None -> implements
		in
		let constraints = ExtList.List.filter_map (fun jsig -> match jsig with
			| TTypeParameter name' when name = name' ->
				None
			| _ ->
				Some (convert_signature ctx p jsig,p)
		) jsigs in
		let tp = {
			tp_name = (name,p);
			tp_params = [];
			tp_meta = [];
			tp_default = None;
			tp_constraints = match constraints with
				| [] -> None
				| _ -> Some (CTIntersection constraints,p);
		} in
		tp

	let convert_enum (jc : jclass) (file : string) =
		let p = {
			pfile = file;
			pmin = 0;
			pmax = 0
		} in
		let meta = ref [] in
		let add_meta m = meta := m :: !meta in
		let data = ref [] in
		List.iter (fun (jf : jfield) ->
			match jf.jf_descriptor with
			| TObject( path, [] ) when path = jc.jc_path && AccessFlags.has_flag jf.jf_flags MStatic && AccessFlags.has_flag jf.jf_flags MFinal ->
				data := { ec_name = jf.jf_name,p; ec_doc = None; ec_meta = []; ec_args = []; ec_pos = p; ec_params = []; ec_type = None; } :: !data;
			| _ -> ()
		) jc.jc_fields;
		let _,class_name = jname_to_hx (snd jc.jc_path) in
		add_meta (Meta.Native, [EConst (String (s_type_path jc.jc_path,SDoubleQuotes) ),p],p);
		let d = {
			d_name = (class_name,p);
			d_doc = None;
			d_params = []; (* enums never have type parameters *)
			d_meta = !meta;
			d_flags = [EExtern];
			d_data = List.rev !data;
		} in
		(EEnum d,p)

	let type_param_lut acc params =
		List.fold_left (fun acc (s,_,_) ->
			PMap.add s (ct_type_param s) acc
		) acc params

	(**
		`haxe.Rest<T>` auto-boxes primitive types.
		That means we can't use it as varargs for extern methods.
		E.g externs with `int` varargs are represented as `int[]` at run time
		while `haxe.Rest<Int>` is actually `java.lang.Integer[]`.
	*)
	let is_eligible_for_haxe_rest_args arg_type =
		match arg_type with
		| TByte | TChar | TDouble | TFloat | TInt | TLong | TShort | TBool -> false
		| _ -> true

	let convert_field ctx is_method (jc : jclass) (is_interface : bool) (jf : jfield) p =
		let ctx = {
			type_params = type_param_lut ctx.type_params jf.jf_types;
		} in
		let p = {p with pfile = p.pfile ^ "@" ^ jf.jf_name} in
		let is_static = AccessFlags.has_flag jf.jf_flags MStatic in
		let access = ref [] in
		let meta = ref [] in
		let add_access a = access := a :: !access in
		let add_meta m = meta := m :: !meta in
		if is_static then add_access (AStatic,p);
		List.iter (function
			| AttrDeprecated when jc.jc_path <> (["java";"util"],"Date") ->
				add_meta (Meta.Deprecated,[],p);
			| AttrVisibleAnnotations ann ->
				List.iter (function
					| { ann_type = TObject( (["java";"lang"], "Override"), [] ) } ->
						add_access (AOverride,null_pos);
					| _ -> ()
				) ann
			| AttrCode _ when is_interface ->
				add_meta (Meta.JavaDefault,[],p)
			| _ -> ()
		) jf.jf_attributes;
		let add_native_meta () =
			add_meta (Meta.Native, [EConst (String (jf.jf_name,SDoubleQuotes) ),p],p)
		in
		let name = match String.nsplit jf.jf_name "$" with
			| ["<init>"] ->
				"new"
			| [name] ->
				if is_haxe_keyword name then begin
					add_native_meta();
					"_" ^ name
				end else
					name
			| parts ->
				add_native_meta();
				String.concat "_" parts
		in
		if is_method then add_access (AOverload,p);
		if AccessFlags.has_flag jf.jf_flags MFinal then add_access (AFinal,p);
		if not is_interface && AccessFlags.has_flag jf.jf_flags MAbstract then add_access (AAbstract,p);
		let extract_local_names () =
			let default i =
				"param" ^ string_of_int i
			in
			let rec loop attribs = match attribs with
				| AttrLocalVariableTable locals :: _ ->
					let shift = if is_static then 0 else -1 in
					List.map (fun loc ->
						loc.ld_index + shift,loc.ld_name
					) locals
				| AttrMethodParameters l :: _ ->
					List.mapi (fun i (name,_) ->
						(i,name)
					) l
				| _ :: attribs ->
					loop attribs
				| [] ->
					raise Not_found
			in
			let use locals =
				let h = Hashtbl.create 0 in
				List.iter (fun (index,name) ->
					Hashtbl.replace h index name
				) locals;
				(fun i ->
					try Hashtbl.find h (i - 1) (* they are 1-based *)
					with Not_found -> "param" ^ string_of_int i
				)
			in
			try
				use (loop jf.jf_attributes)
			with Not_found -> try
				match jf.jf_code with
				| None ->
					default
				| Some attribs ->
					use (loop attribs)
			with Not_found ->
				default
		in
		let kind = if not is_method then
				FVar(Some (convert_signature ctx p jf.jf_descriptor,p),None)
			else
				begin match jf.jf_descriptor with
				| TMethod(args,ret) ->
					let local_names = extract_local_names() in
					let args_count = List.length args
					and is_varargs = AccessFlags.has_flag jf.jf_flags MVarargs in
					let convert_arg i jsig =
						let name = local_names (i + 1) in
						let hx_sig =
							match jsig with
							| TArray (jsig1,_) when is_varargs && i + 1 = args_count && is_eligible_for_haxe_rest_args jsig1 ->
								mk_type_path (["haxe"], "Rest") [TPType (convert_signature ctx p jsig1,p)] p
							| _ ->
								convert_signature ctx p jsig
						in
						((name,p),false,[],Some (hx_sig,p),None)
					in
					let f = {
						f_params = List.map (fun tp -> convert_type_parameter ctx tp p) jf.jf_types;
						f_args = List.mapi convert_arg args;
						f_type = Some (Option.map_default (fun jsig -> convert_signature ctx p jsig,p) (ct_void,p) ret);
						f_expr = None;
					} in
					FFun f
				| _ ->
					assert false
				end
		in
		let cff = {
			cff_name = (name,p);
			cff_doc = None;
			cff_pos = p;
			cff_meta = !meta;
			cff_access = !access;
			cff_kind = kind;
		} in
		cff

	let convert_class ctx (jc : jclass) (file : string) =
		let p = {
			pfile = file;
			pmin = 0;
			pmax = 0
		} in
		let flags = ref [HExtern] in
		let meta = ref [] in
		let add_flag f = flags := f :: !flags in
		let add_meta m = meta := m :: !meta in
		add_meta (Meta.LibType,[],p);
		let is_interface = AccessFlags.has_flag jc.jc_flags MInterface in
		if is_interface then add_flag HInterface
		else if AccessFlags.has_flag jc.jc_flags MAbstract then add_flag HAbstract;
		let is_annotation = AccessFlags.has_flag jc.jc_flags MAnnotation in
		begin match jc.jc_super with
			| TObject(([],""),_)
			| TObject((["java";"lang"],"Object"),_) ->
				if is_annotation then
					add_flag (HExtends (make_ptp {tpackage = ["java";"lang";"annotation"]; tname = "Annotation"; tsub = None; tparams = []} p))
			| jsig ->
				add_flag (HExtends (get_type_path (convert_signature ctx p jsig)))
		end;
		List.iter (fun jsig ->
			let path = get_type_path (convert_signature ctx p jsig) in
			if is_interface then
				add_flag (HExtends path)
			else
				add_flag (HImplements path)
		) jc.jc_interfaces;
		let fields = DynArray.create () in
		let known_names = Hashtbl.create 0 in
		let known_sigs = Hashtbl.create 0 in
		let should_generate jf =
			not (AccessFlags.has_flag jf.jf_flags MPrivate)
			(* We might need member synthetics for proper call resolution, but we should never need static ones (issue #10279). *)
			&& (not (AccessFlags.has_flag jf.jf_flags MSynthetic) || not (AccessFlags.has_flag jf.jf_flags MStatic))
			&& jf.jf_name <> "<clinit>"
		in
		if jc.jc_path <> (["java";"lang"], "CharSequence") then begin
			List.iter (fun jf ->
				if should_generate jf then begin
					Hashtbl.replace known_names jf.jf_name jf;
					let sig_key = match jf.jf_descriptor with
						| TMethod(jsigs,_) -> TMethod(jsigs,None) (* lack of return type variance *)
						| jsig -> jsig
					in
					let key = (jf.jf_name,sig_key) in
					if not (Hashtbl.mem known_sigs key) then begin
						Hashtbl.add known_sigs key jf;
						DynArray.add fields (convert_field ctx true jc is_interface jf p)
					end
				end
			) jc.jc_methods;
			List.iter (fun jf ->
				if should_generate jf then begin
					if not (Hashtbl.mem known_names jf.jf_name) then begin
						Hashtbl.add known_names jf.jf_name jf;
						DynArray.add fields (convert_field ctx false jc is_interface jf p)
					end
				end
			) jc.jc_fields;
		end;
		let _,class_name = jname_to_hx (snd jc.jc_path) in
		add_meta (Meta.Native, [EConst (String (s_type_path jc.jc_path,SDoubleQuotes) ),p],p);
		if is_annotation then begin
			let args = match extract_retention_policy jc.jc_attributes with
				| None ->
					[]
				| Some v ->
					[EConst (String(v,SDoubleQuotes)),p]
			in
			add_meta (Meta.Annotation,args,p)
		end;
		let d = {
			d_name = (class_name,p);
			d_doc = None;
			d_params = List.map (fun tp -> convert_type_parameter ctx tp p) jc.jc_types;
			d_meta = !meta;
			d_flags = !flags;
			d_data = DynArray.to_list fields;
		} in
		(EClass d,p)

	let convert_type ctx jc file =
		if AccessFlags.has_flag jc.jc_flags MEnum then convert_enum jc file else convert_class ctx jc file

	let convert_module pack jcs =
		let types = List.map (fun (jc,_,file) ->
			let ctx = {
				type_params = type_param_lut PMap.empty jc.jc_types;
			} in
			convert_type ctx jc file;
		) jcs in
		(pack,types)
end

class java_library_modern com name file_path = object(self)
	inherit [java_lib_type,unit] native_library name file_path as super


	val zip = lazy (Zip.open_in file_path)
	val mutable cached_files = []
	val modules = Hashtbl.create 0
	val mutable loaded = false
	val mutable closed = false

	method load =
		if not loaded then begin
			loaded <- true;
			let close = Timer.timer ["jar";"load"] in
			List.iter (function
				| ({ Zip.is_directory = false; Zip.filename = filename } as entry) when String.ends_with filename ".class" ->
					let pack = String.nsplit filename "/" in
					begin match List.rev pack with
						| [] -> ()
						| name :: pack ->
							let name = String.sub name 0 (String.length name - 6) in
							let pack = List.rev pack in
							let pack,(mname,tname) = PathConverter.jpath_to_hx (pack,name) in
							let path = PathConverter.jpath_to_path (pack,(mname,tname)) in
							let mname = match mname with
								| None ->
									cached_files <- path :: cached_files;
									tname
								| Some mname -> mname
							in
							Hashtbl.add modules (pack,mname) (filename,entry);
						end
				| _ -> ()
			) (Zip.entries (Lazy.force zip));
			close();
		end

	method private read zip (filename,entry) =
		Std.finally (Timer.timer ["jar";"read"]) (fun () ->
			let data = Zip.read_entry zip entry in
			let jc = JReaderModern.parse_class (IO.input_string data) in
			(jc,file_path,file_path ^ "@" ^ filename)
		) ()

	method lookup path : java_lib_type =
		None

	method close =
		if not closed then begin
			closed <- true;
			Zip.close_in (Lazy.force zip)
		end

	method list_modules : path list =
		cached_files

	method build path (p : pos) : Ast.package option =
		let build path =
			if path = (["java";"lang"],"String") then
				None
			else begin
				try
					let entries = Hashtbl.find_all modules path in
					if entries = [] then raise Not_found;
					let zip = Lazy.force zip in
					let jcs = List.map (self#read zip) entries in
					Std.finally (Timer.timer ["jar";"convert"]) (fun () ->
						Some (Converter.convert_module (fst path) jcs)
					) ();
				with Not_found ->
					None
			end
		in
		build path

	method get_data = ()
end