gencs.ml 93 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349
  1. (*
  2. * Copyright (C)2005-2013 Haxe Foundation
  3. *
  4. * Permission is hereby granted, free of charge, to any person obtaining a
  5. * copy of this software and associated documentation files (the "Software"),
  6. * to deal in the Software without restriction, including without limitation
  7. * the rights to use, copy, modify, merge, publish, distribute, sublicense,
  8. * and/or sell copies of the Software, and to permit persons to whom the
  9. * Software is furnished to do so, subject to the following conditions:
  10. *
  11. * The above copyright notice and this permission notice shall be included in
  12. * all copies or substantial portions of the Software.
  13. *
  14. * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  15. * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  16. * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  17. * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  18. * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  19. * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  20. * DEALINGS IN THE SOFTWARE.
  21. *)
  22. open Gencommon.ReflectionCFs
  23. open Ast
  24. open Common
  25. open Gencommon
  26. open Gencommon.SourceWriter
  27. open Type
  28. open Printf
  29. open Option
  30. let is_cs_basic_type t =
  31. match follow t with
  32. | TInst( { cl_path = (["haxe"], "Int32") }, [] )
  33. | TInst( { cl_path = (["haxe"], "Int64") }, [] )
  34. | TInst( { cl_path = ([], "Int") }, [] )
  35. | TAbstract ({ a_path = ([], "Int") },[])
  36. | TInst( { cl_path = ([], "Float") }, [] )
  37. | TAbstract ({ a_path = ([], "Float") },[])
  38. | TEnum( { e_path = ([], "Bool") }, [] )
  39. | TAbstract ({ a_path = ([], "Bool") },[]) ->
  40. true
  41. | TAbstract _ when like_float t ->
  42. true
  43. | TEnum(e, _) when not (Meta.has Meta.Class e.e_meta) -> true
  44. | TInst(cl, _) when Meta.has Meta.Struct cl.cl_meta -> true
  45. | _ -> false
  46. (* see http://msdn.microsoft.com/en-us/library/2sk3x8a7(v=vs.71).aspx *)
  47. let cs_binops =
  48. [Ast.OpAdd, "op_Addition";
  49. Ast.OpSub, "op_Subtraction";
  50. Ast.OpMult, "op_Multiply";
  51. Ast.OpDiv, "op_Division";
  52. Ast.OpMod, "op_Modulus";
  53. Ast.OpXor, "op_ExclusiveOr";
  54. Ast.OpOr, "op_BitwiseOr";
  55. Ast.OpAnd, "op_BitwiseAnd";
  56. Ast.OpBoolAnd, "op_LogicalAnd";
  57. Ast.OpBoolOr, "op_LogicalOr";
  58. Ast.OpAssign, "op_Assign";
  59. Ast.OpShl, "op_LeftShift";
  60. Ast.OpShr, "op_RightShift";
  61. Ast.OpShr, "op_SignedRightShift";
  62. Ast.OpUShr, "op_UnsignedRightShift";
  63. Ast.OpEq, "op_Equality";
  64. Ast.OpGt, "op_GreaterThan";
  65. Ast.OpLt, "op_LessThan";
  66. Ast.OpNotEq, "op_Inequality";
  67. Ast.OpGte, "op_GreaterThanOrEqual";
  68. Ast.OpLte, "op_LessThanOrEqual";
  69. Ast.OpAssignOp Ast.OpMult, "op_MultiplicationAssignment";
  70. Ast.OpAssignOp Ast.OpSub, "op_SubtractionAssignment";
  71. Ast.OpAssignOp Ast.OpXor, "op_ExclusiveOrAssignment";
  72. Ast.OpAssignOp Ast.OpShl, "op_LeftShiftAssignment";
  73. Ast.OpAssignOp Ast.OpMod, "op_ModulusAssignment";
  74. Ast.OpAssignOp Ast.OpAdd, "op_AdditionAssignment";
  75. Ast.OpAssignOp Ast.OpAnd, "op_BitwiseAndAssignment";
  76. Ast.OpAssignOp Ast.OpOr, "op_BitwiseOrAssignment";
  77. (* op_Comma *)
  78. Ast.OpAssignOp Ast.OpDiv, "op_DivisionAssignment";]
  79. let cs_unops =
  80. [Ast.Decrement, "op_Decrement";
  81. Ast.Increment, "op_Increment";
  82. Ast.Not, "op_UnaryNegation";
  83. Ast.Neg, "op_UnaryMinus";
  84. Ast.NegBits, "op_OnesComplement"]
  85. let binops_names = List.fold_left (fun acc (op,n) -> PMap.add n op acc) PMap.empty cs_binops
  86. let unops_names = List.fold_left (fun acc (op,n) -> PMap.add n op acc) PMap.empty cs_unops
  87. let get_item = "get_Item"
  88. let set_item = "set_Item"
  89. let is_tparam t =
  90. match follow t with
  91. | TInst( { cl_kind = KTypeParameter _ }, [] ) -> true
  92. | _ -> false
  93. let rec is_int_float t =
  94. match follow t with
  95. | TInst( { cl_path = (["haxe"], "Int32") }, [] )
  96. | TInst( { cl_path = (["haxe"], "Int64") }, [] )
  97. | TInst( { cl_path = ([], "Int") }, [] )
  98. | TAbstract ({ a_path = ([], "Int") },[])
  99. | TInst( { cl_path = ([], "Float") }, [] )
  100. | TAbstract ({ a_path = ([], "Float") },[]) ->
  101. true
  102. | TAbstract _ when like_float t ->
  103. true
  104. | TInst( { cl_path = (["haxe"; "lang"], "Null") }, [t] ) -> is_int_float t
  105. | _ -> false
  106. let rec is_null t =
  107. match t with
  108. | TInst( { cl_path = (["haxe"; "lang"], "Null") }, _ )
  109. | TType( { t_path = ([], "Null") }, _ ) -> true
  110. | TType( t, tl ) -> is_null (apply_params t.t_types tl t.t_type)
  111. | TMono r ->
  112. (match !r with
  113. | Some t -> is_null t
  114. | _ -> false)
  115. | TLazy f ->
  116. is_null (!f())
  117. | _ -> false
  118. let parse_explicit_iface =
  119. let regex = Str.regexp "\\." in
  120. let parse_explicit_iface str =
  121. let split = Str.split regex str in
  122. let rec get_iface split pack =
  123. match split with
  124. | clname :: fn_name :: [] -> fn_name, (List.rev pack, clname)
  125. | pack_piece :: tl -> get_iface tl (pack_piece :: pack)
  126. | _ -> assert false
  127. in
  128. get_iface split []
  129. in parse_explicit_iface
  130. let is_string t =
  131. match follow t with
  132. | TInst( { cl_path = ([], "String") }, [] ) -> true
  133. | _ -> false
  134. (* ******************************************* *)
  135. (* CSharpSpecificESynf *)
  136. (* ******************************************* *)
  137. (*
  138. Some CSharp-specific syntax filters that must run before ExpressionUnwrap
  139. dependencies:
  140. It must run before ExprUnwrap, as it may not return valid Expr/Statement expressions
  141. It must run before ClassInstance, as it will detect expressions that need unchanged TTypeExpr
  142. *)
  143. module CSharpSpecificESynf =
  144. struct
  145. let name = "csharp_specific_e"
  146. let priority = solve_deps name [DBefore ExpressionUnwrap.priority; DBefore ClassInstance.priority; DAfter TryCatchWrapper.priority]
  147. let get_cl_from_t t =
  148. match follow t with
  149. | TInst(cl,_) -> cl
  150. | _ -> assert false
  151. let traverse gen runtime_cl =
  152. let basic = gen.gcon.basic in
  153. let uint = match get_type gen ([], "UInt") with | TTypeDecl t -> TType(t, []) | TAbstractDecl a -> TAbstract(a, []) | _ -> assert false in
  154. let is_var = alloc_var "__is__" t_dynamic in
  155. let rec run e =
  156. match e.eexpr with
  157. (* Std.is() *)
  158. | TCall(
  159. { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = "is" })) },
  160. [ obj; { eexpr = TTypeExpr(TClassDecl { cl_path = [], "Dynamic" } | TAbstractDecl { a_path = [], "Dynamic" }) }]
  161. ) ->
  162. Type.map_expr run e
  163. | TCall(
  164. { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = "is"}) ) },
  165. [ obj; { eexpr = TTypeExpr(md) }]
  166. ) ->
  167. let mk_is obj md =
  168. { e with eexpr = TCall( { eexpr = TLocal is_var; etype = t_dynamic; epos = e.epos }, [
  169. obj;
  170. { eexpr = TTypeExpr md; etype = t_dynamic (* this is after all a syntax filter *); epos = e.epos }
  171. ] ) }
  172. in
  173. let obj = run obj in
  174. (match follow_module follow md with
  175. | TClassDecl{ cl_path = ([], "Float") } ->
  176. (* on the special case of seeing if it is a Float, we need to test if both it is a float and if it is an Int *)
  177. let mk_is local =
  178. mk_paren {
  179. eexpr = TBinop(Ast.OpBoolOr, mk_is local md, mk_is local (TClassDecl (get_cl_from_t basic.tint)));
  180. etype = basic.tbool;
  181. epos = e.epos
  182. }
  183. in
  184. let ret = match obj.eexpr with
  185. | TLocal(v) -> mk_is obj
  186. | _ ->
  187. let var = mk_temp gen "is" obj.etype in
  188. let added = { obj with eexpr = TVars([var, Some(obj)]); etype = basic.tvoid } in
  189. let local = mk_local var obj.epos in
  190. {
  191. eexpr = TBlock([ added; mk_is local ]);
  192. etype = basic.tbool;
  193. epos = e.epos
  194. }
  195. in
  196. ret
  197. | TClassDecl{ cl_path = ([], "Int") } ->
  198. {
  199. eexpr = TCall(
  200. mk_static_field_access_infer runtime_cl "isInt" e.epos [],
  201. [ obj ]
  202. );
  203. etype = basic.tbool;
  204. epos = e.epos
  205. }
  206. | _ ->
  207. mk_is obj md
  208. )
  209. (* end Std.is() *)
  210. | TBinop( Ast.OpUShr, e1, e2 ) ->
  211. mk_cast e.etype { e with eexpr = TBinop( Ast.OpShr, mk_cast uint (run e1), run e2 ) }
  212. | TBinop( Ast.OpAssignOp Ast.OpUShr, e1, e2 ) ->
  213. let mk_ushr local =
  214. { e with eexpr = TBinop(Ast.OpAssign, local, run { e with eexpr = TBinop(Ast.OpUShr, local, run e2) }) }
  215. in
  216. let mk_local obj =
  217. let var = mk_temp gen "opUshr" obj.etype in
  218. let added = { obj with eexpr = TVars([var, Some(obj)]); etype = basic.tvoid } in
  219. let local = mk_local var obj.epos in
  220. local, added
  221. in
  222. let e1 = run e1 in
  223. let ret = match e1.eexpr with
  224. | TField({ eexpr = TLocal _ }, _)
  225. | TField({ eexpr = TTypeExpr _ }, _)
  226. | TArray({ eexpr = TLocal _ }, _)
  227. | TLocal(_) ->
  228. mk_ushr e1
  229. | TField(fexpr, field) ->
  230. let local, added = mk_local fexpr in
  231. { e with eexpr = TBlock([ added; mk_ushr { e1 with eexpr = TField(local, field) } ]); }
  232. | TArray(ea1, ea2) ->
  233. let local, added = mk_local ea1 in
  234. { e with eexpr = TBlock([ added; mk_ushr { e1 with eexpr = TArray(local, ea2) } ]); }
  235. | _ -> (* invalid left-side expression *)
  236. assert false
  237. in
  238. ret
  239. | _ -> Type.map_expr run e
  240. in
  241. run
  242. let configure gen (mapping_func:texpr->texpr) =
  243. let map e = Some(mapping_func e) in
  244. gen.gsyntax_filters#add ~name:name ~priority:(PCustom priority) map
  245. end;;
  246. (* ******************************************* *)
  247. (* CSharpSpecificSynf *)
  248. (* ******************************************* *)
  249. (*
  250. Some CSharp-specific syntax filters that can run after ExprUnwrap
  251. dependencies:
  252. Runs after ExprUnwrap
  253. *)
  254. module CSharpSpecificSynf =
  255. struct
  256. let name = "csharp_specific"
  257. let priority = solve_deps name [ DAfter ExpressionUnwrap.priority; DAfter ObjectDeclMap.priority; DAfter ArrayDeclSynf.priority; DAfter HardNullableSynf.priority ]
  258. let get_cl_from_t t =
  259. match follow t with
  260. | TInst(cl,_) -> cl
  261. | _ -> assert false
  262. let is_tparam t =
  263. match follow t with
  264. | TInst( { cl_kind = KTypeParameter _ }, _ ) -> true
  265. | _ -> false
  266. let traverse gen runtime_cl =
  267. let basic = gen.gcon.basic in
  268. let tchar = match ( get_type gen (["cs"], "Char16") ) with | TTypeDecl t -> t | _ -> assert false in
  269. let tchar = TType(tchar,[]) in
  270. let string_ext = get_cl ( get_type gen (["haxe";"lang"], "StringExt")) in
  271. let is_string t = match follow t with | TInst({ cl_path = ([], "String") }, []) -> true | _ -> false in
  272. let clstring = match basic.tstring with | TInst(cl,_) -> cl | _ -> assert false in
  273. let is_struct t = (* not basic type *)
  274. match follow t with
  275. | TInst(cl, _) when Meta.has Meta.Struct cl.cl_meta -> true
  276. | _ -> false
  277. in
  278. let is_cl t = match gen.greal_type t with | TInst ( { cl_path = (["System"], "Type") }, [] ) -> true | _ -> false in
  279. let rec run e =
  280. match e.eexpr with
  281. (* Std.int() *)
  282. | TCall(
  283. { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = "int" }) ) },
  284. [obj]
  285. ) ->
  286. run (mk_cast basic.tint obj)
  287. (* end Std.int() *)
  288. (* TODO: change cf_name *)
  289. | TField(ef, FInstance({ cl_path = [], "String" }, { cf_name = "length" })) ->
  290. { e with eexpr = TField(run ef, FDynamic "Length") }
  291. | TField(ef, FInstance({ cl_path = [], "String" }, { cf_name = "toLowerCase" })) ->
  292. { e with eexpr = TField(run ef, FDynamic "ToLower") }
  293. | TField(ef, FInstance({ cl_path = [], "String" }, { cf_name = "toUpperCase" })) ->
  294. { e with eexpr = TField(run ef, FDynamic "ToUpper") }
  295. | TCall( { eexpr = TField(_, FStatic({ cl_path = [], "String" }, { cf_name = "fromCharCode" })) }, [cc] ) ->
  296. { e with eexpr = TNew(get_cl_from_t basic.tstring, [], [mk_cast tchar (run cc); mk_int gen 1 cc.epos]) }
  297. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, { cf_name = ("charAt" as field) })) }, args )
  298. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, { cf_name = ("charCodeAt" as field) })) }, args )
  299. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, { cf_name = ("indexOf" as field) })) }, args )
  300. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, { cf_name = ("lastIndexOf" as field) })) }, args )
  301. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, { cf_name = ("split" as field) })) }, args )
  302. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, { cf_name = ("substring" as field) })) }, args )
  303. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, { cf_name = ("substr" as field) })) }, args ) ->
  304. { e with eexpr = TCall(mk_static_field_access_infer string_ext field e.epos [], [run ef] @ (List.map run args)) }
  305. | TNew( { cl_path = ([], "String") }, [], [p] ) -> run p (* new String(myString) -> myString *)
  306. | TCast(expr, _) when is_int_float e.etype && not (is_int_float expr.etype) && not (is_null e.etype) ->
  307. let needs_cast = match gen.gfollow#run_f e.etype with
  308. | TInst _ -> false
  309. | _ -> true
  310. in
  311. let fun_name = if like_int e.etype then "toInt" else "toDouble" in
  312. let ret = {
  313. eexpr = TCall(
  314. mk_static_field_access_infer runtime_cl fun_name expr.epos [],
  315. [ run expr ]
  316. );
  317. etype = basic.tint;
  318. epos = expr.epos
  319. } in
  320. if needs_cast then mk_cast e.etype ret else ret
  321. | TCast(expr, _) when is_string e.etype ->
  322. { e with eexpr = TCall( mk_static_field_access_infer runtime_cl "toString" expr.epos [], [run expr] ) }
  323. | TBinop( (Ast.OpNotEq as op), e1, e2)
  324. | TBinop( (Ast.OpEq as op), e1, e2) when is_string e1.etype || is_string e2.etype ->
  325. let mk_ret e = match op with | Ast.OpNotEq -> { e with eexpr = TUnop(Ast.Not, Ast.Prefix, e) } | _ -> e in
  326. mk_ret { e with
  327. eexpr = TCall({
  328. eexpr = TField(mk_classtype_access clstring e.epos, FDynamic "Equals");
  329. etype = TFun(["obj1",false,basic.tstring; "obj2",false,basic.tstring], basic.tbool);
  330. epos = e1.epos
  331. }, [ run e1; run e2 ])
  332. }
  333. | TCast(expr, _) when is_tparam e.etype ->
  334. let static = mk_static_field_access_infer (runtime_cl) "genericCast" e.epos [e.etype] in
  335. { e with eexpr = TCall(static, [mk_local (alloc_var "$type_param" e.etype) expr.epos; run expr]); }
  336. | TBinop( (Ast.OpNotEq as op), e1, e2)
  337. | TBinop( (Ast.OpEq as op), e1, e2) when is_struct e1.etype || is_struct e2.etype ->
  338. let mk_ret e = match op with | Ast.OpNotEq -> { e with eexpr = TUnop(Ast.Not, Ast.Prefix, e) } | _ -> e in
  339. mk_ret { e with
  340. eexpr = TCall({
  341. eexpr = TField(run e1, FDynamic "Equals");
  342. etype = TFun(["obj1",false,t_dynamic;], basic.tbool);
  343. epos = e1.epos
  344. }, [ run e2 ])
  345. }
  346. | TBinop ( (Ast.OpEq as op), e1, e2 )
  347. | TBinop ( (Ast.OpNotEq as op), e1, e2 ) when is_cl e1.etype ->
  348. let static = mk_static_field_access_infer (runtime_cl) "typeEq" e.epos [] in
  349. let ret = { e with eexpr = TCall(static, [run e1; run e2]); } in
  350. if op = Ast.OpNotEq then
  351. { ret with eexpr = TUnop(Ast.Not, Ast.Prefix, ret) }
  352. else
  353. ret
  354. | _ -> Type.map_expr run e
  355. in
  356. run
  357. let configure gen (mapping_func:texpr->texpr) =
  358. let map e = Some(mapping_func e) in
  359. gen.gsyntax_filters#add ~name:name ~priority:(PCustom priority) map
  360. end;;
  361. (* Type Parameters Handling *)
  362. let handle_type_params gen ifaces base_generic =
  363. let basic = gen.gcon.basic in
  364. (*
  365. starting to set gtparam_cast.
  366. *)
  367. (* NativeArray: the most important. *)
  368. (*
  369. var new_arr = new NativeArray<TO_T>(old_arr.Length);
  370. var i = -1;
  371. while( i < old_arr.Length )
  372. {
  373. new_arr[i] = (TO_T) old_arr[i];
  374. }
  375. *)
  376. let native_arr_cl = get_cl ( get_type gen (["cs"], "NativeArray") ) in
  377. let get_narr_param t = match follow t with
  378. | TInst({ cl_path = (["cs"], "NativeArray") }, [param]) -> param
  379. | _ -> assert false
  380. in
  381. let gtparam_cast_native_array e to_t =
  382. let old_param = get_narr_param e.etype in
  383. let new_param = get_narr_param to_t in
  384. let new_v = mk_temp gen "new_arr" to_t in
  385. let i = mk_temp gen "i" basic.tint in
  386. let old_len = mk_field_access gen e "Length" e.epos in
  387. let obj_v = mk_temp gen "obj" t_dynamic in
  388. let block = [
  389. {
  390. eexpr = TVars(
  391. [
  392. new_v, Some( {
  393. eexpr = TNew(native_arr_cl, [new_param], [old_len] );
  394. etype = to_t;
  395. epos = e.epos
  396. } );
  397. i, Some( mk_int gen (-1) e.epos )
  398. ]);
  399. etype = basic.tvoid;
  400. epos = e.epos };
  401. {
  402. eexpr = TWhile(
  403. {
  404. eexpr = TBinop(
  405. Ast.OpLt,
  406. { eexpr = TUnop(Ast.Increment, Ast.Prefix, mk_local i e.epos); etype = basic.tint; epos = e.epos },
  407. old_len
  408. );
  409. etype = basic.tbool;
  410. epos = e.epos
  411. },
  412. { eexpr = TBlock [
  413. {
  414. eexpr = TVars([obj_v, Some (mk_cast t_dynamic { eexpr = TArray(e, mk_local i e.epos); etype = old_param; epos = e.epos })]);
  415. etype = basic.tvoid;
  416. epos = e.epos
  417. };
  418. {
  419. eexpr = TIf({
  420. eexpr = TBinop(Ast.OpNotEq, mk_local obj_v e.epos, null e.etype e.epos);
  421. etype = basic.tbool;
  422. epos = e.epos
  423. },
  424. {
  425. eexpr = TBinop(
  426. Ast.OpAssign,
  427. { eexpr = TArray(mk_local new_v e.epos, mk_local i e.epos); etype = new_param; epos = e.epos },
  428. mk_cast new_param (mk_local obj_v e.epos)
  429. );
  430. etype = new_param;
  431. epos = e.epos
  432. },
  433. None);
  434. etype = basic.tvoid;
  435. epos = e.epos
  436. }
  437. ]; etype = basic.tvoid; epos = e.epos },
  438. Ast.NormalWhile
  439. );
  440. etype = basic.tvoid;
  441. epos = e.epos;
  442. };
  443. mk_local new_v e.epos
  444. ] in
  445. { eexpr = TBlock(block); etype = to_t; epos = e.epos }
  446. in
  447. Hashtbl.add gen.gtparam_cast (["cs"], "NativeArray") gtparam_cast_native_array;
  448. (* end set gtparam_cast *)
  449. TypeParams.RealTypeParams.default_config gen (fun e t -> gen.gcon.warning ("Cannot cast to " ^ (debug_type t)) e.epos; mk_cast t e) ifaces base_generic
  450. let connecting_string = "?" (* ? see list here http://www.fileformat.info/info/unicode/category/index.htm and here for C# http://msdn.microsoft.com/en-us/library/aa664670.aspx *)
  451. let default_package = "cs" (* I'm having this separated as I'm still not happy with having a cs package. Maybe dotnet would be better? *)
  452. let strict_mode = ref false (* strict mode is so we can check for unexpected information *)
  453. (* reserved c# words *)
  454. let reserved = let res = Hashtbl.create 120 in
  455. List.iter (fun lst -> Hashtbl.add res lst ("@" ^ lst)) ["abstract"; "as"; "base"; "bool"; "break"; "byte"; "case"; "catch"; "char"; "checked"; "class";
  456. "const"; "continue"; "decimal"; "default"; "delegate"; "do"; "double"; "else"; "enum"; "event"; "explicit";
  457. "extern"; "false"; "finally"; "fixed"; "float"; "for"; "foreach"; "goto"; "if"; "implicit"; "in"; "int";
  458. "interface"; "internal"; "is"; "lock"; "long"; "namespace"; "new"; "null"; "object"; "operator"; "out"; "override";
  459. "params"; "private"; "protected"; "public"; "readonly"; "ref"; "return"; "sbyte"; "sealed"; "short"; "sizeof";
  460. "stackalloc"; "static"; "string"; "struct"; "switch"; "this"; "throw"; "true"; "try"; "typeof"; "uint"; "ulong";
  461. "unchecked"; "unsafe"; "ushort"; "using"; "virtual"; "volatile"; "void"; "while"; "add"; "ascending"; "by"; "descending";
  462. "dynamic"; "equals"; "from"; "get"; "global"; "group"; "into"; "join"; "let"; "on"; "orderby"; "partial";
  463. "remove"; "select"; "set"; "value"; "var"; "where"; "yield"];
  464. res
  465. let dynamic_anon = TAnon( { a_fields = PMap.empty; a_status = ref Closed } )
  466. let rec get_class_modifiers meta cl_type cl_access cl_modifiers =
  467. match meta with
  468. | [] -> cl_type,cl_access,cl_modifiers
  469. | (Meta.Struct,[],_) :: meta -> get_class_modifiers meta "struct" cl_access cl_modifiers
  470. | (Meta.Protected,[],_) :: meta -> get_class_modifiers meta cl_type "protected" cl_modifiers
  471. | (Meta.Internal,[],_) :: meta -> get_class_modifiers meta cl_type "internal" cl_modifiers
  472. (* no abstract for now | (":abstract",[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("abstract" :: cl_modifiers)
  473. | (":static",[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("static" :: cl_modifiers) TODO: support those types *)
  474. | (Meta.Final,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("sealed" :: cl_modifiers)
  475. | (Meta.Unsafe,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("unsafe" :: cl_modifiers)
  476. | _ :: meta -> get_class_modifiers meta cl_type cl_access cl_modifiers
  477. let rec get_fun_modifiers meta access modifiers =
  478. match meta with
  479. | [] -> access,modifiers
  480. | (Meta.Protected,[],_) :: meta -> get_fun_modifiers meta "protected" modifiers
  481. | (Meta.Internal,[],_) :: meta -> get_fun_modifiers meta "internal" modifiers
  482. | (Meta.ReadOnly,[],_) :: meta -> get_fun_modifiers meta access ("readonly" :: modifiers)
  483. | (Meta.Unsafe,[],_) :: meta -> get_fun_modifiers meta access ("unsafe" :: modifiers)
  484. | (Meta.Volatile,[],_) :: meta -> get_fun_modifiers meta access ("volatile" :: modifiers)
  485. | _ :: meta -> get_fun_modifiers meta access modifiers
  486. (* this was the way I found to pass the generator context to be accessible across all functions here *)
  487. (* so 'configure' is almost 'top-level' and will have all functions needed to make this work *)
  488. let configure gen =
  489. let basic = gen.gcon.basic in
  490. let fn_cl = get_cl (get_type gen (["haxe";"lang"],"Function")) in
  491. let null_t = (get_cl (get_type gen (["haxe";"lang"],"Null")) ) in
  492. let runtime_cl = get_cl (get_type gen (["haxe";"lang"],"Runtime")) in
  493. let no_root = Common.defined gen.gcon Define.NoRoot in
  494. let change_clname n = n in
  495. let change_id name = try Hashtbl.find reserved name with | Not_found -> name in
  496. let change_ns md = if no_root then
  497. function
  498. | [] when is_hxgen md -> ["haxe";"root"]
  499. | ns -> List.map change_id ns
  500. else List.map change_id in
  501. let change_field = change_id in
  502. let write_id w name = write w (change_id name) in
  503. let write_field w name = write w (change_field name) in
  504. gen.gfollow#add ~name:"follow_basic" (fun t -> match t with
  505. | TEnum ({ e_path = ([], "Bool") }, [])
  506. | TAbstract ({ a_path = ([], "Bool") },[])
  507. | TEnum ({ e_path = ([], "Void") }, [])
  508. | TAbstract ({ a_path = ([], "Void") },[])
  509. | TInst ({ cl_path = ([],"Float") },[])
  510. | TAbstract ({ a_path = ([],"Float") },[])
  511. | TInst ({ cl_path = ([],"Int") },[])
  512. | TAbstract ({ a_path = ([],"Int") },[])
  513. | TType ({ t_path = [],"UInt" },[])
  514. | TAbstract ({ a_path = [],"UInt" },[])
  515. | TType ({ t_path = ["haxe";"_Int64"], "NativeInt64" },[])
  516. | TAbstract ({ a_path = ["haxe";"_Int64"], "NativeInt64" },[])
  517. | TType ({ t_path = ["haxe";"_Int64"], "NativeUInt64" },[])
  518. | TAbstract ({ a_path = ["haxe";"_Int64"], "NativeUInt64" },[])
  519. | TType ({ t_path = ["cs"],"UInt64" },[])
  520. | TAbstract ({ a_path = ["cs"],"UInt64" },[])
  521. | TType ({ t_path = ["cs"],"UInt8" },[])
  522. | TAbstract ({ a_path = ["cs"],"UInt8" },[])
  523. | TType ({ t_path = ["cs"],"Int8" },[])
  524. | TAbstract ({ a_path = ["cs"],"Int8" },[])
  525. | TType ({ t_path = ["cs"],"Int16" },[])
  526. | TAbstract ({ a_path = ["cs"],"Int16" },[])
  527. | TType ({ t_path = ["cs"],"UInt16" },[])
  528. | TAbstract ({ a_path = ["cs"],"UInt16" },[])
  529. | TType ({ t_path = ["cs"],"Char16" },[])
  530. | TAbstract ({ a_path = ["cs"],"Char16" },[])
  531. | TType ({ t_path = ["cs"],"Ref" },_)
  532. | TAbstract ({ a_path = ["cs"],"Ref" },_)
  533. | TType ({ t_path = ["cs"],"Out" },_)
  534. | TAbstract ({ a_path = ["cs"],"Out" },_)
  535. | TType ({ t_path = [],"Single" },[])
  536. | TAbstract ({ a_path = [],"Single" },[]) -> Some t
  537. | TType ({ t_path = [],"Null" },[_]) -> Some t
  538. | TAbstract ({ a_impl = Some _ } as a, pl) ->
  539. Some (gen.gfollow#run_f ( Codegen.Abstract.get_underlying_type a pl) )
  540. | TAbstract( { a_path = ([], "EnumValue") }, _ )
  541. | TInst( { cl_path = ([], "EnumValue") }, _ ) -> Some t_dynamic
  542. | _ -> None);
  543. let module_s md =
  544. let path = (t_infos md).mt_path in
  545. match path with
  546. | ([], "String") -> "string"
  547. | ([], "Null") -> path_s (change_ns md ["haxe"; "lang"], change_clname "Null")
  548. | (ns,clname) -> path_s (change_ns md ns, change_clname clname)
  549. in
  550. let ifaces = Hashtbl.create 1 in
  551. let ti64 = match ( get_type gen (["haxe";"_Int64"], "NativeInt64") ) with | TTypeDecl t -> TType(t,[]) | TAbstractDecl a -> TAbstract(a,[]) | _ -> assert false in
  552. let ttype = get_cl ( get_type gen (["System"], "Type") ) in
  553. let has_tdyn tl =
  554. List.exists (fun t -> match follow t with
  555. | TDynamic _ | TMono _ -> true
  556. | _ -> false
  557. ) tl
  558. in
  559. let rec real_type t =
  560. let t = gen.gfollow#run_f t in
  561. let ret = match t with
  562. | TAbstract ({ a_impl = Some _ } as a, pl) ->
  563. real_type (Codegen.Abstract.get_underlying_type a pl)
  564. | TInst( { cl_path = (["haxe"], "Int32") }, [] ) -> gen.gcon.basic.tint
  565. | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> ti64
  566. | TAbstract( { a_path = [],"Class" }, _ )
  567. | TAbstract( { a_path = [],"Enum" }, _ )
  568. | TInst( { cl_path = ([], "Class") }, _ )
  569. | TInst( { cl_path = ([], "Enum") }, _ ) -> TInst(ttype,[])
  570. | TEnum(_, [])
  571. | TInst(_, []) -> t
  572. | TInst(cl, params) when
  573. has_tdyn params &&
  574. Hashtbl.mem ifaces cl.cl_path ->
  575. TInst(Hashtbl.find ifaces cl.cl_path, [])
  576. | TEnum(e, params) ->
  577. TEnum(e, List.map (fun _ -> t_dynamic) params)
  578. | TInst(cl, params) when Meta.has Meta.Enum cl.cl_meta ->
  579. TInst(cl, List.map (fun _ -> t_dynamic) params)
  580. | TInst(cl, params) -> TInst(cl, change_param_type (TClassDecl cl) params)
  581. | TType({ t_path = ([], "Null") }, [t]) ->
  582. (*
  583. Null<> handling is a little tricky.
  584. It will only change to haxe.lang.Null<> when the actual type is non-nullable or a type parameter
  585. It works on cases such as Hash<T> returning Null<T> since cast_detect will invoke real_type at the original type,
  586. Null<T>, which will then return the type haxe.lang.Null<>
  587. *)
  588. (match real_type t with
  589. | TInst( { cl_kind = KTypeParameter _ }, _ ) -> TInst(null_t, [t])
  590. | _ when is_cs_basic_type t -> TInst(null_t, [t])
  591. | _ -> real_type t)
  592. | TAbstract _
  593. | TType _ -> t
  594. | TAnon (anon) when (match !(anon.a_status) with | Statics _ | EnumStatics _ | AbstractStatics _ -> true | _ -> false) -> t
  595. | TFun _ -> TInst(fn_cl,[])
  596. | _ -> t_dynamic
  597. in
  598. ret
  599. and
  600. (*
  601. On hxcs, the only type parameters allowed to be declared are the basic c# types.
  602. That's made like this to avoid casting problems when type parameters in this case
  603. add nothing to performance, since the memory layout is always the same.
  604. To avoid confusion between Generic<Dynamic> (which has a different meaning in hxcs AST),
  605. all those references are using dynamic_anon, which means Generic<{}>
  606. *)
  607. change_param_type md tl =
  608. let is_hxgeneric = (TypeParams.RealTypeParams.is_hxgeneric md) in
  609. let ret t = match is_hxgeneric, real_type t with
  610. | false, _ -> t
  611. (*
  612. Because Null<> types need a special compiler treatment for many operations (e.g. boxing/unboxing),
  613. Null<> type parameters will be transformed into Dynamic.
  614. *)
  615. | true, TInst ( { cl_path = (["haxe";"lang"], "Null") }, _ ) -> dynamic_anon
  616. | true, TInst ( { cl_kind = KTypeParameter _ }, _ ) -> t
  617. | true, TInst _
  618. | true, TEnum _
  619. | true, TAbstract _ when is_cs_basic_type t -> t
  620. | true, TDynamic _ -> t
  621. | true, _ -> dynamic_anon
  622. in
  623. if is_hxgeneric && List.exists (fun t -> match follow t with | TDynamic _ -> true | _ -> false) tl then
  624. List.map (fun _ -> t_dynamic) tl
  625. else
  626. List.map ret tl
  627. in
  628. let is_dynamic t = match real_type t with
  629. | TMono _ | TDynamic _ -> true
  630. | TAnon anon ->
  631. (match !(anon.a_status) with
  632. | EnumStatics _ | Statics _ -> false
  633. | _ -> true
  634. )
  635. | _ -> false
  636. in
  637. let rec t_s t =
  638. match real_type t with
  639. (* basic types *)
  640. | TEnum ({ e_path = ([], "Bool") }, [])
  641. | TAbstract ({ a_path = ([], "Bool") },[]) -> "bool"
  642. | TEnum ({ e_path = ([], "Void") }, [])
  643. | TAbstract ({ a_path = ([], "Void") },[]) -> "object"
  644. | TInst ({ cl_path = ([],"Float") },[])
  645. | TAbstract ({ a_path = ([],"Float") },[]) -> "double"
  646. | TInst ({ cl_path = ([],"Int") },[])
  647. | TAbstract ({ a_path = ([],"Int") },[]) -> "int"
  648. | TType ({ t_path = [],"UInt" },[])
  649. | TAbstract ({ a_path = [],"UInt" },[]) -> "uint"
  650. | TType ({ t_path = ["haxe";"_Int64"], "NativeInt64" },[])
  651. | TAbstract ({ a_path = ["haxe";"_Int64"], "NativeInt64" },[]) -> "long"
  652. | TType ({ t_path = ["haxe";"_Int64"], "NativeUInt64" },[])
  653. | TAbstract ({ a_path = ["haxe";"_Int64"], "NativeUInt64" },[]) -> "ulong"
  654. | TType ({ t_path = ["cs"],"UInt64" },[])
  655. | TAbstract ({ a_path = ["cs"],"UInt64" },[]) -> "ulong"
  656. | TType ({ t_path = ["cs"],"UInt8" },[])
  657. | TAbstract ({ a_path = ["cs"],"UInt8" },[]) -> "byte"
  658. | TType ({ t_path = ["cs"],"Int8" },[])
  659. | TAbstract ({ a_path = ["cs"],"Int8" },[]) -> "sbyte"
  660. | TType ({ t_path = ["cs"],"Int16" },[])
  661. | TAbstract ({ a_path = ["cs"],"Int16" },[]) -> "short"
  662. | TType ({ t_path = ["cs"],"UInt16" },[])
  663. | TAbstract ({ a_path = ["cs"],"UInt16" },[]) -> "ushort"
  664. | TType ({ t_path = ["cs"],"Char16" },[])
  665. | TAbstract ({ a_path = ["cs"],"Char16" },[]) -> "char"
  666. | TType ({ t_path = [],"Single" },[])
  667. | TAbstract ({ a_path = [],"Single" },[]) -> "float"
  668. | TInst ({ cl_path = ["haxe"],"Int32" },[])
  669. | TAbstract ({ a_path = ["haxe"],"Int32" },[]) -> "int"
  670. | TInst ({ cl_path = ["haxe"],"Int64" },[])
  671. | TAbstract ({ a_path = ["haxe"],"Int64" },[]) -> "long"
  672. | TInst ({ cl_path = ([], "Dynamic") },_)
  673. | TAbstract ({ a_path = ([], "Dynamic") },_) -> "object"
  674. | TType ({ t_path = ["cs"],"Out" },[t])
  675. | TAbstract ({ a_path = ["cs"],"Out" },[t])
  676. | TType ({ t_path = ["cs"],"Ref" },[t])
  677. | TAbstract ({ a_path = ["cs"],"Ref" },[t]) -> t_s t
  678. | TInst({ cl_path = (["cs"], "NativeArray") }, [param]) ->
  679. let rec check_t_s t =
  680. match real_type t with
  681. | TInst({ cl_path = (["cs"], "NativeArray") }, [param]) ->
  682. (check_t_s param) ^ "[]"
  683. | _ -> t_s (run_follow gen t)
  684. in
  685. (check_t_s param) ^ "[]"
  686. | TInst({ cl_path = (["cs"], "Pointer") },[t])
  687. | TAbstract({ a_path = (["cs"], "Pointer") },[t])->
  688. t_s t ^ "*"
  689. (* end of basic types *)
  690. | TInst ({ cl_kind = KTypeParameter _; cl_path=p }, []) -> snd p
  691. | TMono r -> (match !r with | None -> "object" | Some t -> t_s (run_follow gen t))
  692. | TInst ({ cl_path = [], "String" }, []) -> "string"
  693. | TEnum (e, params) -> ("global::" ^ (module_s (TEnumDecl e)))
  694. | TInst (cl, _ :: _) when Meta.has Meta.Enum cl.cl_meta ->
  695. "global::" ^ module_s (TClassDecl cl)
  696. | TInst (({ cl_path = p } as cl), params) -> (path_param_s (TClassDecl cl) p params)
  697. | TType (({ t_path = p } as t), params) -> (path_param_s (TTypeDecl t) p params)
  698. | TAnon (anon) ->
  699. (match !(anon.a_status) with
  700. | Statics _ | EnumStatics _ -> "System.Type"
  701. | _ -> "object")
  702. | TDynamic _ -> "object"
  703. | TAbstract(a,pl) when a.a_impl <> None ->
  704. t_s (Codegen.Abstract.get_underlying_type a pl)
  705. (* No Lazy type nor Function type made. That's because function types will be at this point be converted into other types *)
  706. | _ -> if !strict_mode then begin trace ("[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]"); assert false end else "[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]"
  707. and path_param_s md path params =
  708. match params with
  709. | [] -> "global::" ^ module_s md
  710. | _ -> sprintf "%s<%s>" ("global::" ^ module_s md) (String.concat ", " (List.map (fun t -> t_s t) (change_param_type md params)))
  711. in
  712. let rett_s t =
  713. match t with
  714. | TEnum ({e_path = ([], "Void")}, [])
  715. | TAbstract ({ a_path = ([], "Void") },[]) -> "void"
  716. | _ -> t_s t
  717. in
  718. let argt_s t =
  719. match t with
  720. | TType ({ t_path = (["cs"], "Ref") }, [t])
  721. | TAbstract ({ a_path = (["cs"], "Ref") },[t]) -> "ref " ^ t_s t
  722. | TType ({ t_path = (["cs"], "Out") }, [t])
  723. | TAbstract ({ a_path = (["cs"], "Out") },[t]) -> "out " ^ t_s t
  724. | _ -> t_s t
  725. in
  726. let escape ichar b =
  727. match ichar with
  728. | 92 (* \ *) -> Buffer.add_string b "\\\\"
  729. | 39 (* ' *) -> Buffer.add_string b "\\\'"
  730. | 34 -> Buffer.add_string b "\\\""
  731. | 13 (* \r *) -> Buffer.add_string b "\\r"
  732. | 10 (* \n *) -> Buffer.add_string b "\\n"
  733. | 9 (* \t *) -> Buffer.add_string b "\\t"
  734. | c when c < 32 || c >= 127 -> Buffer.add_string b (Printf.sprintf "\\u%.4x" c)
  735. | c -> Buffer.add_char b (Char.chr c)
  736. in
  737. let escape s =
  738. let b = Buffer.create 0 in
  739. (try
  740. UTF8.validate s;
  741. UTF8.iter (fun c -> escape (UChar.code c) b) s
  742. with
  743. UTF8.Malformed_code ->
  744. String.iter (fun c -> escape (Char.code c) b) s
  745. );
  746. Buffer.contents b
  747. in
  748. let has_semicolon e =
  749. match e.eexpr with
  750. | TBlock _ | TFor _ | TSwitch _ | TMatch _ | TTry _ | TIf _ -> false
  751. | TWhile (_,_,flag) when flag = Ast.NormalWhile -> false
  752. | _ -> true
  753. in
  754. let in_value = ref false in
  755. let rec md_s md =
  756. let md = follow_module (gen.gfollow#run_f) md in
  757. match md with
  758. | TClassDecl ({ cl_types = [] } as cl) ->
  759. t_s (TInst(cl,[]))
  760. | TClassDecl (cl) when not (is_hxgen md) ->
  761. t_s (TInst(cl,List.map (fun t -> t_dynamic) cl.cl_types))
  762. | TEnumDecl ({ e_types = [] } as e) ->
  763. t_s (TEnum(e,[]))
  764. | TEnumDecl (e) when not (is_hxgen md) ->
  765. t_s (TEnum(e,List.map (fun t -> t_dynamic) e.e_types))
  766. | TClassDecl cl ->
  767. t_s (TInst(cl,[]))
  768. | TEnumDecl e ->
  769. t_s (TEnum(e,[]))
  770. | TTypeDecl t ->
  771. t_s (TType(t, List.map (fun t -> t_dynamic) t.t_types))
  772. | TAbstractDecl a ->
  773. t_s (TAbstract(a, List.map(fun t -> t_dynamic) a.a_types))
  774. in
  775. let rec ensure_local e explain =
  776. match e.eexpr with
  777. | TLocal _ -> e
  778. | TCast(e,_)
  779. | TParenthesis e -> ensure_local e explain
  780. | _ -> gen.gcon.error ("This function argument " ^ explain ^ " must be a local variable.") e.epos; e
  781. in
  782. let is_pointer t = match follow t with
  783. | TInst({ cl_path = (["cs"], "Pointer") }, _)
  784. | TAbstract ({ a_path = (["cs"], "Pointer") },_) ->
  785. true
  786. | _ ->
  787. false in
  788. let last_line = ref (-1) in
  789. let line_directive =
  790. if Common.defined gen.gcon Define.RealPosition then
  791. fun w p -> ()
  792. else fun w p ->
  793. let cur_line = Lexer.get_error_line p in
  794. let is_relative_path = (String.sub p.pfile 0 1) = "." in
  795. let file = if is_relative_path then Common.get_full_path p.pfile else p.pfile in
  796. if cur_line <> ((!last_line)+1) then begin print w "#line %d \"%s\"" cur_line (Ast.s_escape file); newline w end;
  797. last_line := cur_line
  798. in
  799. let rec extract_tparams params el =
  800. match el with
  801. | ({ eexpr = TLocal({ v_name = "$type_param" }) } as tp) :: tl ->
  802. extract_tparams (tp.etype :: params) tl
  803. | _ -> (params, el)
  804. in
  805. let expr_s w e =
  806. last_line := -1;
  807. in_value := false;
  808. let rec expr_s w e =
  809. let was_in_value = !in_value in
  810. in_value := true;
  811. (match e.eexpr with
  812. | TConst c ->
  813. (match c with
  814. | TInt i32 ->
  815. write w (Int32.to_string i32);
  816. (*match real_type e.etype with
  817. | TType( { t_path = (["haxe";"_Int64"], "NativeInt64") }, [] ) -> write w "L";
  818. | _ -> ()
  819. *)
  820. | TFloat s ->
  821. write w s;
  822. (if String.get s (String.length s - 1) = '.' then write w "0");
  823. (*match real_type e.etype with
  824. | TType( { t_path = ([], "Single") }, [] ) -> write w "f"
  825. | _ -> ()
  826. *)
  827. | TString s ->
  828. write w "\"";
  829. write w (escape s);
  830. write w "\""
  831. | TBool b -> write w (if b then "true" else "false")
  832. | TNull ->
  833. write w "default(";
  834. write w (t_s e.etype);
  835. write w ")"
  836. | TThis -> write w "this"
  837. | TSuper -> write w "base")
  838. | TLocal { v_name = "__sbreak__" } -> write w "break"
  839. | TLocal { v_name = "__undefined__" } ->
  840. write w (t_s (TInst(runtime_cl, List.map (fun _ -> t_dynamic) runtime_cl.cl_types)));
  841. write w ".undefined";
  842. | TLocal { v_name = "__typeof__" } -> write w "typeof"
  843. | TLocal { v_name = "__sizeof__" } -> write w "sizeof"
  844. | TLocal var ->
  845. write_id w var.v_name
  846. | TField (_, FEnum(e, ef)) ->
  847. let s = ef.ef_name in
  848. print w "%s." ("global::" ^ module_s (TEnumDecl e)); write_field w s
  849. | TArray (e1, e2) ->
  850. expr_s w e1; write w "["; expr_s w e2; write w "]"
  851. | TBinop ((Ast.OpAssign as op), e1, e2)
  852. | TBinop ((Ast.OpAssignOp _ as op), e1, e2) ->
  853. expr_s w e1; write w ( " " ^ (Ast.s_binop op) ^ " " ); expr_s w e2
  854. | TBinop (op, e1, e2) ->
  855. write w "( ";
  856. expr_s w e1; write w ( " " ^ (Ast.s_binop op) ^ " " ); expr_s w e2;
  857. write w " )"
  858. | TField ({ eexpr = TTypeExpr mt }, s) ->
  859. (match mt with
  860. | TClassDecl { cl_path = (["haxe"], "Int64") } -> write w ("global::" ^ module_s mt)
  861. | TClassDecl { cl_path = (["haxe"], "Int32") } -> write w ("global::" ^ module_s mt)
  862. | TClassDecl { cl_interface = true } ->
  863. write w ("global::" ^ module_s mt);
  864. write w "__Statics_";
  865. | TClassDecl cl -> write w (t_s (TInst(cl, List.map (fun _ -> t_empty) cl.cl_types)))
  866. | TEnumDecl en -> write w (t_s (TEnum(en, List.map (fun _ -> t_empty) en.e_types)))
  867. | TTypeDecl td -> write w (t_s (gen.gfollow#run_f (TType(td, List.map (fun _ -> t_empty) td.t_types))))
  868. | TAbstractDecl a -> write w (t_s (TAbstract(a, List.map (fun _ -> t_empty) a.a_types)))
  869. );
  870. write w ".";
  871. write_field w (field_name s)
  872. | TField (e, s) ->
  873. expr_s w e; write w "."; write_field w (field_name s)
  874. | TTypeExpr mt ->
  875. (match mt with
  876. | TClassDecl { cl_path = (["haxe"], "Int64") } -> write w ("global::" ^ module_s mt)
  877. | TClassDecl { cl_path = (["haxe"], "Int32") } -> write w ("global::" ^ module_s mt)
  878. | TClassDecl cl -> write w (t_s (TInst(cl, List.map (fun _ -> t_dynamic) cl.cl_types)))
  879. | TEnumDecl en -> write w (t_s (TEnum(en, List.map (fun _ -> t_dynamic) en.e_types)))
  880. | TTypeDecl td -> write w (t_s (gen.gfollow#run_f (TType(td, List.map (fun _ -> t_dynamic) td.t_types))))
  881. | TAbstractDecl a -> write w (t_s (TAbstract(a, List.map (fun _ -> t_dynamic) a.a_types)))
  882. )
  883. | TParenthesis e ->
  884. write w "("; expr_s w e; write w ")"
  885. | TArrayDecl el ->
  886. print w "new %s" (t_s e.etype);
  887. write w "{";
  888. ignore (List.fold_left (fun acc e ->
  889. (if acc <> 0 then write w ", ");
  890. expr_s w e;
  891. acc + 1
  892. ) 0 el);
  893. write w "}"
  894. | TCall ({ eexpr = TLocal( { v_name = "__is__" } ) }, [ expr; { eexpr = TTypeExpr(md) } ] ) ->
  895. write w "( ";
  896. expr_s w expr;
  897. write w " is ";
  898. write w (md_s md);
  899. write w " )"
  900. | TCall ({ eexpr = TLocal( { v_name = "__as__" } ) }, [ expr; { eexpr = TTypeExpr(md) } ] ) ->
  901. write w "( ";
  902. expr_s w expr;
  903. write w " as ";
  904. write w (md_s md);
  905. write w " )"
  906. | TCall ({ eexpr = TLocal( { v_name = "__as__" } ) }, [ expr ] ) ->
  907. write w "( ";
  908. expr_s w expr;
  909. write w " as ";
  910. write w (t_s e.etype);
  911. write w " )";
  912. | TCall ({ eexpr = TLocal( { v_name = "__cs__" } ) }, [ { eexpr = TConst(TString(s)) } ] ) ->
  913. write w s
  914. | TCall ({ eexpr = TLocal( { v_name = "__unsafe__" } ) }, [ e ] ) ->
  915. write w "unsafe";
  916. expr_s w (mk_block e)
  917. | TCall ({ eexpr = TLocal( { v_name = "__checked__" } ) }, [ e ] ) ->
  918. write w "checked";
  919. expr_s w (mk_block e)
  920. | TCall ({ eexpr = TLocal( { v_name = "__lock__" } ) }, [ eobj; eblock ] ) ->
  921. write w "lock(";
  922. expr_s w eobj;
  923. write w ")";
  924. expr_s w (mk_block eblock)
  925. | TCall ({ eexpr = TLocal( { v_name = "__fixed__" } ) }, [ e ] ) ->
  926. let first = ref true in
  927. let rec loop = function
  928. | ({ eexpr = TVars([v, Some({ eexpr = TCast( { eexpr = TCast(e, _) }, _) }) ]) } as expr) :: tl when is_pointer v.v_type ->
  929. (if !first then first := false);
  930. write w "fixed(";
  931. let vf = mk_temp gen "fixed" v.v_type in
  932. expr_s w { expr with eexpr = TVars([vf, Some e]) };
  933. write w ")";
  934. begin_block w;
  935. expr_s w { expr with eexpr = TVars([v, Some (mk_local vf expr.epos)]) };
  936. write w ";";
  937. loop tl;
  938. end_block w
  939. | el when not !first ->
  940. expr_s w { e with eexpr = TBlock el }
  941. | _ ->
  942. trace (debug_expr e);
  943. gen.gcon.error "Invalid 'fixed' keyword format" e.epos
  944. in
  945. (match e.eexpr with
  946. | TBlock bl -> loop bl
  947. | _ ->
  948. trace "not block";
  949. trace (debug_expr e);
  950. gen.gcon.error "Invalid 'fixed' keyword format" e.epos
  951. )
  952. | TCall ({ eexpr = TLocal( { v_name = "__addressOf__" } ) }, [ e ] ) ->
  953. let e = ensure_local e "for addressOf" in
  954. write w "&";
  955. expr_s w e
  956. | TCall ({ eexpr = TLocal( { v_name = "__valueOf__" } ) }, [ e ] ) ->
  957. write w "*(";
  958. expr_s w e;
  959. write w ")"
  960. | TCall ({ eexpr = TLocal( { v_name = "__goto__" } ) }, [ { eexpr = TConst(TInt v) } ] ) ->
  961. print w "goto label%ld" v
  962. | TCall ({ eexpr = TLocal( { v_name = "__label__" } ) }, [ { eexpr = TConst(TInt v) } ] ) ->
  963. print w "label%ld: {}" v
  964. | TCall ({ eexpr = TLocal( { v_name = "__rethrow__" } ) }, _) ->
  965. write w "throw"
  966. (* operator overloading handling *)
  967. | TCall({ eexpr = TField(ef, FInstance(cl,{ cf_name = "__get" })) }, [idx]) when not (is_hxgen (TClassDecl cl)) ->
  968. expr_s w { e with eexpr = TArray(ef, idx) }
  969. | TCall({ eexpr = TField(ef, FInstance(cl,{ cf_name = "__set" })) }, [idx; v]) when not (is_hxgen (TClassDecl cl)) ->
  970. expr_s w { e with eexpr = TBinop(Ast.OpAssign, { e with eexpr = TArray(ef, idx) }, v) }
  971. | TCall({ eexpr = TField(ef, FStatic(_,cf)) }, el) when PMap.mem cf.cf_name binops_names ->
  972. let _, elr = extract_tparams [] el in
  973. (match elr with
  974. | [e1;e2] ->
  975. expr_s w { e with eexpr = TBinop(PMap.find cf.cf_name binops_names, e1, e2) }
  976. | _ -> do_call w e el)
  977. | TCall({ eexpr = TField(ef, FStatic(_,cf)) }, el) when PMap.mem cf.cf_name unops_names ->
  978. (match extract_tparams [] el with
  979. | _, [e1] ->
  980. expr_s w { e with eexpr = TUnop(PMap.find cf.cf_name unops_names, Ast.Prefix,e1) }
  981. | _ -> do_call w e el)
  982. | TCall (e, el) ->
  983. do_call w e el
  984. | TNew (({ cl_path = (["cs"], "NativeArray") } as cl), params, [ size ]) ->
  985. let rec check_t_s t times =
  986. match real_type t with
  987. | TInst({ cl_path = (["cs"], "NativeArray") }, [param]) ->
  988. (check_t_s param (times+1))
  989. | _ ->
  990. print w "new %s[" (t_s (run_follow gen t));
  991. expr_s w size;
  992. print w "]";
  993. let rec loop i =
  994. if i <= 0 then () else (write w "[]"; loop (i-1))
  995. in
  996. loop (times - 1)
  997. in
  998. check_t_s (TInst(cl, params)) 0
  999. | TNew ({ cl_path = ([], "String") } as cl, [], el) ->
  1000. write w "new ";
  1001. write w (t_s (TInst(cl, [])));
  1002. write w "(";
  1003. ignore (List.fold_left (fun acc e ->
  1004. (if acc <> 0 then write w ", ");
  1005. expr_s w e;
  1006. acc + 1
  1007. ) 0 el);
  1008. write w ")"
  1009. | TNew (cl, params, el) ->
  1010. write w "new ";
  1011. write w (path_param_s (TClassDecl cl) cl.cl_path params);
  1012. write w "(";
  1013. ignore (List.fold_left (fun acc e ->
  1014. (if acc <> 0 then write w ", ");
  1015. expr_s w e;
  1016. acc + 1
  1017. ) 0 el);
  1018. write w ")"
  1019. | TUnop ((Ast.Increment as op), flag, e)
  1020. | TUnop ((Ast.Decrement as op), flag, e) ->
  1021. (match flag with
  1022. | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " " ); expr_s w e
  1023. | Ast.Postfix -> expr_s w e; write w (Ast.s_unop op))
  1024. | TUnop (op, flag, e) ->
  1025. (match flag with
  1026. | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " (" ); expr_s w e; write w ") "
  1027. | Ast.Postfix -> write w "("; expr_s w e; write w (") " ^ Ast.s_unop op))
  1028. | TVars (v_eop_l) ->
  1029. ignore (List.fold_left (fun acc (var, eopt) ->
  1030. (if acc <> 0 then write w ", ");
  1031. print w "%s " (t_s var.v_type);
  1032. write_id w var.v_name;
  1033. (match eopt with
  1034. | None ->
  1035. write w " = ";
  1036. expr_s w (null var.v_type e.epos)
  1037. | Some e ->
  1038. write w " = ";
  1039. expr_s w e
  1040. );
  1041. acc + 1
  1042. ) 0 v_eop_l);
  1043. | TBlock [e] when was_in_value ->
  1044. expr_s w e
  1045. | TBlock el ->
  1046. begin_block w;
  1047. List.iter (fun e ->
  1048. line_directive w e.epos;
  1049. in_value := false;
  1050. expr_s w e;
  1051. (if has_semicolon e then write w ";");
  1052. newline w
  1053. ) el;
  1054. end_block w
  1055. | TIf (econd, e1, Some(eelse)) when was_in_value ->
  1056. write w "( ";
  1057. expr_s w (mk_paren econd);
  1058. write w " ? ";
  1059. expr_s w (mk_paren e1);
  1060. write w " : ";
  1061. expr_s w (mk_paren eelse);
  1062. write w " )";
  1063. | TIf (econd, e1, eelse) ->
  1064. write w "if ";
  1065. expr_s w (mk_paren econd);
  1066. write w " ";
  1067. in_value := false;
  1068. expr_s w (mk_block e1);
  1069. (match eelse with
  1070. | None -> ()
  1071. | Some e ->
  1072. write w " else ";
  1073. in_value := false;
  1074. expr_s w (mk_block e)
  1075. )
  1076. | TWhile (econd, eblock, flag) ->
  1077. (match flag with
  1078. | Ast.NormalWhile ->
  1079. write w "while ";
  1080. expr_s w (mk_paren econd);
  1081. write w "";
  1082. in_value := false;
  1083. expr_s w (mk_block eblock)
  1084. | Ast.DoWhile ->
  1085. write w "do ";
  1086. in_value := false;
  1087. expr_s w (mk_block eblock);
  1088. write w "while ";
  1089. in_value := true;
  1090. expr_s w (mk_paren econd);
  1091. )
  1092. | TSwitch (econd, ele_l, default) ->
  1093. write w "switch ";
  1094. expr_s w (mk_paren econd);
  1095. begin_block w;
  1096. List.iter (fun (el, e) ->
  1097. List.iter (fun e ->
  1098. write w "case ";
  1099. in_value := true;
  1100. expr_s w e;
  1101. write w ":";
  1102. ) el;
  1103. newline w;
  1104. in_value := false;
  1105. expr_s w (mk_block e);
  1106. newline w;
  1107. newline w
  1108. ) ele_l;
  1109. if is_some default then begin
  1110. write w "default:";
  1111. newline w;
  1112. in_value := false;
  1113. expr_s w (get default);
  1114. newline w;
  1115. end;
  1116. end_block w
  1117. | TTry (tryexpr, ve_l) ->
  1118. write w "try ";
  1119. in_value := false;
  1120. expr_s w (mk_block tryexpr);
  1121. List.iter (fun (var, e) ->
  1122. print w "catch (%s %s)" (t_s var.v_type) (var.v_name);
  1123. in_value := false;
  1124. expr_s w (mk_block e);
  1125. newline w
  1126. ) ve_l
  1127. | TReturn eopt ->
  1128. write w "return ";
  1129. if is_some eopt then expr_s w (get eopt)
  1130. | TBreak -> write w "break"
  1131. | TContinue -> write w "continue"
  1132. | TThrow e ->
  1133. write w "throw ";
  1134. expr_s w e
  1135. | TCast (e1,md_t) ->
  1136. ((*match gen.gfollow#run_f e.etype with
  1137. | TType({ t_path = ([], "UInt") }, []) ->
  1138. write w "( unchecked ((uint) ";
  1139. expr_s w e1;
  1140. write w ") )"
  1141. | _ ->*)
  1142. (* FIXME I'm ignoring module type *)
  1143. print w "((%s) (" (t_s e.etype);
  1144. expr_s w e1;
  1145. write w ") )"
  1146. )
  1147. | TFor (_,_,content) ->
  1148. write w "[ for not supported ";
  1149. expr_s w content;
  1150. write w " ]";
  1151. if !strict_mode then assert false
  1152. | TObjectDecl _ -> write w "[ obj decl not supported ]"; if !strict_mode then assert false
  1153. | TFunction _ -> write w "[ func decl not supported ]"; if !strict_mode then assert false
  1154. | TMatch _ -> write w "[ match not supported ]"; if !strict_mode then assert false
  1155. )
  1156. and do_call w e el =
  1157. let params, el = extract_tparams [] el in
  1158. let params = List.rev params in
  1159. expr_s w e;
  1160. (match params with
  1161. | [] -> ()
  1162. | params ->
  1163. let md = match e.eexpr with
  1164. | TField(ef, _) -> t_to_md (run_follow gen ef.etype)
  1165. | _ -> assert false
  1166. in
  1167. write w "<";
  1168. ignore (List.fold_left (fun acc t ->
  1169. (if acc <> 0 then write w ", ");
  1170. write w (t_s t);
  1171. acc + 1
  1172. ) 0 (change_param_type md params));
  1173. write w ">"
  1174. );
  1175. let rec loop acc elist tlist =
  1176. match elist, tlist with
  1177. | e :: etl, (_,_,t) :: ttl ->
  1178. (if acc <> 0 then write w ", ");
  1179. (match real_type t with
  1180. | TType({ t_path = (["cs"], "Ref") }, _)
  1181. | TAbstract ({ a_path = (["cs"], "Ref") },_) ->
  1182. let e = ensure_local e "of type cs.Ref" in
  1183. write w "ref ";
  1184. expr_s w e
  1185. | TType({ t_path = (["cs"], "Out") }, _)
  1186. | TAbstract ({ a_path = (["cs"], "Out") },_) ->
  1187. let e = ensure_local e "of type cs.Out" in
  1188. write w "out ";
  1189. expr_s w e
  1190. | _ ->
  1191. expr_s w e
  1192. );
  1193. loop (acc + 1) etl ttl
  1194. | e :: etl, [] ->
  1195. (if acc <> 0 then write w ", ");
  1196. expr_s w e;
  1197. loop (acc + 1) etl []
  1198. | _ -> ()
  1199. in
  1200. write w "(";
  1201. let ft = match follow e.etype with
  1202. | TFun(args,_) -> args
  1203. | _ -> []
  1204. in
  1205. loop 0 el ft;
  1206. write w ")"
  1207. in
  1208. expr_s w e
  1209. in
  1210. let get_string_params cl_types =
  1211. match cl_types with
  1212. | [] ->
  1213. ("","")
  1214. | _ ->
  1215. let params = sprintf "<%s>" (String.concat ", " (List.map (fun (_, tcl) -> match follow tcl with | TInst(cl, _) -> snd cl.cl_path | _ -> assert false) cl_types)) in
  1216. let params_extends = List.fold_left (fun acc (name, t) ->
  1217. match run_follow gen t with
  1218. | TInst (cl, p) ->
  1219. (match cl.cl_implements with
  1220. | [] -> acc
  1221. | _ -> acc) (* TODO
  1222. | _ -> (sprintf " where %s : %s" name (String.concat ", " (List.map (fun (cl,p) -> path_param_s (TClassDecl cl) cl.cl_path p) cl.cl_implements))) :: acc ) *)
  1223. | _ -> trace (t_s t); assert false (* FIXME it seems that a cl_types will never be anything other than cl.cl_types. I'll take the risk and fail if not, just to see if that confirms *)
  1224. ) [] cl_types in
  1225. (params, String.concat " " params_extends)
  1226. in
  1227. let rec gen_class_field w ?(is_overload=false) is_static cl is_final cf =
  1228. let is_interface = cl.cl_interface in
  1229. let name, is_new, is_explicit_iface = match cf.cf_name with
  1230. | "new" -> snd cl.cl_path, true, false
  1231. | name when String.contains name '.' ->
  1232. let fn_name, path = parse_explicit_iface name in
  1233. (path_s path) ^ "." ^ fn_name, false, true
  1234. | name -> try
  1235. let binop = PMap.find name binops_names in
  1236. "operator " ^ s_binop binop, false, false
  1237. with | Not_found -> try
  1238. let unop = PMap.find name unops_names in
  1239. "operator " ^ s_unop unop, false, false
  1240. with | Not_found ->
  1241. name, false, false
  1242. in
  1243. let rec loop_static cl =
  1244. match is_static, cl.cl_super with
  1245. | false, _ -> []
  1246. | true, None -> []
  1247. | true, Some(cl,_) ->
  1248. (try
  1249. let cf2 = PMap.find cf.cf_name cl.cl_statics in
  1250. Gencommon.CastDetect.type_eq gen EqStrict cf.cf_type cf2.cf_type;
  1251. ["new"]
  1252. with
  1253. | Not_found | Unify_error _ ->
  1254. loop_static cl
  1255. )
  1256. in
  1257. let modf = loop_static cl in
  1258. (match cf.cf_kind with
  1259. | Var _
  1260. | Method (MethDynamic) when not (Type.is_extern_field cf) ->
  1261. (if is_overload || List.exists (fun cf -> cf.cf_expr <> None) cf.cf_overloads then
  1262. gen.gcon.error "Only normal (non-dynamic) methods can be overloaded" cf.cf_pos);
  1263. if not is_interface then begin
  1264. let access, modifiers = get_fun_modifiers cf.cf_meta "public" [] in
  1265. let modifiers = modifiers @ modf in
  1266. (match cf.cf_expr with
  1267. | Some e ->
  1268. print w "%s %s%s %s %s = " access (if is_static then "static " else "") (String.concat " " modifiers) (t_s (run_follow gen cf.cf_type)) (change_field name);
  1269. expr_s w e;
  1270. write w ";"
  1271. | None ->
  1272. print w "%s %s%s %s %s;" access (if is_static then "static " else "") (String.concat " " modifiers) (t_s (run_follow gen cf.cf_type)) (change_field name)
  1273. )
  1274. end (* TODO see how (get,set) variable handle when they are interfaces *)
  1275. | Method _ when Type.is_extern_field cf || (match cl.cl_kind, cf.cf_expr with | KAbstractImpl _, None -> true | _ -> false) ->
  1276. List.iter (fun cf -> if cl.cl_interface || cf.cf_expr <> None then
  1277. gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
  1278. ) cf.cf_overloads
  1279. | Var _ | Method MethDynamic -> ()
  1280. | Method mkind ->
  1281. List.iter (fun cf ->
  1282. if cl.cl_interface || cf.cf_expr <> None then
  1283. gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
  1284. ) cf.cf_overloads;
  1285. let is_virtual = not is_final && match mkind with | MethInline -> false | _ when not is_new -> true | _ -> false in
  1286. let is_virtual = if not is_virtual || Meta.has Meta.Final cf.cf_meta then false else is_virtual in
  1287. let is_override = List.memq cf cl.cl_overrides in
  1288. let is_override = is_override || match cf.cf_name, follow cf.cf_type with
  1289. | "Equals", TFun([_,_,targ], tret) ->
  1290. (match follow targ, follow tret with
  1291. | TDynamic _, TEnum({ e_path = ([], "Bool") }, [])
  1292. | TDynamic _, TAbstract({ a_path = ([], "Bool") }, []) -> true
  1293. | _ -> false)
  1294. | "GetHashCode", TFun([],_) -> true
  1295. | _ -> false
  1296. in
  1297. let is_virtual = is_virtual && not (Meta.has Meta.Final cl.cl_meta) && not (is_interface) in
  1298. let visibility = if is_interface then "" else "public" in
  1299. let visibility, modifiers = get_fun_modifiers cf.cf_meta visibility [] in
  1300. let modifiers = modifiers @ modf in
  1301. let visibility, is_virtual = if is_explicit_iface then "",false else visibility, is_virtual in
  1302. let v_n = if is_static then "static " else if is_override && not is_interface then "override " else if is_virtual then "virtual " else "" in
  1303. let cf_type = if is_override && not is_overload && not (Meta.has Meta.Overload cf.cf_meta) then match field_access gen (TInst(cl, List.map snd cl.cl_types)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> assert false else cf.cf_type in
  1304. let ret_type, args = match follow cf_type with | TFun (strbtl, t) -> (t, strbtl) | _ -> assert false in
  1305. (* public static void funcName *)
  1306. print w "%s %s %s %s %s" (visibility) v_n (String.concat " " modifiers) (if is_new then "" else rett_s (run_follow gen ret_type)) (change_field name);
  1307. let params, params_ext = get_string_params cf.cf_params in
  1308. (* <T>(string arg1, object arg2) with T : object *)
  1309. (match cf.cf_expr with
  1310. | Some { eexpr = TFunction tf } ->
  1311. print w "%s(%s)%s" (params) (String.concat ", " (List.map2 (fun (var, _) (_,_,t) -> sprintf "%s %s" (argt_s (run_follow gen t)) (change_id var.v_name)) tf.tf_args args)) (params_ext)
  1312. | _ ->
  1313. print w "%s(%s)%s" (params) (String.concat ", " (List.map (fun (name, _, t) -> sprintf "%s %s" (argt_s (run_follow gen t)) (change_id name)) args)) (params_ext)
  1314. );
  1315. if is_interface then
  1316. write w ";"
  1317. else begin
  1318. let rec loop meta =
  1319. match meta with
  1320. | [] ->
  1321. let expr = match cf.cf_expr with
  1322. | None -> mk (TBlock([])) t_dynamic Ast.null_pos
  1323. | Some s ->
  1324. match s.eexpr with
  1325. | TFunction tf ->
  1326. mk_block (tf.tf_expr)
  1327. | _ -> assert false (* FIXME *)
  1328. in
  1329. (if is_new then begin
  1330. let rec get_super_call el =
  1331. match el with
  1332. | ( { eexpr = TCall( { eexpr = TConst(TSuper) }, _) } as call) :: rest ->
  1333. Some call, rest
  1334. | ( { eexpr = TBlock(bl) } as block ) :: rest ->
  1335. let ret, mapped = get_super_call bl in
  1336. ret, ( { block with eexpr = TBlock(mapped) } :: rest )
  1337. | _ ->
  1338. None, el
  1339. in
  1340. match expr.eexpr with
  1341. | TBlock(bl) ->
  1342. let super_call, rest = get_super_call bl in
  1343. (match super_call with
  1344. | None -> ()
  1345. | Some sc ->
  1346. write w " : ";
  1347. let t = Common.timer "expression to string" in
  1348. expr_s w sc;
  1349. t()
  1350. );
  1351. begin_block w;
  1352. write w "unchecked ";
  1353. let t = Common.timer "expression to string" in
  1354. expr_s w { expr with eexpr = TBlock(rest) };
  1355. t();
  1356. write w "#line default";
  1357. end_block w;
  1358. | _ -> assert false
  1359. end else begin
  1360. begin_block w;
  1361. write w "unchecked ";
  1362. let t = Common.timer "expression to string" in
  1363. expr_s w expr;
  1364. t();
  1365. write w "#line default";
  1366. end_block w;
  1367. end)
  1368. | (Meta.FunctionCode, [Ast.EConst (Ast.String contents),_],_) :: tl ->
  1369. begin_block w;
  1370. write w contents;
  1371. end_block w
  1372. | _ :: tl -> loop tl
  1373. in
  1374. loop cf.cf_meta
  1375. end);
  1376. newline w;
  1377. newline w;
  1378. in
  1379. let check_special_behaviors w cl = match cl.cl_kind with
  1380. | KAbstractImpl _ -> ()
  1381. | _ ->
  1382. (* get/set pairs *)
  1383. let pairs = ref PMap.empty in
  1384. (try
  1385. let get = PMap.find "__get" cl.cl_fields in
  1386. List.iter (fun cf ->
  1387. let args,ret = get_fun cf.cf_type in
  1388. match args with
  1389. | [_,_,idx] -> pairs := PMap.add (t_s idx) ( t_s ret, Some cf, None ) !pairs
  1390. | _ -> gen.gcon.warning "The __get function must have exactly one argument (the index)" cf.cf_pos
  1391. ) (get :: get.cf_overloads)
  1392. with | Not_found -> ());
  1393. (try
  1394. let set = PMap.find "__set" cl.cl_fields in
  1395. List.iter (fun cf ->
  1396. let args, ret = get_fun cf.cf_type in
  1397. match args with
  1398. | [_,_,idx; _,_,v] -> (try
  1399. let vt, g, _ = PMap.find (t_s idx) !pairs in
  1400. let tvt = t_s v in
  1401. if vt <> tvt then gen.gcon.warning "The __get function of same index has a different type from this __set function" cf.cf_pos;
  1402. pairs := PMap.add (t_s idx) (vt, g, Some cf) !pairs
  1403. with | Not_found ->
  1404. pairs := PMap.add (t_s idx) (t_s v, None, Some cf) !pairs)
  1405. | _ ->
  1406. gen.gcon.warning "The __set function must have exactly two arguments (index, value)" cf.cf_pos
  1407. ) (set :: set.cf_overloads)
  1408. with | Not_found -> ());
  1409. PMap.iter (fun idx (v, get, set) ->
  1410. print w "public %s this[%s index]" v idx;
  1411. begin_block w;
  1412. (match get with
  1413. | None -> ()
  1414. | Some _ ->
  1415. write w "get";
  1416. begin_block w;
  1417. write w "return this.__get(index);";
  1418. end_block w);
  1419. (match set with
  1420. | None -> ()
  1421. | Some _ ->
  1422. write w "set";
  1423. begin_block w;
  1424. write w "this.__set(index,value);";
  1425. end_block w);
  1426. end_block w) !pairs;
  1427. (if not (PMap.is_empty !pairs) then try
  1428. let get = PMap.find "__get" cl.cl_fields in
  1429. let idx_t, v_t = match follow get.cf_type with
  1430. | TFun([_,_,arg_t],ret_t) ->
  1431. t_s (run_follow gen arg_t), t_s (run_follow gen ret_t)
  1432. | _ -> gen.gcon.error "The __get function must be a function with one argument. " get.cf_pos; assert false
  1433. in
  1434. List.iter (fun (cl,args) ->
  1435. match cl.cl_array_access with
  1436. | None -> ()
  1437. | Some t ->
  1438. let changed_t = apply_params cl.cl_types (List.map (fun _ -> t_dynamic) cl.cl_types) t in
  1439. let t_as_s = t_s (run_follow gen changed_t) in
  1440. print w "%s %s.this[int key]" t_as_s (t_s (TInst(cl, args)));
  1441. begin_block w;
  1442. write w "get";
  1443. begin_block w;
  1444. print w "return ((%s) this.__get(key));" t_as_s;
  1445. end_block w;
  1446. write w "set";
  1447. begin_block w;
  1448. print w "this.__set(key, (%s) value);" v_t;
  1449. end_block w;
  1450. end_block w;
  1451. newline w;
  1452. newline w
  1453. ) cl.cl_implements
  1454. with | Not_found -> ());
  1455. if cl.cl_interface && is_hxgen (TClassDecl cl) && is_some cl.cl_array_access then begin
  1456. let changed_t = apply_params cl.cl_types (List.map (fun _ -> t_dynamic) cl.cl_types) (get cl.cl_array_access) in
  1457. print w "%s this[int key]" (t_s (run_follow gen changed_t));
  1458. begin_block w;
  1459. write w "get;";
  1460. newline w;
  1461. write w "set;";
  1462. newline w;
  1463. end_block w;
  1464. newline w;
  1465. newline w
  1466. end;
  1467. (try
  1468. if cl.cl_interface then raise Not_found;
  1469. let cf = PMap.find "toString" cl.cl_fields in
  1470. (if List.exists (fun c -> c.cf_name = "toString") cl.cl_overrides then raise Not_found);
  1471. (match cf.cf_type with
  1472. | TFun([], ret) ->
  1473. (match real_type ret with
  1474. | TInst( { cl_path = ([], "String") }, []) ->
  1475. write w "public override string ToString()";
  1476. begin_block w;
  1477. write w "return this.toString();";
  1478. end_block w;
  1479. newline w;
  1480. newline w
  1481. | _ ->
  1482. gen.gcon.error "A toString() function should return a String!" cf.cf_pos
  1483. )
  1484. | _ -> ()
  1485. )
  1486. with | Not_found -> ());
  1487. (* properties *
  1488. let handle_prop static f =
  1489. match f.cf_kind with
  1490. | Method _ -> ()
  1491. | Var v when not (Type.is_extern_field f) -> ()
  1492. | Var v ->
  1493. let prop acc = match acc with
  1494. | AccNo | AccNever | AccCall -> true
  1495. | _ -> false
  1496. in
  1497. if prop v.v_read && prop v.v_write && (v.v_read = AccCall || v.v_write = AccCall) then begin
  1498. let this = if static then
  1499. mk_classtype_access cl f.cf_pos
  1500. else
  1501. { eexpr = TConst TThis; etype = TInst(cl,List.map snd cl.cl_types); epos = f.cf_pos }
  1502. in
  1503. print w "public %s%s %s" (if static then "static " else "") (t_s f.cf_type) f.cf_name;
  1504. begin_block w;
  1505. (match v.v_read with
  1506. | AccCall ->
  1507. write w "get";
  1508. begin_block w;
  1509. write w "return ";
  1510. expr_s w this;
  1511. print w ".get_%s();" f.cf_name;
  1512. end_block w
  1513. | _ -> ());
  1514. (match v.v_write with
  1515. | AccCall ->
  1516. write w "set";
  1517. begin_block w;
  1518. expr_s w this;
  1519. print w ".set_%s(value);" f.cf_name;
  1520. end_block w
  1521. | _ -> ());
  1522. end_block w;
  1523. end
  1524. in
  1525. List.iter (handle_prop true) cl.cl_ordered_statics;
  1526. List.iter (handle_prop false) cl.cl_ordered_fields *)
  1527. in
  1528. let gen_class w cl =
  1529. write w "#pragma warning disable 109, 114, 219, 429, 168, 162";
  1530. newline w;
  1531. let should_close = match change_ns (TClassDecl cl) (fst (cl.cl_path)) with
  1532. | [] -> false
  1533. | ns ->
  1534. print w "namespace %s" (String.concat "." ns);
  1535. begin_block w;
  1536. true
  1537. in
  1538. let is_main =
  1539. match gen.gcon.main_class with
  1540. | Some ( (_,"Main") as path) when path = cl.cl_path && not cl.cl_interface ->
  1541. (*
  1542. for cases where the main class is called Main, there will be a problem with creating the entry point there.
  1543. In this special case, a special entry point class will be created
  1544. *)
  1545. write w "public class EntryPoint__Main";
  1546. begin_block w;
  1547. write w "public static void Main()";
  1548. begin_block w;
  1549. (if Hashtbl.mem gen.gtypes (["cs"], "Boot") then write w "cs.Boot.init();"; newline w);
  1550. expr_s w { eexpr = TTypeExpr(TClassDecl cl); etype = t_dynamic; epos = Ast.null_pos };
  1551. write w ".main();";
  1552. end_block w;
  1553. end_block w;
  1554. false
  1555. | Some path when path = cl.cl_path && not cl.cl_interface -> true
  1556. | _ -> false
  1557. in
  1558. let clt, access, modifiers = get_class_modifiers cl.cl_meta (if cl.cl_interface then "interface" else "class") "public" [] in
  1559. let is_final = clt = "struct" || Meta.has Meta.Final cl.cl_meta in
  1560. print w "%s %s %s %s" access (String.concat " " modifiers) clt (change_clname (snd cl.cl_path));
  1561. (* type parameters *)
  1562. let params, params_ext = get_string_params cl.cl_types in
  1563. let extends_implements = (match cl.cl_super with | None -> [] | Some (cl,p) -> [path_param_s (TClassDecl cl) cl.cl_path p]) @ (List.map (fun (cl,p) -> path_param_s (TClassDecl cl) cl.cl_path p) cl.cl_implements) in
  1564. (match extends_implements with
  1565. | [] -> print w "%s %s" params params_ext
  1566. | _ -> print w "%s : %s %s" params (String.concat ", " extends_implements) params_ext);
  1567. (* class head ok: *)
  1568. (* public class Test<A> : X, Y, Z where A : Y *)
  1569. begin_block w;
  1570. (* our constructor is expected to be a normal "new" function *
  1571. if !strict_mode && is_some cl.cl_constructor then assert false;*)
  1572. let rec loop meta =
  1573. match meta with
  1574. | [] -> ()
  1575. | (Meta.ClassCode, [Ast.EConst (Ast.String contents),_],_) :: tl ->
  1576. write w contents
  1577. | _ :: tl -> loop tl
  1578. in
  1579. loop cl.cl_meta;
  1580. if is_main then begin
  1581. write w "public static void Main()";
  1582. begin_block w;
  1583. (if Hashtbl.mem gen.gtypes (["cs"], "Boot") then write w "cs.Boot.init();"; newline w);
  1584. write w "main();";
  1585. end_block w
  1586. end;
  1587. (match cl.cl_init with
  1588. | None -> ()
  1589. | Some init ->
  1590. print w "static %s() " (snd cl.cl_path);
  1591. expr_s w (mk_block init));
  1592. (if is_some cl.cl_constructor then gen_class_field w false cl is_final (get cl.cl_constructor));
  1593. if not cl.cl_interface then List.iter (gen_class_field w true cl is_final) cl.cl_ordered_statics;
  1594. List.iter (gen_class_field w false cl is_final) cl.cl_ordered_fields;
  1595. check_special_behaviors w cl;
  1596. end_block w;
  1597. if cl.cl_interface && cl.cl_ordered_statics <> [] then begin
  1598. print w "public class %s__Statics_" (snd cl.cl_path);
  1599. begin_block w;
  1600. List.iter (gen_class_field w true { cl with cl_interface = false } is_final) cl.cl_ordered_statics;
  1601. end_block w
  1602. end;
  1603. if should_close then end_block w
  1604. in
  1605. let gen_enum w e =
  1606. let should_close = match change_ns (TEnumDecl e) (fst e.e_path) with
  1607. | [] -> false
  1608. | ns ->
  1609. print w "namespace %s" (String.concat "." ns);
  1610. begin_block w;
  1611. true
  1612. in
  1613. print w "public enum %s" (change_clname (snd e.e_path));
  1614. begin_block w;
  1615. write w (String.concat ", " (List.map (change_id) e.e_names));
  1616. end_block w;
  1617. if should_close then end_block w
  1618. in
  1619. let module_type_gen w md_tp =
  1620. match md_tp with
  1621. | TClassDecl cl ->
  1622. if not cl.cl_extern then begin
  1623. (if no_root && len w = 0 then write w "using haxe.root;"; newline w;);
  1624. gen_class w cl;
  1625. newline w;
  1626. newline w
  1627. end;
  1628. (not cl.cl_extern)
  1629. | TEnumDecl e ->
  1630. if not e.e_extern then begin
  1631. (if no_root && len w = 0 then write w "using haxe.root;"; newline w;);
  1632. gen_enum w e;
  1633. newline w;
  1634. newline w
  1635. end;
  1636. (not e.e_extern)
  1637. | TAbstractDecl _
  1638. | TTypeDecl _ ->
  1639. false
  1640. in
  1641. let module_gen w md_def =
  1642. List.fold_left (fun should md -> module_type_gen w md or should) false md_def.m_types
  1643. in
  1644. (* generate source code *)
  1645. init_ctx gen;
  1646. Hashtbl.add gen.gspecial_vars "__rethrow__" true;
  1647. Hashtbl.add gen.gspecial_vars "__typeof__" true;
  1648. Hashtbl.add gen.gspecial_vars "__label__" true;
  1649. Hashtbl.add gen.gspecial_vars "__goto__" true;
  1650. Hashtbl.add gen.gspecial_vars "__is__" true;
  1651. Hashtbl.add gen.gspecial_vars "__as__" true;
  1652. Hashtbl.add gen.gspecial_vars "__cs__" true;
  1653. Hashtbl.add gen.gspecial_vars "__checked__" true;
  1654. Hashtbl.add gen.gspecial_vars "__lock__" true;
  1655. Hashtbl.add gen.gspecial_vars "__fixed__" true;
  1656. Hashtbl.add gen.gspecial_vars "__unsafe__" true;
  1657. Hashtbl.add gen.gspecial_vars "__addressOf__" true;
  1658. Hashtbl.add gen.gspecial_vars "__valueOf__" true;
  1659. Hashtbl.add gen.gspecial_vars "__sizeof__" true;
  1660. Hashtbl.add gen.gsupported_conversions (["haxe"; "lang"], "Null") (fun t1 t2 -> true);
  1661. let last_needs_box = gen.gneeds_box in
  1662. gen.gneeds_box <- (fun t -> match t with | TInst( { cl_path = (["haxe"; "lang"], "Null") }, _ ) -> true | _ -> last_needs_box t);
  1663. gen.greal_type <- real_type;
  1664. gen.greal_type_param <- change_param_type;
  1665. SetHXGen.run_filter gen SetHXGen.default_hxgen_func;
  1666. (* before running the filters, follow all possible types *)
  1667. (* this is needed so our module transformations don't break some core features *)
  1668. (* like multitype selection *)
  1669. let run_follow_gen = run_follow gen in
  1670. let rec type_map e = Type.map_expr_type (fun e->type_map e) (run_follow_gen) (fun tvar-> tvar.v_type <- (run_follow_gen tvar.v_type); tvar) e in
  1671. let super_map (cl,tl) = (cl, List.map run_follow_gen tl) in
  1672. List.iter (function
  1673. | TClassDecl cl ->
  1674. let all_fields = (Option.map_default (fun cf -> [cf]) [] cl.cl_constructor) @ cl.cl_ordered_fields @ cl.cl_ordered_statics in
  1675. List.iter (fun cf ->
  1676. cf.cf_type <- run_follow_gen cf.cf_type;
  1677. cf.cf_expr <- Option.map type_map cf.cf_expr
  1678. ) all_fields;
  1679. cl.cl_dynamic <- Option.map run_follow_gen cl.cl_dynamic;
  1680. cl.cl_array_access <- Option.map run_follow_gen cl.cl_array_access;
  1681. cl.cl_init <- Option.map type_map cl.cl_init;
  1682. cl.cl_super <- Option.map super_map cl.cl_super;
  1683. cl.cl_implements <- List.map super_map cl.cl_implements
  1684. | _ -> ()
  1685. ) gen.gcon.types;
  1686. let closure_t = ClosuresToClass.DoubleAndDynamicClosureImpl.get_ctx gen 6 in
  1687. (*let closure_t = ClosuresToClass.create gen 10 float_cl
  1688. (fun l -> l)
  1689. (fun l -> l)
  1690. (fun args -> args)
  1691. (fun args -> [])
  1692. in
  1693. ClosuresToClass.configure gen (ClosuresToClass.default_implementation closure_t (fun e _ _ -> e));
  1694. StubClosureImpl.configure gen (StubClosureImpl.default_implementation gen float_cl 10 (fun e _ _ -> e));*)
  1695. let tp_v = alloc_var "$type_param" t_dynamic in
  1696. let mk_tp t pos = { eexpr = TLocal(tp_v); etype = t; epos = pos } in
  1697. TypeParams.configure gen (fun ecall efield params elist ->
  1698. match efield.eexpr with
  1699. | TField(_, FEnum _) ->
  1700. { ecall with eexpr = TCall(efield, elist) }
  1701. | _ ->
  1702. { ecall with eexpr = TCall(efield, (List.map (fun t -> mk_tp t ecall.epos ) params) @ elist) }
  1703. );
  1704. HardNullableSynf.configure gen (HardNullableSynf.traverse gen
  1705. (fun e ->
  1706. match real_type e.etype with
  1707. | TInst({ cl_path = (["haxe";"lang"], "Null") }, [t]) ->
  1708. { (mk_field_access gen e "value" e.epos) with etype = t }
  1709. | _ ->
  1710. trace (debug_type e.etype); gen.gcon.error "This expression is not a Nullable expression" e.epos; assert false
  1711. )
  1712. (fun v t has_value ->
  1713. match has_value, real_type v.etype with
  1714. | true, TDynamic _ | true, TAnon _ | true, TMono _ ->
  1715. {
  1716. eexpr = TCall(mk_static_field_access_infer null_t "ofDynamic" v.epos [t], [mk_tp t v.epos; v]);
  1717. etype = TInst(null_t, [t]);
  1718. epos = v.epos
  1719. }
  1720. | _ ->
  1721. { eexpr = TNew(null_t, [t], [gen.ghandle_cast t v.etype v; { eexpr = TConst(TBool has_value); etype = gen.gcon.basic.tbool; epos = v.epos } ]); etype = TInst(null_t, [t]); epos = v.epos }
  1722. )
  1723. (fun e ->
  1724. {
  1725. eexpr = TCall(
  1726. { (mk_field_access gen { (mk_paren e) with etype = real_type e.etype } "toDynamic" e.epos) with etype = TFun([], t_dynamic) },
  1727. []);
  1728. etype = t_dynamic;
  1729. epos = e.epos
  1730. }
  1731. )
  1732. (fun e ->
  1733. mk_field_access gen { e with etype = real_type e.etype } "hasValue" e.epos
  1734. )
  1735. (fun e1 e2 ->
  1736. {
  1737. eexpr = TCall(
  1738. mk_field_access gen e1 "Equals" e1.epos,
  1739. [e2]);
  1740. etype = basic.tbool;
  1741. epos = e1.epos;
  1742. }
  1743. )
  1744. true
  1745. false
  1746. );
  1747. let explicit_fn_name c tl fname =
  1748. path_param_s (TClassDecl c) c.cl_path tl ^ "." ^ fname
  1749. in
  1750. FixOverrides.configure ~explicit_fn_name:explicit_fn_name gen;
  1751. NormalizeType.configure gen;
  1752. AbstractImplementationFix.configure gen;
  1753. IteratorsInterface.configure gen (fun e -> e);
  1754. OverrideFix.configure gen;
  1755. ClosuresToClass.configure gen (ClosuresToClass.default_implementation closure_t (get_cl (get_type gen (["haxe";"lang"],"Function")) ));
  1756. EnumToClass.configure gen (Some (fun e -> mk_cast gen.gcon.basic.tint e)) false true (get_cl (get_type gen (["haxe";"lang"],"Enum")) ) true false;
  1757. InterfaceVarsDeleteModf.configure gen;
  1758. let dynamic_object = (get_cl (get_type gen (["haxe";"lang"],"DynamicObject")) ) in
  1759. let object_iface = get_cl (get_type gen (["haxe";"lang"],"IHxObject")) in
  1760. (*fixme: THIS IS A HACK. take this off *)
  1761. let empty_e = match (get_type gen (["haxe";"lang"], "EmptyObject")) with | TEnumDecl e -> e | _ -> assert false in
  1762. (*OverloadingCtor.set_new_create_empty gen ({eexpr=TEnumField(empty_e, "EMPTY"); etype=TEnum(empty_e,[]); epos=null_pos;});*)
  1763. let empty_expr = { eexpr = (TTypeExpr (TEnumDecl empty_e)); etype = (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics empty_e) }); epos = null_pos } in
  1764. let empty_ef =
  1765. try
  1766. PMap.find "EMPTY" empty_e.e_constrs
  1767. with Not_found -> gen.gcon.error "Required enum field EMPTY was not found" empty_e.e_pos; assert false
  1768. in
  1769. OverloadingConstructor.configure ~empty_ctor_type:(TEnum(empty_e, [])) ~empty_ctor_expr:({ eexpr=TField(empty_expr, FEnum(empty_e, empty_ef)); etype=TEnum(empty_e,[]); epos=null_pos; }) ~supports_ctor_inheritance:false gen;
  1770. let rcf_static_find = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "findHash" Ast.null_pos [] in
  1771. let rcf_static_lookup = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "lookupHash" Ast.null_pos [] in
  1772. let can_be_float = like_float in
  1773. let rcf_on_getset_field main_expr field_expr field may_hash may_set is_unsafe =
  1774. let is_float = can_be_float (real_type main_expr.etype) in
  1775. let fn_name = if is_some may_set then "setField" else "getField" in
  1776. let fn_name = if is_float then fn_name ^ "_f" else fn_name in
  1777. let pos = field_expr.epos in
  1778. let is_unsafe = { eexpr = TConst(TBool is_unsafe); etype = basic.tbool; epos = pos } in
  1779. let should_cast = match main_expr.etype with | TInst({ cl_path = ([], "Float") }, []) -> false | _ -> true in
  1780. let infer = mk_static_field_access_infer runtime_cl fn_name field_expr.epos [] in
  1781. let first_args =
  1782. [ field_expr; { eexpr = TConst(TString field); etype = basic.tstring; epos = pos } ]
  1783. @ if is_some may_hash then [ { eexpr = TConst(TInt (get may_hash)); etype = basic.tint; epos = pos } ] else []
  1784. in
  1785. let args = first_args @ match is_float, may_set with
  1786. | true, Some(set) ->
  1787. [ if should_cast then mk_cast basic.tfloat set else set ]
  1788. | false, Some(set) ->
  1789. [ set ]
  1790. | _ ->
  1791. [ is_unsafe ]
  1792. in
  1793. let call = { main_expr with eexpr = TCall(infer,args) } in
  1794. let call = if is_float && should_cast then mk_cast main_expr.etype call else call in
  1795. call
  1796. in
  1797. let rcf_on_call_field ecall field_expr field may_hash args =
  1798. let infer = mk_static_field_access_infer runtime_cl "callField" field_expr.epos [] in
  1799. let hash_arg = match may_hash with
  1800. | None -> []
  1801. | Some h -> [ { eexpr = TConst(TInt h); etype = basic.tint; epos = field_expr.epos } ]
  1802. in
  1803. let arr_call = if args <> [] then
  1804. { eexpr = TArrayDecl args; etype = basic.tarray t_dynamic; epos = ecall.epos }
  1805. else
  1806. null (basic.tarray t_dynamic) ecall.epos
  1807. in
  1808. let call_args =
  1809. [field_expr; { field_expr with eexpr = TConst(TString field); etype = basic.tstring } ]
  1810. @ hash_arg
  1811. @ [ arr_call ]
  1812. in
  1813. mk_cast ecall.etype { ecall with eexpr = TCall(infer, call_args) }
  1814. in
  1815. handle_type_params gen ifaces (get_cl (get_type gen (["haxe";"lang"], "IGenericObject")));
  1816. let rcf_ctx = ReflectionCFs.new_ctx gen closure_t object_iface true rcf_on_getset_field rcf_on_call_field (fun hash hash_array ->
  1817. { hash with eexpr = TCall(rcf_static_find, [hash; hash_array]); etype=basic.tint }
  1818. ) (fun hash -> { hash with eexpr = TCall(rcf_static_lookup, [hash]); etype = gen.gcon.basic.tstring } ) false in
  1819. ReflectionCFs.UniversalBaseClass.default_config gen (get_cl (get_type gen (["haxe";"lang"],"HxObject")) ) object_iface dynamic_object;
  1820. ReflectionCFs.configure_dynamic_field_access rcf_ctx false;
  1821. (* let closure_func = ReflectionCFs.implement_closure_cl rcf_ctx ( get_cl (get_type gen (["haxe";"lang"],"Closure")) ) in *)
  1822. let closure_cl = get_cl (get_type gen (["haxe";"lang"],"Closure")) in
  1823. let varargs_cl = get_cl (get_type gen (["haxe";"lang"],"VarArgsFunction")) in
  1824. let dynamic_name = gen.gmk_internal_name "hx" "invokeDynamic" in
  1825. List.iter (fun cl ->
  1826. List.iter (fun cf ->
  1827. if cf.cf_name = dynamic_name then cl.cl_overrides <- cf :: cl.cl_overrides
  1828. ) cl.cl_ordered_fields
  1829. ) [closure_cl; varargs_cl];
  1830. let closure_func = ReflectionCFs.get_closure_func rcf_ctx closure_cl in
  1831. ReflectionCFs.implement_varargs_cl rcf_ctx ( get_cl (get_type gen (["haxe";"lang"], "VarArgsBase")) );
  1832. let slow_invoke = mk_static_field_access_infer (runtime_cl) "slowCallField" Ast.null_pos [] in
  1833. ReflectionCFs.configure rcf_ctx ~slow_invoke:(fun ethis efield eargs -> {
  1834. eexpr = TCall(slow_invoke, [ethis; efield; eargs]);
  1835. etype = t_dynamic;
  1836. epos = ethis.epos;
  1837. } ) object_iface;
  1838. let objdecl_fn = ReflectionCFs.implement_dynamic_object_ctor rcf_ctx dynamic_object in
  1839. ObjectDeclMap.configure gen (ObjectDeclMap.traverse gen objdecl_fn);
  1840. InitFunction.configure gen true;
  1841. TArrayTransform.configure gen (TArrayTransform.default_implementation gen (
  1842. fun e ->
  1843. match e.eexpr with
  1844. | TArray(e1, e2) ->
  1845. ( match follow e1.etype with
  1846. | TDynamic _ | TAnon _ | TMono _ -> true
  1847. | TInst({ cl_kind = KTypeParameter _ }, _) -> true
  1848. | _ -> false )
  1849. | _ -> assert false
  1850. ) "__get" "__set" );
  1851. let field_is_dynamic t field =
  1852. match field_access gen (gen.greal_type t) field with
  1853. | FEnumField _
  1854. | FClassField _ -> false
  1855. | _ -> true
  1856. in
  1857. let is_type_param e = match follow e with
  1858. | TInst( { cl_kind = KTypeParameter _ },[]) -> true
  1859. | _ -> false
  1860. in
  1861. let is_dynamic_expr e = is_dynamic e.etype || match e.eexpr with
  1862. | TField(tf, f) -> field_is_dynamic tf.etype (field_name f)
  1863. | _ -> false
  1864. in
  1865. let may_nullable t = match gen.gfollow#run_f t with
  1866. | TType({ t_path = ([], "Null") }, [t]) ->
  1867. (match follow t with
  1868. | TInst({ cl_path = ([], "String") }, [])
  1869. | TInst({ cl_path = ([], "Float") }, [])
  1870. | TAbstract ({ a_path = ([], "Float") },[])
  1871. | TInst({ cl_path = (["haxe"], "Int32")}, [] )
  1872. | TInst({ cl_path = (["haxe"], "Int64")}, [] )
  1873. | TInst({ cl_path = ([], "Int") }, [])
  1874. | TAbstract ({ a_path = ([], "Int") },[])
  1875. | TEnum({ e_path = ([], "Bool") }, [])
  1876. | TAbstract ({ a_path = ([], "Bool") },[]) -> Some t
  1877. | TAbstract _ when like_float t -> Some t
  1878. | _ -> None )
  1879. | _ -> None
  1880. in
  1881. let is_double t = like_float t && not (like_int t) in
  1882. let is_int t = like_int t in
  1883. let is_null t = match real_type t with
  1884. | TInst( { cl_path = (["haxe";"lang"], "Null") }, _ ) -> true
  1885. | _ -> false
  1886. in
  1887. let is_null_expr e = is_null e.etype || match e.eexpr with
  1888. | TField(tf, f) -> (match field_access gen (real_type tf.etype) (field_name f) with
  1889. | FClassField(_,_,_,_,_,actual_t,_) -> is_null actual_t
  1890. | _ -> false)
  1891. | _ -> false
  1892. in
  1893. let should_handle_opeq t =
  1894. match real_type t with
  1895. | TDynamic _ | TAnon _ | TMono _
  1896. | TInst( { cl_kind = KTypeParameter _ }, _ )
  1897. | TInst( { cl_path = (["haxe";"lang"], "Null") }, _ ) -> true
  1898. | _ -> false
  1899. in
  1900. let string_cl = match gen.gcon.basic.tstring with
  1901. | TInst(c,[]) -> c
  1902. | _ -> assert false
  1903. in
  1904. DynamicOperators.configure gen
  1905. (DynamicOperators.abstract_implementation gen (fun e -> match e.eexpr with
  1906. | TBinop (Ast.OpEq, e1, e2)
  1907. | TBinop (Ast.OpNotEq, e1, e2) -> should_handle_opeq e1.etype or should_handle_opeq e2.etype
  1908. | TBinop (Ast.OpAssignOp Ast.OpAdd, e1, e2) ->
  1909. is_dynamic_expr e1 || is_null_expr e1 || is_string e.etype
  1910. | TBinop (Ast.OpAdd, e1, e2) -> is_dynamic e1.etype or is_dynamic e2.etype or is_type_param e1.etype or is_type_param e2.etype or is_string e1.etype or is_string e2.etype or is_string e.etype
  1911. | TBinop (Ast.OpLt, e1, e2)
  1912. | TBinop (Ast.OpLte, e1, e2)
  1913. | TBinop (Ast.OpGte, e1, e2)
  1914. | TBinop (Ast.OpGt, e1, e2) -> is_dynamic e.etype or is_dynamic_expr e1 or is_dynamic_expr e2 or is_string e1.etype or is_string e2.etype
  1915. | TBinop (_, e1, e2) -> is_dynamic e.etype or is_dynamic_expr e1 or is_dynamic_expr e2
  1916. | TUnop (_, _, e1) -> is_dynamic_expr e1 || is_null_expr e1 (* we will see if the expression is Null<T> also, as the unwrap from Unop will be the same *)
  1917. | _ -> false)
  1918. (fun e1 e2 ->
  1919. let is_basic = is_cs_basic_type (follow e1.etype) || is_cs_basic_type (follow e2.etype) in
  1920. let is_ref = if is_basic then false else match follow e1.etype, follow e2.etype with
  1921. | TDynamic _, _
  1922. | _, TDynamic _
  1923. | TInst( { cl_path = ([], "String") }, [] ), _
  1924. | _, TInst( { cl_path = ([], "String") }, [] )
  1925. | TInst( { cl_kind = KTypeParameter _ }, [] ), _
  1926. | _, TInst( { cl_kind = KTypeParameter _ }, [] ) -> false
  1927. | _, _ -> true
  1928. in
  1929. let static = mk_static_field_access_infer (runtime_cl) (if is_ref then "refEq" else "eq") e1.epos [] in
  1930. { eexpr = TCall(static, [e1; e2]); etype = gen.gcon.basic.tbool; epos=e1.epos }
  1931. )
  1932. (fun e e1 e2 ->
  1933. match may_nullable e1.etype, may_nullable e2.etype with
  1934. | Some t1, Some t2 ->
  1935. let t1, t2 = if is_string t1 || is_string t2 then
  1936. basic.tstring, basic.tstring
  1937. else if is_double t1 || is_double t2 then
  1938. basic.tfloat, basic.tfloat
  1939. else if is_int t1 || is_int t2 then
  1940. basic.tint, basic.tint
  1941. else t1, t2 in
  1942. { eexpr = TBinop(Ast.OpAdd, mk_cast t1 e1, mk_cast t2 e2); etype = e.etype; epos = e1.epos }
  1943. | _ when is_string e.etype || is_string e1.etype || is_string e2.etype ->
  1944. {
  1945. eexpr = TCall(
  1946. mk_static_field_access_infer runtime_cl "concat" e.epos [],
  1947. [ e1; e2 ]
  1948. );
  1949. etype = basic.tstring;
  1950. epos = e.epos
  1951. }
  1952. | _ ->
  1953. let static = mk_static_field_access_infer (runtime_cl) "plus" e1.epos [] in
  1954. mk_cast e.etype { eexpr = TCall(static, [e1; e2]); etype = t_dynamic; epos=e1.epos })
  1955. (fun e1 e2 ->
  1956. if is_string e1.etype then begin
  1957. { e1 with eexpr = TCall(mk_static_field_access_infer string_cl "Compare" e1.epos [], [ e1; e2 ]); etype = gen.gcon.basic.tint }
  1958. end else begin
  1959. let static = mk_static_field_access_infer (runtime_cl) "compare" e1.epos [] in
  1960. { eexpr = TCall(static, [e1; e2]); etype = gen.gcon.basic.tint; epos=e1.epos }
  1961. end) ~handle_strings:false);
  1962. FilterClosures.configure gen (FilterClosures.traverse gen (fun e1 s -> true) closure_func);
  1963. let base_exception = get_cl (get_type gen (["System"], "Exception")) in
  1964. let base_exception_t = TInst(base_exception, []) in
  1965. let hx_exception = get_cl (get_type gen (["haxe";"lang"], "HaxeException")) in
  1966. let hx_exception_t = TInst(hx_exception, []) in
  1967. let rec is_exception t =
  1968. match follow t with
  1969. | TInst(cl,_) ->
  1970. if cl == base_exception then
  1971. true
  1972. else
  1973. (match cl.cl_super with | None -> false | Some (cl,arg) -> is_exception (TInst(cl,arg)))
  1974. | _ -> false
  1975. in
  1976. TryCatchWrapper.configure gen
  1977. (
  1978. TryCatchWrapper.traverse gen
  1979. (fun t -> not (is_exception (real_type t)))
  1980. (fun throwexpr expr ->
  1981. let wrap_static = mk_static_field_access (hx_exception) "wrap" (TFun([("obj",false,t_dynamic)], base_exception_t)) expr.epos in
  1982. { throwexpr with eexpr = TThrow { expr with eexpr = TCall(wrap_static, [expr]); etype = hx_exception_t }; etype = gen.gcon.basic.tvoid }
  1983. )
  1984. (fun v_to_unwrap pos ->
  1985. let local = mk_cast hx_exception_t { eexpr = TLocal(v_to_unwrap); etype = v_to_unwrap.v_type; epos = pos } in
  1986. mk_field_access gen local "obj" pos
  1987. )
  1988. (fun rethrow ->
  1989. { rethrow with eexpr = TCall(mk_local (alloc_var "__rethrow__" t_dynamic) rethrow.epos, [rethrow]); etype = gen.gcon.basic.tvoid }
  1990. )
  1991. (base_exception_t)
  1992. (hx_exception_t)
  1993. (fun v e -> e)
  1994. );
  1995. let get_typeof e =
  1996. { e with eexpr = TCall( { eexpr = TLocal( alloc_var "__typeof__" t_dynamic ); etype = t_dynamic; epos = e.epos }, [e] ) }
  1997. in
  1998. ClassInstance.configure gen (ClassInstance.traverse gen (fun e mt ->
  1999. get_typeof e
  2000. ));
  2001. CastDetect.configure gen (CastDetect.default_implementation gen (Some (TEnum(empty_e, []))) true ~native_string_cast:false ~overloads_cast_to_base:true);
  2002. (*FollowAll.configure gen;*)
  2003. SwitchToIf.configure gen (SwitchToIf.traverse gen (fun e ->
  2004. match e.eexpr with
  2005. | TSwitch(cond, cases, def) ->
  2006. (match gen.gfollow#run_f cond.etype with
  2007. | TInst({ cl_path = ([], "Int") },[])
  2008. | TAbstract ({ a_path = ([], "Int") },[])
  2009. | TInst({ cl_path = ([], "String") },[]) ->
  2010. (List.exists (fun (c,_) ->
  2011. List.exists (fun expr -> match expr.eexpr with | TConst _ -> false | _ -> true ) c
  2012. ) cases)
  2013. | _ -> true
  2014. )
  2015. | _ -> assert false
  2016. ) true ) ;
  2017. ExpressionUnwrap.configure gen (ExpressionUnwrap.traverse gen (fun e -> Some { eexpr = TVars([mk_temp gen "expr" e.etype, Some e]); etype = gen.gcon.basic.tvoid; epos = e.epos }));
  2018. UnnecessaryCastsRemoval.configure gen;
  2019. IntDivisionSynf.configure gen (IntDivisionSynf.default_implementation gen true);
  2020. UnreachableCodeEliminationSynf.configure gen (UnreachableCodeEliminationSynf.traverse gen false true true false);
  2021. let native_arr_cl = get_cl ( get_type gen (["cs"], "NativeArray") ) in
  2022. ArrayDeclSynf.configure gen (ArrayDeclSynf.default_implementation gen native_arr_cl);
  2023. let goto_special = alloc_var "__goto__" t_dynamic in
  2024. let label_special = alloc_var "__label__" t_dynamic in
  2025. SwitchBreakSynf.configure gen (SwitchBreakSynf.traverse gen
  2026. (fun e_loop n api ->
  2027. api ({ eexpr = TCall( mk_local label_special e_loop.epos, [ mk_int gen n e_loop.epos ] ); etype = t_dynamic; epos = e_loop.epos }) false;
  2028. e_loop
  2029. )
  2030. (fun e_break n api ->
  2031. { eexpr = TCall( mk_local goto_special e_break.epos, [ mk_int gen n e_break.epos ] ); etype = t_dynamic; epos = e_break.epos }
  2032. )
  2033. );
  2034. DefaultArguments.configure gen (DefaultArguments.traverse gen);
  2035. CSharpSpecificSynf.configure gen (CSharpSpecificSynf.traverse gen runtime_cl);
  2036. CSharpSpecificESynf.configure gen (CSharpSpecificESynf.traverse gen runtime_cl);
  2037. let mkdir dir = if not (Sys.file_exists dir) then Unix.mkdir dir 0o755 in
  2038. mkdir gen.gcon.file;
  2039. mkdir (gen.gcon.file ^ "/src");
  2040. (* add resources array *)
  2041. (try
  2042. let res = get_cl (Hashtbl.find gen.gtypes (["haxe"], "Resource")) in
  2043. mkdir (gen.gcon.file ^ "/src/Resources");
  2044. let cf = PMap.find "content" res.cl_statics in
  2045. let res = ref [] in
  2046. Hashtbl.iter (fun name v ->
  2047. res := { eexpr = TConst(TString name); etype = gen.gcon.basic.tstring; epos = Ast.null_pos } :: !res;
  2048. let f = open_out (gen.gcon.file ^ "/src/Resources/" ^ name) in
  2049. output_string f v;
  2050. close_out f
  2051. ) gen.gcon.resources;
  2052. cf.cf_expr <- Some ({ eexpr = TArrayDecl(!res); etype = gen.gcon.basic.tarray gen.gcon.basic.tstring; epos = Ast.null_pos })
  2053. with | Not_found -> ());
  2054. run_filters gen;
  2055. (* after the filters have been run, add all hashed fields to FieldLookup *)
  2056. let normalize_i i =
  2057. let i = Int32.of_int (i) in
  2058. if i < Int32.zero then
  2059. Int32.logor (Int32.logand i (Int32.of_int 0x3FFFFFFF)) (Int32.shift_left Int32.one 30)
  2060. else i
  2061. in
  2062. let hashes = Hashtbl.fold (fun i s acc -> (normalize_i i,s) :: acc) rcf_ctx.rcf_hash_fields [] in
  2063. let hashes = List.sort (fun (i,s) (i2,s2) -> compare i i2) hashes in
  2064. let flookup_cl = get_cl (get_type gen (["haxe";"lang"], "FieldLookup")) in
  2065. (try
  2066. let basic = gen.gcon.basic in
  2067. let change_array = ArrayDeclSynf.default_implementation gen native_arr_cl in
  2068. let cl = flookup_cl in
  2069. let field_ids = PMap.find "fieldIds" cl.cl_statics in
  2070. let fields = PMap.find "fields" cl.cl_statics in
  2071. field_ids.cf_expr <- Some (change_array {
  2072. eexpr = TArrayDecl(List.map (fun (i,s) -> { eexpr = TConst(TInt (i)); etype = basic.tint; epos = field_ids.cf_pos }) hashes);
  2073. etype = basic.tarray basic.tint;
  2074. epos = field_ids.cf_pos
  2075. });
  2076. fields.cf_expr <- Some (change_array {
  2077. eexpr = TArrayDecl(List.map (fun (i,s) -> { eexpr = TConst(TString s); etype = basic.tstring; epos = fields.cf_pos }) hashes);
  2078. etype = basic.tarray basic.tstring;
  2079. epos = fields.cf_pos
  2080. })
  2081. with | Not_found ->
  2082. gen.gcon.error "Fields 'fieldIds' and 'fields' were not found in class haxe.lang.FieldLookup" flookup_cl.cl_pos
  2083. );
  2084. TypeParams.RenameTypeParameters.run gen;
  2085. let t = Common.timer "code generation" in
  2086. generate_modules gen "cs" "src" module_gen;
  2087. dump_descriptor gen ("hxcs_build.txt") path_s module_s;
  2088. if ( not (Common.defined gen.gcon Define.NoCompilation) ) then begin
  2089. let old_dir = Sys.getcwd() in
  2090. Sys.chdir gen.gcon.file;
  2091. let cmd = "haxelib run hxcs hxcs_build.txt --haxe-version " ^ (string_of_int gen.gcon.version) in
  2092. print_endline cmd;
  2093. if gen.gcon.run_command cmd <> 0 then failwith "Build failed";
  2094. Sys.chdir old_dir;
  2095. end;
  2096. t()
  2097. (* end of configure function *)
  2098. let before_generate con =
  2099. ()
  2100. let generate con =
  2101. (try
  2102. let gen = new_ctx con in
  2103. let basic = con.basic in
  2104. (* make the basic functions in C# *)
  2105. let type_cl = get_cl ( get_type gen (["System"], "Type")) in
  2106. let basic_fns =
  2107. [
  2108. mk_class_field "Equals" (TFun(["obj",false,t_dynamic], basic.tbool)) true Ast.null_pos (Method MethNormal) [];
  2109. mk_class_field "ToString" (TFun([], basic.tstring)) true Ast.null_pos (Method MethNormal) [];
  2110. mk_class_field "GetHashCode" (TFun([], basic.tint)) true Ast.null_pos (Method MethNormal) [];
  2111. mk_class_field "GetType" (TFun([], TInst(type_cl, []))) true Ast.null_pos (Method MethNormal) [];
  2112. ] in
  2113. List.iter (fun cf -> gen.gbase_class_fields <- PMap.add cf.cf_name cf gen.gbase_class_fields) basic_fns;
  2114. configure gen
  2115. with | TypeNotFound path ->
  2116. con.error ("Error. Module '" ^ (path_s path) ^ "' is required and was not included in build.") Ast.null_pos);
  2117. debug_mode := false