2
0

gencs.ml 160 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557
  1. (*
  2. The Haxe Compiler
  3. Copyright (C) 2005-2015 Haxe Foundation
  4. This program is free software; you can redistribute it and/or
  5. modify it under the terms of the GNU General Public License
  6. as published by the Free Software Foundation; either version 2
  7. of the License, or (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  15. *)
  16. open Gencommon.ReflectionCFs
  17. open Ast
  18. open Common
  19. open Type
  20. open Gencommon
  21. open Gencommon.SourceWriter
  22. open Printf
  23. open Option
  24. open ExtString
  25. let netname_to_hx name =
  26. let len = String.length name in
  27. let chr = String.get name 0 in
  28. String.make 1 (Char.uppercase chr) ^ (String.sub name 1 (len-1))
  29. let rec is_cs_basic_type t =
  30. match follow t with
  31. | TInst( { cl_path = (["haxe"], "Int32") }, [] )
  32. | TInst( { cl_path = (["haxe"], "Int64") }, [] )
  33. | TAbstract ({ a_path = (["cs"], "Int64") },[])
  34. | TAbstract ({ a_path = (["cs"], "UInt64") },[])
  35. | TAbstract ({ a_path = ([], "Int") },[])
  36. | TAbstract ({ a_path = ([], "Float") },[])
  37. | TAbstract ({ a_path = ([], "Bool") },[]) ->
  38. true
  39. | TAbstract ({ a_path = (["cs"], "Pointer") },_) ->
  40. false
  41. | TAbstract _ when like_float t ->
  42. true
  43. | TAbstract(a,pl) when not (Meta.has Meta.CoreType a.a_meta) ->
  44. is_cs_basic_type (Abstract.get_underlying_type a pl)
  45. | TEnum(e, _) when not (Meta.has Meta.Class e.e_meta) -> true
  46. | TInst(cl, _) when Meta.has Meta.Struct cl.cl_meta -> true
  47. | _ -> false
  48. (* see http://msdn.microsoft.com/en-us/library/2sk3x8a7(v=vs.71).aspx *)
  49. let cs_binops =
  50. [Ast.OpAdd, "op_Addition";
  51. Ast.OpSub, "op_Subtraction";
  52. Ast.OpMult, "op_Multiply";
  53. Ast.OpDiv, "op_Division";
  54. Ast.OpMod, "op_Modulus";
  55. Ast.OpXor, "op_ExclusiveOr";
  56. Ast.OpOr, "op_BitwiseOr";
  57. Ast.OpAnd, "op_BitwiseAnd";
  58. Ast.OpBoolAnd, "op_LogicalAnd";
  59. Ast.OpBoolOr, "op_LogicalOr";
  60. Ast.OpAssign, "op_Assign";
  61. Ast.OpShl, "op_LeftShift";
  62. Ast.OpShr, "op_RightShift";
  63. Ast.OpShr, "op_SignedRightShift";
  64. Ast.OpUShr, "op_UnsignedRightShift";
  65. Ast.OpEq, "op_Equality";
  66. Ast.OpGt, "op_GreaterThan";
  67. Ast.OpLt, "op_LessThan";
  68. Ast.OpNotEq, "op_Inequality";
  69. Ast.OpGte, "op_GreaterThanOrEqual";
  70. Ast.OpLte, "op_LessThanOrEqual";
  71. Ast.OpAssignOp Ast.OpMult, "op_MultiplicationAssignment";
  72. Ast.OpAssignOp Ast.OpSub, "op_SubtractionAssignment";
  73. Ast.OpAssignOp Ast.OpXor, "op_ExclusiveOrAssignment";
  74. Ast.OpAssignOp Ast.OpShl, "op_LeftShiftAssignment";
  75. Ast.OpAssignOp Ast.OpMod, "op_ModulusAssignment";
  76. Ast.OpAssignOp Ast.OpAdd, "op_AdditionAssignment";
  77. Ast.OpAssignOp Ast.OpAnd, "op_BitwiseAndAssignment";
  78. Ast.OpAssignOp Ast.OpOr, "op_BitwiseOrAssignment";
  79. (* op_Comma *)
  80. Ast.OpAssignOp Ast.OpDiv, "op_DivisionAssignment";]
  81. let cs_unops =
  82. [Ast.Decrement, "op_Decrement";
  83. Ast.Increment, "op_Increment";
  84. Ast.Neg, "op_UnaryNegation";
  85. Ast.Not, "op_LogicalNot";
  86. Ast.NegBits, "op_OnesComplement"]
  87. let binops_names = List.fold_left (fun acc (op,n) -> PMap.add n op acc) PMap.empty cs_binops
  88. let unops_names = List.fold_left (fun acc (op,n) -> PMap.add n op acc) PMap.empty cs_unops
  89. let get_item = "get_Item"
  90. let set_item = "set_Item"
  91. let is_tparam t =
  92. match follow t with
  93. | TInst( { cl_kind = KTypeParameter _ }, [] ) -> true
  94. | _ -> false
  95. let rec is_int_float gen t =
  96. match follow (gen.greal_type t) with
  97. | TInst( { cl_path = (["haxe"], "Int32") }, [] )
  98. | TAbstract ({ a_path = ([], "Int") },[])
  99. | TAbstract ({ a_path = ([], "Float") },[]) ->
  100. true
  101. | TAbstract _ when like_float t && not (like_i64 t) ->
  102. true
  103. | TInst( { cl_path = (["haxe"; "lang"], "Null") }, [t] ) -> is_int_float gen t
  104. | _ -> false
  105. let is_bool t =
  106. match follow t with
  107. | TAbstract ({ a_path = ([], "Bool") },[]) ->
  108. true
  109. | _ -> false
  110. let is_exactly_bool gen t =
  111. match gen.gfollow#run_f t with
  112. | TAbstract ({ a_path = ([], "Bool") },[]) ->
  113. true
  114. | _ -> false
  115. let is_dynamic gen t =
  116. match follow (gen.greal_type t) with
  117. | TDynamic _ -> true
  118. | _ -> false
  119. let is_pointer gen t =
  120. match follow (gen.greal_type t) with
  121. | TAbstract( ( {a_path = ["cs"], "Pointer"}, _ ) )
  122. | TInst( {cl_path = ["cs"], "Pointer"}, _ ) -> true
  123. | _ -> false
  124. let rec is_null t =
  125. match t with
  126. | TInst( { cl_path = (["haxe"; "lang"], "Null") }, _ )
  127. | TType( { t_path = ([], "Null") }, _ ) -> true
  128. | TType( t, tl ) -> is_null (apply_params t.t_params tl t.t_type)
  129. | TMono r ->
  130. (match !r with
  131. | Some t -> is_null t
  132. | _ -> false)
  133. | TLazy f ->
  134. is_null (!f())
  135. | _ -> false
  136. let rec get_ptr e = match e.eexpr with
  137. | TParenthesis e | TMeta(_,e)
  138. | TCast(e,_) -> get_ptr e
  139. | TCall( { eexpr = TLocal({ v_name = "__ptr__" }) }, [ e ] ) ->
  140. Some e
  141. | _ -> None
  142. let parse_explicit_iface =
  143. let regex = Str.regexp "\\." in
  144. let parse_explicit_iface str =
  145. let split = Str.split regex str in
  146. let rec get_iface split pack =
  147. match split with
  148. | clname :: fn_name :: [] -> fn_name, (List.rev pack, clname)
  149. | pack_piece :: tl -> get_iface tl (pack_piece :: pack)
  150. | _ -> assert false
  151. in
  152. get_iface split []
  153. in parse_explicit_iface
  154. let is_string t =
  155. match follow t with
  156. | TInst( { cl_path = ([], "String") }, [] ) -> true
  157. | _ -> false
  158. let rec change_md = function
  159. | TAbstractDecl(a) when Meta.has Meta.Delegate a.a_meta && not (Meta.has Meta.CoreType a.a_meta) ->
  160. change_md (t_to_md a.a_this)
  161. | TClassDecl( { cl_kind = KAbstractImpl ({ a_this = TInst(impl,_) } as a) }) when Meta.has Meta.Delegate a.a_meta ->
  162. TClassDecl impl
  163. | md -> md
  164. (* ******************************************* *)
  165. (* CSharpSpecificESynf *)
  166. (* ******************************************* *)
  167. (*
  168. Some CSharp-specific syntax filters that must run before ExpressionUnwrap
  169. dependencies:
  170. It must run before ExprUnwrap, as it may not return valid Expr/Statement expressions
  171. It must run before ClassInstance, as it will detect expressions that need unchanged TTypeExpr
  172. *)
  173. module CSharpSpecificESynf =
  174. struct
  175. let name = "csharp_specific_e"
  176. let priority = solve_deps name [DBefore ExpressionUnwrap.priority; DBefore ClassInstance.priority; DAfter TryCatchWrapper.priority]
  177. let get_cl_from_t t =
  178. match follow t with
  179. | TInst(cl,_) -> cl
  180. | _ -> assert false
  181. let get_ab_from_t t =
  182. match follow t with
  183. | TAbstract(ab,_) -> ab
  184. | _ -> assert false
  185. let traverse gen runtime_cl =
  186. let basic = gen.gcon.basic in
  187. let uint = match get_type gen ([], "UInt") with | TTypeDecl t -> TType(t, []) | TAbstractDecl a -> TAbstract(a, []) | _ -> assert false in
  188. let is_var = alloc_var "__is__" t_dynamic in
  189. let name () = match gen.gcurrent_class with
  190. | Some cl -> path_s cl.cl_path
  191. | _ -> ""
  192. in
  193. let rec run e =
  194. match e.eexpr with
  195. (* Std.is() *)
  196. | TCall(
  197. { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = "is" })) },
  198. [ obj; { eexpr = TTypeExpr(TClassDecl { cl_path = [], "Dynamic" } | TAbstractDecl { a_path = [], "Dynamic" }) }]
  199. ) ->
  200. Type.map_expr run e
  201. | TCall(
  202. { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = "is"}) ) },
  203. [ obj; { eexpr = TTypeExpr(md) }]
  204. ) ->
  205. let md = change_md md in
  206. let mk_is obj md =
  207. { e with eexpr = TCall( { eexpr = TLocal is_var; etype = t_dynamic; epos = e.epos }, [
  208. obj;
  209. { eexpr = TTypeExpr md; etype = t_dynamic (* this is after all a syntax filter *); epos = e.epos }
  210. ] ) }
  211. in
  212. let mk_or a b =
  213. {
  214. eexpr = TBinop(Ast.OpBoolOr, a, b);
  215. etype = basic.tbool;
  216. epos = e.epos
  217. }
  218. in
  219. let wrap_if_needed obj f =
  220. (* introduce temp variable for complex expressions *)
  221. match obj.eexpr with
  222. | TLocal(v) -> f obj
  223. | _ ->
  224. let var = mk_temp gen "is" obj.etype in
  225. let added = { obj with eexpr = TVar(var, Some(obj)); etype = basic.tvoid } in
  226. let local = mk_local var obj.epos in
  227. {
  228. eexpr = TBlock([ added; f local ]);
  229. etype = basic.tbool;
  230. epos = e.epos
  231. }
  232. in
  233. let obj = run obj in
  234. (match follow_module follow md with
  235. | TAbstractDecl{ a_path = ([], "Float") } when name() <> "haxe.lang.Runtime" ->
  236. (* 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 *)
  237. let mk_is local =
  238. (* we check if it float or int or uint *)
  239. let eisint = mk_is local (TAbstractDecl (get_ab_from_t basic.tint)) in
  240. let eisuint = mk_is local (TAbstractDecl (get_ab_from_t uint)) in
  241. let eisfloat = mk_is local md in
  242. mk_paren (mk_or eisfloat (mk_or eisint eisuint))
  243. in
  244. wrap_if_needed obj mk_is
  245. | TAbstractDecl{ a_path = ([], "Int") } when name() <> "haxe.lang.Runtime" ->
  246. (* int can be stored in double variable because of anonymous functions, check that case *)
  247. let mk_isint_call local =
  248. {
  249. eexpr = TCall(
  250. mk_static_field_access_infer runtime_cl "isInt" e.epos [],
  251. [ local ]
  252. );
  253. etype = basic.tbool;
  254. epos = e.epos
  255. }
  256. in
  257. let mk_is local =
  258. let eisint = mk_is local (TAbstractDecl (get_ab_from_t basic.tint)) in
  259. let eisuint = mk_is local (TAbstractDecl (get_ab_from_t uint)) in
  260. mk_paren (mk_or (mk_or eisint eisuint) (mk_isint_call local))
  261. in
  262. wrap_if_needed obj mk_is
  263. | TAbstractDecl{ a_path = ([], "UInt") } when name() <> "haxe.lang.Runtime" ->
  264. (* uint can be stored in double variable because of anonymous functions, check that case *)
  265. let mk_isuint_call local =
  266. {
  267. eexpr = TCall(
  268. mk_static_field_access_infer runtime_cl "isUInt" e.epos [],
  269. [ local ]
  270. );
  271. etype = basic.tbool;
  272. epos = e.epos
  273. }
  274. in
  275. let mk_is local =
  276. let eisuint = mk_is local (TAbstractDecl (get_ab_from_t uint)) in
  277. mk_paren (mk_or eisuint (mk_isuint_call local))
  278. in
  279. wrap_if_needed obj mk_is
  280. | _ ->
  281. mk_is obj md
  282. )
  283. (* end Std.is() *)
  284. | TBinop( Ast.OpUShr, e1, e2 ) ->
  285. mk_cast e.etype { e with eexpr = TBinop( Ast.OpShr, mk_cast uint (run e1), run e2 ) }
  286. | TBinop( Ast.OpAssignOp Ast.OpUShr, e1, e2 ) ->
  287. let mk_ushr local =
  288. { e with eexpr = TBinop(Ast.OpAssign, local, run { e with eexpr = TBinop(Ast.OpUShr, local, run e2) }) }
  289. in
  290. let mk_local obj =
  291. let var = mk_temp gen "opUshr" obj.etype in
  292. let added = { obj with eexpr = TVar(var, Some(obj)); etype = basic.tvoid } in
  293. let local = mk_local var obj.epos in
  294. local, added
  295. in
  296. let e1 = run e1 in
  297. let ret = match e1.eexpr with
  298. | TField({ eexpr = TLocal _ }, _)
  299. | TField({ eexpr = TTypeExpr _ }, _)
  300. | TArray({ eexpr = TLocal _ }, _)
  301. | TLocal(_) ->
  302. mk_ushr e1
  303. | TField(fexpr, field) ->
  304. let local, added = mk_local fexpr in
  305. { e with eexpr = TBlock([ added; mk_ushr { e1 with eexpr = TField(local, field) } ]); }
  306. | TArray(ea1, ea2) ->
  307. let local, added = mk_local ea1 in
  308. { e with eexpr = TBlock([ added; mk_ushr { e1 with eexpr = TArray(local, ea2) } ]); }
  309. | _ -> (* invalid left-side expression *)
  310. assert false
  311. in
  312. ret
  313. | _ -> Type.map_expr run e
  314. in
  315. run
  316. let configure gen (mapping_func:texpr->texpr) =
  317. let map e = Some(mapping_func e) in
  318. gen.gsyntax_filters#add ~name:name ~priority:(PCustom priority) map
  319. end;;
  320. (* ******************************************* *)
  321. (* CSharpSpecificSynf *)
  322. (* ******************************************* *)
  323. (*
  324. Some CSharp-specific syntax filters that can run after ExprUnwrap
  325. dependencies:
  326. Runs after ExprUnwrap
  327. *)
  328. module CSharpSpecificSynf =
  329. struct
  330. let name = "csharp_specific"
  331. let priority = solve_deps name [ DAfter ExpressionUnwrap.priority; DAfter ObjectDeclMap.priority; DAfter ArrayDeclSynf.priority; DAfter HardNullableSynf.priority ]
  332. let get_cl_from_t t =
  333. match follow t with
  334. | TInst(cl,_) -> cl
  335. | _ -> assert false
  336. let is_tparam t =
  337. match follow t with
  338. | TInst( { cl_kind = KTypeParameter _ }, _ ) -> true
  339. | _ -> false
  340. let traverse gen runtime_cl =
  341. let basic = gen.gcon.basic in
  342. let tchar = match ( get_type gen (["cs"], "Char16") ) with
  343. | TTypeDecl t -> TType(t,[])
  344. | TAbstractDecl a -> TAbstract(a,[])
  345. | _ -> assert false
  346. in
  347. let string_ext = get_cl ( get_type gen (["haxe";"lang"], "StringExt")) in
  348. let is_string t = match follow t with | TInst({ cl_path = ([], "String") }, []) -> true | _ -> false in
  349. let clstring = match basic.tstring with | TInst(cl,_) -> cl | _ -> assert false in
  350. let ti64 = match ( get_type gen (["cs"], "Int64") ) with | TTypeDecl t -> TType(t,[]) | TAbstractDecl a -> TAbstract(a,[]) | _ -> assert false in
  351. let boxed_ptr =
  352. if Common.defined gen.gcon Define.Unsafe then
  353. get_cl (get_type gen (["haxe";"lang"], "BoxedPointer"))
  354. (* get_abstract (get_type gen (["cs"],"Pointer")) *)
  355. else
  356. null_class
  357. in
  358. let is_struct t = (* not basic type *)
  359. match follow t with
  360. | TInst(cl, _) when Meta.has Meta.Struct cl.cl_meta -> true
  361. | _ -> false
  362. in
  363. let is_cl t = match gen.greal_type t with | TInst ( { cl_path = (["System"], "Type") }, [] ) -> true | _ -> false in
  364. let name () = match gen.gcurrent_class with
  365. | Some cl -> path_s cl.cl_path
  366. | _ -> ""
  367. in
  368. let rec run e =
  369. match e.eexpr with
  370. (* Std.int() *)
  371. | TCall(
  372. { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = "int" }) ) },
  373. [obj]
  374. ) ->
  375. run (mk_cast basic.tint obj)
  376. (* end Std.int() *)
  377. (* TODO: change cf_name *)
  378. | TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = "length" })) ->
  379. { e with eexpr = TField(run ef, FDynamic "Length") }
  380. | TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = "toLowerCase" })) ->
  381. { e with eexpr = TField(run ef, FDynamic "ToLowerInvariant") }
  382. | TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = "toUpperCase" })) ->
  383. { e with eexpr = TField(run ef, FDynamic "ToUpperInvariant") }
  384. | TCall( { eexpr = TField(_, FStatic({ cl_path = [], "String" }, { cf_name = "fromCharCode" })) }, [cc] ) ->
  385. { e with eexpr = TNew(get_cl_from_t basic.tstring, [], [mk_cast tchar (run cc); mk_int gen 1 cc.epos]) }
  386. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("charAt" as field) })) }, args )
  387. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("charCodeAt" as field) })) }, args )
  388. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("indexOf" as field) })) }, args )
  389. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("lastIndexOf" as field) })) }, args )
  390. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("split" as field) })) }, args )
  391. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("substring" as field) })) }, args )
  392. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("substr" as field) })) }, args ) ->
  393. { e with eexpr = TCall(mk_static_field_access_infer string_ext field e.epos [], [run ef] @ (List.map run args)) }
  394. | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("toString") })) }, [] ) ->
  395. run ef
  396. | TNew( { cl_path = ([], "String") }, [], [p] ) -> run p (* new String(myString) -> myString *)
  397. | TCast(expr, _) when like_float expr.etype && is_pointer gen e.etype ->
  398. let expr = run expr in
  399. mk_cast e.etype (mk_cast ti64 expr)
  400. | TCast(expr, _) when is_dynamic gen expr.etype && is_pointer gen e.etype ->
  401. (match get_ptr expr with
  402. | None ->
  403. (* unboxing *)
  404. let expr = run expr in
  405. mk_cast e.etype (mk_field_access gen (mk_cast (TInst(boxed_ptr,[])) expr) "value" e.epos)
  406. | Some e ->
  407. run e)
  408. | TCast(expr, _) when is_pointer gen expr.etype && is_dynamic gen e.etype ->
  409. (match get_ptr expr with
  410. | None ->
  411. (* boxing *)
  412. let expr = run expr in
  413. { e with eexpr = TNew(boxed_ptr,[],[expr]) }
  414. | Some e ->
  415. run e)
  416. | TCast(expr, _) when is_bool e.etype && not (is_exactly_bool gen expr.etype) ->
  417. {
  418. eexpr = TCall(
  419. mk_static_field_access_infer runtime_cl "toBool" expr.epos [],
  420. [ run expr ]
  421. );
  422. etype = basic.tbool;
  423. epos = e.epos
  424. }
  425. | TCast(expr, _) when is_int_float gen e.etype && not (is_cs_basic_type (gen.greal_type expr.etype)) && ( Common.defined gen.gcon Define.EraseGenerics || not (is_null e.etype) ) && name() <> "haxe.lang.Runtime" ->
  426. let needs_cast = match gen.gfollow#run_f e.etype with
  427. | TInst _ -> false
  428. | _ -> true
  429. in
  430. let fun_name = if like_int e.etype then "toInt" else "toDouble" in
  431. let ret = {
  432. eexpr = TCall(
  433. mk_static_field_access_infer runtime_cl fun_name expr.epos [],
  434. [ run expr ]
  435. );
  436. etype = basic.tint;
  437. epos = expr.epos
  438. } in
  439. if needs_cast then mk_cast e.etype ret else ret
  440. | TCast(expr, _) when (is_string e.etype) && (not (is_string expr.etype)) && name() <> "haxe.lang.Runtime" ->
  441. { e with eexpr = TCall( mk_static_field_access_infer runtime_cl "toString" expr.epos [], [run expr] ) }
  442. | TBinop( (Ast.OpNotEq as op), e1, e2)
  443. | TBinop( (Ast.OpEq as op), e1, e2) when is_string e1.etype || is_string e2.etype ->
  444. let mk_ret e = match op with | Ast.OpNotEq -> { e with eexpr = TUnop(Ast.Not, Ast.Prefix, e) } | _ -> e in
  445. mk_ret { e with
  446. eexpr = TCall({
  447. eexpr = TField(mk_classtype_access clstring e.epos, FDynamic "Equals");
  448. etype = TFun(["obj1",false,basic.tstring; "obj2",false,basic.tstring], basic.tbool);
  449. epos = e1.epos
  450. }, [ run e1; run e2 ])
  451. }
  452. | TCast(expr, _) when is_tparam e.etype && name() <> "haxe.lang.Runtime" && not (Common.defined gen.gcon Define.EraseGenerics) ->
  453. let static = mk_static_field_access_infer (runtime_cl) "genericCast" e.epos [e.etype] in
  454. { e with eexpr = TCall(static, [mk_local (alloc_var "$type_param" e.etype) expr.epos; run expr]); }
  455. | TBinop( (Ast.OpNotEq as op), e1, e2)
  456. | TBinop( (Ast.OpEq as op), e1, e2) when is_struct e1.etype || is_struct e2.etype ->
  457. let mk_ret e = match op with | Ast.OpNotEq -> { e with eexpr = TUnop(Ast.Not, Ast.Prefix, e) } | _ -> e in
  458. mk_ret { e with
  459. eexpr = TCall({
  460. eexpr = TField(run e1, FDynamic "Equals");
  461. etype = TFun(["obj1",false,t_dynamic;], basic.tbool);
  462. epos = e1.epos
  463. }, [ run e2 ])
  464. }
  465. | TBinop ( (Ast.OpEq as op), e1, e2 )
  466. | TBinop ( (Ast.OpNotEq as op), e1, e2 ) when is_cl e1.etype && name() <> "haxe.lang.Runtime" ->
  467. let static = mk_static_field_access_infer (runtime_cl) "typeEq" e.epos [] in
  468. let ret = { e with eexpr = TCall(static, [run e1; run e2]); } in
  469. if op = Ast.OpNotEq then
  470. { ret with eexpr = TUnop(Ast.Not, Ast.Prefix, ret) }
  471. else
  472. ret
  473. | _ -> Type.map_expr run e
  474. in
  475. run
  476. let configure gen (mapping_func:texpr->texpr) =
  477. let map e = Some(mapping_func e) in
  478. gen.gsyntax_filters#add ~name:name ~priority:(PCustom priority) map
  479. end;;
  480. let add_cast_handler gen =
  481. let basic = gen.gcon.basic in
  482. (*
  483. starting to set gtparam_cast.
  484. *)
  485. (* NativeArray: the most important. *)
  486. (*
  487. var new_arr = new NativeArray<TO_T>(old_arr.Length);
  488. var i = -1;
  489. while( i < old_arr.Length )
  490. {
  491. new_arr[i] = (TO_T) old_arr[i];
  492. }
  493. *)
  494. let native_arr_cl = get_cl ( get_type gen (["cs"], "NativeArray") ) in
  495. let get_narr_param t = match follow t with
  496. | TInst({ cl_path = (["cs"], "NativeArray") }, [param]) -> param
  497. | _ -> assert false
  498. in
  499. let gtparam_cast_native_array e to_t =
  500. let old_param = get_narr_param e.etype in
  501. let new_param = get_narr_param to_t in
  502. let new_v = mk_temp gen "new_arr" to_t in
  503. let i = mk_temp gen "i" basic.tint in
  504. let old_len = mk_field_access gen e "Length" e.epos in
  505. let obj_v = mk_temp gen "obj" t_dynamic in
  506. let check_null = {eexpr = TBinop(Ast.OpNotEq, e, null e.etype e.epos); etype = basic.tbool; epos = e.epos} in
  507. let block = [
  508. {
  509. eexpr = TVar(
  510. new_v, Some( {
  511. eexpr = TNew(native_arr_cl, [new_param], [old_len] );
  512. etype = to_t;
  513. epos = e.epos
  514. } )
  515. );
  516. etype = basic.tvoid;
  517. epos = e.epos
  518. };
  519. {
  520. eexpr = TVar(i, Some( mk_int gen (-1) e.epos ));
  521. etype = basic.tvoid;
  522. epos = e.epos
  523. };
  524. {
  525. eexpr = TWhile(
  526. {
  527. eexpr = TBinop(
  528. Ast.OpLt,
  529. { eexpr = TUnop(Ast.Increment, Ast.Prefix, mk_local i e.epos); etype = basic.tint; epos = e.epos },
  530. old_len
  531. );
  532. etype = basic.tbool;
  533. epos = e.epos
  534. },
  535. { eexpr = TBlock [
  536. {
  537. eexpr = TVar(obj_v, Some (mk_cast t_dynamic { eexpr = TArray(e, mk_local i e.epos); etype = old_param; epos = e.epos }));
  538. etype = basic.tvoid;
  539. epos = e.epos
  540. };
  541. {
  542. eexpr = TIf({
  543. eexpr = TBinop(Ast.OpNotEq, mk_local obj_v e.epos, null e.etype e.epos);
  544. etype = basic.tbool;
  545. epos = e.epos
  546. },
  547. {
  548. eexpr = TBinop(
  549. Ast.OpAssign,
  550. { eexpr = TArray(mk_local new_v e.epos, mk_local i e.epos); etype = new_param; epos = e.epos },
  551. mk_cast new_param (mk_local obj_v e.epos)
  552. );
  553. etype = new_param;
  554. epos = e.epos
  555. },
  556. None);
  557. etype = basic.tvoid;
  558. epos = e.epos
  559. }
  560. ]; etype = basic.tvoid; epos = e.epos },
  561. Ast.NormalWhile
  562. );
  563. etype = basic.tvoid;
  564. epos = e.epos;
  565. };
  566. mk_local new_v e.epos
  567. ] in
  568. {
  569. eexpr = TIf(
  570. check_null,
  571. {
  572. eexpr = TBlock(block);
  573. etype = to_t;
  574. epos = e.epos;
  575. },
  576. Some(null new_v.v_type e.epos)
  577. );
  578. etype = to_t;
  579. epos = e.epos;
  580. }
  581. in
  582. Hashtbl.add gen.gtparam_cast (["cs"], "NativeArray") gtparam_cast_native_array
  583. (* end set gtparam_cast *)
  584. (* Type Parameters Handling *)
  585. let handle_type_params gen ifaces base_generic =
  586. add_cast_handler gen;
  587. 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
  588. 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 *)
  589. 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? *)
  590. let strict_mode = ref false (* strict mode is so we can check for unexpected information *)
  591. (* reserved c# words *)
  592. let reserved = let res = Hashtbl.create 120 in
  593. List.iter (fun lst -> Hashtbl.add res lst ("@" ^ lst)) ["abstract"; "as"; "base"; "bool"; "break"; "byte"; "case"; "catch"; "char"; "checked"; "class";
  594. "const"; "continue"; "decimal"; "default"; "delegate"; "do"; "double"; "else"; "enum"; "event"; "explicit";
  595. "extern"; "false"; "finally"; "fixed"; "float"; "for"; "foreach"; "goto"; "if"; "implicit"; "in"; "int";
  596. "interface"; "internal"; "is"; "lock"; "long"; "namespace"; "new"; "null"; "object"; "operator"; "out"; "override";
  597. "params"; "private"; "protected"; "public"; "readonly"; "ref"; "return"; "sbyte"; "sealed"; "short"; "sizeof";
  598. "stackalloc"; "static"; "string"; "struct"; "switch"; "this"; "throw"; "true"; "try"; "typeof"; "uint"; "ulong";
  599. "unchecked"; "unsafe"; "ushort"; "using"; "virtual"; "volatile"; "void"; "while"; "add"; "ascending"; "by"; "descending";
  600. "dynamic"; "equals"; "from"; "get"; "global"; "group"; "into"; "join"; "let"; "on"; "orderby"; "partial";
  601. "remove"; "select"; "set"; "value"; "var"; "where"; "yield"];
  602. res
  603. let dynamic_anon = TAnon( { a_fields = PMap.empty; a_status = ref Closed } )
  604. let rec get_class_modifiers meta cl_type cl_access cl_modifiers =
  605. match meta with
  606. | [] -> cl_type,cl_access,cl_modifiers
  607. | (Meta.Struct,[],_) :: meta -> get_class_modifiers meta "struct" cl_access cl_modifiers
  608. | (Meta.Protected,[],_) :: meta -> get_class_modifiers meta cl_type "protected" cl_modifiers
  609. | (Meta.Internal,[],_) :: meta -> get_class_modifiers meta cl_type "internal" cl_modifiers
  610. (* no abstract for now | (":abstract",[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("abstract" :: cl_modifiers)
  611. | (":static",[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("static" :: cl_modifiers) TODO: support those types *)
  612. | (Meta.Final,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("sealed" :: cl_modifiers)
  613. | (Meta.Unsafe,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("unsafe" :: cl_modifiers)
  614. | _ :: meta -> get_class_modifiers meta cl_type cl_access cl_modifiers
  615. let rec get_fun_modifiers meta access modifiers =
  616. match meta with
  617. | [] -> access,modifiers
  618. | (Meta.Protected,[],_) :: meta -> get_fun_modifiers meta "protected" modifiers
  619. | (Meta.Internal,[],_) :: meta -> get_fun_modifiers meta "internal" modifiers
  620. | (Meta.ReadOnly,[],_) :: meta -> get_fun_modifiers meta access ("readonly" :: modifiers)
  621. | (Meta.Unsafe,[],_) :: meta -> get_fun_modifiers meta access ("unsafe" :: modifiers)
  622. | (Meta.Volatile,[],_) :: meta -> get_fun_modifiers meta access ("volatile" :: modifiers)
  623. | (Meta.Custom ("?prop_impl" | "?event_impl"),[],_) :: meta -> get_fun_modifiers meta "private" modifiers
  624. | _ :: meta -> get_fun_modifiers meta access modifiers
  625. (* this was the way I found to pass the generator context to be accessible across all functions here *)
  626. (* so 'configure' is almost 'top-level' and will have all functions needed to make this work *)
  627. let configure gen =
  628. let native_arr_cl = get_cl ( get_type gen (["cs"], "NativeArray") ) in
  629. gen.gclasses.nativearray <- (fun t -> TInst(native_arr_cl,[t]));
  630. gen.gclasses.nativearray_type <- (function TInst(_,[t]) -> t | _ -> assert false);
  631. gen.gclasses.nativearray_len <- (fun e p -> mk_field_access gen e "Length" p);
  632. let basic = gen.gcon.basic in
  633. let erase_generics = Common.defined gen.gcon Define.EraseGenerics in
  634. let fn_cl = get_cl (get_type gen (["haxe";"lang"],"Function")) in
  635. let null_t = if erase_generics then null_class else (get_cl (get_type gen (["haxe";"lang"],"Null")) ) in
  636. let runtime_cl = get_cl (get_type gen (["haxe";"lang"],"Runtime")) in
  637. let no_root = Common.defined gen.gcon Define.NoRoot in
  638. let change_id name = try
  639. Hashtbl.find reserved name
  640. with | Not_found ->
  641. let ret = String.concat "." (String.nsplit name "#") in
  642. List.hd (String.nsplit ret "`")
  643. in
  644. let change_clname n = change_id n in
  645. let change_ns_params_root md ns params =
  646. let ns,params = List.fold_left (fun (ns,params) nspart -> try
  647. let part, nparams = String.split nspart "`" in
  648. let nparams = int_of_string nparams in
  649. let rec loop i needed params =
  650. if i = nparams then
  651. (List.rev needed,params)
  652. else
  653. loop (i+1) (List.hd params :: needed) (List.tl params)
  654. in
  655. let needed,params = loop 0 [] params in
  656. let part = change_id part in
  657. (part ^ "<" ^ (String.concat ", " needed) ^ ">")::ns, params
  658. with _ -> (* Invalid_string / int_of_string *)
  659. (change_id nspart)::ns, params
  660. ) ([],params) ns
  661. in
  662. List.rev ns,params
  663. in
  664. let change_ns_params md params ns = if no_root then match ns with
  665. | [] when is_hxgen md -> ["haxe";"root"], params
  666. | [] -> (match md with
  667. | TClassDecl { cl_path = ([],"Std" | [],"Math") } -> ["haxe";"root"], params
  668. | TClassDecl { cl_meta = m } when Meta.has Meta.Enum m -> ["haxe";"root"], params
  669. | _ -> [], params)
  670. | ns when params = [] -> List.map change_id ns, params
  671. | ns ->
  672. change_ns_params_root md ns params
  673. else if params = [] then
  674. List.map change_id ns, params
  675. else
  676. change_ns_params_root md ns params
  677. in
  678. let change_ns md ns =
  679. let ns, _ = change_ns_params md [] ns in
  680. ns
  681. in
  682. let change_field = change_id in
  683. let write_id w name = write w (change_id name) in
  684. let write_field w name = write w (change_field name) in
  685. let ptr =
  686. if Common.defined gen.gcon Define.Unsafe then
  687. get_abstract (get_type gen (["cs"],"Pointer"))
  688. else
  689. null_abstract
  690. in
  691. let is_hxgeneric md =
  692. TypeParams.RealTypeParams.is_hxgeneric md
  693. in
  694. let rec field_is_hxgeneric e = match e.eexpr with
  695. | TParenthesis e | TMeta(_,e) -> field_is_hxgeneric e
  696. | TField(_, (FStatic(cl,_) | FInstance(cl,_,_)) ) ->
  697. (* print_endline ("is_hxgeneric " ^ path_s cl.cl_path ^ " : " ^ string_of_bool (is_hxgeneric (TClassDecl cl))); *)
  698. is_hxgeneric (TClassDecl cl)
  699. | _ -> true
  700. in
  701. gen.gfollow#add ~name:"follow_basic" (fun t -> match t with
  702. | TAbstract ({ a_path = ([], "Bool") },[])
  703. | TAbstract ({ a_path = ([], "Void") },[])
  704. | TAbstract ({ a_path = ([],"Float") },[])
  705. | TAbstract ({ a_path = ([],"Int") },[])
  706. | TAbstract ({ a_path = [],"UInt" },[])
  707. | TType ({ t_path = ["cs"], "Int64" },[])
  708. | TAbstract ({ a_path = ["cs"], "Int64" },[])
  709. | TType ({ t_path = ["cs"],"UInt64" },[])
  710. | TAbstract ({ a_path = ["cs"],"UInt64" },[])
  711. | TType ({ t_path = ["cs"],"UInt8" },[])
  712. | TAbstract ({ a_path = ["cs"],"UInt8" },[])
  713. | TType ({ t_path = ["cs"],"Int8" },[])
  714. | TAbstract ({ a_path = ["cs"],"Int8" },[])
  715. | TType ({ t_path = ["cs"],"Int16" },[])
  716. | TAbstract ({ a_path = ["cs"],"Int16" },[])
  717. | TType ({ t_path = ["cs"],"UInt16" },[])
  718. | TAbstract ({ a_path = ["cs"],"UInt16" },[])
  719. | TType ({ t_path = ["cs"],"Char16" },[])
  720. | TAbstract ({ a_path = ["cs"],"Char16" },[])
  721. | TType ({ t_path = ["cs"],"Ref" },_)
  722. | TAbstract ({ a_path = ["cs"],"Ref" },_)
  723. | TType ({ t_path = ["cs"],"Out" },_)
  724. | TAbstract ({ a_path = ["cs"],"Out" },_)
  725. | TType ({ t_path = [],"Single" },[])
  726. | TAbstract ({ a_path = [],"Single" },[]) -> Some t
  727. | TType (({ t_path = [],"Null" } as tdef),[t2]) ->
  728. Some (TType(tdef,[follow (gen.gfollow#run_f t2)]))
  729. | TAbstract({ a_path = ["cs"],"PointerAccess" },[t]) ->
  730. Some (TAbstract(ptr,[t]))
  731. | TAbstract (a, pl) when not (Meta.has Meta.CoreType a.a_meta) ->
  732. Some (gen.gfollow#run_f ( Abstract.get_underlying_type a pl) )
  733. | TAbstract( { a_path = ([], "EnumValue") }, _ )
  734. | TInst( { cl_path = ([], "EnumValue") }, _ ) -> Some t_dynamic
  735. | _ -> None);
  736. let module_s_params md params =
  737. let md = change_md md in
  738. let path = (t_infos md).mt_path in
  739. match path with
  740. | ([], "String") -> "string", params
  741. | ([], "Null") -> path_s (change_ns md ["haxe"; "lang"], change_clname "Null"), params
  742. | (ns,clname) ->
  743. let ns, params = change_ns_params md params ns in
  744. path_s (ns, change_clname clname), params
  745. in
  746. let module_s md =
  747. fst (module_s_params md [])
  748. in
  749. let ifaces = Hashtbl.create 1 in
  750. let ti64 = match ( get_type gen (["cs"], "Int64") ) with | TTypeDecl t -> TType(t,[]) | TAbstractDecl a -> TAbstract(a,[]) | _ -> assert false in
  751. let ttype = get_cl ( get_type gen (["System"], "Type") ) in
  752. let has_tdyn tl =
  753. List.exists (fun t -> match follow t with
  754. | TDynamic _ | TMono _ -> true
  755. | _ -> false
  756. ) tl
  757. in
  758. let rec real_type t =
  759. let t = gen.gfollow#run_f t in
  760. let ret = match t with
  761. | TAbstract (a, pl) when not (Meta.has Meta.CoreType a.a_meta) ->
  762. real_type (Abstract.get_underlying_type a pl)
  763. | TAbstract ({ a_path = (["cs";"_Flags"], "EnumUnderlying") }, [t]) ->
  764. real_type t
  765. | TInst( { cl_path = (["cs";"system"], "String") }, [] ) ->
  766. gen.gcon.basic.tstring;
  767. | TInst( { cl_path = (["haxe"], "Int32") }, [] ) -> gen.gcon.basic.tint
  768. | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> ti64
  769. | TAbstract( { a_path = [],"Class" }, _ )
  770. | TAbstract( { a_path = [],"Enum" }, _ )
  771. | TAbstract( { a_path = ["haxe";"extern"],"Rest" }, _ )
  772. | TInst( { cl_path = ([], "Class") }, _ )
  773. | TInst( { cl_path = ([], "Enum") }, _ ) -> TInst(ttype,[])
  774. | TInst( ({ cl_kind = KTypeParameter _ } as cl), _ ) when erase_generics && not (Meta.has Meta.NativeGeneric cl.cl_meta) ->
  775. t_dynamic
  776. | TInst({ cl_kind = KExpr _ }, _) -> t_dynamic
  777. | TEnum(_, [])
  778. | TInst(_, []) -> t
  779. | TInst(cl, params) when
  780. has_tdyn params &&
  781. Hashtbl.mem ifaces cl.cl_path ->
  782. TInst(Hashtbl.find ifaces cl.cl_path, [])
  783. | TEnum(e, params) ->
  784. TEnum(e, List.map (fun _ -> t_dynamic) params)
  785. | TInst(cl, params) when Meta.has Meta.Enum cl.cl_meta ->
  786. TInst(cl, List.map (fun _ -> t_dynamic) params)
  787. | TInst(cl, params) -> TInst(cl, change_param_type (TClassDecl cl) params)
  788. | TType({ t_path = ([], "Null") }, [t]) ->
  789. (*
  790. Null<> handling is a little tricky.
  791. It will only change to haxe.lang.Null<> when the actual type is non-nullable or a type parameter
  792. It works on cases such as Hash<T> returning Null<T> since cast_detect will invoke real_type at the original type,
  793. Null<T>, which will then return the type haxe.lang.Null<>
  794. *)
  795. if erase_generics then
  796. if is_cs_basic_type t then
  797. t_dynamic
  798. else
  799. real_type t
  800. else
  801. (match real_type t with
  802. | TInst( { cl_kind = KTypeParameter _ }, _ ) -> TInst(null_t, [t])
  803. | _ when is_cs_basic_type t -> TInst(null_t, [t])
  804. | _ -> real_type t)
  805. | TAbstract _
  806. | TType _ -> t
  807. | TAnon (anon) when (match !(anon.a_status) with | Statics _ | EnumStatics _ | AbstractStatics _ -> true | _ -> false) -> t
  808. | TFun _ -> TInst(fn_cl,[])
  809. | _ -> t_dynamic
  810. in
  811. ret
  812. and
  813. (*
  814. On hxcs, the only type parameters allowed to be declared are the basic c# types.
  815. That's made like this to avoid casting problems when type parameters in this case
  816. add nothing to performance, since the memory layout is always the same.
  817. To avoid confusion between Generic<Dynamic> (which has a different meaning in hxcs AST),
  818. all those references are using dynamic_anon, which means Generic<{}>
  819. *)
  820. change_param_type md tl =
  821. let types = match md with
  822. | TClassDecl c -> c.cl_params
  823. | TEnumDecl e -> []
  824. | TAbstractDecl a -> a.a_params
  825. | TTypeDecl t -> t.t_params
  826. in
  827. let is_hxgeneric = if types = [] then is_hxgen md else (TypeParams.RealTypeParams.is_hxgeneric md) in
  828. let ret t =
  829. let t_changed = real_type t in
  830. match is_hxgeneric, t_changed with
  831. | false, _ -> t
  832. (*
  833. Because Null<> types need a special compiler treatment for many operations (e.g. boxing/unboxing),
  834. Null<> type parameters will be transformed into Dynamic.
  835. *)
  836. | true, TInst ( { cl_path = (["haxe";"lang"], "Null") }, _ ) -> dynamic_anon
  837. | true, TInst ( { cl_kind = KTypeParameter _ }, _ ) -> t
  838. | true, TInst _
  839. | true, TEnum _
  840. | true, TAbstract _ when is_cs_basic_type t_changed -> t
  841. | true, TDynamic _ -> t
  842. | true, x ->
  843. dynamic_anon
  844. in
  845. if is_hxgeneric && (erase_generics || List.exists (fun t -> match follow t with | TDynamic _ -> true | _ -> false) tl) then
  846. List.map (fun _ -> t_dynamic) tl
  847. else
  848. List.map ret tl
  849. in
  850. let is_dynamic t = match real_type t with
  851. | TMono _ | TDynamic _
  852. | TInst({ cl_kind = KTypeParameter _ }, _) -> true
  853. | TAnon anon ->
  854. (match !(anon.a_status) with
  855. | EnumStatics _ | Statics _ -> false
  856. | _ -> true
  857. )
  858. | _ -> false
  859. in
  860. let rec t_s t =
  861. match real_type t with
  862. (* basic types *)
  863. | TAbstract ({ a_path = ([], "Bool") },[]) -> "bool"
  864. | TAbstract ({ a_path = ([], "Void") },[]) -> "object"
  865. | TAbstract ({ a_path = ([],"Float") },[]) -> "double"
  866. | TAbstract ({ a_path = ([],"Int") },[]) -> "int"
  867. | TAbstract ({ a_path = [],"UInt" },[]) -> "uint"
  868. | TType ({ t_path = ["cs"], "Int64" },[])
  869. | TAbstract ({ a_path = ["cs"], "Int64" },[]) -> "long"
  870. | TType ({ t_path = ["cs"],"UInt64" },[])
  871. | TAbstract ({ a_path = ["cs"],"UInt64" },[]) -> "ulong"
  872. | TType ({ t_path = ["cs"],"UInt8" },[])
  873. | TAbstract ({ a_path = ["cs"],"UInt8" },[]) -> "byte"
  874. | TType ({ t_path = ["cs"],"Int8" },[])
  875. | TAbstract ({ a_path = ["cs"],"Int8" },[]) -> "sbyte"
  876. | TType ({ t_path = ["cs"],"Int16" },[])
  877. | TAbstract ({ a_path = ["cs"],"Int16" },[]) -> "short"
  878. | TType ({ t_path = ["cs"],"UInt16" },[])
  879. | TAbstract ({ a_path = ["cs"],"UInt16" },[]) -> "ushort"
  880. | TType ({ t_path = ["cs"],"Char16" },[])
  881. | TAbstract ({ a_path = ["cs"],"Char16" },[]) -> "char"
  882. | TType ({ t_path = [],"Single" },[])
  883. | TAbstract ({ a_path = [],"Single" },[]) -> "float"
  884. | TInst ({ cl_path = ["haxe"],"Int32" },[])
  885. | TAbstract ({ a_path = ["haxe"],"Int32" },[]) -> "int"
  886. | TInst ({ cl_path = ["haxe"],"Int64" },[])
  887. | TAbstract ({ a_path = ["haxe"],"Int64" },[]) -> "long"
  888. | TInst ({ cl_path = ([], "Dynamic") },_)
  889. | TAbstract ({ a_path = ([], "Dynamic") },_) -> "object"
  890. | TType ({ t_path = ["cs"],"Out" },[t])
  891. | TAbstract ({ a_path = ["cs"],"Out" },[t])
  892. | TType ({ t_path = ["cs"],"Ref" },[t])
  893. | TAbstract ({ a_path = ["cs"],"Ref" },[t]) -> t_s t
  894. | TInst({ cl_path = (["cs"], "NativeArray") }, [param]) ->
  895. let rec check_t_s t =
  896. match real_type t with
  897. | TInst({ cl_path = (["cs"], "NativeArray") }, [param]) ->
  898. (check_t_s param) ^ "[]"
  899. | _ -> t_s (run_follow gen t)
  900. in
  901. (check_t_s param) ^ "[]"
  902. | TInst({ cl_path = (["cs"], "Pointer") },[t])
  903. | TAbstract({ a_path = (["cs"], "Pointer") },[t])->
  904. let ret = t_s t in
  905. (if ret = "object" then "void" else ret) ^ "*"
  906. (* end of basic types *)
  907. | TInst ({ cl_kind = KTypeParameter _; cl_path=p }, []) -> snd p
  908. | TMono r -> (match !r with | None -> "object" | Some t -> t_s (run_follow gen t))
  909. | TInst ({ cl_path = [], "String" }, []) -> "string"
  910. | TEnum (e, params) -> ("global::" ^ (module_s (TEnumDecl e)))
  911. | TInst (cl, _ :: _) when Meta.has Meta.Enum cl.cl_meta ->
  912. "global::" ^ module_s (TClassDecl cl)
  913. | TInst (({ cl_path = p } as cl), params) -> (path_param_s (TClassDecl cl) p params)
  914. | TType (({ t_path = p } as t), params) -> (path_param_s (TTypeDecl t) p params)
  915. | TAnon (anon) ->
  916. (match !(anon.a_status) with
  917. | Statics _ | EnumStatics _ -> "System.Type"
  918. | _ -> "object")
  919. | TDynamic _ -> "object"
  920. | TAbstract(a,pl) when not (Meta.has Meta.CoreType a.a_meta) ->
  921. t_s (Abstract.get_underlying_type a pl)
  922. (* No Lazy type nor Function type made. That's because function types will be at this point be converted into other types *)
  923. | _ -> 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) ^ " ]"
  924. and path_param_s md path params =
  925. match params with
  926. | [] -> "global::" ^ module_s md
  927. | _ when erase_generics && is_hxgeneric md ->
  928. "global::" ^ module_s md
  929. | _ ->
  930. let params = (List.map (fun t -> t_s t) (change_param_type md params)) in
  931. let str,params = module_s_params md params in
  932. if params = [] then
  933. "global::" ^ str
  934. else
  935. sprintf "global::%s<%s>" str (String.concat ", " params)
  936. in
  937. let rett_s t =
  938. match t with
  939. | TAbstract ({ a_path = ([], "Void") },[]) -> "void"
  940. | _ -> t_s t
  941. in
  942. let escape ichar b =
  943. match ichar with
  944. | 92 (* \ *) -> Buffer.add_string b "\\\\"
  945. | 39 (* ' *) -> Buffer.add_string b "\\\'"
  946. | 34 -> Buffer.add_string b "\\\""
  947. | 13 (* \r *) -> Buffer.add_string b "\\r"
  948. | 10 (* \n *) -> Buffer.add_string b "\\n"
  949. | 9 (* \t *) -> Buffer.add_string b "\\t"
  950. | c when c < 32 || (c >= 127 && c <= 0xFFFF) -> Buffer.add_string b (Printf.sprintf "\\u%.4x" c)
  951. | c when c > 0xFFFF -> Buffer.add_string b (Printf.sprintf "\\U%.8x" c)
  952. | c -> Buffer.add_char b (Char.chr c)
  953. in
  954. let escape s =
  955. let b = Buffer.create 0 in
  956. (try
  957. UTF8.validate s;
  958. UTF8.iter (fun c -> escape (UChar.code c) b) s
  959. with
  960. UTF8.Malformed_code ->
  961. String.iter (fun c -> escape (Char.code c) b) s
  962. );
  963. Buffer.contents b
  964. in
  965. let has_semicolon e =
  966. match e.eexpr with
  967. | TBlock _ | TFor _ | TSwitch _ | TTry _ | TIf _ -> false
  968. | TWhile (_,_,flag) when flag = Ast.NormalWhile -> false
  969. | _ -> true
  970. in
  971. let in_value = ref false in
  972. let rec md_s md =
  973. let md = follow_module (gen.gfollow#run_f) md in
  974. match md with
  975. | TClassDecl ({ cl_params = [] } as cl) ->
  976. t_s (TInst(cl,[]))
  977. | TClassDecl (cl) when not (is_hxgen md) ->
  978. t_s (TInst(cl,List.map (fun t -> t_dynamic) cl.cl_params))
  979. | TEnumDecl ({ e_params = [] } as e) ->
  980. t_s (TEnum(e,[]))
  981. | TEnumDecl (e) when not (is_hxgen md) ->
  982. t_s (TEnum(e,List.map (fun t -> t_dynamic) e.e_params))
  983. | TClassDecl cl ->
  984. t_s (TInst(cl,[]))
  985. | TEnumDecl e ->
  986. t_s (TEnum(e,[]))
  987. | TTypeDecl t ->
  988. t_s (TType(t, List.map (fun t -> t_dynamic) t.t_params))
  989. | TAbstractDecl a ->
  990. t_s (TAbstract(a, List.map(fun t -> t_dynamic) a.a_params))
  991. in
  992. let rec ensure_local e explain =
  993. match e.eexpr with
  994. | TLocal _ -> e
  995. | TCast(e,_)
  996. | TParenthesis e | TMeta(_,e) -> ensure_local e explain
  997. | _ -> gen.gcon.error ("This function argument " ^ explain ^ " must be a local variable.") e.epos; e
  998. in
  999. let rec ensure_refout e explain =
  1000. match e.eexpr with
  1001. | TField _ | TLocal _ -> e
  1002. | TCast(e,_)
  1003. | TParenthesis e | TMeta(_,e) -> ensure_refout e explain
  1004. | _ -> gen.gcon.error ("This function argument " ^ explain ^ " must be a local variable.") e.epos; e
  1005. in
  1006. let last_line = ref (-1) in
  1007. let begin_block w = write w "{"; push_indent w; newline w; last_line := -1 in
  1008. let end_block w = pop_indent w; (if w.sw_has_content then newline w); write w "}"; newline w; last_line := -1 in
  1009. let skip_line_directives = (not gen.gcon.debug && not (Common.defined gen.gcon Define.NoCompilation)) || Common.defined gen.gcon Define.RealPosition in
  1010. let line_directive =
  1011. if skip_line_directives then
  1012. fun w p -> ()
  1013. else fun w p ->
  1014. if p.pfile <> Ast.null_pos.pfile then (* Compiler Error CS1560 https://msdn.microsoft.com/en-us/library/z3t5e5sw(v=vs.90).aspx *)
  1015. let cur_line = Lexer.get_error_line p in
  1016. let file = Common.get_full_path p.pfile in
  1017. if cur_line <> ((!last_line)+1) then
  1018. let line = Ast.s_escape file in
  1019. if String.length line <= 256 then
  1020. begin print w "#line %d \"%s\"" cur_line line; newline w end
  1021. else (* Compiler Error CS1560 https://msdn.microsoft.com/en-us/library/z3t5e5sw(v=vs.90).aspx *)
  1022. begin print w "//line %d \"%s\"" cur_line line; newline w end;
  1023. last_line := cur_line
  1024. in
  1025. let line_reset_directive =
  1026. if skip_line_directives then
  1027. fun w -> ()
  1028. else fun w ->
  1029. print w "#line default"
  1030. in
  1031. let rec extract_tparams params el =
  1032. match el with
  1033. | ({ eexpr = TLocal({ v_name = "$type_param" }) } as tp) :: tl ->
  1034. extract_tparams (tp.etype :: params) tl
  1035. | _ -> (params, el)
  1036. in
  1037. let is_extern_prop t name = match follow (run_follow gen t), field_access gen t name with
  1038. | TInst({ cl_interface = true; cl_extern = true } as cl, _), FNotFound ->
  1039. not (is_hxgen (TClassDecl cl))
  1040. | _, FClassField(_,_,decl,v,_,t,_) ->
  1041. Type.is_extern_field v && (Meta.has Meta.Property v.cf_meta || (decl.cl_extern && not (is_hxgen (TClassDecl decl))))
  1042. | _ -> false
  1043. in
  1044. let is_event t name = match follow (run_follow gen t), field_access gen t name with
  1045. | TInst({ cl_interface = true; cl_extern = true } as cl, _), FNotFound ->
  1046. not (is_hxgen (TClassDecl cl))
  1047. | _, FClassField(_,_,decl,v,_,_,_) ->
  1048. Meta.has Meta.Event v.cf_meta
  1049. | _ -> false
  1050. in
  1051. let extract_statements expr =
  1052. let ret = ref [] in
  1053. let rec loop expr = match expr.eexpr with
  1054. | TCall ({ eexpr = TLocal {
  1055. v_name = "__is__" | "__typeof__" | "__array__" | "__sizeof__" | "__delegate__"
  1056. } }, el) ->
  1057. List.iter loop el
  1058. | TNew ({ cl_path = (["cs"], "NativeArray") }, params, [ size ]) ->
  1059. ()
  1060. | TUnop (Ast.Increment, _, _)
  1061. | TUnop (Ast.Decrement, _, _)
  1062. | TBinop (Ast.OpAssign, _, _)
  1063. | TBinop (Ast.OpAssignOp _, _, _)
  1064. | TLocal { v_name = "__fallback__" }
  1065. | TLocal { v_name = "__sbreak__" } ->
  1066. ret := expr :: !ret
  1067. | TConst _
  1068. | TLocal _
  1069. | TArray _
  1070. | TBinop _
  1071. | TField _
  1072. | TEnumParameter _
  1073. | TTypeExpr _
  1074. | TObjectDecl _
  1075. | TArrayDecl _
  1076. | TCast _
  1077. | TMeta _
  1078. | TParenthesis _
  1079. | TUnop _ ->
  1080. Type.iter loop expr
  1081. | TFunction _ -> () (* do not extract parameters from inside of it *)
  1082. | _ ->
  1083. ret := expr :: !ret
  1084. in
  1085. loop expr;
  1086. (* [expr] *)
  1087. List.rev !ret
  1088. in
  1089. let expr_s w e =
  1090. last_line := -1;
  1091. in_value := false;
  1092. let rec expr_s w e =
  1093. let was_in_value = !in_value in
  1094. in_value := true;
  1095. (match e.eexpr with
  1096. | TCall({ eexpr = TField(ef,f) }, (_ :: _ as args) ) when (field_name f) = "get_Item" ->
  1097. expr_s w ef;
  1098. write w "[";
  1099. let first = ref true in
  1100. List.iter (fun f ->
  1101. if !first then first := false else write w ", ";
  1102. expr_s w f
  1103. ) args;
  1104. write w "]"
  1105. | TCall({ eexpr = TField(ef,f) }, (_ :: _ :: _ as args) ) when (field_name f) = "set_Item" ->
  1106. expr_s w ef;
  1107. write w "[";
  1108. let args, value = match List.rev args with
  1109. | v :: args -> List.rev args, v
  1110. | _ -> assert false
  1111. in
  1112. let first = ref true in
  1113. List.iter (fun f ->
  1114. if !first then first := false else write w ", ";
  1115. expr_s w f
  1116. ) args;
  1117. write w "] = ";
  1118. expr_s w value
  1119. | TCall( ({ eexpr = TField(ef,f) } as e), [ev] ) when String.starts_with (field_name f) "add_" ->
  1120. let name = field_name f in
  1121. let propname = String.sub name 4 (String.length name - 4) in
  1122. if is_event (gen.greal_type ef.etype) propname then begin
  1123. expr_s w ef;
  1124. write w ".";
  1125. write_field w propname;
  1126. write w " += ";
  1127. expr_s w ev
  1128. end else
  1129. do_call w e [ev]
  1130. | TCall( ({ eexpr = TField(ef,f) } as e), [ev] ) when String.starts_with (field_name f) "remove_" ->
  1131. let name = field_name f in
  1132. let propname = String.sub name 7 (String.length name - 7) in
  1133. if is_event (gen.greal_type ef.etype) propname then begin
  1134. expr_s w ef;
  1135. write w ".";
  1136. write_field w propname;
  1137. write w " -= ";
  1138. expr_s w ev
  1139. end else
  1140. do_call w e [ev]
  1141. | TCall( ({ eexpr = TField(ef,f) } as e), [] ) when String.starts_with (field_name f) "get_" ->
  1142. let name = field_name f in
  1143. let propname = String.sub name 4 (String.length name - 4) in
  1144. if is_extern_prop (gen.greal_type ef.etype) propname then begin
  1145. expr_s w ef;
  1146. write w ".";
  1147. write_field w propname
  1148. end else
  1149. do_call w e []
  1150. | TCall( ({ eexpr = TField(ef,f) } as e), [v] ) when String.starts_with (field_name f) "set_" ->
  1151. let name = field_name f in
  1152. let propname = String.sub name 4 (String.length name - 4) in
  1153. if is_extern_prop (gen.greal_type ef.etype) propname then begin
  1154. expr_s w ef;
  1155. write w ".";
  1156. write_field w propname;
  1157. write w " = ";
  1158. expr_s w v
  1159. end else
  1160. do_call w e [v]
  1161. | TField (e, (FStatic(_, cf) | FInstance(_, _, cf))) when Meta.has Meta.Native cf.cf_meta ->
  1162. let rec loop meta = match meta with
  1163. | (Meta.Native, [EConst (String s), _],_) :: _ ->
  1164. expr_s w e; write w "."; write_field w s
  1165. | _ :: tl -> loop tl
  1166. | [] -> expr_s w e; write w "."; write_field w (cf.cf_name)
  1167. in
  1168. loop cf.cf_meta
  1169. | TConst c ->
  1170. (match c with
  1171. | TInt i32 ->
  1172. write w (Int32.to_string i32);
  1173. (*match real_type e.etype with
  1174. | TType( { t_path = (["haxe";"_Int64"], "NativeInt64") }, [] ) -> write w "L";
  1175. | _ -> ()
  1176. *)
  1177. | TFloat s ->
  1178. write w s;
  1179. (if String.get s (String.length s - 1) = '.' then write w "0");
  1180. (*match real_type e.etype with
  1181. | TType( { t_path = ([], "Single") }, [] ) -> write w "f"
  1182. | _ -> ()
  1183. *)
  1184. | TString s ->
  1185. write w "\"";
  1186. write w (escape s);
  1187. write w "\""
  1188. | TBool b -> write w (if b then "true" else "false")
  1189. | TNull when is_cs_basic_type e.etype || is_tparam e.etype ->
  1190. write w "default(";
  1191. write w (t_s e.etype);
  1192. write w ")"
  1193. | TNull -> write w "null"
  1194. | TThis -> write w "this"
  1195. | TSuper -> write w "base")
  1196. | TLocal { v_name = "__sbreak__" } -> write w "break"
  1197. | TLocal { v_name = "__undefined__" } ->
  1198. write w (t_s (TInst(runtime_cl, List.map (fun _ -> t_dynamic) runtime_cl.cl_params)));
  1199. write w ".undefined";
  1200. | TLocal { v_name = "__typeof__" } -> write w "typeof"
  1201. | TLocal { v_name = "__sizeof__" } -> write w "sizeof"
  1202. | TLocal var ->
  1203. write_id w var.v_name
  1204. | TField (_, FEnum(e, ef)) ->
  1205. let s = ef.ef_name in
  1206. print w "%s." ("global::" ^ module_s (TEnumDecl e)); write_field w s
  1207. | TArray (e1, e2) ->
  1208. expr_s w e1; write w "["; expr_s w e2; write w "]"
  1209. | TBinop ((Ast.OpAssign as op), e1, e2)
  1210. | TBinop ((Ast.OpAssignOp _ as op), e1, e2) ->
  1211. expr_s w e1; write w ( " " ^ (Ast.s_binop op) ^ " " ); expr_s w e2
  1212. | TBinop (op, e1, e2) ->
  1213. write w "( ";
  1214. expr_s w e1; write w ( " " ^ (Ast.s_binop op) ^ " " ); expr_s w e2;
  1215. write w " )"
  1216. | TField ({ eexpr = TTypeExpr mt }, s) ->
  1217. (match mt with
  1218. | TClassDecl { cl_path = (["haxe"], "Int64") } -> write w ("global::" ^ module_s mt)
  1219. | TClassDecl { cl_path = (["haxe"], "Int32") } -> write w ("global::" ^ module_s mt)
  1220. | TClassDecl { cl_interface = true } ->
  1221. write w ("global::" ^ module_s mt);
  1222. write w "__Statics_";
  1223. | TClassDecl cl -> write w (t_s (TInst(cl, List.map (fun _ -> t_empty) cl.cl_params)))
  1224. | TEnumDecl en -> write w (t_s (TEnum(en, List.map (fun _ -> t_empty) en.e_params)))
  1225. | TTypeDecl td -> write w (t_s (gen.gfollow#run_f (TType(td, List.map (fun _ -> t_empty) td.t_params))))
  1226. | TAbstractDecl a -> write w (t_s (TAbstract(a, List.map (fun _ -> t_empty) a.a_params)))
  1227. );
  1228. write w ".";
  1229. write_field w (field_name s)
  1230. | TField (e, s) when is_pointer gen e.etype ->
  1231. (* take off the extra cast if possible *)
  1232. let e = match e.eexpr with
  1233. | TCast(e1,_) when Gencommon.CastDetect.type_iseq gen e.etype e1.etype ->
  1234. e1
  1235. | _ -> e
  1236. in
  1237. expr_s w e; write w "->"; write_field w (field_name s)
  1238. | TField (e, s) ->
  1239. expr_s w e; write w "."; write_field w (field_name s)
  1240. | TTypeExpr mt ->
  1241. (match mt with
  1242. | TClassDecl { cl_path = (["haxe"], "Int64") } -> write w ("global::" ^ module_s mt)
  1243. | TClassDecl { cl_path = (["haxe"], "Int32") } -> write w ("global::" ^ module_s mt)
  1244. | TClassDecl cl -> write w (t_s (TInst(cl, List.map (fun _ -> t_empty) cl.cl_params)));
  1245. | TEnumDecl en -> write w (t_s (TEnum(en, List.map (fun _ -> t_empty) en.e_params)))
  1246. | TTypeDecl td -> write w (t_s (gen.gfollow#run_f (TType(td, List.map (fun _ -> t_empty) td.t_params))))
  1247. | TAbstractDecl a -> write w (t_s (TAbstract(a, List.map (fun _ -> t_empty) a.a_params)))
  1248. )
  1249. | TParenthesis e ->
  1250. write w "("; expr_s w e; write w ")"
  1251. | TMeta (_,e) ->
  1252. expr_s w e
  1253. | TArrayDecl el
  1254. | TCall ({ eexpr = TLocal { v_name = "__array__" } }, el)
  1255. | TCall ({ eexpr = TField(_, FStatic({ cl_path = (["cs"],"NativeArray") }, { cf_name = "make" })) }, el) ->
  1256. let _, el = extract_tparams [] el in
  1257. print w "new %s" (t_s e.etype);
  1258. write w "{";
  1259. ignore (List.fold_left (fun acc e ->
  1260. (if acc <> 0 then write w ", ");
  1261. expr_s w e;
  1262. acc + 1
  1263. ) 0 el);
  1264. write w "}"
  1265. | TCall ({ eexpr = TLocal { v_name = "__delegate__" } }, [del]) ->
  1266. expr_s w del
  1267. | TCall ({ eexpr = TLocal( { v_name = "__is__" } ) }, [ expr; { eexpr = TTypeExpr(md) } ] ) ->
  1268. write w "( ";
  1269. expr_s w expr;
  1270. write w " is ";
  1271. write w (md_s md);
  1272. write w " )"
  1273. | TCall ({ eexpr = TLocal( { v_name = "__as__" } ) }, [ expr; { eexpr = TTypeExpr(md) } ] ) ->
  1274. write w "( ";
  1275. expr_s w expr;
  1276. write w " as ";
  1277. write w (md_s md);
  1278. write w " )"
  1279. | TCall ({ eexpr = TLocal( { v_name = "__as__" } ) }, expr :: _ ) ->
  1280. write w "( ";
  1281. expr_s w expr;
  1282. write w " as ";
  1283. write w (t_s e.etype);
  1284. write w " )";
  1285. | TCall ({ eexpr = TLocal( { v_name = "__cs__" } ) }, [ { eexpr = TConst(TString(s)) } ] ) ->
  1286. write w s
  1287. | TCall ({ eexpr = TLocal( { v_name = "__cs__" } ) }, { eexpr = TConst(TString(s)) } :: tl ) ->
  1288. Codegen.interpolate_code gen.gcon s tl (write w) (expr_s w) e.epos
  1289. | TCall ({ eexpr = TLocal( { v_name = "__stackalloc__" } ) }, [ e ] ) ->
  1290. write w "stackalloc byte[";
  1291. expr_s w e;
  1292. write w "]"
  1293. | TCall ({ eexpr = TLocal( { v_name = "__unsafe__" } ) }, [ e ] ) ->
  1294. write w "unsafe";
  1295. expr_s w (mk_block e)
  1296. | TCall ({ eexpr = TLocal( { v_name = "__checked__" } ) }, [ e ] ) ->
  1297. write w "checked";
  1298. expr_s w (mk_block e)
  1299. | TCall ({ eexpr = TLocal( { v_name = "__lock__" } ) }, [ eobj; eblock ] ) ->
  1300. write w "lock(";
  1301. expr_s w eobj;
  1302. write w ")";
  1303. expr_s w (mk_block eblock)
  1304. | TCall ({ eexpr = TLocal( { v_name = "__fixed__" } ) }, [ e ] ) ->
  1305. let fixeds = ref [] in
  1306. let rec loop = function
  1307. | ({ eexpr = TVar(v, Some(e) ) } as expr) :: tl when is_pointer gen v.v_type ->
  1308. let e = match get_ptr e with
  1309. | None -> e
  1310. | Some e -> e
  1311. in
  1312. fixeds := (v,e,expr) :: !fixeds;
  1313. loop tl;
  1314. | el when !fixeds <> [] ->
  1315. let rec loop fx acc = match fx with
  1316. | (v,e,expr) :: tl ->
  1317. write w "fixed(";
  1318. let vf = mk_temp gen "fixed" v.v_type in
  1319. expr_s w { expr with eexpr = TVar(vf, Some e) };
  1320. write w ") ";
  1321. begin_block w;
  1322. expr_s w { expr with eexpr = TVar(v, Some (mk_local vf expr.epos)) };
  1323. write w ";";
  1324. newline w;
  1325. loop tl (acc + 1)
  1326. | [] -> acc
  1327. in
  1328. let nblocks = loop (List.rev !fixeds) 0 in
  1329. in_value := false;
  1330. expr_s w { e with eexpr = TBlock el };
  1331. for i = 1 to nblocks do
  1332. end_block w
  1333. done
  1334. | _ ->
  1335. trace (debug_expr e);
  1336. gen.gcon.error "Invalid 'fixed' keyword format" e.epos
  1337. in
  1338. (match e.eexpr with
  1339. | TBlock bl -> loop bl
  1340. | _ ->
  1341. trace "not block";
  1342. trace (debug_expr e);
  1343. gen.gcon.error "Invalid 'fixed' keyword format" e.epos
  1344. )
  1345. | TCall ({ eexpr = TLocal( { v_name = "__addressOf__" } ) }, [ e ] ) ->
  1346. let e = ensure_local e "for addressOf" in
  1347. write w "&";
  1348. expr_s w e
  1349. | TCall ({ eexpr = TLocal( { v_name = "__valueOf__" } ) }, [ e ] ) ->
  1350. write w "*(";
  1351. expr_s w e;
  1352. write w ")"
  1353. | TCall ({ eexpr = TLocal( { v_name = "__goto__" } ) }, [ { eexpr = TConst(TInt v) } ] ) ->
  1354. print w "goto label%ld" v
  1355. | TCall ({ eexpr = TLocal( { v_name = "__label__" } ) }, [ { eexpr = TConst(TInt v) } ] ) ->
  1356. print w "label%ld: {}" v
  1357. | TCall ({ eexpr = TLocal( { v_name = "__rethrow__" } ) }, _) ->
  1358. write w "throw"
  1359. (* operator overloading handling *)
  1360. | TCall({ eexpr = TField(ef, FInstance(cl,_,{ cf_name = "__get" })) }, [idx]) when not (is_hxgen (TClassDecl cl)) ->
  1361. expr_s w { e with eexpr = TArray(ef, idx) }
  1362. | TCall({ eexpr = TField(ef, FInstance(cl,_,{ cf_name = "__set" })) }, [idx; v]) when not (is_hxgen (TClassDecl cl)) ->
  1363. expr_s w { e with eexpr = TBinop(Ast.OpAssign, { e with eexpr = TArray(ef, idx) }, v) }
  1364. | TCall({ eexpr = TField(ef, FStatic(_,cf)) }, el) when PMap.mem cf.cf_name binops_names ->
  1365. let _, elr = extract_tparams [] el in
  1366. (match elr with
  1367. | [e1;e2] ->
  1368. expr_s w { e with eexpr = TBinop(PMap.find cf.cf_name binops_names, e1, e2) }
  1369. | _ -> do_call w e el)
  1370. | TCall({ eexpr = TField(ef, FStatic(_,cf)) }, el) when PMap.mem cf.cf_name unops_names ->
  1371. (match extract_tparams [] el with
  1372. | _, [e1] ->
  1373. expr_s w { e with eexpr = TUnop(PMap.find cf.cf_name unops_names, Ast.Prefix,e1) }
  1374. | _ -> do_call w e el)
  1375. | TCall (e, el) ->
  1376. do_call w e el
  1377. | TNew (({ cl_path = (["cs"], "NativeArray") } as cl), params, [ size ]) ->
  1378. let rec check_t_s t times =
  1379. match real_type t with
  1380. | TInst({ cl_path = (["cs"], "NativeArray") }, [param]) ->
  1381. (check_t_s param (times+1))
  1382. | _ ->
  1383. print w "new %s[" (t_s (run_follow gen t));
  1384. expr_s w size;
  1385. print w "]";
  1386. let rec loop i =
  1387. if i <= 0 then () else (write w "[]"; loop (i-1))
  1388. in
  1389. loop (times - 1)
  1390. in
  1391. check_t_s (TInst(cl, params)) 0
  1392. | TNew ({ cl_path = ([], "String") } as cl, [], el) ->
  1393. write w "new ";
  1394. write w (t_s (TInst(cl, [])));
  1395. write w "(";
  1396. ignore (List.fold_left (fun acc e ->
  1397. (if acc <> 0 then write w ", ");
  1398. expr_s w e;
  1399. acc + 1
  1400. ) 0 el);
  1401. write w ")"
  1402. | TNew ({ cl_kind = KTypeParameter _ } as cl, params, el) ->
  1403. print w "default(%s) /* This code should never be reached. It was produced by the use of @:generic on a new type parameter instance: %s */" (t_s (TInst(cl,params))) (path_param_s (TClassDecl cl) cl.cl_path params)
  1404. | TNew (cl, params, el) ->
  1405. write w "new ";
  1406. write w (path_param_s (TClassDecl cl) cl.cl_path params);
  1407. write w "(";
  1408. ignore (List.fold_left (fun acc e ->
  1409. (if acc <> 0 then write w ", ");
  1410. expr_s w e;
  1411. acc + 1
  1412. ) 0 el);
  1413. write w ")"
  1414. | TUnop ((Ast.Increment as op), flag, e)
  1415. | TUnop ((Ast.Decrement as op), flag, e) ->
  1416. (match flag with
  1417. | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " " ); expr_s w e
  1418. | Ast.Postfix -> expr_s w e; write w (Ast.s_unop op))
  1419. | TUnop (op, flag, e) ->
  1420. (match flag with
  1421. | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " (" ); expr_s w e; write w ") "
  1422. | Ast.Postfix -> write w "("; expr_s w e; write w (") " ^ Ast.s_unop op))
  1423. | TVar (var, eopt) ->
  1424. print w "%s " (t_s var.v_type);
  1425. write_id w var.v_name;
  1426. (match eopt with
  1427. | None ->
  1428. write w " = ";
  1429. expr_s w (null var.v_type e.epos)
  1430. | Some e ->
  1431. write w " = ";
  1432. expr_s w e
  1433. )
  1434. | TBlock [e] when was_in_value ->
  1435. expr_s w e
  1436. | TBlock el ->
  1437. begin_block w;
  1438. List.iter (fun e ->
  1439. List.iter (fun e ->
  1440. line_directive w e.epos;
  1441. in_value := false;
  1442. expr_s w e;
  1443. (if has_semicolon e then write w ";");
  1444. newline w
  1445. ) (extract_statements e)
  1446. ) el;
  1447. end_block w
  1448. | TIf (econd, e1, Some(eelse)) when was_in_value ->
  1449. write w "( ";
  1450. expr_s w (mk_paren econd);
  1451. write w " ? ";
  1452. expr_s w (mk_paren e1);
  1453. write w " : ";
  1454. expr_s w (mk_paren eelse);
  1455. write w " )";
  1456. | TIf (econd, e1, eelse) ->
  1457. write w "if ";
  1458. expr_s w (mk_paren econd);
  1459. write w " ";
  1460. in_value := false;
  1461. expr_s w (mk_block e1);
  1462. (match eelse with
  1463. | None -> ()
  1464. | Some e ->
  1465. write w "else ";
  1466. in_value := false;
  1467. let e = match e.eexpr with
  1468. | TIf _ -> e
  1469. | TBlock [{eexpr = TIf _} as e] -> e
  1470. | _ -> mk_block e
  1471. in
  1472. expr_s w e
  1473. )
  1474. | TWhile (econd, eblock, flag) ->
  1475. (match flag with
  1476. | Ast.NormalWhile ->
  1477. write w "while ";
  1478. expr_s w (mk_paren econd);
  1479. write w " ";
  1480. in_value := false;
  1481. expr_s w (mk_block eblock)
  1482. | Ast.DoWhile ->
  1483. write w "do ";
  1484. in_value := false;
  1485. expr_s w (mk_block eblock);
  1486. write w "while ";
  1487. in_value := true;
  1488. expr_s w (mk_paren econd);
  1489. )
  1490. | TSwitch (econd, ele_l, default) ->
  1491. write w "switch ";
  1492. expr_s w (mk_paren econd);
  1493. write w " ";
  1494. begin_block w;
  1495. List.iter (fun (el, e) ->
  1496. List.iter (fun e ->
  1497. write w "case ";
  1498. in_value := true;
  1499. expr_s w e;
  1500. write w ":";
  1501. newline w;
  1502. ) el;
  1503. in_value := false;
  1504. expr_s w (mk_block e);
  1505. newline w;
  1506. newline w
  1507. ) ele_l;
  1508. if is_some default then begin
  1509. write w "default:";
  1510. newline w;
  1511. in_value := false;
  1512. expr_s w (get default);
  1513. newline w;
  1514. end;
  1515. end_block w
  1516. | TTry (tryexpr, ve_l) ->
  1517. write w "try ";
  1518. in_value := false;
  1519. expr_s w (mk_block tryexpr);
  1520. List.iter (fun (var, e) ->
  1521. print w "catch (%s %s)" (t_s var.v_type) (var.v_name);
  1522. in_value := false;
  1523. expr_s w (mk_block e);
  1524. newline w
  1525. ) ve_l
  1526. | TReturn eopt ->
  1527. write w "return";
  1528. if is_some eopt then (write w " "; expr_s w (get eopt))
  1529. | TBreak -> write w "break"
  1530. | TContinue -> write w "continue"
  1531. | TThrow e ->
  1532. write w "throw ";
  1533. expr_s w e
  1534. | TCast (e1,md_t) ->
  1535. ((*match gen.gfollow#run_f e.etype with
  1536. | TType({ t_path = ([], "UInt") }, []) ->
  1537. write w "( unchecked ((uint) ";
  1538. expr_s w e1;
  1539. write w ") )"
  1540. | _ ->*)
  1541. (* FIXME I'm ignoring module type *)
  1542. print w "((%s) (" (t_s e.etype);
  1543. expr_s w e1;
  1544. write w ") )"
  1545. )
  1546. | TFor (_,_,content) ->
  1547. write w "[ for not supported ";
  1548. expr_s w content;
  1549. write w " ]";
  1550. if !strict_mode then assert false
  1551. | TObjectDecl _ -> write w "[ obj decl not supported ]"; if !strict_mode then assert false
  1552. | TFunction _ -> write w "[ func decl not supported ]"; if !strict_mode then assert false
  1553. | TEnumParameter _ -> write w "[ enum parameter not supported ]"; if !strict_mode then assert false
  1554. )
  1555. and do_call w e el =
  1556. let params, el = extract_tparams [] el in
  1557. let params = List.rev params in
  1558. expr_s w e;
  1559. (match params with
  1560. | _ :: _ when not (erase_generics && field_is_hxgeneric e) ->
  1561. let md = match e.eexpr with
  1562. | TField(ef, _) ->
  1563. t_to_md (run_follow gen ef.etype)
  1564. | _ -> assert false
  1565. in
  1566. write w "<";
  1567. ignore (List.fold_left (fun acc t ->
  1568. (if acc <> 0 then write w ", ");
  1569. write w (t_s t);
  1570. acc + 1
  1571. ) 0 (change_param_type md params));
  1572. write w ">"
  1573. | _ -> ()
  1574. );
  1575. let rec loop acc elist tlist =
  1576. match elist, tlist with
  1577. | e :: etl, (_,_,t) :: ttl ->
  1578. (if acc <> 0 then write w ", ");
  1579. (match real_type t with
  1580. | TType({ t_path = (["cs"], "Ref") }, _)
  1581. | TAbstract ({ a_path = (["cs"], "Ref") },_) ->
  1582. let e = ensure_refout e "of type cs.Ref" in
  1583. write w "ref ";
  1584. expr_s w e
  1585. | TType({ t_path = (["cs"], "Out") }, _)
  1586. | TAbstract ({ a_path = (["cs"], "Out") },_) ->
  1587. let e = ensure_refout e "of type cs.Out" in
  1588. write w "out ";
  1589. expr_s w e
  1590. | _ ->
  1591. expr_s w e
  1592. );
  1593. loop (acc + 1) etl ttl
  1594. | e :: etl, [] ->
  1595. (if acc <> 0 then write w ", ");
  1596. expr_s w e;
  1597. loop (acc + 1) etl []
  1598. | _ -> ()
  1599. in
  1600. write w "(";
  1601. let ft = match follow e.etype with
  1602. | TFun(args,_) -> args
  1603. | _ -> []
  1604. in
  1605. loop 0 el ft;
  1606. write w ")"
  1607. in
  1608. expr_s w e
  1609. in
  1610. let rec gen_fpart_attrib w = function
  1611. | EConst( Ident i ), _ ->
  1612. write w i
  1613. | EField( ef, f ), _ ->
  1614. gen_fpart_attrib w ef;
  1615. write w ".";
  1616. write w f
  1617. | _, p ->
  1618. gen.gcon.error "Invalid expression inside @:meta metadata" p
  1619. in
  1620. let rec gen_spart w = function
  1621. | EConst c, p -> (match c with
  1622. | Int s | Float s | Ident s ->
  1623. write w s
  1624. | String s ->
  1625. write w "\"";
  1626. write w (escape s);
  1627. write w "\""
  1628. | _ -> gen.gcon.error "Invalid expression inside @:meta metadata" p)
  1629. | EField( ef, f ), _ ->
  1630. gen_spart w ef;
  1631. write w ".";
  1632. write w f
  1633. | EBinop( Ast.OpAssign, (EConst (Ident s), _), e2 ), _ ->
  1634. write w s;
  1635. write w " = ";
  1636. gen_spart w e2
  1637. | EArrayDecl( el ), _ ->
  1638. write w "new[] {";
  1639. let fst = ref true in
  1640. List.iter (fun e ->
  1641. if !fst then fst := false else write w ", ";
  1642. gen_spart w e
  1643. ) el;
  1644. write w "}"
  1645. | ECall(fpart,args), _ ->
  1646. gen_fpart_attrib w fpart;
  1647. write w "(";
  1648. let fst = ref true in
  1649. List.iter (fun e ->
  1650. if !fst then fst := false else write w ", ";
  1651. gen_spart w e
  1652. ) args;
  1653. write w ")"
  1654. | _, p ->
  1655. gen.gcon.error "Invalid expression inside @:meta metadata" p
  1656. in
  1657. let gen_attributes w metadata =
  1658. List.iter (function
  1659. | Meta.Meta, [EConst(String s), _], _ ->
  1660. write w "[";
  1661. write w s;
  1662. write w "]";
  1663. newline w
  1664. | Meta.Meta, [meta], _ ->
  1665. write w "[";
  1666. gen_spart w meta;
  1667. write w "]";
  1668. newline w
  1669. | _ -> ()
  1670. ) metadata
  1671. in
  1672. let gen_nocompletion w metadata =
  1673. if Meta.has Meta.NoCompletion metadata then begin
  1674. write w "[global::System.ComponentModel.EditorBrowsable(global::System.ComponentModel.EditorBrowsableState.Never)]";
  1675. newline w
  1676. end;
  1677. in
  1678. let argt_s t =
  1679. let w = new_source_writer () in
  1680. let rec run t =
  1681. match t with
  1682. | TType (tdef,p) ->
  1683. gen_attributes w tdef.t_meta;
  1684. run (follow_once t)
  1685. | TMono r ->
  1686. (match !r with
  1687. | Some t -> run t
  1688. | _ -> () (* avoid infinite loop / should be the same in this context *))
  1689. | TLazy f ->
  1690. run (!f())
  1691. | _ -> ()
  1692. in
  1693. run t;
  1694. let ret = match run_follow gen t with
  1695. | TType ({ t_path = (["cs"], "Ref") }, [t])
  1696. | TAbstract ({ a_path = (["cs"], "Ref") },[t]) -> "ref " ^ t_s t
  1697. | TType ({ t_path = (["cs"], "Out") }, [t])
  1698. | TAbstract ({ a_path = (["cs"], "Out") },[t]) -> "out " ^ t_s t
  1699. | t -> t_s t
  1700. in
  1701. let c = contents w in
  1702. if c <> "" then
  1703. c ^ " " ^ ret
  1704. else
  1705. ret
  1706. in
  1707. let get_string_params cl cl_params =
  1708. let hxgen = is_hxgen (TClassDecl cl) in
  1709. match cl_params with
  1710. | (_ :: _) when not (erase_generics && is_hxgeneric (TClassDecl cl)) ->
  1711. let get_param_name t = match follow t with TInst(cl, _) -> snd cl.cl_path | _ -> assert false in
  1712. let params = sprintf "<%s>" (String.concat ", " (List.map (fun (_, tcl) -> get_param_name tcl) cl_params)) in
  1713. let params_extends =
  1714. if hxgen
  1715. (* this is temprorary, see https://github.com/HaxeFoundation/haxe/issues/3526 *)
  1716. || not (Meta.has (Meta.Custom ":nativeTypeConstraints") cl.cl_meta)
  1717. then
  1718. [""]
  1719. else
  1720. List.fold_left (fun acc (name, t) ->
  1721. match run_follow gen t with
  1722. | TInst({cl_kind = KTypeParameter constraints}, _) when constraints <> [] ->
  1723. (* base class should come before interface constraints *)
  1724. let base_class_constraints = ref [] in
  1725. let other_constraints = List.fold_left (fun acc t ->
  1726. match follow t with
  1727. (* string is implicitly sealed, maybe haxe should have it final as well *)
  1728. | TInst ({ cl_path=[],"String" }, []) ->
  1729. acc
  1730. (* non-sealed class *)
  1731. | TInst ({ cl_interface = false; cl_meta = meta},_) when not (Meta.has Meta.Final meta) ->
  1732. base_class_constraints := (t_s t) :: !base_class_constraints;
  1733. acc;
  1734. (* interface *)
  1735. | TInst ({ cl_interface = true}, _) ->
  1736. (t_s t) :: acc
  1737. (* skip anything other *)
  1738. | _ ->
  1739. acc
  1740. ) [] constraints in
  1741. let s_constraints = (!base_class_constraints @ other_constraints) in
  1742. if s_constraints <> [] then
  1743. (sprintf " where %s : %s" (get_param_name t) (String.concat ", " s_constraints) :: acc)
  1744. else
  1745. acc;
  1746. | _ -> acc
  1747. ) [] cl_params in
  1748. (params, String.concat " " params_extends)
  1749. | _ -> ("","")
  1750. in
  1751. let gen_field_decl w visibility v_n modifiers t n =
  1752. let parts = ref [] in
  1753. if visibility <> "" then parts := visibility :: !parts;
  1754. if v_n <> "" then parts := v_n :: !parts;
  1755. if modifiers <> [] then parts := modifiers @ !parts;
  1756. if t <> "" then parts := t :: !parts;
  1757. parts := n :: !parts;
  1758. write w (String.concat " " (List.rev !parts));
  1759. in
  1760. let rec gen_event w is_static cl (event,t,custom,add,remove) =
  1761. let is_interface = cl.cl_interface in
  1762. let visibility = if is_interface then "" else "public" in
  1763. let visibility, modifiers = get_fun_modifiers event.cf_meta visibility ["event"] in
  1764. let v_n = if is_static then "static" else "" in
  1765. gen_field_decl w visibility v_n modifiers (t_s (run_follow gen t)) (change_field event.cf_name);
  1766. if custom && not is_interface then begin
  1767. write w " ";
  1768. begin_block w;
  1769. print w "add { _add_%s(value); }" event.cf_name;
  1770. newline w;
  1771. print w "remove { _remove_%s(value); }" event.cf_name;
  1772. newline w;
  1773. end_block w;
  1774. newline w;
  1775. end else
  1776. write w ";\n";
  1777. newline w;
  1778. in
  1779. let rec gen_prop w is_static cl is_final (prop,t,get,set) =
  1780. gen_attributes w prop.cf_meta;
  1781. let is_interface = cl.cl_interface in
  1782. let fn_is_final = function
  1783. | None -> true
  1784. | Some ({ cf_kind = Method mkind } as m) ->
  1785. (match mkind with | MethInline -> true | _ -> false) || Meta.has Meta.Final m.cf_meta
  1786. | _ -> assert false
  1787. in
  1788. let is_virtual = not (is_interface || is_final || Meta.has Meta.Final prop.cf_meta || fn_is_final get || fn_is_final set) in
  1789. let fn_is_override = function
  1790. | Some cf -> List.memq cf cl.cl_overrides
  1791. | None -> false
  1792. in
  1793. let is_override = fn_is_override get || fn_is_override set in
  1794. let visibility = if is_interface then "" else "public" in
  1795. let visibility, modifiers = get_fun_modifiers prop.cf_meta visibility [] in
  1796. 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
  1797. gen_nocompletion w prop.cf_meta;
  1798. gen_field_decl w visibility v_n modifiers (t_s (run_follow gen t)) (change_field prop.cf_name);
  1799. let check cf = match cf with
  1800. | Some ({ cf_overloads = o :: _ } as cf) ->
  1801. gen.gcon.error "Property functions with more than one overload is currently unsupported" cf.cf_pos;
  1802. gen.gcon.error "Property functions with more than one overload is currently unsupported" o.cf_pos
  1803. | _ -> ()
  1804. in
  1805. check get;
  1806. check set;
  1807. write w " ";
  1808. if is_interface then begin
  1809. write w "{ ";
  1810. let s = ref "" in
  1811. (match prop.cf_kind with Var { v_read = AccCall } -> write w "get;"; s := " "; | _ -> ());
  1812. (match prop.cf_kind with Var { v_write = AccCall } -> print w "%sset;" !s | _ -> ());
  1813. write w " }";
  1814. newline w;
  1815. end else begin
  1816. begin_block w;
  1817. (match get with
  1818. | Some cf ->
  1819. print w "get { return _get_%s(); }" prop.cf_name;
  1820. newline w;
  1821. cf.cf_meta <- (Meta.Custom "?prop_impl", [], null_pos) :: cf.cf_meta;
  1822. | None -> ());
  1823. (match set with
  1824. | Some cf ->
  1825. print w "set { _set_%s(value); }" prop.cf_name;
  1826. newline w;
  1827. cf.cf_meta <- (Meta.Custom "?prop_impl", [], null_pos) :: cf.cf_meta;
  1828. | None -> ());
  1829. end_block w;
  1830. newline w;
  1831. newline w;
  1832. end;
  1833. in
  1834. let rec gen_class_field w ?(is_overload=false) is_static cl is_final cf =
  1835. gen_attributes w cf.cf_meta;
  1836. let is_interface = cl.cl_interface in
  1837. let name, is_new, is_explicit_iface = match cf.cf_name with
  1838. | "new" -> snd cl.cl_path, true, false
  1839. | name when String.contains name '.' ->
  1840. let fn_name, path = parse_explicit_iface name in
  1841. (path_s path) ^ "." ^ fn_name, false, true
  1842. | name -> try
  1843. let binop = PMap.find name binops_names in
  1844. "operator " ^ s_binop binop, false, false
  1845. with | Not_found -> try
  1846. let unop = PMap.find name unops_names in
  1847. "operator " ^ s_unop unop, false, false
  1848. with | Not_found ->
  1849. if Meta.has (Meta.Custom "?prop_impl") cf.cf_meta || Meta.has (Meta.Custom "?event_impl") cf.cf_meta then
  1850. "_" ^ name, false, false
  1851. else
  1852. name, false, false
  1853. in
  1854. let rec loop_static cl =
  1855. match is_static, cl.cl_super with
  1856. | false, _ -> []
  1857. | true, None -> []
  1858. | true, Some(cl,_) ->
  1859. (try
  1860. let cf2 = PMap.find cf.cf_name cl.cl_statics in
  1861. Gencommon.CastDetect.type_eq gen EqStrict cf.cf_type cf2.cf_type;
  1862. ["new"]
  1863. with
  1864. | Not_found | Unify_error _ ->
  1865. loop_static cl
  1866. )
  1867. in
  1868. let modf = loop_static cl in
  1869. (match cf.cf_kind with
  1870. | Var _
  1871. | Method (MethDynamic) when not (Type.is_extern_field cf) ->
  1872. (if is_overload || List.exists (fun cf -> cf.cf_expr <> None) cf.cf_overloads then
  1873. gen.gcon.error "Only normal (non-dynamic) methods can be overloaded" cf.cf_pos);
  1874. if not is_interface then begin
  1875. let access, modifiers = get_fun_modifiers cf.cf_meta "public" [] in
  1876. let modifiers = modifiers @ modf in
  1877. gen_nocompletion w cf.cf_meta;
  1878. gen_field_decl w access (if is_static then "static" else "") modifiers (t_s (run_follow gen cf.cf_type)) (change_field name);
  1879. (match cf.cf_expr with
  1880. | Some e ->
  1881. write w " = ";
  1882. expr_s w e;
  1883. | None -> ()
  1884. );
  1885. write w ";"
  1886. end (* TODO see how (get,set) variable handle when they are interfaces *)
  1887. | Method _ when Type.is_extern_field cf || (match cl.cl_kind, cf.cf_expr with | KAbstractImpl _, None -> true | _ -> false) ->
  1888. List.iter (fun cf -> if cl.cl_interface || cf.cf_expr <> None then
  1889. gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
  1890. ) cf.cf_overloads
  1891. | Var _ | Method MethDynamic -> ()
  1892. | Method mkind ->
  1893. List.iter (fun cf ->
  1894. if cl.cl_interface || cf.cf_expr <> None then
  1895. gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
  1896. ) cf.cf_overloads;
  1897. let is_virtual = not is_final && match mkind with | MethInline -> false | _ when not is_new -> true | _ -> false in
  1898. let is_virtual = if not is_virtual || Meta.has Meta.Final cf.cf_meta then false else is_virtual in
  1899. let is_override = List.memq cf cl.cl_overrides in
  1900. let is_override = is_override || match cf.cf_name, follow cf.cf_type with
  1901. | "Equals", TFun([_,_,targ], tret) ->
  1902. (match follow targ, follow tret with
  1903. | TDynamic _, TAbstract({ a_path = ([], "Bool") }, []) -> true
  1904. | _ -> false)
  1905. | "GetHashCode", TFun([],_) -> true
  1906. | _ -> false
  1907. in
  1908. let is_override = if Meta.has (Meta.Custom "?prop_impl") cf.cf_meta then false else is_override in
  1909. let is_virtual = is_virtual && not (Meta.has Meta.Final cl.cl_meta) && not (is_interface) in
  1910. let visibility = if is_interface then "" else "public" in
  1911. let visibility, modifiers = get_fun_modifiers cf.cf_meta visibility [] in
  1912. let modifiers = modifiers @ modf in
  1913. let visibility, is_virtual = if is_explicit_iface then "",false else if visibility = "private" then "private",false else visibility, is_virtual in
  1914. 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
  1915. 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_params)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> assert false else cf.cf_type in
  1916. let ret_type, args = match follow cf_type with | TFun (strbtl, t) -> (t, strbtl) | _ -> assert false in
  1917. gen_nocompletion w cf.cf_meta;
  1918. (* public static void funcName *)
  1919. gen_field_decl w visibility v_n modifiers (if not is_new then (rett_s (run_follow gen ret_type)) else "") (change_field name);
  1920. let params, params_ext = get_string_params cl cf.cf_params in
  1921. (* <T>(string arg1, object arg2) with T : object *)
  1922. (match cf.cf_expr with
  1923. | Some { eexpr = TFunction tf } ->
  1924. print w "%s(%s)%s" (params) (String.concat ", " (List.map2 (fun (var, _) (_,_,t) -> sprintf "%s %s" (argt_s t) (change_id var.v_name)) tf.tf_args args)) (params_ext)
  1925. | _ ->
  1926. print w "%s(%s)%s" (params) (String.concat ", " (List.map (fun (name, _, t) -> sprintf "%s %s" (argt_s t) (change_id name)) args)) (params_ext)
  1927. );
  1928. if is_interface then
  1929. write w ";"
  1930. else begin
  1931. write w " ";
  1932. let rec loop meta =
  1933. match meta with
  1934. | [] ->
  1935. let expr = match cf.cf_expr with
  1936. | None -> mk (TBlock([])) t_dynamic Ast.null_pos
  1937. | Some s ->
  1938. match s.eexpr with
  1939. | TFunction tf ->
  1940. mk_block (tf.tf_expr)
  1941. | _ -> assert false (* FIXME *)
  1942. in
  1943. let needs_unchecked e =
  1944. let rec loop e = match e.eexpr with
  1945. (* a non-zero integer constant means that we want unchecked context *)
  1946. | TConst (TInt i) when i <> Int32.zero ->
  1947. raise Exit
  1948. (* don't recurse into explicit checked blocks *)
  1949. | TCall ({ eexpr = TLocal({ v_name = "__checked__" }) }, _) ->
  1950. ()
  1951. (* skip reflection field hashes as they are safe *)
  1952. | TNew ({ cl_path = (["haxe"; "lang"],"DynamicObject") }, [], [_; e1; _; e2]) ->
  1953. loop e1;
  1954. loop e2
  1955. | TNew ({ cl_path = (["haxe"; "lang"],"Closure") }, [], [eo; _; _]) ->
  1956. loop eo
  1957. | TCall ({ eexpr = TField (_, FStatic ({ cl_path = ["haxe"; "lang"],"Runtime" },
  1958. { cf_name = "getField" | "setField" | "getField_f" | "setField_f" | "callField" })) },
  1959. eo :: _ :: _ :: rest) ->
  1960. loop eo;
  1961. List.iter loop rest
  1962. | _ ->
  1963. Type.iter loop e
  1964. in
  1965. try (loop e; false) with Exit -> true
  1966. in
  1967. let write_method_expr e =
  1968. match e.eexpr with
  1969. | TBlock [] ->
  1970. begin_block w;
  1971. end_block w
  1972. | TBlock _ ->
  1973. let unchecked = needs_unchecked e in
  1974. if unchecked then (begin_block w; write w "unchecked ");
  1975. let t = Common.timer "expression to string" in
  1976. expr_s w e;
  1977. t();
  1978. line_reset_directive w;
  1979. if unchecked then end_block w
  1980. | _ ->
  1981. assert false
  1982. in
  1983. (if is_new then begin
  1984. let rec get_super_call el =
  1985. match el with
  1986. | ( { eexpr = TCall( { eexpr = TConst(TSuper) }, _) } as call) :: rest ->
  1987. Some call, rest
  1988. | ( { eexpr = TBlock(bl) } as block ) :: rest ->
  1989. let ret, mapped = get_super_call bl in
  1990. ret, ( { block with eexpr = TBlock(mapped) } :: rest )
  1991. | _ ->
  1992. None, el
  1993. in
  1994. match expr.eexpr with
  1995. | TBlock(bl) ->
  1996. let super_call, rest = get_super_call bl in
  1997. (match super_call with
  1998. | None -> ()
  1999. | Some sc ->
  2000. write w ": ";
  2001. let t = Common.timer "expression to string" in
  2002. expr_s w sc;
  2003. write w " ";
  2004. t()
  2005. );
  2006. write_method_expr { expr with eexpr = TBlock(rest) }
  2007. | _ -> assert false
  2008. end else
  2009. write_method_expr expr
  2010. )
  2011. | (Meta.FunctionCode, [Ast.EConst (Ast.String contents),_],_) :: tl ->
  2012. begin_block w;
  2013. write w contents;
  2014. end_block w
  2015. | _ :: tl -> loop tl
  2016. in
  2017. loop cf.cf_meta
  2018. end);
  2019. newline w;
  2020. newline w;
  2021. in
  2022. let check_special_behaviors w cl = match cl.cl_kind with
  2023. | KAbstractImpl _ -> ()
  2024. | _ ->
  2025. (* get/set pairs *)
  2026. let pairs = ref PMap.empty in
  2027. (try
  2028. let get = PMap.find "__get" cl.cl_fields in
  2029. List.iter (fun cf ->
  2030. let args,ret = get_fun cf.cf_type in
  2031. match args with
  2032. | [_,_,idx] -> pairs := PMap.add (t_s idx) ( t_s ret, Some cf, None ) !pairs
  2033. | _ -> gen.gcon.warning "The __get function must have exactly one argument (the index)" cf.cf_pos
  2034. ) (get :: get.cf_overloads)
  2035. with | Not_found -> ());
  2036. (try
  2037. let set = PMap.find "__set" cl.cl_fields in
  2038. List.iter (fun cf ->
  2039. let args, ret = get_fun cf.cf_type in
  2040. match args with
  2041. | [_,_,idx; _,_,v] -> (try
  2042. let vt, g, _ = PMap.find (t_s idx) !pairs in
  2043. let tvt = t_s v in
  2044. if vt <> tvt then gen.gcon.warning "The __get function of same index has a different type from this __set function" cf.cf_pos;
  2045. pairs := PMap.add (t_s idx) (vt, g, Some cf) !pairs
  2046. with | Not_found ->
  2047. pairs := PMap.add (t_s idx) (t_s v, None, Some cf) !pairs)
  2048. | _ ->
  2049. gen.gcon.warning "The __set function must have exactly two arguments (index, value)" cf.cf_pos
  2050. ) (set :: set.cf_overloads)
  2051. with | Not_found -> ());
  2052. PMap.iter (fun idx (v, get, set) ->
  2053. print w "public %s this[%s index]" v idx;
  2054. begin_block w;
  2055. (match get with
  2056. | None -> ()
  2057. | Some _ ->
  2058. write w "get";
  2059. begin_block w;
  2060. write w "return this.__get(index);";
  2061. end_block w);
  2062. (match set with
  2063. | None -> ()
  2064. | Some _ ->
  2065. write w "set";
  2066. begin_block w;
  2067. write w "this.__set(index,value);";
  2068. end_block w);
  2069. end_block w) !pairs;
  2070. (if not (PMap.is_empty !pairs) then try
  2071. let get = PMap.find "__get" cl.cl_fields in
  2072. let idx_t, v_t = match follow get.cf_type with
  2073. | TFun([_,_,arg_t],ret_t) ->
  2074. t_s (run_follow gen arg_t), t_s (run_follow gen ret_t)
  2075. | _ -> gen.gcon.error "The __get function must be a function with one argument. " get.cf_pos; assert false
  2076. in
  2077. List.iter (fun (cl,args) ->
  2078. match cl.cl_array_access with
  2079. | None -> ()
  2080. | Some t ->
  2081. let changed_t = apply_params cl.cl_params (List.map (fun _ -> t_dynamic) cl.cl_params) t in
  2082. let t_as_s = t_s (run_follow gen changed_t) in
  2083. print w "%s %s.this[int key]" t_as_s (t_s (TInst(cl, args)));
  2084. begin_block w;
  2085. write w "get";
  2086. begin_block w;
  2087. print w "return ((%s) this.__get(key));" t_as_s;
  2088. end_block w;
  2089. write w "set";
  2090. begin_block w;
  2091. print w "this.__set(key, (%s) value);" v_t;
  2092. end_block w;
  2093. end_block w;
  2094. newline w;
  2095. newline w
  2096. ) cl.cl_implements
  2097. with | Not_found -> ());
  2098. if cl.cl_interface && is_hxgen (TClassDecl cl) && is_some cl.cl_array_access then begin
  2099. let changed_t = apply_params cl.cl_params (List.map (fun _ -> t_dynamic) cl.cl_params) (get cl.cl_array_access) in
  2100. print w "%s this[int key]" (t_s (run_follow gen changed_t));
  2101. begin_block w;
  2102. write w "get;";
  2103. newline w;
  2104. write w "set;";
  2105. newline w;
  2106. end_block w;
  2107. newline w;
  2108. newline w
  2109. end;
  2110. (try
  2111. if cl.cl_interface then raise Not_found;
  2112. let cf = PMap.find "toString" cl.cl_fields in
  2113. (if List.exists (fun c -> c.cf_name = "toString") cl.cl_overrides then raise Not_found);
  2114. (match cf.cf_type with
  2115. | TFun([], ret) ->
  2116. (match real_type ret with
  2117. | TInst( { cl_path = ([], "String") }, []) ->
  2118. write w "public override string ToString()";
  2119. begin_block w;
  2120. write w "return this.toString();";
  2121. end_block w;
  2122. newline w;
  2123. newline w
  2124. | _ ->
  2125. gen.gcon.error "A toString() function should return a String!" cf.cf_pos
  2126. )
  2127. | _ -> ()
  2128. )
  2129. with | Not_found -> ());
  2130. (try
  2131. if cl.cl_interface then raise Not_found;
  2132. let cf = PMap.find "finalize" cl.cl_fields in
  2133. (if List.exists (fun c -> c.cf_name = "finalize") cl.cl_overrides then raise Not_found);
  2134. (match cf.cf_type with
  2135. | TFun([], ret) ->
  2136. (match real_type ret with
  2137. | TAbstract( { a_path = ([], "Void") }, []) ->
  2138. write w "~";
  2139. write w (snd cl.cl_path);
  2140. write w "()";
  2141. begin_block w;
  2142. write w "this.finalize();";
  2143. end_block w;
  2144. newline w;
  2145. newline w
  2146. | _ ->
  2147. gen.gcon.error "A finalize() function should be Void->Void!" cf.cf_pos
  2148. )
  2149. | _ -> ()
  2150. )
  2151. with | Not_found -> ());
  2152. (* properties *)
  2153. let handle_prop static f =
  2154. match f.cf_kind with
  2155. | Method _ -> ()
  2156. | Var v when not (Type.is_extern_field f) -> ()
  2157. | Var v ->
  2158. let prop acc = match acc with
  2159. | AccNo | AccNever | AccCall -> true
  2160. | _ -> false
  2161. in
  2162. if prop v.v_read && prop v.v_write && (v.v_read = AccCall || v.v_write = AccCall) then begin
  2163. let this = if static then
  2164. mk_classtype_access cl f.cf_pos
  2165. else
  2166. { eexpr = TConst TThis; etype = TInst(cl,List.map snd cl.cl_params); epos = f.cf_pos }
  2167. in
  2168. print w "public %s%s %s" (if static then "static " else "") (t_s f.cf_type) (netname_to_hx f.cf_name);
  2169. begin_block w;
  2170. (match v.v_read with
  2171. | AccCall ->
  2172. write w "get";
  2173. begin_block w;
  2174. write w "return ";
  2175. expr_s w this;
  2176. print w ".get_%s();" f.cf_name;
  2177. end_block w
  2178. | _ -> ());
  2179. (match v.v_write with
  2180. | AccCall ->
  2181. write w "set";
  2182. begin_block w;
  2183. expr_s w this;
  2184. print w ".set_%s(value);" f.cf_name;
  2185. end_block w
  2186. | _ -> ());
  2187. end_block w;
  2188. end
  2189. in
  2190. if Meta.has Meta.BridgeProperties cl.cl_meta then begin
  2191. List.iter (handle_prop true) cl.cl_ordered_statics;
  2192. List.iter (handle_prop false) cl.cl_ordered_fields;
  2193. end
  2194. in
  2195. let gen_class w cl =
  2196. write w "#pragma warning disable 109, 114, 219, 429, 168, 162";
  2197. newline w;
  2198. let should_close = match change_ns (TClassDecl cl) (fst (cl.cl_path)) with
  2199. | [] -> false
  2200. | ns ->
  2201. print w "namespace %s " (String.concat "." ns);
  2202. begin_block w;
  2203. true
  2204. in
  2205. (try
  2206. let _,m,_ = Meta.get (Meta.Custom "generic_iface") cl.cl_meta in
  2207. let rec loop i acc =
  2208. if i == 0 then
  2209. acc
  2210. else
  2211. "object" :: (loop (pred i) acc)
  2212. in
  2213. let tparams = loop (match m with [(EConst(Int s),_)] -> int_of_string s | _ -> assert false) [] in
  2214. cl.cl_meta <- (Meta.Meta, [
  2215. EConst(String("global::haxe.lang.GenericInterface(typeof(global::" ^ module_s (TClassDecl cl) ^ "<" ^ String.concat ", " tparams ^ ">))") ), cl.cl_pos
  2216. ], cl.cl_pos) :: cl.cl_meta
  2217. with Not_found ->
  2218. ());
  2219. gen_attributes w cl.cl_meta;
  2220. let is_main =
  2221. match gen.gcon.main_class with
  2222. | Some ( (_,"Main") as path) when path = cl.cl_path && not cl.cl_interface ->
  2223. (*
  2224. for cases where the main class is called Main, there will be a problem with creating the entry point there.
  2225. In this special case, a special entry point class will be created
  2226. *)
  2227. write w "public class EntryPoint__Main ";
  2228. begin_block w;
  2229. write w "public static void Main() ";
  2230. begin_block w;
  2231. (if Hashtbl.mem gen.gtypes (["cs"], "Boot") then write w "global::cs.Boot.init();"; newline w);
  2232. expr_s w { eexpr = TTypeExpr(TClassDecl cl); etype = t_dynamic; epos = Ast.null_pos };
  2233. write w ".main();";
  2234. end_block w;
  2235. end_block w;
  2236. newline w;
  2237. false
  2238. | Some path when path = cl.cl_path && not cl.cl_interface -> true
  2239. | _ -> false
  2240. in
  2241. let clt, access, modifiers = get_class_modifiers cl.cl_meta (if cl.cl_interface then "interface" else "class") "public" [] in
  2242. let is_final = clt = "struct" || Meta.has Meta.Final cl.cl_meta in
  2243. let modifiers = [access] @ modifiers in
  2244. print w "%s %s %s" (String.concat " " modifiers) clt (change_clname (snd cl.cl_path));
  2245. (* type parameters *)
  2246. let params, params_ext = get_string_params cl cl.cl_params in
  2247. 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
  2248. (match extends_implements with
  2249. | [] -> print w "%s%s " params params_ext
  2250. | _ -> print w "%s : %s%s " params (String.concat ", " extends_implements) params_ext);
  2251. (* class head ok: *)
  2252. (* public class Test<A> : X, Y, Z where A : Y *)
  2253. begin_block w;
  2254. newline w;
  2255. (* our constructor is expected to be a normal "new" function *
  2256. if !strict_mode && is_some cl.cl_constructor then assert false;*)
  2257. let rec loop meta =
  2258. match meta with
  2259. | [] -> ()
  2260. | (Meta.ClassCode, [Ast.EConst (Ast.String contents),_],_) :: tl ->
  2261. write w contents
  2262. | _ :: tl -> loop tl
  2263. in
  2264. loop cl.cl_meta;
  2265. if is_main then begin
  2266. write w "public static void Main()";
  2267. begin_block w;
  2268. (if Hashtbl.mem gen.gtypes (["cs"], "Boot") then write w "global::cs.Boot.init();"; newline w);
  2269. write w "main();";
  2270. end_block w
  2271. end;
  2272. (match cl.cl_init with
  2273. | None -> ()
  2274. | Some init ->
  2275. print w "static %s() " (snd cl.cl_path);
  2276. expr_s w (mk_block init);
  2277. line_reset_directive w;
  2278. newline w;
  2279. newline w
  2280. );
  2281. (* collect properties and events *)
  2282. let partition cf cflist =
  2283. let events, props, nonprops = ref [], ref [], ref [] in
  2284. List.iter (fun v -> match v.cf_kind with
  2285. | Var { v_read = AccCall } | Var { v_write = AccCall } when Type.is_extern_field v && Meta.has Meta.Property v.cf_meta ->
  2286. props := (v.cf_name, ref (v, v.cf_type, None, None)) :: !props;
  2287. | Var { v_read = AccNormal; v_write = AccNormal } when Meta.has Meta.Event v.cf_meta ->
  2288. if v.cf_public then gen.gcon.error "@:event fields must be private" v.cf_pos;
  2289. v.cf_meta <- (Meta.SkipReflection, [], null_pos) :: v.cf_meta;
  2290. events := (v.cf_name, ref (v, v.cf_type, false, None, None)) :: !events;
  2291. | _ ->
  2292. nonprops := v :: !nonprops;
  2293. ) cflist;
  2294. let events, nonprops = !events, !nonprops in
  2295. let t = TInst(cl, List.map snd cl.cl_params) in
  2296. let find_prop name = try
  2297. List.assoc name !props
  2298. with | Not_found -> match field_access gen t name with
  2299. | FClassField (_,_,decl,v,_,t,_) when is_extern_prop (TInst(cl,List.map snd cl.cl_params)) name ->
  2300. let ret = ref (v,t,None,None) in
  2301. props := (name, ret) :: !props;
  2302. ret
  2303. | _ -> raise Not_found
  2304. in
  2305. let find_event name = List.assoc name events in
  2306. let is_empty_function cf = match cf.cf_expr with
  2307. | Some {eexpr = TFunction { tf_expr = {eexpr = TBlock []}}} -> true
  2308. | _ -> false
  2309. in
  2310. let interf = cl.cl_interface in
  2311. (* get all functions that are getters/setters *)
  2312. let nonprops = List.filter (function
  2313. | cf when String.starts_with cf.cf_name "get_" -> (try
  2314. (* find the property *)
  2315. let prop = find_prop (String.sub cf.cf_name 4 (String.length cf.cf_name - 4)) in
  2316. let v, t, get, set = !prop in
  2317. assert (get = None);
  2318. prop := (v,t,Some cf,set);
  2319. not interf
  2320. with | Not_found -> true)
  2321. | cf when String.starts_with cf.cf_name "set_" -> (try
  2322. (* find the property *)
  2323. let prop = find_prop (String.sub cf.cf_name 4 (String.length cf.cf_name - 4)) in
  2324. let v, t, get, set = !prop in
  2325. assert (set = None);
  2326. prop := (v,t,get,Some cf);
  2327. not interf
  2328. with | Not_found -> true)
  2329. | cf when String.starts_with cf.cf_name "add_" -> (try
  2330. let event = find_event (String.sub cf.cf_name 4 (String.length cf.cf_name - 4)) in
  2331. let v, t, _, add, remove = !event in
  2332. assert (add = None);
  2333. cf.cf_meta <- (Meta.Custom "?event_impl", [], null_pos) :: cf.cf_meta;
  2334. let custom = not (is_empty_function cf) in
  2335. event := (v, t, custom, Some cf, remove);
  2336. false
  2337. with | Not_found -> true)
  2338. | cf when String.starts_with cf.cf_name "remove_" -> (try
  2339. let event = find_event (String.sub cf.cf_name 7 (String.length cf.cf_name - 7)) in
  2340. let v, t, _, add, remove = !event in
  2341. assert (remove = None);
  2342. cf.cf_meta <- (Meta.Custom "?event_impl", [], null_pos) :: cf.cf_meta;
  2343. let custom = not (is_empty_function cf) in
  2344. event := (v, t, custom, add, Some cf);
  2345. false
  2346. with | Not_found -> true)
  2347. | _ -> true
  2348. ) nonprops in
  2349. let nonprops = ref nonprops in
  2350. List.iter (fun (n,r) ->
  2351. let ev, t, custom, add, remove = !r in
  2352. let tmeth = (tfun [t] basic.tvoid) in
  2353. match add, remove with
  2354. | None, _ ->
  2355. gen.gcon.error ("Missing event method add_" ^ n) ev.cf_pos;
  2356. failwith "Build failed"
  2357. | _, None ->
  2358. gen.gcon.error ("Missing event method remove_" ^ n) ev.cf_pos;
  2359. failwith "Build failed"
  2360. | Some add, Some remove ->
  2361. let check cf = try
  2362. type_eq EqStrict cf.cf_type tmeth
  2363. with Unify_error el ->
  2364. List.iter (fun e -> gen.gcon.error (Typecore.unify_error_msg (print_context()) e) cf.cf_pos) el;
  2365. failwith "Build failed";
  2366. in
  2367. check add;
  2368. check remove;
  2369. if custom && not cl.cl_interface then
  2370. nonprops := add :: remove :: !nonprops
  2371. ) events;
  2372. let evts = List.map (fun(_,v) -> !v) events in
  2373. let ret = List.map (fun (_,v) -> !v) !props in
  2374. let ret = List.filter (function | (_,_,None,None) -> false | _ -> true) ret in
  2375. evts, ret, List.rev !nonprops
  2376. in
  2377. let fevents, fprops, fnonprops = partition cl cl.cl_ordered_fields in
  2378. let sevents, sprops, snonprops = partition cl cl.cl_ordered_statics in
  2379. (if is_some cl.cl_constructor then gen_class_field w false cl is_final (get cl.cl_constructor));
  2380. if not cl.cl_interface then begin
  2381. (* we don't want to generate properties for abstract implementation classes, because they don't have object to work with *)
  2382. List.iter (gen_event w true cl) sevents;
  2383. if (match cl.cl_kind with KAbstractImpl _ -> false | _ -> true) then List.iter (gen_prop w true cl is_final) sprops;
  2384. List.iter (gen_class_field w true cl is_final) snonprops
  2385. end;
  2386. List.iter (gen_event w false cl) fevents;
  2387. List.iter (gen_prop w false cl is_final) fprops;
  2388. List.iter (gen_class_field w false cl is_final) fnonprops;
  2389. check_special_behaviors w cl;
  2390. end_block w;
  2391. if cl.cl_interface && cl.cl_ordered_statics <> [] then begin
  2392. print w "public class %s__Statics_" (snd cl.cl_path);
  2393. begin_block w;
  2394. List.iter (gen_class_field w true { cl with cl_interface = false } is_final) cl.cl_ordered_statics;
  2395. end_block w
  2396. end;
  2397. if should_close then end_block w
  2398. in
  2399. let gen_enum w e =
  2400. let should_close = match change_ns (TEnumDecl e) (fst e.e_path) with
  2401. | [] -> false
  2402. | ns ->
  2403. print w "namespace %s" (String.concat "." ns);
  2404. begin_block w;
  2405. true
  2406. in
  2407. gen_attributes w e.e_meta;
  2408. print w "public enum %s" (change_clname (snd e.e_path));
  2409. begin_block w;
  2410. write w (String.concat ", " (List.map (change_id) e.e_names));
  2411. end_block w;
  2412. if should_close then end_block w
  2413. in
  2414. let module_type_gen w md_tp =
  2415. let file_start = len w = 0 in
  2416. let requires_root = no_root && file_start in
  2417. if file_start then
  2418. Codegen.map_source_header gen.gcon (fun s -> print w "// %s\n" s);
  2419. reset_temps();
  2420. match md_tp with
  2421. | TClassDecl cl ->
  2422. if not cl.cl_extern then begin
  2423. (if requires_root then write w "using haxe.root;\n"; newline w;);
  2424. gen_class w cl;
  2425. newline w;
  2426. newline w
  2427. end;
  2428. (not cl.cl_extern)
  2429. | TEnumDecl e ->
  2430. if not e.e_extern && not (Meta.has Meta.Class e.e_meta) then begin
  2431. (if requires_root then write w "using haxe.root;\n"; newline w;);
  2432. gen_enum w e;
  2433. newline w;
  2434. newline w
  2435. end;
  2436. (not e.e_extern)
  2437. | TAbstractDecl _
  2438. | TTypeDecl _ ->
  2439. false
  2440. in
  2441. let module_gen w md_def =
  2442. List.fold_left (fun should md -> module_type_gen w md || should) false md_def.m_types
  2443. in
  2444. (* generate source code *)
  2445. init_ctx gen;
  2446. Hashtbl.add gen.gspecial_vars "__rethrow__" true;
  2447. Hashtbl.add gen.gspecial_vars "__typeof__" true;
  2448. Hashtbl.add gen.gspecial_vars "__label__" true;
  2449. Hashtbl.add gen.gspecial_vars "__goto__" true;
  2450. Hashtbl.add gen.gspecial_vars "__is__" true;
  2451. Hashtbl.add gen.gspecial_vars "__as__" true;
  2452. Hashtbl.add gen.gspecial_vars "__cs__" true;
  2453. Hashtbl.add gen.gspecial_vars "__checked__" true;
  2454. Hashtbl.add gen.gspecial_vars "__lock__" true;
  2455. Hashtbl.add gen.gspecial_vars "__fixed__" true;
  2456. Hashtbl.add gen.gspecial_vars "__unsafe__" true;
  2457. Hashtbl.add gen.gspecial_vars "__addressOf__" true;
  2458. Hashtbl.add gen.gspecial_vars "__valueOf__" true;
  2459. Hashtbl.add gen.gspecial_vars "__sizeof__" true;
  2460. Hashtbl.add gen.gspecial_vars "__stackalloc__" true;
  2461. Hashtbl.add gen.gspecial_vars "__delegate__" true;
  2462. Hashtbl.add gen.gspecial_vars "__array__" true;
  2463. Hashtbl.add gen.gspecial_vars "__ptr__" true;
  2464. Hashtbl.add gen.gsupported_conversions (["haxe"; "lang"], "Null") (fun t1 t2 -> true);
  2465. let last_needs_box = gen.gneeds_box in
  2466. gen.gneeds_box <- (fun t -> match (gen.greal_type t) with
  2467. | TAbstract( ( { a_path = ["cs"], "Pointer" }, _ ) )
  2468. | TInst( { cl_path = ["cs"], "Pointer" }, _ )
  2469. | TInst( { cl_path = (["haxe"; "lang"], "Null") }, _ ) -> true
  2470. | _ -> last_needs_box t);
  2471. gen.greal_type <- real_type;
  2472. gen.greal_type_param <- change_param_type;
  2473. SetHXGen.run_filter gen SetHXGen.default_hxgen_func;
  2474. (* before running the filters, follow all possible types *)
  2475. (* this is needed so our module transformations don't break some core features *)
  2476. (* like multitype selection *)
  2477. let run_follow_gen = run_follow gen in
  2478. 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
  2479. let super_map (cl,tl) = (cl, List.map run_follow_gen tl) in
  2480. List.iter (function
  2481. | TClassDecl cl ->
  2482. let all_fields = (Option.map_default (fun cf -> [cf]) [] cl.cl_constructor) @ cl.cl_ordered_fields @ cl.cl_ordered_statics in
  2483. List.iter (fun cf ->
  2484. cf.cf_type <- run_follow_gen cf.cf_type;
  2485. cf.cf_expr <- Option.map type_map cf.cf_expr;
  2486. (* add @:skipReflection to @:event vars *)
  2487. match cf.cf_kind with
  2488. | Var _ when (Meta.has Meta.Event cf.cf_meta) && not (Meta.has Meta.SkipReflection cf.cf_meta) ->
  2489. cf.cf_meta <- (Meta.SkipReflection, [], null_pos) :: cf.cf_meta;
  2490. | _ -> ()
  2491. ) all_fields;
  2492. cl.cl_dynamic <- Option.map run_follow_gen cl.cl_dynamic;
  2493. cl.cl_array_access <- Option.map run_follow_gen cl.cl_array_access;
  2494. cl.cl_init <- Option.map type_map cl.cl_init;
  2495. cl.cl_super <- Option.map super_map cl.cl_super;
  2496. cl.cl_implements <- List.map super_map cl.cl_implements
  2497. | _ -> ()
  2498. ) gen.gtypes_list;
  2499. let closure_t = ClosuresToClass.DoubleAndDynamicClosureImpl.get_ctx gen 6 in
  2500. (*let closure_t = ClosuresToClass.create gen 10 float_cl
  2501. (fun l -> l)
  2502. (fun l -> l)
  2503. (fun args -> args)
  2504. (fun args -> [])
  2505. in
  2506. ClosuresToClass.configure gen (ClosuresToClass.default_implementation closure_t (fun e _ _ -> e));
  2507. StubClosureImpl.configure gen (StubClosureImpl.default_implementation gen float_cl 10 (fun e _ _ -> e));*)
  2508. let tp_v = alloc_var "$type_param" t_dynamic in
  2509. let mk_tp t pos = { eexpr = TLocal(tp_v); etype = t; epos = pos } in
  2510. TypeParams.configure gen (fun ecall efield params elist ->
  2511. match efield.eexpr with
  2512. | TField(_, FEnum _) ->
  2513. { ecall with eexpr = TCall(efield, elist) }
  2514. | _ ->
  2515. { ecall with eexpr = TCall(efield, (List.map (fun t -> mk_tp t ecall.epos ) params) @ elist) }
  2516. );
  2517. if not erase_generics then HardNullableSynf.configure gen (HardNullableSynf.traverse gen
  2518. (fun e ->
  2519. match e.eexpr, real_type e.etype with
  2520. | TConst TThis, _ when gen.gcurrent_path = (["haxe";"lang"], "Null") ->
  2521. e
  2522. | _, TInst({ cl_path = (["haxe";"lang"], "Null") }, [t]) ->
  2523. let e = { e with eexpr = TParenthesis(e) } in
  2524. { (mk_field_access gen e "value" e.epos) with etype = t }
  2525. | _ ->
  2526. trace (debug_type e.etype); gen.gcon.error "This expression is not a Nullable expression" e.epos; assert false
  2527. )
  2528. (fun v t has_value ->
  2529. match has_value, real_type v.etype with
  2530. | true, TDynamic _ | true, TAnon _ | true, TMono _ ->
  2531. {
  2532. eexpr = TCall(mk_static_field_access_infer null_t "ofDynamic" v.epos [t], [mk_tp t v.epos; v]);
  2533. etype = TInst(null_t, [t]);
  2534. epos = v.epos
  2535. }
  2536. | _ ->
  2537. { 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 }
  2538. )
  2539. (fun e ->
  2540. {
  2541. eexpr = TCall(
  2542. { (mk_field_access gen { (mk_paren e) with etype = real_type e.etype } "toDynamic" e.epos) with etype = TFun([], t_dynamic) },
  2543. []);
  2544. etype = t_dynamic;
  2545. epos = e.epos
  2546. }
  2547. )
  2548. (fun e ->
  2549. mk_field_access gen { e with etype = real_type e.etype } "hasValue" e.epos
  2550. )
  2551. (fun e1 e2 ->
  2552. {
  2553. eexpr = TCall(
  2554. mk_field_access gen e1 "Equals" e1.epos,
  2555. [e2]);
  2556. etype = basic.tbool;
  2557. epos = e1.epos;
  2558. }
  2559. )
  2560. true
  2561. false
  2562. );
  2563. let explicit_fn_name c tl fname =
  2564. path_param_s (TClassDecl c) c.cl_path tl ^ "." ^ fname
  2565. in
  2566. FixOverrides.configure ~explicit_fn_name:explicit_fn_name ~get_vmtype:real_type gen;
  2567. Normalize.configure gen ~metas:(Hashtbl.create 0);
  2568. AbstractImplementationFix.configure gen;
  2569. IteratorsInterface.configure gen (fun e -> e);
  2570. OverrideFix.configure gen;
  2571. ClosuresToClass.configure gen (ClosuresToClass.default_implementation closure_t (get_cl (get_type gen (["haxe";"lang"],"Function")) ));
  2572. let enum_base = (get_cl (get_type gen (["haxe";"lang"],"Enum")) ) in
  2573. let param_enum_base = (get_cl (get_type gen (["haxe";"lang"],"ParamEnum")) ) in
  2574. EnumToClass.configure gen (Some (fun e -> mk_cast gen.gcon.basic.tint e)) true true enum_base param_enum_base false false;
  2575. InterfaceVarsDeleteModf.configure gen;
  2576. InterfaceProps.configure gen;
  2577. let dynamic_object = (get_cl (get_type gen (["haxe";"lang"],"DynamicObject")) ) in
  2578. let object_iface = get_cl (get_type gen (["haxe";"lang"],"IHxObject")) in
  2579. (*fixme: THIS IS A HACK. take this off *)
  2580. let empty_e = match (get_type gen (["haxe";"lang"], "EmptyObject")) with | TEnumDecl e -> e | _ -> assert false in
  2581. (*OverloadingCtor.set_new_create_empty gen ({eexpr=TEnumField(empty_e, "EMPTY"); etype=TEnum(empty_e,[]); epos=null_pos;});*)
  2582. let empty_expr = { eexpr = (TTypeExpr (TEnumDecl empty_e)); etype = (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics empty_e) }); epos = null_pos } in
  2583. let empty_ef =
  2584. try
  2585. PMap.find "EMPTY" empty_e.e_constrs
  2586. with Not_found -> gen.gcon.error "Required enum field EMPTY was not found" empty_e.e_pos; assert false
  2587. in
  2588. 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;
  2589. let rcf_static_find = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "findHash" Ast.null_pos [] in
  2590. let rcf_static_lookup = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "lookupHash" Ast.null_pos [] in
  2591. let rcf_static_insert, rcf_static_remove =
  2592. if erase_generics then begin
  2593. let get_specialized_postfix t = match t with
  2594. | TAbstract({a_path = [],("Float" | "Int" as name)}, _) -> name
  2595. | TAnon _ | TDynamic _ -> "Dynamic"
  2596. | _ -> print_endline (debug_type t); assert false
  2597. in
  2598. (fun t -> mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) ("insert" ^ get_specialized_postfix t) Ast.null_pos []),
  2599. (fun t -> mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) ("remove" ^ get_specialized_postfix t) Ast.null_pos [])
  2600. end else
  2601. (fun t -> mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "insert" Ast.null_pos [t]),
  2602. (fun t -> mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "remove" Ast.null_pos [t])
  2603. in
  2604. let can_be_float = like_float in
  2605. let rcf_on_getset_field main_expr field_expr field may_hash may_set is_unsafe =
  2606. let is_float = can_be_float (real_type main_expr.etype) in
  2607. let fn_name = if is_some may_set then "setField" else "getField" in
  2608. let fn_name = if is_float then fn_name ^ "_f" else fn_name in
  2609. let pos = field_expr.epos in
  2610. let is_unsafe = { eexpr = TConst(TBool is_unsafe); etype = basic.tbool; epos = pos } in
  2611. let should_cast = match main_expr.etype with | TAbstract({ a_path = ([], "Float") }, []) -> false | _ -> true in
  2612. let infer = mk_static_field_access_infer runtime_cl fn_name field_expr.epos [] in
  2613. let first_args =
  2614. [ field_expr; { eexpr = TConst(TString field); etype = basic.tstring; epos = pos } ]
  2615. @ if is_some may_hash then [ { eexpr = TConst(TInt (get may_hash)); etype = basic.tint; epos = pos } ] else []
  2616. in
  2617. let args = first_args @ match is_float, may_set with
  2618. | true, Some(set) ->
  2619. [ if should_cast then mk_cast basic.tfloat set else set ]
  2620. | false, Some(set) ->
  2621. [ set ]
  2622. | _ ->
  2623. [ is_unsafe ]
  2624. in
  2625. let call = { main_expr with eexpr = TCall(infer,args) } in
  2626. let call = if is_float && should_cast then mk_cast main_expr.etype call else call in
  2627. call
  2628. in
  2629. let rcf_on_call_field ecall field_expr field may_hash args =
  2630. let infer = mk_static_field_access_infer runtime_cl "callField" field_expr.epos [] in
  2631. let hash_arg = match may_hash with
  2632. | None -> []
  2633. | Some h -> [ { eexpr = TConst(TInt h); etype = basic.tint; epos = field_expr.epos } ]
  2634. in
  2635. let arr_call = if args <> [] then
  2636. { eexpr = TArrayDecl args; etype = basic.tarray t_dynamic; epos = ecall.epos }
  2637. else
  2638. null (basic.tarray t_dynamic) ecall.epos
  2639. in
  2640. let call_args =
  2641. [field_expr; { field_expr with eexpr = TConst(TString field); etype = basic.tstring } ]
  2642. @ hash_arg
  2643. @ [ arr_call ]
  2644. in
  2645. mk_cast ecall.etype { ecall with eexpr = TCall(infer, call_args) }
  2646. in
  2647. if not erase_generics then
  2648. handle_type_params gen ifaces (get_cl (get_type gen (["haxe";"lang"], "IGenericObject")))
  2649. else begin
  2650. add_cast_handler gen;
  2651. TypeParams.RealTypeParams.RealTypeParamsModf.configure gen (TypeParams.RealTypeParams.RealTypeParamsModf.set_only_hxgeneric gen)
  2652. end;
  2653. let rcf_ctx =
  2654. ReflectionCFs.new_ctx
  2655. gen
  2656. closure_t
  2657. object_iface
  2658. true
  2659. rcf_on_getset_field
  2660. rcf_on_call_field
  2661. (fun hash hash_array length -> { hash with eexpr = TCall(rcf_static_find, [hash; hash_array; length]); etype=basic.tint })
  2662. (fun hash -> { hash with eexpr = TCall(rcf_static_lookup, [hash]); etype = gen.gcon.basic.tstring })
  2663. (fun hash_array length pos value ->
  2664. let ecall = mk (TCall(rcf_static_insert value.etype, [hash_array; length; pos; value])) (if erase_generics then hash_array.etype else basic.tvoid) hash_array.epos in
  2665. if erase_generics then { ecall with eexpr = TBinop(OpAssign, hash_array, ecall) } else ecall
  2666. )
  2667. (fun hash_array length pos ->
  2668. let t = gen.gclasses.nativearray_type hash_array.etype in
  2669. { hash_array with eexpr = TCall(rcf_static_remove t, [hash_array; length; pos]); etype = gen.gcon.basic.tvoid }
  2670. )
  2671. false
  2672. in
  2673. ReflectionCFs.UniversalBaseClass.default_config gen (get_cl (get_type gen (["haxe";"lang"],"HxObject")) ) object_iface dynamic_object;
  2674. ReflectionCFs.configure_dynamic_field_access rcf_ctx false;
  2675. (* let closure_func = ReflectionCFs.implement_closure_cl rcf_ctx ( get_cl (get_type gen (["haxe";"lang"],"Closure")) ) in *)
  2676. let closure_cl = get_cl (get_type gen (["haxe";"lang"],"Closure")) in
  2677. let varargs_cl = get_cl (get_type gen (["haxe";"lang"],"VarArgsFunction")) in
  2678. let dynamic_name = gen.gmk_internal_name "hx" "invokeDynamic" in
  2679. List.iter (fun cl ->
  2680. List.iter (fun cf ->
  2681. if cf.cf_name = dynamic_name then cl.cl_overrides <- cf :: cl.cl_overrides
  2682. ) cl.cl_ordered_fields
  2683. ) [closure_cl; varargs_cl];
  2684. let closure_func = ReflectionCFs.get_closure_func rcf_ctx closure_cl in
  2685. ReflectionCFs.implement_varargs_cl rcf_ctx ( get_cl (get_type gen (["haxe";"lang"], "VarArgsBase")) );
  2686. let slow_invoke = mk_static_field_access_infer (runtime_cl) "slowCallField" Ast.null_pos [] in
  2687. ReflectionCFs.configure rcf_ctx ~slow_invoke:(fun ethis efield eargs -> {
  2688. eexpr = TCall(slow_invoke, [ethis; efield; eargs]);
  2689. etype = t_dynamic;
  2690. epos = ethis.epos;
  2691. } ) object_iface;
  2692. let objdecl_fn = ReflectionCFs.implement_dynamic_object_ctor rcf_ctx dynamic_object in
  2693. ObjectDeclMap.configure gen (ObjectDeclMap.traverse gen objdecl_fn);
  2694. InitFunction.configure gen true true;
  2695. TArrayTransform.configure gen (TArrayTransform.default_implementation gen (
  2696. fun e binop ->
  2697. match e.eexpr with
  2698. | TArray(e1, e2) ->
  2699. (match follow e1.etype with
  2700. | TDynamic _ | TAnon _ | TMono _ -> true
  2701. | TInst({ cl_kind = KTypeParameter _ }, _) -> true
  2702. | TInst(c,p) when erase_generics && is_hxgeneric (TClassDecl c) && is_hxgen (TClassDecl c) -> (match c.cl_path with
  2703. | [],"String"
  2704. | ["cs"],"NativeArray" -> false
  2705. | _ ->
  2706. true)
  2707. | _ -> match binop, change_param_type (t_to_md e1.etype) [e.etype] with
  2708. | Some(Ast.OpAssignOp _), ([TDynamic _] | [TAnon _]) ->
  2709. true
  2710. | _ -> false)
  2711. | _ -> assert false
  2712. ) "__get" "__set" );
  2713. let field_is_dynamic t field =
  2714. match field_access_esp gen (gen.greal_type t) field with
  2715. | FEnumField _ -> false
  2716. | FClassField (cl,p,_,_,_,t,_) ->
  2717. if not erase_generics then
  2718. false
  2719. else
  2720. let p = change_param_type (TClassDecl cl) p in
  2721. is_dynamic (apply_params cl.cl_params p t)
  2722. | _ -> true
  2723. in
  2724. let is_dynamic_expr e = is_dynamic e.etype || match e.eexpr with
  2725. | TField(tf, f) -> field_is_dynamic tf.etype (f)
  2726. | _ -> false
  2727. in
  2728. let may_nullable t = match gen.gfollow#run_f t with
  2729. | TType({ t_path = ([], "Null") }, [t]) ->
  2730. (match follow t with
  2731. | TInst({ cl_path = ([], "String") }, [])
  2732. | TAbstract ({ a_path = ([], "Float") },[])
  2733. | TInst({ cl_path = (["haxe"], "Int32")}, [] )
  2734. | TInst({ cl_path = (["haxe"], "Int64")}, [] )
  2735. | TAbstract ({ a_path = ([], "Int") },[])
  2736. | TAbstract ({ a_path = ([], "Bool") },[]) -> Some t
  2737. | TAbstract _ when like_float t -> Some t
  2738. | t when is_cs_basic_type t -> Some t
  2739. | _ -> None )
  2740. | _ -> None
  2741. in
  2742. let is_double t = like_float t && not (like_int t) in
  2743. let is_int t = like_int t in
  2744. let is_null t = match real_type t with
  2745. | TInst( { cl_path = (["haxe";"lang"], "Null") }, _ ) -> true
  2746. | _ -> false
  2747. in
  2748. let is_null_expr e = is_null e.etype || match e.eexpr with
  2749. | TField(tf, f) -> (match field_access_esp gen (real_type tf.etype) (f) with
  2750. | FClassField(_,_,_,_,_,actual_t,_) -> is_null actual_t
  2751. | _ -> false)
  2752. | _ -> false
  2753. in
  2754. let should_handle_opeq t =
  2755. match real_type t with
  2756. | TDynamic _ | TAnon _ | TMono _
  2757. | TInst( { cl_kind = KTypeParameter _ }, _ )
  2758. | TInst( { cl_path = (["haxe";"lang"], "Null") }, _ ) -> true
  2759. | _ -> false
  2760. in
  2761. let string_cl = match gen.gcon.basic.tstring with
  2762. | TInst(c,[]) -> c
  2763. | _ -> assert false
  2764. in
  2765. let is_undefined e = match e.eexpr with
  2766. | TLocal { v_name = "__undefined__" } | TField(_,FStatic({cl_path=["haxe";"lang"],"Runtime"},{cf_name="undefined"})) -> true
  2767. | _ -> false
  2768. in
  2769. DynamicOperators.configure gen
  2770. (DynamicOperators.abstract_implementation gen (fun e -> match e.eexpr with
  2771. | TBinop (Ast.OpEq, e1, e2)
  2772. | TBinop (Ast.OpNotEq, e1, e2) ->
  2773. (
  2774. (* dont touch (v == null) and (null == v) comparisons because they are handled by HardNullableSynf later *)
  2775. match e1.eexpr, e2.eexpr with
  2776. | TConst(TNull), _ when (not (is_tparam e2.etype) && is_dynamic e2.etype) || is_null_expr e2 ->
  2777. false
  2778. | _, TConst(TNull) when (not (is_tparam e1.etype) && is_dynamic e1.etype) || is_null_expr e1 ->
  2779. false
  2780. | _ when is_undefined e1 || is_undefined e2 ->
  2781. false
  2782. | _ ->
  2783. should_handle_opeq e1.etype || should_handle_opeq e2.etype
  2784. )
  2785. | TBinop (Ast.OpAssignOp Ast.OpAdd, e1, e2) ->
  2786. is_dynamic_expr e1 || is_null_expr e1 || is_string e.etype
  2787. | TBinop (Ast.OpAdd, e1, e2) -> is_dynamic e1.etype || is_dynamic e2.etype || is_tparam e1.etype || is_tparam e2.etype || is_string e1.etype || is_string e2.etype || is_string e.etype
  2788. | TBinop (Ast.OpLt, e1, e2)
  2789. | TBinop (Ast.OpLte, e1, e2)
  2790. | TBinop (Ast.OpGte, e1, e2)
  2791. | TBinop (Ast.OpGt, e1, e2) -> is_dynamic e.etype || is_dynamic_expr e1 || is_dynamic_expr e2 || is_string e1.etype || is_string e2.etype
  2792. | TBinop (_, e1, e2) -> is_dynamic e.etype || is_dynamic_expr e1 || is_dynamic_expr e2
  2793. | 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 *)
  2794. | _ -> false)
  2795. (fun e1 e2 ->
  2796. let is_basic = is_cs_basic_type (follow e1.etype) || is_cs_basic_type (follow e2.etype) in
  2797. let is_ref = if is_basic then false else match follow e1.etype, follow e2.etype with
  2798. | TDynamic _, _
  2799. | _, TDynamic _
  2800. | TInst( { cl_path = ([], "String") }, [] ), _
  2801. | _, TInst( { cl_path = ([], "String") }, [] )
  2802. | TInst( { cl_kind = KTypeParameter _ }, [] ), _
  2803. | _, TInst( { cl_kind = KTypeParameter _ }, [] ) -> false
  2804. | _, _ -> true
  2805. in
  2806. let static = mk_static_field_access_infer (runtime_cl) (if is_ref then "refEq" else "eq") e1.epos [] in
  2807. { eexpr = TCall(static, [e1; e2]); etype = gen.gcon.basic.tbool; epos=e1.epos }
  2808. )
  2809. (fun e e1 e2 ->
  2810. match may_nullable e1.etype, may_nullable e2.etype with
  2811. | Some t1, Some t2 ->
  2812. let t1, t2 = if is_string t1 || is_string t2 then
  2813. basic.tstring, basic.tstring
  2814. else if is_double t1 || is_double t2 then
  2815. basic.tfloat, basic.tfloat
  2816. else if is_int t1 || is_int t2 then
  2817. basic.tint, basic.tint
  2818. else t1, t2 in
  2819. { eexpr = TBinop(Ast.OpAdd, mk_cast t1 e1, mk_cast t2 e2); etype = e.etype; epos = e1.epos }
  2820. | _ when is_string e.etype || is_string e1.etype || is_string e2.etype ->
  2821. {
  2822. eexpr = TCall(
  2823. mk_static_field_access_infer runtime_cl "concat" e.epos [],
  2824. [ e1; e2 ]
  2825. );
  2826. etype = basic.tstring;
  2827. epos = e.epos
  2828. }
  2829. | _ ->
  2830. let static = mk_static_field_access_infer (runtime_cl) "plus" e1.epos [] in
  2831. mk_cast e.etype { eexpr = TCall(static, [e1; e2]); etype = t_dynamic; epos=e1.epos })
  2832. (fun e1 e2 ->
  2833. if is_string e1.etype then begin
  2834. { e1 with eexpr = TCall(mk_static_field_access_infer string_cl "Compare" e1.epos [], [ e1; e2 ]); etype = gen.gcon.basic.tint }
  2835. end else begin
  2836. let static = mk_static_field_access_infer (runtime_cl) "compare" e1.epos [] in
  2837. { eexpr = TCall(static, [e1; e2]); etype = gen.gcon.basic.tint; epos=e1.epos }
  2838. end) ~handle_strings:false);
  2839. FilterClosures.configure gen (FilterClosures.traverse gen (fun e1 s -> true) closure_func);
  2840. let base_exception = get_cl (get_type gen (["System"], "Exception")) in
  2841. let base_exception_t = TInst(base_exception, []) in
  2842. let hx_exception = get_cl (get_type gen (["haxe";"lang"], "HaxeException")) in
  2843. let hx_exception_t = TInst(hx_exception, []) in
  2844. let rec is_exception t =
  2845. match follow t with
  2846. | TInst(cl,_) ->
  2847. if cl == base_exception then
  2848. true
  2849. else
  2850. (match cl.cl_super with | None -> false | Some (cl,arg) -> is_exception (TInst(cl,arg)))
  2851. | _ -> false
  2852. in
  2853. TryCatchWrapper.configure gen
  2854. (
  2855. TryCatchWrapper.traverse gen
  2856. (fun t -> not (is_exception (real_type t)))
  2857. (fun throwexpr expr ->
  2858. let wrap_static = mk_static_field_access (hx_exception) "wrap" (TFun([("obj",false,t_dynamic)], base_exception_t)) expr.epos in
  2859. { throwexpr with eexpr = TThrow { expr with eexpr = TCall(wrap_static, [expr]); etype = hx_exception_t }; etype = gen.gcon.basic.tvoid }
  2860. )
  2861. (fun v_to_unwrap pos ->
  2862. let local = mk_cast hx_exception_t { eexpr = TLocal(v_to_unwrap); etype = v_to_unwrap.v_type; epos = pos } in
  2863. mk_field_access gen local "obj" pos
  2864. )
  2865. (fun rethrow ->
  2866. { rethrow with eexpr = TCall(mk_local (alloc_var "__rethrow__" t_dynamic) rethrow.epos, [rethrow]); etype = gen.gcon.basic.tvoid }
  2867. )
  2868. (base_exception_t)
  2869. (hx_exception_t)
  2870. (fun v e ->
  2871. let exc_cl = get_cl (get_type gen (["haxe";"lang"],"Exceptions")) in
  2872. let exc_field = mk_static_field_access_infer exc_cl "exception" e.epos [] in
  2873. let esetstack = mk (TBinop(Ast.OpAssign, exc_field, mk_local v e.epos)) v.v_type e.epos in
  2874. Type.concat esetstack e;
  2875. )
  2876. );
  2877. let get_typeof e =
  2878. { e with eexpr = TCall( { eexpr = TLocal( alloc_var "__typeof__" t_dynamic ); etype = t_dynamic; epos = e.epos }, [e] ) }
  2879. in
  2880. ClassInstance.configure gen (ClassInstance.traverse gen (fun e mt ->
  2881. get_typeof e
  2882. ));
  2883. CastDetect.configure gen (CastDetect.default_implementation gen (Some (TEnum(empty_e, []))) (not erase_generics) ~native_string_cast:false ~overloads_cast_to_base:true);
  2884. (*FollowAll.configure gen;*)
  2885. SwitchToIf.configure gen (SwitchToIf.traverse gen (fun e ->
  2886. match e.eexpr with
  2887. | TSwitch(cond, cases, def) ->
  2888. (match gen.gfollow#run_f cond.etype with
  2889. | TAbstract ({ a_path = ([], "Int") },[])
  2890. | TInst({ cl_path = ([], "String") },[]) ->
  2891. (List.exists (fun (c,_) ->
  2892. List.exists (fun expr -> match expr.eexpr with | TConst _ -> false | _ -> true ) c
  2893. ) cases)
  2894. | _ -> true
  2895. )
  2896. | _ -> assert false
  2897. ) true ) ;
  2898. ExpressionUnwrap.configure gen (ExpressionUnwrap.traverse gen (fun e -> Some { eexpr = TVar(mk_temp gen "expr" e.etype, Some e); etype = gen.gcon.basic.tvoid; epos = e.epos }));
  2899. UnnecessaryCastsRemoval.configure gen;
  2900. IntDivisionSynf.configure gen (IntDivisionSynf.default_implementation gen true);
  2901. UnreachableCodeEliminationSynf.configure gen (UnreachableCodeEliminationSynf.traverse gen false true true false);
  2902. ArrayDeclSynf.configure gen (ArrayDeclSynf.default_implementation gen native_arr_cl);
  2903. let goto_special = alloc_var "__goto__" t_dynamic in
  2904. let label_special = alloc_var "__label__" t_dynamic in
  2905. SwitchBreakSynf.configure gen (SwitchBreakSynf.traverse gen
  2906. (fun e_loop n api ->
  2907. 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;
  2908. e_loop
  2909. )
  2910. (fun e_break n api ->
  2911. { eexpr = TCall( mk_local goto_special e_break.epos, [ mk_int gen n e_break.epos ] ); etype = t_dynamic; epos = e_break.epos }
  2912. )
  2913. );
  2914. DefaultArguments.configure gen (DefaultArguments.traverse gen);
  2915. InterfaceMetas.configure gen;
  2916. CSharpSpecificSynf.configure gen (CSharpSpecificSynf.traverse gen runtime_cl);
  2917. CSharpSpecificESynf.configure gen (CSharpSpecificESynf.traverse gen runtime_cl);
  2918. let out_files = ref [] in
  2919. (* copy resource files *)
  2920. if Hashtbl.length gen.gcon.resources > 0 then begin
  2921. let src =
  2922. gen.gcon.file ^ "/src/Resources"
  2923. in
  2924. Hashtbl.iter (fun name v ->
  2925. let name = Codegen.escape_res_name name true in
  2926. let full_path = src ^ "/" ^ name in
  2927. mkdir_from_path full_path;
  2928. let f = open_out_bin full_path in
  2929. output_string f v;
  2930. close_out f;
  2931. out_files := (unique_full_path full_path) :: !out_files
  2932. ) gen.gcon.resources;
  2933. end;
  2934. (* add resources array *)
  2935. (try
  2936. let res = get_cl (Hashtbl.find gen.gtypes (["haxe"], "Resource")) in
  2937. let cf = PMap.find "content" res.cl_statics in
  2938. let res = ref [] in
  2939. Hashtbl.iter (fun name v ->
  2940. res := { eexpr = TConst(TString name); etype = gen.gcon.basic.tstring; epos = Ast.null_pos } :: !res;
  2941. ) gen.gcon.resources;
  2942. cf.cf_expr <- Some ({ eexpr = TArrayDecl(!res); etype = gen.gcon.basic.tarray gen.gcon.basic.tstring; epos = Ast.null_pos })
  2943. with | Not_found -> ());
  2944. run_filters gen;
  2945. (* after the filters have been run, add all hashed fields to FieldLookup *)
  2946. let normalize_i i =
  2947. let i = Int32.of_int (i) in
  2948. if i < Int32.zero then
  2949. Int32.logor (Int32.logand i (Int32.of_int 0x3FFFFFFF)) (Int32.shift_left Int32.one 30)
  2950. else i
  2951. in
  2952. let nhash = ref 0 in
  2953. let hashes = Hashtbl.fold (fun i s acc -> incr nhash; (normalize_i i,s) :: acc) rcf_ctx.rcf_hash_fields [] in
  2954. let hashes = List.sort (fun (i,s) (i2,s2) -> compare i i2) hashes in
  2955. let flookup_cl = get_cl (get_type gen (["haxe";"lang"], "FieldLookup")) in
  2956. let haxe_libs = List.filter (function (_,_,_,lookup) -> is_some (lookup (["haxe";"lang"], "DceNo"))) gen.gcon.net_libs in
  2957. (try
  2958. (* first let's see if we're adding a -net-lib that has already a haxe.lang.FieldLookup *)
  2959. let name,_,_,_ = List.find (function (_,_,_,lookup) -> is_some (lookup (["haxe";"lang"], "FieldLookup"))) gen.gcon.net_libs in
  2960. if not (Common.defined gen.gcon Define.DllImport) then begin
  2961. gen.gcon.warning ("The -net-lib with path " ^ name ^ " contains a Haxe-generated assembly. Please define `-D dll_import` to handle Haxe-generated dll import correctly") null_pos;
  2962. raise Not_found
  2963. end;
  2964. if not (List.exists (function (n,_,_,_) -> n = name) haxe_libs) then
  2965. gen.gcon.warning ("The -net-lib with path " ^ name ^ " contains a Haxe-generated assembly, however it wasn't compiled with `-dce no`. Recompilation with `-dce no` is recommended") null_pos;
  2966. (* it has; in this case, we need to add the used fields on each __init__ *)
  2967. flookup_cl.cl_extern <- true;
  2968. let hashs_by_path = Hashtbl.create !nhash in
  2969. Hashtbl.iter (fun (path,i) s -> Hashtbl.add hashs_by_path path (i,s)) rcf_ctx.rcf_hash_paths;
  2970. Hashtbl.iter (fun _ md -> match md with
  2971. | TClassDecl ({ cl_extern = false; cl_interface = false } as c) -> (try
  2972. let all = Hashtbl.find_all hashs_by_path c.cl_path in
  2973. let all = List.map (fun (i,s) -> normalize_i i, s) all in
  2974. let all = List.sort (fun (i,s) (i2,s2) -> compare i i2) all in
  2975. if all <> [] then begin
  2976. let add = mk_static_field_access_infer flookup_cl "addFields" c.cl_pos [] in
  2977. let expr = { eexpr = TCall(add, [
  2978. mk_nativearray_decl gen basic.tint (List.map (fun (i,s) -> { eexpr = TConst(TInt (i)); etype = basic.tint; epos = c.cl_pos }) all) c.cl_pos;
  2979. mk_nativearray_decl gen basic.tstring (List.map (fun (i,s) -> { eexpr = TConst(TString (s)); etype = basic.tstring; epos = c.cl_pos }) all) c.cl_pos;
  2980. ]); etype = basic.tvoid; epos = c.cl_pos } in
  2981. match c.cl_init with
  2982. | None -> c.cl_init <- Some expr
  2983. | Some e ->
  2984. c.cl_init <- Some { eexpr = TBlock([expr;e]); etype = basic.tvoid; epos = e.epos }
  2985. end
  2986. with | Not_found -> ())
  2987. | _ -> ()) gen.gtypes;
  2988. with | Not_found -> try
  2989. let basic = gen.gcon.basic in
  2990. let cl = flookup_cl in
  2991. let field_ids = PMap.find "fieldIds" cl.cl_statics in
  2992. let fields = PMap.find "fields" cl.cl_statics in
  2993. field_ids.cf_expr <- Some (mk_nativearray_decl gen basic.tint (List.map (fun (i,s) -> { eexpr = TConst(TInt (i)); etype = basic.tint; epos = field_ids.cf_pos }) hashes) field_ids.cf_pos);
  2994. fields.cf_expr <- Some (mk_nativearray_decl gen basic.tstring (List.map (fun (i,s) -> { eexpr = TConst(TString s); etype = basic.tstring; epos = fields.cf_pos }) hashes) fields.cf_pos);
  2995. with | Not_found ->
  2996. gen.gcon.error "Fields 'fieldIds' and 'fields' were not found in class haxe.lang.FieldLookup" flookup_cl.cl_pos
  2997. );
  2998. if Common.defined gen.gcon Define.DllImport then begin
  2999. Hashtbl.iter (fun _ md -> match md with
  3000. | TClassDecl ({ cl_extern = false } as c) -> (try
  3001. let extra = match c.cl_params with
  3002. | _ :: _ when not erase_generics -> "_" ^ string_of_int (List.length c.cl_params)
  3003. | _ -> ""
  3004. in
  3005. let pack = match c.cl_path with
  3006. | ([], _) when no_root && is_hxgen (TClassDecl c) ->
  3007. ["haxe";"root"]
  3008. | (p,_) -> p
  3009. in
  3010. let path = (pack, snd c.cl_path ^ extra) in
  3011. ignore (List.find (function (_,_,_,lookup) ->
  3012. is_some (lookup path)) haxe_libs);
  3013. c.cl_extern <- true;
  3014. with | Not_found -> ())
  3015. | _ -> ()) gen.gtypes
  3016. end;
  3017. TypeParams.RenameTypeParameters.run gen;
  3018. let parts = Str.split_delim (Str.regexp "[\\/]+") gen.gcon.file in
  3019. mkdir_recursive "" parts;
  3020. generate_modules gen "cs" "src" module_gen out_files;
  3021. if not (Common.defined gen.gcon Define.KeepOldOutput) then
  3022. clean_files (gen.gcon.file ^ "/src") !out_files gen.gcon.verbose;
  3023. dump_descriptor gen ("hxcs_build.txt") path_s module_s;
  3024. if ( not (Common.defined gen.gcon Define.NoCompilation) ) then begin
  3025. let old_dir = Sys.getcwd() in
  3026. Sys.chdir gen.gcon.file;
  3027. let cmd = "haxelib run hxcs hxcs_build.txt --haxe-version " ^ (string_of_int gen.gcon.version) ^ " --feature-level 1" in
  3028. print_endline cmd;
  3029. if gen.gcon.run_command cmd <> 0 then failwith "Build failed";
  3030. Sys.chdir old_dir;
  3031. end
  3032. (* end of configure function *)
  3033. let generate con =
  3034. (try
  3035. let gen = new_ctx con in
  3036. let basic = con.basic in
  3037. if Common.defined_value con Define.Dce = "no" then begin
  3038. let m = { null_module with m_id = alloc_mid(); m_path = ["haxe";"lang"],"DceNo" } in
  3039. let cl = mk_class m (["haxe";"lang"],"DceNo") null_pos in
  3040. gen.gtypes_list <- (TClassDecl cl) :: gen.gtypes_list;
  3041. Hashtbl.add gen.gtypes cl.cl_path (TClassDecl cl)
  3042. end;
  3043. (* make the basic functions in C# *)
  3044. let type_cl = get_cl ( get_type gen (["System"], "Type")) in
  3045. let basic_fns =
  3046. [
  3047. mk_class_field "Equals" (TFun(["obj",false,t_dynamic], basic.tbool)) true Ast.null_pos (Method MethNormal) [];
  3048. mk_class_field "ToString" (TFun([], basic.tstring)) true Ast.null_pos (Method MethNormal) [];
  3049. mk_class_field "GetHashCode" (TFun([], basic.tint)) true Ast.null_pos (Method MethNormal) [];
  3050. mk_class_field "GetType" (TFun([], TInst(type_cl, []))) true Ast.null_pos (Method MethNormal) [];
  3051. ] in
  3052. List.iter (fun cf -> gen.gbase_class_fields <- PMap.add cf.cf_name cf gen.gbase_class_fields) basic_fns;
  3053. configure gen
  3054. with | TypeNotFound path ->
  3055. con.error ("Error. Module '" ^ (path_s path) ^ "' is required and was not included in build.") Ast.null_pos);
  3056. debug_mode := false
  3057. (* -net-lib implementation *)
  3058. open IlData
  3059. open IlMeta
  3060. type net_lib_ctx = {
  3061. nstd : bool;
  3062. ncom : Common.context;
  3063. nil : IlData.ilctx;
  3064. }
  3065. let is_haxe_keyword = function
  3066. | "callback" | "cast" | "extern" | "function" | "in" | "typedef" | "using" | "var" | "untyped" | "inline" -> true
  3067. | _ -> false
  3068. let hxpath_to_net ctx path =
  3069. try
  3070. Hashtbl.find ctx.ncom.net_path_map path
  3071. with
  3072. | Not_found ->
  3073. [],[],"Not_found"
  3074. let add_cs = function
  3075. | "haxe" :: ns -> "haxe" :: ns
  3076. | "std" :: ns -> "std" :: ns
  3077. | "cs" :: ns -> "cs" :: ns
  3078. | "system" :: ns -> "cs" :: "system" :: ns
  3079. | ns -> ns
  3080. let escape_chars =
  3081. String.replace_chars (fun chr ->
  3082. if (chr >= 'a' && chr <= 'z') || (chr >= 'A' && chr <= 'Z') || (chr >= '0' && chr <= '9') || chr = '_' then
  3083. Char.escaped chr
  3084. else
  3085. "_x" ^ (string_of_int (Char.code chr)) ^ "_")
  3086. let netcl_to_hx cl =
  3087. let cl = if String.length cl > 0 && String.get cl 0 >= 'a' && String.get cl 0 <= 'z' then
  3088. Char.escaped (Char.uppercase (String.get cl 0)) ^ (String.sub cl 1 (String.length cl - 1))
  3089. else
  3090. cl
  3091. in
  3092. try
  3093. let cl, nargs = String.split cl "`" in
  3094. (escape_chars cl) ^ "_" ^ nargs
  3095. with | Invalid_string ->
  3096. escape_chars cl
  3097. let netpath_to_hx std = function
  3098. | [],[], cl -> [], netcl_to_hx cl
  3099. | ns,[], cl ->
  3100. let ns = (List.map (fun s -> String.lowercase (escape_chars s)) ns) in
  3101. add_cs ns, netcl_to_hx cl
  3102. | ns,(nhd :: ntl as nested), cl ->
  3103. let nested = List.map (netcl_to_hx) nested in
  3104. let ns = (List.map (fun s -> String.lowercase (escape_chars s)) ns) @ [nhd] in
  3105. add_cs ns, String.concat "_" nested ^ "_" ^ netcl_to_hx cl
  3106. let lookup_ilclass std com ilpath =
  3107. let path = netpath_to_hx std ilpath in
  3108. List.fold_right (fun (_,_,_,get_raw_class) acc ->
  3109. match acc with
  3110. | None -> get_raw_class path
  3111. | Some p -> acc
  3112. ) com.net_libs None
  3113. let discard_nested = function
  3114. | (ns,_),cl -> (ns,[]),cl
  3115. let mk_type_path ctx path params =
  3116. let pack, sub, name = match path with
  3117. | ns,[], cl ->
  3118. ns, None, netcl_to_hx cl
  3119. | ns, (nhd :: ntl as nested), cl ->
  3120. let nhd = netcl_to_hx nhd in
  3121. let nested = List.map (netcl_to_hx) nested in
  3122. ns, Some (String.concat "_" nested ^ "_" ^ netcl_to_hx cl), nhd
  3123. in
  3124. CTPath {
  3125. tpackage = fst (netpath_to_hx ctx.nstd (pack,[],""));
  3126. Ast.tname = name;
  3127. tparams = params;
  3128. tsub = sub;
  3129. }
  3130. let raw_type_path ctx path params =
  3131. {
  3132. tpackage = fst path;
  3133. Ast.tname = snd path;
  3134. tparams = params;
  3135. tsub = None;
  3136. }
  3137. let rec convert_signature ctx p = function
  3138. | LVoid ->
  3139. mk_type_path ctx ([],[],"Void") []
  3140. | LBool ->
  3141. mk_type_path ctx ([],[],"Bool") []
  3142. | LChar ->
  3143. mk_type_path ctx (["cs";"types"],[],"Char16") []
  3144. | LInt8 ->
  3145. mk_type_path ctx (["cs";"types"],[],"Int8") []
  3146. | LUInt8 ->
  3147. mk_type_path ctx (["cs";"types"],[],"UInt8") []
  3148. | LInt16 ->
  3149. mk_type_path ctx (["cs";"types"],[],"Int16") []
  3150. | LUInt16 ->
  3151. mk_type_path ctx (["cs";"types"],[],"UInt16") []
  3152. | LInt32 ->
  3153. mk_type_path ctx ([],[],"Int") []
  3154. | LUInt32 ->
  3155. mk_type_path ctx ([],[],"UInt") []
  3156. | LInt64 ->
  3157. mk_type_path ctx (["haxe"],[],"Int64") []
  3158. | LUInt64 ->
  3159. mk_type_path ctx (["cs";"types"],[],"UInt64") []
  3160. | LFloat32 ->
  3161. mk_type_path ctx ([],[],"Single") []
  3162. | LFloat64 ->
  3163. mk_type_path ctx ([],[],"Float") []
  3164. | LString ->
  3165. mk_type_path ctx (["std"],[],"String") []
  3166. | LObject ->
  3167. mk_type_path ctx ([],[],"Dynamic") []
  3168. | LPointer s | LManagedPointer s ->
  3169. mk_type_path ctx (["cs"],[],"Pointer") [ TPType (convert_signature ctx p s) ]
  3170. | LTypedReference ->
  3171. mk_type_path ctx (["cs";"system"],[],"TypedReference") []
  3172. | LIntPtr ->
  3173. mk_type_path ctx (["cs";"system"],[],"IntPtr") []
  3174. | LUIntPtr ->
  3175. mk_type_path ctx (["cs";"system"],[],"UIntPtr") []
  3176. | LValueType (s,args) | LClass (s,args) ->
  3177. mk_type_path ctx s (List.map (fun s -> TPType (convert_signature ctx p s)) args)
  3178. | LTypeParam i ->
  3179. mk_type_path ctx ([],[],"T" ^ string_of_int i) []
  3180. | LMethodTypeParam i ->
  3181. mk_type_path ctx ([],[],"M" ^ string_of_int i) []
  3182. | LVector s ->
  3183. mk_type_path ctx (["cs"],[],"NativeArray") [TPType (convert_signature ctx p s)]
  3184. (* | LArray of ilsig_norm * (int option * int option) array *)
  3185. | LMethod (_,ret,args) ->
  3186. CTFunction (List.map (convert_signature ctx p) args, convert_signature ctx p ret)
  3187. | _ -> mk_type_path ctx ([],[], "Dynamic") []
  3188. let ilpath_s = function
  3189. | ns,[], name -> path_s (ns,name)
  3190. | [],nested,name -> String.concat "." nested ^ "." ^ name
  3191. | ns, nested, name -> String.concat "." ns ^ "." ^ String.concat "." nested ^ "." ^ name
  3192. let get_cls = function
  3193. | _,_,c -> c
  3194. (* TODO: When possible on Haxe, use this to detect flag enums, and make an abstract with @:op() *)
  3195. (* that behaves like an enum, and with an enum as its underlying type *)
  3196. let enum_is_flag ilcls =
  3197. let check_flag name ns = name = "FlagsAttribute" && ns = ["System"] in
  3198. List.exists (fun a ->
  3199. match a.ca_type with
  3200. | TypeRef r ->
  3201. check_flag r.tr_name r.tr_namespace
  3202. | TypeDef d ->
  3203. check_flag d.td_name d.td_namespace
  3204. | Method m ->
  3205. (match m.m_declaring with
  3206. | Some d ->
  3207. check_flag d.td_name d.td_namespace
  3208. | _ -> false)
  3209. | MemberRef r ->
  3210. (match r.memr_class with
  3211. | TypeRef r ->
  3212. check_flag r.tr_name r.tr_namespace
  3213. | TypeDef d ->
  3214. check_flag d.td_name d.td_namespace
  3215. | _ -> false)
  3216. | _ ->
  3217. false
  3218. ) ilcls.cattrs
  3219. let convert_ilenum ctx p ?(is_flag=false) ilcls =
  3220. let meta = ref [
  3221. Meta.Native, [EConst (String (ilpath_s ilcls.cpath) ), p], p;
  3222. Meta.CsNative, [], p;
  3223. ] in
  3224. let data = ref [] in
  3225. List.iter (fun f -> match f.fname with
  3226. | "value__" -> ()
  3227. | _ when not (List.mem CStatic f.fflags.ff_contract) -> ()
  3228. | _ ->
  3229. let meta, const = match f.fconstant with
  3230. | Some IChar i
  3231. | Some IByte i
  3232. | Some IShort i ->
  3233. [Meta.CsNative, [EConst (Int (string_of_int i) ), p], p ], Int64.of_int i
  3234. | Some IInt i ->
  3235. [Meta.CsNative, [EConst (Int (Int32.to_string i) ), p], p ], Int64.of_int32 i
  3236. | Some IFloat32 f | Some IFloat64 f ->
  3237. [], Int64.of_float f
  3238. | Some IInt64 i ->
  3239. [], i
  3240. | _ ->
  3241. [], Int64.zero
  3242. in
  3243. data := ( { ec_name = f.fname; ec_doc = None; ec_meta = meta; ec_args = []; ec_pos = p; ec_params = []; ec_type = None; }, const) :: !data;
  3244. ) ilcls.cfields;
  3245. let data = List.stable_sort (fun (_,i1) (_,i2) -> Int64.compare i1 i2) (List.rev !data) in
  3246. let _, c = netpath_to_hx ctx.nstd ilcls.cpath in
  3247. let name = netname_to_hx c in
  3248. EEnum {
  3249. d_name = if is_flag then name ^ "_FlagsEnum" else name;
  3250. d_doc = None;
  3251. d_params = []; (* enums never have type parameters *)
  3252. d_meta = !meta;
  3253. d_flags = [EExtern];
  3254. d_data = List.map fst data;
  3255. }
  3256. let rec has_unmanaged = function
  3257. | LPointer _ -> true
  3258. | LManagedPointer s -> has_unmanaged s
  3259. | LValueType (p,pl) -> List.exists (has_unmanaged) pl
  3260. | LClass (p,pl) -> List.exists (has_unmanaged) pl
  3261. | LVector s -> has_unmanaged s
  3262. | LArray (s,a) -> has_unmanaged s
  3263. | LMethod (c,r,args) -> has_unmanaged r || List.exists (has_unmanaged) args
  3264. | _ -> false
  3265. let convert_ilfield ctx p field =
  3266. if not (Common.defined ctx.ncom Define.Unsafe) && has_unmanaged field.fsig.snorm then raise Exit;
  3267. let p = { p with pfile = p.pfile ^" (" ^field.fname ^")" } in
  3268. let cff_doc = None in
  3269. let cff_pos = p in
  3270. let cff_meta = ref [] in
  3271. let cff_name = match field.fname with
  3272. | name when String.length name > 5 ->
  3273. (match String.sub name 0 5 with
  3274. | "__hx_" -> raise Exit
  3275. | _ -> name)
  3276. | name -> name
  3277. in
  3278. let cff_access = match field.fflags.ff_access with
  3279. | FAFamily | FAFamOrAssem -> APrivate
  3280. | FAPublic -> APublic
  3281. | _ -> raise Exit (* private instances aren't useful on externs *)
  3282. in
  3283. let readonly, acc = List.fold_left (fun (readonly,acc) -> function
  3284. | CStatic -> readonly, AStatic :: acc
  3285. | CInitOnly | CLiteral -> true, acc
  3286. | _ -> readonly,acc
  3287. ) (false,[cff_access]) field.fflags.ff_contract in
  3288. if PMap.mem "net_loader_debug" ctx.ncom.defines then
  3289. Printf.printf "\t%sfield %s : %s\n" (if List.mem AStatic acc then "static " else "") cff_name (IlMetaDebug.ilsig_s field.fsig.ssig);
  3290. let kind = match readonly with
  3291. | true ->
  3292. FProp ("default", "never", Some (convert_signature ctx p field.fsig.snorm), None)
  3293. | false ->
  3294. FVar (Some (convert_signature ctx p field.fsig.snorm), None)
  3295. in
  3296. let cff_name, cff_meta =
  3297. if String.get cff_name 0 = '%' then
  3298. let name = (String.sub cff_name 1 (String.length cff_name - 1)) in
  3299. "_" ^ name,
  3300. (Meta.Native, [EConst (String (name) ), cff_pos], cff_pos) :: !cff_meta
  3301. else
  3302. cff_name, !cff_meta
  3303. in
  3304. {
  3305. cff_name = cff_name;
  3306. cff_doc = cff_doc;
  3307. cff_pos = cff_pos;
  3308. cff_meta = cff_meta;
  3309. cff_access = acc;
  3310. cff_kind = kind;
  3311. }
  3312. let convert_ilevent ctx p ev =
  3313. let p = { p with pfile = p.pfile ^" (" ^ev.ename ^")" } in
  3314. let name = ev.ename in
  3315. let kind = FVar (Some (convert_signature ctx p ev.esig.snorm), None) in
  3316. let meta = [Meta.Event, [], p; Meta.Keep,[],p; Meta.SkipReflection,[],p] in
  3317. let acc = [APrivate] in
  3318. let add_m acc m = match m with
  3319. | None -> acc
  3320. | Some (name,flags) ->
  3321. if List.mem (CMStatic) flags.mf_contract then
  3322. AStatic :: acc
  3323. else
  3324. acc
  3325. in
  3326. if PMap.mem "net_loader_debug" ctx.ncom.defines then
  3327. Printf.printf "\tevent %s : %s\n" name (IlMetaDebug.ilsig_s ev.esig.ssig);
  3328. let acc = add_m acc ev.eadd in
  3329. let acc = add_m acc ev.eremove in
  3330. let acc = add_m acc ev.eraise in
  3331. {
  3332. cff_name = name;
  3333. cff_doc = None;
  3334. cff_pos = p;
  3335. cff_meta = meta;
  3336. cff_access = acc;
  3337. cff_kind = kind;
  3338. }
  3339. let convert_ilmethod ctx p m is_explicit_impl =
  3340. if not (Common.defined ctx.ncom Define.Unsafe) && has_unmanaged m.msig.snorm then raise Exit;
  3341. let force_check = Common.defined ctx.ncom Define.ForceLibCheck in
  3342. let p = { p with pfile = p.pfile ^" (" ^m.mname ^")" } in
  3343. let cff_doc = None in
  3344. let cff_pos = p in
  3345. let cff_name = match m.mname with
  3346. | ".ctor" -> "new"
  3347. | ".cctor"-> raise Exit (* __init__ field *)
  3348. | "Equals" | "GetHashCode" -> raise Exit
  3349. | name when String.length name > 5 ->
  3350. (match String.sub name 0 5 with
  3351. | "__hx_" -> raise Exit
  3352. | _ -> name)
  3353. | name -> name
  3354. in
  3355. let acc = match m.mflags.mf_access with
  3356. | FAFamily | FAFamOrAssem -> APrivate
  3357. (* | FAPrivate -> APrivate *)
  3358. | FAPublic when List.mem SGetter m.msemantics || List.mem SSetter m.msemantics ->
  3359. APrivate
  3360. | FAPublic -> APublic
  3361. | _ ->
  3362. if PMap.mem "net_loader_debug" ctx.ncom.defines then
  3363. Printf.printf "\tmethod %s (skipped) : %s\n" cff_name (IlMetaDebug.ilsig_s m.msig.ssig);
  3364. raise Exit
  3365. in
  3366. let is_static = ref false in
  3367. let acc, is_final = List.fold_left (fun (acc,is_final) -> function
  3368. | CMStatic when cff_name <> "new" -> is_static := true; AStatic :: acc, is_final
  3369. | CMVirtual when is_final = None -> acc, Some false
  3370. | CMFinal -> acc, Some true
  3371. | _ -> acc, is_final
  3372. ) ([acc],None) m.mflags.mf_contract in
  3373. if PMap.mem "net_loader_debug" ctx.ncom.defines then
  3374. Printf.printf "\t%smethod %s : %s\n" (if !is_static then "static " else "") cff_name (IlMetaDebug.ilsig_s m.msig.ssig);
  3375. let meta = [Meta.Overload, [], p] in
  3376. let meta = match is_final with
  3377. | None | Some true when not force_check ->
  3378. (Meta.Final,[],p) :: meta
  3379. | _ ->
  3380. meta
  3381. in
  3382. let meta = if is_explicit_impl then
  3383. (Meta.NoCompletion,[],p) :: (Meta.SkipReflection,[],p) :: meta
  3384. else
  3385. meta
  3386. in
  3387. (* let meta = if List.mem OSynchronized m.mflags.mf_interop then *)
  3388. (* (Meta.Synchronized,[],p) :: meta *)
  3389. (* else *)
  3390. (* meta *)
  3391. (* in *)
  3392. let rec change_sig = function
  3393. | LManagedPointer s -> LManagedPointer (change_sig s)
  3394. | LPointer s -> LPointer (change_sig s)
  3395. | LValueType (p,pl) -> LValueType(p, List.map change_sig pl)
  3396. | LClass (p,pl) -> LClass(p, List.map change_sig pl)
  3397. | LTypeParam i -> LObject
  3398. | LVector s -> LVector (change_sig s)
  3399. | LArray (s,a) -> LArray (change_sig s, a)
  3400. | LMethod (c,r,args) -> LMethod (c, change_sig r, List.map change_sig args)
  3401. | p -> p
  3402. in
  3403. let change_sig = if !is_static then change_sig else (fun s -> s) in
  3404. let ret =
  3405. if String.length cff_name > 4 && String.sub cff_name 0 4 = "set_" then
  3406. match m.mret.snorm, m.margs with
  3407. | LVoid, [_,_,s] ->
  3408. s.snorm
  3409. | _ -> m.mret.snorm
  3410. else
  3411. m.mret.snorm
  3412. in
  3413. let kind =
  3414. let args = List.map (fun (name,flag,s) ->
  3415. let t = match s.snorm with
  3416. | LManagedPointer s ->
  3417. let is_out = List.mem POut flag.pf_io && not (List.mem PIn flag.pf_io) in
  3418. let name = if is_out then "Out" else "Ref" in
  3419. mk_type_path ctx (["cs"],[],name) [ TPType (convert_signature ctx p s) ]
  3420. | _ ->
  3421. convert_signature ctx p (change_sig s.snorm)
  3422. in
  3423. name,false,Some t,None) m.margs
  3424. in
  3425. let ret = convert_signature ctx p (change_sig ret) in
  3426. let types = List.map (fun t ->
  3427. {
  3428. tp_name = "M" ^ string_of_int t.tnumber;
  3429. tp_params = [];
  3430. tp_constraints = [];
  3431. tp_meta = [];
  3432. }
  3433. ) m.mtypes in
  3434. FFun {
  3435. f_params = types;
  3436. f_args = args;
  3437. f_type = Some ret;
  3438. f_expr = None;
  3439. }
  3440. in
  3441. let cff_name, cff_meta =
  3442. if String.get cff_name 0 = '%' then
  3443. let name = (String.sub cff_name 1 (String.length cff_name - 1)) in
  3444. "_" ^ name,
  3445. (Meta.Native, [EConst (String (name) ), cff_pos], cff_pos) :: meta
  3446. else
  3447. cff_name, meta
  3448. in
  3449. let acc = match m.moverride with
  3450. | None -> acc
  3451. | _ when cff_name = "new" -> acc
  3452. | Some (path,s) -> match lookup_ilclass ctx.nstd ctx.ncom path with
  3453. | Some ilcls when not (List.mem SInterface ilcls.cflags.tdf_semantics) ->
  3454. AOverride :: acc
  3455. | None when ctx.ncom.verbose ->
  3456. prerr_endline ("(net-lib) A referenced assembly for path " ^ ilpath_s path ^ " was not found");
  3457. acc
  3458. | _ -> acc
  3459. in
  3460. {
  3461. cff_name = cff_name;
  3462. cff_doc = cff_doc;
  3463. cff_pos = cff_pos;
  3464. cff_meta = cff_meta;
  3465. cff_access = acc;
  3466. cff_kind = kind;
  3467. }
  3468. let convert_ilprop ctx p prop is_explicit_impl =
  3469. if not (Common.defined ctx.ncom Define.Unsafe) && has_unmanaged prop.psig.snorm then raise Exit;
  3470. let p = { p with pfile = p.pfile ^" (" ^prop.pname ^")" } in
  3471. let pmflags = match prop.pget, prop.pset with
  3472. | Some(_,fl1), _ -> Some fl1
  3473. | _, Some(_,fl2) -> Some fl2
  3474. | _ -> None
  3475. in
  3476. let cff_access = match pmflags with
  3477. | Some { mf_access = FAFamily | FAFamOrAssem } -> APrivate
  3478. | Some { mf_access = FAPublic } -> APublic
  3479. | _ -> raise Exit (* non-public / protected fields don't interest us *)
  3480. in
  3481. let access acc = acc.mf_access in
  3482. let cff_access = match pmflags with
  3483. | Some m when List.mem CMStatic m.mf_contract ->
  3484. [AStatic;cff_access]
  3485. | _ -> [cff_access]
  3486. in
  3487. let get = match prop.pget with
  3488. | None -> "never"
  3489. | Some(s,_) when String.length s <= 4 || String.sub s 0 4 <> "get_" ->
  3490. raise Exit (* special (?) getter; not used *)
  3491. | Some(_,m) when access m <> FAPublic -> (match access m with
  3492. | FAFamily
  3493. | FAFamOrAssem -> "null"
  3494. | _ -> "never")
  3495. | Some _ -> "get"
  3496. in
  3497. let set = match prop.pset with
  3498. | None -> "never"
  3499. | Some(s,_) when String.length s <= 4 || String.sub s 0 4 <> "set_" ->
  3500. raise Exit (* special (?) getter; not used *)
  3501. | Some(_,m) when access m <> FAPublic -> (match access m with
  3502. | FAFamily
  3503. | FAFamOrAssem -> "never"
  3504. | _ -> "never");
  3505. | Some _ -> "set"
  3506. in
  3507. if PMap.mem "net_loader_debug" ctx.ncom.defines then
  3508. Printf.printf "\tproperty %s (%s,%s) : %s\n" prop.pname get set (IlMetaDebug.ilsig_s prop.psig.ssig);
  3509. let ilsig = match prop.psig.snorm with
  3510. | LMethod (_,ret,[]) -> ret
  3511. | s -> raise Exit
  3512. in
  3513. let meta = if is_explicit_impl then
  3514. [ Meta.NoCompletion,[],p; Meta.SkipReflection,[],p ]
  3515. else
  3516. []
  3517. in
  3518. let kind =
  3519. FProp (get, set, Some(convert_signature ctx p ilsig), None)
  3520. in
  3521. {
  3522. cff_name = prop.pname;
  3523. cff_doc = None;
  3524. cff_pos = p;
  3525. cff_meta = meta;
  3526. cff_access = cff_access;
  3527. cff_kind = kind;
  3528. }
  3529. let get_type_path ctx ct = match ct with | CTPath p -> p | _ -> assert false
  3530. let is_explicit ctx ilcls i =
  3531. let s = match i with
  3532. | LClass(path,_) | LValueType(path,_) -> ilpath_s path
  3533. | _ -> assert false
  3534. in
  3535. let len = String.length s in
  3536. List.exists (fun m ->
  3537. String.length m.mname > len && String.sub m.mname 0 len = s
  3538. ) ilcls.cmethods
  3539. let mke e p = (e,p)
  3540. let mk_special_call name p args =
  3541. mke (ECast( mke (EUntyped( mke (ECall( mke (EConst(Ident name)) p, args )) p )) p , None)) p
  3542. let mk_this_call name p args =
  3543. mke (ECall( mke (EField(mke (EConst(Ident "this")) p ,name)) p, args )) p
  3544. let mk_metas metas p =
  3545. List.map (fun m -> m,[],p) metas
  3546. let mk_abstract_fun name p kind metas acc =
  3547. let metas = mk_metas metas p in
  3548. {
  3549. cff_name = name;
  3550. cff_doc = None;
  3551. cff_pos = p;
  3552. cff_meta = metas;
  3553. cff_access = acc;
  3554. cff_kind = kind;
  3555. }
  3556. let convert_fun_arg ctx p = function
  3557. | LManagedPointer s ->
  3558. mk_type_path ctx (["cs"],[],"Ref") [ TPType (convert_signature ctx p s) ]
  3559. | s ->
  3560. convert_signature ctx p s
  3561. let convert_fun ctx p ret args =
  3562. let args = List.map (convert_fun_arg ctx p) args in
  3563. CTFunction(args, convert_signature ctx p ret)
  3564. let get_clsname ctx cpath =
  3565. match netpath_to_hx ctx.nstd cpath with
  3566. | (_,n) -> n
  3567. let convert_delegate ctx p ilcls =
  3568. let p = { p with pfile = p.pfile ^" (abstract delegate)" } in
  3569. (* will have the following methods: *)
  3570. (* - new (haxeType:Func) *)
  3571. (* - FromHaxeFunction(haxeType) *)
  3572. (* - Invoke() *)
  3573. (* - AsDelegate():Super *)
  3574. (* - @:op(A+B) Add(d:absType) *)
  3575. (* - @:op(A-B) Remove(d:absType) *)
  3576. let abs_type = mk_type_path ctx (ilcls.cpath) (List.map (fun t -> TPType (mk_type_path ctx ([],[],"T" ^ string_of_int t.tnumber) [])) ilcls.ctypes) in
  3577. let invoke = List.find (fun m -> m.mname = "Invoke") ilcls.cmethods in
  3578. let ret = invoke.mret.snorm in
  3579. let args = List.map (fun (_,_,s) -> s.snorm) invoke.margs in
  3580. let haxe_type = convert_fun ctx p ret args in
  3581. let types = List.map (fun t ->
  3582. {
  3583. tp_name = "T" ^ string_of_int t.tnumber;
  3584. tp_params = [];
  3585. tp_constraints = [];
  3586. tp_meta = [];
  3587. }
  3588. ) ilcls.ctypes in
  3589. let mk_op_fn op name p =
  3590. let fn_name = List.assoc op cs_binops in
  3591. let clsname = match ilcls.cpath with
  3592. | (ns,inner,n) -> get_clsname ctx (ns,inner,"Delegate_"^n)
  3593. in
  3594. let expr = (ECall( (EField( (EConst(Ident (clsname)),p), fn_name ),p), [(EConst(Ident"arg1"),p);(EConst(Ident"arg2"),p)]),p) in
  3595. FFun {
  3596. f_params = types;
  3597. f_args = ["arg1",false,Some abs_type,None;"arg2",false,Some abs_type,None];
  3598. f_type = Some abs_type;
  3599. f_expr = Some ( (EReturn (Some expr), p) );
  3600. }
  3601. in
  3602. let mk_op op name =
  3603. let p = { p with pfile = p.pfile ^" (op " ^ name ^ ")" } in
  3604. {
  3605. cff_name = name;
  3606. cff_doc = None;
  3607. cff_pos = p;
  3608. cff_meta = [ Meta.Extern,[],p ; Meta.Op, [ (EBinop(op, (EConst(Ident"A"),p), (EConst(Ident"B"),p)),p) ], p ];
  3609. cff_access = [APublic;AInline;AStatic];
  3610. cff_kind = mk_op_fn op name p;
  3611. }
  3612. in
  3613. let params = (List.map (fun s ->
  3614. TPType (mk_type_path ctx ([],[],s.tp_name) [])
  3615. ) types) in
  3616. let underlying_type = match ilcls.cpath with
  3617. | ns,inner,name ->
  3618. mk_type_path ctx (ns,inner,"Delegate_" ^ name) params
  3619. in
  3620. let fn_new = FFun {
  3621. f_params = [];
  3622. f_args = ["hxfunc",false,Some haxe_type,None];
  3623. f_type = None;
  3624. f_expr = Some ( EBinop(Ast.OpAssign, (EConst(Ident "this"),p), (mk_special_call "__delegate__" p [EConst(Ident "hxfunc"),p]) ), p );
  3625. } in
  3626. let fn_from_hx = FFun {
  3627. f_params = types;
  3628. f_args = ["hxfunc",false,Some haxe_type,None];
  3629. f_type = Some( mk_type_path ctx ilcls.cpath params );
  3630. f_expr = Some( EReturn( Some (mk_special_call "__delegate__" p [EConst(Ident "hxfunc"),p] )), p);
  3631. } in
  3632. let fn_asdel = FFun {
  3633. f_params = [];
  3634. f_args = [];
  3635. f_type = None;
  3636. f_expr = Some(
  3637. EReturn( Some ( EConst(Ident "this"), p ) ), p
  3638. );
  3639. } in
  3640. let fn_new = mk_abstract_fun "new" p fn_new [Meta.Extern] [APublic;AInline] in
  3641. let fn_from_hx = mk_abstract_fun "FromHaxeFunction" p fn_from_hx [Meta.Extern;Meta.From] [APublic;AInline;AStatic] in
  3642. let fn_asdel = mk_abstract_fun "AsDelegate" p fn_asdel [Meta.Extern] [APublic;AInline] in
  3643. let _, c = netpath_to_hx ctx.nstd ilcls.cpath in
  3644. EAbstract {
  3645. d_name = netname_to_hx c;
  3646. d_doc = None;
  3647. d_params = types;
  3648. d_meta = mk_metas [Meta.Delegate; Meta.Forward] p;
  3649. d_flags = [AIsType underlying_type];
  3650. d_data = [fn_new;fn_from_hx;fn_asdel;mk_op Ast.OpAdd "Add";mk_op Ast.OpSub "Remove"];
  3651. }
  3652. let convert_ilclass ctx p ?(delegate=false) ilcls = match ilcls.csuper with
  3653. | Some { snorm = LClass ((["System"],[],"Enum"),[]) } ->
  3654. convert_ilenum ctx p ilcls
  3655. | _ ->
  3656. let flags = ref [HExtern] in
  3657. (* todo: instead of CsNative, use more specific definitions *)
  3658. if PMap.mem "net_loader_debug" ctx.ncom.defines then begin
  3659. let sup = match ilcls.csuper with | None -> [] | Some c -> [IlMetaDebug.ilsig_s c.ssig] in
  3660. let sup = sup @ List.map (fun i -> IlMetaDebug.ilsig_s i.ssig) ilcls.cimplements in
  3661. print_endline ("converting " ^ ilpath_s ilcls.cpath ^ " : " ^ (String.concat ", " sup))
  3662. end;
  3663. let meta = ref [Meta.CsNative, [], p; Meta.Native, [EConst (String (ilpath_s ilcls.cpath) ), p], p] in
  3664. let force_check = Common.defined ctx.ncom Define.ForceLibCheck in
  3665. if not force_check then
  3666. meta := (Meta.LibType,[],p) :: !meta;
  3667. let is_interface = ref false in
  3668. List.iter (fun f -> match f with
  3669. | SSealed -> meta := (Meta.Final, [], p) :: !meta
  3670. | SInterface ->
  3671. is_interface := true;
  3672. flags := HInterface :: !flags
  3673. | SAbstract -> meta := (Meta.Abstract, [], p) :: !meta
  3674. | _ -> ()
  3675. ) ilcls.cflags.tdf_semantics;
  3676. (* (match ilcls.cflags.tdf_vis with *)
  3677. (* | VPublic | VNestedFamOrAssem | VNestedFamily -> () *)
  3678. (* | _ -> raise Exit); *)
  3679. (match ilcls.csuper with
  3680. | Some { snorm = LClass ( (["System"],[],"Object"), [] ) } -> ()
  3681. | Some ({ snorm = LClass ( (["System"],[],"ValueType"), [] ) } as s) ->
  3682. flags := HExtends (get_type_path ctx (convert_signature ctx p s.snorm)) :: !flags;
  3683. meta := (Meta.Struct,[],p) :: !meta
  3684. | Some { snorm = LClass ( (["haxe";"lang"],[],"HxObject"), [] ) } ->
  3685. meta := (Meta.HxGen,[],p) :: !meta
  3686. | Some s ->
  3687. flags := HExtends (get_type_path ctx (convert_signature ctx p s.snorm)) :: !flags
  3688. | _ -> ());
  3689. let has_explicit_ifaces = ref false in
  3690. List.iter (fun i ->
  3691. match i.snorm with
  3692. | LClass ( (["haxe";"lang"],[], "IHxObject"), _ ) ->
  3693. meta := (Meta.HxGen,[],p) :: !meta
  3694. (* | i when is_explicit ctx ilcls i -> () *)
  3695. | i ->
  3696. if is_explicit ctx ilcls i then has_explicit_ifaces := true;
  3697. flags := if !is_interface then
  3698. HExtends (get_type_path ctx (convert_signature ctx p i)) :: !flags
  3699. else
  3700. HImplements (get_type_path ctx (convert_signature ctx p i)) :: !flags
  3701. ) ilcls.cimplements;
  3702. (* this is needed because of explicit interfaces. see http://msdn.microsoft.com/en-us/library/aa288461(v=vs.71).aspx *)
  3703. (* explicit interfaces can't be mapped into Haxe in any way - since their fields can't be accessed directly, but they still implement that interface *)
  3704. if !has_explicit_ifaces && force_check then (* do not check on this specific case *)
  3705. meta := (Meta.LibType,[],p) :: !meta;
  3706. (* ArrayAccess *)
  3707. ignore (List.exists (function
  3708. | { psig = { snorm = LMethod(_,ret,[v]) } } ->
  3709. flags := if !is_interface then
  3710. (HExtends( raw_type_path ctx ([],"ArrayAccess") [ TPType (convert_signature ctx p ret) ]) :: !flags)
  3711. else
  3712. (HImplements( raw_type_path ctx ([],"ArrayAccess") [ TPType (convert_signature ctx p ret) ]) :: !flags);
  3713. true
  3714. | _ -> false) ilcls.cprops);
  3715. let fields = ref [] in
  3716. let run_fields fn f =
  3717. List.iter (fun f ->
  3718. try
  3719. fields := fn f :: !fields
  3720. with
  3721. | Exit -> ()
  3722. ) f
  3723. in
  3724. let meths = if !is_interface then
  3725. List.filter (fun m -> m.moverride = None) ilcls.cmethods
  3726. else
  3727. ilcls.cmethods
  3728. in
  3729. run_fields (fun m ->
  3730. convert_ilmethod ctx p m (List.exists (fun m2 -> m != m2 && String.get m2.mname 0 <> '.' && String.ends_with m2.mname ("." ^ m.mname)) meths)
  3731. ) meths;
  3732. run_fields (convert_ilfield ctx p) ilcls.cfields;
  3733. run_fields (fun prop ->
  3734. convert_ilprop ctx p prop (List.exists (fun p2 -> prop != p2 && String.get p2.pname 0 <> '.' && String.ends_with p2.pname ("." ^ prop.pname)) ilcls.cprops)
  3735. ) ilcls.cprops;
  3736. run_fields (convert_ilevent ctx p) ilcls.cevents;
  3737. let params = List.map (fun p ->
  3738. {
  3739. tp_name = "T" ^ string_of_int p.tnumber;
  3740. tp_params = [];
  3741. tp_constraints = [];
  3742. tp_meta = [];
  3743. }) ilcls.ctypes
  3744. in
  3745. if delegate then begin
  3746. (* add op_Addition and op_Subtraction *)
  3747. let path = ilcls.cpath in
  3748. let thist = mk_type_path ctx path (List.map (fun t -> TPType (mk_type_path ctx ([],[],"T" ^ string_of_int t.tnumber) [])) ilcls.ctypes) in
  3749. let op name =
  3750. {
  3751. cff_name = name;
  3752. cff_doc = None;
  3753. cff_pos = p;
  3754. cff_meta = [];
  3755. cff_access = [APublic;AStatic];
  3756. cff_kind = FFun {
  3757. f_params = params;
  3758. f_args = ["arg1",false,Some thist,None;"arg2",false,Some thist,None];
  3759. f_type = Some thist;
  3760. f_expr = None;
  3761. };
  3762. }
  3763. in
  3764. fields := op "op_Addition" :: op "op_Subtraction" :: !fields;
  3765. end;
  3766. let path = match ilcls.cpath with
  3767. | ns,inner,name when delegate ->
  3768. ns,inner,"Delegate_"^name
  3769. | _ -> ilcls.cpath
  3770. in
  3771. let _, c = netpath_to_hx ctx.nstd path in
  3772. EClass {
  3773. d_name = netname_to_hx c;
  3774. d_doc = None;
  3775. d_params = params;
  3776. d_meta = !meta;
  3777. d_flags = !flags;
  3778. d_data = !fields;
  3779. }
  3780. type il_any_field =
  3781. | IlField of ilfield
  3782. | IlMethod of ilmethod
  3783. | IlProp of ilprop
  3784. let get_fname = function
  3785. | IlField f -> f.fname
  3786. | IlMethod m -> m.mname
  3787. | IlProp p -> p.pname
  3788. let is_static = function
  3789. | IlField f ->
  3790. List.mem CStatic f.fflags.ff_contract
  3791. | IlMethod m ->
  3792. List.mem CMStatic m.mflags.mf_contract
  3793. | IlProp p ->
  3794. List.exists (function
  3795. | None -> false
  3796. | Some (_,m) -> List.mem CMStatic m.mf_contract
  3797. ) [p.pget;p.pset]
  3798. (* | _ -> false *)
  3799. let change_name name = function
  3800. | IlField f -> IlField { f with fname = name }
  3801. | IlMethod m -> IlMethod { m with mname = name }
  3802. | IlProp p -> IlProp { p with pname = name }
  3803. let compatible_methods m1 m2 = match m1,m2 with
  3804. | IlMethod { msig = { snorm = LMethod(_,ret1,args1) } }, IlMethod { msig = { snorm = LMethod(_,ret2,args2) } } ->
  3805. ret1 = ret2 && args1 = args2
  3806. | _ -> false
  3807. let ilcls_from_ilsig ctx ilsig =
  3808. let path, params = match ilsig with
  3809. | LClass(path, params) | LValueType(path, params) ->
  3810. path, params
  3811. | LObject ->
  3812. (["System"],[],"Object"),[]
  3813. | _ -> raise Not_found (* all other types won't appear as superclass *)
  3814. in
  3815. match lookup_ilclass ctx.nstd ctx.ncom path with
  3816. | None -> raise Not_found
  3817. | Some c ->
  3818. c, params
  3819. let rec ilapply_params params = function
  3820. | LManagedPointer s -> LManagedPointer (ilapply_params params s)
  3821. | LPointer s -> LPointer (ilapply_params params s)
  3822. | LValueType (p,pl) -> LValueType(p, List.map (ilapply_params params) pl)
  3823. | LClass (p,pl) -> LClass(p, List.map (ilapply_params params) pl)
  3824. | LTypeParam i ->
  3825. List.nth params i (* TODO: maybe i - 1? *)
  3826. | LVector s -> LVector (ilapply_params params s)
  3827. | LArray (s,a) -> LArray (ilapply_params params s, a)
  3828. | LMethod (c,r,args) -> LMethod (c, ilapply_params params r, List.map (ilapply_params params) args)
  3829. | p -> p
  3830. let ilcls_with_params ctx cls params =
  3831. match cls.ctypes with
  3832. | [] -> cls
  3833. | _ ->
  3834. { cls with
  3835. cfields = List.map (fun f -> { f with fsig = { f.fsig with snorm = ilapply_params params f.fsig.snorm } }) cls.cfields;
  3836. cmethods = List.map (fun m -> { m with
  3837. msig = { m.msig with snorm = ilapply_params params m.msig.snorm };
  3838. margs = List.map (fun (n,f,s) -> (n,f,{ s with snorm = ilapply_params params s.snorm })) m.margs;
  3839. mret = { m.mret with snorm = ilapply_params params m.mret.snorm };
  3840. }) cls.cmethods;
  3841. cprops = List.map (fun p -> { p with psig = { p.psig with snorm = ilapply_params params p.psig.snorm } }) cls.cprops;
  3842. csuper = Option.map (fun s -> { s with snorm = ilapply_params params s.snorm } ) cls.csuper;
  3843. cimplements = List.map (fun s -> { s with snorm = ilapply_params params s.snorm } ) cls.cimplements;
  3844. }
  3845. let rec compatible_params t1 t2 = match t1,t2 with
  3846. | LManagedPointer(s1), LManagedPointer(s2) -> compatible_params s1 s2
  3847. | LManagedPointer(s1), s2 | s1, LManagedPointer(s2) ->
  3848. compatible_params s1 s2
  3849. | _ -> t1 = t2
  3850. let compatible_methods m1 m2 = match m1, m2 with
  3851. | LMethod(_,r1,a1), LMethod(_,r2,a2) -> (try
  3852. List.for_all2 (fun a1 a2 -> compatible_params a1 a2) a1 a2
  3853. with | Invalid_argument _ ->
  3854. false)
  3855. | _ -> false
  3856. let compatible_field f1 f2 = match f1, f2 with
  3857. | IlMethod { msig = { snorm = LMethod(_,_,a1) } },
  3858. IlMethod { msig = { snorm = LMethod(_,_,a2) } } ->
  3859. a1 = a2
  3860. | IlProp p1, IlProp p2 ->
  3861. (* p1.psig.snorm = p2.psig.snorm *)
  3862. true
  3863. | IlField f1, IlField f2 ->
  3864. (* f1.fsig.snorm = f2.fsig.snorm *)
  3865. true
  3866. | _ -> false
  3867. let get_all_fields cls =
  3868. let all_fields = List.map (fun f -> IlField f, cls.cpath, f.fname, List.mem CStatic f.fflags.ff_contract) cls.cfields in
  3869. let all_fields = all_fields @ List.map (fun m -> IlMethod m, cls.cpath, m.mname, List.mem CMStatic m.mflags.mf_contract) cls.cmethods in
  3870. let all_fields = all_fields @ List.map (function
  3871. | p ->
  3872. IlProp p, cls.cpath, p.pname, is_static (IlProp p)
  3873. ) cls.cprops in
  3874. all_fields
  3875. let normalize_ilcls ctx cls =
  3876. let force_check = Common.defined ctx.ncom Define.ForceLibCheck in
  3877. (* first filter out overloaded fields of same signature *)
  3878. let rec loop acc = function
  3879. | [] -> acc
  3880. | m :: cmeths ->
  3881. let static = List.mem CMStatic m.mflags.mf_contract in
  3882. if List.exists (fun m2 -> m.mname = m2.mname && List.mem CMStatic m2.mflags.mf_contract = static && compatible_methods m.msig.snorm m2.msig.snorm) cmeths then
  3883. loop acc cmeths
  3884. else
  3885. loop (m :: acc) cmeths
  3886. in
  3887. let meths = loop [] cls.cmethods in
  3888. (* fix overrides *)
  3889. (* get only the methods that aren't declared as override, but may be *)
  3890. let meths = List.map (fun v -> ref v) meths in
  3891. let no_overrides = List.filter (fun m ->
  3892. let m = !m in
  3893. not (List.mem CMStatic m.mflags.mf_contract)
  3894. ) meths in
  3895. let no_overrides = ref no_overrides in
  3896. let all_fields = ref [] in
  3897. let all_events_name = Hashtbl.create 0 in
  3898. (* avoid naming collision between events and functions *)
  3899. let add_cls_events_collision cls =
  3900. List.iter (fun m -> if not (List.mem CMStatic m.mflags.mf_contract) then Hashtbl.replace all_events_name m.mname true) cls.cmethods;
  3901. List.iter (fun p -> if not (is_static (IlProp p)) then Hashtbl.replace all_events_name p.pname true) cls.cprops;
  3902. in
  3903. let rec loop cls = try
  3904. match cls.csuper with
  3905. | Some { snorm = LClass((["System"],[],"Object"),_) }
  3906. | Some { snorm = LObject } | None -> ()
  3907. | Some s ->
  3908. let cls, params = ilcls_from_ilsig ctx s.snorm in
  3909. let cls = ilcls_with_params ctx cls params in
  3910. if force_check then no_overrides := List.filter (fun v ->
  3911. let m = !v in
  3912. let is_override_here = List.exists (fun m2 ->
  3913. m2.mname = m.mname && not (List.mem CMStatic m2.mflags.mf_contract) && compatible_methods m.msig.snorm m2.msig.snorm
  3914. ) cls.cmethods in
  3915. if is_override_here then v := { m with moverride = Some(cls.cpath, m.mname) };
  3916. not is_override_here
  3917. ) !no_overrides;
  3918. all_fields := get_all_fields cls @ !all_fields;
  3919. add_cls_events_collision cls;
  3920. List.iter (fun ev -> Hashtbl.replace all_events_name ev.ename true) cls.cevents;
  3921. loop cls
  3922. with | Not_found -> ()
  3923. in
  3924. loop cls;
  3925. add_cls_events_collision cls;
  3926. if force_check then List.iter (fun v -> v := { !v with moverride = None }) !no_overrides;
  3927. let added = ref [] in
  3928. let current_all = ref (get_all_fields cls @ !all_fields) in
  3929. (* look for interfaces and add missing implementations (some methods' implementation is optional) *)
  3930. let rec loop_interface cls iface = try
  3931. match iface.snorm with
  3932. | LClass((["System"],[],"Object"),_) | LObject -> ()
  3933. | LClass(path,_) when path = cls.cpath -> ()
  3934. | s ->
  3935. let cif, params = ilcls_from_ilsig ctx s in
  3936. let cif = ilcls_with_params ctx cif params in
  3937. List.iter (function
  3938. | (f,_,name,false) as ff ->
  3939. (* look for compatible fields *)
  3940. if not (List.exists (function
  3941. | (f2,_,name2,false) when (name = name2 || String.ends_with name2 ("." ^ name)) -> (* consider explicit implementations as implementations *)
  3942. compatible_field f f2
  3943. | _ -> false
  3944. ) !current_all) then begin
  3945. current_all := ff :: !current_all;
  3946. added := ff :: !added
  3947. end else
  3948. (* ensure it's public *)
  3949. List.iter (fun mref -> match !mref with
  3950. | m when m.mname = name && compatible_field f (IlMethod m) ->
  3951. mref := { m with mflags = { m.mflags with mf_access = FAPublic } }
  3952. | _ -> ()
  3953. ) meths
  3954. | _ -> ()
  3955. ) (get_all_fields cif);
  3956. List.iter (loop_interface cif) cif.cimplements
  3957. with | Not_found -> ()
  3958. in
  3959. List.iter (loop_interface cls) cls.cimplements;
  3960. let added = List.map (function
  3961. | (IlMethod m,a,name,b) when m.mflags.mf_access <> FAPublic ->
  3962. (IlMethod { m with mflags = { m.mflags with mf_access = FAPublic } },a,name,b)
  3963. | (IlField f,a,name,b) when f.fflags.ff_access <> FAPublic ->
  3964. (IlField { f with fflags = { f.fflags with ff_access = FAPublic } },a,name,b)
  3965. | s -> s
  3966. ) !added in
  3967. (* filter out properties that were already declared *)
  3968. let props = if force_check then List.filter (function
  3969. | p ->
  3970. let static = is_static (IlProp p) in
  3971. let name = p.pname in
  3972. not (List.exists (function (IlProp _,_,n,s) -> s = static && name = n | _ -> false) !all_fields)
  3973. (* | _ -> false *)
  3974. ) cls.cprops
  3975. else
  3976. cls.cprops
  3977. in
  3978. let cls = { cls with cmethods = List.map (fun v -> !v) meths; cprops = props } in
  3979. let clsfields = (get_all_fields cls) @ added in
  3980. let super_fields = !all_fields in
  3981. all_fields := clsfields @ !all_fields;
  3982. let refclsfields = (List.map (fun v -> ref v) clsfields) in
  3983. (* search static / non-static name clash *)
  3984. (* change field name to not collide with haxe keywords *)
  3985. let fold_field acc v =
  3986. let f, p, name, is_static = !v in
  3987. let change, copy = match name with
  3988. | _ when is_haxe_keyword name ->
  3989. true, false
  3990. | _ ->
  3991. ((is_static && List.exists (function | (f,_,n,false) -> name = n | _ -> false) !all_fields) ||
  3992. (not is_static && match f with (* filter methods that have the same name as fields *)
  3993. | IlMethod _ ->
  3994. List.exists (function | ( (IlProp _ | IlField _),_,n,false) -> name = n | _ -> false) super_fields ||
  3995. List.exists (function | ( (IlProp _ | IlField _),_,n,s) -> name = n | _ -> false) clsfields
  3996. | _ -> false)), true
  3997. in
  3998. if change then begin
  3999. let name = "%" ^ name in
  4000. let changed = change_name name f, p, name, is_static in
  4001. if not copy then
  4002. v := changed;
  4003. if copy then
  4004. v :: ref changed :: acc
  4005. else
  4006. v :: acc
  4007. end else
  4008. v :: acc
  4009. in
  4010. let refclsfields = List.fold_left fold_field [] refclsfields in
  4011. let rec fold (fields,methods,props) f = match !f with
  4012. | IlField f,_,_,_ -> f :: fields,methods,props
  4013. | IlMethod m,_,_,_ -> fields,m :: methods,props
  4014. | IlProp p,_,_,_ -> fields,methods,p :: props
  4015. in
  4016. let fields, methods, props = List.fold_left fold ([],[],[]) refclsfields in
  4017. { cls with
  4018. cfields = fields;
  4019. cprops = props;
  4020. cmethods = methods;
  4021. cevents = List.filter (fun ev -> not (Hashtbl.mem all_events_name ev.ename)) cls.cevents;
  4022. }
  4023. let add_net_std com file =
  4024. com.net_std <- file :: com.net_std
  4025. let add_net_lib com file std =
  4026. let ilctx = ref None in
  4027. let netpath_to_hx = netpath_to_hx std in
  4028. let real_file = ref file in
  4029. let get_ctx () =
  4030. match !ilctx with
  4031. | Some c ->
  4032. c
  4033. | None ->
  4034. let file = if Sys.file_exists file then
  4035. file
  4036. else try Common.find_file com file with
  4037. | Not_found -> try Common.find_file com (file ^ ".dll") with
  4038. | Not_found ->
  4039. failwith (".NET lib " ^ file ^ " not found")
  4040. in
  4041. real_file := file;
  4042. let r = PeReader.create_r (open_in_bin file) com.defines in
  4043. let ctx = PeReader.read r in
  4044. let clr_header = PeReader.read_clr_header ctx in
  4045. let cache = IlMetaReader.create_cache () in
  4046. let meta = IlMetaReader.read_meta_tables ctx clr_header cache in
  4047. close_in (r.PeReader.ch);
  4048. if PMap.mem "net_loader_debug" com.defines then
  4049. print_endline ("for lib " ^ file);
  4050. let il_typedefs = Hashtbl.copy meta.il_typedefs in
  4051. Hashtbl.clear meta.il_typedefs;
  4052. Hashtbl.iter (fun _ td ->
  4053. let path = IlMetaTools.get_path (TypeDef td) in
  4054. if PMap.mem "net_loader_debug" com.defines then
  4055. Printf.printf "found %s\n" (path_s (netpath_to_hx path));
  4056. Hashtbl.replace com.net_path_map (netpath_to_hx path) path;
  4057. Hashtbl.replace meta.il_typedefs path td
  4058. ) il_typedefs;
  4059. let meta = { nstd = std; ncom = com; nil = meta } in
  4060. ilctx := Some meta;
  4061. meta
  4062. in
  4063. let cache = Hashtbl.create 0 in
  4064. let lookup path =
  4065. try
  4066. Hashtbl.find cache path
  4067. with | Not_found -> try
  4068. let ctx = get_ctx() in
  4069. let ns, n, cl = hxpath_to_net ctx path in
  4070. let cls = IlMetaTools.convert_class ctx.nil (ns,n,cl) in
  4071. let cls = normalize_ilcls ctx cls in
  4072. Hashtbl.add cache path (Some cls);
  4073. Some cls
  4074. with | Not_found ->
  4075. Hashtbl.add cache path None;
  4076. None
  4077. in
  4078. let all_files () =
  4079. Hashtbl.fold (fun path _ acc -> match path with
  4080. | _,_ :: _, _ -> acc
  4081. | _ -> netpath_to_hx path :: acc) (get_ctx()).nil.il_typedefs []
  4082. in
  4083. let build path =
  4084. let p = { pfile = !real_file ^ " @ " ^ path_s path; pmin = 0; pmax = 0; } in
  4085. let pack = match fst path with | ["haxe";"root"] -> [] | p -> p in
  4086. let cp = ref [] in
  4087. let rec build path = try
  4088. if PMap.mem "net_loader_debug" com.defines then
  4089. Printf.printf "looking up %s\n" (path_s path);
  4090. match lookup path with
  4091. | Some({csuper = Some{snorm = LClass( (["System"],[],("Delegate"|"MulticastDelegate")),_)}} as cls)
  4092. when List.mem SSealed cls.cflags.tdf_semantics ->
  4093. let ctx = get_ctx() in
  4094. let hxcls = convert_ilclass ctx p ~delegate:true cls in
  4095. let delegate = convert_delegate ctx p cls in
  4096. cp := (hxcls,p) :: (delegate,p) :: !cp;
  4097. List.iter (fun ilpath ->
  4098. let path = netpath_to_hx ilpath in
  4099. build path
  4100. ) cls.cnested
  4101. | Some cls ->
  4102. let ctx = get_ctx() in
  4103. let hxcls = convert_ilclass ctx p cls in
  4104. cp := (hxcls,p) :: !cp;
  4105. List.iter (fun ilpath ->
  4106. let path = netpath_to_hx ilpath in
  4107. build path
  4108. ) cls.cnested
  4109. | _ -> ()
  4110. with | Not_found | Exit ->
  4111. ()
  4112. in
  4113. build path;
  4114. match !cp with
  4115. | [] -> None
  4116. | cp -> Some (!real_file, (pack,cp))
  4117. in
  4118. let build path p =
  4119. build path
  4120. in
  4121. com.load_extern_type <- com.load_extern_type @ [build];
  4122. com.net_libs <- (file, std, all_files, lookup) :: com.net_libs
  4123. let before_generate com =
  4124. (* net version *)
  4125. let net_ver = try
  4126. int_of_string (PMap.find "net_ver" com.defines)
  4127. with | Not_found ->
  4128. Common.define_value com Define.NetVer "20";
  4129. 20
  4130. in
  4131. if net_ver < 20 then
  4132. failwith (
  4133. ".NET version is defined to target .NET "
  4134. ^ string_of_int net_ver
  4135. ^ ", but the compiler can only output code to versions equal or superior to .NET 2.0 (defined as 20)"
  4136. );
  4137. let rec loop = function
  4138. | v :: acc when v <= net_ver ->
  4139. Common.raw_define com ("NET_" ^ string_of_int v);
  4140. loop acc
  4141. | _ -> ()
  4142. in
  4143. loop [20;21;30;35;40;45];
  4144. (* net target *)
  4145. let net_target = try
  4146. String.lowercase (PMap.find "net_target" com.defines)
  4147. with | Not_found ->
  4148. "net"
  4149. in
  4150. Common.define_value com Define.NetTarget net_target;
  4151. Common.raw_define com net_target;
  4152. (* std dirs *)
  4153. let stds = match com.net_std with
  4154. | [] -> ["netlib"]
  4155. | s -> s
  4156. in
  4157. (* look for all dirs that have the digraph NET_TARGET-NET_VER *)
  4158. let digraph = net_target ^ "-" ^ string_of_int net_ver in
  4159. let matched = ref [] in
  4160. List.iter (fun f -> try
  4161. let f = Common.find_file com (f ^ "/" ^ digraph) in
  4162. matched := (f, Unix.opendir f) :: !matched
  4163. with | _ -> ()) stds;
  4164. if !matched = [] then failwith (
  4165. "No .NET std lib directory with the pattern '" ^ digraph ^ "' was found in the -net-std search path. " ^
  4166. "Try updating the hxcs lib to the latest version, or specifying another -net-std path.");
  4167. List.iter (fun (path,f) ->
  4168. let rec loop () =
  4169. try
  4170. let f = Unix.readdir f in
  4171. let finsens = String.lowercase f in
  4172. if String.ends_with finsens ".dll" then
  4173. add_net_lib com (path ^ "/" ^ f) true;
  4174. loop()
  4175. with | End_of_file ->
  4176. Unix.closedir f
  4177. in
  4178. loop()
  4179. ) !matched;
  4180. (* now force all libraries to initialize *)
  4181. List.iter (function (_,_,_,lookup) -> ignore (lookup ([],""))) com.net_libs