hxbReader.ml 56 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157
  1. open Globals
  2. open Ast
  3. open Type
  4. open HxbData
  5. open HxbReaderApi
  6. type field_reader_context = {
  7. t_pool : Type.t Array.t;
  8. pos : pos ref;
  9. vars : tvar Array.t;
  10. mutable tthis : Type.t option;
  11. }
  12. let create_field_reader_context p ts vars tthis = {
  13. t_pool = ts;
  14. pos = ref p;
  15. vars = vars;
  16. tthis = tthis;
  17. }
  18. type hxb_reader_stats = {
  19. modules_fully_restored : int ref;
  20. modules_partially_restored : int ref;
  21. }
  22. let create_hxb_reader_stats () = {
  23. modules_fully_restored = ref 0;
  24. modules_partially_restored = ref 0;
  25. }
  26. module ClassFieldInfo = struct
  27. type t = {
  28. type_parameters : typed_type_param array;
  29. }
  30. let create params = {
  31. type_parameters = params;
  32. }
  33. end
  34. module ClassFieldInfos = struct
  35. type t = {
  36. infos : ClassFieldInfo.t DynArray.t;
  37. }
  38. let meta = Meta.HxbId
  39. let create () = {
  40. infos = DynArray.create ()
  41. }
  42. let get infos cf =
  43. let _,_,p = Meta.get meta cf.cf_meta in
  44. DynArray.get infos.infos p.pmin
  45. let unset infos cf =
  46. cf.cf_meta <- Meta.remove meta cf.cf_meta
  47. let set infos info cf =
  48. let index = DynArray.length infos.infos in
  49. DynArray.add infos.infos info;
  50. cf.cf_meta <- (meta,[],{null_pos with pmin = index}) :: cf.cf_meta
  51. end
  52. module BytesWithPosition = struct
  53. type t = {
  54. bytes : bytes;
  55. mutable pos : int;
  56. }
  57. let create bytes = {
  58. bytes;
  59. pos = 0;
  60. }
  61. let read_byte b =
  62. let i = Bytes.unsafe_get b.bytes b.pos in
  63. b.pos <- b.pos + 1;
  64. int_of_char i
  65. let read_bytes b length =
  66. let out = Bytes.create length in
  67. Bytes.blit b.bytes b.pos out 0 length;
  68. b.pos <- b.pos + length;
  69. out
  70. let read_i16 i =
  71. let ch2 = read_byte i in
  72. let ch1 = read_byte i in
  73. let n = ch1 lor (ch2 lsl 8) in
  74. if ch2 land 128 <> 0 then
  75. n - 65536
  76. else
  77. n
  78. let read_real_i32 ch =
  79. let ch1 = read_byte ch in
  80. let ch2 = read_byte ch in
  81. let ch3 = read_byte ch in
  82. let base = Int32.of_int (ch1 lor (ch2 lsl 8) lor (ch3 lsl 16)) in
  83. let big = Int32.shift_left (Int32.of_int (read_byte ch)) 24 in
  84. Int32.logor base big
  85. let read_i64 ch =
  86. let big = Int64.of_int32 (read_real_i32 ch) in
  87. let ch4 = read_byte ch in
  88. let ch3 = read_byte ch in
  89. let ch2 = read_byte ch in
  90. let ch1 = read_byte ch in
  91. let base = Int64.of_int (ch1 lor (ch2 lsl 8) lor (ch3 lsl 16)) in
  92. let small = Int64.logor base (Int64.shift_left (Int64.of_int ch4) 24) in
  93. Int64.logor (Int64.shift_left big 32) small
  94. let read_double ch =
  95. Int64.float_of_bits (read_i64 ch)
  96. end
  97. open BytesWithPosition
  98. let rec read_uleb128 ch =
  99. let b = read_byte ch in
  100. if b >= 0x80 then
  101. (b land 0x7F) lor ((read_uleb128 ch) lsl 7)
  102. else
  103. b
  104. let read_leb128 ch =
  105. let rec read acc shift =
  106. let b = read_byte ch in
  107. let acc = ((b land 0x7F) lsl shift) lor acc in
  108. if b >= 0x80 then
  109. read acc (shift + 7)
  110. else
  111. (b, acc, shift + 7)
  112. in
  113. let last, acc, shift = read 0 0 in
  114. let res = (if (last land 0x40) <> 0 then
  115. acc lor ((lnot 0) lsl shift)
  116. else
  117. acc) in
  118. res
  119. let dump_stats name stats =
  120. print_endline (Printf.sprintf "hxb_reader stats for %s" name);
  121. print_endline (Printf.sprintf " modules partially restored: %i" (!(stats.modules_partially_restored) - !(stats.modules_fully_restored)));
  122. print_endline (Printf.sprintf " modules fully restored: %i" !(stats.modules_fully_restored));
  123. class hxb_reader
  124. (mpath : path)
  125. (stats : hxb_reader_stats)
  126. (string_pool : string array option)
  127. (timers_enabled : bool)
  128. = object(self)
  129. val mutable api = Obj.magic ""
  130. val mutable full_restore = true
  131. val mutable current_module = null_module
  132. val mutable delayed_field_loading : (unit->unit) list = []
  133. val mutable ch = BytesWithPosition.create (Bytes.create 0)
  134. val mutable has_string_pool = (string_pool <> None)
  135. val mutable string_pool = (match string_pool with None -> Array.make 0 "" | Some pool -> pool)
  136. val mutable doc_pool = Array.make 0 ""
  137. val mutable classes = Array.make 0 (Lazy.from_val null_class)
  138. val mutable abstracts = Array.make 0 (Lazy.from_val null_abstract)
  139. val mutable enums = Array.make 0 (Lazy.from_val null_enum)
  140. val mutable typedefs = Array.make 0 (Lazy.from_val null_typedef)
  141. val mutable anons = Array.make 0 null_tanon
  142. val mutable anon_fields = Array.make 0 null_field
  143. val mutable tmonos = Array.make 0 (mk_mono())
  144. val mutable class_fields = Array.make 0 (Lazy.from_val null_field)
  145. val mutable enum_fields = Array.make 0 (Lazy.from_val null_enum_field)
  146. val mutable type_type_parameters = Array.make 0 (mk_type_param null_class TPHType None None)
  147. val mutable field_type_parameters = Array.make 0 (mk_type_param null_class TPHMethod None None)
  148. val mutable local_type_parameters = Array.make 0 (mk_type_param null_class TPHLocal None None)
  149. val mutable field_type_parameter_offset = 0
  150. val empty_anon = mk_anon (ref Closed)
  151. method set_delayed_field_loading f =
  152. delayed_field_loading <- f :: delayed_field_loading
  153. method resolve_type pack mname tname =
  154. try
  155. let mt = api#resolve_type pack mname tname in
  156. if not full_restore then begin
  157. let mdep = (t_infos mt).mt_module in
  158. if mdep != null_module && current_module.m_path != mdep.m_path then
  159. current_module.m_extra.m_display_deps <- Some (PMap.add mdep.m_id (create_dependency mdep MDepFromTyping) (Option.get current_module.m_extra.m_display_deps))
  160. end;
  161. mt
  162. with Not_found ->
  163. dump_backtrace();
  164. error (Printf.sprintf "[HXB] [%s] Cannot resolve type %s" (s_type_path current_module.m_path) (s_type_path ((pack @ [mname]),tname)))
  165. method get_string_pool =
  166. if has_string_pool then
  167. Some (string_pool)
  168. else
  169. None
  170. method make_lazy_type_dynamic f : Type.t =
  171. api#make_lazy_type t_dynamic f
  172. (* Primitives *)
  173. method read_i32 =
  174. read_real_i32 ch
  175. method read_i16 =
  176. read_i16 ch
  177. method read_f64 =
  178. read_double ch
  179. method read_bool =
  180. read_byte ch <> 0
  181. method read_from_string_pool pool =
  182. pool.(read_uleb128 ch)
  183. method read_string =
  184. self#read_from_string_pool string_pool
  185. method read_raw_string =
  186. let l = read_uleb128 ch in
  187. Bytes.unsafe_to_string (read_bytes ch l)
  188. (* Basic compounds *)
  189. method read_list : 'a . (unit -> 'a) -> 'a list = fun f ->
  190. let l = read_uleb128 ch in
  191. List.init l (fun _ -> f ())
  192. method read_option : 'a . (unit -> 'a) -> 'a option = fun f ->
  193. match read_byte ch with
  194. | 0 ->
  195. None
  196. | _ ->
  197. Some (f())
  198. method read_path =
  199. let pack = self#read_list (fun () -> self#read_string) in
  200. let name = self#read_string in
  201. (pack,name)
  202. method read_full_path =
  203. let pack = self#read_list (fun () -> self#read_string) in
  204. let mname = self#read_string in
  205. let tname = self#read_string in
  206. (pack,mname,tname)
  207. method read_documentation =
  208. let doc_own = self#read_option (fun () ->
  209. self#read_from_string_pool doc_pool
  210. ) in
  211. let doc_inherited = self#read_list (fun () ->
  212. self#read_from_string_pool doc_pool
  213. ) in
  214. {doc_own;doc_inherited}
  215. method read_pos =
  216. let file = self#read_string in
  217. let min = read_leb128 ch in
  218. let max = read_leb128 ch in
  219. let pos = {
  220. pfile = file;
  221. pmin = min;
  222. pmax = max;
  223. } in
  224. pos
  225. method read_pos_pair =
  226. let file = self#read_string in
  227. let min1 = read_leb128 ch in
  228. let max1 = read_leb128 ch in
  229. let min2 = read_leb128 ch in
  230. let max2 = read_leb128 ch in
  231. let pos1 = {
  232. pfile = file;
  233. pmin = min1;
  234. pmax = max1;
  235. } in
  236. let pos2 = {
  237. pos1 with
  238. pmin = pos1.pmin + min2;
  239. pmax = pos1.pmin + max2;
  240. } in
  241. pos1,pos2
  242. method read_metadata_entry : metadata_entry =
  243. let name = self#read_string in
  244. let p = self#read_pos in
  245. let el = self#read_list (fun () -> self#read_expr) in
  246. (Meta.from_string name,el,p)
  247. method read_metadata =
  248. self#read_list (fun () -> self#read_metadata_entry)
  249. (* References *)
  250. method read_class_ref =
  251. classes.(read_uleb128 ch)
  252. method read_abstract_ref =
  253. abstracts.(read_uleb128 ch)
  254. method read_enum_ref =
  255. enums.(read_uleb128 ch)
  256. method read_typedef_ref =
  257. typedefs.(read_uleb128 ch)
  258. method read_field_ref =
  259. let cf = class_fields.(read_uleb128 ch) in
  260. Lazy.force cf
  261. method read_enum_field_ref =
  262. let ef = enum_fields.(read_uleb128 ch) in
  263. Lazy.force ef
  264. method read_anon_ref =
  265. match read_byte ch with
  266. | 0 ->
  267. anons.(read_uleb128 ch)
  268. | 1 ->
  269. let an = anons.(read_uleb128 ch) in
  270. self#read_anon an;
  271. an
  272. | _ ->
  273. assert false
  274. method read_anon_field_ref =
  275. match read_byte ch with
  276. | 0 ->
  277. anon_fields.(read_uleb128 ch)
  278. | 1 ->
  279. let cf = anon_fields.(read_uleb128 ch) in
  280. self#read_class_field_and_overloads_data cf;
  281. cf
  282. | _ ->
  283. assert false
  284. (* Expr *)
  285. method get_binop i = match i with
  286. | 0 -> OpAdd
  287. | 1 -> OpMult
  288. | 2 -> OpDiv
  289. | 3 -> OpSub
  290. | 4 -> OpAssign
  291. | 5 -> OpEq
  292. | 6 -> OpNotEq
  293. | 7 -> OpGt
  294. | 8 -> OpGte
  295. | 9 -> OpLt
  296. | 10 -> OpLte
  297. | 11 -> OpAnd
  298. | 12 -> OpOr
  299. | 13 -> OpXor
  300. | 14 -> OpBoolAnd
  301. | 15 -> OpBoolOr
  302. | 16 -> OpShl
  303. | 17 -> OpShr
  304. | 18 -> OpUShr
  305. | 19 -> OpMod
  306. | 20 -> OpInterval
  307. | 21 -> OpArrow
  308. | 22 -> OpIn
  309. | 23 -> OpNullCoal
  310. | _ -> OpAssignOp (self#get_binop (i - 30))
  311. method get_unop i = match i with
  312. | 0 -> Increment,Prefix
  313. | 1 -> Decrement,Prefix
  314. | 2 -> Not,Prefix
  315. | 3 -> Neg,Prefix
  316. | 4 -> NegBits,Prefix
  317. | 5 -> Spread,Prefix
  318. | 6 -> Increment,Postfix
  319. | 7 -> Decrement,Postfix
  320. | 8 -> Not,Postfix
  321. | 9 -> Neg,Postfix
  322. | 10 -> NegBits,Postfix
  323. | 11 -> Spread,Postfix
  324. | _ -> assert false
  325. method read_placed_name =
  326. let s = self#read_string in
  327. let p = self#read_pos in
  328. (s,p)
  329. method read_type_path =
  330. let pack = self#read_list (fun () -> self#read_string) in
  331. let name = self#read_string in
  332. let tparams = self#read_list (fun () -> self#read_type_param_or_const) in
  333. let tsub = self#read_option (fun () -> self#read_string) in
  334. {
  335. tpackage = pack;
  336. tname = name;
  337. tparams = tparams;
  338. tsub = tsub;
  339. }
  340. method read_placed_type_path =
  341. let tp = self#read_type_path in
  342. let pfull,ppath = self#read_pos_pair in
  343. {
  344. path = tp;
  345. pos_full = pfull;
  346. pos_path = ppath;
  347. }
  348. method read_type_param =
  349. let pn = self#read_placed_name in
  350. let ttp = self#read_list (fun () -> self#read_type_param) in
  351. let tho = self#read_option (fun () -> self#read_type_hint) in
  352. let def = self#read_option (fun () -> self#read_type_hint) in
  353. let meta = self#read_metadata in
  354. {
  355. tp_name = pn;
  356. tp_params = ttp;
  357. tp_constraints = tho;
  358. tp_meta = meta;
  359. tp_default = def;
  360. }
  361. method read_type_param_or_const =
  362. match read_byte ch with
  363. | 0 -> TPType (self#read_type_hint)
  364. | 1 -> TPExpr (self#read_expr)
  365. | _ -> assert false
  366. method read_func_arg =
  367. let pn = self#read_placed_name in
  368. let b = self#read_bool in
  369. let meta = self#read_metadata in
  370. let tho = self#read_option (fun () -> self#read_type_hint) in
  371. let eo = self#read_option (fun () -> self#read_expr) in
  372. (pn,b,meta,tho,eo)
  373. method read_func =
  374. let params = self#read_list (fun () -> self#read_type_param) in
  375. let args = self#read_list (fun () -> self#read_func_arg) in
  376. let tho = self#read_option (fun () -> self#read_type_hint) in
  377. let eo = self#read_option (fun () -> self#read_expr) in
  378. {
  379. f_params = params;
  380. f_args = args;
  381. f_type = tho;
  382. f_expr = eo;
  383. }
  384. method read_complex_type =
  385. match read_byte ch with
  386. | 0 -> CTPath (self#read_placed_type_path)
  387. | 1 ->
  388. let thl = self#read_list (fun () -> self#read_type_hint) in
  389. let th = self#read_type_hint in
  390. CTFunction(thl,th)
  391. | 2 -> CTAnonymous (self#read_list (fun () -> self#read_cfield))
  392. | 3 -> CTParent (self#read_type_hint)
  393. | 4 ->
  394. let ptp = self#read_list (fun () -> self#read_placed_type_path) in
  395. let cffl = self#read_list (fun () -> self#read_cfield) in
  396. CTExtend(ptp,cffl)
  397. | 5 -> CTOptional (self#read_type_hint)
  398. | 6 ->
  399. let pn = self#read_placed_name in
  400. let th = self#read_type_hint in
  401. CTNamed(pn,th)
  402. | 7 -> CTIntersection (self#read_list (fun () -> self#read_type_hint))
  403. | _ -> assert false
  404. method read_type_hint =
  405. let ct = self#read_complex_type in
  406. let p = self#read_pos in
  407. (ct,p)
  408. method read_access =
  409. match read_byte ch with
  410. | 0 -> APublic
  411. | 1 -> APrivate
  412. | 2 -> AStatic
  413. | 3 -> AOverride
  414. | 4 -> ADynamic
  415. | 5 -> AInline
  416. | 6 -> AMacro
  417. | 7 -> AFinal
  418. | 8 -> AExtern
  419. | 9 -> AAbstract
  420. | 10 -> AOverload
  421. | 11 -> AEnum
  422. | _ -> assert false
  423. method read_placed_access =
  424. let ac = self#read_access in
  425. let p = self#read_pos in
  426. (ac,p)
  427. method read_cfield_kind =
  428. match read_byte ch with
  429. | 0 ->
  430. let tho = self#read_option (fun () -> self#read_type_hint) in
  431. let eo = self#read_option (fun () -> self#read_expr) in
  432. FVar(tho,eo)
  433. | 1 -> FFun (self#read_func)
  434. | 2 ->
  435. let pn1 = self#read_placed_name in
  436. let pn2 = self#read_placed_name in
  437. let tho = self#read_option (fun () -> self#read_type_hint) in
  438. let eo = self#read_option (fun () -> self#read_expr) in
  439. FProp(pn1,pn2,tho,eo)
  440. | _ -> assert false
  441. method read_cfield =
  442. let pn = self#read_placed_name in
  443. let doc = self#read_option (fun () -> self#read_documentation) in
  444. let pos = self#read_pos in
  445. let meta = self#read_metadata in
  446. let access = self#read_list (fun () -> self#read_placed_access) in
  447. let kind = self#read_cfield_kind in
  448. {
  449. cff_name = pn;
  450. cff_doc = doc;
  451. cff_pos = pos;
  452. cff_meta = meta;
  453. cff_access = access;
  454. cff_kind = kind;
  455. }
  456. method read_expr =
  457. let p = self#read_pos in
  458. let e = match read_byte ch with
  459. | 0 ->
  460. let s = self#read_string in
  461. let suffix = self#read_option (fun () -> self#read_string) in
  462. EConst (Int (s, suffix))
  463. | 1 ->
  464. let s = self#read_string in
  465. let suffix = self#read_option (fun () -> self#read_string) in
  466. EConst (Float (s, suffix))
  467. | 2 ->
  468. let s = self#read_string in
  469. let qs = begin match read_byte ch with
  470. | 0 -> SDoubleQuotes
  471. | 1 -> SSingleQuotes
  472. | _ -> assert false
  473. end in
  474. EConst (String (s,qs))
  475. | 3 ->
  476. EConst (Ident (self#read_string))
  477. | 4 ->
  478. let s1 = self#read_string in
  479. let s2 = self#read_string in
  480. EConst (Regexp(s1,s2))
  481. | 5 ->
  482. let e1 = self#read_expr in
  483. let e2 = self#read_expr in
  484. EArray(e1,e2)
  485. | 6 ->
  486. let op = self#get_binop (read_byte ch) in
  487. let e1 = self#read_expr in
  488. let e2 = self#read_expr in
  489. EBinop(op,e1,e2)
  490. | 7 ->
  491. let e = self#read_expr in
  492. let s = self#read_string in
  493. let kind = begin match read_byte ch with
  494. | 0 -> EFNormal
  495. | 1 -> EFSafe
  496. | _ -> assert false
  497. end in
  498. EField(e,s,kind)
  499. | 8 ->
  500. EParenthesis (self#read_expr)
  501. | 9 ->
  502. let fields = self#read_list (fun () ->
  503. let n = self#read_string in
  504. let p = self#read_pos in
  505. let qs = begin match read_byte ch with
  506. | 0 -> NoQuotes
  507. | 1 -> DoubleQuotes
  508. | _ -> assert false
  509. end in
  510. let e = self#read_expr in
  511. ((n,p,qs),e)
  512. ) in
  513. EObjectDecl fields
  514. | 10 ->
  515. let el = self#read_list (fun () -> self#read_expr) in
  516. EArrayDecl el
  517. | 11 ->
  518. let e = self#read_expr in
  519. let el = self#read_list (fun () -> self#read_expr) in
  520. ECall(e,el)
  521. | 12 ->
  522. let ptp = self#read_placed_type_path in
  523. let el = self#read_list (fun () -> self#read_expr) in
  524. ENew(ptp,el)
  525. | 13 ->
  526. let (op,flag) = self#get_unop (read_byte ch) in
  527. let e = self#read_expr in
  528. EUnop(op,flag,e)
  529. | 14 ->
  530. let vl = self#read_list (fun () ->
  531. let name = self#read_placed_name in
  532. let final = self#read_bool in
  533. let static = self#read_bool in
  534. let t = self#read_option (fun () -> self#read_type_hint) in
  535. let expr = self#read_option (fun () -> self#read_expr) in
  536. let meta = self#read_metadata in
  537. {
  538. ev_name = name;
  539. ev_final = final;
  540. ev_static = static;
  541. ev_type = t;
  542. ev_expr = expr;
  543. ev_meta = meta;
  544. }
  545. ) in
  546. EVars vl
  547. | 15 ->
  548. let fk = begin match read_byte ch with
  549. | 0 -> FKAnonymous
  550. | 1 ->
  551. let pn = self#read_placed_name in
  552. let b = self#read_bool in
  553. FKNamed(pn,b)
  554. | 2 -> FKArrow
  555. | _ -> assert false end in
  556. let f = self#read_func in
  557. EFunction(fk,f)
  558. | 16 ->
  559. EBlock (self#read_list (fun () -> self#read_expr))
  560. | 17 ->
  561. let e1 = self#read_expr in
  562. let e2 = self#read_expr in
  563. EFor(e1,e2)
  564. | 18 ->
  565. let e1 = self#read_expr in
  566. let e2 = self#read_expr in
  567. EIf(e1,e2,None)
  568. | 19 ->
  569. let e1 = self#read_expr in
  570. let e2 = self#read_expr in
  571. let e3 = self#read_expr in
  572. EIf(e1,e2,Some e3)
  573. | 20 ->
  574. let e1 = self#read_expr in
  575. let e2 = self#read_expr in
  576. EWhile(e1,e2,NormalWhile)
  577. | 21 ->
  578. let e1 = self#read_expr in
  579. let e2 = self#read_expr in
  580. EWhile(e1,e2,DoWhile)
  581. | 22 ->
  582. let e1 = self#read_expr in
  583. let cases = self#read_list (fun () ->
  584. let el = self#read_list (fun () -> self#read_expr) in
  585. let eg = self#read_option (fun () -> self#read_expr) in
  586. let eo = self#read_option (fun () -> self#read_expr) in
  587. let p = self#read_pos in
  588. (el,eg,eo,p)
  589. ) in
  590. let def = self#read_option (fun () ->
  591. let eo = self#read_option (fun () -> self#read_expr) in
  592. let p = self#read_pos in
  593. (eo,p)
  594. ) in
  595. ESwitch(e1,cases,def)
  596. | 23 ->
  597. let e1 = self#read_expr in
  598. let catches = self#read_list (fun () ->
  599. let pn = self#read_placed_name in
  600. let th = self#read_option (fun () -> self#read_type_hint) in
  601. let e = self#read_expr in
  602. let p = self#read_pos in
  603. (pn,th,e,p)
  604. ) in
  605. ETry(e1,catches)
  606. | 24 -> EReturn None
  607. | 25 -> EReturn (Some (self#read_expr))
  608. | 26 -> EBreak
  609. | 27 -> EContinue
  610. | 28 -> EUntyped (self#read_expr)
  611. | 29 -> EThrow (self#read_expr)
  612. | 30 -> ECast ((self#read_expr),None)
  613. | 31 ->
  614. let e1 = self#read_expr in
  615. let th = self#read_type_hint in
  616. ECast(e1,Some th)
  617. | 32 ->
  618. let e1 = self#read_expr in
  619. let th = self#read_type_hint in
  620. EIs(e1,th)
  621. | 33 ->
  622. let e1 = self#read_expr in
  623. let dk = begin match read_byte ch with
  624. | 0 -> DKCall
  625. | 1 -> DKDot
  626. | 2 -> DKStructure
  627. | 3 -> DKMarked
  628. | 4 -> DKPattern (self#read_bool)
  629. | _ -> assert false end in
  630. EDisplay(e1,dk)
  631. | 34 ->
  632. let e1 = self#read_expr in
  633. let e2 = self#read_expr in
  634. let e3 = self#read_expr in
  635. ETernary(e1,e2,e3)
  636. | 35 ->
  637. let e1 = self#read_expr in
  638. let th = self#read_type_hint in
  639. ECheckType(e1,th)
  640. | 36 ->
  641. let m = self#read_metadata_entry in
  642. let e = self#read_expr in
  643. EMeta(m,e)
  644. | _ -> assert false
  645. in
  646. (e,p)
  647. (* Type instances *)
  648. method resolve_ttp_ref = function
  649. | 1 ->
  650. let i = read_uleb128 ch in
  651. (type_type_parameters.(i))
  652. | 2 ->
  653. let i = read_uleb128 ch in
  654. (field_type_parameters.(i))
  655. | 3 ->
  656. let k = read_uleb128 ch in
  657. local_type_parameters.(k)
  658. | _ ->
  659. die "" __LOC__
  660. method read_type_instance =
  661. let read_fun_arg () =
  662. let name = self#read_string in
  663. let opt = self#read_bool in
  664. let t = self#read_type_instance in
  665. (name,opt,t)
  666. in
  667. match (read_byte ch) with
  668. | 0 ->
  669. let i = read_uleb128 ch in
  670. tmonos.(i)
  671. | 1 ->
  672. let i = read_uleb128 ch in
  673. (type_type_parameters.(i)).ttp_type
  674. | 2 ->
  675. let i = read_uleb128 ch in
  676. (field_type_parameters.(i)).ttp_type
  677. | 3 ->
  678. let k = read_uleb128 ch in
  679. local_type_parameters.(k).ttp_type
  680. | 4 ->
  681. t_dynamic
  682. | 5 ->
  683. let path = self#read_path in
  684. (mk_type_param { null_class with cl_path = path } TPHUnbound None None).ttp_type
  685. | 10 ->
  686. let c = self#read_class_ref in
  687. let c = Lazy.force c in
  688. c.cl_type
  689. | 11 ->
  690. let en = self#read_enum_ref in
  691. self#make_lazy_type_dynamic (fun () ->
  692. (Lazy.force en).e_type
  693. )
  694. | 12 ->
  695. let a = self#read_abstract_ref in
  696. (* self#make_lazy_type_dynamic (fun () -> *)
  697. TType(abstract_module_type (Lazy.force a) [],[])
  698. (* ) *)
  699. | 13 ->
  700. let e = self#read_expr in
  701. let c = {null_class with cl_kind = KExpr e; cl_module = current_module } in
  702. TInst(c, [])
  703. | 20 ->
  704. TFun([],api#basic_types.tvoid)
  705. | 21 ->
  706. let arg1 = read_fun_arg () in
  707. TFun([arg1],api#basic_types.tvoid)
  708. | 22 ->
  709. let arg1 = read_fun_arg () in
  710. let arg2 = read_fun_arg () in
  711. TFun([arg1;arg2],api#basic_types.tvoid)
  712. | 23 ->
  713. let arg1 = read_fun_arg () in
  714. let arg2 = read_fun_arg () in
  715. let arg3 = read_fun_arg () in
  716. TFun([arg1;arg2;arg3],api#basic_types.tvoid)
  717. | 24 ->
  718. let arg1 = read_fun_arg () in
  719. let arg2 = read_fun_arg () in
  720. let arg3 = read_fun_arg () in
  721. let arg4 = read_fun_arg () in
  722. TFun([arg1;arg2;arg3;arg4],api#basic_types.tvoid)
  723. | 29 ->
  724. let args = self#read_list read_fun_arg in
  725. TFun(args,api#basic_types.tvoid)
  726. | 30 ->
  727. let ret = self#read_type_instance in
  728. TFun([],ret)
  729. | 31 ->
  730. let arg1 = read_fun_arg () in
  731. let ret = self#read_type_instance in
  732. TFun([arg1],ret)
  733. | 32 ->
  734. let arg1 = read_fun_arg () in
  735. let arg2 = read_fun_arg () in
  736. let ret = self#read_type_instance in
  737. TFun([arg1;arg2],ret)
  738. | 33 ->
  739. let arg1 = read_fun_arg () in
  740. let arg2 = read_fun_arg () in
  741. let arg3 = read_fun_arg () in
  742. let ret = self#read_type_instance in
  743. TFun([arg1;arg2;arg3],ret)
  744. | 34 ->
  745. let arg1 = read_fun_arg () in
  746. let arg2 = read_fun_arg () in
  747. let arg3 = read_fun_arg () in
  748. let arg4 = read_fun_arg () in
  749. let ret = self#read_type_instance in
  750. TFun([arg1;arg2;arg3;arg4],ret)
  751. | 39 ->
  752. let args = self#read_list read_fun_arg in
  753. let ret = self#read_type_instance in
  754. TFun(args,ret)
  755. | 40 ->
  756. let c = self#read_class_ref in
  757. let c = Lazy.force c in
  758. TInst(c,[])
  759. | 41 ->
  760. let c = self#read_class_ref in
  761. let t1 = self#read_type_instance in
  762. let c = Lazy.force c in
  763. TInst(c,[t1])
  764. | 42 ->
  765. let c = self#read_class_ref in
  766. let t1 = self#read_type_instance in
  767. let t2 = self#read_type_instance in
  768. let c = Lazy.force c in
  769. TInst(c,[t1;t2])
  770. | 49 ->
  771. let c = self#read_class_ref in
  772. let tl = self#read_types in
  773. let c = Lazy.force c in
  774. TInst(c,tl)
  775. | 50 ->
  776. let en = self#read_enum_ref in
  777. self#make_lazy_type_dynamic (fun () ->
  778. TEnum(Lazy.force en,[])
  779. )
  780. | 51 ->
  781. let en = self#read_enum_ref in
  782. let t1 = self#read_type_instance in
  783. self#make_lazy_type_dynamic (fun () ->
  784. TEnum(Lazy.force en,[t1])
  785. )
  786. | 52 ->
  787. let en = self#read_enum_ref in
  788. let t1 = self#read_type_instance in
  789. let t2 = self#read_type_instance in
  790. self#make_lazy_type_dynamic (fun () ->
  791. TEnum(Lazy.force en,[t1;t2])
  792. )
  793. | 59 ->
  794. let e = self#read_enum_ref in
  795. let tl = self#read_types in
  796. self#make_lazy_type_dynamic (fun () ->
  797. TEnum(Lazy.force e,tl)
  798. )
  799. | 60 ->
  800. let td = self#read_typedef_ref in
  801. self#make_lazy_type_dynamic (fun () ->
  802. TType(Lazy.force td,[])
  803. );
  804. | 61 ->
  805. let td = self#read_typedef_ref in
  806. let t1 = self#read_type_instance in
  807. self#make_lazy_type_dynamic (fun () ->
  808. TType(Lazy.force td,[t1])
  809. )
  810. | 62 ->
  811. let td = self#read_typedef_ref in
  812. let t1 = self#read_type_instance in
  813. let t2 = self#read_type_instance in
  814. self#make_lazy_type_dynamic (fun () ->
  815. TType(Lazy.force td,[t1;t2])
  816. )
  817. | 69 ->
  818. let t = self#read_typedef_ref in
  819. let tl = self#read_types in
  820. self#make_lazy_type_dynamic (fun () ->
  821. TType(Lazy.force t,tl)
  822. )
  823. | 70 ->
  824. let a = self#read_abstract_ref in
  825. (* self#make_lazy_type_dynamic (fun () -> *)
  826. TAbstract(Lazy.force a,[])
  827. (* ) *)
  828. | 71 ->
  829. let a = self#read_abstract_ref in
  830. let t1 = self#read_type_instance in
  831. (* self#make_lazy_type_dynamic (fun () -> *)
  832. TAbstract(Lazy.force a,[t1])
  833. (* ) *)
  834. | 72 ->
  835. let a = self#read_abstract_ref in
  836. let t1 = self#read_type_instance in
  837. let t2 = self#read_type_instance in
  838. (* self#make_lazy_type_dynamic (fun () -> *)
  839. TAbstract(Lazy.force a,[t1;t2])
  840. (* ) *)
  841. | 79 ->
  842. let a = self#read_abstract_ref in
  843. let tl = self#read_types in
  844. (* self#make_lazy_type_dynamic (fun () -> *)
  845. TAbstract(Lazy.force a,tl)
  846. (* ) *)
  847. | 80 ->
  848. empty_anon
  849. | 81 ->
  850. TAnon self#read_anon_ref
  851. | 89 ->
  852. TDynamic (Some self#read_type_instance)
  853. | 100 ->
  854. api#basic_types.tvoid
  855. | 101 ->
  856. api#basic_types.tint
  857. | 102 ->
  858. api#basic_types.tfloat
  859. | 103 ->
  860. api#basic_types.tbool
  861. | 104 ->
  862. api#basic_types.tstring
  863. | i ->
  864. error (Printf.sprintf "Bad type instance id: %i" i)
  865. method read_types =
  866. self#read_list (fun () -> self#read_type_instance)
  867. method read_type_parameters_forward =
  868. let length = read_uleb128 ch in
  869. Array.init length (fun _ ->
  870. let path = self#read_path in
  871. let pos = self#read_pos in
  872. let host = match read_byte ch with
  873. | 0 -> TPHType
  874. | 1 -> TPHConstructor
  875. | 2 -> TPHMethod
  876. | 3 -> TPHEnumConstructor
  877. | 4 -> TPHAnonField
  878. | 5 -> TPHLocal
  879. | i -> die (Printf.sprintf "Invalid type paramter host: %i" i) __LOC__
  880. in
  881. let c = mk_class current_module path pos pos in
  882. mk_type_param c host None None
  883. )
  884. method read_type_parameters_data (a : typed_type_param array) =
  885. Array.iter (fun ttp ->
  886. let meta = self#read_metadata in
  887. let constraints = self#read_types in
  888. let def = self#read_option (fun () -> self#read_type_instance) in
  889. let c = ttp.ttp_class in
  890. ttp.ttp_default <- def;
  891. ttp.ttp_constraints <- Some (Lazy.from_val constraints);
  892. c.cl_meta <- meta;
  893. ) a
  894. (* Fields *)
  895. method read_field_kind = match read_byte ch with
  896. | 0 -> Method MethNormal
  897. | 1 -> Method MethInline
  898. | 2 -> Method MethDynamic
  899. | 3 -> Method MethMacro
  900. | 10 -> Var {v_read = AccNormal;v_write = AccNormal}
  901. | 11 -> Var {v_read = AccNormal;v_write = AccNo}
  902. | 12 -> Var {v_read = AccNormal;v_write = AccNever}
  903. | 13 -> Var {v_read = AccNormal;v_write = AccCtor}
  904. | 14 -> Var {v_read = AccNormal;v_write = AccCall}
  905. | 20 -> Var {v_read = AccInline;v_write = AccNever}
  906. | 30 -> Var {v_read = AccCall;v_write = AccNormal}
  907. | 31 -> Var {v_read = AccCall;v_write = AccNo}
  908. | 32 -> Var {v_read = AccCall;v_write = AccNever}
  909. | 33 -> Var {v_read = AccCall;v_write = AccCtor}
  910. | 34 -> Var {v_read = AccCall;v_write = AccCall}
  911. | 100 ->
  912. let f = function
  913. | 0 -> AccNormal
  914. | 1 -> AccNo
  915. | 2 -> AccNever
  916. | 3 -> AccCtor
  917. | 4 -> AccCall
  918. | 5 -> AccInline
  919. | 6 ->
  920. let s = self#read_string in
  921. let so = self#read_option (fun () -> self#read_string) in
  922. AccRequire(s,so)
  923. | i ->
  924. error (Printf.sprintf "Bad accessor kind: %i" i)
  925. in
  926. let r = f (read_byte ch) in
  927. let w = f (read_byte ch) in
  928. Var {v_read = r;v_write = w}
  929. | i ->
  930. error (Printf.sprintf "Bad field kind: %i" i)
  931. method read_var_kind =
  932. match read_byte ch with
  933. | 0 -> VUser TVOLocalVariable
  934. | 1 -> VUser TVOArgument
  935. | 2 -> VUser TVOForVariable
  936. | 3 -> VUser TVOPatternVariable
  937. | 4 -> VUser TVOCatchVariable
  938. | 5 -> VUser TVOLocalFunction
  939. | 6 -> VGenerated
  940. | 7 -> VInlined
  941. | 8 -> VInlinedConstructorVariable (self#read_list (fun () -> self#read_string))
  942. | 9 -> VExtractorVariable
  943. | 10 -> VAbstractThis
  944. | _ -> assert false
  945. method read_var =
  946. let id = read_uleb128 ch in
  947. let name = self#read_string in
  948. let kind = self#read_var_kind in
  949. let flags = read_uleb128 ch in
  950. let meta = self#read_metadata in
  951. let pos = self#read_pos in
  952. let v = {
  953. v_id = api#get_var_id id;
  954. v_name = name;
  955. v_type = t_dynamic;
  956. v_kind = kind;
  957. v_meta = meta;
  958. v_pos = pos;
  959. v_extra = None;
  960. v_flags = flags;
  961. } in
  962. v
  963. method read_texpr fctx =
  964. let declare_local () =
  965. let v = fctx.vars.(read_uleb128 ch) in
  966. v.v_extra <- self#read_option (fun () ->
  967. let params = self#read_list (fun () ->
  968. let i = read_uleb128 ch in
  969. local_type_parameters.(i)
  970. ) in
  971. let vexpr = self#read_option (fun () -> self#read_texpr fctx) in
  972. {
  973. v_params = params;
  974. v_expr = vexpr;
  975. };
  976. );
  977. v.v_type <- self#read_type_instance;
  978. v
  979. in
  980. let update_pmin () =
  981. fctx.pos := {!(fctx.pos) with pmin = read_leb128 ch};
  982. in
  983. let update_pmax () =
  984. fctx.pos := {!(fctx.pos) with pmax = read_leb128 ch};
  985. in
  986. let update_pminmax () =
  987. let pmin = read_leb128 ch in
  988. let pmax = read_leb128 ch in
  989. fctx.pos := {!(fctx.pos) with pmin; pmax};
  990. in
  991. let update_p () =
  992. fctx.pos := self#read_pos;
  993. in
  994. let read_relpos () =
  995. begin match read_byte ch with
  996. | 0 ->
  997. ()
  998. | 1 ->
  999. update_pmin ()
  1000. | 2 ->
  1001. update_pmax ()
  1002. | 3 ->
  1003. update_pminmax ()
  1004. | 4 ->
  1005. update_p ()
  1006. | _ ->
  1007. assert false
  1008. end;
  1009. !(fctx.pos)
  1010. in
  1011. let rec loop () =
  1012. let loop2 () =
  1013. match read_byte ch with
  1014. (* values 0-19 *)
  1015. | 0 -> TConst TNull,None
  1016. | 1 -> TConst TThis,fctx.tthis
  1017. | 2 -> TConst TSuper,None
  1018. | 3 -> TConst (TBool false),(Some api#basic_types.tbool)
  1019. | 4 -> TConst (TBool true),(Some api#basic_types.tbool)
  1020. | 5 -> TConst (TInt self#read_i32),(Some api#basic_types.tint)
  1021. | 6 -> TConst (TFloat self#read_string),(Some api#basic_types.tfloat)
  1022. | 7 -> TConst (TString self#read_string),(Some api#basic_types.tstring)
  1023. | 13 -> TConst (TBool false),None
  1024. | 14 -> TConst (TBool true),None
  1025. | 15 -> TConst (TInt self#read_i32),None
  1026. | 16 -> TConst (TFloat self#read_string),None
  1027. | 17 -> TConst (TString self#read_string),None
  1028. (* vars 20-29 *)
  1029. | 20 ->
  1030. TLocal (fctx.vars.(read_uleb128 ch)),None
  1031. | 21 ->
  1032. let v = declare_local () in
  1033. TVar (v,None),(Some api#basic_types.tvoid)
  1034. | 22 ->
  1035. let v = declare_local () in
  1036. let e = loop () in
  1037. TVar (v, Some e),(Some api#basic_types.tvoid)
  1038. (* blocks 30-49 *)
  1039. | 30 ->
  1040. TBlock [],None
  1041. | 31 | 32 | 33 | 34 | 35 as i ->
  1042. let l = i - 30 in
  1043. let el = List.init l (fun _ -> loop ()) in
  1044. TBlock el,None
  1045. | 36 ->
  1046. let l = read_byte ch in
  1047. let el = List.init l (fun _ -> loop ()) in
  1048. TBlock el,None
  1049. | 39 ->
  1050. let el = self#read_list loop in
  1051. TBlock el,None
  1052. (* function 50-59 *)
  1053. | 50 ->
  1054. let read_tfunction_arg () =
  1055. let v = declare_local () in
  1056. let cto = self#read_option loop in
  1057. (v,cto)
  1058. in
  1059. let args = self#read_list read_tfunction_arg in
  1060. let r = self#read_type_instance in
  1061. let e = loop () in
  1062. TFunction {
  1063. tf_args = args;
  1064. tf_type = r;
  1065. tf_expr = e;
  1066. },None
  1067. (* texpr compounds 60-79 *)
  1068. | 60 ->
  1069. let e1 = loop () in
  1070. let e2 = loop () in
  1071. TArray (e1,e2),None
  1072. | 61 ->
  1073. let e = loop () in
  1074. TParenthesis e,Some e.etype
  1075. | 62 ->
  1076. TArrayDecl (loop_el()),None
  1077. | 63 ->
  1078. let fl = self#read_list (fun () ->
  1079. let name = self#read_string in
  1080. let p = self#read_pos in
  1081. let qs = match read_byte ch with
  1082. | 0 -> NoQuotes
  1083. | 1 -> DoubleQuotes
  1084. | _ -> assert false
  1085. in
  1086. let e = loop () in
  1087. ((name,p,qs),e)
  1088. ) in
  1089. TObjectDecl fl,None
  1090. | 65 ->
  1091. let m = self#read_metadata_entry in
  1092. let e1 = loop () in
  1093. TMeta (m,e1),None
  1094. (* calls 70 - 79 *)
  1095. | 70 ->
  1096. let e1 = loop () in
  1097. TCall(e1,[]),None
  1098. | 71 | 72 | 73 | 74 as i ->
  1099. let e1 = loop () in
  1100. let el = List.init (i - 70) (fun _ -> loop ()) in
  1101. TCall(e1,el),None
  1102. | 79 ->
  1103. let e1 = loop () in
  1104. let el = self#read_list loop in
  1105. TCall(e1,el),None
  1106. (* branching 80-89 *)
  1107. | 80 ->
  1108. let e1 = loop () in
  1109. let e2 = loop () in
  1110. TIf(e1,e2,None),(Some api#basic_types.tvoid)
  1111. | 81 ->
  1112. let e1 = loop () in
  1113. let e2 = loop () in
  1114. let e3 = loop () in
  1115. TIf(e1,e2,Some e3),None
  1116. | 82 ->
  1117. let subject = loop () in
  1118. let cases = self#read_list (fun () ->
  1119. let patterns = loop_el() in
  1120. let ec = loop () in
  1121. { case_patterns = patterns; case_expr = ec}
  1122. ) in
  1123. let def = self#read_option (fun () -> loop ()) in
  1124. TSwitch {
  1125. switch_subject = subject;
  1126. switch_cases = cases;
  1127. switch_default = def;
  1128. switch_exhaustive = true;
  1129. },None
  1130. | 83 ->
  1131. let e1 = loop () in
  1132. let catches = self#read_list (fun () ->
  1133. let v = declare_local () in
  1134. let e = loop () in
  1135. (v,e)
  1136. ) in
  1137. TTry(e1,catches),None
  1138. | 84 ->
  1139. let e1 = loop () in
  1140. let e2 = loop () in
  1141. TWhile(e1,e2,NormalWhile),(Some api#basic_types.tvoid)
  1142. | 85 ->
  1143. let e1 = loop () in
  1144. let e2 = loop () in
  1145. TWhile(e1,e2,DoWhile),(Some api#basic_types.tvoid)
  1146. | 86 ->
  1147. let v = declare_local () in
  1148. let e1 = loop () in
  1149. let e2 = loop () in
  1150. TFor(v,e1,e2),(Some api#basic_types.tvoid)
  1151. (* control flow 90-99 *)
  1152. | 90 ->
  1153. TReturn None,None
  1154. | 91 ->
  1155. TReturn (Some (loop ())),None
  1156. | 92 ->
  1157. TContinue,None
  1158. | 93 ->
  1159. TBreak,None
  1160. | 94 ->
  1161. TThrow (loop ()),None
  1162. (* access 100-119 *)
  1163. | 100 ->
  1164. TEnumIndex (loop ()),(Some api#basic_types.tint)
  1165. | 101 ->
  1166. let e1 = loop () in
  1167. let ef = self#read_enum_field_ref in
  1168. let i = read_uleb128 ch in
  1169. TEnumParameter(e1,ef,i),None
  1170. | 102 ->
  1171. let e1 = loop () in
  1172. let c = self#read_class_ref in
  1173. let c = Lazy.force c in
  1174. let tl = self#read_types in
  1175. let cf = self#read_field_ref in
  1176. TField(e1,FInstance(c,tl,cf)),None
  1177. | 103 ->
  1178. let e1 = loop () in
  1179. let c = self#read_class_ref in
  1180. let c = Lazy.force c in
  1181. let cf = self#read_field_ref in
  1182. TField(e1,FStatic(c,cf)),None
  1183. | 104 ->
  1184. let e1 = loop () in
  1185. let cf = self#read_anon_field_ref in
  1186. TField(e1,FAnon(cf)),None
  1187. | 105 ->
  1188. let e1 = loop () in
  1189. let c = self#read_class_ref in
  1190. let c = Lazy.force c in
  1191. let tl = self#read_types in
  1192. let cf = self#read_field_ref in
  1193. TField(e1,FClosure(Some(c,tl),cf)),None
  1194. | 106 ->
  1195. let e1 = loop () in
  1196. let cf = self#read_anon_field_ref in
  1197. TField(e1,FClosure(None,cf)),None
  1198. | 107 ->
  1199. let e1 = loop () in
  1200. let en = self#read_enum_ref in
  1201. let ef = self#read_enum_field_ref in
  1202. let en = Lazy.force en in
  1203. TField(e1,FEnum(en,ef)),None
  1204. | 108 ->
  1205. let e1 = loop () in
  1206. let s = self#read_string in
  1207. TField(e1,FDynamic s),None
  1208. | 110 ->
  1209. let p = read_relpos () in
  1210. let c = self#read_class_ref in
  1211. let c = Lazy.force c in
  1212. let cf = self#read_field_ref in
  1213. let e1 = Texpr.Builder.make_static_this c p in
  1214. TField(e1,FStatic(c,cf)),None
  1215. | 111 ->
  1216. let p = read_relpos () in
  1217. let c = self#read_class_ref in
  1218. let c = Lazy.force c in
  1219. let tl = self#read_types in
  1220. let cf = self#read_field_ref in
  1221. let ethis = mk (TConst TThis) (Option.get fctx.tthis) p in
  1222. TField(ethis,FInstance(c,tl,cf)),None
  1223. (* module types 120-139 *)
  1224. | 120 ->
  1225. let c = self#read_class_ref in
  1226. let c = Lazy.force c in
  1227. TTypeExpr (TClassDecl c),(Some c.cl_type)
  1228. | 121 ->
  1229. let en = self#read_enum_ref in
  1230. let en = Lazy.force en in
  1231. TTypeExpr (TEnumDecl en),(Some en.e_type)
  1232. | 122 ->
  1233. TTypeExpr (TAbstractDecl (Lazy.force self#read_abstract_ref)),None
  1234. | 123 ->
  1235. TTypeExpr (TTypeDecl (Lazy.force self#read_typedef_ref)),None
  1236. | 124 ->
  1237. TCast(loop (),None),None
  1238. | 125 ->
  1239. let e1 = loop () in
  1240. let (pack,mname,tname) = self#read_full_path in
  1241. let mt = self#resolve_type pack mname tname in
  1242. TCast(e1,Some mt),None
  1243. | 126 ->
  1244. let c = self#read_class_ref in
  1245. let c = Lazy.force c in
  1246. let tl = self#read_types in
  1247. let el = loop_el() in
  1248. TNew(c,tl,el),None
  1249. | 127 ->
  1250. let ttp = self#resolve_ttp_ref (read_uleb128 ch) in
  1251. let tl = self#read_types in
  1252. let el = loop_el() in
  1253. TNew(ttp.ttp_class,tl,el),None
  1254. | 128 ->
  1255. let ttp = self#resolve_ttp_ref (read_uleb128 ch) in
  1256. TTypeExpr (TClassDecl ttp.ttp_class),None
  1257. (* unops 140-159 *)
  1258. | i when i >= 140 && i < 160 ->
  1259. let (op,flag) = self#get_unop (i - 140) in
  1260. let e = loop () in
  1261. TUnop(op,flag,e),None
  1262. (* binops 160-219 *)
  1263. | i when i >= 160 && i < 220 ->
  1264. let op = self#get_binop (i - 160) in
  1265. let e1 = loop () in
  1266. let e2 = loop () in
  1267. TBinop(op,e1,e2),None
  1268. (* rest 250-254 *)
  1269. | 250 ->
  1270. TIdent (self#read_string),None
  1271. | i ->
  1272. die (Printf.sprintf " [ERROR] Unhandled texpr %d at:" i) __LOC__
  1273. in
  1274. let e,t = loop2 () in
  1275. let t = match t with
  1276. | None -> fctx.t_pool.(read_uleb128 ch)
  1277. | Some t -> t
  1278. in
  1279. let p = read_relpos () in
  1280. let e = {
  1281. eexpr = e;
  1282. etype = t;
  1283. epos = p;
  1284. } in
  1285. e
  1286. and loop_el () =
  1287. self#read_list loop
  1288. in
  1289. loop()
  1290. method read_class_field_forward =
  1291. let name = self#read_string in
  1292. let pos,name_pos = self#read_pos_pair in
  1293. let cf_meta = self#read_metadata in
  1294. let overloads = self#read_list (fun () -> self#read_class_field_forward) in
  1295. { null_field with cf_name = name; cf_pos = pos; cf_name_pos = name_pos; cf_overloads = overloads; cf_meta = cf_meta }
  1296. method start_texpr =
  1297. begin match read_byte ch with
  1298. | 0 ->
  1299. ()
  1300. | 1 ->
  1301. let a = self#read_type_parameters_forward in
  1302. local_type_parameters <- a;
  1303. self#read_type_parameters_data a;
  1304. | i ->
  1305. die "" __LOC__
  1306. end;
  1307. let tthis = self#read_option (fun () -> self#read_type_instance) in
  1308. let l = read_uleb128 ch in
  1309. let ts = Array.init l (fun _ ->
  1310. self#read_type_instance
  1311. ) in
  1312. let l = read_uleb128 ch in
  1313. let vars = Array.init l (fun _ ->
  1314. self#read_var
  1315. ) in
  1316. create_field_reader_context self#read_pos ts vars tthis
  1317. method read_field_type_parameters =
  1318. let num_params = read_uleb128 ch in
  1319. begin match read_byte ch with
  1320. | 0 ->
  1321. ()
  1322. | 1 ->
  1323. let a = self#read_type_parameters_forward in
  1324. field_type_parameters <- a;
  1325. self#read_type_parameters_data a;
  1326. field_type_parameter_offset <- 0; (* num_params is added below *)
  1327. | i ->
  1328. die "" __LOC__
  1329. end;
  1330. let params = List.init num_params (fun offset ->
  1331. field_type_parameters.(field_type_parameter_offset + offset)
  1332. ) in
  1333. field_type_parameter_offset <- field_type_parameter_offset + num_params;
  1334. params
  1335. method read_expression (fctx : field_reader_context) =
  1336. let e = self#read_texpr fctx in
  1337. let e_unopt = self#read_option (fun () -> self#read_texpr fctx) in
  1338. e,e_unopt
  1339. val class_field_infos = ClassFieldInfos.create ()
  1340. method read_class_field_data (cf : tclass_field) : unit =
  1341. let params = self#read_field_type_parameters in
  1342. let t = self#read_type_instance in
  1343. let flags = read_uleb128 ch in
  1344. let doc = self#read_option (fun () -> self#read_documentation) in
  1345. let kind = self#read_field_kind in
  1346. let expr,expr_unoptimized = match read_byte ch with
  1347. | 0 ->
  1348. None,None
  1349. | 1 ->
  1350. let fctx = self#start_texpr in
  1351. let e,e_unopt = self#read_expression fctx in
  1352. (Some e,e_unopt)
  1353. | 2 ->
  1354. (* store type parameter info for EXD *)
  1355. let info = ClassFieldInfo.create field_type_parameters in
  1356. ClassFieldInfos.set class_field_infos info cf;
  1357. None,None
  1358. | _ ->
  1359. die "" __LOC__
  1360. in
  1361. cf.cf_type <- t;
  1362. cf.cf_doc <- doc;
  1363. cf.cf_kind <- kind;
  1364. cf.cf_expr <- expr;
  1365. cf.cf_expr_unoptimized <- expr_unoptimized;
  1366. cf.cf_params <- params;
  1367. cf.cf_flags <- flags
  1368. method read_class_field_and_overloads_data (cf : tclass_field) =
  1369. let rec loop depth cfl = match cfl with
  1370. | cf :: cfl ->
  1371. assert (depth > 0);
  1372. self#read_class_field_data cf;
  1373. loop (depth - 1) cfl
  1374. | [] ->
  1375. assert (depth = 0)
  1376. in
  1377. loop (read_uleb128 ch) (cf :: cf.cf_overloads);
  1378. method select_class_type_parameters (c: tclass) =
  1379. match c.cl_kind with
  1380. | KAbstractImpl a ->
  1381. type_type_parameters <- Array.of_list a.a_params
  1382. | _ ->
  1383. type_type_parameters <- Array.of_list c.cl_params
  1384. method read_class_fields (c : tclass) =
  1385. self#select_class_type_parameters c;
  1386. let _ = self#read_option (fun f ->
  1387. let cf = Option.get c.cl_constructor in
  1388. self#read_class_field_and_overloads_data cf
  1389. ) in
  1390. let _ = self#read_option (fun f ->
  1391. let cf = Option.get c.cl_init in
  1392. self#read_class_field_and_overloads_data cf
  1393. ) in
  1394. let rec loop ref_kind num cfl = match cfl with
  1395. | cf :: cfl ->
  1396. assert (num > 0);
  1397. self#read_class_field_and_overloads_data cf;
  1398. loop ref_kind (num - 1) cfl
  1399. | [] ->
  1400. assert (num = 0)
  1401. in
  1402. loop CfrMember (read_uleb128 ch) c.cl_ordered_fields;
  1403. loop CfrStatic (read_uleb128 ch) c.cl_ordered_statics;
  1404. method read_enum_fields (e : tenum) =
  1405. type_type_parameters <- Array.of_list e.e_params;
  1406. ignore(self#read_list (fun () ->
  1407. let name = self#read_string in
  1408. let ef = PMap.find name e.e_constrs in
  1409. ef.ef_params <- self#read_field_type_parameters;
  1410. ef.ef_type <- self#read_type_instance;
  1411. ef.ef_doc <- self#read_option (fun () -> self#read_documentation);
  1412. ef.ef_meta <- self#read_metadata;
  1413. ))
  1414. (* Module types *)
  1415. method read_common_module_type (infos : tinfos) =
  1416. infos.mt_private <- self#read_bool;
  1417. infos.mt_doc <- self#read_option (fun () -> self#read_documentation);
  1418. infos.mt_meta <- self#read_metadata;
  1419. let params = Array.of_list infos.mt_params in
  1420. type_type_parameters <- params;
  1421. self#read_type_parameters_data params;
  1422. infos.mt_params <- Array.to_list type_type_parameters;
  1423. infos.mt_using <- self#read_list (fun () ->
  1424. let c = self#read_class_ref in
  1425. let c = Lazy.force c in
  1426. let p = self#read_pos in
  1427. (c,p)
  1428. )
  1429. method read_class_kind = match read_byte ch with
  1430. | 0 -> KNormal
  1431. | 1 -> die "" __LOC__
  1432. | 2 -> KExpr self#read_expr
  1433. | 3 -> KGeneric
  1434. | 4 ->
  1435. let c = self#read_class_ref in
  1436. let c = Lazy.force c in
  1437. let tl = self#read_types in
  1438. KGenericInstance(c,tl)
  1439. | 5 -> KMacroType
  1440. | 6 -> KGenericBuild (self#read_list (fun () -> self#read_cfield))
  1441. | 7 -> KAbstractImpl (Lazy.force self#read_abstract_ref)
  1442. | 8 -> KModuleFields current_module
  1443. | i ->
  1444. error (Printf.sprintf "Invalid class kind id: %i" i)
  1445. method read_class (c : tclass) =
  1446. self#read_common_module_type (Obj.magic c);
  1447. c.cl_kind <- self#read_class_kind;
  1448. let read_relation () =
  1449. let c = self#read_class_ref in
  1450. let c = Lazy.force c in
  1451. let tl = self#read_types in
  1452. (c,tl)
  1453. in
  1454. c.cl_super <- self#read_option read_relation;
  1455. c.cl_implements <- self#read_list read_relation;
  1456. c.cl_dynamic <- self#read_option (fun () -> self#read_type_instance);
  1457. c.cl_array_access <- self#read_option (fun () -> self#read_type_instance);
  1458. (match c.cl_kind with
  1459. | KModuleFields md -> md.m_statics <- Some c;
  1460. | _ -> ());
  1461. method read_abstract (a : tabstract) =
  1462. self#read_common_module_type (Obj.magic a);
  1463. a.a_impl <- self#read_option (fun () -> Lazy.force self#read_class_ref);
  1464. begin match read_byte ch with
  1465. | 0 ->
  1466. a.a_this <- TAbstract(a,extract_param_types a.a_params)
  1467. | _ ->
  1468. a.a_this <- self#read_type_instance;
  1469. end;
  1470. a.a_from <- self#read_list (fun () -> self#read_type_instance);
  1471. a.a_to <- self#read_list (fun () -> self#read_type_instance);
  1472. a.a_extern <- self#read_bool;
  1473. a.a_enum <- self#read_bool;
  1474. method read_abstract_fields (a : tabstract) =
  1475. a.a_array <- self#read_list (fun () -> self#read_field_ref);
  1476. a.a_read <- self#read_option (fun () -> self#read_field_ref);
  1477. a.a_write <- self#read_option (fun () -> self#read_field_ref);
  1478. a.a_call <- self#read_option (fun () -> self#read_field_ref);
  1479. a.a_ops <- self#read_list (fun () ->
  1480. let i = read_byte ch in
  1481. let op = self#get_binop i in
  1482. let cf = self#read_field_ref in
  1483. (op, cf)
  1484. );
  1485. a.a_unops <- self#read_list (fun () ->
  1486. let i = read_byte ch in
  1487. let (op, flag) = self#get_unop i in
  1488. let cf = self#read_field_ref in
  1489. (op, flag, cf)
  1490. );
  1491. a.a_from_field <- self#read_list (fun () ->
  1492. let cf = self#read_field_ref in
  1493. let t = match cf.cf_type with
  1494. | TFun((_,_,t) :: _, _) -> t
  1495. | _ -> die "" __LOC__
  1496. in
  1497. (t,cf)
  1498. );
  1499. a.a_to_field <- self#read_list (fun () ->
  1500. let cf = self#read_field_ref in
  1501. let t = match cf.cf_type with
  1502. | TFun(_, t) -> t
  1503. | _ -> die "" __LOC__
  1504. in
  1505. (t,cf)
  1506. );
  1507. method read_enum (e : tenum) =
  1508. self#read_common_module_type (Obj.magic e);
  1509. e.e_flags <- read_uleb128 ch;
  1510. e.e_names <- self#read_list (fun () -> self#read_string);
  1511. method read_typedef (td : tdef) =
  1512. self#read_common_module_type (Obj.magic td);
  1513. let t = self#read_type_instance in
  1514. match td.t_type with
  1515. | TMono r ->
  1516. (match r.tm_type with
  1517. | None -> Monomorph.bind r t;
  1518. | Some t' -> die (Printf.sprintf "typedef %s is already initialized to %s, but new init to %s was attempted" (s_type_path td.t_path) (s_type_kind t') (s_type_kind t)) __LOC__)
  1519. | _ ->
  1520. die "" __LOC__
  1521. (* Chunks *)
  1522. method read_string_pool =
  1523. let l = read_uleb128 ch in
  1524. Array.init l (fun i ->
  1525. self#read_raw_string;
  1526. );
  1527. method read_efr =
  1528. let l = read_uleb128 ch in
  1529. let a = Array.init l (fun i ->
  1530. let en = self#read_enum_ref in
  1531. let name = self#read_string in
  1532. Lazy.from_fun (fun () ->
  1533. let en = Lazy.force en in
  1534. PMap.find name en.e_constrs
  1535. )
  1536. ) in
  1537. enum_fields <- a
  1538. method read_ofr =
  1539. let l = read_uleb128 ch in
  1540. let a = Array.init l (fun _ -> self#read_class_field_forward) in
  1541. anon_fields <- a
  1542. method read_ofd =
  1543. let l = read_uleb128 ch in
  1544. for _ = 0 to l - 1 do
  1545. let index = read_uleb128 ch in
  1546. let cf = anon_fields.(index) in
  1547. self#read_class_field_and_overloads_data cf;
  1548. done
  1549. method read_obd =
  1550. let l = read_uleb128 ch in
  1551. for _ = 0 to l - 1 do
  1552. let index = read_uleb128 ch in
  1553. self#read_anon anons.(index)
  1554. done
  1555. method read_cfr =
  1556. let l = read_uleb128 ch in
  1557. let a = Array.init l (fun i ->
  1558. let c = self#read_class_ref in
  1559. let kind = match read_byte ch with
  1560. | 0 -> CfrStatic
  1561. | 1 -> CfrMember
  1562. | 2 -> CfrConstructor
  1563. | 3 -> CfrInit
  1564. | _ -> die "" __LOC__
  1565. in
  1566. let name = match kind with
  1567. | CfrStatic
  1568. | CfrMember ->
  1569. Some self#read_string
  1570. | CfrConstructor
  1571. | CfrInit ->
  1572. None
  1573. in
  1574. let depth = read_uleb128 ch in
  1575. Lazy.from_fun (fun () ->
  1576. let c = Lazy.force c in
  1577. let cf = match kind with
  1578. | CfrStatic ->
  1579. let name = Option.get name in
  1580. begin try
  1581. PMap.find name c.cl_statics
  1582. with Not_found ->
  1583. raise (HxbFailure (Printf.sprintf "Could not read static field %s on %s while hxbing %s" name (s_type_path c.cl_path) (s_type_path current_module.m_path)))
  1584. end;
  1585. | CfrMember ->
  1586. let name = Option.get name in
  1587. begin try
  1588. PMap.find name c.cl_fields
  1589. with Not_found ->
  1590. raise (HxbFailure (Printf.sprintf "Could not read instance field %s on %s while hxbing %s" name (s_type_path c.cl_path) (s_type_path current_module.m_path)))
  1591. end
  1592. | CfrConstructor ->
  1593. Option.get c.cl_constructor
  1594. | CfrInit ->
  1595. Option.get c.cl_init
  1596. in
  1597. let pick_overload cf depth =
  1598. let rec loop depth cfl = match cfl with
  1599. | cf :: cfl ->
  1600. if depth = 0 then
  1601. cf
  1602. else
  1603. loop (depth - 1) cfl
  1604. | [] ->
  1605. raise (HxbFailure (Printf.sprintf "Bad overload depth for %s on %s: %i" cf.cf_name (s_type_path c.cl_path) depth))
  1606. in
  1607. let cfl = cf :: cf.cf_overloads in
  1608. loop depth cfl
  1609. in
  1610. if depth = 0 then
  1611. cf
  1612. else
  1613. pick_overload cf depth;
  1614. )
  1615. ) in
  1616. class_fields <- a
  1617. method read_cfd =
  1618. let l = read_uleb128 ch in
  1619. for i = 0 to l - 1 do
  1620. let c = classes.(i) in
  1621. let c = Lazy.force c in
  1622. self#read_class_fields c;
  1623. done
  1624. method read_exd =
  1625. ignore(self#read_list (fun () ->
  1626. let c = self#read_class_ref in
  1627. let c = Lazy.force c in
  1628. self#read_list (fun () ->
  1629. let cf = self#read_field_ref in
  1630. let length = read_uleb128 ch in
  1631. let bytes = read_bytes ch length in
  1632. let ch_cf = BytesWithPosition.create bytes in
  1633. let read_expressions () =
  1634. self#select_class_type_parameters c;
  1635. field_type_parameters <- (ClassFieldInfos.get class_field_infos cf).type_parameters;
  1636. ClassFieldInfos.unset class_field_infos cf;
  1637. field_type_parameter_offset <- 0;
  1638. let old = ch in
  1639. ch <- ch_cf;
  1640. let fctx = self#start_texpr in
  1641. let e,e_unopt = self#read_expression fctx in
  1642. ch <- old;
  1643. cf.cf_expr <- Some e;
  1644. cf.cf_expr_unoptimized <- e_unopt;
  1645. in
  1646. if api#read_expression_eagerly cf then
  1647. read_expressions ()
  1648. else begin
  1649. let t = cf.cf_type in
  1650. let tl = api#make_lazy_type cf.cf_type (fun () ->
  1651. cf.cf_type <- t;
  1652. read_expressions();
  1653. t
  1654. ) in
  1655. cf.cf_type <- tl
  1656. end
  1657. )
  1658. ))
  1659. method read_afd =
  1660. let l = read_uleb128 ch in
  1661. for i = 0 to l - 1 do
  1662. let a = Lazy.force abstracts.(i) in
  1663. self#read_abstract_fields a;
  1664. done
  1665. method read_cld =
  1666. let l = read_uleb128 ch in
  1667. for i = 0 to l - 1 do
  1668. let c = classes.(i) in
  1669. let c = Lazy.force c in
  1670. self#read_class c;
  1671. done
  1672. method read_abd =
  1673. let l = read_uleb128 ch in
  1674. for i = 0 to l - 1 do
  1675. let a = Lazy.force abstracts.(i) in
  1676. self#read_abstract a;
  1677. done
  1678. method read_end =
  1679. let l = read_uleb128 ch in
  1680. for i = 0 to l - 1 do
  1681. let en = Lazy.force enums.(i) in
  1682. self#read_enum en;
  1683. done
  1684. method read_efd =
  1685. let l = read_uleb128 ch in
  1686. for i = 0 to l - 1 do
  1687. let e = Lazy.force enums.(i) in
  1688. self#read_enum_fields e;
  1689. Type.unify (TType(enum_module_type e,[])) e.e_type
  1690. done
  1691. method read_anon an =
  1692. let read_fields () =
  1693. let rec loop acc i =
  1694. if i = 0 then
  1695. acc
  1696. else begin
  1697. let cf = self#read_anon_field_ref in
  1698. loop (PMap.add cf.cf_name cf acc) (i - 1)
  1699. end
  1700. in
  1701. an.a_fields <- loop PMap.empty (read_uleb128 ch)
  1702. in
  1703. begin match read_byte ch with
  1704. | 0 ->
  1705. an.a_status := Closed;
  1706. read_fields ()
  1707. | 1 ->
  1708. an.a_status := Const;
  1709. read_fields ()
  1710. | 2 ->
  1711. an.a_status := Extend self#read_types;
  1712. read_fields ()
  1713. | _ -> assert false
  1714. end
  1715. method read_tdd =
  1716. let l = read_uleb128 ch in
  1717. for i = 0 to l - 1 do
  1718. let t = Lazy.force typedefs.(i) in
  1719. self#read_typedef t;
  1720. done
  1721. method read_clr =
  1722. let l = read_uleb128 ch in
  1723. classes <- (Array.init l (fun i ->
  1724. let (pack,mname,tname) = self#read_full_path in
  1725. Lazy.from_fun (fun () ->
  1726. match self#resolve_type pack mname tname with
  1727. | TClassDecl c ->
  1728. c
  1729. | _ ->
  1730. error ("Unexpected type where class was expected: " ^ (s_type_path (pack,tname)))
  1731. )
  1732. ))
  1733. method read_abr =
  1734. let l = read_uleb128 ch in
  1735. abstracts <- (Array.init l (fun i ->
  1736. let (pack,mname,tname) = self#read_full_path in
  1737. Lazy.from_fun (fun () ->
  1738. match self#resolve_type pack mname tname with
  1739. | TAbstractDecl a ->
  1740. a
  1741. | _ ->
  1742. error ("Unexpected type where abstract was expected: " ^ (s_type_path (pack,tname)))
  1743. )
  1744. ))
  1745. method read_enr =
  1746. let l = read_uleb128 ch in
  1747. enums <- (Array.init l (fun i ->
  1748. let (pack,mname,tname) = self#read_full_path in
  1749. Lazy.from_fun (fun () ->
  1750. match self#resolve_type pack mname tname with
  1751. | TEnumDecl en ->
  1752. en
  1753. | _ ->
  1754. error ("Unexpected type where enum was expected: " ^ (s_type_path (pack,tname)))
  1755. )
  1756. ))
  1757. method read_tdr =
  1758. let l = read_uleb128 ch in
  1759. typedefs <- (Array.init l (fun i ->
  1760. let (pack,mname,tname) = self#read_full_path in
  1761. Lazy.from_fun (fun () ->
  1762. match self#resolve_type pack mname tname with
  1763. | TTypeDecl tpd ->
  1764. tpd
  1765. | _ ->
  1766. error ("Unexpected type where typedef was expected: " ^ (s_type_path (pack,tname)))
  1767. )
  1768. ))
  1769. method read_imports =
  1770. let length = read_uleb128 ch in
  1771. for _ = 0 to length - 1 do
  1772. let path = self#read_path in
  1773. ignore(api#resolve_module path)
  1774. done
  1775. method read_mtf =
  1776. self#read_list (fun () ->
  1777. let kind = read_byte ch in
  1778. let path = self#read_path in
  1779. let pos,name_pos = self#read_pos_pair in
  1780. let params = self#read_type_parameters_forward in
  1781. let mt = match kind with
  1782. | 0 ->
  1783. let c = mk_class current_module path pos name_pos in
  1784. c.cl_params <- Array.to_list params;
  1785. c.cl_flags <- read_uleb128 ch;
  1786. let read_field () =
  1787. let cf = self#read_class_field_forward in
  1788. if not full_restore then begin
  1789. let r = ref (lazy_processing t_dynamic) in
  1790. r := lazy_wait (fun() ->
  1791. let rec loop = function
  1792. | [] -> []
  1793. | f :: l ->
  1794. f();
  1795. loop l
  1796. in
  1797. delayed_field_loading <- loop delayed_field_loading;
  1798. cf.cf_type
  1799. );
  1800. cf.cf_type <- TLazy r;
  1801. end;
  1802. cf
  1803. in
  1804. c.cl_constructor <- self#read_option read_field;
  1805. c.cl_init <- self#read_option read_field;
  1806. let read_fields i =
  1807. let rec loop acc_l acc_pm i =
  1808. if i = 0 then
  1809. acc_l,acc_pm
  1810. else begin
  1811. let cf = read_field () in
  1812. loop (cf :: acc_l) (PMap.add cf.cf_name cf acc_pm) (i - 1)
  1813. end
  1814. in
  1815. loop [] PMap.empty i
  1816. in
  1817. let num_fields = read_uleb128 ch in
  1818. let num_statics = read_uleb128 ch in
  1819. let l,pm = read_fields num_fields in
  1820. c.cl_ordered_fields <- l;
  1821. c.cl_fields <- pm;
  1822. let l,pm = read_fields num_statics in
  1823. c.cl_ordered_statics <- l;
  1824. c.cl_statics <- pm;
  1825. TClassDecl c
  1826. | 1 ->
  1827. let en = mk_enum current_module path pos name_pos in
  1828. en.e_params <- Array.to_list params;
  1829. let read_field () =
  1830. let name = self#read_string in
  1831. let pos,name_pos = self#read_pos_pair in
  1832. let index = read_uleb128 ch in
  1833. { null_enum_field with
  1834. ef_name = name;
  1835. ef_pos = pos;
  1836. ef_name_pos = name_pos;
  1837. ef_index = index;
  1838. }
  1839. in
  1840. let rec loop acc i =
  1841. if i = 0 then
  1842. acc
  1843. else begin
  1844. let ef = read_field () in
  1845. loop (PMap.add ef.ef_name ef acc) (i - 1)
  1846. end
  1847. in
  1848. en.e_constrs <- loop PMap.empty (read_uleb128 ch);
  1849. TEnumDecl en
  1850. | 2 ->
  1851. let td = mk_typedef current_module path pos name_pos (mk_mono()) in
  1852. td.t_params <- Array.to_list params;
  1853. typedefs <- Array.append typedefs (Array.make 1 (Lazy.from_val td));
  1854. TTypeDecl td
  1855. | 3 ->
  1856. let a = mk_abstract current_module path pos name_pos in
  1857. a.a_params <- Array.to_list params;
  1858. abstracts <- Array.append abstracts (Array.make 1 (Lazy.from_val a));
  1859. TAbstractDecl a
  1860. | _ ->
  1861. error ("Invalid type kind: " ^ (string_of_int kind));
  1862. in
  1863. mt
  1864. )
  1865. method read_mdf =
  1866. let path = self#read_path in
  1867. let file = self#read_string in
  1868. let l = read_uleb128 ch in
  1869. anons <- Array.init l (fun _ -> { a_fields = PMap.empty; a_status = ref Closed });
  1870. tmonos <- Array.init (read_uleb128 ch) (fun _ -> mk_mono());
  1871. api#make_module path file
  1872. method private read_chunk_prefix =
  1873. let name = Bytes.unsafe_to_string (read_bytes ch 3) in
  1874. let size = Int32.to_int self#read_i32 in
  1875. (name,size)
  1876. method private read_chunk_data' (kind : chunk_kind) =
  1877. match kind with
  1878. | STR ->
  1879. string_pool <- self#read_string_pool;
  1880. has_string_pool <- true;
  1881. | DOC ->
  1882. doc_pool <- self#read_string_pool;
  1883. | MDF ->
  1884. assert(has_string_pool);
  1885. current_module <- self#read_mdf;
  1886. incr stats.modules_partially_restored;
  1887. if not full_restore then current_module.m_extra.m_display_deps <- Some PMap.empty
  1888. | MTF ->
  1889. current_module.m_types <- self#read_mtf;
  1890. api#add_module current_module;
  1891. | IMP ->
  1892. if full_restore then self#read_imports;
  1893. | CLR ->
  1894. self#read_clr;
  1895. | ENR ->
  1896. self#read_enr;
  1897. | ABR ->
  1898. self#read_abr;
  1899. | TDR ->
  1900. self#read_tdr;
  1901. | OFR ->
  1902. self#read_ofr;
  1903. | OFD ->
  1904. self#read_ofd;
  1905. | OBD ->
  1906. self#read_obd
  1907. | CLD ->
  1908. self#read_cld;
  1909. | END ->
  1910. self#read_end;
  1911. | ABD ->
  1912. self#read_abd;
  1913. | TDD ->
  1914. self#read_tdd;
  1915. | EOT ->
  1916. ()
  1917. | EFR ->
  1918. self#read_efr;
  1919. | CFR ->
  1920. self#read_cfr;
  1921. | CFD ->
  1922. self#read_cfd;
  1923. | EFD ->
  1924. self#read_efd;
  1925. | AFD ->
  1926. self#read_afd;
  1927. | EOF ->
  1928. ()
  1929. | EXD ->
  1930. self#read_exd;
  1931. | EOM ->
  1932. incr stats.modules_fully_restored;
  1933. method private get_backtrace () = Printexc.get_raw_backtrace ()
  1934. method private get_callstack () = Printexc.get_callstack 200
  1935. method private failwith chunk msg backtrace =
  1936. let msg =
  1937. (Printf.sprintf "Compiler failure while reading hxb chunk %s of %s: %s\n" (string_of_chunk_kind chunk) (s_type_path mpath) (msg))
  1938. ^ "Please submit an issue at https://github.com/HaxeFoundation/haxe/issues/new\n"
  1939. ^ "Attach the following information:"
  1940. in
  1941. let backtrace = Printexc.raw_backtrace_to_string backtrace in
  1942. let s = Printf.sprintf "%s\nHaxe: %s\n%s" msg s_version_full backtrace in
  1943. failwith s
  1944. method private read_chunk_data kind =
  1945. let path = String.concat "_" (ExtLib.String.nsplit (s_type_path mpath) ".") in
  1946. let id = ["hxb";"read";string_of_chunk_kind kind;path] in
  1947. let close = if timers_enabled then Timer.timer id else fun() -> () in
  1948. try
  1949. self#read_chunk_data' kind
  1950. with Invalid_argument msg -> begin
  1951. close();
  1952. self#failwith kind msg (self#get_backtrace ())
  1953. end;
  1954. close()
  1955. method read_chunks (new_api : hxb_reader_api) (chunks : cached_chunks) =
  1956. fst (self#read_chunks_until new_api chunks EOM true)
  1957. method read_chunks_until (new_api : hxb_reader_api) (chunks : cached_chunks) end_chunk full_restore' =
  1958. api <- new_api;
  1959. full_restore <- full_restore';
  1960. let rec loop = function
  1961. | (kind,data) :: chunks ->
  1962. ch <- BytesWithPosition.create data;
  1963. self#read_chunk_data kind;
  1964. if kind = end_chunk then chunks else loop chunks
  1965. | [] -> die "" __LOC__
  1966. in
  1967. let remaining = loop chunks in
  1968. (current_module, remaining)
  1969. method read (new_api : hxb_reader_api) (bytes : bytes) =
  1970. api <- new_api;
  1971. full_restore <- true;
  1972. ch <- BytesWithPosition.create bytes;
  1973. if (Bytes.to_string (read_bytes ch 3)) <> "hxb" then
  1974. raise (HxbFailure "magic");
  1975. let version = read_byte ch in
  1976. if version <> hxb_version then
  1977. raise (HxbFailure (Printf.sprintf "version mismatch: hxb version %i, reader version %i" version hxb_version));
  1978. (fun end_chunk ->
  1979. let rec loop () =
  1980. let (name,size) = self#read_chunk_prefix in
  1981. let kind = chunk_kind_of_string name in
  1982. self#read_chunk_data kind;
  1983. if kind <> end_chunk then begin
  1984. loop()
  1985. end
  1986. in
  1987. loop();
  1988. current_module
  1989. )
  1990. end