tFunctions.ml 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804
  1. open Globals
  2. open Ast
  3. open TType
  4. let monomorph_create_ref : (unit -> tmono) ref = ref (fun _ -> die "" __LOC__)
  5. let monomorph_bind_ref : (tmono -> t -> unit) ref = ref (fun _ _ -> die "" __LOC__)
  6. let monomorph_classify_constraints_ref : (tmono -> tmono_constraint_kind) ref = ref (fun _ -> die "" __LOC__)
  7. let has_meta m ml = List.exists (fun (m2,_,_) -> m = m2) ml
  8. let get_meta m ml = List.find (fun (m2,_,_) -> m = m2) ml
  9. (* Flags *)
  10. let has_flag flags flag =
  11. flags land (1 lsl flag) > 0
  12. let set_flag flags flag =
  13. flags lor (1 lsl flag)
  14. let unset_flag flags flag =
  15. flags land (lnot (1 lsl flag))
  16. let int_of_class_flag (flag : flag_tclass) =
  17. Obj.magic flag
  18. let add_class_flag c (flag : flag_tclass) =
  19. c.cl_flags <- set_flag c.cl_flags (int_of_class_flag flag)
  20. let remove_class_flag c (flag : flag_tclass) =
  21. c.cl_flags <- unset_flag c.cl_flags (int_of_class_flag flag)
  22. let has_class_flag c (flag : flag_tclass) =
  23. has_flag c.cl_flags (int_of_class_flag flag)
  24. let int_of_class_field_flag (flag : flag_tclass_field) =
  25. Obj.magic flag
  26. let add_class_field_flag cf (flag : flag_tclass_field) =
  27. cf.cf_flags <- set_flag cf.cf_flags (int_of_class_field_flag flag)
  28. let remove_class_field_flag cf (flag : flag_tclass_field) =
  29. cf.cf_flags <- unset_flag cf.cf_flags (int_of_class_field_flag flag)
  30. let has_class_field_flag cf (flag : flag_tclass_field) =
  31. has_flag cf.cf_flags (int_of_class_field_flag flag)
  32. let int_of_var_flag (flag : flag_tvar) =
  33. Obj.magic flag
  34. let add_var_flag v (flag : flag_tvar) =
  35. v.v_flags <- set_flag v.v_flags (int_of_var_flag flag)
  36. let remove_var_flag v (flag : flag_tvar) =
  37. v.v_flags <- unset_flag v.v_flags (int_of_var_flag flag)
  38. let has_var_flag v (flag : flag_tvar) =
  39. has_flag v.v_flags (int_of_var_flag flag)
  40. (* ======= General utility ======= *)
  41. let alloc_var =
  42. let uid = ref 0 in
  43. (fun kind n t p ->
  44. incr uid;
  45. {
  46. v_kind = kind;
  47. v_name = n;
  48. v_type = t;
  49. v_id = !uid;
  50. v_extra = None;
  51. v_meta = [];
  52. v_pos = p;
  53. v_flags = (match kind with VUser TVOLocalFunction -> int_of_var_flag VFinal | _ -> 0);
  54. }
  55. )
  56. let alloc_mid =
  57. let mid = ref 0 in
  58. (fun() -> incr mid; !mid)
  59. let mk e t p = { eexpr = e; etype = t; epos = p }
  60. let mk_block e =
  61. match e.eexpr with
  62. | TBlock _ -> e
  63. | _ -> mk (TBlock [e]) e.etype e.epos
  64. let mk_cast e t p = mk (TCast(e,None)) t p
  65. let null t p = mk (TConst TNull) t p
  66. let mk_mono() = TMono (!monomorph_create_ref ())
  67. let rec t_dynamic = TDynamic t_dynamic
  68. let mk_anon ?fields status =
  69. let fields = match fields with Some fields -> fields | None -> PMap.empty in
  70. TAnon { a_fields = fields; a_status = status; }
  71. (* We use this for display purposes because otherwise we never see the Dynamic type that
  72. is defined in StdTypes.hx. This is set each time a typer is created, but this is fine
  73. because Dynamic is the same in all contexts. If this ever changes we'll have to review
  74. how we handle this. *)
  75. let t_dynamic_def = ref t_dynamic
  76. let tfun pl r = TFun (List.map (fun t -> "",false,t) pl,r,false)
  77. let fun_args l = List.map (fun (a,c,t) -> a, c <> None, t) l
  78. let mk_class m path pos name_pos =
  79. {
  80. cl_path = path;
  81. cl_module = m;
  82. cl_pos = pos;
  83. cl_name_pos = name_pos;
  84. cl_doc = None;
  85. cl_meta = [];
  86. cl_private = false;
  87. cl_kind = KNormal;
  88. cl_flags = 0;
  89. cl_params = [];
  90. cl_using = [];
  91. cl_super = None;
  92. cl_implements = [];
  93. cl_fields = PMap.empty;
  94. cl_ordered_statics = [];
  95. cl_ordered_fields = [];
  96. cl_statics = PMap.empty;
  97. cl_dynamic = None;
  98. cl_array_access = None;
  99. cl_constructor = None;
  100. cl_init = None;
  101. cl_build = (fun() -> Built);
  102. cl_restore = (fun() -> ());
  103. cl_descendants = [];
  104. }
  105. let module_extra file sign time kind policy =
  106. {
  107. m_file = Path.UniqueKey.create_lazy file;
  108. m_sign = sign;
  109. m_display = {
  110. m_inline_calls = [];
  111. m_type_hints = [];
  112. m_import_positions = PMap.empty;
  113. };
  114. m_dirty = None;
  115. m_added = 0;
  116. m_mark = 0;
  117. m_time = time;
  118. m_processed = 0;
  119. m_deps = PMap.empty;
  120. m_kind = kind;
  121. m_binded_res = PMap.empty;
  122. m_if_feature = [];
  123. m_features = Hashtbl.create 0;
  124. m_check_policy = policy;
  125. }
  126. let mk_field name ?(public = true) ?(static = false) t p name_pos = {
  127. cf_name = name;
  128. cf_type = t;
  129. cf_pos = p;
  130. cf_name_pos = name_pos;
  131. cf_doc = None;
  132. cf_meta = [];
  133. cf_kind = Var { v_read = AccNormal; v_write = AccNormal };
  134. cf_expr = None;
  135. cf_expr_unoptimized = None;
  136. cf_params = [];
  137. cf_overloads = [];
  138. cf_flags = (
  139. let flags = if static then set_flag 0 (int_of_class_field_flag CfStatic) else 0 in
  140. if public then set_flag flags (int_of_class_field_flag CfPublic) else flags
  141. );
  142. }
  143. let null_module = {
  144. m_id = alloc_mid();
  145. m_path = [] , "";
  146. m_types = [];
  147. m_statics = None;
  148. m_extra = module_extra "" "" 0. MFake [];
  149. }
  150. let null_class =
  151. let c = mk_class null_module ([],"") null_pos null_pos in
  152. c.cl_private <- true;
  153. c
  154. let null_field = mk_field "" t_dynamic null_pos null_pos
  155. let null_abstract = {
  156. a_path = ([],"");
  157. a_module = null_module;
  158. a_pos = null_pos;
  159. a_name_pos = null_pos;
  160. a_private = true;
  161. a_doc = None;
  162. a_meta = [];
  163. a_params = [];
  164. a_using = [];
  165. a_ops = [];
  166. a_unops = [];
  167. a_impl = None;
  168. a_this = t_dynamic;
  169. a_from = [];
  170. a_from_field = [];
  171. a_to = [];
  172. a_to_field = [];
  173. a_array = [];
  174. a_read = None;
  175. a_write = None;
  176. a_call = None;
  177. a_enum = false;
  178. }
  179. let add_dependency m mdep =
  180. if m != null_module && m != mdep then m.m_extra.m_deps <- PMap.add mdep.m_id mdep m.m_extra.m_deps
  181. let arg_name (a,_) = a.v_name
  182. let t_infos t : tinfos =
  183. match t with
  184. | TClassDecl c -> Obj.magic c
  185. | TEnumDecl e -> Obj.magic e
  186. | TTypeDecl t -> Obj.magic t
  187. | TAbstractDecl a -> Obj.magic a
  188. let t_path t = (t_infos t).mt_path
  189. let rec extends c csup =
  190. if c == csup || List.exists (fun (i,_) -> extends i csup) c.cl_implements then
  191. true
  192. else match c.cl_super with
  193. | None -> false
  194. | Some (c,_) -> extends c csup
  195. let add_descendant c descendant =
  196. c.cl_descendants <- descendant :: c.cl_descendants
  197. let lazy_type f =
  198. match !f with
  199. | LAvailable t -> t
  200. | LProcessing f | LWait f -> f()
  201. let lazy_available t = LAvailable t
  202. let lazy_processing f = LProcessing f
  203. let lazy_wait f = LWait f
  204. let map loop t =
  205. match t with
  206. | TMono r ->
  207. (match r.tm_type with
  208. | None -> t
  209. | Some t -> loop t) (* erase*)
  210. | TEnum (_,[]) | TInst (_,[]) | TType (_,[]) | TAbstract (_,[]) ->
  211. t
  212. | TEnum (e,tl) ->
  213. TEnum (e, List.map loop tl)
  214. | TInst (c,tl) ->
  215. TInst (c, List.map loop tl)
  216. | TType (t2,tl) ->
  217. TType (t2,List.map loop tl)
  218. | TAbstract (a,tl) ->
  219. TAbstract (a,List.map loop tl)
  220. | TFun (tl,r,coro) ->
  221. TFun (List.map (fun (s,o,t) -> s, o, loop t) tl,loop r,coro)
  222. | TAnon a ->
  223. let fields = PMap.map (fun f -> { f with cf_type = loop f.cf_type }) a.a_fields in
  224. mk_anon ~fields a.a_status
  225. | TLazy f ->
  226. let ft = lazy_type f in
  227. let ft2 = loop ft in
  228. if ft == ft2 then t else ft2
  229. | TDynamic t2 ->
  230. if t == t2 then t else TDynamic (loop t2)
  231. let iter loop t =
  232. match t with
  233. | TMono r ->
  234. (match r.tm_type with
  235. | None -> ()
  236. | Some t -> loop t)
  237. | TEnum (_,[]) | TInst (_,[]) | TType (_,[]) ->
  238. ()
  239. | TEnum (e,tl) ->
  240. List.iter loop tl
  241. | TInst (c,tl) ->
  242. List.iter loop tl
  243. | TType (t2,tl) ->
  244. List.iter loop tl
  245. | TAbstract (a,tl) ->
  246. List.iter loop tl
  247. | TFun (tl,r,_) ->
  248. List.iter (fun (_,_,t) -> loop t) tl;
  249. loop r
  250. | TAnon a ->
  251. PMap.iter (fun _ f -> loop f.cf_type) a.a_fields
  252. | TLazy f ->
  253. let ft = lazy_type f in
  254. loop ft
  255. | TDynamic t2 ->
  256. if t != t2 then loop t2
  257. let duplicate t =
  258. let monos = ref [] in
  259. let rec loop t =
  260. match t with
  261. | TMono { tm_type = None } ->
  262. (try
  263. List.assq t !monos
  264. with Not_found ->
  265. let m = mk_mono() in
  266. monos := (t,m) :: !monos;
  267. m)
  268. | _ ->
  269. map loop t
  270. in
  271. loop t
  272. exception ApplyParamsRecursion
  273. (* substitute parameters with other types *)
  274. let apply_params ?stack cparams params t =
  275. match cparams with
  276. | [] -> t
  277. | _ ->
  278. let rec loop l1 l2 =
  279. match l1, l2 with
  280. | [] , [] -> []
  281. | (x,TLazy f) :: l1, _ -> loop ((x,lazy_type f) :: l1) l2
  282. | (_,t1) :: l1 , t2 :: l2 -> (t1,t2) :: loop l1 l2
  283. | _ -> die "" __LOC__
  284. in
  285. let subst = loop cparams params in
  286. let rec loop t =
  287. try
  288. List.assq t subst
  289. with Not_found ->
  290. match t with
  291. | TMono r ->
  292. (match r.tm_type with
  293. | None -> t
  294. | Some t -> loop t)
  295. | TEnum (e,tl) ->
  296. (match tl with
  297. | [] -> t
  298. | _ -> TEnum (e,List.map loop tl))
  299. | TType (t2,tl) ->
  300. (match tl with
  301. | [] -> t
  302. | _ ->
  303. let new_applied_params = List.map loop tl in
  304. (match stack with
  305. | None -> ()
  306. | Some stack ->
  307. List.iter (fun (subject, old_applied_params) ->
  308. (*
  309. E.g.:
  310. ```
  311. typedef Rec<T> = { function method():Rec<Array<T>> }
  312. ```
  313. We need to make sure that we are not applying the result of previous
  314. application to the same place, which would mean the result of current
  315. application would go into `apply_params` again and then again and so on.
  316. Argument `stack` holds all previous results of `apply_params` to typedefs in current
  317. unification process.
  318. Imagine we are trying to unify `Rec<Int>` with something.
  319. Once `apply_params Array<T> Int Rec<Array<T>>` is called for the first time the result
  320. will be `Rec< Array<Int> >`. Store `Array<Int>` into `stack`
  321. Then the next params application looks like this:
  322. `apply_params Array<T> Array<Int> Rec<Array<T>>`
  323. Notice the second argument is actually the result of a previous `apply_params` call.
  324. And the result of the current call is `Rec< Array<Array<Int>> >`.
  325. The third call would be:
  326. `apply_params Array<T> Array<Array<Int>> Rec<Array<T>>`
  327. and so on.
  328. To stop infinite params application we need to check that we are trying to apply params
  329. produced by the previous `apply_params Array<Int> _ Rec<Array<T>>` to the same `Rec<Array<T>>`
  330. *)
  331. if
  332. subject == t (* Check the place that we're applying to is the same `Rec<Array<T>>` *)
  333. && old_applied_params == params (* Check that params we're applying are the same params
  334. produced by the previous call to
  335. `apply_params Array<T> _ Rec<Array<T>>` *)
  336. then
  337. raise ApplyParamsRecursion
  338. ) !stack;
  339. stack := (t, new_applied_params) :: !stack;
  340. );
  341. TType (t2,new_applied_params))
  342. | TAbstract (a,tl) ->
  343. (match tl with
  344. | [] -> t
  345. | _ -> TAbstract (a,List.map loop tl))
  346. | TInst (c,tl) ->
  347. (match tl with
  348. | [] ->
  349. t
  350. | [TMono r] ->
  351. (match r.tm_type with
  352. | Some tt when t == tt ->
  353. (* for dynamic *)
  354. let pt = mk_mono() in
  355. let t = TInst (c,[pt]) in
  356. (match pt with TMono r -> !monomorph_bind_ref r t | _ -> die "" __LOC__);
  357. t
  358. | _ -> TInst (c,List.map loop tl))
  359. | _ ->
  360. TInst (c,List.map loop tl))
  361. | TFun (tl,r,coro) ->
  362. TFun (List.map (fun (s,o,t) -> s, o, loop t) tl,loop r,coro)
  363. | TAnon a ->
  364. let fields = PMap.map (fun f -> { f with cf_type = loop f.cf_type }) a.a_fields in
  365. mk_anon ~fields a.a_status
  366. | TLazy f ->
  367. let ft = lazy_type f in
  368. let ft2 = loop ft in
  369. if ft == ft2 then
  370. t
  371. else
  372. ft2
  373. | TDynamic t2 ->
  374. if t == t2 then
  375. t
  376. else
  377. TDynamic (loop t2)
  378. in
  379. loop t
  380. let monomorphs eparams t =
  381. apply_params eparams (List.map (fun _ -> mk_mono()) eparams) t
  382. let apply_params_stack = ref []
  383. let try_apply_params_rec cparams params t success =
  384. let old_stack = !apply_params_stack in
  385. try
  386. let result = success (apply_params ~stack:apply_params_stack cparams params t) in
  387. apply_params_stack := old_stack;
  388. result
  389. with
  390. | ApplyParamsRecursion ->
  391. apply_params_stack := old_stack;
  392. | err ->
  393. apply_params_stack := old_stack;
  394. raise err
  395. let rec follow t =
  396. match t with
  397. | TMono r ->
  398. (match r.tm_type with
  399. | Some t -> follow t
  400. | _ -> t)
  401. | TLazy f ->
  402. follow (lazy_type f)
  403. | TType (t,tl) ->
  404. follow (apply_params t.t_params tl t.t_type)
  405. | TAbstract({a_path = [],"Null"},[t]) ->
  406. follow t
  407. | _ -> t
  408. let follow_once t =
  409. match t with
  410. | TMono r ->
  411. (match r.tm_type with
  412. | None -> t
  413. | Some t -> t)
  414. | TAbstract _ | TEnum _ | TInst _ | TFun _ | TAnon _ | TDynamic _ ->
  415. t
  416. | TType (t,tl) ->
  417. apply_params t.t_params tl t.t_type
  418. | TLazy f ->
  419. lazy_type f
  420. let rec follow_without_null t =
  421. match t with
  422. | TMono r ->
  423. (match r.tm_type with
  424. | Some t -> follow_without_null t
  425. | _ -> t)
  426. | TLazy f ->
  427. follow_without_null (lazy_type f)
  428. | TType (t,tl) ->
  429. follow_without_null (apply_params t.t_params tl t.t_type)
  430. | _ -> t
  431. let rec follow_without_type t =
  432. match t with
  433. | TMono r ->
  434. (match r.tm_type with
  435. | Some t -> follow_without_type t
  436. | _ -> t)
  437. | TLazy f ->
  438. follow_without_type (lazy_type f)
  439. | TAbstract({a_path = [],"Null"},[t]) ->
  440. follow_without_type t
  441. | _ -> t
  442. let rec ambiguate_funs t =
  443. match follow t with
  444. | TFun(_,_,coro) -> TFun ([], t_dynamic,coro)
  445. | _ -> map ambiguate_funs t
  446. let rec is_nullable ?(no_lazy=false) = function
  447. | TMono r ->
  448. (match r.tm_type with None -> false | Some t -> is_nullable ~no_lazy t)
  449. | TAbstract ({ a_path = ([],"Null") },[_]) ->
  450. true
  451. | TLazy f ->
  452. (match !f with
  453. | LAvailable t -> is_nullable ~no_lazy t
  454. | _ when no_lazy -> raise Exit
  455. | _ -> is_nullable (lazy_type f)
  456. )
  457. | TType (t,tl) ->
  458. is_nullable ~no_lazy (apply_params t.t_params tl t.t_type)
  459. | TFun _ ->
  460. false
  461. (*
  462. Type parameters will most of the time be nullable objects, so we don't want to make it hard for users
  463. to have to specify Null<T> all over the place, so while they could be a basic type, let's assume they will not.
  464. This will still cause issues with inlining and haxe.rtti.Generic. In that case proper explicit Null<T> is required to
  465. work correctly with basic types. This could still be fixed by redoing a nullability inference on the typed AST.
  466. | TInst ({ cl_kind = KTypeParameter },_) -> false
  467. *)
  468. | TAbstract (a,_) when Meta.has Meta.CoreType a.a_meta ->
  469. not (Meta.has Meta.NotNull a.a_meta)
  470. | TAbstract (a,tl) ->
  471. not (Meta.has Meta.NotNull a.a_meta) && is_nullable (apply_params a.a_params tl a.a_this)
  472. | _ ->
  473. true
  474. let rec is_null ?(no_lazy=false) = function
  475. | TMono r ->
  476. (match r.tm_type with None -> false | Some t -> is_null ~no_lazy t)
  477. | TAbstract ({ a_path = ([],"Null") },[t]) ->
  478. not (is_nullable ~no_lazy (follow t))
  479. | TLazy f ->
  480. (match !f with
  481. | LAvailable t -> is_null ~no_lazy t
  482. | _ when no_lazy -> raise Exit
  483. | _ -> is_null (lazy_type f)
  484. )
  485. | TType (t,tl) ->
  486. is_null ~no_lazy (apply_params t.t_params tl t.t_type)
  487. | _ ->
  488. false
  489. (* Determines if we have a Null<T>. Unlike is_null, this returns true even if the wrapped type is nullable itself. *)
  490. let rec is_explicit_null = function
  491. | TMono r ->
  492. (match r.tm_type with None -> false | Some t -> is_explicit_null t)
  493. | TAbstract ({ a_path = ([],"Null") },[t]) ->
  494. true
  495. | TLazy f ->
  496. is_explicit_null (lazy_type f)
  497. | TType (t,tl) ->
  498. is_explicit_null (apply_params t.t_params tl t.t_type)
  499. | _ ->
  500. false
  501. let rec has_mono t = match t with
  502. | TMono r ->
  503. (match r.tm_type with None -> true | Some t -> has_mono t)
  504. | TInst(_,pl) | TEnum(_,pl) | TAbstract(_,pl) | TType(_,pl) ->
  505. List.exists has_mono pl
  506. | TDynamic _ ->
  507. false
  508. | TFun(args,r,_) ->
  509. has_mono r || List.exists (fun (_,_,t) -> has_mono t) args
  510. | TAnon a ->
  511. PMap.fold (fun cf b -> has_mono cf.cf_type || b) a.a_fields false
  512. | TLazy f ->
  513. has_mono (lazy_type f)
  514. let concat e1 e2 =
  515. let e = (match e1.eexpr, e2.eexpr with
  516. | TBlock el1, TBlock el2 -> TBlock (el1@el2)
  517. | TBlock el, _ -> TBlock (el @ [e2])
  518. | _, TBlock el -> TBlock (e1 :: el)
  519. | _ , _ -> TBlock [e1;e2]
  520. ) in
  521. mk e e2.etype (punion e1.epos e2.epos)
  522. let type_of_module_type = function
  523. | TClassDecl c -> TInst (c,List.map snd c.cl_params)
  524. | TEnumDecl e -> TEnum (e,List.map snd e.e_params)
  525. | TTypeDecl t -> TType (t,List.map snd t.t_params)
  526. | TAbstractDecl a -> TAbstract (a,List.map snd a.a_params)
  527. let rec module_type_of_type = function
  528. | TInst(c,_) -> TClassDecl c
  529. | TEnum(en,_) -> TEnumDecl en
  530. | TType(t,_) -> TTypeDecl t
  531. | TAbstract(a,_) -> TAbstractDecl a
  532. | TLazy f -> module_type_of_type (lazy_type f)
  533. | TMono r ->
  534. (match r.tm_type with
  535. | Some t -> module_type_of_type t
  536. | _ -> raise Exit)
  537. | _ ->
  538. raise Exit
  539. let tconst_to_const = function
  540. | TInt i -> Int (Int32.to_string i)
  541. | TFloat s -> Float s
  542. | TString s -> String(s,SDoubleQuotes)
  543. | TBool b -> Ident (if b then "true" else "false")
  544. | TNull -> Ident "null"
  545. | TThis -> Ident "this"
  546. | TSuper -> Ident "super"
  547. let has_ctor_constraint c = match c.cl_kind with
  548. | KTypeParameter tl ->
  549. List.exists (fun t -> match follow t with
  550. | TAnon a when PMap.mem "new" a.a_fields -> true
  551. | TAbstract({a_path=["haxe"],"Constructible"},_) -> true
  552. | _ -> false
  553. ) tl;
  554. | _ -> false
  555. (* ======= Field utility ======= *)
  556. let field_name f =
  557. match f with
  558. | FAnon f | FInstance (_,_,f) | FStatic (_,f) | FClosure (_,f) -> f.cf_name
  559. | FEnum (_,f) -> f.ef_name
  560. | FDynamic n -> n
  561. let extract_field = function
  562. | FAnon f | FInstance (_,_,f) | FStatic (_,f) | FClosure (_,f) -> Some f
  563. | _ -> None
  564. let is_physical_var_field f =
  565. match f.cf_kind with
  566. | Var { v_read = AccNormal | AccInline | AccNo } | Var { v_write = AccNormal | AccNo } -> true
  567. | Var _ -> Meta.has Meta.IsVar f.cf_meta
  568. | _ -> false
  569. let is_physical_field f =
  570. match f.cf_kind with
  571. | Method _ -> true
  572. | _ -> is_physical_var_field f
  573. let field_type f =
  574. match f.cf_params with
  575. | [] -> f.cf_type
  576. | l -> monomorphs l f.cf_type
  577. let rec raw_class_field build_type c tl i =
  578. let apply = apply_params c.cl_params tl in
  579. try
  580. let f = PMap.find i c.cl_fields in
  581. Some (c,tl), build_type f , f
  582. with Not_found -> try (match c.cl_constructor with
  583. | Some ctor when i = "new" -> Some (c,tl), build_type ctor,ctor
  584. | _ -> raise Not_found)
  585. with Not_found -> try
  586. match c.cl_super with
  587. | None ->
  588. raise Not_found
  589. | Some (c,tl) ->
  590. let c2 , t , f = raw_class_field build_type c (List.map apply tl) i in
  591. c2, apply_params c.cl_params tl t , f
  592. with Not_found ->
  593. match c.cl_kind with
  594. | KTypeParameter tl ->
  595. let rec loop = function
  596. | [] ->
  597. raise Not_found
  598. | t :: ctl ->
  599. match follow t with
  600. | TAnon a ->
  601. (try
  602. let f = PMap.find i a.a_fields in
  603. None, build_type f, f
  604. with
  605. Not_found -> loop ctl)
  606. | TInst (c,tl) ->
  607. (try
  608. let c2, t , f = raw_class_field build_type c (List.map apply tl) i in
  609. c2, apply_params c.cl_params tl t, f
  610. with
  611. Not_found -> loop ctl)
  612. | _ ->
  613. loop ctl
  614. in
  615. loop tl
  616. | _ ->
  617. if not (has_class_flag c CInterface) then raise Not_found;
  618. (*
  619. an interface can implements other interfaces without
  620. having to redeclare its fields
  621. *)
  622. let rec loop = function
  623. | [] ->
  624. raise Not_found
  625. | (c,tl) :: l ->
  626. try
  627. let c2, t , f = raw_class_field build_type c (List.map apply tl) i in
  628. c2, apply_params c.cl_params tl t, f
  629. with
  630. Not_found -> loop l
  631. in
  632. loop c.cl_implements
  633. let class_field = raw_class_field field_type
  634. let quick_field t n =
  635. match follow t with
  636. | TInst (c,tl) ->
  637. let c, _, f = raw_class_field (fun f -> f.cf_type) c tl n in
  638. (match c with None -> FAnon f | Some (c,tl) -> FInstance (c,tl,f))
  639. | TAnon a ->
  640. (match !(a.a_status) with
  641. | EnumStatics e ->
  642. let ef = PMap.find n e.e_constrs in
  643. FEnum(e,ef)
  644. | Statics c ->
  645. FStatic (c,PMap.find n c.cl_statics)
  646. | AbstractStatics a ->
  647. begin match a.a_impl with
  648. | Some c ->
  649. let cf = PMap.find n c.cl_statics in
  650. FStatic(c,cf) (* is that right? *)
  651. | _ ->
  652. raise Not_found
  653. end
  654. | _ ->
  655. FAnon (PMap.find n a.a_fields))
  656. | TDynamic _ ->
  657. FDynamic n
  658. | TEnum _ | TMono _ | TAbstract _ | TFun _ ->
  659. raise Not_found
  660. | TLazy _ | TType _ ->
  661. die "" __LOC__
  662. let quick_field_dynamic t s =
  663. try quick_field t s
  664. with Not_found -> FDynamic s
  665. let rec get_constructor_class c tl =
  666. match c.cl_constructor, c.cl_super with
  667. | Some cf, _ -> (cf,c,tl)
  668. | None, None -> raise Not_found
  669. | None, Some (csup,tlsup) -> get_constructor_class csup (List.map (apply_params c.cl_params tl) tlsup)
  670. let rec get_constructor c =
  671. match c.cl_constructor, c.cl_super with
  672. | Some c, _ -> c
  673. | None, None -> raise Not_found
  674. | None, Some (csup,_) -> get_constructor csup
  675. let has_constructor c =
  676. try
  677. ignore(get_constructor c);
  678. true
  679. with Not_found -> false
  680. let is_module_fields_class c =
  681. match c.cl_kind with KModuleFields _ -> true | _ -> false
  682. let is_pos_outside_class c p =
  683. p.pfile <> c.cl_pos.pfile || p.pmax < c.cl_pos.pmin || p.pmin > c.cl_pos.pmax
  684. let resolve_typedef t =
  685. match t with
  686. | TClassDecl _ | TEnumDecl _ | TAbstractDecl _ -> t
  687. | TTypeDecl td ->
  688. match follow td.t_type with
  689. | TEnum (e,_) -> TEnumDecl e
  690. | TInst (c,_) -> TClassDecl c
  691. | TAbstract (a,_) -> TAbstractDecl a
  692. | _ -> t
  693. (**
  694. Check if type `t` has meta `m`.
  695. Does not follow typedefs, monomorphs etc.
  696. *)
  697. let type_has_meta t m =
  698. match t with
  699. | TMono _ | TFun _ | TAnon _ | TDynamic _ | TLazy _ -> false
  700. | TEnum ({ e_meta = metadata }, _)
  701. | TInst ({ cl_meta = metadata }, _)
  702. | TType ({ t_meta = metadata }, _)
  703. | TAbstract ({ a_meta = metadata }, _) -> has_meta m metadata
  704. (* tvar *)
  705. let var_extra params e = {
  706. v_params = params;
  707. v_expr = e;
  708. }