typer.ml 176 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155
  1. (*
  2. * Copyright (C)2005-2013 Haxe Foundation
  3. *
  4. * Permission is hereby granted, free of charge, to any person obtaining a
  5. * copy of this software and associated documentation files (the "Software"),
  6. * to deal in the Software without restriction, including without limitation
  7. * the rights to use, copy, modify, merge, publish, distribute, sublicense,
  8. * and/or sell copies of the Software, and to permit persons to whom the
  9. * Software is furnished to do so, subject to the following conditions:
  10. *
  11. * The above copyright notice and this permission notice shall be included in
  12. * all copies or substantial portions of the Software.
  13. *
  14. * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  15. * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  16. * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  17. * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  18. * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  19. * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  20. * DEALINGS IN THE SOFTWARE.
  21. *)
  22. open Ast
  23. open Type
  24. open Common
  25. open Typecore
  26. (* ---------------------------------------------------------------------- *)
  27. (* TOOLS *)
  28. type switch_mode =
  29. | CMatch of (tenum_field * (string * t) option list option * pos)
  30. | CExpr of texpr
  31. type access_mode =
  32. | MGet
  33. | MSet
  34. | MCall
  35. type identifier_type =
  36. | ITLocal of tvar
  37. | ITMember of tclass * tclass_field
  38. | ITStatic of tclass * tclass_field
  39. | ITEnum of tenum * tenum_field
  40. | ITGlobal of module_type * string * t
  41. | ITType of module_type
  42. | ITPackage of string
  43. (* order of these variants affects output sorting *)
  44. type display_field_kind =
  45. | FKVar
  46. | FKMethod
  47. | FKType
  48. | FKPackage
  49. exception DisplayFields of (string * t * display_field_kind option * documentation) list
  50. exception DisplayToplevel of identifier_type list
  51. exception WithTypeError of unify_error list * pos
  52. type access_kind =
  53. | AKNo of string
  54. | AKExpr of texpr
  55. | AKSet of texpr * t * tclass_field
  56. | AKInline of texpr * tclass_field * tfield_access * t
  57. | AKMacro of texpr * tclass_field
  58. | AKUsing of texpr * tclass * tclass_field * texpr
  59. | AKAccess of tabstract * tparams * tclass * texpr * texpr
  60. let build_call_ref : (typer -> access_kind -> expr list -> with_type -> pos -> texpr) ref = ref (fun _ _ _ _ _ -> assert false)
  61. let mk_infos ctx p params =
  62. let file = if ctx.in_macro then p.pfile else if Common.defined ctx.com Define.AbsolutePath then Common.get_full_path p.pfile else Filename.basename p.pfile in
  63. (EObjectDecl (
  64. ("fileName" , (EConst (String file) , p)) ::
  65. ("lineNumber" , (EConst (Int (string_of_int (Lexer.get_error_line p))),p)) ::
  66. ("className" , (EConst (String (s_type_path ctx.curclass.cl_path)),p)) ::
  67. if ctx.curfield.cf_name = "" then
  68. params
  69. else
  70. ("methodName", (EConst (String ctx.curfield.cf_name),p)) :: params
  71. ) ,p)
  72. let check_assign ctx e =
  73. match e.eexpr with
  74. | TLocal {v_extra = None} | TArray _ | TField _ ->
  75. ()
  76. | TConst TThis | TTypeExpr _ when ctx.untyped ->
  77. ()
  78. | _ ->
  79. error "Invalid assign" e.epos
  80. type type_class =
  81. | KInt
  82. | KFloat
  83. | KString
  84. | KUnk
  85. | KDyn
  86. | KOther
  87. | KParam of t
  88. | KAbstract of tabstract * t list
  89. let rec classify t =
  90. match follow t with
  91. | TInst ({ cl_path = ([],"String") },[]) -> KString
  92. | TAbstract({a_impl = Some _} as a,tl) -> KAbstract (a,tl)
  93. | TAbstract ({ a_path = [],"Int" },[]) -> KInt
  94. | TAbstract ({ a_path = [],"Float" },[]) -> KFloat
  95. | TAbstract (a,[]) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) a.a_to -> KParam t
  96. | TInst ({ cl_kind = KTypeParameter ctl },_) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) ctl -> KParam t
  97. | TMono r when !r = None -> KUnk
  98. | TDynamic _ -> KDyn
  99. | _ -> KOther
  100. let get_iterator_param t =
  101. match follow t with
  102. | TAnon a ->
  103. if !(a.a_status) <> Closed then raise Not_found;
  104. (match follow (PMap.find "hasNext" a.a_fields).cf_type, follow (PMap.find "next" a.a_fields).cf_type with
  105. | TFun ([],tb), TFun([],t) when (match follow tb with TAbstract ({ a_path = [],"Bool" },[]) -> true | _ -> false) ->
  106. if PMap.fold (fun _ acc -> acc + 1) a.a_fields 0 <> 2 then raise Not_found;
  107. t
  108. | _ ->
  109. raise Not_found)
  110. | _ ->
  111. raise Not_found
  112. let get_iterable_param t =
  113. match follow t with
  114. | TAnon a ->
  115. if !(a.a_status) <> Closed then raise Not_found;
  116. (match follow (PMap.find "iterator" a.a_fields).cf_type with
  117. | TFun ([],it) ->
  118. let t = get_iterator_param it in
  119. if PMap.fold (fun _ acc -> acc + 1) a.a_fields 0 <> 1 then raise Not_found;
  120. t
  121. | _ ->
  122. raise Not_found)
  123. | _ -> raise Not_found
  124. (*
  125. temporally remove the constant flag from structures to allow larger unification
  126. *)
  127. let remove_constant_flag t callb =
  128. let tmp = ref [] in
  129. let rec loop t =
  130. match follow t with
  131. | TAnon a ->
  132. if !(a.a_status) = Const then begin
  133. a.a_status := Closed;
  134. tmp := a :: !tmp;
  135. end;
  136. PMap.iter (fun _ f -> loop f.cf_type) a.a_fields;
  137. | _ ->
  138. ()
  139. in
  140. let restore() =
  141. List.iter (fun a -> a.a_status := Const) (!tmp)
  142. in
  143. try
  144. loop t;
  145. let ret = callb (!tmp <> []) in
  146. restore();
  147. ret
  148. with e ->
  149. restore();
  150. raise e
  151. let rec is_pos_infos = function
  152. | TMono r ->
  153. (match !r with
  154. | Some t -> is_pos_infos t
  155. | _ -> false)
  156. | TLazy f ->
  157. is_pos_infos (!f())
  158. | TType ({ t_path = ["haxe"] , "PosInfos" },[]) ->
  159. true
  160. | TType (t,tl) ->
  161. is_pos_infos (apply_params t.t_params tl t.t_type)
  162. | _ ->
  163. false
  164. let check_constraints ctx tname tpl tl map delayed p =
  165. List.iter2 (fun m (name,t) ->
  166. match follow t with
  167. | TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] ->
  168. let f = (fun() ->
  169. List.iter (fun ct ->
  170. try
  171. Type.unify (map m) (map ct)
  172. with Unify_error l ->
  173. let l = Constraint_failure (tname ^ "." ^ name) :: l in
  174. raise (Unify_error l)
  175. ) constr
  176. ) in
  177. if delayed then
  178. delay ctx PCheckConstraint (fun () -> try f() with Unify_error l -> display_error ctx (error_msg (Unify l)) p)
  179. else
  180. f()
  181. | _ ->
  182. ()
  183. ) tl tpl
  184. let enum_field_type ctx en ef tl_en tl_ef p =
  185. let map t = apply_params en.e_params tl_en (apply_params ef.ef_params tl_ef t) in
  186. begin try
  187. check_constraints ctx (s_type_path en.e_path) en.e_params tl_en map true p;
  188. check_constraints ctx ef.ef_name ef.ef_params tl_ef map true p;
  189. with Unify_error l ->
  190. display_error ctx (error_msg (Unify l)) p
  191. end;
  192. map ef.ef_type
  193. let add_constraint_checks ctx ctypes pl f tl p =
  194. List.iter2 (fun m (name,t) ->
  195. match follow t with
  196. | TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] ->
  197. let constr = List.map (fun t ->
  198. let t = apply_params f.cf_params tl t in
  199. (* only apply params if not static : in that case no param is passed *)
  200. let t = (if pl = [] then t else apply_params ctypes pl t) in
  201. t
  202. ) constr in
  203. delay ctx PCheckConstraint (fun() ->
  204. List.iter (fun ct ->
  205. try
  206. (* if has_mono m then raise (Unify_error [Unify_custom "Could not resolve full type for constraint checks"; Unify_custom ("Type was " ^ (s_type (print_context()) m))]); *)
  207. Type.unify m ct
  208. with Unify_error l ->
  209. display_error ctx (error_msg (Unify (Constraint_failure (f.cf_name ^ "." ^ name) :: l))) p;
  210. ) constr
  211. );
  212. | _ -> ()
  213. ) tl f.cf_params
  214. let field_type ctx c pl f p =
  215. match f.cf_params with
  216. | [] -> f.cf_type
  217. | l ->
  218. let monos = List.map (fun _ -> mk_mono()) l in
  219. if not (Meta.has Meta.Generic f.cf_meta) then add_constraint_checks ctx c.cl_params pl f monos p;
  220. apply_params l monos f.cf_type
  221. let class_field ctx c tl name p =
  222. raw_class_field (fun f -> field_type ctx c tl f p) c tl name
  223. (* checks if we can access to a given class field using current context *)
  224. let rec can_access ctx ?(in_overload=false) c cf stat =
  225. if cf.cf_public then
  226. true
  227. else if not in_overload && ctx.com.config.pf_overload && Meta.has Meta.Overload cf.cf_meta then
  228. true
  229. else
  230. (* TODO: should we add a c == ctx.curclass short check here? *)
  231. (* has metadata path *)
  232. let rec make_path c f = match c.cl_kind with
  233. | KAbstractImpl a -> fst a.a_path @ [snd a.a_path; f.cf_name]
  234. | KGenericInstance(c,_) -> make_path c f
  235. | _ when c.cl_private -> List.rev (f.cf_name :: snd c.cl_path :: (List.tl (List.rev (fst c.cl_path))))
  236. | _ -> fst c.cl_path @ [snd c.cl_path; f.cf_name]
  237. in
  238. let rec expr_path acc e =
  239. match fst e with
  240. | EField (e,f) -> expr_path (f :: acc) e
  241. | EConst (Ident n) -> n :: acc
  242. | _ -> []
  243. in
  244. let rec chk_path psub pfull =
  245. match psub, pfull with
  246. | [], _ -> true
  247. | a :: l1, b :: l2 when a = b -> chk_path l1 l2
  248. | _ -> false
  249. in
  250. let has m c f path =
  251. let rec loop = function
  252. | (m2,el,_) :: l when m = m2 ->
  253. List.exists (fun e ->
  254. let p = expr_path [] e in
  255. (p <> [] && chk_path p path)
  256. ) el
  257. || loop l
  258. | _ :: l -> loop l
  259. | [] -> false
  260. in
  261. loop c.cl_meta || loop f.cf_meta
  262. in
  263. let cur_paths = ref [] in
  264. let rec loop c =
  265. cur_paths := make_path c ctx.curfield :: !cur_paths;
  266. begin match c.cl_super with
  267. | Some (csup,_) -> loop csup
  268. | None -> ()
  269. end;
  270. List.iter (fun (c,_) -> loop c) c.cl_implements;
  271. in
  272. loop ctx.curclass;
  273. let is_constr = cf.cf_name = "new" in
  274. let rec loop c =
  275. (try
  276. (* if our common ancestor declare/override the field, then we can access it *)
  277. let f = if is_constr then (match c.cl_constructor with None -> raise Not_found | Some c -> c) else PMap.find cf.cf_name (if stat then c.cl_statics else c.cl_fields) in
  278. is_parent c ctx.curclass || (List.exists (has Meta.Allow c f) !cur_paths)
  279. with Not_found ->
  280. false
  281. )
  282. || (match c.cl_super with
  283. | Some (csup,_) -> loop csup
  284. | None -> false)
  285. || has Meta.Access ctx.curclass ctx.curfield (make_path c cf)
  286. in
  287. let b = loop c
  288. (* access is also allowed of we access a type parameter which is constrained to our (base) class *)
  289. || (match c.cl_kind with
  290. | KTypeParameter tl ->
  291. List.exists (fun t -> match follow t with TInst(c,_) -> loop c | _ -> false) tl
  292. | _ -> false)
  293. || (Meta.has Meta.PrivateAccess ctx.meta) in
  294. (* TODO: find out what this does and move it to genas3 *)
  295. if b && Common.defined ctx.com Common.Define.As3 && not (Meta.has Meta.Public cf.cf_meta) then cf.cf_meta <- (Meta.Public,[],cf.cf_pos) :: cf.cf_meta;
  296. b
  297. (* removes the first argument of the class field's function type and all its overloads *)
  298. let prepare_using_field cf = match cf.cf_type with
  299. | TFun((_,_,tf) :: args,ret) ->
  300. let rec loop acc overloads = match overloads with
  301. | ({cf_type = TFun((_,_,tfo) :: args,ret)} as cfo) :: l ->
  302. let tfo = apply_params cfo.cf_params (List.map snd cfo.cf_params) tfo in
  303. (* ignore overloads which have a different first argument *)
  304. if Type.type_iseq tf tfo then loop ({cfo with cf_type = TFun(args,ret)} :: acc) l else loop acc l
  305. | _ :: l ->
  306. loop acc l
  307. | [] ->
  308. acc
  309. in
  310. {cf with cf_overloads = loop [] cf.cf_overloads; cf_type = TFun(args,ret)}
  311. | _ -> cf
  312. let parse_string com s p inlined =
  313. let old = Lexer.save() in
  314. let old_file = (try Some (Hashtbl.find Lexer.all_files p.pfile) with Not_found -> None) in
  315. let old_display = !Parser.resume_display in
  316. let old_de = !Parser.display_error in
  317. let restore() =
  318. (match old_file with
  319. | None -> ()
  320. | Some f -> Hashtbl.replace Lexer.all_files p.pfile f);
  321. if not inlined then Parser.resume_display := old_display;
  322. Lexer.restore old;
  323. Parser.display_error := old_de
  324. in
  325. Lexer.init p.pfile true;
  326. Parser.display_error := (fun e p -> raise (Parser.Error (e,p)));
  327. if not inlined then Parser.resume_display := null_pos;
  328. let pack, decls = try
  329. Parser.parse com (Lexing.from_string s)
  330. with Parser.Error (e,pe) ->
  331. restore();
  332. error (Parser.error_msg e) (if inlined then pe else p)
  333. | Lexer.Error (e,pe) ->
  334. restore();
  335. error (Lexer.error_msg e) (if inlined then pe else p)
  336. in
  337. restore();
  338. pack,decls
  339. let eval ctx s =
  340. let p = { pfile = "--eval"; pmin = 0; pmax = String.length s; } in
  341. let pack,decls = parse_string ctx.com s p false in
  342. let rec find_main current decls = match decls with
  343. | (EClass c,_) :: decls ->
  344. let path = pack,c.d_name in
  345. begin try
  346. let cff = List.find (fun cff -> cff.cff_name = "main") c.d_data in
  347. if ctx.com.main_class <> None then error "Multiple main" cff.cff_pos;
  348. ctx.com.main_class <- Some path;
  349. Some path
  350. with Not_found ->
  351. find_main (if current = None then Some path else current) decls
  352. end
  353. | ((EEnum {d_name = s} | ETypedef {d_name = s} | EAbstract {d_name = s}),_) :: decls when current = None ->
  354. find_main (Some (pack,s)) decls
  355. | _ :: decls ->
  356. find_main current decls
  357. | [] ->
  358. current
  359. in
  360. let path_module = match find_main None decls with
  361. | None -> error "Evaluated string did not define any types" p
  362. | Some path -> path
  363. in
  364. ignore(Typeload.type_module ctx path_module "eval" decls p);
  365. flush_pass ctx PBuildClass "eval"
  366. let parse_expr_string ctx s p inl =
  367. let head = "class X{static function main() " in
  368. let head = (if p.pmin > String.length head then head ^ String.make (p.pmin - String.length head) ' ' else head) in
  369. let rec loop e = let e = Ast.map_expr loop e in (fst e,p) in
  370. match parse_string ctx.com (head ^ s ^ ";}") p inl with
  371. | _,[EClass { d_data = [{ cff_name = "main"; cff_kind = FFun { f_expr = Some e } }]},_] -> if inl then e else loop e
  372. | _ -> raise Interp.Invalid_expr
  373. let collect_toplevel_identifiers ctx =
  374. let acc = DynArray.create () in
  375. (* locals *)
  376. PMap.iter (fun _ v ->
  377. if not (is_gen_local v) then
  378. DynArray.add acc (ITLocal v)
  379. ) ctx.locals;
  380. (* member vars *)
  381. if ctx.curfun <> FunStatic then begin
  382. let rec loop c =
  383. List.iter (fun cf ->
  384. DynArray.add acc (ITMember(ctx.curclass,cf))
  385. ) c.cl_ordered_fields;
  386. match c.cl_super with
  387. | None ->
  388. ()
  389. | Some (csup,tl) ->
  390. loop csup; (* TODO: type parameters *)
  391. in
  392. loop ctx.curclass;
  393. (* TODO: local using? *)
  394. end;
  395. (* statics *)
  396. List.iter (fun cf ->
  397. DynArray.add acc (ITStatic(ctx.curclass,cf))
  398. ) ctx.curclass.cl_ordered_statics;
  399. (* enum constructors *)
  400. let rec enum_ctors t =
  401. match t with
  402. | TClassDecl _ | TAbstractDecl _ ->
  403. ()
  404. | TTypeDecl t ->
  405. begin match follow t.t_type with
  406. | TEnum (e,_) -> enum_ctors (TEnumDecl e)
  407. | _ -> ()
  408. end
  409. | TEnumDecl e ->
  410. PMap.iter (fun _ ef ->
  411. DynArray.add acc (ITEnum(e,ef))
  412. ) e.e_constrs;
  413. in
  414. List.iter enum_ctors ctx.m.curmod.m_types;
  415. List.iter enum_ctors ctx.m.module_types;
  416. (* imported globals *)
  417. PMap.iter (fun _ (mt,s) ->
  418. try
  419. let t = match Typeload.resolve_typedef mt with
  420. | TClassDecl c -> (PMap.find s c.cl_statics).cf_type
  421. | TEnumDecl en -> (PMap.find s en.e_constrs).ef_type
  422. | TAbstractDecl {a_impl = Some c} -> (PMap.find s c.cl_statics).cf_type
  423. | _ -> raise Not_found
  424. in
  425. DynArray.add acc (ITGlobal(mt,s,t))
  426. with Not_found ->
  427. ()
  428. ) ctx.m.module_globals;
  429. let module_types = ref [] in
  430. let add_type mt =
  431. match mt with
  432. | TClassDecl {cl_kind = KAbstractImpl _} -> ()
  433. | _ ->
  434. let path = (t_infos mt).mt_path in
  435. if not (List.exists (fun mt2 -> (t_infos mt2).mt_path = path) !module_types) then module_types := mt :: !module_types
  436. in
  437. (* module types *)
  438. List.iter add_type ctx.m.curmod.m_types;
  439. (* module imports *)
  440. List.iter add_type ctx.m.module_types;
  441. (* module using *)
  442. List.iter (fun c ->
  443. add_type (TClassDecl c)
  444. ) ctx.m.module_using;
  445. (* TODO: wildcard packages. How? *)
  446. (* packages and toplevel types *)
  447. let class_paths = ctx.com.class_path in
  448. let class_paths = List.filter (fun s -> s <> "") class_paths in
  449. let packages = ref [] in
  450. let add_package pack =
  451. try
  452. begin match PMap.find pack ctx.com.package_rules with
  453. | Forbidden ->
  454. ()
  455. | _ ->
  456. raise Not_found
  457. end
  458. with Not_found ->
  459. if not (List.mem pack !packages) then packages := pack :: !packages
  460. in
  461. List.iter (fun dir ->
  462. try
  463. let entries = Sys.readdir dir in
  464. Array.iter (fun file ->
  465. match file with
  466. | "." | ".." ->
  467. ()
  468. | _ when Sys.is_directory (dir ^ file) ->
  469. add_package file
  470. | _ ->
  471. let l = String.length file in
  472. if l > 3 && String.sub file (l - 3) 3 = ".hx" then begin
  473. try
  474. let name = String.sub file 0 (l - 3) in
  475. let md = Typeload.load_module ctx ([],name) Ast.null_pos in
  476. List.iter (fun mt ->
  477. if (t_infos mt).mt_path = md.m_path then add_type mt
  478. ) md.m_types
  479. with _ ->
  480. ()
  481. end
  482. ) entries;
  483. with Sys_error _ ->
  484. ()
  485. ) class_paths;
  486. List.iter (fun pack ->
  487. DynArray.add acc (ITPackage pack)
  488. ) !packages;
  489. List.iter (fun mt ->
  490. DynArray.add acc (ITType mt)
  491. ) !module_types;
  492. raise (DisplayToplevel (DynArray.to_list acc))
  493. (* ---------------------------------------------------------------------- *)
  494. (* PASS 3 : type expression & check structure *)
  495. let rec unify_min_raise ctx (el:texpr list) : t =
  496. let rec base_types t =
  497. let tl = ref [] in
  498. let rec loop t = (match t with
  499. | TInst(cl, params) ->
  500. (match cl.cl_kind with
  501. | KTypeParameter tl -> List.iter loop tl
  502. | _ -> ());
  503. List.iter (fun (ic, ip) ->
  504. let t = apply_params cl.cl_params params (TInst (ic,ip)) in
  505. loop t
  506. ) cl.cl_implements;
  507. (match cl.cl_super with None -> () | Some (csup, pl) ->
  508. let t = apply_params cl.cl_params params (TInst (csup,pl)) in
  509. loop t);
  510. tl := t :: !tl;
  511. | TEnum(en,(_ :: _ as tl2)) ->
  512. tl := (TEnum(en,List.map (fun _ -> t_dynamic) tl2)) :: !tl;
  513. tl := t :: !tl;
  514. | TType (td,pl) ->
  515. loop (apply_params td.t_params pl td.t_type);
  516. (* prioritize the most generic definition *)
  517. tl := t :: !tl;
  518. | TLazy f -> loop (!f())
  519. | TMono r -> (match !r with None -> () | Some t -> loop t)
  520. | _ -> tl := t :: !tl)
  521. in
  522. loop t;
  523. !tl
  524. in
  525. match el with
  526. | [] -> mk_mono()
  527. | [e] -> e.etype
  528. | _ ->
  529. let rec chk_null e = is_null e.etype ||
  530. match e.eexpr with
  531. | TConst TNull -> true
  532. | TBlock el ->
  533. (match List.rev el with
  534. | [] -> false
  535. | e :: _ -> chk_null e)
  536. | TParenthesis e | TMeta(_,e) -> chk_null e
  537. | _ -> false
  538. in
  539. (* First pass: Try normal unification and find out if null is involved. *)
  540. let rec loop t = function
  541. | [] ->
  542. false, t
  543. | e :: el ->
  544. let t = if chk_null e then ctx.t.tnull t else t in
  545. try
  546. unify_raise ctx e.etype t e.epos;
  547. loop t el
  548. with Error (Unify _,_) -> try
  549. unify_raise ctx t e.etype e.epos;
  550. loop (if is_null t then ctx.t.tnull e.etype else e.etype) el
  551. with Error (Unify _,_) ->
  552. true, t
  553. in
  554. let has_error, t = loop (mk_mono()) el in
  555. if not has_error then
  556. t
  557. else try
  558. (* specific case for const anon : we don't want to hide fields but restrict their common type *)
  559. let fcount = ref (-1) in
  560. let field_count a =
  561. PMap.fold (fun _ acc -> acc + 1) a.a_fields 0
  562. in
  563. let expr f = match f.cf_expr with None -> mk (TBlock []) f.cf_type f.cf_pos | Some e -> e in
  564. let fields = List.fold_left (fun acc e ->
  565. match follow e.etype with
  566. | TAnon a when !(a.a_status) = Const ->
  567. if !fcount = -1 then begin
  568. fcount := field_count a;
  569. PMap.map (fun f -> [expr f]) a.a_fields
  570. end else begin
  571. if !fcount <> field_count a then raise Not_found;
  572. PMap.mapi (fun n el -> expr (PMap.find n a.a_fields) :: el) acc
  573. end
  574. | _ ->
  575. raise Not_found
  576. ) PMap.empty el in
  577. let fields = PMap.foldi (fun n el acc ->
  578. let t = try unify_min_raise ctx el with Error (Unify _, _) -> raise Not_found in
  579. PMap.add n (mk_field n t (List.hd el).epos) acc
  580. ) fields PMap.empty in
  581. TAnon { a_fields = fields; a_status = ref Closed }
  582. with Not_found ->
  583. (* Second pass: Get all base types (interfaces, super classes and their interfaces) of most general type.
  584. Then for each additional type filter all types that do not unify. *)
  585. let common_types = base_types t in
  586. let dyn_types = List.fold_left (fun acc t ->
  587. let rec loop c =
  588. Meta.has Meta.UnifyMinDynamic c.cl_meta || (match c.cl_super with None -> false | Some (c,_) -> loop c)
  589. in
  590. match t with
  591. | TInst (c,params) when params <> [] && loop c ->
  592. TInst (c,List.map (fun _ -> t_dynamic) params) :: acc
  593. | _ -> acc
  594. ) [] common_types in
  595. let common_types = ref (match List.rev dyn_types with [] -> common_types | l -> common_types @ l) in
  596. let loop e =
  597. let first_error = ref None in
  598. let filter t = (try unify_raise ctx e.etype t e.epos; true
  599. with Error (Unify l, p) as err -> if !first_error = None then first_error := Some(err); false)
  600. in
  601. common_types := List.filter filter !common_types;
  602. match !common_types, !first_error with
  603. | [], Some err -> raise err
  604. | _ -> ()
  605. in
  606. match !common_types with
  607. | [] ->
  608. error "No common base type found" (punion (List.hd el).epos (List.hd (List.rev el)).epos)
  609. | _ ->
  610. List.iter loop (List.tl el);
  611. List.hd !common_types
  612. let unify_min ctx el =
  613. try unify_min_raise ctx el
  614. with Error (Unify l,p) ->
  615. if not ctx.untyped then display_error ctx (error_msg (Unify l)) p;
  616. (List.hd el).etype
  617. let is_forced_inline c cf =
  618. match c with
  619. | Some { cl_extern = true } -> true
  620. | Some { cl_kind = KAbstractImpl _ } -> true
  621. | _ when Meta.has Meta.Extern cf.cf_meta -> true
  622. | _ -> false
  623. let rec unify_call_args' ctx el args r callp inline force_inline =
  624. let call_error err p =
  625. raise (Error (Call_error err,p))
  626. in
  627. let arg_error ul name opt p =
  628. let err = Stack (Unify ul,Custom ("For " ^ (if opt then "optional " else "") ^ "function argument '" ^ name ^ "'")) in
  629. call_error (Could_not_unify err) p
  630. in
  631. let mk_pos_infos t =
  632. let infos = mk_infos ctx callp [] in
  633. type_expr ctx infos (WithType t)
  634. in
  635. let rec default_value name t =
  636. if is_pos_infos t then
  637. mk_pos_infos t
  638. else
  639. null (ctx.t.tnull t) callp
  640. in
  641. let skipped = ref [] in
  642. let skip name ul t =
  643. if not ctx.com.config.pf_can_skip_non_nullable_argument && not (is_nullable t) then
  644. call_error (Cannot_skip_non_nullable name) callp;
  645. skipped := (name,ul) :: !skipped;
  646. default_value name t
  647. in
  648. (* let force_inline, is_extern = match cf with Some(TInst(c,_),f) -> is_forced_inline (Some c) f, c.cl_extern | _ -> false, false in *)
  649. let type_against t e =
  650. let e = type_expr ctx e (WithTypeResume t) in
  651. (try Codegen.AbstractCast.cast_or_unify_raise ctx t e e.epos with Error (Unify l,p) -> raise (WithTypeError (l,p)));
  652. in
  653. let rec loop el args = match el,args with
  654. | [],[] ->
  655. []
  656. | _,[name,false,t] when (match follow t with TAbstract({a_path = ["haxe";"extern"],"Rest"},_) -> true | _ -> false) ->
  657. begin match follow t with
  658. | TAbstract({a_path=(["haxe";"extern"],"Rest")},[t]) ->
  659. (try List.map (fun e -> type_against t e,false) el with WithTypeError(ul,p) -> arg_error ul name false p)
  660. | _ ->
  661. assert false
  662. end
  663. | [],(_,false,_) :: _ ->
  664. call_error (Not_enough_arguments args) callp
  665. | [],(name,true,t) :: args ->
  666. begin match loop [] args with
  667. | [] when not (inline && (ctx.g.doinline || force_inline)) && not ctx.com.config.pf_pad_nulls ->
  668. if is_pos_infos t then [mk_pos_infos t,true]
  669. else []
  670. | args ->
  671. let e_def = default_value name t in
  672. (e_def,true) :: args
  673. end
  674. | (_,p) :: _, [] ->
  675. begin match List.rev !skipped with
  676. | [] -> call_error Too_many_arguments p
  677. | (s,ul) :: _ -> arg_error ul s true p
  678. end
  679. | e :: el,(name,opt,t) :: args ->
  680. begin try
  681. let e = type_against t e in
  682. (e,opt) :: loop el args
  683. with
  684. WithTypeError (ul,p) ->
  685. if opt then
  686. let e_def = skip name ul t in
  687. (e_def,true) :: loop (e :: el) args
  688. else
  689. arg_error ul name false p
  690. end
  691. in
  692. let el = loop el args in
  693. el,TFun(args,r)
  694. let unify_call_args ctx el args r p inline force_inline =
  695. let el,tf = unify_call_args' ctx el args r p inline force_inline in
  696. List.map fst el,tf
  697. let unify_field_call ctx fa el args ret p inline =
  698. let map_cf cf0 map cf =
  699. let t = map (monomorphs cf.cf_params cf.cf_type) in
  700. begin match cf.cf_expr,cf.cf_kind with
  701. | None,Method MethInline when not ctx.com.config.pf_overload ->
  702. (* This is really awkward and shouldn't be here. We'll keep it for
  703. 3.2 in order to not break code that relied on the quirky behavior
  704. in 3.1.3, but it should really be reviewed afterwards.
  705. Related issue: https://github.com/HaxeFoundation/haxe/issues/3846
  706. *)
  707. cf.cf_expr <- cf0.cf_expr;
  708. cf.cf_kind <- cf0.cf_kind;
  709. | _ ->
  710. ()
  711. end;
  712. t,cf
  713. in
  714. let expand_overloads map cf =
  715. (TFun(args,ret),cf) :: (List.map (map_cf cf map) cf.cf_overloads)
  716. in
  717. let candidates,co,cf,mk_fa = match fa with
  718. | FStatic(c,cf) ->
  719. expand_overloads (fun t -> t) cf,Some c,cf,(fun cf -> FStatic(c,cf))
  720. | FAnon cf ->
  721. expand_overloads (fun t -> t) cf,None,cf,(fun cf -> FAnon cf)
  722. | FInstance(c,tl,cf) ->
  723. let map = apply_params c.cl_params tl in
  724. let cfl = if cf.cf_name = "new" || not (Meta.has Meta.Overload cf.cf_meta && ctx.com.config.pf_overload) then
  725. List.map (map_cf cf map) cf.cf_overloads
  726. else
  727. List.map (fun (t,cf) -> map (monomorphs cf.cf_params t),cf) (Typeload.get_overloads c cf.cf_name)
  728. in
  729. (TFun(args,ret),cf) :: cfl,Some c,cf,(fun cf -> FInstance(c,tl,cf))
  730. | FClosure(co,cf) ->
  731. let c = match co with None -> None | Some (c,_) -> Some c in
  732. expand_overloads (fun t -> t) cf,c,cf,(fun cf -> match co with None -> FAnon cf | Some (c,tl) -> FInstance(c,tl,cf))
  733. | _ ->
  734. error "Invalid field call" p
  735. in
  736. let is_forced_inline = is_forced_inline co cf in
  737. let is_overload = Meta.has Meta.Overload cf.cf_meta in
  738. let attempt_call t cf = match follow t with
  739. | TFun(args,ret) ->
  740. let el,tf = unify_call_args' ctx el args ret p inline is_forced_inline in
  741. let mk_call ethis p_field =
  742. let ef = mk (TField(ethis,mk_fa cf)) tf p_field in
  743. make_call ctx ef (List.map fst el) ret p
  744. in
  745. el,tf,mk_call
  746. | _ ->
  747. assert false
  748. in
  749. let rec loop candidates = match candidates with
  750. | [] -> [],[]
  751. | (t,cf) :: candidates ->
  752. begin try
  753. let candidate = attempt_call t cf in
  754. if ctx.com.config.pf_overload && is_overload then begin
  755. let candidates,failures = loop candidates in
  756. candidate :: candidates,failures
  757. end else
  758. [candidate],[]
  759. with Error (Call_error _,_) as err ->
  760. let candidates,failures = loop candidates in
  761. candidates,err :: failures
  762. end
  763. in
  764. match candidates with
  765. | [t,cf] ->
  766. let el,tf,mk_call = attempt_call t cf in
  767. List.map fst el,tf,mk_call
  768. | _ ->
  769. let candidates,failures = loop candidates in
  770. let fail () = match List.rev failures with
  771. | err :: _ -> raise err
  772. | _ -> assert false
  773. in
  774. if is_overload && ctx.com.config.pf_overload then begin match Codegen.Overloads.reduce_compatible candidates with
  775. | [] -> fail()
  776. | [el,tf,mk_call] -> List.map fst el,tf,mk_call
  777. | _ -> error "Ambiguous overload" p
  778. end else begin match List.rev candidates with
  779. | [] -> fail()
  780. | (el,tf,mk_call) :: _ -> List.map fst el,tf,mk_call
  781. end
  782. let fast_enum_field e ef p =
  783. let et = mk (TTypeExpr (TEnumDecl e)) (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }) p in
  784. TField (et,FEnum (e,ef))
  785. let rec type_module_type ctx t tparams p =
  786. match t with
  787. | TClassDecl c ->
  788. let t_tmp = {
  789. t_path = [],"Class<" ^ (s_type_path c.cl_path) ^ ">" ;
  790. t_module = c.cl_module;
  791. t_doc = None;
  792. t_pos = c.cl_pos;
  793. t_type = TAnon {
  794. a_fields = c.cl_statics;
  795. a_status = ref (Statics c);
  796. };
  797. t_private = true;
  798. t_params = [];
  799. t_meta = no_meta;
  800. } in
  801. mk (TTypeExpr (TClassDecl c)) (TType (t_tmp,[])) p
  802. | TEnumDecl e ->
  803. let types = (match tparams with None -> List.map (fun _ -> mk_mono()) e.e_params | Some l -> l) in
  804. mk (TTypeExpr (TEnumDecl e)) (TType (e.e_type,types)) p
  805. | TTypeDecl s ->
  806. let t = apply_params s.t_params (List.map (fun _ -> mk_mono()) s.t_params) s.t_type in
  807. if not (Common.defined ctx.com Define.NoDeprecationWarnings) then
  808. Codegen.DeprecationCheck.check_typedef ctx.com s p;
  809. (match follow t with
  810. | TEnum (e,params) ->
  811. type_module_type ctx (TEnumDecl e) (Some params) p
  812. | TInst (c,params) ->
  813. type_module_type ctx (TClassDecl c) (Some params) p
  814. | TAbstract (a,params) ->
  815. type_module_type ctx (TAbstractDecl a) (Some params) p
  816. | _ ->
  817. error (s_type_path s.t_path ^ " is not a value") p)
  818. | TAbstractDecl { a_impl = Some c } ->
  819. type_module_type ctx (TClassDecl c) tparams p
  820. | TAbstractDecl a ->
  821. if not (Meta.has Meta.RuntimeValue a.a_meta) then error (s_type_path a.a_path ^ " is not a value") p;
  822. let t_tmp = {
  823. t_path = [],"Abstract<" ^ (s_type_path a.a_path) ^ ">";
  824. t_module = a.a_module;
  825. t_doc = None;
  826. t_pos = a.a_pos;
  827. t_type = TAnon {
  828. a_fields = PMap.empty;
  829. a_status = ref (AbstractStatics a);
  830. };
  831. t_private = true;
  832. t_params = [];
  833. t_meta = no_meta;
  834. } in
  835. mk (TTypeExpr (TAbstractDecl a)) (TType (t_tmp,[])) p
  836. let type_type ctx tpath p =
  837. type_module_type ctx (Typeload.load_type_def ctx p { tpackage = fst tpath; tname = snd tpath; tparams = []; tsub = None }) None p
  838. let get_constructor ctx c params p =
  839. match c.cl_kind with
  840. | KAbstractImpl a ->
  841. let f = (try PMap.find "_new" c.cl_statics with Not_found -> error (s_type_path a.a_path ^ " does not have a constructor") p) in
  842. let ct = field_type ctx c params f p in
  843. apply_params a.a_params params ct, f
  844. | _ ->
  845. let ct, f = (try Type.get_constructor (fun f -> field_type ctx c params f p) c with Not_found -> error (s_type_path c.cl_path ^ " does not have a constructor") p) in
  846. apply_params c.cl_params params ct, f
  847. let make_call ctx e params t p =
  848. try
  849. let ethis,cl,f = match e.eexpr with
  850. | TField (ethis,fa) ->
  851. let co,cf = match fa with
  852. | FInstance(c,_,cf) | FStatic(c,cf) -> Some c,cf
  853. | FAnon cf -> None,cf
  854. | _ -> raise Exit
  855. in
  856. ethis,co,cf
  857. | _ ->
  858. raise Exit
  859. in
  860. if f.cf_kind <> Method MethInline then raise Exit;
  861. let config = match cl with
  862. | Some ({cl_kind = KAbstractImpl _}) when Meta.has Meta.Impl f.cf_meta ->
  863. let t = if f.cf_name = "_new" then
  864. t
  865. else if params = [] then
  866. error "Invalid abstract implementation function" f.cf_pos
  867. else
  868. follow (List.hd params).etype
  869. in
  870. begin match t with
  871. | TAbstract(a,pl) ->
  872. let has_params = a.a_params <> [] || f.cf_params <> [] in
  873. let monos = List.map (fun _ -> mk_mono()) f.cf_params in
  874. let map_type = fun t -> apply_params a.a_params pl (apply_params f.cf_params monos t) in
  875. Some (has_params,map_type)
  876. | _ ->
  877. None
  878. end
  879. | _ ->
  880. None
  881. in
  882. ignore(follow f.cf_type); (* force evaluation *)
  883. let params = List.map (ctx.g.do_optimize ctx) params in
  884. let force_inline = is_forced_inline cl f in
  885. (match f.cf_expr with
  886. | Some { eexpr = TFunction fd } ->
  887. (match Optimizer.type_inline ctx f fd ethis params t config p force_inline with
  888. | None ->
  889. if force_inline then error "Inline could not be done" p;
  890. raise Exit;
  891. | Some e -> e)
  892. | _ ->
  893. (*
  894. we can't inline because there is most likely a loop in the typing.
  895. this can be caused by mutually recursive vars/functions, some of them
  896. being inlined or not. In that case simply ignore inlining.
  897. *)
  898. raise Exit)
  899. with Exit ->
  900. mk (TCall (e,params)) t p
  901. let mk_array_get_call ctx (cf,tf,r,e1,e2o) c ebase p = match cf.cf_expr with
  902. | None ->
  903. if not (Meta.has Meta.NoExpr cf.cf_meta) && ctx.com.display = DMNone then display_error ctx "Recursive array get method" p;
  904. mk (TArray(ebase,e1)) r p
  905. | Some _ ->
  906. let et = type_module_type ctx (TClassDecl c) None p in
  907. let ef = mk (TField(et,(FStatic(c,cf)))) tf p in
  908. make_call ctx ef [ebase;e1] r p
  909. let mk_array_set_call ctx (cf,tf,r,e1,e2o) c ebase p =
  910. let evalue = match e2o with None -> assert false | Some e -> e in
  911. match cf.cf_expr with
  912. | None ->
  913. if not (Meta.has Meta.NoExpr cf.cf_meta) && ctx.com.display = DMNone then display_error ctx "Recursive array set method" p;
  914. let ea = mk (TArray(ebase,e1)) r p in
  915. mk (TBinop(OpAssign,ea,evalue)) r p
  916. | Some _ ->
  917. let et = type_module_type ctx (TClassDecl c) None p in
  918. let ef = mk (TField(et,(FStatic(c,cf)))) tf p in
  919. make_call ctx ef [ebase;e1;evalue] r p
  920. let rec acc_get ctx g p =
  921. match g with
  922. | AKNo f -> error ("Field " ^ f ^ " cannot be accessed for reading") p
  923. | AKExpr e -> e
  924. | AKSet _ | AKAccess _ -> assert false
  925. | AKUsing (et,c,cf,e) when ctx.in_display ->
  926. (* Generate a TField node so we can easily match it for position/usage completion (issue #1968) *)
  927. let ec = type_module_type ctx (TClassDecl c) None p in
  928. let t = match follow et.etype with
  929. | TFun (_ :: args,ret) -> TFun(args,ret)
  930. | _ -> et.etype
  931. in
  932. mk (TField(ec,FStatic(c,cf))) t et.epos
  933. | AKUsing (et,_,cf,e) ->
  934. (* build a closure with first parameter applied *)
  935. (match follow et.etype with
  936. | TFun (_ :: args,ret) ->
  937. let tcallb = TFun (args,ret) in
  938. let twrap = TFun ([("_e",false,e.etype)],tcallb) in
  939. (* arguments might not have names in case of variable fields of function types, so we generate one (issue #2495) *)
  940. let args = List.map (fun (n,o,t) ->
  941. let t = if o then ctx.t.tnull t else t in
  942. o,if n = "" then gen_local ctx t else alloc_var n t
  943. ) args in
  944. let ve = alloc_var "_e" e.etype in
  945. let ecall = make_call ctx et (List.map (fun v -> mk (TLocal v) v.v_type p) (ve :: List.map snd args)) ret p in
  946. let ecallb = mk (TFunction {
  947. tf_args = List.map (fun (o,v) -> v,if o then Some TNull else None) args;
  948. tf_type = ret;
  949. tf_expr = (match follow ret with | TAbstract ({a_path = [],"Void"},_) -> ecall | _ -> mk (TReturn (Some ecall)) t_dynamic p);
  950. }) tcallb p in
  951. let ewrap = mk (TFunction {
  952. tf_args = [ve,None];
  953. tf_type = tcallb;
  954. tf_expr = mk (TReturn (Some ecallb)) t_dynamic p;
  955. }) twrap p in
  956. make_call ctx ewrap [e] tcallb p
  957. | _ -> assert false)
  958. | AKInline (e,f,fmode,t) ->
  959. (* do not create a closure for static calls *)
  960. let cmode = (match fmode with FStatic _ -> fmode | FInstance (c,tl,f) -> FClosure (Some (c,tl),f) | _ -> assert false) in
  961. ignore(follow f.cf_type); (* force computing *)
  962. (match f.cf_expr with
  963. | None ->
  964. if ctx.com.display <> DMNone then
  965. mk (TField (e,cmode)) t p
  966. else
  967. error "Recursive inline is not supported" p
  968. | Some { eexpr = TFunction _ } ->
  969. let chk_class c = (c.cl_extern || Meta.has Meta.Extern f.cf_meta) && not (Meta.has Meta.Runtime f.cf_meta) in
  970. let wrap_extern c =
  971. let c2 =
  972. let m = c.cl_module in
  973. let mpath = (fst m.m_path @ ["_" ^ snd m.m_path],(snd m.m_path) ^ "_Impl_") in
  974. try
  975. let rec loop mtl = match mtl with
  976. | (TClassDecl c) :: _ when c.cl_path = mpath -> c
  977. | _ :: mtl -> loop mtl
  978. | [] -> raise Not_found
  979. in
  980. loop c.cl_module.m_types
  981. with Not_found ->
  982. let c2 = mk_class c.cl_module mpath c.cl_pos in
  983. c.cl_module.m_types <- (TClassDecl c2) :: c.cl_module.m_types;
  984. c2
  985. in
  986. let cf = try
  987. PMap.find f.cf_name c2.cl_statics
  988. with Not_found ->
  989. let cf = {f with cf_kind = Method MethNormal} in
  990. c2.cl_statics <- PMap.add cf.cf_name cf c2.cl_statics;
  991. c2.cl_ordered_statics <- cf :: c2.cl_ordered_statics;
  992. cf
  993. in
  994. let e_t = type_module_type ctx (TClassDecl c2) None p in
  995. mk (TField(e_t,FStatic(c2,cf))) t p
  996. in
  997. let e_def = mk (TField (e,cmode)) t p in
  998. begin match follow e.etype with
  999. | TInst (c,_) when chk_class c ->
  1000. display_error ctx "Can't create closure on an extern inline member method" p;
  1001. e_def
  1002. | TAnon a ->
  1003. begin match !(a.a_status) with
  1004. | Statics {cl_extern = false} when Meta.has Meta.Extern f.cf_meta ->
  1005. display_error ctx "Cannot create closure on @:extern inline method" p;
  1006. e_def
  1007. | Statics c when chk_class c -> wrap_extern c
  1008. | _ -> e_def
  1009. end
  1010. | _ -> e_def
  1011. end
  1012. | Some e ->
  1013. let rec loop e = Type.map_expr loop { e with epos = p } in
  1014. loop e)
  1015. | AKMacro _ ->
  1016. assert false
  1017. let error_require r p =
  1018. if r = "" then
  1019. error "This field is not available with the current compilation flags" p
  1020. else
  1021. let r = if r = "sys" then
  1022. "a system platform (php,neko,cpp,etc.)"
  1023. else try
  1024. if String.sub r 0 5 <> "flash" then raise Exit;
  1025. let _, v = ExtString.String.replace (String.sub r 5 (String.length r - 5)) "_" "." in
  1026. "flash version " ^ v ^ " (use -swf-version " ^ v ^ ")"
  1027. with _ ->
  1028. "'" ^ r ^ "' to be enabled"
  1029. in
  1030. error ("Accessing this field requires " ^ r) p
  1031. let get_this ctx p =
  1032. match ctx.curfun with
  1033. | FunStatic ->
  1034. error "Cannot access this from a static function" p
  1035. | FunMemberClassLocal | FunMemberAbstractLocal ->
  1036. let v = match ctx.vthis with
  1037. | None ->
  1038. let v = if ctx.curfun = FunMemberAbstractLocal then
  1039. PMap.find "this" ctx.locals
  1040. else
  1041. gen_local ctx ctx.tthis
  1042. in
  1043. ctx.vthis <- Some v;
  1044. v
  1045. | Some v ->
  1046. ctx.locals <- PMap.add v.v_name v ctx.locals;
  1047. v
  1048. in
  1049. mk (TLocal v) ctx.tthis p
  1050. | FunMemberAbstract ->
  1051. let v = (try PMap.find "this" ctx.locals with Not_found -> assert false) in
  1052. mk (TLocal v) v.v_type p
  1053. | FunConstructor | FunMember ->
  1054. mk (TConst TThis) ctx.tthis p
  1055. let field_access ctx mode f fmode t e p =
  1056. let fnormal() = AKExpr (mk (TField (e,fmode)) t p) in
  1057. let normal() =
  1058. match follow e.etype with
  1059. | TAnon a ->
  1060. (match !(a.a_status) with
  1061. | EnumStatics en ->
  1062. let c = (try PMap.find f.cf_name en.e_constrs with Not_found -> assert false) in
  1063. let fmode = FEnum (en,c) in
  1064. AKExpr (mk (TField (e,fmode)) t p)
  1065. | _ -> fnormal())
  1066. | _ -> fnormal()
  1067. in
  1068. match f.cf_kind with
  1069. | Method m ->
  1070. if mode = MSet && m <> MethDynamic && not ctx.untyped then error "Cannot rebind this method : please use 'dynamic' before method declaration" p;
  1071. begin match ctx.curfun,e.eexpr with
  1072. | (FunMemberAbstract | FunMemberAbstractLocal),TTypeExpr(TClassDecl ({cl_kind = KAbstractImpl a} as c)) when c == ctx.curclass && Meta.has Meta.Impl f.cf_meta ->
  1073. let e = mk (TField(e,fmode)) t p in
  1074. let ethis = get_this ctx p in
  1075. let ethis = {ethis with etype = TAbstract(a,List.map snd a.a_params)} in
  1076. AKUsing(e,ctx.curclass,f,ethis)
  1077. | _ ->
  1078. (match m, mode with
  1079. | MethInline, _ -> AKInline (e,f,fmode,t)
  1080. | MethMacro, MGet -> display_error ctx "Macro functions must be called immediately" p; normal()
  1081. | MethMacro, MCall -> AKMacro (e,f)
  1082. | _ , MGet ->
  1083. let cmode = (match fmode with
  1084. | FInstance(_, _, cf) | FStatic(_, cf) when Meta.has Meta.Generic cf.cf_meta -> display_error ctx "Cannot create closure on generic function" p; fmode
  1085. | FInstance (c,tl,cf) -> FClosure (Some (c,tl),cf)
  1086. | FStatic _ | FEnum _ -> fmode
  1087. | FAnon f -> FClosure (None, f)
  1088. | FDynamic _ | FClosure _ -> assert false
  1089. ) in
  1090. AKExpr (mk (TField (e,cmode)) t p)
  1091. | _ -> normal())
  1092. end
  1093. | Var v ->
  1094. match (match mode with MGet | MCall -> v.v_read | MSet -> v.v_write) with
  1095. | AccNo ->
  1096. (match follow e.etype with
  1097. | TInst (c,_) when is_parent c ctx.curclass || can_access ctx c { f with cf_public = false } false -> normal()
  1098. | TAnon a ->
  1099. (match !(a.a_status) with
  1100. | Opened when mode = MSet ->
  1101. f.cf_kind <- Var { v with v_write = AccNormal };
  1102. normal()
  1103. | Statics c2 when ctx.curclass == c2 || can_access ctx c2 { f with cf_public = false } true -> normal()
  1104. | _ -> if ctx.untyped then normal() else AKNo f.cf_name)
  1105. | _ ->
  1106. if ctx.untyped then normal() else AKNo f.cf_name)
  1107. | AccNormal ->
  1108. (*
  1109. if we are reading from a read-only variable on an anonymous object, it might actually be a method, so make sure to create a closure
  1110. *)
  1111. let is_maybe_method() =
  1112. match v.v_write, follow t, follow e.etype with
  1113. | (AccNo | AccNever), TFun _, TAnon a ->
  1114. (match !(a.a_status) with
  1115. | Statics _ | EnumStatics _ -> false
  1116. | _ -> true)
  1117. | _ -> false
  1118. in
  1119. if mode = MGet && is_maybe_method() then
  1120. AKExpr (mk (TField (e,FClosure (None,f))) t p)
  1121. else
  1122. normal()
  1123. | AccCall ->
  1124. let m = (match mode with MSet -> "set_" | _ -> "get_") ^ f.cf_name in
  1125. let is_abstract_this_access () = match e.eexpr,ctx.curfun with
  1126. | TTypeExpr (TClassDecl ({cl_kind = KAbstractImpl _} as c)),(FunMemberAbstract | FunMemberAbstractLocal) ->
  1127. c == ctx.curclass
  1128. | _ ->
  1129. false
  1130. in
  1131. if m = ctx.curfield.cf_name && (match e.eexpr with TConst TThis -> true | TTypeExpr (TClassDecl c) when c == ctx.curclass -> true | _ -> false) then
  1132. let prefix = (match ctx.com.platform with Flash when Common.defined ctx.com Define.As3 -> "$" | _ -> "") in
  1133. if is_extern_field f then begin
  1134. display_error ctx "This field cannot be accessed because it is not a real variable" p;
  1135. display_error ctx "Add @:isVar here to enable it" f.cf_pos;
  1136. end;
  1137. AKExpr (mk (TField (e,if prefix = "" then fmode else FDynamic (prefix ^ f.cf_name))) t p)
  1138. else if is_abstract_this_access() then begin
  1139. let this = get_this ctx p in
  1140. if mode = MSet then begin
  1141. let c,a = match ctx.curclass with {cl_kind = KAbstractImpl a} as c -> c,a | _ -> assert false in
  1142. let f = PMap.find m c.cl_statics in
  1143. (* we don't have access to the type parameters here, right? *)
  1144. (* let t = apply_params a.a_params pl (field_type ctx c [] f p) in *)
  1145. let t = (field_type ctx c [] f p) in
  1146. let ef = mk (TField (e,FStatic (c,f))) t p in
  1147. AKUsing (ef,c,f,this)
  1148. end else
  1149. AKExpr (make_call ctx (mk (TField (e,quick_field_dynamic e.etype m)) (tfun [this.etype] t) p) [this] t p)
  1150. end else if mode = MSet then
  1151. AKSet (e,t,f)
  1152. else
  1153. AKExpr (make_call ctx (mk (TField (e,quick_field_dynamic e.etype m)) (tfun [] t) p) [] t p)
  1154. | AccResolve ->
  1155. let fstring = mk (TConst (TString f.cf_name)) ctx.t.tstring p in
  1156. let tresolve = tfun [ctx.t.tstring] t in
  1157. AKExpr (make_call ctx (mk (TField (e,FDynamic "resolve")) tresolve p) [fstring] t p)
  1158. | AccNever ->
  1159. if ctx.untyped then normal() else AKNo f.cf_name
  1160. | AccInline ->
  1161. AKInline (e,f,fmode,t)
  1162. | AccRequire (r,msg) ->
  1163. match msg with
  1164. | None -> error_require r p
  1165. | Some msg -> error msg p
  1166. let rec using_field ctx mode e i p =
  1167. if mode = MSet then raise Not_found;
  1168. (* do not try to find using fields if the type is a monomorph, which could lead to side-effects *)
  1169. let is_dynamic = match follow e.etype with
  1170. | TMono _ -> raise Not_found
  1171. | t -> t == t_dynamic
  1172. in
  1173. let check_constant_struct = ref false in
  1174. let rec loop = function
  1175. | [] ->
  1176. raise Not_found
  1177. | c :: l ->
  1178. try
  1179. let cf = PMap.find i c.cl_statics in
  1180. if Meta.has Meta.NoUsing cf.cf_meta || not (can_access ctx c cf true) then raise Not_found;
  1181. let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
  1182. let map = apply_params cf.cf_params monos in
  1183. let t = map cf.cf_type in
  1184. begin match follow t with
  1185. | TFun((_,_,(TType({t_path = ["haxe";"macro"],"ExprOf"},[t0]) | t0)) :: args,r) ->
  1186. if is_dynamic && follow t0 != t_dynamic then raise Not_found;
  1187. let e = Codegen.AbstractCast.cast_or_unify_raise ctx t0 e p in
  1188. (* early constraints check is possible because e.etype has no monomorphs *)
  1189. List.iter2 (fun m (name,t) -> match follow t with
  1190. | TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] && not (has_mono m) ->
  1191. List.iter (fun tc -> Type.unify m (map tc)) constr
  1192. | _ -> ()
  1193. ) monos cf.cf_params;
  1194. let et = type_module_type ctx (TClassDecl c) None p in
  1195. AKUsing (mk (TField (et,FStatic (c,cf))) t p,c,cf,e)
  1196. | _ ->
  1197. raise Not_found
  1198. end
  1199. with Not_found ->
  1200. loop l
  1201. | Unify_error el | Error (Unify el,_) ->
  1202. if List.exists (function Has_extra_field _ -> true | _ -> false) el then check_constant_struct := true;
  1203. loop l
  1204. in
  1205. try loop ctx.m.module_using with Not_found ->
  1206. try
  1207. let acc = loop ctx.g.global_using in
  1208. (match acc with
  1209. | AKUsing (_,c,_,_) -> add_dependency ctx.m.curmod c.cl_module
  1210. | _ -> assert false);
  1211. acc
  1212. with Not_found ->
  1213. if not !check_constant_struct then raise Not_found;
  1214. remove_constant_flag e.etype (fun ok -> if ok then using_field ctx mode e i p else raise Not_found)
  1215. let rec type_ident_raise ?(imported_enums=true) ctx i p mode =
  1216. match i with
  1217. | "true" ->
  1218. if mode = MGet then
  1219. AKExpr (mk (TConst (TBool true)) ctx.t.tbool p)
  1220. else
  1221. AKNo i
  1222. | "false" ->
  1223. if mode = MGet then
  1224. AKExpr (mk (TConst (TBool false)) ctx.t.tbool p)
  1225. else
  1226. AKNo i
  1227. | "this" ->
  1228. (match mode, ctx.curclass.cl_kind with
  1229. | MSet, KAbstractImpl _ ->
  1230. (match ctx.curfield.cf_kind with
  1231. | Method MethInline -> ()
  1232. | Method _ when ctx.curfield.cf_name = "_new" -> ()
  1233. | _ -> error "You can only modify 'this' inside an inline function" p);
  1234. AKExpr (get_this ctx p)
  1235. | (MCall, KAbstractImpl _) | (MGet, _)-> AKExpr(get_this ctx p)
  1236. | _ -> AKNo i)
  1237. | "super" ->
  1238. let t = (match ctx.curclass.cl_super with
  1239. | None -> error "Current class does not have a superclass" p
  1240. | Some (c,params) -> TInst(c,params)
  1241. ) in
  1242. (match ctx.curfun with
  1243. | FunMember | FunConstructor -> ()
  1244. | FunMemberAbstract -> error "Cannot access super inside an abstract function" p
  1245. | FunStatic -> error "Cannot access super inside a static function" p;
  1246. | FunMemberClassLocal | FunMemberAbstractLocal -> error "Cannot access super inside a local function" p);
  1247. if mode <> MSet && ctx.in_super_call then ctx.in_super_call <- false;
  1248. AKExpr (mk (TConst TSuper) t p)
  1249. | "null" ->
  1250. if mode = MGet then
  1251. AKExpr (null (mk_mono()) p)
  1252. else
  1253. AKNo i
  1254. | _ ->
  1255. try
  1256. let v = PMap.find i ctx.locals in
  1257. (match v.v_extra with
  1258. | Some (params,e) ->
  1259. let t = monomorphs params v.v_type in
  1260. (match e with
  1261. | Some ({ eexpr = TFunction f } as e) ->
  1262. begin match mode with
  1263. | MSet -> error "Cannot set inline closure" p
  1264. | MGet -> error "Cannot create closure on inline closure" p
  1265. | MCall ->
  1266. (* create a fake class with a fake field to emulate inlining *)
  1267. let c = mk_class ctx.m.curmod (["local"],v.v_name) e.epos in
  1268. let cf = { (mk_field v.v_name v.v_type e.epos) with cf_params = params; cf_expr = Some e; cf_kind = Method MethInline } in
  1269. c.cl_extern <- true;
  1270. c.cl_fields <- PMap.add cf.cf_name cf PMap.empty;
  1271. AKInline (mk (TConst TNull) (TInst (c,[])) p, cf, FInstance(c,[],cf), t)
  1272. end
  1273. | _ ->
  1274. AKExpr (mk (TLocal v) t p))
  1275. | _ ->
  1276. AKExpr (mk (TLocal v) v.v_type p))
  1277. with Not_found -> try
  1278. (* member variable lookup *)
  1279. if ctx.curfun = FunStatic then raise Not_found;
  1280. let c , t , f = class_field ctx ctx.curclass (List.map snd ctx.curclass.cl_params) i p in
  1281. field_access ctx mode f (match c with None -> FAnon f | Some (c,tl) -> FInstance (c,tl,f)) t (get_this ctx p) p
  1282. with Not_found -> try
  1283. (* lookup using on 'this' *)
  1284. if ctx.curfun = FunStatic then raise Not_found;
  1285. (match using_field ctx mode (mk (TConst TThis) ctx.tthis p) i p with
  1286. | AKUsing (et,c,f,_) -> AKUsing (et,c,f,get_this ctx p)
  1287. | _ -> assert false)
  1288. with Not_found -> try
  1289. (* static variable lookup *)
  1290. let f = PMap.find i ctx.curclass.cl_statics in
  1291. let e = type_type ctx ctx.curclass.cl_path p in
  1292. (* check_locals_masking already done in type_type *)
  1293. field_access ctx mode f (FStatic (ctx.curclass,f)) (field_type ctx ctx.curclass [] f p) e p
  1294. with Not_found -> try
  1295. if not imported_enums then raise Not_found;
  1296. let wrap e = if mode = MSet then
  1297. AKNo i
  1298. else
  1299. AKExpr e
  1300. in
  1301. (* lookup imported enums *)
  1302. let rec loop l =
  1303. match l with
  1304. | [] -> raise Not_found
  1305. | t :: l ->
  1306. match t with
  1307. | TAbstractDecl ({a_impl = Some c} as a) when Meta.has Meta.Enum a.a_meta ->
  1308. begin try
  1309. let cf = PMap.find i c.cl_statics in
  1310. if not (Meta.has Meta.Enum cf.cf_meta) then
  1311. loop l
  1312. else begin
  1313. let et = type_module_type ctx (TClassDecl c) None p in
  1314. AKInline(et,cf,FStatic(c,cf),monomorphs cf.cf_params cf.cf_type)
  1315. end
  1316. with Not_found ->
  1317. loop l
  1318. end
  1319. | TClassDecl _ | TAbstractDecl _ ->
  1320. loop l
  1321. | TTypeDecl t ->
  1322. (match follow t.t_type with
  1323. | TEnum (e,_) -> loop ((TEnumDecl e) :: l)
  1324. | _ -> loop l)
  1325. | TEnumDecl e ->
  1326. try
  1327. let ef = PMap.find i e.e_constrs in
  1328. let et = type_module_type ctx t None p in
  1329. let monos = List.map (fun _ -> mk_mono()) e.e_params in
  1330. let monos2 = List.map (fun _ -> mk_mono()) ef.ef_params in
  1331. wrap (mk (TField (et,FEnum (e,ef))) (enum_field_type ctx e ef monos monos2 p) p)
  1332. with
  1333. Not_found -> loop l
  1334. in
  1335. (try loop (List.rev ctx.m.curmod.m_types) with Not_found -> loop ctx.m.module_types)
  1336. with Not_found ->
  1337. (* lookup imported globals *)
  1338. let t, name = PMap.find i ctx.m.module_globals in
  1339. let e = type_module_type ctx t None p in
  1340. type_field ctx e name p mode
  1341. and type_field ?(resume=false) ctx e i p mode =
  1342. let no_field() =
  1343. if resume then raise Not_found;
  1344. let t = match follow e.etype with
  1345. | TAnon a -> (match !(a.a_status) with
  1346. | Statics {cl_kind = KAbstractImpl a} -> TAbstract(a,[])
  1347. | _ -> e.etype)
  1348. | TInst({cl_kind = KAbstractImpl a},_) -> TAbstract(a,[])
  1349. | _ -> e.etype
  1350. in
  1351. let has_special_field a =
  1352. List.exists (fun (_,cf) -> cf.cf_name = i) a.a_ops
  1353. || List.exists (fun (_,_,cf) -> cf.cf_name = i) a.a_unops
  1354. || List.exists (fun cf -> cf.cf_name = i) a.a_array
  1355. in
  1356. if not ctx.untyped then begin
  1357. match t with
  1358. | TAbstract(a,_) when has_special_field a ->
  1359. (* the abstract field is not part of the field list, which is only true when it has no expression (issue #2344) *)
  1360. display_error ctx ("Field " ^ i ^ " cannot be called directly because it has no expression") p;
  1361. | _ ->
  1362. display_error ctx (string_error i (string_source t) (s_type (print_context()) t ^ " has no field " ^ i)) p;
  1363. end;
  1364. AKExpr (mk (TField (e,FDynamic i)) (mk_mono()) p)
  1365. in
  1366. match follow e.etype with
  1367. | TInst (c,params) ->
  1368. let rec loop_dyn c params =
  1369. match c.cl_dynamic with
  1370. | Some t ->
  1371. let t = apply_params c.cl_params params t in
  1372. if (mode = MGet || mode = MCall) && PMap.mem "resolve" c.cl_fields then begin
  1373. let f = PMap.find "resolve" c.cl_fields in
  1374. begin match f.cf_kind with
  1375. | Method MethMacro -> display_error ctx "The macro accessor is not allowed for field resolve" f.cf_pos
  1376. | _ -> ()
  1377. end;
  1378. let texpect = tfun [ctx.t.tstring] t in
  1379. let tfield = apply_params c.cl_params params (monomorphs f.cf_params f.cf_type) in
  1380. (try Type.unify tfield texpect
  1381. with Unify_error l ->
  1382. display_error ctx "Field resolve has an invalid type" f.cf_pos;
  1383. display_error ctx (error_msg (Unify [Cannot_unify(tfield,texpect)])) f.cf_pos);
  1384. AKExpr (make_call ctx (mk (TField (e,FInstance (c,params,f))) tfield p) [Codegen.type_constant ctx.com (String i) p] t p)
  1385. end else
  1386. AKExpr (mk (TField (e,FDynamic i)) t p)
  1387. | None ->
  1388. match c.cl_super with
  1389. | None -> raise Not_found
  1390. | Some (c,params) -> loop_dyn c params
  1391. in
  1392. (try
  1393. let c2, t , f = class_field ctx c params i p in
  1394. if e.eexpr = TConst TSuper then (match mode,f.cf_kind with
  1395. | MGet,Var {v_read = AccCall }
  1396. | MSet,Var {v_write = AccCall }
  1397. | MCall,Var {v_read = AccCall } ->
  1398. ()
  1399. | MCall, Var _ ->
  1400. display_error ctx "Cannot access superclass variable for calling: needs to be a proper method" p
  1401. | MCall, _ ->
  1402. ()
  1403. | MGet,Var _
  1404. | MSet,Var _ when (match c2 with Some ({ cl_extern = true; cl_path = ("flash" :: _,_) }, _) -> true | _ -> false) ->
  1405. ()
  1406. | _, Method _ ->
  1407. display_error ctx "Cannot create closure on super method" p
  1408. | _ ->
  1409. display_error ctx "Normal variables cannot be accessed with 'super', use 'this' instead" p);
  1410. if not (can_access ctx c f false) && not ctx.untyped then display_error ctx ("Cannot access private field " ^ i) p;
  1411. field_access ctx mode f (match c2 with None -> FAnon f | Some (c,tl) -> FInstance (c,tl,f)) (apply_params c.cl_params params t) e p
  1412. with Not_found -> try
  1413. using_field ctx mode e i p
  1414. with Not_found -> try
  1415. loop_dyn c params
  1416. with Not_found -> try
  1417. (* if we have an abstract constraint we have to check its static fields and recurse (issue #2343) *)
  1418. begin match c.cl_kind with
  1419. | KTypeParameter tl ->
  1420. let rec loop tl = match tl with
  1421. | t :: tl ->
  1422. begin match follow t with
  1423. | TAbstract({a_impl = Some c},tl) when PMap.mem i c.cl_statics ->
  1424. let e = mk_cast e t p in
  1425. type_field ctx e i p mode;
  1426. | _ ->
  1427. loop tl
  1428. end
  1429. | [] ->
  1430. raise Not_found
  1431. in
  1432. loop tl
  1433. | _ ->
  1434. raise Not_found
  1435. end
  1436. with Not_found ->
  1437. if PMap.mem i c.cl_statics then error ("Cannot access static field " ^ i ^ " from a class instance") p;
  1438. no_field())
  1439. | TDynamic t ->
  1440. (try
  1441. using_field ctx mode e i p
  1442. with Not_found ->
  1443. AKExpr (mk (TField (e,FDynamic i)) t p))
  1444. | TAnon a ->
  1445. (try
  1446. let f = PMap.find i a.a_fields in
  1447. if not f.cf_public && not ctx.untyped then begin
  1448. match !(a.a_status) with
  1449. | Closed | Extend _ -> () (* always allow anon private fields access *)
  1450. | Statics c when can_access ctx c f true -> ()
  1451. | _ -> display_error ctx ("Cannot access private field " ^ i) p
  1452. end;
  1453. let fmode, ft = (match !(a.a_status) with
  1454. | Statics c -> FStatic (c,f), field_type ctx c [] f p
  1455. | EnumStatics e -> FEnum (e,try PMap.find f.cf_name e.e_constrs with Not_found -> assert false), Type.field_type f
  1456. | _ ->
  1457. match f.cf_params with
  1458. | [] ->
  1459. FAnon f, Type.field_type f
  1460. | l ->
  1461. (* handle possible constraints *)
  1462. let monos = List.map (fun _ -> mk_mono()) l in
  1463. let t = apply_params f.cf_params monos f.cf_type in
  1464. add_constraint_checks ctx [] [] f monos p;
  1465. FAnon f, t
  1466. ) in
  1467. field_access ctx mode f fmode ft e p
  1468. with Not_found ->
  1469. if is_closed a then try
  1470. using_field ctx mode e i p
  1471. with Not_found ->
  1472. no_field()
  1473. else
  1474. let f = {
  1475. cf_name = i;
  1476. cf_type = mk_mono();
  1477. cf_doc = None;
  1478. cf_meta = no_meta;
  1479. cf_public = true;
  1480. cf_pos = p;
  1481. cf_kind = Var { v_read = AccNormal; v_write = (match mode with MSet -> AccNormal | MGet | MCall -> AccNo) };
  1482. cf_expr = None;
  1483. cf_params = [];
  1484. cf_overloads = [];
  1485. } in
  1486. a.a_fields <- PMap.add i f a.a_fields;
  1487. field_access ctx mode f (FAnon f) (Type.field_type f) e p
  1488. )
  1489. | TMono r ->
  1490. let f = {
  1491. cf_name = i;
  1492. cf_type = mk_mono();
  1493. cf_doc = None;
  1494. cf_meta = no_meta;
  1495. cf_public = true;
  1496. cf_pos = p;
  1497. cf_kind = Var { v_read = AccNormal; v_write = (match mode with MSet -> AccNormal | MGet | MCall -> AccNo) };
  1498. cf_expr = None;
  1499. cf_params = [];
  1500. cf_overloads = [];
  1501. } in
  1502. let x = ref Opened in
  1503. let t = TAnon { a_fields = PMap.add i f PMap.empty; a_status = x } in
  1504. ctx.opened <- x :: ctx.opened;
  1505. r := Some t;
  1506. field_access ctx mode f (FAnon f) (Type.field_type f) e p
  1507. | TAbstract (a,pl) ->
  1508. let static_abstract_access_through_instance = ref false in
  1509. (try
  1510. let c = (match a.a_impl with None -> raise Not_found | Some c -> c) in
  1511. let f = PMap.find i c.cl_statics in
  1512. if not (can_access ctx c f true) && not ctx.untyped then display_error ctx ("Cannot access private field " ^ i) p;
  1513. let field_type f =
  1514. if not (Meta.has Meta.Impl f.cf_meta) then begin
  1515. static_abstract_access_through_instance := true;
  1516. raise Not_found;
  1517. end;
  1518. let t = field_type ctx c [] f p in
  1519. apply_params a.a_params pl t
  1520. in
  1521. let et = type_module_type ctx (TClassDecl c) None p in
  1522. let field_expr f t = mk (TField (et,FStatic (c,f))) t p in
  1523. (match mode, f.cf_kind with
  1524. | (MGet | MCall), Var {v_read = AccCall } ->
  1525. (* getter call *)
  1526. let f = PMap.find ("get_" ^ f.cf_name) c.cl_statics in
  1527. let t = field_type f in
  1528. let r = match follow t with TFun(_,r) -> r | _ -> raise Not_found in
  1529. let ef = field_expr f t in
  1530. AKExpr(make_call ctx ef [e] r p)
  1531. | MSet, Var {v_write = AccCall } ->
  1532. let f = PMap.find ("set_" ^ f.cf_name) c.cl_statics in
  1533. let t = field_type f in
  1534. let ef = field_expr f t in
  1535. AKUsing (ef,c,f,e)
  1536. | (MGet | MCall), Var {v_read = AccNever} ->
  1537. AKNo f.cf_name
  1538. | (MGet | MCall), _ ->
  1539. let rec loop cfl = match cfl with
  1540. | [] -> error (Printf.sprintf "Field %s cannot be called on %s" f.cf_name (s_type (print_context()) e.etype)) p
  1541. | cf :: cfl ->
  1542. match follow (apply_params a.a_params pl (monomorphs cf.cf_params cf.cf_type)) with
  1543. | TFun((_,_,t1) :: _,_) when type_iseq t1 (Abstract.get_underlying_type a pl) ->
  1544. cf
  1545. | _ ->
  1546. loop cfl
  1547. in
  1548. let f = match f.cf_overloads with
  1549. | [] -> f
  1550. | cfl -> loop (f :: cfl)
  1551. in
  1552. let t = field_type f in
  1553. begin match follow t with
  1554. | TFun((_,_,t1) :: _,_) -> ()
  1555. | _ -> error ("Invalid call to static function " ^ i ^ " through abstract instance") p
  1556. end;
  1557. let ef = field_expr f t in
  1558. AKUsing (ef,c,f,e)
  1559. | MSet, _ ->
  1560. error "This operation is unsupported" p)
  1561. with Not_found -> try
  1562. let _,el,_ = Meta.get Meta.Forward a.a_meta in
  1563. if not (List.exists (fun e -> match fst e with
  1564. | EConst(Ident s | String s) -> s = i
  1565. | _ -> error "Identifier or string expected as argument to @:forward" (pos e)
  1566. ) el) && el <> [] then raise Not_found;
  1567. type_field ctx {e with etype = apply_params a.a_params pl a.a_this} i p mode;
  1568. with Not_found -> try
  1569. using_field ctx mode e i p
  1570. with Not_found -> try
  1571. (match ctx.curfun, e.eexpr with
  1572. | FunMemberAbstract, TConst (TThis) -> type_field ctx {e with etype = apply_params a.a_params pl a.a_this} i p mode;
  1573. | _ -> raise Not_found)
  1574. with Not_found -> try
  1575. let c,cf = match a.a_impl,a.a_resolve with
  1576. | Some c,Some cf -> c,cf
  1577. | _ -> raise Not_found
  1578. in
  1579. let et = type_module_type ctx (TClassDecl c) None p in
  1580. let t = apply_params a.a_params pl (field_type ctx c [] cf p) in
  1581. let ef = mk (TField (et,FStatic (c,cf))) t p in
  1582. AKExpr ((!build_call_ref) ctx (AKUsing(ef,c,cf,e)) [EConst (String i),p] NoValue p)
  1583. with Not_found ->
  1584. if !static_abstract_access_through_instance then error ("Invalid call to static function " ^ i ^ " through abstract instance") p
  1585. else no_field())
  1586. | _ ->
  1587. try using_field ctx mode e i p with Not_found -> no_field()
  1588. let type_bind ctx (e : texpr) params p =
  1589. let args,ret = match follow e.etype with TFun(args, ret) -> args, ret | _ -> error "First parameter of callback is not a function" p in
  1590. let vexpr v = mk (TLocal v) v.v_type p in
  1591. let acount = ref 0 in
  1592. let alloc_name n =
  1593. if n = "" || String.length n > 2 then begin
  1594. incr acount;
  1595. "a" ^ string_of_int !acount;
  1596. end else
  1597. n
  1598. in
  1599. let rec loop args params given_args missing_args ordered_args = match args, params with
  1600. | [], [] -> given_args,missing_args,ordered_args
  1601. | [], _ -> error "Too many callback arguments" p
  1602. | (n,o,t) :: args , [] when o ->
  1603. let a = if is_pos_infos t then
  1604. let infos = mk_infos ctx p [] in
  1605. ordered_args @ [type_expr ctx infos (WithType t)]
  1606. else if ctx.com.config.pf_pad_nulls then
  1607. (ordered_args @ [(mk (TConst TNull) t_dynamic p)])
  1608. else
  1609. ordered_args
  1610. in
  1611. loop args [] given_args missing_args a
  1612. | (n,o,t) :: _ , (EConst(Ident "_"),p) :: _ when not ctx.com.config.pf_can_skip_non_nullable_argument && o && not (is_nullable t) ->
  1613. error "Usage of _ is not supported for optional non-nullable arguments" p
  1614. | (n,o,t) :: args , ([] as params)
  1615. | (n,o,t) :: args , (EConst(Ident "_"),_) :: params ->
  1616. let v = alloc_var (alloc_name n) (if o then ctx.t.tnull t else t) in
  1617. loop args params given_args (missing_args @ [v,o]) (ordered_args @ [vexpr v])
  1618. | (n,o,t) :: args , param :: params ->
  1619. let e = type_expr ctx param (WithType t) in
  1620. unify ctx e.etype t p;
  1621. let v = alloc_var (alloc_name n) t in
  1622. loop args params (given_args @ [v,o,Some e]) missing_args (ordered_args @ [vexpr v])
  1623. in
  1624. let given_args,missing_args,ordered_args = loop args params [] [] [] in
  1625. let rec gen_loc_name n =
  1626. let name = if n = 0 then "f" else "f" ^ (string_of_int n) in
  1627. if List.exists (fun (n,_,_) -> name = n) args then gen_loc_name (n + 1) else name
  1628. in
  1629. let loc = alloc_var (gen_loc_name 0) e.etype in
  1630. let given_args = (loc,false,Some e) :: given_args in
  1631. let inner_fun_args l = List.map (fun (v,o) -> v.v_name, o, v.v_type) l in
  1632. let t_inner = TFun(inner_fun_args missing_args, ret) in
  1633. let call = make_call ctx (vexpr loc) ordered_args ret p in
  1634. let e_ret = match follow ret with
  1635. | TAbstract ({a_path = [],"Void"},_) ->
  1636. call
  1637. | TMono _ ->
  1638. mk (TReturn (Some call)) t_dynamic p;
  1639. | _ ->
  1640. mk (TReturn (Some call)) t_dynamic p;
  1641. in
  1642. let func = mk (TFunction {
  1643. tf_args = List.map (fun (v,o) -> v, if o then Some TNull else None) missing_args;
  1644. tf_type = ret;
  1645. tf_expr = e_ret;
  1646. }) t_inner p in
  1647. let outer_fun_args l = List.map (fun (v,o,_) -> v.v_name, o, v.v_type) l in
  1648. let func = mk (TFunction {
  1649. tf_args = List.map (fun (v,_,_) -> v,None) given_args;
  1650. tf_type = t_inner;
  1651. tf_expr = mk (TReturn (Some func)) t_inner p;
  1652. }) (TFun(outer_fun_args given_args, t_inner)) p in
  1653. make_call ctx func (List.map (fun (_,_,e) -> (match e with Some e -> e | None -> assert false)) given_args) t_inner p
  1654. (*
  1655. We want to try unifying as an integer and apply side effects.
  1656. However, in case the value is not a normal Monomorph but one issued
  1657. from a Dynamic relaxation, we will instead unify with float since
  1658. we don't want to accidentaly truncate the value
  1659. *)
  1660. let unify_int ctx e k =
  1661. let is_dynamic t =
  1662. match follow t with
  1663. | TDynamic _ -> true
  1664. | _ -> false
  1665. in
  1666. let is_dynamic_array t =
  1667. match follow t with
  1668. | TInst (_,[p]) -> is_dynamic p
  1669. | _ -> true
  1670. in
  1671. let is_dynamic_field t f =
  1672. match follow t with
  1673. | TAnon a ->
  1674. (try is_dynamic (PMap.find f a.a_fields).cf_type with Not_found -> false)
  1675. | TInst (c,tl) ->
  1676. (try is_dynamic (apply_params c.cl_params tl ((let _,t,_ = Type.class_field c tl f in t))) with Not_found -> false)
  1677. | _ ->
  1678. true
  1679. in
  1680. let is_dynamic_return t =
  1681. match follow t with
  1682. | TFun (_,r) -> is_dynamic r
  1683. | _ -> true
  1684. in
  1685. (*
  1686. This is some quick analysis that matches the most common cases of dynamic-to-mono convertions
  1687. *)
  1688. let rec maybe_dynamic_mono e =
  1689. match e.eexpr with
  1690. | TLocal _ -> is_dynamic e.etype
  1691. | TArray({ etype = t } as e,_) -> is_dynamic_array t || maybe_dynamic_rec e t
  1692. | TField({ etype = t } as e,f) -> is_dynamic_field t (field_name f) || maybe_dynamic_rec e t
  1693. | TCall({ etype = t } as e,_) -> is_dynamic_return t || maybe_dynamic_rec e t
  1694. | TParenthesis e | TMeta(_,e) -> maybe_dynamic_mono e
  1695. | TIf (_,a,Some b) -> maybe_dynamic_mono a || maybe_dynamic_mono b
  1696. | _ -> false
  1697. and maybe_dynamic_rec e t =
  1698. match follow t with
  1699. | TMono _ | TDynamic _ -> maybe_dynamic_mono e
  1700. (* we might have inferenced a tmono into a single field *)
  1701. | TAnon a when !(a.a_status) = Opened -> maybe_dynamic_mono e
  1702. | _ -> false
  1703. in
  1704. match k with
  1705. | KUnk | KDyn when maybe_dynamic_mono e ->
  1706. unify ctx e.etype ctx.t.tfloat e.epos;
  1707. false
  1708. | _ ->
  1709. unify ctx e.etype ctx.t.tint e.epos;
  1710. true
  1711. let type_generic_function ctx (e,fa) el ?(using_param=None) with_type p =
  1712. let c,tl,cf,stat = match fa with
  1713. | FInstance(c,tl,cf) -> c,tl,cf,false
  1714. | FStatic(c,cf) -> c,[],cf,true
  1715. | _ -> assert false
  1716. in
  1717. if cf.cf_params = [] then error "Function has no type parameters and cannot be generic" p;
  1718. let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
  1719. let map t = apply_params cf.cf_params monos t in
  1720. let map t = if stat then map t else apply_params c.cl_params tl (map t) in
  1721. let t = map cf.cf_type in
  1722. let args,ret = match t,using_param with
  1723. | TFun((_,_,ta) :: args,ret),Some e ->
  1724. let ta = if not (Meta.has Meta.Impl cf.cf_meta) then ta
  1725. else match follow ta with TAbstract(a,tl) -> Abstract.get_underlying_type a tl | _ -> assert false
  1726. in
  1727. (* manually unify first argument *)
  1728. unify ctx e.etype ta p;
  1729. args,ret
  1730. | TFun(args,ret),None -> args,ret
  1731. | _ -> error "Invalid field type for generic call" p
  1732. in
  1733. begin match with_type with
  1734. | WithType t -> unify ctx ret t p
  1735. | WithTypeResume t -> (try unify_raise ctx ret t p with Error (Unify l,_) -> raise (WithTypeError(l,p)))
  1736. | _ -> ()
  1737. end;
  1738. let el,_ = unify_call_args ctx el args ret p false false in
  1739. begin try
  1740. check_constraints ctx cf.cf_name cf.cf_params monos map false p
  1741. with Unify_error l ->
  1742. display_error ctx (error_msg (Unify l)) p
  1743. end;
  1744. let el = match using_param with None -> el | Some e -> e :: el in
  1745. (try
  1746. let gctx = Codegen.make_generic ctx cf.cf_params monos p in
  1747. let name = cf.cf_name ^ "_" ^ gctx.Codegen.name in
  1748. let unify_existing_field tcf pcf = try
  1749. unify_raise ctx tcf t p
  1750. with Error(Unify _,_) as err ->
  1751. display_error ctx ("Cannot create field " ^ name ^ " due to type mismatch") p;
  1752. display_error ctx "Conflicting field was defined here" pcf;
  1753. raise err
  1754. in
  1755. let cf2 = try
  1756. let cf2 = if stat then
  1757. let cf2 = PMap.find name c.cl_statics in
  1758. unify_existing_field cf2.cf_type cf2.cf_pos;
  1759. cf2
  1760. else
  1761. let cf2 = PMap.find name c.cl_fields in
  1762. unify_existing_field cf2.cf_type cf2.cf_pos;
  1763. cf2
  1764. in
  1765. cf2
  1766. with Not_found ->
  1767. let cf2 = mk_field name t cf.cf_pos in
  1768. if stat then begin
  1769. c.cl_statics <- PMap.add name cf2 c.cl_statics;
  1770. c.cl_ordered_statics <- cf2 :: c.cl_ordered_statics
  1771. end else begin
  1772. if List.memq cf c.cl_overrides then c.cl_overrides <- cf2 :: c.cl_overrides;
  1773. c.cl_fields <- PMap.add name cf2 c.cl_fields;
  1774. c.cl_ordered_fields <- cf2 :: c.cl_ordered_fields
  1775. end;
  1776. ignore(follow cf.cf_type);
  1777. cf2.cf_expr <- (match cf.cf_expr with
  1778. | None -> error "Recursive @:generic function" p
  1779. | Some e -> Some (Codegen.generic_substitute_expr gctx e));
  1780. cf2.cf_kind <- cf.cf_kind;
  1781. cf2.cf_public <- cf.cf_public;
  1782. let metadata = List.filter (fun (m,_,_) -> match m with
  1783. | Meta.Generic -> false
  1784. | _ -> true
  1785. ) cf.cf_meta in
  1786. cf2.cf_meta <- (Meta.NoCompletion,[],p) :: (Meta.NoUsing,[],p) :: (Meta.GenericInstance,[],p) :: metadata;
  1787. cf2
  1788. in
  1789. let e = if stat then type_type ctx c.cl_path p else e in
  1790. let fa = if stat then FStatic (c,cf2) else FInstance (c,tl,cf2) in
  1791. let e = mk (TField(e,fa)) cf2.cf_type p in
  1792. make_call ctx e el ret p
  1793. with Codegen.Generic_Exception (msg,p) ->
  1794. error msg p)
  1795. let call_to_string ctx c e =
  1796. let et = type_module_type ctx (TClassDecl c) None e.epos in
  1797. let cf = PMap.find "toString" c.cl_statics in
  1798. make_call ctx (mk (TField(et,FStatic(c,cf))) cf.cf_type e.epos) [e] ctx.t.tstring e.epos
  1799. let rec type_binop ctx op e1 e2 is_assign_op with_type p =
  1800. match op with
  1801. | OpAssign ->
  1802. let e1 = type_access ctx (fst e1) (snd e1) MSet in
  1803. let tt = (match e1 with AKNo _ | AKInline _ | AKUsing _ | AKMacro _ | AKAccess _ -> Value | AKSet(_,t,_) -> WithType t | AKExpr e -> WithType e.etype) in
  1804. let e2 = type_expr ctx e2 tt in
  1805. (match e1 with
  1806. | AKNo s -> error ("Cannot access field or identifier " ^ s ^ " for writing") p
  1807. | AKExpr e1 ->
  1808. let e2 = Codegen.AbstractCast.cast_or_unify ctx e1.etype e2 p in
  1809. check_assign ctx e1;
  1810. (match e1.eexpr , e2.eexpr with
  1811. | TLocal i1 , TLocal i2 when i1 == i2 -> error "Assigning a value to itself" p
  1812. | TField ({ eexpr = TConst TThis },FInstance (_,_,f1)) , TField ({ eexpr = TConst TThis },FInstance (_,_,f2)) when f1 == f2 ->
  1813. error "Assigning a value to itself" p
  1814. | _ , _ -> ());
  1815. mk (TBinop (op,e1,e2)) e1.etype p
  1816. | AKSet (e,t,cf) ->
  1817. let e2 = Codegen.AbstractCast.cast_or_unify ctx t e2 p in
  1818. make_call ctx (mk (TField (e,quick_field_dynamic e.etype ("set_" ^ cf.cf_name))) (tfun [t] t) p) [e2] t p
  1819. | AKAccess(a,tl,c,ebase,ekey) ->
  1820. mk_array_set_call ctx (Codegen.AbstractCast.find_array_access ctx a tl ekey (Some e2) p) c ebase p
  1821. | AKUsing(ef,_,_,et) ->
  1822. (* this must be an abstract setter *)
  1823. let ret = match follow ef.etype with
  1824. | TFun([_;(_,_,t)],ret) ->
  1825. unify ctx e2.etype t p;
  1826. ret
  1827. | _ -> error "Invalid field type for abstract setter" p
  1828. in
  1829. make_call ctx ef [et;e2] ret p
  1830. | AKInline _ | AKMacro _ ->
  1831. assert false)
  1832. | OpAssignOp op ->
  1833. (match type_access ctx (fst e1) (snd e1) MSet with
  1834. | AKNo s -> error ("Cannot access field or identifier " ^ s ^ " for writing") p
  1835. | AKExpr e ->
  1836. let eop = type_binop ctx op e1 e2 true with_type p in
  1837. (match eop.eexpr with
  1838. | TBinop (_,_,e2) ->
  1839. unify ctx eop.etype e.etype p;
  1840. check_assign ctx e;
  1841. mk (TBinop (OpAssignOp op,e,e2)) e.etype p;
  1842. | TMeta((Meta.RequiresAssign,_,_),e2) ->
  1843. unify ctx e2.etype e.etype p;
  1844. check_assign ctx e;
  1845. mk (TBinop (OpAssign,e,e2)) e.etype p;
  1846. | _ ->
  1847. (* this must be an abstract cast *)
  1848. check_assign ctx e;
  1849. eop)
  1850. | AKSet (e,t,cf) ->
  1851. let l = save_locals ctx in
  1852. let v = gen_local ctx e.etype in
  1853. let ev = mk (TLocal v) e.etype p in
  1854. let get = type_binop ctx op (EField ((EConst (Ident v.v_name),p),cf.cf_name),p) e2 true with_type p in
  1855. let e' = match get.eexpr with
  1856. | TBinop _ | TMeta((Meta.RequiresAssign,_,_),_) ->
  1857. unify ctx get.etype t p;
  1858. make_call ctx (mk (TField (ev,quick_field_dynamic ev.etype ("set_" ^ cf.cf_name))) (tfun [t] t) p) [get] t p
  1859. | _ ->
  1860. (* abstract setter *)
  1861. get
  1862. in
  1863. l();
  1864. mk (TBlock [
  1865. mk (TVar (v,Some e)) ctx.t.tvoid p;
  1866. e'
  1867. ]) t p
  1868. | AKUsing(ef,c,cf,et) ->
  1869. (* abstract setter + getter *)
  1870. let ta = match c.cl_kind with KAbstractImpl a -> TAbstract(a, List.map (fun _ -> mk_mono()) a.a_params) | _ -> assert false in
  1871. let ret = match follow ef.etype with
  1872. | TFun([_;_],ret) -> ret
  1873. | _ -> error "Invalid field type for abstract setter" p
  1874. in
  1875. let l = save_locals ctx in
  1876. let v,is_temp = match et.eexpr with
  1877. | TLocal v when not (v.v_name = "this") -> v,false
  1878. | _ -> gen_local ctx ta,true
  1879. in
  1880. let ev = mk (TLocal v) ta p in
  1881. (* this relies on the fact that cf_name is set_name *)
  1882. let getter_name = String.sub cf.cf_name 4 (String.length cf.cf_name - 4) in
  1883. let get = type_binop ctx op (EField ((EConst (Ident v.v_name),p),getter_name),p) e2 true with_type p in
  1884. unify ctx get.etype ret p;
  1885. l();
  1886. let e_call = make_call ctx ef [ev;get] ret p in
  1887. if is_temp then
  1888. mk (TBlock [
  1889. mk (TVar (v,Some et)) ctx.t.tvoid p;
  1890. e_call
  1891. ]) ret p
  1892. else
  1893. e_call
  1894. | AKAccess(a,tl,c,ebase,ekey) ->
  1895. let cf_get,tf_get,r_get,ekey,_ = Codegen.AbstractCast.find_array_access ctx a tl ekey None p in
  1896. (* bind complex keys to a variable so they do not make it into the output twice *)
  1897. let ekey,l = match Optimizer.make_constant_expression ctx ekey with
  1898. | Some e -> e, fun () -> None
  1899. | None ->
  1900. let save = save_locals ctx in
  1901. let v = gen_local ctx ekey.etype in
  1902. let e = mk (TLocal v) ekey.etype p in
  1903. e, fun () -> (save(); Some (mk (TVar (v,Some ekey)) ctx.t.tvoid p))
  1904. in
  1905. let eget = mk_array_get_call ctx (cf_get,tf_get,r_get,ekey,None) c ebase p in
  1906. let eget = type_binop2 ctx op eget e2 true (WithType eget.etype) p in
  1907. unify ctx eget.etype r_get p;
  1908. let cf_set,tf_set,r_set,ekey,eget = Codegen.AbstractCast.find_array_access ctx a tl ekey (Some eget) p in
  1909. let eget = match eget with None -> assert false | Some e -> e in
  1910. let et = type_module_type ctx (TClassDecl c) None p in
  1911. begin match cf_set.cf_expr,cf_get.cf_expr with
  1912. | None,None ->
  1913. let ea = mk (TArray(ebase,ekey)) r_get p in
  1914. mk (TBinop(OpAssignOp op,ea,type_expr ctx e2 (WithType r_get))) r_set p
  1915. | Some _,Some _ ->
  1916. let ef_set = mk (TField(et,(FStatic(c,cf_set)))) tf_set p in
  1917. (match l() with
  1918. | None -> make_call ctx ef_set [ebase;ekey;eget] r_set p
  1919. | Some e ->
  1920. mk (TBlock [
  1921. e;
  1922. make_call ctx ef_set [ebase;ekey;eget] r_set p
  1923. ]) r_set p)
  1924. | _ ->
  1925. error "Invalid array access getter/setter combination" p
  1926. end;
  1927. | AKInline _ | AKMacro _ ->
  1928. assert false)
  1929. | _ ->
  1930. (* If the with_type is an abstract which has exactly one applicable @:op method, we can promote it
  1931. to the individual arguments (issue #2786). *)
  1932. let wt = match with_type with
  1933. | WithType t | WithTypeResume t ->
  1934. begin match follow t with
  1935. | TAbstract(a,_) ->
  1936. begin match List.filter (fun (o,_) -> o = OpAssignOp(op) || o == op) a.a_ops with
  1937. | [_] -> with_type
  1938. | _ -> Value
  1939. end
  1940. | _ ->
  1941. Value
  1942. end
  1943. | _ ->
  1944. Value
  1945. in
  1946. let e1 = type_expr ctx e1 wt in
  1947. type_binop2 ctx op e1 e2 is_assign_op wt p
  1948. and type_binop2 ctx op (e1 : texpr) (e2 : Ast.expr) is_assign_op wt p =
  1949. let e2 = type_expr ctx e2 (if op == OpEq || op == OpNotEq then WithType e1.etype else wt) in
  1950. let tint = ctx.t.tint in
  1951. let tfloat = ctx.t.tfloat in
  1952. let tstring = ctx.t.tstring in
  1953. let to_string e =
  1954. let rec loop t = match classify t with
  1955. | KAbstract ({a_impl = Some c},_) when PMap.mem "toString" c.cl_statics ->
  1956. call_to_string ctx c e
  1957. | KInt | KFloat | KString -> e
  1958. | KUnk | KDyn | KParam _ | KOther ->
  1959. let std = type_type ctx ([],"Std") e.epos in
  1960. let acc = acc_get ctx (type_field ctx std "string" e.epos MCall) e.epos in
  1961. ignore(follow acc.etype);
  1962. let acc = (match acc.eexpr with TField (e,FClosure (Some (c,tl),f)) -> { acc with eexpr = TField (e,FInstance (c,tl,f)) } | _ -> acc) in
  1963. make_call ctx acc [e] ctx.t.tstring e.epos
  1964. | KAbstract (a,tl) ->
  1965. loop (Abstract.get_underlying_type a tl)
  1966. in
  1967. loop e.etype
  1968. in
  1969. let mk_op e1 e2 t =
  1970. if op = OpAdd && (classify t) = KString then
  1971. let e1 = to_string e1 in
  1972. let e2 = to_string e2 in
  1973. mk (TBinop (op,e1,e2)) t p
  1974. else
  1975. mk (TBinop (op,e1,e2)) t p
  1976. in
  1977. let make e1 e2 = match op with
  1978. | OpAdd ->
  1979. mk_op e1 e2 (match classify e1.etype, classify e2.etype with
  1980. | KInt , KInt ->
  1981. tint
  1982. | KFloat , KInt
  1983. | KInt, KFloat
  1984. | KFloat, KFloat ->
  1985. tfloat
  1986. | KUnk , KInt ->
  1987. if unify_int ctx e1 KUnk then tint else tfloat
  1988. | KUnk , KFloat
  1989. | KUnk , KString ->
  1990. unify ctx e1.etype e2.etype e1.epos;
  1991. e1.etype
  1992. | KInt , KUnk ->
  1993. if unify_int ctx e2 KUnk then tint else tfloat
  1994. | KFloat , KUnk
  1995. | KString , KUnk ->
  1996. unify ctx e2.etype e1.etype e2.epos;
  1997. e2.etype
  1998. | _ , KString
  1999. | KString , _ ->
  2000. tstring
  2001. | _ , KDyn ->
  2002. e2.etype
  2003. | KDyn , _ ->
  2004. e1.etype
  2005. | KUnk , KUnk ->
  2006. let ok1 = unify_int ctx e1 KUnk in
  2007. let ok2 = unify_int ctx e2 KUnk in
  2008. if ok1 && ok2 then tint else tfloat
  2009. | KParam t1, KParam t2 when Type.type_iseq t1 t2 ->
  2010. t1
  2011. | KParam t, KInt | KInt, KParam t ->
  2012. t
  2013. | KParam _, KFloat | KFloat, KParam _ | KParam _, KParam _ ->
  2014. tfloat
  2015. | KParam t, KUnk ->
  2016. unify ctx e2.etype tfloat e2.epos;
  2017. tfloat
  2018. | KUnk, KParam t ->
  2019. unify ctx e1.etype tfloat e1.epos;
  2020. tfloat
  2021. | KAbstract _,KFloat ->
  2022. unify ctx e1.etype tfloat e1.epos;
  2023. tfloat
  2024. | KFloat, KAbstract _ ->
  2025. unify ctx e2.etype tfloat e2.epos;
  2026. tfloat
  2027. | KAbstract _,KInt ->
  2028. unify ctx e1.etype ctx.t.tint e1.epos;
  2029. ctx.t.tint
  2030. | KInt, KAbstract _ ->
  2031. unify ctx e2.etype ctx.t.tint e2.epos;
  2032. ctx.t.tint
  2033. | KAbstract _,_
  2034. | _,KAbstract _
  2035. | KParam _, _
  2036. | _, KParam _
  2037. | KOther, _
  2038. | _ , KOther ->
  2039. let pr = print_context() in
  2040. error ("Cannot add " ^ s_type pr e1.etype ^ " and " ^ s_type pr e2.etype) p
  2041. )
  2042. | OpAnd
  2043. | OpOr
  2044. | OpXor
  2045. | OpShl
  2046. | OpShr
  2047. | OpUShr ->
  2048. let i = tint in
  2049. unify ctx e1.etype i e1.epos;
  2050. unify ctx e2.etype i e2.epos;
  2051. mk_op e1 e2 i
  2052. | OpMod
  2053. | OpMult
  2054. | OpDiv
  2055. | OpSub ->
  2056. let result = ref (if op = OpDiv then tfloat else tint) in
  2057. (match classify e1.etype, classify e2.etype with
  2058. | KFloat, KFloat ->
  2059. result := tfloat
  2060. | KParam t1, KParam t2 when Type.type_iseq t1 t2 ->
  2061. if op <> OpDiv then result := t1
  2062. | KParam _, KParam _ ->
  2063. result := tfloat
  2064. | KParam t, KInt | KInt, KParam t ->
  2065. if op <> OpDiv then result := t
  2066. | KParam _, KFloat | KFloat, KParam _ ->
  2067. result := tfloat
  2068. | KFloat, k ->
  2069. ignore(unify_int ctx e2 k);
  2070. result := tfloat
  2071. | k, KFloat ->
  2072. ignore(unify_int ctx e1 k);
  2073. result := tfloat
  2074. | k1 , k2 ->
  2075. let ok1 = unify_int ctx e1 k1 in
  2076. let ok2 = unify_int ctx e2 k2 in
  2077. if not ok1 || not ok2 then result := tfloat;
  2078. );
  2079. mk_op e1 e2 !result
  2080. | OpEq
  2081. | OpNotEq ->
  2082. let e1,e2 = try
  2083. (* we only have to check one type here, because unification fails if one is Void and the other is not *)
  2084. (match follow e2.etype with TAbstract({a_path=[],"Void"},_) -> error "Cannot compare Void" p | _ -> ());
  2085. Codegen.AbstractCast.cast_or_unify_raise ctx e2.etype e1 p,e2
  2086. with Error (Unify _,_) ->
  2087. e1,Codegen.AbstractCast.cast_or_unify ctx e1.etype e2 p
  2088. in
  2089. mk_op e1 e2 ctx.t.tbool
  2090. | OpGt
  2091. | OpGte
  2092. | OpLt
  2093. | OpLte ->
  2094. (match classify e1.etype, classify e2.etype with
  2095. | KInt , KInt | KInt , KFloat | KFloat , KInt | KFloat , KFloat | KString , KString -> ()
  2096. | KInt , KUnk -> ignore(unify_int ctx e2 KUnk)
  2097. | KFloat , KUnk | KString , KUnk -> unify ctx e2.etype e1.etype e2.epos
  2098. | KUnk , KInt -> ignore(unify_int ctx e1 KUnk)
  2099. | KUnk , KFloat | KUnk , KString -> unify ctx e1.etype e2.etype e1.epos
  2100. | KUnk , KUnk ->
  2101. ignore(unify_int ctx e1 KUnk);
  2102. ignore(unify_int ctx e2 KUnk);
  2103. | KDyn , KInt | KDyn , KFloat | KDyn , KString -> ()
  2104. | KInt , KDyn | KFloat , KDyn | KString , KDyn -> ()
  2105. | KDyn , KDyn -> ()
  2106. | KParam _ , x | x , KParam _ when x <> KString && x <> KOther -> ()
  2107. | KAbstract _,_
  2108. | _,KAbstract _
  2109. | KDyn , KUnk
  2110. | KUnk , KDyn
  2111. | KString , KInt
  2112. | KString , KFloat
  2113. | KInt , KString
  2114. | KFloat , KString
  2115. | KParam _ , _
  2116. | _ , KParam _
  2117. | KOther , _
  2118. | _ , KOther ->
  2119. let pr = print_context() in
  2120. error ("Cannot compare " ^ s_type pr e1.etype ^ " and " ^ s_type pr e2.etype) p
  2121. );
  2122. mk_op e1 e2 ctx.t.tbool
  2123. | OpBoolAnd
  2124. | OpBoolOr ->
  2125. let b = ctx.t.tbool in
  2126. unify ctx e1.etype b p;
  2127. unify ctx e2.etype b p;
  2128. mk_op e1 e2 b
  2129. | OpInterval ->
  2130. let t = Typeload.load_core_type ctx "IntIterator" in
  2131. unify ctx e1.etype tint e1.epos;
  2132. unify ctx e2.etype tint e2.epos;
  2133. mk (TNew ((match t with TInst (c,[]) -> c | _ -> assert false),[],[e1;e2])) t p
  2134. | OpArrow ->
  2135. error "Unexpected =>" p
  2136. | OpAssign
  2137. | OpAssignOp _ ->
  2138. assert false
  2139. in
  2140. let find_overload a c tl left =
  2141. let map = apply_params a.a_params tl in
  2142. let make op_cf cf e1 e2 tret =
  2143. if cf.cf_expr = None then begin
  2144. if not (Meta.has Meta.NoExpr cf.cf_meta) then display_error ctx "Recursive operator method" p;
  2145. if not (Meta.has Meta.CoreType a.a_meta) then begin
  2146. (* for non core-types we require that the return type is compatible to the native result type *)
  2147. let e' = make {e1 with etype = Abstract.follow_with_abstracts e1.etype} {e1 with etype = Abstract.follow_with_abstracts e2.etype} in
  2148. let t_expected = e'.etype in
  2149. begin try
  2150. unify_raise ctx tret t_expected p
  2151. with Error (Unify _,_) ->
  2152. match follow tret with
  2153. | TAbstract(a,tl) when type_iseq (Abstract.get_underlying_type a tl) t_expected ->
  2154. ()
  2155. | _ ->
  2156. let st = s_type (print_context()) in
  2157. error (Printf.sprintf "The result of this operation (%s) is not compatible with declared return type %s" (st t_expected) (st tret)) p
  2158. end;
  2159. end;
  2160. let e = Codegen.binop op e1 e2 tret p in
  2161. mk_cast e tret p
  2162. (* Codegen.maybe_cast e tret *)
  2163. end else begin
  2164. let e = make_static_call ctx c cf map [e1;e2] tret p in
  2165. e
  2166. end
  2167. in
  2168. (* special case for == and !=: if the second type is a monomorph, assume that we want to unify
  2169. it with the first type to preserve comparison semantics. *)
  2170. let is_eq_op = match op with OpEq | OpNotEq -> true | _ -> false in
  2171. if is_eq_op then begin match follow e1.etype,follow e2.etype with
  2172. | TMono _,_ | _,TMono _ ->
  2173. Type.unify e1.etype e2.etype
  2174. | _ ->
  2175. ()
  2176. end;
  2177. let rec loop ol = match ol with
  2178. | (op_cf,cf) :: ol when op_cf <> op && (not is_assign_op || op_cf <> OpAssignOp(op)) ->
  2179. loop ol
  2180. | (op_cf,cf) :: ol ->
  2181. let is_impl = Meta.has Meta.Impl cf.cf_meta in
  2182. begin match follow cf.cf_type with
  2183. | TFun([(_,_,t1);(_,_,t2)],tret) ->
  2184. let check e1 e2 swapped =
  2185. let map_arguments () =
  2186. let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
  2187. let map t = map (apply_params cf.cf_params monos t) in
  2188. let t1 = map t1 in
  2189. let t2 = map t2 in
  2190. let tret = map tret in
  2191. monos,t1,t2,tret
  2192. in
  2193. let monos,t1,t2,tret = map_arguments() in
  2194. let make e1 e2 = make op_cf cf e1 e2 tret in
  2195. let t1 = if is_impl then Abstract.follow_with_abstracts t1 else t1 in
  2196. let e1,e2 = if left || not left && swapped then begin
  2197. Type.type_eq EqStrict (if is_impl then Abstract.follow_with_abstracts e1.etype else e1.etype) t1;
  2198. e1,Codegen.AbstractCast.cast_or_unify_raise ctx t2 e2 p
  2199. end else begin
  2200. Type.type_eq EqStrict e2.etype t2;
  2201. Codegen.AbstractCast.cast_or_unify_raise ctx t1 e1 p,e2
  2202. end in
  2203. check_constraints ctx "" cf.cf_params monos (apply_params a.a_params tl) false cf.cf_pos;
  2204. let check_null e t = if is_eq_op then match e.eexpr with
  2205. | TConst TNull when not (is_explicit_null t) -> raise (Unify_error [])
  2206. | _ -> ()
  2207. in
  2208. (* If either expression is `null` we only allow operator resolving if the argument type
  2209. is explicitly Null<T> (issue #3376) *)
  2210. if is_eq_op then begin
  2211. check_null e2 t2;
  2212. check_null e1 t1;
  2213. end;
  2214. let e = if not swapped then
  2215. make e1 e2
  2216. else if not (Optimizer.has_side_effect e1) && not (Optimizer.has_side_effect e2) then
  2217. make e1 e2
  2218. else
  2219. let v1,v2 = gen_local ctx t1, gen_local ctx t2 in
  2220. let ev1,ev2 = mk (TVar(v1,Some e1)) ctx.t.tvoid p,mk (TVar(v2,Some e2)) ctx.t.tvoid p in
  2221. let eloc1,eloc2 = mk (TLocal v1) v1.v_type p,mk (TLocal v2) v2.v_type p in
  2222. let e = make eloc1 eloc2 in
  2223. let e = mk (TBlock [
  2224. ev2;
  2225. ev1;
  2226. e
  2227. ]) e.etype e.epos in
  2228. e
  2229. in
  2230. if is_assign_op && op_cf = op then (mk (TMeta((Meta.RequiresAssign,[],p),e)) e.etype e.epos)
  2231. else e
  2232. in
  2233. begin try
  2234. check e1 e2 false
  2235. with Error (Unify _,_) | Unify_error _ -> try
  2236. if not (Meta.has Meta.Commutative cf.cf_meta) then raise Not_found;
  2237. check e2 e1 true
  2238. with Not_found | Error (Unify _,_) | Unify_error _ ->
  2239. loop ol
  2240. end
  2241. | _ ->
  2242. assert false
  2243. end
  2244. | [] ->
  2245. raise Not_found
  2246. in
  2247. loop (if left then a.a_ops else List.filter (fun (_,cf) -> not (Meta.has Meta.Impl cf.cf_meta)) a.a_ops)
  2248. in
  2249. try
  2250. begin match follow e1.etype with
  2251. | TAbstract({a_impl = Some c} as a,tl) -> find_overload a c tl true
  2252. | _ -> raise Not_found
  2253. end
  2254. with Not_found -> try
  2255. begin match follow e2.etype with
  2256. | TAbstract({a_impl = Some c} as a,tl) -> find_overload a c tl false
  2257. | _ -> raise Not_found
  2258. end
  2259. with Not_found ->
  2260. make e1 e2
  2261. and type_unop ctx op flag e p =
  2262. let set = (op = Increment || op = Decrement) in
  2263. let acc = type_access ctx (fst e) (snd e) (if set then MSet else MGet) in
  2264. let access e =
  2265. let make e =
  2266. let t = (match op with
  2267. | Not ->
  2268. unify ctx e.etype ctx.t.tbool e.epos;
  2269. ctx.t.tbool
  2270. | Increment
  2271. | Decrement
  2272. | Neg
  2273. | NegBits ->
  2274. if set then check_assign ctx e;
  2275. (match classify e.etype with
  2276. | KFloat -> ctx.t.tfloat
  2277. | KParam t ->
  2278. unify ctx e.etype ctx.t.tfloat e.epos;
  2279. t
  2280. | k ->
  2281. if unify_int ctx e k then ctx.t.tint else ctx.t.tfloat)
  2282. ) in
  2283. mk (TUnop (op,flag,e)) t p
  2284. in
  2285. try (match follow e.etype with
  2286. | TAbstract ({a_impl = Some c} as a,pl) ->
  2287. let rec loop opl = match opl with
  2288. | [] -> raise Not_found
  2289. | (op2,flag2,cf) :: opl when op == op2 && flag == flag2 ->
  2290. let m = mk_mono() in
  2291. let tcf = apply_params a.a_params pl (monomorphs cf.cf_params cf.cf_type) in
  2292. if Meta.has Meta.Impl cf.cf_meta then begin
  2293. if type_iseq (tfun [apply_params a.a_params pl a.a_this] m) tcf then cf,tcf,m else loop opl
  2294. end else
  2295. if type_iseq (tfun [e.etype] m) tcf then cf,tcf,m else loop opl
  2296. | _ :: opl -> loop opl
  2297. in
  2298. let cf,t,r = try loop a.a_unops with Not_found -> raise Not_found in
  2299. (match cf.cf_expr with
  2300. | None ->
  2301. let e = {e with etype = apply_params a.a_params pl a.a_this} in
  2302. let e = mk (TUnop(op,flag,e)) r p in
  2303. (* unify ctx r e.etype p; *) (* TODO: I'm not sure why this was here (related to #2295) *)
  2304. e
  2305. | Some _ ->
  2306. let et = type_module_type ctx (TClassDecl c) None p in
  2307. let ef = mk (TField (et,FStatic (c,cf))) t p in
  2308. make_call ctx ef [e] r p)
  2309. | _ -> raise Not_found
  2310. ) with Not_found ->
  2311. make e
  2312. in
  2313. let rec loop acc =
  2314. match acc with
  2315. | AKExpr e -> access e
  2316. | AKInline _ | AKUsing _ when not set -> access (acc_get ctx acc p)
  2317. | AKNo s ->
  2318. error ("The field or identifier " ^ s ^ " is not accessible for " ^ (if set then "writing" else "reading")) p
  2319. | AKAccess(a,tl,c,ebase,ekey) ->
  2320. let e = mk_array_get_call ctx (Codegen.AbstractCast.find_array_access ctx a tl ekey None p) c ebase p in
  2321. loop (AKExpr e)
  2322. | AKInline _ | AKUsing _ | AKMacro _ ->
  2323. error "This kind of operation is not supported" p
  2324. | AKSet (e,t,cf) ->
  2325. let l = save_locals ctx in
  2326. let v = gen_local ctx e.etype in
  2327. let ev = mk (TLocal v) e.etype p in
  2328. let op = (match op with Increment -> OpAdd | Decrement -> OpSub | _ -> assert false) in
  2329. let one = (EConst (Int "1"),p) in
  2330. let eget = (EField ((EConst (Ident v.v_name),p),cf.cf_name),p) in
  2331. match flag with
  2332. | Prefix ->
  2333. let get = type_binop ctx op eget one false Value p in
  2334. unify ctx get.etype t p;
  2335. l();
  2336. mk (TBlock [
  2337. mk (TVar (v,Some e)) ctx.t.tvoid p;
  2338. make_call ctx (mk (TField (ev,quick_field_dynamic ev.etype ("set_" ^ cf.cf_name))) (tfun [t] t) p) [get] t p
  2339. ]) t p
  2340. | Postfix ->
  2341. let v2 = gen_local ctx t in
  2342. let ev2 = mk (TLocal v2) t p in
  2343. let get = type_expr ctx eget Value in
  2344. let plusone = type_binop ctx op (EConst (Ident v2.v_name),p) one false Value p in
  2345. unify ctx get.etype t p;
  2346. l();
  2347. mk (TBlock [
  2348. mk (TVar (v,Some e)) ctx.t.tvoid p;
  2349. mk (TVar (v2,Some get)) ctx.t.tvoid p;
  2350. make_call ctx (mk (TField (ev,quick_field_dynamic ev.etype ("set_" ^ cf.cf_name))) (tfun [plusone.etype] t) p) [plusone] t p;
  2351. ev2
  2352. ]) t p
  2353. in
  2354. loop acc
  2355. and type_switch_old ctx e cases def with_type p =
  2356. let eval = type_expr ctx e Value in
  2357. let el = ref [] in
  2358. let type_case_code e =
  2359. let e = (match e with
  2360. | Some e -> type_expr ctx e with_type
  2361. | None -> mk (TBlock []) ctx.com.basic.tvoid Ast.null_pos
  2362. ) in
  2363. el := e :: !el;
  2364. e
  2365. in
  2366. let consts = Hashtbl.create 0 in
  2367. let exprs (el,_,e) =
  2368. let el = List.map (fun e ->
  2369. match type_expr ctx e (WithType eval.etype) with
  2370. | { eexpr = TConst c } as e ->
  2371. if Hashtbl.mem consts c then error "Duplicate constant in switch" e.epos;
  2372. Hashtbl.add consts c true;
  2373. e
  2374. | e ->
  2375. e
  2376. ) el in
  2377. let locals = save_locals ctx in
  2378. let e = type_case_code e in
  2379. locals();
  2380. el, e
  2381. in
  2382. let cases = List.map exprs cases in
  2383. let def() = (match def with
  2384. | None -> None
  2385. | Some e ->
  2386. let locals = save_locals ctx in
  2387. let e = type_case_code e in
  2388. locals();
  2389. Some e
  2390. ) in
  2391. let def = def() in
  2392. let t = if with_type = NoValue then (mk_mono()) else unify_min ctx (List.rev !el) in
  2393. mk (TSwitch (eval,cases,def)) t p
  2394. and type_ident ctx i p mode =
  2395. try
  2396. type_ident_raise ctx i p mode
  2397. with Not_found -> try
  2398. (* lookup type *)
  2399. if is_lower_ident i then raise Not_found;
  2400. let e = (try type_type ctx ([],i) p with Error (Module_not_found ([],name),_) when name = i -> raise Not_found) in
  2401. AKExpr e
  2402. with Not_found ->
  2403. if ctx.untyped then begin
  2404. if i = "__this__" then
  2405. AKExpr (mk (TConst TThis) ctx.tthis p)
  2406. else
  2407. let t = mk_mono() in
  2408. let v = alloc_unbound_var i t in
  2409. AKExpr (mk (TLocal v) t p)
  2410. end else begin
  2411. if ctx.curfun = FunStatic && PMap.mem i ctx.curclass.cl_fields then error ("Cannot access " ^ i ^ " in static function") p;
  2412. let err = Unknown_ident i in
  2413. if ctx.in_display then raise (Error (err,p));
  2414. if ctx.com.display <> DMNone then begin
  2415. display_error ctx (error_msg err) p;
  2416. let t = mk_mono() in
  2417. AKExpr (mk (TLocal (add_local ctx i t)) t p)
  2418. end else begin
  2419. if List.exists (fun (i2,_) -> i2 = i) ctx.type_params then
  2420. display_error ctx ("Type parameter " ^ i ^ " is only available at compilation and is not a runtime value") p
  2421. else
  2422. display_error ctx (error_msg err) p;
  2423. AKExpr (mk (TConst TNull) t_dynamic p)
  2424. end
  2425. end
  2426. and type_access ctx e p mode =
  2427. match e with
  2428. | EConst (Ident s) ->
  2429. type_ident ctx s p mode
  2430. | EField (e1,"new") ->
  2431. let e1 = type_expr ctx e1 Value in
  2432. begin match e1.eexpr with
  2433. | TTypeExpr (TClassDecl c) ->
  2434. if mode = MSet then error "Cannot set constructor" p;
  2435. if mode = MCall then error ("Cannot call constructor like this, use 'new " ^ (s_type_path c.cl_path) ^ "()' instead") p;
  2436. let monos = List.map (fun _ -> mk_mono()) c.cl_params in
  2437. let ct, cf = get_constructor ctx c monos p in
  2438. let args = match follow ct with TFun(args,ret) -> args | _ -> assert false in
  2439. let vl = List.map (fun (n,_,t) -> alloc_var n t) args in
  2440. let vexpr v = mk (TLocal v) v.v_type p in
  2441. let el = List.map vexpr vl in
  2442. let ec,t = match c.cl_kind with
  2443. | KAbstractImpl a ->
  2444. let e = type_module_type ctx (TClassDecl c) None p in
  2445. let e = mk (TField (e,(FStatic (c,cf)))) ct p in
  2446. let t = TAbstract(a,monos) in
  2447. make_call ctx e el t p,t
  2448. | _ ->
  2449. let t = TInst(c,monos) in
  2450. mk (TNew(c,monos,el)) t p,t
  2451. in
  2452. AKExpr(mk (TFunction {
  2453. tf_args = List.map (fun v -> v,None) vl;
  2454. tf_type = t;
  2455. tf_expr = mk (TReturn (Some ec)) t p;
  2456. }) (tfun (List.map (fun v -> v.v_type) vl) t) p)
  2457. | _ -> error "Binding new is only allowed on class types" p
  2458. end;
  2459. | EField _ ->
  2460. let fields ?(resume=false) path e =
  2461. let resume = ref resume in
  2462. let force = ref false in
  2463. let e = List.fold_left (fun e (f,_,p) ->
  2464. let e = acc_get ctx (e MGet) p in
  2465. let f = type_field ~resume:(!resume) ctx e f p in
  2466. force := !resume;
  2467. resume := false;
  2468. f
  2469. ) e path in
  2470. if !force then ignore(e MCall); (* not necessarily a call, but prevent #2602 among others *)
  2471. e
  2472. in
  2473. let type_path path =
  2474. let rec loop acc path =
  2475. match path with
  2476. | [] ->
  2477. (match List.rev acc with
  2478. | [] -> assert false
  2479. | (name,flag,p) :: path ->
  2480. try
  2481. fields path (type_access ctx (EConst (Ident name)) p)
  2482. with
  2483. Error (Unknown_ident _,p2) as e when p = p2 ->
  2484. try
  2485. let path = ref [] in
  2486. let name , _ , _ = List.find (fun (name,flag,p) ->
  2487. if flag then
  2488. true
  2489. else begin
  2490. path := name :: !path;
  2491. false
  2492. end
  2493. ) (List.rev acc) in
  2494. raise (Error (Module_not_found (List.rev !path,name),p))
  2495. with
  2496. Not_found ->
  2497. if ctx.in_display then raise (Parser.TypePath (List.map (fun (n,_,_) -> n) (List.rev acc),None,false));
  2498. raise e)
  2499. | (_,false,_) as x :: path ->
  2500. loop (x :: acc) path
  2501. | (name,true,p) as x :: path ->
  2502. let pack = List.rev_map (fun (x,_,_) -> x) acc in
  2503. let def() =
  2504. try
  2505. let e = type_type ctx (pack,name) p in
  2506. fields path (fun _ -> AKExpr e)
  2507. with
  2508. Error (Module_not_found m,_) when m = (pack,name) ->
  2509. loop ((List.rev path) @ x :: acc) []
  2510. in
  2511. match path with
  2512. | (sname,true,p) :: path ->
  2513. let get_static resume t =
  2514. fields ~resume ((sname,true,p) :: path) (fun _ -> AKExpr (type_module_type ctx t None p))
  2515. in
  2516. let check_module m v =
  2517. try
  2518. let md = Typeload.load_module ctx m p in
  2519. (* first look for existing subtype *)
  2520. (try
  2521. let t = List.find (fun t -> not (t_infos t).mt_private && t_path t = (fst m,sname)) md.m_types in
  2522. Some (fields path (fun _ -> AKExpr (type_module_type ctx t None p)))
  2523. with Not_found -> try
  2524. (* then look for main type statics *)
  2525. if fst m = [] then raise Not_found; (* ensure that we use def() to resolve local types first *)
  2526. let t = List.find (fun t -> not (t_infos t).mt_private && t_path t = m) md.m_types in
  2527. Some (get_static false t)
  2528. with Not_found ->
  2529. None)
  2530. with Error (Module_not_found m2,_) when m = m2 ->
  2531. None
  2532. in
  2533. let rec loop pack =
  2534. match check_module (pack,name) sname with
  2535. | Some r -> r
  2536. | None ->
  2537. match List.rev pack with
  2538. | [] -> def()
  2539. | _ :: l -> loop (List.rev l)
  2540. in
  2541. (match pack with
  2542. | [] ->
  2543. (try
  2544. let t = List.find (fun t -> snd (t_infos t).mt_path = name) (ctx.m.curmod.m_types @ ctx.m.module_types) in
  2545. (* if the static is not found, look for a subtype instead - #1916 *)
  2546. get_static true t
  2547. with Not_found ->
  2548. loop (fst ctx.m.curmod.m_path))
  2549. | _ ->
  2550. match check_module (pack,name) sname with
  2551. | Some r -> r
  2552. | None -> def());
  2553. | _ -> def()
  2554. in
  2555. match path with
  2556. | [] -> assert false
  2557. | (name,_,p) :: pnext ->
  2558. try
  2559. fields pnext (fun _ -> type_ident_raise ctx name p MGet)
  2560. with
  2561. Not_found -> loop [] path
  2562. in
  2563. let rec loop acc e =
  2564. let p = pos e in
  2565. match fst e with
  2566. | EField (e,s) ->
  2567. loop ((s,not (is_lower_ident s),p) :: acc) e
  2568. | EConst (Ident i) ->
  2569. type_path ((i,not (is_lower_ident i),p) :: acc)
  2570. | _ ->
  2571. fields acc (type_access ctx (fst e) (snd e))
  2572. in
  2573. loop [] (e,p) mode
  2574. | EArray (e1,e2) ->
  2575. let e1 = type_expr ctx e1 Value in
  2576. let e2 = type_expr ctx e2 Value in
  2577. let has_abstract_array_access = ref false in
  2578. (try (match follow e1.etype with
  2579. | TAbstract ({a_impl = Some c} as a,pl) when a.a_array <> [] ->
  2580. begin match mode with
  2581. | MSet ->
  2582. (* resolve later *)
  2583. AKAccess (a,pl,c,e1,e2)
  2584. | _ ->
  2585. has_abstract_array_access := true;
  2586. let e = mk_array_get_call ctx (Codegen.AbstractCast.find_array_access ctx a pl e2 None p) c e1 p in
  2587. AKExpr e
  2588. end
  2589. | _ -> raise Not_found)
  2590. with Not_found ->
  2591. unify ctx e2.etype ctx.t.tint e2.epos;
  2592. let rec loop et =
  2593. match follow et with
  2594. | TInst ({ cl_array_access = Some t; cl_params = pl },tl) ->
  2595. apply_params pl tl t
  2596. | TInst ({ cl_super = Some (c,stl); cl_params = pl },tl) ->
  2597. apply_params pl tl (loop (TInst (c,stl)))
  2598. | TInst ({ cl_path = [],"ArrayAccess" },[t]) ->
  2599. t
  2600. | TInst ({ cl_path = [],"Array"},[t]) when t == t_dynamic ->
  2601. t_dynamic
  2602. | TAbstract(a,tl) when Meta.has Meta.ArrayAccess a.a_meta ->
  2603. loop (apply_params a.a_params tl a.a_this)
  2604. | _ ->
  2605. let pt = mk_mono() in
  2606. let t = ctx.t.tarray pt in
  2607. (try unify_raise ctx et t p
  2608. with Error(Unify _,_) -> if not ctx.untyped then begin
  2609. if !has_abstract_array_access then error ("No @:arrayAccess function accepts an argument of " ^ (s_type (print_context()) e2.etype)) e1.epos
  2610. else error ("Array access is not allowed on " ^ (s_type (print_context()) e1.etype)) e1.epos
  2611. end);
  2612. pt
  2613. in
  2614. let pt = loop e1.etype in
  2615. AKExpr (mk (TArray (e1,e2)) pt p))
  2616. | _ ->
  2617. AKExpr (type_expr ctx (e,p) Value)
  2618. and type_vars ctx vl p in_block =
  2619. let save = if in_block then (fun() -> ()) else save_locals ctx in
  2620. let vl = List.map (fun (v,t,e) ->
  2621. try
  2622. let t = Typeload.load_type_opt ctx p t in
  2623. let e = (match e with
  2624. | None -> None
  2625. | Some e ->
  2626. let e = type_expr ctx e (WithType t) in
  2627. let e = Codegen.AbstractCast.cast_or_unify ctx t e p in
  2628. Some e
  2629. ) in
  2630. if v.[0] = '$' && ctx.com.display = DMNone then error "Variables names starting with a dollar are not allowed" p;
  2631. add_local ctx v t, e
  2632. with
  2633. Error (e,p) ->
  2634. display_error ctx (error_msg e) p;
  2635. add_local ctx v t_dynamic, None
  2636. ) vl in
  2637. save();
  2638. match vl with
  2639. | [v,eo] ->
  2640. mk (TVar (v,eo)) ctx.t.tvoid p
  2641. | _ ->
  2642. let e = mk (TBlock (List.map (fun (v,e) -> (mk (TVar (v,e)) ctx.t.tvoid p)) vl)) ctx.t.tvoid p in
  2643. mk (TMeta((Meta.MergeBlock,[],p), e)) e.etype e.epos
  2644. and with_type_error ctx with_type msg p =
  2645. match with_type with
  2646. | WithTypeResume _ -> raise (WithTypeError ([Unify_custom msg],p))
  2647. | _ -> display_error ctx msg p
  2648. and format_string ctx s p =
  2649. let e = ref None in
  2650. let pmin = ref p.pmin in
  2651. let min = ref (p.pmin + 1) in
  2652. let add enext len =
  2653. let p = { p with pmin = !min; pmax = !min + len } in
  2654. min := !min + len;
  2655. match !e with
  2656. | None -> e := Some (enext,p)
  2657. | Some prev ->
  2658. e := Some (EBinop (OpAdd,prev,(enext,p)),punion (pos prev) p)
  2659. in
  2660. let add_sub start pos =
  2661. let len = pos - start in
  2662. if len > 0 || !e = None then add (EConst (String (String.sub s start len))) len
  2663. in
  2664. let warn_escape = Common.defined ctx.com Define.FormatWarning in
  2665. let warn pos len =
  2666. ctx.com.warning "This string is formated" { p with pmin = !pmin + 1 + pos; pmax = !pmin + 1 + pos + len }
  2667. in
  2668. let len = String.length s in
  2669. let rec parse start pos =
  2670. if pos = len then add_sub start pos else
  2671. let c = String.unsafe_get s pos in
  2672. let pos = pos + 1 in
  2673. if c = '\'' then begin
  2674. incr pmin;
  2675. incr min;
  2676. end;
  2677. if c <> '$' || pos = len then parse start pos else
  2678. match String.unsafe_get s pos with
  2679. | '$' ->
  2680. if warn_escape then warn pos 1;
  2681. (* double $ *)
  2682. add_sub start pos;
  2683. parse (pos + 1) (pos + 1)
  2684. | '{' ->
  2685. parse_group start pos '{' '}' "brace"
  2686. | 'a'..'z' | 'A'..'Z' | '_' ->
  2687. add_sub start (pos - 1);
  2688. incr min;
  2689. let rec loop i =
  2690. if i = len then i else
  2691. let c = String.unsafe_get s i in
  2692. match c with
  2693. | 'a'..'z' | 'A'..'Z' | '0'..'9' | '_' -> loop (i+1)
  2694. | _ -> i
  2695. in
  2696. let iend = loop (pos + 1) in
  2697. let len = iend - pos in
  2698. if warn_escape then warn pos len;
  2699. add (EConst (Ident (String.sub s pos len))) len;
  2700. parse (pos + len) (pos + len)
  2701. | _ ->
  2702. (* keep as-it *)
  2703. parse start pos
  2704. and parse_group start pos gopen gclose gname =
  2705. add_sub start (pos - 1);
  2706. let rec loop groups i =
  2707. if i = len then
  2708. match groups with
  2709. | [] -> assert false
  2710. | g :: _ -> error ("Unclosed " ^ gname) { p with pmin = !pmin + g + 1; pmax = !pmin + g + 2 }
  2711. else
  2712. let c = String.unsafe_get s i in
  2713. if c = gopen then
  2714. loop (i :: groups) (i + 1)
  2715. else if c = gclose then begin
  2716. let groups = List.tl groups in
  2717. if groups = [] then i else loop groups (i + 1)
  2718. end else
  2719. loop groups (i + 1)
  2720. in
  2721. let send = loop [pos] (pos + 1) in
  2722. let slen = send - pos - 1 in
  2723. let scode = String.sub s (pos + 1) slen in
  2724. if warn_escape then warn (pos + 1) slen;
  2725. min := !min + 2;
  2726. if slen > 0 then
  2727. add (fst (parse_expr_string ctx scode { p with pmin = !pmin + pos + 2; pmax = !pmin + send + 1 } true)) slen;
  2728. min := !min + 1;
  2729. parse (send + 1) (send + 1)
  2730. in
  2731. parse 0 0;
  2732. match !e with
  2733. | None -> assert false
  2734. | Some e -> e
  2735. and type_block ctx el with_type p =
  2736. let merge e = match e.eexpr with
  2737. | TMeta((Meta.MergeBlock,_,_), {eexpr = TBlock el}) ->
  2738. el
  2739. | _ -> [e]
  2740. in
  2741. let rec loop = function
  2742. | [] -> []
  2743. | (EVars vl,p) :: l ->
  2744. let e = type_vars ctx vl p true in
  2745. merge e @ loop l
  2746. | [e] ->
  2747. (try
  2748. merge (type_expr ctx e with_type)
  2749. with
  2750. Error (e,p) -> display_error ctx (error_msg e) p; [])
  2751. | e :: l ->
  2752. try
  2753. let e = type_expr ctx e NoValue in
  2754. merge e @ loop l
  2755. with
  2756. Error (e,p) -> display_error ctx (error_msg e) p; loop l
  2757. in
  2758. let l = loop el in
  2759. let rec loop = function
  2760. | [] -> ctx.t.tvoid
  2761. | [e] -> e.etype
  2762. | _ :: l -> loop l
  2763. in
  2764. mk (TBlock l) (loop l) p
  2765. and type_expr ctx (e,p) (with_type:with_type) =
  2766. match e with
  2767. | EField ((EConst (String s),p),"code") ->
  2768. if UTF8.length s <> 1 then error "String must be a single UTF8 char" p;
  2769. mk (TConst (TInt (Int32.of_int (UChar.code (UTF8.get s 0))))) ctx.t.tint p
  2770. | EField(_,n) when n.[0] = '$' ->
  2771. error "Field names starting with $ are not allowed" p
  2772. | EConst (Ident s) ->
  2773. if s = "super" && with_type <> NoValue then error "Cannot use super as value" p;
  2774. (try
  2775. acc_get ctx (type_ident_raise ~imported_enums:false ctx s p MGet) p
  2776. with Not_found -> try
  2777. (match with_type with
  2778. | WithType t | WithTypeResume t ->
  2779. (match follow t with
  2780. | TEnum (e,pl) ->
  2781. (try
  2782. let ef = PMap.find s e.e_constrs in
  2783. let monos = List.map (fun _ -> mk_mono()) ef.ef_params in
  2784. mk (fast_enum_field e ef p) (enum_field_type ctx e ef pl monos p) p
  2785. with Not_found ->
  2786. if ctx.untyped then raise Not_found;
  2787. with_type_error ctx with_type (string_error s e.e_names ("Identifier '" ^ s ^ "' is not part of enum " ^ s_type_path e.e_path)) p;
  2788. mk (TConst TNull) t p)
  2789. | TAbstract (a,pl) when has_meta Meta.Enum a.a_meta ->
  2790. let cimpl = (match a.a_impl with None -> assert false | Some c -> c) in
  2791. (try
  2792. let cf = PMap.find s cimpl.cl_statics in
  2793. acc_get ctx (type_field ctx (mk (TTypeExpr (TClassDecl cimpl)) (TAnon { a_fields = PMap.add cf.cf_name cf PMap.empty; a_status = ref (Statics cimpl) }) p) s p MGet) p
  2794. with Not_found ->
  2795. if ctx.untyped then raise Not_found;
  2796. with_type_error ctx with_type (string_error s (List.map (fun f -> f.cf_name) cimpl.cl_ordered_statics) ("Identifier '" ^ s ^ "' is not part of enum " ^ s_type_path a.a_path)) p;
  2797. mk (TConst TNull) t p)
  2798. | _ -> raise Not_found)
  2799. | _ ->
  2800. raise Not_found)
  2801. with Not_found ->
  2802. acc_get ctx (type_access ctx e p MGet) p)
  2803. | EField _
  2804. | EArray _ ->
  2805. acc_get ctx (type_access ctx e p MGet) p
  2806. | EConst (Regexp (r,opt)) ->
  2807. let str = mk (TConst (TString r)) ctx.t.tstring p in
  2808. let opt = mk (TConst (TString opt)) ctx.t.tstring p in
  2809. let t = Typeload.load_core_type ctx "EReg" in
  2810. mk (TNew ((match t with TInst (c,[]) -> c | _ -> assert false),[],[str;opt])) t p
  2811. | EConst (String s) when Lexer.is_fmt_string p ->
  2812. type_expr ctx (format_string ctx s p) with_type
  2813. | EConst c ->
  2814. Codegen.type_constant ctx.com c p
  2815. | EBinop (op,e1,e2) ->
  2816. type_binop ctx op e1 e2 false with_type p
  2817. | EBlock [] when with_type <> NoValue ->
  2818. type_expr ctx (EObjectDecl [],p) with_type
  2819. | EBlock l ->
  2820. let locals = save_locals ctx in
  2821. let e = type_block ctx l with_type p in
  2822. locals();
  2823. e
  2824. | EParenthesis e ->
  2825. let e = type_expr ctx e with_type in
  2826. mk (TParenthesis e) e.etype p
  2827. | EObjectDecl fl ->
  2828. let dynamic_parameter = ref None in
  2829. let a = (match with_type with
  2830. | WithType t | WithTypeResume t ->
  2831. (match follow t with
  2832. | TAnon a when not (PMap.is_empty a.a_fields) -> Some a
  2833. (* issues with https://github.com/HaxeFoundation/haxe/issues/3437 *)
  2834. (* | TAbstract (a,tl) when not (Meta.has Meta.CoreType a.a_meta) && a.a_from <> [] ->
  2835. begin match follow (Abstract.get_underlying_type a tl) with
  2836. | TAnon a when not (PMap.is_empty a.a_fields) -> Some a
  2837. | _ -> None
  2838. end *)
  2839. | TDynamic t when (follow t != t_dynamic) ->
  2840. dynamic_parameter := Some t;
  2841. Some {
  2842. a_status = ref Closed;
  2843. a_fields = PMap.empty;
  2844. }
  2845. | _ -> None)
  2846. | _ -> None
  2847. ) in
  2848. let wrap_quoted_meta e =
  2849. mk (TMeta((Meta.QuotedField,[],e.epos),e)) e.etype e.epos
  2850. in
  2851. (match a with
  2852. | None ->
  2853. let rec loop (l,acc) (f,e) =
  2854. let f,is_quoted,is_valid = Parser.unquote_ident f in
  2855. if PMap.mem f acc then error ("Duplicate field in object declaration : " ^ f) p;
  2856. let e = type_expr ctx e Value in
  2857. (match follow e.etype with TAbstract({a_path=[],"Void"},_) -> error "Fields of type Void are not allowed in structures" e.epos | _ -> ());
  2858. let cf = mk_field f e.etype e.epos in
  2859. let e = if is_quoted then wrap_quoted_meta e else e in
  2860. ((f,e) :: l, if is_valid then begin
  2861. if String.length f > 0 && f.[0] = '$' then error "Field names starting with a dollar are not allowed" p;
  2862. PMap.add f cf acc
  2863. end else acc)
  2864. in
  2865. let fields , types = List.fold_left loop ([],PMap.empty) fl in
  2866. let x = ref Const in
  2867. ctx.opened <- x :: ctx.opened;
  2868. mk (TObjectDecl (List.rev fields)) (TAnon { a_fields = types; a_status = x }) p
  2869. | Some a ->
  2870. let fields = ref PMap.empty in
  2871. let extra_fields = ref [] in
  2872. let fl = List.map (fun (n, e) ->
  2873. let n,is_quoted,is_valid = Parser.unquote_ident n in
  2874. if PMap.mem n !fields then error ("Duplicate field in object declaration : " ^ n) p;
  2875. let e = try
  2876. let t = (match !dynamic_parameter with Some t -> t | None -> (PMap.find n a.a_fields).cf_type) in
  2877. let e = type_expr ctx e (match with_type with WithTypeResume _ -> WithTypeResume t | _ -> WithType t) in
  2878. let e = Codegen.AbstractCast.cast_or_unify ctx t e p in
  2879. (try type_eq EqStrict e.etype t; e with Unify_error _ -> mk (TCast (e,None)) t e.epos)
  2880. with Not_found ->
  2881. if is_valid then
  2882. extra_fields := n :: !extra_fields;
  2883. type_expr ctx e Value
  2884. in
  2885. if is_valid then begin
  2886. if String.length n > 0 && n.[0] = '$' then error "Field names starting with a dollar are not allowed" p;
  2887. let cf = mk_field n e.etype e.epos in
  2888. fields := PMap.add n cf !fields;
  2889. end;
  2890. let e = if is_quoted then wrap_quoted_meta e else e in
  2891. (n,e)
  2892. ) fl in
  2893. let t = (TAnon { a_fields = !fields; a_status = ref Const }) in
  2894. if not ctx.untyped then begin
  2895. let unify_error l p =
  2896. match with_type with
  2897. | WithTypeResume _ -> raise (WithTypeError (l,p))
  2898. | _ -> raise (Error (Unify l,p))
  2899. in
  2900. (match PMap.foldi (fun n cf acc -> if not (Meta.has Meta.Optional cf.cf_meta) && not (PMap.mem n !fields) then n :: acc else acc) a.a_fields [] with
  2901. | [] -> ()
  2902. | [n] -> unify_error [Unify_custom ("Object requires field " ^ n)] p
  2903. | nl -> unify_error [Unify_custom ("Object requires fields: " ^ (String.concat ", " nl))] p);
  2904. (match !extra_fields with
  2905. | [] -> ()
  2906. | _ -> unify_error (List.map (fun n -> has_extra_field t n) !extra_fields) p);
  2907. end;
  2908. if !(a.a_status) <> Const then a.a_status := Closed;
  2909. mk (TObjectDecl fl) t p)
  2910. | EArrayDecl [(EFor _,_) | (EWhile _,_) as e] ->
  2911. let v = gen_local ctx (mk_mono()) in
  2912. let et = ref (EConst(Ident "null"),p) in
  2913. let rec map_compr (e,p) =
  2914. match e with
  2915. | EFor(it,e2) -> (EFor (it, map_compr e2),p)
  2916. | EWhile(cond,e2,flag) -> (EWhile (cond,map_compr e2,flag),p)
  2917. | EIf (cond,e2,None) -> (EIf (cond,map_compr e2,None),p)
  2918. | EBlock [e] -> (EBlock [map_compr e],p)
  2919. | EParenthesis e2 -> (EParenthesis (map_compr e2),p)
  2920. | EBinop(OpArrow,a,b) ->
  2921. et := (ENew({tpackage=[];tname="Map";tparams=[];tsub=None},[]),p);
  2922. (ECall ((EField ((EConst (Ident v.v_name),p),"set"),p),[a;b]),p)
  2923. | _ ->
  2924. et := (EArrayDecl [],p);
  2925. (ECall ((EField ((EConst (Ident v.v_name),p),"push"),p),[(e,p)]),p)
  2926. in
  2927. let e = map_compr e in
  2928. let ea = type_expr ctx !et with_type in
  2929. unify ctx v.v_type ea.etype p;
  2930. let efor = type_expr ctx e NoValue in
  2931. mk (TBlock [
  2932. mk (TVar (v,Some ea)) ctx.t.tvoid p;
  2933. efor;
  2934. mk (TLocal v) v.v_type p;
  2935. ]) v.v_type p
  2936. | EArrayDecl ((EBinop(OpArrow,_,_),_) as e1 :: el) ->
  2937. let (tkey,tval,has_type),resume =
  2938. let get_map_params t = match follow t with
  2939. | TAbstract({a_path=[],"Map"},[tk;tv]) -> tk,tv,true
  2940. | TInst({cl_path=["haxe";"ds"],"IntMap"},[tv]) -> ctx.t.tint,tv,true
  2941. | TInst({cl_path=["haxe";"ds"],"StringMap"},[tv]) -> ctx.t.tstring,tv,true
  2942. | TInst({cl_path=["haxe";"ds"],("ObjectMap" | "EnumValueMap")},[tk;tv]) -> tk,tv,true
  2943. | _ -> mk_mono(),mk_mono(),false
  2944. in
  2945. match with_type with
  2946. | WithType t -> get_map_params t,false
  2947. | WithTypeResume t -> get_map_params t,true
  2948. | _ -> (mk_mono(),mk_mono(),false),false
  2949. in
  2950. let keys = Hashtbl.create 0 in
  2951. let unify_with_resume ctx e t p =
  2952. if resume then try Codegen.AbstractCast.cast_or_unify_raise ctx t e p with Error (Unify l,p) -> raise (WithTypeError(l,p))
  2953. else Codegen.AbstractCast.cast_or_unify ctx t e p
  2954. in
  2955. let check_key e_key =
  2956. try
  2957. let p = Hashtbl.find keys e_key.eexpr in
  2958. display_error ctx "Duplicate key" e_key.epos;
  2959. error "Previously defined here" p
  2960. with Not_found ->
  2961. Hashtbl.add keys e_key.eexpr e_key.epos;
  2962. in
  2963. let el = e1 :: el in
  2964. let el_kv = List.map (fun e -> match fst e with
  2965. | EBinop(OpArrow,e1,e2) -> e1,e2
  2966. | _ -> error "Expected a => b" (pos e)
  2967. ) el in
  2968. let el_k,el_v,tkey,tval = if has_type then begin
  2969. let el_k,el_v = List.fold_left (fun (el_k,el_v) (e1,e2) ->
  2970. let e1 = type_expr ctx e1 (WithType tkey) in
  2971. check_key e1;
  2972. let e1 = unify_with_resume ctx e1 tkey e1.epos in
  2973. let e2 = type_expr ctx e2 (WithType tval) in
  2974. let e2 = unify_with_resume ctx e2 tval e2.epos in
  2975. (e1 :: el_k,e2 :: el_v)
  2976. ) ([],[]) el_kv in
  2977. el_k,el_v,tkey,tval
  2978. end else begin
  2979. let el_k,el_v = List.fold_left (fun (el_k,el_v) (e1,e2) ->
  2980. let e1 = type_expr ctx e1 Value in
  2981. check_key e1;
  2982. let e2 = type_expr ctx e2 Value in
  2983. (e1 :: el_k,e2 :: el_v)
  2984. ) ([],[]) el_kv in
  2985. let unify_min_resume el = try
  2986. unify_min_raise ctx el
  2987. with Error (Unify l,p) when resume ->
  2988. raise (WithTypeError(l,p))
  2989. in
  2990. let tkey = unify_min_resume el_k in
  2991. let tval = unify_min_resume el_v in
  2992. el_k,el_v,tkey,tval
  2993. end in
  2994. let m = Typeload.load_module ctx ([],"Map") null_pos in
  2995. let a,c = match m.m_types with
  2996. | (TAbstractDecl ({a_impl = Some c} as a)) :: _ -> a,c
  2997. | _ -> assert false
  2998. in
  2999. let tmap = TAbstract(a,[tkey;tval]) in
  3000. let cf = PMap.find "set" c.cl_statics in
  3001. let v = gen_local ctx tmap in
  3002. let ev = mk (TLocal v) tmap p in
  3003. let ec = type_module_type ctx (TClassDecl c) None p in
  3004. let ef = mk (TField(ec,FStatic(c,cf))) (tfun [tkey;tval] ctx.t.tvoid) p in
  3005. let el = ev :: List.map2 (fun e1 e2 -> (make_call ctx ef [ev;e1;e2] ctx.com.basic.tvoid p)) el_k el_v in
  3006. let enew = mk (TNew(c,[tkey;tval],[])) tmap p in
  3007. let el = (mk (TVar (v,Some enew)) t_dynamic p) :: (List.rev el) in
  3008. mk (TBlock el) tmap p
  3009. | EArrayDecl el ->
  3010. let tp = (match with_type with
  3011. | WithType t | WithTypeResume t ->
  3012. (match follow t with
  3013. | TInst ({ cl_path = [],"Array" },[tp]) ->
  3014. (match follow tp with
  3015. | TMono _ -> None
  3016. | _ -> Some tp)
  3017. | TAnon _ ->
  3018. (try
  3019. Some (get_iterable_param t)
  3020. with Not_found ->
  3021. None)
  3022. | t ->
  3023. if t == t_dynamic then Some t else None)
  3024. | _ ->
  3025. None
  3026. ) in
  3027. (match tp with
  3028. | None ->
  3029. let el = List.map (fun e -> type_expr ctx e Value) el in
  3030. let t = try
  3031. unify_min_raise ctx el
  3032. with Error (Unify l,p) ->
  3033. if ctx.untyped then t_dynamic else begin
  3034. display_error ctx "Arrays of mixed types are only allowed if the type is forced to Array<Dynamic>" p;
  3035. raise (Error (Unify l, p))
  3036. end
  3037. in
  3038. mk (TArrayDecl el) (ctx.t.tarray t) p
  3039. | Some t ->
  3040. let el = List.map (fun e ->
  3041. let e = type_expr ctx e (match with_type with WithTypeResume _ -> WithTypeResume t | _ -> WithType t) in
  3042. (match with_type with
  3043. | WithTypeResume _ -> (try Codegen.AbstractCast.cast_or_unify_raise ctx t e p with Error (Unify l,p) -> raise (WithTypeError (l,p)))
  3044. | _ -> Codegen.AbstractCast.cast_or_unify ctx t e p);
  3045. ) el in
  3046. mk (TArrayDecl el) (ctx.t.tarray t) p)
  3047. | EVars vl ->
  3048. type_vars ctx vl p false
  3049. | EFor (it,e2) ->
  3050. let i, pi, e1 = (match it with
  3051. | (EIn ((EConst (Ident i),pi),e),_) -> i, pi, e
  3052. | _ -> error "For expression should be 'v in expr'" (snd it)
  3053. ) in
  3054. let e1 = type_expr ctx e1 Value in
  3055. let old_loop = ctx.in_loop in
  3056. let old_locals = save_locals ctx in
  3057. ctx.in_loop <- true;
  3058. let e = (match Optimizer.optimize_for_loop ctx (i,pi) e1 e2 p with
  3059. | Some e -> e
  3060. | None ->
  3061. let t, pt = Typeload.t_iterator ctx in
  3062. let i = add_local ctx i pt in
  3063. let e1 = (match follow e1.etype with
  3064. | TMono _
  3065. | TDynamic _ ->
  3066. display_error ctx "You can't iterate on a Dynamic value, please specify Iterator or Iterable" e1.epos;
  3067. e1
  3068. | TLazy _ ->
  3069. assert false
  3070. | _ ->
  3071. (try
  3072. Codegen.AbstractCast.cast_or_unify_raise ctx t e1 p
  3073. with Error (Unify _,_) ->
  3074. let acc = build_call ctx (type_field ctx e1 "iterator" e1.epos MCall) [] Value e1.epos in
  3075. try
  3076. unify_raise ctx acc.etype t acc.epos;
  3077. acc
  3078. with Error (Unify(l),p) ->
  3079. display_error ctx "Field iterator has an invalid type" acc.epos;
  3080. display_error ctx (error_msg (Unify l)) p;
  3081. mk (TConst TNull) t_dynamic p
  3082. )
  3083. ) in
  3084. let e2 = type_expr ctx e2 NoValue in
  3085. (try Optimizer.optimize_for_loop_iterator ctx i e1 e2 p with Exit -> mk (TFor (i,e1,e2)) ctx.t.tvoid p)
  3086. ) in
  3087. ctx.in_loop <- old_loop;
  3088. old_locals();
  3089. e
  3090. | EIn _ ->
  3091. error "This expression is not allowed outside a for loop" p
  3092. | ETernary (e1,e2,e3) ->
  3093. type_expr ctx (EIf (e1,e2,Some e3),p) with_type
  3094. | EIf (e,e1,e2) ->
  3095. let e = type_expr ctx e Value in
  3096. let e = Codegen.AbstractCast.cast_or_unify ctx ctx.t.tbool e p in
  3097. let e1 = type_expr ctx e1 with_type in
  3098. (match e2 with
  3099. | None ->
  3100. mk (TIf (e,e1,None)) ctx.t.tvoid p
  3101. | Some e2 ->
  3102. let e2 = type_expr ctx e2 with_type in
  3103. let e1,e2,t = match with_type with
  3104. | NoValue -> e1,e2,ctx.t.tvoid
  3105. | Value -> e1,e2,unify_min ctx [e1; e2]
  3106. | WithType t | WithTypeResume t when (match follow t with TMono _ -> true | _ -> false) -> e1,e2,unify_min ctx [e1; e2]
  3107. | WithType t | WithTypeResume t ->
  3108. begin try
  3109. let e1 = Codegen.AbstractCast.cast_or_unify_raise ctx t e1 e1.epos in
  3110. let e2 = Codegen.AbstractCast.cast_or_unify_raise ctx t e2 e2.epos in
  3111. e1,e2,t
  3112. with Error (Unify l,p) -> match with_type with
  3113. | WithTypeResume _ -> raise (WithTypeError (l,p))
  3114. | _ ->
  3115. display_error ctx (error_msg (Unify l)) p;
  3116. e1,e2,t
  3117. end;
  3118. in
  3119. mk (TIf (e,e1,Some e2)) t p)
  3120. | EWhile (cond,e,NormalWhile) ->
  3121. let old_loop = ctx.in_loop in
  3122. let cond = type_expr ctx cond Value in
  3123. let cond = Codegen.AbstractCast.cast_or_unify ctx ctx.t.tbool cond p in
  3124. ctx.in_loop <- true;
  3125. let e = type_expr ctx e NoValue in
  3126. ctx.in_loop <- old_loop;
  3127. mk (TWhile (cond,e,NormalWhile)) ctx.t.tvoid p
  3128. | EWhile (cond,e,DoWhile) ->
  3129. let old_loop = ctx.in_loop in
  3130. ctx.in_loop <- true;
  3131. let e = type_expr ctx e NoValue in
  3132. ctx.in_loop <- old_loop;
  3133. let cond = type_expr ctx cond Value in
  3134. let cond = Codegen.AbstractCast.cast_or_unify ctx ctx.t.tbool cond cond.epos in
  3135. mk (TWhile (cond,e,DoWhile)) ctx.t.tvoid p
  3136. | ESwitch (e1,cases,def) ->
  3137. begin try
  3138. let dt = match_expr ctx e1 cases def with_type p in
  3139. let wrap e1 = if not dt.dt_is_complex then e1 else mk (TMeta((Meta.Ast,[e,p],p),e1)) e1.etype e1.epos in
  3140. wrap (Codegen.PatternMatchConversion.to_typed_ast ctx dt p)
  3141. with Exit ->
  3142. type_switch_old ctx e1 cases def with_type p
  3143. end
  3144. | EReturn e ->
  3145. begin match e with
  3146. | None ->
  3147. let v = ctx.t.tvoid in
  3148. unify ctx v ctx.ret p;
  3149. mk (TReturn None) t_dynamic p
  3150. | Some e ->
  3151. let e = type_expr ctx e (WithType ctx.ret) in
  3152. let e = Codegen.AbstractCast.cast_or_unify ctx ctx.ret e p in
  3153. begin match follow e.etype with
  3154. | TAbstract({a_path=[],"Void"},_) ->
  3155. (* if we get a Void expression (e.g. from inlining) we don't want to return it (issue #4323) *)
  3156. mk (TBlock [
  3157. e;
  3158. mk (TReturn None) t_dynamic p
  3159. ]) t_dynamic e.epos;
  3160. | _ ->
  3161. mk (TReturn (Some e)) t_dynamic p
  3162. end
  3163. end
  3164. | EBreak ->
  3165. if not ctx.in_loop then display_error ctx "Break outside loop" p;
  3166. mk TBreak t_dynamic p
  3167. | EContinue ->
  3168. if not ctx.in_loop then display_error ctx "Continue outside loop" p;
  3169. mk TContinue t_dynamic p
  3170. | ETry (e1,[]) ->
  3171. type_expr ctx e1 with_type
  3172. | ETry (e1,catches) ->
  3173. let e1 = type_expr ctx e1 with_type in
  3174. let rec check_unreachable cases t p = match cases with
  3175. | (v,e) :: cases ->
  3176. let unreachable () =
  3177. display_error ctx "This block is unreachable" p;
  3178. let st = s_type (print_context()) in
  3179. display_error ctx (Printf.sprintf "%s can be assigned to %s, which is handled here" (st t) (st v.v_type)) e.epos
  3180. in
  3181. begin try
  3182. begin match follow t,follow v.v_type with
  3183. | TDynamic _, TDynamic _ ->
  3184. unreachable()
  3185. | TDynamic _,_ ->
  3186. ()
  3187. | _ ->
  3188. Type.unify t v.v_type;
  3189. unreachable()
  3190. end
  3191. with Unify_error _ ->
  3192. check_unreachable cases t p
  3193. end
  3194. | [] ->
  3195. ()
  3196. in
  3197. let check_catch_type path params =
  3198. List.iter (fun pt ->
  3199. if pt != t_dynamic then error "Catch class parameter must be Dynamic" p;
  3200. ) params;
  3201. (match path with
  3202. | x :: _ , _ -> x
  3203. | [] , name -> name)
  3204. in
  3205. let catches = List.fold_left (fun acc (v,t,e) ->
  3206. let t = Typeload.load_complex_type ctx (pos e) t in
  3207. let rec loop t = match follow t with
  3208. | TInst ({ cl_kind = KTypeParameter _} as c,_) when not (Typeload.is_generic_parameter ctx c) ->
  3209. error "Cannot catch non-generic type parameter" p
  3210. | TInst ({ cl_path = path },params)
  3211. | TEnum ({ e_path = path },params) ->
  3212. check_catch_type path params,t
  3213. | TAbstract(a,params) when Meta.has Meta.RuntimeValue a.a_meta ->
  3214. check_catch_type a.a_path params,t
  3215. | TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) ->
  3216. loop (Abstract.get_underlying_type a tl)
  3217. | TDynamic _ -> "",t
  3218. | _ -> error "Catch type must be a class, an enum or Dynamic" (pos e)
  3219. in
  3220. let name,t2 = loop t in
  3221. if v.[0] = '$' then display_error ctx "Catch variable names starting with a dollar are not allowed" p;
  3222. check_unreachable acc t2 (pos e);
  3223. let locals = save_locals ctx in
  3224. let v = add_local ctx v t in
  3225. let e = type_expr ctx e with_type in
  3226. v.v_type <- t2;
  3227. locals();
  3228. if with_type <> NoValue then unify ctx e.etype e1.etype e.epos;
  3229. if PMap.mem name ctx.locals then error ("Local variable " ^ name ^ " is preventing usage of this type here") e.epos;
  3230. (v , e) :: acc
  3231. ) [] catches in
  3232. mk (TTry (e1,List.rev catches)) (if with_type = NoValue then ctx.t.tvoid else e1.etype) p
  3233. | EThrow e ->
  3234. let e = type_expr ctx e Value in
  3235. mk (TThrow e) (mk_mono()) p
  3236. | ECall (((EConst (Ident s),pc) as e),el) ->
  3237. (try
  3238. let en,t = (match with_type with
  3239. | WithType t | WithTypeResume t ->
  3240. (match follow t with
  3241. | TEnum (e,pl) -> e,t
  3242. | _ -> raise Exit)
  3243. | _ -> raise Exit
  3244. ) in
  3245. let old = ctx.on_error,ctx.m.curmod.m_types in
  3246. ctx.m.curmod.m_types <- ctx.m.curmod.m_types @ [(TEnumDecl en)];
  3247. let restore = fun () ->
  3248. ctx.m.curmod.m_types <- snd old;
  3249. ctx.on_error <- fst old;
  3250. in
  3251. ctx.on_error <- (fun ctx msg ep ->
  3252. (* raise Not_found only if the error is actually about the outside identifier (issue #2148) *)
  3253. if ep = pc then
  3254. raise Not_found
  3255. else begin
  3256. restore();
  3257. ctx.on_error ctx msg ep;
  3258. end
  3259. );
  3260. begin try
  3261. let e = type_call ctx e el with_type p in
  3262. restore();
  3263. e
  3264. with Not_found ->
  3265. restore();
  3266. if ctx.untyped then raise Exit; (* __js__, etc. *)
  3267. with_type_error ctx with_type (string_error s en.e_names ("Identifier '" ^ s ^ "' is not part of enum " ^ s_type_path en.e_path)) p;
  3268. mk (TConst TNull) t p
  3269. | err ->
  3270. restore();
  3271. raise err
  3272. end
  3273. with Exit ->
  3274. type_call ctx e el with_type p)
  3275. | ECall (e,el) ->
  3276. type_call ctx e el with_type p
  3277. | ENew (t,el) ->
  3278. let unify_constructor_call c params f ct = match follow ct with
  3279. | TFun (args,r) ->
  3280. (try
  3281. let el,_,_ = unify_field_call ctx (FInstance(c,params,f)) el args r p false in
  3282. el
  3283. with Error (e,p) ->
  3284. display_error ctx (error_msg e) p;
  3285. [])
  3286. | _ ->
  3287. error "Constructor is not a function" p
  3288. in
  3289. let t = if t.tparams <> [] then
  3290. follow (Typeload.load_instance ctx t p false)
  3291. else try
  3292. ctx.call_argument_stack <- el :: ctx.call_argument_stack;
  3293. let t = follow (Typeload.load_instance ctx t p true) in
  3294. ctx.call_argument_stack <- List.tl ctx.call_argument_stack;
  3295. (* Try to properly build @:generic classes here (issue #2016) *)
  3296. begin match t with
  3297. | TInst({cl_kind = KGeneric } as c,tl) -> follow (Codegen.build_generic ctx c p tl)
  3298. | _ -> t
  3299. end
  3300. with Codegen.Generic_Exception _ ->
  3301. (* Try to infer generic parameters from the argument list (issue #2044) *)
  3302. match Typeload.resolve_typedef (Typeload.load_type_def ctx p t) with
  3303. | TClassDecl ({cl_constructor = Some cf} as c) ->
  3304. let monos = List.map (fun _ -> mk_mono()) c.cl_params in
  3305. let ct, f = get_constructor ctx c monos p in
  3306. ignore (unify_constructor_call c monos f ct);
  3307. begin try
  3308. Codegen.build_generic ctx c p monos
  3309. with Codegen.Generic_Exception _ as exc ->
  3310. (* If we have an expected type, just use that (issue #3804) *)
  3311. begin match with_type with
  3312. | WithType t | WithTypeResume t ->
  3313. begin match follow t with
  3314. | TMono _ -> raise exc
  3315. | t -> t
  3316. end
  3317. | _ ->
  3318. raise exc
  3319. end
  3320. end
  3321. | mt ->
  3322. error ((s_type_path (t_infos mt).mt_path) ^ " cannot be constructed") p
  3323. in
  3324. let build_constructor_call c tl =
  3325. let ct, f = get_constructor ctx c tl p in
  3326. if (Meta.has Meta.CompilerGenerated f.cf_meta) then display_error ctx (s_type_path c.cl_path ^ " does not have a constructor") p;
  3327. if not (can_access ctx c f true || is_parent c ctx.curclass) && not ctx.untyped then display_error ctx "Cannot access private constructor" p;
  3328. (match f.cf_kind with
  3329. | Var { v_read = AccRequire (r,msg) } -> (match msg with Some msg -> error msg p | None -> error_require r p)
  3330. | _ -> ());
  3331. let el = unify_constructor_call c tl f ct in
  3332. el,f,ct
  3333. in
  3334. (match t with
  3335. | TInst ({cl_kind = KTypeParameter tl} as c,params) ->
  3336. if not (Typeload.is_generic_parameter ctx c) then error "Only generic type parameters can be constructed" p;
  3337. let el = List.map (fun e -> type_expr ctx e Value) el in
  3338. let ct = (tfun (List.map (fun e -> e.etype) el) ctx.t.tvoid) in
  3339. if not (List.exists (fun t -> match follow t with
  3340. | TAnon a ->
  3341. (try
  3342. unify ctx (PMap.find "new" a.a_fields).cf_type ct p;
  3343. true
  3344. with Not_found ->
  3345. false)
  3346. | _ -> false
  3347. ) tl) then error (s_type_path c.cl_path ^ " does not have a constructor") p;
  3348. mk (TNew (c,params,el)) t p
  3349. | TAbstract({a_impl = Some c} as a,tl) when not (Meta.has Meta.MultiType a.a_meta) ->
  3350. let el,cf,ct = build_constructor_call c tl in
  3351. let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
  3352. let e = mk (TTypeExpr (TClassDecl c)) ta p in
  3353. let e = mk (TField (e,(FStatic (c,cf)))) ct p in
  3354. make_call ctx e el t p
  3355. | TInst (c,params) | TAbstract({a_impl = Some c},params) ->
  3356. let el,_,_ = build_constructor_call c params in
  3357. mk (TNew (c,params,el)) t p
  3358. | _ ->
  3359. error (s_type (print_context()) t ^ " cannot be constructed") p)
  3360. | EUnop (op,flag,e) ->
  3361. type_unop ctx op flag e p
  3362. | EFunction (name,f) ->
  3363. let params = Typeload.type_function_params ctx f (match name with None -> "localfun" | Some n -> n) p in
  3364. if params <> [] then begin
  3365. if name = None then display_error ctx "Type parameters not supported in unnamed local functions" p;
  3366. if with_type <> NoValue then error "Type parameters are not supported for rvalue functions" p
  3367. end;
  3368. List.iter (fun tp -> if tp.tp_constraints <> [] then display_error ctx "Type parameter constraints are not supported for local functions" p) f.f_params;
  3369. let inline, v = (match name with
  3370. | None -> false, None
  3371. | Some v when ExtString.String.starts_with v "inline_" -> true, Some (String.sub v 7 (String.length v - 7))
  3372. | Some v -> false, Some v
  3373. ) in
  3374. let old_tp,old_in_loop = ctx.type_params,ctx.in_loop in
  3375. ctx.type_params <- params @ ctx.type_params;
  3376. if not inline then ctx.in_loop <- false;
  3377. let rt = Typeload.load_type_opt ctx p f.f_type in
  3378. let args = List.map (fun (s,opt,t,c) ->
  3379. let t = Typeload.load_type_opt ctx p t in
  3380. let t, c = Typeload.type_function_arg ctx t c opt p in
  3381. s , c, t
  3382. ) f.f_args in
  3383. (match with_type with
  3384. | WithType t | WithTypeResume t ->
  3385. let rec loop t =
  3386. (match follow t with
  3387. | TFun (args2,tr) when List.length args2 = List.length args ->
  3388. List.iter2 (fun (_,_,t1) (_,_,t2) ->
  3389. match follow t1 with
  3390. | TMono _ -> unify ctx t2 t1 p
  3391. | _ -> ()
  3392. ) args args2;
  3393. (* unify for top-down inference unless we are expecting Void *)
  3394. begin match follow tr,follow rt with
  3395. | TAbstract({a_path = [],"Void"},_),_ -> ()
  3396. | _,TMono _ -> unify ctx rt tr p
  3397. | _ -> ()
  3398. end
  3399. | TAbstract(a,tl) ->
  3400. loop (Abstract.get_underlying_type a tl)
  3401. | _ -> ())
  3402. in
  3403. loop t
  3404. | NoValue ->
  3405. if name = None then display_error ctx "Unnamed lvalue functions are not supported" p
  3406. | _ ->
  3407. ());
  3408. let ft = TFun (fun_args args,rt) in
  3409. let v = (match v with
  3410. | None -> None
  3411. | Some v ->
  3412. if v.[0] = '$' then display_error ctx "Variable names starting with a dollar are not allowed" p;
  3413. Some (add_local ctx v ft)
  3414. ) in
  3415. let curfun = match ctx.curfun with
  3416. | FunStatic -> FunStatic
  3417. | FunMemberAbstract -> FunMemberAbstractLocal
  3418. | _ -> FunMemberClassLocal
  3419. in
  3420. let e , fargs = Typeload.type_function ctx args rt curfun f false p in
  3421. ctx.type_params <- old_tp;
  3422. ctx.in_loop <- old_in_loop;
  3423. let f = {
  3424. tf_args = fargs;
  3425. tf_type = rt;
  3426. tf_expr = e;
  3427. } in
  3428. let e = mk (TFunction f) ft p in
  3429. (match v with
  3430. | None -> e
  3431. | Some v ->
  3432. if params <> [] || inline then v.v_extra <- Some (params,if inline then Some e else None);
  3433. let rec loop = function
  3434. | Filters.Block f | Filters.Loop f | Filters.Function f -> f loop
  3435. | Filters.Use v2 | Filters.Assign v2 when v == v2 -> raise Exit
  3436. | Filters.Use _ | Filters.Assign _ | Filters.Declare _ -> ()
  3437. in
  3438. let is_rec = (try Filters.local_usage loop e; false with Exit -> true) in
  3439. let decl = (if is_rec then begin
  3440. if inline then display_error ctx "Inline function cannot be recursive" e.epos;
  3441. let vnew = add_local ctx v.v_name ft in
  3442. mk (TVar (vnew,Some (mk (TBlock [
  3443. mk (TVar (v,Some (mk (TConst TNull) ft p))) ctx.t.tvoid p;
  3444. mk (TBinop (OpAssign,mk (TLocal v) ft p,e)) ft p;
  3445. mk (TLocal v) ft p
  3446. ]) ft p))) ctx.t.tvoid p
  3447. end else if inline then
  3448. mk (TBlock []) ctx.t.tvoid p (* do not add variable since it will be inlined *)
  3449. else
  3450. mk (TVar (v,Some e)) ctx.t.tvoid p
  3451. ) in
  3452. if with_type <> NoValue && not inline then mk (TBlock [decl;mk (TLocal v) v.v_type p]) v.v_type p else decl)
  3453. | EUntyped e ->
  3454. let old = ctx.untyped in
  3455. ctx.untyped <- true;
  3456. if not (Meta.has Meta.HasUntyped ctx.curfield.cf_meta) then ctx.curfield.cf_meta <- (Meta.HasUntyped,[],p) :: ctx.curfield.cf_meta;
  3457. let e = type_expr ctx e with_type in
  3458. ctx.untyped <- old;
  3459. {
  3460. eexpr = e.eexpr;
  3461. etype = mk_mono();
  3462. epos = e.epos;
  3463. }
  3464. | ECast (e,None) ->
  3465. let e = type_expr ctx e Value in
  3466. mk (TCast (e,None)) (mk_mono()) p
  3467. | ECast (e, Some t) ->
  3468. let t = Typeload.load_complex_type ctx (pos e) t in
  3469. let rec loop t = match follow t with
  3470. | TInst (_,params) | TEnum (_,params) ->
  3471. List.iter (fun pt ->
  3472. if follow pt != t_dynamic then error "Cast type parameters must be Dynamic" p;
  3473. ) params;
  3474. (match follow t with
  3475. | TInst (c,_) ->
  3476. (match c.cl_kind with KTypeParameter _ -> error "Can't cast to a type parameter" p | _ -> ());
  3477. TClassDecl c
  3478. | TEnum (e,_) -> TEnumDecl e
  3479. | _ -> assert false);
  3480. | TAbstract (a,params) when Meta.has Meta.RuntimeValue a.a_meta ->
  3481. List.iter (fun pt ->
  3482. if follow pt != t_dynamic then error "Cast type parameters must be Dynamic" p;
  3483. ) params;
  3484. TAbstractDecl a
  3485. | TAbstract (a,params) ->
  3486. loop (Abstract.get_underlying_type a params)
  3487. | _ ->
  3488. error "Cast type must be a class or an enum" p
  3489. in
  3490. let texpr = loop t in
  3491. mk (TCast (type_expr ctx e Value,Some texpr)) t p
  3492. | EDisplay (e,iscall) ->
  3493. handle_display ctx e iscall with_type p
  3494. | EDisplayNew t ->
  3495. let t = Typeload.load_instance ctx t p true in
  3496. (match follow t with
  3497. | TInst (c,params) | TAbstract({a_impl = Some c},params) ->
  3498. let ct, f = get_constructor ctx c params p in
  3499. raise (DisplayTypes (ct :: List.map (fun f -> f.cf_type) f.cf_overloads))
  3500. | _ ->
  3501. error "Not a class" p)
  3502. | ECheckType (e,t) ->
  3503. let t = Typeload.load_complex_type ctx p t in
  3504. let e = type_expr ctx e (WithType t) in
  3505. let e = Codegen.AbstractCast.cast_or_unify ctx t e p in
  3506. if e.etype == t then e else mk (TCast (e,None)) t p
  3507. | EMeta (m,e1) ->
  3508. let old = ctx.meta in
  3509. ctx.meta <- m :: ctx.meta;
  3510. let e () = type_expr ctx e1 with_type in
  3511. let e = match m with
  3512. | (Meta.ToString,_,_) ->
  3513. let e = e() in
  3514. (match follow e.etype with
  3515. | TAbstract({a_impl = Some c},_) when PMap.mem "toString" c.cl_statics -> call_to_string ctx c e
  3516. | _ -> e)
  3517. | (Meta.This,_,_) ->
  3518. let e = List.hd ctx.this_stack in
  3519. let rec loop e = match e.eexpr with
  3520. | TConst TThis -> get_this ctx e.epos
  3521. | _ -> Type.map_expr loop e
  3522. in
  3523. loop e
  3524. | (Meta.Analyzer,_,_) ->
  3525. let e = e() in
  3526. {e with eexpr = TMeta(m,e)}
  3527. | (Meta.MergeBlock,_,_) ->
  3528. begin match fst e1 with
  3529. | EBlock el -> type_block ctx el with_type p
  3530. | _ -> e()
  3531. end
  3532. | (Meta.StoredTypedExpr,_,_) ->
  3533. let id = match e1 with (EConst (Int s),_) -> int_of_string s | _ -> assert false in
  3534. get_stored_typed_expr ctx.com id
  3535. | (Meta.NoPrivateAccess,_,_) ->
  3536. ctx.meta <- List.filter (fun(m,_,_) -> m <> Meta.PrivateAccess) ctx.meta;
  3537. e()
  3538. | _ -> e()
  3539. in
  3540. ctx.meta <- old;
  3541. e
  3542. and get_next_stored_typed_expr_id =
  3543. let uid = ref 0 in
  3544. (fun() -> incr uid; !uid)
  3545. and get_stored_typed_expr com id =
  3546. let vars = Hashtbl.create 0 in
  3547. let copy_var v =
  3548. let v2 = alloc_var v.v_name v.v_type in
  3549. v2.v_meta <- v.v_meta;
  3550. Hashtbl.add vars v.v_id v2;
  3551. v2;
  3552. in
  3553. let rec build_expr e =
  3554. match e.eexpr with
  3555. | TVar (v,eo) ->
  3556. let v2 = copy_var v in
  3557. {e with eexpr = TVar(v2, Option.map build_expr eo)}
  3558. | TFor (v,e1,e2) ->
  3559. let v2 = copy_var v in
  3560. {e with eexpr = TFor(v2, build_expr e1, build_expr e2)}
  3561. | TTry (e1,cl) ->
  3562. let cl = List.map (fun (v,e) ->
  3563. let v2 = copy_var v in
  3564. v2, build_expr e
  3565. ) cl in
  3566. {e with eexpr = TTry(build_expr e1, cl)}
  3567. | TFunction f ->
  3568. let args = List.map (fun (v,c) -> copy_var v, c) f.tf_args in
  3569. let f = {
  3570. tf_args = args;
  3571. tf_type = f.tf_type;
  3572. tf_expr = build_expr f.tf_expr;
  3573. } in
  3574. {e with eexpr = TFunction f}
  3575. | TLocal v ->
  3576. (try
  3577. let v2 = Hashtbl.find vars v.v_id in
  3578. {e with eexpr = TLocal v2}
  3579. with _ ->
  3580. e)
  3581. | _ ->
  3582. map_expr build_expr e
  3583. in
  3584. let e = PMap.find id com.stored_typed_exprs in
  3585. build_expr e
  3586. and handle_display ctx e_ast iscall with_type p =
  3587. let old = ctx.in_display in
  3588. ctx.in_display <- true;
  3589. let get_submodule_fields path =
  3590. let m = Hashtbl.find ctx.g.modules path in
  3591. let tl = List.filter (fun t -> path <> (t_infos t).mt_path && not (t_infos t).mt_private) m.m_types in
  3592. let tl = List.map (fun mt ->
  3593. let infos = t_infos mt in
  3594. (snd infos.mt_path),type_of_module_type mt,Some FKType,infos.mt_doc
  3595. ) tl in
  3596. tl
  3597. in
  3598. let e = try
  3599. type_expr ctx e_ast Value
  3600. with Error (Unknown_ident n,_) when not iscall ->
  3601. raise (Parser.TypePath ([n],None,false))
  3602. | Error (Unknown_ident "trace",_) ->
  3603. raise (DisplayTypes [tfun [t_dynamic] ctx.com.basic.tvoid])
  3604. | Error (Type_not_found (path,_),_) as err ->
  3605. begin try
  3606. raise (DisplayFields (get_submodule_fields path))
  3607. with Not_found ->
  3608. raise err
  3609. end
  3610. in
  3611. ctx.in_display <- old;
  3612. let handle_field cf =
  3613. if ctx.com.display = DMPosition then
  3614. raise (DisplayPosition [cf.cf_pos]);
  3615. cf.cf_meta <- (Meta.Usage,[],p) :: cf.cf_meta;
  3616. in
  3617. match ctx.com.display with
  3618. | DMResolve _ ->
  3619. assert false
  3620. | DMType ->
  3621. raise (DisplayTypes [e.etype])
  3622. | DMUsage | DMPosition ->
  3623. begin match e.eexpr with
  3624. | TField(_,FEnum(_,ef)) ->
  3625. if ctx.com.display = DMPosition then
  3626. raise (DisplayPosition [ef.ef_pos]);
  3627. ef.ef_meta <- (Meta.Usage,[],p) :: ef.ef_meta;
  3628. | TField(_,(FAnon cf | FInstance (_,_,cf) | FStatic (_,cf) | FClosure (_,cf))) ->
  3629. handle_field cf;
  3630. | TLocal v ->
  3631. v.v_meta <- (Meta.Usage,[],p) :: v.v_meta;
  3632. | TTypeExpr mt ->
  3633. let ti = t_infos mt in
  3634. if ctx.com.display = DMPosition then
  3635. raise (DisplayPosition [ti.mt_pos]);
  3636. ti.mt_meta <- (Meta.Usage,[],p) :: ti.mt_meta;
  3637. | TNew(c,tl,_) ->
  3638. begin try
  3639. let _,cf = get_constructor ctx c tl p in
  3640. handle_field cf;
  3641. with Not_found ->
  3642. ()
  3643. end
  3644. | _ ->
  3645. ()
  3646. end;
  3647. e
  3648. | DMToplevel ->
  3649. collect_toplevel_identifiers ctx;
  3650. | DMDefault | DMNone ->
  3651. let opt_args args ret = TFun(List.map(fun (n,o,t) -> n,true,t) args,ret) in
  3652. let e = match e.eexpr with
  3653. | TField (e1,fa) ->
  3654. if field_name fa = "bind" then (match follow e1.etype with
  3655. | TFun(args,ret) -> {e1 with etype = opt_args args ret}
  3656. | _ -> e)
  3657. else
  3658. e
  3659. | _ ->
  3660. e
  3661. in
  3662. let opt_type t =
  3663. match t with
  3664. | TLazy f ->
  3665. Typeload.return_partial_type := true;
  3666. let t = (!f)() in
  3667. Typeload.return_partial_type := false;
  3668. t
  3669. | _ ->
  3670. t
  3671. in
  3672. let merge_core_doc c =
  3673. let c_core = Typeload.load_core_class ctx c in
  3674. if c.cl_doc = None then c.cl_doc <- c_core.cl_doc;
  3675. let maybe_merge cf_map cf =
  3676. if cf.cf_doc = None then try cf.cf_doc <- (PMap.find cf.cf_name cf_map).cf_doc with Not_found -> ()
  3677. in
  3678. List.iter (maybe_merge c_core.cl_fields) c.cl_ordered_fields;
  3679. List.iter (maybe_merge c_core.cl_statics) c.cl_ordered_statics;
  3680. match c.cl_constructor,c_core.cl_constructor with
  3681. | Some ({cf_doc = None} as cf),Some cf2 -> cf.cf_doc <- cf2.cf_doc
  3682. | _ -> ()
  3683. in
  3684. let rec get_fields t =
  3685. match follow t with
  3686. | TInst (c,params) ->
  3687. if Meta.has Meta.CoreApi c.cl_meta then merge_core_doc c;
  3688. let priv = is_parent c ctx.curclass in
  3689. let merge ?(cond=(fun _ -> true)) a b =
  3690. PMap.foldi (fun k f m -> if cond f then PMap.add k f m else m) a b
  3691. in
  3692. let rec loop c params =
  3693. let m = List.fold_left (fun m (i,params) ->
  3694. merge m (loop i params)
  3695. ) PMap.empty c.cl_implements in
  3696. let m = (match c.cl_super with
  3697. | None -> m
  3698. | Some (csup,cparams) -> merge m (loop csup cparams)
  3699. ) in
  3700. let m = merge ~cond:(fun f -> priv || can_access ctx c f false) c.cl_fields m in
  3701. let m = (match c.cl_kind with
  3702. | KTypeParameter pl -> List.fold_left (fun acc t -> merge acc (get_fields t)) m pl
  3703. | _ -> m
  3704. ) in
  3705. PMap.map (fun f -> { f with cf_type = apply_params c.cl_params params (opt_type f.cf_type); cf_public = true; }) m
  3706. in
  3707. loop c params
  3708. | TAbstract({a_impl = Some c} as a,pl) ->
  3709. if Meta.has Meta.CoreApi c.cl_meta then merge_core_doc c;
  3710. ctx.m.module_using <- c :: ctx.m.module_using;
  3711. let fields = try
  3712. let _,el,_ = Meta.get Meta.Forward a.a_meta in
  3713. let sl = ExtList.List.filter_map (fun e -> match fst e with
  3714. | EConst(Ident s) -> Some s
  3715. | _ -> None
  3716. ) el in
  3717. let fields = get_fields (apply_params a.a_params pl a.a_this) in
  3718. if sl = [] then fields else PMap.fold (fun cf acc ->
  3719. if List.mem cf.cf_name sl then
  3720. PMap.add cf.cf_name cf acc
  3721. else
  3722. acc
  3723. ) fields PMap.empty
  3724. with Not_found ->
  3725. PMap.empty
  3726. in
  3727. PMap.fold (fun f acc ->
  3728. if f.cf_name <> "_new" && can_access ctx c f true && Meta.has Meta.Impl f.cf_meta && not (Meta.has Meta.Enum f.cf_meta) then begin
  3729. let f = prepare_using_field f in
  3730. let t = apply_params a.a_params pl (follow f.cf_type) in
  3731. PMap.add f.cf_name { f with cf_public = true; cf_type = opt_type t } acc
  3732. end else
  3733. acc
  3734. ) c.cl_statics fields
  3735. | TAnon a when PMap.is_empty a.a_fields ->
  3736. begin match with_type with
  3737. | WithType t | WithTypeResume t -> get_fields t
  3738. | _ -> a.a_fields
  3739. end
  3740. | TAnon a ->
  3741. (match !(a.a_status) with
  3742. | Statics c ->
  3743. if Meta.has Meta.CoreApi c.cl_meta then merge_core_doc c;
  3744. let is_abstract_impl = match c.cl_kind with KAbstractImpl _ -> true | _ -> false in
  3745. let pm = match c.cl_constructor with None -> PMap.empty | Some cf -> PMap.add "new" cf PMap.empty in
  3746. PMap.fold (fun f acc ->
  3747. if can_access ctx c f true && (not is_abstract_impl || not (Meta.has Meta.Impl f.cf_meta) || Meta.has Meta.Enum f.cf_meta) then
  3748. PMap.add f.cf_name { f with cf_public = true; cf_type = opt_type f.cf_type } acc else acc
  3749. ) a.a_fields pm
  3750. | _ ->
  3751. a.a_fields)
  3752. | TFun (args,ret) ->
  3753. let t = opt_args args ret in
  3754. let cf = mk_field "bind" (tfun [t] t) p in
  3755. PMap.add "bind" cf PMap.empty
  3756. | _ ->
  3757. PMap.empty
  3758. in
  3759. let fields = get_fields e.etype in
  3760. (*
  3761. add 'using' methods compatible with this type
  3762. *)
  3763. let rec loop acc = function
  3764. | [] -> acc
  3765. | c :: l ->
  3766. let acc = ref (loop acc l) in
  3767. let rec dup t = Type.map dup t in
  3768. List.iter (fun f ->
  3769. if not (Meta.has Meta.NoUsing f.cf_meta) then
  3770. let f = { f with cf_type = opt_type f.cf_type } in
  3771. let monos = List.map (fun _ -> mk_mono()) f.cf_params in
  3772. let map = apply_params f.cf_params monos in
  3773. match follow (map f.cf_type) with
  3774. | TFun((_,_,TType({t_path=["haxe";"macro"], "ExprOf"}, [t])) :: args, ret)
  3775. | TFun((_,_,t) :: args, ret) ->
  3776. (try
  3777. unify_raise ctx (dup e.etype) t e.epos;
  3778. List.iter2 (fun m (name,t) -> match follow t with
  3779. | TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] ->
  3780. List.iter (fun tc -> unify_raise ctx m (map tc) e.epos) constr
  3781. | _ -> ()
  3782. ) monos f.cf_params;
  3783. if not (can_access ctx c f true) || follow e.etype == t_dynamic && follow t != t_dynamic then
  3784. ()
  3785. else begin
  3786. let f = prepare_using_field f in
  3787. let f = { f with cf_params = []; cf_public = true; cf_type = TFun(args,ret) } in
  3788. acc := PMap.add f.cf_name f (!acc)
  3789. end
  3790. with Error (Unify _,_) -> ())
  3791. | _ -> ()
  3792. ) c.cl_ordered_statics;
  3793. !acc
  3794. in
  3795. let use_methods = match follow e.etype with TMono _ -> PMap.empty | _ -> loop (loop PMap.empty ctx.g.global_using) ctx.m.module_using in
  3796. let fields = PMap.fold (fun f acc -> PMap.add f.cf_name f acc) fields use_methods in
  3797. let fields = match fst e_ast with
  3798. | EConst(String s) when String.length s = 1 ->
  3799. let cf = mk_field "code" ctx.t.tint e.epos in
  3800. cf.cf_doc <- Some "The character code of this character (inlined at compile-time).";
  3801. cf.cf_kind <- Var { v_read = AccNormal; v_write = AccNever };
  3802. PMap.add cf.cf_name cf fields
  3803. | _ ->
  3804. fields
  3805. in
  3806. let fields = PMap.fold (fun f acc -> if Meta.has Meta.NoCompletion f.cf_meta then acc else f :: acc) fields [] in
  3807. let t = if iscall then
  3808. let rec loop t = match follow t with
  3809. | TFun _ -> t
  3810. | TAbstract(a,tl) when Meta.has Meta.Callable a.a_meta -> loop (Abstract.get_underlying_type a tl)
  3811. | _ -> t_dynamic
  3812. in
  3813. loop e.etype
  3814. else
  3815. let get_field acc f =
  3816. List.fold_left (fun acc f ->
  3817. let kind = match f.cf_kind with Method _ -> FKMethod | Var _ -> FKVar in
  3818. if f.cf_public then (f.cf_name,f.cf_type,Some kind,f.cf_doc) :: acc else acc
  3819. ) acc (f :: f.cf_overloads)
  3820. in
  3821. let fields = List.fold_left get_field [] fields in
  3822. let fields = try
  3823. let sl = string_list_of_expr_path_raise e_ast in
  3824. fields @ get_submodule_fields (List.tl sl,List.hd sl)
  3825. with Exit | Not_found ->
  3826. fields
  3827. in
  3828. if fields = [] then
  3829. e.etype
  3830. else
  3831. raise (DisplayFields fields)
  3832. in
  3833. (match follow t with
  3834. | TMono _ | TDynamic _ when ctx.in_macro -> mk (TConst TNull) t p
  3835. | _ -> raise (DisplayTypes [t]))
  3836. and type_call ctx e el (with_type:with_type) p =
  3837. let def () = (match e with
  3838. | EField ((EConst (Ident "super"),_),_) , _ -> ctx.in_super_call <- true
  3839. | _ -> ());
  3840. build_call ctx (type_access ctx (fst e) (snd e) MCall) el with_type p
  3841. in
  3842. match e, el with
  3843. | (EConst (Ident "trace"),p) , e :: el ->
  3844. if Common.defined ctx.com Define.NoTraces then
  3845. null ctx.t.tvoid p
  3846. else
  3847. let params = (match el with [] -> [] | _ -> ["customParams",(EArrayDecl el , p)]) in
  3848. let infos = mk_infos ctx p params in
  3849. if (platform ctx.com Js || platform ctx.com Python) && el = [] && has_dce ctx.com then
  3850. let e = type_expr ctx e Value in
  3851. let infos = type_expr ctx infos Value in
  3852. let e = match follow e.etype with
  3853. | TAbstract({a_impl = Some c},_) when PMap.mem "toString" c.cl_statics ->
  3854. call_to_string ctx c e
  3855. | _ ->
  3856. e
  3857. in
  3858. let v_trace = alloc_unbound_var "`trace" t_dynamic in
  3859. mk (TCall (mk (TLocal v_trace) t_dynamic p,[e;infos])) ctx.t.tvoid p
  3860. else
  3861. let me = Meta.ToString,[],pos e in
  3862. type_expr ctx (ECall ((EField ((EField ((EConst (Ident "haxe"),p),"Log"),p),"trace"),p),[(EMeta (me,e),pos e);infos]),p) NoValue
  3863. | (EConst(Ident "callback"),p1),args ->
  3864. let ecb = try Some (type_ident_raise ctx "callback" p1 MCall) with Not_found -> None in
  3865. (match ecb with
  3866. | Some ecb ->
  3867. build_call ctx ecb args with_type p
  3868. | None ->
  3869. display_error ctx "callback syntax has changed to func.bind(args)" p;
  3870. let e = type_expr ctx e Value in
  3871. type_bind ctx e args p)
  3872. | (EField ((EConst (Ident "super"),_),_),_), _ ->
  3873. def()
  3874. | (EField (e,"bind"),p), args ->
  3875. let e = type_expr ctx e Value in
  3876. (match follow e.etype with
  3877. | TFun _ -> type_bind ctx e args p
  3878. | _ -> def ())
  3879. | (EConst (Ident "$type"),_) , [e] ->
  3880. let e = type_expr ctx e Value in
  3881. ctx.com.warning (s_type (print_context()) e.etype) e.epos;
  3882. e
  3883. | (EField(e,"match"),p), [epat] ->
  3884. let et = type_expr ctx e Value in
  3885. (match follow et.etype with
  3886. | TEnum _ as t ->
  3887. let e = match_expr ctx e [[epat],None,Some (EConst(Ident "true"),p)] (Some (Some (EConst(Ident "false"),p))) (WithType ctx.t.tbool) p in
  3888. let locals = !get_pattern_locals_ref ctx epat t in
  3889. PMap.iter (fun _ (_,p) -> display_error ctx "Capture variables are not allowed" p) locals;
  3890. Codegen.PatternMatchConversion.to_typed_ast ctx e p
  3891. | _ -> def ())
  3892. | (EConst (Ident "__unprotect__"),_) , [(EConst (String _),_) as e] ->
  3893. let e = type_expr ctx e Value in
  3894. if Common.platform ctx.com Flash then
  3895. let t = tfun [e.etype] e.etype in
  3896. let v_unprotect = alloc_unbound_var "__unprotect__" t in
  3897. mk (TCall (mk (TLocal v_unprotect) t p,[e])) e.etype e.epos
  3898. else
  3899. e
  3900. | (EConst (Ident "super"),sp) , el ->
  3901. if ctx.curfun <> FunConstructor then error "Cannot call super constructor outside class constructor" p;
  3902. let el, t = (match ctx.curclass.cl_super with
  3903. | None -> error "Current class does not have a super" p
  3904. | Some (c,params) ->
  3905. let ct, f = get_constructor ctx c params p in
  3906. if (Meta.has Meta.CompilerGenerated f.cf_meta) then display_error ctx (s_type_path c.cl_path ^ " does not have a constructor") p;
  3907. let el = (match follow ct with
  3908. | TFun (args,r) ->
  3909. let el,_,_ = unify_field_call ctx (FInstance(c,params,f)) el args r p false in
  3910. el
  3911. | _ ->
  3912. error "Constructor is not a function" p
  3913. ) in
  3914. el , TInst (c,params)
  3915. ) in
  3916. mk (TCall (mk (TConst TSuper) t sp,el)) ctx.t.tvoid p
  3917. | _ ->
  3918. def ()
  3919. and build_call ctx acc el (with_type:with_type) p =
  3920. match acc with
  3921. | AKInline (ethis,f,fmode,t) when Meta.has Meta.Generic f.cf_meta ->
  3922. type_generic_function ctx (ethis,fmode) el with_type p
  3923. | AKInline (ethis,f,fmode,t) ->
  3924. (match follow t with
  3925. | TFun (args,r) ->
  3926. let _,_,mk_call = unify_field_call ctx fmode el args r p true in
  3927. mk_call ethis p
  3928. | _ ->
  3929. error (s_type (print_context()) t ^ " cannot be called") p
  3930. )
  3931. | AKUsing (et,cl,ef,eparam) when Meta.has Meta.Generic ef.cf_meta ->
  3932. (match et.eexpr with
  3933. | TField(ec,fa) ->
  3934. type_generic_function ctx (ec,fa) el ~using_param:(Some eparam) with_type p
  3935. | _ -> assert false)
  3936. | AKUsing (et,cl,ef,eparam) ->
  3937. begin match ef.cf_kind with
  3938. | Method MethMacro ->
  3939. let ethis = type_module_type ctx (TClassDecl cl) None p in
  3940. let eparam,f = Codegen.push_this ctx eparam in
  3941. let e = build_call ctx (AKMacro (ethis,ef)) (eparam :: el) with_type p in
  3942. f();
  3943. e
  3944. | _ ->
  3945. let t = follow (field_type ctx cl [] ef p) in
  3946. (* for abstracts we have to apply their parameters to the static function *)
  3947. let t,tthis = match follow eparam.etype with
  3948. | TAbstract(a,tl) when Meta.has Meta.Impl ef.cf_meta -> apply_params a.a_params tl t,apply_params a.a_params tl a.a_this
  3949. | te -> t,te
  3950. in
  3951. let params,args,r,eparam = match t with
  3952. | TFun ((_,_,t1) :: args,r) ->
  3953. unify ctx tthis t1 eparam.epos;
  3954. let ef = prepare_using_field ef in
  3955. begin match unify_call_args ctx el args r p (ef.cf_kind = Method MethInline) (is_forced_inline (Some cl) ef) with
  3956. | el,TFun(args,r) -> el,args,r,eparam
  3957. | _ -> assert false
  3958. end
  3959. | _ -> assert false
  3960. in
  3961. make_call ctx et (eparam :: params) r p
  3962. end
  3963. | AKMacro (ethis,cf) ->
  3964. if ctx.macro_depth > 300 then error "Stack overflow" p;
  3965. ctx.macro_depth <- ctx.macro_depth + 1;
  3966. ctx.with_type_stack <- with_type :: ctx.with_type_stack;
  3967. let ethis_f = ref (fun () -> ()) in
  3968. let f = (match ethis.eexpr with
  3969. | TTypeExpr (TClassDecl c) ->
  3970. (match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name el p with
  3971. | None -> (fun() -> type_expr ctx (EConst (Ident "null"),p) Value)
  3972. | Some (EMeta((Meta.MergeBlock,_,_),(EBlock el,_)),_) -> (fun () -> let e = type_block ctx el with_type p in mk (TMeta((Meta.MergeBlock,[],p), e)) e.etype e.epos)
  3973. | Some (EVars vl,p) -> (fun() -> type_vars ctx vl p true)
  3974. | Some e -> (fun() -> type_expr ctx e with_type))
  3975. | _ ->
  3976. (* member-macro call : since we will make a static call, let's found the actual class and not its subclass *)
  3977. (match follow ethis.etype with
  3978. | TInst (c,_) ->
  3979. let rec loop c =
  3980. if PMap.mem cf.cf_name c.cl_fields then
  3981. let eparam,f = Codegen.push_this ctx ethis in
  3982. ethis_f := f;
  3983. let e = match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name (eparam :: el) p with
  3984. | None -> (fun() -> type_expr ctx (EConst (Ident "null"),p) Value)
  3985. | Some e -> (fun() -> type_expr ctx e Value)
  3986. in
  3987. e
  3988. else
  3989. match c.cl_super with
  3990. | None -> assert false
  3991. | Some (csup,_) -> loop csup
  3992. in
  3993. loop c
  3994. | _ -> assert false))
  3995. in
  3996. ctx.macro_depth <- ctx.macro_depth - 1;
  3997. ctx.with_type_stack <- List.tl ctx.with_type_stack;
  3998. let old = ctx.on_error in
  3999. ctx.on_error <- (fun ctx msg ep ->
  4000. (* display additional info in the case the error is not part of our original call *)
  4001. if ep.pfile <> p.pfile || ep.pmax < p.pmin || ep.pmin > p.pmax then begin
  4002. Typeload.locate_macro_error := false;
  4003. old ctx msg ep;
  4004. Typeload.locate_macro_error := true;
  4005. ctx.com.error "Called from macro here" p;
  4006. end else
  4007. old ctx msg ep;
  4008. );
  4009. let e = try
  4010. f()
  4011. with Error (m,p) ->
  4012. ctx.on_error <- old;
  4013. !ethis_f();
  4014. raise (Fatal_error ((error_msg m),p))
  4015. in
  4016. ctx.on_error <- old;
  4017. !ethis_f();
  4018. e
  4019. | AKNo _ | AKSet _ | AKAccess _ ->
  4020. ignore(acc_get ctx acc p);
  4021. assert false
  4022. | AKExpr e ->
  4023. let rec loop t = match follow t with
  4024. | TFun (args,r) ->
  4025. begin match e.eexpr with
  4026. | TField(e1,fa) when not (match fa with FEnum _ -> true | _ -> false) ->
  4027. begin match fa with
  4028. | FInstance(_,_,cf) | FStatic(_,cf) when Meta.has Meta.Generic cf.cf_meta ->
  4029. type_generic_function ctx (e1,fa) el with_type p
  4030. | _ ->
  4031. let _,_,mk_call = unify_field_call ctx fa el args r p false in
  4032. mk_call e1 e.epos
  4033. end
  4034. | _ ->
  4035. let el, tfunc = unify_call_args ctx el args r p false false in
  4036. let r = match tfunc with TFun(_,r) -> r | _ -> assert false in
  4037. mk (TCall ({e with etype = tfunc},el)) r p
  4038. end
  4039. | TAbstract(a,tl) when Meta.has Meta.Callable a.a_meta ->
  4040. loop (Abstract.get_underlying_type a tl)
  4041. | TMono _ ->
  4042. let t = mk_mono() in
  4043. let el = List.map (fun e -> type_expr ctx e Value) el in
  4044. unify ctx (tfun (List.map (fun e -> e.etype) el) t) e.etype e.epos;
  4045. mk (TCall (e,el)) t p
  4046. | t ->
  4047. let el = List.map (fun e -> type_expr ctx e Value) el in
  4048. let t = if t == t_dynamic then
  4049. t_dynamic
  4050. else if ctx.untyped then
  4051. mk_mono()
  4052. else
  4053. error (s_type (print_context()) e.etype ^ " cannot be called") e.epos
  4054. in
  4055. mk (TCall (e,el)) t p
  4056. in
  4057. loop e.etype
  4058. (* ---------------------------------------------------------------------- *)
  4059. (* FINALIZATION *)
  4060. let get_main ctx =
  4061. match ctx.com.main_class with
  4062. | None -> None
  4063. | Some cl ->
  4064. let t = Typeload.load_type_def ctx null_pos { tpackage = fst cl; tname = snd cl; tparams = []; tsub = None } in
  4065. let fmode, ft, r = (match t with
  4066. | TEnumDecl _ | TTypeDecl _ | TAbstractDecl _ ->
  4067. error ("Invalid -main : " ^ s_type_path cl ^ " is not a class") null_pos
  4068. | TClassDecl c ->
  4069. try
  4070. let f = PMap.find "main" c.cl_statics in
  4071. let t = Type.field_type f in
  4072. (match follow t with
  4073. | TFun ([],r) -> FStatic (c,f), t, r
  4074. | _ -> error ("Invalid -main : " ^ s_type_path cl ^ " has invalid main function") c.cl_pos);
  4075. with
  4076. Not_found -> error ("Invalid -main : " ^ s_type_path cl ^ " does not have static function main") c.cl_pos
  4077. ) in
  4078. let emain = type_type ctx cl null_pos in
  4079. Some (mk (TCall (mk (TField (emain,fmode)) ft null_pos,[])) r null_pos)
  4080. let finalize ctx =
  4081. flush_pass ctx PFinal "final"
  4082. type state =
  4083. | Generating
  4084. | Done
  4085. | NotYet
  4086. let generate ctx =
  4087. let types = ref [] in
  4088. let states = Hashtbl.create 0 in
  4089. let state p = try Hashtbl.find states p with Not_found -> NotYet in
  4090. let statics = ref PMap.empty in
  4091. let rec loop t =
  4092. let p = t_path t in
  4093. match state p with
  4094. | Done -> ()
  4095. | Generating ->
  4096. ctx.com.warning ("Warning : maybe loop in static generation of " ^ s_type_path p) (t_infos t).mt_pos;
  4097. | NotYet ->
  4098. Hashtbl.add states p Generating;
  4099. let t = (match t with
  4100. | TClassDecl c ->
  4101. walk_class p c;
  4102. t
  4103. | TEnumDecl _ | TTypeDecl _ | TAbstractDecl _ ->
  4104. t
  4105. ) in
  4106. Hashtbl.replace states p Done;
  4107. types := t :: !types
  4108. and loop_class p c =
  4109. if c.cl_path <> p then loop (TClassDecl c)
  4110. and loop_enum p e =
  4111. if e.e_path <> p then loop (TEnumDecl e)
  4112. and loop_abstract p a =
  4113. if a.a_path <> p then loop (TAbstractDecl a)
  4114. and walk_static_field p c cf =
  4115. match cf.cf_expr with
  4116. | None -> ()
  4117. | Some e ->
  4118. if PMap.mem (c.cl_path,cf.cf_name) (!statics) then
  4119. ()
  4120. else begin
  4121. statics := PMap.add (c.cl_path,cf.cf_name) () (!statics);
  4122. walk_expr p e;
  4123. end
  4124. and walk_expr p e =
  4125. match e.eexpr with
  4126. | TTypeExpr t ->
  4127. (match t with
  4128. | TClassDecl c -> loop_class p c
  4129. | TEnumDecl e -> loop_enum p e
  4130. | TAbstractDecl a -> loop_abstract p a
  4131. | TTypeDecl _ -> assert false)
  4132. | TNew (c,_,_) ->
  4133. iter (walk_expr p) e;
  4134. loop_class p c;
  4135. let rec loop c =
  4136. if PMap.mem (c.cl_path,"new") (!statics) then
  4137. ()
  4138. else begin
  4139. statics := PMap.add (c.cl_path,"new") () !statics;
  4140. (match c.cl_constructor with
  4141. | Some { cf_expr = Some e } -> walk_expr p e
  4142. | _ -> ());
  4143. match c.cl_super with
  4144. | None -> ()
  4145. | Some (csup,_) -> loop csup
  4146. end
  4147. in
  4148. loop c
  4149. | TField(e1,FStatic(c,cf)) ->
  4150. walk_expr p e1;
  4151. walk_static_field p c cf;
  4152. | _ ->
  4153. iter (walk_expr p) e
  4154. and walk_class p c =
  4155. (match c.cl_super with None -> () | Some (c,_) -> loop_class p c);
  4156. List.iter (fun (c,_) -> loop_class p c) c.cl_implements;
  4157. (match c.cl_init with
  4158. | None -> ()
  4159. | Some e -> walk_expr p e);
  4160. PMap.iter (fun _ f ->
  4161. match f.cf_expr with
  4162. | None -> ()
  4163. | Some e ->
  4164. match e.eexpr with
  4165. | TFunction _ -> ()
  4166. | _ -> walk_expr p e
  4167. ) c.cl_statics
  4168. in
  4169. let sorted_modules = List.sort (fun m1 m2 -> compare m1.m_path m2.m_path) (Hashtbl.fold (fun _ m acc -> m :: acc) ctx.g.modules []) in
  4170. List.iter (fun m -> List.iter loop m.m_types) sorted_modules;
  4171. get_main ctx, List.rev !types, sorted_modules
  4172. (* ---------------------------------------------------------------------- *)
  4173. (* MACROS *)
  4174. let macro_enable_cache = ref false
  4175. let macro_interp_cache = ref None
  4176. let delayed_macro_result = ref ((fun() -> assert false) : unit -> unit -> Interp.value)
  4177. let get_type_patch ctx t sub =
  4178. let new_patch() =
  4179. { tp_type = None; tp_remove = false; tp_meta = [] }
  4180. in
  4181. let path = Ast.parse_path t in
  4182. let h, tp = (try
  4183. Hashtbl.find ctx.g.type_patches path
  4184. with Not_found ->
  4185. let h = Hashtbl.create 0 in
  4186. let tp = new_patch() in
  4187. Hashtbl.add ctx.g.type_patches path (h,tp);
  4188. h, tp
  4189. ) in
  4190. match sub with
  4191. | None -> tp
  4192. | Some k ->
  4193. try
  4194. Hashtbl.find h k
  4195. with Not_found ->
  4196. let tp = new_patch() in
  4197. Hashtbl.add h k tp;
  4198. tp
  4199. let macro_timer ctx path =
  4200. Common.timer (if Common.defined ctx.com Define.MacroTimes then "macro " ^ path else "macro execution")
  4201. let typing_timer ctx f =
  4202. let t = Common.timer "typing" in
  4203. let old = ctx.com.error and oldp = ctx.pass in
  4204. (*
  4205. disable resumable errors... unless we are in display mode (we want to reach point of completion)
  4206. *)
  4207. if ctx.com.display = DMNone then ctx.com.error <- (fun e p -> raise (Error(Custom e,p)));
  4208. if ctx.pass < PTypeField then ctx.pass <- PTypeField;
  4209. let exit() =
  4210. t();
  4211. ctx.com.error <- old;
  4212. ctx.pass <- oldp;
  4213. in
  4214. try
  4215. let r = f() in
  4216. exit();
  4217. r
  4218. with Error (ekind,p) ->
  4219. exit();
  4220. Interp.compiler_error (Typecore.error_msg ekind) p
  4221. | WithTypeError (l,p) ->
  4222. exit();
  4223. Interp.compiler_error (Typecore.error_msg (Unify l)) p
  4224. | e ->
  4225. exit();
  4226. raise e
  4227. let load_macro_ref : (typer -> path -> string -> pos -> (typer * ((string * bool * t) list * t * tclass * Type.tclass_field) * (Interp.value list -> Interp.value option))) ref = ref (fun _ _ _ _ -> assert false)
  4228. let make_macro_api ctx p =
  4229. let parse_expr_string s p inl =
  4230. typing_timer ctx (fun() -> parse_expr_string ctx s p inl)
  4231. in
  4232. {
  4233. Interp.pos = p;
  4234. Interp.get_com = (fun() -> ctx.com);
  4235. Interp.get_type = (fun s ->
  4236. typing_timer ctx (fun() ->
  4237. let path = parse_path s in
  4238. let tp = match List.rev (fst path) with
  4239. | s :: sl when String.length s > 0 && (match s.[0] with 'A'..'Z' -> true | _ -> false) ->
  4240. { tpackage = List.rev sl; tname = s; tparams = []; tsub = Some (snd path) }
  4241. | _ ->
  4242. { tpackage = fst path; tname = snd path; tparams = []; tsub = None }
  4243. in
  4244. try
  4245. let m = Some (Typeload.load_instance ctx tp p true) in
  4246. m
  4247. with Error (Module_not_found _,p2) when p == p2 ->
  4248. None
  4249. )
  4250. );
  4251. Interp.get_module = (fun s ->
  4252. typing_timer ctx (fun() ->
  4253. let path = parse_path s in
  4254. let m = List.map type_of_module_type (Typeload.load_module ctx path p).m_types in
  4255. m
  4256. )
  4257. );
  4258. Interp.on_generate = (fun f ->
  4259. Common.add_filter ctx.com (fun() ->
  4260. let t = macro_timer ctx "onGenerate" in
  4261. f (List.map type_of_module_type ctx.com.types);
  4262. t()
  4263. )
  4264. );
  4265. Interp.after_generate = (fun f ->
  4266. Common.add_final_filter ctx.com (fun() ->
  4267. let t = macro_timer ctx "afterGenerate" in
  4268. f();
  4269. t()
  4270. )
  4271. );
  4272. Interp.on_type_not_found = (fun f ->
  4273. ctx.com.load_extern_type <- ctx.com.load_extern_type @ [fun path p ->
  4274. match f (s_type_path path) with
  4275. | Interp.VNull -> None
  4276. | td ->
  4277. let (pack,name),tdef,p = Interp.decode_type_def td in
  4278. Some (name,(pack,[tdef,p]))
  4279. ];
  4280. );
  4281. Interp.parse_string = parse_expr_string;
  4282. Interp.type_expr = (fun e ->
  4283. typing_timer ctx (fun() -> (type_expr ctx e Value))
  4284. );
  4285. Interp.type_macro_expr = (fun e ->
  4286. let e = typing_timer ctx (fun() -> (type_expr ctx e Value)) in
  4287. let rec loop e = match e.eexpr with
  4288. | TField(_,FStatic(c,({cf_kind = Method _} as cf))) -> ignore(!load_macro_ref ctx c.cl_path cf.cf_name e.epos)
  4289. | _ -> Type.iter loop e
  4290. in
  4291. loop e;
  4292. e
  4293. );
  4294. Interp.store_typed_expr = (fun te ->
  4295. let p = te.epos in
  4296. let id = get_next_stored_typed_expr_id() in
  4297. ctx.com.stored_typed_exprs <- PMap.add id te ctx.com.stored_typed_exprs;
  4298. let eid = (EConst (Int (string_of_int id))), p in
  4299. (EMeta ((Meta.StoredTypedExpr,[],p), eid)), p
  4300. );
  4301. Interp.get_display = (fun s ->
  4302. let is_displaying = ctx.com.display <> DMNone in
  4303. let old_resume = !Parser.resume_display in
  4304. let old_error = ctx.on_error in
  4305. let restore () =
  4306. if not is_displaying then begin
  4307. ctx.com.defines <- PMap.remove (fst (Define.infos Define.Display)) ctx.com.defines;
  4308. ctx.com.display <- DMNone
  4309. end;
  4310. Parser.resume_display := old_resume;
  4311. ctx.on_error <- old_error;
  4312. in
  4313. (* temporarily enter display mode with a fake position *)
  4314. if not is_displaying then begin
  4315. Common.define ctx.com Define.Display;
  4316. ctx.com.display <- DMDefault;
  4317. end;
  4318. Parser.resume_display := {
  4319. Ast.pfile = "macro";
  4320. Ast.pmin = 0;
  4321. Ast.pmax = 0;
  4322. };
  4323. ctx.on_error <- (fun ctx msg p -> raise (Error(Custom msg,p)));
  4324. let str = try
  4325. let e = parse_expr_string s Ast.null_pos true in
  4326. let e = Optimizer.optimize_completion_expr e in
  4327. ignore (type_expr ctx e Value);
  4328. "NO COMPLETION"
  4329. with DisplayFields fields ->
  4330. let pctx = print_context() in
  4331. String.concat "," (List.map (fun (f,t,_,_) -> f ^ ":" ^ s_type pctx t) fields)
  4332. | DisplayTypes tl ->
  4333. let pctx = print_context() in
  4334. String.concat "," (List.map (s_type pctx) tl)
  4335. | Parser.TypePath (p,sub,_) ->
  4336. (match sub with
  4337. | None ->
  4338. "path(" ^ String.concat "." p ^ ")"
  4339. | Some (c,_) ->
  4340. "path(" ^ String.concat "." p ^ ":" ^ c ^ ")")
  4341. | Typecore.Error (msg,p) ->
  4342. "error(" ^ error_msg msg ^ ")"
  4343. in
  4344. restore();
  4345. str
  4346. );
  4347. Interp.allow_package = (fun v -> Common.allow_package ctx.com v);
  4348. Interp.type_patch = (fun t f s v ->
  4349. typing_timer ctx (fun() ->
  4350. let v = (match v with None -> None | Some s ->
  4351. match parse_string ctx.com ("typedef T = " ^ s) null_pos false with
  4352. | _,[ETypedef { d_data = ct },_] -> Some ct
  4353. | _ -> assert false
  4354. ) in
  4355. let tp = get_type_patch ctx t (Some (f,s)) in
  4356. match v with
  4357. | None -> tp.tp_remove <- true
  4358. | Some _ -> tp.tp_type <- v
  4359. );
  4360. );
  4361. Interp.meta_patch = (fun m t f s ->
  4362. let m = (match parse_string ctx.com (m ^ " typedef T = T") null_pos false with
  4363. | _,[ETypedef t,_] -> t.d_meta
  4364. | _ -> assert false
  4365. ) in
  4366. let tp = get_type_patch ctx t (match f with None -> None | Some f -> Some (f,s)) in
  4367. tp.tp_meta <- tp.tp_meta @ m;
  4368. );
  4369. Interp.set_js_generator = (fun gen ->
  4370. let js_ctx = Genjs.alloc_ctx ctx.com in
  4371. ctx.com.js_gen <- Some (fun() ->
  4372. let jsctx = Interp.enc_obj [
  4373. "outputFile", Interp.enc_string ctx.com.file;
  4374. "types", Interp.enc_array (List.map (fun t -> Interp.encode_type (type_of_module_type t)) ctx.com.types);
  4375. "main", (match ctx.com.main with None -> Interp.VNull | Some e -> Interp.encode_texpr e);
  4376. "generateValue", Interp.VFunction (Interp.Fun1 (fun v ->
  4377. let e = Interp.decode_texpr v in
  4378. let str = Genjs.gen_single_expr js_ctx e false in
  4379. Interp.enc_string str
  4380. ));
  4381. "isKeyword", Interp.VFunction (Interp.Fun1 (fun v ->
  4382. Interp.VBool (Hashtbl.mem Genjs.kwds (Interp.dec_string v))
  4383. ));
  4384. "hasFeature", Interp.VFunction (Interp.Fun1 (fun v ->
  4385. Interp.VBool (Common.has_feature ctx.com (Interp.dec_string v))
  4386. ));
  4387. "addFeature", Interp.VFunction (Interp.Fun1 (fun v ->
  4388. Common.add_feature ctx.com (Interp.dec_string v);
  4389. Interp.VNull
  4390. ));
  4391. "quoteString", Interp.VFunction (Interp.Fun1 (fun v ->
  4392. Interp.enc_string ("\"" ^ Ast.s_escape (Interp.dec_string v) ^ "\"")
  4393. ));
  4394. "buildMetaData", Interp.VFunction (Interp.Fun1 (fun t ->
  4395. match Codegen.build_metadata ctx.com (Interp.decode_tdecl t) with
  4396. | None -> Interp.VNull
  4397. | Some e -> Interp.encode_texpr e
  4398. ));
  4399. "generateStatement", Interp.VFunction (Interp.Fun1 (fun v ->
  4400. let e = Interp.decode_texpr v in
  4401. let str = Genjs.gen_single_expr js_ctx e true in
  4402. Interp.enc_string str
  4403. ));
  4404. "setTypeAccessor", Interp.VFunction (Interp.Fun1 (fun callb ->
  4405. js_ctx.Genjs.type_accessor <- (fun t ->
  4406. let v = Interp.encode_type (type_of_module_type t) in
  4407. let ret = Interp.call (Interp.get_ctx()) Interp.VNull callb [v] Nast.null_pos in
  4408. Interp.dec_string ret
  4409. );
  4410. Interp.VNull
  4411. ));
  4412. "setCurrentClass", Interp.VFunction (Interp.Fun1 (fun c ->
  4413. Genjs.set_current_class js_ctx (match Interp.decode_tdecl c with TClassDecl c -> c | _ -> assert false);
  4414. Interp.VNull
  4415. ));
  4416. ] in
  4417. let t = macro_timer ctx "jsGenerator" in
  4418. gen jsctx;
  4419. t()
  4420. );
  4421. );
  4422. Interp.get_local_type = (fun() ->
  4423. match ctx.g.get_build_infos() with
  4424. | Some (mt,tl,_) ->
  4425. Some (match mt with
  4426. | TClassDecl c -> TInst (c,tl)
  4427. | TEnumDecl e -> TEnum (e,tl)
  4428. | TTypeDecl t -> TType (t,tl)
  4429. | TAbstractDecl a -> TAbstract(a,tl))
  4430. | None ->
  4431. if ctx.curclass == null_class then
  4432. None
  4433. else
  4434. Some (TInst (ctx.curclass,[]))
  4435. );
  4436. Interp.get_expected_type = (fun() ->
  4437. match ctx.with_type_stack with
  4438. | (WithType t | WithTypeResume t) :: _ -> Some t
  4439. | _ -> None
  4440. );
  4441. Interp.get_call_arguments = (fun() ->
  4442. match ctx.call_argument_stack with
  4443. | [] -> None
  4444. | el :: _ -> Some el
  4445. );
  4446. Interp.get_local_method = (fun() ->
  4447. ctx.curfield.cf_name;
  4448. );
  4449. Interp.get_local_using = (fun() ->
  4450. ctx.m.module_using;
  4451. );
  4452. Interp.get_local_imports = (fun() ->
  4453. ctx.m.module_imports;
  4454. );
  4455. Interp.get_local_vars = (fun () ->
  4456. ctx.locals;
  4457. );
  4458. Interp.get_build_fields = (fun() ->
  4459. match ctx.g.get_build_infos() with
  4460. | None -> Interp.VNull
  4461. | Some (_,_,fields) -> Interp.enc_array (List.map Interp.encode_field fields)
  4462. );
  4463. Interp.get_pattern_locals = (fun e t ->
  4464. !get_pattern_locals_ref ctx e t
  4465. );
  4466. Interp.define_type = (fun v ->
  4467. let m, tdef, pos = (try Interp.decode_type_def v with Interp.Invalid_expr -> Interp.exc (Interp.VString "Invalid type definition")) in
  4468. let add ctx =
  4469. let prev = (try Some (Hashtbl.find ctx.g.modules m) with Not_found -> None) in
  4470. let mnew = Typeload.type_module ctx m ctx.m.curmod.m_extra.m_file [tdef,pos] pos in
  4471. add_dependency mnew ctx.m.curmod;
  4472. (* if we defined a type in an existing module, let's move the types here *)
  4473. (match prev with
  4474. | None ->
  4475. mnew.m_extra.m_kind <- MFake;
  4476. | Some mold ->
  4477. Hashtbl.replace ctx.g.modules mnew.m_path mold;
  4478. mold.m_types <- mold.m_types @ mnew.m_types;
  4479. mnew.m_extra.m_kind <- MSub;
  4480. add_dependency mold mnew;
  4481. );
  4482. in
  4483. add ctx;
  4484. (* if we are adding a class which has a macro field, we also have to add it to the macro context (issue #1497) *)
  4485. if not ctx.in_macro then match tdef,ctx.g.macros with
  4486. | EClass c,Some (_,mctx) when List.exists (fun cff -> (Meta.has Meta.Macro cff.cff_meta || List.mem AMacro cff.cff_access)) c.d_data ->
  4487. add mctx
  4488. | _ ->
  4489. ()
  4490. );
  4491. Interp.define_module = (fun m types imports usings ->
  4492. let types = List.map (fun v ->
  4493. let _, tdef, pos = (try Interp.decode_type_def v with Interp.Invalid_expr -> Interp.exc (Interp.VString "Invalid type definition")) in
  4494. tdef, pos
  4495. ) types in
  4496. let pos = (match types with [] -> Ast.null_pos | (_,p) :: _ -> p) in
  4497. let imports = List.map (fun (il,ik) -> EImport(il,ik),pos) imports in
  4498. let usings = List.map (fun tp -> EUsing tp,pos) usings in
  4499. let types = imports @ usings @ types in
  4500. let m = Ast.parse_path m in
  4501. let prev = (try Some (Hashtbl.find ctx.g.modules m) with Not_found -> None) in
  4502. let mnew = Typeload.type_module ctx m ctx.m.curmod.m_extra.m_file types pos in
  4503. add_dependency mnew ctx.m.curmod;
  4504. (* if we defined a type in an existing module, let's move the types here *)
  4505. (match prev with
  4506. | None ->
  4507. mnew.m_extra.m_kind <- MFake;
  4508. | Some mold ->
  4509. Hashtbl.replace ctx.g.modules mnew.m_path mold;
  4510. mold.m_types <- mold.m_types @ mnew.m_types;
  4511. mnew.m_extra.m_kind <- MSub;
  4512. add_dependency mold mnew;
  4513. );
  4514. );
  4515. Interp.module_dependency = (fun mpath file ismacro ->
  4516. let m = typing_timer ctx (fun() -> Typeload.load_module ctx (parse_path mpath) p) in
  4517. if ismacro then
  4518. m.m_extra.m_macro_calls <- file :: List.filter ((<>) file) m.m_extra.m_macro_calls
  4519. else
  4520. add_dependency m (create_fake_module ctx file);
  4521. );
  4522. Interp.current_module = (fun() ->
  4523. ctx.m.curmod
  4524. );
  4525. Interp.current_macro_module = (fun () -> assert false);
  4526. Interp.delayed_macro = (fun i ->
  4527. let mctx = (match ctx.g.macros with None -> assert false | Some (_,mctx) -> mctx) in
  4528. let f = (try DynArray.get mctx.g.delayed_macros i with _ -> failwith "Delayed macro retrieve failure") in
  4529. f();
  4530. let ret = !delayed_macro_result in
  4531. delayed_macro_result := (fun() -> assert false);
  4532. ret
  4533. );
  4534. Interp.use_cache = (fun() ->
  4535. !macro_enable_cache
  4536. );
  4537. Interp.format_string = (fun s p ->
  4538. format_string ctx s p
  4539. );
  4540. Interp.cast_or_unify = (fun t e p ->
  4541. Codegen.AbstractCast.cast_or_unify_raise ctx t e p
  4542. );
  4543. Interp.add_global_metadata = (fun s1 s2 config ->
  4544. let meta = (match parse_string ctx.com (s2 ^ " typedef T = T") null_pos false with
  4545. | _,[ETypedef t,_] -> t.d_meta
  4546. | _ -> assert false
  4547. ) in
  4548. List.iter (fun m ->
  4549. ctx.g.global_metadata <- (ExtString.String.nsplit s1 ".",m,config) :: ctx.g.global_metadata;
  4550. ) meta;
  4551. );
  4552. }
  4553. let rec init_macro_interp ctx mctx mint =
  4554. let p = Ast.null_pos in
  4555. ignore(Typeload.load_module mctx (["haxe";"macro"],"Expr") p);
  4556. ignore(Typeload.load_module mctx (["haxe";"macro"],"Type") p);
  4557. flush_macro_context mint ctx;
  4558. Interp.init mint;
  4559. if !macro_enable_cache && not (Common.defined mctx.com Define.NoMacroCache) then macro_interp_cache := Some mint
  4560. and flush_macro_context mint ctx =
  4561. let mctx = (match ctx.g.macros with None -> assert false | Some (_,mctx) -> mctx) in
  4562. finalize mctx;
  4563. let _, types, modules = generate mctx in
  4564. mctx.com.types <- types;
  4565. mctx.com.Common.modules <- modules;
  4566. (* if one of the type we are using has been modified, we need to create a new macro context from scratch *)
  4567. let mint = if not (Interp.can_reuse mint types) then begin
  4568. let com2 = mctx.com in
  4569. let mint = Interp.create com2 (make_macro_api ctx Ast.null_pos) in
  4570. let macro = ((fun() -> Interp.select mint), mctx) in
  4571. ctx.g.macros <- Some macro;
  4572. mctx.g.macros <- Some macro;
  4573. init_macro_interp ctx mctx mint;
  4574. mint
  4575. end else mint in
  4576. (* we should maybe ensure that all filters in Main are applied. Not urgent atm *)
  4577. let expr_filters = [Codegen.AbstractCast.handle_abstract_casts mctx; Filters.captured_vars mctx.com; Filters.rename_local_vars mctx] in
  4578. (*
  4579. some filters here might cause side effects that would break compilation server.
  4580. let's save the minimal amount of information we need
  4581. *)
  4582. let minimal_restore t =
  4583. match t with
  4584. | TClassDecl c ->
  4585. let meta = c.cl_meta in
  4586. let path = c.cl_path in
  4587. c.cl_restore <- (fun() -> c.cl_meta <- meta; c.cl_path <- path);
  4588. | _ ->
  4589. ()
  4590. in
  4591. let type_filters = [
  4592. Filters.add_field_inits mctx;
  4593. minimal_restore;
  4594. Filters.apply_native_paths mctx
  4595. ] in
  4596. let ready = fun t ->
  4597. Filters.apply_filters_once mctx expr_filters t;
  4598. List.iter (fun f -> f t) type_filters
  4599. in
  4600. (try Interp.add_types mint types ready
  4601. with Error (e,p) -> raise (Fatal_error(error_msg e,p)));
  4602. Filters.next_compilation()
  4603. let create_macro_interp ctx mctx =
  4604. let com2 = mctx.com in
  4605. let mint, init = (match !macro_interp_cache with
  4606. | None ->
  4607. let mint = Interp.create com2 (make_macro_api ctx Ast.null_pos) in
  4608. mint, (fun() -> init_macro_interp ctx mctx mint)
  4609. | Some mint ->
  4610. Interp.do_reuse mint (make_macro_api ctx Ast.null_pos);
  4611. mint, (fun() -> ())
  4612. ) in
  4613. let on_error = com2.error in
  4614. com2.error <- (fun e p ->
  4615. Interp.set_error (Interp.get_ctx()) true;
  4616. macro_interp_cache := None;
  4617. on_error e p
  4618. );
  4619. let macro = ((fun() -> Interp.select mint), mctx) in
  4620. ctx.g.macros <- Some macro;
  4621. mctx.g.macros <- Some macro;
  4622. (* mctx.g.core_api <- ctx.g.core_api; // causes some issues because of optional args and Null type in Flash9 *)
  4623. init()
  4624. let get_macro_context ctx p =
  4625. let api = make_macro_api ctx p in
  4626. match ctx.g.macros with
  4627. | Some (select,ctx) ->
  4628. select();
  4629. api, ctx
  4630. | None ->
  4631. let com2 = Common.clone ctx.com in
  4632. ctx.com.get_macros <- (fun() -> Some com2);
  4633. com2.package_rules <- PMap.empty;
  4634. com2.main_class <- None;
  4635. com2.display <- DMNone;
  4636. List.iter (fun p -> com2.defines <- PMap.remove (platform_name p) com2.defines) platforms;
  4637. com2.defines_signature <- None;
  4638. com2.class_path <- List.filter (fun s -> not (ExtString.String.exists s "/_std/")) com2.class_path;
  4639. com2.class_path <- List.map (fun p -> p ^ "neko" ^ "/_std/") com2.std_path @ com2.class_path;
  4640. let to_remove = List.map (fun d -> fst (Define.infos d)) [Define.NoTraces] in
  4641. let to_remove = to_remove @ List.map (fun (_,d) -> "flash" ^ d) Common.flash_versions in
  4642. com2.defines <- PMap.foldi (fun k v acc -> if List.mem k to_remove then acc else PMap.add k v acc) com2.defines PMap.empty;
  4643. Common.define com2 Define.Macro;
  4644. Common.init_platform com2 Neko;
  4645. let mctx = ctx.g.do_create com2 in
  4646. create_macro_interp ctx mctx;
  4647. api, mctx
  4648. let load_macro ctx cpath f p =
  4649. (*
  4650. The time measured here takes into account both macro typing an init, but benchmarks
  4651. shows that - unless you re doing heavy statics vars init - the time is mostly spent in
  4652. typing the classes needed for macro execution.
  4653. *)
  4654. let t = macro_timer ctx "typing (+init)" in
  4655. let api, mctx = get_macro_context ctx p in
  4656. let mint = Interp.get_ctx() in
  4657. let cpath, sub = (match List.rev (fst cpath) with
  4658. | name :: pack when name.[0] >= 'A' && name.[0] <= 'Z' -> (List.rev pack,name), Some (snd cpath)
  4659. | _ -> cpath, None
  4660. ) in
  4661. let m = (try Hashtbl.find ctx.g.types_module cpath with Not_found -> cpath) in
  4662. let mloaded = Typeload.load_module mctx m p in
  4663. api.Interp.current_macro_module <- (fun() -> mloaded);
  4664. mctx.m <- {
  4665. curmod = mloaded;
  4666. module_types = [];
  4667. module_using = [];
  4668. module_globals = PMap.empty;
  4669. wildcard_packages = [];
  4670. module_imports = [];
  4671. };
  4672. add_dependency ctx.m.curmod mloaded;
  4673. let mt = Typeload.load_type_def mctx p { tpackage = fst cpath; tname = snd cpath; tparams = []; tsub = sub } in
  4674. let cl, meth = (match mt with
  4675. | TClassDecl c ->
  4676. finalize mctx;
  4677. c, (try PMap.find f c.cl_statics with Not_found -> error ("Method " ^ f ^ " not found on class " ^ s_type_path cpath) p)
  4678. | _ -> error "Macro should be called on a class" p
  4679. ) in
  4680. let meth = (match follow meth.cf_type with TFun (args,ret) -> args,ret,cl,meth | _ -> error "Macro call should be a method" p) in
  4681. if not ctx.in_macro then flush_macro_context mint ctx;
  4682. t();
  4683. let call args =
  4684. let t = macro_timer ctx (s_type_path cpath ^ "." ^ f) in
  4685. incr stats.s_macros_called;
  4686. let r = Interp.call_path (Interp.get_ctx()) ((fst cpath) @ [(match sub with None -> snd cpath | Some s -> s)]) f args api in
  4687. t();
  4688. r
  4689. in
  4690. mctx, meth, call
  4691. type macro_arg_type =
  4692. | MAExpr
  4693. | MAFunction
  4694. | MAOther
  4695. let type_macro ctx mode cpath f (el:Ast.expr list) p =
  4696. let mctx, (margs,mret,mclass,mfield), call_macro = load_macro ctx cpath f p in
  4697. let mpos = mfield.cf_pos in
  4698. let ctexpr = { tpackage = ["haxe";"macro"]; tname = "Expr"; tparams = []; tsub = None } in
  4699. let expr = Typeload.load_instance mctx ctexpr p false in
  4700. (match mode with
  4701. | MExpr ->
  4702. unify mctx mret expr mpos;
  4703. | MBuild ->
  4704. let ctfields = { tpackage = []; tname = "Array"; tparams = [TPType (CTPath { tpackage = ["haxe";"macro"]; tname = "Expr"; tparams = []; tsub = Some "Field" })]; tsub = None } in
  4705. let tfields = Typeload.load_instance mctx ctfields p false in
  4706. unify mctx mret tfields mpos
  4707. | MMacroType ->
  4708. let cttype = { tpackage = ["haxe";"macro"]; tname = "Type"; tparams = []; tsub = None } in
  4709. let ttype = Typeload.load_instance mctx cttype p false in
  4710. try
  4711. unify_raise mctx mret ttype mpos;
  4712. (* TODO: enable this again in the future *)
  4713. (* ctx.com.warning "Returning Type from @:genericBuild macros is deprecated, consider returning ComplexType instead" p; *)
  4714. with Error (Unify _,_) ->
  4715. let cttype = { tpackage = ["haxe";"macro"]; tname = "Expr"; tparams = []; tsub = Some ("ComplexType") } in
  4716. let ttype = Typeload.load_instance mctx cttype p false in
  4717. unify_raise mctx mret ttype mpos;
  4718. );
  4719. (*
  4720. if the function's last argument is of Array<Expr>, split the argument list and use [] for unify_call_args
  4721. *)
  4722. let el,el2 = match List.rev margs with
  4723. | (_,_,TInst({cl_path=([], "Array")},[e])) :: rest when (try Type.type_eq EqStrict e expr; true with Unify_error _ -> false) ->
  4724. let rec loop (acc1,acc2) el1 el2 = match el1,el2 with
  4725. | [],[] ->
  4726. List.rev acc1, List.rev acc2
  4727. | [], e2 :: [] ->
  4728. (List.rev ((EArrayDecl [],p) :: acc1), [])
  4729. | [], _ ->
  4730. (* not enough arguments, will be handled by unify_call_args *)
  4731. List.rev acc1, List.rev acc2
  4732. | e1 :: l1, e2 :: [] ->
  4733. loop (((EArrayDecl [],p) :: acc1), [e1]) l1 []
  4734. | e1 :: l1, [] ->
  4735. loop (acc1, e1 :: acc2) l1 []
  4736. | e1 :: l1, e2 :: l2 ->
  4737. loop (e1 :: acc1, acc2) l1 l2
  4738. in
  4739. loop ([],[]) el margs
  4740. | _ ->
  4741. el,[]
  4742. in
  4743. let todo = ref [] in
  4744. let args =
  4745. (*
  4746. force default parameter types to haxe.macro.Expr, and if success allow to pass any value type since it will be encoded
  4747. *)
  4748. let eargs = List.map (fun (n,o,t) ->
  4749. try unify_raise mctx t expr p; (n, o, t_dynamic), MAExpr
  4750. with Error (Unify _,_) -> match follow t with
  4751. | TFun _ ->
  4752. (n,o,t_dynamic), MAFunction
  4753. | _ ->
  4754. (n,o,t), MAOther
  4755. ) margs in
  4756. (*
  4757. this is quite tricky here : we want to use unify_call_args which will type our AST expr
  4758. but we want to be able to get it back after it's been padded with nulls
  4759. *)
  4760. let index = ref (-1) in
  4761. let constants = List.map (fun e ->
  4762. let p = snd e in
  4763. let e = (try
  4764. (match Codegen.type_constant_value ctx.com e with
  4765. | { eexpr = TConst (TString _); epos = p } when Lexer.is_fmt_string p ->
  4766. Lexer.remove_fmt_string p;
  4767. todo := (fun() -> Lexer.add_fmt_string p) :: !todo;
  4768. | _ -> ());
  4769. e
  4770. with Error (Custom _,_) ->
  4771. (* if it's not a constant, let's make something that is typed as haxe.macro.Expr - for nice error reporting *)
  4772. (EBlock [
  4773. (EVars ["__tmp",Some (CTPath ctexpr),Some (EConst (Ident "null"),p)],p);
  4774. (EConst (Ident "__tmp"),p);
  4775. ],p)
  4776. ) in
  4777. (* let's track the index by doing [e][index] (we will keep the expression type this way) *)
  4778. incr index;
  4779. (EArray ((EArrayDecl [e],p),(EConst (Int (string_of_int (!index))),p)),p)
  4780. ) el in
  4781. let elt, _ = unify_call_args mctx constants (List.map fst eargs) t_dynamic p false false in
  4782. List.iter (fun f -> f()) (!todo);
  4783. List.map2 (fun (_,mct) e ->
  4784. let e, et = (match e.eexpr with
  4785. (* get back our index and real expression *)
  4786. | TArray ({ eexpr = TArrayDecl [e] }, { eexpr = TConst (TInt index) }) -> List.nth el (Int32.to_int index), e
  4787. (* added by unify_call_args *)
  4788. | TConst TNull -> (EConst (Ident "null"),e.epos), e
  4789. | _ -> assert false
  4790. ) in
  4791. let ictx = Interp.get_ctx() in
  4792. match mct with
  4793. | MAExpr ->
  4794. Interp.encode_expr e
  4795. | MAFunction ->
  4796. let e = ictx.Interp.curapi.Interp.type_macro_expr e in
  4797. begin match Interp.eval_expr ictx e with
  4798. | Some v -> v
  4799. | None -> Interp.VNull
  4800. end
  4801. | MAOther -> match Interp.eval_expr ictx et with
  4802. | None -> assert false
  4803. | Some v -> v
  4804. ) eargs elt
  4805. in
  4806. let args = match el2 with
  4807. | [] -> args
  4808. | _ -> (match List.rev args with _::args -> List.rev args | [] -> []) @ [Interp.enc_array (List.map Interp.encode_expr el2)]
  4809. in
  4810. let call() =
  4811. match call_macro args with
  4812. | None -> None
  4813. | Some v ->
  4814. try
  4815. Some (match mode with
  4816. | MExpr -> Interp.decode_expr v
  4817. | MBuild ->
  4818. let fields = (match v with
  4819. | Interp.VNull ->
  4820. (match ctx.g.get_build_infos() with
  4821. | None -> assert false
  4822. | Some (_,_,fields) -> fields)
  4823. | _ ->
  4824. List.map Interp.decode_field (Interp.dec_array v)
  4825. ) in
  4826. (EVars ["fields",Some (CTAnonymous fields),None],p)
  4827. | MMacroType ->
  4828. let t = if v = Interp.VNull then
  4829. mk_mono()
  4830. else try
  4831. let ct = Interp.decode_ctype v in
  4832. Typeload.load_complex_type ctx p ct;
  4833. with Interp.Invalid_expr ->
  4834. Interp.decode_type v
  4835. in
  4836. ctx.ret <- t;
  4837. (EBlock [],p)
  4838. )
  4839. with Interp.Invalid_expr ->
  4840. if v = Interp.VNull then
  4841. error "Unexpected null value returned from macro" p
  4842. else
  4843. error "The macro didn't return a valid result" p
  4844. in
  4845. let e = (if ctx.in_macro then begin
  4846. (*
  4847. this is super-tricky : we can't evaluate a macro inside a macro because we might trigger some cycles.
  4848. So instead, we generate a haxe.macro.Context.delayedCalled(i) expression that will only evaluate the
  4849. macro if/when it is called.
  4850. The tricky part is that the whole delayed-evaluation process has to use the same contextual informations
  4851. as if it was evaluated now.
  4852. *)
  4853. let ctx = {
  4854. ctx with locals = ctx.locals;
  4855. } in
  4856. let pos = DynArray.length mctx.g.delayed_macros in
  4857. DynArray.add mctx.g.delayed_macros (fun() ->
  4858. delayed_macro_result := (fun() ->
  4859. let mint = Interp.get_ctx() in
  4860. match call() with
  4861. | None -> (fun() -> raise Interp.Abort)
  4862. | Some e -> Interp.eval mint (Genneko.gen_expr mint.Interp.gen (type_expr ctx e Value))
  4863. );
  4864. );
  4865. ctx.m.curmod.m_extra.m_time <- -1.; (* disable caching for modules having macro-in-macro *)
  4866. let e = (EConst (Ident "__dollar__delay_call"),p) in
  4867. Some (EUntyped (ECall (e,[EConst (Int (string_of_int pos)),p]),p),p)
  4868. end else
  4869. call()
  4870. ) in
  4871. e
  4872. let call_macro ctx path meth args p =
  4873. let mctx, (margs,_,mclass,mfield), call = load_macro ctx path meth p in
  4874. let el, _ = unify_call_args mctx args margs t_dynamic p false false in
  4875. call (List.map (fun e -> try Interp.make_const e with Exit -> error "Parameter should be a constant" e.epos) el)
  4876. let call_init_macro ctx e =
  4877. let p = { pfile = "--macro"; pmin = 0; pmax = 0 } in
  4878. let e = try
  4879. parse_expr_string ctx e p false
  4880. with err ->
  4881. display_error ctx ("Could not parse `" ^ e ^ "`") p;
  4882. raise err
  4883. in
  4884. match fst e with
  4885. | ECall (e,args) ->
  4886. let rec loop e =
  4887. match fst e with
  4888. | EField (e,f) -> f :: loop e
  4889. | EConst (Ident i) -> [i]
  4890. | _ -> error "Invalid macro call" p
  4891. in
  4892. let path, meth = (match loop e with
  4893. | [meth] -> (["haxe";"macro"],"Compiler"), meth
  4894. | meth :: cl :: path -> (List.rev path,cl), meth
  4895. | _ -> error "Invalid macro call" p) in
  4896. ignore(call_macro ctx path meth args p);
  4897. | _ ->
  4898. error "Invalid macro call" p
  4899. (* ---------------------------------------------------------------------- *)
  4900. (* TYPER INITIALIZATION *)
  4901. let rec create com =
  4902. let ctx = {
  4903. com = com;
  4904. t = com.basic;
  4905. g = {
  4906. core_api = None;
  4907. macros = None;
  4908. modules = Hashtbl.create 0;
  4909. types_module = Hashtbl.create 0;
  4910. type_patches = Hashtbl.create 0;
  4911. global_metadata = [];
  4912. delayed = [];
  4913. debug_delayed = [];
  4914. delayed_macros = DynArray.create();
  4915. doinline = not (Common.defined com Define.NoInline || com.display <> DMNone);
  4916. hook_generate = [];
  4917. get_build_infos = (fun() -> None);
  4918. std = null_module;
  4919. global_using = [];
  4920. do_inherit = Codegen.on_inherit;
  4921. do_create = create;
  4922. do_macro = type_macro;
  4923. do_load_module = Typeload.load_module;
  4924. do_optimize = Optimizer.reduce_expression;
  4925. do_build_instance = Codegen.build_instance;
  4926. };
  4927. m = {
  4928. curmod = null_module;
  4929. module_types = [];
  4930. module_using = [];
  4931. module_globals = PMap.empty;
  4932. wildcard_packages = [];
  4933. module_imports = [];
  4934. };
  4935. meta = [];
  4936. this_stack = [];
  4937. with_type_stack = [];
  4938. call_argument_stack = [];
  4939. pass = PBuildModule;
  4940. macro_depth = 0;
  4941. untyped = false;
  4942. curfun = FunStatic;
  4943. in_loop = false;
  4944. in_super_call = false;
  4945. in_display = false;
  4946. in_macro = Common.defined com Define.Macro;
  4947. ret = mk_mono();
  4948. locals = PMap.empty;
  4949. type_params = [];
  4950. curclass = null_class;
  4951. curfield = null_field;
  4952. tthis = mk_mono();
  4953. opened = [];
  4954. vthis = None;
  4955. on_error = (fun ctx msg p -> ctx.com.error msg p);
  4956. } in
  4957. ctx.g.std <- (try
  4958. Typeload.load_module ctx ([],"StdTypes") null_pos
  4959. with
  4960. Error (Module_not_found ([],"StdTypes"),_) -> error "Standard library not found" null_pos
  4961. );
  4962. (* We always want core types to be available so we add them as default imports (issue #1904 and #3131). *)
  4963. ctx.m.module_types <- ctx.g.std.m_types;
  4964. List.iter (fun t ->
  4965. match t with
  4966. | TAbstractDecl a ->
  4967. (match snd a.a_path with
  4968. | "Void" -> ctx.t.tvoid <- TAbstract (a,[]);
  4969. | "Float" -> ctx.t.tfloat <- TAbstract (a,[]);
  4970. | "Int" -> ctx.t.tint <- TAbstract (a,[])
  4971. | "Bool" -> ctx.t.tbool <- TAbstract (a,[])
  4972. | _ -> ());
  4973. | TEnumDecl e ->
  4974. ()
  4975. | TClassDecl c ->
  4976. ()
  4977. | TTypeDecl td ->
  4978. (match snd td.t_path with
  4979. | "Null" ->
  4980. let mk_null t =
  4981. try
  4982. if not (is_null ~no_lazy:true t) then TType (td,[t]) else t
  4983. with Exit ->
  4984. (* don't force lazy evaluation *)
  4985. let r = ref (fun() -> assert false) in
  4986. r := (fun() ->
  4987. let t = (if not (is_null t) then TType (td,[t]) else t) in
  4988. r := (fun() -> t);
  4989. t
  4990. );
  4991. TLazy r
  4992. in
  4993. ctx.t.tnull <- mk_null;
  4994. | _ -> ());
  4995. ) ctx.g.std.m_types;
  4996. let m = Typeload.load_module ctx ([],"String") null_pos in
  4997. (match m.m_types with
  4998. | [TClassDecl c] -> ctx.t.tstring <- TInst (c,[])
  4999. | _ -> assert false);
  5000. let m = Typeload.load_module ctx ([],"Array") null_pos in
  5001. (try
  5002. List.iter (fun t -> (
  5003. match t with
  5004. | TClassDecl ({cl_path = ([],"Array")} as c) ->
  5005. ctx.t.tarray <- (fun t -> TInst (c,[t]));
  5006. raise Exit
  5007. | _ -> ()
  5008. )) m.m_types;
  5009. assert false
  5010. with Exit -> ());
  5011. let m = Typeload.load_module ctx (["haxe"],"EnumTools") null_pos in
  5012. (match m.m_types with
  5013. | [TClassDecl c1;TClassDecl c2] -> ctx.g.global_using <- c1 :: c2 :: ctx.g.global_using
  5014. | [TClassDecl c1] ->
  5015. let m = Typeload.load_module ctx (["haxe"],"EnumValueTools") null_pos in
  5016. (match m.m_types with
  5017. | [TClassDecl c2 ] -> ctx.g.global_using <- c1 :: c2 :: ctx.g.global_using
  5018. | _ -> assert false);
  5019. | _ -> assert false);
  5020. ctx
  5021. ;;
  5022. unify_min_ref := unify_min;
  5023. make_call_ref := make_call;
  5024. get_constructor_ref := get_constructor;
  5025. cast_or_unify_ref := Codegen.AbstractCast.cast_or_unify_raise;
  5026. type_module_type_ref := type_module_type;
  5027. find_array_access_raise_ref := Codegen.AbstractCast.find_array_access_raise;
  5028. build_call_ref := build_call;
  5029. load_macro_ref := load_macro