typeload.ml 45 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308
  1. (*
  2. * Haxe Compiler
  3. * Copyright (c)2005-2008 Nicolas Cannasse
  4. *
  5. * This program is free software; you can redistribute it and/or modify
  6. * it under the terms of the GNU General Public License as published by
  7. * the Free Software Foundation; either version 2 of the License, or
  8. * (at your option) any later version.
  9. *
  10. * This program is distributed in the hope that it will be useful,
  11. * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. * GNU General Public License for more details.
  14. *
  15. * You should have received a copy of the GNU General Public License
  16. * along with this program; if not, write to the Free Software
  17. * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  18. *)
  19. open Ast
  20. open Type
  21. open Common
  22. open Typecore
  23. let type_function_param ctx t e opt p =
  24. match e with
  25. | None ->
  26. if opt then ctx.t.tnull t, Some (EConst (Ident "null"),p) else t, None
  27. | Some e ->
  28. t, Some e
  29. let type_static_var ctx t e p =
  30. ctx.in_static <- true;
  31. let e = type_expr ctx e true in
  32. unify ctx e.etype t p;
  33. (* specific case for UInt statics *)
  34. match t with
  35. | TType ({ t_path = ([],"UInt") },[]) -> { e with etype = t }
  36. | _ -> e
  37. let apply_macro ctx path el p =
  38. let cpath, meth = (match List.rev (ExtString.String.nsplit path ".") with
  39. | meth :: name :: pack -> (List.rev pack,name), meth
  40. | _ -> error "Invalid macro path" p
  41. ) in
  42. ctx.g.do_macro ctx cpath meth el p
  43. (** since load_type_def and load_instance are used in PASS2, they should not access the structure of a type **)
  44. (*
  45. load a type or a subtype definition
  46. *)
  47. let rec load_type_def ctx p t =
  48. let no_pack = t.tpackage = [] in
  49. let tname = (match t.tsub with None -> t.tname | Some n -> n) in
  50. try
  51. List.find (fun t2 ->
  52. let tp = t_path t2 in
  53. tp = (t.tpackage,tname) || (no_pack && snd tp = tname)
  54. ) ctx.local_types
  55. with
  56. Not_found ->
  57. let next() =
  58. let m = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
  59. let tpath = (t.tpackage,tname) in
  60. try
  61. List.find (fun t -> not (t_private t) && t_path t = tpath) m.mtypes
  62. with
  63. Not_found -> raise (Error (Type_not_found (m.mpath,tname),p))
  64. in
  65. let rec loop = function
  66. | [] -> raise Exit
  67. | (_ :: lnext) as l ->
  68. try
  69. load_type_def ctx p { t with tpackage = List.rev l }
  70. with
  71. | Error (Module_not_found _,p2)
  72. | Error (Type_not_found _,p2) when p == p2 -> loop lnext
  73. in
  74. try
  75. if not no_pack then raise Exit;
  76. (match fst ctx.current.mpath with
  77. | [] -> raise Exit
  78. | x :: _ ->
  79. (* this can occur due to haxe remoting : a module can be
  80. already defined in the "js" package and is not allowed
  81. to access the js classes *)
  82. try
  83. (match PMap.find x ctx.com.package_rules with
  84. | Forbidden -> raise Exit
  85. | _ -> ())
  86. with Not_found -> ());
  87. loop (List.rev (fst ctx.current.mpath));
  88. with
  89. Exit -> next()
  90. (* build an instance from a full type *)
  91. let rec load_instance ctx t p allow_no_params =
  92. try
  93. if t.tpackage <> [] || t.tsub <> None then raise Not_found;
  94. let pt = List.assoc t.tname ctx.type_params in
  95. if t.tparams <> [] then error ("Class type parameter " ^ t.tname ^ " can't have parameters") p;
  96. pt
  97. with Not_found ->
  98. let types , path , f = ctx.g.do_build_instance ctx (load_type_def ctx p t) p in
  99. if allow_no_params && t.tparams = [] then
  100. f (List.map (fun (name,t) ->
  101. match follow t with
  102. | TInst (c,_) ->
  103. let t = mk_mono() in
  104. if c.cl_implements <> [] then delay ctx (fun() ->
  105. List.iter (fun (i,tl) -> unify ctx t (TInst(i,tl)) p) c.cl_implements
  106. );
  107. t;
  108. | _ -> assert false
  109. ) types)
  110. else if path = ([],"Dynamic") then
  111. match t.tparams with
  112. | [] -> t_dynamic
  113. | [TPType t] -> TDynamic (load_complex_type ctx p t)
  114. | _ -> error "Too many parameters for Dynamic" p
  115. else begin
  116. if List.length types <> List.length t.tparams then error ("Invalid number of type parameters for " ^ s_type_path path) p;
  117. let tparams = List.map (fun t ->
  118. match t with
  119. | TPConst c ->
  120. let name, const = (match c with
  121. | String s -> "S" ^ s, TString s
  122. | Int i -> "I" ^ i, TInt (Int32.of_string i)
  123. | Float f -> "F" ^ f, TFloat f
  124. | _ -> assert false
  125. ) in
  126. let c = mk_class ([],name) p in
  127. c.cl_kind <- KConstant const;
  128. TInst (c,[])
  129. | TPType t -> load_complex_type ctx p t
  130. ) t.tparams in
  131. let params = List.map2 (fun t (name,t2) ->
  132. let isconst = (match t with TInst ({ cl_kind = KConstant _ },_) -> true | _ -> false) in
  133. if isconst <> (name = "Const") && t != t_dynamic then error (if isconst then "Constant value unexpected here" else "Constant value excepted as type parameter") p;
  134. match follow t2 with
  135. | TInst ({ cl_implements = [] }, []) ->
  136. t
  137. | TInst (c,[]) ->
  138. let r = exc_protect (fun r ->
  139. r := (fun() -> t);
  140. List.iter (fun (i,params) ->
  141. unify ctx t (apply_params types tparams (TInst (i,params))) p
  142. ) c.cl_implements;
  143. t
  144. ) in
  145. delay ctx (fun () -> ignore(!r()));
  146. TLazy r
  147. | _ -> assert false
  148. ) tparams types in
  149. f params
  150. end
  151. (*
  152. build an instance from a complex type
  153. *)
  154. and load_complex_type ctx p t =
  155. match t with
  156. | CTParent t -> load_complex_type ctx p t
  157. | CTPath t -> load_instance ctx t p false
  158. | CTExtend (t,l) ->
  159. (match load_complex_type ctx p (CTAnonymous l) with
  160. | TAnon a ->
  161. let rec loop t =
  162. match follow t with
  163. | TInst (c,tl) ->
  164. let c2 = mk_class (fst c.cl_path,"+" ^ snd c.cl_path) p in
  165. c2.cl_private <- true;
  166. PMap.iter (fun f _ ->
  167. try
  168. ignore(class_field c f);
  169. error ("Cannot redefine field " ^ f) p
  170. with
  171. Not_found -> ()
  172. ) a.a_fields;
  173. (* do NOT tag as extern - for protect *)
  174. c2.cl_kind <- KExtension (c,tl);
  175. c2.cl_super <- Some (c,tl);
  176. c2.cl_fields <- a.a_fields;
  177. TInst (c2,[])
  178. | TMono _ ->
  179. error "Please ensure correct initialization of cascading signatures" p
  180. | TAnon a2 ->
  181. PMap.iter (fun f _ ->
  182. if PMap.mem f a2.a_fields then error ("Cannot redefine field " ^ f) p
  183. ) a.a_fields;
  184. mk_anon (PMap.foldi PMap.add a.a_fields a2.a_fields)
  185. | _ -> error "Cannot only extend classes and anonymous" p
  186. in
  187. loop (load_instance ctx t p false)
  188. | _ -> assert false)
  189. | CTAnonymous l ->
  190. let rec loop acc (n,pub,f,p) =
  191. if PMap.mem n acc then error ("Duplicate field declaration : " ^ n) p;
  192. let t , access = (match f with
  193. | AFVar t ->
  194. load_complex_type ctx p t, Var { v_read = AccNormal; v_write = AccNormal }
  195. | AFFun (tl,t) ->
  196. let t = load_complex_type ctx p t in
  197. let args = List.map (fun (name,o,t) -> name , o, load_complex_type ctx p t) tl in
  198. TFun (args,t), Method MethNormal
  199. | AFProp (t,i1,i2) ->
  200. let access m get =
  201. match m with
  202. | "null" -> AccNo
  203. | "never" -> AccNever
  204. | "default" -> AccNormal
  205. | "dynamic" -> AccCall ((if get then "get_" else "set_") ^ n)
  206. | _ -> AccCall m
  207. in
  208. load_complex_type ctx p t, Var { v_read = access i1 true; v_write = access i2 false }
  209. ) in
  210. PMap.add n {
  211. cf_name = n;
  212. cf_type = t;
  213. cf_public = (match pub with None -> true | Some p -> p);
  214. cf_kind = access;
  215. cf_params = [];
  216. cf_expr = None;
  217. cf_doc = None;
  218. cf_meta = no_meta;
  219. } acc
  220. in
  221. mk_anon (List.fold_left loop PMap.empty l)
  222. | CTFunction (args,r) ->
  223. match args with
  224. | [CTPath { tpackage = []; tparams = []; tname = "Void" }] ->
  225. TFun ([],load_complex_type ctx p r)
  226. | _ ->
  227. TFun (List.map (fun t -> "",false,load_complex_type ctx p t) args,load_complex_type ctx p r)
  228. let hide_types ctx =
  229. let old_locals = ctx.local_types in
  230. let old_type_params = ctx.type_params in
  231. ctx.local_types <- ctx.g.std.mtypes;
  232. ctx.type_params <- [];
  233. (fun() ->
  234. ctx.local_types <- old_locals;
  235. ctx.type_params <- old_type_params;
  236. )
  237. (*
  238. load a type while ignoring the current imports or local types
  239. *)
  240. let load_core_type ctx name =
  241. let show = hide_types ctx in
  242. let t = load_instance ctx { tpackage = []; tname = name; tparams = []; tsub = None; } null_pos false in
  243. show();
  244. t
  245. let t_iterator ctx =
  246. let show = hide_types ctx in
  247. match load_type_def ctx null_pos { tpackage = []; tname = "Iterator"; tparams = []; tsub = None } with
  248. | TTypeDecl t ->
  249. show();
  250. if List.length t.t_types <> 1 then assert false;
  251. let pt = mk_mono() in
  252. apply_params t.t_types [pt] t.t_type, pt
  253. | _ ->
  254. assert false
  255. (*
  256. load either a type t or Null<Unknown> if not defined
  257. *)
  258. let load_type_opt ?(opt=false) ctx p t =
  259. let t = (match t with None -> mk_mono() | Some t -> load_complex_type ctx p t) in
  260. if opt then ctx.t.tnull t else t
  261. (* ---------------------------------------------------------------------- *)
  262. (* Structure check *)
  263. let valid_redefinition ctx f1 t1 f2 t2 =
  264. let valid t1 t2 =
  265. type_eq EqStrict t1 t2;
  266. if is_null t1 <> is_null t2 then raise (Unify_error [Cannot_unify (t1,t2)]);
  267. in
  268. let t1, t2 = (match f1.cf_params, f2.cf_params with
  269. | [], [] -> t1, t2
  270. | l1, l2 when List.length l1 = List.length l2 ->
  271. let monos = List.map (fun _ -> mk_mono()) l1 in
  272. apply_params l1 monos t1, apply_params l2 monos t2
  273. | _ -> t1, t2
  274. ) in
  275. match follow t1, follow t2 with
  276. | TFun (args1,r1) , TFun (args2,r2) when List.length args1 = List.length args2 ->
  277. List.iter2 (fun (n,o1,a1) (_,o2,a2) ->
  278. if o1 <> o2 then raise (Unify_error [Not_matching_optional n]);
  279. valid a1 a2;
  280. ) args1 args2;
  281. valid r1 r2;
  282. | _ , _ ->
  283. (* in case args differs, or if an interface var *)
  284. valid t1 t2
  285. let check_overriding ctx c p () =
  286. match c.cl_super with
  287. | None ->
  288. (match c.cl_overrides with
  289. | [] -> ()
  290. | i :: _ ->
  291. display_error ctx ("Field " ^ i ^ " is declared 'override' but doesn't override any field") p)
  292. | Some (csup,params) ->
  293. PMap.iter (fun i f ->
  294. try
  295. let t , f2 = raw_class_field (fun f -> f.cf_type) csup i in
  296. ignore(follow f.cf_type); (* force evaluation *)
  297. let p = (match f.cf_expr with None -> p | Some e -> e.epos) in
  298. if not (List.mem i c.cl_overrides) then
  299. display_error ctx ("Field " ^ i ^ " should be declared with 'override' since it is inherited from superclass") p
  300. else if f.cf_public <> f2.cf_public then
  301. display_error ctx ("Field " ^ i ^ " has different visibility (public/private) than superclass one") p
  302. else (match f.cf_kind, f2.cf_kind with
  303. | _, Method MethInline ->
  304. display_error ctx ("Field " ^ i ^ " is inlined and cannot be overridden") p
  305. | a, b when a = b -> ()
  306. | Method MethInline, Method MethNormal ->
  307. () (* allow to redefine a method as inlined *)
  308. | _ ->
  309. display_error ctx ("Field " ^ i ^ " has different property access than in superclass") p);
  310. try
  311. let t = apply_params csup.cl_types params t in
  312. valid_redefinition ctx f f.cf_type f2 t
  313. with
  314. Unify_error l ->
  315. display_error ctx ("Field " ^ i ^ " overload parent class with different or incomplete type") p;
  316. display_error ctx (error_msg (Unify l)) p;
  317. with
  318. Not_found ->
  319. if List.mem i c.cl_overrides then display_error ctx ("Field " ^ i ^ " is declared 'override' but doesn't override any field") p
  320. ) c.cl_fields
  321. let class_field_no_interf c i =
  322. try
  323. let f = PMap.find i c.cl_fields in
  324. f.cf_type , f
  325. with Not_found ->
  326. match c.cl_super with
  327. | None ->
  328. raise Not_found
  329. | Some (c,tl) ->
  330. (* rec over class_field *)
  331. let t , f = raw_class_field (fun f -> f.cf_type) c i in
  332. apply_params c.cl_types tl t , f
  333. let rec check_interface ctx c p intf params =
  334. PMap.iter (fun i f ->
  335. try
  336. let t2, f2 = class_field_no_interf c i in
  337. ignore(follow f2.cf_type); (* force evaluation *)
  338. let p = (match f2.cf_expr with None -> p | Some e -> e.epos) in
  339. if f.cf_public && not f2.cf_public then
  340. display_error ctx ("Field " ^ i ^ " should be public as requested by " ^ s_type_path intf.cl_path) p
  341. else if not (unify_kind f2.cf_kind f.cf_kind) then
  342. display_error ctx ("Field " ^ i ^ " has different property access than in " ^ s_type_path intf.cl_path ^ " (" ^ s_kind f2.cf_kind ^ " should be " ^ s_kind f.cf_kind ^ ")") p
  343. else try
  344. valid_redefinition ctx f2 t2 f (apply_params intf.cl_types params f.cf_type)
  345. with
  346. Unify_error l ->
  347. display_error ctx ("Field " ^ i ^ " has different type than in " ^ s_type_path intf.cl_path) p;
  348. display_error ctx (error_msg (Unify l)) p;
  349. with
  350. Not_found ->
  351. if not c.cl_interface then display_error ctx ("Field " ^ i ^ " needed by " ^ s_type_path intf.cl_path ^ " is missing") p
  352. ) intf.cl_fields;
  353. List.iter (fun (i2,p2) ->
  354. check_interface ctx c p i2 (List.map (apply_params intf.cl_types params) p2)
  355. ) intf.cl_implements
  356. let check_interfaces ctx c p () =
  357. match c.cl_path with
  358. | "Proxy" :: _ , _ -> ()
  359. | _ ->
  360. List.iter (fun (intf,params) -> check_interface ctx c p intf params) c.cl_implements
  361. let rec return_flow ctx e =
  362. let error() = display_error ctx "A return is missing here" e.epos; raise Exit in
  363. let return_flow = return_flow ctx in
  364. match e.eexpr with
  365. | TReturn _ | TThrow _ -> ()
  366. | TParenthesis e ->
  367. return_flow e
  368. | TBlock el ->
  369. let rec loop = function
  370. | [] -> error()
  371. | [e] -> return_flow e
  372. | { eexpr = TReturn _ } :: _ | { eexpr = TThrow _ } :: _ -> ()
  373. | _ :: l -> loop l
  374. in
  375. loop el
  376. | TIf (_,e1,Some e2) ->
  377. return_flow e1;
  378. return_flow e2;
  379. | TSwitch (v,cases,Some e) ->
  380. List.iter (fun (_,e) -> return_flow e) cases;
  381. return_flow e
  382. | TSwitch (e,cases,None) when (match follow e.etype with TEnum _ -> true | _ -> false) ->
  383. List.iter (fun (_,e) -> return_flow e) cases;
  384. | TMatch (_,_,cases,def) ->
  385. List.iter (fun (_,_,e) -> return_flow e) cases;
  386. (match def with None -> () | Some e -> return_flow e)
  387. | TTry (e,cases) ->
  388. return_flow e;
  389. List.iter (fun (_,_,e) -> return_flow e) cases;
  390. | _ ->
  391. error()
  392. (* ---------------------------------------------------------------------- *)
  393. (* PASS 1 & 2 : Module and Class Structure *)
  394. let set_heritance ctx c herits p =
  395. let rec loop = function
  396. | HPrivate | HExtern | HInterface ->
  397. ()
  398. | HExtends t ->
  399. if c.cl_super <> None then error "Cannot extend several classes" p;
  400. let t = load_instance ctx t p false in
  401. (match follow t with
  402. | TInst ({ cl_path = [],"Array" },_)
  403. | TInst ({ cl_path = [],"String" },_)
  404. | TInst ({ cl_path = [],"Date" },_)
  405. | TInst ({ cl_path = [],"Xml" },_) when ((not (platform ctx.com Cpp)) && (match c.cl_path with "mt" :: _ , _ -> false | _ -> true)) ->
  406. error "Cannot extend basic class" p;
  407. | TInst (cl,params) ->
  408. if is_parent c cl then error "Recursive class" p;
  409. if c.cl_interface then error "Cannot extend an interface" p;
  410. if cl.cl_interface then error "Cannot extend by using an interface" p;
  411. if Type.has_meta ":final" cl.cl_meta && not (Type.has_meta ":hack" c.cl_meta) then error "Cannot extend a final class" p;
  412. c.cl_super <- Some (cl,params)
  413. | _ -> error "Should extend by using a class" p)
  414. | HImplements t ->
  415. let t = load_instance ctx t p false in
  416. (match follow t with
  417. | TInst ({ cl_path = [],"ArrayAccess"; cl_extern = true; },[t]) ->
  418. if c.cl_array_access <> None then error "Duplicate array access" p;
  419. c.cl_array_access <- Some t
  420. | TInst (cl,params) ->
  421. if is_parent c cl then error "Recursive class" p;
  422. c.cl_implements <- (cl, params) :: c.cl_implements
  423. | TDynamic t ->
  424. if c.cl_dynamic <> None then error "Cannot have several dynamics" p;
  425. c.cl_dynamic <- Some t
  426. | _ -> error "Should implement by using an interface or a class" p)
  427. in
  428. (*
  429. resolve imports before calling build_inheritance, since it requires full paths.
  430. that means that typedefs are not working, but that's a fair limitation
  431. *)
  432. let rec resolve_imports t =
  433. match t.tpackage with
  434. | _ :: _ -> t
  435. | [] ->
  436. try
  437. let lt = List.find (fun lt -> snd (t_path lt) = t.tname) ctx.local_types in
  438. { t with tpackage = fst (t_path lt) }
  439. with
  440. Not_found -> t
  441. in
  442. let herits = List.map (function
  443. | HExtends t -> HExtends (resolve_imports t)
  444. | HImplements t -> HImplements (resolve_imports t)
  445. | h -> h
  446. ) herits in
  447. List.iter loop (List.filter (ctx.g.do_inherit ctx c p) herits)
  448. let type_type_params ctx path p (n,flags) =
  449. let c = mk_class (fst path @ [snd path],n) p in
  450. c.cl_kind <- KTypeParameter;
  451. let t = TInst (c,[]) in
  452. match flags with
  453. | [] -> n, t
  454. | _ ->
  455. let r = exc_protect (fun r ->
  456. r := (fun _ -> t);
  457. set_heritance ctx c (List.map (fun t -> HImplements t) flags) p;
  458. t
  459. ) in
  460. delay ctx (fun () -> ignore(!r()));
  461. n, TLazy r
  462. let type_function ctx args ret static constr f p =
  463. let locals = save_locals ctx in
  464. let fargs = List.map (fun (n,c,t) ->
  465. let c = (match c with
  466. | None -> None
  467. | Some e ->
  468. let p = pos e in
  469. let e = ctx.g.do_optimize ctx (type_expr ctx e true) in
  470. unify ctx e.etype t p;
  471. match e.eexpr with
  472. | TConst c -> Some c
  473. | _ -> error "Parameter default value should be constant" p
  474. ) in
  475. let n = add_local ctx n t in
  476. n, c, t
  477. ) args in
  478. let old_ret = ctx.ret in
  479. let old_static = ctx.in_static in
  480. let old_constr = ctx.in_constructor in
  481. let old_opened = ctx.opened in
  482. ctx.in_static <- static;
  483. ctx.in_constructor <- constr;
  484. ctx.ret <- ret;
  485. ctx.opened <- [];
  486. let e = type_expr ctx f.f_expr false in
  487. let rec loop e =
  488. match e.eexpr with
  489. | TReturn (Some _) -> raise Exit
  490. | TFunction _ -> ()
  491. | _ -> Type.iter loop e
  492. in
  493. let have_ret = (try loop e; false with Exit -> true) in
  494. if have_ret then
  495. (try return_flow ctx e with Exit -> ())
  496. else
  497. unify ctx ret ctx.t.tvoid p;
  498. let rec loop e =
  499. match e.eexpr with
  500. | TCall ({ eexpr = TConst TSuper },_) -> raise Exit
  501. | TFunction _ -> ()
  502. | _ -> Type.iter loop e
  503. in
  504. if constr && (match ctx.curclass.cl_super with None -> false | Some (cl,_) -> cl.cl_constructor <> None) then
  505. (try
  506. loop e;
  507. error "Missing super constructor call" p
  508. with
  509. Exit -> ());
  510. locals();
  511. List.iter (fun r -> r := Closed) ctx.opened;
  512. ctx.ret <- old_ret;
  513. ctx.in_static <- old_static;
  514. ctx.in_constructor <- old_constr;
  515. ctx.opened <- old_opened;
  516. e , fargs
  517. let init_core_api ctx c =
  518. let ctx2 = (match ctx.g.core_api with
  519. | None ->
  520. let com2 = Common.clone ctx.com in
  521. com2.class_path <- ctx.com.std_path;
  522. let ctx2 = ctx.g.do_create com2 in
  523. ctx.g.core_api <- Some ctx2;
  524. ctx2
  525. | Some c ->
  526. c
  527. ) in
  528. let t = load_instance ctx2 { tpackage = fst c.cl_path; tname = snd c.cl_path; tparams = []; tsub = None; } c.cl_pos true in
  529. match t with
  530. | TInst (ccore,_) ->
  531. (match c.cl_doc with
  532. | None -> c.cl_doc <- ccore.cl_doc
  533. | Some _ -> ());
  534. let check_fields fcore fl =
  535. PMap.iter (fun i f ->
  536. if not f.cf_public then () else
  537. let f2 = try PMap.find f.cf_name fl with Not_found -> error ("Missing field " ^ i ^ " required by core type") c.cl_pos in
  538. let p = (match f2.cf_expr with None -> c.cl_pos | Some e -> e.epos) in
  539. (try
  540. type_eq EqCoreType (apply_params ccore.cl_types (List.map snd c.cl_types) f.cf_type) f2.cf_type
  541. with Unify_error l ->
  542. display_error ctx ("Field " ^ i ^ " has different type than in core type") p;
  543. display_error ctx (error_msg (Unify l)) p);
  544. if f2.cf_public <> f.cf_public then error ("Field " ^ i ^ " has different visibility than core type") p;
  545. (match f2.cf_doc with
  546. | None -> f2.cf_doc <- f.cf_doc
  547. | Some _ -> ());
  548. if f2.cf_kind <> f.cf_kind then begin
  549. match f2.cf_kind, f.cf_kind with
  550. | Method MethInline, Method MethNormal -> () (* allow to add 'inline' *)
  551. | _ ->
  552. error ("Field " ^ i ^ " has different property access than core type") p;
  553. end;
  554. (match follow f.cf_type, follow f2.cf_type with
  555. | TFun (pl1,_), TFun (pl2,_) ->
  556. if List.length pl1 != List.length pl2 then assert false;
  557. List.iter2 (fun (n1,_,_) (n2,_,_) ->
  558. if n1 <> n2 then error ("Method parameter name '" ^ n2 ^ "' should be '" ^ n1 ^ "'") p;
  559. ) pl1 pl2;
  560. | _ -> ());
  561. ) fcore;
  562. PMap.iter (fun i f ->
  563. let p = (match f.cf_expr with None -> c.cl_pos | Some e -> e.epos) in
  564. if f.cf_public && not (PMap.mem f.cf_name fcore) then error ("Public field " ^ i ^ " is not part of core type") p;
  565. ) fl;
  566. in
  567. check_fields ccore.cl_fields c.cl_fields;
  568. check_fields ccore.cl_statics c.cl_statics;
  569. | _ -> assert false
  570. let patch_class ctx c fields =
  571. let h = (try Some (Hashtbl.find ctx.g.type_patches c.cl_path) with Not_found -> None) in
  572. match h with
  573. | None -> fields
  574. | Some (h,hcl) ->
  575. c.cl_meta <- c.cl_meta @ hcl.tp_meta;
  576. let rec loop acc = function
  577. | [] -> List.rev acc
  578. | f :: l ->
  579. (* patch arguments types *)
  580. (match f.cff_kind with
  581. | FFun (pl,ff) ->
  582. let param ((n,opt,t,e) as p) =
  583. try n, opt, (Hashtbl.find h (("$" ^ n),false)).tp_type, e with Not_found -> p
  584. in
  585. f.cff_kind <- FFun (pl,{ ff with f_args = List.map param ff.f_args })
  586. | _ -> ());
  587. (* other patches *)
  588. match (try Some (Hashtbl.find h (f.cff_name,List.mem AStatic f.cff_access)) with Not_found -> None) with
  589. | None -> loop (f :: acc) l
  590. | Some { tp_remove = true } -> loop acc l
  591. | Some p ->
  592. f.cff_meta <- f.cff_meta @ p.tp_meta;
  593. (match p.tp_type with
  594. | None -> ()
  595. | Some t ->
  596. f.cff_kind <- match f.cff_kind with
  597. | FVar (_,e) -> FVar (Some t,e)
  598. | FProp (get,set,_) -> FProp (get,set,t)
  599. | FFun (pl,f) -> FFun (pl,{ f with f_type = Some t }));
  600. loop (f :: acc) l
  601. in
  602. List.rev (loop [] fields)
  603. let init_class ctx c p herits fields =
  604. let fields = patch_class ctx c fields in
  605. ctx.type_params <- c.cl_types;
  606. c.cl_extern <- List.mem HExtern herits;
  607. c.cl_interface <- List.mem HInterface herits;
  608. set_heritance ctx c herits p;
  609. let core_api = has_meta ":core_api" c.cl_meta in
  610. let is_macro = has_meta ":macro" c.cl_meta in
  611. let fields, herits = if is_macro && not ctx.in_macro then begin
  612. c.cl_extern <- true;
  613. List.filter (fun f -> List.mem AStatic f.cff_access) fields, []
  614. end else fields, herits in
  615. if core_api then delay ctx ((fun() -> init_core_api ctx c));
  616. let tthis = TInst (c,List.map snd c.cl_types) in
  617. let rec extends_public c =
  618. List.exists (fun (c,_) -> c.cl_path = (["haxe"],"Public") || extends_public c) c.cl_implements ||
  619. match c.cl_super with
  620. | None -> false
  621. | Some (c,_) -> extends_public c
  622. in
  623. let extends_public = extends_public c in
  624. let is_public access parent =
  625. if List.mem APrivate access then
  626. false
  627. else if List.mem APublic access then
  628. true
  629. else match parent with
  630. | Some { cf_public = p } -> p
  631. | _ -> c.cl_extern || c.cl_interface || extends_public
  632. in
  633. let rec get_parent c name =
  634. match c.cl_super with
  635. | None -> None
  636. | Some (csup,_) ->
  637. try
  638. Some (PMap.find name csup.cl_fields)
  639. with
  640. Not_found -> get_parent csup name
  641. in
  642. let type_opt ctx p t =
  643. match t with
  644. | None when c.cl_extern || c.cl_interface ->
  645. display_error ctx "Type required for extern classes and interfaces" p;
  646. t_dynamic
  647. | None when core_api ->
  648. display_error ctx "Type required for core api classes" p;
  649. t_dynamic
  650. | _ ->
  651. load_type_opt ctx p t
  652. in
  653. let rec has_field f = function
  654. | None -> false
  655. | Some (c,_) ->
  656. PMap.exists f c.cl_fields || has_field f c.cl_super || List.exists (fun i -> has_field f (Some i)) c.cl_implements
  657. in
  658. let loop_cf f =
  659. let name = f.cff_name in
  660. let p = f.cff_pos in
  661. let stat = List.mem AStatic f.cff_access in
  662. let inline = List.mem AInline f.cff_access in
  663. match f.cff_kind with
  664. | FVar (t,e) ->
  665. if not stat && has_field name c.cl_super then error ("Redefinition of variable " ^ name ^ " in subclass is not allowed") p;
  666. if inline && not stat then error "Inline variable must be static" p;
  667. if inline && e = None then error "Inline variable must be initialized" p;
  668. let t = (match t with
  669. | None ->
  670. if not stat then display_error ctx ("Type required for member variable " ^ name) p;
  671. mk_mono()
  672. | Some t ->
  673. let old = ctx.type_params in
  674. if stat then ctx.type_params <- [];
  675. let t = load_complex_type ctx p t in
  676. if stat then ctx.type_params <- old;
  677. t
  678. ) in
  679. let cf = {
  680. cf_name = name;
  681. cf_doc = f.cff_doc;
  682. cf_meta = f.cff_meta;
  683. cf_type = t;
  684. cf_kind = Var (if inline then { v_read = AccInline ; v_write = AccNever } else { v_read = AccNormal; v_write = AccNormal });
  685. cf_expr = None;
  686. cf_public = is_public f.cff_access None;
  687. cf_params = [];
  688. } in
  689. let delay = (match e with
  690. | None -> (fun() -> ())
  691. | Some e ->
  692. let ctx = { ctx with curclass = c; tthis = tthis } in
  693. let r = exc_protect (fun r ->
  694. r := (fun() -> t);
  695. if ctx.com.verbose then print_endline ("Typing " ^ s_type_path c.cl_path ^ "." ^ name);
  696. cf.cf_expr <- Some (type_static_var ctx t e p);
  697. t
  698. ) in
  699. cf.cf_type <- TLazy r;
  700. (fun () -> ignore(!r()))
  701. ) in
  702. f, false, cf, delay
  703. | FFun (params,fd) ->
  704. let params = List.map (fun (n,flags) ->
  705. match flags with
  706. | [] ->
  707. type_type_params ctx ([],name) p (n,[])
  708. | _ -> error "This notation is not allowed because it can't be checked" p
  709. ) params in
  710. if inline && c.cl_interface then error "You can't declare inline methods in interfaces" p;
  711. let is_macro = (is_macro && stat) || has_meta ":macro" f.cff_meta in
  712. if is_macro && not stat then error "Only static methods can be macros" p;
  713. let fd = if not is_macro then
  714. fd
  715. else if ctx.in_macro then
  716. let texpr = CTPath { tpackage = ["haxe";"macro"]; tname = "Expr"; tparams = []; tsub = None } in
  717. {
  718. f_type = (match fd.f_type with None -> Some texpr | t -> t);
  719. f_args = List.map (fun (a,o,t,e) -> a,o,(match t with None -> Some texpr | _ -> t),e) fd.f_args;
  720. f_expr = fd.f_expr;
  721. }
  722. else
  723. let tdyn = Some (CTPath { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None }) in
  724. {
  725. f_type = tdyn;
  726. f_args = List.map (fun (a,o,_,_) -> a,o,tdyn,None) fd.f_args;
  727. f_expr = (EBlock [],p)
  728. }
  729. in
  730. let parent = (if not stat then get_parent c name else None) in
  731. let dynamic = List.mem ADynamic f.cff_access || (match parent with Some { cf_kind = Method MethDynamic } -> true | _ -> false) in
  732. if inline && dynamic then error "You can't have both 'inline' and 'dynamic'" p;
  733. let ctx = { ctx with
  734. curclass = c;
  735. curmethod = name;
  736. tthis = tthis;
  737. type_params = if stat then params else params @ ctx.type_params;
  738. } in
  739. let ret = type_opt ctx p fd.f_type in
  740. let args = List.map (fun (name,opt,t,c) ->
  741. let t, c = type_function_param ctx (type_opt ctx p t) c opt p in
  742. name, c, t
  743. ) fd.f_args in
  744. let t = TFun (fun_args args,ret) in
  745. let constr = (name = "new") in
  746. if constr && c.cl_interface then error "An interface cannot have a constructor" p;
  747. if c.cl_interface && not stat && (match fd.f_expr with EBlock [] , _ -> false | _ -> true) then error "An interface method cannot have a body" p;
  748. if constr then (match fd.f_type with
  749. | None | Some (CTPath { tpackage = []; tname = "Void" }) -> ()
  750. | _ -> error "A class constructor can't have a return value" p
  751. );
  752. let cf = {
  753. cf_name = name;
  754. cf_doc = f.cff_doc;
  755. cf_meta = f.cff_meta;
  756. cf_type = t;
  757. cf_kind = Method (if is_macro then MethMacro else if inline then MethInline else if dynamic then MethDynamic else MethNormal);
  758. cf_expr = None;
  759. cf_public = is_public f.cff_access parent;
  760. cf_params = params;
  761. } in
  762. let r = exc_protect (fun r ->
  763. r := (fun() -> t);
  764. if ctx.com.verbose then print_endline ("Typing " ^ s_type_path c.cl_path ^ "." ^ name);
  765. let e , fargs = type_function ctx args ret stat constr fd p in
  766. let f = {
  767. tf_args = fargs;
  768. tf_type = ret;
  769. tf_expr = e;
  770. } in
  771. if stat && name = "__init__" then
  772. (match e.eexpr with
  773. | TBlock [] | TBlock [{ eexpr = TConst _ }] | TConst _ | TObjectDecl [] -> ()
  774. | _ -> c.cl_init <- Some e);
  775. cf.cf_expr <- Some (mk (TFunction f) t p);
  776. t
  777. ) in
  778. let delay = if (ctx.com.dead_code_elimination && not !Common.display) then begin
  779. let is_main = (match ctx.com.main_class with | Some cl when c.cl_path = cl -> true | _ -> false) && name = "main" in
  780. let platform_boot pf = match pf with
  781. | Flash -> [["flash"], "Boot"]
  782. | Flash9 -> [["flash"; "_Boot"], "RealBoot"; ["flash"], "Boot"]
  783. | Js -> [["js"], "Boot"]
  784. | Neko -> [["neko"], "Boot"]
  785. | Php -> [["php"], "Boot"]
  786. | Cpp -> [["cpp"], "Boot"]
  787. | _ -> [] in
  788. let must_keep = (List.exists (fun p -> p = c.cl_path) (platform_boot ctx.com.platform)) in
  789. let keep = core_api || is_main || must_keep || has_meta ":keep" c.cl_meta || has_meta ":keep" f.cff_meta || (stat && name = "__init__") in
  790. let remove item lst = List.filter (fun i -> item <> i.cf_name) lst in
  791. if ((c.cl_extern && not inline) || c.cl_interface) && cf.cf_name <> "__init__" then begin
  792. (fun() -> ())
  793. end else begin
  794. cf.cf_type <- TLazy r;
  795. (fun() ->
  796. if not keep then begin
  797. delay ctx (fun () ->
  798. match cf.cf_expr with
  799. | None ->
  800. if ctx.com.verbose then print_endline ("Removed " ^ (s_type_path c.cl_path) ^ "." ^ name);
  801. if stat then begin
  802. c.cl_statics <- PMap.remove name c.cl_statics;
  803. c.cl_ordered_statics <- remove name c.cl_ordered_statics;
  804. end else begin
  805. if name = "new" then c.cl_constructor <- None;
  806. c.cl_fields <- PMap.remove name c.cl_fields;
  807. c.cl_ordered_fields <- remove name c.cl_ordered_fields;
  808. end
  809. | _ -> ())
  810. end else
  811. ignore((!r)())
  812. )
  813. end
  814. end else begin
  815. if ((c.cl_extern && not inline) || c.cl_interface) && cf.cf_name <> "__init__" then begin
  816. (fun() -> ())
  817. end else begin
  818. cf.cf_type <- TLazy r;
  819. (fun() -> ignore((!r)()))
  820. end
  821. end in
  822. f, constr, cf, delay
  823. | FProp (get,set,t) ->
  824. let ret = load_complex_type ctx p t in
  825. let check_get = ref (fun() -> ()) in
  826. let check_set = ref (fun() -> ()) in
  827. let check_method m t () =
  828. try
  829. let t2 = (if stat then (PMap.find m c.cl_statics).cf_type else fst (class_field c m)) in
  830. unify_raise ctx t2 t p;
  831. with
  832. | Error (Unify l,_) -> raise (Error (Stack (Custom ("In method " ^ m ^ " required by property " ^ name),Unify l),p))
  833. | Not_found -> if not c.cl_interface then error ("Method " ^ m ^ " required by property " ^ name ^ " is missing") p
  834. in
  835. let get = (match get with
  836. | "null" -> AccNo
  837. | "dynamic" -> AccCall ("get_" ^ name)
  838. | "never" -> AccNever
  839. | "default" -> AccNormal
  840. | _ ->
  841. check_get := check_method get (TFun ([],ret));
  842. AccCall get
  843. ) in
  844. let set = (match set with
  845. | "null" ->
  846. (* standard flash library read-only variables can't be accessed for writing, even in subclasses *)
  847. if c.cl_extern && (match c.cl_path with "flash" :: _ , _ -> true | _ -> false) && Common.defined ctx.com "flash9" then
  848. AccNever
  849. else
  850. AccNo
  851. | "never" -> AccNever
  852. | "dynamic" -> AccCall ("set_" ^ name)
  853. | "default" -> AccNormal
  854. | _ ->
  855. check_set := check_method set (TFun (["",false,ret],ret));
  856. AccCall set
  857. ) in
  858. if set = AccNormal && (match get with AccCall _ -> true | _ -> false) then error "Unsupported property combination" p;
  859. let cf = {
  860. cf_name = name;
  861. cf_doc = f.cff_doc;
  862. cf_meta = f.cff_meta;
  863. cf_kind = Var { v_read = get; v_write = set };
  864. cf_expr = None;
  865. cf_type = ret;
  866. cf_public = is_public f.cff_access None;
  867. cf_params = [];
  868. } in
  869. f, false, cf, (fun() -> (!check_get)(); (!check_set)())
  870. in
  871. let rec check_require = function
  872. | [] -> None
  873. | (":require",conds,_) :: l ->
  874. let rec loop = function
  875. | [] -> check_require l
  876. | (EConst (Ident i | Type i),_) :: l ->
  877. if not (Common.defined ctx.com i) then
  878. Some i
  879. else
  880. loop l
  881. | _ -> error "Invalid require identifier" p
  882. in
  883. loop conds
  884. | _ :: l ->
  885. check_require l
  886. in
  887. let cl_req = check_require c.cl_meta in
  888. let fl = List.map (fun f ->
  889. let fd , constr, f , delayed = loop_cf f in
  890. let is_static = List.mem AStatic fd.cff_access in
  891. if is_static && f.cf_name = "name" && Common.defined ctx.com "js" then error "This identifier cannot be used in Javascript for statics" p;
  892. if (is_static || constr) && c.cl_interface && f.cf_name <> "__init__" then error "You can't declare static fields in interfaces" p;
  893. let req = check_require fd.cff_meta in
  894. let req = (match req with None -> if is_static || constr then cl_req else None | _ -> req) in
  895. (match req with
  896. | None -> ()
  897. | Some r -> f.cf_kind <- Var { v_read = AccRequire r; v_write = AccRequire r });
  898. if constr then begin
  899. if c.cl_constructor <> None then error "Duplicate constructor" p;
  900. c.cl_constructor <- Some f;
  901. end else if not is_static || f.cf_name <> "__init__" then begin
  902. if PMap.mem f.cf_name (if is_static then c.cl_statics else c.cl_fields) then error ("Duplicate class field declaration : " ^ f.cf_name) p;
  903. if PMap.exists f.cf_name (if is_static then c.cl_fields else c.cl_statics) then error ("Same field name can't be use for both static and instance : " ^ f.cf_name) p;
  904. if is_static then begin
  905. c.cl_statics <- PMap.add f.cf_name f c.cl_statics;
  906. c.cl_ordered_statics <- f :: c.cl_ordered_statics;
  907. end else begin
  908. c.cl_fields <- PMap.add f.cf_name f c.cl_fields;
  909. c.cl_ordered_fields <- f :: c.cl_ordered_fields;
  910. if List.mem AOverride fd.cff_access then c.cl_overrides <- f.cf_name :: c.cl_overrides;
  911. end;
  912. end;
  913. delayed
  914. ) fields in
  915. c.cl_ordered_statics <- List.rev c.cl_ordered_statics;
  916. c.cl_ordered_fields <- List.rev c.cl_ordered_fields;
  917. (*
  918. define a default inherited constructor.
  919. This is actually pretty tricky since we can't assume that the constructor of the
  920. superclass has been defined yet because type structure is not stabilized wrt recursion.
  921. *)
  922. let rec define_constructor ctx c =
  923. try
  924. Some (Hashtbl.find ctx.g.constructs c.cl_path)
  925. with Not_found ->
  926. match c.cl_super with
  927. | None -> None
  928. | Some (csuper,_) ->
  929. match define_constructor ctx csuper with
  930. | None -> None
  931. | Some (acc,pl,f) as infos ->
  932. let p = c.cl_pos in
  933. let esuper = (ECall ((EConst (Ident "super"),p),List.map (fun (n,_,_,_) -> (EConst (Ident n),p)) f.f_args),p) in
  934. let acc = (if csuper.cl_extern && acc = [] then [APublic] else acc) in
  935. let fnew = { f with f_expr = esuper; f_args = List.map (fun (a,opt,t,def) ->
  936. (*
  937. we are removing the type and letting the type inference
  938. work because the current package is not the same as the superclass one
  939. or there might be private and/or imported types
  940. if we are an extern class then we need a type
  941. if the type is Dynamic also because it would not propagate
  942. if we have a package declaration, we are sure it's fully qualified
  943. *)
  944. let rec is_qualified = function
  945. | CTPath t -> is_qual_name t
  946. | CTParent t -> is_qualified t
  947. | CTFunction (tl,t) -> List.for_all is_qualified tl && is_qualified t
  948. | CTAnonymous fl -> List.for_all (fun (_,_,f,_) -> is_qual_field f) fl
  949. | CTExtend (t,fl) -> is_qual_name t && List.for_all (fun (_,_,f,_) -> is_qual_field f) fl
  950. and is_qual_field = function
  951. | AFVar t -> is_qualified t
  952. | AFProp (t,_,_) -> is_qualified t
  953. | AFFun (pl,t) -> List.for_all (fun (_,_,t) -> is_qualified t) pl && is_qualified t
  954. and is_qual_name t =
  955. match t.tpackage with
  956. | [] -> t.tname = "Dynamic" && List.for_all is_qual_param t.tparams
  957. | _ :: _ -> true
  958. and is_qual_param = function
  959. | TPType t -> is_qualified t
  960. | TPConst _ -> false (* prevent multiple incompatible types *)
  961. in
  962. let t = (match t with
  963. | Some t when is_qualified t -> Some t
  964. | _ -> None
  965. ) in
  966. a,opt,t,def
  967. ) f.f_args } in
  968. let _, _, cf, delayed = loop_cf { cff_name = "new"; cff_pos = p; cff_doc = None; cff_meta = []; cff_access = acc; cff_kind = FFun (pl,fnew) } in
  969. c.cl_constructor <- Some cf;
  970. Hashtbl.add ctx.g.constructs c.cl_path (acc,pl,f);
  971. delay ctx delayed;
  972. infos
  973. in
  974. (*
  975. extern classes will browse superclass to find a constructor
  976. *)
  977. if not c.cl_extern then ignore(define_constructor ctx c);
  978. fl
  979. let resolve_typedef ctx t =
  980. match t with
  981. | TClassDecl _ | TEnumDecl _ -> t
  982. | TTypeDecl td ->
  983. match follow td.t_type with
  984. | TEnum (e,_) -> TEnumDecl e
  985. | TInst (c,_) -> TClassDecl c
  986. | _ -> t
  987. let type_module ctx m tdecls loadp =
  988. (* PASS 1 : build module structure - does not load any module or type - should be atomic ! *)
  989. let decls = ref [] in
  990. let decl_with_name name p priv =
  991. let tpath = if priv then (fst m @ ["_" ^ snd m], name) else (fst m, name) in
  992. if priv && List.exists (fun t -> tpath = t_path t) (!decls) then error ("Type name " ^ name ^ " is already defined in this module") p;
  993. try
  994. let m2 = Hashtbl.find ctx.g.types_module tpath in
  995. if m <> m2 && String.lowercase (s_type_path m2) = String.lowercase (s_type_path m) then error ("Module " ^ s_type_path m2 ^ " is loaded with a different case than " ^ s_type_path m) loadp;
  996. error ("Type name " ^ s_type_path tpath ^ " is redefined from module " ^ s_type_path m2) p
  997. with
  998. Not_found ->
  999. Hashtbl.add ctx.g.types_module tpath m;
  1000. tpath
  1001. in
  1002. List.iter (fun (d,p) ->
  1003. match d with
  1004. | EImport _ | EUsing _ -> ()
  1005. | EClass d ->
  1006. let priv = List.mem HPrivate d.d_flags in
  1007. let path = decl_with_name d.d_name p priv in
  1008. let c = mk_class path p in
  1009. c.cl_private <- priv;
  1010. c.cl_doc <- d.d_doc;
  1011. c.cl_meta <- d.d_meta;
  1012. (* store the constructor for later usage *)
  1013. List.iter (fun cf ->
  1014. match cf with
  1015. | { cff_name = "new"; cff_kind = FFun (pl,f) } -> Hashtbl.add ctx.g.constructs path (cf.cff_access,pl,f)
  1016. | _ -> ()
  1017. ) d.d_data;
  1018. decls := TClassDecl c :: !decls
  1019. | EEnum d ->
  1020. let priv = List.mem EPrivate d.d_flags in
  1021. let path = decl_with_name d.d_name p priv in
  1022. let e = {
  1023. e_path = path;
  1024. e_pos = p;
  1025. e_doc = d.d_doc;
  1026. e_meta = d.d_meta;
  1027. e_types = [];
  1028. e_private = priv;
  1029. e_extern = List.mem EExtern d.d_flags;
  1030. e_constrs = PMap.empty;
  1031. e_names = [];
  1032. } in
  1033. decls := TEnumDecl e :: !decls
  1034. | ETypedef d ->
  1035. let priv = List.mem EPrivate d.d_flags in
  1036. let path = decl_with_name d.d_name p priv in
  1037. let t = {
  1038. t_path = path;
  1039. t_pos = p;
  1040. t_doc = d.d_doc;
  1041. t_private = priv;
  1042. t_types = [];
  1043. t_type = mk_mono();
  1044. t_meta = d.d_meta;
  1045. } in
  1046. decls := TTypeDecl t :: !decls
  1047. ) tdecls;
  1048. let m = {
  1049. mpath = m;
  1050. mtypes = List.rev !decls;
  1051. } in
  1052. Hashtbl.add ctx.g.modules m.mpath m;
  1053. (* PASS 2 : build types structure - does not type any expression ! *)
  1054. let ctx = {
  1055. com = ctx.com;
  1056. g = ctx.g;
  1057. t = ctx.t;
  1058. curclass = ctx.curclass;
  1059. tthis = ctx.tthis;
  1060. ret = ctx.ret;
  1061. current = m;
  1062. locals = PMap.empty;
  1063. locals_map = PMap.empty;
  1064. locals_map_inv = PMap.empty;
  1065. local_types = ctx.g.std.mtypes @ m.mtypes;
  1066. local_using = [];
  1067. type_params = [];
  1068. curmethod = "";
  1069. untyped = false;
  1070. in_super_call = false;
  1071. in_constructor = false;
  1072. in_static = false;
  1073. in_macro = ctx.in_macro;
  1074. in_display = false;
  1075. in_loop = false;
  1076. opened = [];
  1077. param_type = None;
  1078. } in
  1079. let delays = ref [] in
  1080. let get_class name =
  1081. let c = List.find (fun d -> match d with TClassDecl { cl_path = _ , n } -> n = name | _ -> false) m.mtypes in
  1082. match c with TClassDecl c -> c | _ -> assert false
  1083. in
  1084. let get_enum name =
  1085. let e = List.find (fun d -> match d with TEnumDecl { e_path = _ , n } -> n = name | _ -> false) m.mtypes in
  1086. match e with TEnumDecl e -> e | _ -> assert false
  1087. in
  1088. let get_tdef name =
  1089. let s = List.find (fun d -> match d with TTypeDecl { t_path = _ , n } -> n = name | _ -> false) m.mtypes in
  1090. match s with TTypeDecl s -> s | _ -> assert false
  1091. in
  1092. (* here is an additional PASS 1 phase, which handle the type parameters declaration, with lazy contraints *)
  1093. List.iter (fun (d,p) ->
  1094. match d with
  1095. | EImport _ | EUsing _ -> ()
  1096. | EClass d ->
  1097. let c = get_class d.d_name in
  1098. c.cl_types <- List.map (type_type_params ctx c.cl_path p) d.d_params;
  1099. | EEnum d ->
  1100. let e = get_enum d.d_name in
  1101. e.e_types <- List.map (type_type_params ctx e.e_path p) d.d_params;
  1102. | ETypedef d ->
  1103. let t = get_tdef d.d_name in
  1104. t.t_types <- List.map (type_type_params ctx t.t_path p) d.d_params;
  1105. ) tdecls;
  1106. (* back to PASS2 *)
  1107. List.iter (fun (d,p) ->
  1108. match d with
  1109. | EImport t ->
  1110. (match t.tsub with
  1111. | None ->
  1112. let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
  1113. let types = List.filter (fun t -> not (t_private t)) md.mtypes in
  1114. ctx.local_types <- ctx.local_types @ types
  1115. | Some _ ->
  1116. let t = load_type_def ctx p t in
  1117. ctx.local_types <- ctx.local_types @ [t]
  1118. )
  1119. | EUsing t ->
  1120. (match t.tsub with
  1121. | None ->
  1122. let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
  1123. let types = List.filter (fun t -> not (t_private t)) md.mtypes in
  1124. ctx.local_using <- ctx.local_using @ (List.map (resolve_typedef ctx) types);
  1125. | Some _ ->
  1126. let t = load_type_def ctx p t in
  1127. ctx.local_using<- ctx.local_using @ [resolve_typedef ctx t])
  1128. | EClass d ->
  1129. let c = get_class d.d_name in
  1130. delays := !delays @ check_overriding ctx c p :: check_interfaces ctx c p :: init_class ctx c p d.d_flags d.d_data
  1131. | EEnum d ->
  1132. let e = get_enum d.d_name in
  1133. ctx.type_params <- e.e_types;
  1134. let et = TEnum (e,List.map snd e.e_types) in
  1135. let names = ref [] in
  1136. let index = ref 0 in
  1137. let rec loop = function
  1138. | (":build",[ECall (epath,el),p],_) :: _ ->
  1139. let rec loop (e,p) =
  1140. match e with
  1141. | EConst (Ident i) | EConst (Type i) -> i
  1142. | EField (e,f) | EType (e,f) -> loop e ^ "." ^ f
  1143. | _ -> error "Build call parameter must be a class path" p
  1144. in
  1145. let s = loop epath in
  1146. if ctx.in_macro then error "You cannot used :build inside a macro : make sure that your enum is not used in macro" p;
  1147. (match apply_macro ctx s el p with
  1148. | None -> error "Enum build failure" p
  1149. | Some (EArrayDecl el,_) | Some (EBlock el,_) ->
  1150. List.map (fun (e,p) ->
  1151. match e with
  1152. | EConst (Ident i) | EConst (Type i) | EConst (String i) -> i, None, [], [], p
  1153. | _ -> error "Invalid enum constructor" p
  1154. ) el
  1155. | _ -> error "Build macro must return an block" p
  1156. )
  1157. | _ :: l -> loop l
  1158. | [] -> []
  1159. in
  1160. let extra = loop d.d_meta in
  1161. List.iter (fun (c,doc,meta,t,p) ->
  1162. if c = "name" && Common.defined ctx.com "js" then error "This identifier cannot be used in Javascript" p;
  1163. let t = (match t with
  1164. | [] -> et
  1165. | l ->
  1166. let pnames = ref PMap.empty in
  1167. TFun (List.map (fun (s,opt,t) ->
  1168. if PMap.mem s (!pnames) then error ("Duplicate parameter '" ^ s ^ "' in enum constructor " ^ c) p;
  1169. pnames := PMap.add s () (!pnames);
  1170. s, opt, load_type_opt ~opt ctx p (Some t)
  1171. ) l, et)
  1172. ) in
  1173. if PMap.mem c e.e_constrs then error ("Duplicate constructor " ^ c) p;
  1174. e.e_constrs <- PMap.add c {
  1175. ef_name = c;
  1176. ef_type = t;
  1177. ef_pos = p;
  1178. ef_doc = doc;
  1179. ef_index = !index;
  1180. ef_meta = meta;
  1181. } e.e_constrs;
  1182. incr index;
  1183. names := c :: !names;
  1184. ) (d.d_data @ extra);
  1185. e.e_names <- List.rev !names;
  1186. e.e_extern <- e.e_extern || e.e_names = [];
  1187. | ETypedef d ->
  1188. let t = get_tdef d.d_name in
  1189. ctx.type_params <- t.t_types;
  1190. let tt = load_complex_type ctx p d.d_data in
  1191. if t.t_type == follow tt then error "Recursive typedef is not allowed" p;
  1192. (match t.t_type with
  1193. | TMono r ->
  1194. (match !r with
  1195. | None -> r := Some tt;
  1196. | Some _ -> assert false);
  1197. | _ -> assert false);
  1198. ) tdecls;
  1199. (* PASS 3 : type checking, delayed until all modules and types are built *)
  1200. List.iter (delay ctx) (List.rev (!delays));
  1201. m
  1202. let parse_module ctx m p =
  1203. let remap = ref (fst m) in
  1204. let file = (match m with
  1205. | [] , name -> name
  1206. | x :: l , name ->
  1207. let x = (try
  1208. match PMap.find x ctx.com.package_rules with
  1209. | Forbidden -> error ("You can't access the " ^ x ^ " package with current compilation flags (for " ^ s_type_path m ^ ")") p;
  1210. | Directory d -> d
  1211. | Remap d -> remap := d :: l; d
  1212. with Not_found -> x
  1213. ) in
  1214. String.concat "/" (x :: l) ^ "/" ^ name
  1215. ) ^ ".hx" in
  1216. let file = Common.find_file ctx.com file in
  1217. let ch = (try open_in_bin file with _ -> error ("Could not open " ^ file) p) in
  1218. let t = Common.timer "parsing" in
  1219. Lexer.init file;
  1220. let pack , decls = (try Parser.parse ctx.com (Lexing.from_channel ch) with e -> close_in ch; t(); raise e) in
  1221. t();
  1222. close_in ch;
  1223. if ctx.com.verbose then print_endline ("Parsed " ^ file);
  1224. if pack <> !remap then begin
  1225. let spack m = if m = [] then "<empty>" else String.concat "." m in
  1226. if p == Ast.null_pos then
  1227. error ("Invalid commandline class : " ^ s_type_path m ^ " should be " ^ s_type_path (pack,snd m)) p
  1228. else
  1229. error ("Invalid package : " ^ spack (fst m) ^ " should be " ^ spack pack) p
  1230. end;
  1231. if !remap <> fst m then
  1232. (* build typedefs to redirect to real package *)
  1233. List.rev (List.fold_left (fun acc (t,p) ->
  1234. let build f d =
  1235. let priv = List.mem f d.d_flags in
  1236. (ETypedef {
  1237. d_name = d.d_name;
  1238. d_doc = None;
  1239. d_meta = [];
  1240. d_params = d.d_params;
  1241. d_flags = if priv then [EPrivate] else [];
  1242. d_data = CTPath (if priv then { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None; } else
  1243. {
  1244. tpackage = !remap;
  1245. tname = d.d_name;
  1246. tparams = List.map (fun (s,_) ->
  1247. TPType (CTPath { tpackage = []; tname = s; tparams = []; tsub = None; })
  1248. ) d.d_params;
  1249. tsub = None;
  1250. });
  1251. },p) :: acc
  1252. in
  1253. match t with
  1254. | EClass d -> build HPrivate d
  1255. | EEnum d -> build EPrivate d
  1256. | ETypedef d -> build EPrivate d
  1257. | EImport _ | EUsing _ -> acc
  1258. ) [(EImport { tpackage = !remap; tname = snd m; tparams = []; tsub = None; },null_pos)] decls)
  1259. else
  1260. decls
  1261. let load_module ctx m p =
  1262. try
  1263. Hashtbl.find ctx.g.modules m
  1264. with
  1265. Not_found ->
  1266. let decls = (try
  1267. parse_module ctx m p
  1268. with Not_found ->
  1269. let rec loop = function
  1270. | [] -> raise (Error (Module_not_found m,p))
  1271. | load :: l ->
  1272. match load m p with
  1273. | None -> loop l
  1274. | Some (_,a) -> a
  1275. in
  1276. loop ctx.com.load_extern_type
  1277. ) in
  1278. type_module ctx m decls p