fppas2js.pp 356 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732673367346735673667376738673967406741674267436744674567466747674867496750675167526753675467556756675767586759676067616762676367646765676667676768676967706771677267736774677567766777677867796780678167826783678467856786678767886789679067916792679367946795679667976798679968006801680268036804680568066807680868096810681168126813681468156816681768186819682068216822682368246825682668276828682968306831683268336834683568366837683868396840684168426843684468456846684768486849685068516852685368546855685668576858685968606861686268636864686568666867686868696870687168726873687468756876687768786879688068816882688368846885688668876888688968906891689268936894689568966897689868996900690169026903690469056906690769086909691069116912691369146915691669176918691969206921692269236924692569266927692869296930693169326933693469356936693769386939694069416942694369446945694669476948694969506951695269536954695569566957695869596960696169626963696469656966696769686969697069716972697369746975697669776978697969806981698269836984698569866987698869896990699169926993699469956996699769986999700070017002700370047005700670077008700970107011701270137014701570167017701870197020702170227023702470257026702770287029703070317032703370347035703670377038703970407041704270437044704570467047704870497050705170527053705470557056705770587059706070617062706370647065706670677068706970707071707270737074707570767077707870797080708170827083708470857086708770887089709070917092709370947095709670977098709971007101710271037104710571067107710871097110711171127113711471157116711771187119712071217122712371247125712671277128712971307131713271337134713571367137713871397140714171427143714471457146714771487149715071517152715371547155715671577158715971607161716271637164716571667167716871697170717171727173717471757176717771787179718071817182718371847185718671877188718971907191719271937194719571967197719871997200720172027203720472057206720772087209721072117212721372147215721672177218721972207221722272237224722572267227722872297230723172327233723472357236723772387239724072417242724372447245724672477248724972507251725272537254725572567257725872597260726172627263726472657266726772687269727072717272727372747275727672777278727972807281728272837284728572867287728872897290729172927293729472957296729772987299730073017302730373047305730673077308730973107311731273137314731573167317731873197320732173227323732473257326732773287329733073317332733373347335733673377338733973407341734273437344734573467347734873497350735173527353735473557356735773587359736073617362736373647365736673677368736973707371737273737374737573767377737873797380738173827383738473857386738773887389739073917392739373947395739673977398739974007401740274037404740574067407740874097410741174127413741474157416741774187419742074217422742374247425742674277428742974307431743274337434743574367437743874397440744174427443744474457446744774487449745074517452745374547455745674577458745974607461746274637464746574667467746874697470747174727473747474757476747774787479748074817482748374847485748674877488748974907491749274937494749574967497749874997500750175027503750475057506750775087509751075117512751375147515751675177518751975207521752275237524752575267527752875297530753175327533753475357536753775387539754075417542754375447545754675477548754975507551755275537554755575567557755875597560756175627563756475657566756775687569757075717572757375747575757675777578757975807581758275837584758575867587758875897590759175927593759475957596759775987599760076017602760376047605760676077608760976107611761276137614761576167617761876197620762176227623762476257626762776287629763076317632763376347635763676377638763976407641764276437644764576467647764876497650765176527653765476557656765776587659766076617662766376647665766676677668766976707671767276737674767576767677767876797680768176827683768476857686768776887689769076917692769376947695769676977698769977007701770277037704770577067707770877097710771177127713771477157716771777187719772077217722772377247725772677277728772977307731773277337734773577367737773877397740774177427743774477457746774777487749775077517752775377547755775677577758775977607761776277637764776577667767776877697770777177727773777477757776777777787779778077817782778377847785778677877788778977907791779277937794779577967797779877997800780178027803780478057806780778087809781078117812781378147815781678177818781978207821782278237824782578267827782878297830783178327833783478357836783778387839784078417842784378447845784678477848784978507851785278537854785578567857785878597860786178627863786478657866786778687869787078717872787378747875787678777878787978807881788278837884788578867887788878897890789178927893789478957896789778987899790079017902790379047905790679077908790979107911791279137914791579167917791879197920792179227923792479257926792779287929793079317932793379347935793679377938793979407941794279437944794579467947794879497950795179527953795479557956795779587959796079617962796379647965796679677968796979707971797279737974797579767977797879797980798179827983798479857986798779887989799079917992799379947995799679977998799980008001800280038004800580068007800880098010801180128013801480158016801780188019802080218022802380248025802680278028802980308031803280338034803580368037803880398040804180428043804480458046804780488049805080518052805380548055805680578058805980608061806280638064806580668067806880698070807180728073807480758076807780788079808080818082808380848085808680878088808980908091809280938094809580968097809880998100810181028103810481058106810781088109811081118112811381148115811681178118811981208121812281238124812581268127812881298130813181328133813481358136813781388139814081418142814381448145814681478148814981508151815281538154815581568157815881598160816181628163816481658166816781688169817081718172817381748175817681778178817981808181818281838184818581868187818881898190819181928193819481958196819781988199820082018202820382048205820682078208820982108211821282138214821582168217821882198220822182228223822482258226822782288229823082318232823382348235823682378238823982408241824282438244824582468247824882498250825182528253825482558256825782588259826082618262826382648265826682678268826982708271827282738274827582768277827882798280828182828283828482858286828782888289829082918292829382948295829682978298829983008301830283038304830583068307830883098310831183128313831483158316831783188319832083218322832383248325832683278328832983308331833283338334833583368337833883398340834183428343834483458346834783488349835083518352835383548355835683578358835983608361836283638364836583668367836883698370837183728373837483758376837783788379838083818382838383848385838683878388838983908391839283938394839583968397839883998400840184028403840484058406840784088409841084118412841384148415841684178418841984208421842284238424842584268427842884298430843184328433843484358436843784388439844084418442844384448445844684478448844984508451845284538454845584568457845884598460846184628463846484658466846784688469847084718472847384748475847684778478847984808481848284838484848584868487848884898490849184928493849484958496849784988499850085018502850385048505850685078508850985108511851285138514851585168517851885198520852185228523852485258526852785288529853085318532853385348535853685378538853985408541854285438544854585468547854885498550855185528553855485558556855785588559856085618562856385648565856685678568856985708571857285738574857585768577857885798580858185828583858485858586858785888589859085918592859385948595859685978598859986008601860286038604860586068607860886098610861186128613861486158616861786188619862086218622862386248625862686278628862986308631863286338634863586368637863886398640864186428643864486458646864786488649865086518652865386548655865686578658865986608661866286638664866586668667866886698670867186728673867486758676867786788679868086818682868386848685868686878688868986908691869286938694869586968697869886998700870187028703870487058706870787088709871087118712871387148715871687178718871987208721872287238724872587268727872887298730873187328733873487358736873787388739874087418742874387448745874687478748874987508751875287538754875587568757875887598760876187628763876487658766876787688769877087718772877387748775877687778778877987808781878287838784878587868787878887898790879187928793879487958796879787988799880088018802880388048805880688078808880988108811881288138814881588168817881888198820882188228823882488258826882788288829883088318832883388348835883688378838883988408841884288438844884588468847884888498850885188528853885488558856885788588859886088618862886388648865886688678868886988708871887288738874887588768877887888798880888188828883888488858886888788888889889088918892889388948895889688978898889989008901890289038904890589068907890889098910891189128913891489158916891789188919892089218922892389248925892689278928892989308931893289338934893589368937893889398940894189428943894489458946894789488949895089518952895389548955895689578958895989608961896289638964896589668967896889698970897189728973897489758976897789788979898089818982898389848985898689878988898989908991899289938994899589968997899889999000900190029003900490059006900790089009901090119012901390149015901690179018901990209021902290239024902590269027902890299030903190329033903490359036903790389039904090419042904390449045904690479048904990509051905290539054905590569057905890599060906190629063906490659066906790689069907090719072907390749075907690779078907990809081908290839084908590869087908890899090909190929093909490959096909790989099910091019102910391049105910691079108910991109111911291139114911591169117911891199120912191229123912491259126912791289129913091319132913391349135913691379138913991409141914291439144914591469147914891499150915191529153915491559156915791589159916091619162916391649165916691679168916991709171917291739174917591769177917891799180918191829183918491859186918791889189919091919192919391949195919691979198919992009201920292039204920592069207920892099210921192129213921492159216921792189219922092219222922392249225922692279228922992309231923292339234923592369237923892399240924192429243924492459246924792489249925092519252925392549255925692579258925992609261926292639264926592669267926892699270927192729273927492759276927792789279928092819282928392849285928692879288928992909291929292939294929592969297929892999300930193029303930493059306930793089309931093119312931393149315931693179318931993209321932293239324932593269327932893299330933193329333933493359336933793389339934093419342934393449345934693479348934993509351935293539354935593569357935893599360936193629363936493659366936793689369937093719372937393749375937693779378937993809381938293839384938593869387938893899390939193929393939493959396939793989399940094019402940394049405940694079408940994109411941294139414941594169417941894199420942194229423942494259426942794289429943094319432943394349435943694379438943994409441944294439444944594469447944894499450945194529453945494559456945794589459946094619462946394649465946694679468946994709471947294739474947594769477947894799480948194829483948494859486948794889489949094919492949394949495949694979498949995009501950295039504950595069507950895099510951195129513951495159516951795189519952095219522952395249525952695279528952995309531953295339534953595369537953895399540954195429543954495459546954795489549955095519552955395549555955695579558955995609561956295639564956595669567956895699570957195729573957495759576957795789579958095819582958395849585958695879588958995909591959295939594959595969597959895999600960196029603960496059606960796089609961096119612961396149615961696179618961996209621962296239624962596269627962896299630963196329633963496359636963796389639964096419642964396449645964696479648964996509651965296539654965596569657965896599660966196629663966496659666966796689669967096719672967396749675967696779678967996809681968296839684968596869687968896899690969196929693969496959696969796989699970097019702970397049705970697079708970997109711971297139714971597169717971897199720972197229723972497259726972797289729973097319732973397349735973697379738973997409741974297439744974597469747974897499750975197529753975497559756975797589759976097619762976397649765976697679768976997709771977297739774977597769777977897799780978197829783978497859786978797889789979097919792979397949795979697979798979998009801980298039804980598069807980898099810981198129813981498159816981798189819982098219822982398249825982698279828982998309831983298339834983598369837983898399840984198429843984498459846984798489849985098519852985398549855985698579858985998609861986298639864986598669867986898699870987198729873987498759876987798789879988098819882988398849885988698879888988998909891989298939894989598969897989898999900990199029903990499059906990799089909991099119912991399149915991699179918991999209921992299239924992599269927992899299930993199329933993499359936993799389939994099419942994399449945994699479948994999509951995299539954995599569957995899599960996199629963996499659966996799689969997099719972997399749975997699779978997999809981998299839984998599869987998899899990999199929993999499959996999799989999100001000110002100031000410005100061000710008100091001010011100121001310014100151001610017100181001910020100211002210023100241002510026100271002810029100301003110032100331003410035100361003710038100391004010041100421004310044100451004610047100481004910050100511005210053100541005510056100571005810059100601006110062100631006410065100661006710068100691007010071100721007310074100751007610077100781007910080100811008210083100841008510086100871008810089100901009110092100931009410095100961009710098100991010010101101021010310104101051010610107101081010910110101111011210113101141011510116101171011810119101201012110122101231012410125101261012710128101291013010131101321013310134101351013610137101381013910140101411014210143101441014510146101471014810149101501015110152101531015410155101561015710158101591016010161101621016310164101651016610167101681016910170101711017210173101741017510176101771017810179101801018110182101831018410185101861018710188101891019010191101921019310194101951019610197101981019910200102011020210203102041020510206102071020810209102101021110212102131021410215102161021710218102191022010221102221022310224102251022610227102281022910230102311023210233102341023510236102371023810239102401024110242102431024410245102461024710248102491025010251102521025310254102551025610257102581025910260102611026210263102641026510266102671026810269102701027110272102731027410275102761027710278102791028010281102821028310284102851028610287102881028910290102911029210293102941029510296102971029810299103001030110302103031030410305103061030710308103091031010311103121031310314103151031610317103181031910320103211032210323103241032510326103271032810329103301033110332103331033410335103361033710338103391034010341103421034310344103451034610347103481034910350103511035210353103541035510356103571035810359103601036110362103631036410365103661036710368103691037010371103721037310374103751037610377103781037910380103811038210383103841038510386103871038810389103901039110392103931039410395103961039710398103991040010401104021040310404104051040610407104081040910410104111041210413104141041510416104171041810419104201042110422104231042410425104261042710428104291043010431104321043310434104351043610437104381043910440104411044210443104441044510446104471044810449104501045110452104531045410455104561045710458104591046010461104621046310464104651046610467104681046910470104711047210473104741047510476104771047810479104801048110482104831048410485104861048710488104891049010491104921049310494104951049610497104981049910500105011050210503105041050510506105071050810509105101051110512105131051410515105161051710518105191052010521105221052310524105251052610527105281052910530105311053210533105341053510536105371053810539105401054110542105431054410545105461054710548105491055010551105521055310554105551055610557105581055910560105611056210563105641056510566105671056810569105701057110572105731057410575105761057710578105791058010581105821058310584105851058610587105881058910590105911059210593105941059510596105971059810599106001060110602106031060410605106061060710608106091061010611106121061310614106151061610617106181061910620106211062210623106241062510626106271062810629106301063110632106331063410635106361063710638106391064010641106421064310644106451064610647106481064910650106511065210653106541065510656106571065810659106601066110662106631066410665106661066710668106691067010671106721067310674106751067610677106781067910680106811068210683106841068510686106871068810689106901069110692106931069410695106961069710698106991070010701107021070310704107051070610707107081070910710107111071210713107141071510716107171071810719107201072110722107231072410725107261072710728107291073010731107321073310734107351073610737107381073910740107411074210743107441074510746107471074810749107501075110752107531075410755107561075710758107591076010761107621076310764107651076610767107681076910770107711077210773107741077510776107771077810779107801078110782107831078410785107861078710788107891079010791107921079310794107951079610797107981079910800108011080210803108041080510806108071080810809108101081110812108131081410815108161081710818108191082010821108221082310824108251082610827108281082910830108311083210833108341083510836108371083810839108401084110842108431084410845108461084710848108491085010851108521085310854108551085610857108581085910860108611086210863108641086510866108671086810869108701087110872108731087410875108761087710878108791088010881108821088310884108851088610887108881088910890108911089210893108941089510896108971089810899109001090110902109031090410905109061090710908109091091010911109121091310914109151091610917109181091910920109211092210923109241092510926109271092810929109301093110932109331093410935109361093710938109391094010941109421094310944109451094610947109481094910950109511095210953109541095510956109571095810959109601096110962109631096410965109661096710968109691097010971109721097310974109751097610977109781097910980109811098210983109841098510986109871098810989109901099110992109931099410995109961099710998109991100011001110021100311004110051100611007110081100911010110111101211013110141101511016110171101811019110201102111022110231102411025110261102711028110291103011031110321103311034110351103611037110381103911040110411104211043110441104511046110471104811049110501105111052110531105411055110561105711058110591106011061110621106311064110651106611067110681106911070110711107211073110741107511076110771107811079110801108111082110831108411085110861108711088110891109011091110921109311094110951109611097110981109911100111011110211103111041110511106111071110811109111101111111112111131111411115111161111711118111191112011121111221112311124111251112611127111281112911130111311113211133111341113511136111371113811139111401114111142111431114411145111461114711148111491115011151111521115311154111551115611157111581115911160111611116211163111641116511166111671116811169111701117111172111731117411175111761117711178111791118011181111821118311184111851118611187111881118911190111911119211193111941119511196111971119811199112001120111202112031120411205112061120711208112091121011211112121121311214112151121611217112181121911220112211122211223112241122511226112271122811229112301123111232112331123411235112361123711238112391124011241112421124311244112451124611247112481124911250112511125211253112541125511256112571125811259112601126111262112631126411265112661126711268112691127011271112721127311274112751127611277112781127911280112811128211283112841128511286112871128811289112901129111292112931129411295
  1. {
  2. This file is part of the Free Component Library (FCL)
  3. Copyright (c) 2014 by Michael Van Canneyt
  4. Pascal to Javascript converter class.
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************
  11. }(*
  12. Abstract:
  13. Converts TPasElements into TJSElements.
  14. Works:
  15. - units, programs
  16. - unit interface function
  17. - uses list
  18. - use $impl for implementation declarations, can be disabled
  19. - interface vars
  20. - only double, no other float type
  21. - only string, no other string type
  22. - modifier public to protect from removing by optimizer
  23. - implementation vars
  24. - external vars
  25. - initialization section
  26. - option to add "use strict";
  27. - procedures
  28. - params
  29. - local vars
  30. - default values
  31. - function results
  32. - modifier external 'name'
  33. - local const: declare in singleton parent function as local var
  34. - give procedure overloads in module unique names by appending $1, $2, ...
  35. - give nested procedure overloads unique names by appending $1, $2, ...
  36. - untyped parameter
  37. - varargs
  38. - modifier public to protect from removing by optimizer
  39. - assign statements
  40. - char
  41. - literals
  42. - ord(char) -> char.charCodeAt()
  43. - chr(integer) -> String.fromCharCode(integer)
  44. - string
  45. - literals
  46. - setlength(s,newlen) -> s.length == newlen
  47. - read and write char aString[]
  48. - allow only String, no ShortString, AnsiString, UnicodeString,...
  49. - allow type casting string to external class name 'String'
  50. - for loop
  51. - if loopvar is used afterwards append if($loopend>i)i--;
  52. - repeat..until
  53. - while..do
  54. - try..finally
  55. - try..except, try..except on else
  56. - raise, raise E
  57. - asm..end
  58. - assembler; asm..end;
  59. - break
  60. - continue
  61. - procedure str, function str
  62. - type alias
  63. - inc/dec to += -=
  64. - case-of
  65. - convert "a div b" to "Math.floor(a / b)"
  66. - and, or, xor, not: logical and bitwise
  67. - typecast boolean to integer and back
  68. - rename name conflicts with js identifiers: apply, bind, call, prototype, ...
  69. - record
  70. - types and vars
  71. - assign
  72. - clone record member
  73. - clone set member
  74. - clone when passing as argument
  75. - equal, not equal
  76. - classes
  77. - declare using createClass
  78. - constructor
  79. - destructor
  80. - vars, init on create, clear references on destroy
  81. - class vars
  82. - ancestor
  83. - virtual, override, abstract
  84. - "is" operator
  85. - "as" operator
  86. - call inherited "inherited;", "inherited funcname;"
  87. - call class method
  88. - read/write class var
  89. - property
  90. - param list
  91. - property of type array
  92. - class property
  93. - accessors non static
  94. - Assigned()
  95. - default property
  96. - type casts
  97. - overloads, reintroduce append $1, $2, ...
  98. - reintroduced variables
  99. - external vars and methods
  100. - const
  101. - bracket accessor, getter/setter has external name '[]'
  102. - dynamic arrays
  103. - arrays can be null
  104. - init as "arr = []" so typeof works
  105. - SetLength(arr,len) becomes arr = SetLength(arr,len,defaultvalue)
  106. - length(), low(), high(), assigned(), concat()
  107. - assign nil -> [] so typeof works
  108. - read, write element arr[index]
  109. - multi dimensional [index1,index2] -> [index1][index2]
  110. - array of record
  111. - equal, unequal nil -> rtl.length(array)==0 or >0
  112. - when passing nil to an array argument, pass []
  113. - allow type casting array to external class name 'Array'
  114. - type cast array to array of same dimensions and compatible element type
  115. - function copy(array,start=0,count=max): array
  116. - procedure insert(item,var array,const position)
  117. - procedure delete(var array,const start,count)
  118. - static arrays
  119. - range: enumtype
  120. - init as arr = rtl.arrayNewMultiDim([dim1,dim2,...],value)
  121. - init with expression
  122. - length(1-dim array)
  123. - low(1-dim array), high(1-dim array)
  124. - open arrays
  125. - as dynamic arrays
  126. - enums
  127. - type with values and names
  128. - option to write numbers instead of variables
  129. - ord(), low(), high(), pred(), succ()
  130. - type cast alias to enumtype
  131. - type cast number to enumtype
  132. - const aliasname = enumvalue
  133. - sets
  134. - set of enum
  135. - include, exclude, clone when referenced
  136. - assign := set state referenced
  137. - constant set: enums, enum vars, ranges
  138. - set operators +, -, *, ><, =, <>, >=, <=
  139. - in-operator
  140. - low(), high()
  141. - when passing as argument set state referenced
  142. - with-do using local var
  143. - with record do i:=v;
  144. - with classinstance do begin create; i:=v; f(); i:=a[]; end;
  145. - pass by reference
  146. - pass local var to a var/out parameter
  147. - pass variable to a var/out parameter
  148. - pass reference to a var/out parameter
  149. - pass array element to a var/out parameter
  150. - procedure types
  151. - implemented as immutable wrapper function
  152. - assign := nil, proctype (not clone), @function, @method
  153. - call explicit and implicit
  154. - compare equal and notequal with nil, proctype, address, function
  155. - assigned(proctype)
  156. - pass as argument
  157. - methods
  158. - mode delphi: proctype:=proc
  159. - mode delphi: functype=funcresulttype
  160. - nested functions
  161. - class-of
  162. - assign := nil, var
  163. - call class method
  164. - call constructor
  165. - operators =, <>
  166. - class var, property, method
  167. - Self in class method
  168. - typecast
  169. - class external
  170. - JS object or function as ancestor
  171. - does not descend from TObject
  172. - all members become external. case sensitive
  173. - has no hidden values like $class, $ancestor, $unitname, $init, $final
  174. - can be ancestor of a pascal class (not descend from TObject).
  175. - pascal class descendant can override methods
  176. - property works as normal, replaced by getter and setter
  177. - class-of
  178. - class var/function: works as in JS.
  179. - is and as operators
  180. - destructor forbidden
  181. - constructor must not be virtual
  182. - constructor 'new' -> new extclass(params)
  183. - identifiers are renamed to avoid clashes with external names
  184. - call inherited
  185. - Pascal descendant can override newinstance
  186. - any class can be typecasted to any root class
  187. - class instances cannot access external class members (e.g. static class functions)
  188. - external class 'Array' bracket operator [integer] type jsvalue
  189. - external class 'Object' bracket operator [string] type jsvalue
  190. - jsvalue
  191. - init as undefined
  192. - assign to jsvalue := integer, string, boolean, double, char
  193. - type cast base types to jsvalue
  194. - type cast jsvalue to base type
  195. integer: Math.floor(jsvalue) may return NaN
  196. boolean: !(jsvalue == false) works for numbers too 0==false
  197. double: rtl.getNumber(jsvalue) typeof(n)=="number"?n:NaN;
  198. string: ""+jsvalue
  199. char: rtl.getChar(jsvalue) ((typeof(c)!="string") && (c.length==1)) ? c : ""
  200. - enums: assign to jsvalue, typecast jsvalue to enum
  201. - class instance: assign to jsvalue, typecast jsvalue to a class
  202. - class of: assign to jsvalue, typecast jsvalue to a class-of
  203. - array of jsvalue,
  204. allow to assign any array to an array of jsvalue
  205. allow type casting to any array
  206. - parameter, result type, assign from/to untyped
  207. - operators equal, not equal
  208. - callback: assign to jsvalue, equal, not equal
  209. - RTTI
  210. - base types
  211. - unit $rtti
  212. - enum type tkEnumeration
  213. - set type tkSet
  214. - procedure type tkProcVar, tkMethod
  215. - class type tkClass
  216. - fields,
  217. - methods,
  218. - properties no params, no index, no defaultvalue
  219. - class forward
  220. - class-of type tkClassRef
  221. - dyn array type tkDynArray
  222. - static array type tkArray
  223. - record type tkRecord
  224. - no typeinfo for local types
  225. - built-in function typeinfo(): Pointer/TTypeInfo/...;
  226. - typeinfo(class) -> class.$rtti
  227. - WPO skip not used typeinfo
  228. - pointer
  229. - compare with and assign nil
  230. - ECMAScript6:
  231. - use 0b for binary literals
  232. - use 0o for octal literals
  233. ToDos:
  234. - move pas.System calls from rtl.js to system unit initialization, because of
  235. UseLowerCase and WPO
  236. - RTTI
  237. - codetools function typeinfo
  238. - jsinteger (pasresolver: btIntDouble)
  239. - class property
  240. - defaultvalue
  241. - type alias type
  242. - typinfo.pp functions to get/setprop
  243. - warn int64
  244. - local var absolute
  245. - make -Jirtl.js default for -Jc and -Tnodejs, needs #IFDEF in cfg
  246. - FuncName:= (instead of Result:=)
  247. - $modeswitch -> define <modeswitch>
  248. - $modeswitch- -> turn off
  249. - check memleaks
  250. - integer range
  251. - @@ compare method in delphi mode
  252. - make records more lightweight
  253. - dotted unit names, namespaces
  254. - enumeration for..in..do
  255. - pointer of record
  256. - nested types in class
  257. - asm: pas() - useful for overloads and protect an identifier from optimization
  258. - source maps
  259. - ifthen
  260. Not in Version 1.0:
  261. - write, writeln
  262. - arrays
  263. - static array: non 0 start index, length
  264. - array of static array: setlength
  265. - array range char, char range, integer range, enum range
  266. - array of const
  267. - sets
  268. - set of char, boolean, integer range, char range, enum range
  269. - set of (enum,enum2) - anonymous enumtype
  270. - call array of proc element without ()
  271. - record const
  272. - class: property modifier index
  273. - enums with custom values
  274. - library
  275. - option typecast checking
  276. - option verify method calls -CR
  277. - option range checking -Cr
  278. - option overflow checking -Co
  279. - optimizations:
  280. - set operators on literals without temporary arrays, a in [b], [a]*b<>[]
  281. - use a number for small sets
  282. -O1 insert local/unit vars for global type references:
  283. at start of intf var $r1;
  284. at end of impl: $r1=path;
  285. -O1 insert unit vars for complex literals
  286. -O1 no function Result var when assigned only once
  287. - SetLength(scope.a,l) -> read scope only once, same for
  288. Include, Exclude, Inc, Dec
  289. -O1 replace constant expression with result
  290. -O1 pass array element by ref: when index is constant, use that directly
  291. - objects, interfaces, advanced records
  292. - class helpers, type helpers, record helpers,
  293. - generics
  294. - operator overloading
  295. - inline
  296. - anonymous functions
  297. Compile flags for debugging: -d<x>
  298. VerbosePas2JS
  299. *)
  300. unit fppas2js;
  301. {$mode objfpc}{$H+}
  302. {$inline on}
  303. interface
  304. uses
  305. Classes, SysUtils, math, contnrs, jsbase, jstree, PasTree, PScanner,
  306. PasResolver;
  307. // message numbers
  308. const
  309. nPasElementNotSupported = 4001;
  310. nIdentifierNotFound = 4002;
  311. nUnaryOpcodeNotSupported = 4003;
  312. nBinaryOpcodeNotSupported = 4004;
  313. nInvalidNumber = 4005;
  314. nInitializedArraysNotSupported = 4006;
  315. nMemberExprMustBeIdentifier = 4007;
  316. nCantWriteSetLiteral = 4008;
  317. nVariableIdentifierExpected = 4009;
  318. nExpectedXButFoundY = 4010;
  319. nInvalidFunctionReference = 4011;
  320. nMissingExternalName = 4012;
  321. nVirtualMethodNameMustMatchExternal = 4013;
  322. nPublishedNameMustMatchExternal = 4014;
  323. nInvalidVariableModifier = 4015;
  324. nNoArgumentsAllowedForExternalObjectConstructor = 4016;
  325. nNewInstanceFunctionMustBeVirtual = 4017;
  326. nNewInstanceFunctionMustHaveTwoParameters = 4018;
  327. nNewInstanceFunctionMustNotHaveOverloadAtX = 4019;
  328. nBracketAccessorOfExternalClassMustHaveOneParameter = 4020;
  329. nTypeXCannotBePublished = 4021;
  330. // resourcestring patterns of messages
  331. resourcestring
  332. sPasElementNotSupported = 'Pascal element not supported: %s';
  333. sIdentifierNotFound = 'Identifier not found "%s"';
  334. sUnaryOpcodeNotSupported = 'Unary OpCode not yet supported "%s"';
  335. sBinaryOpcodeNotSupported = 'Binary OpCode not yet supported "%s"';
  336. sInvalidNumber = 'Invalid number "%s"';
  337. sInitializedArraysNotSupported = 'Initialized array variables not yet supported';
  338. sMemberExprMustBeIdentifier = 'Member expression must be an identifier';
  339. sCantWriteSetLiteral = 'Cannot write set literal';
  340. sVariableIdentifierExpected = 'Variable identifier expected';
  341. sExpectedXButFoundY = 'Expected %s, but found %s';
  342. sInvalidFunctionReference = 'Invalid function reference';
  343. sMissingExternalName = 'Missing external name';
  344. sVirtualMethodNameMustMatchExternal = 'Virtual method name must match external';
  345. sInvalidVariableModifier = 'Invalid variable modifier "%s"';
  346. sPublishedNameMustMatchExternal = 'Published name must match external';
  347. sNoArgumentsAllowedForExternalObjectConstructor = 'no arguments allowed for external object constructor';
  348. sNewInstanceFunctionMustBeVirtual = 'NewInstance function must be virtual';
  349. sNewInstanceFunctionMustHaveTwoParameters = 'NewInstance function must have two parameters';
  350. sNewInstanceFunctionMustNotHaveOverloadAtX = 'NewInstance function must not have overload at %s';
  351. sBracketAccessorOfExternalClassMustHaveOneParameter = 'Bracket accessor of external class must have one parameter';
  352. sTypeXCannotBePublished = 'Type "%s" cannot be published';
  353. const
  354. ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
  355. type
  356. TPas2JSBuiltInName = (
  357. pbifnArray_Concat,
  358. pbifnArray_Copy,
  359. pbifnArray_Length,
  360. pbifnArray_NewMultiDim,
  361. pbifnArray_SetLength,
  362. pbifnAs,
  363. pbifnAsExt,
  364. pbifnClassInstanceFree,
  365. pbifnClassInstanceNew,
  366. pbifnCreateClass,
  367. pbifnCreateClassExt,
  368. pbifnGetChar,
  369. pbifnGetNumber,
  370. pbifnGetObject,
  371. pbifnIs,
  372. pbifnIsExt,
  373. pbifnProcType_Create,
  374. pbifnProcType_Equal,
  375. pbifnProgramMain,
  376. pbifnRecordEqual,
  377. pbifnRTTIAddField, // typeinfos of tkclass and tkrecord have addField
  378. pbifnRTTIAddFields, // typeinfos of tkclass and tkrecord have addFields
  379. pbifnRTTIAddMethod,// " "
  380. pbifnRTTIAddProperty,// " "
  381. pbifnRTTINewClass,// typeinfo creator of tkClass $Class
  382. pbifnRTTINewClassRef,// typeinfo of tkClassRef $ClassRef
  383. pbifnRTTINewEnum,// typeinfo of tkEnumeration $Enum
  384. pbifnRTTINewDynArray,// typeinfo of tkDynArray $DynArray
  385. pbifnRTTINewMethodVar,// typeinfo of tkMethod $MethodVar
  386. pbifnRTTINewPointer,// typeinfo of tkPointer $Pointer
  387. pbifnRTTINewProcSig,// rtl.newTIProcSig
  388. pbifnRTTINewProcVar,// typeinfo of tkProcVar $ProcVar
  389. pbifnRTTINewRecord,// typeinfo creator of tkRecord $Record
  390. pbifnRTTINewSet,// typeinfo of tkSet $Set
  391. pbifnRTTINewStaticArray,// typeinfo of tkArray $StaticArray
  392. pbifnSetCharAt,
  393. pbifnSet_Clone,
  394. pbifnSet_Create,
  395. pbifnSet_Difference,
  396. pbifnSet_Equal,
  397. pbifnSet_Exclude,
  398. pbifnSet_GreaterEqual,
  399. pbifnSet_Include,
  400. pbifnSet_Intersect,
  401. pbifnSet_LowerEqual,
  402. pbifnSet_NotEqual,
  403. pbifnSet_Reference,
  404. pbifnSet_SymDiffSet,
  405. pbifnSet_Union,
  406. pbifnSpaceLeft,
  407. pbifnUnitInit,
  408. pbivnExceptObject,
  409. pbivnImplementation,
  410. pbivnLoopEnd,
  411. pbivnModules,
  412. pbivnPtrClass,
  413. pbivnRTL,
  414. pbivnRTTI, // $rtti
  415. pbivnRTTIArray_Dims,
  416. pbivnRTTIArray_ElType,
  417. pbivnRTTIClassRef_InstanceType,
  418. pbivnRTTIEnum_EnumType,
  419. pbivnRTTIInt_MaxValue,
  420. pbivnRTTIInt_MinValue,
  421. pbivnRTTILocal, // $r
  422. pbivnRTTIMethodKind, // tTypeInfoMethodVar has methodkind
  423. pbivnRTTIPointer_RefType,
  424. pbivnRTTIProcFlags,
  425. pbivnRTTIProcVar_ProcSig,
  426. pbivnRTTIPropDefault,
  427. pbivnRTTIPropStored,
  428. pbivnRTTISet_CompType,
  429. pbivnWith,
  430. pbitnTI,
  431. pbitnTIClass,
  432. pbitnTIClassRef,
  433. pbitnTIDynArray,
  434. pbitnTIEnum,
  435. pbitnTIInteger,
  436. pbitnTIMethodVar,
  437. pbitnTIPointer,
  438. pbitnTIProcVar,
  439. pbitnTIRecord,
  440. pbitnTISet,
  441. pbitnTIStaticArray
  442. );
  443. const
  444. Pas2JSBuiltInNames: array[TPas2JSBuiltInName] of string = (
  445. 'arrayConcat', // rtl.arrayConcat
  446. 'arrayCopy', // rtl.arrayCopy
  447. 'length', // rtl.length
  448. 'arrayNewMultiDim', // rtl.arrayNewMultiDim
  449. 'arraySetLength', // rtl.arraySetLength
  450. 'as', // rtl.as
  451. 'asExt', // rtl.asExt
  452. '$destroy',
  453. '$create',
  454. 'createClass', // rtl.createClass
  455. 'createClassExt', // rtl.createClassExt
  456. 'getChar', // rtl.getChar
  457. 'getNumber', // rtl.getNumber
  458. 'getObject', // rtl.getObject
  459. 'is', // rtl.is
  460. 'isExt', // rtl.isExt
  461. 'createCallback', // rtl.createCallback
  462. 'eqCallback', // rtl.eqCallback
  463. '$main',
  464. '$equal',
  465. 'addField',
  466. 'addFields',
  467. 'addMethod',
  468. 'addProperty',
  469. '$Class',
  470. '$ClassRef',
  471. '$Enum',
  472. '$DynArray',
  473. '$MethodVar',
  474. '$Pointer',
  475. 'newTIProcSig',
  476. '$ProcVar',
  477. '$Record',
  478. '$Set',
  479. '$StaticArray',
  480. 'setCharAt', // rtl.setCharAt
  481. 'cloneSet', // rtl.cloneSet
  482. 'createSet', // rtl.createSet [...]
  483. 'diffSet', // rtl.diffSet -
  484. 'eqSet', // rtl.eqSet =
  485. 'excludeSet', // rtl.excludeSet
  486. 'geSet', // rtl.geSet superset >=
  487. 'includeSet', // rtl.includeSet
  488. 'intersectSet', // rtl.intersectSet *
  489. 'leSet', // rtl.leSet subset <=
  490. 'neSet', // rtl.neSet <>
  491. 'refSet', // rtl.refSet
  492. 'symDiffSet', // rtl.symDiffSet >< (symmetrical difference)
  493. 'unionSet', // rtl.unionSet +
  494. 'spaceLeft', // rtl.spaceLeft
  495. '$init',
  496. '$e',
  497. '$impl',
  498. '$loopend',
  499. 'pas',
  500. '$class',
  501. 'rtl',
  502. '$rtti',
  503. 'dims',
  504. 'eltype',
  505. 'instancetype',
  506. 'enumtype',
  507. 'maxvalue',
  508. 'minvalue',
  509. '$r',
  510. 'methodkind',
  511. 'reftype',
  512. 'flags',
  513. 'procsig',
  514. 'defaultvalue',
  515. 'stored',
  516. 'comptype',
  517. '$with',
  518. 'tTypeInfo',
  519. 'tTypeInfoClass',
  520. 'tTypeInfoClassRef',
  521. 'tTypeInfoDynArray',
  522. 'tTypeInfoEnum',
  523. 'tTypeInfoInteger',
  524. 'tTypeInfoMethodVar',
  525. 'tTypeInfoPointer',
  526. 'tTypeInfoProcVar',
  527. 'tTypeInfoRecord',
  528. 'tTypeInfoSet',
  529. 'tTypeInfoStaticArray'
  530. );
  531. JSReservedWords: array[0..106] of string = (
  532. // keep sorted, first uppercase, then lowercase !
  533. 'Array',
  534. 'ArrayBuffer',
  535. 'Boolean',
  536. 'DataView',
  537. 'Date',
  538. 'Error',
  539. 'EvalError',
  540. 'Float32Array',
  541. 'Float64Array',
  542. 'Generator',
  543. 'GeneratorFunction',
  544. 'Infinity',
  545. 'Int16Array',
  546. 'Int32Array',
  547. 'Int8Array',
  548. 'InternalError',
  549. 'JSON',
  550. 'Map',
  551. 'Math',
  552. 'NaN',
  553. 'Number',
  554. 'Object',
  555. 'Promise',
  556. 'Proxy',
  557. 'RangeError',
  558. 'ReferenceError',
  559. 'Reflect',
  560. 'RegExp',
  561. 'Set',
  562. 'String',
  563. 'Symbol',
  564. 'SyntaxError',
  565. 'TypeError',
  566. 'URIError',
  567. 'Uint16Array',
  568. 'Uint32Array',
  569. 'Uint8Array',
  570. 'Uint8ClampedArray',
  571. 'WeakMap',
  572. 'WeakSet',
  573. '__extends',
  574. '_super',
  575. 'anonymous',
  576. 'apply',
  577. 'arguments',
  578. 'array',
  579. 'await',
  580. 'bind',
  581. 'break',
  582. 'call',
  583. 'case',
  584. 'catch',
  585. 'class',
  586. 'constructor',
  587. 'continue',
  588. 'decodeURI',
  589. 'decodeURIComponent',
  590. 'default',
  591. 'delete',
  592. 'do',
  593. 'each',
  594. 'else',
  595. 'encodeURI',
  596. 'encodeURIComponent',
  597. 'enum',
  598. 'escape',
  599. 'eval',
  600. 'export',
  601. 'extends',
  602. 'false',
  603. 'for',
  604. 'function',
  605. 'getPrototypeOf',
  606. 'if',
  607. 'implements',
  608. 'import',
  609. 'in',
  610. 'instanceof',
  611. 'interface',
  612. 'isFinite',
  613. 'isNaN',
  614. 'isPrototypeOf',
  615. 'let',
  616. 'new',
  617. 'null',
  618. 'package',
  619. 'parseFloat',
  620. 'parseInt',
  621. 'private',
  622. 'protected',
  623. 'prototype',
  624. 'public',
  625. 'return',
  626. 'static',
  627. 'super',
  628. 'switch',
  629. 'this',
  630. 'throw',
  631. 'true',
  632. 'try',
  633. 'undefined',
  634. 'unescape',
  635. 'uneval',
  636. 'var',
  637. 'while',
  638. 'with',
  639. 'yield'
  640. );
  641. const
  642. ClassVarModifiersType = [vmClass,vmStatic];
  643. LowJSInteger = -$10000000000000;
  644. HighJSInteger = $fffffffffffff;
  645. LowJSBoolean = false;
  646. HighJSBoolean = true;
  647. Type
  648. { EPas2JS }
  649. EPas2JS = Class(Exception)
  650. public
  651. PasElement: TPasElement;
  652. MsgNumber: integer;
  653. Args: TMessageArgs;
  654. Id: int64;
  655. MsgType: TMessageType;
  656. end;
  657. //------------------------------------------------------------------------------
  658. // Pas2js built-in types
  659. type
  660. TPas2jsBaseType = (
  661. pbtNone,
  662. pbtJSValue
  663. );
  664. TPas2jsBaseTypes = set of TPas2jsBaseType;
  665. const
  666. Pas2jsBaseTypeNames: array[TPas2jsBaseType] of string = (
  667. 'None',
  668. 'JSValue'
  669. );
  670. btAllJSValueSrcTypes = [btNil,btUntyped,btPointer]+btAllInteger
  671. +btAllStringAndChars+btAllFloats+btAllBooleans;
  672. btAllJSValueTypeCastTo = btAllInteger
  673. +btAllStringAndChars+btAllFloats+btAllBooleans+[btPointer];
  674. //------------------------------------------------------------------------------
  675. // Element CustomData
  676. type
  677. { TPas2JsElementData }
  678. TPas2JsElementData = Class(TPasElementBase)
  679. private
  680. FElement: TPasElement;
  681. procedure SetElement(const AValue: TPasElement);
  682. public
  683. Owner: TObject; // e.g. a TPasToJSConverter
  684. Next: TPas2JsElementData; // TPasToJSConverter uses this for its memory chain
  685. constructor Create; virtual;
  686. destructor Destroy; override;
  687. property Element: TPasElement read FElement write SetElement; // can be TPasElement
  688. end;
  689. TPas2JsElementDataClass = class of TPas2JsElementData;
  690. { TP2JConstExprData - CustomData of a const TPasExpr }
  691. TP2JConstExprData = Class(TPas2JsElementData)
  692. public
  693. // Element is TPasExpr
  694. Value: TJSValue;
  695. destructor Destroy; override;
  696. end;
  697. TPas2JSClassScope = class(TPasClassScope)
  698. public
  699. NewInstanceFunction: TPasClassFunction;
  700. end;
  701. { TPas2JSWithExprScope }
  702. TPas2JSWithExprScope = class(TPasWithExprScope)
  703. public
  704. WithVarName: string;
  705. end;
  706. { TResElDataPas2JSBaseType - CustomData for compiler built-in types (TPasUnresolvedSymbolRef), e.g. jsvalue }
  707. TResElDataPas2JSBaseType = class(TResElDataBaseType)
  708. public
  709. JSBaseType: TPas2jsBaseType;
  710. end;
  711. //------------------------------------------------------------------------------
  712. // TPas2JSResolver
  713. const
  714. btAllPas2jsBaseTypes = [
  715. btChar,
  716. btString,
  717. btDouble,
  718. btBoolean,
  719. //btByteBool,
  720. //btWordBool,
  721. //btLongBool,
  722. //btQWordBool,
  723. btByte,
  724. btShortInt,
  725. btWord,
  726. btSmallInt,
  727. btLongWord,
  728. btCardinal,
  729. btLongint,
  730. //btQWord,
  731. btInt64,
  732. btPointer
  733. //btFile,
  734. //btText,
  735. //btVariant
  736. ];
  737. bfAllPas2jsBaseProcs = bfAllStandardProcs;
  738. DefaultPasResolverOptions = [
  739. proFixCaseOfOverrides,
  740. proClassPropertyNonStatic,
  741. proPropertyAsVarParam,
  742. proClassOfIs,
  743. proExtClassInstanceNoTypeMembers,
  744. proOpenAsDynArrays,
  745. proProcTypeWithoutIsNested
  746. ];
  747. type
  748. TPas2JSResolver = class(TPasResolver)
  749. private
  750. FJSBaseTypes: array[TPas2jsBaseType] of TPasUnresolvedSymbolRef;
  751. FExternalNames: TFPHashList; // list of list of TPasIdentifier
  752. FFirstElementData, FLastElementData: TPas2JsElementData;
  753. function GetJSBaseTypes(aBaseType: TPas2jsBaseType): TPasUnresolvedSymbolRef; inline;
  754. procedure InternalAdd(Item: TPasIdentifier);
  755. procedure OnClearHashItem(Item, Dummy: pointer);
  756. protected
  757. FOverloadScopes: TFPList; // list of TPasIdentifierScope
  758. function HasOverloadIndex(El: TPasElement): boolean; virtual;
  759. function GetOverloadIndex(Identifier: TPasIdentifier;
  760. StopAt: TPasElement): integer;
  761. function GetOverloadAt(Identifier: TPasIdentifier; var Index: integer): TPasIdentifier;
  762. function GetOverloadIndex(El: TPasElement): integer;
  763. function GetOverloadAt(const aName: String; Index: integer): TPasIdentifier;
  764. function RenameOverload(El: TPasElement): boolean;
  765. procedure RenameOverloadsInSection(aSection: TPasSection);
  766. procedure RenameOverloads(DeclEl: TPasElement; Declarations: TFPList);
  767. procedure RenameSubOverloads(Declarations: TFPList);
  768. procedure PushOverloadScope(Scope: TPasIdentifierScope);
  769. procedure PopOverloadScope;
  770. procedure ResolveImplAsm(El: TPasImplAsmStatement); override;
  771. procedure FinishModule(CurModule: TPasModule); override;
  772. procedure FinishClassType(El: TPasClassType); override;
  773. procedure FinishVariable(El: TPasVariable); override;
  774. procedure FinishProcedureType(El: TPasProcedureType); override;
  775. procedure FinishPropertyOfClass(PropEl: TPasProperty); override;
  776. procedure CheckNewInstanceFunction(ClassScope: TPas2JSClassScope); virtual;
  777. function AddExternalName(const aName: string; El: TPasElement): TPasIdentifier; virtual;
  778. function FindExternalName(const aName: String): TPasIdentifier; virtual;
  779. procedure AddExternalPath(aName: string; El: TPasElement);
  780. procedure ClearElementData; virtual;
  781. protected
  782. // additional base types
  783. function AddJSBaseType(const aName: string; Typ: TPas2jsBaseType): TResElDataPas2JSBaseType;
  784. function IsJSBaseType(TypeEl: TPasType; Typ: TPas2jsBaseType): boolean;
  785. function IsJSBaseType(const TypeResolved: TPasResolverResult;
  786. Typ: TPas2jsBaseType; HasValue: boolean = false): boolean;
  787. function CheckAssignCompatibilityCustom(const LHS,
  788. RHS: TPasResolverResult; ErrorEl: TPasElement;
  789. RaiseOnIncompatible: boolean; var Handled: boolean): integer; override;
  790. function CheckTypeCastClassInstanceToClass(const FromClassRes,
  791. ToClassRes: TPasResolverResult; ErrorEl: TPasElement): integer; override;
  792. function CheckEqualCompatibilityCustomType(const LHS,
  793. RHS: TPasResolverResult; ErrorEl: TPasElement;
  794. RaiseOnIncompatible: boolean): integer; override;
  795. procedure BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
  796. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); override;
  797. public
  798. constructor Create;
  799. destructor Destroy; override;
  800. // base types
  801. procedure AddObjFPCBuiltInIdentifiers(
  802. const TheBaseTypes: TResolveBaseTypes;
  803. const TheBaseProcs: TResolverBuiltInProcs); override;
  804. function CheckTypeCastRes(const FromResolved,
  805. ToResolved: TPasResolverResult; ErrorEl: TPasElement;
  806. RaiseOnError: boolean): integer; override;
  807. property JSBaseTypes[aBaseType: TPas2jsBaseType]: TPasUnresolvedSymbolRef read GetJSBaseTypes;
  808. // compute literals and constants
  809. function ExtractPasStringLiteral(El: TPasElement; const S: String): TJSString; virtual;
  810. function ComputeConst(Expr: TPasExpr; StoreCustomData: boolean): TJSValue; virtual;
  811. function ComputeConstString(Expr: TPasExpr; StoreCustomData, NotEmpty: boolean): String; virtual;
  812. function IsExternalBracketAccessor(El: TPasElement): boolean;
  813. // CustomData
  814. function GetElementData(El: TPasElementBase;
  815. DataClass: TPas2JsElementDataClass): TPas2JsElementData; virtual;
  816. procedure AddElementData(Data: TPas2JsElementData); virtual;
  817. function CreateElementData(DataClass: TPas2JsElementDataClass;
  818. El: TPasElement): TPas2JsElementData; virtual;
  819. // utility
  820. function HasTypeInfo(El: TPasType): boolean; override;
  821. end;
  822. //------------------------------------------------------------------------------
  823. // TConvertContext
  824. type
  825. TCtxJSElementKind = (
  826. cjkRoot,
  827. cjkObject,
  828. cjkFunction,
  829. cjkArray,
  830. cjkDot);
  831. TCtxAccess = (
  832. caRead, // normal read
  833. caAssign, // needs setter
  834. caByReference // needs path, getter and setter
  835. );
  836. TFunctionContext = Class;
  837. { TConvertContext }
  838. TConvertContextClass = Class of TConvertContext;
  839. TConvertContext = Class(TObject)
  840. public
  841. PasElement: TPasElement;
  842. JSElement: TJSElement;
  843. Resolver: TPas2JSResolver;
  844. Parent: TConvertContext;
  845. Kind: TCtxJSElementKind;
  846. IsSingleton: boolean;
  847. Access: TCtxAccess;
  848. AccessContext: TConvertContext;
  849. TmpVarCount: integer;
  850. constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); virtual;
  851. function GetRootModule: TPasModule;
  852. function GetThis: TPasElement;
  853. function GetThisContext: TFunctionContext;
  854. function GetContextOfType(aType: TConvertContextClass): TConvertContext;
  855. function CreateLocalIdentifier(const Prefix: string): string;
  856. function CurrentModeswitches: TModeSwitches;
  857. function GetSingletonFunc: TFunctionContext;
  858. end;
  859. { TRootContext }
  860. TRootContext = Class(TConvertContext)
  861. public
  862. constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
  863. end;
  864. { TFunctionContext }
  865. TFunctionContext = Class(TConvertContext)
  866. public
  867. This: TPasElement;
  868. constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
  869. end;
  870. { TObjectContext }
  871. TObjectContext = Class(TConvertContext)
  872. public
  873. constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
  874. end;
  875. { TSectionContext - interface/implementation/program/library }
  876. TSectionContext = Class(TFunctionContext)
  877. public
  878. constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
  879. end;
  880. { TDotContext - used for converting eopSubIdent }
  881. TDotContext = Class(TConvertContext)
  882. public
  883. LeftResolved: TPasResolverResult;
  884. constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
  885. end;
  886. { TAssignContext - used for left side of an assign statement }
  887. TAssignContext = Class(TConvertContext)
  888. public
  889. // set when creating:
  890. LeftResolved: TPasResolverResult;
  891. RightResolved: TPasResolverResult;
  892. RightSide: TJSElement;
  893. // created by ConvertElement:
  894. PropertyEl: TPasProperty;
  895. Setter: TPasElement;
  896. Call: TJSCallExpression;
  897. constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
  898. end;
  899. { TParamContext }
  900. TParamContext = Class(TConvertContext)
  901. public
  902. // set when creating:
  903. Arg: TPasArgument;
  904. Expr: TPasExpr;
  905. ResolvedExpr: TPasResolverResult;
  906. // created by ConvertElement:
  907. Getter: TJSElement;
  908. Setter: TJSElement;
  909. ReusingReference: boolean; // true = result is a reference, do not create another
  910. constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
  911. end;
  912. //------------------------------------------------------------------------------
  913. // TPasToJSConverter
  914. type
  915. TPasToJsConverterOption = (
  916. coLowerCase, // lowercase all identifiers, except conflicts with JS reserved words
  917. coSwitchStatement, // convert case-of into switch instead of if-then-else
  918. coEnumNumbers, // use enum numbers instead of names
  919. coUseStrict, // insert 'use strict'
  920. coNoTypeInfo // do not generate RTTI
  921. );
  922. TPasToJsConverterOptions = set of TPasToJsConverterOption;
  923. TPas2JSIsElementUsedEvent = function(Sender: TObject; El: TPasElement): boolean of object;
  924. TPasToJsPlatform = (
  925. PlatformBrowser,
  926. PlatformNodeJS
  927. );
  928. TPasToJsPlatforms = set of TPasToJsPlatform;
  929. const
  930. PasToJsPlatformNames: array[TPasToJsPlatform] of string = (
  931. 'Browser',
  932. 'NodeJS'
  933. );
  934. type
  935. TPasToJsProcessor = (
  936. ProcessorECMAScript5,
  937. ProcessorECMAScript6
  938. );
  939. TPasToJsProcessors = set of TPasToJsProcessor;
  940. const
  941. PasToJsProcessorNames: array[TPasToJsProcessor] of string = (
  942. 'ECMAScript5',
  943. 'ECMAScript6'
  944. );
  945. type
  946. TJSReservedWordList = array of String;
  947. TRefPathKind = (
  948. rpkPath, // e.g. "TObject"
  949. rpkPathWithDot, // e.g. "TObject."
  950. rpkPathAndName // e.g. "TObject.ClassName"
  951. );
  952. { TPasToJSConverter }
  953. TPasToJSConverter = Class(TObject)
  954. private
  955. // inline at top, only functions declared after the inline implementation actually use it
  956. function GetUseEnumNumbers: boolean; inline;
  957. function GetUseLowerCase: boolean; inline;
  958. function GetUseSwitchStatement: boolean; inline;
  959. private
  960. type
  961. TForLoopFindData = record
  962. ForLoop: TPasImplForLoop;
  963. LoopVar: TPasElement;
  964. FoundLoop: boolean;
  965. LoopVarWrite: boolean; // true if first acces of LoopVar after loop is a write
  966. LoopVarRead: boolean; // true if first acces of LoopVar after loop is a read
  967. end;
  968. PForLoopFindData = ^TForLoopFindData;
  969. procedure ForLoop_OnProcBodyElement(El: TPasElement; arg: pointer);
  970. private
  971. type
  972. TTryExceptFindData = record
  973. HasRaiseWithoutObject: boolean;
  974. end;
  975. PTryExceptFindData = ^TTryExceptFindData;
  976. procedure TryExcept_OnElement(El: TPasElement; arg: pointer);
  977. private
  978. FBuiltInNames: array[TPas2JSBuiltInName] of string;
  979. FOnIsElementUsed: TPas2JSIsElementUsedEvent;
  980. FOnIsTypeInfoUsed: TPas2JSIsElementUsedEvent;
  981. FOptions: TPasToJsConverterOptions;
  982. FPreservedWords: TJSReservedWordList; // sorted with CompareStr
  983. FTargetPlatform: TPasToJsPlatform;
  984. FTargetProcessor: TPasToJsProcessor;
  985. Function CreateBuiltInIdentifierExpr(AName: string): TJSPrimaryExpressionIdent;
  986. Function CreateDeclNameExpression(El: TPasElement; const Name: string;
  987. AContext: TConvertContext): TJSPrimaryExpressionIdent;
  988. Function CreateIdentifierExpr(AName: string; El: TPasElement; AContext: TConvertContext): TJSPrimaryExpressionIdent;
  989. Function CreateSwitchStatement(El: TPasImplCaseOf; AContext: TConvertContext): TJSElement;
  990. Function CreateTypeDecl(El: TPasType; AContext: TConvertContext): TJSElement;
  991. Function CreateVarDecl(El: TPasVariable; AContext: TConvertContext): TJSElement;
  992. Procedure AddToSourceElements(Src: TJSSourceElements; El: TJSElement);
  993. procedure RemoveFromSourceElements(Src: TJSSourceElements;
  994. El: TJSElement);
  995. function GetBuildInNames(bin: TPas2JSBuiltInName): string;
  996. procedure SetBuildInNames(bin: TPas2JSBuiltInName; const AValue: string);
  997. procedure SetPreservedWords(const AValue: TJSReservedWordList);
  998. procedure SetUseEnumNumbers(const AValue: boolean);
  999. procedure SetUseLowerCase(const AValue: boolean);
  1000. procedure SetUseSwitchStatement(const AValue: boolean);
  1001. protected
  1002. // Error functions
  1003. Procedure DoError(Id: int64; Const Msg : String);
  1004. Procedure DoError(Id: int64; Const Msg : String; Const Args : Array of Const);
  1005. Procedure DoError(Id: int64; MsgNumber: integer; const MsgPattern: string; Const Args : Array of Const; El: TPasElement);
  1006. procedure RaiseNotSupported(El: TPasElement; AContext: TConvertContext; Id: int64; const Msg: string = '');
  1007. procedure RaiseIdentifierNotFound(Identifier: string; El: TPasElement; Id: int64);
  1008. procedure RaiseInconsistency(Id: int64);
  1009. // Computation, value conversions
  1010. Function GetExpressionValueType(El: TPasExpr; AContext: TConvertContext ): TJSType; virtual;
  1011. Function GetPasIdentValueType(AName: String; AContext: TConvertContext): TJSType; virtual;
  1012. Function ComputeConstString(Expr: TPasExpr; AContext: TConvertContext; NotEmpty: boolean): String; virtual;
  1013. Function IsExternalClassConstructor(El: TPasElement): boolean;
  1014. Procedure ComputeRange(const RangeResolved: TPasResolverResult;
  1015. out MinValue, MaxValue: int64; ErrorEl: TPasElement); virtual;
  1016. // Name mangling
  1017. Function TransformVariableName(El: TPasElement; Const AName: String; AContext : TConvertContext): String; virtual;
  1018. Function TransformVariableName(El: TPasElement; AContext : TConvertContext) : String; virtual;
  1019. Function TransformModuleName(El: TPasModule; AContext : TConvertContext) : String; virtual;
  1020. Function IsPreservedWord(const aName: string): boolean; virtual;
  1021. // Never create an element manually, always use the below functions
  1022. Function IsElementUsed(El: TPasElement): boolean; virtual;
  1023. Function HasTypeInfo(El: TPasType; AContext: TConvertContext): boolean; virtual;
  1024. Function IsClassRTTICreatedBefore(aClass: TPasClassType; Before: TPasElement): boolean;
  1025. Function CreateElement(C: TJSElementClass; Src: TPasElement): TJSElement; virtual;
  1026. Function CreateFreeOrNewInstanceExpr(Ref: TResolvedReference;
  1027. AContext : TConvertContext): TJSCallExpression; virtual;
  1028. Function CreateFunction(El: TPasElement; WithBody: boolean = true;
  1029. WithSrc: boolean = false): TJSFunctionDeclarationStatement;
  1030. Procedure CreateProcedureCall(var Call: TJSCallExpression; Args: TParamsExpr;
  1031. TargetProc: TPasProcedureType; AContext: TConvertContext); virtual;
  1032. Procedure CreateProcedureCallArgs(Elements: TJSArrayLiteralElements;
  1033. Args: TParamsExpr; TargetProc: TPasProcedureType; AContext: TConvertContext); virtual;
  1034. Function CreateProcCallArg(El: TPasExpr; TargetArg: TPasArgument;
  1035. AContext: TConvertContext): TJSElement; virtual;
  1036. Function CreateProcCallArgRef(El: TPasExpr; ResolvedEl: TPasResolverResult;
  1037. TargetArg: TPasArgument; AContext: TConvertContext): TJSElement; virtual;
  1038. Function CreateUnary(Members: array of string; E: TJSElement): TJSUnary;
  1039. Function CreateMemberExpression(Members: array of string): TJSDotMemberExpression;
  1040. Function CreateCallExpression(El: TPasElement): TJSCallExpression;
  1041. Function CreateUsesList(UsesSection: TPasSection; AContext : TConvertContext): TJSArrayLiteral;
  1042. Procedure AddToStatementList(var First, Last: TJSStatementList;
  1043. Add: TJSElement; Src: TPasElement);
  1044. Function CreateValInit(PasType: TPasType; Expr: TPasElement; El: TPasElement;
  1045. AContext: TConvertContext): TJSElement; virtual;
  1046. Function CreateVarInit(El: TPasVariable; AContext: TConvertContext): TJSElement; virtual;
  1047. Function CreateVarStatement(const aName: String; Init: TJSElement;
  1048. El: TPasElement): TJSVariableStatement; virtual;
  1049. Function CreateVarDecl(const aName: String; Init: TJSElement; El: TPasElement): TJSVarDeclaration; virtual;
  1050. Function CreateLiteralNumber(El: TPasElement; const n: TJSNumber): TJSLiteral; virtual;
  1051. Function CreateLiteralString(El: TPasElement; const s: string): TJSLiteral; virtual;
  1052. Function CreateLiteralJSString(El: TPasElement; const s: TJSString): TJSLiteral; virtual;
  1053. Function CreateLiteralBoolean(El: TPasElement; b: boolean): TJSLiteral; virtual;
  1054. Function CreateLiteralNull(El: TPasElement): TJSLiteral; virtual;
  1055. Function CreateLiteralUndefined(El: TPasElement): TJSLiteral; virtual;
  1056. Function CreateRecordInit(aRecord: TPasRecordType; Expr: TPasElement;
  1057. El: TPasElement; AContext: TConvertContext): TJSElement; virtual;
  1058. Function CreateArrayInit(ArrayType: TPasArrayType; Expr: TPasElement;
  1059. El: TPasElement; AContext: TConvertContext): TJSElement; virtual;
  1060. Function CreateCmpArrayWithNil(El: TPasElement; JSArray: TJSElement;
  1061. OpCode: TExprOpCode): TJSElement; virtual;
  1062. Function CreateReferencePath(El: TPasElement; AContext : TConvertContext;
  1063. Kind: TRefPathKind; Full: boolean = false; Ref: TResolvedReference = nil): string; virtual;
  1064. Function CreateReferencePathExpr(El: TPasElement; AContext : TConvertContext;
  1065. Full: boolean = false; Ref: TResolvedReference = nil): TJSPrimaryExpressionIdent; virtual;
  1066. Function CreateImplementationSection(El: TPasModule; AContext: TConvertContext): TJSFunctionDeclarationStatement;
  1067. Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext);
  1068. Function CreateDotExpression(aParent: TPasElement; Left, Right: TJSElement): TJSElement; virtual;
  1069. Function CreateReferencedSet(El: TPasElement; SetExpr: TJSElement): TJSElement; virtual;
  1070. Function CreateCloneRecord(El: TPasElement; ResolvedEl: TPasResolverResult;
  1071. RecordExpr: TJSElement; AContext: TConvertContext): TJSElement; virtual;
  1072. Function CreateCallback(El: TPasElement; ResolvedEl: TPasResolverResult;
  1073. AContext: TConvertContext): TJSElement; virtual;
  1074. Function CreateAssignStatement(LeftEl: TPasElement; AssignContext: TAssignContext): TJSElement; virtual;
  1075. Function CreateTypeInfoRef(El: TPasType; AContext: TConvertContext;
  1076. ErrorEl: TPasElement): TJSElement; virtual;
  1077. Function CreateRTTIArgList(Parent: TPasElement; Args: TFPList;
  1078. AContext: TConvertContext): TJSElement; virtual;
  1079. Procedure AddRTTIArgument(Arg: TPasArgument; TargetParams: TJSArrayLiteral;
  1080. AContext: TConvertContext); virtual;
  1081. Function CreateRTTINewType(El: TPasType; const CallFuncName: string;
  1082. IsForward: boolean; AContext: TConvertContext; out ObjLit: TJSObjectLiteral): TJSCallExpression; virtual;
  1083. Function CreateRTTIClassField(V: TPasVariable; AContext: TConvertContext): TJSElement; virtual;
  1084. Function CreateRTTIClassMethod(Proc: TPasProcedure; AContext: TConvertContext): TJSElement; virtual;
  1085. Function CreateRTTIClassProperty(Prop: TPasProperty; AContext: TConvertContext): TJSElement; virtual;
  1086. // Statements
  1087. Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
  1088. Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
  1089. Function ConvertStatement(El: TPasImplStatement; AContext: TConvertContext ): TJSElement; virtual;
  1090. Function ConvertAssignStatement(El: TPasImplAssign; AContext: TConvertContext): TJSElement; virtual;
  1091. Function ConvertRaiseStatement(El: TPasImplRaise; AContext: TConvertContext ): TJSElement; virtual;
  1092. Function ConvertIfStatement(El: TPasImplIfElse; AContext: TConvertContext ): TJSElement; virtual;
  1093. Function ConvertWhileStatement(El: TPasImplWhileDo; AContext: TConvertContext): TJSElement; virtual;
  1094. Function ConvertRepeatStatement(El: TPasImplRepeatUntil; AContext: TConvertContext): TJSElement; virtual;
  1095. Function ConvertForStatement(El: TPasImplForLoop; AContext: TConvertContext): TJSElement; virtual;
  1096. Function ConvertFinalizationSection(El: TFinalizationSection; AContext: TConvertContext): TJSElement; virtual;
  1097. Function ConvertInitializationSection(El: TInitializationSection; AContext: TConvertContext): TJSElement; virtual;
  1098. Function ConvertSimpleStatement(El: TPasImplSimple; AContext: TConvertContext): TJSElement; virtual;
  1099. Function ConvertWithStatement(El: TPasImplWithDo; AContext: TConvertContext): TJSElement; virtual;
  1100. Function ConvertTryStatement(El: TPasImplTry; AContext: TConvertContext ): TJSElement; virtual;
  1101. Function ConvertExceptOn(El: TPasImplExceptOn; AContext: TConvertContext): TJSElement;
  1102. Function ConvertCaseOfStatement(El: TPasImplCaseOf; AContext: TConvertContext): TJSElement;
  1103. Function ConvertAsmStatement(El: TPasImplAsmStatement; AContext: TConvertContext): TJSElement;
  1104. // Expressions
  1105. Function ConvertArrayValues(El: TArrayValues; AContext: TConvertContext): TJSElement; virtual;
  1106. Function ConvertInheritedExpression(El: TInheritedExpr; AContext: TConvertContext): TJSElement; virtual;
  1107. Function ConvertNilExpr(El: TNilExpr; AContext: TConvertContext): TJSElement; virtual;
  1108. Function ConvertParamsExpression(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1109. Function ConvertArrayParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1110. Function ConvertFuncParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1111. Function ConvertExternalConstructor(Left: TPasElement;
  1112. Ref: TResolvedReference; ParamsExpr: TParamsExpr;
  1113. AContext : TConvertContext): TJSElement; virtual;
  1114. Function ConvertTypeCastToBaseType(El: TParamsExpr; AContext: TConvertContext; BaseTypeData: TResElDataBaseType): TJSElement; virtual;
  1115. Function ConvertSetLiteral(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1116. Function ConvertOpenArrayParam(ElType: TPasType; El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1117. Function ConvertBuiltIn_Length(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1118. Function ConvertBuiltIn_SetLength(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1119. Function ConvertBuiltIn_ExcludeInclude(El: TParamsExpr; AContext: TConvertContext; IsInclude: boolean): TJSElement; virtual;
  1120. Function ConvertBuiltInContinue(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
  1121. Function ConvertBuiltInBreak(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
  1122. Function ConvertBuiltIn_Exit(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
  1123. Function ConvertBuiltIn_IncDec(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1124. Function ConvertBuiltIn_Assigned(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1125. Function ConvertBuiltIn_Chr(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1126. Function ConvertBuiltIn_Ord(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1127. Function ConvertBuiltIn_Low(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1128. Function ConvertBuiltIn_High(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1129. Function ConvertBuiltIn_Pred(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1130. Function ConvertBuiltIn_Succ(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1131. Function ConvertBuiltIn_StrProc(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1132. Function ConvertBuiltIn_StrFunc(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1133. Function ConvertBuiltInStrParam(El: TPasExpr; AContext: TConvertContext; IsStrFunc, IsFirst: boolean): TJSElement; virtual;
  1134. Function ConvertBuiltIn_ConcatArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1135. Function ConvertBuiltIn_CopyArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1136. Function ConvertBuiltIn_InsertArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1137. Function ConvertBuiltIn_DeleteArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1138. Function ConvertBuiltIn_TypeInfo(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
  1139. Function ConvertRecordValues(El: TRecordValues; AContext: TConvertContext): TJSElement; virtual;
  1140. Function ConvertSelfExpression(El: TSelfExpr; AContext: TConvertContext): TJSElement; virtual;
  1141. Function ConvertBinaryExpression(El: TBinaryExpr; AContext: TConvertContext): TJSElement; virtual;
  1142. Function ConvertBinaryExpressionRes(El: TBinaryExpr; AContext: TConvertContext;
  1143. const LeftResolved, RightResolved: TPasResolverResult; var A,B: TJSElement): TJSElement; virtual;
  1144. Function ConvertSubIdentExpression(El: TBinaryExpr; AContext: TConvertContext): TJSElement; virtual;
  1145. Function ConvertBoolConstExpression(El: TBoolConstExpr; AContext: TConvertContext): TJSElement; virtual;
  1146. Function ConvertPrimitiveExpression(El: TPrimitiveExpr; AContext: TConvertContext): TJSElement; virtual;
  1147. Function ConvertIdentifierExpr(El: TPrimitiveExpr; AContext : TConvertContext): TJSElement; virtual;
  1148. Function ConvertUnaryExpression(El: TUnaryExpr; AContext: TConvertContext): TJSElement; virtual;
  1149. // Convert declarations
  1150. Function ConvertElement(El : TPasElement; AContext: TConvertContext) : TJSElement; virtual;
  1151. Function ConvertProperty(El: TPasProperty; AContext: TConvertContext ): TJSElement; virtual;
  1152. Function ConvertCommand(El: TPasImplCommand; AContext: TConvertContext): TJSElement; virtual;
  1153. Function ConvertCommands(El: TPasImplCommands; AContext: TConvertContext): TJSElement; virtual;
  1154. Function ConvertConst(El: TPasConst; AContext: TConvertContext): TJSElement; virtual;
  1155. Function ConvertDeclarations(El: TPasDeclarations; AContext: TConvertContext): TJSElement; virtual;
  1156. Function ConvertExportSymbol(El: TPasExportSymbol; AContext: TConvertContext): TJSElement; virtual;
  1157. Function ConvertExpression(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
  1158. Function ConvertImplBlock(El: TPasImplBlock; AContext: TConvertContext ): TJSElement; virtual;
  1159. Function ConvertLabelMark(El: TPasImplLabelMark; AContext: TConvertContext): TJSElement; virtual;
  1160. Function ConvertLabels(El: TPasLabels; AContext: TConvertContext): TJSElement; virtual;
  1161. Function ConvertModule(El: TPasModule; AContext: TConvertContext): TJSElement; virtual;
  1162. Function ConvertPackage(El: TPasPackage; AContext: TConvertContext): TJSElement; virtual;
  1163. Function ConvertProcedure(El: TPasProcedure; AContext: TConvertContext): TJSElement; virtual;
  1164. Function ConvertResString(El: TPasResString; AContext: TConvertContext): TJSElement; virtual;
  1165. Function ConvertVariable(El: TPasVariable; AContext: TConvertContext): TJSElement; virtual;
  1166. Function ConvertRecordType(El: TPasRecordType; AContext: TConvertContext): TJSElement; virtual;
  1167. Function ConvertClassType(El: TPasClassType; AContext: TConvertContext): TJSElement; virtual;
  1168. Function ConvertClassForwardType(El: TPasClassType; AContext: TConvertContext): TJSElement; virtual;
  1169. Function ConvertClassExternalType(El: TPasClassType; AContext: TConvertContext): TJSElement; virtual;
  1170. Function ConvertClassOfType(El: TPasClassOfType; AContext: TConvertContext): TJSElement; virtual;
  1171. Function ConvertEnumType(El: TPasEnumType; AContext: TConvertContext): TJSElement; virtual;
  1172. Function ConvertSetType(El: TPasSetType; AContext: TConvertContext): TJSElement; virtual;
  1173. Function ConvertPointerType(El: TPasPointerType; AContext: TConvertContext): TJSElement; virtual;
  1174. Function ConvertProcedureType(El: TPasProcedureType; AContext: TConvertContext): TJSElement; virtual;
  1175. Function ConvertArrayType(El: TPasArrayType; AContext: TConvertContext): TJSElement; virtual;
  1176. Public
  1177. // RTTI, TypeInfo constants
  1178. const
  1179. // TParamFlag
  1180. pfVar = 1;
  1181. pfConst = 2;
  1182. pfOut = 4;
  1183. // TProcedureFlag
  1184. pfStatic = 1;
  1185. pfVarargs = 2;
  1186. pfExternal = 4;
  1187. // TPropertyFlag
  1188. pfGetFunction = 1;
  1189. pfSetProcedure = 2;
  1190. pfStoredFunction = 4;
  1191. type
  1192. TMethodKind = (
  1193. mkProcedure, // 0 default
  1194. mkFunction, // 1
  1195. mkConstructor, // 2
  1196. mkDestructor, // 3
  1197. mkClassProcedure, // 4
  1198. mkClassFunction // 5
  1199. );
  1200. Public
  1201. Constructor Create;
  1202. destructor Destroy; override;
  1203. Function ConvertPasElement(El: TPasElement; Resolver: TPas2JSResolver) : TJSElement;
  1204. // options
  1205. Property Options: TPasToJsConverterOptions read FOptions write FOptions;
  1206. Property TargetPlatform: TPasToJsPlatform read FTargetPlatform write FTargetPlatform;
  1207. Property TargetProcessor: TPasToJsProcessor read FTargetProcessor write FTargetProcessor;
  1208. Property UseLowerCase: boolean read GetUseLowerCase write SetUseLowerCase default true;
  1209. Property UseSwitchStatement: boolean read GetUseSwitchStatement write SetUseSwitchStatement;// default false, because slower than "if" in many engines
  1210. Property UseEnumNumbers: boolean read GetUseEnumNumbers write SetUseEnumNumbers; // default false
  1211. Property OnIsElementUsed: TPas2JSIsElementUsedEvent read FOnIsElementUsed write FOnIsElementUsed;
  1212. Property OnIsTypeInfoUsed: TPas2JSIsElementUsedEvent read FOnIsTypeInfoUsed write FOnIsTypeInfoUsed;
  1213. Property PreservedWords: TJSReservedWordList read FPreservedWords write SetPreservedWords;
  1214. // names
  1215. Property BuildInNames[bin: TPas2JSBuiltInName]: string read GetBuildInNames write SetBuildInNames;
  1216. end;
  1217. var
  1218. JSTypeCaptions: array[TJSType] of string = (
  1219. 'undefined',
  1220. 'null',
  1221. 'boolean',
  1222. 'number',
  1223. 'string',
  1224. 'object',
  1225. 'reference',
  1226. 'completion'
  1227. );
  1228. function CodePointToJSString(u: cardinal): TJSString;
  1229. function PosLast(c: char; const s: string): integer;
  1230. implementation
  1231. const
  1232. TempRefObjGetterName = 'get';
  1233. TempRefObjSetterName = 'set';
  1234. TempRefObjSetterArgName = 'v';
  1235. function CodePointToJSString(u: cardinal): TJSString;
  1236. begin
  1237. if u < $10000 then
  1238. // Note: codepoints $D800 - $DFFF are reserved
  1239. Result:=WideChar(u)
  1240. else
  1241. Result:=WideChar($D800+((u - $10000) shr 10))+WideChar($DC00+((u - $10000) and $3ff));
  1242. end;
  1243. function PosLast(c: char; const s: string): integer;
  1244. begin
  1245. Result:=length(s);
  1246. while (Result>0) and (s[Result]<>c) do dec(Result);
  1247. end;
  1248. { TPas2JSResolver }
  1249. // inline
  1250. function TPas2JSResolver.GetJSBaseTypes(aBaseType: TPas2jsBaseType
  1251. ): TPasUnresolvedSymbolRef;
  1252. begin
  1253. Result:=TPasUnresolvedSymbolRef(FJSBaseTypes[aBaseType]);
  1254. end;
  1255. procedure TPas2JSResolver.InternalAdd(Item: TPasIdentifier);
  1256. var
  1257. Index: Integer;
  1258. OldItem: TPasIdentifier;
  1259. aName: ShortString;
  1260. begin
  1261. aName:=Item.Identifier;
  1262. Index:=FExternalNames.FindIndexOf(aName);
  1263. {$IFDEF VerbosePasResolver}
  1264. if Item.Owner<>nil then
  1265. raise Exception.Create('20170322235419');
  1266. Item.Owner:=Self;
  1267. {$ENDIF}
  1268. //writeln(' Index=',Index);
  1269. if Index>=0 then
  1270. begin
  1271. // insert LIFO - last in, first out
  1272. OldItem:=TPasIdentifier(FExternalNames.List^[Index].Data);
  1273. {$IFDEF VerbosePasResolver}
  1274. if OldItem.Identifier<>aName then
  1275. raise Exception.Create('20170322235429');
  1276. {$ENDIF}
  1277. Item.NextSameIdentifier:=OldItem;
  1278. FExternalNames.List^[Index].Data:=Item;
  1279. end
  1280. else
  1281. begin
  1282. FExternalNames.Add(aName, Item);
  1283. {$IFDEF VerbosePasResolver}
  1284. if FindExternalName(Item.Identifier)<>Item then
  1285. raise Exception.Create('20170322235433');
  1286. {$ENDIF}
  1287. end;
  1288. end;
  1289. procedure TPas2JSResolver.OnClearHashItem(Item, Dummy: pointer);
  1290. var
  1291. PasIdentifier: TPasIdentifier absolute Item;
  1292. Ident: TPasIdentifier;
  1293. begin
  1294. if Dummy=nil then ;
  1295. //writeln('TPas2JSResolver.OnClearItem ',PasIdentifier.Identifier+':'+PasIdentifier.ClassName);
  1296. while PasIdentifier<>nil do
  1297. begin
  1298. Ident:=PasIdentifier;
  1299. PasIdentifier:=PasIdentifier.NextSameIdentifier;
  1300. Ident.Free;
  1301. end;
  1302. end;
  1303. function TPas2JSResolver.HasOverloadIndex(El: TPasElement): boolean;
  1304. var
  1305. C: TClass;
  1306. ProcScope: TPasProcedureScope;
  1307. begin
  1308. C:=El.ClassType;
  1309. if C=TPasProperty then
  1310. exit(false)
  1311. else if C=TPasClassType then
  1312. begin
  1313. if TPasClassType(El).IsForward then
  1314. exit(false);
  1315. end
  1316. else if C.InheritsFrom(TPasProcedure) then
  1317. begin
  1318. if TPasProcedure(El).IsOverride then
  1319. exit(true);
  1320. // Note: external proc pollutes the name space
  1321. ProcScope:=TPasProcedureScope(El.CustomData);
  1322. if ProcScope.DeclarationProc<>nil then
  1323. // implementation proc -> only count the header -> skip
  1324. exit(false);
  1325. end;
  1326. Result:=true;
  1327. end;
  1328. function TPas2JSResolver.GetOverloadIndex(Identifier: TPasIdentifier;
  1329. StopAt: TPasElement): integer;
  1330. // if not found return number of overloads
  1331. // if found return index in overloads
  1332. var
  1333. El: TPasElement;
  1334. begin
  1335. Result:=0;
  1336. // iterate from last added to first added
  1337. // Note: the first added has Index=0
  1338. while Identifier<>nil do
  1339. begin
  1340. El:=Identifier.Element;
  1341. Identifier:=Identifier.NextSameIdentifier;
  1342. if El=StopAt then
  1343. begin
  1344. Result:=0;
  1345. continue;
  1346. end;
  1347. if HasOverloadIndex(El) then
  1348. inc(Result);
  1349. end;
  1350. end;
  1351. function TPas2JSResolver.GetOverloadAt(Identifier: TPasIdentifier;
  1352. var Index: integer): TPasIdentifier;
  1353. // if found Result<>nil and Index=0
  1354. // if not found Result=nil and Index is reduced by number of overloads
  1355. var
  1356. El: TPasElement;
  1357. CurIdent: TPasIdentifier;
  1358. Count: Integer;
  1359. begin
  1360. if Identifier=nil then exit(nil);
  1361. // Note: the Identifier chain is from last added to first added
  1362. // -> get length of chain
  1363. Count:=0;
  1364. CurIdent:=Identifier;
  1365. while CurIdent<>nil do
  1366. begin
  1367. El:=CurIdent.Element;
  1368. CurIdent:=CurIdent.NextSameIdentifier;
  1369. if HasOverloadIndex(El) then
  1370. inc(Count);
  1371. end;
  1372. if Count<=Index then
  1373. begin
  1374. // Index is not in this scope
  1375. dec(Index);
  1376. exit(nil);
  1377. end;
  1378. // Index is in this scope -> find it
  1379. CurIdent:=Identifier;
  1380. while CurIdent<>nil do
  1381. begin
  1382. if HasOverloadIndex(CurIdent.Element) then
  1383. begin
  1384. dec(Count);
  1385. if (Index=Count) then
  1386. begin
  1387. Index:=0;
  1388. Result:=CurIdent;
  1389. exit;
  1390. end;
  1391. end;
  1392. CurIdent:=CurIdent.NextSameIdentifier;
  1393. end;
  1394. end;
  1395. function TPas2JSResolver.GetOverloadIndex(El: TPasElement): integer;
  1396. var
  1397. i: Integer;
  1398. Identifier: TPasIdentifier;
  1399. begin
  1400. Result:=0;
  1401. for i:=FOverloadScopes.Count-1 downto 0 do
  1402. begin
  1403. // find last added
  1404. Identifier:=TPasIdentifierScope(FOverloadScopes[i]).FindLocalIdentifier(El.Name);
  1405. // add count or index
  1406. inc(Result,GetOverloadIndex(Identifier,El));
  1407. end;
  1408. // find in external names
  1409. Identifier:=FindExternalName(El.Name);
  1410. // add count or index
  1411. inc(Result,GetOverloadIndex(Identifier,El));
  1412. end;
  1413. function TPas2JSResolver.GetOverloadAt(const aName: String; Index: integer
  1414. ): TPasIdentifier;
  1415. var
  1416. i: Integer;
  1417. begin
  1418. Result:=nil;
  1419. for i:=FOverloadScopes.Count-1 downto 0 do
  1420. begin
  1421. // find last added
  1422. Result:=TPasIdentifierScope(FOverloadScopes[i]).FindLocalIdentifier(aName);
  1423. Result:=GetOverloadAt(Result,Index);
  1424. if Result<>nil then
  1425. exit;
  1426. end;
  1427. // find in external names
  1428. Result:=FindExternalName(aName);
  1429. Result:=GetOverloadAt(Result,Index);
  1430. end;
  1431. function TPas2JSResolver.RenameOverload(El: TPasElement): boolean;
  1432. var
  1433. OverloadIndex: Integer;
  1434. function GetDuplicate: TPasElement;
  1435. var
  1436. Duplicate: TPasIdentifier;
  1437. begin
  1438. Duplicate:=GetOverloadAt(El.Name,0);
  1439. Result:=Duplicate.Element;
  1440. end;
  1441. var
  1442. NewName: String;
  1443. Duplicate: TPasElement;
  1444. begin
  1445. // => count overloads in this section
  1446. OverloadIndex:=GetOverloadIndex(El);
  1447. if OverloadIndex=0 then
  1448. exit(false); // there is no overload
  1449. if (El.ClassType=TPasClassFunction)
  1450. and (TPas2JSClassScope(TPasClassType(El.Parent).CustomData).NewInstanceFunction=El) then
  1451. begin
  1452. Duplicate:=GetDuplicate;
  1453. RaiseMsg(20170324234324,nNewInstanceFunctionMustNotHaveOverloadAtX,
  1454. sNewInstanceFunctionMustNotHaveOverloadAtX,[GetElementSourcePosStr(Duplicate)],El);
  1455. end;
  1456. if El.Visibility=visPublished then
  1457. begin
  1458. Duplicate:=GetDuplicate;
  1459. RaiseMsg(20170413220924,nDuplicateIdentifier,sDuplicateIdentifier,
  1460. [Duplicate.Name,GetElementSourcePosStr(Duplicate)],El);
  1461. end;
  1462. NewName:=El.Name+'$'+IntToStr(OverloadIndex);
  1463. {$IFDEF VerbosePas2JS}
  1464. writeln('TPas2JSResolver.RenameOverload "',El.Name,'" has overload. NewName="',NewName,'"');
  1465. {$ENDIF}
  1466. El.Name:=NewName;
  1467. Result:=true;
  1468. end;
  1469. procedure TPas2JSResolver.RenameOverloadsInSection(aSection: TPasSection);
  1470. var
  1471. ImplSection: TImplementationSection;
  1472. SectionClass: TClass;
  1473. begin
  1474. if aSection=nil then exit;
  1475. PushOverloadScope(aSection.CustomData as TPasIdentifierScope);
  1476. RenameOverloads(aSection,aSection.Declarations);
  1477. SectionClass:=aSection.ClassType;
  1478. if SectionClass=TInterfaceSection then
  1479. begin
  1480. // unit interface
  1481. // first rename all overloads in interface and implementation
  1482. ImplSection:=(aSection.Parent as TPasModule).ImplementationSection;
  1483. if ImplSection<>nil then
  1484. begin
  1485. PushOverloadScope(ImplSection.CustomData as TPasIdentifierScope);
  1486. RenameOverloads(ImplSection,ImplSection.Declarations);
  1487. end;
  1488. // and then rename all nested overloads (e.g. methods)
  1489. // Important: nested overloads must check both interface and implementation
  1490. RenameSubOverloads(aSection.Declarations);
  1491. if ImplSection<>nil then
  1492. begin
  1493. RenameSubOverloads(ImplSection.Declarations);
  1494. PopOverloadScope;
  1495. end;
  1496. end
  1497. else
  1498. begin
  1499. // program or library
  1500. RenameSubOverloads(aSection.Declarations);
  1501. end;
  1502. PopOverloadScope;
  1503. {$IFDEF VerbosePas2JS}
  1504. writeln('TPas2JSResolver.RenameOverloadsInSection END ',GetObjName(aSection));
  1505. {$ENDIF}
  1506. end;
  1507. procedure TPas2JSResolver.RenameOverloads(DeclEl: TPasElement;
  1508. Declarations: TFPList);
  1509. var
  1510. i: Integer;
  1511. El: TPasElement;
  1512. Proc: TPasProcedure;
  1513. ProcScope: TPasProcedureScope;
  1514. begin
  1515. //IsExternalClass:=(DeclEl is TPasClassType) and (TPasClassType(DeclEl).IsExternal);
  1516. if DeclEl=nil then;
  1517. for i:=0 to Declarations.Count-1 do
  1518. begin
  1519. El:=TPasElement(Declarations[i]);
  1520. if (El is TPasProcedure) then
  1521. begin
  1522. Proc:=TPasProcedure(El);
  1523. if Proc.IsOverride or Proc.IsExternal then
  1524. continue;
  1525. // Note: Pascal names of external procs are not in the JS, so no need to rename them
  1526. ProcScope:=Proc.CustomData as TPasProcedureScope;
  1527. //writeln('TPas2JSResolver.RenameOverloads Proc=',Proc.Name,' DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ImplProc=',GetObjName(ProcScope.ImplProc),' ClassScope=',GetObjName(ProcScope.ClassScope));
  1528. if ProcScope.DeclarationProc<>nil then
  1529. begin
  1530. if ProcScope.ImplProc<>nil then
  1531. RaiseInternalError(20170221110853);
  1532. // proc implementation (not forward) -> skip
  1533. continue;
  1534. end;
  1535. // proc declaration (header, not body)
  1536. if RenameOverload(Proc) then
  1537. if ProcScope.ImplProc<>nil then
  1538. ProcScope.ImplProc.Name:=Proc.Name;
  1539. end;
  1540. end;
  1541. {$IFDEF VerbosePas2JS}
  1542. writeln('TPas2JSResolver.RenameOverloads END ',GetObjName(DeclEl));
  1543. {$ENDIF}
  1544. end;
  1545. procedure TPas2JSResolver.RenameSubOverloads(Declarations: TFPList);
  1546. var
  1547. i, OldScopeCount: Integer;
  1548. El: TPasElement;
  1549. Proc, ImplProc: TPasProcedure;
  1550. ProcScope: TPasProcedureScope;
  1551. ClassScope, aScope: TPasClassScope;
  1552. ClassEl: TPasClassType;
  1553. C: TClass;
  1554. begin
  1555. for i:=0 to Declarations.Count-1 do
  1556. begin
  1557. El:=TPasElement(Declarations[i]);
  1558. C:=El.ClassType;
  1559. if C.InheritsFrom(TPasProcedure) then
  1560. begin
  1561. Proc:=TPasProcedure(El);
  1562. if Proc.IsAbstract or Proc.IsExternal then continue;
  1563. ProcScope:=Proc.CustomData as TPasProcedureScope;
  1564. {$IFDEF VerbosePas2JS}
  1565. writeln('TPas2JSResolver.RenameSubOverloads Proc=',Proc.Name,' DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ImplProc=',GetObjName(ProcScope.ImplProc),' ClassScope=',GetObjName(ProcScope.ClassScope));
  1566. {$ENDIF}
  1567. if ProcScope.DeclarationProc<>nil then
  1568. // proc implementation (not forward) -> skip
  1569. continue;
  1570. ImplProc:=Proc;
  1571. if ProcScope.ImplProc<>nil then
  1572. begin
  1573. // this proc has a separate implementation
  1574. // -> switch to implementation
  1575. ImplProc:=ProcScope.ImplProc;
  1576. ProcScope:=ImplProc.CustomData as TPasProcedureScope;
  1577. end;
  1578. PushOverloadScope(ProcScope);
  1579. // first rename all overloads on this level
  1580. RenameOverloads(ImplProc.Body,ImplProc.Body.Declarations);
  1581. // then process nested procedures
  1582. RenameSubOverloads(ImplProc.Body.Declarations);
  1583. PopOverloadScope;
  1584. end
  1585. else if C=TPasClassType then
  1586. begin
  1587. ClassEl:=TPasClassType(El);
  1588. if ClassEl.IsForward then continue;
  1589. ClassScope:=El.CustomData as TPas2JSClassScope;
  1590. OldScopeCount:=FOverloadScopes.Count;
  1591. // add class and ancestors scopes
  1592. aScope:=ClassScope;
  1593. repeat
  1594. PushOverloadScope(aScope);
  1595. aScope:=aScope.AncestorScope;
  1596. until aScope=nil;
  1597. // first rename all overloads on this level
  1598. RenameOverloads(ClassEl,ClassEl.Members);
  1599. // then process nested procedures
  1600. RenameSubOverloads(ClassEl.Members);
  1601. while FOverloadScopes.Count>OldScopeCount do
  1602. PopOverloadScope;
  1603. end
  1604. else if C=TPasConst then
  1605. RenameOverload(El)
  1606. else if C.InheritsFrom(TPasVariable) and (El.Parent.ClassType=TPasClassType) then
  1607. RenameOverload(El);
  1608. end;
  1609. {$IFDEF VerbosePas2JS}
  1610. writeln('TPas2JSResolver.RenameSubOverloads END');
  1611. {$ENDIF}
  1612. end;
  1613. procedure TPas2JSResolver.PushOverloadScope(Scope: TPasIdentifierScope);
  1614. begin
  1615. FOverloadScopes.Add(Scope);
  1616. end;
  1617. procedure TPas2JSResolver.PopOverloadScope;
  1618. begin
  1619. FOverloadScopes.Delete(FOverloadScopes.Count-1);
  1620. end;
  1621. procedure TPas2JSResolver.ResolveImplAsm(El: TPasImplAsmStatement);
  1622. {type
  1623. TAsmToken = (
  1624. atNone,
  1625. atWord,
  1626. atDot,
  1627. atRoundBracketOpen,
  1628. atRoundBracketClose
  1629. );
  1630. procedure Next;
  1631. begin
  1632. end;}
  1633. var
  1634. Lines: TStrings;
  1635. begin
  1636. Lines:=El.Tokens;
  1637. if Lines=nil then exit;
  1638. end;
  1639. procedure TPas2JSResolver.FinishModule(CurModule: TPasModule);
  1640. var
  1641. ModuleClass: TClass;
  1642. begin
  1643. inherited FinishModule(CurModule);
  1644. FOverloadScopes:=TFPList.Create;
  1645. try
  1646. ModuleClass:=CurModule.ClassType;
  1647. if ModuleClass=TPasModule then
  1648. begin
  1649. RenameOverloadsInSection(CurModule.InterfaceSection);
  1650. // Note: ImplementationSection is child of InterfaceSection
  1651. end
  1652. else if ModuleClass=TPasProgram then
  1653. RenameOverloadsInSection(TPasProgram(CurModule).ProgramSection)
  1654. else if CurModule.ClassType=TPasLibrary then
  1655. RenameOverloadsInSection(TPasLibrary(CurModule).LibrarySection)
  1656. else
  1657. RaiseNotYetImplemented(20170221000032,CurModule);
  1658. finally
  1659. FOverloadScopes.Free;
  1660. end;
  1661. end;
  1662. procedure TPas2JSResolver.FinishClassType(El: TPasClassType);
  1663. begin
  1664. inherited FinishClassType(El);
  1665. if El.IsExternal then
  1666. begin
  1667. if El.ExternalName='' then
  1668. RaiseMsg(20170321151109,nMissingExternalName,sMissingExternalName,[],El);
  1669. AddExternalPath(El.ExternalName,El);
  1670. end;
  1671. end;
  1672. procedure TPas2JSResolver.FinishVariable(El: TPasVariable);
  1673. const
  1674. ClassFieldModifiersAllowed = [vmClass,vmStatic,vmExternal,vmPublic];
  1675. RecordVarModifiersAllowed = [];
  1676. LocalVarModifiersAllowed = [];
  1677. ImplementationVarModifiersAllowed = [];
  1678. SectionVarModifiersAllowed = [vmExternal,vmPublic];
  1679. procedure RaiseVarModifierNotSupported(const Allowed: TVariableModifiers);
  1680. var
  1681. s: String;
  1682. m: TVariableModifier;
  1683. begin
  1684. s:='';
  1685. for m in TVariableModifiers do
  1686. if (m in El.VarModifiers) and not (m in Allowed) then
  1687. begin
  1688. str(m,s);
  1689. RaiseMsg(20170322134418,nInvalidVariableModifier,
  1690. sInvalidVariableModifier,[VariableModifierNames[m]],El);
  1691. end;
  1692. end;
  1693. var
  1694. ExtName: String;
  1695. ParentC: TClass;
  1696. begin
  1697. inherited FinishVariable(El);
  1698. ParentC:=El.Parent.ClassType;
  1699. if (ParentC=TPasClassType) then
  1700. begin
  1701. // class member
  1702. RaiseVarModifierNotSupported(ClassFieldModifiersAllowed);
  1703. if TPasClassType(El.Parent).IsExternal then
  1704. begin
  1705. // external class -> make variable external
  1706. if not (vmExternal in El.VarModifiers) then
  1707. begin
  1708. if (El.ClassType=TPasVariable) or (El.ClassType=TPasConst) then
  1709. begin
  1710. if El.ExportName<>nil then
  1711. RaiseMsg(20170322134321,nInvalidVariableModifier,
  1712. sInvalidVariableModifier,['export name'],El.ExportName);
  1713. El.ExportName:=TPrimitiveExpr.Create(El,pekString,''''+El.Name+'''');
  1714. end;
  1715. Include(El.VarModifiers,vmExternal);
  1716. end;
  1717. if El.Visibility=visPublished then
  1718. // Note: an external class has no typeinfo
  1719. RaiseMsg(20170413221516,nSymbolCannotBePublished,sSymbolCannotBePublished,
  1720. [],El);
  1721. end;
  1722. end
  1723. else if ParentC=TPasRecordType then
  1724. // record member
  1725. RaiseVarModifierNotSupported(RecordVarModifiersAllowed)
  1726. else if ParentC=TProcedureBody then
  1727. // local var
  1728. RaiseVarModifierNotSupported(LocalVarModifiersAllowed)
  1729. else if ParentC=TImplementationSection then
  1730. // implementation var
  1731. RaiseVarModifierNotSupported(ImplementationVarModifiersAllowed)
  1732. else if ParentC.InheritsFrom(TPasSection) then
  1733. begin
  1734. // interface/program/library var
  1735. RaiseVarModifierNotSupported(SectionVarModifiersAllowed);
  1736. end
  1737. else
  1738. begin
  1739. {$IFDEF VerbosePas2JS}
  1740. writeln('TPas2JSResolver.FinishVariable ',GetObjName(El),' Parent=',GetObjName(El.Parent));
  1741. {$ENDIF}
  1742. RaiseNotYetImplemented(20170324151259,El);
  1743. end;
  1744. if vmExternal in El.VarModifiers then
  1745. begin
  1746. // compute constant
  1747. if El.LibraryName<>nil then
  1748. RaiseMsg(20170227094227,nPasElementNotSupported,sPasElementNotSupported,
  1749. ['library'],El.ExportName);
  1750. if El.ExportName=nil then
  1751. RaiseMsg(20170227100750,nMissingExternalName,sMissingExternalName,[],El);
  1752. ExtName:=ComputeConstString(El.ExportName,true,true);
  1753. if (El.Visibility=visPublished) and (ExtName<>El.Name) then
  1754. RaiseMsg(20170407002940,nPublishedNameMustMatchExternal,
  1755. sPublishedNameMustMatchExternal,[],El.ExportName);
  1756. // add external name to FExternalNames
  1757. if (El.Parent is TPasSection)
  1758. or ((El.ClassType=TPasConst) and (El.Parent is TPasProcedure)) then
  1759. AddExternalPath(ExtName,El.ExportName);
  1760. end;
  1761. end;
  1762. procedure TPas2JSResolver.FinishProcedureType(El: TPasProcedureType);
  1763. var
  1764. Proc: TPasProcedure;
  1765. pm: TProcedureModifier;
  1766. ExtName: String;
  1767. C: TClass;
  1768. AClass: TPasClassType;
  1769. ClassScope: TPas2JSClassScope;
  1770. ptm: TProcTypeModifier;
  1771. begin
  1772. inherited FinishProcedureType(El);
  1773. if El.Parent is TPasProcedure then
  1774. begin
  1775. Proc:=TPasProcedure(El.Parent);
  1776. // calling convention
  1777. if Proc.CallingConvention<>ccDefault then
  1778. RaiseMsg(20170211214731,nPasElementNotSupported,sPasElementNotSupported,
  1779. [cCallingConventions[Proc.CallingConvention]],Proc);
  1780. for pm in TProcedureModifiers do
  1781. if (pm in Proc.Modifiers)
  1782. and (not (pm in [pmVirtual, pmAbstract, pmOverride,
  1783. pmOverload, pmReintroduce,
  1784. pmAssembler, pmPublic,
  1785. pmExternal, pmForward])) then
  1786. RaiseNotYetImplemented(20170208142159,El,'modifier '+ModifierNames[pm]);
  1787. for ptm in TProcTypeModifiers do
  1788. if (ptm in Proc.ProcType.Modifiers)
  1789. and (not (ptm in [ptmOfObject,ptmVarargs])) then
  1790. RaiseNotYetImplemented(20170411171454,El,'modifier '+ProcTypeModifiers[ptm]);
  1791. // check pmPublic
  1792. if [pmPublic,pmExternal]<=Proc.Modifiers then
  1793. RaiseMsg(20170324150149,nInvalidXModifierY,
  1794. sInvalidXModifierY,[Proc.ElementTypeName,'public, external'],Proc);
  1795. if (Proc.PublicName<>nil) then
  1796. RaiseMsg(20170324150417,nPasElementNotSupported,sPasElementNotSupported,
  1797. ['public name'],Proc.PublicName);
  1798. if (Proc.Parent.ClassType=TPasClassType) then
  1799. begin
  1800. // class member
  1801. AClass:=TPasClassType(Proc.Parent);
  1802. ClassScope:=AClass.CustomData as TPas2JSClassScope;
  1803. if AClass.IsExternal then
  1804. begin
  1805. // external class -> make method external
  1806. if not (pmExternal in Proc.Modifiers) then
  1807. begin
  1808. if Proc.LibrarySymbolName<>nil then
  1809. RaiseMsg(20170322142158,nInvalidXModifierY,
  1810. sInvalidXModifierY,[Proc.ElementTypeName,'symbol name'],Proc.LibrarySymbolName);
  1811. Proc.Modifiers:=Proc.Modifiers+[pmExternal];
  1812. Proc.LibrarySymbolName:=TPrimitiveExpr.Create(El,pekString,''''+Proc.Name+'''');
  1813. end;
  1814. if Proc.Visibility=visPublished then
  1815. // Note: an external class has no typeinfo
  1816. RaiseMsg(20170413221327,nSymbolCannotBePublished,sSymbolCannotBePublished,
  1817. [],Proc);
  1818. C:=Proc.ClassType;
  1819. if (C=TPasProcedure) or (C=TPasFunction)
  1820. or (C=TPasClassProcedure) or (C=TPasClassFunction) then
  1821. // ok
  1822. else if C=TPasConstructor then
  1823. begin
  1824. if Proc.IsVirtual then
  1825. // constructor of external class can't be overriden -> forbid virtual
  1826. RaiseMsg(20170323100447,nInvalidXModifierY,sInvalidXModifierY,
  1827. [Proc.ElementTypeName,'virtual,external'],Proc);
  1828. if CompareText(Proc.Name,'new')=0 then
  1829. begin
  1830. ExtName:=ComputeConstString(Proc.LibrarySymbolName,true,true);
  1831. if ExtName<>Proc.Name then
  1832. RaiseMsg(20170323083511,nVirtualMethodNameMustMatchExternal,
  1833. sVirtualMethodNameMustMatchExternal,[],Proc.LibrarySymbolName);
  1834. end
  1835. else if El.Args.Count>0 then
  1836. RaiseMsg(20170322164357,nNoArgumentsAllowedForExternalObjectConstructor,
  1837. sNoArgumentsAllowedForExternalObjectConstructor,[],TPasArgument(El.Args[0]));
  1838. if pmVirtual in Proc.Modifiers then
  1839. RaiseMsg(20170322183141,nInvalidXModifierY,sInvalidXModifierY,
  1840. [Proc.ElementTypeName,'virtual'],Proc.ProcType);
  1841. end
  1842. else
  1843. RaiseMsg(20170322163210,nPasElementNotSupported,sPasElementNotSupported,
  1844. [Proc.ElementTypeName],Proc);
  1845. end
  1846. else
  1847. begin
  1848. // Pascal class
  1849. if (ClassScope.NewInstanceFunction=nil)
  1850. and (ClassScope.AncestorScope<>nil)
  1851. and (TPasClassType(ClassScope.AncestorScope.Element).IsExternal)
  1852. and (Proc.ClassType=TPasClassFunction)
  1853. and (Proc.Visibility in [visProtected,visPublic,visPublished])
  1854. and (TPasClassFunction(Proc).FuncType.ResultEl.ResultType=AClass)
  1855. and ([pmOverride,pmExternal]*Proc.Modifiers=[]) then
  1856. begin
  1857. // The first non private class function in a Pascal class descending
  1858. // from an external class
  1859. // -> this is the NewInstance function
  1860. ClassScope.NewInstanceFunction:=TPasClassFunction(Proc);
  1861. CheckNewInstanceFunction(ClassScope);
  1862. end;
  1863. end;
  1864. end;
  1865. if pmExternal in Proc.Modifiers then
  1866. begin
  1867. // external proc
  1868. // external override -> unneeded information, probably a bug
  1869. if Proc.IsOverride then
  1870. RaiseMsg(20170321101715,nInvalidXModifierY,sInvalidXModifierY,
  1871. [Proc.ElementTypeName,'override,external'],Proc);
  1872. if Proc.LibraryExpr<>nil then
  1873. RaiseMsg(20170211220712,nPasElementNotSupported,sPasElementNotSupported,
  1874. ['external library name'],Proc.LibraryExpr);
  1875. if Proc.LibrarySymbolName=nil then
  1876. RaiseMsg(20170227095454,nMissingExternalName,sMissingExternalName,
  1877. ['missing external name'],Proc);
  1878. for pm in [pmAssembler,pmForward,pmNoReturn,pmInline] do
  1879. if pm in Proc.Modifiers then
  1880. RaiseMsg(20170323100842,nInvalidXModifierY,sInvalidXModifierY,
  1881. [Proc.ElementTypeName,ModifierNames[pm]],Proc);
  1882. // compute external name
  1883. ExtName:=ComputeConstString(Proc.LibrarySymbolName,true,true);
  1884. // a virtual must have the external name, so that override works
  1885. if Proc.IsVirtual and (Proc.Name<>ExtName) then
  1886. RaiseMsg(20170321090049,nVirtualMethodNameMustMatchExternal,
  1887. sVirtualMethodNameMustMatchExternal,[],Proc.LibrarySymbolName);
  1888. // a published must have the external name, so that streaming works
  1889. if (Proc.Visibility=visPublished) then
  1890. begin
  1891. if (Proc.Name<>ExtName) then
  1892. RaiseMsg(20170407002940,nPublishedNameMustMatchExternal,
  1893. sPublishedNameMustMatchExternal,[],Proc.LibrarySymbolName);
  1894. if ExtName=ExtClassBracketAccessor then
  1895. RaiseMsg(20170409211805,nSymbolCannotBePublished,
  1896. sSymbolCannotBePublished,[],Proc.LibrarySymbolName);
  1897. end;
  1898. if Proc.Parent is TPasSection then
  1899. AddExternalPath(ExtName,Proc.LibrarySymbolName);
  1900. exit;
  1901. end;
  1902. end;
  1903. end;
  1904. procedure TPas2JSResolver.FinishPropertyOfClass(PropEl: TPasProperty);
  1905. var
  1906. Getter, Setter: TPasElement;
  1907. GetterIsBracketAccessor, SetterIsBracketAccessor: Boolean;
  1908. Arg: TPasArgument;
  1909. ArgResolved: TPasResolverResult;
  1910. ParentC: TClass;
  1911. begin
  1912. inherited FinishPropertyOfClass(PropEl);
  1913. ParentC:=PropEl.Parent.ClassType;
  1914. if (ParentC=TPasClassType) then
  1915. begin
  1916. // class member
  1917. if TPasClassType(PropEl.Parent).IsExternal then
  1918. begin
  1919. // external class
  1920. if PropEl.Visibility=visPublished then
  1921. // Note: an external class has no typeinfo
  1922. RaiseMsg(20170413221703,nSymbolCannotBePublished,sSymbolCannotBePublished,
  1923. [],PropEl);
  1924. end;
  1925. end;
  1926. Getter:=GetPasPropertyGetter(PropEl);
  1927. GetterIsBracketAccessor:=IsExternalBracketAccessor(Getter);
  1928. Setter:=GetPasPropertySetter(PropEl);
  1929. SetterIsBracketAccessor:=IsExternalBracketAccessor(Setter);
  1930. if GetterIsBracketAccessor then
  1931. begin
  1932. if PropEl.Args.Count<>1 then
  1933. RaiseMsg(20170403001743,nBracketAccessorOfExternalClassMustHaveOneParameter,
  1934. sBracketAccessorOfExternalClassMustHaveOneParameter,
  1935. [],PropEl);
  1936. end;
  1937. if SetterIsBracketAccessor then
  1938. begin
  1939. if PropEl.Args.Count<>1 then
  1940. RaiseMsg(20170403001806,nBracketAccessorOfExternalClassMustHaveOneParameter,
  1941. sBracketAccessorOfExternalClassMustHaveOneParameter,
  1942. [],PropEl);
  1943. end;
  1944. if GetterIsBracketAccessor or SetterIsBracketAccessor then
  1945. begin
  1946. Arg:=TPasArgument(PropEl.Args[0]);
  1947. if not (Arg.Access in [argDefault,argConst]) then
  1948. RaiseMsg(20170403090225,nXExpectedButYFound,sXExpectedButYFound,
  1949. ['default or "const"',AccessNames[Arg.Access]],PropEl);
  1950. ComputeElement(Arg,ArgResolved,[rcType],Arg);
  1951. if not (ArgResolved.BaseType in (btAllInteger+btAllStringAndChars+btAllBooleans+btAllFloats)) then
  1952. RaiseMsg(20170403090628,nIncompatibleTypesGotExpected,
  1953. sIncompatibleTypesGotExpected,
  1954. [GetResolverResultDescription(ArgResolved,true),'string'],Arg);
  1955. end;
  1956. end;
  1957. procedure TPas2JSResolver.CheckNewInstanceFunction(ClassScope: TPas2JSClassScope
  1958. );
  1959. var
  1960. Proc: TPasClassFunction;
  1961. Args: TFPList;
  1962. Arg: TPasArgument;
  1963. ResolvedArg: TPasResolverResult;
  1964. begin
  1965. Proc:=ClassScope.NewInstanceFunction;
  1966. // proc modifiers override and external were already checked
  1967. // visibility was already checked
  1968. // function result type was already checked
  1969. if not Proc.IsVirtual then
  1970. RaiseMsg(20170324231040,nNewInstanceFunctionMustBeVirtual,
  1971. sNewInstanceFunctionMustBeVirtual,[],Proc);
  1972. Args:=Proc.ProcType.Args;
  1973. if Args.Count<2 then
  1974. RaiseMsg(20170324232247,nNewInstanceFunctionMustHaveTwoParameters,
  1975. sNewInstanceFunctionMustHaveTwoParameters,[],Proc.ProcType);
  1976. // first param must be a string
  1977. Arg:=TPasArgument(Args[0]);
  1978. if Arg.Access<>argDefault then
  1979. RaiseMsg(20170324232655,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  1980. ['1',AccessNames[Arg.Access],'default (none)'],Arg);
  1981. if Arg.ArgType=nil then
  1982. RaiseMsg(20170324233201,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  1983. ['1','untyped','String'],Arg);
  1984. ComputeElement(Arg.ArgType,ResolvedArg,[rcType]);
  1985. if ResolvedArg.BaseType<>btString then
  1986. RaiseMsg(20170324233348,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  1987. ['1',GetResolverResultDescription(ResolvedArg),'String'],Arg);
  1988. // second param must be const untyped
  1989. Arg:=TPasArgument(Args[1]);
  1990. if Arg.Access<>argConst then
  1991. RaiseMsg(20170324233457,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  1992. ['2',AccessNames[Arg.Access],'const'],Arg);
  1993. if Arg.ArgType<>nil then
  1994. RaiseMsg(20170324233508,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  1995. ['2','type','untyped'],Arg);
  1996. end;
  1997. function TPas2JSResolver.AddExternalName(const aName: string; El: TPasElement
  1998. ): TPasIdentifier;
  1999. var
  2000. Item: TPasIdentifier;
  2001. begin
  2002. //writeln('TPas2JSResolver.AddExternalIdentifier Name="',aName,'" El=',GetObjName(El));
  2003. Item:=TPasIdentifier.Create;
  2004. Item.Identifier:=aName;
  2005. Item.Element:=El;
  2006. InternalAdd(Item);
  2007. //writeln('TPas2JSResolver.AddExternalIdentifier END');
  2008. Result:=Item;
  2009. end;
  2010. function TPas2JSResolver.FindExternalName(const aName: String
  2011. ): TPasIdentifier;
  2012. begin
  2013. Result:=TPasIdentifier(FExternalNames.Find(aName));
  2014. {$IFDEF VerbosePasResolver}
  2015. if (Result<>nil) and (Result.Owner<>Self) then
  2016. begin
  2017. writeln('TPas2JSResolver.FindExternalName Result.Owner<>Self Owner='+GetObjName(Result.Owner));
  2018. raise Exception.Create('20170322235814');
  2019. end;
  2020. {$ENDIF}
  2021. end;
  2022. procedure TPas2JSResolver.AddExternalPath(aName: string; El: TPasElement);
  2023. // add aName and the first identifier of aName
  2024. var
  2025. p: PChar;
  2026. l: integer;
  2027. begin
  2028. aName:=Trim(aName);
  2029. if aName='' then exit;
  2030. AddExternalName(aName,El);
  2031. p:=PChar(aName);
  2032. while p^ in ['a'..'z','A'..'Z','0'..'9','_','$'] do inc(p);
  2033. l:=p-PChar(aName);
  2034. if l=length(aName) then exit;
  2035. AddExternalName(LeftStr(aName,l),El);
  2036. end;
  2037. procedure TPas2JSResolver.ClearElementData;
  2038. var
  2039. Data, Next: TPas2JsElementData;
  2040. begin
  2041. Data:=FFirstElementData;
  2042. while Data<>nil do
  2043. begin
  2044. Next:=Data.Next;
  2045. Data.Free;
  2046. Data:=Next;
  2047. end;
  2048. FFirstElementData:=nil;
  2049. FLastElementData:=nil;
  2050. FExternalNames.ForEachCall(@OnClearHashItem,nil);
  2051. FExternalNames.Clear;
  2052. end;
  2053. function TPas2JSResolver.AddJSBaseType(const aName: string; Typ: TPas2jsBaseType
  2054. ): TResElDataPas2JSBaseType;
  2055. var
  2056. El: TPasUnresolvedSymbolRef;
  2057. begin
  2058. El:=AddCustomBaseType(aName,TResElDataPas2JSBaseType);
  2059. if Typ<>pbtNone then
  2060. FJSBaseTypes[Typ]:=El;
  2061. Result:=TResElDataPas2JSBaseType(El.CustomData);
  2062. Result.JSBaseType:=Typ;
  2063. end;
  2064. function TPas2JSResolver.IsJSBaseType(TypeEl: TPasType; Typ: TPas2jsBaseType
  2065. ): boolean;
  2066. begin
  2067. Result:=(TypeEl is TPasUnresolvedSymbolRef)
  2068. and (CompareText(TypeEl.Name,Pas2jsBaseTypeNames[Typ])=0)
  2069. and (TypeEl.CustomData is TResElDataPas2JSBaseType);
  2070. end;
  2071. function TPas2JSResolver.IsJSBaseType(const TypeResolved: TPasResolverResult;
  2072. Typ: TPas2jsBaseType; HasValue: boolean): boolean;
  2073. begin
  2074. if (TypeResolved.BaseType<>btCustom) or not IsJSBaseType(TypeResolved.TypeEl,Typ) then
  2075. exit(false);
  2076. if HasValue and not (rrfReadable in TypeResolved.Flags) then
  2077. exit(false);
  2078. Result:=true;
  2079. end;
  2080. function TPas2JSResolver.CheckAssignCompatibilityCustom(const LHS,
  2081. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  2082. var Handled: boolean): integer;
  2083. var
  2084. LeftBaseType: TPas2jsBaseType;
  2085. LArray: TPasArrayType;
  2086. ElTypeResolved: TPasResolverResult;
  2087. begin
  2088. Result:=cIncompatible;
  2089. if LHS.BaseType=btCustom then
  2090. begin
  2091. if not (LHS.TypeEl is TPasUnresolvedSymbolRef) then
  2092. begin
  2093. {$IFDEF VerbosePas2JS}
  2094. writeln('TPas2JSResolver.CheckAssignCompatibilityCustomBaseType LHS=',GetResolverResultDesc(LHS));
  2095. {$ENDIF}
  2096. RaiseInternalError(20170325114554);
  2097. end;
  2098. if not (LHS.TypeEl.CustomData is TResElDataPas2JSBaseType) then
  2099. exit;
  2100. Handled:=true;
  2101. LeftBaseType:=TResElDataPas2JSBaseType(LHS.TypeEl.CustomData).JSBaseType;
  2102. if LeftBaseType=pbtJSValue then
  2103. begin
  2104. // assign to a JSValue
  2105. if rrfReadable in RHS.Flags then
  2106. begin
  2107. // RHS is a value
  2108. if (RHS.BaseType in btAllJSValueSrcTypes) then
  2109. Result:=cExact+1 // type cast to JSValue
  2110. else if RHS.BaseType=btCustom then
  2111. begin
  2112. if IsJSBaseType(RHS,pbtJSValue) then
  2113. Result:=cExact;
  2114. end
  2115. else if RHS.BaseType=btContext then
  2116. Result:=cExact+1;
  2117. end
  2118. else if RHS.BaseType=btContext then
  2119. begin
  2120. // RHS is not a value
  2121. if RHS.IdentEl<>nil then
  2122. begin
  2123. if RHS.IdentEl.ClassType=TPasClassType then
  2124. Result:=cExact+1; // RHS is a class type
  2125. end;
  2126. end;
  2127. end;
  2128. end
  2129. else if (LHS.BaseType=btContext) and (LHS.TypeEl.ClassType=TPasArrayType)
  2130. and (rrfReadable in RHS.Flags) then
  2131. begin
  2132. LArray:=TPasArrayType(LHS.TypeEl);
  2133. if length(LArray.Ranges)>0 then
  2134. exit;
  2135. if (RHS.BaseType<>btContext) or (RHS.TypeEl.ClassType<>TPasArrayType) then
  2136. exit;
  2137. ComputeElement(LArray.ElType,ElTypeResolved,[rcType]);
  2138. if IsJSBaseType(ElTypeResolved,pbtJSValue) then
  2139. begin
  2140. // array of jsvalue := array
  2141. Handled:=true;
  2142. Result:=cExact+1;
  2143. end;
  2144. end;
  2145. if RaiseOnIncompatible then ;
  2146. if ErrorEl=nil then ;
  2147. end;
  2148. function TPas2JSResolver.CheckTypeCastClassInstanceToClass(const FromClassRes,
  2149. ToClassRes: TPasResolverResult; ErrorEl: TPasElement): integer;
  2150. var
  2151. ToClass: TPasClassType;
  2152. ClassScope: TPasClassScope;
  2153. begin
  2154. if FromClassRes.BaseType=btNil then exit(cExact);
  2155. ToClass:=(ToClassRes.TypeEl as TPasClassType);
  2156. ClassScope:=ToClass.CustomData as TPasClassScope;
  2157. if ClassScope.AncestorScope=nil then
  2158. // type cast to root class
  2159. Result:=cExact+1
  2160. else
  2161. Result:=cIncompatible;
  2162. if ErrorEl=nil then ;
  2163. end;
  2164. function TPas2JSResolver.CheckEqualCompatibilityCustomType(const LHS,
  2165. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  2166. ): integer;
  2167. var
  2168. LeftBaseType: TPas2jsBaseType;
  2169. begin
  2170. Result:=cIncompatible;
  2171. if LHS.BaseType=btCustom then
  2172. begin
  2173. if not (LHS.TypeEl is TPasUnresolvedSymbolRef) then
  2174. begin
  2175. {$IFDEF VerbosePas2JS}
  2176. writeln('TPas2JSResolver.CheckEqualCompatibilityCustomType LHS=',GetResolverResultDesc(LHS));
  2177. {$ENDIF}
  2178. RaiseInternalError(20170330005841);
  2179. end;
  2180. if not (LHS.TypeEl.CustomData is TResElDataPas2JSBaseType) then
  2181. exit;
  2182. LeftBaseType:=TResElDataPas2JSBaseType(LHS.TypeEl.CustomData).JSBaseType;
  2183. if LeftBaseType=pbtJSValue then
  2184. begin
  2185. if (rrfReadable in LHS.Flags) then
  2186. begin
  2187. if (rrfReadable in RHS.Flags) then
  2188. begin
  2189. if RHS.BaseType in btAllJSValueSrcTypes then
  2190. Result:=cExact
  2191. else if RHS.BaseType=btCustom then
  2192. begin
  2193. if IsJSBaseType(RHS,pbtJSValue) then
  2194. Result:=cExact;
  2195. end
  2196. else if RHS.BaseType=btContext then
  2197. Result:=cExact+1;
  2198. end
  2199. else if RHS.BaseType=btContext then
  2200. begin
  2201. // right side is not a value
  2202. if RHS.IdentEl<>nil then
  2203. begin
  2204. if RHS.IdentEl.ClassType=TPasClassType then
  2205. Result:=cExact+1; // RHS is a class
  2206. end;
  2207. end;
  2208. end;
  2209. end;
  2210. end
  2211. else if RHS.BaseType=btCustom then
  2212. exit(CheckEqualCompatibilityCustomType(RHS,LHS,ErrorEl,RaiseOnIncompatible))
  2213. else
  2214. RaiseInternalError(20170330005725);
  2215. end;
  2216. procedure TPas2JSResolver.BI_TypeInfo_OnGetCallResult(
  2217. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  2218. ResolvedEl: TPasResolverResult);
  2219. // if an external type with the right name and external name is in scope return
  2220. // that, otherwise btPointer
  2221. var
  2222. Param: TPasExpr;
  2223. ParamResolved: TPasResolverResult;
  2224. C: TClass;
  2225. TIName: String;
  2226. FindData: TPRFindData;
  2227. Abort: boolean;
  2228. bt: TResolverBaseType;
  2229. jbt: TPas2jsBaseType;
  2230. TypeEl: TPasType;
  2231. FoundClass: TPasClassType;
  2232. begin
  2233. Param:=Params.Params[0];
  2234. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  2235. if ParamResolved.TypeEl=nil then
  2236. RaiseInternalError(20170413090726);
  2237. TypeEl:=ResolveAliasType(ParamResolved.TypeEl);
  2238. C:=TypeEl.ClassType;
  2239. TIName:='';
  2240. //writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TypeEl=',GetObjName(TypeEl));
  2241. if C=TPasUnresolvedSymbolRef then
  2242. begin
  2243. if TypeEl.CustomData is TResElDataPas2JSBaseType then
  2244. begin
  2245. jbt:=TResElDataPas2JSBaseType(TypeEl.CustomData).JSBaseType;
  2246. if jbt=pbtJSValue then
  2247. TIName:=Pas2JSBuiltInNames[pbitnTI];
  2248. end
  2249. else if TypeEl.CustomData is TResElDataBaseType then
  2250. begin
  2251. bt:=TResElDataBaseType(TypeEl.CustomData).BaseType;
  2252. if bt in btAllInteger then
  2253. TIName:=Pas2JSBuiltInNames[pbitnTIInteger]
  2254. else if bt in [btString,btChar,btDouble,btBoolean] then
  2255. TIName:=Pas2JSBuiltInNames[pbitnTI]
  2256. else if bt=btPointer then
  2257. TIName:=Pas2JSBuiltInNames[pbitnTIPointer];
  2258. end;
  2259. end
  2260. else if ParamResolved.BaseType=btContext then
  2261. begin
  2262. if C=TPasEnumType then
  2263. TIName:=Pas2JSBuiltInNames[pbitnTIEnum]
  2264. else if C=TPasSetType then
  2265. TIName:=Pas2JSBuiltInNames[pbitnTISet]
  2266. else if C.InheritsFrom(TPasProcedureType) then
  2267. begin
  2268. if TPasProcedureType(TypeEl).IsOfObject then
  2269. TIName:=Pas2JSBuiltInNames[pbitnTIMethodVar]
  2270. else
  2271. TIName:=Pas2JSBuiltInNames[pbitnTIProcVar];
  2272. end
  2273. else if C=TPasRecordType then
  2274. TIName:=Pas2JSBuiltInNames[pbitnTIRecord]
  2275. else if C=TPasClassType then
  2276. TIName:=Pas2JSBuiltInNames[pbitnTIClass]
  2277. else if C=TPasClassOfType then
  2278. TIName:=Pas2JSBuiltInNames[pbitnTIClassRef]
  2279. else if C=TPasArrayType then
  2280. begin
  2281. if length(TPasArrayType(TypeEl).Ranges)>0 then
  2282. TIName:=Pas2JSBuiltInNames[pbitnTIStaticArray]
  2283. else
  2284. TIName:=Pas2JSBuiltInNames[pbitnTIDynArray];
  2285. end
  2286. else if C=TPasPointerType then
  2287. TIName:=Pas2JSBuiltInNames[pbitnTIPointer]
  2288. end
  2289. else if ParamResolved.BaseType=btSet then
  2290. begin
  2291. if ParamResolved.IdentEl is TPasSetType then
  2292. TIName:=Pas2JSBuiltInNames[pbitnTISet];
  2293. end
  2294. else if ParamResolved.BaseType=btCustom then
  2295. begin
  2296. end;
  2297. if TIName='' then
  2298. begin
  2299. {$IFDEF VerbosePas2JS}
  2300. writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult ',GetResolverResultDesc(ParamResolved));
  2301. {$ENDIF}
  2302. RaiseMsg(20170413091852,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
  2303. end;
  2304. // search for TIName
  2305. FindData:=Default(TPRFindData);
  2306. FindData.ErrorPosEl:=Params;
  2307. Abort:=false;
  2308. IterateElements(TIName,@OnFindFirstElement,@FindData,Abort);
  2309. {$IFDEF VerbosePas2JS}
  2310. writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName="',TIName,'" FindData.Found="',GetObjName(FindData.Found),'"');
  2311. {$ENDIF}
  2312. if (FindData.Found<>nil) and (FindData.Found.ClassType=TPasClassType) then
  2313. begin
  2314. FoundClass:=TPasClassType(FindData.Found);
  2315. if FoundClass.IsExternal
  2316. and (FoundClass.ExternalName=Pas2JSBuiltInNames[pbivnRTL]+'.'+TIName) then
  2317. begin
  2318. // use external class definition
  2319. {$IFDEF VerbosePas2JS}
  2320. writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult FindData.Found="',FindData.Found.FullName,'"');
  2321. {$ENDIF}
  2322. SetResolverTypeExpr(ResolvedEl,btContext,TPasClassType(FindData.Found),[rrfReadable]);
  2323. exit;
  2324. end;
  2325. end;
  2326. // default: btPointer
  2327. SetResolverTypeExpr(ResolvedEl,btPointer,BaseTypes[btPointer],[rrfReadable]);
  2328. if Proc=nil then ;
  2329. end;
  2330. constructor TPas2JSResolver.Create;
  2331. var
  2332. bt: TPas2jsBaseType;
  2333. begin
  2334. inherited;
  2335. FExternalNames:=TFPHashList.Create;
  2336. StoreSrcColumns:=true;
  2337. Options:=Options+DefaultPasResolverOptions;
  2338. ScopeClass_Class:=TPas2JSClassScope;
  2339. ScopeClass_WithExpr:=TPas2JSWithExprScope;
  2340. for bt in [pbtJSValue] do
  2341. AddJSBaseType(Pas2jsBaseTypeNames[bt],bt);
  2342. end;
  2343. destructor TPas2JSResolver.Destroy;
  2344. begin
  2345. ClearElementData;
  2346. FreeAndNil(FExternalNames);
  2347. inherited Destroy;
  2348. end;
  2349. procedure TPas2JSResolver.AddObjFPCBuiltInIdentifiers(
  2350. const TheBaseTypes: TResolveBaseTypes;
  2351. const TheBaseProcs: TResolverBuiltInProcs);
  2352. var
  2353. InvalidTypes: TResolveBaseTypes;
  2354. bt: TResolverBaseType;
  2355. InvalidProcs: TResolverBuiltInProcs;
  2356. bf: TResolverBuiltInProc;
  2357. begin
  2358. InvalidTypes:=TheBaseTypes-btAllPas2jsBaseTypes;
  2359. if InvalidTypes<>[] then
  2360. for bt in InvalidTypes do
  2361. RaiseInternalError(20170409180202,BaseTypeNames[bt]);
  2362. InvalidProcs:=TheBaseProcs-bfAllPas2jsBaseProcs;
  2363. if InvalidProcs<>[] then
  2364. for bf in InvalidProcs do
  2365. RaiseInternalError(20170409180246,ResolverBuiltInProcNames[bf]);
  2366. inherited AddObjFPCBuiltInIdentifiers(TheBaseTypes,TheBaseProcs);
  2367. end;
  2368. function TPas2JSResolver.CheckTypeCastRes(const FromResolved,
  2369. ToResolved: TPasResolverResult; ErrorEl: TPasElement; RaiseOnError: boolean
  2370. ): integer;
  2371. var
  2372. JSBaseType: TPas2jsBaseType;
  2373. C: TClass;
  2374. ToClass: TPasClassType;
  2375. begin
  2376. Result:=cIncompatible;
  2377. {$IFDEF VerbosePas2JS}
  2378. writeln('TPas2JSResolver.CheckTypeCastCustomBaseType To=',GetResolverResultDesc(ToResolved),' From=',GetResolverResultDesc(FromResolved));
  2379. {$ENDIF}
  2380. if rrfReadable in FromResolved.Flags then
  2381. begin
  2382. if (ToResolved.BaseType=btCustom) then
  2383. begin
  2384. if not (ToResolved.TypeEl is TPasUnresolvedSymbolRef) then
  2385. RaiseInternalError(20170325142826);
  2386. if (ToResolved.TypeEl.CustomData is TResElDataPas2JSBaseType) then
  2387. begin
  2388. // type cast to pas2js type, e.g. JSValue(V)
  2389. JSBaseType:=TResElDataPas2JSBaseType(ToResolved.TypeEl.CustomData).JSBaseType;
  2390. if JSBaseType=pbtJSValue then
  2391. begin
  2392. if rrfReadable in FromResolved.Flags then
  2393. begin
  2394. if (FromResolved.BaseType in btAllJSValueSrcTypes) then
  2395. Result:=cExact+1 // type cast to JSValue
  2396. else if FromResolved.BaseType=btCustom then
  2397. begin
  2398. if IsJSBaseType(FromResolved,pbtJSValue) then
  2399. Result:=cExact;
  2400. end
  2401. else if FromResolved.BaseType=btContext then
  2402. Result:=cExact+1;
  2403. end;
  2404. end;
  2405. exit;
  2406. end;
  2407. end
  2408. else if FromResolved.BaseType=btCustom then
  2409. begin
  2410. if not (FromResolved.TypeEl is TPasUnresolvedSymbolRef) then
  2411. RaiseInternalError(20170325143016);
  2412. if (FromResolved.TypeEl.CustomData is TResElDataPas2JSBaseType) then
  2413. begin
  2414. // type cast a pas2js value, e.g. T(jsvalue)
  2415. if not (rrfReadable in FromResolved.Flags) then
  2416. exit;
  2417. JSBaseType:=TResElDataPas2JSBaseType(FromResolved.TypeEl.CustomData).JSBaseType;
  2418. if JSBaseType=pbtJSValue then
  2419. begin
  2420. if (ToResolved.BaseType in btAllJSValueTypeCastTo) then
  2421. Result:=cExact+1 // type cast JSValue to simple base type
  2422. else if ToResolved.BaseType=btContext then
  2423. begin
  2424. C:=ToResolved.TypeEl.ClassType;
  2425. if (C=TPasClassType)
  2426. or (C=TPasClassOfType)
  2427. or (C=TPasEnumType) then
  2428. Result:=cExact+1;
  2429. end;
  2430. end;
  2431. exit;
  2432. end;
  2433. end
  2434. else if ToResolved.BaseType=btContext then
  2435. begin
  2436. C:=ToResolved.TypeEl.ClassType;
  2437. if C=TPasClassType then
  2438. begin
  2439. ToClass:=TPasClassType(ToResolved.TypeEl);
  2440. if ToClass.IsExternal then
  2441. begin
  2442. if IsExternalClassName(ToClass,'String')
  2443. and (FromResolved.BaseType in btAllStringAndChars) then
  2444. exit(cExact);
  2445. if IsExternalClassName(ToClass,'Array')
  2446. and ((FromResolved.BaseType=btArray)
  2447. or (FromResolved.BaseType=btContext)) then
  2448. exit(cExact);
  2449. end;
  2450. end
  2451. else if C=TPasArrayType then
  2452. begin
  2453. if (FromResolved.BaseType=btContext)
  2454. and (FromResolved.TypeEl.ClassType=TPasClassType)
  2455. and TPasClassType(FromResolved.TypeEl).IsExternal
  2456. and IsExternalClassName(TPasClassType(FromResolved.TypeEl),'Array') then
  2457. begin
  2458. // type cast external Array to an array
  2459. exit(cExact+1);
  2460. end;
  2461. end;
  2462. end;
  2463. end;
  2464. Result:=inherited CheckTypeCastRes(FromResolved,ToResolved,ErrorEl,RaiseOnError);
  2465. end;
  2466. function TPas2JSResolver.ExtractPasStringLiteral(El: TPasElement;
  2467. const S: String): TJSString;
  2468. { Extracts the value from a Pascal string literal
  2469. S is a Pascal string literal e.g. 'Line'#10
  2470. '' empty string
  2471. '''' => "'"
  2472. #decimal
  2473. #$hex
  2474. ^l l is a letter a-z
  2475. }
  2476. var
  2477. p, StartP: PChar;
  2478. c: Char;
  2479. i: Integer;
  2480. begin
  2481. Result:='';
  2482. {$IFDEF VerbosePas2JS}
  2483. writeln('TPasToJSConverter.ExtractPasStringLiteral "',S,'"');
  2484. {$ENDIF}
  2485. if S='' then
  2486. RaiseInternalError(20170207154543);
  2487. p:=PChar(S);
  2488. repeat
  2489. case p^ of
  2490. #0: break;
  2491. '''':
  2492. begin
  2493. inc(p);
  2494. StartP:=p;
  2495. repeat
  2496. c:=p^;
  2497. case c of
  2498. #0:
  2499. RaiseInternalError(20170207155120);
  2500. '''':
  2501. begin
  2502. if p>StartP then
  2503. Result:=Result+TJSString(copy(S,StartP-PChar(S)+1,p-StartP));
  2504. inc(p);
  2505. StartP:=p;
  2506. if p^<>'''' then
  2507. break;
  2508. Result:=Result+'''';
  2509. inc(p);
  2510. StartP:=p;
  2511. end;
  2512. else
  2513. inc(p);
  2514. end;
  2515. until false;
  2516. if p>StartP then
  2517. Result:=Result+TJSString(copy(S,StartP-PChar(S)+1,p-StartP));
  2518. end;
  2519. '#':
  2520. begin
  2521. inc(p);
  2522. if p^='$' then
  2523. begin
  2524. // #$hexnumber
  2525. inc(p);
  2526. StartP:=p;
  2527. i:=0;
  2528. repeat
  2529. c:=p^;
  2530. case c of
  2531. #0: break;
  2532. '0'..'9': i:=i*16+ord(c)-ord('0');
  2533. 'a'..'f': i:=i*16+ord(c)-ord('a')+10;
  2534. 'A'..'F': i:=i*16+ord(c)-ord('A')+10;
  2535. else break;
  2536. end;
  2537. if i>$10ffff then
  2538. RaiseNotYetImplemented(20170207164657,El,'maximum codepoint is $10ffff');
  2539. inc(p);
  2540. until false;
  2541. if p=StartP then
  2542. RaiseInternalError(20170207164956);
  2543. Result:=Result+CodePointToJSString(i);
  2544. end
  2545. else
  2546. begin
  2547. // #decimalnumber
  2548. StartP:=p;
  2549. i:=0;
  2550. repeat
  2551. c:=p^;
  2552. case c of
  2553. #0: break;
  2554. '0'..'9': i:=i*10+ord(c)-ord('0');
  2555. else break;
  2556. end;
  2557. if i>$10ffff then
  2558. RaiseNotYetImplemented(20170207171140,El,'maximum codepoint is $10ffff');
  2559. inc(p);
  2560. until false;
  2561. if p=StartP then
  2562. RaiseInternalError(20170207171148);
  2563. Result:=Result+CodePointToJSString(i);
  2564. end;
  2565. end;
  2566. '^':
  2567. begin
  2568. // ^A is #1
  2569. inc(p);
  2570. c:=p^;
  2571. case c of
  2572. 'a'..'z': Result:=Result+TJSChar(ord(c)-ord('a')+1);
  2573. 'A'..'Z': Result:=Result+TJSChar(ord(c)-ord('A')+1);
  2574. else RaiseInternalError(20170207160412);
  2575. end;
  2576. inc(p);
  2577. end;
  2578. else
  2579. RaiseNotYetImplemented(20170207154653,El,'ord='+IntToStr(ord(p^)));
  2580. end;
  2581. until false;
  2582. {$IFDEF VerbosePas2JS}
  2583. writeln('TPasToJSConverter.ExtractPasStringLiteral Result="',Result,'"');
  2584. {$ENDIF}
  2585. end;
  2586. function TPas2JSResolver.ComputeConst(Expr: TPasExpr; StoreCustomData: boolean
  2587. ): TJSValue;
  2588. var
  2589. Prim: TPrimitiveExpr;
  2590. V: TJSValue;
  2591. ConstData: TP2JConstExprData;
  2592. begin
  2593. Result:=nil;
  2594. if Expr=nil then
  2595. RaiseInternalError(20170215123600);
  2596. if StoreCustomData and (Expr.CustomData is TPasElementBase) then
  2597. begin
  2598. ConstData:=TP2JConstExprData(GetElementData(
  2599. TPasElementBase(Expr.CustomData),TP2JConstExprData));
  2600. if ConstData<>nil then
  2601. begin
  2602. // use stored result
  2603. Result:=ConstData.Value;
  2604. exit;
  2605. end;
  2606. end;
  2607. V:=nil;
  2608. try
  2609. if Expr.ClassType=TPrimitiveExpr then
  2610. begin
  2611. Prim:=TPrimitiveExpr(Expr);
  2612. if Prim.Kind=pekString then
  2613. V:=TJSValue.Create(ExtractPasStringLiteral(Prim,Prim.Value))
  2614. else
  2615. RaiseNotYetImplemented(20170215124733,Prim);
  2616. end
  2617. else
  2618. RaiseNotYetImplemented(20170215124746,Expr);
  2619. Result:=V;
  2620. if StoreCustomData then
  2621. begin
  2622. // store result
  2623. ConstData:=TP2JConstExprData(CreateElementData(TP2JConstExprData,Expr));
  2624. ConstData.Value:=V;
  2625. end;
  2626. finally
  2627. if Result=nil then
  2628. V.Free;
  2629. end;
  2630. end;
  2631. function TPas2JSResolver.ComputeConstString(Expr: TPasExpr; StoreCustomData,
  2632. NotEmpty: boolean): String;
  2633. var
  2634. V: TJSValue;
  2635. begin
  2636. V:=ComputeConst(Expr,StoreCustomData);
  2637. if V.ValueType<>jsbase.jstString then
  2638. RaiseNotYetImplemented(20170320220728,Expr,'expected string constant');
  2639. if V.ValueType<>jstString then
  2640. RaiseMsg(20170211221121,nExpectedXButFoundY,sExpectedXButFoundY,['string literal',JSTypeCaptions[V.ValueType]],Expr);
  2641. if NotEmpty and (V.AsString='') then
  2642. RaiseMsg(20170321085318,nExpectedXButFoundY,sExpectedXButFoundY,['string literal','empty'],Expr);
  2643. Result:=String(V.AsString);
  2644. end;
  2645. function TPas2JSResolver.IsExternalBracketAccessor(El: TPasElement): boolean;
  2646. var
  2647. ExtName: String;
  2648. begin
  2649. if (not (El is TPasProcedure)) or (TPasProcedure(El).LibrarySymbolName=nil) then
  2650. exit(false);
  2651. ExtName:=ComputeConstString(TPasProcedure(El).LibrarySymbolName,false,false);
  2652. Result:=ExtName=ExtClassBracketAccessor;
  2653. end;
  2654. function TPas2JSResolver.GetElementData(El: TPasElementBase;
  2655. DataClass: TPas2JsElementDataClass): TPas2JsElementData;
  2656. begin
  2657. Result:=nil;
  2658. repeat
  2659. if El.InheritsFrom(DataClass) then
  2660. exit(TPas2JsElementData(El));
  2661. if El.CustomData=nil then exit;
  2662. El:=El.CustomData as TPasElementBase;
  2663. until false;
  2664. end;
  2665. procedure TPas2JSResolver.AddElementData(Data: TPas2JsElementData);
  2666. begin
  2667. Data.Owner:=Self;
  2668. if FFirstElementData<>nil then
  2669. begin
  2670. FLastElementData.Next:=Data;
  2671. FLastElementData:=Data;
  2672. end
  2673. else
  2674. begin
  2675. FFirstElementData:=Data;
  2676. FLastElementData:=Data;
  2677. end;
  2678. end;
  2679. function TPas2JSResolver.CreateElementData(DataClass: TPas2JsElementDataClass;
  2680. El: TPasElement): TPas2JsElementData;
  2681. begin
  2682. Result:=DataClass.Create;
  2683. Result.Element:=El;
  2684. AddElementData(Result);
  2685. end;
  2686. function TPas2JSResolver.HasTypeInfo(El: TPasType): boolean;
  2687. begin
  2688. Result:=inherited HasTypeInfo(El);
  2689. if not Result then exit;
  2690. if (El.ClassType=TPasClassType) and TPasClassType(El).IsExternal then
  2691. exit(false);
  2692. if El.Parent is TProcedureBody then
  2693. Result:=false;
  2694. end;
  2695. { TP2JConstExprData }
  2696. destructor TP2JConstExprData.Destroy;
  2697. begin
  2698. FreeAndNil(Value);
  2699. inherited Destroy;
  2700. end;
  2701. { TParamContext }
  2702. constructor TParamContext.Create(PasEl: TPasElement; JSEl: TJSElement;
  2703. aParent: TConvertContext);
  2704. begin
  2705. inherited Create(PasEl, JSEl, aParent);
  2706. Access:=caAssign;
  2707. AccessContext:=Self;
  2708. end;
  2709. { TPas2JsElementData }
  2710. procedure TPas2JsElementData.SetElement(const AValue: TPasElement);
  2711. var
  2712. Data: TPasElementBase;
  2713. begin
  2714. if FElement=AValue then Exit;
  2715. if FElement<>nil then
  2716. begin
  2717. Data:=FElement;
  2718. while Data.CustomData<>Self do
  2719. if Data.CustomData is TPasElementBase then
  2720. Data:=TPasElementBase(Data.CustomData)
  2721. else
  2722. begin
  2723. {$IFDEF VerbosePas2JS}
  2724. writeln('TPas2JsElementData.SetElement REMOVE ',ClassName);
  2725. writeln(' ',GetObjName(Data.CustomData));
  2726. {$ENDIF}
  2727. raise EPas2JS.Create('');
  2728. end;
  2729. Data.CustomData:=CustomData;
  2730. TPasElement(FElement).Release;
  2731. end;
  2732. FElement:=AValue;
  2733. if FElement<>nil then
  2734. begin
  2735. TPasElement(FElement).AddRef;
  2736. Data:=FElement;
  2737. while Data.CustomData is TPasElementBase do
  2738. Data:=TPasElementBase(Data.CustomData);
  2739. if Data.CustomData<>nil then
  2740. begin
  2741. {$IFDEF VerbosePas2JS}
  2742. writeln('TPas2JsElementData.SetElement INSERT ',ClassName);
  2743. writeln(' ',GetObjName(Data.CustomData));
  2744. {$ENDIF}
  2745. raise EPas2JS.Create('');
  2746. end;
  2747. Data.CustomData:=Self;
  2748. end;
  2749. end;
  2750. constructor TPas2JsElementData.Create;
  2751. begin
  2752. end;
  2753. destructor TPas2JsElementData.Destroy;
  2754. begin
  2755. Element:=nil;
  2756. Next:=nil;
  2757. Owner:=nil;
  2758. inherited Destroy;
  2759. end;
  2760. { TAssignContext }
  2761. constructor TAssignContext.Create(PasEl: TPasElement; JSEl: TJSElement;
  2762. aParent: TConvertContext);
  2763. begin
  2764. inherited Create(PasEl, JSEl, aParent);
  2765. Access:=caAssign;
  2766. AccessContext:=Self;
  2767. end;
  2768. { TDotContext }
  2769. constructor TDotContext.Create(PasEl: TPasElement; JSEl: TJSElement;
  2770. aParent: TConvertContext);
  2771. begin
  2772. inherited Create(PasEl, JSEl, aParent);
  2773. Kind:=cjkDot;
  2774. end;
  2775. { TSectionContext }
  2776. constructor TSectionContext.Create(PasEl: TPasElement; JSEl: TJSElement;
  2777. aParent: TConvertContext);
  2778. begin
  2779. inherited;
  2780. IsSingleton:=true;
  2781. end;
  2782. { TObjectContext }
  2783. constructor TObjectContext.Create(PasEl: TPasElement; JSEl: TJSElement;
  2784. aParent: TConvertContext);
  2785. begin
  2786. inherited;
  2787. Kind:=cjkObject;
  2788. end;
  2789. { TFunctionContext }
  2790. constructor TFunctionContext.Create(PasEl: TPasElement; JSEl: TJSElement;
  2791. aParent: TConvertContext);
  2792. begin
  2793. inherited;
  2794. Kind:=cjkFunction;
  2795. end;
  2796. { TRootContext }
  2797. constructor TRootContext.Create(PasEl: TPasElement; JSEl: TJSElement;
  2798. aParent: TConvertContext);
  2799. begin
  2800. inherited;
  2801. Kind:=cjkRoot;
  2802. end;
  2803. { TConvertContext }
  2804. constructor TConvertContext.Create(PasEl: TPasElement; JSEl: TJSElement;
  2805. aParent: TConvertContext);
  2806. begin
  2807. PasElement:=PasEl;
  2808. JSElement:=JsEl;
  2809. Parent:=aParent;
  2810. if Parent<>nil then
  2811. begin
  2812. Resolver:=Parent.Resolver;
  2813. Access:=aParent.Access;
  2814. AccessContext:=aParent.AccessContext;
  2815. end;
  2816. end;
  2817. function TConvertContext.GetRootModule: TPasModule;
  2818. var
  2819. aContext: TConvertContext;
  2820. begin
  2821. aContext:=Self;
  2822. while aContext.Parent<>nil do
  2823. aContext:=aContext.Parent;
  2824. if aContext.PasElement is TPasModule then
  2825. Result:=TPasModule(aContext.PasElement)
  2826. else
  2827. Result:=nil;
  2828. end;
  2829. function TConvertContext.GetThis: TPasElement;
  2830. var
  2831. ctx: TFunctionContext;
  2832. begin
  2833. ctx:=GetThisContext;
  2834. if ctx<>nil then
  2835. Result:=ctx.This
  2836. else
  2837. Result:=nil;
  2838. end;
  2839. function TConvertContext.GetThisContext: TFunctionContext;
  2840. begin
  2841. Result:=TFunctionContext(GetContextOfType(TFunctionContext));
  2842. end;
  2843. function TConvertContext.GetContextOfType(aType: TConvertContextClass
  2844. ): TConvertContext;
  2845. var
  2846. ctx: TConvertContext;
  2847. begin
  2848. Result:=nil;
  2849. ctx:=Self;
  2850. repeat
  2851. if ctx is aType then
  2852. exit(ctx);
  2853. ctx:=ctx.Parent;
  2854. until ctx=nil;
  2855. end;
  2856. function TConvertContext.CreateLocalIdentifier(const Prefix: string): string;
  2857. begin
  2858. inc(TmpVarCount);
  2859. Result:=Prefix+IntToStr(TmpVarCount);
  2860. end;
  2861. function TConvertContext.CurrentModeswitches: TModeSwitches;
  2862. begin
  2863. if Resolver=nil then
  2864. Result:=OBJFPCModeSwitches
  2865. else
  2866. Result:=Resolver.CurrentParser.CurrentModeswitches;
  2867. end;
  2868. function TConvertContext.GetSingletonFunc: TFunctionContext;
  2869. var
  2870. Ctx: TConvertContext;
  2871. begin
  2872. Ctx:=Self;
  2873. while (Ctx<>nil) do
  2874. begin
  2875. if Ctx.IsSingleton and (Ctx.JSElement<>nil) and (Ctx is TFunctionContext) then
  2876. exit(TFunctionContext(Ctx));
  2877. Ctx:=Ctx.Parent;
  2878. end;
  2879. end;
  2880. { TPasToJSConverter }
  2881. // inline
  2882. function TPasToJSConverter.GetUseEnumNumbers: boolean;
  2883. begin
  2884. Result:=coEnumNumbers in FOptions;
  2885. end;
  2886. // inline
  2887. function TPasToJSConverter.GetUseLowerCase: boolean;
  2888. begin
  2889. Result:=coLowerCase in FOptions;
  2890. end;
  2891. // inline
  2892. function TPasToJSConverter.GetUseSwitchStatement: boolean;
  2893. begin
  2894. Result:=coSwitchStatement in FOptions;
  2895. end;
  2896. procedure TPasToJSConverter.AddToSourceElements(Src: TJSSourceElements;
  2897. El: TJSElement);
  2898. Var
  2899. List : TJSStatementList;
  2900. AddEl : TJSElement;
  2901. begin
  2902. While El<>nil do
  2903. begin
  2904. if El is TJSStatementList then
  2905. begin
  2906. List:=El as TJSStatementList;
  2907. // List.A is first statement, List.B is next in list, chained.
  2908. // -> add A, continue with B and free List
  2909. AddEl:=List.A;
  2910. El:=List.B;
  2911. List.A:=Nil;
  2912. List.B:=Nil;
  2913. FreeAndNil(List);
  2914. end
  2915. else
  2916. begin
  2917. AddEl:=El;
  2918. El:=Nil;
  2919. end;
  2920. Src.Statements.AddNode.Node:=AddEl;
  2921. end;
  2922. end;
  2923. procedure TPasToJSConverter.RemoveFromSourceElements(Src: TJSSourceElements;
  2924. El: TJSElement);
  2925. var
  2926. Statements: TJSElementNodes;
  2927. i: Integer;
  2928. begin
  2929. Statements:=Src.Statements;
  2930. for i:=Statements.Count-1 downto 0 do
  2931. if Statements[i].Node=El then
  2932. Statements.Delete(i);
  2933. end;
  2934. function TPasToJSConverter.GetBuildInNames(bin: TPas2JSBuiltInName): string;
  2935. begin
  2936. Result:=FBuiltInNames[bin];
  2937. end;
  2938. procedure TPasToJSConverter.SetBuildInNames(bin: TPas2JSBuiltInName;
  2939. const AValue: string);
  2940. begin
  2941. FBuiltInNames[bin]:=AValue;
  2942. end;
  2943. procedure TPasToJSConverter.SetPreservedWords(const AValue: TJSReservedWordList
  2944. );
  2945. var
  2946. i: Integer;
  2947. begin
  2948. if FPreservedWords=AValue then Exit;
  2949. for i:=0 to length(AValue)-2 do
  2950. if CompareStr(AValue[i],AValue[i+1])>=0 then
  2951. raise Exception.Create('TPasToJSConverter.SetPreservedWords "'+AValue[i]+'" >= "'+AValue[i+1]+'"');
  2952. FPreservedWords:=AValue;
  2953. end;
  2954. function TPasToJSConverter.ConvertModule(El: TPasModule;
  2955. AContext: TConvertContext): TJSElement;
  2956. (*
  2957. Program:
  2958. rtl.module('program',
  2959. [<uses1>,<uses2>, ...],
  2960. function(){
  2961. <programsection>
  2962. this.$main=function(){
  2963. <initialization>
  2964. };
  2965. });
  2966. Unit:
  2967. rtl.module('<unitname>',
  2968. [<interface uses1>,<uses2>, ...],
  2969. function(){
  2970. var $impl = {};
  2971. this.$impl = $impl;
  2972. <interface>
  2973. this.$init=function(){
  2974. <initialization>
  2975. };
  2976. },
  2977. [<implementation uses1>,<uses2>, ...],
  2978. function(){
  2979. var $impl = this.$impl;
  2980. <implementation>
  2981. });
  2982. *)
  2983. Var
  2984. OuterSrc , Src: TJSSourceElements;
  2985. RegModuleCall: TJSCallExpression;
  2986. ArgArray: TJSArguments;
  2987. UsesList: TFPList;
  2988. FunDecl, ImplFunc: TJSFunctionDeclarationStatement;
  2989. UsesSection: TPasSection;
  2990. ModuleName: String;
  2991. IntfContext: TSectionContext;
  2992. ImplVarSt: TJSVariableStatement;
  2993. HasImplUsesList: Boolean;
  2994. begin
  2995. Result:=Nil;
  2996. OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El));
  2997. Result:=OuterSrc;
  2998. // create 'rtl.module(...)'
  2999. RegModuleCall:=CreateCallExpression(El);
  3000. AddToSourceElements(OuterSrc,RegModuleCall);
  3001. RegModuleCall.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],'module']);
  3002. ArgArray := RegModuleCall.Args;
  3003. RegModuleCall.Args:=ArgArray;
  3004. // add unitname parameter: unitname
  3005. ModuleName:=TransformModuleName(El,AContext);
  3006. ArgArray.Elements.AddElement.Expr:=CreateLiteralString(El,ModuleName);
  3007. // add interface-uses-section parameter: [<interface uses1>,<uses2>, ...]
  3008. UsesSection:=nil;
  3009. if (El is TPasProgram) then
  3010. UsesSection:=TPasProgram(El).ProgramSection
  3011. else if (El is TPasLibrary) then
  3012. UsesSection:=TPasLibrary(El).LibrarySection
  3013. else
  3014. UsesSection:=El.InterfaceSection;
  3015. ArgArray.Elements.AddElement.Expr:=CreateUsesList(UsesSection,AContext);
  3016. // add interface parameter: function(){}
  3017. FunDecl:=CreateFunction(El,true,true);
  3018. ArgArray.Elements.AddElement.Expr:=FunDecl;
  3019. Src:=FunDecl.AFunction.Body.A as TJSSourceElements;
  3020. if coUseStrict in Options then
  3021. AddToSourceElements(Src,CreateLiteralString(El,'use strict'));
  3022. ImplVarSt:=nil;
  3023. HasImplUsesList:=false;
  3024. IntfContext:=TSectionContext.Create(El,Src,AContext);
  3025. try
  3026. IntfContext.This:=El;
  3027. if (El is TPasProgram) then
  3028. begin // program
  3029. if Assigned(TPasProgram(El).ProgramSection) then
  3030. AddToSourceElements(Src,ConvertDeclarations(TPasProgram(El).ProgramSection,IntfContext));
  3031. CreateInitSection(El,Src,IntfContext);
  3032. end
  3033. else if El is TPasLibrary then
  3034. begin // library
  3035. if Assigned(TPasLibrary(El).LibrarySection) then
  3036. AddToSourceElements(Src,ConvertDeclarations(TPasLibrary(El).LibrarySection,IntfContext));
  3037. CreateInitSection(El,Src,IntfContext);
  3038. end
  3039. else
  3040. begin // unit
  3041. // add implementation object at top, so the interface elemwnts can add stuff
  3042. if Assigned(El.ImplementationSection) then
  3043. begin
  3044. // add var $impl = this.$impl
  3045. ImplVarSt:=CreateVarStatement(FBuiltInNames[pbivnImplementation],
  3046. CreateMemberExpression(['this',FBuiltInNames[pbivnImplementation]]),El);
  3047. AddToSourceElements(Src,ImplVarSt);
  3048. end;
  3049. if Assigned(El.InterfaceSection) then
  3050. AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfContext));
  3051. CreateInitSection(El,Src,IntfContext);
  3052. // add optional implementation uses list: [<implementation uses1>,<uses2>, ...]
  3053. if Assigned(El.ImplementationSection) then
  3054. begin
  3055. UsesList:=El.ImplementationSection.UsesList;
  3056. if (UsesList<>nil) and (UsesList.Count>0) then
  3057. begin
  3058. ArgArray.Elements.AddElement.Expr:=CreateUsesList(El.ImplementationSection,AContext);
  3059. HasImplUsesList:=true;
  3060. end;
  3061. end;
  3062. end;
  3063. finally
  3064. IntfContext.Free;
  3065. end;
  3066. // add implementation function
  3067. if ImplVarSt<>nil then
  3068. begin
  3069. ImplFunc:=CreateImplementationSection(El,AContext);
  3070. if ImplFunc=nil then
  3071. begin
  3072. // remove unneeded $impl from interface
  3073. RemoveFromSourceElements(Src,ImplVarSt);
  3074. end
  3075. else
  3076. begin
  3077. // add param
  3078. if not HasImplUsesList then
  3079. ArgArray.Elements.AddElement.Expr:=CreateLiteralNull(El);
  3080. ArgArray.Elements.AddElement.Expr:=ImplFunc;
  3081. end;
  3082. end;
  3083. end;
  3084. function TPasToJSConverter.CreateElement(C: TJSElementClass; Src: TPasElement
  3085. ): TJSElement;
  3086. var
  3087. Line, Col: Integer;
  3088. begin
  3089. if Assigned(Src) then
  3090. begin
  3091. TPasResolver.UnmangleSourceLineNumber(Src.SourceLinenumber,Line,Col);
  3092. Result:=C.Create(Line,Col,Src.SourceFilename);
  3093. end
  3094. else
  3095. Result:=C.Create(0,0);
  3096. end;
  3097. function TPasToJSConverter.CreateFreeOrNewInstanceExpr(Ref: TResolvedReference;
  3098. AContext: TConvertContext): TJSCallExpression;
  3099. // create "$create("funcname");"
  3100. var
  3101. ok: Boolean;
  3102. C: TJSCallExpression;
  3103. Proc: TPasProcedure;
  3104. ProcScope: TPasProcedureScope;
  3105. ClassScope: TPasClassScope;
  3106. aClass: TPasElement;
  3107. ArgEx: TJSLiteral;
  3108. ArgElems: TJSArrayLiteralElements;
  3109. FunName: String;
  3110. begin
  3111. Result:=nil;
  3112. //writeln('TPasToJSConverter.CreateNewInstanceStatement Ref.Declaration=',GetObjName(Ref.Declaration));
  3113. Proc:=Ref.Declaration as TPasProcedure;
  3114. if Proc.Name='' then
  3115. RaiseInconsistency(20170125191914);
  3116. //writeln('TPasToJSConverter.CreateNewInstanceStatement Proc.Name=',Proc.Name);
  3117. ProcScope:=Proc.CustomData as TPasProcedureScope;
  3118. //writeln('TPasToJSConverter.CreateNewInstanceStatement ProcScope.Element=',GetObjName(ProcScope.Element),' ProcScope.ClassScope=',GetObjName(ProcScope.ClassScope),' ProcScope.DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ProcScope.ImplProc=',GetObjName(ProcScope.ImplProc),' ProcScope.CustomData=',GetObjName(ProcScope.CustomData));
  3119. ClassScope:=ProcScope.ClassScope;
  3120. aClass:=ClassScope.Element;
  3121. if aClass.Name='' then
  3122. RaiseInconsistency(20170125191923);
  3123. //writeln('TPasToJSConverter.CreateNewInstanceStatement aClass.Name=',aClass.Name);
  3124. C:=CreateCallExpression(Ref.Element);
  3125. ok:=false;
  3126. try
  3127. // add "$create()"
  3128. if rrfNewInstance in Ref.Flags then
  3129. FunName:=FBuiltInNames[pbifnClassInstanceNew]
  3130. else
  3131. FunName:=FBuiltInNames[pbifnClassInstanceFree];
  3132. FunName:=CreateReferencePath(Proc,AContext,rpkPathWithDot,false,Ref)+FunName;
  3133. C.Expr:=CreateBuiltInIdentifierExpr(FunName);
  3134. ArgElems:=C.Args.Elements;
  3135. // parameter: "funcname"
  3136. ArgEx := CreateLiteralString(Ref.Element,TransformVariableName(Proc,AContext));
  3137. ArgElems.AddElement.Expr:=ArgEx;
  3138. ok:=true;
  3139. finally
  3140. if not ok then
  3141. C.Free;
  3142. end;
  3143. Result:=C;
  3144. end;
  3145. function TPasToJSConverter.CreateFunction(El: TPasElement; WithBody: boolean;
  3146. WithSrc: boolean): TJSFunctionDeclarationStatement;
  3147. var
  3148. FuncDef: TJSFuncDef;
  3149. FuncSt: TJSFunctionDeclarationStatement;
  3150. Src: TJSSourceElements;
  3151. begin
  3152. FuncSt:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement,El));
  3153. Result:=FuncSt;
  3154. FuncDef:=TJSFuncDef.Create;
  3155. FuncSt.AFunction:=FuncDef;
  3156. if WithBody then
  3157. begin
  3158. FuncDef.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,El));
  3159. if WithSrc then
  3160. begin
  3161. Src:=TJSSourceElements(CreateElement(TJSSourceElements, El));
  3162. FuncDef.Body.A:=Src;
  3163. end;
  3164. end;
  3165. end;
  3166. function TPasToJSConverter.ConvertUnaryExpression(El: TUnaryExpr;
  3167. AContext: TConvertContext): TJSElement;
  3168. procedure NotSupported;
  3169. begin
  3170. DoError(20170215134950,nUnaryOpcodeNotSupported,sUnaryOpcodeNotSupported,
  3171. [OpcodeStrings[El.OpCode]],El);
  3172. end;
  3173. Var
  3174. U : TJSUnaryExpression;
  3175. E : TJSElement;
  3176. ResolvedOp, ResolvedEl: TPasResolverResult;
  3177. BitwiseNot: Boolean;
  3178. begin
  3179. if AContext=nil then ;
  3180. Result:=Nil;
  3181. U:=nil;
  3182. Case El.OpCode of
  3183. eopAdd:
  3184. begin
  3185. E:=ConvertElement(El.Operand,AContext);
  3186. U:=TJSUnaryPlusExpression(CreateElement(TJSUnaryPlusExpression,El));
  3187. U.A:=E;
  3188. end;
  3189. eopSubtract:
  3190. begin
  3191. E:=ConvertElement(El.Operand,AContext);
  3192. U:=TJSUnaryMinusExpression(CreateElement(TJSUnaryMinusExpression,El));
  3193. U.A:=E;
  3194. end;
  3195. eopNot:
  3196. begin
  3197. E:=ConvertElement(El.Operand,AContext);
  3198. BitwiseNot:=true;
  3199. if AContext.Resolver<>nil then
  3200. begin
  3201. AContext.Resolver.ComputeElement(El.Operand,ResolvedOp,[]);
  3202. BitwiseNot:=ResolvedOp.BaseType in btAllInteger;
  3203. end;
  3204. if BitwiseNot then
  3205. U:=TJSUnaryInvExpression(CreateElement(TJSUnaryInvExpression,El))
  3206. else
  3207. U:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
  3208. U.A:=E;
  3209. end;
  3210. eopAddress:
  3211. begin
  3212. if AContext.Resolver=nil then
  3213. NotSupported;
  3214. AContext.Resolver.ComputeElement(El.Operand,ResolvedEl,[rcNoImplicitProc]);
  3215. {$IFDEF VerbosePas2JS}
  3216. writeln('TPasToJSConverter.ConvertUnaryExpression ',GetResolverResultDesc(ResolvedEl));
  3217. {$ENDIF}
  3218. if ResolvedEl.BaseType=btProc then
  3219. begin
  3220. if ResolvedEl.IdentEl is TPasProcedure then
  3221. begin
  3222. Result:=CreateCallback(El.Operand,ResolvedEl,AContext);
  3223. exit;
  3224. end;
  3225. end;
  3226. end;
  3227. end;
  3228. if U=nil then
  3229. NotSupported;
  3230. Result:=U;
  3231. end;
  3232. function TPasToJSConverter.GetExpressionValueType(El: TPasExpr;
  3233. AContext: TConvertContext): TJSType;
  3234. Function CombineValueType(A,B : TJSType) : TJSType;
  3235. begin
  3236. If (A=jstUNDEFINED) then
  3237. Result:=B
  3238. else if (B=jstUNDEFINED) then
  3239. Result:=A
  3240. else
  3241. Result:=A; // pick the first
  3242. end;
  3243. Var
  3244. A,B : TJSType;
  3245. begin
  3246. if (El is TBoolConstExpr) then
  3247. Result:=jstBoolean
  3248. else if (El is TPrimitiveExpr) then
  3249. begin
  3250. Case El.Kind of
  3251. pekIdent : Result:=GetPasIdentValueType(El.Name,AContext);
  3252. pekNumber : Result:=jstNumber;
  3253. pekString : Result:=jstString;
  3254. pekSet : Result:=jstUNDEFINED;
  3255. pekNil : Result:=jstNull;
  3256. pekBoolConst : Result:=jstBoolean;
  3257. pekRange : Result:=jstUNDEFINED;
  3258. pekFuncParams : Result:=jstUNDEFINED;
  3259. pekArrayParams : Result:=jstUNDEFINED;
  3260. pekListOfExp : Result:=jstUNDEFINED;
  3261. pekInherited : Result:=jstUNDEFINED;
  3262. pekSelf : Result:=jstObject;
  3263. end
  3264. end
  3265. else if (El is TUnaryExpr) then
  3266. Result:=GetExpressionValueType(TUnaryExpr(El).Operand,AContext)
  3267. else if (El is TBinaryExpr) then
  3268. begin
  3269. A:=GetExpressionValueType(TBinaryExpr(El).Left,AContext);
  3270. B:=GetExpressionValueType(TBinaryExpr(El).Right,AContext);
  3271. Result:=CombineValueType(A,B);
  3272. end
  3273. else
  3274. result:=jstUndefined
  3275. end;
  3276. function TPasToJSConverter.GetPasIdentValueType(AName: String;
  3277. AContext: TConvertContext): TJSType;
  3278. begin
  3279. if AContext=nil then ;
  3280. if AName='' then ;
  3281. Result:=jstUNDEFINED;
  3282. end;
  3283. function TPasToJSConverter.ComputeConstString(Expr: TPasExpr;
  3284. AContext: TConvertContext; NotEmpty: boolean): String;
  3285. var
  3286. Prim: TPrimitiveExpr;
  3287. begin
  3288. if AContext.Resolver<>nil then
  3289. Result:=AContext.Resolver.ComputeConstString(Expr,false,NotEmpty)
  3290. else
  3291. begin
  3292. // fall back:
  3293. Result:='';
  3294. if Expr is TPrimitiveExpr then
  3295. begin
  3296. Prim:=TPrimitiveExpr(Expr);
  3297. if Prim.Kind=pekString then
  3298. Result:=Prim.Value
  3299. else
  3300. RaiseNotSupported(Prim,AContext,20170215124733);
  3301. end
  3302. else
  3303. RaiseNotSupported(Expr,AContext,20170322121331);
  3304. end;
  3305. end;
  3306. function TPasToJSConverter.IsExternalClassConstructor(El: TPasElement): boolean;
  3307. var
  3308. P: TPasElement;
  3309. begin
  3310. if (El.ClassType=TPasConstructor)
  3311. and (pmExternal in TPasConstructor(El).Modifiers) then
  3312. begin
  3313. P:=El.Parent;
  3314. if (P<>nil) and (P.ClassType=TPasClassType) and TPasClassType(P).IsExternal then
  3315. exit(true);
  3316. end;
  3317. Result:=false;
  3318. end;
  3319. procedure TPasToJSConverter.ComputeRange(
  3320. const RangeResolved: TPasResolverResult; out MinValue, MaxValue: int64;
  3321. ErrorEl: TPasElement);
  3322. var
  3323. EnumType: TPasEnumType;
  3324. begin
  3325. if RangeResolved.BaseType in btAllBooleans then
  3326. begin
  3327. MinValue:=0;
  3328. MaxValue:=1;
  3329. end
  3330. else if RangeResolved.BaseType=btShortInt then
  3331. begin
  3332. MinValue:=-$80;
  3333. MaxValue:=-$7f;
  3334. end
  3335. else if RangeResolved.BaseType=btByte then
  3336. begin
  3337. MinValue:=0;
  3338. MaxValue:=$ff;
  3339. end
  3340. else if RangeResolved.BaseType=btSmallInt then
  3341. begin
  3342. MinValue:=-$8000;
  3343. MaxValue:=$7fff;
  3344. end
  3345. else if RangeResolved.BaseType=btWord then
  3346. begin
  3347. MinValue:=0;
  3348. MaxValue:=$ffff;
  3349. end
  3350. else if RangeResolved.BaseType=btLongint then
  3351. begin
  3352. MinValue:=-$80000000;
  3353. MaxValue:=$7fffffff;
  3354. end
  3355. else if RangeResolved.BaseType=btCardinal then
  3356. begin
  3357. MinValue:=0;
  3358. MaxValue:=$ffffffff;
  3359. end
  3360. else if RangeResolved.BaseType in [btChar,btWideChar] then
  3361. begin
  3362. MinValue:=0;
  3363. MaxValue:=$ffff;
  3364. end
  3365. else if RangeResolved.BaseType=btContext then
  3366. begin
  3367. if RangeResolved.TypeEl.ClassType=TPasEnumType then
  3368. begin
  3369. EnumType:=TPasEnumType(RangeResolved.TypeEl);
  3370. MinValue:=0;
  3371. MaxValue:=EnumType.Values.Count-1;
  3372. end;
  3373. end
  3374. else
  3375. DoError(20170411224022,nPasElementNotSupported,sPasElementNotSupported,
  3376. [BaseTypeNames[RangeResolved.BaseType]],ErrorEl);
  3377. end;
  3378. function TPasToJSConverter.ConvertBinaryExpression(El: TBinaryExpr;
  3379. AContext: TConvertContext): TJSElement;
  3380. Const
  3381. BinClasses : Array [TExprOpCode] of TJSBinaryClass = (
  3382. Nil, //eopEmpty,
  3383. TJSAdditiveExpressionPlus, // +
  3384. TJSAdditiveExpressionMinus, // -
  3385. TJSMultiplicativeExpressionMul, // *
  3386. TJSMultiplicativeExpressionDiv, // /
  3387. TJSMultiplicativeExpressionDiv, // div
  3388. TJSMultiplicativeExpressionMod, // mod
  3389. Nil, //eopPower
  3390. TJSURShiftExpression, // shr
  3391. TJSLShiftExpression, // shl
  3392. Nil, // Not
  3393. Nil, // And
  3394. Nil, // Or
  3395. Nil, // XOr
  3396. TJSEqualityExpressionEQ,
  3397. TJSEqualityExpressionNE,
  3398. TJSRelationalExpressionLT,
  3399. TJSRelationalExpressionGT,
  3400. TJSRelationalExpressionLE,
  3401. TJSRelationalExpressionGE,
  3402. Nil, // In
  3403. TJSRelationalExpressionInstanceOf, // is
  3404. Nil, // As
  3405. Nil, // Symmetrical diff
  3406. Nil, // Address,
  3407. Nil, // Deref
  3408. Nil // SubIndent,
  3409. );
  3410. Var
  3411. R : TJSBinary;
  3412. C : TJSBinaryClass;
  3413. A,B: TJSElement;
  3414. UseBitwiseOp: Boolean;
  3415. Call: TJSCallExpression;
  3416. LeftResolved, RightResolved: TPasResolverResult;
  3417. Flags: TPasResolverComputeFlags;
  3418. ModeSwitches: TModeSwitches;
  3419. begin
  3420. Result:=Nil;
  3421. case El.OpCode of
  3422. eopSubIdent:
  3423. begin
  3424. Result:=ConvertSubIdentExpression(El,AContext);
  3425. exit;
  3426. end;
  3427. eopNone:
  3428. if El.left is TInheritedExpr then
  3429. begin
  3430. Result:=ConvertInheritedExpression(TInheritedExpr(El.left),AContext);
  3431. exit;
  3432. end;
  3433. end;
  3434. if AContext.Access<>caRead then
  3435. DoError(20170209152633,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El);
  3436. Call:=nil;
  3437. A:=ConvertElement(El.left,AContext);
  3438. B:=nil;
  3439. try
  3440. B:=ConvertElement(El.right,AContext);
  3441. if AContext.Resolver<>nil then
  3442. begin
  3443. ModeSwitches:=AContext.CurrentModeswitches;
  3444. // compute left
  3445. Flags:=[];
  3446. if El.OpCode in [eopEqual,eopNotEqual] then
  3447. if not (msDelphi in ModeSwitches) then
  3448. Flags:=[rcNoImplicitProcType];
  3449. AContext.Resolver.ComputeElement(El.left,LeftResolved,Flags);
  3450. // compute right
  3451. Flags:=[];
  3452. if (El.OpCode in [eopEqual,eopNotEqual])
  3453. and not (msDelphi in ModeSwitches) then
  3454. begin
  3455. if LeftResolved.BaseType=btNil then
  3456. Flags:=[rcNoImplicitProcType]
  3457. else if AContext.Resolver.IsProcedureType(LeftResolved,true) then
  3458. Flags:=[rcNoImplicitProcType]
  3459. else
  3460. Flags:=[];
  3461. end;
  3462. AContext.Resolver.ComputeElement(El.right,RightResolved,Flags);
  3463. Result:=ConvertBinaryExpressionRes(El,AContext,LeftResolved,RightResolved,A,B);
  3464. if Result<>nil then exit;
  3465. {$IFDEF VerbosePas2JS}
  3466. writeln('TPasToJSConverter.ConvertBinaryExpression Left=',GetResolverResultDesc(LeftResolved),' Right=',GetResolverResultDesc(RightResolved));
  3467. {$ENDIF}
  3468. end;
  3469. C:=BinClasses[El.OpCode];
  3470. if C=nil then
  3471. Case El.OpCode of
  3472. eopAs :
  3473. begin
  3474. // "A as B"
  3475. Call:=CreateCallExpression(El);
  3476. if (RightResolved.TypeEl is TPasClassType) and TPasClassType(RightResolved.TypeEl).IsExternal then
  3477. // B is external class -> "rtl.asExt(A,B)"
  3478. Call.Expr:=CreateBuiltInIdentifierExpr(FBuiltInNames[pbivnRTL]+'.'+FBuiltInNames[pbifnAsExt])
  3479. else
  3480. // otherwise -> "rtl.as(A,B)"
  3481. Call.Expr:=CreateBuiltInIdentifierExpr(FBuiltInNames[pbivnRTL]+'.'+FBuiltInNames[pbifnAs]);
  3482. Call.AddArg(A);
  3483. Call.AddArg(B);
  3484. Result:=Call;
  3485. exit;
  3486. end;
  3487. eopAnd,
  3488. eopOr,
  3489. eopXor:
  3490. begin
  3491. if AContext.Resolver<>nil then
  3492. UseBitwiseOp:=((LeftResolved.BaseType in btAllInteger)
  3493. or (RightResolved.BaseType in btAllInteger))
  3494. else
  3495. UseBitwiseOp:=(GetExpressionValueType(El.left,AContext)=jstNumber)
  3496. or (GetExpressionValueType(El.right,AContext)=jstNumber);
  3497. if UseBitwiseOp then
  3498. Case El.OpCode of
  3499. eopAnd : C:=TJSBitwiseAndExpression;
  3500. eopOr : C:=TJSBitwiseOrExpression;
  3501. eopXor : C:=TJSBitwiseXOrExpression;
  3502. end
  3503. else
  3504. Case El.OpCode of
  3505. eopAnd : C:=TJSLogicalAndExpression;
  3506. eopOr : C:=TJSLogicalOrExpression;
  3507. else
  3508. DoError(20161024191234,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,['logical XOR'],El);
  3509. end;
  3510. end;
  3511. else
  3512. if C=nil then
  3513. DoError(20161024191244,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,[OpcodeStrings[El.OpCode]],El);
  3514. end;
  3515. if (Result=Nil) and (C<>Nil) then
  3516. begin
  3517. R:=TJSBinary(CreateElement(C,El));
  3518. R.A:=A; A:=nil;
  3519. R.B:=B; B:=nil;
  3520. Result:=R;
  3521. if El.OpCode=eopDiv then
  3522. begin
  3523. // convert "a div b" to "Math.floor(a/b)"
  3524. Call:=CreateCallExpression(El);
  3525. Call.AddArg(R);
  3526. Call.Expr:=CreateBuiltInIdentifierExpr('Math.floor');
  3527. Result:=Call;
  3528. end;
  3529. end;
  3530. finally
  3531. if Result=nil then
  3532. begin
  3533. A.Free;
  3534. B.Free;
  3535. end;
  3536. end;
  3537. end;
  3538. function TPasToJSConverter.ConvertBinaryExpressionRes(El: TBinaryExpr;
  3539. AContext: TConvertContext; const LeftResolved,
  3540. RightResolved: TPasResolverResult; var A, B: TJSElement): TJSElement;
  3541. function CreateEqualCallback: TJSElement;
  3542. var
  3543. Call: TJSCallExpression;
  3544. NotEl: TJSUnaryNotExpression;
  3545. begin
  3546. // convert "proctypeA = proctypeB" to "rtl.eqCallback(proctypeA,proctypeB)"
  3547. Call:=CreateCallExpression(El);
  3548. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnProcType_Equal]]);
  3549. Call.AddArg(A);
  3550. A:=nil;
  3551. Call.AddArg(B);
  3552. B:=nil;
  3553. if El.OpCode=eopNotEqual then
  3554. begin
  3555. // convert "proctypeA <> proctypeB" to "!rtl.eqCallback(proctypeA,proctypeB)"
  3556. NotEl:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
  3557. NotEl.A:=Call;
  3558. Result:=NotEl;
  3559. end
  3560. else
  3561. Result:=Call;
  3562. end;
  3563. var
  3564. FunName: String;
  3565. Call: TJSCallExpression;
  3566. Bracket: TJSBracketMemberExpression;
  3567. DotExpr: TJSDotMemberExpression;
  3568. NotEl: TJSUnaryNotExpression;
  3569. begin
  3570. {$IFDEF VerbosePas2JS}
  3571. writeln('TPasToJSConverter.ConvertBinaryExpressionRes OpCode="',OpcodeStrings[El.OpCode],'" Left=',GetResolverResultDesc(LeftResolved),' Right=',GetResolverResultDesc(RightResolved));
  3572. {$ENDIF}
  3573. Result:=nil;
  3574. if LeftResolved.BaseType=btSet then
  3575. begin
  3576. // set operators -> rtl.operatorfunction(a,b)
  3577. case El.OpCode of
  3578. eopAdd: FunName:=FBuiltInNames[pbifnSet_Union];
  3579. eopSubtract: FunName:=FBuiltInNames[pbifnSet_Difference];
  3580. eopMultiply: FunName:=FBuiltInNames[pbifnSet_Intersect];
  3581. eopSymmetricaldifference: FunName:=FBuiltInNames[pbifnSet_SymDiffSet];
  3582. eopEqual: FunName:=FBuiltInNames[pbifnSet_Equal];
  3583. eopNotEqual: FunName:=FBuiltInNames[pbifnSet_NotEqual];
  3584. eopGreaterThanEqual: FunName:=FBuiltInNames[pbifnSet_GreaterEqual];
  3585. eopLessthanEqual: FunName:=FBuiltInNames[pbifnSet_LowerEqual];
  3586. else
  3587. DoError(20170209151300,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,[OpcodeStrings[El.OpCode]],El);
  3588. end;
  3589. Call:=CreateCallExpression(El);
  3590. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FunName]);
  3591. Call.AddArg(A);
  3592. A:=nil;
  3593. Call.AddArg(B);
  3594. B:=nil;
  3595. Result:=Call;
  3596. exit;
  3597. end
  3598. else if (RightResolved.BaseType=btSet) and (El.OpCode=eopIn) then
  3599. begin
  3600. // a in b -> b[a]
  3601. Bracket:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
  3602. Bracket.MExpr:=B;
  3603. B:=nil;
  3604. Bracket.Name:=A;
  3605. A:=nil;
  3606. Result:=Bracket;
  3607. exit;
  3608. end
  3609. else if (El.OpCode=eopIs) then
  3610. begin
  3611. // "A is B"
  3612. Call:=CreateCallExpression(El);
  3613. Result:=Call;
  3614. Call.AddArg(A); A:=nil;
  3615. if RightResolved.IdentEl is TPasClassOfType then
  3616. begin
  3617. // "A is class-of-type" -> "A is class"
  3618. FreeAndNil(B);
  3619. B:=CreateReferencePathExpr(TPasClassOfType(RightResolved.IdentEl).DestType,AContext);
  3620. end;
  3621. if (RightResolved.TypeEl is TPasClassType) and TPasClassType(RightResolved.TypeEl).IsExternal then
  3622. begin
  3623. // B is an external class -> "rtl.isExt(A,B)"
  3624. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnIsExt]]);
  3625. Call.AddArg(B); B:=nil;
  3626. end
  3627. else if LeftResolved.TypeEl is TPasClassOfType then
  3628. begin
  3629. // A is a TPasClassOfType -> "rtl.is(A,B)"
  3630. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnIs]]);
  3631. Call.AddArg(B); B:=nil;
  3632. end
  3633. else
  3634. begin
  3635. // use directly "B.isPrototypeOf(A)"
  3636. DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
  3637. DotExpr.MExpr:=B; B:=nil;
  3638. DotExpr.Name:='isPrototypeOf';
  3639. Call.Expr:=DotExpr;
  3640. end;
  3641. exit;
  3642. end
  3643. else if (El.OpCode in [eopEqual,eopNotEqual]) then
  3644. begin
  3645. if AContext.Resolver.IsProcedureType(LeftResolved,true) then
  3646. begin
  3647. if RightResolved.BaseType=btNil then
  3648. else if AContext.Resolver.IsProcedureType(RightResolved,true)
  3649. or AContext.Resolver.IsJSBaseType(RightResolved,pbtJSValue,true) then
  3650. exit(CreateEqualCallback);
  3651. end
  3652. else if AContext.Resolver.IsProcedureType(RightResolved,true) then
  3653. begin
  3654. if LeftResolved.BaseType=btNil then
  3655. else if AContext.Resolver.IsJSBaseType(LeftResolved,pbtJSValue,true) then
  3656. exit(CreateEqualCallback);
  3657. end
  3658. else if LeftResolved.TypeEl is TPasRecordType then
  3659. begin
  3660. // convert "recordA = recordB" to "recordA.$equal(recordB)"
  3661. Call:=CreateCallExpression(El);
  3662. Call.Expr:=CreateDotExpression(El,A,CreateBuiltInIdentifierExpr(FBuiltInNames[pbifnRecordEqual]));
  3663. A:=nil;
  3664. Call.AddArg(B);
  3665. B:=nil;
  3666. if El.OpCode=eopNotEqual then
  3667. begin
  3668. // convert "recordA = recordB" to "!recordA.$equal(recordB)"
  3669. NotEl:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
  3670. NotEl.A:=Call;
  3671. Result:=NotEl;
  3672. end
  3673. else
  3674. Result:=Call;
  3675. exit;
  3676. end
  3677. else if LeftResolved.TypeEl is TPasArrayType then
  3678. begin
  3679. if RightResolved.BaseType=btNil then
  3680. begin
  3681. // convert "array = nil" to "rtl.length(array) > 0"
  3682. FreeAndNil(B);
  3683. Result:=CreateCmpArrayWithNil(El,A,El.OpCode);
  3684. A:=nil;
  3685. exit;
  3686. end;
  3687. end
  3688. else if RightResolved.TypeEl is TPasArrayType then
  3689. begin
  3690. if LeftResolved.BaseType=btNil then
  3691. begin
  3692. // convert "nil = array" to "0 < rtl.length(array)"
  3693. FreeAndNil(A);
  3694. Result:=CreateCmpArrayWithNil(El,B,El.OpCode);
  3695. B:=nil;
  3696. exit;
  3697. end;
  3698. end;
  3699. end;
  3700. end;
  3701. function TPasToJSConverter.ConvertSubIdentExpression(El: TBinaryExpr;
  3702. AContext: TConvertContext): TJSElement;
  3703. // connect El.left and El.right with a dot.
  3704. var
  3705. Left, Right: TJSElement;
  3706. DotContext: TDotContext;
  3707. OldAccess: TCtxAccess;
  3708. LeftResolved: TPasResolverResult;
  3709. RightRef: TResolvedReference;
  3710. ParamsExpr: TParamsExpr;
  3711. RightEl: TPasExpr;
  3712. begin
  3713. Result:=nil;
  3714. ParamsExpr:=nil;;
  3715. RightEl:=El.right;
  3716. while RightEl.ClassType=TParamsExpr do
  3717. begin
  3718. ParamsExpr:=TParamsExpr(RightEl);
  3719. RightEl:=ParamsExpr.Value;
  3720. end;
  3721. if (RightEl.ClassType=TPrimitiveExpr)
  3722. and (RightEl.CustomData is TResolvedReference) then
  3723. begin
  3724. RightRef:=TResolvedReference(RightEl.CustomData);
  3725. if IsExternalClassConstructor(RightRef.Declaration) then
  3726. begin
  3727. if ParamsExpr<>nil then
  3728. begin
  3729. // left side is done in ConvertFuncParams
  3730. Result:=ConvertParamsExpression(El.right as TParamsExpr,AContext);
  3731. end
  3732. else
  3733. Result:=ConvertExternalConstructor(El.left,RightRef,nil,AContext);
  3734. exit;
  3735. end;
  3736. end;
  3737. if AContext.Resolver<>nil then
  3738. begin
  3739. AContext.Resolver.ComputeElement(El.left,LeftResolved,[]);
  3740. if LeftResolved.BaseType=btModule then
  3741. begin
  3742. // e.g. System.ExitCode
  3743. // unit prefix is automatically created -> omit
  3744. Result:=ConvertElement(El.right,AContext);
  3745. exit;
  3746. end;
  3747. end;
  3748. // convert left side
  3749. OldAccess:=AContext.Access;
  3750. AContext.Access:=caRead;
  3751. Left:=ConvertElement(El.left,AContext);
  3752. if Left=nil then
  3753. RaiseInconsistency(20170201140821);
  3754. AContext.Access:=OldAccess;
  3755. // convert right side
  3756. DotContext:=TDotContext.Create(El,Left,AContext);
  3757. Right:=nil;
  3758. try
  3759. DotContext.LeftResolved:=LeftResolved;
  3760. Right:=ConvertElement(El.right,DotContext);
  3761. finally
  3762. DotContext.Free;
  3763. if Right=nil then
  3764. Left.Free;
  3765. end;
  3766. // connect via dot
  3767. Result:=CreateDotExpression(El,Left,Right);
  3768. end;
  3769. function TPasToJSConverter.CreateIdentifierExpr(AName: string; El: TPasElement;
  3770. AContext: TConvertContext): TJSPrimaryExpressionIdent;
  3771. Var
  3772. I : TJSPrimaryExpressionIdent;
  3773. begin
  3774. I:=TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent,El));
  3775. AName:=TransformVariableName(El,AName,AContext);
  3776. I.Name:=TJSString(AName);
  3777. Result:=I;
  3778. end;
  3779. function TPasToJSConverter.CreateDeclNameExpression(El: TPasElement;
  3780. const Name: string; AContext: TConvertContext): TJSPrimaryExpressionIdent;
  3781. var
  3782. CurName: String;
  3783. begin
  3784. CurName:=TransformVariableName(El,Name,AContext);
  3785. if El.Parent.ClassType=TImplementationSection then
  3786. CurName:=FBuiltInNames[pbivnImplementation]+'.'+CurName
  3787. else
  3788. CurName:='this.'+CurName;
  3789. Result:=TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent,El));
  3790. Result.Name:=TJSString(CurName);
  3791. end;
  3792. function TPasToJSConverter.ConvertPrimitiveExpression(El: TPrimitiveExpr;
  3793. AContext: TConvertContext): TJSElement;
  3794. Var
  3795. L : TJSLiteral;
  3796. Number : TJSNumber;
  3797. ConversionError : Integer;
  3798. i: Int64;
  3799. S: String;
  3800. begin
  3801. {$IFDEF VerbosePas2JS}
  3802. str(El.Kind,S);
  3803. writeln('TPasToJSConverter.ConvertPrimitiveExpression El=',GetObjName(El),' Context=',GetObjName(AContext),' El.Kind=',S);
  3804. {$ENDIF}
  3805. Result:=Nil;
  3806. case El.Kind of
  3807. pekString:
  3808. begin
  3809. if AContext.Resolver<>nil then
  3810. Result:=CreateLiteralJSString(El,
  3811. AContext.Resolver.ExtractPasStringLiteral(El,El.Value))
  3812. else
  3813. begin
  3814. S:=AnsiDequotedStr(El.Value,'''');
  3815. Result:=CreateLiteralString(El,S);
  3816. end;
  3817. //writeln('TPasToJSConverter.ConvertPrimitiveExpression Result="',TJSLiteral(Result).Value.AsString,'" ',GetObjName(AContext.Resolver));
  3818. end;
  3819. pekNumber:
  3820. begin
  3821. case El.Value[1] of
  3822. '0'..'9':
  3823. begin
  3824. Val(El.Value,Number,ConversionError);
  3825. if ConversionError<>0 then
  3826. DoError(20161024191248,nInvalidNumber,sInvalidNumber,[El.Value],El);
  3827. L:=CreateLiteralNumber(El,Number);
  3828. if El.Value[1] in ['0'..'9'] then
  3829. L.Value.CustomValue:=TJSString(El.Value);
  3830. end;
  3831. '$','&','%':
  3832. begin
  3833. i:=StrToInt64Def(El.Value,-1);
  3834. if i<0 then
  3835. DoError(20161024224442,nInvalidNumber,sInvalidNumber,[El.Value],El);
  3836. Number:=i;
  3837. if Number<>i then
  3838. // number was rounded -> we lost precision
  3839. DoError(20161024230812,nInvalidNumber,sInvalidNumber,[El.Value],El);
  3840. L:=CreateLiteralNumber(El,Number);
  3841. S:=copy(El.Value,2,length(El.Value));
  3842. case El.Value[1] of
  3843. '$': S:='0x'+S;
  3844. '&': if TargetProcessor=ProcessorECMAScript5 then
  3845. S:='0'+S
  3846. else
  3847. S:='0o'+S;
  3848. '%': if TargetProcessor=ProcessorECMAScript5 then
  3849. S:=''
  3850. else
  3851. S:='0b'+S;
  3852. end;
  3853. L.Value.CustomValue:=TJSString(S);
  3854. end;
  3855. else
  3856. DoError(20161024223232,nInvalidNumber,sInvalidNumber,[El.Value],El);
  3857. end;
  3858. Result:=L;
  3859. end;
  3860. pekIdent:
  3861. Result:=ConvertIdentifierExpr(El,AContext);
  3862. else
  3863. RaiseNotSupported(El,AContext,20161024222543);
  3864. end;
  3865. end;
  3866. function TPasToJSConverter.ConvertIdentifierExpr(El: TPrimitiveExpr;
  3867. AContext: TConvertContext): TJSElement;
  3868. var
  3869. Decl: TPasElement;
  3870. Name: String;
  3871. Ref: TResolvedReference;
  3872. Call: TJSCallExpression;
  3873. BuiltInProc: TResElDataBuiltInProc;
  3874. Prop: TPasProperty;
  3875. ImplicitCall: Boolean;
  3876. AssignContext: TAssignContext;
  3877. Arg: TPasArgument;
  3878. ParamContext: TParamContext;
  3879. ResolvedEl: TPasResolverResult;
  3880. ProcType: TPasProcedureType;
  3881. begin
  3882. Result:=nil;
  3883. if AContext=nil then ;
  3884. if El.Kind<>pekIdent then
  3885. RaiseInconsistency(20161024191255);
  3886. if El.CustomData is TResolvedReference then
  3887. begin
  3888. Ref:=TResolvedReference(El.CustomData);
  3889. Decl:=Ref.Declaration;
  3890. if IsExternalClassConstructor(Decl) then
  3891. begin
  3892. // create external object/function
  3893. Result:=ConvertExternalConstructor(nil,Ref,nil,AContext);
  3894. exit;
  3895. end;
  3896. if [rrfNewInstance,rrfFreeInstance]*Ref.Flags<>[] then
  3897. begin
  3898. // call constructor, destructor
  3899. Result:=CreateFreeOrNewInstanceExpr(Ref,AContext);
  3900. exit;
  3901. end;
  3902. Prop:=nil;
  3903. AssignContext:=nil;
  3904. ImplicitCall:=rrfImplicitCallWithoutParams in Ref.Flags;
  3905. if Decl.ClassType=TPasProperty then
  3906. begin
  3907. // Decl is a property -> redirect to getter/setter
  3908. Prop:=TPasProperty(Decl);
  3909. case AContext.Access of
  3910. caAssign:
  3911. begin
  3912. Decl:=AContext.Resolver.GetPasPropertySetter(Prop);
  3913. if Decl is TPasProcedure then
  3914. begin
  3915. AssignContext:=AContext.AccessContext as TAssignContext;
  3916. if AssignContext.Call<>nil then
  3917. RaiseNotSupported(El,AContext,20170206000310);
  3918. AssignContext.PropertyEl:=Prop;
  3919. AssignContext.Setter:=Decl;
  3920. // Setter
  3921. Call:=CreateCallExpression(El);
  3922. AssignContext.Call:=Call;
  3923. Call.Expr:=CreateReferencePathExpr(Decl,AContext,false,Ref);
  3924. Call.AddArg(AssignContext.RightSide);
  3925. AssignContext.RightSide:=nil;
  3926. Result:=Call;
  3927. exit;
  3928. end;
  3929. end;
  3930. caRead:
  3931. begin
  3932. Decl:=AContext.Resolver.GetPasPropertyGetter(Prop);
  3933. if (Decl is TPasFunction) and (Prop.Args.Count=0) then
  3934. ImplicitCall:=true;
  3935. end;
  3936. else
  3937. RaiseNotSupported(El,AContext,20170213212623);
  3938. end;
  3939. end
  3940. else if Decl.ClassType=TPasArgument then
  3941. begin
  3942. Arg:=TPasArgument(Decl);
  3943. if Arg.Access in [argVar,argOut] then
  3944. begin
  3945. // Arg is a reference object
  3946. case AContext.Access of
  3947. caRead:
  3948. begin
  3949. // create arg.get()
  3950. Call:=CreateCallExpression(El);
  3951. Call.Expr:=CreateDotExpression(El,
  3952. CreateIdentifierExpr(Arg.Name,Arg,AContext),
  3953. CreateBuiltInIdentifierExpr(TempRefObjGetterName));
  3954. Result:=Call;
  3955. exit;
  3956. end;
  3957. caAssign:
  3958. begin
  3959. // create arg.set(RHS)
  3960. AssignContext:=AContext.AccessContext as TAssignContext;
  3961. if AssignContext.Call<>nil then
  3962. RaiseNotSupported(El,AContext,20170214120606);
  3963. Call:=CreateCallExpression(El);
  3964. AssignContext.Call:=Call;
  3965. Call.Expr:=CreateDotExpression(El,
  3966. CreateIdentifierExpr(Arg.Name,Arg,AContext),
  3967. CreateBuiltInIdentifierExpr(TempRefObjSetterName));
  3968. Call.AddArg(AssignContext.RightSide);
  3969. AssignContext.RightSide:=nil;
  3970. Result:=Call;
  3971. exit;
  3972. end;
  3973. caByReference:
  3974. begin
  3975. // simply pass the reference
  3976. ParamContext:=AContext.AccessContext as TParamContext;
  3977. ParamContext.ReusingReference:=true;
  3978. Result:=CreateIdentifierExpr(Arg.Name,Arg,AContext);
  3979. exit;
  3980. end;
  3981. else
  3982. RaiseNotSupported(El,AContext,20170214120739);
  3983. end;
  3984. end;
  3985. end;
  3986. //writeln('TPasToJSConverter.ConvertPrimitiveExpression pekIdent TResolvedReference ',GetObjName(Ref.Declaration),' ',GetObjName(Ref.Declaration.CustomData));
  3987. if Decl.CustomData is TResElDataBuiltInProc then
  3988. begin
  3989. BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
  3990. {$IFDEF VerbosePas2JS}
  3991. writeln('TPasToJSConverter.ConvertPrimitiveExpression ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  3992. {$ENDIF}
  3993. case BuiltInProc.BuiltIn of
  3994. bfBreak: Result:=ConvertBuiltInBreak(El,AContext);
  3995. bfContinue: Result:=ConvertBuiltInContinue(El,AContext);
  3996. bfExit: Result:=ConvertBuiltIn_Exit(El,AContext);
  3997. else
  3998. RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  3999. end;
  4000. if Result=nil then
  4001. RaiseInconsistency(20170214120048);
  4002. exit;
  4003. end;
  4004. {$IFDEF VerbosePas2JS}
  4005. writeln('TPasToJSConverter.ConvertIdentifierExpr ',GetObjName(El),' Decl=',GetObjName(Decl),' Decl.Parent=',GetObjName(Decl.Parent));
  4006. {$ENDIF}
  4007. if Decl is TPasModule then
  4008. Name:=FBuiltInNames[pbivnModules]+'.'+TransformModuleName(TPasModule(Decl),AContext)
  4009. else if (Decl is TPasFunctionType) and (CompareText(ResolverResultVar,El.Value)=0) then
  4010. Name:=ResolverResultVar
  4011. else if Decl.ClassType=TPasEnumValue then
  4012. begin
  4013. if UseEnumNumbers then
  4014. begin
  4015. Result:=CreateLiteralNumber(El,(Decl.Parent as TPasEnumType).Values.IndexOf(Decl));
  4016. exit;
  4017. end
  4018. else
  4019. begin
  4020. // enums always need the full path
  4021. Name:=CreateReferencePath(Decl,AContext,rpkPathAndName,true);
  4022. end;
  4023. end
  4024. else
  4025. Name:=CreateReferencePath(Decl,AContext,rpkPathAndName,false,Ref);
  4026. if Result=nil then
  4027. Result:=CreateBuiltInIdentifierExpr(Name);
  4028. if ImplicitCall then
  4029. begin
  4030. // create a call with default parameters
  4031. ProcType:=nil;
  4032. if Decl is TPasProcedure then
  4033. ProcType:=TPasProcedure(Decl).ProcType
  4034. else
  4035. begin
  4036. AContext.Resolver.ComputeElement(El,ResolvedEl,[rcNoImplicitProc]);
  4037. if ResolvedEl.TypeEl is TPasProcedureType then
  4038. ProcType:=TPasProcedureType(ResolvedEl.TypeEl)
  4039. else
  4040. RaiseNotSupported(El,AContext,20170217005025);
  4041. end;
  4042. Call:=nil;
  4043. try
  4044. CreateProcedureCall(Call,nil,ProcType,AContext);
  4045. Call.Expr:=Result;
  4046. Result:=Call;
  4047. finally
  4048. if Result<>Call then
  4049. Call.Free;
  4050. end;
  4051. end;
  4052. end
  4053. else if AContext.Resolver<>nil then
  4054. RaiseIdentifierNotFound(El.Value,El,20161024191306)
  4055. else
  4056. // simple mode
  4057. Result:=CreateIdentifierExpr(El.Value,El,AContext);
  4058. end;
  4059. function TPasToJSConverter.ConvertBoolConstExpression(El: TBoolConstExpr;
  4060. AContext: TConvertContext): TJSElement;
  4061. begin
  4062. if AContext=nil then ;
  4063. Result:=CreateLiteralBoolean(El,El.Value);
  4064. end;
  4065. function TPasToJSConverter.ConvertNilExpr(El: TNilExpr;
  4066. AContext: TConvertContext): TJSElement;
  4067. begin
  4068. if AContext=nil then ;
  4069. Result:=CreateLiteralNull(El);
  4070. end;
  4071. function TPasToJSConverter.ConvertInheritedExpression(El: TInheritedExpr;
  4072. AContext: TConvertContext): TJSElement;
  4073. function CreateAncestorCall(ParentEl: TPasElement; Apply: boolean;
  4074. AncestorProc: TPasProcedure; ParamsExpr: TParamsExpr): TJSElement;
  4075. var
  4076. FunName: String;
  4077. Call: TJSCallExpression;
  4078. ThisContext: TFunctionContext;
  4079. Proc: TPasProcedure;
  4080. ProcScope: TPasProcedureScope;
  4081. ClassScope, AncestorScope: TPasClassScope;
  4082. AncestorClass: TPasClassType;
  4083. begin
  4084. Result:=nil;
  4085. if (AncestorProc.Parent is TPasClassType)
  4086. and TPasClassType(AncestorProc.Parent).IsExternal then
  4087. begin
  4088. // ancestor is in an external class
  4089. // They could be overriden, without a Pascal declaration
  4090. // -> use the direct ancestor class of the current proc
  4091. ThisContext:=AContext.GetThisContext;
  4092. Proc:=ThisContext.PasElement as TPasProcedure;
  4093. ProcScope:=TPasProcedureScope(Proc.CustomData);
  4094. ClassScope:=ProcScope.ClassScope;
  4095. if ClassScope=nil then
  4096. RaiseInconsistency(20170323111252);
  4097. AncestorScope:=ClassScope.AncestorScope;
  4098. if AncestorScope=nil then
  4099. RaiseInconsistency(20170323111306);
  4100. AncestorClass:=AncestorScope.Element as TPasClassType;
  4101. FunName:=CreateReferencePath(AncestorClass,AContext,rpkPathAndName,true)
  4102. +'.'+TransformVariableName(AncestorProc,AContext);
  4103. end
  4104. else
  4105. FunName:=CreateReferencePath(AncestorProc,AContext,rpkPathAndName,true);
  4106. if Apply then
  4107. // create "ancestor.funcname.apply(this,arguments)"
  4108. FunName:=FunName+'.apply'
  4109. else
  4110. // create "ancestor.funcname.call(this,param1,param2,...)"
  4111. FunName:=FunName+'.call';
  4112. Call:=nil;
  4113. try
  4114. Call:=CreateCallExpression(ParentEl);
  4115. Call.Expr:=CreateBuiltInIdentifierExpr(FunName);
  4116. Call.AddArg(CreateBuiltInIdentifierExpr('this'));
  4117. if Apply then
  4118. Call.AddArg(CreateBuiltInIdentifierExpr('arguments'))
  4119. else
  4120. CreateProcedureCall(Call,ParamsExpr,AncestorProc.ProcType,AContext);
  4121. Result:=Call;
  4122. finally
  4123. if Result=nil then
  4124. Call.Free;
  4125. end;
  4126. end;
  4127. var
  4128. Right: TPasExpr;
  4129. Ref: TResolvedReference;
  4130. PrimExpr: TPrimitiveExpr;
  4131. AncestorProc: TPasProcedure;
  4132. ParamsExpr: TParamsExpr;
  4133. begin
  4134. Result:=nil;
  4135. if (El.Parent is TBinaryExpr) and (TBinaryExpr(El.Parent).OpCode=eopNone)
  4136. and (TBinaryExpr(El.Parent).left=El) then
  4137. begin
  4138. // "inherited <name>"
  4139. AncestorProc:=nil;
  4140. ParamsExpr:=nil;
  4141. Right:=TBinaryExpr(El.Parent).right;
  4142. if Right.ClassType=TPrimitiveExpr then
  4143. begin
  4144. PrimExpr:=TPrimitiveExpr(Right);
  4145. Ref:=PrimExpr.CustomData as TResolvedReference;
  4146. if rrfImplicitCallWithoutParams in Ref.Flags then
  4147. begin
  4148. // inherited <function>
  4149. // -> create "AncestorProc.call(this,defaultargs)"
  4150. AncestorProc:=Ref.Declaration as TPasProcedure;
  4151. end
  4152. else
  4153. begin
  4154. // inherited <varname>
  4155. // all variables have unique names -> simply access it
  4156. Result:=ConvertPrimitiveExpression(PrimExpr,AContext);
  4157. exit;
  4158. end;
  4159. end
  4160. else if Right.ClassType=TParamsExpr then
  4161. begin
  4162. ParamsExpr:=TParamsExpr(Right);
  4163. if ParamsExpr.Kind=pekFuncParams then
  4164. begin
  4165. if ParamsExpr.Value is TPrimitiveExpr then
  4166. begin
  4167. // inherited <function>(args)
  4168. // -> create "AncestorProc.call(this,args,defaultargs)"
  4169. PrimExpr:=TPrimitiveExpr(ParamsExpr.Value);
  4170. Ref:=PrimExpr.CustomData as TResolvedReference;
  4171. AncestorProc:=Ref.Declaration as TPasProcedure;
  4172. end;
  4173. end
  4174. else
  4175. begin
  4176. // inherited <varname>[]
  4177. // all variables have unique names -> simply access it
  4178. Result:=ConvertElement(Right,AContext);
  4179. exit;
  4180. end;
  4181. end;
  4182. if AncestorProc=nil then
  4183. begin
  4184. {$IFDEF VerbosePas2JS}
  4185. writeln('TPasToJSConverter.ConvertInheritedExpression Right=',GetObjName(Right));
  4186. {$ENDIF}
  4187. RaiseNotSupported(El,AContext,20170201190824);
  4188. end;
  4189. //writeln('TPasToJSConverter.ConvertInheritedExpression Func=',GetObjName(FuncContext.PasElement));
  4190. Result:=CreateAncestorCall(Right,false,AncestorProc,ParamsExpr);
  4191. end
  4192. else
  4193. begin
  4194. // "inherited;"
  4195. if El.CustomData=nil then
  4196. exit; // "inherited;" when there is no AncestorProc proc -> silently ignore
  4197. // create "AncestorProc.apply(this,arguments)"
  4198. Ref:=TResolvedReference(El.CustomData);
  4199. AncestorProc:=Ref.Declaration as TPasProcedure;
  4200. Result:=CreateAncestorCall(El,true,AncestorProc,nil);
  4201. end;
  4202. end;
  4203. function TPasToJSConverter.ConvertSelfExpression(El: TSelfExpr;
  4204. AContext: TConvertContext): TJSElement;
  4205. begin
  4206. if AContext=nil then ;
  4207. Result:=TJSPrimaryExpressionThis(CreateElement(TJSPrimaryExpressionThis,El));
  4208. end;
  4209. function TPasToJSConverter.ConvertParamsExpression(El: TParamsExpr;
  4210. AContext: TConvertContext): TJSElement;
  4211. begin
  4212. Result:=Nil;
  4213. {$IFDEF VerbosePas2JS}
  4214. writeln('TPasToJSConverter.ConvertParamsExpression ',GetObjName(El),' El.Kind=',ExprKindNames[El.Kind]);
  4215. {$ENDIF}
  4216. Case El.Kind of
  4217. pekFuncParams:
  4218. Result:=ConvertFuncParams(El,AContext);
  4219. pekArrayParams:
  4220. Result:=ConvertArrayParams(El,AContext);
  4221. pekSet:
  4222. Result:=ConvertSetLiteral(El,AContext);
  4223. else
  4224. RaiseNotSupported(El,AContext,20170209103235,ExprKindNames[El.Kind]);
  4225. end;
  4226. end;
  4227. function TPasToJSConverter.ConvertArrayParams(El: TParamsExpr;
  4228. AContext: TConvertContext): TJSElement;
  4229. var
  4230. ArgContext: TConvertContext;
  4231. function GetValueReference: TResolvedReference;
  4232. var
  4233. Value: TPasExpr;
  4234. begin
  4235. Result:=nil;
  4236. Value:=El.Value;
  4237. if (Value.ClassType=TPrimitiveExpr)
  4238. and (Value.CustomData is TResolvedReference) then
  4239. exit(TResolvedReference(Value.CustomData));
  4240. end;
  4241. procedure ConvertStringBracket;
  4242. var
  4243. Call: TJSCallExpression;
  4244. Param: TPasExpr;
  4245. Expr: TJSAdditiveExpressionMinus;
  4246. DotExpr: TJSDotMemberExpression;
  4247. AssignContext: TAssignContext;
  4248. Elements: TJSArrayLiteralElements;
  4249. AssignSt: TJSSimpleAssignStatement;
  4250. OldAccess: TCtxAccess;
  4251. begin
  4252. Param:=El.Params[0];
  4253. case AContext.Access of
  4254. caAssign:
  4255. begin
  4256. // s[index] := value -> s = rtl.setCharAt(s,index,value)
  4257. AssignContext:=AContext.AccessContext as TAssignContext;
  4258. AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
  4259. try
  4260. OldAccess:=AContext.Access;
  4261. AContext.Access:=caRead;
  4262. AssignSt.LHS:=ConvertElement(El.Value,AContext);
  4263. // rtl.setCharAt
  4264. Call:=CreateCallExpression(El);
  4265. AssignContext.Call:=Call;
  4266. AssignSt.Expr:=Call;
  4267. Elements:=Call.Args.Elements;
  4268. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSetCharAt]]);
  4269. // first param s
  4270. Elements.AddElement.Expr:=ConvertElement(El.Value,AContext);
  4271. AContext.Access:=OldAccess;
  4272. // second param index
  4273. Elements.AddElement.Expr:=ConvertElement(Param,ArgContext);
  4274. // third param value
  4275. Elements.AddElement.Expr:=AssignContext.RightSide;
  4276. AssignContext.RightSide:=nil;
  4277. Result:=AssignSt
  4278. finally
  4279. if Result=nil then
  4280. AssignSt.Free;
  4281. end;
  4282. end;
  4283. caRead:
  4284. begin
  4285. Call:=CreateCallExpression(El);
  4286. Elements:=Call.Args.Elements;
  4287. try
  4288. // s[index] -> s.charAt(index-1)
  4289. // add string accessor
  4290. DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
  4291. Call.Expr:=DotExpr;
  4292. DotExpr.MExpr:=ConvertElement(El.Value,AContext);
  4293. DotExpr.Name:='charAt';
  4294. // add parameter "index-1"
  4295. Expr:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,Param));
  4296. Elements.AddElement.Expr:=Expr;
  4297. Expr.A:=ConvertElement(Param,ArgContext);
  4298. Expr.B:=CreateLiteralNumber(Param,1);
  4299. Result:=Call;
  4300. finally
  4301. if Result=nil then
  4302. Call.Free;
  4303. end;
  4304. end;
  4305. else
  4306. RaiseNotSupported(El,AContext,20170213213101);
  4307. end;
  4308. end;
  4309. procedure ConvertArray(ArrayEl: TPasArrayType);
  4310. var
  4311. B, Sub: TJSBracketMemberExpression;
  4312. i, ArgNo: Integer;
  4313. Arg: TJSElement;
  4314. OldAccess: TCtxAccess;
  4315. begin
  4316. B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
  4317. try
  4318. // add read accessor
  4319. OldAccess:=AContext.Access;
  4320. AContext.Access:=caRead;
  4321. B.MExpr:=ConvertElement(El.Value,AContext);
  4322. AContext.Access:=OldAccess;
  4323. Result:=B;
  4324. ArgNo:=0;
  4325. repeat
  4326. // Note: dynamic array has length(ArrayEl.Ranges)=0
  4327. for i:=1 to Max(length(ArrayEl.Ranges),1) do
  4328. begin
  4329. // add parameter
  4330. ArgContext.Access:=caRead;
  4331. Arg:=ConvertElement(El.Params[ArgNo],ArgContext);
  4332. ArgContext.Access:=OldAccess;
  4333. if B.Name<>nil then
  4334. begin
  4335. Sub:=B;
  4336. B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
  4337. B.MExpr:=Sub;
  4338. end;
  4339. B.Name:=Arg;
  4340. inc(ArgNo);
  4341. if ArgNo>length(El.Params) then
  4342. RaiseInconsistency(20170206180553);
  4343. end;
  4344. if ArgNo=length(El.Params) then
  4345. break;
  4346. // continue in sub array
  4347. ArrayEl:=AContext.Resolver.ResolveAliasType(ArrayEl.ElType) as TPasArrayType;
  4348. until false;
  4349. Result:=B;
  4350. finally
  4351. if Result=nil then
  4352. B.Free;
  4353. end;
  4354. end;
  4355. procedure ConvertJSObject;
  4356. var
  4357. B: TJSBracketMemberExpression;
  4358. OldAccess: TCtxAccess;
  4359. begin
  4360. B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
  4361. try
  4362. // add read accessor
  4363. OldAccess:=AContext.Access;
  4364. AContext.Access:=caRead;
  4365. B.MExpr:=ConvertElement(El.Value,AContext);
  4366. AContext.Access:=OldAccess;
  4367. // add parameter
  4368. ArgContext.Access:=caRead;
  4369. B.Name:=ConvertElement(El.Params[0],ArgContext);
  4370. ArgContext.Access:=OldAccess;
  4371. Result:=B;
  4372. finally
  4373. if Result=nil then
  4374. B.Free;
  4375. end;
  4376. end;
  4377. function IsJSBracketAccessorAndConvert(Prop: TPasProperty;
  4378. AccessEl: TPasElement;
  4379. AContext: TConvertContext; ChompPropName: boolean): boolean;
  4380. // If El.Value contains property name set ChompPropName = true
  4381. var
  4382. Bracket: TJSBracketMemberExpression;
  4383. OldAccess: TCtxAccess;
  4384. PathEl: TPasExpr;
  4385. Ref: TResolvedReference;
  4386. Path: String;
  4387. begin
  4388. if not AContext.Resolver.IsExternalBracketAccessor(AccessEl) then
  4389. exit(false);
  4390. Result:=true;
  4391. // bracket accessor of external class
  4392. if Prop.Args.Count<>1 then
  4393. RaiseInconsistency(20170403003753);
  4394. // bracket accessor of external class -> create PathEl[param]
  4395. Bracket:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,Prop));
  4396. try
  4397. PathEl:=El.Value;
  4398. if ChompPropName then
  4399. begin
  4400. if (PathEl is TPrimitiveExpr)
  4401. and (TPrimitiveExpr(PathEl).Kind=pekIdent)
  4402. and (PathEl.CustomData is TResolvedReference) then
  4403. begin
  4404. // propname without path, e.g. propname[param]
  4405. Ref:=TResolvedReference(PathEl.CustomData);
  4406. Path:=CreateReferencePath(Prop,AContext,rpkPath,false,Ref);
  4407. if Path<>'' then
  4408. Bracket.MExpr:=CreateBuiltInIdentifierExpr(Path);
  4409. PathEl:=nil;
  4410. end
  4411. else if (PathEl is TBinaryExpr)
  4412. and (TBinaryExpr(PathEl).OpCode=eopSubIdent)
  4413. and (TBinaryExpr(PathEl).right is TPrimitiveExpr)
  4414. and (TPrimitiveExpr(TBinaryExpr(PathEl).right).Kind=pekIdent) then
  4415. begin
  4416. // instance.propname[param] -> instance[param]
  4417. PathEl:=TBinaryExpr(PathEl).left;
  4418. end
  4419. else
  4420. RaiseNotSupported(El.Value,AContext,20170402225050);
  4421. end;
  4422. if (PathEl<>nil) and (Bracket.MExpr=nil) then
  4423. begin
  4424. OldAccess:=AContext.Access;
  4425. AContext.Access:=caRead;
  4426. Bracket.MExpr:=ConvertElement(PathEl,AContext);
  4427. AContext.Access:=OldAccess;
  4428. end;
  4429. OldAccess:=ArgContext.Access;
  4430. ArgContext.Access:=caRead;
  4431. Bracket.Name:=ConvertElement(El.Params[0],AContext);
  4432. ArgContext.Access:=OldAccess;
  4433. ConvertArrayParams:=Bracket;
  4434. Bracket:=nil;
  4435. finally
  4436. Bracket.Free;
  4437. end;
  4438. end;
  4439. procedure ConvertIndexProperty(Prop: TPasProperty; AContext: TConvertContext);
  4440. var
  4441. Call: TJSCallExpression;
  4442. i: Integer;
  4443. TargetArg: TPasArgument;
  4444. Elements: TJSArrayLiteralElements;
  4445. Arg: TJSElement;
  4446. AccessEl: TPasElement;
  4447. AssignContext: TAssignContext;
  4448. OldAccess: TCtxAccess;
  4449. begin
  4450. Result:=nil;
  4451. AssignContext:=nil;
  4452. Call:=CreateCallExpression(El);
  4453. try
  4454. case AContext.Access of
  4455. caAssign:
  4456. begin
  4457. AccessEl:=AContext.Resolver.GetPasPropertySetter(Prop);
  4458. if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,true) then
  4459. exit;
  4460. AssignContext:=AContext.AccessContext as TAssignContext;
  4461. AssignContext.PropertyEl:=Prop;
  4462. AssignContext.Setter:=AccessEl;
  4463. AssignContext.Call:=Call;
  4464. end;
  4465. caRead:
  4466. begin
  4467. AccessEl:=AContext.Resolver.GetPasPropertyGetter(Prop);
  4468. if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,true) then
  4469. exit;
  4470. end
  4471. else
  4472. RaiseNotSupported(El,AContext,20170213213317);
  4473. end;
  4474. Call.Expr:=CreateReferencePathExpr(AccessEl,AContext,false,GetValueReference);
  4475. Elements:=Call.Args.Elements;
  4476. OldAccess:=ArgContext.Access;
  4477. // add params
  4478. i:=0;
  4479. while i<Prop.Args.Count do
  4480. begin
  4481. TargetArg:=TPasArgument(Prop.Args[i]);
  4482. Arg:=CreateProcCallArg(El.Params[i],TargetArg,ArgContext);
  4483. Elements.AddElement.Expr:=Arg;
  4484. inc(i);
  4485. end;
  4486. // fill up default values
  4487. while i<Prop.Args.Count do
  4488. begin
  4489. TargetArg:=TPasArgument(Prop.Args[i]);
  4490. if TargetArg.ValueExpr=nil then
  4491. begin
  4492. {$IFDEF VerbosePas2JS}
  4493. writeln('TPasToJSConverter.ConvertArrayParams.ConvertIndexProperty missing default value: Prop=',Prop.Name,' i=',i);
  4494. {$ENDIF}
  4495. RaiseInconsistency(20170206185126);
  4496. end;
  4497. AContext.Access:=caRead;
  4498. Arg:=ConvertElement(TargetArg.ValueExpr,ArgContext);
  4499. Elements.AddElement.Expr:=Arg;
  4500. inc(i);
  4501. end;
  4502. // finally add as last parameter the value
  4503. if AssignContext<>nil then
  4504. begin
  4505. Elements.AddElement.Expr:=AssignContext.RightSide;
  4506. AssignContext.RightSide:=nil;
  4507. end;
  4508. ArgContext.Access:=OldAccess;
  4509. Result:=Call;
  4510. finally
  4511. if Result=nil then
  4512. begin
  4513. if (AssignContext<>nil) and (AssignContext.Call=Call) then
  4514. AssignContext.Call:=nil;
  4515. Call.Free;
  4516. end;
  4517. end;
  4518. end;
  4519. procedure ConvertDefaultProperty(const ResolvedEl: TPasResolverResult;
  4520. Prop: TPasProperty);
  4521. var
  4522. DotContext: TDotContext;
  4523. Left, Right: TJSElement;
  4524. OldAccess: TCtxAccess;
  4525. AccessEl, SetAccessEl: TPasElement;
  4526. begin
  4527. case AContext.Access of
  4528. caAssign:
  4529. begin
  4530. AccessEl:=AContext.Resolver.GetPasPropertySetter(Prop);
  4531. if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,false) then
  4532. exit;
  4533. end;
  4534. caRead:
  4535. begin
  4536. AccessEl:=AContext.Resolver.GetPasPropertyGetter(Prop);
  4537. if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,false) then
  4538. exit;
  4539. end;
  4540. caByReference:
  4541. begin
  4542. //ParamContext:=AContext.AccessContext as TParamContext;
  4543. AccessEl:=AContext.Resolver.GetPasPropertyGetter(Prop);
  4544. SetAccessEl:=AContext.Resolver.GetPasPropertySetter(Prop);
  4545. if AContext.Resolver.IsExternalBracketAccessor(AccessEl) then
  4546. begin
  4547. if AContext.Resolver.IsExternalBracketAccessor(SetAccessEl) then
  4548. begin
  4549. // read and write are brackets -> easy
  4550. if not IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,false) then
  4551. RaiseNotSupported(El,AContext,20170405090845);
  4552. exit;
  4553. end;
  4554. end;
  4555. RaiseNotSupported(El,AContext,20170403000550);
  4556. end;
  4557. else
  4558. RaiseNotSupported(El,AContext,20170402233834);
  4559. end;
  4560. DotContext:=nil;
  4561. Left:=nil;
  4562. Right:=nil;
  4563. try
  4564. OldAccess:=AContext.Access;
  4565. AContext.Access:=caRead;
  4566. Left:=ConvertElement(El.Value,AContext);
  4567. AContext.Access:=OldAccess;
  4568. DotContext:=TDotContext.Create(El.Value,Left,AContext);
  4569. DotContext.LeftResolved:=ResolvedEl;
  4570. ConvertIndexProperty(Prop,DotContext);
  4571. Right:=Result;
  4572. Result:=nil;
  4573. finally
  4574. DotContext.Free;
  4575. if Right=nil then
  4576. Left.Free;
  4577. end;
  4578. Result:=CreateDotExpression(El,Left,Right);
  4579. end;
  4580. Var
  4581. ResolvedEl: TPasResolverResult;
  4582. TypeEl: TPasType;
  4583. ClassScope: TPas2JSClassScope;
  4584. B: TJSBracketMemberExpression;
  4585. OldAccess: TCtxAccess;
  4586. aClass: TPasClassType;
  4587. begin
  4588. if El.Kind<>pekArrayParams then
  4589. RaiseInconsistency(20170209113713);
  4590. ArgContext:=AContext;
  4591. while ArgContext is TDotContext do
  4592. ArgContext:=ArgContext.Parent;
  4593. if AContext.Resolver=nil then
  4594. begin
  4595. // without Resolver
  4596. if Length(El.Params)>1 then
  4597. RaiseNotSupported(El,AContext,20170207151325,'Cannot convert 2-dim arrays');
  4598. B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
  4599. try
  4600. // add reference
  4601. OldAccess:=AContext.Access;
  4602. AContext.Access:=caRead;
  4603. B.MExpr:=ConvertElement(El.Value,AContext);
  4604. // add parameter
  4605. OldAccess:=ArgContext.Access;
  4606. ArgContext.Access:=caRead;
  4607. B.Name:=ConvertElement(El.Params[0],ArgContext);
  4608. ArgContext.Access:=OldAccess;
  4609. Result:=B;
  4610. finally
  4611. if Result=nil then
  4612. B.Free;
  4613. end;
  4614. exit;
  4615. end;
  4616. // has Resolver
  4617. AContext.Resolver.ComputeElement(El.Value,ResolvedEl,[]);
  4618. {$IFDEF VerbosePas2JS}
  4619. writeln('TPasToJSConverter.ConvertArrayParams Value=',GetResolverResultDesc(ResolvedEl));
  4620. {$ENDIF}
  4621. if ResolvedEl.BaseType in btAllStrings then
  4622. ConvertStringBracket
  4623. else if (ResolvedEl.IdentEl is TPasProperty)
  4624. and (TPasProperty(ResolvedEl.IdentEl).Args.Count>0) then
  4625. ConvertIndexProperty(TPasProperty(ResolvedEl.IdentEl),AContext)
  4626. else if ResolvedEl.BaseType=btContext then
  4627. begin
  4628. TypeEl:=ResolvedEl.TypeEl;
  4629. if TypeEl.ClassType=TPasClassType then
  4630. begin
  4631. aClass:=TPasClassType(TypeEl);
  4632. ClassScope:=aClass.CustomData as TPas2JSClassScope;
  4633. if ClassScope.DefaultProperty<>nil then
  4634. ConvertDefaultProperty(ResolvedEl,ClassScope.DefaultProperty)
  4635. else
  4636. RaiseInconsistency(20170206180448);
  4637. end
  4638. else if TypeEl.ClassType=TPasClassOfType then
  4639. begin
  4640. ClassScope:=TPasClassOfType(TypeEl).DestType.CustomData as TPas2JSClassScope;
  4641. if ClassScope.DefaultProperty=nil then
  4642. RaiseInconsistency(20170206180503);
  4643. ConvertDefaultProperty(ResolvedEl,ClassScope.DefaultProperty);
  4644. end
  4645. else if TypeEl.ClassType=TPasArrayType then
  4646. ConvertArray(TPasArrayType(TypeEl))
  4647. else
  4648. RaiseNotSupported(El,AContext,20170206181220,GetResolverResultDesc(ResolvedEl));
  4649. end
  4650. else
  4651. RaiseNotSupported(El,AContext,20170206180222);
  4652. end;
  4653. function TPasToJSConverter.ConvertFuncParams(El: TParamsExpr;
  4654. AContext: TConvertContext): TJSElement;
  4655. var
  4656. Ref: TResolvedReference;
  4657. Decl, Left: TPasElement;
  4658. BuiltInProc: TResElDataBuiltInProc;
  4659. TargetProcType: TPasProcedureType;
  4660. Call: TJSCallExpression;
  4661. Elements: TJSArrayLiteralElements;
  4662. E: TJSArrayLiteral;
  4663. OldAccess: TCtxAccess;
  4664. DeclResolved, ParamResolved: TPasResolverResult;
  4665. Param: TPasExpr;
  4666. JSBaseType: TPas2jsBaseType;
  4667. C: TClass;
  4668. begin
  4669. Result:=nil;
  4670. if El.Kind<>pekFuncParams then
  4671. RaiseInconsistency(20170209113515);
  4672. //writeln('TPasToJSConverter.ConvertFuncParams START pekFuncParams ',GetObjName(El.CustomData),' ',GetObjName(El.Value.CustomData));
  4673. Call:=nil;
  4674. Elements:=nil;
  4675. TargetProcType:=nil;
  4676. if El.Value.CustomData is TResolvedReference then
  4677. begin
  4678. Ref:=TResolvedReference(El.Value.CustomData);
  4679. Decl:=Ref.Declaration;
  4680. if Decl is TPasType then
  4681. Decl:=AContext.Resolver.ResolveAliasType(TPasType(Decl));
  4682. //writeln('TPasToJSConverter.ConvertFuncParams pekFuncParams TResolvedReference ',GetObjName(Ref.Declaration),' ',GetObjName(Ref.Declaration.CustomData));
  4683. C:=Decl.ClassType;
  4684. if C=TPasUnresolvedSymbolRef then
  4685. begin
  4686. if Decl.CustomData is TResElDataBuiltInProc then
  4687. begin
  4688. BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
  4689. {$IFDEF VerbosePas2JS}
  4690. writeln('TPasToJSConverter.ConvertFuncParams ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  4691. {$ENDIF}
  4692. case BuiltInProc.BuiltIn of
  4693. bfLength: Result:=ConvertBuiltIn_Length(El,AContext);
  4694. bfSetLength: Result:=ConvertBuiltIn_SetLength(El,AContext);
  4695. bfInclude: Result:=ConvertBuiltIn_ExcludeInclude(El,AContext,true);
  4696. bfExclude: Result:=ConvertBuiltIn_ExcludeInclude(El,AContext,false);
  4697. bfExit: Result:=ConvertBuiltIn_Exit(El,AContext);
  4698. bfInc,
  4699. bfDec: Result:=ConvertBuiltIn_IncDec(El,AContext);
  4700. bfAssigned: Result:=ConvertBuiltIn_Assigned(El,AContext);
  4701. bfChr: Result:=ConvertBuiltIn_Chr(El,AContext);
  4702. bfOrd: Result:=ConvertBuiltIn_Ord(El,AContext);
  4703. bfLow: Result:=ConvertBuiltIn_Low(El,AContext);
  4704. bfHigh: Result:=ConvertBuiltIn_High(El,AContext);
  4705. bfPred: Result:=ConvertBuiltIn_Pred(El,AContext);
  4706. bfSucc: Result:=ConvertBuiltIn_Succ(El,AContext);
  4707. bfStrProc: Result:=ConvertBuiltIn_StrProc(El,AContext);
  4708. bfStrFunc: Result:=ConvertBuiltIn_StrFunc(El,AContext);
  4709. bfConcatArray: Result:=ConvertBuiltIn_ConcatArray(El,AContext);
  4710. bfCopyArray: Result:=ConvertBuiltIn_CopyArray(El,AContext);
  4711. bfInsertArray: Result:=ConvertBuiltIn_InsertArray(El,AContext);
  4712. bfDeleteArray: Result:=ConvertBuiltIn_DeleteArray(El,AContext);
  4713. bfTypeInfo: Result:=ConvertBuiltIn_TypeInfo(El,AContext);
  4714. else
  4715. RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  4716. end;
  4717. if Result=nil then
  4718. RaiseInconsistency(20170210121932);
  4719. exit;
  4720. end
  4721. else if Decl.CustomData is TResElDataBaseType then
  4722. begin
  4723. Result:=ConvertTypeCastToBaseType(El,AContext,TResElDataBaseType(Decl.CustomData));
  4724. exit;
  4725. end
  4726. else
  4727. RaiseNotSupported(El,AContext,20170325160624);
  4728. end
  4729. else if IsExternalClassConstructor(Decl) then
  4730. begin
  4731. // create external object/function
  4732. // -> check if there is complex left side, e.g. TExtA.Create(params)
  4733. Left:=El;
  4734. while (Left.Parent.ClassType=TParamsExpr) do
  4735. Left:=Left.Parent;
  4736. if (Left.Parent.ClassType=TBinaryExpr) and (TBinaryExpr(Left.Parent).right=Left) then
  4737. Left:=TBinaryExpr(Left.Parent).Left
  4738. else
  4739. Left:=nil;
  4740. Result:=ConvertExternalConstructor(Left,Ref,El,AContext);
  4741. exit;
  4742. end
  4743. else if C.InheritsFrom(TPasProcedure) then
  4744. TargetProcType:=TPasProcedure(Decl).ProcType
  4745. else if (C=TPasClassType)
  4746. or (C=TPasClassOfType)
  4747. or (C=TPasEnumType)
  4748. or (C=TPasArrayType) then
  4749. begin
  4750. // typecast
  4751. // default is to simply replace "aType(value)" with "value"
  4752. Param:=El.Params[0];
  4753. AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
  4754. Result:=ConvertElement(Param,AContext);
  4755. if (ParamResolved.BaseType=btCustom)
  4756. and (ParamResolved.TypeEl.CustomData is TResElDataPas2JSBaseType) then
  4757. begin
  4758. JSBaseType:=TResElDataPas2JSBaseType(ParamResolved.TypeEl.CustomData).JSBaseType;
  4759. if JSBaseType=pbtJSValue then
  4760. begin
  4761. if (C=TPasClassType)
  4762. or (C=TPasClassOfType) then
  4763. begin
  4764. // TObject(jsvalue) -> rtl.getObject(jsvalue)
  4765. Call:=CreateCallExpression(El);
  4766. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnGetObject]]);
  4767. Call.AddArg(Result);
  4768. Result:=Call;
  4769. end;
  4770. end;
  4771. end;
  4772. exit;
  4773. end
  4774. else if C.InheritsFrom(TPasVariable) then
  4775. begin
  4776. AContext.Resolver.ComputeElement(Decl,DeclResolved,[rcType]);
  4777. if DeclResolved.TypeEl is TPasProcedureType then
  4778. TargetProcType:=TPasProcedureType(DeclResolved.TypeEl)
  4779. else
  4780. RaiseNotSupported(El,AContext,20170217115244);
  4781. end
  4782. else if (C=TPasArgument) then
  4783. begin
  4784. AContext.Resolver.ComputeElement(Decl,DeclResolved,[rcType]);
  4785. if DeclResolved.TypeEl is TPasProcedureType then
  4786. TargetProcType:=TPasProcedureType(DeclResolved.TypeEl)
  4787. else
  4788. RaiseNotSupported(El,AContext,20170328224020);
  4789. end
  4790. else if (C=TPasProcedureType)
  4791. or (C=TPasFunctionType) then
  4792. begin
  4793. TargetProcType:=TPasProcedureType(Decl);
  4794. end
  4795. else
  4796. begin
  4797. {$IFDEF VerbosePas2JS}
  4798. writeln('TPasToJSConverter.ConvertFuncParams El=',GetObjName(El),' Decl=',GetObjName(Decl));
  4799. {$ENDIF}
  4800. RaiseNotSupported(El,AContext,20170215114337);
  4801. end;
  4802. if [rrfNewInstance,rrfFreeInstance]*Ref.Flags<>[] then
  4803. // call constructor, destructor
  4804. Call:=CreateFreeOrNewInstanceExpr(Ref,AContext);
  4805. end;
  4806. if Call=nil then
  4807. begin
  4808. Call:=CreateCallExpression(El);
  4809. Elements:=Call.Args.Elements;
  4810. end;
  4811. OldAccess:=AContext.Access;
  4812. try
  4813. AContext.Access:=caRead;
  4814. if Call.Expr=nil then
  4815. Call.Expr:=ConvertElement(El.Value,AContext);
  4816. if Call.Args=nil then
  4817. begin
  4818. // append ()
  4819. Call.Args:=TJSArguments(CreateElement(TJSArguments,El));
  4820. Elements:=Call.Args.Elements;
  4821. end
  4822. else if Elements=nil then
  4823. begin
  4824. // insert array parameter [], e.g. this.TObject.$create("create",[])
  4825. Elements:=Call.Args.Elements;
  4826. E:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
  4827. Elements.AddElement.Expr:=E;
  4828. Elements:=TJSArrayLiteral(E).Elements;
  4829. end;
  4830. CreateProcedureCallArgs(Elements,El,TargetProcType,AContext);
  4831. if Elements.Count=0 then
  4832. begin
  4833. Call.Args.Free;
  4834. Call.Args:=nil;
  4835. end;
  4836. Result:=Call;
  4837. finally
  4838. AContext.Access:=OldAccess;
  4839. if Result=nil then
  4840. Call.Free;
  4841. end;
  4842. end;
  4843. function TPasToJSConverter.ConvertExternalConstructor(Left: TPasElement;
  4844. Ref: TResolvedReference; ParamsExpr: TParamsExpr; AContext: TConvertContext
  4845. ): TJSElement;
  4846. var
  4847. Proc: TPasConstructor;
  4848. ExtName: String;
  4849. NewExpr: TJSNewMemberExpression;
  4850. Call: TJSCallExpression;
  4851. LeftResolved: TPasResolverResult;
  4852. OldAccess: TCtxAccess;
  4853. ExtNameEl: TJSElement;
  4854. WithData: TPas2JSWithExprScope;
  4855. begin
  4856. Result:=nil;
  4857. NewExpr:=nil;
  4858. Call:=nil;
  4859. ExtNameEl:=nil;
  4860. try
  4861. Proc:=Ref.Declaration as TPasConstructor;
  4862. ExtNameEl:=nil;
  4863. if Left<>nil then
  4864. begin
  4865. if AContext.Resolver<>nil then
  4866. begin
  4867. AContext.Resolver.ComputeElement(Left,LeftResolved,[]);
  4868. if LeftResolved.BaseType=btModule then
  4869. begin
  4870. // e.g. Unit.TExtA
  4871. // ExtName is global -> omit unit
  4872. Left:=nil;
  4873. end
  4874. else ;
  4875. end;
  4876. if Left<>nil then
  4877. begin
  4878. // convert left side
  4879. OldAccess:=AContext.Access;
  4880. AContext.Access:=caRead;
  4881. ExtNameEl:=ConvertElement(Left,AContext);
  4882. AContext.Access:=OldAccess;
  4883. end;
  4884. end;
  4885. if ExtNameEl=nil then
  4886. begin
  4887. if Ref.WithExprScope<>nil then
  4888. begin
  4889. // using local WITH var
  4890. WithData:=Ref.WithExprScope as TPas2JSWithExprScope;
  4891. ExtName:=WithData.WithVarName;
  4892. end
  4893. else
  4894. // use external class name
  4895. ExtName:=(Proc.Parent as TPasClassType).ExternalName;
  4896. ExtNameEl:=CreateBuiltInIdentifierExpr(ExtName);
  4897. end;
  4898. if CompareText(Proc.Name,'new')=0 then
  4899. begin
  4900. // create 'new ExtName(params)'
  4901. NewExpr:=TJSNewMemberExpression(CreateElement(TJSNewMemberExpression,Ref.Element));
  4902. NewExpr.MExpr:=ExtNameEl;
  4903. NewExpr.Args:=TJSArguments(CreateElement(TJSArguments,Ref.Element));
  4904. ExtNameEl:=nil;
  4905. if ParamsExpr<>nil then
  4906. CreateProcedureCallArgs(NewExpr.Args.Elements,ParamsExpr,Proc.ProcType,AContext);
  4907. Result:=NewExpr;
  4908. NewExpr:=nil;
  4909. end
  4910. else
  4911. RaiseInconsistency(20170323083214);
  4912. finally
  4913. ExtNameEl.Free;
  4914. NewExpr.Free;
  4915. Call.Free;
  4916. end;
  4917. end;
  4918. function TPasToJSConverter.ConvertTypeCastToBaseType(El: TParamsExpr;
  4919. AContext: TConvertContext; BaseTypeData: TResElDataBaseType): TJSElement;
  4920. var
  4921. bt: TResolverBaseType;
  4922. Param: TPasExpr;
  4923. ParamResolved: TPasResolverResult;
  4924. NotEqual: TJSEqualityExpressionNE;
  4925. CondExpr: TJSConditionalExpression;
  4926. JSBaseType: TPas2jsBaseType;
  4927. Call: TJSCallExpression;
  4928. NotExpr: TJSUnaryNotExpression;
  4929. AddExpr: TJSAdditiveExpressionPlus;
  4930. JSBaseTypeData: TResElDataPas2JSBaseType;
  4931. TypeEl: TPasType;
  4932. C: TClass;
  4933. function IsParamPas2JSBaseType: boolean;
  4934. var
  4935. TypeEl: TPasType;
  4936. begin
  4937. if ParamResolved.BaseType<>btCustom then exit(false);
  4938. TypeEl:=ParamResolved.TypeEl;
  4939. if TypeEl.ClassType<>TPasUnresolvedSymbolRef then exit(false);
  4940. if not (TypeEl.CustomData is TResElDataPas2JSBaseType) then exit(false);
  4941. Result:=true;
  4942. JSBaseTypeData:=TResElDataPas2JSBaseType(TypeEl.CustomData);
  4943. JSBaseType:=JSBaseTypeData.JSBaseType;
  4944. end;
  4945. begin
  4946. Result:=nil;
  4947. Param:=El.Params[0];
  4948. AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
  4949. JSBaseTypeData:=nil;
  4950. JSBaseType:=pbtNone;
  4951. bt:=BaseTypeData.BaseType;
  4952. if bt in btAllInteger then
  4953. begin
  4954. if ParamResolved.BaseType in btAllInteger then
  4955. begin
  4956. // integer to integer -> value
  4957. Result:=ConvertElement(Param,AContext);
  4958. exit;
  4959. end
  4960. else if ParamResolved.BaseType in btAllBooleans then
  4961. begin
  4962. // boolean to integer -> value?1:0
  4963. Result:=ConvertElement(Param,AContext);
  4964. // Note: convert value first in case it raises an exception
  4965. CondExpr:=TJSConditionalExpression(CreateElement(TJSConditionalExpression,El));
  4966. CondExpr.A:=Result;
  4967. CondExpr.B:=CreateLiteralNumber(El,1);
  4968. CondExpr.C:=CreateLiteralNumber(El,0);
  4969. Result:=CondExpr;
  4970. exit;
  4971. end
  4972. else if IsParamPas2JSBaseType then
  4973. begin
  4974. if JSBaseType=pbtJSValue then
  4975. begin
  4976. // convert jsvalue to integer -> Math.floor(value)
  4977. Result:=ConvertElement(Param,AContext);
  4978. // Note: convert value first in case it raises an exception
  4979. Call:=CreateCallExpression(El);
  4980. Call.Expr:=CreateMemberExpression(['Math','floor']);
  4981. Call.AddArg(Result);
  4982. Result:=Call;
  4983. exit;
  4984. end;
  4985. end;
  4986. end
  4987. else if bt in btAllBooleans then
  4988. begin
  4989. if ParamResolved.BaseType in btAllBooleans then
  4990. begin
  4991. // boolean to boolean -> value
  4992. Result:=ConvertElement(Param,AContext);
  4993. exit;
  4994. end
  4995. else if ParamResolved.BaseType in btAllInteger then
  4996. begin
  4997. // integer to boolean -> value!=0
  4998. Result:=ConvertElement(Param,AContext);
  4999. // Note: convert value first in case it raises an exception
  5000. NotEqual:=TJSEqualityExpressionNE(CreateElement(TJSEqualityExpressionNE,El));
  5001. NotEqual.A:=Result;
  5002. NotEqual.B:=CreateLiteralNumber(El,0);
  5003. Result:=NotEqual;
  5004. exit;
  5005. end
  5006. else if IsParamPas2JSBaseType then
  5007. begin
  5008. if JSBaseType=pbtJSValue then
  5009. begin
  5010. // convert jsvalue to boolean -> !(value==false)
  5011. Result:=ConvertElement(Param,AContext);
  5012. // Note: convert value first in case it raises an exception
  5013. NotExpr:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
  5014. NotExpr.A:=TJSEqualityExpressionEQ(CreateElement(TJSEqualityExpressionEQ,El));
  5015. TJSEqualityExpressionEQ(NotExpr.A).A:=Result;
  5016. TJSEqualityExpressionEQ(NotExpr.A).B:=CreateLiteralBoolean(El,false);
  5017. Result:=NotExpr;
  5018. exit;
  5019. end;
  5020. end;
  5021. end
  5022. else if bt in btAllFloats then
  5023. begin
  5024. if ParamResolved.BaseType in (btAllFloats+btAllInteger) then
  5025. begin
  5026. // double to double -> value
  5027. Result:=ConvertElement(Param,AContext);
  5028. exit;
  5029. end
  5030. else if IsParamPas2JSBaseType then
  5031. begin
  5032. if JSBaseType=pbtJSValue then
  5033. begin
  5034. // convert jsvalue to double -> rtl.getNumber(value)
  5035. Result:=ConvertElement(Param,AContext);
  5036. // Note: convert value first in case it raises an exception
  5037. Call:=CreateCallExpression(El);
  5038. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnGetNumber]]);
  5039. Call.AddArg(Result);
  5040. Result:=Call;
  5041. exit;
  5042. end;
  5043. end;
  5044. end
  5045. else if bt in btAllStrings then
  5046. begin
  5047. if ParamResolved.BaseType in btAllStringAndChars then
  5048. begin
  5049. // string or char to string -> value
  5050. Result:=ConvertElement(Param,AContext);
  5051. exit;
  5052. end
  5053. else if IsParamPas2JSBaseType then
  5054. begin
  5055. if JSBaseType=pbtJSValue then
  5056. begin
  5057. // convert jsvalue to string -> ""+value
  5058. Result:=ConvertElement(Param,AContext);
  5059. // Note: convert value first in case it raises an exception
  5060. AddExpr:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,El));
  5061. AddExpr.A:=CreateLiteralString(El,'');
  5062. AddExpr.B:=Result;
  5063. Result:=AddExpr;
  5064. exit;
  5065. end;
  5066. end;
  5067. end
  5068. else if bt=btChar then
  5069. begin
  5070. if ParamResolved.BaseType=btChar then
  5071. begin
  5072. // char to char
  5073. Result:=ConvertElement(Param,AContext);
  5074. exit;
  5075. end
  5076. else if IsParamPas2JSBaseType then
  5077. begin
  5078. if JSBaseType=pbtJSValue then
  5079. begin
  5080. // convert jsvalue to char -> rtl.getChar(value)
  5081. Result:=ConvertElement(Param,AContext);
  5082. // Note: convert value first in case it raises an exception
  5083. Call:=CreateCallExpression(El);
  5084. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnGetChar]]);
  5085. Call.AddArg(Result);
  5086. Result:=Call;
  5087. exit;
  5088. end;
  5089. end;
  5090. end
  5091. else if bt=btPointer then
  5092. begin
  5093. if IsParamPas2JSBaseType then
  5094. begin
  5095. if JSBaseType=pbtJSValue then
  5096. begin
  5097. // convert jsvalue to pointer -> pass through
  5098. Result:=ConvertElement(Param,AContext);
  5099. exit;
  5100. end;
  5101. end;
  5102. end
  5103. else if (bt=btCustom) and (BaseTypeData is TResElDataPas2JSBaseType) then
  5104. begin
  5105. JSBaseType:=TResElDataPas2JSBaseType(BaseTypeData).JSBaseType;
  5106. if JSBaseType=pbtJSValue then
  5107. begin
  5108. // type cast to jsvalue
  5109. Result:=ConvertElement(Param,AContext);
  5110. // Note: convert value first in case it raises an exception
  5111. if ParamResolved.BaseType=btContext then
  5112. begin
  5113. TypeEl:=AContext.Resolver.ResolveAliasType(ParamResolved.TypeEl);
  5114. C:=TypeEl.ClassType;
  5115. if C=TPasClassType then
  5116. begin
  5117. // TObject(vsvalue) -> rtl.getObject(vsvalue)
  5118. Call:=CreateCallExpression(El);
  5119. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnGetObject]]);
  5120. Call.AddArg(Result);
  5121. Result:=Call;
  5122. end;
  5123. end;
  5124. exit;
  5125. end;
  5126. end;
  5127. {$IFDEF VerbosePas2JS}
  5128. writeln('TPasToJSConverter.ConvertTypeCastToBaseType BaseTypeData=',BaseTypeNames[bt],' ParamResolved=',GetResolverResultDesc(ParamResolved));
  5129. {$ENDIF}
  5130. RaiseNotSupported(El,AContext,20170325161150);
  5131. end;
  5132. function TPasToJSConverter.ConvertSetLiteral(El: TParamsExpr;
  5133. AContext: TConvertContext): TJSElement;
  5134. var
  5135. Call: TJSCallExpression;
  5136. ArgContext: TConvertContext;
  5137. i: Integer;
  5138. Arg: TJSElement;
  5139. ArgEl: TPasExpr;
  5140. begin
  5141. if El.Kind<>pekSet then
  5142. RaiseInconsistency(20170209112737);
  5143. if AContext.Access<>caRead then
  5144. DoError(20170209112926,nCantWriteSetLiteral,sCantWriteSetLiteral,[],El);
  5145. if length(El.Params)=0 then
  5146. Result:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El))
  5147. else
  5148. begin
  5149. Result:=nil;
  5150. ArgContext:=AContext;
  5151. while ArgContext is TDotContext do
  5152. ArgContext:=ArgContext.Parent;
  5153. Call:=CreateCallExpression(El);
  5154. try
  5155. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSet_Create]]);
  5156. for i:=0 to length(El.Params)-1 do
  5157. begin
  5158. ArgEl:=El.Params[i];
  5159. {$IFDEF VerbosePas2JS}
  5160. writeln('TPasToJSConverter.ConvertSetLiteral ',i,' El.Params[i]=',GetObjName(ArgEl));
  5161. {$ENDIF}
  5162. if (ArgEl.ClassType=TBinaryExpr) and (TBinaryExpr(ArgEl).Kind=pekRange) then
  5163. begin
  5164. // range -> add three parameters: null,left,right
  5165. // ToDo: error if left>right
  5166. // add null
  5167. Call.AddArg(CreateLiteralNull(ArgEl));
  5168. // add left
  5169. Arg:=ConvertElement(TBinaryExpr(ArgEl).left,ArgContext);
  5170. Call.AddArg(Arg);
  5171. // add right
  5172. Arg:=ConvertElement(TBinaryExpr(ArgEl).right,ArgContext);
  5173. Call.AddArg(Arg);
  5174. end
  5175. else
  5176. begin
  5177. Arg:=ConvertElement(ArgEl,ArgContext);
  5178. Call.AddArg(Arg);
  5179. end;
  5180. end;
  5181. Result:=Call;
  5182. finally
  5183. if Result=nil then
  5184. Call.Free;
  5185. end;
  5186. end;
  5187. end;
  5188. function TPasToJSConverter.ConvertOpenArrayParam(ElType: TPasType;
  5189. El: TParamsExpr; AContext: TConvertContext): TJSElement;
  5190. var
  5191. ArrLit: TJSArrayLiteral;
  5192. i: Integer;
  5193. NestedElType: TPasType;
  5194. Param: TPasExpr;
  5195. JSParam: TJSElement;
  5196. begin
  5197. {$IFDEF VerbosePas2JS}
  5198. writeln('TPasToJSConverter.ConvertOpenArrayParam ',GetObjName(ElType));
  5199. {$ENDIF}
  5200. Result:=nil;
  5201. try
  5202. NestedElType:=nil;
  5203. if ElType is TPasArrayType then
  5204. NestedElType:=TPasArrayType(ElType).ElType;
  5205. ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
  5206. for i:=0 to length(El.Params)-1 do
  5207. begin
  5208. Param:=El.Params[i];
  5209. if (NestedElType<>nil)
  5210. and (Param is TParamsExpr) and (TParamsExpr(Param).Kind=pekSet) then
  5211. JSParam:=ConvertOpenArrayParam(NestedElType,TParamsExpr(Param),AContext)
  5212. else
  5213. JSParam:=ConvertElement(Param,AContext);
  5214. ArrLit.Elements.AddElement.Expr:=JSParam;
  5215. end;
  5216. Result:=ArrLit;
  5217. finally
  5218. if Result=nil then
  5219. ArrLit.Free;
  5220. end;
  5221. end;
  5222. function TPasToJSConverter.ConvertBuiltIn_Length(El: TParamsExpr;
  5223. AContext: TConvertContext): TJSElement;
  5224. var
  5225. Arg: TJSElement;
  5226. Param, RangeEl: TPasExpr;
  5227. ParamResolved, RangeResolved: TPasResolverResult;
  5228. Ranges: TPasExprArray;
  5229. Call: TJSCallExpression;
  5230. aMinValue, aMaxValue: int64;
  5231. begin
  5232. Result:=nil;
  5233. Param:=El.Params[0];
  5234. AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
  5235. if ParamResolved.BaseType=btContext then
  5236. begin
  5237. if ParamResolved.TypeEl is TPasArrayType then
  5238. begin
  5239. Ranges:=TPasArrayType(ParamResolved.TypeEl).Ranges;
  5240. if length(Ranges)>0 then
  5241. begin
  5242. // static array -> number literal
  5243. if length(Ranges)>1 then
  5244. RaiseNotSupported(El,AContext,20170223131042);
  5245. RangeEl:=Ranges[0];
  5246. AContext.Resolver.ComputeElement(RangeEl,RangeResolved,[rcType]);
  5247. ComputeRange(RangeResolved,aMinValue,aMaxValue,RangeEl);
  5248. Result:=CreateLiteralNumber(El,aMaxValue-aMinValue+1);
  5249. exit;
  5250. end
  5251. else
  5252. begin
  5253. // dynamic array -> rtl.length(array)
  5254. Result:=ConvertElement(El.Params[0],AContext);
  5255. // Note: convert param first, it may raise an exception
  5256. Call:=CreateCallExpression(El);
  5257. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Length]]);
  5258. Call.AddArg(Result);
  5259. Result:=Call;
  5260. exit;
  5261. end;
  5262. end;
  5263. end;
  5264. // default: Param.length
  5265. Arg:=ConvertElement(Param,AContext);
  5266. Result:=CreateDotExpression(El,Arg,CreateBuiltInIdentifierExpr('length'));
  5267. end;
  5268. function TPasToJSConverter.ConvertBuiltIn_SetLength(El: TParamsExpr;
  5269. AContext: TConvertContext): TJSElement;
  5270. // convert "SetLength(a,Len)" to "a = rtl.arraySetLength(a,Len)"
  5271. var
  5272. Param0: TPasExpr;
  5273. ResolvedParam0: TPasResolverResult;
  5274. ArrayType: TPasArrayType;
  5275. Call: TJSCallExpression;
  5276. ValInit, Arg: TJSElement;
  5277. AssignSt: TJSSimpleAssignStatement;
  5278. AssignContext: TAssignContext;
  5279. ElType: TPasType;
  5280. begin
  5281. Result:=nil;
  5282. Param0:=El.Params[0];
  5283. if AContext.Access<>caRead then
  5284. RaiseInconsistency(20170213213621);
  5285. AContext.Resolver.ComputeElement(Param0,ResolvedParam0,[rcNoImplicitProc]);
  5286. {$IFDEF VerbosePasResolver}
  5287. writeln('TPasToJSConverter.ConvertBuiltInSetLength ',GetResolverResultDesc(ResolvedParam0));
  5288. {$ENDIF}
  5289. if ResolvedParam0.TypeEl is TPasArrayType then
  5290. begin
  5291. // SetLength(AnArray,newlength)
  5292. ArrayType:=TPasArrayType(ResolvedParam0.TypeEl);
  5293. {$IFDEF VerbosePasResolver}
  5294. writeln('TPasToJSConverter.ConvertBuiltInSetLength array');
  5295. {$ENDIF}
  5296. // -> AnArray = rtl.setArrayLength(AnArray,newlength,initvalue)
  5297. AssignContext:=TAssignContext.Create(El,nil,AContext);
  5298. try
  5299. AContext.Resolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
  5300. AssignContext.RightResolved:=ResolvedParam0;
  5301. // create right side
  5302. // rtl.setArrayLength()
  5303. Call:=CreateCallExpression(El);
  5304. AssignContext.RightSide:=Call;
  5305. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_SetLength]]);
  5306. // 1st param: AnArray
  5307. Call.AddArg(ConvertElement(Param0,AContext));
  5308. // 2nd param: newlength
  5309. Call.AddArg(ConvertElement(El.Params[1],AContext));
  5310. // 3rd param: default value
  5311. ElType:=AContext.Resolver.ResolveAliasType(ArrayType.ElType);
  5312. if ElType.ClassType=TPasRecordType then
  5313. ValInit:=CreateReferencePathExpr(ElType,AContext)
  5314. else
  5315. ValInit:=CreateValInit(ElType,nil,Param0,AContext);
  5316. Call.AddArg(ValInit);
  5317. // create left side: array =
  5318. Result:=CreateAssignStatement(Param0,AssignContext);
  5319. finally
  5320. AssignContext.RightSide.Free;
  5321. AssignContext.Free;
  5322. end;
  5323. end
  5324. else if ResolvedParam0.BaseType=btString then
  5325. begin
  5326. // convert "SetLength(string,NewLen);" to "string.length == NewLen;"
  5327. {$IFDEF VerbosePasResolver}
  5328. writeln('TPasToJSConverter.ConvertBuiltInSetLength string');
  5329. {$ENDIF}
  5330. AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
  5331. try
  5332. Arg:=ConvertElement(Param0,AContext);
  5333. // left side: string.length
  5334. AssignSt.LHS:=CreateDotExpression(El,Arg,CreateBuiltInIdentifierExpr('length'));
  5335. // right side: newlength
  5336. AssignSt.Expr:=ConvertElement(El.Params[1],AContext);
  5337. Result:=AssignSt;
  5338. finally
  5339. if Result=nil then
  5340. AssignSt.Free;
  5341. end;
  5342. end
  5343. else
  5344. RaiseNotSupported(El.Value,AContext,20170130141026,'setlength '+GetResolverResultDesc(ResolvedParam0));
  5345. end;
  5346. function TPasToJSConverter.ConvertBuiltIn_ExcludeInclude(El: TParamsExpr;
  5347. AContext: TConvertContext; IsInclude: boolean): TJSElement;
  5348. // convert "Include(aSet,Enum)" to "aSet=rtl.includeSet(aSet,Enum)"
  5349. var
  5350. Call: TJSCallExpression;
  5351. Param0: TPasExpr;
  5352. AssignContext: TAssignContext;
  5353. FunName: String;
  5354. begin
  5355. Result:=nil;
  5356. Param0:=El.Params[0];
  5357. AssignContext:=TAssignContext.Create(El,nil,AContext);
  5358. try
  5359. AContext.Resolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
  5360. AssignContext.RightResolved:=AssignContext.LeftResolved;
  5361. // create right side rtl.includeSet(aSet,Enum)
  5362. Call:=CreateCallExpression(El);
  5363. AssignContext.RightSide:=Call;
  5364. if IsInclude then
  5365. FunName:=FBuiltInNames[pbifnSet_Include]
  5366. else
  5367. FunName:=FBuiltInNames[pbifnSet_Exclude];
  5368. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FunName]);
  5369. Call.AddArg(ConvertElement(Param0,AContext));
  5370. Call.AddArg(ConvertElement(El.Params[1],AContext));
  5371. Result:=CreateAssignStatement(Param0,AssignContext);
  5372. finally
  5373. AssignContext.RightSide.Free;
  5374. AssignContext.Free;
  5375. end;
  5376. end;
  5377. function TPasToJSConverter.ConvertBuiltInContinue(El: TPasExpr;
  5378. AContext: TConvertContext): TJSElement;
  5379. begin
  5380. if AContext=nil then;
  5381. Result:=TJSContinueStatement(CreateElement(TJSContinueStatement,El));
  5382. end;
  5383. function TPasToJSConverter.ConvertBuiltInBreak(El: TPasExpr;
  5384. AContext: TConvertContext): TJSElement;
  5385. begin
  5386. if AContext=nil then;
  5387. Result:=TJSBreakStatement(CreateElement(TJSBreakStatement,El));
  5388. end;
  5389. function TPasToJSConverter.ConvertBuiltIn_Exit(El: TPasExpr;
  5390. AContext: TConvertContext): TJSElement;
  5391. // convert "exit;" -> in a function: "return result;" in a procedure: "return;"
  5392. // convert "exit(param);" -> "return param;"
  5393. var
  5394. ProcEl: TPasElement;
  5395. begin
  5396. Result:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
  5397. if (El is TParamsExpr) and (length(TParamsExpr(El).Params)>0) then
  5398. begin
  5399. // with parameter. convert "exit(param);" -> "return param;"
  5400. TJSReturnStatement(Result).Expr:=ConvertExpression(TParamsExpr(El).Params[0],AContext);
  5401. end
  5402. else
  5403. begin
  5404. // without parameter.
  5405. ProcEl:=El.Parent;
  5406. while not (ProcEl is TPasProcedure) do ProcEl:=ProcEl.Parent;
  5407. if ProcEl is TPasFunction then
  5408. // in a function, "return result;"
  5409. TJSReturnStatement(Result).Expr:=CreateBuiltInIdentifierExpr(ResolverResultVar)
  5410. else
  5411. ; // in a procedure, "return;" which means "return undefined;"
  5412. end;
  5413. end;
  5414. function TPasToJSConverter.ConvertBuiltIn_IncDec(El: TParamsExpr;
  5415. AContext: TConvertContext): TJSElement;
  5416. // convert inc(a,b) to a+=b
  5417. // convert dec(a,b) to a-=b
  5418. var
  5419. AssignSt: TJSAssignStatement;
  5420. begin
  5421. if CompareText((El.Value as TPrimitiveExpr).Value,'inc')=0 then
  5422. AssignSt:=TJSAddEqAssignStatement(CreateElement(TJSAddEqAssignStatement,El))
  5423. else
  5424. AssignSt:=TJSSubEqAssignStatement(CreateElement(TJSSubEqAssignStatement,El));
  5425. Result:=AssignSt;
  5426. AssignSt.LHS:=ConvertExpression(El.Params[0],AContext);
  5427. if length(El.Params)=1 then
  5428. AssignSt.Expr:=CreateLiteralNumber(El,1)
  5429. else
  5430. AssignSt.Expr:=ConvertExpression(El.Params[1],AContext);
  5431. end;
  5432. function TPasToJSConverter.ConvertBuiltIn_Assigned(El: TParamsExpr;
  5433. AContext: TConvertContext): TJSElement;
  5434. var
  5435. NE: TJSEqualityExpressionNE;
  5436. Param: TPasExpr;
  5437. ParamResolved: TPasResolverResult;
  5438. C: TClass;
  5439. GT: TJSRelationalExpressionGT;
  5440. Call: TJSCallExpression;
  5441. begin
  5442. Result:=nil;
  5443. if AContext.Resolver=nil then
  5444. RaiseInconsistency(20170210105235);
  5445. Param:=El.Params[0];
  5446. AContext.Resolver.ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
  5447. {$IFDEF VerbosePas2JS}
  5448. writeln('TPasToJSConverter.ConvertBuiltInAssigned ParamResolved=',GetResolverResultDesc(ParamResolved));
  5449. {$ENDIF}
  5450. if ParamResolved.BaseType=btPointer then
  5451. begin
  5452. // convert Assigned(value) -> value!=null
  5453. Result:=ConvertElement(Param,AContext);
  5454. // Note: convert Param first, it may raise an exception
  5455. NE:=TJSEqualityExpressionNE(CreateElement(TJSEqualityExpressionNE,El));
  5456. NE.A:=Result;
  5457. NE.B:=CreateLiteralNull(El);
  5458. Result:=NE;
  5459. end
  5460. else if ParamResolved.BaseType=btContext then
  5461. begin
  5462. C:=ParamResolved.TypeEl.ClassType;
  5463. if (C=TPasClassType)
  5464. or (C=TPasClassOfType)
  5465. or C.InheritsFrom(TPasProcedureType) then
  5466. begin
  5467. // convert Assigned(value) -> value!=null
  5468. Result:=ConvertElement(Param,AContext);
  5469. // Note: convert Param first, it may raise an exception
  5470. NE:=TJSEqualityExpressionNE(CreateElement(TJSEqualityExpressionNE,El));
  5471. NE.A:=Result;
  5472. NE.B:=CreateLiteralNull(El);
  5473. Result:=NE;
  5474. end
  5475. else if C=TPasArrayType then
  5476. begin
  5477. // convert Assigned(value) -> rtl.length(value)>0
  5478. Result:=ConvertElement(Param,AContext);
  5479. // Note: convert Param first, it may raise an exception
  5480. GT:=TJSRelationalExpressionGT(CreateElement(TJSRelationalExpressionGT,El));
  5481. Call:=CreateCallExpression(El);
  5482. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Length]]);
  5483. Call.AddArg(Result);
  5484. GT.A:=Call;
  5485. GT.B:=CreateLiteralNumber(El,0);
  5486. Result:=GT;
  5487. end
  5488. else
  5489. RaiseNotSupported(El,AContext,20170328124606);
  5490. end;
  5491. end;
  5492. function TPasToJSConverter.ConvertBuiltIn_Chr(El: TParamsExpr;
  5493. AContext: TConvertContext): TJSElement;
  5494. var
  5495. ParamResolved: TPasResolverResult;
  5496. Param: TPasExpr;
  5497. Call: TJSCallExpression;
  5498. begin
  5499. Result:=nil;
  5500. if AContext.Resolver=nil then
  5501. RaiseInconsistency(20170325185847);
  5502. Param:=El.Params[0];
  5503. AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
  5504. if ParamResolved.BaseType in btAllInteger then
  5505. begin
  5506. // chr(integer) -> String.fromCharCode(integer)
  5507. Result:=ConvertElement(Param,AContext);
  5508. // Note: convert Param first, as it might raise an exception
  5509. Call:=CreateCallExpression(El);
  5510. Call.Expr:=CreateMemberExpression(['String','fromCharCode']);
  5511. Call.AddArg(Result);
  5512. Result:=Call;
  5513. exit;
  5514. end;
  5515. DoError(20170325185906,nExpectedXButFoundY,sExpectedXButFoundY,['integer',GetResolverResultDescription(ParamResolved)],Param);
  5516. end;
  5517. function TPasToJSConverter.ConvertBuiltIn_Ord(El: TParamsExpr;
  5518. AContext: TConvertContext): TJSElement;
  5519. var
  5520. ParamResolved, SubParamResolved: TPasResolverResult;
  5521. Param, SubParam: TPasExpr;
  5522. Call: TJSCallExpression;
  5523. SubParams: TParamsExpr;
  5524. SubParamJS: TJSElement;
  5525. Minus: TJSAdditiveExpressionMinus;
  5526. begin
  5527. Result:=nil;
  5528. if AContext.Resolver=nil then
  5529. RaiseInconsistency(20170210105235);
  5530. Param:=El.Params[0];
  5531. AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
  5532. if ParamResolved.BaseType=btChar then
  5533. begin
  5534. if Param is TParamsExpr then
  5535. begin
  5536. SubParams:=TParamsExpr(Param);
  5537. if SubParams.Kind=pekArrayParams then
  5538. begin
  5539. // e.g. ord(something[index])
  5540. SubParam:=SubParams.Value;
  5541. AContext.Resolver.ComputeElement(SubParam,SubParamResolved,[]);
  5542. if SubParamResolved.BaseType in btAllStrings then
  5543. begin
  5544. // e.g. ord(aString[index]) -> aString.charCodeAt(index-1)
  5545. SubParamJS:=ConvertElement(SubParam,AContext);
  5546. // Note: convert SubParam first, as it might raise an exception
  5547. Call:=nil;
  5548. try
  5549. Call:=CreateCallExpression(El);
  5550. Call.Expr:=CreateDotExpression(El,SubParamJS,CreateBuiltInIdentifierExpr('charCodeAt'));
  5551. Minus:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,Param));
  5552. Call.AddArg(Minus);
  5553. if length(SubParams.Params)<>1 then
  5554. RaiseInconsistency(20170405231706);
  5555. Minus.A:=ConvertElement(SubParams.Params[0],AContext);
  5556. Minus.B:=CreateLiteralNumber(Param,1);
  5557. Result:=Call;
  5558. finally
  5559. if Result=nil then
  5560. Call.Free;
  5561. end;
  5562. exit;
  5563. end;
  5564. end;
  5565. end;
  5566. // ord(aChar) -> aChar.charCodeAt()
  5567. Result:=ConvertElement(Param,AContext);
  5568. // Note: convert Param first, as it might raise an exception
  5569. Call:=CreateCallExpression(El);
  5570. Call.Expr:=CreateDotExpression(El,Result,CreateBuiltInIdentifierExpr('charCodeAt'));
  5571. Result:=Call;
  5572. exit;
  5573. end
  5574. else if ParamResolved.BaseType=btContext then
  5575. begin
  5576. if ParamResolved.TypeEl.ClassType=TPasEnumType then
  5577. begin
  5578. // ord(enum) -> enum
  5579. Result:=ConvertElement(Param,AContext);
  5580. exit;
  5581. end;
  5582. end;
  5583. DoError(20170210105339,nExpectedXButFoundY,sExpectedXButFoundY,['enum',GetResolverResultDescription(ParamResolved)],Param);
  5584. end;
  5585. function TPasToJSConverter.ConvertBuiltIn_Low(El: TParamsExpr;
  5586. AContext: TConvertContext): TJSElement;
  5587. // low(enumtype) -> first enumvalue
  5588. // low(set var) -> first enumvalue
  5589. // low(settype) -> first enumvalue
  5590. // low(array var) -> first index
  5591. procedure CreateEnumValue(TypeEl: TPasEnumType);
  5592. var
  5593. EnumValue: TPasEnumValue;
  5594. begin
  5595. EnumValue:=TPasEnumValue(TypeEl.Values[0]);
  5596. Result:=CreateReferencePathExpr(EnumValue,AContext);
  5597. end;
  5598. var
  5599. ResolvedEl, RangeResolved: TPasResolverResult;
  5600. Param: TPasExpr;
  5601. TypeEl: TPasType;
  5602. Ranges: TPasExprArray;
  5603. begin
  5604. Result:=nil;
  5605. if AContext.Resolver=nil then
  5606. RaiseInconsistency(20170210120659);
  5607. Param:=El.Params[0];
  5608. AContext.Resolver.ComputeElement(Param,ResolvedEl,[]);
  5609. case ResolvedEl.BaseType of
  5610. btContext:
  5611. begin
  5612. TypeEl:=ResolvedEl.TypeEl;
  5613. if TypeEl.ClassType=TPasEnumType then
  5614. begin
  5615. CreateEnumValue(TPasEnumType(TypeEl));
  5616. exit;
  5617. end
  5618. else if (TypeEl.ClassType=TPasSetType) then
  5619. begin
  5620. if TPasSetType(TypeEl).EnumType<>nil then
  5621. begin
  5622. TypeEl:=TPasSetType(TypeEl).EnumType;
  5623. CreateEnumValue(TPasEnumType(TypeEl));
  5624. exit;
  5625. end;
  5626. end
  5627. else if TypeEl.ClassType=TPasArrayType then
  5628. begin
  5629. Ranges:=TPasArrayType(TypeEl).Ranges;
  5630. if length(Ranges)=0 then
  5631. begin
  5632. Result:=CreateLiteralNumber(El,0);
  5633. exit;
  5634. end
  5635. else if length(Ranges)=1 then
  5636. begin
  5637. AContext.Resolver.ComputeElement(Ranges[0],RangeResolved,[rcConstant]);
  5638. if RangeResolved.BaseType=btContext then
  5639. begin
  5640. if RangeResolved.IdentEl is TPasEnumType then
  5641. begin
  5642. CreateEnumValue(TPasEnumType(RangeResolved.IdentEl));
  5643. exit;
  5644. end;
  5645. end
  5646. else if RangeResolved.BaseType=btBoolean then
  5647. begin
  5648. Result:=CreateLiteralBoolean(El,LowJSBoolean);
  5649. exit;
  5650. end;
  5651. end;
  5652. RaiseNotSupported(El,AContext,20170222231008);
  5653. end;
  5654. end;
  5655. btChar,
  5656. btWideChar:
  5657. begin
  5658. Result:=CreateLiteralJSString(El,#0);
  5659. exit;
  5660. end;
  5661. btBoolean:
  5662. begin
  5663. Result:=CreateLiteralBoolean(El,LowJSBoolean);
  5664. exit;
  5665. end;
  5666. btSet:
  5667. begin
  5668. TypeEl:=ResolvedEl.TypeEl;
  5669. if TypeEl.ClassType=TPasEnumType then
  5670. begin
  5671. CreateEnumValue(TPasEnumType(TypeEl));
  5672. exit;
  5673. end;
  5674. end;
  5675. end;
  5676. DoError(20170210110717,nExpectedXButFoundY,sExpectedXButFoundY,['enum or array',GetResolverResultDescription(ResolvedEl)],Param);
  5677. end;
  5678. function TPasToJSConverter.ConvertBuiltIn_High(El: TParamsExpr;
  5679. AContext: TConvertContext): TJSElement;
  5680. // high(enumtype) -> last enumvalue
  5681. // high(set var) -> last enumvalue
  5682. // high(settype) -> last enumvalue
  5683. // high(dynamic array) -> array.length-1
  5684. // high(static array) -> last index
  5685. procedure CreateEnumValue(TypeEl: TPasEnumType);
  5686. var
  5687. EnumValue: TPasEnumValue;
  5688. begin
  5689. EnumValue:=TPasEnumValue(TypeEl.Values[TypeEl.Values.Count-1]);
  5690. Result:=CreateReferencePathExpr(EnumValue,AContext);
  5691. end;
  5692. var
  5693. ResolvedEl, RangeResolved: TPasResolverResult;
  5694. Param, Range: TPasExpr;
  5695. TypeEl: TPasType;
  5696. MinusExpr: TJSAdditiveExpressionMinus;
  5697. Call: TJSCallExpression;
  5698. aMinValue, aMaxValue: int64;
  5699. begin
  5700. Result:=nil;
  5701. if AContext.Resolver=nil then
  5702. RaiseInconsistency(20170210120653);
  5703. Param:=El.Params[0];
  5704. AContext.Resolver.ComputeElement(Param,ResolvedEl,[]);
  5705. case ResolvedEl.BaseType of
  5706. btContext:
  5707. begin
  5708. TypeEl:=ResolvedEl.TypeEl;
  5709. if TypeEl.ClassType=TPasEnumType then
  5710. begin
  5711. CreateEnumValue(TPasEnumType(TypeEl));
  5712. exit;
  5713. end
  5714. else if (TypeEl.ClassType=TPasSetType) then
  5715. begin
  5716. if TPasSetType(TypeEl).EnumType<>nil then
  5717. begin
  5718. TypeEl:=TPasSetType(TypeEl).EnumType;
  5719. CreateEnumValue(TPasEnumType(TypeEl));
  5720. exit;
  5721. end;
  5722. end
  5723. else if TypeEl.ClassType=TPasArrayType then
  5724. begin
  5725. if length(TPasArrayType(TypeEl).Ranges)=0 then
  5726. begin
  5727. // dynamic array -> rtl.length(Param)-1
  5728. Result:=ConvertElement(Param,AContext);
  5729. // Note: convert Param first, it may raise an exception
  5730. Call:=CreateCallExpression(El);
  5731. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Length]]);
  5732. Call.AddArg(Result);
  5733. MinusExpr:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,El));
  5734. MinusExpr.A:=Call;
  5735. MinusExpr.B:=CreateLiteralNumber(El,1);
  5736. Result:=MinusExpr;
  5737. exit;
  5738. end
  5739. else if length(TPasArrayType(TypeEl).Ranges)=1 then
  5740. begin
  5741. // static array
  5742. Range:=TPasArrayType(TypeEl).Ranges[0];
  5743. AContext.Resolver.ComputeElement(Range,RangeResolved,[rcConstant]);
  5744. if RangeResolved.BaseType=btContext then
  5745. begin
  5746. if RangeResolved.IdentEl is TPasEnumType then
  5747. begin
  5748. CreateEnumValue(TPasEnumType(RangeResolved.IdentEl));
  5749. exit;
  5750. end;
  5751. end
  5752. else if RangeResolved.BaseType=btBoolean then
  5753. begin
  5754. Result:=CreateLiteralBoolean(Param,HighJSBoolean);
  5755. exit;
  5756. end
  5757. else if RangeResolved.BaseType in btAllInteger then
  5758. begin
  5759. ComputeRange(RangeResolved,aMinValue,aMaxValue,Range);
  5760. Result:=CreateLiteralNumber(Param,aMaxValue);
  5761. exit;
  5762. end;
  5763. end;
  5764. RaiseNotSupported(El,AContext,20170222231101);
  5765. end;
  5766. end;
  5767. btBoolean:
  5768. begin
  5769. Result:=CreateLiteralBoolean(Param,HighJSBoolean);
  5770. exit;
  5771. end;
  5772. btSet:
  5773. begin
  5774. TypeEl:=ResolvedEl.TypeEl;
  5775. if TypeEl.ClassType=TPasEnumType then
  5776. begin
  5777. CreateEnumValue(TPasEnumType(TypeEl));
  5778. exit;
  5779. end;
  5780. end;
  5781. end;
  5782. DoError(20170210114139,nExpectedXButFoundY,sExpectedXButFoundY,['enum or array',GetResolverResultDescription(ResolvedEl)],Param);
  5783. end;
  5784. function TPasToJSConverter.ConvertBuiltIn_Pred(El: TParamsExpr;
  5785. AContext: TConvertContext): TJSElement;
  5786. // pred(enumvalue) -> enumvalue-1
  5787. var
  5788. ResolvedEl: TPasResolverResult;
  5789. Param: TPasExpr;
  5790. V: TJSElement;
  5791. Expr: TJSAdditiveExpressionMinus;
  5792. begin
  5793. Result:=nil;
  5794. if AContext.Resolver=nil then
  5795. RaiseInconsistency(20170210120648);
  5796. Param:=El.Params[0];
  5797. AContext.Resolver.ComputeElement(Param,ResolvedEl,[]);
  5798. if (ResolvedEl.BaseType=btContext)
  5799. and (ResolvedEl.TypeEl.ClassType=TPasEnumType) then
  5800. begin
  5801. V:=ConvertElement(Param,AContext);
  5802. Expr:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,El));
  5803. Expr.A:=V;
  5804. Expr.B:=CreateLiteralNumber(El,1);
  5805. Result:=Expr;
  5806. exit;
  5807. end;
  5808. DoError(20170210120039,nExpectedXButFoundY,sExpectedXButFoundY,['enum',GetResolverResultDescription(ResolvedEl)],Param);
  5809. end;
  5810. function TPasToJSConverter.ConvertBuiltIn_Succ(El: TParamsExpr;
  5811. AContext: TConvertContext): TJSElement;
  5812. // succ(enumvalue) -> enumvalue+1
  5813. var
  5814. ResolvedEl: TPasResolverResult;
  5815. Param: TPasExpr;
  5816. V: TJSElement;
  5817. Expr: TJSAdditiveExpressionPlus;
  5818. begin
  5819. Result:=nil;
  5820. if AContext.Resolver=nil then
  5821. RaiseInconsistency(20170210120645);
  5822. Param:=El.Params[0];
  5823. AContext.Resolver.ComputeElement(Param,ResolvedEl,[]);
  5824. if (ResolvedEl.BaseType=btContext)
  5825. and (ResolvedEl.TypeEl.ClassType=TPasEnumType) then
  5826. begin
  5827. V:=ConvertElement(Param,AContext);
  5828. Expr:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,El));
  5829. Expr.A:=V;
  5830. Expr.B:=CreateLiteralNumber(El,1);
  5831. Result:=Expr;
  5832. exit;
  5833. end;
  5834. DoError(20170210120626,nExpectedXButFoundY,sExpectedXButFoundY,['enum',GetResolverResultDescription(ResolvedEl)],Param);
  5835. end;
  5836. function TPasToJSConverter.ConvertBuiltIn_StrProc(El: TParamsExpr;
  5837. AContext: TConvertContext): TJSElement;
  5838. // convert 'str(value,aString)' to 'aString = <string>'
  5839. // for the conversion see ConvertBuiltInStrFunc
  5840. var
  5841. AssignContext: TAssignContext;
  5842. StrVar: TPasExpr;
  5843. begin
  5844. Result:=nil;
  5845. AssignContext:=TAssignContext.Create(El,nil,AContext);
  5846. try
  5847. StrVar:=El.Params[1];
  5848. AContext.Resolver.ComputeElement(StrVar,AssignContext.LeftResolved,[rcNoImplicitProc]);
  5849. // create right side
  5850. AssignContext.RightSide:=ConvertBuiltInStrParam(El.Params[0],AContext,false,true);
  5851. SetResolverValueExpr(AssignContext.RightResolved,btString,
  5852. AContext.Resolver.BaseTypes[btString],El,[rrfReadable]);
  5853. // create 'StrVar = rightside'
  5854. Result:=CreateAssignStatement(StrVar,AssignContext);
  5855. finally
  5856. AssignContext.RightSide.Free;
  5857. AssignContext.Free;
  5858. end;
  5859. end;
  5860. function TPasToJSConverter.ConvertBuiltIn_StrFunc(El: TParamsExpr;
  5861. AContext: TConvertContext): TJSElement;
  5862. // convert 'str(boolean)' to '""+boolean'
  5863. // convert 'str(integer)' to '""+integer'
  5864. // convert 'str(float)' to '""+float'
  5865. // convert 'str(float:width)' to rtl.spaceLeft('""+float,width)'
  5866. // convert 'str(float:width:precision)' to 'rtl.spaceLeft(float.toFixed(precision),width)'
  5867. var
  5868. i: Integer;
  5869. Param: TPasExpr;
  5870. Sum, Add: TJSElement;
  5871. AddEl: TJSAdditiveExpressionPlus;
  5872. begin
  5873. {$IFDEF VerbosePas2JS}
  5874. writeln('TPasToJSConverter.ConvertBuiltInStrFunc Count=',length(El.Params));
  5875. {$ENDIF}
  5876. Result:=nil;
  5877. Sum:=nil;
  5878. Add:=nil;
  5879. try
  5880. for i:=0 to length(El.Params)-1 do
  5881. begin
  5882. Param:=El.Params[i];
  5883. Add:=ConvertBuiltInStrParam(Param,AContext,true,i=0);
  5884. if Sum=nil then
  5885. Sum:=Add
  5886. else
  5887. begin
  5888. AddEl:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,Param));
  5889. AddEl.A:=Sum;
  5890. AddEl.B:=Add;
  5891. Sum:=AddEl;
  5892. end;
  5893. Add:=nil;
  5894. end;
  5895. Result:=Sum;
  5896. finally
  5897. Add.Free;
  5898. if Result=nil then
  5899. Sum.Free;
  5900. end;
  5901. end;
  5902. function TPasToJSConverter.ConvertBuiltInStrParam(El: TPasExpr;
  5903. AContext: TConvertContext; IsStrFunc, IsFirst: boolean): TJSElement;
  5904. var
  5905. ResolvedEl: TPasResolverResult;
  5906. NeedStrLit: Boolean;
  5907. Add: TJSElement;
  5908. Call: TJSCallExpression;
  5909. PlusEl: TJSAdditiveExpressionPlus;
  5910. Bracket: TJSBracketMemberExpression;
  5911. procedure PrependStrLit;
  5912. begin
  5913. PlusEl:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,El));
  5914. PlusEl.A:=CreateLiteralString(El,'');
  5915. PlusEl.B:=Add;
  5916. Add:=PlusEl;
  5917. end;
  5918. begin
  5919. Result:=nil;
  5920. AContext.Resolver.ComputeElement(El,ResolvedEl,[]);
  5921. Add:=nil;
  5922. Call:=nil;
  5923. Bracket:=nil;
  5924. try
  5925. NeedStrLit:=false;
  5926. if ResolvedEl.BaseType in (btAllBooleans+btAllInteger) then
  5927. begin
  5928. NeedStrLit:=true;
  5929. Add:=ConvertElement(El,AContext);
  5930. end
  5931. else if ResolvedEl.BaseType in btAllFloats then
  5932. begin
  5933. NeedStrLit:=true;
  5934. Add:=ConvertElement(El,AContext);
  5935. if El.format2<>nil then
  5936. begin
  5937. // precision -> rtl El.toFixed(precision);
  5938. NeedStrLit:=false;
  5939. Call:=CreateCallExpression(El);
  5940. Call.Expr:=CreateDotExpression(El,Add,CreateBuiltInIdentifierExpr('toFixed'));
  5941. Call.AddArg(ConvertElement(El.format2,AContext));
  5942. Add:=Call;
  5943. Call:=nil;
  5944. end;
  5945. end
  5946. else if IsStrFunc and (ResolvedEl.BaseType in btAllStringAndChars) then
  5947. Add:=ConvertElement(El,AContext)
  5948. else if ResolvedEl.BaseType=btContext then
  5949. begin
  5950. if ResolvedEl.TypeEl.ClassType=TPasEnumType then
  5951. begin
  5952. // create enumtype[enumvalue]
  5953. Bracket:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
  5954. Bracket.MExpr:=CreateReferencePathExpr(TPasEnumType(ResolvedEl.TypeEl),AContext);
  5955. Bracket.Name:=ConvertElement(El,AContext);
  5956. Add:=Bracket;
  5957. Bracket:=nil;
  5958. end
  5959. else
  5960. RaiseNotSupported(El,AContext,20170320123827);
  5961. end
  5962. else
  5963. RaiseNotSupported(El,AContext,20170320093001);
  5964. if El.format1<>nil then
  5965. begin
  5966. // width -> leading spaces
  5967. if NeedStrLit then
  5968. PrependStrLit;
  5969. // create 'rtl.spaceLeft(add,width)'
  5970. Call:=CreateCallExpression(El);
  5971. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSpaceLeft]]);
  5972. Call.AddArg(Add);
  5973. Add:=nil;
  5974. Call.AddArg(ConvertElement(El.format1,AContext));
  5975. Add:=Call;
  5976. Call:=nil;
  5977. end
  5978. else if IsFirst and NeedStrLit then
  5979. PrependStrLit;
  5980. Result:=Add;
  5981. finally
  5982. Call.Free;
  5983. Bracket.Free;
  5984. if Result=nil then
  5985. Add.Free;
  5986. end;
  5987. end;
  5988. function TPasToJSConverter.ConvertBuiltIn_ConcatArray(El: TParamsExpr;
  5989. AContext: TConvertContext): TJSElement;
  5990. // concat(array1, array2)
  5991. var
  5992. Param0Resolved, ElTypeResolved: TPasResolverResult;
  5993. Param0: TPasExpr;
  5994. ArrayType: TPasArrayType;
  5995. Call: TJSCallExpression;
  5996. i: Integer;
  5997. begin
  5998. if length(El.Params)<1 then
  5999. RaiseInconsistency(20170331000332);
  6000. if length(El.Params)=1 then
  6001. begin
  6002. // concat(array1) -> array1
  6003. {$IFDEF VerbosePas2JS}
  6004. writeln('TPasToJSConverter.ConvertBuiltInConcatArray Count=',length(El.Params));
  6005. {$ENDIF}
  6006. Result:=ConvertElement(El.Params[0],AContext);
  6007. end
  6008. else
  6009. begin
  6010. // concat(array1,array2,...)
  6011. Param0:=El.Params[0];
  6012. AContext.Resolver.ComputeElement(Param0,Param0Resolved,[]);
  6013. if Param0Resolved.BaseType<>btContext then
  6014. RaiseNotSupported(Param0,AContext,20170331000819);
  6015. if Param0Resolved.TypeEl.ClassType<>TPasArrayType then
  6016. RaiseNotSupported(Param0,AContext,20170331000846);
  6017. ArrayType:=TPasArrayType(Param0Resolved.TypeEl);
  6018. if length(ArrayType.Ranges)>0 then
  6019. RaiseNotSupported(Param0,AContext,20170331001021);
  6020. AContext.Resolver.ComputeElement(ArrayType.ElType,ElTypeResolved,[rcType]);
  6021. Call:=CreateCallExpression(El);
  6022. try
  6023. {$IFDEF VerbosePas2JS}
  6024. writeln('TPasToJSConverter.ConvertBuiltInConcatArray Count=',length(El.Params),' ElType=',GetResolverResultDesc(ElTypeResolved));
  6025. {$ENDIF}
  6026. if ElTypeResolved.BaseType=btContext then
  6027. begin
  6028. if ElTypeResolved.TypeEl.ClassType=TPasRecordType then
  6029. begin
  6030. // record: rtl.arrayConcat(RecordType,array1,array2,...)
  6031. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Concat]]);
  6032. Call.AddArg(CreateReferencePathExpr(ElTypeResolved.TypeEl,AContext));
  6033. end;
  6034. end
  6035. else if ElTypeResolved.BaseType=btSet then
  6036. begin
  6037. // set: rtl.arrayConcat("refSet",array1,array2,...)
  6038. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Concat]]);
  6039. Call.AddArg(CreateLiteralString(El,FBuiltInNames[pbifnSet_Reference]));
  6040. end;
  6041. if Call.Expr=nil then
  6042. // default: array1.concat(array2,...)
  6043. Call.Expr:=CreateDotExpression(El,ConvertElement(Param0,AContext),
  6044. CreateBuiltInIdentifierExpr('concat'));
  6045. for i:=1 to length(El.Params)-1 do
  6046. Call.AddArg(ConvertElement(El.Params[i],AContext));
  6047. Result:=Call;
  6048. finally
  6049. if Result=nil then
  6050. Call.Free;
  6051. end;
  6052. end;
  6053. end;
  6054. function TPasToJSConverter.ConvertBuiltIn_CopyArray(El: TParamsExpr;
  6055. AContext: TConvertContext): TJSElement;
  6056. var
  6057. Param: TPasExpr;
  6058. ParamResolved, ElTypeResolved: TPasResolverResult;
  6059. C: TClass;
  6060. TypeParam: TJSElement;
  6061. Call: TJSCallExpression;
  6062. ArrayType: TPasArrayType;
  6063. begin
  6064. Result:=nil;
  6065. Call:=nil;
  6066. try
  6067. Param:=El.Params[0];
  6068. AContext.Resolver.ComputeElement(El,ParamResolved,[]);
  6069. if ParamResolved.BaseType<>btContext then
  6070. RaiseInconsistency(20170401003242);
  6071. if ParamResolved.TypeEl.ClassType<>TPasArrayType then
  6072. RaiseInconsistency(20170401003256);
  6073. ArrayType:=TPasArrayType(ParamResolved.TypeEl);
  6074. AContext.Resolver.ComputeElement(ArrayType.ElType,ElTypeResolved,[rcType]);
  6075. // rtl.arrayCopy(type,src,start,count)
  6076. TypeParam:=nil;
  6077. if ElTypeResolved.BaseType=btContext then
  6078. begin
  6079. C:=ElTypeResolved.TypeEl.ClassType;
  6080. if C=TPasRecordType then
  6081. TypeParam:=CreateReferencePathExpr(TPasRecordType(ElTypeResolved.TypeEl),AContext);
  6082. end
  6083. else if ElTypeResolved.BaseType=btSet then
  6084. TypeParam:=CreateLiteralString(El,FBuiltInNames[pbifnSet_Reference]);
  6085. if TypeParam=nil then
  6086. TypeParam:=CreateLiteralNumber(El,0);
  6087. Call:=CreateCallExpression(El);
  6088. // rtl.arrayCopy
  6089. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Copy]]);
  6090. // param: type
  6091. Call.AddArg(TypeParam);
  6092. // param: src
  6093. Call.AddArg(ConvertElement(Param,AContext));
  6094. // param: start
  6095. if length(El.Params)=1 then
  6096. Call.AddArg(CreateLiteralNumber(El,0))
  6097. else
  6098. Call.AddArg(ConvertElement(El.Params[1],AContext));
  6099. // param: count
  6100. if length(El.Params)>=3 then
  6101. Call.AddArg(ConvertElement(El.Params[2],AContext));
  6102. Result:=Call;
  6103. finally
  6104. if Result=nil then
  6105. Call.Free;
  6106. end;
  6107. if El=nil then ;
  6108. if AContext=nil then;
  6109. end;
  6110. function TPasToJSConverter.ConvertBuiltIn_InsertArray(El: TParamsExpr;
  6111. AContext: TConvertContext): TJSElement;
  6112. // procedure insert(item,var array,const position)
  6113. // -> array.splice(position,1,item);
  6114. var
  6115. ArrEl: TJSElement;
  6116. Call: TJSCallExpression;
  6117. begin
  6118. Result:=nil;
  6119. Call:=nil;
  6120. try
  6121. Call:=CreateCallExpression(El);
  6122. ArrEl:=ConvertElement(El.Params[1],AContext);
  6123. Call.Expr:=CreateDotExpression(El,ArrEl,CreateBuiltInIdentifierExpr('splice'));
  6124. Call.AddArg(ConvertElement(El.Params[2],AContext));
  6125. Call.AddArg(CreateLiteralNumber(El,1));
  6126. Call.AddArg(ConvertElement(El.Params[0],AContext));
  6127. Result:=Call;
  6128. finally
  6129. if Result=nil then
  6130. Call.Free;
  6131. end;
  6132. end;
  6133. function TPasToJSConverter.ConvertBuiltIn_DeleteArray(El: TParamsExpr;
  6134. AContext: TConvertContext): TJSElement;
  6135. // proc delete(var array,const start,count)
  6136. // -> array.splice(start,count)
  6137. var
  6138. ArrEl: TJSElement;
  6139. Call: TJSCallExpression;
  6140. begin
  6141. Result:=nil;
  6142. Call:=nil;
  6143. try
  6144. Call:=CreateCallExpression(El);
  6145. ArrEl:=ConvertElement(El.Params[0],AContext);
  6146. Call.Expr:=CreateDotExpression(El,ArrEl,CreateBuiltInIdentifierExpr('splice'));
  6147. Call.AddArg(ConvertElement(El.Params[1],AContext));
  6148. Call.AddArg(ConvertElement(El.Params[2],AContext));
  6149. Result:=Call;
  6150. finally
  6151. if Result=nil then
  6152. Call.Free;
  6153. end;
  6154. end;
  6155. function TPasToJSConverter.ConvertBuiltIn_TypeInfo(El: TParamsExpr;
  6156. AContext: TConvertContext): TJSElement;
  6157. var
  6158. ParamResolved: TPasResolverResult;
  6159. Param: TPasExpr;
  6160. begin
  6161. Result:=nil;
  6162. Param:=El.Params[0];
  6163. AContext.Resolver.ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  6164. if ParamResolved.IdentEl is TPasType then
  6165. Result:=CreateTypeInfoRef(TPasType(ParamResolved.IdentEl),AContext,Param)
  6166. else if ParamResolved.TypeEl<>nil then
  6167. begin
  6168. if (ParamResolved.TypeEl.ClassType=TPasClassType)
  6169. and (rrfReadable in ParamResolved.Flags)
  6170. and ((ParamResolved.IdentEl is TPasVariable)
  6171. or (ParamResolved.IdentEl.ClassType=TPasArgument)) then
  6172. begin
  6173. // typeinfo(classinstance) -> classinstance.$rtti
  6174. Result:=ConvertElement(Param,AContext);
  6175. Result:=CreateDotExpression(El,Result,CreateBuiltInIdentifierExpr(FBuiltInNames[pbivnRTTI]));
  6176. end
  6177. else
  6178. Result:=CreateTypeInfoRef(ParamResolved.TypeEl,AContext,Param);
  6179. end
  6180. else
  6181. RaiseNotSupported(El,AContext,20170413001544);
  6182. end;
  6183. function TPasToJSConverter.ConvertRecordValues(El: TRecordValues;
  6184. AContext: TConvertContext): TJSElement;
  6185. Var
  6186. R : TJSObjectLiteral;
  6187. I : Integer;
  6188. It : TRecordValuesItem;
  6189. rel : TJSObjectLiteralElement;
  6190. begin
  6191. R:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El));
  6192. For I:=0 to Length(El.Fields)-1 do
  6193. begin
  6194. it:=El.Fields[i];
  6195. Rel:=R.Elements.AddElement;
  6196. Rel.Name:=TJSString(it.Name);
  6197. Rel.Expr:=ConvertElement(it.ValueExp,AContext);
  6198. end;
  6199. Result:=R;
  6200. end;
  6201. function TPasToJSConverter.ConvertArrayValues(El: TArrayValues;
  6202. AContext: TConvertContext): TJSElement;
  6203. Var
  6204. R : TJSArrayLiteral;
  6205. I : Integer;
  6206. rel : TJSArrayLiteralElement;
  6207. begin
  6208. R:=TJSArrayLiteral(CreateElement(TJSObjectLiteral,El));
  6209. For I:=0 to Length(El.Values)-1 do
  6210. begin
  6211. Rel:=R.Elements.AddElement;
  6212. Rel.ElementIndex:=i;
  6213. Rel.Expr:=ConvertElement(El.Values[i],AContext);
  6214. end;
  6215. Result:=R;
  6216. end;
  6217. function TPasToJSConverter.ConvertExpression(El: TPasExpr;
  6218. AContext: TConvertContext): TJSElement;
  6219. begin
  6220. {$IFDEF VerbosePas2JS}
  6221. writeln('TPasToJSConverter.ConvertExpression El=',GetObjName(El),' Context=',GetObjName(AContext));
  6222. {$ENDIF}
  6223. Result:=Nil;
  6224. if (El.ClassType=TUnaryExpr) then
  6225. Result:=ConvertUnaryExpression(TUnaryExpr(El),AContext)
  6226. else if (El.ClassType=TBinaryExpr) then
  6227. Result:=ConvertBinaryExpression(TBinaryExpr(El),AContext)
  6228. else if (El.ClassType=TPrimitiveExpr) then
  6229. Result:=ConvertPrimitiveExpression(TPrimitiveExpr(El),AContext)
  6230. else if (El.ClassType=TBoolConstExpr) then
  6231. Result:=ConvertBoolConstExpression(TBoolConstExpr(El),AContext)
  6232. else if (El.ClassType=TNilExpr) then
  6233. Result:=ConvertNilExpr(TNilExpr(El),AContext)
  6234. else if (El.ClassType=TInheritedExpr) then
  6235. Result:=ConvertInheritedExpression(TInheritedExpr(El),AContext)
  6236. else if (El.ClassType=TSelfExpr) then
  6237. Result:=ConvertSelfExpression(TSelfExpr(El),AContext)
  6238. else if (El.ClassType=TParamsExpr) then
  6239. Result:=ConvertParamsExpression(TParamsExpr(El),AContext)
  6240. else if (El.ClassType=TRecordValues) then
  6241. Result:=ConvertRecordValues(TRecordValues(El),AContext)
  6242. else
  6243. RaiseNotSupported(El,AContext,20161024191314);
  6244. end;
  6245. function TPasToJSConverter.CreateBuiltInIdentifierExpr(AName: string
  6246. ): TJSPrimaryExpressionIdent;
  6247. var
  6248. Ident: TJSPrimaryExpressionIdent;
  6249. begin
  6250. if AName='' then
  6251. RaiseInconsistency(20170402230134);
  6252. Ident:=TJSPrimaryExpressionIdent.Create(0,0);
  6253. // do not lowercase
  6254. Ident.Name:=TJSString(AName);
  6255. Result:=Ident;
  6256. end;
  6257. function TPasToJSConverter.CreateTypeDecl(El: TPasType;
  6258. AContext: TConvertContext): TJSElement;
  6259. var
  6260. ElClass: TClass;
  6261. begin
  6262. Result:=Nil;
  6263. ElClass:=El.ClassType;
  6264. if ElClass=TPasClassType then
  6265. Result := ConvertClassType(TPasClassType(El), AContext)
  6266. else if (ElClass=TPasClassOfType) then
  6267. Result := ConvertClassOfType(TPasClassOfType(El), AContext)
  6268. else if ElClass=TPasRecordType then
  6269. Result := ConvertRecordType(TPasRecordType(El), AContext)
  6270. else if ElClass=TPasEnumType then
  6271. Result := ConvertEnumType(TPasEnumType(El), AContext)
  6272. else if (ElClass=TPasSetType) then
  6273. Result := ConvertSetType(TPasSetType(El), AContext)
  6274. else if (ElClass=TPasAliasType) then
  6275. else if (ElClass=TPasPointerType) then
  6276. Result:=ConvertPointerType(TPasPointerType(El),AContext)
  6277. else if (ElClass=TPasProcedureType)
  6278. or (ElClass=TPasFunctionType) then
  6279. Result:=ConvertProcedureType(TPasProcedureType(El),AContext)
  6280. else if (ElClass=TPasArrayType) then
  6281. Result:=ConvertArrayType(TPasArrayType(El),AContext)
  6282. else
  6283. begin
  6284. {$IFDEF VerbosePas2JS}
  6285. writeln('TPasToJSConverter.CreateTypeDecl El=',GetObjName(El));
  6286. {$ENDIF}
  6287. RaiseNotSupported(El,AContext,20170208144053);
  6288. end;
  6289. end;
  6290. function TPasToJSConverter.CreateVarDecl(El: TPasVariable;
  6291. AContext: TConvertContext): TJSElement;
  6292. Var
  6293. C : TJSElement;
  6294. V : TJSVariableStatement;
  6295. AssignSt: TJSSimpleAssignStatement;
  6296. Obj: TJSObjectLiteral;
  6297. ObjLit: TJSObjectLiteralElement;
  6298. begin
  6299. Result:=nil;
  6300. if vmExternal in El.VarModifiers then
  6301. begin
  6302. // external: do not add a declaration
  6303. exit;
  6304. end;
  6305. if AContext is TObjectContext then
  6306. begin
  6307. // create 'A: initvalue'
  6308. Obj:=TObjectContext(AContext).JSElement as TJSObjectLiteral;
  6309. ObjLit:=Obj.Elements.AddElement;
  6310. ObjLit.Name:=TJSString(TransformVariableName(El,AContext));
  6311. ObjLit.Expr:=CreateVarInit(El,AContext);
  6312. end
  6313. else if AContext.IsSingleton then
  6314. begin
  6315. // create 'this.A=initvalue'
  6316. AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
  6317. Result:=AssignSt;
  6318. AssignSt.LHS:=CreateDeclNameExpression(El,El.Name,AContext);
  6319. AssignSt.Expr:=CreateVarInit(El,AContext);
  6320. end
  6321. else
  6322. begin
  6323. // create 'var A=initvalue'
  6324. C:=ConvertVariable(El,AContext);
  6325. V:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
  6326. V.A:=C;
  6327. Result:=V;
  6328. end;
  6329. end;
  6330. function TPasToJSConverter.CreateSwitchStatement(El: TPasImplCaseOf;
  6331. AContext: TConvertContext): TJSElement;
  6332. var
  6333. SwitchEl: TJSSwitchStatement;
  6334. JSCaseEl: TJSCaseElement;
  6335. SubEl: TPasImplElement;
  6336. St: TPasImplCaseStatement;
  6337. ok: Boolean;
  6338. i, j: Integer;
  6339. BreakSt: TJSBreakStatement;
  6340. BodySt: TJSElement;
  6341. StList: TJSStatementList;
  6342. Expr: TPasExpr;
  6343. begin
  6344. Result:=nil;
  6345. SwitchEl:=TJSSwitchStatement(CreateElement(TJSSwitchStatement,El));
  6346. ok:=false;
  6347. try
  6348. SwitchEl.Cond:=ConvertExpression(El.CaseExpr,AContext);
  6349. for i:=0 to El.Elements.Count-1 do
  6350. begin
  6351. SubEl:=TPasImplElement(El.Elements[i]);
  6352. if not (SubEl is TPasImplCaseStatement) then
  6353. continue;
  6354. St:=TPasImplCaseStatement(SubEl);
  6355. JSCaseEl:=nil;
  6356. for j:=0 to St.Expressions.Count-1 do
  6357. begin
  6358. Expr:=TPasExpr(St.Expressions[j]);
  6359. JSCaseEl:=SwitchEl.Cases.AddCase;
  6360. JSCaseEl.Expr:=ConvertExpression(Expr,AContext);
  6361. end;
  6362. BodySt:=nil;
  6363. if St.Body<>nil then
  6364. BodySt:=ConvertElement(St.Body,AContext);
  6365. // add break
  6366. BreakSt:=TJSBreakStatement(CreateElement(TJSBreakStatement,St));
  6367. if BodySt=nil then
  6368. // no Pascal statement -> add only one 'break;'
  6369. BodySt:=BreakSt
  6370. else
  6371. begin
  6372. if (BodySt is TJSStatementList) then
  6373. begin
  6374. // list of statements -> append 'break;' to end
  6375. StList:=TJSStatementList(BodySt);
  6376. AddToStatementList(TJSStatementList(BodySt),StList,BreakSt,St);
  6377. end
  6378. else
  6379. begin
  6380. // single statement -> create list of old and 'break;'
  6381. StList:=TJSStatementList(CreateElement(TJSStatementList,St));
  6382. StList.A:=BodySt;
  6383. StList.B:=BreakSt;
  6384. BodySt:=StList;
  6385. end;
  6386. end;
  6387. JSCaseEl.Body:=BodySt;
  6388. end;
  6389. if El.ElseBranch<>nil then
  6390. begin
  6391. JSCaseEl:=SwitchEl.Cases.AddCase;
  6392. JSCaseEl.Body:=ConvertImplBlockElements(El.ElseBranch,AContext,false);
  6393. SwitchEl.TheDefault:=JSCaseEl;
  6394. end;
  6395. ok:=true;
  6396. finally
  6397. if not ok then
  6398. SwitchEl.Free;
  6399. end;
  6400. Result:=SwitchEl;
  6401. end;
  6402. function TPasToJSConverter.ConvertDeclarations(El: TPasDeclarations;
  6403. AContext: TConvertContext): TJSElement;
  6404. Var
  6405. E : TJSElement;
  6406. SLFirst, SLLast: TJSStatementList;
  6407. P: TPasElement;
  6408. IsProcBody, IsFunction, IsAssembler: boolean;
  6409. I : Integer;
  6410. PasProc: TPasProcedure;
  6411. ProcScope: TPasProcedureScope;
  6412. ProcBody: TPasImplBlock;
  6413. Procedure Add(NewEl: TJSElement);
  6414. begin
  6415. if AContext is TObjectContext then
  6416. begin
  6417. // NewEl is already added
  6418. end
  6419. else
  6420. begin
  6421. AddToStatementList(SLFirst,SLLast,NewEl,El);
  6422. ConvertDeclarations:=SLFirst;
  6423. end;
  6424. end;
  6425. Procedure AddFunctionResultInit;
  6426. var
  6427. VarSt: TJSVariableStatement;
  6428. PasFun: TPasFunction;
  6429. FunType: TPasFunctionType;
  6430. ResultEl: TPasResultElement;
  6431. begin
  6432. PasFun:=El.Parent as TPasFunction;
  6433. FunType:=PasFun.FuncType;
  6434. ResultEl:=FunType.ResultEl;
  6435. // add 'var result=initvalue'
  6436. VarSt:=CreateVarStatement(ResolverResultVar,CreateValInit(ResultEl.ResultType,nil,El,aContext),El);
  6437. Add(VarSt);
  6438. Result:=SLFirst;
  6439. end;
  6440. Procedure AddFunctionResultReturn;
  6441. var
  6442. RetSt: TJSReturnStatement;
  6443. begin
  6444. RetSt:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
  6445. RetSt.Expr:=CreateBuiltInIdentifierExpr(ResolverResultVar);
  6446. Add(RetSt);
  6447. end;
  6448. begin
  6449. Result:=nil;
  6450. {
  6451. TPasDeclarations = class(TPasElement)
  6452. TPasSection = class(TPasDeclarations)
  6453. TInterfaceSection = class(TPasSection)
  6454. TImplementationSection = class(TPasSection)
  6455. TProgramSection = class(TImplementationSection)
  6456. TLibrarySection = class(TImplementationSection)
  6457. TProcedureBody = class(TPasDeclarations)
  6458. }
  6459. SLFirst:=nil;
  6460. SLLast:=nil;
  6461. IsProcBody:=(El is TProcedureBody) and (TProcedureBody(El).Body<>nil);
  6462. IsFunction:=IsProcBody and (El.Parent is TPasFunction);
  6463. IsAssembler:=IsProcBody and (TProcedureBody(El).Body is TPasImplAsmStatement);
  6464. if IsFunction and not IsAssembler then
  6465. AddFunctionResultInit;
  6466. For I:=0 to El.Declarations.Count-1 do
  6467. begin
  6468. P:=TPasElement(El.Declarations[i]);
  6469. {$IFDEF VerbosePas2JS}
  6470. //writeln('TPasToJSConverter.ConvertDeclarations El[',i,']=',GetObjName(P));
  6471. {$ENDIF}
  6472. if not IsElementUsed(P) then continue;
  6473. E:=Nil;
  6474. if P.ClassType=TPasConst then
  6475. E:=ConvertConst(TPasConst(P),aContext) // can be nil
  6476. else if P.ClassType=TPasVariable then
  6477. E:=CreateVarDecl(TPasVariable(P),aContext) // can be nil
  6478. else if P is TPasType then
  6479. E:=CreateTypeDecl(TPasType(P),aContext) // can be nil
  6480. else if P is TPasProcedure then
  6481. begin
  6482. PasProc:=TPasProcedure(P);
  6483. if PasProc.IsForward then continue; // JavaScript does not need the forward
  6484. ProcScope:=TPasProcedureScope(PasProc.CustomData);
  6485. if (ProcScope.DeclarationProc<>nil)
  6486. and (not ProcScope.DeclarationProc.IsForward) then
  6487. continue; // this proc was already converted in interface or class
  6488. if ProcScope.DeclarationProc<>nil then
  6489. PasProc:=ProcScope.DeclarationProc;
  6490. E:=ConvertProcedure(PasProc,aContext);
  6491. end
  6492. else
  6493. RaiseNotSupported(P as TPasElement,AContext,20161024191434);
  6494. Add(E);
  6495. end;
  6496. if IsProcBody then
  6497. begin
  6498. ProcBody:=TProcedureBody(El).Body;
  6499. if (ProcBody.Elements.Count>0) or IsAssembler then
  6500. begin
  6501. E:=ConvertElement(TProcedureBody(El).Body,aContext);
  6502. Add(E);
  6503. end;
  6504. end;
  6505. if IsFunction and not IsAssembler then
  6506. AddFunctionResultReturn;
  6507. end;
  6508. function TPasToJSConverter.ConvertClassType(El: TPasClassType;
  6509. AContext: TConvertContext): TJSElement;
  6510. (*
  6511. type
  6512. TMyClass = class(Ancestor)
  6513. i: longint;
  6514. end;
  6515. rtl.createClass(this,"TMyClass",Ancestor,function(){
  6516. this.i = 0;
  6517. });
  6518. *)
  6519. type
  6520. TMemberFunc = (mfInit, mfFinalize);
  6521. const
  6522. MemberFuncName: array[TMemberFunc] of string = (
  6523. '$init',
  6524. '$final'
  6525. );
  6526. var
  6527. IsTObject, AncestorIsExternal: boolean;
  6528. function IsMemberNeeded(aMember: TPasElement): boolean;
  6529. begin
  6530. if IsElementUsed(aMember) then exit(true);
  6531. if IsTObject then
  6532. begin
  6533. if aMember is TPasProcedure then
  6534. begin
  6535. if (CompareText(aMember.Name,'AfterConstruction')=0)
  6536. or (CompareText(aMember.Name,'BeforeDestruction')=0) then
  6537. exit(true);
  6538. end;
  6539. end;
  6540. Result:=false;
  6541. end;
  6542. procedure AddCallAncestorMemberFunction(ClassContext: TConvertContext;
  6543. Ancestor: TPasType; Src: TJSSourceElements; Kind: TMemberFunc);
  6544. var
  6545. Call: TJSCallExpression;
  6546. AncestorPath: String;
  6547. begin
  6548. if (Ancestor=nil) or AncestorIsExternal then
  6549. exit;
  6550. Call:=CreateCallExpression(El);
  6551. AncestorPath:=CreateReferencePath(Ancestor,ClassContext,rpkPathAndName);
  6552. Call.Expr:=CreateBuiltInIdentifierExpr(AncestorPath+'.'+MemberFuncName[Kind]+'.call');
  6553. Call.AddArg(CreateBuiltInIdentifierExpr('this'));
  6554. AddToSourceElements(Src,Call);
  6555. end;
  6556. procedure AddInstanceMemberFunction(Src: TJSSourceElements;
  6557. ClassContext: TConvertContext; Ancestor: TPasType; Kind: TMemberFunc);
  6558. // add instance initialization function:
  6559. // this.$init = function(){
  6560. // ancestor.$init();
  6561. // ... init variables ...
  6562. // }
  6563. // or add instance finalization function:
  6564. // this.$final = function(){
  6565. // ... clear references ...
  6566. // ancestor.$final();
  6567. // }
  6568. var
  6569. FuncVD: TJSVarDeclaration;
  6570. New_Src: TJSSourceElements;
  6571. New_FuncContext: TFunctionContext;
  6572. I: Integer;
  6573. P: TPasElement;
  6574. NewEl: TJSElement;
  6575. Func: TJSFunctionDeclarationStatement;
  6576. VarType: TPasType;
  6577. AssignSt: TJSSimpleAssignStatement;
  6578. begin
  6579. // add instance members
  6580. New_Src:=TJSSourceElements(CreateElement(TJSSourceElements, El));
  6581. New_FuncContext:=TFunctionContext.Create(El,New_Src,ClassContext);
  6582. try
  6583. New_FuncContext.This:=El;
  6584. New_FuncContext.IsSingleton:=true;
  6585. // add class members
  6586. For I:=0 to El.Members.Count-1 do
  6587. begin
  6588. P:=TPasElement(El.Members[i]);
  6589. if not IsMemberNeeded(P) then continue;
  6590. NewEl:=nil;
  6591. if (P.ClassType=TPasVariable)
  6592. and (ClassVarModifiersType*TPasVariable(P).VarModifiers=[]) then
  6593. begin
  6594. if Kind=mfInit then
  6595. // mfInit: init var
  6596. NewEl:=CreateVarDecl(TPasVariable(P),New_FuncContext) // can be nil
  6597. else
  6598. begin
  6599. // mfFinalize: clear reference
  6600. if vmExternal in TPasVariable(P).VarModifiers then continue;
  6601. VarType:=ClassContext.Resolver.ResolveAliasType(TPasVariable(P).VarType);
  6602. if (VarType.ClassType=TPasRecordType)
  6603. or (VarType.ClassType=TPasClassType)
  6604. or (VarType.ClassType=TPasClassOfType)
  6605. or (VarType.ClassType=TPasSetType)
  6606. or (VarType.ClassType=TPasProcedureType)
  6607. or (VarType.ClassType=TPasFunctionType)
  6608. or (VarType.ClassType=TPasArrayType) then
  6609. begin
  6610. AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
  6611. NewEl:=AssignSt;
  6612. AssignSt.LHS:=CreateDeclNameExpression(P,P.Name,New_FuncContext);
  6613. AssignSt.Expr:=CreateLiteralUndefined(El);
  6614. end;
  6615. end;
  6616. end;
  6617. if NewEl=nil then continue;
  6618. if (Kind=mfInit) and (New_Src.Statements.Count=0) then
  6619. // add call ancestor.$init.call(this)
  6620. AddCallAncestorMemberFunction(ClassContext,Ancestor,New_Src,Kind);
  6621. AddToSourceElements(New_Src,NewEl);
  6622. end;
  6623. if (Kind=mfFinalize) and (New_Src.Statements.Count>0) then
  6624. // call ancestor.$final.call(this)
  6625. AddCallAncestorMemberFunction(ClassContext,Ancestor,New_Src,Kind);
  6626. if (Ancestor<>nil) and (not AncestorIsExternal)
  6627. and (New_Src.Statements.Count=0) then
  6628. exit; // descendent does not need $init/$final
  6629. FuncVD:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El));
  6630. AddToSourceElements(Src,FuncVD);
  6631. FuncVD.Name:='this.'+MemberFuncName[Kind];
  6632. Func:=CreateFunction(El);
  6633. FuncVD.Init:=Func;
  6634. Func.AFunction.Body.A:=New_Src;
  6635. New_Src:=nil;
  6636. finally
  6637. New_Src.Free;
  6638. New_FuncContext.Free;
  6639. end;
  6640. end;
  6641. procedure AddRTTI(Src: TJSSourceElements; FuncContext: TConvertContext);
  6642. var
  6643. HasRTTIMembers: Boolean;
  6644. i: Integer;
  6645. P: TPasElement;
  6646. NewEl: TJSElement;
  6647. VarSt: TJSVariableStatement;
  6648. begin
  6649. HasRTTIMembers:=false;
  6650. For i:=0 to El.Members.Count-1 do
  6651. begin
  6652. P:=TPasElement(El.Members[i]);
  6653. //writeln('TPasToJSConverter.ConvertClassType RTTI El[',i,']=',GetObjName(P));
  6654. if P.Visibility<>visPublished then continue;
  6655. if not IsMemberNeeded(P) then continue;
  6656. NewEl:=nil;
  6657. if P.ClassType=TPasVariable then
  6658. NewEl:=CreateRTTIClassField(TPasVariable(P),FuncContext)
  6659. else if P.InheritsFrom(TPasProcedure) then
  6660. NewEl:=CreateRTTIClassMethod(TPasProcedure(P),FuncContext)
  6661. else if P.ClassType=TPasProperty then
  6662. NewEl:=CreateRTTIClassProperty(TPasProperty(P),FuncContext)
  6663. else if P.InheritsFrom(TPasType) then
  6664. continue
  6665. else
  6666. DoError(20170409202315,nSymbolCannotBePublished,sSymbolCannotBePublished,[],P);
  6667. if NewEl=nil then
  6668. continue; // e.g. abstract or external proc
  6669. // add RTTI element
  6670. if not HasRTTIMembers then
  6671. begin
  6672. // add "var $r = this.$rtti"
  6673. VarSt:=CreateVarStatement(FBuiltInNames[pbivnRTTILocal],
  6674. CreateMemberExpression(['this',FBuiltInNames[pbivnRTTI]]),El);
  6675. AddToSourceElements(Src,VarSt);
  6676. HasRTTIMembers:=true;
  6677. end;
  6678. AddToSourceElements(Src,NewEl);
  6679. end;
  6680. end;
  6681. var
  6682. Call: TJSCallExpression;
  6683. FunDecl: TJSFunctionDeclarationStatement;
  6684. Src: TJSSourceElements;
  6685. ArgEx: TJSLiteral;
  6686. FuncContext: TFunctionContext;
  6687. i: Integer;
  6688. NewEl: TJSElement;
  6689. P: TPasElement;
  6690. Scope: TPas2JSClassScope;
  6691. Ancestor: TPasType;
  6692. AncestorPath: String;
  6693. C: TClass;
  6694. begin
  6695. Result:=nil;
  6696. if El.IsForward then
  6697. begin
  6698. Result:=ConvertClassForwardType(El,AContext);
  6699. exit;
  6700. end;
  6701. if El.IsExternal then exit;
  6702. if El.CustomData is TPas2JSClassScope then
  6703. Scope:=TPas2JSClassScope(El.CustomData)
  6704. else
  6705. Scope:=nil;
  6706. IsTObject:=CompareText(El.Name,'TObject')=0;
  6707. if (Scope<>nil) and (Scope.AncestorScope<>nil) then
  6708. Ancestor:=Scope.AncestorScope.Element as TPasType
  6709. else
  6710. Ancestor:=El.AncestorType;
  6711. // create call 'rtl.createClass('
  6712. FuncContext:=nil;
  6713. Call:=CreateCallExpression(El);
  6714. try
  6715. AncestorIsExternal:=(Ancestor is TPasClassType) and TPasClassType(Ancestor).IsExternal;
  6716. if AncestorIsExternal then
  6717. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnCreateClassExt]])
  6718. else
  6719. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnCreateClass]]);
  6720. // add parameter: owner. 'this' for top level class.
  6721. Call.AddArg(CreateBuiltInIdentifierExpr('this'));
  6722. // add parameter: string constant '"classname"'
  6723. ArgEx := CreateLiteralString(El,TransformVariableName(El,AContext));
  6724. Call.AddArg(ArgEx);
  6725. // add parameter: ancestor
  6726. if Ancestor=nil then
  6727. AncestorPath:='null'
  6728. else if AncestorIsExternal then
  6729. AncestorPath:=TPasClassType(Ancestor).ExternalName
  6730. else
  6731. AncestorPath:=CreateReferencePath(Ancestor,AContext,rpkPathAndName);
  6732. Call.AddArg(CreateBuiltInIdentifierExpr(AncestorPath));
  6733. if AncestorIsExternal then
  6734. begin
  6735. // add the name of the NewInstance function
  6736. if Scope.NewInstanceFunction<>nil then
  6737. Call.AddArg(CreateLiteralString(
  6738. Scope.NewInstanceFunction,Scope.NewInstanceFunction.Name))
  6739. else
  6740. Call.AddArg(CreateLiteralString(El,''));
  6741. end;
  6742. // add parameter: class initialize function 'function(){...}'
  6743. FunDecl:=CreateFunction(El,true,true);
  6744. Call.AddArg(FunDecl);
  6745. Src:=TJSSourceElements(FunDecl.AFunction.Body.A);
  6746. // add members
  6747. FuncContext:=TFunctionContext.Create(El,Src,AContext);
  6748. FuncContext.IsSingleton:=true;
  6749. FuncContext.This:=El;
  6750. // add class members: types and class vars
  6751. For i:=0 to El.Members.Count-1 do
  6752. begin
  6753. P:=TPasElement(El.Members[i]);
  6754. //writeln('TPasToJSConverter.ConvertClassType class vars El[',i,']=',GetObjName(P));
  6755. if not IsMemberNeeded(P) then continue;
  6756. C:=P.ClassType;
  6757. NewEl:=nil;
  6758. if C=TPasVariable then
  6759. begin
  6760. if ClassVarModifiersType*TPasVariable(P).VarModifiers<>[] then
  6761. begin
  6762. NewEl:=CreateVarDecl(TPasVariable(P),FuncContext); // can be nil
  6763. if NewEl=nil then continue;
  6764. end
  6765. else
  6766. continue;
  6767. end
  6768. else if C=TPasConst then
  6769. NewEl:=ConvertConst(TPasConst(P),aContext)
  6770. else if C=TPasProperty then
  6771. begin
  6772. NewEl:=ConvertProperty(TPasProperty(P),AContext);
  6773. if NewEl=nil then continue;
  6774. end
  6775. else if C.InheritsFrom(TPasType) then
  6776. NewEl:=CreateTypeDecl(TPasType(P),aContext)
  6777. else if C.InheritsFrom(TPasProcedure) then
  6778. continue
  6779. else
  6780. RaiseNotSupported(P,FuncContext,20161221233338);
  6781. if NewEl=nil then
  6782. RaiseNotSupported(P,FuncContext,20170204223922);
  6783. AddToSourceElements(Src,NewEl);
  6784. end;
  6785. // instance initialization function
  6786. AddInstanceMemberFunction(Src,FuncContext,Ancestor,mfInit);
  6787. // instance finalization function
  6788. AddInstanceMemberFunction(Src,FuncContext,Ancestor,mfFinalize);
  6789. // add methods
  6790. For i:=0 to El.Members.Count-1 do
  6791. begin
  6792. P:=TPasElement(El.Members[i]);
  6793. //writeln('TPasToJSConverter.ConvertClassType methods El[',i,']=',GetObjName(P));
  6794. if not IsMemberNeeded(P) then continue;
  6795. if P is TPasProcedure then
  6796. NewEl:=ConvertProcedure(TPasProcedure(P),FuncContext)
  6797. else
  6798. continue;
  6799. if NewEl=nil then
  6800. continue; // e.g. abstract or external proc
  6801. AddToSourceElements(Src,NewEl);
  6802. end;
  6803. // add RTTI init function
  6804. if AContext.Resolver<>nil then
  6805. AddRTTI(Src,FuncContext);
  6806. Result:=Call;
  6807. finally
  6808. FuncContext.Free;
  6809. if Result<>Call then
  6810. Call.Free;
  6811. end;
  6812. end;
  6813. function TPasToJSConverter.ConvertClassForwardType(El: TPasClassType;
  6814. AContext: TConvertContext): TJSElement;
  6815. // module.$rtti.$Class("classname");
  6816. var
  6817. Ref: TResolvedReference;
  6818. aClass: TPasClassType;
  6819. ObjLit: TJSObjectLiteral;
  6820. begin
  6821. Result:=nil;
  6822. if (AContext.Resolver=nil) or not (El.CustomData is TResolvedReference) then exit;
  6823. Ref:=TResolvedReference(El.CustomData);
  6824. aClass:=Ref.Declaration as TPasClassType;
  6825. if not HasTypeInfo(aClass,AContext) then exit;
  6826. if IsClassRTTICreatedBefore(aClass,El) then exit;
  6827. // module.$rtti.$Class("classname");
  6828. Result:=CreateRTTINewType(aClass,FBuiltInNames[pbifnRTTINewClass],true,AContext,ObjLit);
  6829. if ObjLit<>nil then
  6830. RaiseInconsistency(20170412093427);
  6831. end;
  6832. function TPasToJSConverter.ConvertClassExternalType(El: TPasClassType;
  6833. AContext: TConvertContext): TJSElement;
  6834. function IsMemberNeeded(aMember: TPasElement): boolean;
  6835. begin
  6836. Result:=IsElementUsed(aMember);
  6837. end;
  6838. var
  6839. i: Integer;
  6840. P: TPasElement;
  6841. C: TClass;
  6842. Proc: TPasProcedure;
  6843. begin
  6844. Result:=nil;
  6845. if El.IsForward then exit;
  6846. // add class members: types and class vars
  6847. For i:=0 to El.Members.Count-1 do
  6848. begin
  6849. P:=TPasElement(El.Members[i]);
  6850. //writeln('TPasToJSConverter.ConvertClassExternalType class El[',i,']=',GetObjName(P));
  6851. if not IsMemberNeeded(P) then continue;
  6852. C:=P.ClassType;
  6853. if (C=TPasVariable) or (C=TPasConst) then
  6854. begin
  6855. if not (vmExternal in TPasVariable(P).VarModifiers) then
  6856. DoError(20170321150737,nMissingExternalName,sMissingExternalName,[],P);
  6857. end
  6858. else if C=TPasProperty then
  6859. // is replaced with Getter/Setter -> nothing to do here
  6860. else if C.InheritsFrom(TPasProcedure) then
  6861. begin
  6862. Proc:=TPasProcedure(P);
  6863. if Proc.IsExternal then
  6864. // external, nothing to do here
  6865. else
  6866. DoError(20170321152209,nMissingExternalName,sMissingExternalName,[],P);
  6867. end
  6868. else
  6869. RaiseNotSupported(P,AContext,20170321151727);
  6870. end;
  6871. end;
  6872. function TPasToJSConverter.ConvertClassOfType(El: TPasClassOfType;
  6873. AContext: TConvertContext): TJSElement;
  6874. // create
  6875. // module.$rtti.$ClassRef("typename",{
  6876. // instancetype: module.$rtti["classname"])
  6877. // }
  6878. // if class is defined later add a forward define for the class
  6879. var
  6880. ObjLit: TJSObjectLiteral;
  6881. Prop: TJSObjectLiteralElement;
  6882. Call: TJSCallExpression;
  6883. ok: Boolean;
  6884. List: TJSStatementList;
  6885. begin
  6886. Result:=nil;
  6887. if not HasTypeInfo(El,AContext) then exit;
  6888. ok:=false;
  6889. Call:=CreateRTTINewType(El,FBuiltInNames[pbifnRTTINewClassRef],false,AContext,ObjLit);
  6890. Result:=Call;
  6891. try
  6892. Prop:=ObjLit.Elements.AddElement;
  6893. Prop.Name:=TJSString(FBuiltInNames[pbivnRTTIClassRef_InstanceType]);
  6894. Prop.Expr:=CreateTypeInfoRef(El.DestType,AContext,El);
  6895. if not IsClassRTTICreatedBefore(El.DestType as TPasClassType,El) then
  6896. begin
  6897. // class rtti must be forward registered
  6898. if not (AContext is TFunctionContext) then
  6899. RaiseNotSupported(El,AContext,20170412102916);
  6900. // prepend module.$rtti.$Class("classname");
  6901. Call:=CreateRTTINewType(El.DestType,FBuiltInNames[pbifnRTTINewClass],true,AContext,ObjLit);
  6902. if ObjLit<>nil then
  6903. RaiseInconsistency(20170412102654);
  6904. List:=TJSStatementList(CreateElement(TJSStatementList,El));
  6905. List.A:=Call;
  6906. List.B:=Result;
  6907. Result:=List;
  6908. end;
  6909. ok:=true;
  6910. finally
  6911. if not ok then
  6912. FreeAndNil(Result);
  6913. end;
  6914. end;
  6915. function TPasToJSConverter.ConvertEnumType(El: TPasEnumType;
  6916. AContext: TConvertContext): TJSElement;
  6917. // TMyEnum = (red, green)
  6918. // convert to
  6919. // this.TMyEnum = {
  6920. // "0":"red",
  6921. // "red":0,
  6922. // "0":"green",
  6923. // "green":0,
  6924. // };
  6925. // module.$rtti.$TIEnum("TMyEnum",{
  6926. // enumtype: this.TMyEnum,
  6927. // minvalue: 0,
  6928. // maxvalue: 1
  6929. // });
  6930. var
  6931. ObjectContect: TObjectContext;
  6932. i: Integer;
  6933. EnumValue: TPasEnumValue;
  6934. ParentObj, Obj, TIObj: TJSObjectLiteral;
  6935. ObjLit, TIProp: TJSObjectLiteralElement;
  6936. AssignSt: TJSSimpleAssignStatement;
  6937. JSName: TJSString;
  6938. Call: TJSCallExpression;
  6939. List: TJSStatementList;
  6940. ok: Boolean;
  6941. begin
  6942. Result:=nil;
  6943. for i:=0 to El.Values.Count-1 do
  6944. begin
  6945. EnumValue:=TPasEnumValue(El.Values[i]);
  6946. if EnumValue.Value<>nil then
  6947. RaiseNotSupported(EnumValue.Value,AContext,20170208145221,'enum constant');
  6948. end;
  6949. ok:=false;
  6950. ObjectContect:=nil;
  6951. try
  6952. Obj:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El));
  6953. if AContext is TObjectContext then
  6954. begin
  6955. // add 'TypeName: function(){}'
  6956. ParentObj:=TObjectContext(AContext).JSElement as TJSObjectLiteral;
  6957. ObjLit:=ParentObj.Elements.AddElement;
  6958. ObjLit.Name:=TJSString(TransformVariableName(El,AContext));
  6959. ObjLit.Expr:=Obj;
  6960. Result:=Obj;
  6961. end
  6962. else
  6963. begin
  6964. // add 'this.TypeName = function(){}'
  6965. AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
  6966. AssignSt.LHS:=CreateDeclNameExpression(El,El.Name,AContext);
  6967. AssignSt.Expr:=Obj;
  6968. Result:=AssignSt;
  6969. end;
  6970. ObjectContect:=TObjectContext.Create(El,Obj,AContext);
  6971. for i:=0 to El.Values.Count-1 do
  6972. begin
  6973. EnumValue:=TPasEnumValue(El.Values[i]);
  6974. JSName:=TJSString(TransformVariableName(EnumValue,AContext));
  6975. // add "0":"value"
  6976. ObjLit:=Obj.Elements.AddElement;
  6977. ObjLit.Name:=TJSString(IntToStr(i));
  6978. ObjLit.Expr:=CreateLiteralJSString(El,JSName);
  6979. // add value:0
  6980. ObjLit:=Obj.Elements.AddElement;
  6981. ObjLit.Name:=JSName;
  6982. ObjLit.Expr:=CreateLiteralNumber(El,i);
  6983. end;
  6984. if HasTypeInfo(El,AContext) then
  6985. begin
  6986. // create typeinfo
  6987. if not (AContext is TFunctionContext) then
  6988. RaiseNotSupported(El,AContext,20170411210045,'typeinfo');
  6989. // create statement list
  6990. List:=TJSStatementList(CreateElement(TJSStatementList,El));
  6991. List.A:=Result;
  6992. Result:=List;
  6993. // module.$rtti.$TIEnum("TMyEnum",{...});
  6994. Call:=CreateRTTINewType(El,FBuiltInNames[pbifnRTTINewEnum],false,AContext,TIObj);
  6995. List.B:=Call;
  6996. // add minvalue: number
  6997. TIProp:=TIObj.Elements.AddElement;
  6998. TIProp.Name:=TJSString(FBuiltInNames[pbivnRTTIInt_MinValue]);
  6999. TIProp.Expr:=CreateLiteralNumber(El,0);
  7000. // add maxvalue: number
  7001. TIProp:=TIObj.Elements.AddElement;
  7002. TIProp.Name:=TJSString(FBuiltInNames[pbivnRTTIInt_MaxValue]);
  7003. TIProp.Expr:=CreateLiteralNumber(El,El.Values.Count-1);
  7004. // add enumtype: this.TypeName
  7005. TIProp:=TIObj.Elements.AddElement;
  7006. TIProp.Name:=TJSString(FBuiltInNames[pbivnRTTIEnum_EnumType]);
  7007. TIProp.Expr:=CreateDeclNameExpression(El,El.Name,AContext);
  7008. end;
  7009. ok:=true;
  7010. finally
  7011. ObjectContect.Free;
  7012. if not ok then
  7013. FreeAndNil(Result);
  7014. end;
  7015. end;
  7016. function TPasToJSConverter.ConvertSetType(El: TPasSetType;
  7017. AContext: TConvertContext): TJSElement;
  7018. // create
  7019. // module.$rtti.$Set("name",{
  7020. // comptype: module.$rtti["enumtype"]
  7021. // })
  7022. var
  7023. Obj: TJSObjectLiteral;
  7024. Call: TJSCallExpression;
  7025. Prop: TJSObjectLiteralElement;
  7026. begin
  7027. Result:=nil;
  7028. if El.IsPacked then
  7029. DoError(20170222231613,nPasElementNotSupported,sPasElementNotSupported,
  7030. ['packed'],El);
  7031. if not HasTypeInfo(El,AContext) then exit;
  7032. // module.$rtti.$Set("name",{...})
  7033. Call:=CreateRTTINewType(El,FBuiltInNames[pbifnRTTINewSet],false,AContext,Obj);
  7034. try
  7035. // "comptype: ref"
  7036. Prop:=Obj.Elements.AddElement;
  7037. Prop.Name:=TJSString(FBuiltInNames[pbivnRTTISet_CompType]);
  7038. Prop.Expr:=CreateTypeInfoRef(El.EnumType,AContext,El);
  7039. Result:=Call;
  7040. finally
  7041. if Result=nil then
  7042. Call.Free;
  7043. end;
  7044. end;
  7045. function TPasToJSConverter.ConvertPointerType(El: TPasPointerType;
  7046. AContext: TConvertContext): TJSElement;
  7047. // create
  7048. // module.$rtti.$Set("name",{
  7049. // reftype: module.$rtti["reftype"]
  7050. // })
  7051. var
  7052. Obj: TJSObjectLiteral;
  7053. Call: TJSCallExpression;
  7054. Prop: TJSObjectLiteralElement;
  7055. begin
  7056. Result:=nil;
  7057. if not HasTypeInfo(El,AContext) then exit;
  7058. // module.$rtti.$Pointer("name",{...})
  7059. Call:=CreateRTTINewType(El,FBuiltInNames[pbifnRTTINewPointer],false,AContext,Obj);
  7060. try
  7061. // "reftype: ref"
  7062. Prop:=Obj.Elements.AddElement;
  7063. Prop.Name:=TJSString(FBuiltInNames[pbivnRTTISet_CompType]);
  7064. Prop.Expr:=CreateTypeInfoRef(El.DestType,AContext,El);
  7065. Result:=Call;
  7066. finally
  7067. if Result=nil then
  7068. Call.Free;
  7069. end;
  7070. end;
  7071. function TPasToJSConverter.ConvertProcedureType(El: TPasProcedureType;
  7072. AContext: TConvertContext): TJSElement;
  7073. // create
  7074. // module.$rtti.$ProcVar("name",{
  7075. // procsig: rtl.newTIProcSignature([[arg1name,arg1type,arg1flags],[arg2name...],...],resulttype,flags)
  7076. // })
  7077. // module.$rtti.$MethodVar("name",{
  7078. // procsig: rtl.newTIProcSignature([[arg1name,arg1type,arg1flags],[arg2name...],...],resulttype,flags),
  7079. // methodkind: 1
  7080. // })
  7081. var
  7082. Call, InnerCall: TJSCallExpression;
  7083. FunName: String;
  7084. ResultEl: TPasResultElement;
  7085. ResultTypeInfo: TJSElement;
  7086. Flags: Integer;
  7087. MethodKind: TMethodKind;
  7088. Obj: TJSObjectLiteral;
  7089. Prop: TJSObjectLiteralElement;
  7090. begin
  7091. Result:=nil;
  7092. if El.IsNested then
  7093. DoError(20170222231636,nPasElementNotSupported,sPasElementNotSupported,
  7094. ['is nested'],El);
  7095. if El.CallingConvention<>ccDefault then
  7096. DoError(20170222231532,nPasElementNotSupported,sPasElementNotSupported,
  7097. ['calling convention '+cCallingConventions[El.CallingConvention]],El);
  7098. if not HasTypeInfo(El,AContext) then exit;
  7099. // module.$rtti.$ProcVar("name",function(){})
  7100. if El.IsOfObject then
  7101. FunName:=FBuiltInNames[pbifnRTTINewMethodVar]
  7102. else
  7103. FunName:=FBuiltInNames[pbifnRTTINewProcVar];
  7104. Call:=CreateRTTINewType(El,FunName,false,AContext,Obj);
  7105. try
  7106. // add "procsig: rtl.newTIProcSignature()"
  7107. Prop:=Obj.Elements.AddElement;
  7108. Prop.Name:=TJSString(FBuiltInNames[pbivnRTTIProcVar_ProcSig]);
  7109. InnerCall:=CreateCallExpression(El);
  7110. Prop.Expr:=InnerCall;
  7111. InnerCall.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnRTTINewProcSig]]);
  7112. // add array of arguments
  7113. InnerCall.AddArg(CreateRTTIArgList(El,El.Args,AContext));
  7114. // add resulttype as typeinfo reference
  7115. if El is TPasFunctionType then
  7116. begin
  7117. ResultEl:=TPasFunctionType(El).ResultEl;
  7118. ResultTypeInfo:=CreateTypeInfoRef(ResultEl.ResultType,AContext,ResultEl);
  7119. if ResultTypeInfo<>nil then
  7120. InnerCall.AddArg(ResultTypeInfo);
  7121. end;
  7122. // add param flags
  7123. Flags:=0;
  7124. if ptmVarargs in El.Modifiers then
  7125. inc(Flags,pfVarargs);
  7126. if Flags>0 then
  7127. InnerCall.AddArg(CreateLiteralNumber(El,Flags));
  7128. if El.IsOfObject then
  7129. begin
  7130. // add "methodkind: number;"
  7131. Prop:=Obj.Elements.AddElement;
  7132. Prop.Name:=TJSString(FBuiltInNames[pbivnRTTIMethodKind]);
  7133. if El.ClassType=TPasProcedureType then
  7134. MethodKind:=mkProcedure
  7135. else if El.ClassType=TPasFunctionType then
  7136. MethodKind:=mkFunction
  7137. else
  7138. RaiseNotSupported(El,AContext,20170411180848);
  7139. Prop.Expr:=CreateLiteralNumber(El,ord(MethodKind));
  7140. end;
  7141. Result:=Call;
  7142. finally
  7143. if Result=nil then
  7144. Call.Free;
  7145. end;
  7146. end;
  7147. function TPasToJSConverter.ConvertArrayType(El: TPasArrayType;
  7148. AContext: TConvertContext): TJSElement;
  7149. // Create
  7150. // module.$rtti.$StaticArray("name",{
  7151. // dims: [dimsize1,dimsize2,...],
  7152. // eltype: module.$rtti["ElTypeName"]
  7153. // };
  7154. // module.$rtti.$DynArray("name",{
  7155. // eltype: module.$rtti["ElTypeName"]
  7156. // };
  7157. var
  7158. CallName: String;
  7159. Obj: TJSObjectLiteral;
  7160. Prop: TJSObjectLiteralElement;
  7161. ArrLit: TJSArrayLiteral;
  7162. Arr: TPasArrayType;
  7163. Index: Integer;
  7164. RangeResolved: TPasResolverResult;
  7165. ElType: TPasType;
  7166. RangeEl: TPasExpr;
  7167. aMinValue, aMaxValue: int64;
  7168. Call: TJSCallExpression;
  7169. begin
  7170. Result:=nil;
  7171. if El.PackMode<>pmNone then
  7172. DoError(20170222231648,nPasElementNotSupported,sPasElementNotSupported,
  7173. ['packed'],El);
  7174. {$IFDEF VerbosePas2JS}
  7175. writeln('TPasToJSConverter.ConvertArrayType ',GetObjName(El));
  7176. {$ENDIF}
  7177. if not HasTypeInfo(El,AContext) then exit;
  7178. writeln('AAA1 TPasToJSConverter.ConvertArrayType ');
  7179. // module.$rtti.$DynArray("name",{...})
  7180. if length(El.Ranges)>0 then
  7181. CallName:=FBuiltInNames[pbifnRTTINewStaticArray]
  7182. else
  7183. CallName:=FBuiltInNames[pbifnRTTINewDynArray];
  7184. Call:=CreateRTTINewType(El,CallName,false,AContext,Obj);
  7185. try
  7186. ElType:=El.ElType;
  7187. if length(El.Ranges)>0 then
  7188. begin
  7189. // dims: [dimsize1,dimsize2,...]
  7190. Prop:=Obj.Elements.AddElement;
  7191. Prop.Name:=TJSString(FBuiltInNames[pbivnRTTIArray_Dims]);
  7192. ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
  7193. Prop.Expr:=ArrLit;
  7194. Arr:=El;
  7195. Index:=0;
  7196. repeat
  7197. RangeEl:=Arr.Ranges[Index];
  7198. AContext.Resolver.ComputeElement(RangeEl,RangeResolved,[rcType]);
  7199. ComputeRange(RangeResolved,aMinValue,aMaxValue,RangeEl);
  7200. ArrLit.AddElement(CreateLiteralNumber(RangeEl,aMaxValue-aMinValue+1));
  7201. inc(Index);
  7202. if Index=length(Arr.Ranges) then
  7203. begin
  7204. if ElType.ClassType<>TPasArrayType then
  7205. break;
  7206. Arr:=TPasArrayType(ElType);
  7207. if length(Arr.Ranges)=0 then
  7208. RaiseNotSupported(Arr,AContext,20170411222315,'static array of anonymous array');
  7209. ElType:=Arr.ElType;
  7210. Index:=0;
  7211. end;
  7212. until false;
  7213. end;
  7214. // eltype: ref
  7215. Prop:=Obj.Elements.AddElement;
  7216. Prop.Name:=TJSString(FBuiltInNames[pbivnRTTIArray_ElType]);
  7217. Prop.Expr:=CreateTypeInfoRef(ElType,AContext,El);
  7218. Result:=Call;
  7219. finally
  7220. if Result=nil then
  7221. Call.Free;
  7222. end;
  7223. end;
  7224. procedure TPasToJSConverter.ForLoop_OnProcBodyElement(El: TPasElement;
  7225. arg: pointer);
  7226. // Called by ConvertForStatement on each element of the current proc body
  7227. // Check each element that lies behind the loop if it is reads the LoopVar
  7228. var
  7229. Data: PForLoopFindData absolute arg;
  7230. begin
  7231. if El.HasParent(Data^.ForLoop) then
  7232. Data^.FoundLoop:=true
  7233. else if Data^.FoundLoop and (not Data^.LoopVarWrite) and (not Data^.LoopVarRead) then
  7234. begin
  7235. // El comes after loop and LoopVar was not yet accessed
  7236. if (El.CustomData is TResolvedReference)
  7237. and (TResolvedReference(El.CustomData).Declaration=Data^.LoopVar) then
  7238. begin
  7239. // El refers the LoopVar
  7240. // ToDo: check write only access
  7241. Data^.LoopVarRead:=true;
  7242. end;
  7243. end;
  7244. end;
  7245. procedure TPasToJSConverter.TryExcept_OnElement(El: TPasElement; arg: pointer);
  7246. var
  7247. Data: PTryExceptFindData absolute arg;
  7248. begin
  7249. if (El is TPasImplRaise) and (TPasImplRaise(El).ExceptObject=nil) then
  7250. Data^.HasRaiseWithoutObject:=true;
  7251. end;
  7252. procedure TPasToJSConverter.SetUseEnumNumbers(const AValue: boolean);
  7253. begin
  7254. if AValue then
  7255. Include(FOptions,coEnumNumbers)
  7256. else
  7257. Exclude(FOptions,coEnumNumbers);
  7258. end;
  7259. procedure TPasToJSConverter.SetUseLowerCase(const AValue: boolean);
  7260. begin
  7261. if AValue then
  7262. Include(FOptions,coLowerCase)
  7263. else
  7264. Exclude(FOptions,coLowerCase);
  7265. end;
  7266. procedure TPasToJSConverter.SetUseSwitchStatement(const AValue: boolean);
  7267. begin
  7268. if AValue then
  7269. Include(FOptions,coSwitchStatement)
  7270. else
  7271. Exclude(FOptions,coSwitchStatement);
  7272. end;
  7273. constructor TPasToJSConverter.Create;
  7274. var
  7275. n: TPas2JSBuiltInName;
  7276. begin
  7277. FOptions:=[coLowerCase];
  7278. for n in TPas2JSBuiltInName do
  7279. FBuiltInNames[n]:=Pas2JSBuiltInNames[n];
  7280. end;
  7281. destructor TPasToJSConverter.Destroy;
  7282. begin
  7283. inherited Destroy;
  7284. end;
  7285. function TPasToJSConverter.ConvertProcedure(El: TPasProcedure;
  7286. AContext: TConvertContext): TJSElement;
  7287. Var
  7288. FS : TJSFunctionDeclarationStatement;
  7289. FD : TJSFuncDef;
  7290. n:Integer;
  7291. AssignSt: TJSSimpleAssignStatement;
  7292. FuncContext: TFunctionContext;
  7293. ProcScope: TPasProcedureScope;
  7294. Arg: TPasArgument;
  7295. ImplProc: TPasProcedure;
  7296. begin
  7297. Result:=nil;
  7298. if El.IsAbstract then exit;
  7299. if El.IsExternal then exit;
  7300. ProcScope:=TPasProcedureScope(El.CustomData);
  7301. if ProcScope.DeclarationProc<>nil then
  7302. exit;
  7303. {$IFDEF VerbosePas2JS}
  7304. writeln('TPasToJSConverter.ConvertProcedure "',El.Name,'" ',El.Parent.ClassName);
  7305. {$ENDIF}
  7306. ImplProc:=El;
  7307. if ProcScope.ImplProc<>nil then
  7308. ImplProc:=ProcScope.ImplProc;
  7309. AssignSt:=nil;
  7310. if AContext.IsSingleton then
  7311. begin
  7312. AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
  7313. Result:=AssignSt;
  7314. AssignSt.LHS:=CreateDeclNameExpression(El,El.Name,AContext);
  7315. end;
  7316. FS:=CreateFunction(El,ImplProc.Body<>nil);
  7317. FD:=FS.AFunction;
  7318. if AssignSt<>nil then
  7319. AssignSt.Expr:=FS
  7320. else
  7321. begin
  7322. // local/nested function
  7323. Result:=FS;
  7324. FD.Name:=TJSString(TransformVariableName(El,AContext));
  7325. end;
  7326. for n := 0 to El.ProcType.Args.Count - 1 do
  7327. begin
  7328. Arg:=TPasArgument(El.ProcType.Args[n]);
  7329. FD.Params.Add(TransformVariableName(Arg,AContext));
  7330. end;
  7331. if ImplProc.Body<>nil then
  7332. begin
  7333. FuncContext:=TFunctionContext.Create(ImplProc,FD.Body,AContext);
  7334. try
  7335. if ProcScope.ClassScope<>nil then
  7336. FuncContext.This:=ProcScope.ClassScope.Element
  7337. else
  7338. FuncContext.This:=AContext.GetThis;
  7339. FD.Body.A:=ConvertDeclarations(ImplProc.Body,FuncContext);
  7340. finally
  7341. FuncContext.Free;
  7342. end;
  7343. end;
  7344. {
  7345. TPasProcedureBase = class(TPasElement)
  7346. TPasOverloadedProc = class(TPasProcedureBase)
  7347. TPasProcedure = class(TPasProcedureBase)
  7348. TPasFunction = class(TPasProcedure)
  7349. TPasOperator = class(TPasProcedure)
  7350. TPasConstructor = class(TPasProcedure)
  7351. TPasDestructor = class(TPasProcedure)
  7352. TPasClassProcedure = class(TPasProcedure)
  7353. TPasClassFunction = class(TPasProcedure)
  7354. }
  7355. end;
  7356. function TPasToJSConverter.ConvertBeginEndStatement(El: TPasImplBeginBlock;
  7357. AContext: TConvertContext; NilIfEmpty: boolean): TJSElement;
  7358. begin
  7359. Result:=ConvertImplBlockElements(El,AContext,NilIfEmpty);
  7360. end;
  7361. function TPasToJSConverter.ConvertImplBlockElements(El: TPasImplBlock;
  7362. AContext: TConvertContext; NilIfEmpty: boolean): TJSElement;
  7363. var
  7364. First, Last: TJSStatementList;
  7365. I : Integer;
  7366. PasImpl: TPasImplElement;
  7367. JSImpl : TJSElement;
  7368. begin
  7369. if Not (Assigned(El.Elements) and (El.Elements.Count>0)) then
  7370. begin
  7371. if NilIfEmpty then
  7372. Result:=nil
  7373. else
  7374. Result:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El));
  7375. end
  7376. else
  7377. begin
  7378. First:=nil;
  7379. Result:=First;
  7380. Last:=First;
  7381. //writeln('TPasToJSConverter.ConvertImplBlockElements START El.Elements.Count=',El.Elements.Count);
  7382. For I:=0 to El.Elements.Count-1 do
  7383. begin
  7384. PasImpl:=TPasImplElement(El.Elements[i]);
  7385. JSImpl:=ConvertElement(PasImpl,AContext);
  7386. if JSImpl=nil then
  7387. continue; // e.g. "inherited;" when there is no ancestor proc
  7388. //writeln('TPasToJSConverter.ConvertImplBlockElements ',i,' ',JSImpl.ClassName);
  7389. AddToStatementList(First,Last,JSImpl,PasImpl);
  7390. Result:=First;
  7391. end;
  7392. end;
  7393. end;
  7394. function TPasToJSConverter.ConvertInitializationSection(
  7395. El: TInitializationSection; AContext: TConvertContext): TJSElement;
  7396. var
  7397. FDS: TJSFunctionDeclarationStatement;
  7398. FunName: String;
  7399. IsMain, ok: Boolean;
  7400. AssignSt: TJSSimpleAssignStatement;
  7401. FuncContext: TFunctionContext;
  7402. Body: TJSFunctionBody;
  7403. begin
  7404. // create: 'this.$init=function(){}'
  7405. IsMain:=(El.Parent<>nil) and (El.Parent is TPasProgram);
  7406. if IsMain then
  7407. FunName:=FBuiltInNames[pbifnProgramMain]
  7408. else
  7409. FunName:=FBuiltInNames[pbifnUnitInit];
  7410. AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
  7411. Result:=AssignSt;
  7412. FuncContext:=nil;
  7413. ok:=false;
  7414. try
  7415. AssignSt.LHS:=CreateMemberExpression(['this',FunName]);
  7416. FDS:=CreateFunction(El,El.Elements.Count>0);
  7417. AssignSt.Expr:=FDS;
  7418. if El.Elements.Count>0 then
  7419. begin
  7420. Body:=FDS.AFunction.Body;
  7421. FuncContext:=TFunctionContext.Create(El,Body,AContext);
  7422. FuncContext.This:=AContext.GetThis;
  7423. Body.A:=ConvertImplBlockElements(El,FuncContext,false);
  7424. end;
  7425. ok:=true;
  7426. finally
  7427. FuncContext.Free;
  7428. if not ok then FreeAndNil(Result);
  7429. end;
  7430. end;
  7431. function TPasToJSConverter.ConvertFinalizationSection(El: TFinalizationSection;
  7432. AContext: TConvertContext): TJSElement;
  7433. begin
  7434. Result:=nil;
  7435. RaiseNotSupported(El,AContext,20161024192519);
  7436. end;
  7437. function TPasToJSConverter.ConvertTryStatement(El: TPasImplTry;
  7438. AContext: TConvertContext): TJSElement;
  7439. function NeedExceptObject: boolean;
  7440. var
  7441. Data: TTryExceptFindData;
  7442. begin
  7443. Result:=false;
  7444. if El.FinallyExcept.Elements.Count=0 then exit;
  7445. if TPasElement(El.FinallyExcept.Elements[0]) is TPasImplExceptOn then
  7446. exit(true);
  7447. Data:=Default(TTryExceptFindData);
  7448. El.FinallyExcept.ForEachCall(@TryExcept_OnElement,@Data);
  7449. Result:=Data.HasRaiseWithoutObject;
  7450. end;
  7451. Var
  7452. T : TJSTryStatement;
  7453. ExceptBlock: TPasImplTryHandler;
  7454. i: Integer;
  7455. ExceptOn: TPasImplExceptOn;
  7456. IfSt, Last: TJSIfStatement;
  7457. begin
  7458. Result:=nil;
  7459. T:=nil;
  7460. try
  7461. if El.FinallyExcept is TPasImplTryFinally then
  7462. begin
  7463. T:=TJSTryFinallyStatement(CreateElement(TJSTryFinallyStatement,El));
  7464. T.Block:=ConvertImplBlockElements(El,AContext,true);
  7465. T.BFinally:=ConvertImplBlockElements(El.FinallyExcept,AContext,true);
  7466. end
  7467. else
  7468. begin
  7469. T:=TJSTryCatchStatement(CreateElement(TJSTryCatchStatement,El));
  7470. T.Block:=ConvertImplBlockElements(El,AContext,true);
  7471. if NeedExceptObject then
  7472. T.Ident:=TJSString(FBuiltInNames[pbivnExceptObject]);
  7473. //T.BCatch:=ConvertElement(El.FinallyExcept,AContext);
  7474. ExceptBlock:=El.FinallyExcept;
  7475. if (ExceptBlock.Elements.Count>0)
  7476. and (TPasImplElement(ExceptBlock.Elements[0]) is TPasImplExceptOn) then
  7477. begin
  7478. Last:=nil;
  7479. for i:=0 to ExceptBlock.Elements.Count-1 do
  7480. begin
  7481. ExceptOn:=TObject(ExceptBlock.Elements[i]) as TPasImplExceptOn;
  7482. IfSt:=ConvertExceptOn(ExceptOn,AContext) as TJSIfStatement;
  7483. if Last=nil then
  7484. T.BCatch:=IfSt
  7485. else
  7486. Last.BFalse:=IfSt;
  7487. Last:=IfSt;
  7488. end;
  7489. if El.ElseBranch<>nil then
  7490. Last.BFalse:=ConvertImplBlockElements(El.ElseBranch,AContext,true)
  7491. else
  7492. begin
  7493. // default else: throw exceptobject
  7494. Last.BFalse:=TJSThrowStatement(CreateElement(TJSThrowStatement,El));
  7495. TJSThrowStatement(Last.BFalse).A:=
  7496. CreateBuiltInIdentifierExpr(FBuiltInNames[pbivnExceptObject]);
  7497. end;
  7498. end
  7499. else
  7500. begin
  7501. if El.ElseBranch<>nil then
  7502. RaiseNotSupported(El.ElseBranch,AContext,20170205003014);
  7503. T.BCatch:=ConvertImplBlockElements(ExceptBlock,AContext,true);
  7504. end;
  7505. end;
  7506. Result:=T;
  7507. finally
  7508. if Result=nil then
  7509. T.Free;
  7510. end;
  7511. end;
  7512. function TPasToJSConverter.ConvertCaseOfStatement(El: TPasImplCaseOf;
  7513. AContext: TConvertContext): TJSElement;
  7514. var
  7515. SubEl: TPasImplElement;
  7516. St: TPasImplCaseStatement;
  7517. ok: Boolean;
  7518. i, j: Integer;
  7519. JSExpr: TJSElement;
  7520. StList: TJSStatementList;
  7521. Expr: TPasExpr;
  7522. IfSt, LastIfSt: TJSIfStatement;
  7523. TmpVarName: String;
  7524. VarDecl: TJSVarDeclaration;
  7525. VarSt: TJSVariableStatement;
  7526. JSOrExpr: TJSLogicalOrExpression;
  7527. JSAndExpr: TJSLogicalAndExpression;
  7528. JSLEExpr: TJSRelationalExpressionLE;
  7529. JSGEExpr: TJSRelationalExpressionGE;
  7530. JSEQExpr: TJSEqualityExpressionEQ;
  7531. begin
  7532. Result:=nil;
  7533. if UseSwitchStatement then
  7534. begin
  7535. // convert to switch statement
  7536. // switch does not support ranges -> check
  7537. ok:=true;
  7538. for i:=0 to El.Elements.Count-1 do
  7539. begin
  7540. SubEl:=TPasImplElement(El.Elements[i]);
  7541. if not (SubEl is TPasImplCaseStatement) then
  7542. continue;
  7543. St:=TPasImplCaseStatement(SubEl);
  7544. for j:=0 to St.Expressions.Count-1 do
  7545. begin
  7546. Expr:=TPasExpr(St.Expressions[j]);
  7547. if (Expr is TBinaryExpr) and (TBinaryExpr(Expr).Kind=pekRange) then
  7548. begin
  7549. ok:=false;
  7550. break;
  7551. end;
  7552. end;
  7553. if not ok then break;
  7554. end;
  7555. if ok then
  7556. begin
  7557. Result:=CreateSwitchStatement(El,AContext);
  7558. exit;
  7559. end;
  7560. end;
  7561. // convert to if statements
  7562. StList:=TJSStatementList(CreateElement(TJSStatementList,El));
  7563. ok:=false;
  7564. try
  7565. // create var $tmp=CaseExpr;
  7566. TmpVarName:=AContext.CreateLocalIdentifier('$tmp');
  7567. VarSt:=TJSVariableStatement(CreateElement(TJSVariableStatement,El.CaseExpr));
  7568. StList.A:=VarSt;
  7569. VarDecl:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El.CaseExpr));
  7570. VarSt.A:=VarDecl;
  7571. VarDecl.Name:=TmpVarName;
  7572. VarDecl.Init:=ConvertExpression(El.CaseExpr,AContext);
  7573. LastIfSt:=nil;
  7574. for i:=0 to El.Elements.Count-1 do
  7575. begin
  7576. SubEl:=TPasImplElement(El.Elements[i]);
  7577. if SubEl is TPasImplCaseStatement then
  7578. begin
  7579. St:=TPasImplCaseStatement(SubEl);
  7580. // create for example "if (tmp==expr) || ((tmp>=expr) && (tmp<=expr)){}"
  7581. IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,SubEl));
  7582. if LastIfSt=nil then
  7583. StList.B:=IfSt
  7584. else
  7585. LastIfSt.BFalse:=IfSt;
  7586. LastIfSt:=IfSt;
  7587. for j:=0 to St.Expressions.Count-1 do
  7588. begin
  7589. Expr:=TPasExpr(St.Expressions[j]);
  7590. if (Expr is TBinaryExpr) and (TBinaryExpr(Expr).Kind=pekRange) then
  7591. begin
  7592. // range -> create "(tmp>=left) && (tmp<=right)"
  7593. // create "() && ()"
  7594. JSAndExpr:=TJSLogicalAndExpression(CreateElement(TJSLogicalAndExpression,Expr));
  7595. JSExpr:=JSAndExpr;
  7596. // create "tmp>=left"
  7597. JSGEExpr:=TJSRelationalExpressionGE(CreateElement(TJSRelationalExpressionGE,Expr));
  7598. JSAndExpr.A:=JSGEExpr;
  7599. JSGEExpr.A:=CreateIdentifierExpr(TmpVarName,El.CaseExpr,AContext);
  7600. JSGEExpr.B:=ConvertExpression(TBinaryExpr(Expr).left,AContext);
  7601. // create "tmp<=right"
  7602. JSLEExpr:=TJSRelationalExpressionLE(CreateElement(TJSRelationalExpressionLE,Expr));
  7603. JSAndExpr.B:=JSLEExpr;
  7604. JSLEExpr.A:=CreateIdentifierExpr(TmpVarName,El.CaseExpr,AContext);
  7605. JSLEExpr.B:=ConvertExpression(TBinaryExpr(Expr).right,AContext);
  7606. end
  7607. else
  7608. begin
  7609. // value -> create (tmp==Expr)
  7610. JSEQExpr:=TJSEqualityExpressionEQ(CreateElement(TJSEqualityExpressionEQ,Expr));
  7611. JSExpr:=JSEQExpr;
  7612. JSEQExpr.A:=CreateIdentifierExpr(TmpVarName,El.CaseExpr,AContext);
  7613. JSEQExpr.B:=ConvertExpression(Expr,AContext);
  7614. end;
  7615. if IfSt.Cond=nil then
  7616. // first expression
  7617. IfSt.Cond:=JSExpr
  7618. else
  7619. begin
  7620. // multi expression -> append with OR
  7621. JSOrExpr:=TJSLogicalOrExpression(CreateElement(TJSLogicalOrExpression,St));
  7622. JSOrExpr.A:=IfSt.Cond;
  7623. JSOrExpr.B:=JSExpr;
  7624. IfSt.Cond:=JSOrExpr;
  7625. end;
  7626. end;
  7627. // convert statement
  7628. if St.Body<>nil then
  7629. IfSt.BTrue:=ConvertElement(St.Body,AContext)
  7630. else
  7631. IfSt.BTrue:=TJSEmptyStatement(CreateElement(TJSEmptyStatement,St));
  7632. end
  7633. else if SubEl is TPasImplCaseElse then
  7634. begin
  7635. // Pascal 'else' or 'otherwise' -> create JS "else{}"
  7636. if LastIfSt=nil then
  7637. RaiseNotSupported(SubEl,AContext,20161128120802,'case-of needs at least one case');
  7638. LastIfSt.BFalse:=ConvertImplBlockElements(El.ElseBranch,AContext,true);
  7639. end
  7640. else
  7641. RaiseNotSupported(SubEl,AContext,20161128113055);
  7642. end;
  7643. ok:=true;
  7644. finally
  7645. if not ok then
  7646. StList.Free;
  7647. end;
  7648. Result:=StList;
  7649. end;
  7650. function TPasToJSConverter.ConvertAsmStatement(El: TPasImplAsmStatement;
  7651. AContext: TConvertContext): TJSElement;
  7652. var
  7653. s: String;
  7654. L: TJSLiteral;
  7655. begin
  7656. if AContext=nil then ;
  7657. s:=Trim(El.Tokens.Text);
  7658. if (s<>'') and (s[length(s)]=';') then
  7659. Delete(s,length(s),1);
  7660. if s='' then
  7661. Result:=TJSEmptyStatement(CreateElement(TJSEmptyStatement,El))
  7662. else begin
  7663. L:=TJSLiteral(CreateElement(TJSLiteral,El));
  7664. L.Value.CustomValue:=TJSString(s);
  7665. Result:=L;
  7666. end;
  7667. end;
  7668. function TPasToJSConverter.CreateImplementationSection(El: TPasModule;
  7669. AContext: TConvertContext
  7670. ): TJSFunctionDeclarationStatement;
  7671. var
  7672. Src: TJSSourceElements;
  7673. ImplContext: TSectionContext;
  7674. ImplDecl: TJSElement;
  7675. ImplVarSt: TJSVariableStatement;
  7676. FunDecl: TJSFunctionDeclarationStatement;
  7677. begin
  7678. Result:=nil;
  7679. // create function(){}
  7680. FunDecl:=CreateFunction(El,true,true);
  7681. Src:=TJSSourceElements(FunDecl.AFunction.Body.A);
  7682. // create section context (a function)
  7683. ImplContext:=TSectionContext.Create(El,Src,AContext);
  7684. try
  7685. if coUseStrict in Options then
  7686. AddToSourceElements(Src,CreateLiteralString(El,'use strict'));
  7687. // add var $impl = this.$impl
  7688. ImplVarSt:=CreateVarStatement(FBuiltInNames[pbivnImplementation],
  7689. CreateMemberExpression(['this',FBuiltInNames[pbivnImplementation]]),El);
  7690. AddToSourceElements(Src,ImplVarSt);
  7691. ImplContext.This:=El;
  7692. // create implementation declarations
  7693. ImplDecl:=ConvertDeclarations(El.ImplementationSection,ImplContext);
  7694. if ImplDecl=nil then
  7695. exit;
  7696. // add impl declarations
  7697. AddToSourceElements(Src,ImplDecl);
  7698. Result:=FunDecl;
  7699. finally
  7700. ImplContext.Free;
  7701. if Result=nil then
  7702. FunDecl.Free;
  7703. end;
  7704. end;
  7705. procedure TPasToJSConverter.CreateInitSection(El: TPasModule;
  7706. Src: TJSSourceElements; AContext: TConvertContext);
  7707. begin
  7708. // add initialization section
  7709. if Assigned(El.InitializationSection) then
  7710. AddToSourceElements(Src,ConvertInitializationSection(El.InitializationSection,AContext));
  7711. // finalization: not supported
  7712. if Assigned(El.FinalizationSection) then
  7713. raise Exception.Create('TPasToJSConverter.ConvertInitializationSection: finalization section is not supported');
  7714. end;
  7715. function TPasToJSConverter.CreateDotExpression(aParent: TPasElement; Left,
  7716. Right: TJSElement): TJSElement;
  7717. var
  7718. Dot: TJSDotMemberExpression;
  7719. RightParent: TJSElement;
  7720. ok: Boolean;
  7721. begin
  7722. Result:=nil;
  7723. if Left=nil then
  7724. RaiseInconsistency(20170201140827);
  7725. if Right=nil then
  7726. RaiseInconsistency(20170211192018);
  7727. ok:=false;
  7728. try
  7729. // create a TJSDotMemberExpression of Left and the left-most identifier of Right
  7730. // Left becomes the new left-most element of Right.
  7731. Result:=Right;
  7732. RightParent:=nil;
  7733. repeat
  7734. if (Right.ClassType=TJSCallExpression) then
  7735. begin
  7736. RightParent:=Right;
  7737. Right:=TJSCallExpression(Right).Expr;
  7738. if Right=nil then
  7739. begin
  7740. // left-most is nil -> insert Left
  7741. TJSCallExpression(RightParent).Expr:=Left;
  7742. ok:=true;
  7743. exit;
  7744. end;
  7745. end
  7746. else if (Right.ClassType=TJSBracketMemberExpression) then
  7747. begin
  7748. RightParent:=Right;
  7749. Right:=TJSBracketMemberExpression(Right).MExpr;
  7750. if Right=nil then
  7751. begin
  7752. // left-most is nil -> insert Left
  7753. TJSBracketMemberExpression(RightParent).MExpr:=Left;
  7754. ok:=true;
  7755. exit;
  7756. end;
  7757. end
  7758. else if (Right.ClassType=TJSDotMemberExpression) then
  7759. begin
  7760. RightParent:=Right;
  7761. Right:=TJSDotMemberExpression(Right).MExpr;
  7762. if Right=nil then
  7763. begin
  7764. // left-most is nil -> insert Left
  7765. TJSDotMemberExpression(RightParent).MExpr:=Left;
  7766. ok:=true;
  7767. exit;
  7768. end;
  7769. end
  7770. else if (Right.ClassType=TJSPrimaryExpressionIdent) then
  7771. begin
  7772. // left-most identifier found
  7773. // -> replace it
  7774. Dot := TJSDotMemberExpression(CreateElement(TJSDotMemberExpression, aParent));
  7775. if Result=Right then
  7776. Result:=Dot
  7777. else if RightParent is TJSBracketMemberExpression then
  7778. TJSBracketMemberExpression(RightParent).MExpr:=Dot
  7779. else if RightParent is TJSCallExpression then
  7780. TJSCallExpression(RightParent).Expr:=Dot
  7781. else if RightParent is TJSDotMemberExpression then
  7782. TJSDotMemberExpression(RightParent).MExpr:=Dot
  7783. else
  7784. begin
  7785. Dot.Free;
  7786. {$IFDEF VerbosePas2JS}
  7787. writeln('TPasToJSConverter.CreateDotExpression Right=',GetObjName(Right),' RightParent=',GetObjName(RightParent),' Result=',GetObjName(Result));
  7788. {$ENDIF}
  7789. RaiseInconsistency(20170129141307);
  7790. end;
  7791. Dot.MExpr := Left;
  7792. Dot.Name := TJSPrimaryExpressionIdent(Right).Name;
  7793. FreeAndNil(Right);
  7794. break;
  7795. end
  7796. else
  7797. begin
  7798. {$IFDEF VerbosePas2JS}
  7799. writeln('CreateDotExpression Right=',Right.ClassName);
  7800. {$ENDIF}
  7801. DoError(20161024191240,nMemberExprMustBeIdentifier,sMemberExprMustBeIdentifier,[],aParent);
  7802. end;
  7803. until false;
  7804. ok:=true;
  7805. finally
  7806. if not ok then
  7807. begin
  7808. Left.Free;
  7809. FreeAndNil(Result);
  7810. end;
  7811. end;
  7812. end;
  7813. function TPasToJSConverter.CreateReferencedSet(El: TPasElement; SetExpr: TJSElement
  7814. ): TJSElement;
  7815. var
  7816. Call: TJSCallExpression;
  7817. begin
  7818. Call:=CreateCallExpression(El);
  7819. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSet_Reference]]);
  7820. Call.AddArg(SetExpr);
  7821. Result:=Call;
  7822. end;
  7823. function TPasToJSConverter.CreateCloneRecord(El: TPasElement;
  7824. ResolvedEl: TPasResolverResult; RecordExpr: TJSElement;
  7825. AContext: TConvertContext): TJSElement;
  7826. // create "new RecordType(RecordExpr)
  7827. var
  7828. NewExpr: TJSNewMemberExpression;
  7829. begin
  7830. if not (ResolvedEl.TypeEl is TPasRecordType) then
  7831. RaiseInconsistency(20170212155956);
  7832. NewExpr:=TJSNewMemberExpression(CreateElement(TJSNewMemberExpression,El));
  7833. NewExpr.MExpr:=CreateReferencePathExpr(ResolvedEl.TypeEl,AContext);
  7834. NewExpr.Args:=TJSArguments(CreateElement(TJSArguments,El));
  7835. NewExpr.AddArg(RecordExpr);
  7836. Result:=NewExpr;
  7837. end;
  7838. function TPasToJSConverter.CreateCallback(El: TPasElement;
  7839. ResolvedEl: TPasResolverResult; AContext: TConvertContext): TJSElement;
  7840. var
  7841. Call: TJSCallExpression;
  7842. Scope: TJSElement;
  7843. DotExpr: TJSDotMemberExpression;
  7844. Prim: TJSPrimaryExpressionIdent;
  7845. aName: String;
  7846. DotPos: SizeInt;
  7847. FunName: String;
  7848. begin
  7849. // create "rtl.createCallback(scope,func)"
  7850. Result:=nil;
  7851. if not (ResolvedEl.IdentEl is TPasProcedure) then
  7852. RaiseInconsistency(20170215140756);
  7853. Call:=nil;
  7854. Scope:=nil;
  7855. try
  7856. Call:=CreateCallExpression(El);
  7857. // "rtl.createCallback"
  7858. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnProcType_Create]]);
  7859. // add parameters
  7860. Scope:=ConvertElement(El,AContext);
  7861. {$IFDEF VerbosePas2JS}
  7862. writeln('TPasToJSConverter.CreateCallback ',GetObjName(Scope));
  7863. {$ENDIF}
  7864. FunName:='';
  7865. // the last element of Scope is the proc, chomp that off
  7866. if Scope.ClassType=TJSDotMemberExpression then
  7867. begin
  7868. // chomp dot member -> rtl.createCallback(scope,"FunName")
  7869. DotExpr:=TJSDotMemberExpression(Scope);
  7870. FunName:=String(DotExpr.Name);
  7871. DotPos:=PosLast('.',FunName);
  7872. if DotPos>0 then
  7873. begin
  7874. // e.g. path dot $class.funname
  7875. // keep DotExpr, chomp funname
  7876. DotExpr.Name:=TJSString(LeftStr(FunName,DotPos-1));
  7877. FunName:=copy(FunName,DotPos+1);
  7878. if not IsValidJSIdentifier(DotExpr.Name) then
  7879. begin
  7880. {$IFDEF VerbosePas2JS}
  7881. writeln('TPasToJSConverter.CreateCallback ',GetObjName(Scope),' DotExpr.Name="',DotExpr.Name,'"');
  7882. {$ENDIF}
  7883. DoError(20170215161802,nInvalidFunctionReference,sInvalidFunctionReference,[],El);
  7884. end;
  7885. end
  7886. else
  7887. begin
  7888. // e.g. path dot funname
  7889. // delete DotExpr
  7890. Scope:=DotExpr.MExpr;
  7891. DotExpr.MExpr:=nil;
  7892. FreeAndNil(DotExpr);
  7893. end;
  7894. if not IsValidJSIdentifier(TJSString(FunName)) then
  7895. begin
  7896. {$IFDEF VerbosePas2JS}
  7897. writeln('TPasToJSConverter.CreateCallback ',GetObjName(Scope),' FunName="',FunName,'"');
  7898. {$ENDIF}
  7899. DoError(20170215161802,nInvalidFunctionReference,sInvalidFunctionReference,[],El);
  7900. end;
  7901. Call.AddArg(Scope);
  7902. // add function name as parameter
  7903. Call.AddArg(CreateLiteralString(El,FunName));
  7904. end
  7905. else if Scope.ClassType=TJSPrimaryExpressionIdent then
  7906. begin
  7907. Prim:=TJSPrimaryExpressionIdent(Scope);
  7908. aName:=String(Prim.Name);
  7909. DotPos:=PosLast('.',aName);
  7910. if DotPos>0 then
  7911. begin
  7912. // chomp dotted identifier -> rtl.createCallback(scope,"FunName")
  7913. FunName:=copy(aName,DotPos+1);
  7914. Prim.Name:=TJSString(LeftStr(aName,DotPos-1));
  7915. Call.AddArg(Prim);
  7916. // add function name as parameter
  7917. Call.AddArg(CreateLiteralString(El,FunName));
  7918. end
  7919. else
  7920. begin
  7921. // nested proc -> rtl.createCallback(this,FunName)
  7922. FunName:=aName;
  7923. Prim.Name:='this';
  7924. Call.AddArg(Prim);
  7925. // add function as parameter
  7926. Call.AddArg(CreateBuiltInIdentifierExpr(FunName));
  7927. end;
  7928. end
  7929. else
  7930. begin
  7931. {$IFDEF VerbosePas2JS}
  7932. writeln('TPasToJSConverter.CreateCallback invalid Scope=',GetObjName(Scope));
  7933. {$ENDIF}
  7934. RaiseNotSupported(El,AContext,20170215161210);
  7935. end;
  7936. Result:=Call;
  7937. finally
  7938. if Result=nil then
  7939. begin
  7940. Scope.Free;
  7941. Call.Free;
  7942. end;
  7943. end;
  7944. end;
  7945. function TPasToJSConverter.CreateAssignStatement(LeftEl: TPasElement;
  7946. AssignContext: TAssignContext): TJSElement;
  7947. var
  7948. LHS: TJSElement;
  7949. AssignSt: TJSSimpleAssignStatement;
  7950. begin
  7951. Result:=nil;
  7952. LHS:=ConvertElement(LeftEl,AssignContext);
  7953. if AssignContext.Call<>nil then
  7954. begin
  7955. // has a setter -> right side was already added as parameter
  7956. if AssignContext.RightSide<>nil then
  7957. begin
  7958. LHS.Free;
  7959. RaiseInconsistency(20170207215447);
  7960. end;
  7961. Result:=LHS;
  7962. end
  7963. else
  7964. begin
  7965. AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,AssignContext.PasElement));
  7966. AssignSt.LHS:=LHS;
  7967. AssignSt.Expr:=AssignContext.RightSide;
  7968. AssignContext.RightSide:=nil;
  7969. Result:=AssignSt;
  7970. end;
  7971. end;
  7972. function TPasToJSConverter.CreateTypeInfoRef(El: TPasType;
  7973. AContext: TConvertContext; ErrorEl: TPasElement): TJSElement;
  7974. var
  7975. C: TClass;
  7976. aName, aModName: String;
  7977. bt: TResolverBaseType;
  7978. jbt: TPas2jsBaseType;
  7979. Parent: TPasElement;
  7980. aModule: TPasModule;
  7981. Bracket: TJSBracketMemberExpression;
  7982. begin
  7983. El:=AContext.Resolver.ResolveAliasType(El);
  7984. if El=nil then
  7985. RaiseInconsistency(20170409172756);
  7986. if El=AContext.PasElement then
  7987. begin
  7988. // refering itself
  7989. if El is TPasClassType then
  7990. begin
  7991. // use this
  7992. Result:=CreateBuiltInIdentifierExpr(FBuiltInNames[pbivnRTTILocal]);
  7993. exit;
  7994. end
  7995. else
  7996. RaiseNotSupported(ErrorEl,AContext,20170409195518,'cannot typeinfo itself');
  7997. end;
  7998. if El.Name='' then
  7999. RaiseNotSupported(El,AContext,20170412125911,'typeinfo of anonymous '+El.ElementTypeName);
  8000. C:=El.ClassType;
  8001. if C=TPasUnresolvedSymbolRef then
  8002. begin
  8003. if El.CustomData is TResElDataBaseType then
  8004. begin
  8005. bt:=TResElDataBaseType(El.CustomData).BaseType;
  8006. case bt of
  8007. btLongint,btCardinal,btSmallInt,btWord,btShortInt,btByte,
  8008. btString,btChar,
  8009. btDouble,
  8010. btBoolean,
  8011. btPointer:
  8012. begin
  8013. // create rtl.basename
  8014. Result:=CreateMemberExpression([FBuiltInNames[pbivnRTL],lowercase(BaseTypeNames[bt])]);
  8015. exit;
  8016. end;
  8017. btCustom:
  8018. if El.CustomData is TResElDataPas2JSBaseType then
  8019. begin
  8020. jbt:=TResElDataPas2JSBaseType(El.CustomData).JSBaseType;
  8021. case jbt of
  8022. pbtJSValue:
  8023. begin
  8024. // create rtl.basename
  8025. Result:=CreateMemberExpression([FBuiltInNames[pbivnRTL],lowercase(Pas2jsBaseTypeNames[jbt])]);
  8026. exit;
  8027. end;
  8028. else
  8029. {$IFDEF VerbosePas2JS}
  8030. writeln('TPasToJSConverter.CreateTypeInfoRef [20170409174539] El=',GetObjName(El),' El.CustomData=',GetObjName(El.CustomData),' jbt=',Pas2jsBaseTypeNames[jbt]);
  8031. {$ENDIF}
  8032. end;
  8033. end
  8034. else
  8035. begin
  8036. {$IFDEF VerbosePas2JS}
  8037. writeln('TPasToJSConverter.CreateTypeInfoRef [20170409174645] El=',GetObjName(El),' El.CustomData=',GetObjName(El.CustomData),' bt=',BaseTypeNames[bt]);
  8038. {$ENDIF}
  8039. end
  8040. else
  8041. {$IFDEF VerbosePas2JS}
  8042. writeln('TPasToJSConverter.CreateTypeInfoRef [20170409173746] El=',GetObjName(El),' El.CustomData=',GetObjName(El.CustomData),' bt=',BaseTypeNames[bt]);
  8043. {$ENDIF}
  8044. end;
  8045. end
  8046. else
  8047. begin
  8048. {$IFDEF VerbosePas2JS}
  8049. writeln('TPasToJSConverter.CreateTypeInfoRef [20170409173729] El=',GetObjName(El),' El.CustomData=',GetObjName(El.CustomData));
  8050. {$ENDIF}
  8051. end;
  8052. end
  8053. else if (C=TPasEnumType)
  8054. or (C=TPasSetType)
  8055. or (C=TPasClassType)
  8056. or (C=TPasClassOfType)
  8057. or (C=TPasArrayType)
  8058. or (C=TPasProcedureType)
  8059. or (C=TPasFunctionType)
  8060. or (C=TPasPointerType)
  8061. // ToDo or (C=TPasTypeAliasType)
  8062. or (C=TPasRecordType)
  8063. // ToDo or (C=TPasRangeType)
  8064. then
  8065. begin
  8066. // user type -> module.$rtti[typename]
  8067. aName:=TransformVariableName(El,AContext);
  8068. if aName='' then
  8069. DoError(20170411230435,nPasElementNotSupported,sPasElementNotSupported,
  8070. ['typeinfo of anonymous '+El.ElementTypeName+' not supported'],ErrorEl);
  8071. Parent:=El.Parent;
  8072. while Parent.ClassType=TPasClassType do
  8073. begin
  8074. aName:=TransformVariableName(Parent,AContext)+'.'+aName;
  8075. Parent:=Parent.Parent;
  8076. end;
  8077. if Parent is TPasSection then
  8078. begin
  8079. aModule:=Parent.Parent as TPasModule;
  8080. if AContext.GetThis=aModule then
  8081. aModName:='this'
  8082. else
  8083. aModName:=TransformModuleName(aModule,AContext);
  8084. Bracket:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
  8085. Bracket.MExpr:=CreateMemberExpression([aModName,FBuiltInNames[pbivnRTTI]]);
  8086. Bracket.Name:=CreateLiteralString(El,aName);
  8087. Result:=Bracket;
  8088. exit;
  8089. end;
  8090. end;
  8091. aName:=El.Name;
  8092. if aName='' then aName:=El.ClassName;
  8093. DoError(20170409173329,nTypeXCannotBePublished,sTypeXCannotBePublished,
  8094. [aName],ErrorEl);
  8095. end;
  8096. function TPasToJSConverter.CreateRTTIArgList(Parent: TPasElement;
  8097. Args: TFPList; AContext: TConvertContext): TJSElement;
  8098. var
  8099. Params: TJSArrayLiteral;
  8100. i: Integer;
  8101. begin
  8102. Result:=nil;
  8103. if Args.Count=0 then
  8104. Result:=CreateLiteralNull(Parent)
  8105. else
  8106. begin
  8107. try
  8108. Params:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,Parent));
  8109. for i:=0 to Args.Count-1 do
  8110. AddRTTIArgument(TPasArgument(Args[i]),Params,AContext);
  8111. Result:=Params;
  8112. finally
  8113. if Result=nil then
  8114. Params.Free;
  8115. end;
  8116. end;
  8117. end;
  8118. procedure TPasToJSConverter.AddRTTIArgument(Arg: TPasArgument;
  8119. TargetParams: TJSArrayLiteral; AContext: TConvertContext);
  8120. var
  8121. Param: TJSArrayLiteral;
  8122. ArgName: String;
  8123. Flags: Integer;
  8124. begin
  8125. // for each param add "["argname",argtype,flags]" Note: flags only if >0
  8126. Param:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,Arg));
  8127. TargetParams.Elements.AddElement.Expr:=Param;
  8128. // add "argname"
  8129. ArgName:=TransformVariableName(Arg,Arg.Name,AContext);
  8130. Param.Elements.AddElement.Expr:=CreateLiteralString(Arg,ArgName);
  8131. // add "argtype"
  8132. if Arg.ArgType=nil then
  8133. // untyped
  8134. Param.Elements.AddElement.Expr:=CreateLiteralNull(Arg)
  8135. else
  8136. Param.Elements.AddElement.Expr:=CreateTypeInfoRef(Arg.ArgType,AContext,Arg);
  8137. // add flags
  8138. Flags:=0;
  8139. case Arg.Access of
  8140. argDefault: ;
  8141. argConst: inc(Flags,pfConst);
  8142. argVar: inc(Flags,pfVar);
  8143. argOut: inc(Flags,pfOut);
  8144. else
  8145. RaiseNotSupported(Arg,AContext,20170409192127,AccessNames[Arg.Access]);
  8146. end;
  8147. if Flags>0 then
  8148. Param.Elements.AddElement.Expr:=CreateLiteralNumber(Arg,Flags);
  8149. end;
  8150. function TPasToJSConverter.CreateRTTINewType(El: TPasType;
  8151. const CallFuncName: string; IsForward: boolean; AContext: TConvertContext;
  8152. out ObjLit: TJSObjectLiteral): TJSCallExpression;
  8153. // module.$rtti.$TiSomething("name",{})
  8154. var
  8155. ThisContext: TFunctionContext;
  8156. RttiPath, TypeName: String;
  8157. Call: TJSCallExpression;
  8158. begin
  8159. Result:=nil;
  8160. ObjLit:=nil;
  8161. // get module path
  8162. ThisContext:=AContext.GetThisContext;
  8163. if ThisContext=nil then
  8164. RaiseInconsistency(20170411151517);
  8165. if ThisContext.This is TPasModule then
  8166. RttiPath:='this'
  8167. else
  8168. begin
  8169. RttiPath:=CallFuncName+'.'
  8170. +TransformModuleName(ThisContext.GetRootModule,AContext);
  8171. end;
  8172. Call:=CreateCallExpression(El);
  8173. try
  8174. // module.$rtti.$ProcVar
  8175. Call.Expr:=CreateMemberExpression([RttiPath,FBuiltInNames[pbivnRTTI],CallFuncName]);
  8176. // add param "typename"
  8177. TypeName:=TransformVariableName(El,AContext);
  8178. Call.AddArg(CreateLiteralString(El,TypeName));
  8179. if not IsForward then
  8180. begin
  8181. // add {}
  8182. ObjLit:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El));
  8183. Call.AddArg(ObjLit);
  8184. end;
  8185. Result:=Call;
  8186. finally
  8187. if Result=nil then
  8188. Call.Free;
  8189. end;
  8190. end;
  8191. function TPasToJSConverter.CreateRTTIClassField(V: TPasVariable;
  8192. AContext: TConvertContext): TJSElement;
  8193. // create $r.addField("varname",typeinfo);
  8194. var
  8195. Call: TJSCallExpression;
  8196. var
  8197. JSTypeInfo: TJSElement;
  8198. aName: String;
  8199. begin
  8200. Result:=nil;
  8201. JSTypeInfo:=CreateTypeInfoRef(V.VarType,AContext,V);
  8202. // Note: create JSTypeInfo first, it may raise an exception
  8203. Call:=CreateCallExpression(V);
  8204. // $r.addField
  8205. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTTILocal],FBuiltInNames[pbifnRTTIAddField]]);
  8206. // param "varname"
  8207. aName:=TransformVariableName(V,AContext);
  8208. Call.AddArg(CreateLiteralString(V,aName));
  8209. // param typeinfo
  8210. Call.AddArg(JSTypeInfo);
  8211. Result:=Call;
  8212. end;
  8213. function TPasToJSConverter.CreateRTTIClassMethod(Proc: TPasProcedure;
  8214. AContext: TConvertContext): TJSElement;
  8215. // create $r.addMethod("funcname",methodkind,params,resulttype,options)
  8216. var
  8217. OptionsEl: TJSObjectLiteral;
  8218. ResultTypeInfo: TJSElement;
  8219. Call: TJSCallExpression;
  8220. procedure AddOption(const aName: String; JS: TJSElement);
  8221. var
  8222. ObjLit: TJSObjectLiteralElement;
  8223. begin
  8224. if OptionsEl=nil then
  8225. begin
  8226. OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Proc));
  8227. if ResultTypeInfo=nil then
  8228. Call.AddArg(CreateLiteralNull(Proc));
  8229. Call.AddArg(OptionsEl);
  8230. end;
  8231. ObjLit:=OptionsEl.Elements.AddElement;
  8232. ObjLit.Name:=TJSString(aName);
  8233. ObjLit.Expr:=JS;
  8234. end;
  8235. var
  8236. FunName: String;
  8237. C: TClass;
  8238. MethodKind, Flags: Integer;
  8239. ResultEl: TPasResultElement;
  8240. ProcScope, OverriddenProcScope: TPasProcedureScope;
  8241. OverriddenClass: TPasClassType;
  8242. begin
  8243. Result:=nil;
  8244. if Proc.IsOverride then
  8245. begin
  8246. ProcScope:=Proc.CustomData as TPasProcedureScope;
  8247. if ProcScope.OverriddenProc.Visibility=visPublished then
  8248. begin
  8249. // overridden proc is published as well
  8250. OverriddenProcScope:=ProcScope.OverriddenProc.CustomData as TPasProcedureScope;
  8251. OverriddenClass:=OverriddenProcScope.ClassScope.Element as TPasClassType;
  8252. if HasTypeInfo(OverriddenClass,AContext) then
  8253. exit; // overridden proc was already published in ancestor
  8254. end;
  8255. end;
  8256. OptionsEl:=nil;
  8257. ResultTypeInfo:=nil;
  8258. try
  8259. // $r.addMethod
  8260. Call:=CreateCallExpression(Proc);
  8261. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTTILocal],FBuiltInNames[pbifnRTTIAddMethod]]);
  8262. // param "funname"
  8263. FunName:=TransformVariableName(Proc,AContext);
  8264. Call.AddArg(CreateLiteralString(Proc,FunName));
  8265. // param methodkind as number
  8266. C:=Proc.ClassType;
  8267. if C=TPasProcedure then
  8268. MethodKind:=ord(mkProcedure)
  8269. else if C=TPasFunction then
  8270. MethodKind:=ord(mkFunction)
  8271. else if C=TPasConstructor then
  8272. MethodKind:=ord(mkConstructor)
  8273. else if C=TPasDestructor then
  8274. MethodKind:=ord(mkDestructor)
  8275. else if C=TPasClassProcedure then
  8276. MethodKind:=ord(mkClassProcedure)
  8277. else if C=TPasClassFunction then
  8278. MethodKind:=ord(mkClassFunction)
  8279. else
  8280. RaiseNotSupported(Proc,AContext,20170409190242);
  8281. Call.AddArg(CreateLiteralNumber(Proc,MethodKind));
  8282. // param params as []
  8283. Call.AddArg(CreateRTTIArgList(Proc,Proc.ProcType.Args,AContext));
  8284. // param resulttype as typeinfo reference
  8285. if C.InheritsFrom(TPasFunction) then
  8286. begin
  8287. ResultEl:=TPasFunction(Proc).FuncType.ResultEl;
  8288. ResultTypeInfo:=CreateTypeInfoRef(ResultEl.ResultType,AContext,ResultEl);
  8289. if ResultTypeInfo<>nil then
  8290. Call.AddArg(ResultTypeInfo);
  8291. end;
  8292. // param options if needed as {}
  8293. Flags:=0;
  8294. if Proc.IsStatic then
  8295. inc(Flags,pfStatic);
  8296. if ptmVarargs in Proc.ProcType.Modifiers then
  8297. inc(Flags,pfVarargs);
  8298. if Proc.IsExternal then
  8299. inc(Flags,pfExternal);
  8300. if Flags>0 then
  8301. AddOption(FBuiltInNames[pbivnRTTIProcFlags],CreateLiteralNumber(Proc,Flags));
  8302. Result:=Call;
  8303. finally
  8304. if Result=nil then
  8305. Call.Free;
  8306. end;
  8307. end;
  8308. function TPasToJSConverter.CreateRTTIClassProperty(Prop: TPasProperty;
  8309. AContext: TConvertContext): TJSElement;
  8310. // create $r.addProperty("propname",flags,result,"getter","setter",{options})
  8311. var
  8312. Call: TJSCallExpression;
  8313. OptionsEl: TJSObjectLiteral;
  8314. function GetAccessorName(Decl: TPasElement): String;
  8315. begin
  8316. Result:=TransformVariableName(Decl,AContext);
  8317. end;
  8318. procedure AddOption(const aName: String; JS: TJSElement);
  8319. var
  8320. ObjLit: TJSObjectLiteralElement;
  8321. begin
  8322. if OptionsEl=nil then
  8323. begin
  8324. OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Prop));
  8325. Call.AddArg(OptionsEl);
  8326. end;
  8327. ObjLit:=OptionsEl.Elements.AddElement;
  8328. ObjLit.Name:=TJSString(aName);
  8329. ObjLit.Expr:=JS;
  8330. end;
  8331. var
  8332. PropName: String;
  8333. Flags: Integer;
  8334. GetterPas, StoredPas, SetterPas: TPasElement;
  8335. ResultTypeInfo: TJSElement;
  8336. begin
  8337. Result:=nil;
  8338. OptionsEl:=nil;
  8339. try
  8340. // $r.addProperty
  8341. Call:=CreateCallExpression(Prop);
  8342. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTTILocal],FBuiltInNames[pbifnRTTIAddProperty]]);
  8343. // param "propname"
  8344. PropName:=TransformVariableName(Prop,Prop.Name,AContext);
  8345. Call.AddArg(CreateLiteralString(Prop,PropName));
  8346. // add flags
  8347. Flags:=0;
  8348. GetterPas:=AContext.Resolver.GetPasPropertyGetter(Prop);
  8349. if GetterPas is TPasProcedure then
  8350. inc(Flags,pfGetFunction);
  8351. SetterPas:=AContext.Resolver.GetPasPropertySetter(Prop);
  8352. if SetterPas is TPasProcedure then
  8353. inc(Flags,pfSetProcedure);
  8354. StoredPas:=AContext.Resolver.GetPasPropertyStored(Prop);
  8355. if StoredPas is TPasProcedure then
  8356. inc(Flags,pfStoredFunction);
  8357. Call.AddArg(CreateLiteralNumber(Prop,Flags));
  8358. // add resulttype
  8359. ResultTypeInfo:=CreateTypeInfoRef(Prop.VarType,AContext,Prop);
  8360. if ResultTypeInfo<>nil then
  8361. Call.AddArg(ResultTypeInfo)
  8362. else
  8363. Call.AddArg(CreateLiteralNull(Prop));
  8364. // add "getter"
  8365. if GetterPas=nil then
  8366. Call.AddArg(CreateLiteralString(Prop,''))
  8367. else
  8368. Call.AddArg(CreateLiteralString(GetterPas,GetAccessorName(GetterPas)));
  8369. // add "setter"
  8370. if SetterPas=nil then
  8371. Call.AddArg(CreateLiteralString(Prop,''))
  8372. else
  8373. Call.AddArg(CreateLiteralString(SetterPas,GetAccessorName(SetterPas)));
  8374. // add option "stored"
  8375. if StoredPas<>nil then
  8376. AddOption(FBuiltInNames[pbivnRTTIPropStored],
  8377. CreateLiteralString(StoredPas,GetAccessorName(StoredPas)));
  8378. // add option defaultvalue
  8379. // ToDo
  8380. // add option Index
  8381. // ToDo
  8382. Result:=Call;
  8383. finally
  8384. if Result=nil then
  8385. Call.Free;
  8386. end;
  8387. end;
  8388. function TPasToJSConverter.ConvertImplBlock(El: TPasImplBlock;
  8389. AContext: TConvertContext): TJSElement;
  8390. begin
  8391. Result:=Nil;
  8392. if (El is TPasImplStatement) then
  8393. Result:=ConvertStatement(TPasImplStatement(El),AContext)
  8394. else if (El.ClassType=TPasImplIfElse) then
  8395. Result:=ConvertIfStatement(TPasImplIfElse(El),AContext)
  8396. else if (El.ClassType=TPasImplRepeatUntil) then
  8397. Result:=ConvertRepeatStatement(TPasImplRepeatUntil(El),AContext)
  8398. else if (El.ClassType=TPasImplBeginBlock) then
  8399. Result:=ConvertBeginEndStatement(TPasImplBeginBlock(El),AContext,true)
  8400. else if (El.ClassType=TInitializationSection) then
  8401. Result:=ConvertInitializationSection(TInitializationSection(El),AContext)
  8402. else if (El.ClassType=TFinalizationSection) then
  8403. Result:=ConvertFinalizationSection(TFinalizationSection(El),AContext)
  8404. else if (El.ClassType=TPasImplTry) then
  8405. Result:=ConvertTryStatement(TPasImplTry(El),AContext)
  8406. else if (El.ClassType=TPasImplCaseOf) then
  8407. Result:=ConvertCaseOfStatement(TPasImplCaseOf(El),AContext)
  8408. else
  8409. RaiseNotSupported(El,AContext,20161024192156);
  8410. (*
  8411. TPasImplBlock = class(TPasImplElement)
  8412. TPasImplCaseOf = class(TPasImplBlock)
  8413. TPasImplStatement = class(TPasImplBlock)
  8414. TPasImplCaseElse = class(TPasImplBlock)
  8415. TPasImplTry = class(TPasImplBlock)
  8416. TPasImplTryHandler = class(TPasImplBlock)
  8417. TPasImplTryFinally = class(TPasImplTryHandler)
  8418. TPasImplTryExcept = class(TPasImplTryHandler)
  8419. TPasImplTryExceptElse = class(TPasImplTryHandler)
  8420. *)
  8421. end;
  8422. function TPasToJSConverter.ConvertPackage(El: TPasPackage;
  8423. AContext: TConvertContext): TJSElement;
  8424. begin
  8425. RaiseNotSupported(El,AContext,20161024192555);
  8426. Result:=Nil;
  8427. // ToDo TPasPackage = class(TPasElement)
  8428. end;
  8429. function TPasToJSConverter.ConvertResString(El: TPasResString;
  8430. AContext: TConvertContext): TJSElement;
  8431. begin
  8432. RaiseNotSupported(El,AContext,20161024192604);
  8433. Result:=Nil;
  8434. // ToDo: TPasResString
  8435. end;
  8436. function TPasToJSConverter.ConvertVariable(El: TPasVariable;
  8437. AContext: TConvertContext): TJSElement;
  8438. Var
  8439. V : TJSVarDeclaration;
  8440. vm: TVariableModifier;
  8441. begin
  8442. for vm in TVariableModifier do
  8443. if (vm in El.VarModifiers) and (not (vm in [vmClass,vmExternal])) then
  8444. RaiseNotSupported(El,AContext,20170208141622,'modifier '+VariableModifierNames[vm]);
  8445. if El.LibraryName<>nil then
  8446. RaiseNotSupported(El,AContext,20170208141844,'library name');
  8447. if El.AbsoluteLocation<>'' then
  8448. RaiseNotSupported(El,AContext,20170208141926,'absolute');
  8449. V:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El));
  8450. V.Name:=TransformVariableName(El,AContext);
  8451. V.Init:=CreateVarInit(El,AContext);
  8452. Result:=V;
  8453. end;
  8454. function TPasToJSConverter.ConvertProperty(El: TPasProperty;
  8455. AContext: TConvertContext): TJSElement;
  8456. begin
  8457. Result:=Nil;
  8458. if El.IndexExpr<>nil then
  8459. RaiseNotSupported(El.IndexExpr,AContext,20170215103010,'property index expression');
  8460. if El.ImplementsFunc<>nil then
  8461. RaiseNotSupported(El.ImplementsFunc,AContext,20170215102923,'property implements function');
  8462. if El.DispIDExpr<>nil then
  8463. RaiseNotSupported(El.DispIDExpr,AContext,20170215103029,'property dispid expression');
  8464. if El.DefaultExpr<>nil then
  8465. RaiseNotSupported(El.DefaultExpr,AContext,20170215103129,'property default modifier');
  8466. // does not need any declaration. Access is redirected to getter/setter.
  8467. end;
  8468. function TPasToJSConverter.ConvertExportSymbol(El: TPasExportSymbol;
  8469. AContext: TConvertContext): TJSElement;
  8470. begin
  8471. RaiseNotSupported(El,AContext,20161024192650);
  8472. Result:=Nil;
  8473. // ToDo: TPasExportSymbol
  8474. end;
  8475. function TPasToJSConverter.ConvertLabels(El: TPasLabels;
  8476. AContext: TConvertContext): TJSElement;
  8477. begin
  8478. RaiseNotSupported(El,AContext,20161024192701);
  8479. Result:=Nil;
  8480. // ToDo: TPasLabels = class(TPasImplElement)
  8481. end;
  8482. function TPasToJSConverter.ConvertRaiseStatement(El: TPasImplRaise;
  8483. AContext: TConvertContext): TJSElement;
  8484. Var
  8485. E : TJSElement;
  8486. T : TJSThrowStatement;
  8487. begin
  8488. if El.ExceptObject<>Nil then
  8489. E:=ConvertElement(El.ExceptObject,AContext)
  8490. else
  8491. E:=CreateBuiltInIdentifierExpr(FBuiltInNames[pbivnExceptObject]);
  8492. T:=TJSThrowStatement(CreateElement(TJSThrowStatement,El));
  8493. T.A:=E;
  8494. Result:=T;
  8495. end;
  8496. function TPasToJSConverter.ConvertAssignStatement(El: TPasImplAssign;
  8497. AContext: TConvertContext): TJSElement;
  8498. Var
  8499. LHS: TJSElement;
  8500. T: TJSAssignStatement;
  8501. AssignContext: TAssignContext;
  8502. Flags: TPasResolverComputeFlags;
  8503. LeftIsProcType: Boolean;
  8504. begin
  8505. Result:=nil;
  8506. LHS:=nil;
  8507. AssignContext:=TAssignContext.Create(El,nil,AContext);
  8508. try
  8509. if AContext.Resolver<>nil then
  8510. begin
  8511. AContext.Resolver.ComputeElement(El.left,AssignContext.LeftResolved,[rcNoImplicitProc]);
  8512. Flags:=[];
  8513. LeftIsProcType:=AContext.Resolver.IsProcedureType(AssignContext.LeftResolved,true);
  8514. if LeftIsProcType then
  8515. begin
  8516. if msDelphi in AContext.CurrentModeswitches then
  8517. Include(Flags,rcNoImplicitProc)
  8518. else
  8519. Include(Flags,rcNoImplicitProcType);
  8520. end;
  8521. AContext.Resolver.ComputeElement(El.right,AssignContext.RightResolved,Flags);
  8522. {$IFDEF VerbosePas2JS}
  8523. writeln('TPasToJSConverter.ConvertAssignStatement Left={',GetResolverResultDesc(AssignContext.LeftResolved),'} Right={',GetResolverResultDesc(AssignContext.RightResolved),'}');
  8524. {$ENDIF}
  8525. if LeftIsProcType and (msDelphi in AContext.CurrentModeswitches)
  8526. and (AssignContext.RightResolved.BaseType=btProc) then
  8527. begin
  8528. // Delphi allows assigning a proc without @: proctype:=proc
  8529. AssignContext.RightSide:=CreateCallback(El.right,AssignContext.RightResolved,AContext);
  8530. end
  8531. else if AssignContext.RightResolved.BaseType=btNil then
  8532. begin
  8533. if AContext.Resolver.IsArrayType(AssignContext.LeftResolved) then
  8534. begin
  8535. // array:=nil -> array:=[]
  8536. AssignContext.RightSide:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El.right));
  8537. end;
  8538. end;
  8539. end;
  8540. if AssignContext.RightSide=nil then
  8541. AssignContext.RightSide:=ConvertElement(El.right,AContext);
  8542. if (AssignContext.RightResolved.BaseType=btSet)
  8543. and (AssignContext.RightResolved.IdentEl<>nil) then
  8544. begin
  8545. // right side is a set variable -> create reference
  8546. {$IFDEF VerbosePas2JS}
  8547. //writeln('TPasToJSConverter.ConvertAssignStatement SET variable Right={',GetResolverResultDesc(AssignContext.RightResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(AssignContext.RightResolved.IdentEl));
  8548. {$ENDIF}
  8549. // create rtl.refSet(right)
  8550. AssignContext.RightSide:=CreateReferencedSet(El.right,AssignContext.RightSide);
  8551. end
  8552. else if AssignContext.RightResolved.BaseType=btContext then
  8553. begin
  8554. if AssignContext.RightResolved.TypeEl.ClassType=TPasRecordType then
  8555. begin
  8556. // right side is a record -> clone
  8557. {$IFDEF VerbosePas2JS}
  8558. writeln('TPasToJSConverter.ConvertAssignStatement RECORD variable Right={',GetResolverResultDesc(AssignContext.RightResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(AssignContext.RightResolved.IdentEl));
  8559. {$ENDIF}
  8560. // create "new RightRecordType(RightRecord)"
  8561. AssignContext.RightSide:=CreateCloneRecord(El.right,
  8562. AssignContext.RightResolved,AssignContext.RightSide,AContext);
  8563. end;
  8564. end;
  8565. LHS:=ConvertElement(El.left,AssignContext);
  8566. if AssignContext.Call<>nil then
  8567. begin
  8568. // left side is a Setter -> RightSide was already inserted as parameter
  8569. if AssignContext.RightSide<>nil then
  8570. RaiseInconsistency(20170207215544);
  8571. Result:=LHS;
  8572. end
  8573. else
  8574. begin
  8575. // left side is a variable -> create normal assign statement
  8576. case El.Kind of
  8577. akDefault: T:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
  8578. akAdd: T:=TJSAddEqAssignStatement(CreateElement(TJSAddEqAssignStatement,El));
  8579. akMinus: T:=TJSSubEqAssignStatement(CreateElement(TJSSubEqAssignStatement,El));
  8580. akMul: T:=TJSMulEqAssignStatement(CreateElement(TJSMulEqAssignStatement,El));
  8581. akDivision: T:=TJSDivEqAssignStatement(CreateElement(TJSDivEqAssignStatement,El));
  8582. else RaiseNotSupported(El,AContext,20161107221807);
  8583. end;
  8584. T.Expr:=AssignContext.RightSide;
  8585. AssignContext.RightSide:=nil;
  8586. T.LHS:=LHS;
  8587. Result:=T;
  8588. end;
  8589. finally
  8590. if Result=nil then
  8591. LHS.Free;
  8592. AssignContext.RightSide.Free;
  8593. AssignContext.Free;
  8594. end;
  8595. end;
  8596. function TPasToJSConverter.ConvertCommand(El: TPasImplCommand;
  8597. AContext: TConvertContext): TJSElement;
  8598. begin
  8599. RaiseNotSupported(El,AContext,20161024192705);
  8600. Result:=Nil;
  8601. // ToDo: TPasImplCommand = class(TPasImplElement)
  8602. end;
  8603. function TPasToJSConverter.ConvertIfStatement(El: TPasImplIfElse;
  8604. AContext: TConvertContext): TJSElement;
  8605. Var
  8606. C,BThen,BElse : TJSElement;
  8607. T : TJSIfStatement;
  8608. ok: Boolean;
  8609. begin
  8610. if AContext=nil then ;
  8611. C:=Nil;
  8612. BThen:=Nil;
  8613. BElse:=Nil;
  8614. ok:=false;
  8615. try
  8616. C:=ConvertElement(El.ConditionExpr,AContext);
  8617. if Assigned(El.IfBranch) then
  8618. BThen:=ConvertElement(El.IfBranch,AContext);
  8619. if Assigned(El.ElseBranch) then
  8620. BElse:=ConvertElement(El.ElseBranch,AContext);
  8621. ok:=true;
  8622. finally
  8623. if not ok then
  8624. begin
  8625. FreeAndNil(C);
  8626. FreeAndNil(BThen);
  8627. FreeAndNil(BElse);
  8628. end;
  8629. end;
  8630. T:=TJSIfStatement(CreateElement(TJSIfStatement,El));
  8631. T.Cond:=C;
  8632. T.BTrue:=BThen;
  8633. T.BFalse:=BElse;
  8634. Result:=T;
  8635. end;
  8636. function TPasToJSConverter.ConvertWhileStatement(El: TPasImplWhileDo;
  8637. AContext: TConvertContext): TJSElement;
  8638. Var
  8639. C : TJSElement;
  8640. B : TJSElement;
  8641. W : TJSWhileStatement;
  8642. ok: Boolean;
  8643. begin
  8644. Result:=Nil;
  8645. C:=Nil;
  8646. B:=Nil;
  8647. ok:=false;
  8648. try
  8649. C:=ConvertElement(EL.ConditionExpr,AContext);
  8650. if Assigned(EL.Body) then
  8651. B:=ConvertElement(EL.Body,AContext)
  8652. else
  8653. B:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El));
  8654. ok:=true;
  8655. finally
  8656. if not ok then
  8657. begin
  8658. FreeAndNil(B);
  8659. FreeAndNil(C);
  8660. end;
  8661. end;
  8662. W:=TJSWhileStatement(CreateElement(TJSWhileStatement,El));
  8663. W.Cond:=C;
  8664. W.Body:=B;
  8665. Result:=W;
  8666. end;
  8667. function TPasToJSConverter.ConvertRepeatStatement(El: TPasImplRepeatUntil;
  8668. AContext: TConvertContext): TJSElement;
  8669. Var
  8670. C : TJSElement;
  8671. N : TJSUnaryNotExpression;
  8672. W : TJSDoWhileStatement;
  8673. B : TJSElement;
  8674. ok: Boolean;
  8675. begin
  8676. Result:=Nil;
  8677. C:=Nil;
  8678. B:=Nil;
  8679. ok:=false;
  8680. try
  8681. C:=ConvertElement(EL.ConditionExpr,AContext);
  8682. N:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,EL.ConditionExpr));
  8683. N.A:=C;
  8684. B:=ConvertImplBlockElements(El,AContext,false);
  8685. ok:=true;
  8686. finally
  8687. if not ok then
  8688. begin
  8689. FreeAndNil(B);
  8690. FreeAndNil(C);
  8691. end;
  8692. end;
  8693. W:=TJSDoWhileStatement(CreateElement(TJSDoWhileStatement,El));
  8694. W.Cond:=N;
  8695. W.Body:=B;
  8696. Result:=W;
  8697. end;
  8698. function TPasToJSConverter.ConvertForStatement(El: TPasImplForLoop;
  8699. AContext: TConvertContext): TJSElement;
  8700. // Creates the following code:
  8701. // var $loopend=<EndExpr>;
  8702. // for(LoopVar=<StartExpr>; LoopVar<=$loopend; LoopVar++){}
  8703. // if(LoopVar>$loopend)LoopVar--; // this line is only added if LoopVar is read later
  8704. //
  8705. // The StartExpr must be executed exactly once at beginning.
  8706. // The EndExpr must be executed exactly once at beginning.
  8707. // LoopVar can be a varname or programname.varname
  8708. Var
  8709. ForSt : TJSForStatement;
  8710. List, ListEnd: TJSStatementList;
  8711. SimpleAss : TJSSimpleAssignStatement;
  8712. Incr, Decr : TJSUNaryExpression;
  8713. BinExp : TJSBinaryExpression;
  8714. VarStat: TJSVariableStatement;
  8715. IfSt: TJSIfStatement;
  8716. GTExpr: TJSRelationalExpression;
  8717. CurLoopEndVarName: String;
  8718. FuncContext: TConvertContext;
  8719. ResolvedVar: TPasResolverResult;
  8720. function NeedDecrAfterLoop: boolean;
  8721. var
  8722. ResolvedVar: TPasResolverResult;
  8723. aParent: TPasElement;
  8724. ProcBody: TProcedureBody;
  8725. FindData: TForLoopFindData;
  8726. begin
  8727. Result:=true;
  8728. if AContext.Resolver=nil then exit(false);
  8729. AContext.Resolver.ComputeElement(El.VariableName,ResolvedVar,[rcNoImplicitProc]);
  8730. if ResolvedVar.IdentEl=nil then
  8731. exit;
  8732. if ResolvedVar.IdentEl.Parent is TProcedureBody then
  8733. begin
  8734. // loopvar is a local var
  8735. ProcBody:=TProcedureBody(ResolvedVar.IdentEl.Parent);
  8736. aParent:=El;
  8737. while true do
  8738. begin
  8739. aParent:=aParent.Parent;
  8740. if aParent=nil then exit;
  8741. if aParent is TProcedureBody then
  8742. begin
  8743. if aParent<>ProcBody then exit;
  8744. break;
  8745. end;
  8746. end;
  8747. // loopvar is a local var of the same function as where the loop is
  8748. // -> check if it is read after the loop
  8749. FindData:=Default(TForLoopFindData);
  8750. FindData.ForLoop:=El;
  8751. FindData.LoopVar:=ResolvedVar.IdentEl;
  8752. ProcBody.Body.ForEachCall(@ForLoop_OnProcBodyElement,@FindData);
  8753. if not FindData.LoopVarRead then
  8754. exit(false);
  8755. end;
  8756. end;
  8757. begin
  8758. Result:=Nil;
  8759. BinExp:=Nil;
  8760. if AContext.Access<>caRead then
  8761. RaiseInconsistency(20170213213740);
  8762. // get function context
  8763. FuncContext:=AContext;
  8764. while (FuncContext.Parent<>nil) and (not (FuncContext is TFunctionContext)) do
  8765. FuncContext:=FuncContext.Parent;
  8766. // create unique loopend var name
  8767. CurLoopEndVarName:=FuncContext.CreateLocalIdentifier(FBuiltInNames[pbivnLoopEnd]);
  8768. // loopvar:=
  8769. // for (statementlist...
  8770. List:=TJSStatementList(CreateElement(TJSStatementList,El));
  8771. ListEnd:=List;
  8772. try
  8773. // add "var $loopend=<EndExpr>"
  8774. VarStat:=CreateVarStatement(CurLoopEndVarName,
  8775. ConvertElement(El.EndExpr,AContext),El);
  8776. List.A:=VarStat;
  8777. // add "for()"
  8778. ForSt:=TJSForStatement(CreateElement(TJSForStatement,El));
  8779. List.B:=ForSt;
  8780. // add "LoopVar=<StartExpr>;"
  8781. SimpleAss:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El.StartExpr));
  8782. ForSt.Init:=SimpleAss;
  8783. if AContext.Resolver<>nil then
  8784. begin
  8785. AContext.Resolver.ComputeElement(El.VariableName,ResolvedVar,[rcNoImplicitProc]);
  8786. if not (ResolvedVar.IdentEl is TPasVariable) then
  8787. DoError(20170213214404,nExpectedXButFoundY,sExpectedXButFoundY,['var',GetResolverResultDescription(ResolvedVar)],El);
  8788. end;
  8789. SimpleAss.LHS:=ConvertElement(El.VariableName,AContext);
  8790. SimpleAss.Expr:=ConvertElement(El.StartExpr,AContext);
  8791. // add "LoopVar<=$loopend"
  8792. if El.Down then
  8793. BinExp:=TJSRelationalExpressionGE(CreateElement(TJSRelationalExpressionGE,El.EndExpr))
  8794. else
  8795. BinExp:=TJSRelationalExpressionLE(CreateElement(TJSRelationalExpressionLE,El.EndExpr));
  8796. ForSt.Cond:=BinExp;
  8797. BinExp.A:=ConvertElement(El.VariableName,AContext);
  8798. BinExp.B:=CreateIdentifierExpr(CurLoopEndVarName,El.EndExpr,AContext);
  8799. // add "LoopVar++"
  8800. if El.Down then
  8801. Incr:=TJSUnaryPostMinusMinusExpression(CreateElement(TJSUnaryPostMinusMinusExpression,El))
  8802. else
  8803. Incr:=TJSUnaryPostPlusPlusExpression(CreateElement(TJSUnaryPostPlusPlusExpression,El));
  8804. ForSt.Incr:=Incr;
  8805. Incr.A:=ConvertElement(El.VariableName,AContext);
  8806. // add body
  8807. if El.Body<>nil then
  8808. ForSt.Body:=ConvertElement(El.Body,AContext);
  8809. if NeedDecrAfterLoop then
  8810. begin
  8811. // add "if(LoopVar>$loopend)LoopVar--;"
  8812. // add "if()"
  8813. IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,El));
  8814. AddToStatementList(List,ListEnd,IfSt,El);
  8815. // add "LoopVar>$loopend"
  8816. if El.Down then
  8817. GTExpr:=TJSRelationalExpressionLT(CreateElement(TJSRelationalExpressionLT,El))
  8818. else
  8819. GTExpr:=TJSRelationalExpressionGT(CreateElement(TJSRelationalExpressionGT,El));
  8820. IfSt.Cond:=GTExpr;
  8821. GTExpr.A:=ConvertElement(El.VariableName,AContext);
  8822. GTExpr.B:=CreateIdentifierExpr(CurLoopEndVarName,El.EndExpr,AContext);
  8823. // add "LoopVar--"
  8824. if El.Down then
  8825. Decr:=TJSUnaryPostPlusPlusExpression(CreateElement(TJSUnaryPostPlusPlusExpression,El))
  8826. else
  8827. Decr:=TJSUnaryPostMinusMinusExpression(CreateElement(TJSUnaryPostMinusMinusExpression,El));
  8828. IfSt.BTrue:=Decr;
  8829. Decr.A:=ConvertElement(El.VariableName,AContext);
  8830. end;
  8831. Result:=List;
  8832. finally
  8833. if Result=nil then
  8834. List.Free;
  8835. end;
  8836. end;
  8837. function TPasToJSConverter.ConvertSimpleStatement(El: TPasImplSimple;
  8838. AContext: TConvertContext): TJSElement;
  8839. Var
  8840. E : TJSElement;
  8841. begin
  8842. E:=ConvertElement(EL.Expr,AContext);
  8843. if E=nil then
  8844. exit(nil); // e.g. "inherited;" without ancestor proc
  8845. Result:=TJSExpressionStatement(CreateElement(TJSExpressionStatement,El));
  8846. TJSExpressionStatement(Result).A:=E;
  8847. end;
  8848. function TPasToJSConverter.ConvertWithStatement(El: TPasImplWithDo;
  8849. AContext: TConvertContext): TJSElement;
  8850. Var
  8851. B,E , Expr: TJSElement;
  8852. W,W2 : TJSWithStatement;
  8853. I : Integer;
  8854. ok: Boolean;
  8855. PasExpr: TPasElement;
  8856. V: TJSVariableStatement;
  8857. FuncContext: TFunctionContext;
  8858. FirstSt, LastSt: TJSStatementList;
  8859. WithScope: TPasWithScope;
  8860. WithExprScope: TPas2JSWithExprScope;
  8861. begin
  8862. Result:=nil;
  8863. if AContext.Resolver<>nil then
  8864. begin
  8865. // with Resolver:
  8866. // Insert for each expression a local var. Example:
  8867. // with aPoint do X:=3;
  8868. // convert to
  8869. // var $with1 = aPoint;
  8870. // $with1.X = 3;
  8871. FuncContext:=TFunctionContext(AContext.GetContextOfType(TFunctionContext));
  8872. if FuncContext=nil then
  8873. RaiseInconsistency(20170212003759);
  8874. FirstSt:=nil;
  8875. LastSt:=nil;
  8876. try
  8877. WithScope:=El.CustomData as TPasWithScope;
  8878. for i:=0 to El.Expressions.Count-1 do
  8879. begin
  8880. PasExpr:=TPasElement(El.Expressions[i]);
  8881. Expr:=ConvertElement(PasExpr,AContext);
  8882. // create unique local var name
  8883. WithExprScope:=WithScope.ExpressionScopes[i] as TPas2JSWithExprScope;
  8884. WithExprScope.WithVarName:=FuncContext.CreateLocalIdentifier(FBuiltInNames[pbivnWith]);
  8885. // create local "var $with1 = expr;"
  8886. V:=CreateVarStatement(WithExprScope.WithVarName,Expr,PasExpr);
  8887. AddToStatementList(FirstSt,LastSt,V,PasExpr);
  8888. end;
  8889. if Assigned(El.Body) then
  8890. begin
  8891. B:=ConvertElement(El.Body,AContext);
  8892. AddToStatementList(FirstSt,LastSt,B,El.Body);
  8893. end;
  8894. Result:=FirstSt;
  8895. finally
  8896. if Result=nil then
  8897. FreeAndNil(FirstSt);
  8898. end;
  8899. end
  8900. else
  8901. begin
  8902. // without Resolver use as fallback the JavaScript with(){}
  8903. W:=Nil;
  8904. if Assigned(El.Body) then
  8905. B:=ConvertElement(El.Body,AContext)
  8906. else
  8907. B:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El));
  8908. ok:=false;
  8909. try
  8910. For I:=0 to El.Expressions.Count-1 do
  8911. begin
  8912. E:=ConvertElement(TPasElement(El.Expressions[i]),AContext);
  8913. W2:=TJSWithStatement(CreateElement(TJSWithStatement,TPasElement(El.Expressions[i])));
  8914. if Not Assigned(Result) then // result is the first
  8915. Result:=W2;
  8916. if Assigned(W) then // Chain
  8917. W.B:=W2;
  8918. W:=W2; // W is the last
  8919. W.A:=E;
  8920. end;
  8921. ok:=true;
  8922. finally
  8923. if not ok then
  8924. begin
  8925. FreeAndNil(E);
  8926. FreeAndNil(Result);
  8927. end;
  8928. end;
  8929. W.B:=B;
  8930. end;
  8931. end;
  8932. function TPasToJSConverter.IsElementUsed(El: TPasElement): boolean;
  8933. begin
  8934. if Assigned(OnIsElementUsed) then
  8935. Result:=OnIsElementUsed(Self,El)
  8936. else
  8937. Result:=true;
  8938. end;
  8939. function TPasToJSConverter.HasTypeInfo(El: TPasType; AContext: TConvertContext
  8940. ): boolean;
  8941. begin
  8942. Result:=false;
  8943. if coNoTypeInfo in Options then exit;
  8944. if AContext.Resolver=nil then exit;
  8945. if not AContext.Resolver.HasTypeInfo(El) then exit;
  8946. if Assigned(OnIsTypeInfoUsed) and not OnIsTypeInfoUsed(Self,El) then exit;
  8947. Result:=true;
  8948. end;
  8949. function TPasToJSConverter.IsClassRTTICreatedBefore(aClass: TPasClassType;
  8950. Before: TPasElement): boolean;
  8951. var
  8952. Decls: TPasDeclarations;
  8953. i: Integer;
  8954. Types: TFPList;
  8955. T: TPasType;
  8956. C: TClass;
  8957. begin
  8958. Result:=false;
  8959. if aClass.Parent=nil then exit;
  8960. if not aClass.Parent.InheritsFrom(TPasDeclarations) then
  8961. RaiseInconsistency(20170412101457);
  8962. Decls:=TPasDeclarations(aClass.Parent);
  8963. Types:=Decls.Types;
  8964. for i:=0 to Types.Count-1 do
  8965. begin
  8966. T:=TPasType(Types[i]);
  8967. if T=Before then exit;
  8968. if T=aClass then exit(true);
  8969. C:=T.ClassType;
  8970. if C=TPasClassType then
  8971. begin
  8972. if TPasClassType(T).IsForward and (T.CustomData is TResolvedReference)
  8973. and (TResolvedReference(T.CustomData).Declaration=aClass) then
  8974. exit(true);
  8975. end
  8976. else if C=TPasClassOfType then
  8977. begin
  8978. if TPasClassOfType(T).DestType=aClass then exit(true);
  8979. end;
  8980. end;
  8981. end;
  8982. procedure TPasToJSConverter.RaiseInconsistency(Id: int64);
  8983. begin
  8984. raise Exception.Create('TPasToJSConverter.RaiseInconsistency['+IntToStr(Id)+']: you found a bug');
  8985. end;
  8986. function TPasToJSConverter.CreateUnary(Members: array of string; E: TJSElement): TJSUnary;
  8987. var
  8988. unary: TJSUnary;
  8989. asi: TJSSimpleAssignStatement;
  8990. begin
  8991. unary := TJSUnary.Create(0, 0, '');
  8992. asi := TJSSimpleAssignStatement.Create(0, 0, '');
  8993. unary.A := asi;
  8994. asi.Expr := E;
  8995. asi.LHS := CreateMemberExpression(Members);
  8996. Result := unary;
  8997. end;
  8998. function TPasToJSConverter.CreateMemberExpression(Members: array of string): TJSDotMemberExpression;
  8999. var
  9000. pex: TJSPrimaryExpressionIdent;
  9001. MExpr: TJSDotMemberExpression;
  9002. LastMExpr: TJSDotMemberExpression;
  9003. k: integer;
  9004. begin
  9005. if Length(Members) < 2 then
  9006. DoError(20161024192715,'internal error: member expression with less than two members');
  9007. LastMExpr := nil;
  9008. for k:=High(Members) downto Low(Members)+1 do
  9009. begin
  9010. MExpr := TJSDotMemberExpression.Create(0, 0, '');
  9011. MExpr.Name := TJSString(Members[k]);
  9012. if LastMExpr=nil then
  9013. Result := MExpr
  9014. else
  9015. LastMExpr.MExpr := MExpr;
  9016. LastMExpr := MExpr;
  9017. end;
  9018. pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
  9019. pex.Name := TJSString(Members[Low(Members)]);
  9020. LastMExpr.MExpr := pex;
  9021. end;
  9022. function TPasToJSConverter.CreateCallExpression(El: TPasElement
  9023. ): TJSCallExpression;
  9024. begin
  9025. Result:=TJSCallExpression(CreateElement(TJSCallExpression,El));
  9026. Result.Args:=TJSArguments(CreateElement(TJSArguments,El));
  9027. end;
  9028. function TPasToJSConverter.CreateUsesList(UsesSection: TPasSection;
  9029. AContext: TConvertContext): TJSArrayLiteral;
  9030. var
  9031. ArgArray: TJSArrayLiteral;
  9032. k: Integer;
  9033. El: TPasElement;
  9034. anUnitName: String;
  9035. ArgEx: TJSLiteral;
  9036. UsesList: TFPList;
  9037. begin
  9038. UsesList:=UsesSection.UsesList;
  9039. ArgArray:=TJSArrayLiteral.Create(0,0);
  9040. if UsesList<>nil then
  9041. for k:=0 to UsesList.Count-1 do
  9042. begin
  9043. El:=TPasElement(UsesList[k]);
  9044. if not (El is TPasModule) then continue;
  9045. if (not IsElementUsed(El)) and (CompareText('system',El.Name)<>0) then
  9046. continue;
  9047. anUnitName := TransformVariableName(TPasModule(El),AContext);
  9048. ArgEx := CreateLiteralString(UsesSection,anUnitName);
  9049. ArgArray.Elements.AddElement.Expr := ArgEx;
  9050. end;
  9051. Result:=ArgArray;
  9052. end;
  9053. procedure TPasToJSConverter.AddToStatementList(var First,
  9054. Last: TJSStatementList; Add: TJSElement; Src: TPasElement);
  9055. var
  9056. SL2: TJSStatementList;
  9057. begin
  9058. if Add=nil then exit;
  9059. if Add is TJSStatementList then
  9060. begin
  9061. // add list
  9062. if TJSStatementList(Add).A=nil then
  9063. begin
  9064. // empty list -> skip
  9065. if TJSStatementList(Add).B<>nil then
  9066. raise Exception.Create('internal error: AddToStatementList add list A=nil, B<>nil, B='+TJSStatementList(Add).B.ClassName);
  9067. FreeAndNil(Add);
  9068. end
  9069. else if Last=nil then
  9070. begin
  9071. // our list is not yet started -> simply take the extra list
  9072. Last:=TJSStatementList(Add);
  9073. First:=Last;
  9074. end
  9075. else
  9076. begin
  9077. // merge lists (append)
  9078. if Last.B<>nil then
  9079. begin
  9080. // add a nil to the end of chain
  9081. SL2:=TJSStatementList(CreateElement(TJSStatementList,Src));
  9082. SL2.A:=Last.B;
  9083. Last.B:=SL2;
  9084. Last:=SL2;
  9085. // Last.B is now nil
  9086. end;
  9087. Last.B:=Add;
  9088. while Last.B is TJSStatementList do
  9089. Last:=TJSStatementList(Last.B);
  9090. end;
  9091. end
  9092. else
  9093. begin
  9094. if Last=nil then
  9095. begin
  9096. // start list
  9097. Last:=TJSStatementList(CreateElement(TJSStatementList,Src));
  9098. First:=Last;
  9099. Last.A:=Add;
  9100. end
  9101. else if Last.B=nil then
  9102. // second element
  9103. Last.B:=Add
  9104. else
  9105. begin
  9106. // add to chain
  9107. while Last.B is TJSStatementList do
  9108. Last:=TJSStatementList(Last.B);
  9109. SL2:=TJSStatementList(CreateElement(TJSStatementList,Src));
  9110. SL2.A:=Last.B;
  9111. Last.B:=SL2;
  9112. Last:=SL2;
  9113. Last.B:=Add;
  9114. end;
  9115. end;
  9116. end;
  9117. function TPasToJSConverter.CreateValInit(PasType: TPasType; Expr: TPasElement;
  9118. El: TPasElement; AContext: TConvertContext): TJSElement;
  9119. var
  9120. T: TPasType;
  9121. Lit: TJSLiteral;
  9122. bt: TResolverBaseType;
  9123. JSBaseType: TPas2jsBaseType;
  9124. begin
  9125. T:=PasType;
  9126. if AContext.Resolver<>nil then
  9127. T:=AContext.Resolver.ResolveAliasType(T);
  9128. if (T is TPasArrayType) then
  9129. Result:=CreateArrayInit(TPasArrayType(T),Expr,El,AContext)
  9130. else if T is TPasRecordType then
  9131. Result:=CreateRecordInit(TPasRecordType(T),Expr,El,AContext)
  9132. else if Assigned(Expr) then
  9133. Result:=ConvertElement(Expr,AContext)
  9134. else if T is TPasSetType then
  9135. Result:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El))
  9136. else
  9137. begin
  9138. // always init with a default value to create a typed variable (faster and more readable)
  9139. Lit:=TJSLiteral(CreateElement(TJSLiteral,El));
  9140. Result:=Lit;
  9141. if T=nil then
  9142. Lit.Value.IsUndefined:=true
  9143. else if (T.ClassType=TPasPointerType)
  9144. or (T.ClassType=TPasClassType)
  9145. or (T.ClassType=TPasClassOfType)
  9146. or (T.ClassType=TPasProcedureType)
  9147. or (T.ClassType=TPasFunctionType) then
  9148. Lit.Value.IsNull:=true
  9149. else if T.ClassType=TPasStringType then
  9150. Lit.Value.AsString:=''
  9151. else if T.ClassType=TPasEnumType then
  9152. Lit.Value.AsNumber:=0
  9153. else if T.ClassType=TPasUnresolvedSymbolRef then
  9154. begin
  9155. if T.CustomData is TResElDataBaseType then
  9156. begin
  9157. bt:=TResElDataBaseType(T.CustomData).BaseType;
  9158. if bt in btAllInteger then
  9159. Lit.Value.AsNumber:=0
  9160. else if bt in btAllFloats then
  9161. Lit.Value.CustomValue:='0.0'
  9162. else if bt in btAllStringAndChars then
  9163. Lit.Value.AsString:=''
  9164. else if bt in btAllBooleans then
  9165. Lit.Value.AsBoolean:=false
  9166. else if bt in [btNil,btPointer,btProc] then
  9167. Lit.Value.IsNull:=true
  9168. else if (bt=btCustom) and (T.CustomData is TResElDataPas2JSBaseType) then
  9169. begin
  9170. JSBaseType:=TResElDataPas2JSBaseType(T.CustomData).JSBaseType;
  9171. if JSBaseType=pbtJSValue then
  9172. Lit.Value.IsUndefined:=true;
  9173. end
  9174. else
  9175. begin
  9176. {$IFDEF VerbosePas2JS}
  9177. writeln('TPasToJSConverter.CreateVarInit unknown PasType T=',GetObjName(T),' basetype=',BaseTypeNames[bt]);
  9178. {$ENDIF}
  9179. RaiseNotSupported(PasType,AContext,20170208162121);
  9180. end;
  9181. end
  9182. else if (CompareText(T.Name,'longint')=0)
  9183. or (CompareText(T.Name,'int64')=0)
  9184. or (CompareText(T.Name,'real')=0)
  9185. or (CompareText(T.Name,'double')=0)
  9186. or (CompareText(T.Name,'single')=0) then
  9187. Lit.Value.AsNumber:=0.0
  9188. else if (CompareText(T.Name,'boolean')=0) then
  9189. Lit.Value.AsBoolean:=false
  9190. else if (CompareText(T.Name,'string')=0)
  9191. or (CompareText(T.Name,'char')=0)
  9192. then
  9193. Lit.Value.AsString:=''
  9194. else
  9195. begin
  9196. Lit.Value.IsUndefined:=true;
  9197. {$IFDEF VerbosePas2JS}
  9198. writeln('TPasToJSConverter.CreateVarInit unknown PasType class=',T.ClassName,' name=',T.Name);
  9199. {$ENDIF}
  9200. end;
  9201. end
  9202. else
  9203. begin
  9204. {$IFDEF VerbosePas2JS}
  9205. writeln('TPasToJSConverter.CreateValInit unknown PasType ',GetObjName(T));
  9206. {$ENDIF}
  9207. RaiseNotSupported(PasType,AContext,20170208161506);
  9208. end;
  9209. end;
  9210. end;
  9211. function TPasToJSConverter.CreateVarInit(El: TPasVariable;
  9212. AContext: TConvertContext): TJSElement;
  9213. begin
  9214. Result:=CreateValInit(El.VarType,El.Expr,El,AContext);
  9215. end;
  9216. function TPasToJSConverter.CreateVarStatement(const aName: String;
  9217. Init: TJSElement; El: TPasElement): TJSVariableStatement;
  9218. begin
  9219. Result:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
  9220. Result.A:=CreateVarDecl(aName,Init,El);
  9221. end;
  9222. function TPasToJSConverter.CreateVarDecl(const aName: String; Init: TJSElement;
  9223. El: TPasElement): TJSVarDeclaration;
  9224. begin
  9225. Result:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El));
  9226. Result.Name:=aName;
  9227. Result.Init:=Init;
  9228. end;
  9229. function TPasToJSConverter.CreateLiteralNumber(El: TPasElement;
  9230. const n: TJSNumber): TJSLiteral;
  9231. begin
  9232. Result:=TJSLiteral(CreateElement(TJSLiteral,El));
  9233. Result.Value.AsNumber:=n;
  9234. end;
  9235. function TPasToJSConverter.CreateLiteralString(El: TPasElement; const s: string
  9236. ): TJSLiteral;
  9237. begin
  9238. Result:=TJSLiteral(CreateElement(TJSLiteral,El));
  9239. Result.Value.AsString:=TJSString(s);
  9240. end;
  9241. function TPasToJSConverter.CreateLiteralJSString(El: TPasElement;
  9242. const s: TJSString): TJSLiteral;
  9243. begin
  9244. Result:=TJSLiteral(CreateElement(TJSLiteral,El));
  9245. Result.Value.AsString:=s;
  9246. end;
  9247. function TPasToJSConverter.CreateLiteralBoolean(El: TPasElement; b: boolean
  9248. ): TJSLiteral;
  9249. begin
  9250. Result:=TJSLiteral(CreateElement(TJSLiteral,El));
  9251. Result.Value.AsBoolean:=b;
  9252. end;
  9253. function TPasToJSConverter.CreateLiteralNull(El: TPasElement): TJSLiteral;
  9254. begin
  9255. Result:=TJSLiteral(CreateElement(TJSLiteral,El));
  9256. Result.Value.IsNull:=true;
  9257. end;
  9258. function TPasToJSConverter.CreateLiteralUndefined(El: TPasElement): TJSLiteral;
  9259. begin
  9260. Result:=TJSLiteral(CreateElement(TJSLiteral,El));
  9261. Result.Value.IsUndefined:=true;
  9262. end;
  9263. function TPasToJSConverter.CreateRecordInit(aRecord: TPasRecordType;
  9264. Expr: TPasElement; El: TPasElement; AContext: TConvertContext): TJSElement;
  9265. // new recordtype()
  9266. var
  9267. NewMemE: TJSNewMemberExpression;
  9268. begin
  9269. if Expr<>nil then
  9270. RaiseNotSupported(Expr,AContext,20161024192747);
  9271. NewMemE:=TJSNewMemberExpression(CreateElement(TJSNewMemberExpression,El));
  9272. Result:=NewMemE;
  9273. NewMemE.MExpr:=CreateReferencePathExpr(aRecord,AContext);
  9274. end;
  9275. function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
  9276. Expr: TPasElement; El: TPasElement; AContext: TConvertContext): TJSElement;
  9277. var
  9278. Call: TJSCallExpression;
  9279. DimArray, ArrLit: TJSArrayLiteral;
  9280. i, DimSize: Integer;
  9281. RangeResolved, ElTypeResolved, ExprResolved: TPasResolverResult;
  9282. Range: TPasExpr;
  9283. Lit: TJSLiteral;
  9284. CurArrayType: TPasArrayType;
  9285. DefaultValue: TJSElement;
  9286. ArrayValues: TPasExprArray;
  9287. begin
  9288. if Assigned(Expr) then
  9289. begin
  9290. // init array with constant(s)
  9291. if AContext.Resolver=nil then
  9292. DoError(20161024192739,nInitializedArraysNotSupported,sInitializedArraysNotSupported,[],ArrayType);
  9293. ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
  9294. try
  9295. AContext.Resolver.ComputeElement(Expr,ExprResolved,[rcConstant]);
  9296. if (ExprResolved.BaseType=btArray)
  9297. and (ExprResolved.ExprEl is TArrayValues) then
  9298. begin
  9299. ArrayValues:=TArrayValues(ExprResolved.ExprEl).Values;
  9300. for i:=0 to length(ArrayValues)-1 do
  9301. ArrLit.Elements.AddElement.Expr:=ConvertElement(ArrayValues[i],AContext);
  9302. end
  9303. else
  9304. RaiseNotSupported(Expr,AContext,20170223133034);
  9305. Result:=ArrLit;
  9306. finally
  9307. if Result=nil then
  9308. ArrLit.Free;
  9309. end;
  9310. end
  9311. else if length(ArrayType.Ranges)=0 then
  9312. begin
  9313. // empty dynamic array: []
  9314. Result:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
  9315. end
  9316. else
  9317. begin
  9318. // static array
  9319. // create "rtl.arrayNewMultiDim([dim1,dim2,...],defaultvalue)"
  9320. if AContext.Resolver=nil then
  9321. RaiseNotSupported(El,AContext,20170223113050,'');
  9322. Result:=nil;
  9323. try
  9324. Call:=CreateCallExpression(El);
  9325. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_NewMultiDim]]);
  9326. // add parameter [dim1,dim2,...]
  9327. DimArray:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
  9328. Call.AddArg(DimArray);
  9329. CurArrayType:=ArrayType;
  9330. while true do
  9331. begin
  9332. for i:=0 to length(CurArrayType.Ranges)-1 do
  9333. begin
  9334. Range:=CurArrayType.Ranges[i];
  9335. // compute size of this dimension
  9336. AContext.Resolver.ComputeElement(Range,RangeResolved,[rcConstant]);
  9337. DimSize:=AContext.Resolver.GetRangeLength(RangeResolved);
  9338. if DimSize=0 then
  9339. RaiseNotSupported(Range,AContext,20170223113318);
  9340. Lit:=CreateLiteralNumber(El,DimSize);
  9341. DimArray.Elements.AddElement.Expr:=Lit;
  9342. end;
  9343. AContext.Resolver.ComputeElement(CurArrayType.ElType,ElTypeResolved,[rcType]);
  9344. if (ElTypeResolved.TypeEl is TPasArrayType) then
  9345. begin
  9346. CurArrayType:=TPasArrayType(ElTypeResolved.TypeEl);
  9347. if length(CurArrayType.Ranges)>0 then
  9348. begin
  9349. // nested static array
  9350. continue;
  9351. end;
  9352. end;
  9353. break;
  9354. end;
  9355. // add parameter defaultvalue
  9356. DefaultValue:=CreateValInit(ElTypeResolved.TypeEl,nil,El,AContext);
  9357. Call.AddArg(DefaultValue);
  9358. Result:=Call;
  9359. finally
  9360. if Result=nil then
  9361. Call.Free;
  9362. end;
  9363. end;
  9364. end;
  9365. function TPasToJSConverter.CreateCmpArrayWithNil(El: TPasElement;
  9366. JSArray: TJSElement; OpCode: TExprOpCode): TJSElement;
  9367. var
  9368. Call: TJSCallExpression;
  9369. BinExpr: TJSBinaryExpression;
  9370. begin
  9371. if not (OpCode in [eopEqual,eopNotEqual]) then
  9372. RaiseInconsistency(20170401184819);
  9373. Call:=CreateCallExpression(El);
  9374. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Length]]);
  9375. Call.AddArg(JSArray);
  9376. if OpCode=eopEqual then
  9377. BinExpr:=TJSEqualityExpressionEQ(CreateElement(TJSEqualityExpressionEQ,El))
  9378. else
  9379. BinExpr:=TJSRelationalExpressionGT(CreateElement(TJSRelationalExpressionGT,El));
  9380. BinExpr.A:=Call;
  9381. BinExpr.B:=CreateLiteralNumber(El,0);
  9382. Result:=BinExpr;
  9383. end;
  9384. function TPasToJSConverter.CreateReferencePath(El: TPasElement;
  9385. AContext: TConvertContext; Kind: TRefPathKind; Full: boolean;
  9386. Ref: TResolvedReference): string;
  9387. { Notes:
  9388. - local var, argument or result variable, even higher lvl does not need a reference path
  9389. local vars are also argument, result var, result variable
  9390. - 'this':
  9391. - in interface function (even nested) 'this' is the interface,
  9392. - in implementation function (even nested) 'this' is the implementation,
  9393. - in initialization 'this' is interface
  9394. - in method body 'this' is the instance
  9395. - in class method body 'this' is the class
  9396. - with context uses the local $withnnn var
  9397. otherwise use absolute path
  9398. }
  9399. function GetReferenceEl: TPasElement;
  9400. begin
  9401. if Ref<>nil then
  9402. Result:=Ref.Element
  9403. else
  9404. Result:=El;
  9405. end;
  9406. function IsLocalVar: boolean;
  9407. begin
  9408. Result:=false;
  9409. if El.ClassType=TPasArgument then
  9410. exit(true);
  9411. if El.ClassType=TPasResultElement then
  9412. exit(true);
  9413. if AContext.Resolver=nil then
  9414. exit(true);
  9415. if El.Parent=nil then
  9416. RaiseNotSupported(El,AContext,20170203121306,GetObjName(El));
  9417. if El.Parent.ClassType=TPasImplExceptOn then
  9418. exit(true);
  9419. if not (El.Parent is TProcedureBody) then exit;
  9420. Result:=true;
  9421. end;
  9422. procedure Prepend(var aPath: string; Prefix: string);
  9423. begin
  9424. if aPath<>'' then
  9425. aPath:='.'+aPath;
  9426. aPath:=Prefix+aPath;
  9427. end;
  9428. function IsClassFunction(Proc: TPasElement): boolean;
  9429. var
  9430. C: TClass;
  9431. begin
  9432. if Proc=nil then exit(false);
  9433. C:=Proc.ClassType;
  9434. Result:=(C=TPasClassFunction) or (C=TPasClassProcedure)
  9435. or (C=TPasClassConstructor) or (C=TPasClassDestructor);
  9436. end;
  9437. procedure Append_GetClass(Member: TPasElement);
  9438. begin
  9439. if (Member.Parent as TPasClassType).IsExternal then
  9440. exit;
  9441. if Result<>'' then
  9442. Result:=Result+'.'+FBuiltInNames[pbivnPtrClass]
  9443. else
  9444. Result:=FBuiltInNames[pbivnPtrClass];
  9445. end;
  9446. var
  9447. FoundModule: TPasModule;
  9448. This, ParentEl: TPasElement;
  9449. Dot: TDotContext;
  9450. ThisContext: TFunctionContext;
  9451. WithData: TPas2JSWithExprScope;
  9452. ProcScope: TPasProcedureScope;
  9453. begin
  9454. Result:='';
  9455. //writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext));
  9456. if AContext is TDotContext then
  9457. begin
  9458. Dot:=TDotContext(AContext);
  9459. if Dot.Resolver<>nil then
  9460. begin
  9461. if El is TPasVariable then
  9462. begin
  9463. //writeln('TPasToJSConverter.CreateReferencePath Left=',GetResolverResultDesc(Dot.LeftResolved),' Right=class var ',GetObjName(El));
  9464. if (ClassVarModifiersType*TPasVariable(El).VarModifiers<>[])
  9465. and (Dot.Access=caAssign)
  9466. and Dot.Resolver.ResolvedElIsClassInstance(Dot.LeftResolved) then
  9467. begin
  9468. // writing a class var
  9469. Append_GetClass(El);
  9470. end;
  9471. end
  9472. else if IsClassFunction(El) then
  9473. begin
  9474. if Dot.Resolver.ResolvedElIsClassInstance(Dot.LeftResolved) then
  9475. // accessing a class method from an object, 'this' must be the class
  9476. Append_GetClass(El);
  9477. end;
  9478. end;
  9479. end
  9480. else if (Ref<>nil) and (Ref.WithExprScope<>nil) then
  9481. begin
  9482. // using local WITH var
  9483. WithData:=Ref.WithExprScope as TPas2JSWithExprScope;
  9484. Prepend(Result,WithData.WithVarName);
  9485. end
  9486. else if IsLocalVar then
  9487. begin
  9488. // El is local var -> does not need path
  9489. end
  9490. else if (El is TPasProcedure) and (TPasProcedure(El).LibrarySymbolName<>nil)
  9491. and not (El.Parent is TPasClassType) then
  9492. begin
  9493. // an external function -> use the literal
  9494. if Kind=rpkPathAndName then
  9495. Result:=ComputeConstString(TPasProcedure(El).LibrarySymbolName,AContext,true)
  9496. else
  9497. Result:='';
  9498. exit;
  9499. end
  9500. else if (El is TPasVariable) and (TPasVariable(El).ExportName<>nil)
  9501. and not (El.Parent is TPasClassType) then
  9502. begin
  9503. // an external var -> use the literal
  9504. if Kind=rpkPathAndName then
  9505. Result:=ComputeConstString(TPasVariable(El).ExportName,AContext,true)
  9506. else
  9507. Result:='';
  9508. exit;
  9509. end
  9510. else if (El.ClassType=TPasClassType) and TPasClassType(El).IsExternal then
  9511. begin
  9512. Result:=TPasClassType(El).ExternalName;
  9513. exit;
  9514. end
  9515. else
  9516. begin
  9517. // need full path
  9518. if El.Parent=nil then
  9519. RaiseNotSupported(El,AContext,20170201172141,GetObjName(El));
  9520. if (El.CustomData is TPasProcedureScope) then
  9521. begin
  9522. ProcScope:=TPasProcedureScope(El.CustomData);
  9523. if ProcScope.DeclarationProc<>nil then
  9524. El:=ProcScope.DeclarationProc;
  9525. end;
  9526. ThisContext:=AContext.GetThisContext;
  9527. if ThisContext<>nil then
  9528. This:=ThisContext.This
  9529. else
  9530. This:=nil;
  9531. ParentEl:=El.Parent;
  9532. while ParentEl<>nil do
  9533. begin
  9534. if (ParentEl.CustomData is TPasProcedureScope) then
  9535. begin
  9536. ProcScope:=TPasProcedureScope(ParentEl.CustomData);
  9537. if ProcScope.DeclarationProc<>nil then
  9538. ParentEl:=ProcScope.DeclarationProc;
  9539. end;
  9540. if ParentEl.ClassType=TImplementationSection then
  9541. begin
  9542. // element is in an implementation section
  9543. if ParentEl=This then
  9544. Prepend(Result,'this')
  9545. else
  9546. begin
  9547. FoundModule:=El.GetModule;
  9548. if FoundModule=nil then
  9549. RaiseInconsistency(20161024192755);
  9550. if AContext.GetRootModule=FoundModule then
  9551. // in same unit -> use '$impl'
  9552. Prepend(Result,FBuiltInNames[pbivnImplementation])
  9553. else
  9554. // in other unit -> use pas.unitname.$impl
  9555. Prepend(Result,FBuiltInNames[pbivnModules]
  9556. +'.'+TransformModuleName(FoundModule,AContext)
  9557. +'.'+FBuiltInNames[pbivnImplementation]);
  9558. end;
  9559. break;
  9560. end
  9561. else if ParentEl is TPasModule then
  9562. begin
  9563. // element is in an unit interface or program/library section
  9564. if ParentEl=This then
  9565. Prepend(Result,'this')
  9566. else
  9567. Prepend(Result,FBuiltInNames[pbivnModules]
  9568. +'.'+TransformModuleName(TPasModule(ParentEl),AContext));
  9569. break;
  9570. end
  9571. else if (ParentEl.ClassType=TPasClassType)
  9572. or (ParentEl.ClassType=TPasRecordType) then
  9573. begin
  9574. // element is a class or record
  9575. if Full then
  9576. Prepend(Result,ParentEl.Name)
  9577. else
  9578. begin
  9579. // Pascal and JS have similar scoping rules, so we can use 'this'.
  9580. Result:='this';
  9581. if (ThisContext<>nil) and (not IsClassFunction(ThisContext.PasElement)) then
  9582. begin
  9583. // 'this' is an class instance
  9584. if El is TPasVariable then
  9585. begin
  9586. //writeln('TPasToJSConverter.CreateReferencePath class var ',GetObjName(El),' This=',GetObjName(This));
  9587. if (ClassVarModifiersType*TPasVariable(El).VarModifiers<>[])
  9588. and (AContext.Access=caAssign) then
  9589. begin
  9590. Append_GetClass(El); // writing a class var
  9591. end;
  9592. end
  9593. else if IsClassFunction(El) then
  9594. Append_GetClass(El); // accessing a class function
  9595. end;
  9596. break;
  9597. end;
  9598. end
  9599. else if ParentEl.ClassType=TPasEnumType then
  9600. Prepend(Result,ParentEl.Name);
  9601. ParentEl:=ParentEl.Parent;
  9602. end;
  9603. end;
  9604. if (Result<>'') and (Kind in [rpkPathWithDot,rpkPathAndName]) then
  9605. Result:=Result+'.';
  9606. if Kind=rpkPathAndName then
  9607. Result:=Result+TransformVariableName(El,AContext);
  9608. end;
  9609. function TPasToJSConverter.CreateReferencePathExpr(El: TPasElement;
  9610. AContext: TConvertContext; Full: boolean; Ref: TResolvedReference
  9611. ): TJSPrimaryExpressionIdent;
  9612. var
  9613. Name: String;
  9614. begin
  9615. {$IFDEF VerbosePas2JS}
  9616. writeln('TPasToJSConverter.CreateReferencePathExpr El="',GetObjName(El),'" El.Parent=',GetObjName(El.Parent));
  9617. {$ENDIF}
  9618. Name:=CreateReferencePath(El,AContext,rpkPathAndName,Full,Ref);
  9619. Result:=CreateBuiltInIdentifierExpr(Name);
  9620. end;
  9621. procedure TPasToJSConverter.CreateProcedureCall(var Call: TJSCallExpression;
  9622. Args: TParamsExpr; TargetProc: TPasProcedureType; AContext: TConvertContext);
  9623. // create a call, adding call by reference and default values
  9624. begin
  9625. if Call=nil then
  9626. Call:=TJSCallExpression(CreateElement(TJSCallExpression,Args));
  9627. if ((Args=nil) or (length(Args.Params)=0))
  9628. and ((TargetProc=nil) or (TargetProc.Args.Count=0)) then
  9629. exit;
  9630. if Call.Args=nil then
  9631. Call.Args:=TJSArguments(CreateElement(TJSArguments,Args));
  9632. CreateProcedureCallArgs(Call.Args.Elements,Args,TargetProc,AContext);
  9633. end;
  9634. procedure TPasToJSConverter.CreateProcedureCallArgs(
  9635. Elements: TJSArrayLiteralElements; Args: TParamsExpr;
  9636. TargetProc: TPasProcedureType; AContext: TConvertContext);
  9637. // Add call arguments. Handle call by reference and default values
  9638. var
  9639. ArgContext: TConvertContext;
  9640. i: Integer;
  9641. Arg: TJSElement;
  9642. TargetArgs: TFPList;
  9643. TargetArg: TPasArgument;
  9644. OldAccess: TCtxAccess;
  9645. begin
  9646. // get context
  9647. ArgContext:=AContext;
  9648. while ArgContext is TDotContext do
  9649. ArgContext:=ArgContext.Parent;
  9650. i:=0;
  9651. OldAccess:=ArgContext.Access;
  9652. if TargetProc<>nil then
  9653. TargetArgs:=TargetProc.Args
  9654. else
  9655. TargetArgs:=nil;
  9656. // add params
  9657. if Args<>nil then
  9658. while i<length(Args.Params) do
  9659. begin
  9660. if (TargetArgs<>nil) and (i<TargetArgs.Count) then
  9661. TargetArg:=TPasArgument(TargetArgs[i])
  9662. else
  9663. TargetArg:=nil;
  9664. Arg:=CreateProcCallArg(Args.Params[i],TargetArg,ArgContext);
  9665. Elements.AddElement.Expr:=Arg;
  9666. inc(i);
  9667. end;
  9668. // fill up default values
  9669. if TargetProc<>nil then
  9670. begin
  9671. while i<TargetArgs.Count do
  9672. begin
  9673. TargetArg:=TPasArgument(TargetArgs[i]);
  9674. if TargetArg.ValueExpr=nil then
  9675. begin
  9676. {$IFDEF VerbosePas2JS}
  9677. writeln('TPasToJSConverter.CreateProcedureCallArgs missing default value: TargetProc=',TargetProc.Name,' i=',i);
  9678. {$ENDIF}
  9679. RaiseNotSupported(Args,AContext,20170201193601);
  9680. end;
  9681. AContext.Access:=caRead;
  9682. Arg:=ConvertElement(TargetArg.ValueExpr,ArgContext);
  9683. Elements.AddElement.Expr:=Arg;
  9684. inc(i);
  9685. end;
  9686. end;
  9687. ArgContext.Access:=OldAccess;
  9688. end;
  9689. function TPasToJSConverter.CreateProcCallArg(El: TPasExpr;
  9690. TargetArg: TPasArgument; AContext: TConvertContext): TJSElement;
  9691. var
  9692. ExprResolved, ArgResolved: TPasResolverResult;
  9693. ExprFlags: TPasResolverComputeFlags;
  9694. NeedVar: Boolean;
  9695. begin
  9696. Result:=nil;
  9697. if TargetArg=nil then
  9698. begin
  9699. // simple conversion
  9700. AContext.Access:=caRead;
  9701. Result:=ConvertElement(El,AContext);
  9702. exit;
  9703. end;
  9704. if not (TargetArg.Access in [argDefault,argVar,argOut,argConst]) then
  9705. DoError(20170213220927,nPasElementNotSupported,sPasElementNotSupported,
  9706. [AccessNames[TargetArg.Access]],El);
  9707. NeedVar:=TargetArg.Access in [argVar,argOut];
  9708. AContext.Resolver.ComputeElement(TargetArg,ArgResolved,[]);
  9709. ExprFlags:=[];
  9710. if NeedVar then
  9711. Include(ExprFlags,rcNoImplicitProc)
  9712. else if AContext.Resolver.IsProcedureType(ArgResolved,true) then
  9713. Include(ExprFlags,rcNoImplicitProcType);
  9714. if (ArgResolved.TypeEl is TPasArrayType)
  9715. and (El is TParamsExpr) and (TParamsExpr(El).Kind=pekSet) then
  9716. begin
  9717. // passing a set to an open array
  9718. if NeedVar then
  9719. RaiseNotSupported(El,AContext,20170326213042);
  9720. Result:=ConvertOpenArrayParam(AContext.Resolver.ResolveAliasType(ArgResolved.TypeEl),
  9721. TParamsExpr(El),AContext);
  9722. exit;
  9723. end;
  9724. AContext.Resolver.ComputeElement(El,ExprResolved,ExprFlags);
  9725. // consider TargetArg access
  9726. if NeedVar then
  9727. Result:=CreateProcCallArgRef(El,ExprResolved,TargetArg,AContext)
  9728. else
  9729. begin
  9730. // pass as default, const or constref
  9731. AContext.Access:=caRead;
  9732. if (ExprResolved.BaseType=btNil) and (ArgResolved.TypeEl is TPasArrayType) then
  9733. begin
  9734. // arrays must never be null -> pass []
  9735. Result:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
  9736. exit;
  9737. end;
  9738. Result:=ConvertElement(El,AContext);
  9739. if TargetArg.Access=argDefault then
  9740. begin
  9741. if (ExprResolved.BaseType=btSet) and (ExprResolved.IdentEl<>nil) then
  9742. begin
  9743. // right side is a set variable -> create reference
  9744. {$IFDEF VerbosePas2JS}
  9745. writeln('TPasToJSConverter.CreateProcedureCallArg create reference of SET variable Right={',GetResolverResultDesc(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
  9746. {$ENDIF}
  9747. // create rtl.refSet(right)
  9748. Result:=CreateReferencedSet(El,Result);
  9749. exit;
  9750. end
  9751. else if ExprResolved.BaseType=btContext then
  9752. begin
  9753. if ExprResolved.TypeEl.ClassType=TPasRecordType then
  9754. begin
  9755. // right side is a record -> clone
  9756. {$IFDEF VerbosePas2JS}
  9757. writeln('TPasToJSConverter.CreateProcedureCallArg clone RECORD variable Right={',GetResolverResultDesc(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
  9758. {$ENDIF}
  9759. // create "new RightRecordType(RightRecord)"
  9760. Result:=CreateCloneRecord(El,ExprResolved,Result,AContext);
  9761. exit;
  9762. end;
  9763. end;
  9764. end;
  9765. end;
  9766. end;
  9767. function TPasToJSConverter.CreateProcCallArgRef(El: TPasExpr;
  9768. ResolvedEl: TPasResolverResult; TargetArg: TPasArgument;
  9769. AContext: TConvertContext): TJSElement;
  9770. const
  9771. GetPathName = 'p';
  9772. SetPathName = 's';
  9773. ParamName = 'a';
  9774. var
  9775. Obj: TJSObjectLiteral;
  9776. procedure AddVar(const aName: string; var Expr: TJSElement);
  9777. var
  9778. ObjLit: TJSObjectLiteralElement;
  9779. begin
  9780. if Expr=nil then exit;
  9781. ObjLit:=Obj.Elements.AddElement;
  9782. ObjLit.Name:=TJSString(aName);
  9783. ObjLit.Expr:=Expr;
  9784. Expr:=nil;
  9785. end;
  9786. var
  9787. ParamContext: TParamContext;
  9788. FullGetter, GetPathExpr, SetPathExpr, GetExpr, SetExpr, ParamExpr: TJSElement;
  9789. AssignSt: TJSSimpleAssignStatement;
  9790. ObjLit: TJSObjectLiteralElement;
  9791. FuncSt: TJSFunctionDeclarationStatement;
  9792. RetSt: TJSReturnStatement;
  9793. GetDotPos, SetDotPos: Integer;
  9794. GetPath, SetPath: String;
  9795. BracketExpr: TJSBracketMemberExpression;
  9796. DotExpr: TJSDotMemberExpression;
  9797. begin
  9798. // pass reference -> create a temporary JS object with a FullGetter and setter
  9799. Obj:=nil;
  9800. FullGetter:=nil;
  9801. ParamContext:=TParamContext.Create(El,nil,AContext);
  9802. GetPathExpr:=nil;
  9803. SetPathExpr:=nil;
  9804. GetExpr:=nil;
  9805. SetExpr:=nil;
  9806. try
  9807. // create FullGetter and setter
  9808. ParamContext.Access:=caByReference;
  9809. ParamContext.Arg:=TargetArg;
  9810. ParamContext.Expr:=El;
  9811. ParamContext.ResolvedExpr:=ResolvedEl;
  9812. FullGetter:=ConvertElement(El,ParamContext);
  9813. // FullGetter is now a full JS expression to retrieve the value.
  9814. if ParamContext.ReusingReference then
  9815. begin
  9816. // result is already a reference
  9817. Result:=FullGetter;
  9818. exit;
  9819. end;
  9820. // if ParamContext.Getter is set then
  9821. // ParamContext.Getter is the last part of the FullGetter
  9822. // FullSetter is created from FullGetter by replacing the Getter with the Setter
  9823. {$IFDEF VerbosePas2JS}
  9824. writeln('TPasToJSConverter.CreateProcedureCallArg VAR FullGetter=',GetObjName(FullGetter),' Getter=',GetObjName(ParamContext.Getter),' Setter=',GetObjName(ParamContext.Setter));
  9825. {$ENDIF}
  9826. if (ParamContext.Getter=nil)<>(ParamContext.Setter=nil) then
  9827. begin
  9828. {$IFDEF VerbosePas2JS}
  9829. writeln('TPasToJSConverter.CreateProcedureCallArg FullGetter=',GetObjName(FullGetter),' Getter=',GetObjName(ParamContext.Getter),' Setter=',GetObjName(ParamContext.Setter));
  9830. {$ENDIF}
  9831. RaiseInconsistency(20170213222941);
  9832. end;
  9833. // create "{p:Result,get:function(){return this.p.Getter},set:function(v){this.p.Setter(v);}}"
  9834. Obj:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El));
  9835. if FullGetter.ClassType=TJSPrimaryExpressionIdent then
  9836. begin
  9837. // create "{get:function(){return FullGetter;},set:function(v){FullGetter=v;}}"
  9838. if (ParamContext.Getter<>nil) and (ParamContext.Getter<>FullGetter) then
  9839. RaiseInconsistency(20170213224339);
  9840. GetPath:=String(TJSPrimaryExpressionIdent(FullGetter).Name);
  9841. GetDotPos:=PosLast('.',GetPath);
  9842. if GetDotPos>0 then
  9843. begin
  9844. // e.g. path1.path2.readvar
  9845. // create
  9846. // GetPathExpr: path1.path2
  9847. // GetExpr: this.p.readvar
  9848. // Will create "{p:GetPathExpr, get:function(){return GetExpr;},
  9849. // set:function(v){GetExpr = v;}}"
  9850. GetPathExpr:=CreateBuiltInIdentifierExpr(LeftStr(GetPath,GetDotPos-1));
  9851. GetExpr:=CreateDotExpression(El,CreateBuiltInIdentifierExpr('this.'+GetPathName),
  9852. CreateBuiltInIdentifierExpr(copy(GetPath,GetDotPos+1)));
  9853. if ParamContext.Setter=nil then
  9854. SetExpr:=CreateDotExpression(El,CreateBuiltInIdentifierExpr('this.'+GetPathName),
  9855. CreateBuiltInIdentifierExpr(copy(GetPath,GetDotPos+1)));
  9856. end
  9857. else
  9858. begin
  9859. // local var
  9860. GetExpr:=FullGetter;
  9861. FullGetter:=nil;
  9862. if ParamContext.Setter=nil then
  9863. SetExpr:=CreateBuiltInIdentifierExpr(GetPath);
  9864. end;
  9865. if ParamContext.Setter<>nil then
  9866. begin
  9867. // custom Setter
  9868. SetExpr:=ParamContext.Setter;
  9869. ParamContext.Setter:=nil;
  9870. if SetExpr.ClassType=TJSPrimaryExpressionIdent then
  9871. begin
  9872. SetPath:=String(TJSPrimaryExpressionIdent(SetExpr).Name);
  9873. SetDotPos:=PosLast('.',SetPath);
  9874. FreeAndNil(SetExpr);
  9875. if LeftStr(GetPath,GetDotPos)=LeftStr(SetPath,SetDotPos) then
  9876. begin
  9877. // use GetPathExpr for setter
  9878. SetExpr:=CreateDotExpression(El,CreateBuiltInIdentifierExpr('this.'+GetPathName),
  9879. CreateBuiltInIdentifierExpr(copy(SetPath,GetDotPos+1)));
  9880. end
  9881. else
  9882. begin
  9883. // setter needs its own SetPathExpr
  9884. SetPathExpr:=CreateBuiltInIdentifierExpr(LeftStr(SetPath,SetDotPos-1));
  9885. SetExpr:=CreateDotExpression(El,CreateBuiltInIdentifierExpr('this.'+SetPathName),
  9886. CreateBuiltInIdentifierExpr(copy(SetPath,GetDotPos+1)));
  9887. end;
  9888. end;
  9889. end;
  9890. end
  9891. else if FullGetter.ClassType=TJSDotMemberExpression then
  9892. begin
  9893. if ParamContext.Setter<>nil then
  9894. RaiseNotSupported(El,AContext,20170214231900);
  9895. // convert this.r.i to
  9896. // {p:this.r,
  9897. // get:function{return this.p.i;},
  9898. // set:function(v){this.p.i=v;}
  9899. // }
  9900. // GetPathExpr: this.r
  9901. // GetExpr: this.p.i
  9902. // SetExpr: this.p.i
  9903. DotExpr:=TJSDotMemberExpression(FullGetter);
  9904. GetPathExpr:=DotExpr.MExpr;
  9905. DotExpr.MExpr:=CreateBuiltInIdentifierExpr('this.'+GetPathName);
  9906. GetExpr:=DotExpr;
  9907. FullGetter:=nil;
  9908. SetExpr:=CreateDotExpression(El,
  9909. CreateBuiltInIdentifierExpr('this.'+GetPathName),
  9910. CreateBuiltInIdentifierExpr(String(DotExpr.Name)));
  9911. end
  9912. else if FullGetter.ClassType=TJSBracketMemberExpression then
  9913. begin
  9914. if ParamContext.Setter<>nil then
  9915. RaiseNotSupported(El,AContext,20170214215150);
  9916. // convert this.arr[value] to
  9917. // {a:value,
  9918. // p:this.arr,
  9919. // get:function{return this.p[this.a];},
  9920. // set:function(v){this.p[this.a]=v;}
  9921. // }
  9922. BracketExpr:=TJSBracketMemberExpression(FullGetter);
  9923. ParamExpr:=BracketExpr.Name;
  9924. // create "a:value"
  9925. BracketExpr.Name:=CreateBuiltInIdentifierExpr('this.'+ParamName);
  9926. AddVar(ParamName,ParamExpr);
  9927. // create GetPathExpr "this.arr"
  9928. GetPathExpr:=BracketExpr.MExpr;
  9929. BracketExpr.MExpr:=CreateBuiltInIdentifierExpr('this.'+GetPathName);
  9930. // GetExpr "this.p[this.a]"
  9931. GetExpr:=BracketExpr;
  9932. FullGetter:=nil;
  9933. // SetExpr "this.p[this.a]"
  9934. BracketExpr:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
  9935. SetExpr:=BracketExpr;
  9936. BracketExpr.MExpr:=CreateBuiltInIdentifierExpr('this.'+GetPathName);
  9937. BracketExpr.Name:=CreateBuiltInIdentifierExpr('this.'+ParamName);
  9938. end
  9939. else
  9940. begin
  9941. {$IFDEF VerbosePas2JS}
  9942. writeln('TPasToJSConverter.CreateProcedureCallArg FullGetter=',GetObjName(FullGetter),' Getter=',GetObjName(ParamContext.Getter),' Setter=',GetObjName(ParamContext.Setter));
  9943. {$ENDIF}
  9944. RaiseNotSupported(El,AContext,20170213230336);
  9945. end;
  9946. if (SetExpr.ClassType=TJSPrimaryExpressionIdent)
  9947. or (SetExpr.ClassType=TJSDotMemberExpression)
  9948. or (SetExpr.ClassType=TJSBracketMemberExpression) then
  9949. begin
  9950. // create SetExpr = v;
  9951. AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
  9952. AssignSt.LHS:=SetExpr;
  9953. AssignSt.Expr:=CreateBuiltInIdentifierExpr(TempRefObjSetterArgName);
  9954. SetExpr:=AssignSt;
  9955. end
  9956. else if (SetExpr.ClassType=TJSCallExpression) then
  9957. // has already the form Func(v)
  9958. else
  9959. RaiseInconsistency(20170213225940);
  9960. // add p:GetPathExpr
  9961. AddVar(GetPathName,GetPathExpr);
  9962. // add get:function(){ return GetExpr; }
  9963. ObjLit:=Obj.Elements.AddElement;
  9964. ObjLit.Name:=TempRefObjGetterName;
  9965. FuncSt:=CreateFunction(El);
  9966. ObjLit.Expr:=FuncSt;
  9967. RetSt:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
  9968. FuncSt.AFunction.Body.A:=RetSt;
  9969. RetSt.Expr:=GetExpr;
  9970. GetExpr:=nil;
  9971. // add s:GetPathExpr
  9972. AddVar(SetPathName,SetPathExpr);
  9973. // add set:function(v){ SetExpr }
  9974. ObjLit:=Obj.Elements.AddElement;
  9975. ObjLit.Name:=TempRefObjSetterName;
  9976. FuncSt:=CreateFunction(El);
  9977. ObjLit.Expr:=FuncSt;
  9978. FuncSt.AFunction.Params.Add(TempRefObjSetterArgName);
  9979. FuncSt.AFunction.Body.A:=SetExpr;
  9980. SetExpr:=nil;
  9981. Result:=Obj;
  9982. finally
  9983. if Result=nil then
  9984. begin
  9985. GetPathExpr.Free;
  9986. SetPathExpr.Free;
  9987. GetExpr.Free;
  9988. SetExpr.Free;
  9989. Obj.Free;
  9990. ParamContext.Setter.Free;
  9991. FullGetter.Free;
  9992. end;
  9993. ParamContext.Free;
  9994. end;
  9995. end;
  9996. function TPasToJSConverter.ConvertExceptOn(El: TPasImplExceptOn;
  9997. AContext: TConvertContext): TJSElement;
  9998. // convert "on T do ;" to "if(T.isPrototypeOf(exceptObject)){}"
  9999. // convert "on E:T do ;" to "if(T.isPrototypeOf(exceptObject)){ var E=exceptObject; }"
  10000. Var
  10001. IfSt : TJSIfStatement;
  10002. ListFirst , ListLast: TJSStatementList;
  10003. DotExpr: TJSDotMemberExpression;
  10004. Call: TJSCallExpression;
  10005. V: TJSVariableStatement;
  10006. begin
  10007. Result:=nil;
  10008. // create "if()"
  10009. IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,El));
  10010. try
  10011. // create "T.isPrototypeOf"
  10012. DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
  10013. DotExpr.MExpr:=CreateReferencePathExpr(El.TypeEl,AContext);
  10014. DotExpr.Name:='isPrototypeOf';
  10015. // create "T.isPrototypeOf(exceptObject)"
  10016. Call:=CreateCallExpression(El);
  10017. Call.Expr:=DotExpr;
  10018. Call.AddArg(CreateBuiltInIdentifierExpr(FBuiltInNames[pbivnExceptObject]));
  10019. IfSt.Cond:=Call;
  10020. if El.VarEl<>nil then
  10021. begin
  10022. // add "var E=exceptObject;"
  10023. ListFirst:=TJSStatementList(CreateElement(TJSStatementList,El.Body));
  10024. ListLast:=ListFirst;
  10025. IfSt.BTrue:=ListFirst;
  10026. V:=CreateVarStatement(TransformVariableName(El,El.VariableName,AContext),
  10027. CreateBuiltInIdentifierExpr(FBuiltInNames[pbivnExceptObject]),El);
  10028. ListFirst.A:=V;
  10029. // add statements
  10030. AddToStatementList(ListFirst,ListLast,ConvertElement(El.Body,AContext),El);
  10031. end
  10032. else if El.Body<>nil then
  10033. // add statements
  10034. IfSt.BTrue:=ConvertElement(El.Body,AContext);
  10035. Result:=IfSt;
  10036. finally
  10037. if Result=nil then
  10038. IfSt.Free;
  10039. end;
  10040. end;
  10041. function TPasToJSConverter.ConvertStatement(El: TPasImplStatement;
  10042. AContext: TConvertContext): TJSElement;
  10043. begin
  10044. Result:=Nil;
  10045. if (El is TPasImplRaise) then
  10046. Result:=ConvertRaiseStatement(TPasImplRaise(El),AContext)
  10047. else if (El is TPasImplAssign) then
  10048. Result:=ConvertAssignStatement(TPasImplAssign(El),AContext)
  10049. else if (El is TPasImplWhileDo) then
  10050. Result:=ConvertWhileStatement(TPasImplWhileDo(El),AContext)
  10051. else if (El is TPasImplSimple) then
  10052. Result:=ConvertSimpleStatement(TPasImplSimple(El),AContext)
  10053. else if (El is TPasImplWithDo) then
  10054. Result:=ConvertWithStatement(TPasImplWithDo(El),AContext)
  10055. else if (El is TPasImplExceptOn) then
  10056. Result:=ConvertExceptOn(TPasImplExceptOn(El),AContext)
  10057. else if (El is TPasImplForLoop) then
  10058. Result:=ConvertForStatement(TPasImplForLoop(El),AContext)
  10059. else if (El is TPasImplAsmStatement) then
  10060. Result:=ConvertAsmStatement(TPasImplAsmStatement(El),AContext)
  10061. else
  10062. RaiseNotSupported(El,AContext,20161024192759);
  10063. {
  10064. TPasImplCaseStatement = class(TPasImplStatement)
  10065. }
  10066. end;
  10067. function TPasToJSConverter.ConvertCommands(El: TPasImplCommands;
  10068. AContext: TConvertContext): TJSElement;
  10069. begin
  10070. RaiseNotSupported(El,AContext,20161024192806);
  10071. Result:=Nil;
  10072. // ToDo: TPasImplCommands = class(TPasImplElement)
  10073. end;
  10074. function TPasToJSConverter.ConvertConst(El: TPasConst; AContext: TConvertContext
  10075. ): TJSElement;
  10076. // Important: returns nil if const was added to higher context
  10077. Var
  10078. AssignSt: TJSSimpleAssignStatement;
  10079. Obj: TJSObjectLiteral;
  10080. ObjLit: TJSObjectLiteralElement;
  10081. ConstContext: TFunctionContext;
  10082. C: TJSElement;
  10083. V: TJSVariableStatement;
  10084. Src: TJSSourceElements;
  10085. begin
  10086. Result:=nil;
  10087. if not AContext.IsSingleton then
  10088. begin
  10089. // local const are stored in interface/implementation
  10090. ConstContext:=AContext.GetSingletonFunc;
  10091. if not (ConstContext.JSElement is TJSSourceElements) then
  10092. begin
  10093. {$IFDEF VerbosePas2JS}
  10094. writeln('TPasToJSConverter.CreateConstDecl ConstContext=',GetObjName(ConstContext),' JSElement=',GetObjName(ConstContext.JSElement));
  10095. {$ENDIF}
  10096. RaiseNotSupported(El,AContext,20170220153216);
  10097. end;
  10098. Src:=TJSSourceElements(ConstContext.JSElement);
  10099. C:=ConvertVariable(El,AContext);
  10100. V:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
  10101. V.A:=C;
  10102. AddToSourceElements(Src,V);
  10103. end
  10104. else if AContext is TObjectContext then
  10105. begin
  10106. // create 'A: initvalue'
  10107. Obj:=TObjectContext(AContext).JSElement as TJSObjectLiteral;
  10108. ObjLit:=Obj.Elements.AddElement;
  10109. ObjLit.Name:=TJSString(TransformVariableName(El,AContext));
  10110. ObjLit.Expr:=CreateVarInit(El,AContext);
  10111. end
  10112. else
  10113. begin
  10114. // create 'this.A=initvalue'
  10115. AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
  10116. Result:=AssignSt;
  10117. AssignSt.LHS:=CreateDeclNameExpression(El,El.Name,AContext);
  10118. AssignSt.Expr:=CreateVarInit(El,AContext);
  10119. end;
  10120. end;
  10121. function TPasToJSConverter.ConvertLabelMark(El: TPasImplLabelMark;
  10122. AContext: TConvertContext): TJSElement;
  10123. begin
  10124. RaiseNotSupported(El,AContext,20161024192857);
  10125. Result:=Nil;
  10126. // ToDo: TPasImplLabelMark = class(TPasImplLabelMark) then
  10127. end;
  10128. function TPasToJSConverter.ConvertElement(El: TPasElement;
  10129. AContext: TConvertContext): TJSElement;
  10130. var
  10131. C: TClass;
  10132. begin
  10133. {$IFDEF VerbosePas2JS}
  10134. writeln('TPasToJSConverter.ConvertElement El=',GetObjName(El),' Context=',GetObjName(AContext));
  10135. {$ENDIF}
  10136. if El=nil then
  10137. begin
  10138. Result:=nil;
  10139. RaiseInconsistency(20161024190203);
  10140. end;
  10141. C:=El.ClassType;
  10142. If (C=TPasPackage) then
  10143. Result:=ConvertPackage(TPasPackage(El),AContext)
  10144. else if (C=TPasResString) then
  10145. Result:=ConvertResString(TPasResString(El),AContext)
  10146. else if (C=TPasConst) then
  10147. Result:=ConvertConst(TPasConst(El),AContext)
  10148. else if (C=TPasProperty) then
  10149. Result:=ConvertProperty(TPasProperty(El),AContext)
  10150. else if (C=TPasVariable) then
  10151. Result:=ConvertVariable(TPasVariable(El),AContext)
  10152. else if (C=TPasExportSymbol) then
  10153. Result:=ConvertExportSymbol(TPasExportSymbol(El),AContext)
  10154. else if (C=TPasLabels) then
  10155. Result:=ConvertLabels(TPasLabels(El),AContext)
  10156. else if (C=TPasImplCommand) then
  10157. Result:=ConvertCommand(TPasImplCommand(El),AContext)
  10158. else if (C=TPasImplCommands) then
  10159. Result:=ConvertCommands(TPasImplCommands(El),AContext)
  10160. else if (C=TPasImplLabelMark) then
  10161. Result:=ConvertLabelMark(TPasImplLabelMark(El),AContext)
  10162. else if C.InheritsFrom(TPasExpr) then
  10163. Result:=ConvertExpression(TPasExpr(El),AContext)
  10164. else if C.InheritsFrom(TPasDeclarations) then
  10165. Result:=ConvertDeclarations(TPasDeclarations(El),AContext)
  10166. else if C.InheritsFrom(TPasProcedure) then
  10167. Result:=ConvertProcedure(TPasProcedure(El),AContext)
  10168. else if C.InheritsFrom(TPasImplBlock) then
  10169. Result:=ConvertImplBlock(TPasImplBlock(El),AContext)
  10170. else if C.InheritsFrom(TPasModule) then
  10171. Result:=ConvertModule(TPasModule(El),AContext)
  10172. else
  10173. begin
  10174. Result:=nil;
  10175. RaiseNotSupported(El, AContext, 20161024190449);
  10176. end;
  10177. {$IFDEF VerbosePas2JS}
  10178. writeln('TPasToJSConverter.ConvertElement END ',GetObjName(El));
  10179. {$ENDIF}
  10180. end;
  10181. function TPasToJSConverter.ConvertRecordType(El: TPasRecordType;
  10182. AContext: TConvertContext): TJSElement;
  10183. (*
  10184. type
  10185. TMyRecord = record
  10186. i: longint;
  10187. s: string;
  10188. d: double;
  10189. r: TOtherRecord;
  10190. end;
  10191. this.TMyRecord=function(s) {
  10192. if (s){
  10193. this.i = s.i;
  10194. this.s = s.s;
  10195. this.d = s.d;
  10196. this.r = new this.TOtherRecord(s.r);
  10197. } else {
  10198. this.i = 0;
  10199. this.s = "";
  10200. this.d = 0.0;
  10201. this.r = new this.TOtherRecord();
  10202. };
  10203. this.$equal = function(b){
  10204. return (this.i == b.i) && (this.s == b.s) && (this.d == b.d)
  10205. && (this.r.$equal(b.r))
  10206. };
  10207. };
  10208. *)
  10209. const
  10210. SrcParamName = 's';
  10211. EqualParamName = 'b';
  10212. procedure AddCloneStatements(IfSt: TJSIfStatement;
  10213. FuncContext: TFunctionContext);
  10214. var
  10215. i: Integer;
  10216. PasVar: TPasVariable;
  10217. VarAssignSt: TJSSimpleAssignStatement;
  10218. First, Last: TJSStatementList;
  10219. VarDotExpr: TJSDotMemberExpression;
  10220. PasVarType: TPasType;
  10221. ResolvedPasVar: TPasResolverResult;
  10222. begin
  10223. // init members with s
  10224. First:=nil;
  10225. Last:=nil;
  10226. for i:=0 to El.Members.Count-1 do
  10227. begin
  10228. PasVar:=TPasVariable(El.Members[i]);
  10229. if not IsElementUsed(PasVar) then continue;
  10230. // create 'this.A = s.A;'
  10231. VarAssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,PasVar));
  10232. AddToStatementList(First,Last,VarAssignSt,PasVar);
  10233. if i=0 then IfSt.BTrue:=First;
  10234. VarAssignSt.LHS:=CreateDeclNameExpression(PasVar,PasVar.Name,FuncContext);
  10235. VarDotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,PasVar));
  10236. VarAssignSt.Expr:=VarDotExpr;
  10237. VarDotExpr.MExpr:=CreateBuiltInIdentifierExpr(SrcParamName);
  10238. VarDotExpr.Name:=TJSString(TransformVariableName(PasVar,FuncContext));
  10239. if (AContext.Resolver<>nil) then
  10240. begin
  10241. PasVarType:=AContext.Resolver.ResolveAliasType(PasVar.VarType);
  10242. if PasVarType.ClassType=TPasRecordType then
  10243. begin
  10244. SetResolverIdentifier(ResolvedPasVar,btContext,PasVar,PasVarType,[rrfReadable,rrfWritable]);
  10245. VarAssignSt.Expr:=CreateCloneRecord(PasVar,ResolvedPasVar,VarDotExpr,FuncContext);
  10246. continue;
  10247. end
  10248. else if PasVarType.ClassType=TPasSetType then
  10249. begin
  10250. VarAssignSt.Expr:=CreateReferencedSet(PasVar,VarDotExpr);
  10251. continue;
  10252. end
  10253. end;
  10254. end;
  10255. end;
  10256. procedure AddInitDefaultStatements(IfSt: TJSIfStatement;
  10257. FuncContext: TFunctionContext);
  10258. var
  10259. i: Integer;
  10260. PasVar: TPasVariable;
  10261. JSVar: TJSElement;
  10262. First, Last: TJSStatementList;
  10263. begin
  10264. // the "else" part:
  10265. // when there is no s parameter, init members with default value
  10266. First:=nil;
  10267. Last:=nil;
  10268. for i:=0 to El.Members.Count-1 do
  10269. begin
  10270. PasVar:=TPasVariable(El.Members[i]);
  10271. if not IsElementUsed(PasVar) then continue;
  10272. JSVar:=CreateVarDecl(PasVar,FuncContext);
  10273. AddToStatementList(First,Last,JSVar,PasVar);
  10274. if IfSt.BFalse=nil then
  10275. IfSt.BFalse:=First;
  10276. end;
  10277. end;
  10278. procedure Add_AndExpr_ToReturnSt(RetSt: TJSReturnStatement;
  10279. PasVar: TPasVariable; var LastAndExpr: TJSLogicalAndExpression;
  10280. Expr: TJSElement);
  10281. var
  10282. AndExpr: TJSLogicalAndExpression;
  10283. begin
  10284. if RetSt.Expr=nil then
  10285. RetSt.Expr:=Expr
  10286. else
  10287. begin
  10288. AndExpr:=TJSLogicalAndExpression(CreateElement(TJSLogicalAndExpression,PasVar));
  10289. if LastAndExpr=nil then
  10290. begin
  10291. AndExpr.A:=RetSt.Expr;
  10292. RetSt.Expr:=AndExpr;
  10293. end
  10294. else
  10295. begin
  10296. AndExpr.A:=LastAndExpr.B;
  10297. LastAndExpr.B:=AndExpr;
  10298. end;
  10299. AndExpr.B:=Expr;
  10300. LastAndExpr:=AndExpr;
  10301. end;
  10302. end;
  10303. procedure AddEqualFunction(var BodyFirst, BodyLast: TJSStatementList;
  10304. FuncContext: TFunctionContext);
  10305. // add equal function:
  10306. // this.$equal = function(b){
  10307. // return (this.member1 == b.member1);
  10308. // };
  10309. var
  10310. AssignSt: TJSSimpleAssignStatement;
  10311. FD: TJSFuncDef;
  10312. RetSt: TJSReturnStatement;
  10313. i: Integer;
  10314. PasVar: TPasVariable;
  10315. FDS: TJSFunctionDeclarationStatement;
  10316. EqExpr: TJSEqualityExpressionEQ;
  10317. LastAndExpr: TJSLogicalAndExpression;
  10318. VarType: TPasType;
  10319. Call: TJSCallExpression;
  10320. VarName: String;
  10321. begin
  10322. // add "this.$equal ="
  10323. AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
  10324. AssignSt.LHS:=CreateMemberExpression(['this',FBuiltInNames[pbifnRecordEqual]]);
  10325. AddToStatementList(BodyFirst,BodyLast,AssignSt,El);
  10326. // add "function(b){"
  10327. FDS:=CreateFunction(El);
  10328. AssignSt.Expr:=FDS;
  10329. FD:=FDS.AFunction;
  10330. FD.Params.Add(EqualParamName);
  10331. FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,El));
  10332. // add "return "
  10333. RetSt:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
  10334. FD.Body.A:=RetSt;
  10335. LastAndExpr:=nil;
  10336. for i:=0 to El.Members.Count-1 do
  10337. begin
  10338. PasVar:=TPasVariable(El.Members[i]);
  10339. if not IsElementUsed(PasVar) then continue;
  10340. // "this.member = b.member;"
  10341. VarType:=PasVar.VarType;
  10342. if FuncContext.Resolver<>nil then
  10343. VarType:=FuncContext.Resolver.ResolveAliasType(VarType);
  10344. VarName:=TransformVariableName(PasVar,FuncContext);
  10345. if VarType.ClassType=TPasRecordType then
  10346. begin
  10347. // record
  10348. // add "this.member.$equal(b.member)"
  10349. Call:=CreateCallExpression(PasVar);
  10350. Add_AndExpr_ToReturnSt(RetSt,PasVar,LastAndExpr,Call);
  10351. Call.Expr:=CreateMemberExpression(['this',VarName,FBuiltInNames[pbifnRecordEqual]]);
  10352. Call.AddArg(CreateMemberExpression([EqualParamName,VarName]));
  10353. end
  10354. else if VarType.ClassType=TPasSetType then
  10355. begin
  10356. // set
  10357. // add "rtl.eqSet(this.member,b.member)"
  10358. Call:=CreateCallExpression(PasVar);
  10359. Add_AndExpr_ToReturnSt(RetSt,PasVar,LastAndExpr,Call);
  10360. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSet_Equal]]);
  10361. Call.AddArg(CreateMemberExpression(['this',VarName]));
  10362. Call.AddArg(CreateMemberExpression([EqualParamName,VarName]));
  10363. end
  10364. else if VarType is TPasProcedureType then
  10365. begin
  10366. // proc type
  10367. // add "rtl.eqCallback(this.member,b.member)"
  10368. Call:=CreateCallExpression(PasVar);
  10369. Add_AndExpr_ToReturnSt(RetSt,PasVar,LastAndExpr,Call);
  10370. Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnProcType_Equal]]);
  10371. Call.AddArg(CreateMemberExpression(['this',VarName]));
  10372. Call.AddArg(CreateMemberExpression([EqualParamName,VarName]));
  10373. end
  10374. else
  10375. begin
  10376. // default: use simple equal "=="
  10377. EqExpr:=TJSEqualityExpressionEQ(CreateElement(TJSEqualityExpressionEQ,PasVar));
  10378. Add_AndExpr_ToReturnSt(RetSt,PasVar,LastAndExpr,EqExpr);
  10379. EqExpr.A:=CreateMemberExpression(['this',VarName]);
  10380. EqExpr.B:=CreateMemberExpression([EqualParamName,VarName]);
  10381. end;
  10382. end;
  10383. end;
  10384. procedure AddRTTIFields(Args: TJSArguments);
  10385. var
  10386. i: Integer;
  10387. PasVar: TPasVariable;
  10388. begin
  10389. for i:=0 to El.Members.Count-1 do
  10390. begin
  10391. PasVar:=TPasVariable(El.Members[i]);
  10392. if not IsElementUsed(PasVar) then continue;
  10393. // add quoted "fieldname"
  10394. Args.AddElement(CreateLiteralString(PasVar,TransformVariableName(PasVar,AContext)));
  10395. // add typeinfo ref
  10396. Args.AddElement(CreateTypeInfoRef(PasVar.VarType,AContext,PasVar));
  10397. end;
  10398. end;
  10399. var
  10400. AssignSt: TJSSimpleAssignStatement;
  10401. FDS: TJSFunctionDeclarationStatement;
  10402. FD: TJSFuncDef;
  10403. BodyFirst, BodyLast, List: TJSStatementList;
  10404. FuncContext: TFunctionContext;
  10405. ObjLit: TJSObjectLiteral;
  10406. ObjEl: TJSObjectLiteralElement;
  10407. IfSt: TJSIfStatement;
  10408. Call: TJSCallExpression;
  10409. ok: Boolean;
  10410. begin
  10411. Result:=nil;
  10412. FuncContext:=nil;
  10413. ok:=false;
  10414. try
  10415. FDS:=CreateFunction(El);
  10416. if AContext is TObjectContext then
  10417. begin
  10418. // add 'TypeName: function(){}'
  10419. ObjLit:=TObjectContext(AContext).JSElement as TJSObjectLiteral;
  10420. Result:=ObjLit;
  10421. ObjEl:=ObjLit.Elements.AddElement;
  10422. ObjEl.Name:=TJSString(TransformVariableName(El,AContext));
  10423. ObjEl.Expr:=FDS;
  10424. end
  10425. else
  10426. begin
  10427. // add 'this.TypeName = function(){}'
  10428. AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
  10429. Result:=AssignSt;
  10430. AssignSt.LHS:=CreateDeclNameExpression(El,El.Name,AContext);
  10431. AssignSt.Expr:=FDS;
  10432. end;
  10433. FD:=FDS.AFunction;
  10434. // add param s
  10435. FD.Params.Add(SrcParamName);
  10436. // create function body
  10437. FuncContext:=TFunctionContext.Create(El,FD.Body,AContext);
  10438. FuncContext.This:=El;
  10439. FuncContext.IsSingleton:=true;
  10440. if El.Members.Count>0 then
  10441. begin
  10442. BodyFirst:=nil;
  10443. BodyLast:=nil;
  10444. // add if(s)
  10445. IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,El));
  10446. AddToStatementList(BodyFirst,BodyLast,IfSt,El);
  10447. FD.Body.A:=BodyFirst;
  10448. IfSt.Cond:=CreateBuiltInIdentifierExpr(SrcParamName);
  10449. // add clone statements
  10450. AddCloneStatements(IfSt,FuncContext);
  10451. // add init default statements
  10452. AddInitDefaultStatements(IfSt,FuncContext);
  10453. // add equal function
  10454. AddEqualFunction(BodyFirst,BodyLast,FuncContext);
  10455. end;
  10456. if HasTypeInfo(El,AContext) then
  10457. begin
  10458. // add $rtti as second statement
  10459. if not (AContext is TFunctionContext) then
  10460. RaiseNotSupported(El,AContext,20170412120012);
  10461. List:=TJSStatementList(CreateElement(TJSStatementList,El));
  10462. List.A:=Result;
  10463. Result:=List;
  10464. // module.$rtti.$Record("typename",{});
  10465. Call:=CreateRTTINewType(El,FBuiltInNames[pbifnRTTINewRecord],false,AContext,ObjLit);
  10466. List.B:=Call;
  10467. if ObjLit=nil then
  10468. RaiseInconsistency(20170412124804);
  10469. if El.Members.Count>0 then
  10470. begin
  10471. // module.$rtti.$Record("typename",{}).addFields(
  10472. // "fieldname1",type1,"fieldname2",type2,...
  10473. // );
  10474. Call:=CreateCallExpression(El);
  10475. Call.Expr:=CreateDotExpression(El,List.B,
  10476. CreateBuiltInIdentifierExpr(FBuiltInNames[pbifnRTTIAddFields]));
  10477. List.B:=Call;
  10478. AddRTTIFields(Call.Args);
  10479. end;
  10480. end;
  10481. ok:=true;;
  10482. finally
  10483. FuncContext.Free;
  10484. if not ok then
  10485. FreeAndNil(Result);
  10486. end;
  10487. end;
  10488. procedure TPasToJSConverter.DoError(Id: int64; const Msg: String);
  10489. var
  10490. E: EPas2JS;
  10491. begin
  10492. E:=EPas2JS.Create(Msg);
  10493. E.Id:=Id;
  10494. E.MsgType:=mtError;
  10495. Raise E;
  10496. end;
  10497. procedure TPasToJSConverter.DoError(Id: int64; const Msg: String;
  10498. const Args: array of const);
  10499. var
  10500. E: EPas2JS;
  10501. begin
  10502. E:=EPas2JS.CreateFmt(Msg,Args);
  10503. E.Id:=Id;
  10504. E.MsgType:=mtError;
  10505. Raise E;
  10506. end;
  10507. procedure TPasToJSConverter.DoError(Id: int64; MsgNumber: integer;
  10508. const MsgPattern: string; const Args: array of const; El: TPasElement);
  10509. var
  10510. E: EPas2JS;
  10511. begin
  10512. E:=EPas2JS.CreateFmt(MsgPattern,Args);
  10513. {$IFDEF VerbosePas2JS}
  10514. writeln('TPasToJSConverter.DoError ',id,' ',El.FullName,':',El.ClassName,' Msg="',E.Message,'"');
  10515. {$ENDIF}
  10516. E.PasElement:=El;
  10517. E.MsgNumber:=MsgNumber;
  10518. E.Id:=Id;
  10519. E.MsgType:=mtError;
  10520. CreateMsgArgs(E.Args,Args);
  10521. raise E;
  10522. end;
  10523. procedure TPasToJSConverter.RaiseNotSupported(El: TPasElement;
  10524. AContext: TConvertContext; Id: int64; const Msg: string);
  10525. var
  10526. E: EPas2JS;
  10527. begin
  10528. {$IFDEF VerbosePas2JS}
  10529. writeln('TPasToJSConverter.RaiseNotSupported ',id,' ',El.FullName,':',El.ClassName,' Msg="',Msg,'"');
  10530. {$ENDIF}
  10531. if AContext=nil then ;
  10532. E:=EPas2JS.CreateFmt(sPasElementNotSupported,[GetObjName(El)]);
  10533. if Msg<>'' then
  10534. E.Message:=E.Message+': '+Msg;
  10535. E.PasElement:=El;
  10536. E.MsgNumber:=nPasElementNotSupported;
  10537. SetLength(E.Args,1);
  10538. E.Args[0]:=El.ClassName;
  10539. E.Id:=Id;
  10540. E.MsgType:=mtError;
  10541. raise E;
  10542. end;
  10543. procedure TPasToJSConverter.RaiseIdentifierNotFound(Identifier: string;
  10544. El: TPasElement; Id: int64);
  10545. var
  10546. E: EPas2JS;
  10547. begin
  10548. E:=EPas2JS.CreateFmt(sIdentifierNotFound,[Identifier]);
  10549. E.PasElement:=El;
  10550. E.MsgNumber:=nIdentifierNotFound;
  10551. SetLength(E.Args,1);
  10552. E.Args[0]:=Identifier;
  10553. E.Id:=Id;
  10554. E.MsgType:=mtError;
  10555. raise E;
  10556. end;
  10557. function TPasToJSConverter.TransformVariableName(El: TPasElement;
  10558. const AName: String; AContext: TConvertContext): String;
  10559. var
  10560. i: Integer;
  10561. c: Char;
  10562. begin
  10563. if AContext=nil then ;
  10564. if Pos('.',AName)>0 then
  10565. RaiseInconsistency(20170203164711);
  10566. if UseLowerCase then
  10567. Result:=LowerCase(AName)
  10568. else
  10569. Result:=AName;
  10570. if not IsPreservedWord(Result) then
  10571. exit;
  10572. for i:=1 to length(Result) do
  10573. begin
  10574. c:=Result[i];
  10575. case c of
  10576. 'a'..'z','A'..'Z':
  10577. begin
  10578. Result[i]:=chr(ord(c) xor 32);
  10579. if not IsPreservedWord(Result) then
  10580. exit;
  10581. end;
  10582. end;
  10583. end;
  10584. RaiseNotSupported(El,AContext,20170203131832);
  10585. end;
  10586. function TPasToJSConverter.TransformVariableName(El: TPasElement;
  10587. AContext: TConvertContext): String;
  10588. begin
  10589. if (El is TPasProcedure) and (TPasProcedure(El).LibrarySymbolName<>nil) then
  10590. Result:=ComputeConstString(TPasProcedure(El).LibrarySymbolName,AContext,true)
  10591. else if (El is TPasVariable) and (TPasVariable(El).ExportName<>nil) then
  10592. Result:=ComputeConstString(TPasVariable(El).ExportName,AContext,true)
  10593. else
  10594. Result:=TransformVariableName(El,El.Name,AContext);
  10595. end;
  10596. function TPasToJSConverter.TransformModuleName(El: TPasModule;
  10597. AContext: TConvertContext): String;
  10598. begin
  10599. if El is TPasProgram then
  10600. Result:='program'
  10601. else
  10602. Result:=TransformVariableName(El,AContext);
  10603. end;
  10604. function TPasToJSConverter.IsPreservedWord(const aName: string): boolean;
  10605. var
  10606. l, r, m, cmp: Integer;
  10607. begin
  10608. Result:=true;
  10609. if aName=FBuiltInNames[pbivnModules] then exit;
  10610. if aName=FBuiltInNames[pbivnRTL] then exit;
  10611. // search default list
  10612. l:=low(JSReservedWords);
  10613. r:=high(JSReservedWords);
  10614. while l<=r do
  10615. begin
  10616. m:=(l+r) div 2;
  10617. cmp:=CompareStr(aName,JSReservedWords[m]);
  10618. //writeln('TPasToJSConverter.IsPreservedWord Name="',aName,'" l=',l,' r=',r,' m=',m,' JSReservedWords[m]=',JSReservedWords[m],' cmp=',cmp);
  10619. if cmp>0 then
  10620. l:=m+1
  10621. else if cmp<0 then
  10622. r:=m-1
  10623. else
  10624. exit;
  10625. end;
  10626. // search user list
  10627. l:=0;
  10628. r:=length(FPreservedWords)-1;
  10629. while l<=r do
  10630. begin
  10631. m:=(l+r) div 2;
  10632. cmp:=CompareStr(aName,FPreservedWords[m]);
  10633. //writeln('TPasToJSConverter.IsPreservedWord Name="',aName,'" l=',l,' r=',r,' m=',m,' FReservedWords[m]=',FReservedWords[m],' cmp=',cmp);
  10634. if cmp>0 then
  10635. l:=m+1
  10636. else if cmp<0 then
  10637. r:=m-1
  10638. else
  10639. exit;
  10640. end;
  10641. Result:=false;
  10642. end;
  10643. function TPasToJSConverter.ConvertPasElement(El: TPasElement;
  10644. Resolver: TPas2JSResolver): TJSElement;
  10645. var
  10646. aContext: TRootContext;
  10647. begin
  10648. aContext:=TRootContext.Create(El,nil,nil);
  10649. try
  10650. aContext.Resolver:=Resolver;
  10651. if (El.ClassType=TPasImplBeginBlock) then
  10652. Result:=ConvertBeginEndStatement(TPasImplBeginBlock(El),AContext,false)
  10653. else
  10654. Result:=ConvertElement(El,aContext);
  10655. finally
  10656. FreeAndNil(aContext);
  10657. end;
  10658. end;
  10659. var
  10660. i: integer;
  10661. initialization
  10662. for i:=low(JSReservedWords) to High(JSReservedWords)-1 do
  10663. if CompareStr(JSReservedWords[i],JSReservedWords[i+1])>=0 then
  10664. raise Exception.Create('20170203135442 '+JSReservedWords[i]+' >= '+JSReservedWords[i+1]);
  10665. end.