filters.ml 42 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376
  1. (*
  2. The Haxe Compiler
  3. Copyright (C) 2005-2015 Haxe Foundation
  4. This program is free software; you can redistribute it and/or
  5. modify it under the terms of the GNU General Public License
  6. as published by the Free Software Foundation; either version 2
  7. of the License, or (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  15. *)
  16. open Ast
  17. open Common
  18. open Type
  19. open Typecore
  20. (* PASS 1 begin *)
  21. let rec verify_ast ctx e =
  22. let not_null e e1 = match e1.eexpr with
  23. | TConst TNull ->
  24. (* TODO: https://github.com/HaxeFoundation/haxe/issues/4072 *)
  25. (* display_error ctx ("Invalid null expression: " ^ (s_expr_pretty "" (s_type (print_context())) e)) e.epos *)
  26. ()
  27. | _ -> ()
  28. in
  29. let rec loop e = match e.eexpr with
  30. | TField(e1,_) ->
  31. not_null e e1;
  32. ()
  33. | TArray(e1,e2) ->
  34. not_null e e1;
  35. loop e1;
  36. loop e2
  37. | TCall(e1,el) ->
  38. not_null e e1;
  39. loop e1;
  40. List.iter loop el
  41. | TUnop(_,_,e1) ->
  42. not_null e e1;
  43. loop e1
  44. (* probably too messy *)
  45. (* | TBinop((OpEq | OpNotEq),e1,e2) ->
  46. loop e1;
  47. loop e2
  48. | TBinop((OpAssign | OpAssignOp _),e1,e2) ->
  49. not_null e e1;
  50. loop e1;
  51. loop e2
  52. | TBinop(op,e1,e2) ->
  53. not_null e e1;
  54. not_null e e2;
  55. loop e1;
  56. loop e2 *)
  57. | TTypeExpr(TClassDecl {cl_kind = KAbstractImpl a}) when not (Meta.has Meta.RuntimeValue a.a_meta) ->
  58. error "Cannot use abstract as value" e.epos
  59. | _ ->
  60. Type.iter loop e
  61. in
  62. loop e
  63. (*
  64. Wraps implicit blocks in TIf, TFor, TWhile, TFunction and TTry with real ones
  65. *)
  66. let rec blockify_ast e =
  67. match e.eexpr with
  68. | TIf(e1,e2,eo) ->
  69. {e with eexpr = TIf(blockify_ast e1,mk_block (blockify_ast e2),match eo with None -> None | Some e -> Some (mk_block (blockify_ast e)))}
  70. | TFor(v,e1,e2) ->
  71. {e with eexpr = TFor(v,blockify_ast e1,mk_block (blockify_ast e2))}
  72. | TWhile(e1,e2,flag) ->
  73. {e with eexpr = TWhile(blockify_ast e1,mk_block (blockify_ast e2),flag)}
  74. | TFunction tf ->
  75. {e with eexpr = TFunction {tf with tf_expr = mk_block (blockify_ast tf.tf_expr)}}
  76. | TTry(e1,cl) ->
  77. {e with eexpr = TTry(mk_block (blockify_ast e1),List.map (fun (v,e) -> v,mk_block (blockify_ast e)) cl)}
  78. | TSwitch(e1,cases,def) ->
  79. let e1 = blockify_ast e1 in
  80. let cases = List.map (fun (el,e) ->
  81. el,mk_block (blockify_ast e)
  82. ) cases in
  83. let def = match def with None -> None | Some e -> Some (mk_block (blockify_ast e)) in
  84. {e with eexpr = TSwitch(e1,cases,def)}
  85. | _ ->
  86. Type.map_expr blockify_ast e
  87. (*
  88. Pushes complex right-hand side expression inwards.
  89. return { exprs; value; } -> { exprs; return value; }
  90. x = { exprs; value; } -> { exprs; x = value; }
  91. var x = { exprs; value; } -> { var x; exprs; x = value; }
  92. *)
  93. let promote_complex_rhs com e =
  94. let rec is_complex e = match e.eexpr with
  95. | TBlock _ | TSwitch _ | TIf _ | TTry _ | TCast(_,Some _) -> true
  96. | TBinop(_,e1,e2) -> is_complex e1 || is_complex e2
  97. | TParenthesis e | TMeta(_,e) | TCast(e, None) | TField(e,_) -> is_complex e
  98. | _ -> false
  99. in
  100. let rec loop f e = match e.eexpr with
  101. | TBlock(el) ->
  102. begin match List.rev el with
  103. | elast :: el -> {e with eexpr = TBlock(block (List.rev ((loop f elast) :: el)))}
  104. | [] -> e
  105. end
  106. | TSwitch(es,cases,edef) ->
  107. {e with eexpr = TSwitch(es,List.map (fun (el,e) -> List.map find el,loop f e) cases,match edef with None -> None | Some e -> Some (loop f e)); }
  108. | TIf(eif,ethen,eelse) ->
  109. {e with eexpr = TIf(find eif, loop f ethen, match eelse with None -> None | Some e -> Some (loop f e)); }
  110. | TTry(e1,el) ->
  111. {e with eexpr = TTry(loop f e1, List.map (fun (el,e) -> el,loop f e) el); }
  112. | TParenthesis e1 when not (Common.defined com Define.As3) ->
  113. {e with eexpr = TParenthesis(loop f e1)}
  114. | TMeta(m,e1) ->
  115. { e with eexpr = TMeta(m,loop f e1)}
  116. | TReturn _ | TThrow _ ->
  117. find e
  118. | TContinue | TBreak ->
  119. e
  120. | _ ->
  121. f (find e)
  122. and block el =
  123. let r = ref [] in
  124. List.iter (fun e ->
  125. match e.eexpr with
  126. | TVar(v,eo) ->
  127. begin match eo with
  128. | Some e when is_complex e ->
  129. let e = find e in
  130. r := (loop (fun e -> mk (TBinop(OpAssign,mk (TLocal v) v.v_type e.epos,e)) v.v_type e.epos) e)
  131. :: ((mk (TVar (v,None)) com.basic.tvoid e.epos))
  132. :: !r
  133. | Some e ->
  134. r := (mk (TVar (v,Some (find e))) com.basic.tvoid e.epos) :: !r
  135. | None -> r := (mk (TVar (v,None)) com.basic.tvoid e.epos) :: !r
  136. end
  137. | TReturn (Some e1) when (match follow e1.etype with TAbstract({a_path=[],"Void"},_) -> true | _ -> false) ->
  138. r := ({e with eexpr = TReturn None}) :: e1 :: !r
  139. | _ -> r := (find e) :: !r
  140. ) el;
  141. List.rev !r
  142. and find e = match e.eexpr with
  143. | TReturn (Some e1) -> loop (fun er -> {e with eexpr = TReturn (Some er)}) e1
  144. | TBinop(OpAssign | OpAssignOp _ as op, ({eexpr = TLocal _ | TField _ | TArray _} as e1), e2) -> loop (fun er -> {e with eexpr = TBinop(op, e1, er)}) e2
  145. | TBlock(el) -> {e with eexpr = TBlock (block el)}
  146. | _ -> Type.map_expr find e
  147. in
  148. find e
  149. (* Adds final returns to functions as required by some platforms *)
  150. let rec add_final_return e =
  151. let rec loop e t =
  152. let def_return p =
  153. let c = (match follow t with
  154. | TAbstract ({ a_path = [],"Int" },_) -> TInt 0l
  155. | TAbstract ({ a_path = [],"Float" },_) -> TFloat "0."
  156. | TAbstract ({ a_path = [],"Bool" },_) -> TBool false
  157. | _ -> TNull
  158. ) in
  159. { eexpr = TReturn (Some { eexpr = TConst c; epos = p; etype = t }); etype = t_dynamic; epos = p }
  160. in
  161. match e.eexpr with
  162. | TBlock el ->
  163. (match List.rev el with
  164. | [] -> e
  165. | elast :: el ->
  166. match loop elast t with
  167. | { eexpr = TBlock el2 } -> { e with eexpr = TBlock ((List.rev el) @ el2) }
  168. | elast -> { e with eexpr = TBlock (List.rev (elast :: el)) })
  169. | TReturn _ ->
  170. e
  171. | _ ->
  172. { e with eexpr = TBlock [e;def_return e.epos] }
  173. in
  174. let e = Type.map_expr add_final_return e in
  175. match e.eexpr with
  176. | TFunction f ->
  177. let f = (match follow f.tf_type with
  178. | TAbstract ({ a_path = [],"Void" },[]) -> f
  179. | _ -> { f with tf_expr = loop f.tf_expr f.tf_type }
  180. ) in
  181. { e with eexpr = TFunction f }
  182. | _ -> e
  183. let rec wrap_js_exceptions com e =
  184. let rec is_error t =
  185. match follow t with
  186. | TInst ({cl_path = (["js"],"Error")},_) -> true
  187. | TInst ({cl_super = Some (csup,tl)}, _) -> is_error (TInst (csup,tl))
  188. | _ -> false
  189. in
  190. let rec loop e =
  191. match e.eexpr with
  192. | TThrow eerr when not (is_error eerr.etype) ->
  193. let terr = List.find (fun mt -> match mt with TClassDecl {cl_path = ["js";"_Boot"],"HaxeError"} -> true | _ -> false) com.types in
  194. let cerr = match terr with TClassDecl c -> c | _ -> assert false in
  195. (match eerr.etype with
  196. | TDynamic _ ->
  197. let eterr = Codegen.ExprBuilder.make_static_this cerr e.epos in
  198. let ewrap = Codegen.fcall eterr "wrap" [eerr] t_dynamic e.epos in
  199. { e with eexpr = TThrow ewrap }
  200. | _ ->
  201. let ewrap = { eerr with eexpr = TNew (cerr,[],[eerr]) } in
  202. { e with eexpr = TThrow ewrap }
  203. )
  204. | _ ->
  205. Type.map_expr loop e
  206. in
  207. loop e
  208. (* -------------------------------------------------------------------------- *)
  209. (* CHECK LOCAL VARS INIT *)
  210. let check_local_vars_init e =
  211. let intersect vl1 vl2 =
  212. PMap.mapi (fun v t -> t && PMap.find v vl2) vl1
  213. in
  214. let join vars cvars =
  215. List.iter (fun v -> vars := intersect !vars v) cvars
  216. in
  217. let restore vars old_vars declared =
  218. (* restore variables declared in this block to their previous state *)
  219. vars := List.fold_left (fun acc v ->
  220. try PMap.add v (PMap.find v old_vars) acc with Not_found -> PMap.remove v acc
  221. ) !vars declared;
  222. in
  223. let declared = ref [] in
  224. let outside_vars = ref IntMap.empty in
  225. let rec loop vars e =
  226. match e.eexpr with
  227. | TLocal v ->
  228. let init = (try PMap.find v.v_id !vars with Not_found -> true) in
  229. if not init && not (IntMap.mem v.v_id !outside_vars) then begin
  230. if v.v_name = "this" then error "Missing this = value" e.epos
  231. else error ("Local variable " ^ v.v_name ^ " used without being initialized") e.epos
  232. end
  233. | TVar (v,eo) ->
  234. begin
  235. match eo with
  236. | None ->
  237. declared := v.v_id :: !declared;
  238. vars := PMap.add v.v_id false !vars
  239. | Some e ->
  240. loop vars e
  241. end
  242. | TBlock el ->
  243. let old = !declared in
  244. let old_vars = !vars in
  245. declared := [];
  246. List.iter (loop vars) el;
  247. restore vars old_vars (List.rev !declared);
  248. declared := old;
  249. | TBinop (OpAssign,{ eexpr = TLocal v },e) when PMap.mem v.v_id !vars ->
  250. loop vars e;
  251. vars := PMap.add v.v_id true !vars
  252. | TIf (e1,e2,eo) ->
  253. loop vars e1;
  254. let vbase = !vars in
  255. loop vars e2;
  256. (match eo with
  257. | None -> vars := vbase
  258. (* ignore else false cases (they are added by the side-effect handler) *)
  259. | Some {eexpr = TConst (TBool(false))} -> ()
  260. | Some e ->
  261. let v1 = !vars in
  262. vars := vbase;
  263. loop vars e;
  264. vars := intersect !vars v1)
  265. | TWhile (cond,e,flag) ->
  266. (match flag with
  267. | NormalWhile when (match cond.eexpr with TParenthesis {eexpr = TConst (TBool true)} -> false | _ -> true) ->
  268. loop vars cond;
  269. let old = !vars in
  270. loop vars e;
  271. vars := old;
  272. | _ ->
  273. loop vars e;
  274. loop vars cond)
  275. | TTry (e,catches) ->
  276. let cvars = List.map (fun (v,e) ->
  277. let old = !vars in
  278. loop vars e;
  279. let v = !vars in
  280. vars := old;
  281. v
  282. ) catches in
  283. loop vars e;
  284. join vars cvars;
  285. | TSwitch (e,cases,def) ->
  286. loop vars e;
  287. let cvars = List.map (fun (ec,e) ->
  288. let old = !vars in
  289. List.iter (loop vars) ec;
  290. vars := old;
  291. loop vars e;
  292. let v = !vars in
  293. vars := old;
  294. v
  295. ) cases in
  296. (match def with
  297. | None when (match e.eexpr with TMeta((Meta.Exhaustive,_,_),_) | TParenthesis({eexpr = TMeta((Meta.Exhaustive,_,_),_)}) -> true | _ -> false) ->
  298. (match cvars with
  299. | cv :: cvars ->
  300. PMap.iter (fun i b -> if b then vars := PMap.add i b !vars) cv;
  301. join vars cvars
  302. | [] -> ())
  303. | None -> ()
  304. | Some e ->
  305. loop vars e;
  306. join vars cvars)
  307. (* mark all reachable vars as initialized, since we don't exit the block *)
  308. | TBreak | TContinue | TReturn None ->
  309. vars := PMap.map (fun _ -> true) !vars
  310. | TThrow e | TReturn (Some e) ->
  311. loop vars e;
  312. vars := PMap.map (fun _ -> true) !vars
  313. | TFunction tf ->
  314. let old = !outside_vars in
  315. (* Mark all known variables as "outside" so we can ignore their initialization state within the function.
  316. We cannot use `vars` directly because we still care about initializations the function might make.
  317. *)
  318. PMap.iter (fun i _ -> outside_vars := IntMap.add i true !outside_vars) !vars;
  319. loop vars tf.tf_expr;
  320. outside_vars := old;
  321. | _ ->
  322. Type.iter (loop vars) e
  323. in
  324. loop (ref PMap.empty) e;
  325. e
  326. (* -------------------------------------------------------------------------- *)
  327. (* BLOCK VARIABLES CAPTURE *)
  328. (*
  329. For some platforms, it will simply mark the variables which are used in closures
  330. using the v_capture flag so it can be processed in a more optimized
  331. For Flash/JS platforms, it will ensure that variables used in loop sub-functions
  332. have an unique scope. It transforms the following expression :
  333. for( x in array )
  334. funs.push(function() return x++);
  335. Into the following :
  336. for( _x in array ) {
  337. var x = [_x];
  338. funs.push(function(x) { function() return x[0]++; }(x));
  339. }
  340. *)
  341. type usage =
  342. | Block of ((usage -> unit) -> unit)
  343. | Loop of ((usage -> unit) -> unit)
  344. | Function of ((usage -> unit) -> unit)
  345. | Declare of tvar
  346. | Use of tvar
  347. | Assign of tvar
  348. let rec local_usage f e =
  349. match e.eexpr with
  350. | TBinop ((OpAssign | OpAssignOp _), { eexpr = TLocal v }, e2) ->
  351. local_usage f e2;
  352. f (Assign v)
  353. | TUnop ((Increment | Decrement), _, { eexpr = TLocal v }) ->
  354. f (Assign v)
  355. | TLocal v ->
  356. f (Use v)
  357. | TVar (v,eo) ->
  358. (match eo with None -> () | Some e -> local_usage f e);
  359. f (Declare v);
  360. | TFunction tf ->
  361. let cc f =
  362. List.iter (fun (v,_) -> f (Declare v)) tf.tf_args;
  363. local_usage f tf.tf_expr;
  364. in
  365. f (Function cc)
  366. | TBlock l ->
  367. f (Block (fun f -> List.iter (local_usage f) l))
  368. | TFor (v,it,e) ->
  369. local_usage f it;
  370. f (Loop (fun f ->
  371. f (Declare v);
  372. local_usage f e;
  373. ))
  374. | TWhile _ ->
  375. f (Loop (fun f ->
  376. iter (local_usage f) e
  377. ))
  378. | TTry (e,catchs) ->
  379. local_usage f e;
  380. List.iter (fun (v,e) ->
  381. f (Block (fun f ->
  382. f (Declare v);
  383. local_usage f e;
  384. ))
  385. ) catchs;
  386. | _ ->
  387. iter (local_usage f) e
  388. let captured_vars com e =
  389. let t = com.basic in
  390. let impl = match com.platform with
  391. (* optimized version for C#/Java - use native arrays *)
  392. | Cs | Java ->
  393. let cnativearray =
  394. match (List.find (fun md -> match md with
  395. | TClassDecl ({ cl_path = ["cs"|"java"],"NativeArray" }) -> true
  396. | _ -> false
  397. ) com.types)
  398. with TClassDecl cl -> cl | _ -> assert false
  399. in
  400. object
  401. method captured_type t = TInst (cnativearray,[t])
  402. method mk_ref v ve p =
  403. match ve with
  404. | None ->
  405. let eone = mk (TConst (TInt (Int32.of_int 1))) t.tint p in
  406. let t = match v.v_type with TInst (_, [t]) -> t | _ -> assert false in
  407. mk (TNew (cnativearray,[t],[eone])) v.v_type p
  408. | Some e ->
  409. { (Optimizer.mk_untyped_call "__array__" p [e]) with etype = v.v_type }
  410. method mk_ref_access e v =
  411. mk (TArray ({ e with etype = v.v_type }, mk (TConst (TInt 0l)) t.tint e.epos)) e.etype e.epos
  412. method mk_init av v pos =
  413. let elocal = mk (TLocal v) v.v_type pos in
  414. let earray = { (Optimizer.mk_untyped_call "__array__" pos [elocal]) with etype = av.v_type } in
  415. mk (TVar (av,Some earray)) t.tvoid pos
  416. end
  417. (* default implementation - use haxe array *)
  418. | _ ->
  419. object
  420. method captured_type = t.tarray
  421. method mk_ref v ve p =
  422. mk (TArrayDecl (match ve with None -> [] | Some e -> [e])) v.v_type p
  423. method mk_ref_access e v =
  424. mk (TArray ({ e with etype = v.v_type }, mk (TConst (TInt 0l)) t.tint e.epos)) e.etype e.epos
  425. method mk_init av v pos =
  426. mk (TVar (av,Some (mk (TArrayDecl [mk (TLocal v) v.v_type pos]) av.v_type pos))) t.tvoid pos
  427. end
  428. in
  429. let mk_var v used =
  430. let v2 = alloc_var v.v_name (PMap.find v.v_id used) in
  431. v2.v_meta <- v.v_meta;
  432. v2
  433. in
  434. let rec wrap used e =
  435. match e.eexpr with
  436. | TVar (v,ve) ->
  437. let v,ve =
  438. if PMap.mem v.v_id used then
  439. v, Some (impl#mk_ref v (Option.map (wrap used) ve) e.epos)
  440. else
  441. v, (match ve with None -> None | Some e -> Some (wrap used e))
  442. in
  443. { e with eexpr = TVar (v,ve) }
  444. | TLocal v when PMap.mem v.v_id used ->
  445. impl#mk_ref_access e v
  446. | TFor (v,it,expr) when PMap.mem v.v_id used ->
  447. let vtmp = mk_var v used in
  448. let it = wrap used it in
  449. let expr = wrap used expr in
  450. mk (TFor (vtmp,it,Type.concat (impl#mk_init v vtmp e.epos) expr)) e.etype e.epos
  451. | TTry (expr,catchs) ->
  452. let catchs = List.map (fun (v,e) ->
  453. let e = wrap used e in
  454. try
  455. let vtmp = mk_var v used in
  456. vtmp, Type.concat (impl#mk_init v vtmp e.epos) e
  457. with Not_found ->
  458. v, e
  459. ) catchs in
  460. mk (TTry (wrap used expr,catchs)) e.etype e.epos
  461. | TFunction f ->
  462. (*
  463. list variables that are marked as used, but also used in that
  464. function and which are not declared inside it !
  465. *)
  466. let fused = ref PMap.empty in
  467. let tmp_used = ref used in
  468. let rec browse = function
  469. | Block f | Loop f | Function f -> f browse
  470. | Use v | Assign v ->
  471. if PMap.mem v.v_id !tmp_used then fused := PMap.add v.v_id v !fused;
  472. | Declare v ->
  473. tmp_used := PMap.remove v.v_id !tmp_used
  474. in
  475. local_usage browse e;
  476. let vars = PMap.fold (fun v acc -> v :: acc) !fused [] in
  477. (* in case the variable has been marked as used in a parallel scope... *)
  478. let fexpr = ref (wrap used f.tf_expr) in
  479. let fargs = List.map (fun (v,o) ->
  480. if PMap.mem v.v_id used then
  481. let vtmp = mk_var v used in
  482. fexpr := Type.concat (impl#mk_init v vtmp e.epos) !fexpr;
  483. vtmp, o
  484. else
  485. v, o
  486. ) f.tf_args in
  487. let e = { e with eexpr = TFunction { f with tf_args = fargs; tf_expr = !fexpr } } in
  488. (*
  489. Create a new function scope to make sure that the captured loop variable
  490. will not be overwritten in next loop iteration
  491. *)
  492. if com.config.pf_capture_policy = CPLoopVars then
  493. (* We don't want to duplicate any variable declarations, so let's make copies (issue #3902). *)
  494. let new_vars = List.map (fun v -> v.v_id,alloc_var v.v_name v.v_type) vars in
  495. let rec loop e = match e.eexpr with
  496. | TLocal v ->
  497. begin try
  498. let v' = List.assoc v.v_id new_vars in
  499. v'.v_capture <- true;
  500. {e with eexpr = TLocal v'}
  501. with Not_found ->
  502. e
  503. end
  504. | _ ->
  505. Type.map_expr loop e
  506. in
  507. let e = loop e in
  508. mk (TCall (
  509. Codegen.mk_parent (mk (TFunction {
  510. tf_args = List.map (fun (_,v) -> v, None) new_vars;
  511. tf_type = e.etype;
  512. tf_expr = mk_block (mk (TReturn (Some e)) e.etype e.epos);
  513. }) (TFun (List.map (fun (_,v) -> v.v_name,false,v.v_type) new_vars,e.etype)) e.epos),
  514. List.map (fun v -> mk (TLocal v) v.v_type e.epos) vars)
  515. ) e.etype e.epos
  516. else
  517. e
  518. | _ ->
  519. map_expr (wrap used) e
  520. and do_wrap used e =
  521. if PMap.is_empty used then
  522. e
  523. else
  524. let used = PMap.map (fun v ->
  525. let vt = v.v_type in
  526. v.v_type <- impl#captured_type vt;
  527. v.v_capture <- true;
  528. vt
  529. ) used in
  530. wrap used e
  531. and out_loop e =
  532. match e.eexpr with
  533. | TFor _ | TWhile _ ->
  534. (*
  535. collect variables that are declared in loop but used in subfunctions
  536. *)
  537. let vars = ref PMap.empty in
  538. let used = ref PMap.empty in
  539. let depth = ref 0 in
  540. let rec collect_vars in_loop = function
  541. | Block f ->
  542. let old = !vars in
  543. f (collect_vars in_loop);
  544. vars := old;
  545. | Loop f ->
  546. let old = !vars in
  547. f (collect_vars true);
  548. vars := old;
  549. | Function f ->
  550. incr depth;
  551. f (collect_vars false);
  552. decr depth;
  553. | Declare v ->
  554. if in_loop then vars := PMap.add v.v_id !depth !vars;
  555. | Use v | Assign v ->
  556. try
  557. let d = PMap.find v.v_id !vars in
  558. if d <> !depth then used := PMap.add v.v_id v !used;
  559. with Not_found ->
  560. ()
  561. in
  562. local_usage (collect_vars false) e;
  563. do_wrap !used e
  564. | _ ->
  565. map_expr out_loop e
  566. and all_vars e =
  567. let vars = ref PMap.empty in
  568. let used = ref PMap.empty in
  569. let assigned = ref PMap.empty in
  570. let depth = ref 0 in
  571. let rec collect_vars = function
  572. | Block f ->
  573. let old = !vars in
  574. f collect_vars;
  575. vars := old;
  576. | Loop f ->
  577. let old = !vars in
  578. f collect_vars;
  579. vars := old;
  580. | Function f ->
  581. incr depth;
  582. f collect_vars;
  583. decr depth;
  584. | Declare v ->
  585. vars := PMap.add v.v_id !depth !vars;
  586. | Use v ->
  587. (try
  588. let d = PMap.find v.v_id !vars in
  589. if d <> !depth then used := PMap.add v.v_id v !used;
  590. with Not_found -> ())
  591. | Assign v ->
  592. (try
  593. let d = PMap.find v.v_id !vars in
  594. (* different depth - needs wrap *)
  595. if d <> !depth then begin
  596. used := PMap.add v.v_id v !used;
  597. assigned := PMap.add v.v_id v !assigned;
  598. end
  599. (* same depth but assigned after being used on a different depth - needs wrap *)
  600. else if PMap.mem v.v_id !used then
  601. assigned := PMap.add v.v_id v !assigned;
  602. with Not_found -> ())
  603. in
  604. local_usage collect_vars e;
  605. (* mark all capture variables - also used in rename_local_vars at later stage *)
  606. PMap.iter (fun _ v -> v.v_capture <- true) !used;
  607. !assigned
  608. in
  609. let captured = all_vars e in
  610. match com.config.pf_capture_policy with
  611. | CPNone -> e
  612. | CPWrapRef -> do_wrap captured e
  613. | CPLoopVars -> out_loop e
  614. (* -------------------------------------------------------------------------- *)
  615. (* RENAME LOCAL VARS *)
  616. let rename_local_vars ctx e =
  617. let cfg = ctx.com.config in
  618. let all_scope = (not cfg.pf_captured_scope) || (not cfg.pf_locals_scope) in
  619. let vars = ref PMap.empty in
  620. let all_vars = ref PMap.empty in
  621. let vtemp = alloc_var "~" t_dynamic in
  622. let rebuild_vars = ref false in
  623. let rebuild m =
  624. PMap.fold (fun v acc -> PMap.add v.v_name v acc) m PMap.empty
  625. in
  626. let save() =
  627. let old = !vars in
  628. if cfg.pf_unique_locals || not cfg.pf_locals_scope then (fun() -> ()) else (fun() -> vars := if !rebuild_vars then rebuild old else old)
  629. in
  630. let rename vars v =
  631. let count = ref 1 in
  632. while PMap.mem (v.v_name ^ string_of_int !count) vars do
  633. incr count;
  634. done;
  635. v.v_name <- v.v_name ^ string_of_int !count;
  636. in
  637. let declare v p =
  638. (match follow v.v_type with
  639. | TAbstract ({a_path = [],"Void"},_) -> error "Arguments and variables of type Void are not allowed" p
  640. | _ -> ());
  641. (* chop escape char for all local variables generated *)
  642. if is_gen_local v then v.v_name <- "_g" ^ String.sub v.v_name 1 (String.length v.v_name - 1);
  643. let look_vars = (if not cfg.pf_captured_scope && v.v_capture then !all_vars else !vars) in
  644. (try
  645. let v2 = PMap.find v.v_name look_vars in
  646. (*
  647. block_vars will create some wrapper-functions that are declaring
  648. the same variable twice. In that case do not perform a rename since
  649. we are sure it's actually the same variable
  650. *)
  651. if v == v2 then raise Not_found;
  652. rename look_vars v;
  653. with Not_found ->
  654. ());
  655. vars := PMap.add v.v_name v !vars;
  656. if all_scope then all_vars := PMap.add v.v_name v !all_vars;
  657. in
  658. (*
  659. This is quite a rare case, when a local variable would otherwise prevent
  660. accessing a type because it masks the type value or the package name.
  661. *)
  662. let check t =
  663. match (t_infos t).mt_path with
  664. | [], name | name :: _, _ ->
  665. let vars = if cfg.pf_locals_scope then vars else all_vars in
  666. (try
  667. let v = PMap.find name !vars in
  668. if v == vtemp then raise Not_found; (* ignore *)
  669. rename (!vars) v;
  670. rebuild_vars := true;
  671. vars := PMap.add v.v_name v !vars
  672. with Not_found ->
  673. ());
  674. vars := PMap.add name vtemp !vars
  675. in
  676. let check_type t =
  677. match follow t with
  678. | TInst (c,_) -> check (TClassDecl c)
  679. | TEnum (e,_) -> check (TEnumDecl e)
  680. | TType (t,_) -> check (TTypeDecl t)
  681. | TAbstract (a,_) -> check (TAbstractDecl a)
  682. | TMono _ | TLazy _ | TAnon _ | TDynamic _ | TFun _ -> ()
  683. in
  684. let rec loop e =
  685. match e.eexpr with
  686. | TVar (v,eo) ->
  687. if not cfg.pf_locals_scope then declare v e.epos;
  688. (match eo with None -> () | Some e -> loop e);
  689. if cfg.pf_locals_scope then declare v e.epos;
  690. | TFunction tf ->
  691. let old = save() in
  692. List.iter (fun (v,_) -> declare v e.epos) tf.tf_args;
  693. loop tf.tf_expr;
  694. old()
  695. | TBlock el ->
  696. let old = save() in
  697. (* we have to look ahead for vars on these targets (issue #3344) *)
  698. begin match ctx.com.platform with
  699. | Js ->
  700. let rec check_var e = match e.eexpr with
  701. | TVar (v,eo) ->
  702. (match eo with None -> () | Some e -> loop e);
  703. declare v e.epos
  704. | TBlock _ ->
  705. ()
  706. | _ ->
  707. Type.iter check_var e
  708. in
  709. List.iter check_var el
  710. | _ ->
  711. ()
  712. end;
  713. List.iter loop el;
  714. old()
  715. | TFor (v,it,e1) ->
  716. loop it;
  717. let old = save() in
  718. declare v e.epos;
  719. loop e1;
  720. old()
  721. | TTry (e,catchs) ->
  722. loop e;
  723. List.iter (fun (v,e) ->
  724. let old = save() in
  725. declare v e.epos;
  726. check_type v.v_type;
  727. loop e;
  728. old()
  729. ) catchs;
  730. | TTypeExpr t ->
  731. check t
  732. | TNew (c,_,_) ->
  733. Type.iter loop e;
  734. check (TClassDecl c);
  735. | TCast (e,Some t) ->
  736. loop e;
  737. check t;
  738. | TConst TSuper ->
  739. check_type e.etype
  740. | _ ->
  741. Type.iter loop e
  742. in
  743. declare (alloc_var "this" t_dynamic) Ast.null_pos; (* force renaming of 'this' vars in abstract *)
  744. begin match ctx.curclass.cl_path with
  745. | s :: _,_ | [],s -> declare (alloc_var s t_dynamic) Ast.null_pos
  746. end;
  747. loop e;
  748. e
  749. let check_unification ctx e t =
  750. begin match e.eexpr,t with
  751. | TLocal v,TType({t_path = ["cs"],("Ref" | "Out")},_) ->
  752. (* TODO: this smells of hack, but we have to deal with it somehow *)
  753. v.v_capture <- true
  754. | _ ->
  755. ()
  756. end;
  757. e
  758. (* PASS 1 end *)
  759. (* Saves a class state so it can be restored later, e.g. after DCE or native path rewrite *)
  760. let save_class_state ctx t = match t with
  761. | TClassDecl c ->
  762. let mk_field_restore f =
  763. let rec mk_overload_restore f =
  764. f.cf_name,f.cf_kind,f.cf_expr,f.cf_type,f.cf_meta,f.cf_params
  765. in
  766. ( f,mk_overload_restore f, List.map (fun f -> f,mk_overload_restore f) f.cf_overloads )
  767. in
  768. let restore_field (f,res,overloads) =
  769. let restore_field (f,(name,kind,expr,t,meta,params)) =
  770. f.cf_name <- name; f.cf_kind <- kind; f.cf_expr <- expr; f.cf_type <- t; f.cf_meta <- meta; f.cf_params <- params;
  771. f
  772. in
  773. let f = restore_field (f,res) in
  774. f.cf_overloads <- List.map restore_field overloads;
  775. f
  776. in
  777. let mk_pmap lst =
  778. List.fold_left (fun pmap f -> PMap.add f.cf_name f pmap) PMap.empty lst
  779. in
  780. let meta = c.cl_meta and path = c.cl_path and ext = c.cl_extern and over = c.cl_overrides in
  781. let sup = c.cl_super and impl = c.cl_implements in
  782. let csr = Option.map (mk_field_restore) c.cl_constructor in
  783. let ofr = List.map (mk_field_restore) c.cl_ordered_fields in
  784. let osr = List.map (mk_field_restore) c.cl_ordered_statics in
  785. let init = c.cl_init in
  786. c.cl_restore <- (fun() ->
  787. c.cl_super <- sup;
  788. c.cl_implements <- impl;
  789. c.cl_meta <- meta;
  790. c.cl_extern <- ext;
  791. c.cl_path <- path;
  792. c.cl_init <- init;
  793. c.cl_ordered_fields <- List.map restore_field ofr;
  794. c.cl_ordered_statics <- List.map restore_field osr;
  795. c.cl_fields <- mk_pmap c.cl_ordered_fields;
  796. c.cl_statics <- mk_pmap c.cl_ordered_statics;
  797. c.cl_constructor <- Option.map restore_field csr;
  798. c.cl_overrides <- over;
  799. )
  800. | _ ->
  801. ()
  802. (* PASS 2 begin *)
  803. let rec is_removable_class c =
  804. match c.cl_kind with
  805. | KGeneric ->
  806. (Meta.has Meta.Remove c.cl_meta ||
  807. (match c.cl_super with
  808. | Some (c,_) -> is_removable_class c
  809. | _ -> false) ||
  810. List.exists (fun (_,t) -> match follow t with
  811. | TInst(c,_) ->
  812. Codegen.has_ctor_constraint c || Meta.has Meta.Const c.cl_meta
  813. | _ ->
  814. false
  815. ) c.cl_params)
  816. | KTypeParameter _ ->
  817. (* this shouldn't happen, have to investigate (see #4092) *)
  818. true
  819. | _ ->
  820. false
  821. let remove_generic_base ctx t = match t with
  822. | TClassDecl c when is_removable_class c ->
  823. c.cl_extern <- true
  824. | _ ->
  825. ()
  826. (* Removes extern and macro fields, also checks for Void fields *)
  827. let remove_extern_fields ctx t = match t with
  828. | TClassDecl c ->
  829. if not (Common.defined ctx.com Define.DocGen) then begin
  830. c.cl_ordered_fields <- List.filter (fun f ->
  831. let b = Codegen.is_removable_field ctx f in
  832. if b then c.cl_fields <- PMap.remove f.cf_name c.cl_fields;
  833. not b
  834. ) c.cl_ordered_fields;
  835. c.cl_ordered_statics <- List.filter (fun f ->
  836. let b = Codegen.is_removable_field ctx f in
  837. if b then c.cl_statics <- PMap.remove f.cf_name c.cl_statics;
  838. not b
  839. ) c.cl_ordered_statics;
  840. end
  841. | _ ->
  842. ()
  843. (* PASS 2 end *)
  844. (* PASS 3 begin *)
  845. (* Checks if a private class' path clashes with another path *)
  846. let check_private_path ctx t = match t with
  847. | TClassDecl c when c.cl_private ->
  848. let rpath = (fst c.cl_module.m_path,"_" ^ snd c.cl_module.m_path) in
  849. if Hashtbl.mem ctx.g.types_module rpath then error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos;
  850. | _ ->
  851. ()
  852. (* Rewrites class or enum paths if @:native metadata is set *)
  853. let apply_native_paths ctx t =
  854. let get_native_name meta =
  855. let rec get_native meta = match meta with
  856. | [] -> raise Not_found
  857. | (Meta.Native,[v],p as meta) :: _ ->
  858. meta
  859. | _ :: meta ->
  860. get_native meta
  861. in
  862. let (_,e,mp) = get_native meta in
  863. match e with
  864. | [Ast.EConst (Ast.String name),p] ->
  865. name,p
  866. | [] ->
  867. raise Not_found
  868. | _ ->
  869. error "String expected" mp
  870. in
  871. let get_real_name meta name =
  872. let name',p = get_native_name meta in
  873. (Meta.RealPath,[Ast.EConst (Ast.String (name)), p], p), name'
  874. in
  875. let get_real_path meta path =
  876. let name,p = get_native_name meta in
  877. (Meta.RealPath,[Ast.EConst (Ast.String (s_type_path path)), p], p), parse_path name
  878. in
  879. try
  880. (match t with
  881. | TClassDecl c ->
  882. let did_change = ref false in
  883. let field cf = try
  884. let meta,name = get_real_name cf.cf_meta cf.cf_name in
  885. cf.cf_name <- name;
  886. cf.cf_meta <- meta :: cf.cf_meta;
  887. List.iter (fun cf -> cf.cf_name <- name) cf.cf_overloads;
  888. did_change := true
  889. with Not_found ->
  890. ()
  891. in
  892. let fields cfs old_map =
  893. did_change := false;
  894. List.iter field cfs;
  895. if !did_change then
  896. List.fold_left (fun map f -> PMap.add f.cf_name f map) PMap.empty cfs
  897. else
  898. old_map
  899. in
  900. c.cl_fields <- fields c.cl_ordered_fields c.cl_fields;
  901. c.cl_statics <- fields c.cl_ordered_statics c.cl_statics;
  902. let meta,path = get_real_path c.cl_meta c.cl_path in
  903. c.cl_meta <- meta :: c.cl_meta;
  904. c.cl_path <- path;
  905. | TEnumDecl e ->
  906. let meta,path = get_real_path e.e_meta e.e_path in
  907. e.e_meta <- meta :: e.e_meta;
  908. e.e_path <- path;
  909. | TAbstractDecl a when Meta.has Meta.CoreType a.a_meta ->
  910. let meta,path = get_real_path a.a_meta a.a_path in
  911. a.a_meta <- meta :: a.a_meta;
  912. a.a_path <- path;
  913. | _ ->
  914. ())
  915. with Not_found ->
  916. ()
  917. (* Adds the __rtti field if required *)
  918. let add_rtti ctx t =
  919. let rec has_rtti c =
  920. Meta.has Meta.Rtti c.cl_meta || match c.cl_super with None -> false | Some (csup,_) -> has_rtti csup
  921. in
  922. match t with
  923. | TClassDecl c when has_rtti c && not (PMap.mem "__rtti" c.cl_statics) ->
  924. let f = mk_field "__rtti" ctx.t.tstring c.cl_pos in
  925. let str = Genxml.gen_type_string ctx.com t in
  926. f.cf_expr <- Some (mk (TConst (TString str)) f.cf_type c.cl_pos);
  927. c.cl_ordered_statics <- f :: c.cl_ordered_statics;
  928. c.cl_statics <- PMap.add f.cf_name f c.cl_statics;
  929. | _ ->
  930. ()
  931. (* Adds member field initializations as assignments to the constructor *)
  932. let add_field_inits ctx t =
  933. let is_as3 = Common.defined ctx.com Define.As3 && not ctx.in_macro in
  934. let apply c =
  935. let ethis = mk (TConst TThis) (TInst (c,List.map snd c.cl_params)) c.cl_pos in
  936. (* TODO: we have to find a variable name which is not used in any of the functions *)
  937. let v = alloc_var "_g" ethis.etype in
  938. let need_this = ref false in
  939. let inits,fields = List.fold_left (fun (inits,fields) cf ->
  940. match cf.cf_kind,cf.cf_expr with
  941. | Var _, Some _ ->
  942. if is_as3 then (inits, cf :: fields) else (cf :: inits, cf :: fields)
  943. | Method MethDynamic, Some e when is_as3 ->
  944. (* TODO : this would have a better place in genSWF9 I think - NC *)
  945. (* we move the initialization of dynamic functions to the constructor and also solve the
  946. 'this' problem along the way *)
  947. let rec use_this v e = match e.eexpr with
  948. | TConst TThis ->
  949. need_this := true;
  950. mk (TLocal v) v.v_type e.epos
  951. | _ -> Type.map_expr (use_this v) e
  952. in
  953. let e = Type.map_expr (use_this v) e in
  954. let cf2 = {cf with cf_expr = Some e} in
  955. (* if the method is an override, we have to remove the class field to not get invalid overrides *)
  956. let fields = if List.memq cf c.cl_overrides then begin
  957. c.cl_fields <- PMap.remove cf.cf_name c.cl_fields;
  958. fields
  959. end else
  960. cf2 :: fields
  961. in
  962. (cf2 :: inits, fields)
  963. | _ -> (inits, cf :: fields)
  964. ) ([],[]) c.cl_ordered_fields in
  965. c.cl_ordered_fields <- (List.rev fields);
  966. match inits with
  967. | [] -> ()
  968. | _ ->
  969. let el = List.map (fun cf ->
  970. match cf.cf_expr with
  971. | None -> assert false
  972. | Some e ->
  973. let lhs = mk (TField(ethis,FInstance (c,List.map snd c.cl_params,cf))) cf.cf_type e.epos in
  974. cf.cf_expr <- None;
  975. let eassign = mk (TBinop(OpAssign,lhs,e)) e.etype e.epos in
  976. if is_as3 then begin
  977. let echeck = mk (TBinop(OpEq,lhs,(mk (TConst TNull) lhs.etype e.epos))) ctx.com.basic.tbool e.epos in
  978. mk (TIf(echeck,eassign,None)) eassign.etype e.epos
  979. end else
  980. eassign;
  981. ) inits in
  982. let el = if !need_this then (mk (TVar((v, Some ethis))) ethis.etype ethis.epos) :: el else el in
  983. match c.cl_constructor with
  984. | None ->
  985. let ct = TFun([],ctx.com.basic.tvoid) in
  986. let ce = mk (TFunction {
  987. tf_args = [];
  988. tf_type = ctx.com.basic.tvoid;
  989. tf_expr = mk (TBlock el) ctx.com.basic.tvoid c.cl_pos;
  990. }) ct c.cl_pos in
  991. let ctor = mk_field "new" ct c.cl_pos in
  992. ctor.cf_kind <- Method MethNormal;
  993. c.cl_constructor <- Some { ctor with cf_expr = Some ce };
  994. | Some cf ->
  995. match cf.cf_expr with
  996. | Some { eexpr = TFunction f } ->
  997. let bl = match f.tf_expr with {eexpr = TBlock b } -> b | x -> [x] in
  998. let ce = mk (TFunction {f with tf_expr = mk (TBlock (el @ bl)) ctx.com.basic.tvoid c.cl_pos }) cf.cf_type cf.cf_pos in
  999. c.cl_constructor <- Some {cf with cf_expr = Some ce }
  1000. | _ ->
  1001. assert false
  1002. in
  1003. match t with
  1004. | TClassDecl c ->
  1005. apply c
  1006. | _ ->
  1007. ()
  1008. (* Adds the __meta__ field if required *)
  1009. let add_meta_field ctx t = match t with
  1010. | TClassDecl c ->
  1011. (match Codegen.build_metadata ctx.com t with
  1012. | None -> ()
  1013. | Some e ->
  1014. add_feature ctx.com "has_metadata";
  1015. let f = mk_field "__meta__" t_dynamic c.cl_pos in
  1016. f.cf_expr <- Some e;
  1017. let can_deal_with_interface_metadata () = match ctx.com.platform with
  1018. | Flash when Common.defined ctx.com Define.As3 -> false
  1019. | Php -> false
  1020. | _ -> true
  1021. in
  1022. if c.cl_interface && not (can_deal_with_interface_metadata()) then begin
  1023. (* borrowed from gencommon, but I did wash my hands afterwards *)
  1024. let path = fst c.cl_path,snd c.cl_path ^ "_HxMeta" in
  1025. let ncls = mk_class c.cl_module path c.cl_pos in
  1026. let cf = mk_field "__meta__" e.etype e.epos in
  1027. cf.cf_expr <- Some e;
  1028. ncls.cl_statics <- PMap.add "__meta__" cf ncls.cl_statics;
  1029. ncls.cl_ordered_statics <- cf :: ncls.cl_ordered_statics;
  1030. ctx.com.types <- (TClassDecl ncls) :: ctx.com.types;
  1031. c.cl_meta <- (Meta.Custom ":hasMetadata",[],e.epos) :: c.cl_meta
  1032. end else begin
  1033. c.cl_ordered_statics <- f :: c.cl_ordered_statics;
  1034. c.cl_statics <- PMap.add f.cf_name f c.cl_statics
  1035. end)
  1036. | _ ->
  1037. ()
  1038. (* Removes interfaces tagged with @:remove metadata *)
  1039. let check_remove_metadata ctx t = match t with
  1040. | TClassDecl c ->
  1041. c.cl_implements <- List.filter (fun (c,_) -> not (Meta.has Meta.Remove c.cl_meta)) c.cl_implements;
  1042. | _ ->
  1043. ()
  1044. let do_the_tivo_thing ctx =
  1045. let rec get_substitute_class c = match c.cl_dependent with
  1046. | [({cl_params = []} as c2),[]] when c.cl_interface && c.cl_params = [] && not c.cl_extern && not (Meta.has Meta.Keep c.cl_meta) ->
  1047. get_substitute_class c2
  1048. | _ -> c
  1049. in
  1050. let rec substitute_type t = match follow t with
  1051. | TInst(c,[])->
  1052. let c2 = get_substitute_class c in
  1053. if c == c2 then
  1054. t
  1055. else if is_null t then
  1056. ctx.t.tnull (TInst(c2,[]))
  1057. else
  1058. TInst(c2,[])
  1059. | _ ->
  1060. Type.map substitute_type t
  1061. in
  1062. let substitute_expr e =
  1063. let build_var v =
  1064. v.v_type <- (substitute_type v.v_type);
  1065. v
  1066. in
  1067. let rec build_expr e = match e.eexpr with
  1068. | TTypeExpr (TClassDecl c) ->
  1069. let c2 = get_substitute_class c in
  1070. if c != c2 then begin
  1071. {e with eexpr = TTypeExpr (TClassDecl c2); etype = mk_type_expr_type c}
  1072. end else
  1073. e
  1074. | TCast(e1,Some (TClassDecl c)) ->
  1075. let e1 = build_expr e1 in
  1076. {e with eexpr = TCast(e1,Some (TClassDecl (get_substitute_class c))); etype = substitute_type e.etype}
  1077. | _ ->
  1078. map_expr_type build_expr substitute_type build_var e
  1079. in
  1080. build_expr e
  1081. in
  1082. let run = substitute_expr in
  1083. List.iter (fun mt -> match mt with
  1084. | TClassDecl c ->
  1085. if get_substitute_class c != c2 then c.cl_meta <- (Meta.Remove,[],c.cl_pos) :: c.cl_meta;
  1086. let rec process_field f =
  1087. f.cf_type <- substitute_type f.cf_type;
  1088. begin match f.cf_expr with
  1089. | Some e ->
  1090. f.cf_expr <- Some (run e);
  1091. | _ -> ()
  1092. end;
  1093. List.iter process_field f.cf_overloads
  1094. in
  1095. List.iter process_field c.cl_ordered_fields;
  1096. List.iter process_field c.cl_ordered_statics;
  1097. (match c.cl_constructor with
  1098. | None -> ()
  1099. | Some f -> process_field f);
  1100. (match c.cl_init with
  1101. | None -> ()
  1102. | Some e ->
  1103. c.cl_init <- Some (run e));
  1104. | _ ->
  1105. ()
  1106. ) ctx.com.types
  1107. (* Checks for Void class fields *)
  1108. let check_void_field ctx t = match t with
  1109. | TClassDecl c ->
  1110. let check f =
  1111. match follow f.cf_type with TAbstract({a_path=[],"Void"},_) -> error "Fields of type Void are not allowed" f.cf_pos | _ -> ();
  1112. in
  1113. List.iter check c.cl_ordered_fields;
  1114. List.iter check c.cl_ordered_statics;
  1115. | _ ->
  1116. ()
  1117. (* Interfaces have no 'super', but can extend many other interfaces.
  1118. This makes the first extended (implemented) interface the super for efficiency reasons (you can get one for 'free')
  1119. and leaves the remaining ones as 'implemented' *)
  1120. let promote_first_interface_to_super ctx t = match t with
  1121. | TClassDecl c when c.cl_interface ->
  1122. begin match c.cl_implements with
  1123. | ({ cl_path = ["cpp";"rtti"],_ },_ ) :: _ -> ()
  1124. | first_interface :: remaining ->
  1125. c.cl_super <- Some first_interface;
  1126. c.cl_implements <- remaining
  1127. | _ -> ()
  1128. end
  1129. | _ ->
  1130. ()
  1131. let commit_features ctx t =
  1132. let m = (t_infos t).mt_module in
  1133. Hashtbl.iter (fun k v ->
  1134. Common.add_feature ctx.com k;
  1135. ) m.m_extra.m_features
  1136. let check_reserved_type_paths ctx t =
  1137. let check path pos =
  1138. if List.mem path ctx.com.config.pf_reserved_type_paths then
  1139. ctx.com.warning ("Type path " ^ (s_type_path path) ^ " is reserved on this target") pos
  1140. in
  1141. match t with
  1142. | TClassDecl c when not c.cl_extern -> check c.cl_path c.cl_pos
  1143. | TEnumDecl e when not e.e_extern -> check e.e_path e.e_pos
  1144. | _ -> ()
  1145. (* PASS 3 end *)
  1146. let run_expression_filters ctx filters t =
  1147. let run e =
  1148. List.fold_left (fun e f -> f e) e filters
  1149. in
  1150. match t with
  1151. | TClassDecl c when is_removable_class c -> ()
  1152. | TClassDecl c ->
  1153. ctx.curclass <- c;
  1154. let rec process_field f =
  1155. (match f.cf_expr with
  1156. | Some e when not (Codegen.is_removable_field ctx f) ->
  1157. Codegen.AbstractCast.cast_stack := f :: !Codegen.AbstractCast.cast_stack;
  1158. f.cf_expr <- Some (run e);
  1159. Codegen.AbstractCast.cast_stack := List.tl !Codegen.AbstractCast.cast_stack;
  1160. | _ -> ());
  1161. List.iter process_field f.cf_overloads
  1162. in
  1163. List.iter process_field c.cl_ordered_fields;
  1164. List.iter process_field c.cl_ordered_statics;
  1165. (match c.cl_constructor with
  1166. | None -> ()
  1167. | Some f -> process_field f);
  1168. (match c.cl_init with
  1169. | None -> ()
  1170. | Some e ->
  1171. c.cl_init <- Some (run e));
  1172. | TEnumDecl _ -> ()
  1173. | TTypeDecl _ -> ()
  1174. | TAbstractDecl _ -> ()
  1175. let pp_counter = ref 1
  1176. let is_cached t =
  1177. let m = (t_infos t).mt_module.m_extra in
  1178. if m.m_processed = 0 then m.m_processed <- !pp_counter;
  1179. m.m_processed <> !pp_counter
  1180. let apply_filters_once ctx filters t =
  1181. if not (is_cached t) then run_expression_filters ctx filters t
  1182. let next_compilation() =
  1183. incr pp_counter
  1184. let iter_expressions fl mt =
  1185. match mt with
  1186. | TClassDecl c ->
  1187. let field cf = match cf.cf_expr with
  1188. | None -> ()
  1189. | Some e -> List.iter (fun f -> f e) fl
  1190. in
  1191. List.iter field c.cl_ordered_statics;
  1192. List.iter field c.cl_ordered_fields;
  1193. (match c.cl_constructor with None -> () | Some cf -> field cf)
  1194. | _ ->
  1195. ()
  1196. let run com tctx main =
  1197. begin match com.display with
  1198. | DMUsage | DMPosition ->
  1199. Codegen.detect_usage com;
  1200. | _ ->
  1201. ()
  1202. end;
  1203. if not (Common.defined com Define.NoDeprecationWarnings) then
  1204. Codegen.DeprecationCheck.run com;
  1205. let use_static_analyzer = Common.defined com Define.Analyzer in
  1206. (* this part will be a bit messy until we make the analyzer the default *)
  1207. let new_types = List.filter (fun t -> not (is_cached t)) com.types in
  1208. if use_static_analyzer then begin
  1209. (* PASS 1: general expression filters *)
  1210. let filters = [
  1211. Codegen.AbstractCast.handle_abstract_casts tctx;
  1212. check_local_vars_init;
  1213. Optimizer.inline_constructors tctx;
  1214. Optimizer.reduce_expression tctx;
  1215. blockify_ast;
  1216. captured_vars com;
  1217. ] in
  1218. List.iter (run_expression_filters tctx filters) new_types;
  1219. Analyzer.Run.run_on_types tctx new_types;
  1220. List.iter (iter_expressions [verify_ast tctx]) new_types;
  1221. let filters = [
  1222. Optimizer.sanitize com;
  1223. if com.config.pf_add_final_return then add_final_return else (fun e -> e);
  1224. if com.platform = Js then wrap_js_exceptions com else (fun e -> e);
  1225. rename_local_vars tctx;
  1226. ] in
  1227. List.iter (run_expression_filters tctx filters) new_types;
  1228. end else begin
  1229. (* PASS 1: general expression filters *)
  1230. let filters = [
  1231. Codegen.AbstractCast.handle_abstract_casts tctx;
  1232. blockify_ast;
  1233. check_local_vars_init;
  1234. Optimizer.inline_constructors tctx;
  1235. ( if (Common.defined com Define.NoSimplify) || (Common.defined com Define.Cppia) ||
  1236. ( match com.platform with Cpp -> false | _ -> true ) then
  1237. fun e -> e
  1238. else
  1239. fun e ->
  1240. let save = save_locals tctx in
  1241. let timer = timer "analyzer-simplify-apply" in
  1242. let e = try snd (Analyzer.Simplifier.apply com e) with Exit -> e in
  1243. timer();
  1244. save();
  1245. e );
  1246. if com.foptimize then (fun e -> Optimizer.reduce_expression tctx e) else Optimizer.sanitize com;
  1247. captured_vars com;
  1248. promote_complex_rhs com;
  1249. if com.config.pf_add_final_return then add_final_return else (fun e -> e);
  1250. if com.platform = Js then wrap_js_exceptions com else (fun e -> e);
  1251. rename_local_vars tctx;
  1252. ] in
  1253. List.iter (run_expression_filters tctx filters) new_types;
  1254. List.iter (iter_expressions [verify_ast tctx]) new_types;
  1255. end;
  1256. next_compilation();
  1257. List.iter (fun f -> f()) (List.rev com.filters); (* macros onGenerate etc. *)
  1258. List.iter (save_class_state tctx) new_types;
  1259. List.iter (fun t ->
  1260. remove_generic_base tctx t;
  1261. remove_extern_fields tctx t;
  1262. ) com.types;
  1263. do_the_tivo_thing tctx;
  1264. (* update cache dependencies before DCE is run *)
  1265. Codegen.update_cache_dependencies com;
  1266. (* check @:remove metadata before DCE so it is ignored there (issue #2923) *)
  1267. List.iter (check_remove_metadata tctx) com.types;
  1268. (* DCE *)
  1269. let dce_mode = if Common.defined com Define.As3 then
  1270. "no"
  1271. else
  1272. (try Common.defined_value com Define.Dce with _ -> "no")
  1273. in
  1274. begin match dce_mode with
  1275. | "full" -> Dce.run com main (not (Common.defined com Define.Interp))
  1276. | "std" -> Dce.run com main false
  1277. | "no" -> Dce.fix_accessors com
  1278. | _ -> failwith ("Unknown DCE mode " ^ dce_mode)
  1279. end;
  1280. (* always filter empty abstract implementation classes (issue #1885) *)
  1281. List.iter (fun mt -> match mt with
  1282. | TClassDecl({cl_kind = KAbstractImpl _} as c) when c.cl_ordered_statics = [] && c.cl_ordered_fields = [] && not (Meta.has Meta.Used c.cl_meta) ->
  1283. c.cl_extern <- true
  1284. | TClassDecl({cl_kind = KAbstractImpl a} as c) when Meta.has Meta.Enum a.a_meta ->
  1285. let is_runtime_field cf =
  1286. not (Meta.has Meta.Enum cf.cf_meta)
  1287. in
  1288. (* also filter abstract implementation classes that have only @:enum fields (issue #2858) *)
  1289. if not (List.exists is_runtime_field c.cl_ordered_statics) then
  1290. c.cl_extern <- true
  1291. | _ -> ()
  1292. ) com.types;
  1293. (* PASS 3: type filters *)
  1294. let type_filters = [
  1295. check_private_path;
  1296. apply_native_paths;
  1297. add_rtti;
  1298. (match com.platform with | Java | Cs -> (fun _ _ -> ()) | _ -> add_field_inits);
  1299. add_meta_field;
  1300. check_void_field;
  1301. (match com.platform with | Cpp -> promote_first_interface_to_super | _ -> (fun _ _ -> ()) );
  1302. commit_features;
  1303. (if com.config.pf_reserved_type_paths <> [] then check_reserved_type_paths else (fun _ _ -> ()));
  1304. ] in
  1305. List.iter (fun t -> List.iter (fun f -> f tctx t) type_filters) com.types