castDetect.ml 50 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240
  1. (*
  2. The Haxe Compiler
  3. Copyright (C) 2005-2017 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 Option
  17. open Common
  18. open Ast
  19. open Globals
  20. open Type
  21. open Codegen
  22. open Gencommon
  23. (* ******************************************* *)
  24. (* Casts detection v2 *)
  25. (* ******************************************* *)
  26. (*
  27. Will detect implicit casts and add TCast for them. Since everything is already followed by follow_all, typedefs are considered a new type altogether
  28. Types shouldn't be cast if:
  29. * When an instance is being coerced to a superclass or to an implemented interface
  30. * When anything is being coerced to Dynamic
  31. edit:
  32. As a matter of performance, we will also run the type parameters casts in here. Otherwise the exact same computation would have to be performed twice,
  33. with maybe even some loss of information
  34. * TAnon / TDynamic will call
  35. * Type parameter handling will be abstracted
  36. dependencies:
  37. Must run before ExpressionUnwrap
  38. *)
  39. let name = "cast_detect"
  40. let priority = solve_deps name [DBefore RealTypeParams.priority; DBefore ExpressionUnwrap.priority]
  41. (* ******************************************* *)
  42. (* ReturnCast *)
  43. (* ******************************************* *)
  44. (*
  45. Cast detection for return types can't be done at CastDetect time, since we need an
  46. unwrapped expression to make sure we catch all return cast detections. So this module
  47. is specifically to deal with that, and is configured automatically by CastDetect
  48. *)
  49. module ReturnCast =
  50. struct
  51. let name = "return_cast"
  52. let priority = solve_deps name [DAfter priority; DAfter ExpressionUnwrap.priority]
  53. let default_implementation gen =
  54. let rec extract_expr e = match e.eexpr with
  55. | TParenthesis e
  56. | TMeta (_,e)
  57. | TCast(e,_) -> extract_expr e
  58. | _ -> e
  59. in
  60. let current_ret_type = ref None in
  61. let handle e tto tfrom = gen.ghandle_cast (gen.greal_type tto) (gen.greal_type tfrom) e in
  62. let in_value = ref false in
  63. let rec run e =
  64. let was_in_value = !in_value in
  65. in_value := true;
  66. match e.eexpr with
  67. | TReturn (eopt) ->
  68. (* a return must be inside a function *)
  69. let ret_type = match !current_ret_type with | Some(s) -> s | None -> gen.gcon.error "Invalid return outside function declaration." e.epos; assert false in
  70. (match eopt with
  71. | None when not (ExtType.is_void ret_type) ->
  72. mk_return (null ret_type e.epos)
  73. | None -> e
  74. | Some eret ->
  75. mk_return (handle (run eret) ret_type eret.etype))
  76. | TFunction(tfunc) ->
  77. let last_ret = !current_ret_type in
  78. current_ret_type := Some(tfunc.tf_type);
  79. let ret = Type.map_expr run e in
  80. current_ret_type := last_ret;
  81. ret
  82. | TBlock el ->
  83. { e with eexpr = TBlock ( List.map (fun e -> in_value := false; run e) el ) }
  84. | TBinop ( (Ast.OpAssign as op),e1,e2)
  85. | TBinop ( (Ast.OpAssignOp _ as op),e1,e2) when was_in_value ->
  86. let e1 = extract_expr (run e1) in
  87. let r = { e with eexpr = TBinop(op, e1, handle (run e2) e1.etype e2.etype); etype = e1.etype } in
  88. handle r e.etype e1.etype
  89. | TBinop ( (Ast.OpAssign as op),({ eexpr = TField(tf, f) } as e1), e2 )
  90. | TBinop ( (Ast.OpAssignOp _ as op),({ eexpr = TField(tf, f) } as e1), e2 ) ->
  91. (match field_access_esp gen (gen.greal_type tf.etype) (f) with
  92. | FClassField(cl,params,_,_,is_static,actual_t,_) ->
  93. let actual_t = if is_static then actual_t else apply_params cl.cl_params params actual_t in
  94. let e1 = extract_expr (run e1) in
  95. { e with eexpr = TBinop(op, e1, handle (run e2) actual_t e2.etype); etype = e1.etype }
  96. | _ ->
  97. let e1 = extract_expr (run e1) in
  98. { e with eexpr = TBinop(op, e1, handle (run e2) e1.etype e2.etype); etype = e1.etype }
  99. )
  100. | TBinop ( (Ast.OpAssign as op),e1,e2)
  101. | TBinop ( (Ast.OpAssignOp _ as op),e1,e2) ->
  102. let e1 = extract_expr (run e1) in
  103. { e with eexpr = TBinop(op, e1, handle (run e2) e1.etype e2.etype); etype = e1.etype }
  104. | _ -> Type.map_expr run e
  105. in
  106. run
  107. let configure gen =
  108. let map = default_implementation gen in
  109. gen.gsyntax_filters#add name (PCustom priority) map
  110. end;;
  111. (*
  112. Since this function is applied under native-context only, the type paraters will already be changed
  113. *)
  114. let map_cls gen also_implements fn super =
  115. let rec loop c tl =
  116. if c == super then
  117. fn c tl
  118. else
  119. (match c.cl_super with
  120. | None -> false
  121. | Some (cs,tls) ->
  122. let tls = gen.greal_type_param (TClassDecl cs) tls in
  123. loop cs (List.map (apply_params c.cl_params tl) tls)
  124. )
  125. ||
  126. (if also_implements then
  127. List.exists (fun (cs,tls) -> loop cs (List.map (apply_params c.cl_params tl) tls)) c.cl_implements
  128. else
  129. false)
  130. in
  131. loop
  132. let follow_dyn t = match follow t with
  133. | TMono _ | TLazy _ -> t_dynamic
  134. | t -> t
  135. (*
  136. this has a slight change from the type.ml version, in which it doesn't
  137. change a TMono into the other parameter
  138. *)
  139. let rec type_eq gen param a b =
  140. if a == b then
  141. ()
  142. else match follow_dyn (gen.greal_type a) , follow_dyn (gen.greal_type b) with
  143. | TEnum (e1,tl1) , TEnum (e2,tl2) ->
  144. if e1 != e2 && not (param = EqCoreType && e1.e_path = e2.e_path) then Type.error [cannot_unify a b];
  145. List.iter2 (type_eq gen param) tl1 tl2
  146. | TAbstract (a1,tl1) , TAbstract (a2,tl2) ->
  147. if a1 != a2 && not (param = EqCoreType && a1.a_path = a2.a_path) then Type.error [cannot_unify a b];
  148. List.iter2 (type_eq gen param) tl1 tl2
  149. | TInst (c1,tl1) , TInst (c2,tl2) ->
  150. if c1 != c2 && not (param = EqCoreType && c1.cl_path = c2.cl_path) && (match c1.cl_kind, c2.cl_kind with KExpr _, KExpr _ -> false | _ -> true) then Type.error [cannot_unify a b];
  151. List.iter2 (type_eq gen param) tl1 tl2
  152. | TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 ->
  153. (try
  154. type_eq gen param r1 r2;
  155. List.iter2 (fun (n,o1,t1) (_,o2,t2) ->
  156. if o1 <> o2 then Type.error [Not_matching_optional n];
  157. type_eq gen param t1 t2
  158. ) l1 l2
  159. with
  160. Unify_error l -> Type.error (cannot_unify a b :: l))
  161. | TDynamic a , TDynamic b ->
  162. type_eq gen param a b
  163. | TAnon a1, TAnon a2 ->
  164. (try
  165. PMap.iter (fun n f1 ->
  166. try
  167. let f2 = PMap.find n a2.a_fields in
  168. if f1.cf_kind <> f2.cf_kind && (param = EqStrict || param = EqCoreType || not (unify_kind f1.cf_kind f2.cf_kind)) then Type.error [invalid_kind n f1.cf_kind f2.cf_kind];
  169. try
  170. type_eq gen param f1.cf_type f2.cf_type
  171. with
  172. Unify_error l -> Type.error (invalid_field n :: l)
  173. with
  174. Not_found ->
  175. if is_closed a2 then Type.error [has_no_field b n];
  176. if not (link (ref None) b f1.cf_type) then Type.error [cannot_unify a b];
  177. a2.a_fields <- PMap.add n f1 a2.a_fields
  178. ) a1.a_fields;
  179. PMap.iter (fun n f2 ->
  180. if not (PMap.mem n a1.a_fields) then begin
  181. if is_closed a1 then Type.error [has_no_field a n];
  182. if not (link (ref None) a f2.cf_type) then Type.error [cannot_unify a b];
  183. a1.a_fields <- PMap.add n f2 a1.a_fields
  184. end;
  185. ) a2.a_fields;
  186. with
  187. Unify_error l -> Type.error (cannot_unify a b :: l))
  188. | _ , _ ->
  189. if b == t_dynamic && (param = EqRightDynamic || param = EqBothDynamic) then
  190. ()
  191. else if a == t_dynamic && param = EqBothDynamic then
  192. ()
  193. else
  194. Type.error [cannot_unify a b]
  195. let type_iseq gen a b =
  196. try
  197. type_eq gen EqStrict a b;
  198. true
  199. with
  200. Unify_error _ -> false
  201. (* will return true if both arguments are compatible. If it's not the case, a runtime error is very likely *)
  202. let is_cl_related gen cl tl super superl =
  203. let is_cl_related cl tl super superl = map_cls gen (match cl.cl_kind,super.cl_kind with KTypeParameter _, _ | _,KTypeParameter _ -> false | _ -> true) (fun _ _ -> true) super cl tl in
  204. is_cl_related cl tl super superl || is_cl_related super superl cl tl
  205. let is_exactly_basic gen t1 t2 =
  206. match gen.gfollow#run_f t1, gen.gfollow#run_f t2 with
  207. | TAbstract(a1, []), TAbstract(a2, []) ->
  208. a1 == a2 && Common.defined gen.gcon Define.FastCast
  209. | TInst(c1, []), TInst(c2, []) ->
  210. c1 == c2 && Common.defined gen.gcon Define.FastCast
  211. | TEnum(e1, []), TEnum(e2, []) ->
  212. e1 == e2 && Common.defined gen.gcon Define.FastCast
  213. | _ ->
  214. false
  215. let rec is_unsafe_cast gen to_t from_t =
  216. match (follow to_t, follow from_t) with
  217. | TInst(cl_to, to_params), TInst(cl_from, from_params) ->
  218. not (is_cl_related gen cl_from from_params cl_to to_params)
  219. | TEnum(e_to, _), TEnum(e_from, _) ->
  220. e_to.e_path <> e_from.e_path
  221. | TFun _, TFun _ ->
  222. (* functions are never unsafe cast by default. This behavior might be changed *)
  223. (* with a later AST pass which will run through TFun to TFun casts *)
  224. false
  225. | TMono _, _
  226. | _, TMono _
  227. | TDynamic _, _
  228. | _, TDynamic _ ->
  229. false
  230. | TAnon _, _
  231. | _, TAnon _ ->
  232. (* anonymous are never unsafe also. *)
  233. (* Though they will generate a cast, so if this cast is unneeded it's better to avoid them by tweaking gen.greal_type *)
  234. false
  235. | TAbstract _, _
  236. | _, TAbstract _ ->
  237. (try
  238. unify from_t to_t;
  239. false
  240. with | Unify_error _ ->
  241. try
  242. unify to_t from_t; (* still not unsafe *)
  243. false
  244. with | Unify_error _ ->
  245. true)
  246. | _ -> true
  247. let unifies tfrom tto = try
  248. unify tfrom tto;
  249. true
  250. with | _ ->
  251. false
  252. let do_unsafe_cast gen from_t to_t e =
  253. let t_path t =
  254. match t with
  255. | TInst(cl, _) -> cl.cl_path
  256. | TEnum(e, _) -> e.e_path
  257. | TType(t, _) -> t.t_path
  258. | TAbstract(a, _) -> a.a_path
  259. | TDynamic _ -> ([], "Dynamic")
  260. | _ -> raise Not_found
  261. in
  262. match gen.gfollow#run_f from_t, gen.gfollow#run_f to_t with
  263. | TInst({ cl_kind = KTypeParameter tl },_), t2 when List.exists (fun t -> unifies t t2) tl ->
  264. mk_cast to_t (mk_cast t_dynamic e)
  265. | from_t, to_t when gen.gspecial_needs_cast to_t from_t ->
  266. mk_cast to_t e
  267. | _ ->
  268. let do_default () =
  269. gen.gon_unsafe_cast to_t e.etype e.epos;
  270. mk_cast to_t (mk_cast t_dynamic e)
  271. in
  272. (* TODO: there really should be a better way to write that *)
  273. try
  274. if (Hashtbl.find gen.gsupported_conversions (t_path from_t)) from_t to_t then
  275. mk_cast to_t e
  276. else
  277. do_default()
  278. with
  279. | Not_found ->
  280. try
  281. if (Hashtbl.find gen.gsupported_conversions (t_path to_t)) from_t to_t then
  282. mk_cast to_t e
  283. else
  284. do_default()
  285. with
  286. | Not_found -> do_default()
  287. (* ****************************** *)
  288. (* cast handler *)
  289. (* decides if a cast should be emitted, given a from and a to type *)
  290. (*
  291. this function is like a mini unify, without e.g. subtyping, which makes sense
  292. at the backend level, since most probably Anons and TInst will have a different representation there
  293. *)
  294. let rec handle_cast gen e real_to_t real_from_t =
  295. let do_unsafe_cast () = do_unsafe_cast gen real_from_t real_to_t { e with etype = real_from_t } in
  296. let to_t, from_t = real_to_t, real_from_t in
  297. let mk_cast fast t e =
  298. match e.eexpr with
  299. (* TThrow is always typed as Dynamic, we just need to type it accordingly *)
  300. | TThrow _ -> { e with etype = t }
  301. | _ -> if fast then mk_castfast t e else mk_cast t e
  302. in
  303. let e = { e with etype = real_from_t } in
  304. if try fast_eq real_to_t real_from_t with Invalid_argument _ -> false then e else
  305. match real_to_t, real_from_t with
  306. (* string is the only type that can be implicitly converted from any other *)
  307. | TInst( { cl_path = ([], "String") }, []), TInst( { cl_path = ([], "String") }, [] ) ->
  308. mk_cast true to_t e
  309. | TInst( { cl_path = ([], "String") }, []), _ ->
  310. mk_cast false to_t e
  311. | TInst( ({ cl_path = (["cs"|"java"], "NativeArray") } as c_array), [tp_to] ), TInst({ cl_path = (["cs"|"java"], "NativeArray") }, [tp_from]) when not (type_iseq gen (gen.greal_type tp_to) (gen.greal_type tp_from)) ->
  312. (* when running e.g. var nativeArray:NativeArray<Dynamic> = @:privateAccess someIntMap.vals, we end up with a bad cast because of the type parameters differences *)
  313. (* se clean these kinds of casts *)
  314. let rec clean_cast e = match e.eexpr with
  315. | TCast(expr,_) -> (match gen.greal_type e.etype with
  316. | TInst({ cl_path = (["cs"|"java"],"NativeArray") }, _) ->
  317. clean_cast expr
  318. | _ ->
  319. e)
  320. | TParenthesis(e) | TMeta(_,e) -> clean_cast e
  321. | _ -> e
  322. in
  323. (* see #5751 . NativeArray is special because of its ties to Array. We could potentially deal with this for all *)
  324. (* TNew expressions, but it's not that simple, since we don't want to retype the whole expression list with the *)
  325. (* updated type. *)
  326. (match e.eexpr with
  327. | TNew(c,_,el) when c == c_array ->
  328. mk_cast false (TInst(c_array,[tp_to])) { e with eexpr = TNew(c, [tp_to], el); etype = TInst(c_array,[tp_to]) }
  329. | _ ->
  330. try
  331. type_eq gen EqRightDynamic tp_from tp_to;
  332. e
  333. with | Unify_error _ ->
  334. mk_cast false to_t (clean_cast e))
  335. | TInst(cl_to, params_to), TInst(cl_from, params_from) ->
  336. let ret = ref None in
  337. (*
  338. this is a little confusing:
  339. we are here mapping classes until we have the same to and from classes, applying the type parameters in each step, so we can
  340. compare the type parameters;
  341. If a class is found - meaning that the cl_from can be converted without a cast into cl_to,
  342. we still need to check their type parameters.
  343. *)
  344. ignore (map_cls gen (match cl_from.cl_kind,cl_to.cl_kind with KTypeParameter _, _ | _,KTypeParameter _ -> false | _ -> true) (fun _ tl ->
  345. try
  346. (* type found, checking type parameters *)
  347. List.iter2 (type_eq gen EqStrict) tl params_to;
  348. ret := Some e;
  349. true
  350. with | Unify_error _ ->
  351. (* type parameters need casting *)
  352. if gen.ghas_tparam_cast_handler then begin
  353. (*
  354. if we are already handling type parameter casts on other part of code (e.g. RealTypeParameters),
  355. we'll just make a cast to indicate that this place needs type parameter-involved casting
  356. *)
  357. ret := Some (mk_cast true to_t e);
  358. true
  359. end else
  360. (*
  361. if not, we're going to check if we only need a simple cast,
  362. or if we need to first cast into the dynamic version of it
  363. *)
  364. try
  365. List.iter2 (type_eq gen EqRightDynamic) tl params_to;
  366. ret := Some (mk_cast true to_t e);
  367. true
  368. with | Unify_error _ ->
  369. ret := Some (mk_cast true to_t (mk_cast true (TInst(cl_to, List.map (fun _ -> t_dynamic) params_to)) e));
  370. true
  371. ) cl_to cl_from params_from);
  372. if is_some !ret then
  373. get !ret
  374. else if is_cl_related gen cl_from params_from cl_to params_to then
  375. mk_cast true to_t e
  376. else
  377. (* potential unsafe cast *)
  378. (do_unsafe_cast ())
  379. | TMono _, TMono _
  380. | TMono _, TDynamic _
  381. | TDynamic _, TDynamic _
  382. | TDynamic _, TMono _ ->
  383. e
  384. | TMono _, _
  385. | TDynamic _, _
  386. | TAnon _, _ when gen.gneeds_box real_from_t ->
  387. mk_cast false to_t e
  388. | TMono _, _
  389. | TDynamic _, _ -> e
  390. | _, TMono _
  391. | _, TDynamic _ -> mk_cast false to_t e
  392. | TAnon (a_to), TAnon (a_from) ->
  393. if a_to == a_from then
  394. e
  395. else if type_iseq gen to_t from_t then (* FIXME apply unify correctly *)
  396. e
  397. else
  398. mk_cast true to_t e
  399. | _, TAnon(anon) -> (try
  400. let p2 = match !(anon.a_status) with
  401. | Statics c -> TInst(c,List.map (fun _ -> t_dynamic) c.cl_params)
  402. | EnumStatics e -> TEnum(e, List.map (fun _ -> t_dynamic) e.e_params)
  403. | AbstractStatics a -> TAbstract(a, List.map (fun _ -> t_dynamic) a.a_params)
  404. | _ -> raise Not_found
  405. in
  406. let tclass = match get_type gen ([],"Class") with
  407. | TAbstractDecl(a) -> a
  408. | _ -> assert false in
  409. handle_cast gen e real_to_t (gen.greal_type (TAbstract(tclass, [p2])))
  410. with | Not_found ->
  411. mk_cast false to_t e)
  412. | TAbstract (a_to, _), TAbstract(a_from, _) when a_to == a_from ->
  413. e
  414. | TAbstract _, TInst({ cl_kind = KTypeParameter _ }, _)
  415. | TInst({ cl_kind = KTypeParameter _ }, _), TAbstract _ ->
  416. do_unsafe_cast()
  417. | TAbstract _, _
  418. | _, TAbstract _ ->
  419. (try
  420. unify from_t to_t;
  421. mk_cast true to_t e
  422. with | Unify_error _ ->
  423. try
  424. unify to_t from_t;
  425. mk_cast true to_t e
  426. with | Unify_error _ ->
  427. do_unsafe_cast())
  428. | TEnum(e_to, []), TEnum(e_from, []) ->
  429. if e_to == e_from then
  430. e
  431. else
  432. (* potential unsafe cast *)
  433. (do_unsafe_cast ())
  434. | TEnum(e_to, params_to), TEnum(e_from, params_from) when e_to.e_path = e_from.e_path ->
  435. (try
  436. List.iter2 (type_eq gen (if gen.gallow_tp_dynamic_conversion then EqRightDynamic else EqStrict)) params_from params_to;
  437. e
  438. with
  439. | Unify_error _ -> do_unsafe_cast ()
  440. )
  441. | TEnum(en, params_to), TInst(cl, params_from)
  442. | TInst(cl, params_to), TEnum(en, params_from) ->
  443. (* this is here for max compatibility with EnumsToClass module *)
  444. if en.e_path = cl.cl_path && Meta.has Meta.Class en.e_meta then begin
  445. (try
  446. List.iter2 (type_eq gen (if gen.gallow_tp_dynamic_conversion then EqRightDynamic else EqStrict)) params_from params_to;
  447. e
  448. with
  449. | Invalid_argument _ ->
  450. (*
  451. this is a hack for RealTypeParams. Since there is no way at this stage to know if the class is the actual
  452. EnumsToClass derived from the enum, we need to imply from possible ArgumentErrors (because of RealTypeParams interfaces),
  453. that they would only happen if they were a RealTypeParams created interface
  454. *)
  455. e
  456. | Unify_error _ -> do_unsafe_cast ()
  457. )
  458. end else
  459. do_unsafe_cast ()
  460. | TType(t_to, params_to), TType(t_from, params_from) when t_to == t_from ->
  461. if gen.gspecial_needs_cast real_to_t real_from_t then
  462. (try
  463. List.iter2 (type_eq gen (if gen.gallow_tp_dynamic_conversion then EqRightDynamic else EqStrict)) params_from params_to;
  464. e
  465. with
  466. | Unify_error _ -> do_unsafe_cast ()
  467. )
  468. else
  469. e
  470. | TType(t_to, _), TType(t_from,_) ->
  471. if gen.gspecial_needs_cast real_to_t real_from_t then
  472. mk_cast false to_t e
  473. else
  474. e
  475. | TType _, _ when gen.gspecial_needs_cast real_to_t real_from_t ->
  476. mk_cast false to_t e
  477. | _, TType _ when gen.gspecial_needs_cast real_to_t real_from_t ->
  478. mk_cast false to_t e
  479. (*| TType(t_to, _), TType(t_from, _) ->
  480. if t_to.t_path = t_from.t_path then
  481. e
  482. else if is_unsafe_cast gen real_to_t real_from_t then (* is_unsafe_cast will already follow both *)
  483. (do_unsafe_cast ())
  484. else
  485. mk_cast to_t e*)
  486. | TType _, _
  487. | _, TType _ ->
  488. if is_unsafe_cast gen real_to_t real_from_t then (* is_unsafe_cast will already follow both *)
  489. (do_unsafe_cast ())
  490. else
  491. mk_cast false to_t e
  492. | TAnon anon, _ ->
  493. if PMap.is_empty anon.a_fields then
  494. e
  495. else
  496. mk_cast true to_t e
  497. | TFun(args, ret), TFun(args2, ret2) ->
  498. let get_args = List.map (fun (_,_,t) -> t) in
  499. (try List.iter2 (type_eq gen (EqBothDynamic)) (ret :: get_args args) (ret2 :: get_args args2); e with | Unify_error _ | Invalid_argument _ -> mk_cast true to_t e)
  500. | _, _ ->
  501. do_unsafe_cast ()
  502. (* end of cast handler *)
  503. (* ******************* *)
  504. let is_static_overload c name =
  505. match c.cl_super with
  506. | None -> false
  507. | Some (sup,_) ->
  508. let rec loop c =
  509. (PMap.mem name c.cl_statics) || (match c.cl_super with
  510. | None -> false
  511. | Some (sup,_) -> loop sup)
  512. in
  513. loop sup
  514. (* this is a workaround for issue #1743, as FInstance() is returning the incorrect classfield *)
  515. let rec clean_t t = match follow t with
  516. | TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) ->
  517. clean_t (Abstract.get_underlying_type a tl)
  518. | t -> t
  519. let select_overload gen applied_f overloads types params =
  520. let rec check_arg arglist elist =
  521. match arglist, elist with
  522. | [], [] -> true (* it is valid *)
  523. | (_,_,TAbstract({ a_path = (["haxe";"extern"],"Rest") }, [t])) :: [], elist ->
  524. List.for_all (fun (_,_,et) -> Type.type_iseq (clean_t et) (clean_t t)) elist
  525. | (_,_,t) :: arglist, (_,_,et) :: elist when Type.type_iseq (clean_t et) (clean_t t) ->
  526. check_arg arglist elist
  527. | _ -> false
  528. in
  529. match follow applied_f with
  530. | TFun _ ->
  531. replace_mono applied_f;
  532. let args, _ = get_fun applied_f in
  533. let elist = List.rev args in
  534. let rec check_overload overloads =
  535. match overloads with
  536. | (t, cf) :: overloads ->
  537. let cft = apply_params types params t in
  538. let cft = monomorphs cf.cf_params cft in
  539. let args, _ = get_fun cft in
  540. if check_arg (List.rev args) elist then
  541. cf,t,false
  542. else if overloads = [] then
  543. cf,t,true (* no compatible overload was found *)
  544. else
  545. check_overload overloads
  546. | [] -> assert false
  547. in
  548. check_overload overloads
  549. | _ -> match overloads with (* issue #1742 *)
  550. | (t,cf) :: [] -> cf,t,true
  551. | (t,cf) :: _ -> cf,t,false
  552. | _ -> assert false
  553. let choose_ctor gen cl tparams etl maybe_empty_t p =
  554. let ctor, sup, stl = OverloadingConstructor.cur_ctor cl tparams in
  555. (* get returned stl, with Dynamic as t_empty *)
  556. let rec get_changed_stl c tl =
  557. if c == sup then
  558. tl
  559. else match c.cl_super with
  560. | None -> stl
  561. | Some(sup,stl) -> get_changed_stl sup (List.map (apply_params c.cl_params tl) stl)
  562. in
  563. let ret_tparams = List.map (fun t -> match follow t with
  564. | TDynamic _ | TMono _ -> t_empty
  565. | _ -> t) tparams
  566. in
  567. let ret_stl = get_changed_stl cl ret_tparams in
  568. let ctors = ctor :: ctor.cf_overloads in
  569. List.iter replace_mono etl;
  570. (* first filter out or select outright maybe_empty *)
  571. let ctors, is_overload = match etl, maybe_empty_t with
  572. | [t], Some empty_t ->
  573. let count = ref 0 in
  574. let is_empty_call = Type.type_iseq t empty_t in
  575. let ret = List.filter (fun cf -> match follow cf.cf_type with
  576. | TFun([_,_,t],_) ->
  577. replace_mono t; incr count; is_empty_call = (Type.type_iseq t empty_t)
  578. | _ -> false) ctors
  579. in
  580. ret, !count > 1
  581. | _ ->
  582. let len = List.length etl in
  583. let ret = List.filter (fun cf -> List.length (fst (get_fun cf.cf_type)) = len) ctors in
  584. ret, (match ret with | _ :: [] -> false | _ -> true)
  585. in
  586. let rec check_arg arglist elist =
  587. match arglist, elist with
  588. | [], [] -> true
  589. | (_,_,t) :: arglist, et :: elist -> (try
  590. let t = run_follow gen t in
  591. unify et t;
  592. check_arg arglist elist
  593. with | Unify_error el ->
  594. (* List.iter (fun el -> gen.gcon.warning (Typecore.unify_error_msg (print_context()) el) p) el; *)
  595. false)
  596. | _ ->
  597. false
  598. in
  599. let rec check_cf cf =
  600. let t = apply_params sup.cl_params stl cf.cf_type in
  601. replace_mono t;
  602. let args, _ = get_fun t in
  603. check_arg args etl
  604. in
  605. match is_overload, ctors with
  606. | false, [c] ->
  607. false, c, sup, ret_stl
  608. | _ ->
  609. is_overload, List.find check_cf ctors, sup, ret_stl
  610. let change_rest tfun elist =
  611. let rec loop acc arglist elist = match arglist, elist with
  612. | (_,_,TAbstract({ a_path = (["haxe";"extern"],"Rest") },[t])) :: [], elist ->
  613. List.rev (List.map (fun _ -> "rest",false,t) elist @ acc)
  614. | (n,o,t) :: arglist, _ :: elist ->
  615. loop ((n,o,t) :: acc) arglist elist
  616. | _, _ ->
  617. List.rev acc
  618. in
  619. let args,ret = get_fun tfun in
  620. TFun(loop [] args elist, ret)
  621. let fastcast_if_needed gen expr real_to_t real_from_t =
  622. if Common.defined gen.gcon Define.FastCast then begin
  623. if type_iseq gen real_to_t real_from_t then
  624. { expr with etype = real_to_t }
  625. else
  626. mk_castfast real_to_t { expr with etype=real_from_t }
  627. end else
  628. handle_cast gen expr real_to_t real_from_t
  629. (*
  630. Type parameter handling
  631. It will detect if/what type parameters were used, and call the cast handler
  632. It will handle both TCall(TField) and TCall by receiving a texpr option field: e
  633. Also it will transform the type parameters with greal_type_param and make
  634. handle_impossible_tparam - should cases where the type parameter is impossible to be determined from the called parameters be Dynamic?
  635. e.g. static function test<T>():T {}
  636. *)
  637. (* match e.eexpr with | TCall( ({ eexpr = TField(ef, f) }) as e1, elist ) -> *)
  638. let handle_type_parameter gen e e1 ef ~clean_ef ~overloads_cast_to_base f elist calls_parameters_explicitly =
  639. (* the ONLY way to know if this call has parameters is to analyze the calling field. *)
  640. (* To make matters a little worse, on both C# and Java only in some special cases that type parameters will be used *)
  641. (* Namely, when using reflection type parameters are useless, of course. This also includes anonymous types *)
  642. (* this will have to be handled by gparam_func_call *)
  643. let return_var efield =
  644. match e with
  645. | None ->
  646. efield
  647. | Some ecall ->
  648. match follow efield.etype with
  649. | TFun(_,ret) ->
  650. (* closures will be handled by the closure handler. So we will just hint what's the expected type *)
  651. (* FIXME: should closures have also its arguments cast correctly? In the current implementation I think not. TO_REVIEW *)
  652. handle_cast gen { ecall with eexpr = TCall(efield, elist) } (gen.greal_type ecall.etype) ret
  653. | _ ->
  654. { ecall with eexpr = TCall(efield, elist) }
  655. in
  656. (* this function will receive the original function argument, the applied function argument and the original function parameters. *)
  657. (* from this info, it will infer the applied tparams for the function *)
  658. let infer_params pos (original_args:((string * bool * t) list * t)) (applied_args:((string * bool * t) list * t)) (params:(string * t) list) calls_parameters_explicitly : tparams =
  659. match params with
  660. | [] -> []
  661. | _ ->
  662. let args_list args = (if not calls_parameters_explicitly then t_dynamic else snd args) :: (List.map (fun (n,o,t) -> t) (fst args)) in
  663. let monos = List.map (fun _ -> mk_mono()) params in
  664. let original = args_list (get_fun (apply_params params monos (TFun(fst original_args,snd original_args)))) in
  665. let applied = args_list applied_args in
  666. (try
  667. List.iter2 (fun a o ->
  668. unify a o
  669. (* type_eq EqStrict a o *)
  670. ) applied original
  671. (* unify applied original *)
  672. with
  673. | Unify_error el ->
  674. (* List.iter (fun el -> gen.gcon.warning (Typecore.unify_error_msg (print_context()) el) pos) el; *)
  675. gen.gcon.warning ("This expression may be invalid") pos
  676. | Invalid_argument _ ->
  677. gen.gcon.warning ("This expression may be invalid") pos
  678. );
  679. List.map (fun t ->
  680. match follow t with
  681. | TMono _ -> t_empty
  682. | t -> t
  683. ) monos
  684. in
  685. let real_type = gen.greal_type ef.etype in
  686. (* this part was rewritten at roughly r6477 in order to correctly support overloads *)
  687. (match field_access_esp gen real_type (f) with
  688. | FClassField (cl, params, _, cf, is_static, actual_t, declared_t) when e <> None && (cf.cf_kind = Method MethNormal || cf.cf_kind = Method MethInline) ->
  689. (* C# target changes params with a real_type function *)
  690. let params = match follow clean_ef.etype with
  691. | TInst(_,params) -> params
  692. | _ -> params
  693. in
  694. let local_mk_cast t expr =
  695. (* handle_cast gen expr t expr.etype *)
  696. if is_exactly_basic gen t expr.etype then
  697. expr
  698. else
  699. mk_castfast t expr
  700. in
  701. let ecall = get e in
  702. let ef = ref ef in
  703. let is_overload = cf.cf_overloads <> [] || Meta.has Meta.Overload cf.cf_meta || (is_static && is_static_overload cl (field_name f)) in
  704. let cf, actual_t, error = match is_overload with
  705. | false ->
  706. (* since actual_t from FClassField already applies greal_type, we're using the get_overloads helper to get this info *)
  707. let t = if cf.cf_params = [] then (* this if statement must be eliminated - it's a workaround for #3516 + infer params. *)
  708. actual_t
  709. else
  710. declared_t
  711. in
  712. cf,t,false
  713. | true ->
  714. let (cf, actual_t, error), is_static = match f with
  715. | FInstance(c,_,cf) | FClosure(Some (c,_),cf) ->
  716. (* get from overloads *)
  717. (* FIXME: this is a workaround for issue #1743 . Uncomment this code after it was solved *)
  718. (* let t, cf = List.find (fun (t,cf2) -> cf == cf2) (Overloads.get_overloads cl (field_name f)) in *)
  719. (* cf, t, false *)
  720. select_overload gen e1.etype (Overloads.get_overloads cl (field_name f)) cl.cl_params params, false
  721. | FStatic(c,f) ->
  722. (* workaround for issue #1743 *)
  723. (* f,f.cf_type, false *)
  724. select_overload gen e1.etype ((f.cf_type,f) :: List.map (fun f -> f.cf_type,f) f.cf_overloads) [] [], true
  725. | _ ->
  726. gen.gcon.warning "Overloaded classfield typed as anonymous" ecall.epos;
  727. (cf, actual_t, true), true
  728. in
  729. if not (is_static || error) then match find_first_declared_field gen cl ~exact_field:{ cf with cf_type = actual_t } cf.cf_name with
  730. | Some(cf_orig,actual_t,_,_,declared_cl,tl,tlch) ->
  731. let rec is_super e = match e.eexpr with
  732. | TConst TSuper -> true
  733. | TParenthesis p | TMeta(_,p) -> is_super p
  734. | _ -> false
  735. in
  736. if declared_cl != cl && overloads_cast_to_base && not (is_super !ef) then begin
  737. let pos = (!ef).epos in
  738. ef := {
  739. eexpr = TCall(
  740. { eexpr = TIdent "__as__"; etype = t_dynamic; epos = pos },
  741. [!ef]);
  742. etype = TInst(declared_cl,List.map (apply_params cl.cl_params params) tl);
  743. epos = pos
  744. }
  745. end;
  746. { cf_orig with cf_name = cf.cf_name },actual_t,false
  747. | None ->
  748. gen.gcon.warning "Cannot find matching overload" ecall.epos;
  749. cf, actual_t, true
  750. else
  751. cf,actual_t,error
  752. in
  753. (* take off Rest param *)
  754. let actual_t = change_rest actual_t elist in
  755. (* set the real (selected) class field *)
  756. let f = match f with
  757. | FInstance(c,tl,_) -> FInstance(c,tl,cf)
  758. | FClosure(c,_) -> FClosure(c,cf)
  759. | FStatic(c,_) -> FStatic(c,cf)
  760. | f -> f
  761. in
  762. let error = error || (match follow actual_t with | TFun _ -> false | _ -> true) in
  763. if error then (* if error, ignore arguments *)
  764. if ExtType.is_void ecall.etype then
  765. { ecall with eexpr = TCall({ e1 with eexpr = TField(!ef, f) }, elist ) }
  766. else
  767. local_mk_cast ecall.etype { ecall with eexpr = TCall({ e1 with eexpr = TField(!ef, f) }, elist ) }
  768. else begin
  769. (* infer arguments *)
  770. (* let called_t = TFun(List.map (fun e -> "arg",false,e.etype) elist, ecall.etype) in *)
  771. let called_t = match follow e1.etype with | TFun _ -> e1.etype | _ -> TFun(List.map (fun e -> "arg",false,e.etype) elist, ecall.etype) in (* workaround for issue #1742 *)
  772. let called_t = change_rest called_t elist in
  773. let fparams = infer_params ecall.epos (get_fun (apply_params cl.cl_params params actual_t)) (get_fun called_t) cf.cf_params calls_parameters_explicitly in
  774. (* get what the backend actually sees *)
  775. (* actual field's function *)
  776. let actual_t = get_real_fun gen actual_t in
  777. let real_params = gen.greal_type_param (TClassDecl cl) params in
  778. let function_t = apply_params cl.cl_params real_params actual_t in
  779. let real_fparams = if calls_parameters_explicitly then
  780. gen.greal_type_param (TClassDecl cl) fparams
  781. else
  782. gen.greal_type_param (TClassDecl cl) (infer_params ecall.epos (get_fun function_t) (get_fun (get_real_fun gen called_t)) cf.cf_params calls_parameters_explicitly) in
  783. let function_t = get_real_fun gen (apply_params cf.cf_params real_fparams function_t) in
  784. let args_ft, ret_ft = get_fun function_t in
  785. (* applied function *)
  786. let applied = elist in
  787. (* check types list *)
  788. let new_ecall, elist = try
  789. let elist = List.map2 (fun applied (_,_,funct) ->
  790. match is_overload || real_fparams <> [], applied.eexpr with
  791. | true, TConst TNull ->
  792. mk_castfast (gen.greal_type funct) applied
  793. | true, _ -> (* when not (type_iseq gen (gen.greal_type applied.etype) funct) -> *)
  794. let ret = handle_cast gen applied (funct) (gen.greal_type applied.etype) in
  795. (match ret.eexpr with
  796. | TCast _ -> ret
  797. | _ -> local_mk_cast (funct) ret)
  798. | _ ->
  799. handle_cast gen applied (funct) (gen.greal_type applied.etype)
  800. ) applied args_ft in
  801. { ecall with
  802. eexpr = TCall(
  803. { e1 with eexpr = TField(!ef, f) },
  804. elist);
  805. }, elist
  806. with Invalid_argument _ ->
  807. gen.gcon.warning ("This expression may be invalid" ) ecall.epos;
  808. { ecall with eexpr = TCall({ e1 with eexpr = TField(!ef, f) }, elist) }, elist
  809. in
  810. let new_ecall = if fparams <> [] then gen.gparam_func_call new_ecall { e1 with eexpr = TField(!ef, f) } fparams elist else new_ecall in
  811. let ret = handle_cast gen new_ecall (gen.greal_type ecall.etype) (gen.greal_type ret_ft) in
  812. (match gen.gcon.platform, cf.cf_params, ret.eexpr with
  813. | _, _, TCast _ -> ret
  814. | Java, _ :: _, _ ->
  815. (* this is a workaround for a javac openjdk issue with unused type parameters and return type inference *)
  816. (* see more at issue #3123 *)
  817. mk_cast (gen.greal_type ret_ft) new_ecall
  818. | _ -> ret)
  819. end
  820. | FClassField (cl,params,_,{ cf_kind = (Method MethDynamic | Var _) },_,actual_t,_) ->
  821. (* if it's a var, we will just try to apply the class parameters that have been changed with greal_type_param *)
  822. let t = apply_params cl.cl_params (gen.greal_type_param (TClassDecl cl) params) (gen.greal_type actual_t) in
  823. return_var (handle_cast gen { e1 with eexpr = TField(ef, f) } (gen.greal_type e1.etype) (gen.greal_type t))
  824. | FClassField (cl,params,_,cf,_,actual_t,_) ->
  825. return_var (handle_cast gen { e1 with eexpr = TField({ ef with etype = t_dynamic }, f) } e1.etype t_dynamic) (* force dynamic and cast back to needed type *)
  826. | FEnumField (en, efield, true) ->
  827. let ecall = match e with | None -> trace (field_name f); trace efield.ef_name; gen.gcon.error "This field should be called immediately" ef.epos; assert false | Some ecall -> ecall in
  828. (match en.e_params with
  829. (*
  830. | [] ->
  831. let args, ret = get_fun (efield.ef_type) in
  832. let ef = { ef with eexpr = TTypeExpr( TEnumDecl en ); etype = TEnum(en, []) } in
  833. handle_cast gen { ecall with eexpr = TCall({ e1 with eexpr = TField(ef, FEnum(en, efield)) }, List.map2 (fun param (_,_,t) -> handle_cast gen param (gen.greal_type t) (gen.greal_type param.etype)) elist args) } (gen.greal_type ecall.etype) (gen.greal_type ret)
  834. *)
  835. | _ ->
  836. let pt = match e with | None -> real_type | Some _ -> snd (get_fun e1.etype) in
  837. let _params = match follow pt with | TEnum(_, p) -> p | _ -> gen.gcon.warning (debug_expr e1) e1.epos; assert false in
  838. let args, ret = get_fun efield.ef_type in
  839. let actual_t = TFun(List.map (fun (n,o,t) -> (n,o,gen.greal_type t)) args, gen.greal_type ret) in
  840. (*
  841. because of differences on how <Dynamic> is handled on the platforms, this is a hack to be able to
  842. correctly use class field type parameters with RealTypeParams
  843. *)
  844. let cf_params = List.map (fun t -> match follow t with | TDynamic _ -> t_empty | _ -> t) _params in
  845. let t = apply_params en.e_params (gen.greal_type_param (TEnumDecl en) cf_params) actual_t in
  846. let t = apply_params efield.ef_params (List.map (fun _ -> t_dynamic) efield.ef_params) t in
  847. let args, ret = get_fun t in
  848. let elist = List.map2 (fun param (_,_,t) -> handle_cast gen (param) (gen.greal_type t) (gen.greal_type param.etype)) elist args in
  849. let e1 = { e1 with eexpr = TField({ ef with eexpr = TTypeExpr( TEnumDecl en ); etype = TEnum(en, _params) }, FEnum(en, efield) ) } in
  850. let new_ecall = gen.gparam_func_call ecall e1 _params elist in
  851. handle_cast gen new_ecall (gen.greal_type ecall.etype) (gen.greal_type ret)
  852. )
  853. | FEnumField _ when is_some e -> assert false
  854. | FEnumField (en,efield,_) ->
  855. return_var { e1 with eexpr = TField({ ef with eexpr = TTypeExpr( TEnumDecl en ); },FEnum(en,efield)) }
  856. (* no target by date will uses this.so this code may not be correct at all *)
  857. | FAnonField cf ->
  858. let t = gen.greal_type cf.cf_type in
  859. return_var (handle_cast gen { e1 with eexpr = TField(ef, f) } (gen.greal_type e1.etype) t)
  860. | FNotFound
  861. | FDynamicField _ ->
  862. if is_some e then
  863. return_var { e1 with eexpr = TField(ef, f) }
  864. else
  865. return_var (handle_cast gen { e1 with eexpr = TField({ ef with etype = t_dynamic }, f) } e1.etype t_dynamic) (* force dynamic and cast back to needed type *)
  866. )
  867. (* end of type parameter handling *)
  868. (* ****************************** *)
  869. (** overloads_cast_to_base argument will cast overloaded function types to the class that declared it. **)
  870. (** This is necessary for C#, and if true, will require the target to implement __as__, as a `quicker` form of casting **)
  871. let configure gen ?(overloads_cast_to_base = false) maybe_empty_t calls_parameters_explicitly =
  872. let handle e t1 t2 = handle_cast gen e (gen.greal_type t1) (gen.greal_type t2) in
  873. let in_value = ref false in
  874. let rec clean_cast e = match e.eexpr with
  875. | TCast(e,_) -> clean_cast e
  876. | TParenthesis(e) | TMeta(_,e) -> clean_cast e
  877. | _ -> e
  878. in
  879. let get_abstract_impl t = match t with
  880. | TAbstract(a,pl) when not (Meta.has Meta.CoreType a.a_meta) ->
  881. Abstract.get_underlying_type a pl
  882. | t -> t
  883. in
  884. let rec is_abstract_to_struct t = match t with
  885. | TAbstract(a,pl) when not (Meta.has Meta.CoreType a.a_meta) ->
  886. is_abstract_to_struct (Abstract.get_underlying_type a pl)
  887. | TInst(c,_) when Meta.has Meta.Struct c.cl_meta ->
  888. true
  889. | _ -> false
  890. in
  891. let binop_type op main_expr e1 e2 =
  892. let name = platform_name gen.gcon.platform in
  893. let basic = gen.gcon.basic in
  894. (* If either operand is of type decimal, the other operand is converted to type decimal, or a compile-time error occurs if the other operand is of type float or double.
  895. * Otherwise, if either operand is of type double, the other operand is converted to type double.
  896. * Otherwise, if either operand is of type float, the other operand is converted to type float.
  897. * Otherwise, if either operand is of type ulong, the other operand is converted to type ulong, or a compile-time error occurs if the other operand is of type sbyte, short, int, or long.
  898. * Otherwise, if either operand is of type long, the other operand is converted to type long.
  899. * Otherwise, if either operand is of type uint and the other operand is of type sbyte, short, or int, both operands are converted to type long.
  900. * Otherwise, if either operand is of type uint, the other operand is converted to type uint.
  901. * Otherwise, both operands are converted to type int.
  902. * *)
  903. let t1, t2 = follow (run_follow gen e1.etype), follow (run_follow gen e2.etype) in
  904. match t1, t2 with
  905. | TAbstract(a1,[]), TAbstract(a2,[]) when a1 == a2 ->
  906. { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype }
  907. | TInst(i1,[]), TInst(i2,[]) when i1 == i2 ->
  908. { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype }
  909. | TInst({ cl_path = ([],"String") },[]), _ when op = OpAdd ->
  910. { main_expr with eexpr = TBinop(op, e1, mk_cast basic.tstring e2); etype = basic.tstring }
  911. | _, TInst({ cl_path = ([],"String") },[]) when op = OpAdd ->
  912. { main_expr with eexpr = TBinop(op, mk_cast basic.tstring e1, e2); etype = basic.tstring }
  913. | TAbstract({ a_path = ([], "Float") }, []), _ ->
  914. { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype }
  915. | _, TAbstract({ a_path = ([], "Float") }, []) ->
  916. { main_expr with eexpr = TBinop(op, e1, e2); etype = e2.etype }
  917. | TAbstract({ a_path = ([], "Single") }, []), _ ->
  918. { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype }
  919. | _, TAbstract({ a_path = ([], "Single") }, []) ->
  920. { main_expr with eexpr = TBinop(op, e1, e2); etype = e2.etype }
  921. | TAbstract({ a_path = ([pf], "UInt64") }, []), _ when pf = name ->
  922. { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype }
  923. | _, TAbstract({ a_path = ([pf], "UInt64") }, []) when pf = name ->
  924. { main_expr with eexpr = TBinop(op, e1, e2); etype = e2.etype }
  925. | TAbstract({ a_path = ([pf], "Int64") }, []), _ when pf = name ->
  926. { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype }
  927. | _, TAbstract({ a_path = ([pf], "Int64") }, []) when pf = name ->
  928. { main_expr with eexpr = TBinop(op, e1, e2); etype = e2.etype }
  929. | TAbstract({ a_path = ([], "UInt") }, []), tother when like_int tother ->
  930. let ti64 = mt_to_t_dyn ( get_type gen ([name], "Int64") ) in
  931. let ret = { main_expr with eexpr = TBinop(op, e1, e2); etype = ti64 } in
  932. if op <> OpDiv then
  933. mk_cast t1 ret
  934. else
  935. ret
  936. | tother, TAbstract({ a_path = ([], "UInt") }, []) when like_int tother ->
  937. let ti64 = mt_to_t_dyn ( get_type gen ([name], "Int64") ) in
  938. let ret = { main_expr with eexpr = TBinop(op, e1, e2); etype = ti64 } in
  939. if op <> OpDiv then
  940. mk_cast t2 ret
  941. else
  942. ret
  943. | TAbstract({ a_path = ([], "UInt") }, []), _ ->
  944. { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype }
  945. | _, TAbstract({ a_path = ([], "UInt") }, []) ->
  946. { main_expr with eexpr = TBinop(op, e1, e2); etype = e2.etype }
  947. | TAbstract(a1,[]), TAbstract(a2,[]) ->
  948. { main_expr with eexpr = TBinop(op, e1, e2); etype = basic.tint }
  949. | _ ->
  950. { main_expr with eexpr = TBinop(op, e1, e2) }
  951. in
  952. let binop_type = if Common.defined gen.gcon Define.FastCast then
  953. binop_type
  954. else
  955. fun op main_expr e1 e2 -> { main_expr with eexpr = TBinop(op, e1, e2) }
  956. in
  957. let rec run ?(just_type = false) e =
  958. let handle = if not just_type then handle else fun e t1 t2 -> { e with etype = gen.greal_type t2 } in
  959. let was_in_value = !in_value in
  960. in_value := true;
  961. match e.eexpr with
  962. | TConst ( TInt _ | TFloat _ | TBool _ as const ) ->
  963. (* take off any Null<> that it may have *)
  964. let t = follow (run_follow gen e.etype) in
  965. (* do not allow constants typed as Single - need to cast them *)
  966. let real_t = match const with
  967. | TInt _ -> gen.gcon.basic.tint
  968. | TFloat _ -> gen.gcon.basic.tfloat
  969. | TBool _ -> gen.gcon.basic.tbool
  970. | _ -> assert false
  971. in
  972. handle e t real_t
  973. | TCast( { eexpr = TConst TNull }, _ ) ->
  974. { e with eexpr = TConst TNull }
  975. | TCast( { eexpr = TCall( { eexpr = TIdent "__delegate__" } as local, [del] ) } as e2, _) ->
  976. { e with eexpr = TCast({ e2 with eexpr = TCall(local, [Type.map_expr run del]) }, None) }
  977. | TBinop ( (Ast.OpAssign | Ast.OpAssignOp _ as op), e1, e2 ) ->
  978. let e1 = run ~just_type:true e1 in
  979. let e2 = handle (run e2) e1.etype e2.etype in
  980. { e with eexpr = TBinop(op, clean_cast e1, e2) }
  981. | TBinop ( (Ast.OpShl | Ast.OpShr | Ast.OpUShr as op), e1, e2 ) ->
  982. let e1 = run e1 in
  983. let e2 = handle (run e2) (gen.gcon.basic.tint) e2.etype in
  984. let rett = binop_type op e e1 e2 in
  985. { e with eexpr = TBinop(op, e1, e2); etype = rett.etype }
  986. | TBinop( (OpAdd | OpMult | OpDiv | OpSub | OpAnd | OpOr | OpXor | OpMod) as op, e1, e2 ) ->
  987. binop_type op e (run e1) (run e2)
  988. | TBinop( (OpEq | OpNotEq | OpGt | OpGte | OpLt | OpLte | OpBoolAnd | OpBoolOr) as op, e1, e2 ) ->
  989. handle { e with eexpr = TBinop(op, run e1, run e2) } e.etype gen.gcon.basic.tbool
  990. | TField(ef, f) ->
  991. handle_type_parameter gen None e (run ef) ~clean_ef:ef ~overloads_cast_to_base:overloads_cast_to_base f [] calls_parameters_explicitly
  992. | TArrayDecl el ->
  993. let et = e.etype in
  994. let base_type = match follow et with
  995. | TInst({ cl_path = ([], "Array") } as cl, bt) -> gen.greal_type_param (TClassDecl cl) bt
  996. | _ ->
  997. gen.gcon.warning (debug_type et) e.epos;
  998. (match gen.gcurrent_class with
  999. | Some cl -> print_endline (s_type_path cl.cl_path)
  1000. | _ -> ());
  1001. assert false
  1002. in
  1003. let base_type = List.hd base_type in
  1004. { e with eexpr = TArrayDecl( List.map (fun e -> handle (run e) base_type e.etype) el ); etype = et }
  1005. | TCall ({ eexpr = TIdent "__array__" } as arr_local, el) ->
  1006. let et = e.etype in
  1007. let base_type = match follow et with
  1008. | TInst(cl, bt) -> gen.greal_type_param (TClassDecl cl) bt
  1009. | _ -> assert false
  1010. in
  1011. let base_type = List.hd base_type in
  1012. { e with eexpr = TCall(arr_local, List.map (fun e -> handle (run e) base_type e.etype) el ); etype = et }
  1013. | TCall( ({ eexpr = TIdent s } as local), params ) when String.get s 0 = '_' && String.get s 1 = '_' && Hashtbl.mem gen.gspecial_vars s ->
  1014. { e with eexpr = TCall(local, List.map (fun e -> (match e.eexpr with TBlock _ -> in_value := false | _ -> ()); run e) params) }
  1015. | TCall( ({ eexpr = TField(ef, f) }) as e1, elist ) ->
  1016. handle_type_parameter gen (Some e) (e1) (run ef) ~clean_ef:ef ~overloads_cast_to_base:overloads_cast_to_base f (List.map run elist) calls_parameters_explicitly
  1017. | TCall( { eexpr = TConst TSuper } as ef, eparams ) ->
  1018. let cl, tparams = match follow ef.etype with
  1019. | TInst(cl,p) ->
  1020. cl,p
  1021. | _ -> assert false in
  1022. (try
  1023. let is_overload, cf, sup, stl = choose_ctor gen cl tparams (List.map (fun e -> e.etype) eparams) maybe_empty_t e.epos in
  1024. let handle e t1 t2 =
  1025. if is_overload then
  1026. let ret = handle e t1 t2 in
  1027. match ret.eexpr with
  1028. | TCast _ -> ret
  1029. | _ -> mk_cast (gen.greal_type t1) e
  1030. else
  1031. handle e t1 t2
  1032. in
  1033. let stl = gen.greal_type_param (TClassDecl sup) stl in
  1034. let args, _ = get_fun (apply_params sup.cl_params stl cf.cf_type) in
  1035. let eparams = List.map2 (fun e (_,_,t) ->
  1036. handle (run e) t e.etype
  1037. ) eparams args in
  1038. { e with eexpr = TCall(ef, eparams) }
  1039. with | Not_found ->
  1040. gen.gcon.warning "No overload found for this constructor call" e.epos;
  1041. { e with eexpr = TCall(ef, List.map run eparams) })
  1042. | TCall (ef, eparams) ->
  1043. (match ef.etype with
  1044. | TFun(p, ret) ->
  1045. handle ({ e with eexpr = TCall(run ef, List.map2 (fun param (_,_,t) -> handle (run param) t param.etype) eparams p) }) e.etype ret
  1046. | _ -> Type.map_expr run e
  1047. )
  1048. | TNew ({ cl_kind = KTypeParameter _ }, _, _) ->
  1049. Type.map_expr run e
  1050. | TNew (cl, tparams, eparams) -> (try
  1051. let is_overload, cf, sup, stl = choose_ctor gen cl tparams (List.map (fun e -> e.etype) eparams) maybe_empty_t e.epos in
  1052. let handle e t1 t2 =
  1053. if is_overload then
  1054. let ret = handle e t1 t2 in
  1055. match ret.eexpr with
  1056. | TCast _ -> ret
  1057. | _ -> mk_cast (gen.greal_type t1) e
  1058. else
  1059. handle e t1 t2
  1060. in
  1061. let stl = gen.greal_type_param (TClassDecl sup) stl in
  1062. let args, _ = get_fun (apply_params sup.cl_params stl cf.cf_type) in
  1063. let eparams = List.map2 (fun e (_,_,t) ->
  1064. handle (run e) t e.etype
  1065. ) eparams args in
  1066. { e with eexpr = TNew(cl, tparams, eparams) }
  1067. with | Not_found ->
  1068. gen.gcon.warning "No overload found for this constructor call" e.epos;
  1069. { e with eexpr = TNew(cl, tparams, List.map run eparams) })
  1070. | TArray(arr, idx) ->
  1071. let arr_etype = match follow arr.etype with
  1072. | (TInst _ as t) -> t
  1073. | TAbstract (a, pl) when not (Meta.has Meta.CoreType a.a_meta) ->
  1074. follow (Abstract.get_underlying_type a pl)
  1075. | t -> t
  1076. in
  1077. let idx = run idx in
  1078. let idx = match gen.greal_type idx.etype with
  1079. | TAbstract({ a_path = [],"Int" },_) -> idx
  1080. | _ -> match handle idx gen.gcon.basic.tint (gen.greal_type idx.etype) with
  1081. | ({ eexpr = TCast _ } as idx) -> idx
  1082. | idx -> mk_cast gen.gcon.basic.tint idx
  1083. in
  1084. let e = { e with eexpr = TArray(run arr, idx) } in
  1085. (* get underlying class (if it's a class *)
  1086. (match arr_etype with
  1087. | TInst(cl, params) ->
  1088. (* see if it implements ArrayAccess *)
  1089. (match cl.cl_array_access with
  1090. | None -> e
  1091. | Some t ->
  1092. (* if it does, apply current parameters (and change them) *)
  1093. (* let real_t = apply_params_internal (List.map (gen.greal_type_param (TClassDecl cl))) cl params t in *)
  1094. let param = apply_params cl.cl_params (gen.greal_type_param (TClassDecl cl) params) t in
  1095. let real_t = apply_params cl.cl_params params param in
  1096. (* see if it needs a cast *)
  1097. fastcast_if_needed gen e (gen.greal_type e.etype) (gen.greal_type real_t)
  1098. (* handle (e) (gen.greal_type e.etype) (gen.greal_type real_t) *)
  1099. )
  1100. | _ -> Type.map_expr run e)
  1101. | TVar (v, eopt) ->
  1102. { e with eexpr = TVar (v, match eopt with
  1103. | None -> eopt
  1104. | Some e -> Some( handle (run e) v.v_type e.etype ))
  1105. }
  1106. (* FIXME deal with in_value when using other statements that may not have a TBlock wrapped on them *)
  1107. | TIf (econd, ethen, Some(eelse)) when was_in_value ->
  1108. { e with eexpr = TIf (handle (run econd) gen.gcon.basic.tbool econd.etype, handle (run ethen) e.etype ethen.etype, Some( handle (run eelse) e.etype eelse.etype ) ) }
  1109. | TIf (econd, ethen, eelse) ->
  1110. { e with eexpr = TIf (handle (run econd) gen.gcon.basic.tbool econd.etype, (in_value := false; run (mk_block ethen)), Option.map (fun e -> in_value := false; run (mk_block e)) eelse) }
  1111. | TWhile (econd, e1, flag) ->
  1112. { e with eexpr = TWhile (handle (run econd) gen.gcon.basic.tbool econd.etype, (in_value := false; run (mk_block e1)), flag) }
  1113. | TSwitch (cond, el_e_l, edef) ->
  1114. { e with eexpr = TSwitch(run cond, List.map (fun (el,e) -> (List.map run el, (in_value := false; run (mk_block e)))) el_e_l, Option.map (fun e -> in_value := false; run (mk_block e)) edef) }
  1115. | TFor (v,cond,e1) ->
  1116. { e with eexpr = TFor(v, run cond, (in_value := false; run (mk_block e1))) }
  1117. | TTry (e, ve_l) ->
  1118. { e with eexpr = TTry((in_value := false; run (mk_block e)), List.map (fun (v,e) -> in_value := false; (v, run (mk_block e))) ve_l) }
  1119. | TBlock el ->
  1120. let i = ref 0 in
  1121. let len = List.length el in
  1122. { e with eexpr = TBlock ( List.map (fun e ->
  1123. incr i;
  1124. if !i <> len || not was_in_value then
  1125. in_value := false;
  1126. run e
  1127. ) el ) }
  1128. | TCast (expr, md) when ExtType.is_void (follow e.etype) ->
  1129. run expr
  1130. | TCast (expr, md) ->
  1131. let rec get_null e =
  1132. match e.eexpr with
  1133. | TConst TNull -> Some e
  1134. | TParenthesis e | TMeta(_,e) -> get_null e
  1135. | _ -> None
  1136. in
  1137. (match get_null expr with
  1138. | Some enull ->
  1139. if gen.gcon.platform = Cs then
  1140. { enull with etype = gen.greal_type e.etype }
  1141. else
  1142. mk_cast (gen.greal_type e.etype) enull
  1143. | _ when is_abstract_to_struct expr.etype && type_iseq gen e.etype (get_abstract_impl expr.etype) ->
  1144. run { expr with etype = expr.etype }
  1145. | _ when is_exactly_basic gen expr.etype e.etype ->
  1146. run { expr with etype = expr.etype }
  1147. | _ ->
  1148. match gen.greal_type e.etype, gen.greal_type expr.etype with
  1149. | (TInst(c,tl) as tinst1), TAbstract({ a_path = ["cs"],"Pointer" }, [tinst2]) when type_iseq gen tinst1 (gen.greal_type tinst2) ->
  1150. run expr
  1151. | _ ->
  1152. let expr = run expr in
  1153. let last_unsafe = gen.gon_unsafe_cast in
  1154. gen.gon_unsafe_cast <- (fun t t2 pos -> ());
  1155. let ret = handle expr e.etype expr.etype in
  1156. gen.gon_unsafe_cast <- last_unsafe;
  1157. match ret.eexpr with
  1158. | TCast _ -> { ret with etype = gen.greal_type e.etype }
  1159. | _ -> { e with eexpr = TCast(ret,md); etype = gen.greal_type e.etype }
  1160. )
  1161. (*| TCast _ ->
  1162. (* if there is already a cast, we should skip this cast check *)
  1163. Type.map_expr run e*)
  1164. | TFunction f ->
  1165. in_value := false;
  1166. Type.map_expr run e
  1167. | _ -> Type.map_expr run e
  1168. in
  1169. gen.ghandle_cast <- (fun tto tfrom expr -> handle_cast gen expr (gen.greal_type tto) (gen.greal_type tfrom));
  1170. let map e =
  1171. match gen.gcurrent_classfield with
  1172. | Some cf when Meta.has (Meta.Custom ":skipCastDetect") cf.cf_meta ->
  1173. e
  1174. | _ ->
  1175. run e
  1176. in
  1177. gen.gsyntax_filters#add name (PCustom priority) map;
  1178. ReturnCast.configure gen