pasresolveeval.pas 183 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781
  1. {
  2. This file is part of the Free Component Library
  3. Pascal source parser
  4. Copyright (c) 2017 by Mattias Gaertner, [email protected]
  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. Abstract:
  12. Evaluation of Pascal constants.
  13. Works:
  14. - Emitting range check warnings
  15. - Error on overflow
  16. - bool:
  17. - not, =, <>, and, or, xor, low(), high(), pred(), succ(), ord()
  18. - boolean(0), boolean(1)
  19. - int/uint
  20. - unary +, -
  21. - binary: +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not, shl, shr
  22. - low(), high(), pred(), succ(), ord()
  23. - typecast longint(-1), word(-2), intsingle(-1), uintsingle(1)
  24. - float:
  25. - typecast single(double), double(single), float(integer)
  26. - +, -, /, *, =, <>, <, >, <=, >=
  27. - string:
  28. - #65, '', 'a', 'ab'
  29. - +, =, <>, <, >, <=, >=
  30. - pred(), succ(), chr(), ord(), low(char), high(char)
  31. - s[]
  32. - length(string)
  33. - #$DC00
  34. - unicodestring
  35. - enum
  36. - ord(), low(), high(), pred(), succ()
  37. - typecast enumtype(integer)
  38. - set of enum, set of char, set of bool, set of int
  39. - [a,b,c..d]
  40. - +, -, *, ><, =, <>, >=, <=, in
  41. - error on duplicate in const set
  42. - arrays
  43. - length()
  44. - array of int, charm enum, bool
  45. ToDo:
  46. - arrays
  47. - [], [a..b], multi dim [a,b], concat with +
  48. - array of record
  49. - array of string
  50. - error on: array[1..2] of longint = (1,2,3);
  51. - anonymous enum range: type f=(a,b,c,d); g=b..c;
  52. }
  53. unit PasResolveEval;
  54. {$mode objfpc}{$H+}
  55. {$ifdef fpc}
  56. {$define UsePChar}
  57. {$endif}
  58. {$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF}
  59. {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
  60. interface
  61. uses
  62. Sysutils, Math, PasTree, PScanner;
  63. // message numbers
  64. const
  65. nIdentifierNotFound = 3001;
  66. nNotYetImplemented = 3002;
  67. nIllegalQualifier = 3003;
  68. nSyntaxErrorExpectedButFound = 3004;
  69. nWrongNumberOfParametersForCallTo = 3005;
  70. nIncompatibleTypeArgNo = 3006;
  71. nIncompatibleTypeArgNoVarParamMustMatchExactly = 3007;
  72. nVariableIdentifierExpected = 3008;
  73. nDuplicateIdentifier = 3009;
  74. nXExpectedButYFound = 3010;
  75. nAncestorCycleDetected = 3011;
  76. nCantUseForwardDeclarationAsAncestor = 3012;
  77. nCantDetermineWhichOverloadedFunctionToCall = 3013;
  78. nForwardTypeNotResolved = 3014;
  79. nForwardProcNotResolved = 3015;
  80. nInvalidXModifierY = 3016;
  81. nAbstractMethodsMustNotHaveImplementation = 3017;
  82. nCallingConventionMismatch = 3018;
  83. nResultTypeMismatchExpectedButFound = 3019;
  84. nFunctionHeaderMismatchForwardVarName = 3020;
  85. nFunctionHidesIdentifier_NonVirtualMethod = 3021;
  86. nNoMethodInAncestorToOverride = 3022;
  87. nInheritedOnlyWorksInMethods = 3023;
  88. nInheritedNeedsAncestor = 3024;
  89. nNoPropertyFoundToOverride = 3025;
  90. nExprTypeMustBeClassOrRecordTypeGot = 3026;
  91. nPropertyNotWritable = 3027;
  92. nIncompatibleTypesGotExpected = 3028;
  93. nTypesAreNotRelatedXY = 3029;
  94. nAbstractMethodsCannotBeCalledDirectly = 3030;
  95. nMissingParameterX = 3031;
  96. nCannotAccessThisMemberFromAX = 3032;
  97. nInOperatorExpectsSetElementButGot = 3033;
  98. nWrongNumberOfParametersForTypeCast = 3034;
  99. nIllegalTypeConversionTo = 3035;
  100. nConstantExpressionExpected = 3036;
  101. nLeftSideOfIsOperatorExpectsAClassButGot = 3037;
  102. nNotReadable = 3038;
  103. nClassPropertyAccessorMustBeStatic = 3039;
  104. nClassPropertyAccessorMustNotBeStatic = 3040;
  105. nOnlyOneDefaultPropertyIsAllowed = 3041;
  106. nWrongNumberOfParametersForArray = 3042;
  107. nCantAssignValuesToAnAddress = 3043;
  108. nIllegalExpression = 3044;
  109. nCantAccessXMember = 3045;
  110. nMustBeInsideALoop = 3046;
  111. nExpectXArrayElementsButFoundY = 3047;
  112. nCannotCreateADescendantOfTheSealedXY = 3048;
  113. nAncestorIsNotExternal = 3049;
  114. nPropertyMustHaveReadOrWrite = 3050;
  115. nExternalClassInstanceCannotAccessStaticX = 3051;
  116. nXModifierMismatchY = 3052;
  117. nSymbolCannotBePublished = 3053;
  118. nCannotTypecastAType = 3054;
  119. nTypeIdentifierExpected = 3055;
  120. nCannotNestAnonymousX = 3056;
  121. nFoundCallCandidateX = 3057;
  122. nTextAfterFinalIgnored = 3058;
  123. nNoMemberIsProvidedToAccessProperty = 3059;
  124. nTheUseOfXisNotAllowedInARecord = 3060;
  125. nParameterlessConstructorsNotAllowedInRecords = 3061;
  126. nMultipleXinTypeYNameZCAandB = 3062;
  127. nXCannotHaveParameters = 3063;
  128. nRangeCheckError = 3064;
  129. nHighRangeLimitLTLowRangeLimit = 3065;
  130. nRangeCheckEvaluatingConstantsVMinMax = 3066;
  131. nIllegalChar = 3067;
  132. nOverflowInArithmeticOperation = 3068;
  133. nDivByZero = 3069;
  134. nRangeCheckInSetConstructor = 3070;
  135. nIncompatibleTypesGotParametersExpected = 3071;
  136. nAddingIndexSpecifierRequiresNewX = 3072;
  137. nCantFindUnitX = 3073;
  138. nCannotFindEnumeratorForType = 3074;
  139. nPreviousDeclMissesOverload = 3075;
  140. nOverloadedProcMissesOverload = 3076;
  141. nMethodHidesMethodOfBaseType = 3077;
  142. nContextExpectedXButFoundY = 3078;
  143. nContextXInvalidY = 3079;
  144. nIdentifierXIsNotAnInstanceField = 3080;
  145. nXIsNotSupported = 3081;
  146. nOperatorIsNotOverloadedAOpB = 3082;
  147. nIllegalQualifierAfter = 3084;
  148. nIllegalQualifierInFrontOf = 3085;
  149. nIllegalQualifierWithin = 3086;
  150. nMethodClassXInOtherUnitY = 3087;
  151. nClassMethodsMustBeStaticInRecords = 3088;
  152. nCannotMixMethodResolutionAndDelegationAtX = 3089;
  153. nImplementsDoesNotSupportArrayProperty = 3101;
  154. nImplementsDoesNotSupportIndex = 3102;
  155. nImplementsUsedOnUnimplIntf = 3103;
  156. nDuplicateImplementsForIntf = 3103;
  157. nImplPropMustHaveReadSpec = 3104;
  158. nDoesNotImplementInterface = 3105;
  159. nTypeCycleFound = 3106;
  160. nTypeXIsNotYetCompletelyDefined = 3107;
  161. nDuplicateCaseValueXatY = 3108;
  162. nMissingFieldsX = 3109;
  163. nCantAssignValuesToConstVariable = 3110;
  164. nIllegalAssignmentToForLoopVar = 3111;
  165. nFunctionHidesIdentifier_NonProc = 3112;
  166. nTypeXCannotBeExtendedByATypeHelper = 3113;
  167. nDerivedXMustExtendASubClassY = 3114;
  168. nDefaultPropertyNotAllowedInHelperForX = 3115;
  169. nHelpersCannotBeUsedAsTypes = 3116;
  170. nBitWiseOperationsAre32Bit = 3117;
  171. // using same IDs as FPC
  172. nVirtualMethodXHasLowerVisibility = 3250; // was 3050
  173. nConstructingClassXWithAbstractMethodY = 4046; // was 3080
  174. nNoMatchingImplForIntfMethodXFound = 5042; // was 3088
  175. nSymbolXIsDeprecated = 5043; // was 3062
  176. nSymbolXBelongsToALibrary = 5065; // was 3061
  177. nSymbolXIsDeprecatedY = 5066; // 3063
  178. nSymbolXIsNotPortable = 5076; // was 3058
  179. nSymbolXIsNotImplemented = 5078; // was 3060
  180. nSymbolXIsExperimental = 5079; // was 3059
  181. // resourcestring patterns of messages
  182. resourcestring
  183. sIdentifierNotFound = 'identifier not found "%s"';
  184. sNotYetImplemented = 'not yet implemented: %s';
  185. sIllegalQualifier = 'illegal qualifier "%s"';
  186. sSyntaxErrorExpectedButFound = 'Syntax error, "%s" expected but "%s" found';
  187. sWrongNumberOfParametersForCallTo = 'Wrong number of parameters specified for call to "%s"';
  188. sIncompatibleTypeArgNo = 'Incompatible type arg no. %s: Got "%s", expected "%s"';
  189. sIncompatibleTypeArgNoVarParamMustMatchExactly = 'Incompatible type arg no. %s: Got "%s", expected "%s". Var param must match exactly.';
  190. sVariableIdentifierExpected = 'Variable identifier expected';
  191. sDuplicateIdentifier = 'Duplicate identifier "%s" at %s';
  192. sXExpectedButYFound = '%s expected, but %s found';
  193. sAncestorCycleDetected = 'Ancestor cycle detected';
  194. sCantUseForwardDeclarationAsAncestor = 'Can''t use forward declaration "%s" as ancestor';
  195. sCantDetermineWhichOverloadedFunctionToCall = 'Can''t determine which overloaded function to call';
  196. sForwardTypeNotResolved = 'Forward type not resolved "%s"';
  197. sForwardProcNotResolved = 'Forward %s not resolved "%s"';
  198. sInvalidXModifierY = 'Invalid %s modifier %s';
  199. sAbstractMethodsMustNotHaveImplementation = 'Abstract method must not have an implementation.';
  200. sCallingConventionMismatch = 'Calling convention mismatch';
  201. sResultTypeMismatchExpectedButFound = 'Result type mismatch, expected %s, but found %s';
  202. sFunctionHeaderMismatchForwardVarName = 'function header "%s" doesn''t match forward : var name changes %s => %s';
  203. sFunctionHidesIdentifier = 'function hides identifier at "%s". Use overload or reintroduce';
  204. sNoMethodInAncestorToOverride = 'There is no method in an ancestor class to be overridden "%s"';
  205. sInheritedOnlyWorksInMethods = 'Inherited works only in methods';
  206. sInheritedNeedsAncestor = 'inherited needs an ancestor';
  207. sNoPropertyFoundToOverride = 'No property found to override';
  208. sExprTypeMustBeClassOrRecordTypeGot = 'Expression type must be class or record type, got %s';
  209. sPropertyNotWritable = 'No member is provided to access property';
  210. sIncompatibleTypesGotExpected = 'Incompatible types: got "%s" expected "%s"';
  211. sTypesAreNotRelatedXY = 'Types are not related: "%s" and "%s"';
  212. sAbstractMethodsCannotBeCalledDirectly = 'Abstract methods cannot be called directly';
  213. sMissingParameterX = 'Missing parameter %s';
  214. sCannotAccessThisMemberFromAX = 'Cannot access this member from a %s';
  215. sInOperatorExpectsSetElementButGot = 'the in-operator expects a set element, but got %s';
  216. sWrongNumberOfParametersForTypeCast = 'wrong number of parameters for type cast to %s';
  217. sIllegalTypeConversionTo = 'Illegal type conversion: "%s" to "%s"';
  218. sConstantExpressionExpected = 'Constant expression expected';
  219. sLeftSideOfIsOperatorExpectsAClassButGot = 'left side of is-operator expects a class, but got "%s"';
  220. sNotReadable = 'not readable';
  221. sClassPropertyAccessorMustBeStatic = 'class property accessor must be static';
  222. sClassPropertyAccessorMustNotBeStatic = 'class property accessor must not be static';
  223. sOnlyOneDefaultPropertyIsAllowed = 'Only one default property is allowed';
  224. sWrongNumberOfParametersForArray = 'Wrong number of parameters for array';
  225. sCantAssignValuesToAnAddress = 'Can''t assign values to an address';
  226. sIllegalExpression = 'Illegal expression';
  227. sCantAccessXMember = 'Can''t access %s member %s';
  228. sMustBeInsideALoop = '%s must be inside a loop';
  229. sExpectXArrayElementsButFoundY = 'Expect %s array elements, but found %s';
  230. sCannotCreateADescendantOfTheSealedXY = 'Cannot create a descendant of the sealed %s "%s"';
  231. sAncestorIsNotExternal = 'Ancestor "%s" is not external';
  232. sPropertyMustHaveReadOrWrite = 'Property must have read or write accessor';
  233. sVirtualMethodXHasLowerVisibility = 'Virtual method "%s" has a lower visibility (%s) than parent class %s (%s)';
  234. sExternalClassInstanceCannotAccessStaticX = 'External class instance cannot access static %s';
  235. sXModifierMismatchY = '%s modifier "%s" mismatch';
  236. sSymbolCannotBePublished = 'Symbol cannot be published';
  237. sCannotTypecastAType = 'Cannot type cast a type';
  238. sTypeIdentifierExpected = 'Type identifier expected';
  239. sCannotNestAnonymousX = 'Cannot nest anonymous %s';
  240. sFoundCallCandidateX = 'Found call candidate %s';
  241. sTextAfterFinalIgnored = 'Text after final ''end.''. ignored by compiler';
  242. sNoMemberIsProvidedToAccessProperty = 'No member is provided to access property';
  243. sTheUseOfXisNotAllowedInARecord = 'The use of "%s" is not allowed in a record';
  244. sParameterlessConstructorsNotAllowedInRecords = 'Parameterless constructors are not allowed in records or record/type helpers';
  245. sMultipleXinTypeYNameZCAandB = 'Multiple %s in %s %s: %s and %s';
  246. sXCannotHaveParameters = '%s cannot have parameters';
  247. sSymbolXIsNotPortable = 'Symbol "%s" is not portable';
  248. sSymbolXIsExperimental = 'Symbol "%s" is experimental';
  249. sSymbolXIsNotImplemented = 'Symbol "%s" is not implemented';
  250. sSymbolXBelongsToALibrary = 'Symbol "%s" belongs to a library';
  251. sSymbolXIsDeprecated = 'Symbol "%s" is deprecated';
  252. sSymbolXIsDeprecatedY = 'Symbol "%s" is deprecated: %s';
  253. sRangeCheckError = 'Range check error';
  254. sHighRangeLimitLTLowRangeLimit = 'High range limit < low range limit';
  255. sRangeCheckEvaluatingConstantsVMinMax = 'range check error while evaluating constants (%s is not between %s and %s)';
  256. sIllegalChar = 'Illegal character';
  257. sOverflowInArithmeticOperation = 'Overflow in arithmetic operation';
  258. sDivByZero = 'Division by zero';
  259. sRangeCheckInSetConstructor = 'range check error in set constructor or duplicate set element';
  260. sIncompatibleTypesGotParametersExpected = 'Incompatible types, got %s parameters, expected %s';
  261. sAddingIndexSpecifierRequiresNewX = 'adding index specifier requires new "%s" specifier';
  262. sCantFindUnitX = 'can''t find unit "%s"';
  263. sCannotFindEnumeratorForType = 'Cannot find an enumerator for the type "%s"';
  264. sPreviousDeclMissesOverload = 'Previous declaration of "%s" at %s was not marked with "overload" directive';
  265. sOverloadedProcMissesOverload = 'Overloaded procedure misses "overload" directive. Previous declaration is at %s';
  266. sMethodHidesMethodOfBaseType = 'Method "%s" hides method of base type "%s" at %s';
  267. sContextExpectedXButFoundY = '%s: expected "%s", but found "%s"';
  268. sContextXInvalidY = '%s: invalid %s';
  269. sIdentifierXIsNotAnInstanceField = 'Identifier "%s" is not an instance field';
  270. sConstructingClassXWithAbstractMethodY = 'Constructing a class "%s" with abstract method "%s"';
  271. sXIsNotSupported = '%s is not supported';
  272. sOperatorIsNotOverloadedAOpB = 'Operator is not overloaded: "%s" %s "%s"';
  273. sIllegalQualifierAfter = 'illegal qualifier "%s" after "%s"';
  274. sIllegalQualifierInFrontOf = 'illegal qualifier "%s" in front of "%s"';
  275. sIllegalQualifierWithin = 'illegal qualifier "%s" within "%s"';
  276. sMethodClassXInOtherUnitY = 'method class "%s" in other unit "%s"';
  277. sNoMatchingImplForIntfMethodXFound = 'No matching implementation for interface method "%s" found';
  278. sClassMethodsMustBeStaticInRecords = 'Class methods must be static in records';
  279. sCannotMixMethodResolutionAndDelegationAtX = 'Cannot mix method resolution and delegation at %s';
  280. sImplementsDoesNotSupportArrayProperty = '"implements" does dot support array property';
  281. sImplementsDoesNotSupportIndex = '"implements" does not support "index"';
  282. sImplementsUsedOnUnimplIntf = 'Implements-property used on unimplemented interface: "%"';
  283. sDuplicateImplementsForIntf = 'Duplicate implements for interface "%s" at %s';
  284. sImplPropMustHaveReadSpec = 'Implements-property must have read specifier';
  285. sDoesNotImplementInterface = '"%s" does not implement interface "%s"';
  286. sTypeCycleFound = 'Type cycle found';
  287. sTypeXIsNotYetCompletelyDefined = 'type "%s" is not yet completely defined';
  288. sDuplicateCaseValueXatY = 'Duplicate case value "%s", other at %s';
  289. sMissingFieldsX = 'Missing fields: "%s"';
  290. sCantAssignValuesToConstVariable = 'Can''t assign values to const variable';
  291. sIllegalAssignmentToForLoopVar = 'Illegal assignment to for-loop variable "%s"';
  292. sTypeXCannotBeExtendedByATypeHelper = 'Type "%s" cannot be extended by a type helper';
  293. sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself';
  294. sDefaultPropertyNotAllowedInHelperForX = 'Default property not allowed in helper for %s';
  295. sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';
  296. sBitWiseOperationsAre32Bit = 'Bitwise operations are 32-bit';
  297. type
  298. { TResolveData - base class for data stored in TPasElement.CustomData }
  299. TResolveData = Class(TPasElementBase)
  300. private
  301. FElement: TPasElement;
  302. procedure SetElement(AValue: TPasElement);
  303. public
  304. Owner: TObject; // e.g. a TPasResolver
  305. Next: TResolveData; // TPasResolver uses this for its memory chain
  306. constructor Create; virtual;
  307. destructor Destroy; override;
  308. property Element: TPasElement read FElement write SetElement;// Element.CustomData=Self
  309. end;
  310. TResolveDataClass = class of TResolveData;
  311. type
  312. {$ifdef pas2js}
  313. TMaxPrecInt = nativeint;
  314. TMaxPrecUInt = NativeUInt;
  315. TMaxPrecFloat = double;
  316. {$else}
  317. TMaxPrecInt = int64;
  318. TMaxPrecUInt = qword;
  319. TMaxPrecFloat = extended;
  320. {$endif}
  321. TMaxPrecCurrency = currency;
  322. {$ifdef fpc}
  323. PMaxPrecInt = ^TMaxPrecInt;
  324. PMaxPrecUInt = ^TMaxPrecUInt;
  325. PMaxPrecFloat = ^TMaxPrecFloat;
  326. PMaxPrecCurrency = ^TMaxPrecCurrency;
  327. {$endif}
  328. const
  329. // Note: when FPC compares int64 with qword it converts the qword to an int64,
  330. // possibly resulting in a range check error -> using a qword const instead
  331. HighIntAsUInt = TMaxPrecUInt(High(TMaxPrecInt));
  332. const
  333. MinSafeIntCurrency = -922337203685477; // .5808
  334. MaxSafeIntCurrency = 922337203685477; // .5807
  335. MinSafeIntSingle = -16777216;
  336. MaxSafeIntSingle = 16777216;
  337. MaskUIntSingle = $3fffff;
  338. MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
  339. MaxSafeIntDouble = $fffffffffffff; // 4503599627370495
  340. MaskUIntDouble = $fffffffffffff;
  341. type
  342. { TResEvalValue }
  343. TREVKind = (
  344. revkNone,
  345. revkCustom,
  346. revkNil, // TResEvalValue
  347. revkBool, // TResEvalBool
  348. revkInt, // TResEvalInt
  349. revkUInt, // TResEvalUInt
  350. revkFloat, // TResEvalFloat
  351. revkCurrency, // TResEvalCurrency
  352. {$ifdef FPC_HAS_CPSTRING}
  353. revkString, // TResEvalString rawbytestring
  354. {$endif}
  355. revkUnicodeString, // TResEvalUTF16
  356. revkEnum, // TResEvalEnum
  357. revkRangeInt, // TResEvalRangeInt: range of enum, int, char, widechar, e.g. 1..2
  358. revkRangeUInt, // TResEvalRangeUInt: range of uint, e.g. 1..2
  359. revkSetOfInt, // set of enum, int, char, widechar, e.g. [1,2..3]
  360. revkExternal // TResEvalExternal: an external const
  361. );
  362. const
  363. revkAllStrings = [{$ifdef FPC_HAS_CPSTRING}revkString,{$endif}revkUnicodeString];
  364. type
  365. TResEvalValue = class(TResolveData)
  366. public
  367. Kind: TREVKind;
  368. IdentEl: TPasElement;
  369. // Note: "Element" is used when the TResEvalValue is stored as CustomData of an Element
  370. constructor CreateKind(const aKind: TREVKind);
  371. function Clone: TResEvalValue; virtual;
  372. function AsDebugString: string; virtual;
  373. function AsString: string; virtual;
  374. end;
  375. TResEvalValueClass = class of TResEvalValue;
  376. { TResEvalBool }
  377. TResEvalBool = class(TResEvalValue)
  378. public
  379. B: boolean;
  380. constructor Create; override;
  381. constructor CreateValue(const aValue: boolean);
  382. function Clone: TResEvalValue; override;
  383. function AsString: string; override;
  384. end;
  385. TResEvalTypedInt = (
  386. reitNone,
  387. reitByte,
  388. reitShortInt,
  389. reitWord,
  390. reitSmallInt,
  391. reitUIntSingle,
  392. reitIntSingle,
  393. reitLongWord,
  394. reitLongInt,
  395. reitUIntDouble,
  396. reitIntDouble);
  397. TResEvalTypedInts = set of TResEvalTypedInt;
  398. const
  399. reitDefaults = [reitNone,reitByte,reitShortInt,reitWord,reitSmallInt,reitLongWord,reitLongInt];
  400. reitAllSigned = [reitNone,reitShortInt,reitSmallInt,reitIntSingle,reitLongInt,reitIntDouble];
  401. reitAllUnsigned = [reitByte,reitWord,reitUIntSingle,reitLongWord,reitUIntDouble];
  402. reitLow: array[TResEvalTypedInt] of TMaxPrecInt = (
  403. low(TMaxPrecInt), // reitNone,
  404. low(Byte), // reitByte,
  405. low(ShortInt), // reitShortInt,
  406. low(Word), // reitWord,
  407. low(SmallInt), // reitSmallInt,
  408. 0, // reitUIntSingle,
  409. MinSafeIntSingle, // reitIntSingle,
  410. low(LongWord), // reitLongWord,
  411. low(LongInt), // reitLongInt,
  412. 0, // reitUIntDouble,
  413. MinSafeIntDouble // reitIntDouble)
  414. );
  415. reitHigh: array[TResEvalTypedInt] of TMaxPrecInt = (
  416. high(TMaxPrecInt), // reitNone,
  417. high(Byte), // reitByte,
  418. high(ShortInt), // reitShortInt,
  419. high(Word), // reitWord,
  420. high(SmallInt), // reitSmallInt,
  421. MaxSafeIntSingle, // reitUIntSingle,
  422. MaxSafeIntSingle, // reitIntSingle,
  423. high(LongWord), // reitLongWord,
  424. high(LongInt), // reitLongInt,
  425. MaxSafeIntDouble, // reitUIntDouble,
  426. MaxSafeIntDouble // reitIntDouble)
  427. );
  428. type
  429. { TResEvalInt }
  430. TResEvalInt = class(TResEvalValue)
  431. public
  432. Int: TMaxPrecInt;
  433. Typed: TResEvalTypedInt;
  434. constructor Create; override;
  435. constructor CreateValue(const aValue: TMaxPrecInt);
  436. constructor CreateValue(const aValue: TMaxPrecInt; aTyped: TResEvalTypedInt);
  437. function Clone: TResEvalValue; override;
  438. function AsString: string; override;
  439. function AsDebugString: string; override;
  440. end;
  441. { TResEvalUInt }
  442. TResEvalUInt = class(TResEvalValue)
  443. public
  444. UInt: TMaxPrecUInt;
  445. constructor Create; override;
  446. constructor CreateValue(const aValue: TMaxPrecUInt);
  447. function Clone: TResEvalValue; override;
  448. function AsString: string; override;
  449. end;
  450. { TResEvalFloat }
  451. TResEvalFloat = class(TResEvalValue)
  452. public
  453. FloatValue: TMaxPrecFloat;
  454. constructor Create; override;
  455. constructor CreateValue(const aValue: TMaxPrecFloat);
  456. function Clone: TResEvalValue; override;
  457. function AsString: string; override;
  458. function IsInt(out Int: TMaxPrecInt): boolean;
  459. end;
  460. { TResEvalCurrency }
  461. TResEvalCurrency = class(TResEvalValue)
  462. public
  463. Value: TMaxPrecCurrency;
  464. constructor Create; override;
  465. constructor CreateValue(const aValue: TMaxPrecCurrency);
  466. function Clone: TResEvalValue; override;
  467. function AsString: string; override;
  468. function IsInt(out Int: TMaxPrecInt): boolean;
  469. function AsInt: TMaxPrecInt; // value * 10.000
  470. end;
  471. {$ifdef FPC_HAS_CPSTRING}
  472. { TResEvalString - Kind=revkString }
  473. TResEvalString = class(TResEvalValue)
  474. public
  475. S: RawByteString;
  476. constructor Create; override;
  477. constructor CreateValue(const aValue: RawByteString);
  478. function Clone: TResEvalValue; override;
  479. function AsString: string; override;
  480. end;
  481. {$endif}
  482. { TResEvalUTF16 - Kind=revkUnicodeString }
  483. TResEvalUTF16 = class(TResEvalValue)
  484. public
  485. S: UnicodeString;
  486. constructor Create; override;
  487. constructor CreateValue(const aValue: UnicodeString);
  488. function Clone: TResEvalValue; override;
  489. function AsString: string; override;
  490. end;
  491. { TResEvalEnum - Kind=revkEnum, Value.Int }
  492. TResEvalEnum = class(TResEvalValue)
  493. public
  494. Index: integer; // Beware: might be outside TPasEnumType
  495. ElType: TPasEnumType; // TPasEnumType
  496. constructor Create; override;
  497. constructor CreateValue(const aValue: integer; aIdentEl: TPasEnumValue);
  498. function GetEnumValue: TPasEnumValue;
  499. function GetEnumName: String;
  500. function Clone: TResEvalValue; override;
  501. function AsDebugString: string; override;
  502. function AsString: string; override;
  503. end;
  504. TRESetElKind = (
  505. revskNone,
  506. revskEnum, // ElType is TPasEnumType
  507. revskInt,
  508. revskChar,
  509. revskBool
  510. );
  511. { TResEvalRangeInt - Kind=revkRangeInt }
  512. TResEvalRangeInt = class(TResEvalValue)
  513. public
  514. ElKind: TRESetElKind;
  515. RangeStart, RangeEnd: TMaxPrecInt;
  516. ElType: TPasType; // revskEnum: TPasEnumType
  517. constructor Create; override;
  518. constructor CreateValue(const aElKind: TRESetElKind; aElType: TPasType;
  519. const aRangeStart, aRangeEnd: TMaxPrecInt); virtual;
  520. function Clone: TResEvalValue; override;
  521. function AsString: string; override;
  522. function AsDebugString: string; override;
  523. function ElementAsString(El: TMaxPrecInt): string; virtual;
  524. end;
  525. { TResEvalRangeUInt }
  526. TResEvalRangeUInt = class(TResEvalValue)
  527. public
  528. RangeStart, RangeEnd: TMaxPrecUInt;
  529. constructor Create; override;
  530. constructor CreateValue(const aRangeStart, aRangeEnd: TMaxPrecUInt);
  531. function Clone: TResEvalValue; override;
  532. function AsString: string; override;
  533. end;
  534. { TResEvalSet - Kind=revkSetOfInt }
  535. TResEvalSet = class(TResEvalRangeInt)
  536. public
  537. const MaxCount = $ffff;
  538. type
  539. TItem = record
  540. RangeStart, RangeEnd: TMaxPrecInt;
  541. end;
  542. TItems = array of TItem;
  543. public
  544. Ranges: TItems; // disjunct, sorted ascending
  545. constructor Create; override;
  546. constructor CreateEmpty(const aElKind: TRESetElKind; aElType: TPasType = nil);
  547. constructor CreateEmptySameKind(aSet: TResEvalSet);
  548. constructor CreateValue(const aElKind: TRESetElKind; aElType: TPasType;
  549. const aRangeStart, aRangeEnd: TMaxPrecInt); override;
  550. function Clone: TResEvalValue; override;
  551. function AsString: string; override;
  552. function Add(aRangeStart, aRangeEnd: TMaxPrecInt): boolean; // false if duplicate ignored
  553. function IndexOfRange(Index: TMaxPrecInt; FindInsertPos: boolean = false): integer;
  554. function Intersects(aRangeStart, aRangeEnd: TMaxPrecInt): integer; // returns index of first intersecting range
  555. procedure ConsistencyCheck;
  556. end;
  557. { TResEvalExternal }
  558. TResEvalExternal = class(TResEvalValue)
  559. public
  560. constructor Create; override;
  561. function Clone: TResEvalValue; override;
  562. function AsString: string; override;
  563. end;
  564. TResEvalFlag = (
  565. refConst, // computing a const, error if a value is not const
  566. refConstExt, // as refConst, except allow external const
  567. refAutoConst, // set refConst if in a const
  568. refAutoConstExt // set refConstExt if in a const
  569. );
  570. TResEvalFlags = set of TResEvalFlag;
  571. TResExprEvaluator = class;
  572. TPasResEvalLogHandler = procedure(Sender: TResExprEvaluator; const id: TMaxPrecInt;
  573. MsgType: TMessageType; MsgNumber: integer;
  574. const Fmt: String; Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif}; PosEl: TPasElement) of object;
  575. TPasResEvalIdentHandler = function(Sender: TResExprEvaluator;
  576. Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue of object;
  577. TPasResEvalParamsHandler = function(Sender: TResExprEvaluator;
  578. Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue of object;
  579. TPasResEvalRangeCheckElHandler = procedure(Sender: TResExprEvaluator;
  580. El: TPasElement; var MsgType: TMessageType) of object;
  581. { TResExprEvaluator }
  582. TResExprEvaluator = class
  583. private
  584. FAllowedInts: TResEvalTypedInts;
  585. {$ifdef FPC_HAS_CPSTRING}
  586. FDefaultEncoding: TSystemCodePage;
  587. {$endif}
  588. FOnEvalIdentifier: TPasResEvalIdentHandler;
  589. FOnEvalParams: TPasResEvalParamsHandler;
  590. FOnLog: TPasResEvalLogHandler;
  591. FOnRangeCheckEl: TPasResEvalRangeCheckElHandler;
  592. protected
  593. procedure LogMsg(const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
  594. const Fmt: String; Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif}; PosEl: TPasElement); overload;
  595. procedure RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer; const Fmt: String;
  596. Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif}; ErrorPosEl: TPasElement);
  597. procedure RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement; Msg: string = ''); virtual;
  598. procedure RaiseInternalError(id: TMaxPrecInt; const Msg: string = '');
  599. procedure RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement);
  600. procedure RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
  601. procedure RaiseOverflowArithmetic(id: TMaxPrecInt; ErrorEl: TPasElement);
  602. procedure RaiseDivByZero(id: TMaxPrecInt; ErrorEl: TPasElement);
  603. function EvalUnaryExpr(Expr: TUnaryExpr; Flags: TResEvalFlags): TResEvalValue;
  604. function EvalBinaryExpr(Expr: TBinaryExpr; Flags: TResEvalFlags): TResEvalValue;
  605. function EvalBinaryRangeExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  606. function EvalBinaryAddExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  607. function EvalBinarySubExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  608. function EvalBinaryMulExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  609. function EvalBinaryDivideExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  610. function EvalBinaryDivExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  611. function EvalBinaryModExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  612. function EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  613. function EvalBinaryShiftExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  614. function EvalBinaryBoolOpExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  615. function EvalBinaryNEqualExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  616. function EvalBinaryLessGreaterExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  617. function EvalBinaryInExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  618. function EvalBinarySymmetricaldifferenceExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  619. function EvalParamsExpr(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
  620. function EvalArrayParamsExpr(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
  621. function EvalSetParamsExpr(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalSet;
  622. function EvalSetExpr(Expr: TPasExpr; ExprArray: TPasExprArray; Flags: TResEvalFlags): TResEvalSet;
  623. function EvalArrayValuesExpr(Expr: TArrayValues; Flags: TResEvalFlags): TResEvalSet;
  624. function ExprStringToOrd(Value: TResEvalValue; PosEl: TPasElement): longword; virtual;
  625. function EvalPrimitiveExprString(Expr: TPrimitiveExpr): TResEvalValue; virtual;
  626. procedure PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
  627. procedure SuccBool(Value: TResEvalBool; ErrorEl: TPasElement);
  628. procedure PredInt(Value: TResEvalInt; ErrorEl: TPasElement);
  629. procedure SuccInt(Value: TResEvalInt; ErrorEl: TPasElement);
  630. procedure PredUInt(Value: TResEvalUInt; ErrorEl: TPasElement);
  631. procedure SuccUInt(Value: TResEvalUInt; ErrorEl: TPasElement);
  632. {$ifdef FPC_HAS_CPSTRING}
  633. procedure PredString(Value: TResEvalString; ErrorEl: TPasElement);
  634. procedure SuccString(Value: TResEvalString; ErrorEl: TPasElement);
  635. {$endif}
  636. procedure PredUnicodeString(Value: TResEvalUTF16; ErrorEl: TPasElement);
  637. procedure SuccUnicodeString(Value: TResEvalUTF16; ErrorEl: TPasElement);
  638. procedure PredEnum(Value: TResEvalEnum; ErrorEl: TPasElement);
  639. procedure SuccEnum(Value: TResEvalEnum; ErrorEl: TPasElement);
  640. function CreateResEvalInt(UInt: TMaxPrecUInt): TResEvalValue; virtual;
  641. public
  642. constructor Create;
  643. function Eval(Expr: TPasExpr; Flags: TResEvalFlags): TResEvalValue;
  644. function IsInRange(Expr, RangeExpr: TPasExpr; EmitHints: boolean): boolean;
  645. function IsInRange(Value: TResEvalValue; ValueExpr: TPasExpr;
  646. RangeValue: TResEvalValue; RangeExpr: TPasExpr; EmitHints: boolean): boolean;
  647. function IsSetCompatible(Value: TResEvalValue; ValueExpr: TPasExpr;
  648. RangeValue: TResEvalValue; EmitHints: boolean): boolean;
  649. function IsConst(Expr: TPasExpr): boolean;
  650. function IsSimpleExpr(Expr: TPasExpr): boolean; // true = no need to store result
  651. procedure EmitRangeCheckConst(id: TMaxPrecInt; const aValue, MinVal, MaxVal: String;
  652. PosEl: TPasElement; MsgType: TMessageType = mtWarning); virtual;
  653. procedure EmitRangeCheckConst(id: TMaxPrecInt; const aValue: String;
  654. MinVal, MaxVal: TMaxPrecInt; PosEl: TPasElement; MsgType: TMessageType = mtWarning);
  655. function ChrValue(Value: TResEvalValue; ErrorEl: TPasElement): TResEvalValue; virtual;
  656. function OrdValue(Value: TResEvalValue; ErrorEl: TPasElement): TResEvalValue; virtual;
  657. procedure PredValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
  658. procedure SuccValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
  659. function EvalStrFunc(Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
  660. function EvalStringAddExpr(Expr, LeftExpr, RightExpr: TPasExpr;
  661. LeftValue, RightValue: TResEvalValue): TResEvalValue; virtual;
  662. function EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
  663. Flags: TResEvalFlags): TResEvalEnum; virtual;
  664. {$ifdef FPC_HAS_CPSTRING}
  665. function CheckValidUTF8(const s: RawByteString; ErrorEl: TPasElement): boolean;
  666. function GetCodePage(const s: RawByteString): TSystemCodePage;
  667. function GetUTF8Str(const s: RawByteString; ErrorEl: TPasElement): String;
  668. function GetUnicodeStr(const s: RawByteString; ErrorEl: TPasElement): UnicodeString;
  669. function GetWideChar(const s: RawByteString; out w: WideChar): boolean;
  670. {$endif}
  671. property OnLog: TPasResEvalLogHandler read FOnLog write FOnLog;
  672. property OnEvalIdentifier: TPasResEvalIdentHandler read FOnEvalIdentifier write FOnEvalIdentifier;
  673. property OnEvalParams: TPasResEvalParamsHandler read FOnEvalParams write FOnEvalParams;
  674. property OnRangeCheckEl: TPasResEvalRangeCheckElHandler read FOnRangeCheckEl write FOnRangeCheckEl;
  675. property AllowedInts: TResEvalTypedInts read FAllowedInts write FAllowedInts;
  676. {$ifdef FPC_HAS_CPSTRING}
  677. property DefaultStringCodePage: TSystemCodePage read FDefaultEncoding write FDefaultEncoding;
  678. {$endif}
  679. end;
  680. TResExprEvaluatorClass = class of TResExprEvaluator;
  681. procedure ReleaseEvalValue(var Value: TResEvalValue);
  682. {$ifdef FPC_HAS_CPSTRING}
  683. function RawStrToCaption(const r: RawByteString; MaxLength: integer): string;
  684. {$endif}
  685. function UnicodeStrToCaption(const u: UnicodeString; MaxLength: integer): Unicodestring;
  686. function CodePointToString(CodePoint: longword): String;
  687. function CodePointToUnicodeString(u: longword): UnicodeString;
  688. function GetObjName(o: TObject): string;
  689. function dbgs(const Flags: TResEvalFlags): string; overload;
  690. function dbgs(v: TResEvalValue): string; overload;
  691. implementation
  692. procedure ReleaseEvalValue(var Value: TResEvalValue);
  693. begin
  694. if Value=nil then exit;
  695. if Value.Element<>nil then exit;
  696. Value.{$ifdef pas2js}Destroy{$else}Free{$endif};
  697. Value:=nil;
  698. end;
  699. {$ifdef FPC_HAS_CPSTRING}
  700. function RawStrToCaption(const r: RawByteString; MaxLength: integer): string;
  701. var
  702. s: RawByteString;
  703. p: PAnsiChar;
  704. InLit: boolean;
  705. Len: integer;
  706. procedure AddHash(o: integer);
  707. var
  708. h: String;
  709. begin
  710. if (Result<>'') and InLit then
  711. begin
  712. Result:=Result+'''';
  713. inc(Len);
  714. InLit:=false;
  715. end;
  716. h:='#'+IntToStr(o);
  717. inc(Len,length(h));
  718. if Len<=MaxLength then
  719. Result:=Result+h;
  720. end;
  721. procedure AddLit(const Lit: string; CaptionLen: integer);
  722. begin
  723. if not InLit then
  724. begin
  725. Result:=Result+'''';
  726. inc(Len);
  727. InLit:=true;
  728. end;
  729. Result:=Result+Lit;
  730. inc(Len,CaptionLen);
  731. end;
  732. var
  733. l: SizeInt;
  734. CP: TSystemCodePage;
  735. EndP: PAnsiChar;
  736. begin
  737. Result:='';
  738. s:=r;
  739. CP:=StringCodePage(s);
  740. if (CP<>CP_ACP) and (CP<>CP_UTF8) then
  741. SetCodePage(s, CP_ACP, true);
  742. p:=PAnsiChar(s);
  743. EndP:=p+length(s);
  744. Len:=0;
  745. InLit:=false;
  746. while Len<MaxLength do
  747. case p^ of
  748. #0:
  749. begin
  750. if p-PAnsiChar(s)=length(s) then
  751. break;
  752. AddHash(0);
  753. inc(p);
  754. end;
  755. '''':
  756. begin
  757. AddLit('''''',2);
  758. inc(p);
  759. end;
  760. #1..#31,#127..#192:
  761. begin
  762. AddHash(ord(p^));
  763. inc(p);
  764. end
  765. else
  766. begin
  767. l:=Utf8CodePointLen(p,EndP-p,true);
  768. if l<=0 then
  769. begin
  770. // invalid
  771. AddHash(ord(p^));
  772. inc(p);
  773. end
  774. else
  775. begin
  776. AddLit(copy(s,p-PAnsiChar(s)+1,l),1);
  777. inc(p,l);
  778. end;
  779. end;
  780. end;
  781. if InLit then
  782. Result:=Result+'''';
  783. end;
  784. {$endif}
  785. function UnicodeStrToCaption(const u: UnicodeString; MaxLength: integer
  786. ): Unicodestring;
  787. var
  788. InLit: boolean;
  789. Len: integer;
  790. procedure AddHash(o: integer);
  791. var
  792. h: UnicodeString;
  793. begin
  794. if (Result<>'') and InLit then
  795. begin
  796. Result:=Result+'''';
  797. inc(Len);
  798. InLit:=false;
  799. end;
  800. h:='#'+UnicodeString(IntToStr(o));
  801. inc(Len,length(h));
  802. if Len<=MaxLength then
  803. Result:=Result+h;
  804. end;
  805. procedure AddLit(const Lit: Unicodestring; CaptionLen: integer);
  806. begin
  807. if not InLit then
  808. begin
  809. Result:=Result+'''';
  810. inc(Len);
  811. InLit:=true;
  812. end;
  813. Result:=Result+Lit;
  814. inc(Len,CaptionLen);
  815. end;
  816. var
  817. p: integer;
  818. begin
  819. Result:='';
  820. p:=1;
  821. Len:=0;
  822. InLit:=false;
  823. while (Len<MaxLength) and (p<=length(u)) do
  824. case u[p] of
  825. '''':
  826. begin
  827. AddLit('''''',2);
  828. inc(p);
  829. end;
  830. #0..#31,#127..#255,#$D800..#$ffff:
  831. begin
  832. AddHash(ord(u[p]));
  833. inc(p);
  834. end
  835. else
  836. begin
  837. AddLit(u[p],1);
  838. inc(p);
  839. end;
  840. end;
  841. if InLit then
  842. Result:=Result+'''';
  843. end;
  844. function CodePointToString(CodePoint: longword): String;
  845. begin
  846. case CodePoint of
  847. 0..$7f:
  848. begin
  849. Result:=char(byte(CodePoint));
  850. end;
  851. $80..$7ff:
  852. begin
  853. Result:=char(byte($c0 or (CodePoint shr 6)))
  854. +char(byte($80 or (CodePoint and $3f)));
  855. end;
  856. $800..$ffff:
  857. begin
  858. Result:=char(byte($e0 or (CodePoint shr 12)))
  859. +char(byte((CodePoint shr 6) and $3f) or $80)
  860. +char(byte(CodePoint and $3f) or $80);
  861. end;
  862. $10000..$10ffff:
  863. begin
  864. Result:=char(byte($f0 or (CodePoint shr 18)))
  865. +char(byte((CodePoint shr 12) and $3f) or $80)
  866. +char(byte((CodePoint shr 6) and $3f) or $80)
  867. +char(byte(CodePoint and $3f) or $80);
  868. end;
  869. else
  870. Result:='';
  871. end;
  872. end;
  873. function CodePointToUnicodeString(u: longword): UnicodeString;
  874. begin
  875. if u < $10000 then
  876. // Note: codepoints $D800 - $DFFF are reserved
  877. Result:=WideChar(u)
  878. else
  879. Result:=WideChar($D800+((u - $10000) shr 10))+WideChar($DC00+((u - $10000) and $3ff));
  880. end;
  881. function GetObjName(o: TObject): string;
  882. begin
  883. if o=nil then
  884. Result:='nil'
  885. else if o is TPasElement then
  886. Result:=TPasElement(o).Name+':'+o.ClassName
  887. else
  888. Result:=o.ClassName;
  889. end;
  890. function dbgs(const Flags: TResEvalFlags): string;
  891. var
  892. s: string;
  893. f: TResEvalFlag;
  894. begin
  895. Result:='';
  896. for f in Flags do
  897. if f in Flags then
  898. begin
  899. if Result<>'' then Result:=Result+',';
  900. str(f,s);
  901. Result:=Result+s;
  902. end;
  903. Result:='['+Result+']';
  904. end;
  905. function dbgs(v: TResEvalValue): string;
  906. begin
  907. if v=nil then
  908. Result:='nil'
  909. else
  910. Result:=v.AsDebugString;
  911. end;
  912. { TResEvalExternal }
  913. constructor TResEvalExternal.Create;
  914. begin
  915. inherited Create;
  916. Kind:=revkExternal;
  917. end;
  918. function TResEvalExternal.Clone: TResEvalValue;
  919. begin
  920. Result:=inherited Clone;
  921. end;
  922. function TResEvalExternal.AsString: string;
  923. begin
  924. Result:=inherited AsString;
  925. end;
  926. { TResEvalCurrency }
  927. constructor TResEvalCurrency.Create;
  928. begin
  929. inherited Create;
  930. Kind:=revkCurrency;
  931. end;
  932. constructor TResEvalCurrency.CreateValue(const aValue: TMaxPrecCurrency);
  933. begin
  934. Create;
  935. Value:=aValue;
  936. end;
  937. function TResEvalCurrency.Clone: TResEvalValue;
  938. begin
  939. Result:=inherited Clone;
  940. TResEvalCurrency(Result).Value:=Value;
  941. end;
  942. function TResEvalCurrency.AsString: string;
  943. begin
  944. str(Value,Result);
  945. end;
  946. function TResEvalCurrency.IsInt(out Int: TMaxPrecInt): boolean;
  947. var
  948. i: TMaxPrecInt;
  949. begin
  950. i:=AsInt;
  951. Result:=(i mod 10000)=0;
  952. Int:=i div 10000;
  953. end;
  954. function TResEvalCurrency.AsInt: TMaxPrecInt;
  955. begin
  956. {$ifdef pas2js}
  957. Result:=NativeInt(Value); // pas2js stores currency as a double with factor 10.000
  958. {$else}
  959. Result:=PInt64(@Value)^; // fpc stores currency as an int64 with factor 10.000
  960. {$endif};
  961. end;
  962. { TResEvalBool }
  963. constructor TResEvalBool.Create;
  964. begin
  965. inherited Create;
  966. Kind:=revkBool;
  967. end;
  968. constructor TResEvalBool.CreateValue(const aValue: boolean);
  969. begin
  970. Create;
  971. B:=aValue;
  972. end;
  973. function TResEvalBool.Clone: TResEvalValue;
  974. begin
  975. Result:=inherited Clone;
  976. TResEvalBool(Result).B:=B;
  977. end;
  978. function TResEvalBool.AsString: string;
  979. begin
  980. if B then
  981. Result:='true'
  982. else
  983. Result:='false';
  984. end;
  985. { TResEvalRangeUInt }
  986. constructor TResEvalRangeUInt.Create;
  987. begin
  988. inherited Create;
  989. Kind:=revkRangeInt;
  990. end;
  991. constructor TResEvalRangeUInt.CreateValue(const aRangeStart,
  992. aRangeEnd: TMaxPrecUInt);
  993. begin
  994. Create;
  995. RangeStart:=aRangeStart;
  996. RangeEnd:=aRangeEnd;
  997. end;
  998. function TResEvalRangeUInt.Clone: TResEvalValue;
  999. begin
  1000. Result:=inherited Clone;
  1001. TResEvalRangeUInt(Result).RangeStart:=RangeStart;
  1002. TResEvalRangeUInt(Result).RangeEnd:=RangeEnd;
  1003. end;
  1004. function TResEvalRangeUInt.AsString: string;
  1005. begin
  1006. Result:=IntToStr(RangeStart)+'..'+IntToStr(RangeEnd);
  1007. end;
  1008. { TResExprEvaluator }
  1009. procedure TResExprEvaluator.LogMsg(const id: TMaxPrecInt; MsgType: TMessageType;
  1010. MsgNumber: integer; const Fmt: String;
  1011. Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  1012. PosEl: TPasElement);
  1013. begin
  1014. OnLog(Self,id,MsgType,MsgNumber,Fmt,Args,PosEl);
  1015. end;
  1016. procedure TResExprEvaluator.RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer;
  1017. const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  1018. ErrorPosEl: TPasElement);
  1019. begin
  1020. LogMsg(id,mtError,MsgNumber,Fmt,Args,ErrorPosEl);
  1021. raise Exception.Create('['+IntToStr(id)+'] ('+IntToStr(MsgNumber)+') '+SafeFormat(Fmt,Args));
  1022. end;
  1023. procedure TResExprEvaluator.RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement;
  1024. Msg: string);
  1025. var
  1026. s: String;
  1027. begin
  1028. s:=sNotYetImplemented+' ['+IntToStr(id)+']';
  1029. if Msg<>'' then
  1030. s:=s+' '+Msg;
  1031. {$IFDEF VerbosePasResolver}
  1032. writeln('TResExprEvaluator.RaiseNotYetImplemented s="',s,'" El=',GetObjName(El));
  1033. {$ENDIF}
  1034. RaiseMsg(id,nNotYetImplemented,s,[GetObjName(El)],El);
  1035. end;
  1036. procedure TResExprEvaluator.RaiseInternalError(id: TMaxPrecInt; const Msg: string);
  1037. begin
  1038. raise Exception.Create('Internal error: ['+IntToStr(id)+'] '+Msg);
  1039. end;
  1040. procedure TResExprEvaluator.RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement
  1041. );
  1042. begin
  1043. RaiseMsg(id,nConstantExpressionExpected,sConstantExpressionExpected,[],ErrorEl);
  1044. end;
  1045. procedure TResExprEvaluator.RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
  1046. begin
  1047. RaiseMsg(id,nRangeCheckError,sRangeCheckError,[],ErrorEl);
  1048. end;
  1049. procedure TResExprEvaluator.RaiseOverflowArithmetic(id: TMaxPrecInt;
  1050. ErrorEl: TPasElement);
  1051. begin
  1052. RaiseMsg(id,nOverflowInArithmeticOperation,sOverflowInArithmeticOperation,[],ErrorEl);
  1053. end;
  1054. procedure TResExprEvaluator.RaiseDivByZero(id: TMaxPrecInt; ErrorEl: TPasElement);
  1055. begin
  1056. RaiseMsg(id,nDivByZero,sDivByZero,[],ErrorEl);
  1057. end;
  1058. function TResExprEvaluator.EvalUnaryExpr(Expr: TUnaryExpr; Flags: TResEvalFlags
  1059. ): TResEvalValue;
  1060. var
  1061. Int: TMaxPrecInt;
  1062. UInt: TMaxPrecUInt;
  1063. begin
  1064. Result:=Eval(Expr.Operand,Flags);
  1065. if Result=nil then exit;
  1066. {$IFDEF VerbosePasResEval}
  1067. writeln('TResExprEvaluator.EvalUnaryExpr ',OpcodeStrings[Expr.OpCode],' Value=',Result.AsDebugString);
  1068. {$ENDIF}
  1069. case Expr.OpCode of
  1070. eopAdd: ;
  1071. eopSubtract:
  1072. case Result.Kind of
  1073. revkInt:
  1074. begin
  1075. Int:=TResEvalInt(Result).Int;
  1076. if Int=0 then exit;
  1077. if Result.Element<>nil then
  1078. Result:=Result.Clone;
  1079. if (TResEvalInt(Result).Typed in reitAllSigned) then
  1080. begin
  1081. if Int=reitLow[TResEvalInt(Result).Typed] then
  1082. begin
  1083. // need higher precision
  1084. if TResEvalInt(Result).Typed<>reitNone then
  1085. // unsigned -> switch to untyped
  1086. TResEvalInt(Result).Typed:=reitNone
  1087. else
  1088. begin
  1089. // switch to float
  1090. ReleaseEvalValue(Result);
  1091. Result:=TResEvalFloat.CreateValue(-TMaxPrecFloat(low(TMaxPrecInt)));
  1092. exit;
  1093. end;
  1094. end;
  1095. end
  1096. else
  1097. begin
  1098. // unsigned -> switch to untyped
  1099. TResEvalInt(Result).Typed:=reitNone;
  1100. end ;
  1101. // negate
  1102. TResEvalInt(Result).Int:=-Int;
  1103. end;
  1104. revkUInt:
  1105. begin
  1106. UInt:=TResEvalUInt(Result).UInt;
  1107. if UInt=0 then exit;
  1108. if UInt<=High(TMaxPrecInt) then
  1109. begin
  1110. ReleaseEvalValue(Result);
  1111. Result:=TResEvalInt.CreateValue(-TMaxPrecInt(UInt));
  1112. end
  1113. else
  1114. begin
  1115. // switch to float
  1116. ReleaseEvalValue(Result);
  1117. Result:=TResEvalFloat.CreateValue(-TMaxPrecFloat(UInt));
  1118. end;
  1119. end;
  1120. revkFloat:
  1121. begin
  1122. if TResEvalFloat(Result).FloatValue=0 then exit;
  1123. if Result.Element<>nil then
  1124. Result:=Result.Clone;
  1125. TResEvalFloat(Result).FloatValue:=-TResEvalFloat(Result).FloatValue;
  1126. end;
  1127. revkCurrency:
  1128. begin
  1129. if TResEvalCurrency(Result).Value=0 then exit;
  1130. if Result.Element<>nil then
  1131. Result:=Result.Clone;
  1132. TResEvalCurrency(Result).Value:=-TResEvalCurrency(Result).Value;
  1133. end;
  1134. revkExternal:
  1135. exit;
  1136. else
  1137. begin
  1138. if Result.Element=nil then
  1139. Result.Free;
  1140. RaiseNotYetImplemented(20170518230738,Expr);
  1141. end;
  1142. end;
  1143. eopNot:
  1144. case Result.Kind of
  1145. revkBool:
  1146. begin
  1147. if Result.Element<>nil then
  1148. Result:=Result.Clone;
  1149. TResEvalBool(Result).B:=not TResEvalBool(Result).B;
  1150. end;
  1151. revkInt:
  1152. begin
  1153. if Result.Element<>nil then
  1154. Result:=Result.Clone;
  1155. case TResEvalInt(Result).Typed of
  1156. reitByte: TResEvalInt(Result).Int:=not byte(TResEvalInt(Result).Int);
  1157. reitShortInt: TResEvalInt(Result).Int:=not shortint(TResEvalInt(Result).Int);
  1158. reitWord: TResEvalInt(Result).Int:=not word(TResEvalInt(Result).Int);
  1159. reitSmallInt: TResEvalInt(Result).Int:=not smallint(TResEvalInt(Result).Int);
  1160. reitUIntSingle: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $3fffff;
  1161. reitIntSingle: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $7fffff;
  1162. reitLongWord: TResEvalInt(Result).Int:=not longword(TResEvalInt(Result).Int);
  1163. reitLongInt: TResEvalInt(Result).Int:=not longint(TResEvalInt(Result).Int);
  1164. reitUIntDouble: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $fffffffffffff;
  1165. reitIntDouble: {$ifdef fpc}TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $1fffffffffffff{$endif};
  1166. else TResEvalInt(Result).Int:=not TResEvalInt(Result).Int;
  1167. end;
  1168. end;
  1169. revkUInt:
  1170. begin
  1171. if Result.Element<>nil then
  1172. Result:=Result.Clone;
  1173. TResEvalUInt(Result).UInt:=not TResEvalUInt(Result).UInt;
  1174. end;
  1175. revkExternal:
  1176. exit;
  1177. else
  1178. begin
  1179. if Result.Element=nil then
  1180. Result.Free;
  1181. RaiseNotYetImplemented(20170518232804,Expr);
  1182. end;
  1183. end;
  1184. eopAddress:
  1185. begin
  1186. if Result.Element=nil then
  1187. Result.Free;
  1188. // @ operator requires a compiler (not just a resolver) -> return nil
  1189. Result:=TResEvalValue.CreateKind(revkNil);
  1190. end
  1191. else
  1192. RaiseNotYetImplemented(20170518232823,Expr,'operator='+OpcodeStrings[Expr.OpCode]);
  1193. end;
  1194. end;
  1195. function TResExprEvaluator.EvalBinaryExpr(Expr: TBinaryExpr;
  1196. Flags: TResEvalFlags): TResEvalValue;
  1197. var
  1198. LeftValue, RightValue: TResEvalValue;
  1199. begin
  1200. Result:=nil;
  1201. if (Expr.Kind=pekBinary) and (Expr.OpCode=eopSubIdent) then
  1202. begin
  1203. Result:=Eval(Expr.right,Flags);
  1204. exit;
  1205. end;
  1206. LeftValue:=nil;
  1207. RightValue:=nil;
  1208. try
  1209. LeftValue:=Eval(Expr.left,Flags);
  1210. if LeftValue=nil then exit;
  1211. RightValue:=Eval(Expr.right,Flags);
  1212. if RightValue=nil then exit;
  1213. if LeftValue.Kind=revkExternal then
  1214. begin
  1215. if [refConst,refConstExt]*Flags=[refConst] then
  1216. RaiseConstantExprExp(20181024134508,Expr.left);
  1217. Result:=LeftValue;
  1218. LeftValue:=nil;
  1219. exit;
  1220. end;
  1221. if RightValue.Kind=revkExternal then
  1222. begin
  1223. if [refConst,refConstExt]*Flags=[refConst] then
  1224. RaiseConstantExprExp(20181024134545,Expr.right);
  1225. Result:=RightValue;
  1226. RightValue:=nil;
  1227. exit;
  1228. end;
  1229. case Expr.Kind of
  1230. pekRange:
  1231. // leftvalue..rightvalue
  1232. Result:=EvalBinaryRangeExpr(Expr,LeftValue,RightValue);
  1233. pekBinary:
  1234. case Expr.OpCode of
  1235. eopAdd:
  1236. Result:=EvalBinaryAddExpr(Expr,LeftValue,RightValue);
  1237. eopSubtract:
  1238. Result:=EvalBinarySubExpr(Expr,LeftValue,RightValue);
  1239. eopMultiply:
  1240. Result:=EvalBinaryMulExpr(Expr,LeftValue,RightValue);
  1241. eopDivide:
  1242. Result:=EvalBinaryDivideExpr(Expr,LeftValue,RightValue);
  1243. eopDiv:
  1244. Result:=EvalBinaryDivExpr(Expr,LeftValue,RightValue);
  1245. eopMod:
  1246. Result:=EvalBinaryModExpr(Expr,LeftValue,RightValue);
  1247. eopPower:
  1248. Result:=EvalBinaryPowerExpr(Expr,LeftValue,RightValue);
  1249. eopShl,eopShr:
  1250. Result:=EvalBinaryShiftExpr(Expr,LeftValue,RightValue);
  1251. eopAnd,eopOr,eopXor:
  1252. Result:=EvalBinaryBoolOpExpr(Expr,LeftValue,RightValue);
  1253. eopEqual,eopNotEqual:
  1254. Result:=EvalBinaryNEqualExpr(Expr,LeftValue,RightValue);
  1255. eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual:
  1256. Result:=EvalBinaryLessGreaterExpr(Expr,LeftValue,RightValue);
  1257. eopIn:
  1258. Result:=EvalBinaryInExpr(Expr,LeftValue,RightValue);
  1259. eopSymmetricaldifference:
  1260. Result:=EvalBinarySymmetricaldifferenceExpr(Expr,LeftValue,RightValue);
  1261. else
  1262. {$IFDEF VerbosePasResolver}
  1263. writeln('TResExprEvaluator.EvalBinaryExpr Kind=',Expr.Kind,' Opcode=',OpcodeStrings[Expr.OpCode],' Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1264. {$ENDIF}
  1265. RaiseNotYetImplemented(20170530100823,Expr);
  1266. end;
  1267. else
  1268. {$IFDEF VerbosePasResolver}
  1269. writeln('TResExprEvaluator.EvalBinaryExpr Kind=',Expr.Kind,' Opcode=',OpcodeStrings[Expr.OpCode]);
  1270. {$ENDIF}
  1271. RaiseNotYetImplemented(20170530100827,Expr);
  1272. end;
  1273. {$IFDEF VerbosePasResEval}
  1274. {AllowWriteln}
  1275. if Result<>nil then
  1276. writeln('TResExprEvaluator.EvalBinaryExpr Left=',LeftValue.AsDebugString,' Opcode=',OpcodeStrings[Expr.OpCode],' Right=',RightValue.AsDebugString,' Result=',Result.AsDebugString)
  1277. else
  1278. writeln('TResExprEvaluator.EvalBinaryExpr Left=',LeftValue.AsDebugString,' Opcode=',OpcodeStrings[Expr.OpCode],' Right=',RightValue.AsDebugString,' Result not set');
  1279. {AllowWriteln-}
  1280. {$ENDIF}
  1281. finally
  1282. ReleaseEvalValue(LeftValue);
  1283. ReleaseEvalValue(RightValue);
  1284. end;
  1285. end;
  1286. function TResExprEvaluator.EvalBinaryRangeExpr(Expr: TBinaryExpr; LeftValue,
  1287. RightValue: TResEvalValue): TResEvalValue;
  1288. // LeftValue..RightValue
  1289. var
  1290. LeftInt, RightInt: TMaxPrecInt;
  1291. begin
  1292. case LeftValue.Kind of
  1293. revkBool:
  1294. if RightValue.Kind<>revkBool then
  1295. RaiseRangeCheck(20170714133017,Expr.Right)
  1296. else
  1297. begin
  1298. LeftInt:=ord(TResEvalBool(LeftValue).B);
  1299. RightInt:=ord(TResEvalBool(RightValue).B);
  1300. if LeftInt>RightInt then
  1301. RaiseMsg(20170714133540,nHighRangeLimitLTLowRangeLimit,
  1302. sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
  1303. Result:=TResEvalRangeInt.CreateValue(revskBool,nil,LeftInt,RightInt);
  1304. exit;
  1305. end;
  1306. revkInt:
  1307. if RightValue.Kind=revkInt then
  1308. begin
  1309. LeftInt:=TResEvalInt(LeftValue).Int;
  1310. RightInt:=TResEvalInt(RightValue).Int;
  1311. if LeftInt>RightInt then
  1312. RaiseMsg(20170518222939,nHighRangeLimitLTLowRangeLimit,
  1313. sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
  1314. Result:=TResEvalRangeInt.CreateValue(revskInt,nil,LeftInt,RightInt);
  1315. exit;
  1316. end
  1317. else if RightValue.Kind=revkUInt then
  1318. begin
  1319. // Note: when FPC compares int64 with qword it converts the qword to an int64
  1320. if TResEvalUInt(RightValue).UInt<=HighIntAsUInt then
  1321. begin
  1322. if TResEvalInt(LeftValue).Int>TResEvalUInt(RightValue).UInt then
  1323. RaiseMsg(20170519000235,nHighRangeLimitLTLowRangeLimit,
  1324. sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
  1325. Result:=TResEvalRangeInt.CreateValue(revskInt,nil,
  1326. TResEvalInt(LeftValue).Int,TMaxPrecInt(TResEvalUInt(RightValue).UInt));
  1327. exit;
  1328. end
  1329. else if TResEvalInt(LeftValue).Int<0 then
  1330. RaiseRangeCheck(20170522151629,Expr.Right)
  1331. else if TMaxPrecUInt(TResEvalInt(LeftValue).Int)>TResEvalUInt(RightValue).UInt then
  1332. RaiseMsg(20170522151708,nHighRangeLimitLTLowRangeLimit,
  1333. sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
  1334. Result:=TResEvalRangeUInt.CreateValue(TMaxPrecUInt(TResEvalInt(LeftValue).Int),
  1335. TResEvalUInt(RightValue).UInt);
  1336. exit;
  1337. end
  1338. else
  1339. RaiseRangeCheck(20170518222812,Expr.Right);
  1340. revkUInt:
  1341. if RightValue.Kind=revkInt then
  1342. begin
  1343. // Note: when FPC compares int64 with qword it converts the qword to an int64
  1344. if TResEvalUInt(LeftValue).UInt>HighIntAsUInt then
  1345. begin
  1346. if TResEvalInt(RightValue).Int<0 then
  1347. RaiseRangeCheck(20170522152608,Expr.Right)
  1348. else if TResEvalUInt(LeftValue).UInt>TMaxPrecUInt(TResEvalInt(RightValue).Int) then
  1349. RaiseMsg(20170522152648,nHighRangeLimitLTLowRangeLimit,
  1350. sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
  1351. Result:=TResEvalRangeUInt.CreateValue(TResEvalUInt(LeftValue).UInt,
  1352. TMaxPrecUInt(TResEvalInt(RightValue).Int));
  1353. exit;
  1354. end
  1355. else if TResEvalUInt(LeftValue).UInt>TResEvalInt(RightValue).Int then
  1356. RaiseMsg(20170522152804,nHighRangeLimitLTLowRangeLimit,
  1357. sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
  1358. Result:=TResEvalRangeInt.CreateValue(revskInt,nil,
  1359. TMaxPrecInt(TResEvalUInt(LeftValue).UInt),TResEvalInt(RightValue).Int);
  1360. exit;
  1361. end
  1362. else if RightValue.Kind=revkUInt then
  1363. begin
  1364. if TResEvalUInt(LeftValue).UInt>TResEvalUInt(RightValue).UInt then
  1365. RaiseMsg(20170519000240,nHighRangeLimitLTLowRangeLimit,
  1366. sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
  1367. Result:=TResEvalRangeUInt.CreateValue(TResEvalUInt(LeftValue).UInt,
  1368. TResEvalUInt(RightValue).UInt);
  1369. exit;
  1370. end
  1371. else
  1372. RaiseRangeCheck(20170522123106,Expr.Right);
  1373. revkEnum:
  1374. if (RightValue.Kind<>revkEnum) then
  1375. RaiseRangeCheck(20170522153003,Expr.Right)
  1376. else if (TResEvalEnum(LeftValue).ElType<>TResEvalEnum(RightValue).ElType) then
  1377. begin
  1378. {$IFDEF VerbosePasResolver}
  1379. writeln('TResExprEvaluator.EvalBinaryRangeExpr LeftValue=',dbgs(LeftValue),',',GetObjName(TResEvalEnum(LeftValue).ElType),' RightValue=',dbgs(RightValue),',',GetObjName(TResEvalEnum(RightValue).ElType));
  1380. {$ENDIF}
  1381. RaiseRangeCheck(20170522123241,Expr.Right) // mismatch enumtype
  1382. end
  1383. else if TResEvalEnum(LeftValue).Index>TResEvalEnum(RightValue).Index then
  1384. RaiseMsg(20170522123320,nHighRangeLimitLTLowRangeLimit,
  1385. sHighRangeLimitLTLowRangeLimit,[],Expr.Right)
  1386. else
  1387. begin
  1388. Result:=TResEvalRangeInt.CreateValue(revskEnum,
  1389. TResEvalEnum(LeftValue).ElType as TPasEnumType,
  1390. TResEvalEnum(LeftValue).Index,TResEvalEnum(RightValue).Index);
  1391. exit;
  1392. end;
  1393. {$ifdef FPC_HAS_CPSTRING}
  1394. revkString,
  1395. {$endif}
  1396. revkUnicodeString:
  1397. begin
  1398. LeftInt:=ExprStringToOrd(LeftValue,Expr.left);
  1399. if RightValue.Kind in revkAllStrings then
  1400. begin
  1401. RightInt:=ExprStringToOrd(RightValue,Expr.right);
  1402. if LeftInt>RightInt then
  1403. RaiseMsg(20170523151508,nHighRangeLimitLTLowRangeLimit,
  1404. sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
  1405. Result:=TResEvalRangeInt.CreateValue(revskChar,nil,LeftInt,RightInt);
  1406. exit;
  1407. end
  1408. else
  1409. RaiseRangeCheck(20170522123106,Expr.Right);
  1410. end
  1411. else
  1412. {$IFDEF VerbosePasResolver}
  1413. writeln('TResExprEvaluator.EvalBinaryRangeExpr Left=',GetObjName(Expr.Left),' LeftValue.Kind=',LeftValue.Kind);
  1414. RaiseNotYetImplemented(20170518221103,Expr.Left);
  1415. {$ENDIF}
  1416. end;
  1417. end;
  1418. function TResExprEvaluator.EvalBinaryAddExpr(Expr: TBinaryExpr; LeftValue,
  1419. RightValue: TResEvalValue): TResEvalValue;
  1420. procedure IntAddUInt(const i: TMaxPrecInt; const u: TMaxPrecUInt);
  1421. var
  1422. Int: TMaxPrecInt;
  1423. UInt: TMaxPrecUInt;
  1424. begin
  1425. if (i>=0) then
  1426. begin
  1427. UInt:=TMaxPrecUInt(i)+u;
  1428. Result:=CreateResEvalInt(UInt);
  1429. end
  1430. else if u<=HighIntAsUInt then
  1431. begin
  1432. Int:=i + TMaxPrecInt(u);
  1433. Result:=TResEvalInt.CreateValue(Int);
  1434. end
  1435. else
  1436. RaiseRangeCheck(20170601140523,Expr);
  1437. end;
  1438. var
  1439. Int: TMaxPrecInt;
  1440. UInt: TMaxPrecUInt;
  1441. Flo: TMaxPrecFloat;
  1442. aCurrency: TMaxPrecCurrency;
  1443. LeftSet, RightSet: TResEvalSet;
  1444. i: Integer;
  1445. begin
  1446. Result:=nil;
  1447. try
  1448. {$Q+} // enable overflow and range checks
  1449. {$R+}
  1450. case LeftValue.Kind of
  1451. revkInt:
  1452. begin
  1453. Int:=TResEvalInt(LeftValue).Int;
  1454. case RightValue.Kind of
  1455. revkInt: // int + int
  1456. if (Int>0) and (TResEvalInt(RightValue).Int>0) then
  1457. begin
  1458. UInt:=TMaxPrecUInt(Int)+TMaxPrecUInt(TResEvalInt(RightValue).Int);
  1459. Result:=CreateResEvalInt(UInt);
  1460. end
  1461. else
  1462. begin
  1463. Int:=Int + TResEvalInt(RightValue).Int;
  1464. Result:=TResEvalInt.CreateValue(Int);
  1465. end;
  1466. revkUInt: // int + uint
  1467. IntAddUInt(Int,TResEvalUInt(RightValue).UInt);
  1468. revkFloat: // int + float
  1469. Result:=TResEvalFloat.CreateValue(Int + TResEvalFloat(RightValue).FloatValue);
  1470. revkCurrency: // int + currency
  1471. Result:=TResEvalCurrency.CreateValue(Int + TResEvalCurrency(RightValue).Value);
  1472. else
  1473. {$IFDEF VerbosePasResolver}
  1474. writeln('TResExprEvaluator.EvalBinaryAddExpr int+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1475. {$ENDIF}
  1476. RaiseNotYetImplemented(20170525115537,Expr);
  1477. end;
  1478. end;
  1479. revkUInt:
  1480. begin
  1481. UInt:=TResEvalUInt(LeftValue).UInt;
  1482. case RightValue.Kind of
  1483. revkInt: // uint + int
  1484. IntAddUInt(UInt,TResEvalInt(RightValue).Int);
  1485. revkUInt: // uint + uint
  1486. begin
  1487. UInt:=UInt+TResEvalUInt(RightValue).UInt;
  1488. Result:=TResEvalUInt.CreateValue(UInt);
  1489. end;
  1490. revkFloat: // uint + float
  1491. Result:=TResEvalFloat.CreateValue(UInt + TResEvalFloat(RightValue).FloatValue);
  1492. revkCurrency: // uint + currency
  1493. Result:=TResEvalCurrency.CreateValue(UInt + TResEvalCurrency(RightValue).Value);
  1494. else
  1495. {$IFDEF VerbosePasResolver}
  1496. writeln('TResExprEvaluator.EvalBinaryAddExpr uint+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1497. {$ENDIF}
  1498. RaiseNotYetImplemented(20170601141031,Expr);
  1499. end;
  1500. end;
  1501. revkFloat:
  1502. begin
  1503. Flo:=TResEvalFloat(LeftValue).FloatValue;
  1504. case RightValue.Kind of
  1505. revkInt: // float + int
  1506. Result:=TResEvalFloat.CreateValue(Flo + TResEvalInt(RightValue).Int);
  1507. revkUInt: // float + uint
  1508. Result:=TResEvalFloat.CreateValue(Flo + TResEvalUInt(RightValue).UInt);
  1509. revkFloat: // float + float
  1510. Result:=TResEvalFloat.CreateValue(Flo + TResEvalFloat(RightValue).FloatValue);
  1511. revkCurrency: // float + Currency
  1512. Result:=TResEvalCurrency.CreateValue(Flo + TResEvalCurrency(RightValue).Value);
  1513. else
  1514. {$IFDEF VerbosePasResolver}
  1515. writeln('TResExprEvaluator.EvalBinaryAddExpr float+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1516. {$ENDIF}
  1517. RaiseNotYetImplemented(20170711145637,Expr);
  1518. end;
  1519. end;
  1520. revkCurrency:
  1521. begin
  1522. aCurrency:=TResEvalCurrency(LeftValue).Value;
  1523. case RightValue.Kind of
  1524. revkInt: // currency + int
  1525. Result:=TResEvalFloat.CreateValue(aCurrency + TResEvalInt(RightValue).Int);
  1526. revkUInt: // currency + uint
  1527. Result:=TResEvalFloat.CreateValue(aCurrency + TResEvalUInt(RightValue).UInt);
  1528. revkFloat: // currency + float
  1529. Result:=TResEvalFloat.CreateValue(aCurrency + TResEvalFloat(RightValue).FloatValue);
  1530. revkCurrency: // currency + currency
  1531. Result:=TResEvalCurrency.CreateValue(aCurrency + TResEvalCurrency(RightValue).Value);
  1532. else
  1533. {$IFDEF VerbosePasResolver}
  1534. writeln('TResExprEvaluator.EvalBinaryAddExpr currency+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1535. {$ENDIF}
  1536. RaiseNotYetImplemented(20180421163819,Expr);
  1537. end;
  1538. end;
  1539. {$ifdef FPC_HAS_CPSTRING}
  1540. revkString,
  1541. {$endif}
  1542. revkUnicodeString:
  1543. Result:=EvalStringAddExpr(Expr,Expr.left,Expr.right,LeftValue,RightValue);
  1544. revkSetOfInt:
  1545. case RightValue.Kind of
  1546. revkSetOfInt:
  1547. begin
  1548. // union
  1549. LeftSet:=TResEvalSet(LeftValue);
  1550. RightSet:=TResEvalSet(RightValue);
  1551. if LeftSet.ElKind=revskNone then
  1552. Result:=RightSet.Clone
  1553. else if RightSet.ElKind=revskNone then
  1554. Result:=LeftSet.Clone
  1555. else
  1556. begin
  1557. Result:=RightSet.Clone;
  1558. // add elements of left
  1559. for i:=0 to length(LeftSet.Ranges)-1 do
  1560. begin
  1561. Int:=LeftSet.Ranges[i].RangeStart;
  1562. while Int<=LeftSet.Ranges[i].RangeEnd do
  1563. begin
  1564. TResEvalSet(Result).Add(Int,Int);
  1565. inc(Int);
  1566. end;
  1567. end;
  1568. end;
  1569. end;
  1570. else
  1571. {$IFDEF VerbosePasResolver}
  1572. writeln('TResExprEvaluator.EvalBinaryMulExpr add set+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1573. {$ENDIF}
  1574. RaiseNotYetImplemented(20170714114055,Expr);
  1575. end
  1576. else
  1577. {$IFDEF VerbosePasResolver}
  1578. writeln('TResExprEvaluator.EvalBinaryAddExpr ?+ Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1579. {$ENDIF}
  1580. RaiseNotYetImplemented(20170525115548,Expr);
  1581. end;
  1582. except
  1583. on EOverflow do
  1584. RaiseOverflowArithmetic(20170601140130,Expr);
  1585. on ERangeError do
  1586. RaiseRangeCheck(20170601140132,Expr);
  1587. end;
  1588. end;
  1589. function TResExprEvaluator.EvalBinarySubExpr(Expr: TBinaryExpr; LeftValue,
  1590. RightValue: TResEvalValue): TResEvalValue;
  1591. var
  1592. Int: TMaxPrecInt;
  1593. UInt: TMaxPrecUInt;
  1594. Flo: TMaxPrecFloat;
  1595. aCurrency: TMaxPrecCurrency;
  1596. LeftSet, RightSet: TResEvalSet;
  1597. i: Integer;
  1598. begin
  1599. Result:=nil;
  1600. case LeftValue.Kind of
  1601. revkInt:
  1602. begin
  1603. Int:=TResEvalInt(LeftValue).Int;
  1604. case RightValue.Kind of
  1605. revkInt:
  1606. // int - int
  1607. try
  1608. {$Q+}
  1609. Int:=Int - TResEvalInt(RightValue).Int;
  1610. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1611. Result:=TResEvalInt.CreateValue(Int);
  1612. except
  1613. on E: EOverflow do
  1614. if (Int>0) and (TResEvalInt(RightValue).Int<0) then
  1615. begin
  1616. UInt:=TMaxPrecUInt(Int)+TMaxPrecUInt(-TResEvalInt(RightValue).Int);
  1617. Result:=CreateResEvalInt(UInt);
  1618. end
  1619. else
  1620. RaiseOverflowArithmetic(20170525230247,Expr);
  1621. end;
  1622. revkUInt:
  1623. // int - uint
  1624. try
  1625. {$Q+}
  1626. Int:=Int - TResEvalUInt(RightValue).UInt;
  1627. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1628. Result:=TResEvalInt.CreateValue(Int);
  1629. except
  1630. on E: EOverflow do
  1631. RaiseOverflowArithmetic(20170711151201,Expr);
  1632. end;
  1633. revkFloat:
  1634. // int - float
  1635. try
  1636. {$Q+}
  1637. Flo:=TMaxPrecFloat(Int) - TResEvalFloat(RightValue).FloatValue;
  1638. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1639. Result:=TResEvalFloat.CreateValue(Flo);
  1640. except
  1641. on E: EOverflow do
  1642. RaiseOverflowArithmetic(20170711151313,Expr);
  1643. end;
  1644. revkCurrency:
  1645. // int - currency
  1646. try
  1647. {$Q+}
  1648. aCurrency:=TMaxPrecCurrency(Int) - TResEvalCurrency(RightValue).Value;
  1649. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1650. Result:=TResEvalCurrency.CreateValue(aCurrency);
  1651. except
  1652. on E: EOverflow do
  1653. RaiseOverflowArithmetic(20180421164011,Expr);
  1654. end;
  1655. else
  1656. {$IFDEF VerbosePasResolver}
  1657. writeln('TResExprEvaluator.EvalBinarySubExpr sub int-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1658. {$ENDIF}
  1659. RaiseNotYetImplemented(20170525230028,Expr);
  1660. end;
  1661. end;
  1662. revkUInt:
  1663. begin
  1664. UInt:=TResEvalUInt(LeftValue).UInt;
  1665. case RightValue.Kind of
  1666. revkInt:
  1667. // uint - int
  1668. try
  1669. {$Q+}
  1670. UInt:=UInt - TResEvalInt(RightValue).Int;
  1671. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1672. Result:=TResEvalUInt.CreateValue(UInt);
  1673. except
  1674. on E: EOverflow do
  1675. RaiseOverflowArithmetic(20170711151405,Expr);
  1676. end;
  1677. revkUInt:
  1678. // uint - uint
  1679. try
  1680. {$Q+}
  1681. UInt:=UInt - TResEvalUInt(RightValue).UInt;
  1682. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1683. Result:=TResEvalUInt.CreateValue(UInt);
  1684. except
  1685. on E: EOverflow do
  1686. RaiseOverflowArithmetic(20170711151419,Expr);
  1687. end;
  1688. revkFloat:
  1689. // uint - float
  1690. try
  1691. {$Q+}
  1692. Flo:=TMaxPrecFloat(UInt) - TResEvalFloat(RightValue).FloatValue;
  1693. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1694. Result:=TResEvalFloat.CreateValue(Flo);
  1695. except
  1696. on E: EOverflow do
  1697. RaiseOverflowArithmetic(20170711151428,Expr);
  1698. end;
  1699. revkCurrency:
  1700. // uint - currency
  1701. try
  1702. {$Q+}
  1703. aCurrency:=TMaxPrecCurrency(UInt) - TResEvalCurrency(RightValue).Value;
  1704. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1705. Result:=TResEvalCurrency.CreateValue(aCurrency);
  1706. except
  1707. on E: EOverflow do
  1708. RaiseOverflowArithmetic(20180421164005,Expr);
  1709. end;
  1710. else
  1711. {$IFDEF VerbosePasResolver}
  1712. writeln('TResExprEvaluator.EvalBinarySubExpr sub uint-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1713. {$ENDIF}
  1714. RaiseNotYetImplemented(20170711151435,Expr);
  1715. end;
  1716. end;
  1717. revkFloat:
  1718. begin
  1719. Flo:=TResEvalFloat(LeftValue).FloatValue;
  1720. case RightValue.Kind of
  1721. revkInt:
  1722. // float - int
  1723. try
  1724. {$Q+}
  1725. Flo:=Flo - TResEvalInt(RightValue).Int;
  1726. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1727. Result:=TResEvalFloat.CreateValue(Flo);
  1728. except
  1729. on E: EOverflow do
  1730. RaiseOverflowArithmetic(20170711151519,Expr);
  1731. end;
  1732. revkUInt:
  1733. // float - uint
  1734. try
  1735. {$Q+}
  1736. Flo:=Flo - TResEvalUInt(RightValue).UInt;
  1737. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1738. Result:=TResEvalFloat.CreateValue(Flo);
  1739. except
  1740. on E: EOverflow do
  1741. RaiseOverflowArithmetic(20170711151538,Expr);
  1742. end;
  1743. revkFloat:
  1744. // float - float
  1745. try
  1746. {$Q+}
  1747. Flo:=Flo - TResEvalFloat(RightValue).FloatValue;
  1748. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1749. Result:=TResEvalFloat.CreateValue(Flo);
  1750. except
  1751. on E: EOverflow do
  1752. RaiseOverflowArithmetic(20170711151552,Expr);
  1753. end;
  1754. revkCurrency:
  1755. // float - currency
  1756. try
  1757. {$Q+}
  1758. aCurrency:=Flo - TResEvalCurrency(RightValue).Value;
  1759. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1760. Result:=TResEvalCurrency.CreateValue(aCurrency);
  1761. except
  1762. on E: EOverflow do
  1763. RaiseOverflowArithmetic(20180421164054,Expr);
  1764. end;
  1765. else
  1766. {$IFDEF VerbosePasResolver}
  1767. writeln('TResExprEvaluator.EvalBinarySubExpr sub float-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1768. {$ENDIF}
  1769. RaiseNotYetImplemented(20170711151600,Expr);
  1770. end;
  1771. end;
  1772. revkCurrency:
  1773. begin
  1774. aCurrency:=TResEvalCurrency(LeftValue).Value;
  1775. case RightValue.Kind of
  1776. revkInt:
  1777. // currency - int
  1778. try
  1779. {$Q+}
  1780. aCurrency:=aCurrency - TResEvalInt(RightValue).Int;
  1781. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1782. Result:=TResEvalCurrency.CreateValue(aCurrency);
  1783. except
  1784. on E: EOverflow do
  1785. RaiseOverflowArithmetic(20180421164200,Expr);
  1786. end;
  1787. revkUInt:
  1788. // currency - uint
  1789. try
  1790. {$Q+}
  1791. aCurrency:=aCurrency - TResEvalUInt(RightValue).UInt;
  1792. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1793. Result:=TResEvalCurrency.CreateValue(aCurrency);
  1794. except
  1795. on E: EOverflow do
  1796. RaiseOverflowArithmetic(20180421164218,Expr);
  1797. end;
  1798. revkFloat:
  1799. // currency - float
  1800. try
  1801. {$Q+}
  1802. aCurrency:=aCurrency - TResEvalFloat(RightValue).FloatValue;
  1803. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1804. Result:=TResEvalCurrency.CreateValue(aCurrency);
  1805. except
  1806. on E: EOverflow do
  1807. RaiseOverflowArithmetic(20180421164250,Expr);
  1808. end;
  1809. revkCurrency:
  1810. // currency - currency
  1811. try
  1812. {$Q+}
  1813. aCurrency:=aCurrency - TResEvalCurrency(RightValue).Value;
  1814. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1815. Result:=TResEvalCurrency.CreateValue(aCurrency);
  1816. except
  1817. on E: EOverflow do
  1818. RaiseOverflowArithmetic(20180421164258,Expr);
  1819. end;
  1820. else
  1821. {$IFDEF VerbosePasResolver}
  1822. writeln('TResExprEvaluator.EvalBinarySubExpr sub currency-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1823. {$ENDIF}
  1824. RaiseNotYetImplemented(20180421164312,Expr);
  1825. end;
  1826. end;
  1827. revkSetOfInt:
  1828. case RightValue.Kind of
  1829. revkSetOfInt:
  1830. begin
  1831. // difference
  1832. LeftSet:=TResEvalSet(LeftValue);
  1833. RightSet:=TResEvalSet(RightValue);
  1834. if LeftSet.ElKind=revskNone then
  1835. Result:=TResEvalSet.CreateEmptySameKind(RightSet)
  1836. else
  1837. begin
  1838. Result:=TResEvalSet.CreateEmptySameKind(LeftSet);
  1839. // add elements, which exists only in LeftSet
  1840. for i:=0 to length(LeftSet.Ranges)-1 do
  1841. begin
  1842. Int:=LeftSet.Ranges[i].RangeStart;
  1843. while Int<=LeftSet.Ranges[i].RangeEnd do
  1844. begin
  1845. if RightSet.IndexOfRange(Int)<0 then
  1846. TResEvalSet(Result).Add(Int,Int);
  1847. inc(Int);
  1848. end;
  1849. end;
  1850. end;
  1851. end;
  1852. else
  1853. {$IFDEF VerbosePasResolver}
  1854. writeln('TResExprEvaluator.EvalBinarySubExpr sub set-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1855. {$ENDIF}
  1856. RaiseNotYetImplemented(20170714114101,Expr);
  1857. end;
  1858. else
  1859. {$IFDEF VerbosePasResolver}
  1860. writeln('TResExprEvaluator.EvalBinarySubExpr sub ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1861. {$ENDIF}
  1862. RaiseNotYetImplemented(20170525225946,Expr);
  1863. end;
  1864. end;
  1865. function TResExprEvaluator.EvalBinaryMulExpr(Expr: TBinaryExpr; LeftValue,
  1866. RightValue: TResEvalValue): TResEvalValue;
  1867. var
  1868. Int: TMaxPrecInt;
  1869. UInt: TMaxPrecUInt;
  1870. Flo: TMaxPrecFloat;
  1871. aCurrency: TMaxPrecCurrency;
  1872. LeftSet, RightSet: TResEvalSet;
  1873. i: Integer;
  1874. begin
  1875. Result:=nil;
  1876. case LeftValue.Kind of
  1877. revkInt:
  1878. begin
  1879. Int:=TResEvalInt(LeftValue).Int;
  1880. case RightValue.Kind of
  1881. revkInt:
  1882. // int * int
  1883. try
  1884. {$Q+}
  1885. Int:=Int * TResEvalInt(RightValue).Int;
  1886. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1887. Result:=TResEvalInt.CreateValue(Int);
  1888. except
  1889. on E: EOverflow do
  1890. if (Int>0) and (TResEvalInt(RightValue).Int>0) then
  1891. try
  1892. // try uint*uint
  1893. {$Q+}
  1894. UInt:=TMaxPrecUInt(Int) * TMaxPrecUInt(TResEvalInt(RightValue).Int);
  1895. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1896. Result:=CreateResEvalInt(UInt);
  1897. except
  1898. on E: EOverflow do
  1899. RaiseOverflowArithmetic(20170530101616,Expr);
  1900. end
  1901. else
  1902. RaiseOverflowArithmetic(20170525230247,Expr);
  1903. end;
  1904. revkUInt:
  1905. // int * uint
  1906. try
  1907. {$Q+}
  1908. Int:=Int * TResEvalUInt(RightValue).UInt;
  1909. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1910. Result:=TResEvalInt.CreateValue(Int);
  1911. except
  1912. RaiseOverflowArithmetic(20170711164445,Expr);
  1913. end;
  1914. revkFloat:
  1915. // int * float
  1916. try
  1917. {$Q+}
  1918. Flo:=Int * TResEvalFloat(RightValue).FloatValue;
  1919. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1920. Result:=TResEvalFloat.CreateValue(Flo);
  1921. except
  1922. RaiseOverflowArithmetic(20170711164541,Expr);
  1923. end;
  1924. revkCurrency:
  1925. // int * currency
  1926. try
  1927. {$Q+}
  1928. aCurrency:=Int * TResEvalCurrency(RightValue).Value;
  1929. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1930. Result:=TResEvalCurrency.CreateValue(aCurrency);
  1931. except
  1932. RaiseOverflowArithmetic(20180421164426,Expr);
  1933. end;
  1934. else
  1935. {$IFDEF VerbosePasResolver}
  1936. writeln('TResExprEvaluator.EvalBinaryMulExpr mul int*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  1937. {$ENDIF}
  1938. RaiseNotYetImplemented(20170525230028,Expr);
  1939. end;
  1940. end;
  1941. revkUInt:
  1942. begin
  1943. UInt:=TResEvalUInt(LeftValue).UInt;
  1944. case RightValue.Kind of
  1945. revkInt:
  1946. // uint * int
  1947. if TResEvalInt(RightValue).Int>=0 then
  1948. try
  1949. {$Q+}
  1950. UInt:=UInt * TResEvalInt(RightValue).Int;
  1951. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1952. Result:=TResEvalUInt.CreateValue(UInt);
  1953. except
  1954. on E: EOverflow do
  1955. RaiseOverflowArithmetic(20170711164714,Expr);
  1956. end
  1957. else
  1958. try
  1959. {$Q+}
  1960. Int:=UInt * TResEvalInt(RightValue).Int;
  1961. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1962. Result:=TResEvalInt.CreateValue(Int);
  1963. except
  1964. on E: EOverflow do
  1965. RaiseOverflowArithmetic(20170711164736,Expr);
  1966. end;
  1967. revkUInt:
  1968. // uint * uint
  1969. try
  1970. {$Q+}
  1971. UInt:=UInt * TResEvalUInt(RightValue).UInt;
  1972. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1973. Result:=TResEvalUInt.CreateValue(UInt);
  1974. except
  1975. RaiseOverflowArithmetic(20170711164751,Expr);
  1976. end;
  1977. revkFloat:
  1978. // uint * float
  1979. try
  1980. {$Q+}
  1981. Flo:=UInt * TResEvalFloat(RightValue).FloatValue;
  1982. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1983. Result:=TResEvalFloat.CreateValue(Flo);
  1984. except
  1985. RaiseOverflowArithmetic(20170711164800,Expr);
  1986. end;
  1987. revkCurrency:
  1988. // uint * currency
  1989. try
  1990. {$Q+}
  1991. aCurrency:=UInt * TResEvalCurrency(RightValue).Value;
  1992. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  1993. Result:=TResEvalCurrency.CreateValue(aCurrency);
  1994. except
  1995. RaiseOverflowArithmetic(20180421164500,Expr);
  1996. end;
  1997. else
  1998. {$IFDEF VerbosePasResolver}
  1999. writeln('TResExprEvaluator.EvalBinaryMulExpr mul uint*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2000. {$ENDIF}
  2001. RaiseNotYetImplemented(20170711164810,Expr);
  2002. end;
  2003. end;
  2004. revkFloat:
  2005. begin
  2006. Flo:=TResEvalFloat(LeftValue).FloatValue;
  2007. case RightValue.Kind of
  2008. revkInt:
  2009. // float * int
  2010. try
  2011. {$Q+}
  2012. Flo:=Flo * TResEvalInt(RightValue).Int;
  2013. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  2014. Result:=TResEvalFloat.CreateValue(Flo);
  2015. except
  2016. on E: EOverflow do
  2017. RaiseOverflowArithmetic(20170711164920,Expr);
  2018. end;
  2019. revkUInt:
  2020. // float * uint
  2021. try
  2022. {$Q+}
  2023. Flo:=Flo * TResEvalUInt(RightValue).UInt;
  2024. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  2025. Result:=TResEvalFloat.CreateValue(Flo);
  2026. except
  2027. RaiseOverflowArithmetic(20170711164940,Expr);
  2028. end;
  2029. revkFloat:
  2030. // float * float
  2031. try
  2032. {$Q+}
  2033. Flo:=Flo * TResEvalFloat(RightValue).FloatValue;
  2034. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  2035. Result:=TResEvalFloat.CreateValue(Flo);
  2036. except
  2037. RaiseOverflowArithmetic(20170711164955,Expr);
  2038. end;
  2039. revkCurrency:
  2040. // float * currency
  2041. try
  2042. {$Q+}
  2043. Flo:=Flo * TResEvalCurrency(RightValue).Value;
  2044. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  2045. Result:=TResEvalFloat.CreateValue(Flo);
  2046. except
  2047. RaiseOverflowArithmetic(20180421164542,Expr);
  2048. end;
  2049. else
  2050. {$IFDEF VerbosePasResolver}
  2051. writeln('TResExprEvaluator.EvalBinaryMulExpr mul float*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2052. {$ENDIF}
  2053. RaiseNotYetImplemented(20170711165004,Expr);
  2054. end;
  2055. end;
  2056. revkCurrency:
  2057. begin
  2058. aCurrency:=TResEvalCurrency(LeftValue).Value;
  2059. case RightValue.Kind of
  2060. revkInt:
  2061. // currency * int
  2062. try
  2063. {$Q+}
  2064. aCurrency:=aCurrency * TResEvalInt(RightValue).Int;
  2065. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  2066. Result:=TResEvalCurrency.CreateValue(aCurrency);
  2067. except
  2068. on E: EOverflow do
  2069. RaiseOverflowArithmetic(20180421164636,Expr);
  2070. end;
  2071. revkUInt:
  2072. // currency * uint
  2073. try
  2074. {$Q+}
  2075. aCurrency:=aCurrency * TResEvalUInt(RightValue).UInt;
  2076. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  2077. Result:=TResEvalCurrency.CreateValue(aCurrency);
  2078. except
  2079. RaiseOverflowArithmetic(20180421164654,Expr);
  2080. end;
  2081. revkFloat:
  2082. // currency * float
  2083. try
  2084. {$Q+}
  2085. Flo:=aCurrency * TResEvalFloat(RightValue).FloatValue;
  2086. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  2087. Result:=TResEvalFloat.CreateValue(Flo);
  2088. except
  2089. RaiseOverflowArithmetic(20180421164718,Expr);
  2090. end;
  2091. revkCurrency:
  2092. // currency * currency
  2093. try
  2094. {$Q+}
  2095. aCurrency:=aCurrency * TResEvalCurrency(RightValue).Value;
  2096. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  2097. Result:=TResEvalCurrency.CreateValue(aCurrency);
  2098. except
  2099. RaiseOverflowArithmetic(20180421164806,Expr);
  2100. end;
  2101. else
  2102. {$IFDEF VerbosePasResolver}
  2103. writeln('TResExprEvaluator.EvalBinaryMulExpr mul currency*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2104. {$ENDIF}
  2105. RaiseNotYetImplemented(20180421164817,Expr);
  2106. end;
  2107. end;
  2108. revkSetOfInt:
  2109. case RightValue.Kind of
  2110. revkSetOfInt:
  2111. begin
  2112. // intersect
  2113. LeftSet:=TResEvalSet(LeftValue);
  2114. RightSet:=TResEvalSet(RightValue);
  2115. if LeftSet.ElKind=revskNone then
  2116. Result:=TResEvalSet.CreateEmptySameKind(RightSet)
  2117. else
  2118. begin
  2119. Result:=TResEvalSet.CreateEmptySameKind(LeftSet);
  2120. // add elements, which exists in both
  2121. for i:=0 to length(LeftSet.Ranges)-1 do
  2122. begin
  2123. Int:=LeftSet.Ranges[i].RangeStart;
  2124. while Int<=LeftSet.Ranges[i].RangeEnd do
  2125. begin
  2126. if RightSet.IndexOfRange(Int)>=0 then
  2127. TResEvalSet(Result).Add(Int,Int);
  2128. inc(Int);
  2129. end;
  2130. end;
  2131. end;
  2132. end;
  2133. else
  2134. {$IFDEF VerbosePasResolver}
  2135. writeln('TResExprEvaluator.EvalBinaryMulExpr mul set*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2136. {$ENDIF}
  2137. RaiseNotYetImplemented(20170714110420,Expr);
  2138. end
  2139. else
  2140. {$IFDEF VerbosePasResolver}
  2141. writeln('TResExprEvaluator.EvalBinaryMulExpr mul ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2142. {$ENDIF}
  2143. RaiseNotYetImplemented(20170525225946,Expr);
  2144. end;
  2145. end;
  2146. function TResExprEvaluator.EvalBinaryDivideExpr(Expr: TBinaryExpr; LeftValue,
  2147. RightValue: TResEvalValue): TResEvalValue;
  2148. var
  2149. Int: TMaxPrecInt;
  2150. UInt: TMaxPrecUInt;
  2151. Flo: TMaxPrecFloat;
  2152. aCurrency: TMaxPrecCurrency;
  2153. begin
  2154. Result:=nil;
  2155. case LeftValue.Kind of
  2156. revkInt:
  2157. begin
  2158. Int:=TResEvalInt(LeftValue).Int;
  2159. case RightValue.Kind of
  2160. revkInt:
  2161. // int / int
  2162. if TResEvalInt(RightValue).Int=0 then
  2163. RaiseDivByZero(20170711143925,Expr)
  2164. else
  2165. Result:=TResEvalFloat.CreateValue(Int / TResEvalInt(RightValue).Int);
  2166. revkUInt:
  2167. // int / uint
  2168. if TResEvalUInt(RightValue).UInt=0 then
  2169. RaiseDivByZero(20170711144013,Expr)
  2170. else
  2171. Result:=TResEvalFloat.CreateValue(Int / TResEvalUInt(RightValue).UInt);
  2172. revkFloat:
  2173. begin
  2174. // int / float
  2175. try
  2176. Flo:=Int / TResEvalFloat(RightValue).FloatValue;
  2177. except
  2178. RaiseMsg(20170711144525,nDivByZero,sDivByZero,[],Expr);
  2179. end;
  2180. Result:=TResEvalFloat.CreateValue(Flo);
  2181. end;
  2182. revkCurrency:
  2183. begin
  2184. // int / currency
  2185. try
  2186. aCurrency:=Int / TResEvalCurrency(RightValue).Value;
  2187. except
  2188. RaiseMsg(20180421164915,nDivByZero,sDivByZero,[],Expr);
  2189. end;
  2190. Result:=TResEvalCurrency.CreateValue(aCurrency);
  2191. end;
  2192. else
  2193. {$IFDEF VerbosePasResolver}
  2194. writeln('TResExprEvaluator.EvalBinaryDivideExpr int / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2195. {$ENDIF}
  2196. RaiseNotYetImplemented(20170711144057,Expr);
  2197. end;
  2198. end;
  2199. revkUInt:
  2200. begin
  2201. UInt:=TResEvalUInt(LeftValue).UInt;
  2202. case RightValue.Kind of
  2203. revkInt:
  2204. // uint / int
  2205. if TResEvalInt(RightValue).Int=0 then
  2206. RaiseDivByZero(20170711144103,Expr)
  2207. else
  2208. Result:=TResEvalFloat.CreateValue(UInt / TResEvalInt(RightValue).Int);
  2209. revkUInt:
  2210. // uint / uint
  2211. if TResEvalUInt(RightValue).UInt=0 then
  2212. RaiseDivByZero(20170711144203,Expr)
  2213. else
  2214. Result:=TResEvalFloat.CreateValue(UInt / TResEvalUInt(RightValue).UInt);
  2215. revkFloat:
  2216. begin
  2217. // uint / float
  2218. try
  2219. Flo:=UInt / TResEvalFloat(RightValue).FloatValue;
  2220. except
  2221. RaiseMsg(20170711144912,nDivByZero,sDivByZero,[],Expr);
  2222. end;
  2223. Result:=TResEvalFloat.CreateValue(Flo);
  2224. end;
  2225. revkCurrency:
  2226. begin
  2227. // uint / currency
  2228. try
  2229. aCurrency:=UInt / TResEvalCurrency(RightValue).Value;
  2230. except
  2231. RaiseMsg(20180421164959,nDivByZero,sDivByZero,[],Expr);
  2232. end;
  2233. Result:=TResEvalCurrency.CreateValue(aCurrency);
  2234. end;
  2235. else
  2236. {$IFDEF VerbosePasResolver}
  2237. writeln('TResExprEvaluator.EvalBinaryDivideExpr uint / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2238. {$ENDIF}
  2239. RaiseNotYetImplemented(20170711144239,Expr);
  2240. end;
  2241. end;
  2242. revkFloat:
  2243. begin
  2244. Flo:=TResEvalFloat(LeftValue).FloatValue;
  2245. case RightValue.Kind of
  2246. revkInt:
  2247. // float / int
  2248. if TResEvalInt(RightValue).Int=0 then
  2249. RaiseDivByZero(20170711144954,Expr)
  2250. else
  2251. Result:=TResEvalFloat.CreateValue(Flo / TResEvalInt(RightValue).Int);
  2252. revkUInt:
  2253. // float / uint
  2254. if TResEvalUInt(RightValue).UInt=0 then
  2255. RaiseDivByZero(20170711145023,Expr)
  2256. else
  2257. Result:=TResEvalFloat.CreateValue(Flo / TResEvalUInt(RightValue).UInt);
  2258. revkFloat:
  2259. begin
  2260. // float / float
  2261. try
  2262. Flo:=Flo / TResEvalFloat(RightValue).FloatValue;
  2263. except
  2264. RaiseMsg(20170711145040,nDivByZero,sDivByZero,[],Expr);
  2265. end;
  2266. Result:=TResEvalFloat.CreateValue(Flo);
  2267. end;
  2268. revkCurrency:
  2269. begin
  2270. // float / currency
  2271. try
  2272. aCurrency:=Flo / TResEvalCurrency(RightValue).Value;
  2273. except
  2274. RaiseMsg(20180421165058,nDivByZero,sDivByZero,[],Expr);
  2275. end;
  2276. Result:=TResEvalCurrency.CreateValue(aCurrency);
  2277. end;
  2278. else
  2279. {$IFDEF VerbosePasResolver}
  2280. writeln('TResExprEvaluator.EvalBinaryDivideExpr float / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2281. {$ENDIF}
  2282. RaiseNotYetImplemented(20170711145050,Expr);
  2283. end;
  2284. end;
  2285. revkCurrency:
  2286. begin
  2287. aCurrency:=TResEvalCurrency(LeftValue).Value;
  2288. case RightValue.Kind of
  2289. revkInt:
  2290. // currency / int
  2291. if TResEvalInt(RightValue).Int=0 then
  2292. RaiseDivByZero(20180421165154,Expr)
  2293. else
  2294. Result:=TResEvalCurrency.CreateValue(aCurrency / TResEvalInt(RightValue).Int);
  2295. revkUInt:
  2296. // currency / uint
  2297. if TResEvalUInt(RightValue).UInt=0 then
  2298. RaiseDivByZero(20180421165205,Expr)
  2299. else
  2300. Result:=TResEvalCurrency.CreateValue(aCurrency / TResEvalUInt(RightValue).UInt);
  2301. revkFloat:
  2302. begin
  2303. // currency / float
  2304. try
  2305. aCurrency:=aCurrency / TResEvalFloat(RightValue).FloatValue;
  2306. except
  2307. RaiseMsg(20180421165237,nDivByZero,sDivByZero,[],Expr);
  2308. end;
  2309. Result:=TResEvalCurrency.CreateValue(aCurrency);
  2310. end;
  2311. revkCurrency:
  2312. begin
  2313. // currency / currency
  2314. try
  2315. aCurrency:=aCurrency / TResEvalCurrency(RightValue).Value;
  2316. except
  2317. RaiseMsg(20180421165252,nDivByZero,sDivByZero,[],Expr);
  2318. end;
  2319. Result:=TResEvalCurrency.CreateValue(aCurrency);
  2320. end;
  2321. else
  2322. {$IFDEF VerbosePasResolver}
  2323. writeln('TResExprEvaluator.EvalBinaryDivideExpr currency / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2324. {$ENDIF}
  2325. RaiseNotYetImplemented(20180421165301,Expr);
  2326. end;
  2327. end;
  2328. else
  2329. {$IFDEF VerbosePasResolver}
  2330. writeln('TResExprEvaluator.EvalBinaryDivExpr div ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2331. {$ENDIF}
  2332. RaiseNotYetImplemented(20170530102352,Expr);
  2333. end;
  2334. end;
  2335. function TResExprEvaluator.EvalBinaryDivExpr(Expr: TBinaryExpr; LeftValue,
  2336. RightValue: TResEvalValue): TResEvalValue;
  2337. var
  2338. Int: TMaxPrecInt;
  2339. UInt: TMaxPrecUInt;
  2340. begin
  2341. Result:=nil;
  2342. case LeftValue.Kind of
  2343. revkInt:
  2344. case RightValue.Kind of
  2345. revkInt:
  2346. // int div int
  2347. if TResEvalInt(RightValue).Int=0 then
  2348. RaiseDivByZero(20170530102619,Expr)
  2349. else
  2350. begin
  2351. Int:=TResEvalInt(LeftValue).Int div TResEvalInt(RightValue).Int;
  2352. Result:=TResEvalInt.CreateValue(Int);
  2353. end;
  2354. revkUInt:
  2355. // int div uint
  2356. if TResEvalUInt(RightValue).UInt=0 then
  2357. RaiseDivByZero(20170530102745,Expr)
  2358. else
  2359. begin
  2360. if TResEvalUInt(RightValue).UInt>HighIntAsUInt then
  2361. Int:=0
  2362. else
  2363. Int:=TResEvalInt(LeftValue).Int div TResEvalUInt(RightValue).UInt;
  2364. Result:=TResEvalInt.CreateValue(Int);
  2365. end;
  2366. else
  2367. {$IFDEF VerbosePasResolver}
  2368. writeln('TResExprEvaluator.EvalBinaryDivExpr int div ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2369. {$ENDIF}
  2370. RaiseNotYetImplemented(20170530102403,Expr);
  2371. end;
  2372. revkUInt:
  2373. case RightValue.Kind of
  2374. revkInt:
  2375. // uint div int
  2376. if TResEvalInt(RightValue).Int=0 then
  2377. RaiseDivByZero(20170530103026,Expr)
  2378. else if TResEvalUInt(LeftValue).UInt<=HighIntAsUInt then
  2379. begin
  2380. Int:=TMaxPrecInt(TResEvalUInt(LeftValue).UInt) div TResEvalInt(RightValue).Int;
  2381. Result:=TResEvalInt.CreateValue(Int);
  2382. end
  2383. else if TResEvalInt(RightValue).Int>0 then
  2384. begin
  2385. UInt:=TResEvalUInt(LeftValue).UInt div TMaxPrecUInt(TResEvalInt(RightValue).Int);
  2386. Result:=CreateResEvalInt(UInt);
  2387. end
  2388. else
  2389. RaiseOverflowArithmetic(20170530104315,Expr);
  2390. revkUInt:
  2391. // uint div uint
  2392. if TResEvalInt(RightValue).Int=0 then
  2393. RaiseDivByZero(20170530103026,Expr)
  2394. else
  2395. begin
  2396. UInt:=TResEvalUInt(LeftValue).UInt div TResEvalUInt(RightValue).UInt;
  2397. Result:=CreateResEvalInt(UInt);
  2398. end;
  2399. else
  2400. {$IFDEF VerbosePasResolver}
  2401. writeln('TResExprEvaluator.EvalBinaryDivExpr uint div ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2402. {$ENDIF}
  2403. RaiseNotYetImplemented(20170530102403,Expr);
  2404. end;
  2405. else
  2406. {$IFDEF VerbosePasResolver}
  2407. writeln('TResExprEvaluator.EvalBinaryDivExpr div ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2408. {$ENDIF}
  2409. RaiseNotYetImplemented(20170530102352,Expr);
  2410. end;
  2411. end;
  2412. function TResExprEvaluator.EvalBinaryModExpr(Expr: TBinaryExpr; LeftValue,
  2413. RightValue: TResEvalValue): TResEvalValue;
  2414. var
  2415. Int: TMaxPrecInt;
  2416. UInt: TMaxPrecUInt;
  2417. begin
  2418. Result:=nil;
  2419. case LeftValue.Kind of
  2420. revkInt:
  2421. case RightValue.Kind of
  2422. revkInt:
  2423. // int mod int
  2424. if TResEvalInt(RightValue).Int=0 then
  2425. RaiseDivByZero(20170530104638,Expr)
  2426. else
  2427. begin
  2428. Int:=TResEvalInt(LeftValue).Int mod TResEvalInt(RightValue).Int;
  2429. Result:=TResEvalInt.CreateValue(Int);
  2430. end;
  2431. revkUInt:
  2432. // int mod uint
  2433. if TResEvalUInt(RightValue).UInt=0 then
  2434. RaiseDivByZero(20170530104758,Expr)
  2435. else
  2436. begin
  2437. if TResEvalInt(LeftValue).Int<0 then
  2438. UInt:=TMaxPrecUInt(-TResEvalInt(LeftValue).Int) mod TResEvalUInt(RightValue).UInt
  2439. else
  2440. UInt:=TMaxPrecUInt(TResEvalInt(LeftValue).Int) mod TResEvalUInt(RightValue).UInt;
  2441. Result:=CreateResEvalInt(UInt);
  2442. end;
  2443. else
  2444. {$IFDEF VerbosePasResolver}
  2445. writeln('TResExprEvaluator.EvalBinaryModExpr int mod ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2446. {$ENDIF}
  2447. RaiseNotYetImplemented(20170530110057,Expr);
  2448. end;
  2449. revkUInt:
  2450. case RightValue.Kind of
  2451. revkInt:
  2452. // uint mod int
  2453. if TResEvalInt(RightValue).Int=0 then
  2454. RaiseDivByZero(20170530110110,Expr)
  2455. else if TResEvalUInt(LeftValue).UInt<=HighIntAsUInt then
  2456. begin
  2457. Int:=TMaxPrecInt(TResEvalUInt(LeftValue).UInt) mod TResEvalInt(RightValue).Int;
  2458. Result:=TResEvalInt.CreateValue(Int);
  2459. end
  2460. else if TResEvalInt(RightValue).Int>0 then
  2461. begin
  2462. UInt:=TResEvalUInt(LeftValue).UInt mod TMaxPrecUInt(TResEvalInt(RightValue).Int);
  2463. Result:=CreateResEvalInt(UInt);
  2464. end
  2465. else
  2466. RaiseOverflowArithmetic(20170530110602,Expr);
  2467. revkUInt:
  2468. // uint div uint
  2469. if TResEvalInt(RightValue).Int=0 then
  2470. RaiseDivByZero(20170530110609,Expr)
  2471. else
  2472. begin
  2473. UInt:=TResEvalUInt(LeftValue).UInt mod TResEvalUInt(RightValue).UInt;
  2474. Result:=CreateResEvalInt(UInt);
  2475. end;
  2476. else
  2477. {$IFDEF VerbosePasResolver}
  2478. writeln('TResExprEvaluator.EvalBinaryModExpr uint mod ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2479. {$ENDIF}
  2480. RaiseNotYetImplemented(20170530110633,Expr);
  2481. end;
  2482. else
  2483. {$IFDEF VerbosePasResolver}
  2484. writeln('TResExprEvaluator.EvalBinaryModExpr mod ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2485. {$ENDIF}
  2486. RaiseNotYetImplemented(20170530110644,Expr);
  2487. end;
  2488. end;
  2489. function TResExprEvaluator.EvalBinaryShiftExpr(Expr: TBinaryExpr; LeftValue,
  2490. RightValue: TResEvalValue): TResEvalValue;
  2491. var
  2492. Int: TMaxPrecInt;
  2493. UInt: TMaxPrecUInt;
  2494. ShiftLeft: Boolean;
  2495. begin
  2496. Result:=nil;
  2497. ShiftLeft:=Expr.OpCode=eopShl;
  2498. case LeftValue.Kind of
  2499. revkInt:
  2500. case RightValue.Kind of
  2501. revkInt:
  2502. // int shl int
  2503. begin
  2504. if (TResEvalInt(RightValue).Int<0) or (TResEvalInt(RightValue).Int>63) then
  2505. EmitRangeCheckConst(20170530203840,IntToStr(TResEvalInt(RightValue).Int),0,63,Expr);
  2506. if ShiftLeft then
  2507. Int:=TResEvalInt(LeftValue).Int shl byte(TResEvalInt(RightValue).Int)
  2508. else
  2509. Int:=TResEvalInt(LeftValue).Int shr byte(TResEvalInt(RightValue).Int);
  2510. Result:=TResEvalInt.CreateValue(Int);
  2511. end;
  2512. revkUInt:
  2513. // int shl uint
  2514. begin
  2515. if (TResEvalUInt(RightValue).UInt>63) then
  2516. EmitRangeCheckConst(20170530203840,IntToStr(TResEvalUInt(RightValue).UInt),0,63,Expr);
  2517. if ShiftLeft then
  2518. Int:=TResEvalInt(LeftValue).Int shl byte(TResEvalUInt(RightValue).UInt)
  2519. else
  2520. Int:=TResEvalInt(LeftValue).Int shr byte(TResEvalUInt(RightValue).UInt);
  2521. Result:=TResEvalInt.CreateValue(Int);
  2522. end;
  2523. else
  2524. {$IFDEF VerbosePasResolver}
  2525. writeln('TResExprEvaluator.EvalBinaryModExpr int shl/shr ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2526. {$ENDIF}
  2527. RaiseNotYetImplemented(20170530205332,Expr);
  2528. end;
  2529. revkUInt:
  2530. case RightValue.Kind of
  2531. revkInt:
  2532. // uint shl int
  2533. begin
  2534. if (TResEvalInt(RightValue).Int<0) or (TResEvalInt(RightValue).Int>63) then
  2535. EmitRangeCheckConst(20170530205414,IntToStr(TResEvalInt(RightValue).Int),0,63,Expr);
  2536. if ShiftLeft then
  2537. UInt:=TResEvalUInt(LeftValue).UInt shl byte(TResEvalInt(RightValue).Int)
  2538. else
  2539. UInt:=TResEvalUInt(LeftValue).UInt shr byte(TResEvalInt(RightValue).Int);
  2540. Result:=CreateResEvalInt(UInt);
  2541. end;
  2542. revkUInt:
  2543. // uint shl uint
  2544. begin
  2545. if (TResEvalUInt(RightValue).UInt>63) then
  2546. EmitRangeCheckConst(20170530205601,IntToStr(TResEvalUInt(RightValue).UInt),0,63,Expr);
  2547. if ShiftLeft then
  2548. UInt:=TResEvalUInt(LeftValue).UInt shl byte(TResEvalUInt(RightValue).UInt)
  2549. else
  2550. UInt:=TResEvalUInt(LeftValue).UInt shr byte(TResEvalUInt(RightValue).UInt);
  2551. Result:=CreateResEvalInt(UInt);
  2552. end;
  2553. else
  2554. {$IFDEF VerbosePasResolver}
  2555. writeln('TResExprEvaluator.EvalBinaryShiftExpr uint shl/shr ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2556. {$ENDIF}
  2557. RaiseNotYetImplemented(20170530205640,Expr);
  2558. end;
  2559. else
  2560. {$IFDEF VerbosePasResolver}
  2561. writeln('TResExprEvaluator.EvalBinaryShiftExpr shl/shr ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2562. {$ENDIF}
  2563. RaiseNotYetImplemented(20170530205646,Expr);
  2564. end;
  2565. end;
  2566. function TResExprEvaluator.EvalBinaryBoolOpExpr(Expr: TBinaryExpr; LeftValue,
  2567. RightValue: TResEvalValue): TResEvalValue;
  2568. // AND, OR, XOR
  2569. begin
  2570. Result:=nil;
  2571. case LeftValue.Kind of
  2572. revkBool:
  2573. case RightValue.Kind of
  2574. revkBool:
  2575. begin
  2576. // logical and/or/xor
  2577. Result:=TResEvalBool.Create;
  2578. case Expr.OpCode of
  2579. eopAnd: TResEvalBool(Result).B:=TResEvalBool(LeftValue).B and TResEvalBool(RightValue).B;
  2580. eopOr: TResEvalBool(Result).B:=TResEvalBool(LeftValue).B or TResEvalBool(RightValue).B;
  2581. eopXor: TResEvalBool(Result).B:=TResEvalBool(LeftValue).B xor TResEvalBool(RightValue).B;
  2582. end;
  2583. end;
  2584. else
  2585. {$IFDEF VerbosePasResolver}
  2586. writeln('TResExprEvaluator.EvalBinaryBoolOpExpr bool ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2587. {$ENDIF}
  2588. RaiseNotYetImplemented(20170531011502,Expr);
  2589. end;
  2590. revkInt:
  2591. case RightValue.Kind of
  2592. revkInt:
  2593. begin
  2594. // bitwise and/or/xor
  2595. Result:=TResEvalInt.Create;
  2596. case Expr.OpCode of
  2597. eopAnd: TResEvalInt(Result).Int:=TResEvalInt(LeftValue).Int and TResEvalInt(RightValue).Int;
  2598. eopOr: TResEvalInt(Result).Int:=TResEvalInt(LeftValue).Int or TResEvalInt(RightValue).Int;
  2599. eopXor: TResEvalInt(Result).Int:=TResEvalInt(LeftValue).Int xor TResEvalInt(RightValue).Int;
  2600. end;
  2601. end;
  2602. else
  2603. {$IFDEF VerbosePasResolver}
  2604. writeln('TResExprEvaluator.EvalBinaryBoolOpExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2605. {$ENDIF}
  2606. RaiseNotYetImplemented(20170530211140,Expr);
  2607. end;
  2608. revkUInt:
  2609. case RightValue.Kind of
  2610. revkUInt:
  2611. begin
  2612. // bitwise and/or/xor
  2613. Result:=TResEvalUInt.Create;
  2614. case Expr.OpCode of
  2615. eopAnd: TResEvalUInt(Result).UInt:=TResEvalUInt(LeftValue).UInt and TResEvalUInt(RightValue).UInt;
  2616. eopOr: TResEvalUInt(Result).UInt:=TResEvalUInt(LeftValue).UInt or TResEvalUInt(RightValue).UInt;
  2617. eopXor: TResEvalUInt(Result).UInt:=TResEvalUInt(LeftValue).UInt xor TResEvalUInt(RightValue).UInt;
  2618. end;
  2619. end;
  2620. else
  2621. {$IFDEF VerbosePasResolver}
  2622. writeln('TResExprEvaluator.EvalBinaryBoolOpExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2623. {$ENDIF}
  2624. RaiseNotYetImplemented(20170530211140,Expr);
  2625. end;
  2626. else
  2627. {$IFDEF VerbosePasResolver}
  2628. writeln('TResExprEvaluator.EvalBinaryBoolOpExpr ',Expr.OpCode,' ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2629. {$ENDIF}
  2630. RaiseNotYetImplemented(20170530205938,Expr);
  2631. end;
  2632. end;
  2633. function TResExprEvaluator.EvalBinaryNEqualExpr(Expr: TBinaryExpr; LeftValue,
  2634. RightValue: TResEvalValue): TResEvalValue;
  2635. var
  2636. UInt: TMaxPrecUInt;
  2637. LeftSet, RightSet: TResEvalSet;
  2638. i: Integer;
  2639. begin
  2640. Result:=TResEvalBool.Create;
  2641. try
  2642. {$Q+}
  2643. {$R+}
  2644. case LeftValue.Kind of
  2645. revkBool:
  2646. case RightValue.Kind of
  2647. revkBool:
  2648. TResEvalBool(Result).B:=TResEvalBool(LeftValue).B=TResEvalBool(RightValue).B;
  2649. else
  2650. {$IFDEF VerbosePasResolver}
  2651. writeln('TResExprEvaluator.EvalBinaryNEqualExpr bool ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2652. {$ENDIF}
  2653. Result.Free;
  2654. RaiseNotYetImplemented(20170531011937,Expr);
  2655. end;
  2656. revkInt:
  2657. case RightValue.Kind of
  2658. revkInt:
  2659. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalInt(RightValue).Int;
  2660. revkUInt:
  2661. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalUInt(RightValue).UInt;
  2662. revkFloat:
  2663. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalFloat(RightValue).FloatValue;
  2664. revkCurrency:
  2665. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalCurrency(RightValue).Value;
  2666. else
  2667. {$IFDEF VerbosePasResolver}
  2668. writeln('TResExprEvaluator.EvalBinaryNEqualExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2669. {$ENDIF}
  2670. Result.Free;
  2671. RaiseNotYetImplemented(20170531012412,Expr);
  2672. end;
  2673. revkUInt:
  2674. begin
  2675. UInt:=TResEvalUInt(LeftValue).UInt;
  2676. case RightValue.Kind of
  2677. revkInt:
  2678. TResEvalBool(Result).B:=(UInt<=HighIntAsUInt)
  2679. and (TMaxPrecInt(UInt)=TResEvalInt(RightValue).Int);
  2680. revkUInt:
  2681. TResEvalBool(Result).B:=UInt=TResEvalUInt(RightValue).UInt;
  2682. revkFloat:
  2683. TResEvalBool(Result).B:=UInt=TResEvalFloat(RightValue).FloatValue;
  2684. revkCurrency:
  2685. TResEvalBool(Result).B:=UInt=TResEvalCurrency(RightValue).Value;
  2686. else
  2687. {$IFDEF VerbosePasResolver}
  2688. writeln('TResExprEvaluator.EvalBinaryNEqualExpr uint ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2689. {$ENDIF}
  2690. Result.Free;
  2691. RaiseNotYetImplemented(20170601122803,Expr);
  2692. end;
  2693. end;
  2694. revkFloat:
  2695. case RightValue.Kind of
  2696. revkInt:
  2697. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalInt(RightValue).Int;
  2698. revkUInt:
  2699. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalUInt(RightValue).UInt;
  2700. revkFloat:
  2701. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalFloat(RightValue).FloatValue;
  2702. revkCurrency:
  2703. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalCurrency(RightValue).Value;
  2704. else
  2705. {$IFDEF VerbosePasResolver}
  2706. writeln('TResExprEvaluator.EvalBinaryNEqualExpr float ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2707. {$ENDIF}
  2708. Result.Free;
  2709. RaiseNotYetImplemented(20170601122806,Expr);
  2710. end;
  2711. revkCurrency:
  2712. case RightValue.Kind of
  2713. revkInt:
  2714. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value=TResEvalInt(RightValue).Int;
  2715. revkUInt:
  2716. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value=TResEvalUInt(RightValue).UInt;
  2717. revkFloat:
  2718. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value=TResEvalFloat(RightValue).FloatValue;
  2719. revkCurrency:
  2720. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value=TResEvalCurrency(RightValue).Value;
  2721. else
  2722. {$IFDEF VerbosePasResolver}
  2723. writeln('TResExprEvaluator.EvalBinaryNEqualExpr currency ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2724. {$ENDIF}
  2725. Result.Free;
  2726. RaiseNotYetImplemented(20180421165438,Expr);
  2727. end;
  2728. {$ifdef FPC_HAS_CPSTRING}
  2729. revkString:
  2730. case RightValue.Kind of
  2731. revkString:
  2732. if GetCodePage(TResEvalString(LeftValue).S)=GetCodePage(TResEvalString(RightValue).S) then
  2733. TResEvalBool(Result).B:=TResEvalString(LeftValue).S=TResEvalString(RightValue).S
  2734. else
  2735. TResEvalBool(Result).B:=GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left)
  2736. =GetUnicodeStr(TResEvalString(RightValue).S,Expr.right);
  2737. revkUnicodeString:
  2738. TResEvalBool(Result).B:=GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left)
  2739. =TResEvalUTF16(RightValue).S;
  2740. else
  2741. {$IFDEF VerbosePasResolver}
  2742. writeln('TResExprEvaluator.EvalBinaryNEqualExpr string ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2743. {$ENDIF}
  2744. Result.Free;
  2745. RaiseNotYetImplemented(20170711175409,Expr);
  2746. end;
  2747. {$endif}
  2748. revkUnicodeString:
  2749. case RightValue.Kind of
  2750. {$ifdef FPC_HAS_CPSTRING}
  2751. revkString:
  2752. TResEvalBool(Result).B:=TResEvalUTF16(LeftValue).S
  2753. =GetUnicodeStr(TResEvalString(RightValue).S,Expr.right);
  2754. {$endif}
  2755. revkUnicodeString:
  2756. TResEvalBool(Result).B:=TResEvalUTF16(LeftValue).S
  2757. =TResEvalUTF16(RightValue).S;
  2758. else
  2759. {$IFDEF VerbosePasResolver}
  2760. writeln('TResExprEvaluator.EvalBinaryNEqualExpr string ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2761. {$ENDIF}
  2762. Result.Free;
  2763. RaiseNotYetImplemented(20170711175409,Expr);
  2764. end;
  2765. revkSetOfInt:
  2766. case RightValue.Kind of
  2767. revkSetOfInt:
  2768. begin
  2769. LeftSet:=TResEvalSet(LeftValue);
  2770. RightSet:=TResEvalSet(RightValue);
  2771. if LeftSet.ElKind=revskNone then
  2772. TResEvalBool(Result).B:=length(RightSet.Ranges)=0
  2773. else if RightSet.ElKind=revskNone then
  2774. TResEvalBool(Result).B:=length(LeftSet.Ranges)=0
  2775. else if length(LeftSet.Ranges)<>length(RightSet.Ranges) then
  2776. TResEvalBool(Result).B:=false
  2777. else
  2778. begin
  2779. TResEvalBool(Result).B:=true;
  2780. for i:=0 to length(LeftSet.Ranges)-1 do
  2781. if (LeftSet.Ranges[i].RangeStart<>RightSet.Ranges[i].RangeStart)
  2782. or (LeftSet.Ranges[i].RangeEnd<>RightSet.Ranges[i].RangeEnd) then
  2783. begin
  2784. TResEvalBool(Result).B:=false;
  2785. break;
  2786. end;
  2787. end;
  2788. end;
  2789. else
  2790. {$IFDEF VerbosePasResolver}
  2791. writeln('TResExprEvaluator.EvalBinaryNEqualExpr ',Expr.OpCode,' set=? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2792. {$ENDIF}
  2793. RaiseNotYetImplemented(20170714120756,Expr);
  2794. end;
  2795. else
  2796. {$IFDEF VerbosePasResolver}
  2797. writeln('TResExprEvaluator.EvalBinaryNEqualExpr ',Expr.OpCode,' ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2798. {$ENDIF}
  2799. Result.Free;
  2800. RaiseNotYetImplemented(20170531011931,Expr);
  2801. end;
  2802. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  2803. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  2804. except
  2805. on EOverflow do
  2806. RaiseOverflowArithmetic(20170601132729,Expr);
  2807. on ERangeError do
  2808. RaiseRangeCheck(20170601132740,Expr);
  2809. end;
  2810. if Expr.OpCode=eopNotEqual then
  2811. TResEvalBool(Result).B:=not TResEvalBool(Result).B;
  2812. end;
  2813. function TResExprEvaluator.EvalBinaryLessGreaterExpr(Expr: TBinaryExpr;
  2814. LeftValue, RightValue: TResEvalValue): TResEvalValue;
  2815. procedure CmpUnicode(const LeftUnicode, RightUnicode: UnicodeString);
  2816. begin
  2817. case Expr.OpCode of
  2818. eopLessThan:
  2819. TResEvalBool(Result).B:=LeftUnicode < RightUnicode;
  2820. eopGreaterThan:
  2821. TResEvalBool(Result).B:=LeftUnicode > RightUnicode;
  2822. eopLessthanEqual:
  2823. TResEvalBool(Result).B:=LeftUnicode <= RightUnicode;
  2824. eopGreaterThanEqual:
  2825. TResEvalBool(Result).B:=LeftUnicode >= RightUnicode;
  2826. end;
  2827. end;
  2828. var
  2829. LeftSet, RightSet: TResEvalSet;
  2830. i: Integer;
  2831. Int: TMaxPrecInt;
  2832. begin
  2833. Result:=TResEvalBool.Create;
  2834. try
  2835. {$Q+}
  2836. {$R+}
  2837. case LeftValue.Kind of
  2838. revkInt:
  2839. case RightValue.Kind of
  2840. revkInt:
  2841. case Expr.OpCode of
  2842. eopLessThan:
  2843. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int < TResEvalInt(RightValue).Int;
  2844. eopGreaterThan:
  2845. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int > TResEvalInt(RightValue).Int;
  2846. eopLessthanEqual:
  2847. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int <= TResEvalInt(RightValue).Int;
  2848. eopGreaterThanEqual:
  2849. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int >= TResEvalInt(RightValue).Int;
  2850. end;
  2851. revkUInt:
  2852. case Expr.OpCode of
  2853. eopLessThan:
  2854. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int < TResEvalUInt(RightValue).UInt;
  2855. eopGreaterThan:
  2856. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int > TResEvalUInt(RightValue).UInt;
  2857. eopLessthanEqual:
  2858. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int <= TResEvalUInt(RightValue).UInt;
  2859. eopGreaterThanEqual:
  2860. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int >= TResEvalUInt(RightValue).UInt;
  2861. end;
  2862. revkFloat:
  2863. case Expr.OpCode of
  2864. eopLessThan:
  2865. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int < TResEvalFloat(RightValue).FloatValue;
  2866. eopGreaterThan:
  2867. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int > TResEvalFloat(RightValue).FloatValue;
  2868. eopLessthanEqual:
  2869. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int <= TResEvalFloat(RightValue).FloatValue;
  2870. eopGreaterThanEqual:
  2871. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int >= TResEvalFloat(RightValue).FloatValue;
  2872. end;
  2873. revkCurrency:
  2874. case Expr.OpCode of
  2875. eopLessThan:
  2876. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int < TResEvalCurrency(RightValue).Value;
  2877. eopGreaterThan:
  2878. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int > TResEvalCurrency(RightValue).Value;
  2879. eopLessthanEqual:
  2880. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int <= TResEvalCurrency(RightValue).Value;
  2881. eopGreaterThanEqual:
  2882. TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int >= TResEvalCurrency(RightValue).Value;
  2883. end;
  2884. else
  2885. {$IFDEF VerbosePasResolver}
  2886. writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2887. {$ENDIF}
  2888. Result.Free;
  2889. RaiseNotYetImplemented(20170601122512,Expr);
  2890. end;
  2891. revkUInt:
  2892. case RightValue.Kind of
  2893. revkInt:
  2894. case Expr.OpCode of
  2895. eopLessThan:
  2896. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt < TResEvalInt(RightValue).Int;
  2897. eopGreaterThan:
  2898. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt > TResEvalInt(RightValue).Int;
  2899. eopLessthanEqual:
  2900. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt <= TResEvalInt(RightValue).Int;
  2901. eopGreaterThanEqual:
  2902. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt >= TResEvalInt(RightValue).Int;
  2903. end;
  2904. revkUInt:
  2905. case Expr.OpCode of
  2906. eopLessThan:
  2907. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt < TResEvalUInt(RightValue).UInt;
  2908. eopGreaterThan:
  2909. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt > TResEvalUInt(RightValue).UInt;
  2910. eopLessthanEqual:
  2911. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt <= TResEvalUInt(RightValue).UInt;
  2912. eopGreaterThanEqual:
  2913. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt >= TResEvalUInt(RightValue).UInt;
  2914. end;
  2915. revkFloat:
  2916. case Expr.OpCode of
  2917. eopLessThan:
  2918. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt < TResEvalFloat(RightValue).FloatValue;
  2919. eopGreaterThan:
  2920. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt > TResEvalFloat(RightValue).FloatValue;
  2921. eopLessthanEqual:
  2922. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt <= TResEvalFloat(RightValue).FloatValue;
  2923. eopGreaterThanEqual:
  2924. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt >= TResEvalFloat(RightValue).FloatValue;
  2925. end;
  2926. revkCurrency:
  2927. case Expr.OpCode of
  2928. eopLessThan:
  2929. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt < TResEvalCurrency(RightValue).Value;
  2930. eopGreaterThan:
  2931. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt > TResEvalCurrency(RightValue).Value;
  2932. eopLessthanEqual:
  2933. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt <= TResEvalCurrency(RightValue).Value;
  2934. eopGreaterThanEqual:
  2935. TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt >= TResEvalCurrency(RightValue).Value;
  2936. end;
  2937. else
  2938. {$IFDEF VerbosePasResolver}
  2939. writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr uint ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2940. {$ENDIF}
  2941. Result.Free;
  2942. RaiseNotYetImplemented(20170601133222,Expr);
  2943. end;
  2944. revkFloat:
  2945. case RightValue.Kind of
  2946. revkInt:
  2947. case Expr.OpCode of
  2948. eopLessThan:
  2949. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue < TResEvalInt(RightValue).Int;
  2950. eopGreaterThan:
  2951. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue > TResEvalInt(RightValue).Int;
  2952. eopLessthanEqual:
  2953. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue <= TResEvalInt(RightValue).Int;
  2954. eopGreaterThanEqual:
  2955. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue >= TResEvalInt(RightValue).Int;
  2956. end;
  2957. revkUInt:
  2958. case Expr.OpCode of
  2959. eopLessThan:
  2960. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue < TResEvalUInt(RightValue).UInt;
  2961. eopGreaterThan:
  2962. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue > TResEvalUInt(RightValue).UInt;
  2963. eopLessthanEqual:
  2964. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue <= TResEvalUInt(RightValue).UInt;
  2965. eopGreaterThanEqual:
  2966. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue >= TResEvalUInt(RightValue).UInt;
  2967. end;
  2968. revkFloat:
  2969. case Expr.OpCode of
  2970. eopLessThan:
  2971. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue < TResEvalFloat(RightValue).FloatValue;
  2972. eopGreaterThan:
  2973. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue > TResEvalFloat(RightValue).FloatValue;
  2974. eopLessthanEqual:
  2975. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue <= TResEvalFloat(RightValue).FloatValue;
  2976. eopGreaterThanEqual:
  2977. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue >= TResEvalFloat(RightValue).FloatValue;
  2978. end;
  2979. revkCurrency:
  2980. case Expr.OpCode of
  2981. eopLessThan:
  2982. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue < TResEvalCurrency(RightValue).Value;
  2983. eopGreaterThan:
  2984. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue > TResEvalCurrency(RightValue).Value;
  2985. eopLessthanEqual:
  2986. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue <= TResEvalCurrency(RightValue).Value;
  2987. eopGreaterThanEqual:
  2988. TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue >= TResEvalCurrency(RightValue).Value;
  2989. end;
  2990. else
  2991. {$IFDEF VerbosePasResolver}
  2992. writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr float ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  2993. {$ENDIF}
  2994. Result.Free;
  2995. RaiseNotYetImplemented(20170601133421,Expr);
  2996. end;
  2997. revkCurrency:
  2998. case RightValue.Kind of
  2999. revkInt:
  3000. case Expr.OpCode of
  3001. eopLessThan:
  3002. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value < TResEvalInt(RightValue).Int;
  3003. eopGreaterThan:
  3004. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value > TResEvalInt(RightValue).Int;
  3005. eopLessthanEqual:
  3006. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value <= TResEvalInt(RightValue).Int;
  3007. eopGreaterThanEqual:
  3008. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value >= TResEvalInt(RightValue).Int;
  3009. end;
  3010. revkUInt:
  3011. case Expr.OpCode of
  3012. eopLessThan:
  3013. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value < TResEvalUInt(RightValue).UInt;
  3014. eopGreaterThan:
  3015. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value > TResEvalUInt(RightValue).UInt;
  3016. eopLessthanEqual:
  3017. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value <= TResEvalUInt(RightValue).UInt;
  3018. eopGreaterThanEqual:
  3019. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value >= TResEvalUInt(RightValue).UInt;
  3020. end;
  3021. revkFloat:
  3022. case Expr.OpCode of
  3023. eopLessThan:
  3024. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value < TResEvalFloat(RightValue).FloatValue;
  3025. eopGreaterThan:
  3026. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value > TResEvalFloat(RightValue).FloatValue;
  3027. eopLessthanEqual:
  3028. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value <= TResEvalFloat(RightValue).FloatValue;
  3029. eopGreaterThanEqual:
  3030. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value >= TResEvalFloat(RightValue).FloatValue;
  3031. end;
  3032. revkCurrency:
  3033. case Expr.OpCode of
  3034. eopLessThan:
  3035. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value < TResEvalCurrency(RightValue).Value;
  3036. eopGreaterThan:
  3037. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value > TResEvalCurrency(RightValue).Value;
  3038. eopLessthanEqual:
  3039. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value <= TResEvalCurrency(RightValue).Value;
  3040. eopGreaterThanEqual:
  3041. TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value >= TResEvalCurrency(RightValue).Value;
  3042. end;
  3043. else
  3044. {$IFDEF VerbosePasResolver}
  3045. writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr currency ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  3046. {$ENDIF}
  3047. Result.Free;
  3048. RaiseNotYetImplemented(20180421165752,Expr);
  3049. end;
  3050. {$ifdef FPC_HAS_CPSTRING}
  3051. revkString:
  3052. case RightValue.Kind of
  3053. revkString:
  3054. if GetCodePage(TResEvalString(LeftValue).S)=GetCodePage(TResEvalString(RightValue).S) then
  3055. case Expr.OpCode of
  3056. eopLessThan:
  3057. TResEvalBool(Result).B:=TResEvalString(LeftValue).S < TResEvalString(RightValue).S;
  3058. eopGreaterThan:
  3059. TResEvalBool(Result).B:=TResEvalString(LeftValue).S > TResEvalString(RightValue).S;
  3060. eopLessthanEqual:
  3061. TResEvalBool(Result).B:=TResEvalString(LeftValue).S <= TResEvalString(RightValue).S;
  3062. eopGreaterThanEqual:
  3063. TResEvalBool(Result).B:=TResEvalString(LeftValue).S >= TResEvalString(RightValue).S;
  3064. end
  3065. else
  3066. CmpUnicode(GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left),
  3067. GetUnicodeStr(TResEvalString(RightValue).S,Expr.right));
  3068. revkUnicodeString:
  3069. CmpUnicode(GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left),
  3070. TResEvalUTF16(RightValue).S);
  3071. else
  3072. {$IFDEF VerbosePasResolver}
  3073. writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr string ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  3074. {$ENDIF}
  3075. Result.Free;
  3076. RaiseNotYetImplemented(20170711175629,Expr);
  3077. end;
  3078. {$endif}
  3079. revkUnicodeString:
  3080. case RightValue.Kind of
  3081. {$ifdef FPC_HAS_CPSTRING}
  3082. revkString:
  3083. CmpUnicode(TResEvalUTF16(LeftValue).S,
  3084. GetUnicodeStr(TResEvalString(RightValue).S,Expr.right));
  3085. {$endif}
  3086. revkUnicodeString:
  3087. CmpUnicode(TResEvalUTF16(LeftValue).S,TResEvalUTF16(RightValue).S);
  3088. else
  3089. {$IFDEF VerbosePasResolver}
  3090. writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr unicodestring ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  3091. {$ENDIF}
  3092. Result.Free;
  3093. RaiseNotYetImplemented(20170711210730,Expr);
  3094. end;
  3095. revkSetOfInt:
  3096. case RightValue.Kind of
  3097. revkSetOfInt:
  3098. begin
  3099. LeftSet:=TResEvalSet(LeftValue);
  3100. RightSet:=TResEvalSet(RightValue);
  3101. case Expr.OpCode of
  3102. eopGreaterThanEqual:
  3103. begin
  3104. // >= -> true if all elements of RightSet are in LeftSet
  3105. TResEvalBool(Result).B:=true;
  3106. for i:=0 to length(RightSet.Ranges)-1 do
  3107. begin
  3108. Int:=RightSet.Ranges[i].RangeStart;
  3109. while Int<=RightSet.Ranges[i].RangeEnd do
  3110. begin
  3111. if LeftSet.IndexOfRange(Int)<0 then
  3112. begin
  3113. TResEvalBool(Result).B:=false;
  3114. break;
  3115. end;
  3116. inc(Int);
  3117. end;
  3118. end;
  3119. end;
  3120. eopLessthanEqual:
  3121. begin
  3122. // <= -> true if all elements of LeftSet are in RightSet
  3123. TResEvalBool(Result).B:=true;
  3124. for i:=0 to length(LeftSet.Ranges)-1 do
  3125. begin
  3126. Int:=LeftSet.Ranges[i].RangeStart;
  3127. while Int<=LeftSet.Ranges[i].RangeEnd do
  3128. begin
  3129. if RightSet.IndexOfRange(Int)<0 then
  3130. begin
  3131. TResEvalBool(Result).B:=false;
  3132. break;
  3133. end;
  3134. inc(Int);
  3135. end;
  3136. end;
  3137. end
  3138. else
  3139. {$IFDEF VerbosePasResolver}
  3140. writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr set ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  3141. {$ENDIF}
  3142. Result.Free;
  3143. RaiseNotYetImplemented(20170714122121,Expr);
  3144. end;
  3145. end;
  3146. else
  3147. {$IFDEF VerbosePasResolver}
  3148. writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr set ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  3149. {$ENDIF}
  3150. Result.Free;
  3151. RaiseNotYetImplemented(20170714121925,Expr);
  3152. end;
  3153. else
  3154. {$IFDEF VerbosePasResolver}
  3155. writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr ? ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  3156. {$ENDIF}
  3157. Result.Free;
  3158. RaiseNotYetImplemented(20170601122529,Expr);
  3159. end;
  3160. except
  3161. on EOverflow do
  3162. RaiseOverflowArithmetic(20170601132956,Expr);
  3163. on ERangeError do
  3164. RaiseRangeCheck(20170601132958,Expr);
  3165. end;
  3166. end;
  3167. function TResExprEvaluator.EvalBinaryInExpr(Expr: TBinaryExpr; LeftValue,
  3168. RightValue: TResEvalValue): TResEvalValue;
  3169. var
  3170. RightSet: TResEvalSet;
  3171. Int: TMaxPrecInt;
  3172. begin
  3173. Result:=nil;
  3174. case RightValue.Kind of
  3175. revkSetOfInt:
  3176. begin
  3177. RightSet:=TResEvalSet(RightValue);
  3178. case LeftValue.Kind of
  3179. revkBool:
  3180. Int:=ord(TResEvalBool(LeftValue).B);
  3181. revkInt:
  3182. Int:=TResEvalInt(LeftValue).Int;
  3183. revkUInt:
  3184. // Note: when FPC compares int64 with qword it converts the qword to an int64
  3185. if TResEvalUInt(LeftValue).UInt>HighIntAsUInt then
  3186. RaiseMsg(20170714123700,nRangeCheckError,sRangeCheckError,[],Expr)
  3187. else
  3188. Int:=TResEvalUInt(LeftValue).UInt;
  3189. {$ifdef FPC_HAS_CPSTRING}
  3190. revkString:
  3191. if length(TResEvalString(LeftValue).S)<>1 then
  3192. RaiseMsg(20170714124231,nXExpectedButYFound,sXExpectedButYFound,
  3193. ['char','string'],Expr)
  3194. else
  3195. Int:=ord(TResEvalString(LeftValue).S[1]);
  3196. {$endif}
  3197. revkUnicodeString:
  3198. if length(TResEvalUTF16(LeftValue).S)<>1 then
  3199. RaiseMsg(20170714124320,nXExpectedButYFound,sXExpectedButYFound,
  3200. ['char','unicodestring'],Expr)
  3201. else
  3202. Int:=ord(TResEvalUTF16(LeftValue).S[1]);
  3203. revkEnum:
  3204. Int:=TResEvalEnum(LeftValue).Index;
  3205. else
  3206. {$IFDEF VerbosePasResolver}
  3207. writeln('TResExprEvaluator.EvalBinaryInExpr ? in Set Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  3208. {$ENDIF}
  3209. RaiseNotYetImplemented(20170714123412,Expr);
  3210. end;
  3211. Result:=TResEvalBool.CreateValue(RightSet.IndexOfRange(Int)>=0);
  3212. end;
  3213. else
  3214. {$IFDEF VerbosePasResolver}
  3215. writeln('TResExprEvaluator.EvalBinaryInExpr ? ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  3216. {$ENDIF}
  3217. RaiseNotYetImplemented(20170714123409,Expr);
  3218. end;
  3219. end;
  3220. function TResExprEvaluator.EvalBinarySymmetricaldifferenceExpr(
  3221. Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  3222. var
  3223. LeftSet, RightSet: TResEvalSet;
  3224. i: Integer;
  3225. Int: TMaxPrecInt;
  3226. begin
  3227. case LeftValue.Kind of
  3228. revkSetOfInt:
  3229. case RightValue.Kind of
  3230. revkSetOfInt:
  3231. begin
  3232. // sym diff
  3233. LeftSet:=TResEvalSet(LeftValue);
  3234. RightSet:=TResEvalSet(RightValue);
  3235. // elements, which exists in either, but not both
  3236. if LeftSet.ElKind=revskNone then
  3237. Result:=RightSet.Clone
  3238. else
  3239. begin
  3240. Result:=TResEvalSet.CreateEmptySameKind(LeftSet);
  3241. for i:=0 to length(LeftSet.Ranges)-1 do
  3242. begin
  3243. Int:=LeftSet.Ranges[i].RangeStart;
  3244. while Int<=LeftSet.Ranges[i].RangeEnd do
  3245. begin
  3246. if RightSet.IndexOfRange(Int)<0 then
  3247. TResEvalSet(Result).Add(Int,Int);
  3248. inc(Int);
  3249. end;
  3250. end;
  3251. for i:=0 to length(RightSet.Ranges)-1 do
  3252. begin
  3253. Int:=RightSet.Ranges[i].RangeStart;
  3254. while Int<=RightSet.Ranges[i].RangeEnd do
  3255. begin
  3256. if LeftSet.IndexOfRange(Int)<0 then
  3257. TResEvalSet(Result).Add(Int,Int);
  3258. inc(Int);
  3259. end;
  3260. end;
  3261. end;
  3262. end
  3263. else
  3264. {$IFDEF VerbosePasResolver}
  3265. writeln('TResExprEvaluator.EvalBinarySymmetricaldifferenceExpr Set><? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  3266. {$ENDIF}
  3267. RaiseNotYetImplemented(20170714114144,Expr);
  3268. end;
  3269. else
  3270. {$IFDEF VerbosePasResolver}
  3271. writeln('TResExprEvaluator.EvalBinarySymmetricaldifferenceExpr ? ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  3272. {$ENDIF}
  3273. RaiseNotYetImplemented(20170714114119,Expr);
  3274. end;
  3275. end;
  3276. function TResExprEvaluator.EvalParamsExpr(Expr: TParamsExpr;
  3277. Flags: TResEvalFlags): TResEvalValue;
  3278. begin
  3279. Result:=OnEvalParams(Self,Expr,Flags);
  3280. if Result<>nil then exit;
  3281. case Expr.Kind of
  3282. pekArrayParams: Result:=EvalArrayParamsExpr(Expr,Flags);
  3283. pekSet: Result:=EvalSetParamsExpr(Expr,Flags);
  3284. end;
  3285. if Result=nil then
  3286. begin
  3287. if [refConst,refConstExt]*Flags<>[] then
  3288. RaiseConstantExprExp(20170713124038,Expr);
  3289. exit;
  3290. end;
  3291. end;
  3292. function TResExprEvaluator.EvalArrayParamsExpr(Expr: TParamsExpr;
  3293. Flags: TResEvalFlags): TResEvalValue;
  3294. var
  3295. ArrayValue, IndexValue: TResEvalValue;
  3296. Int: TMaxPrecInt;
  3297. Param0: TPasExpr;
  3298. MaxIndex: Integer;
  3299. begin
  3300. Result:=nil;
  3301. ArrayValue:=Eval(Expr.Value,Flags);
  3302. if ArrayValue=nil then
  3303. begin
  3304. if [refConst,refConstExt]*Flags<>[] then
  3305. RaiseConstantExprExp(20170711181321,Expr.Value);
  3306. exit;
  3307. end;
  3308. IndexValue:=nil;
  3309. try
  3310. case ArrayValue.Kind of
  3311. {$ifdef FPC_HAS_CPSTRING}
  3312. revkString,
  3313. {$endif}
  3314. revkUnicodeString:
  3315. begin
  3316. // string[index]
  3317. Param0:=Expr.Params[0];
  3318. IndexValue:=Eval(Param0,Flags);
  3319. if IndexValue=nil then
  3320. begin
  3321. if [refConst,refConstExt]*Flags<>[] then
  3322. RaiseConstantExprExp(20170711181603,Param0);
  3323. exit;
  3324. end;
  3325. case IndexValue.Kind of
  3326. revkInt: Int:=TResEvalInt(IndexValue).Int;
  3327. revkUInt:
  3328. // Note: when FPC compares int64 with qword it converts the qword to an int64
  3329. if TResEvalUInt(IndexValue).UInt>HighIntAsUInt then
  3330. RaiseRangeCheck(20170711182006,Param0)
  3331. else
  3332. Int:=TResEvalUInt(IndexValue).UInt;
  3333. else
  3334. {$IFDEF VerbosePasResolver}
  3335. writeln('TResExprEvaluator.EvalParamsExpr string[',IndexValue.AsDebugString,']');
  3336. {$ENDIF}
  3337. RaiseNotYetImplemented(20170711182100,Expr);
  3338. end;
  3339. {$ifdef FPC_HAS_CPSTRING}
  3340. if ArrayValue.Kind=revkString then
  3341. MaxIndex:=length(TResEvalString(ArrayValue).S)
  3342. else
  3343. {$endif}
  3344. MaxIndex:=length(TResEvalUTF16(ArrayValue).S);
  3345. if (Int<1) or (Int>MaxIndex) then
  3346. EmitRangeCheckConst(20170711183058,IntToStr(Int),'1',IntToStr(MaxIndex),Param0,mtError);
  3347. {$ifdef FPC_HAS_CPSTRING}
  3348. if ArrayValue.Kind=revkString then
  3349. Result:=TResEvalString.CreateValue(TResEvalString(ArrayValue).S[Int])
  3350. else
  3351. {$endif}
  3352. Result:=TResEvalUTF16.CreateValue(TResEvalUTF16(ArrayValue).S[Int]);
  3353. exit;
  3354. end;
  3355. else
  3356. {$IFDEF VerbosePasResolver}
  3357. writeln('TResExprEvaluator.EvalParamsExpr Array=',ArrayValue.AsDebugString);
  3358. {$ENDIF}
  3359. RaiseNotYetImplemented(20170711181507,Expr);
  3360. end;
  3361. if [refConst,refConstExt]*Flags<>[] then
  3362. RaiseConstantExprExp(20170522173150,Expr);
  3363. finally
  3364. ReleaseEvalValue(ArrayValue);
  3365. ReleaseEvalValue(IndexValue);
  3366. end;
  3367. end;
  3368. function TResExprEvaluator.EvalSetParamsExpr(Expr: TParamsExpr;
  3369. Flags: TResEvalFlags): TResEvalSet;
  3370. begin
  3371. {$IFDEF VerbosePasResEval}
  3372. writeln('TResExprEvaluator.EvalSetParamsExpr length(Expr.Params)=',length(Expr.Params));
  3373. {$ENDIF}
  3374. Result:=EvalSetExpr(Expr,Expr.Params,Flags);
  3375. end;
  3376. function TResExprEvaluator.EvalSetExpr(Expr: TPasExpr;
  3377. ExprArray: TPasExprArray; Flags: TResEvalFlags): TResEvalSet;
  3378. var
  3379. i: Integer;
  3380. RangeStart, RangeEnd: TMaxPrecInt;
  3381. Value: TResEvalValue;
  3382. ok, OnlyConstElements: Boolean;
  3383. El: TPasExpr;
  3384. begin
  3385. {$IFDEF VerbosePasResEval}
  3386. writeln('TResExprEvaluator.EvalSetExpr Expr=',GetObjName(Expr),' length(ExprArray)=',length(ExprArray));
  3387. {$ENDIF}
  3388. Result:=TResEvalSet.Create;
  3389. if Expr=nil then ;
  3390. Value:=nil;
  3391. OnlyConstElements:=true;
  3392. ok:=false;
  3393. try
  3394. for i:=0 to length(ExprArray)-1 do
  3395. begin
  3396. El:=ExprArray[i];
  3397. {$IFDEF VerbosePasResEval}
  3398. writeln('TResExprEvaluator.EvalSetExpr ',i,' of ',length(ExprArray),' El=',GetObjName(El));
  3399. {$ENDIF}
  3400. Value:=Eval(El,Flags);
  3401. if Value=nil then
  3402. begin
  3403. // element is not a const -> the set is not a const
  3404. OnlyConstElements:=false;
  3405. continue;
  3406. end;
  3407. {$IFDEF VerbosePasResEval}
  3408. //writeln('TResExprEvaluator.EvalSetExpr ',i,' of ',length(ExprArray),' Value=',Value.AsDebugString);
  3409. {$ENDIF}
  3410. case Value.Kind of
  3411. revkBool:
  3412. begin
  3413. if Result.ElKind=revskNone then
  3414. Result.ElKind:=revskBool
  3415. else if Result.ElKind<>revskBool then
  3416. RaiseNotYetImplemented(20170714132843,El);
  3417. RangeStart:=ord(TResEvalBool(Value).B);
  3418. RangeEnd:=RangeStart;
  3419. end;
  3420. revkInt:
  3421. begin
  3422. if Result.ElKind=revskNone then
  3423. Result.ElKind:=revskInt
  3424. else if Result.ElKind<>revskInt then
  3425. RaiseNotYetImplemented(20170713201208,El);
  3426. RangeStart:=TResEvalInt(Value).Int;
  3427. RangeEnd:=RangeStart;
  3428. end;
  3429. revkUInt:
  3430. begin
  3431. if Result.ElKind=revskNone then
  3432. Result.ElKind:=revskInt
  3433. else if Result.ElKind<>revskInt then
  3434. RaiseNotYetImplemented(20170713201230,El)
  3435. // Note: when FPC compares int64 with qword it converts the qword to an int64
  3436. else if TResEvalUInt(Value).UInt>HighIntAsUInt then
  3437. EmitRangeCheckConst(20170713201306,Value.AsString,
  3438. '0',IntToStr(High(TMaxPrecInt)),El,mtError);
  3439. RangeStart:=TResEvalUInt(Value).UInt;
  3440. RangeEnd:=RangeStart;
  3441. end;
  3442. {$ifdef FPC_HAS_CPSTRING}
  3443. revkString:
  3444. begin
  3445. if Result.ElKind=revskNone then
  3446. Result.ElKind:=revskChar
  3447. else if Result.ElKind<>revskChar then
  3448. RaiseNotYetImplemented(20170713201456,El);
  3449. if length(TResEvalString(Value).S)<>1 then
  3450. begin
  3451. // set of string (not of char)
  3452. ReleaseEvalValue(TResEvalValue(Result));
  3453. exit;
  3454. end;
  3455. RangeStart:=ord(TResEvalString(Value).S[1]);
  3456. RangeEnd:=RangeStart;
  3457. end;
  3458. {$endif}
  3459. revkUnicodeString:
  3460. begin
  3461. if Result.ElKind=revskNone then
  3462. Result.ElKind:=revskChar
  3463. else if Result.ElKind<>revskChar then
  3464. RaiseNotYetImplemented(20170713201516,El);
  3465. if length(TResEvalUTF16(Value).S)<>1 then
  3466. begin
  3467. // set of string (not of char)
  3468. ReleaseEvalValue(TResEvalValue(Result));
  3469. exit;
  3470. end;
  3471. RangeStart:=ord(TResEvalUTF16(Value).S[1]);
  3472. RangeEnd:=RangeStart;
  3473. end;
  3474. revkEnum:
  3475. begin
  3476. if Result.ElKind=revskNone then
  3477. begin
  3478. Result.ElKind:=revskEnum;
  3479. Result.ElType:=Value.IdentEl.Parent as TPasEnumType;
  3480. end
  3481. else if Result.ElKind<>revskEnum then
  3482. RaiseNotYetImplemented(20170713143559,El)
  3483. else if Result.ElType<>TResEvalEnum(Value).ElType then
  3484. RaiseNotYetImplemented(20170713201021,El);
  3485. RangeStart:=TResEvalEnum(Value).Index;
  3486. RangeEnd:=RangeStart;
  3487. end;
  3488. revkRangeInt:
  3489. begin
  3490. if Result.ElKind=revskNone then
  3491. begin
  3492. Result.ElKind:=TResEvalRangeInt(Value).ElKind;
  3493. if Result.ElKind=revskEnum then
  3494. Result.ElType:=TResEvalRangeInt(Value).ElType;
  3495. end
  3496. else if Result.ElKind<>TResEvalRangeInt(Value).ElKind then
  3497. RaiseNotYetImplemented(20170714101910,El);
  3498. RangeStart:=TResEvalRangeInt(Value).RangeStart;
  3499. RangeEnd:=TResEvalRangeInt(Value).RangeEnd;
  3500. end;
  3501. revkRangeUInt:
  3502. begin
  3503. if Result.ElKind=revskNone then
  3504. Result.ElKind:=revskInt
  3505. else if Result.ElKind<>revskInt then
  3506. RaiseNotYetImplemented(20170713202934,El)
  3507. // Note: when FPC compares int64 with qword it converts the qword to an int64
  3508. else if TResEvalRangeUInt(Value).RangeEnd>HighIntAsUInt then
  3509. EmitRangeCheckConst(20170713203034,Value.AsString,
  3510. '0',IntToStr(High(TMaxPrecInt)),El,mtError);
  3511. RangeStart:=TResEvalRangeUInt(Value).RangeStart;
  3512. RangeEnd:=TResEvalRangeUInt(Value).RangeEnd;
  3513. end
  3514. else
  3515. {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
  3516. writeln('TResExprEvaluator.EvalSetExpr Result.ElKind=',Result.ElKind,' Value.Kind=',Value.Kind);
  3517. {$ENDIF}
  3518. RaiseNotYetImplemented(20170713143422,El);
  3519. end;
  3520. if Result.Intersects(RangeStart,RangeEnd)>=0 then
  3521. begin
  3522. {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
  3523. writeln('TResExprEvaluator.EvalSetExpr Value=',Value.AsDebugString,' Range=',RangeStart,'..',RangeEnd,' Result=',Result.AsDebugString);
  3524. {$ENDIF}
  3525. RaiseMsg(20170714141326,nRangeCheckInSetConstructor,
  3526. sRangeCheckInSetConstructor,[],El);
  3527. end;
  3528. Result.Add(RangeStart,RangeEnd);
  3529. ReleaseEvalValue(Value);
  3530. end;
  3531. ok:=OnlyConstElements;
  3532. finally
  3533. ReleaseEvalValue(Value);
  3534. if not ok then
  3535. ReleaseEvalValue(TResEvalValue(Result));
  3536. end;
  3537. end;
  3538. function TResExprEvaluator.EvalArrayValuesExpr(Expr: TArrayValues;
  3539. Flags: TResEvalFlags): TResEvalSet;
  3540. begin
  3541. {$IFDEF VerbosePasResEval}
  3542. writeln('TResExprEvaluator.EvalArrayValuesExpr length(Expr.Values)=',length(Expr.Values));
  3543. {$ENDIF}
  3544. Result:=EvalSetExpr(Expr,Expr.Values,Flags);
  3545. end;
  3546. function TResExprEvaluator.EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue,
  3547. RightValue: TResEvalValue): TResEvalValue;
  3548. var
  3549. Int: TMaxPrecInt;
  3550. Flo: TMaxPrecFloat;
  3551. aCurrency: TMaxPrecCurrency;
  3552. begin
  3553. Result:=nil;
  3554. case LeftValue.Kind of
  3555. revkInt:
  3556. case RightValue.Kind of
  3557. revkInt:
  3558. // int^^int
  3559. try
  3560. {$Q+}{$R+}
  3561. Int:=trunc(Math.power(TResEvalInt(LeftValue).Int,TResEvalInt(RightValue).Int));
  3562. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3563. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3564. Result:=TResEvalInt.CreateValue(Int);
  3565. except
  3566. RaiseOverflowArithmetic(20170530210533,Expr);
  3567. end;
  3568. revkUInt:
  3569. // int^^uint
  3570. try
  3571. {$Q+}{$R+}
  3572. Int:=trunc(Math.power(TResEvalInt(LeftValue).Int,TResEvalUInt(RightValue).UInt));
  3573. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3574. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3575. Result:=TResEvalInt.CreateValue(Int);
  3576. except
  3577. RaiseOverflowArithmetic(20170530211028,Expr);
  3578. end;
  3579. revkFloat:
  3580. // int^^float
  3581. try
  3582. {$Q+}{$R+}
  3583. Flo:=Math.power(TResEvalInt(LeftValue).Int,TResEvalFloat(RightValue).FloatValue);
  3584. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3585. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3586. Result:=TResEvalFloat.CreateValue(Flo);
  3587. except
  3588. RaiseOverflowArithmetic(20170816154223,Expr);
  3589. end;
  3590. revkCurrency:
  3591. // int^^currency
  3592. try
  3593. {$Q+}{$R+}
  3594. Flo:=Math.power(TResEvalInt(LeftValue).Int,TResEvalCurrency(RightValue).Value);
  3595. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3596. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3597. Result:=TResEvalFloat.CreateValue(Flo);
  3598. except
  3599. RaiseOverflowArithmetic(20180421165906,Expr);
  3600. end;
  3601. else
  3602. {$IFDEF VerbosePasResolver}
  3603. writeln('TResExprEvaluator.EvalBinaryPowerExpr int ^^ ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  3604. {$ENDIF}
  3605. RaiseNotYetImplemented(20170530205640,Expr);
  3606. end;
  3607. revkUInt:
  3608. case RightValue.Kind of
  3609. revkInt:
  3610. // uint^^int
  3611. try
  3612. {$Q+}{$R+}
  3613. Int:=trunc(Math.power(TResEvalUInt(LeftValue).UInt,TResEvalInt(RightValue).Int));
  3614. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3615. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3616. Result:=TResEvalInt.CreateValue(Int);
  3617. except
  3618. RaiseOverflowArithmetic(20170530211102,Expr);
  3619. end;
  3620. revkUInt:
  3621. // uint^^uint
  3622. try
  3623. {$Q+}{$R+}
  3624. Int:=trunc(Math.power(TResEvalUInt(LeftValue).UInt,TResEvalUInt(RightValue).UInt));
  3625. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3626. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3627. Result:=TResEvalInt.CreateValue(Int);
  3628. except
  3629. RaiseOverflowArithmetic(20170530211121,Expr);
  3630. end;
  3631. revkFloat:
  3632. // uint^^float
  3633. try
  3634. {$Q+}{$R+}
  3635. Flo:=Math.power(TResEvalUInt(LeftValue).UInt,TResEvalFloat(RightValue).FloatValue);
  3636. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3637. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3638. Result:=TResEvalFloat.CreateValue(Flo);
  3639. except
  3640. RaiseOverflowArithmetic(20170816154241,Expr);
  3641. end;
  3642. revkCurrency:
  3643. // uint^^currency
  3644. try
  3645. {$Q+}{$R+}
  3646. Flo:=Math.power(TResEvalUInt(LeftValue).UInt,TResEvalCurrency(RightValue).Value);
  3647. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3648. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3649. Result:=TResEvalFloat.CreateValue(Flo);
  3650. except
  3651. RaiseOverflowArithmetic(20180421165948,Expr);
  3652. end;
  3653. else
  3654. {$IFDEF VerbosePasResolver}
  3655. writeln('TResExprEvaluator.EvalBinaryPowerExpr uint ^^ ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  3656. {$ENDIF}
  3657. RaiseNotYetImplemented(20170530211140,Expr);
  3658. end;
  3659. revkFloat:
  3660. case RightValue.Kind of
  3661. revkInt:
  3662. // float ^^ int
  3663. try
  3664. {$Q+}{$R+}
  3665. Flo:=Math.power(TResEvalFloat(LeftValue).FloatValue,TResEvalInt(RightValue).Int);
  3666. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3667. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3668. Result:=TResEvalFloat.CreateValue(Flo);
  3669. except
  3670. RaiseOverflowArithmetic(20170816153950,Expr);
  3671. end;
  3672. revkUInt:
  3673. // float ^^ uint
  3674. try
  3675. {$Q+}{$R+}
  3676. Flo:=Math.power(TResEvalFloat(LeftValue).FloatValue,TResEvalUInt(RightValue).UInt);
  3677. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3678. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3679. Result:=TResEvalFloat.CreateValue(Flo);
  3680. except
  3681. RaiseOverflowArithmetic(20170816154012,Expr);
  3682. end;
  3683. revkFloat:
  3684. // float ^^ float
  3685. try
  3686. {$Q+}{$R+}
  3687. Flo:=Math.power(TResEvalFloat(LeftValue).FloatValue,TResEvalFloat(RightValue).FloatValue);
  3688. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3689. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3690. Result:=TResEvalFloat.CreateValue(Flo);
  3691. except
  3692. RaiseOverflowArithmetic(20170816154012,Expr);
  3693. end;
  3694. revkCurrency:
  3695. // float ^^ currency
  3696. try
  3697. {$Q+}{$R+}
  3698. Flo:=Math.power(TResEvalFloat(LeftValue).FloatValue,TResEvalCurrency(RightValue).Value);
  3699. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3700. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3701. Result:=TResEvalFloat.CreateValue(Flo);
  3702. except
  3703. RaiseOverflowArithmetic(20180421170016,Expr);
  3704. end;
  3705. end;
  3706. revkCurrency:
  3707. case RightValue.Kind of
  3708. revkInt:
  3709. // currency ^^ int
  3710. try
  3711. {$Q+}{$R+}
  3712. aCurrency:=Math.power(TResEvalCurrency(LeftValue).Value,TResEvalInt(RightValue).Int);
  3713. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3714. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3715. Result:=TResEvalCurrency.CreateValue(aCurrency);
  3716. except
  3717. RaiseOverflowArithmetic(20180421170235,Expr);
  3718. end;
  3719. revkUInt:
  3720. // currency ^^ uint
  3721. try
  3722. {$Q+}{$R+}
  3723. aCurrency:=Math.power(TResEvalCurrency(LeftValue).Value,TResEvalUInt(RightValue).UInt);
  3724. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3725. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3726. Result:=TResEvalCurrency.CreateValue(aCurrency);
  3727. except
  3728. RaiseOverflowArithmetic(20180421170240,Expr);
  3729. end;
  3730. revkFloat:
  3731. // currency ^^ float
  3732. try
  3733. {$Q+}{$R+}
  3734. aCurrency:=Math.power(TResEvalCurrency(LeftValue).Value,TResEvalFloat(RightValue).FloatValue);
  3735. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3736. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3737. Result:=TResEvalCurrency.CreateValue(aCurrency);
  3738. except
  3739. RaiseOverflowArithmetic(20180421170254,Expr);
  3740. end;
  3741. revkCurrency:
  3742. // currency ^^ currency
  3743. try
  3744. {$Q+}{$R+}
  3745. aCurrency:=Math.power(TResEvalCurrency(LeftValue).Value,TResEvalCurrency(RightValue).Value);
  3746. {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
  3747. {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
  3748. Result:=TResEvalCurrency.CreateValue(aCurrency);
  3749. except
  3750. RaiseOverflowArithmetic(20180421170311,Expr);
  3751. end;
  3752. end;
  3753. else
  3754. {$IFDEF VerbosePasResolver}
  3755. writeln('TResExprEvaluator.EvalBinaryPowerExpr ^^ ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  3756. {$ENDIF}
  3757. RaiseNotYetImplemented(20170816153813,Expr);
  3758. end;
  3759. end;
  3760. function TResExprEvaluator.ExprStringToOrd(Value: TResEvalValue;
  3761. PosEl: TPasElement): longword;
  3762. const
  3763. Invalid = $12345678; // bigger than $ffff and smaller than $8000000
  3764. var
  3765. {$ifdef FPC_HAS_CPSTRING}
  3766. S: RawByteString;
  3767. {$endif}
  3768. U: UnicodeString;
  3769. begin
  3770. {$ifdef FPC_HAS_CPSTRING}
  3771. if Value.Kind=revkString then
  3772. begin
  3773. // ord(ansichar)
  3774. S:=TResEvalString(Value).S;
  3775. if length(S)=1 then
  3776. Result:=ord(S[1])
  3777. else if (length(S)=0) or (length(S)>4) then
  3778. begin
  3779. if PosEl<>nil then
  3780. RaiseMsg(20170522221143,nXExpectedButYFound,sXExpectedButYFound,
  3781. ['char','string'],PosEl)
  3782. else
  3783. exit(Invalid);
  3784. end
  3785. else
  3786. begin
  3787. U:=GetUnicodeStr(S,nil);
  3788. if length(U)<>1 then
  3789. begin
  3790. if PosEl<>nil then
  3791. RaiseMsg(20190124180407,nXExpectedButYFound,sXExpectedButYFound,
  3792. ['char','string'],PosEl)
  3793. else
  3794. exit(Invalid);
  3795. end;
  3796. Result:=ord(U[1]);
  3797. end;
  3798. end
  3799. else
  3800. {$endif}
  3801. if Value.Kind=revkUnicodeString then
  3802. begin
  3803. // ord(widechar)
  3804. U:=TResEvalUTF16(Value).S;
  3805. if length(U)<>1 then
  3806. begin
  3807. if PosEl<>nil then
  3808. RaiseMsg(20170522221358,nXExpectedButYFound,sXExpectedButYFound,
  3809. ['char','string'],PosEl)
  3810. else
  3811. exit(Invalid);
  3812. end
  3813. else
  3814. Result:=ord(U[1]);
  3815. end
  3816. else
  3817. RaiseNotYetImplemented(20170522220959,PosEl);
  3818. end;
  3819. function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
  3820. ): TResEvalValue;
  3821. { Extracts the value from a Pascal string literal
  3822. S is a Pascal string literal e.g. 'Line'#10
  3823. '' empty string
  3824. '''' => "'"
  3825. #decimal
  3826. #$hex
  3827. ^l l is a letter a-z
  3828. }
  3829. procedure RangeError(id: TMaxPrecInt);
  3830. begin
  3831. Result.Free;
  3832. RaiseRangeCheck(id,Expr);
  3833. end;
  3834. procedure Add(h: String);
  3835. begin
  3836. {$ifdef FPC_HAS_CPSTRING}
  3837. if Result.Kind=revkString then
  3838. TResEvalString(Result).S:=TResEvalString(Result).S+h
  3839. else
  3840. TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+GetUnicodeStr(h,Expr);
  3841. {$else}
  3842. TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+h;
  3843. {$endif}
  3844. end;
  3845. procedure AddHash(u: longword; ForceUTF16: boolean);
  3846. {$ifdef FPC_HAS_CPSTRING}
  3847. var
  3848. h: RawByteString;
  3849. begin
  3850. if ((u>255) or (ForceUTF16)) and (Result.Kind=revkString) then
  3851. begin
  3852. // switch to unicodestring
  3853. h:=TResEvalString(Result).S;
  3854. Result.Free;
  3855. Result:=nil; // in case of exception in GetUnicodeStr
  3856. Result:=TResEvalUTF16.CreateValue(GetUnicodeStr(h,Expr));
  3857. end;
  3858. if Result.Kind=revkString then
  3859. TResEvalString(Result).S:=TResEvalString(Result).S+Chr(u)
  3860. else
  3861. TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u);
  3862. end;
  3863. {$else}
  3864. begin
  3865. TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u);
  3866. end;
  3867. {$endif}
  3868. var
  3869. p, StartP, l: integer;
  3870. c: Char;
  3871. u: longword;
  3872. S: String;
  3873. begin
  3874. Result:=nil;
  3875. S:=Expr.Value;
  3876. {$IFDEF VerbosePasResEval}
  3877. //writeln('TResExprEvaluator.EvalPrimitiveExprString (',S,')');
  3878. {$ENDIF}
  3879. l:=length(S);
  3880. if l=0 then
  3881. RaiseInternalError(20170523113809);
  3882. {$ifdef FPC_HAS_CPSTRING}
  3883. Result:=TResEvalString.Create;
  3884. {$else}
  3885. Result:=TResEvalUTF16.Create;
  3886. {$endif}
  3887. p:=1;
  3888. while p<=l do
  3889. case S[p] of
  3890. {$ifdef UsePChar}
  3891. #0: break;
  3892. {$endif}
  3893. '''':
  3894. begin
  3895. inc(p);
  3896. StartP:=p;
  3897. repeat
  3898. if p>l then
  3899. RaiseInternalError(20170523113938);
  3900. c:=S[p];
  3901. case c of
  3902. '''':
  3903. begin
  3904. if p>StartP then
  3905. Add(copy(S,StartP,p-StartP));
  3906. inc(p);
  3907. StartP:=p;
  3908. if (p>l) or (S[p]<>'''') then
  3909. break;
  3910. Add('''');
  3911. inc(p);
  3912. StartP:=p;
  3913. end;
  3914. else
  3915. inc(p);
  3916. end;
  3917. until false;
  3918. if p>StartP then
  3919. Add(copy(S,StartP,p-StartP));
  3920. end;
  3921. '#':
  3922. begin
  3923. inc(p);
  3924. if p>l then
  3925. RaiseInternalError(20181016121354);
  3926. if S[p]='$' then
  3927. begin
  3928. // #$hexnumber
  3929. inc(p);
  3930. StartP:=p;
  3931. u:=0;
  3932. while p<=l do
  3933. begin
  3934. c:=S[p];
  3935. case c of
  3936. '0'..'9': u:=u*16+longword(ord(c)-ord('0'));
  3937. 'a'..'f': u:=u*16+longword(ord(c)-ord('a'))+10;
  3938. 'A'..'F': u:=u*16+longword(ord(c)-ord('A'))+10;
  3939. else break;
  3940. end;
  3941. if u>$10FFFF then
  3942. RangeError(20170523115712);
  3943. inc(p);
  3944. end;
  3945. if p=StartP then
  3946. RaiseInternalError(20170207164956);
  3947. if u>$ffff then
  3948. begin
  3949. // split into two
  3950. dec(u,$10000);
  3951. AddHash($D800+(u shr 10),true);
  3952. AddHash($DC00+(u and $3ff),true);
  3953. end
  3954. else
  3955. AddHash(u,p-StartP>2);
  3956. end
  3957. else
  3958. begin
  3959. // #decimalnumber
  3960. StartP:=p;
  3961. u:=0;
  3962. while p<=l do
  3963. begin
  3964. c:=S[p];
  3965. case c of
  3966. '0'..'9': u:=u*10+longword(ord(c)-ord('0'));
  3967. else break;
  3968. end;
  3969. if u>$ffff then
  3970. RangeError(20170523123137);
  3971. inc(p);
  3972. end;
  3973. if p=StartP then
  3974. RaiseInternalError(20170523123806);
  3975. AddHash(u,false);
  3976. end;
  3977. end;
  3978. '^':
  3979. begin
  3980. // ^A is #1
  3981. inc(p);
  3982. if p>l then
  3983. RaiseInternalError(20181016121520);
  3984. c:=S[p];
  3985. case c of
  3986. 'a'..'z': AddHash(ord(c)-ord('a')+1,false);
  3987. 'A'..'Z': AddHash(ord(c)-ord('A')+1,false);
  3988. else RaiseInternalError(20170523123809);
  3989. end;
  3990. inc(p);
  3991. end;
  3992. else
  3993. RaiseNotYetImplemented(20170523123815,Expr,'ord='+IntToStr(ord(S[p])));
  3994. end;
  3995. {$IFDEF VerbosePasResEval}
  3996. //writeln('TResExprEvaluator.EvalPrimitiveExprString Result=',Result.AsString);
  3997. {$ENDIF}
  3998. end;
  3999. function TResExprEvaluator.CreateResEvalInt(UInt: TMaxPrecUInt): TResEvalValue;
  4000. begin
  4001. if UInt<=HighIntAsUInt then
  4002. Result:=TResEvalInt.CreateValue(TMaxPrecInt(UInt))
  4003. else
  4004. Result:=TResEvalUInt.CreateValue(UInt);
  4005. end;
  4006. constructor TResExprEvaluator.Create;
  4007. begin
  4008. inherited Create;
  4009. FAllowedInts:=ReitDefaults;
  4010. {$ifdef FPC_HAS_CPSTRING}
  4011. FDefaultEncoding:=CP_ACP;
  4012. {$endif}
  4013. end;
  4014. function TResExprEvaluator.Eval(Expr: TPasExpr; Flags: TResEvalFlags
  4015. ): TResEvalValue;
  4016. var
  4017. C: TClass;
  4018. Code: integer;
  4019. Int: TMaxPrecInt;
  4020. UInt: TMaxPrecUInt;
  4021. Flo: TMaxPrecFloat;
  4022. begin
  4023. Result:=nil;
  4024. if Expr.CustomData is TResEvalValue then
  4025. begin
  4026. Result:=TResEvalValue(Expr.CustomData);
  4027. exit;
  4028. end;
  4029. {$IFDEF VerbosePasResEval}
  4030. writeln('TResExprEvaluator.Eval Expr=',GetObjName(Expr),' Flags=',dbgs(Flags));
  4031. {$ENDIF}
  4032. if refAutoConst in Flags then
  4033. begin
  4034. Exclude(Flags,refAutoConst);
  4035. if IsConst(Expr) then
  4036. Include(Flags,refConst);
  4037. end;
  4038. if refAutoConstExt in Flags then
  4039. begin
  4040. Exclude(Flags,refAutoConstExt);
  4041. if IsConst(Expr) then
  4042. Include(Flags,refConstExt);
  4043. end;
  4044. C:=Expr.ClassType;
  4045. if C=TPrimitiveExpr then
  4046. begin
  4047. case TPrimitiveExpr(Expr).Kind of
  4048. pekIdent:
  4049. begin
  4050. Result:=OnEvalIdentifier(Self,TPrimitiveExpr(Expr),Flags);
  4051. //writeln('TResExprEvaluator.Eval primitiv result=',Result<>nil,' ',dbgs(Result));
  4052. end;
  4053. pekNumber:
  4054. begin
  4055. // try TMaxPrecInt
  4056. val(TPrimitiveExpr(Expr).Value,Int,Code);
  4057. if Code=0 then
  4058. begin
  4059. {$IFDEF VerbosePasResEval}
  4060. writeln('TResExprEvaluator.Eval Int=',Int,' Value="',TPrimitiveExpr(Expr).Value,'"');
  4061. {$ENDIF}
  4062. if (Int<0) and (Pos('-',TPrimitiveExpr(Expr).Value)<1) then
  4063. // FPC str() converts $8000000000000000 to a negative int64 -> ignore
  4064. else
  4065. begin
  4066. Result:=TResEvalInt.CreateValue(Int);
  4067. exit;
  4068. end;
  4069. end;
  4070. // try TMaxPrecUInt
  4071. val(TPrimitiveExpr(Expr).Value,UInt,Code);
  4072. if Code=0 then
  4073. begin
  4074. Result:=TResEvalUInt.CreateValue(UInt);
  4075. {$IFDEF VerbosePasResEval}
  4076. writeln('TResExprEvaluator.Eval UInt=',UInt,' Value="',TPrimitiveExpr(Expr).Value,'"');
  4077. {$ENDIF}
  4078. exit;
  4079. end;
  4080. // try TMaxPrecFloat
  4081. val(TPrimitiveExpr(Expr).Value,Flo,Code);
  4082. if Code=0 then
  4083. begin
  4084. Result:=TResEvalFloat.CreateValue(Flo);
  4085. {$IFDEF VerbosePasResEval}
  4086. writeln('TResExprEvaluator.Eval Float=',Flo,' Value="',TPrimitiveExpr(Expr).Value,'"');
  4087. {$ENDIF}
  4088. exit;
  4089. end;
  4090. {$IFDEF VerbosePasResEval}
  4091. writeln('TResExprEvaluator.Eval Value="',TPrimitiveExpr(Expr).Value,'"');
  4092. {$ENDIF}
  4093. RaiseRangeCheck(20170518202252,Expr);
  4094. end;
  4095. pekString:
  4096. begin
  4097. Result:=EvalPrimitiveExprString(TPrimitiveExpr(Expr));
  4098. exit;
  4099. end;
  4100. else
  4101. RaiseNotYetImplemented(20170518200951,Expr);
  4102. end;
  4103. {$IFDEF VerbosePasResEval}
  4104. writeln('TResExprEvaluator.Eval primitiv end result=',Result<>nil,' ',dbgs(Result));
  4105. {$ENDIF}
  4106. end
  4107. else if C=TNilExpr then
  4108. Result:=TResEvalValue.CreateKind(revkNil)
  4109. else if C=TBoolConstExpr then
  4110. Result:=TResEvalBool.CreateValue(TBoolConstExpr(Expr).Value)
  4111. else if C=TUnaryExpr then
  4112. Result:=EvalUnaryExpr(TUnaryExpr(Expr),Flags)
  4113. else if C=TBinaryExpr then
  4114. Result:=EvalBinaryExpr(TBinaryExpr(Expr),Flags)
  4115. else if C=TParamsExpr then
  4116. Result:=EvalParamsExpr(TParamsExpr(Expr),Flags)
  4117. else if C=TArrayValues then
  4118. Result:=EvalArrayValuesExpr(TArrayValues(Expr),Flags)
  4119. else if [refConst,refConstExt]*Flags<>[] then
  4120. RaiseConstantExprExp(20170518213800,Expr);
  4121. {$IFDEF VerbosePasResEval}
  4122. writeln('TResExprEvaluator.Eval END ',Expr.ClassName,' result=',Result<>nil,' ',dbgs(Result));
  4123. {$ENDIF}
  4124. end;
  4125. function TResExprEvaluator.IsInRange(Expr, RangeExpr: TPasExpr;
  4126. EmitHints: boolean): boolean;
  4127. var
  4128. Value, RangeValue: TResEvalValue;
  4129. begin
  4130. Value:=Eval(Expr,[refAutoConst]);
  4131. if Value=nil then
  4132. exit(true); // a variable -> ok
  4133. RangeValue:=nil;
  4134. try
  4135. RangeValue:=Eval(RangeExpr,[]);
  4136. if RangeValue=nil then
  4137. RaiseNotYetImplemented(20170522171226,RangeExpr);
  4138. Result:=IsInRange(Value,Expr,RangeValue,RangeExpr,EmitHints);
  4139. finally
  4140. ReleaseEvalValue(Value);
  4141. ReleaseEvalValue(RangeValue);
  4142. end;
  4143. end;
  4144. function TResExprEvaluator.IsInRange(Value: TResEvalValue; ValueExpr: TPasExpr;
  4145. RangeValue: TResEvalValue; RangeExpr: TPasExpr; EmitHints: boolean): boolean;
  4146. var
  4147. RgInt: TResEvalRangeInt;
  4148. RgUInt: TResEvalRangeUInt;
  4149. CharIndex: LongWord;
  4150. begin
  4151. Result:=false;
  4152. {$IFDEF VerbosePasResEval}
  4153. //writeln('TResExprEvaluator.IsInRange Value=',dbgs(Value),' RangeValue=',dbgs(RangeValue));
  4154. {$ENDIF}
  4155. case RangeValue.Kind of
  4156. revkRangeInt:
  4157. begin
  4158. RgInt:=TResEvalRangeInt(RangeValue);
  4159. case RgInt.ElKind of
  4160. revskBool:
  4161. if Value.Kind=revkBool then
  4162. exit(true)
  4163. else
  4164. RaiseNotYetImplemented(20170522220104,ValueExpr);
  4165. revskEnum:
  4166. begin
  4167. if Value.Kind<>revkEnum then
  4168. RaiseInternalError(20170522172754)
  4169. else if TResEvalEnum(Value).ElType<>RgInt.ElType then
  4170. RaiseInternalError(20170522174028)
  4171. else if (TResEvalEnum(Value).Index<RgInt.RangeStart)
  4172. or (TResEvalEnum(Value).Index>RgInt.RangeEnd) then
  4173. begin
  4174. if EmitHints then
  4175. EmitRangeCheckConst(20170522174406,Value.AsString,
  4176. RgInt.ElementAsString(RgInt.RangeStart),
  4177. RgInt.ElementAsString(RgInt.RangeEnd),
  4178. ValueExpr);
  4179. exit(false);
  4180. end
  4181. else
  4182. exit(true);
  4183. end;
  4184. revskInt: // int..int
  4185. if Value.Kind=revkInt then
  4186. begin
  4187. // int in int..int
  4188. if (TResEvalInt(Value).Int<RgInt.RangeStart)
  4189. or (TResEvalInt(Value).Int>RgInt.RangeEnd) then
  4190. begin
  4191. if EmitHints then
  4192. EmitRangeCheckConst(20170522174958,Value.AsString,
  4193. RgInt.ElementAsString(RgInt.RangeStart),
  4194. RgInt.ElementAsString(RgInt.RangeEnd),
  4195. ValueExpr);
  4196. exit(false);
  4197. end
  4198. else
  4199. exit(true);
  4200. end
  4201. else if Value.Kind=revkUInt then
  4202. begin
  4203. // uint in int..int
  4204. if (TResEvalUInt(Value).UInt>HighIntAsUInt)
  4205. or (TMaxPrecInt(TResEvalUInt(Value).UInt)<RgInt.RangeStart)
  4206. or (TMaxPrecInt(TResEvalUInt(Value).UInt)>RgInt.RangeEnd) then
  4207. begin
  4208. if EmitHints then
  4209. EmitRangeCheckConst(20170522215852,Value.AsString,
  4210. RgInt.ElementAsString(RgInt.RangeStart),
  4211. RgInt.ElementAsString(RgInt.RangeEnd),
  4212. ValueExpr);
  4213. exit(false);
  4214. end
  4215. else
  4216. exit(true);
  4217. end
  4218. else
  4219. begin
  4220. {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
  4221. writeln('TResExprEvaluator.IsInRange Kind=',Value.Kind,' ',Value.AsDebugString);
  4222. {$ENDIF}
  4223. RaiseNotYetImplemented(20170522215906,ValueExpr);
  4224. end;
  4225. revskChar:
  4226. if Value.Kind in revkAllStrings then
  4227. begin
  4228. // string in char..char
  4229. CharIndex:=ExprStringToOrd(Value,ValueExpr);
  4230. if (CharIndex<RgInt.RangeStart) or (CharIndex>RgInt.RangeEnd) then
  4231. begin
  4232. if EmitHints then
  4233. EmitRangeCheckConst(20170522221709,Value.AsString,
  4234. RgInt.ElementAsString(RgInt.RangeStart),
  4235. RgInt.ElementAsString(RgInt.RangeEnd),
  4236. ValueExpr);
  4237. exit(false);
  4238. end
  4239. else
  4240. exit(true);
  4241. end
  4242. else
  4243. RaiseNotYetImplemented(20170522220210,ValueExpr);
  4244. else
  4245. RaiseInternalError(20170522172630);
  4246. end;
  4247. end;
  4248. revkRangeUInt:
  4249. if Value.Kind=revkInt then
  4250. begin
  4251. // int in uint..uint
  4252. RgUInt:=TResEvalRangeUInt(RangeValue);
  4253. if (TResEvalInt(Value).Int<0)
  4254. or (TMaxPrecUInt(TResEvalInt(Value).Int)<RgUInt.RangeStart)
  4255. or (TMaxPrecUInt(TResEvalInt(Value).Int)>RgUInt.RangeEnd) then
  4256. begin
  4257. if EmitHints then
  4258. EmitRangeCheckConst(20170522172250,Value.AsString,
  4259. IntToStr(RgUInt.RangeStart),
  4260. IntToStr(RgUInt.RangeEnd),ValueExpr);
  4261. exit(false);
  4262. end
  4263. else
  4264. exit(true);
  4265. end
  4266. else if Value.Kind=revkUInt then
  4267. begin
  4268. // uint in uint..uint
  4269. RgUInt:=TResEvalRangeUInt(RangeValue);
  4270. if (TResEvalUInt(Value).UInt<RgUInt.RangeStart)
  4271. or (TResEvalUInt(Value).UInt>RgUInt.RangeEnd) then
  4272. begin
  4273. if EmitHints then
  4274. EmitRangeCheckConst(20170522172544,IntToStr(TResEvalUInt(Value).UInt),
  4275. IntToStr(RgUInt.RangeStart),
  4276. IntToStr(RgUInt.RangeEnd),ValueExpr);
  4277. exit(false);
  4278. end
  4279. else
  4280. exit(true);
  4281. end
  4282. else
  4283. begin
  4284. {$IFDEF VerbosePasResEval}
  4285. writeln('TResExprEvaluator.IsInRange Value=',dbgs(Value),' RangeValue=',dbgs(RangeValue));
  4286. {$ENDIF}
  4287. RaiseNotYetImplemented(20170522171551,ValueExpr);
  4288. end;
  4289. else
  4290. {$IFDEF VerbosePasResEval}
  4291. writeln('TResExprEvaluator.IsInRange Value=',dbgs(Value),' RangeValue=',dbgs(RangeValue));
  4292. {$ENDIF}
  4293. RaiseNotYetImplemented(20170522171307,RangeExpr);
  4294. end;
  4295. end;
  4296. function TResExprEvaluator.IsSetCompatible(Value: TResEvalValue;
  4297. ValueExpr: TPasExpr; RangeValue: TResEvalValue; EmitHints: boolean): boolean;
  4298. // checks if Value fits into a set of RangeValue
  4299. var
  4300. RightSet: TResEvalSet;
  4301. LeftRange: TResEvalRangeInt;
  4302. MinVal, MaxVal: TMaxPrecInt;
  4303. begin
  4304. Result:=true;
  4305. case Value.Kind of
  4306. revkSetOfInt:
  4307. begin
  4308. RightSet:=TResEvalSet(Value);
  4309. if RightSet.ElKind=revskNone then
  4310. exit(true); // empty set always fits
  4311. case RangeValue.Kind of
  4312. revkRangeInt:
  4313. begin
  4314. LeftRange:=TResEvalRangeInt(RangeValue);
  4315. if (LeftRange.ElKind<>RightSet.ElKind)
  4316. or (LeftRange.ElType<>RightSet.ElType) then
  4317. begin
  4318. {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
  4319. writeln('TResExprEvaluator.IsSetCompatible Value=',dbgs(Value),' RangeValue=',dbgs(RangeValue));
  4320. {$ENDIF}
  4321. RaiseNotYetImplemented(20170714201425,ValueExpr);
  4322. end;
  4323. if length(RightSet.Ranges)=0 then
  4324. exit(true); // empty typed set fits
  4325. MinVal:=RightSet.Ranges[0].RangeStart;
  4326. MaxVal:=RightSet.Ranges[length(RightSet.Ranges)-1].RangeEnd;
  4327. {$IFDEF VerbosePasResEval}
  4328. writeln('TResExprEvaluator.IsSetCompatible Value=',dbgs(Value),' MinVal=',MinVal,' MaxVal=',MaxVal,' RangeValue=',dbgs(RangeValue));
  4329. {$ENDIF}
  4330. if (MinVal<LeftRange.RangeStart) then
  4331. if EmitHints then
  4332. EmitRangeCheckConst(20170714202813,RightSet.ElementAsString(MinVal),
  4333. LeftRange.ElementAsString(LeftRange.RangeStart),
  4334. LeftRange.ElementAsString(LeftRange.RangeEnd),ValueExpr,mtError)
  4335. else
  4336. exit(false);
  4337. if (MaxVal>LeftRange.RangeEnd) then
  4338. if EmitHints then
  4339. EmitRangeCheckConst(20170714203134,RightSet.ElementAsString(MaxVal),
  4340. LeftRange.ElementAsString(LeftRange.RangeStart),
  4341. LeftRange.ElementAsString(LeftRange.RangeEnd),ValueExpr,mtError)
  4342. else
  4343. exit(false);
  4344. end;
  4345. else
  4346. {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
  4347. writeln('TResExprEvaluator.IsSetCompatible Value=',dbgs(Value),' RangeValue=',dbgs(RangeValue));
  4348. {$ENDIF}
  4349. RaiseNotYetImplemented(20170714201121,ValueExpr);
  4350. end;
  4351. end
  4352. else
  4353. {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
  4354. writeln('TResExprEvaluator.IsSetCompatible Value=',Value.Kind,' ',dbgs(RangeValue));
  4355. {$ENDIF}
  4356. RaiseNotYetImplemented(20170714195815,ValueExpr);
  4357. end;
  4358. end;
  4359. function TResExprEvaluator.IsConst(Expr: TPasExpr): boolean;
  4360. var
  4361. El: TPasElement;
  4362. C: TClass;
  4363. begin
  4364. El:=Expr;
  4365. while El<>nil do
  4366. begin
  4367. C:=El.ClassType;
  4368. if C.InheritsFrom(TPasProcedure) then exit(true);
  4369. if C.InheritsFrom(TPasImplBlock) then exit(false);
  4370. El:=El.Parent;
  4371. end;
  4372. Result:=true;
  4373. end;
  4374. function TResExprEvaluator.IsSimpleExpr(Expr: TPasExpr): boolean;
  4375. var
  4376. C: TClass;
  4377. begin
  4378. C:=Expr.ClassType;
  4379. Result:=(C=TNilExpr)
  4380. or (C=TBoolConstExpr)
  4381. or (C=TPrimitiveExpr);
  4382. end;
  4383. procedure TResExprEvaluator.EmitRangeCheckConst(id: TMaxPrecInt; const aValue,
  4384. MinVal, MaxVal: String; PosEl: TPasElement; MsgType: TMessageType);
  4385. begin
  4386. if Assigned(OnRangeCheckEl) then
  4387. OnRangeCheckEl(Self,PosEl,MsgType);
  4388. LogMsg(id,MsgType,nRangeCheckEvaluatingConstantsVMinMax,
  4389. sRangeCheckEvaluatingConstantsVMinMax,[aValue,MinVal,MaxVal],PosEl);
  4390. end;
  4391. procedure TResExprEvaluator.EmitRangeCheckConst(id: TMaxPrecInt;
  4392. const aValue: String; MinVal, MaxVal: TMaxPrecInt; PosEl: TPasElement;
  4393. MsgType: TMessageType);
  4394. begin
  4395. EmitRangeCheckConst(id,aValue,IntToStr(MinVal),IntToStr(MaxVal),PosEl,MsgType);
  4396. end;
  4397. function TResExprEvaluator.ChrValue(Value: TResEvalValue; ErrorEl: TPasElement
  4398. ): TResEvalValue;
  4399. var
  4400. Int: TMaxPrecInt;
  4401. begin
  4402. Result:=nil;
  4403. case Value.Kind of
  4404. revkInt,revkUInt:
  4405. begin
  4406. if Value.Kind=revkUInt then
  4407. begin
  4408. if TResEvalUInt(Value).UInt>$ffff then
  4409. EmitRangeCheckConst(20170711195605,Value.AsString,0,$ffff,ErrorEl,mtError)
  4410. else
  4411. Int:=TResEvalUInt(Value).UInt;
  4412. end
  4413. else
  4414. Int:=TResEvalInt(Value).Int;
  4415. if (Int<0) or (Int>$ffff) then
  4416. EmitRangeCheckConst(20170711195747,Value.AsString,0,$ffff,ErrorEl,mtError);
  4417. {$ifdef FPC_HAS_CPSTRING}
  4418. if Int<=$ff then
  4419. Result:=TResEvalString.CreateValue(chr(Int))
  4420. else
  4421. {$endif}
  4422. Result:=TResEvalUTF16.CreateValue(WideChar(Int))
  4423. end;
  4424. else
  4425. {$IFDEF VerbosePasResEval}
  4426. writeln('TResExprEvaluator.ChrValue ',Value.AsDebugString);
  4427. {$ENDIF}
  4428. RaiseNotYetImplemented(20170711195440,ErrorEl);
  4429. end;
  4430. end;
  4431. function TResExprEvaluator.OrdValue(Value: TResEvalValue; ErrorEl: TPasElement
  4432. ): TResEvalValue;
  4433. var
  4434. v: longword;
  4435. begin
  4436. Result:=nil;
  4437. v:=0;
  4438. case Value.Kind of
  4439. revkBool:
  4440. if TResEvalBool(Value).B then
  4441. v:=1
  4442. else
  4443. v:=0;
  4444. revkInt,revkUInt:
  4445. exit(Value);
  4446. {$ifdef FPC_HAS_CPSTRING}
  4447. revkString:
  4448. v:=ExprStringToOrd(Value,ErrorEl);
  4449. {$endif}
  4450. revkUnicodeString:
  4451. v:=ExprStringToOrd(Value,ErrorEl);
  4452. revkEnum:
  4453. v:=TResEvalEnum(Value).Index;
  4454. else
  4455. {$IFDEF VerbosePasResEval}
  4456. writeln('TResExprEvaluator.OrdValue ',Value.AsDebugString);
  4457. {$ENDIF}
  4458. RaiseNotYetImplemented(20170624155932,ErrorEl);
  4459. end;
  4460. if v>$ffff then exit;
  4461. Result:=TResEvalInt.CreateValue(v);
  4462. end;
  4463. procedure TResExprEvaluator.PredValue(Value: TResEvalValue; ErrorEl: TPasElement
  4464. );
  4465. begin
  4466. case Value.Kind of
  4467. revkBool:
  4468. PredBool(TResEvalBool(Value),ErrorEl);
  4469. revkInt:
  4470. PredInt(TResEvalInt(Value),ErrorEl);
  4471. revkUInt:
  4472. PredUInt(TResEvalUInt(Value),ErrorEl);
  4473. {$ifdef FPC_HAS_CPSTRING}
  4474. revkString:
  4475. PredString(TResEvalString(Value),ErrorEl);
  4476. {$endif}
  4477. revkUnicodeString:
  4478. PredUnicodeString(TResEvalUTF16(Value),ErrorEl);
  4479. revkEnum:
  4480. PredEnum(TResEvalEnum(Value),ErrorEl);
  4481. else
  4482. {$IFDEF VerbosePasResEval}
  4483. writeln('TResExprEvaluator.PredValue ',Value.AsDebugString);
  4484. {$ENDIF}
  4485. ReleaseEvalValue(Value);
  4486. RaiseNotYetImplemented(20170624135738,ErrorEl);
  4487. end;
  4488. end;
  4489. procedure TResExprEvaluator.SuccValue(Value: TResEvalValue; ErrorEl: TPasElement
  4490. );
  4491. begin
  4492. case Value.Kind of
  4493. revkBool:
  4494. SuccBool(TResEvalBool(Value),ErrorEl);
  4495. revkInt:
  4496. SuccInt(TResEvalInt(Value),ErrorEl);
  4497. revkUInt:
  4498. SuccUInt(TResEvalUInt(Value),ErrorEl);
  4499. {$ifdef FPC_HAS_CPSTRING}
  4500. revkString:
  4501. SuccString(TResEvalString(Value),ErrorEl);
  4502. {$endif}
  4503. revkUnicodeString:
  4504. SuccUnicodeString(TResEvalUTF16(Value),ErrorEl);
  4505. revkEnum:
  4506. SuccEnum(TResEvalEnum(Value),ErrorEl);
  4507. else
  4508. {$IFDEF VerbosePasResEval}
  4509. writeln('TResExprEvaluator.SuccValue ',Value.AsDebugString);
  4510. {$ENDIF}
  4511. ReleaseEvalValue(Value);
  4512. RaiseNotYetImplemented(20170624151252,ErrorEl);
  4513. end;
  4514. end;
  4515. function TResExprEvaluator.EvalStrFunc(Params: TParamsExpr; Flags: TResEvalFlags
  4516. ): TResEvalValue;
  4517. var
  4518. AllConst: Boolean;
  4519. function EvalFormat(Expr: TPasExpr; MinVal, MaxVal: TMaxPrecInt): TMaxPrecInt;
  4520. var
  4521. Value: TResEvalValue;
  4522. begin
  4523. Value:=Eval(Expr,Flags);
  4524. if Value=nil then
  4525. begin
  4526. AllConst:=false;
  4527. exit(-1);
  4528. end;
  4529. if Value.Kind<>revkInt then
  4530. RaiseNotYetImplemented(20170717144010,Expr);
  4531. Result:=TResEvalInt(Value).Int;
  4532. if (Result<MinVal) or (Result>MaxVal) then
  4533. EmitRangeCheckConst(20170717144609,IntToStr(Result),MinVal,MaxVal,Expr,mtError);
  4534. end;
  4535. var
  4536. i: Integer;
  4537. Param: TPasExpr;
  4538. S, ValStr: String;
  4539. Value: TResEvalValue;
  4540. Format1, Format2: TMaxPrecInt;
  4541. begin
  4542. Result:=nil;
  4543. Value:=nil;
  4544. AllConst:=true;
  4545. S:='';
  4546. for i:=0 to length(Params.Params)-1 do
  4547. begin
  4548. Param:=Params.Params[i];
  4549. {$IFDEF VerbosePasResEval}
  4550. writeln('TPasResolver.BI_StrFunc_OnEval i=',i,' of ',length(Params.Params),' Param=',GetObjName(Param));
  4551. {$ENDIF}
  4552. Value:=Eval(Param,Flags);
  4553. if Value=nil then
  4554. begin
  4555. AllConst:=false;
  4556. continue;
  4557. end;
  4558. Format1:=-1;
  4559. Format2:=-1;
  4560. try
  4561. ValStr:='';
  4562. if Param.format1<>nil then
  4563. begin
  4564. Format1:=EvalFormat(Param.format1,1,255);
  4565. if Format1<0 then
  4566. continue;
  4567. if Param.format2<>nil then
  4568. begin
  4569. Format2:=EvalFormat(Param.format2,0,255);
  4570. if Format2<0 then
  4571. continue;
  4572. end;
  4573. end;
  4574. case Value.Kind of
  4575. revkBool:
  4576. if Format1<0 then
  4577. str(TResEvalBool(Value).B,ValStr)
  4578. else
  4579. str(TResEvalBool(Value).B:Format1,ValStr);
  4580. revkInt:
  4581. if Format1<0 then
  4582. str(TResEvalInt(Value).Int,ValStr)
  4583. else
  4584. str(TResEvalInt(Value).Int:Format1,ValStr);
  4585. revkUInt:
  4586. if Format1<0 then
  4587. str(TResEvalUInt(Value).UInt,ValStr)
  4588. else
  4589. str(TResEvalUInt(Value).UInt:Format1,ValStr);
  4590. revkFloat:
  4591. if Format1<0 then
  4592. str(TResEvalFloat(Value).FloatValue,ValStr)
  4593. else if Format2<0 then
  4594. str(TResEvalFloat(Value).FloatValue:Format1,ValStr)
  4595. else
  4596. str(TResEvalFloat(Value).FloatValue:Format1:Format2,ValStr);
  4597. revkCurrency:
  4598. if Format1<0 then
  4599. str(TResEvalCurrency(Value).Value,ValStr)
  4600. else if Format2<0 then
  4601. str(TResEvalCurrency(Value).Value:Format1,ValStr)
  4602. else
  4603. str(TResEvalCurrency(Value).Value:Format1:Format2,ValStr);
  4604. revkEnum:
  4605. begin
  4606. ValStr:=TResEvalEnum(Value).AsString;
  4607. if Format1>0 then
  4608. ValStr:=StringOfChar(' ',Format1)+ValStr;
  4609. end;
  4610. else
  4611. AllConst:=false;
  4612. continue;
  4613. end;
  4614. finally
  4615. ReleaseEvalValue(Value);
  4616. ReleaseEvalValue(Value);
  4617. ReleaseEvalValue(Value);
  4618. end;
  4619. S:=S+ValStr;
  4620. end;
  4621. if AllConst then
  4622. {$ifdef FPC_HAS_CPSTRING}
  4623. Result:=TResEvalString.CreateValue(S);
  4624. {$else}
  4625. Result:=TResEvalUTF16.CreateValue(S);
  4626. {$endif}
  4627. end;
  4628. function TResExprEvaluator.EvalStringAddExpr(Expr, LeftExpr,
  4629. RightExpr: TPasExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
  4630. {$ifdef FPC_HAS_CPSTRING}
  4631. var
  4632. LeftCP, RightCP: TSystemCodePage;
  4633. {$endif}
  4634. begin
  4635. case LeftValue.Kind of
  4636. {$ifdef FPC_HAS_CPSTRING}
  4637. revkString:
  4638. case RightValue.Kind of
  4639. revkString:
  4640. begin
  4641. LeftCP:=GetCodePage(TResEvalString(LeftValue).S);
  4642. RightCP:=GetCodePage(TResEvalString(RightValue).S);
  4643. if (LeftCP=RightCP) then
  4644. begin
  4645. Result:=TResEvalString.Create;
  4646. TResEvalString(Result).S:=TResEvalString(LeftValue).S+TResEvalString(RightValue).S;
  4647. end
  4648. else
  4649. begin
  4650. Result:=TResEvalUTF16.Create;
  4651. TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,LeftExpr)
  4652. +GetUnicodeStr(TResEvalString(RightValue).S,RightExpr);
  4653. end;
  4654. end;
  4655. revkUnicodeString:
  4656. begin
  4657. Result:=TResEvalUTF16.Create;
  4658. TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,LeftExpr)
  4659. +TResEvalUTF16(RightValue).S;
  4660. end;
  4661. else
  4662. {$IFDEF VerbosePasResolver}
  4663. writeln('TResExprEvaluator.EvalBinaryAddExpr string+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  4664. {$ENDIF}
  4665. RaiseNotYetImplemented(20170601141834,Expr);
  4666. end;
  4667. {$endif}
  4668. revkUnicodeString:
  4669. case RightValue.Kind of
  4670. {$ifdef FPC_HAS_CPSTRING}
  4671. revkString:
  4672. begin
  4673. Result:=TResEvalUTF16.Create;
  4674. TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S
  4675. +GetUnicodeStr(TResEvalString(RightValue).S,RightExpr);
  4676. end;
  4677. {$endif}
  4678. revkUnicodeString:
  4679. begin
  4680. Result:=TResEvalUTF16.Create;
  4681. TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S+TResEvalUTF16(RightValue).S;
  4682. end;
  4683. else
  4684. {$IFDEF VerbosePasResolver}
  4685. writeln('TResExprEvaluator.EvalBinaryAddExpr utf16+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
  4686. {$ENDIF}
  4687. RaiseNotYetImplemented(20170601141811,Expr);
  4688. end;
  4689. else
  4690. RaiseNotYetImplemented(20181219233139,Expr);
  4691. end;
  4692. end;
  4693. function TResExprEvaluator.EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
  4694. Flags: TResEvalFlags): TResEvalEnum;
  4695. var
  4696. Value: TResEvalValue;
  4697. MaxIndex, Index: Integer;
  4698. begin
  4699. Result:=nil;
  4700. Value:=Eval(Expr,Flags);
  4701. if Value=nil then exit;
  4702. try
  4703. MaxIndex:=EnumType.Values.Count-1;
  4704. case Value.Kind of
  4705. revkInt:
  4706. if TResEvalInt(Value).Int>High(Index) then
  4707. EmitRangeCheckConst(20170713105944,
  4708. IntToStr(TResEvalInt(Value).Int),'0',IntToStr(MaxIndex),Expr,mtError)
  4709. else
  4710. Index:=TResEvalInt(Value).Int;
  4711. revkUInt:
  4712. if TResEvalUInt(Value).UInt>MaxIndex then
  4713. EmitRangeCheckConst(20170713105944,
  4714. IntToStr(TResEvalUInt(Value).UInt),'0',IntToStr(MaxIndex),Expr,mtError)
  4715. else
  4716. Index:=TResEvalUInt(Value).UInt;
  4717. else
  4718. RaiseNotYetImplemented(20170713105625,Expr);
  4719. end;
  4720. if (Index<0) or (Index>MaxIndex) then
  4721. EmitRangeCheckConst(20170713110232,
  4722. IntToStr(Index),'0',IntToStr(MaxIndex),Expr,mtError);
  4723. Result:=TResEvalEnum.CreateValue(Index,TPasEnumValue(EnumType.Values[Index]));
  4724. finally
  4725. ReleaseEvalValue(Value);
  4726. end;
  4727. end;
  4728. {$ifdef FPC_HAS_CPSTRING}
  4729. function TResExprEvaluator.CheckValidUTF8(const s: RawByteString;
  4730. ErrorEl: TPasElement): boolean;
  4731. var
  4732. p, EndP: PChar;
  4733. l: SizeInt;
  4734. begin
  4735. p:=PChar(s);
  4736. EndP:=p+length(s);
  4737. while p<EndP do
  4738. begin
  4739. l:=Utf8CodePointLen(p,EndP-p,false);
  4740. if l<=0 then
  4741. if ErrorEl<>nil then
  4742. RaiseMsg(20170711211841,nIllegalChar,sIllegalChar,[],ErrorEl)
  4743. else
  4744. exit(false);
  4745. inc(p,l);
  4746. end;
  4747. Result:=true;
  4748. end;
  4749. function TResExprEvaluator.GetCodePage(const s: RawByteString): TSystemCodePage;
  4750. begin
  4751. if s='' then exit(DefaultStringCodePage);
  4752. Result:=StringCodePage(s);
  4753. if (Result=CP_ACP) or (Result=CP_NONE) then
  4754. begin
  4755. Result:=DefaultStringCodePage;
  4756. if (Result=CP_ACP) or (Result=CP_NONE) then
  4757. begin
  4758. Result:=System.DefaultSystemCodePage;
  4759. if Result=CP_NONE then
  4760. Result:=CP_ACP;
  4761. end;
  4762. end;
  4763. end;
  4764. function TResExprEvaluator.GetUTF8Str(const s: RawByteString;
  4765. ErrorEl: TPasElement): String;
  4766. var
  4767. CP: TSystemCodePage;
  4768. begin
  4769. if s='' then exit('');
  4770. CP:=GetCodePage(s);
  4771. if CP=CP_UTF8 then
  4772. begin
  4773. if ErrorEl<>nil then
  4774. CheckValidUTF8(s,ErrorEl);
  4775. Result:=s;
  4776. end
  4777. else
  4778. // use default conversion
  4779. Result:=UTF8Encode(UnicodeString(s));
  4780. end;
  4781. function TResExprEvaluator.GetUnicodeStr(const s: RawByteString;
  4782. ErrorEl: TPasElement): UnicodeString;
  4783. var
  4784. CP: TSystemCodePage;
  4785. begin
  4786. if s='' then exit('');
  4787. CP:=GetCodePage(s);
  4788. if CP=CP_UTF8 then
  4789. begin
  4790. if ErrorEl<>nil then
  4791. CheckValidUTF8(s,ErrorEl);
  4792. Result:=UTF8Decode(s);
  4793. end
  4794. else
  4795. // use default conversion
  4796. Result:=UnicodeString(s);
  4797. end;
  4798. function TResExprEvaluator.GetWideChar(const s: RawByteString; out w: WideChar
  4799. ): boolean;
  4800. var
  4801. CP: TSystemCodePage;
  4802. u: UnicodeString;
  4803. begin
  4804. w:=#0;
  4805. Result:=false;
  4806. if s='' then exit;
  4807. CP:=GetCodePage(s);
  4808. if CP=CP_UTF8 then
  4809. begin
  4810. if length(s)>4 then exit;
  4811. u:=UTF8Decode(s);
  4812. if length(u)<>1 then exit;
  4813. w:=u[1];
  4814. Result:=true;
  4815. end
  4816. else if length(s)=1 then
  4817. begin
  4818. w:=s[1];
  4819. Result:=true;
  4820. end;
  4821. end;
  4822. {$endif}
  4823. procedure TResExprEvaluator.PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
  4824. begin
  4825. if Value.B=false then
  4826. EmitRangeCheckConst(20170624140251,Value.AsString,
  4827. 'true','true',ErrorEl);
  4828. Value.B:=not Value.B;
  4829. end;
  4830. procedure TResExprEvaluator.SuccBool(Value: TResEvalBool; ErrorEl: TPasElement);
  4831. begin
  4832. if Value.B=true then
  4833. EmitRangeCheckConst(20170624142316,Value.AsString,
  4834. 'false','false',ErrorEl);
  4835. Value.B:=not Value.B;
  4836. end;
  4837. procedure TResExprEvaluator.PredInt(Value: TResEvalInt; ErrorEl: TPasElement);
  4838. begin
  4839. if Value.Int=low(TMaxPrecInt) then
  4840. begin
  4841. EmitRangeCheckConst(20170624142511,IntToStr(Value.Int),
  4842. IntToStr(succ(low(TMaxPrecInt))),IntToStr(high(TMaxPrecInt)),ErrorEl);
  4843. Value.Int:=high(Value.Int);
  4844. end
  4845. else
  4846. dec(Value.Int);
  4847. end;
  4848. procedure TResExprEvaluator.SuccInt(Value: TResEvalInt; ErrorEl: TPasElement);
  4849. begin
  4850. if Value.Int=high(TMaxPrecInt) then
  4851. begin
  4852. EmitRangeCheckConst(20170624142920,IntToStr(Value.Int),
  4853. IntToStr(low(TMaxPrecInt)),IntToStr(pred(high(TMaxPrecInt))),ErrorEl);
  4854. Value.Int:=low(Value.Int);
  4855. end
  4856. else
  4857. inc(Value.Int);
  4858. end;
  4859. procedure TResExprEvaluator.PredUInt(Value: TResEvalUInt; ErrorEl: TPasElement);
  4860. begin
  4861. if Value.UInt=low(TMaxPrecUInt) then
  4862. begin
  4863. EmitRangeCheckConst(20170624143122,IntToStr(Value.UInt),
  4864. IntToStr(succ(low(TMaxPrecUInt))),IntToStr(high(TMaxPrecUInt)),ErrorEl);
  4865. Value.UInt:=high(Value.UInt);
  4866. end
  4867. else
  4868. dec(Value.UInt);
  4869. end;
  4870. procedure TResExprEvaluator.SuccUInt(Value: TResEvalUInt; ErrorEl: TPasElement);
  4871. begin
  4872. // Note: when FPC compares int64 with qword it converts the qword to an int64
  4873. if Value.UInt=HighIntAsUInt then
  4874. begin
  4875. EmitRangeCheckConst(20170624142921,IntToStr(Value.UInt),
  4876. IntToStr(low(TMaxPrecUInt)),IntToStr(pred(high(TMaxPrecUInt))),ErrorEl);
  4877. Value.UInt:=low(Value.UInt);
  4878. end
  4879. else
  4880. inc(Value.UInt);
  4881. end;
  4882. {$ifdef FPC_HAS_CPSTRING}
  4883. procedure TResExprEvaluator.PredString(Value: TResEvalString;
  4884. ErrorEl: TPasElement);
  4885. begin
  4886. if length(Value.S)<>1 then
  4887. RaiseRangeCheck(20170624150138,ErrorEl);
  4888. if Value.S[1]=#0 then
  4889. begin
  4890. EmitRangeCheckConst(20170624150220,Value.AsString,'#1','#255',ErrorEl);
  4891. Value.S:=#255;
  4892. end
  4893. else
  4894. Value.S:=pred(Value.S[1]);
  4895. end;
  4896. procedure TResExprEvaluator.SuccString(Value: TResEvalString;
  4897. ErrorEl: TPasElement);
  4898. begin
  4899. if length(Value.S)<>1 then
  4900. RaiseRangeCheck(20170624150432,ErrorEl);
  4901. if Value.S[1]=#255 then
  4902. begin
  4903. EmitRangeCheckConst(20170624150441,Value.AsString,'#0','#254',ErrorEl);
  4904. Value.S:=#0;
  4905. end
  4906. else
  4907. Value.S:=succ(Value.S[1]);
  4908. end;
  4909. {$endif}
  4910. procedure TResExprEvaluator.PredUnicodeString(Value: TResEvalUTF16;
  4911. ErrorEl: TPasElement);
  4912. begin
  4913. if length(Value.S)<>1 then
  4914. RaiseRangeCheck(20170624150703,ErrorEl);
  4915. if Value.S[1]=#0 then
  4916. begin
  4917. EmitRangeCheckConst(20170624150710,Value.AsString,'#1','#65535',ErrorEl);
  4918. Value.S:=WideChar(#65535);
  4919. end
  4920. else
  4921. Value.S:=pred(Value.S[1]);
  4922. end;
  4923. procedure TResExprEvaluator.SuccUnicodeString(Value: TResEvalUTF16;
  4924. ErrorEl: TPasElement);
  4925. begin
  4926. if length(Value.S)<>1 then
  4927. RaiseRangeCheck(20170624150849,ErrorEl);
  4928. if Value.S[1]=#65535 then
  4929. begin
  4930. EmitRangeCheckConst(20170624150910,Value.AsString,'#0','#65534',ErrorEl);
  4931. Value.S:=#0;
  4932. end
  4933. else
  4934. Value.S:=succ(Value.S[1]);
  4935. end;
  4936. procedure TResExprEvaluator.PredEnum(Value: TResEvalEnum; ErrorEl: TPasElement);
  4937. var
  4938. EnumType: TPasEnumType;
  4939. begin
  4940. EnumType:=Value.ElType as TPasEnumType;
  4941. if EnumType=nil then
  4942. RaiseInternalError(20170821174038,dbgs(Value));
  4943. if Value.Index<=0 then
  4944. begin
  4945. EmitRangeCheckConst(20170624144332,Value.AsString,
  4946. TPasEnumValue(EnumType.Values[Min(1,EnumType.Values.Count-1)]).Name,
  4947. TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]).Name,ErrorEl);
  4948. Value.Index:=EnumType.Values.Count-1;
  4949. end
  4950. else
  4951. dec(Value.Index);
  4952. Value.IdentEl:=TPasEnumValue(EnumType.Values[Value.Index]);
  4953. end;
  4954. procedure TResExprEvaluator.SuccEnum(Value: TResEvalEnum; ErrorEl: TPasElement);
  4955. var
  4956. EnumType: TPasEnumType;
  4957. begin
  4958. EnumType:=Value.ElType as TPasEnumType;
  4959. if EnumType=nil then
  4960. RaiseInternalError(20170821174058,dbgs(Value));
  4961. if Value.Index>=EnumType.Values.Count-1 then
  4962. begin
  4963. EmitRangeCheckConst(20170624145013,Value.AsString,
  4964. TPasEnumValue(EnumType.Values[0]).Name,
  4965. TPasEnumValue(EnumType.Values[Max(0,EnumType.Values.Count-2)]).Name,ErrorEl);
  4966. Value.Index:=0;
  4967. end
  4968. else
  4969. inc(Value.Index);
  4970. Value.IdentEl:=TPasEnumValue(EnumType.Values[Value.Index]);
  4971. end;
  4972. { TResolveData }
  4973. procedure TResolveData.SetElement(AValue: TPasElement);
  4974. begin
  4975. if FElement=AValue then Exit;
  4976. if Element<>nil then
  4977. Element.Release{$IFDEF CheckPasTreeRefCount}(ClassName+'.SetElement'){$ENDIF};
  4978. FElement:=AValue;
  4979. if Element<>nil then
  4980. Element.AddRef{$IFDEF CheckPasTreeRefCount}(ClassName+'.SetElement'){$ENDIF};
  4981. end;
  4982. constructor TResolveData.Create;
  4983. begin
  4984. end;
  4985. destructor TResolveData.Destroy;
  4986. begin
  4987. {$IFDEF VerbosePasResolverMem}
  4988. writeln('TResolveData.Destroy START ',ClassName);
  4989. {$ENDIF}
  4990. Element:=nil;
  4991. Owner:=nil;
  4992. Next:=nil;
  4993. inherited Destroy;
  4994. {$IFDEF VerbosePasResolverMem}
  4995. writeln('TResolveData.Destroy END ',ClassName);
  4996. {$ENDIF}
  4997. end;
  4998. { TResEvalValue }
  4999. constructor TResEvalValue.CreateKind(const aKind: TREVKind);
  5000. begin
  5001. Create;
  5002. Kind:=aKind;
  5003. end;
  5004. function TResEvalValue.Clone: TResEvalValue;
  5005. begin
  5006. Result:=TResEvalValueClass(ClassType).Create;
  5007. Result.Kind:=Kind;
  5008. Result.IdentEl:=IdentEl;
  5009. end;
  5010. function TResEvalValue.AsDebugString: string;
  5011. begin
  5012. str(Kind,Result);
  5013. Result:=Result+'='+AsString;
  5014. end;
  5015. function TResEvalValue.AsString: string;
  5016. begin
  5017. case Kind of
  5018. revkNone: Result:='<None>';
  5019. revkNil: Result:='nil';
  5020. else
  5021. str(Kind,Result);
  5022. end;
  5023. end;
  5024. { TResEvalUInt }
  5025. constructor TResEvalUInt.Create;
  5026. begin
  5027. inherited Create;
  5028. Kind:=revkUInt;
  5029. end;
  5030. constructor TResEvalUInt.CreateValue(const aValue: TMaxPrecUInt);
  5031. begin
  5032. Create;
  5033. UInt:=aValue;
  5034. end;
  5035. function TResEvalUInt.Clone: TResEvalValue;
  5036. begin
  5037. Result:=inherited Clone;
  5038. TResEvalUInt(Result).UInt:=UInt;
  5039. end;
  5040. function TResEvalUInt.AsString: string;
  5041. begin
  5042. Result:=IntToStr(UInt);
  5043. end;
  5044. { TResEvalInt }
  5045. constructor TResEvalInt.Create;
  5046. begin
  5047. inherited Create;
  5048. Kind:=revkInt;
  5049. end;
  5050. constructor TResEvalInt.CreateValue(const aValue: TMaxPrecInt);
  5051. begin
  5052. Create;
  5053. Int:=aValue;
  5054. end;
  5055. constructor TResEvalInt.CreateValue(const aValue: TMaxPrecInt; aTyped: TResEvalTypedInt
  5056. );
  5057. begin
  5058. Create;
  5059. Int:=aValue;
  5060. Typed:=aTyped;
  5061. end;
  5062. function TResEvalInt.Clone: TResEvalValue;
  5063. begin
  5064. Result:=inherited Clone;
  5065. TResEvalInt(Result).Int:=Int;
  5066. TResEvalInt(Result).Typed:=Typed;
  5067. end;
  5068. function TResEvalInt.AsString: string;
  5069. begin
  5070. Result:=IntToStr(Int);
  5071. end;
  5072. function TResEvalInt.AsDebugString: string;
  5073. begin
  5074. if Typed=reitNone then
  5075. Result:=inherited AsDebugString
  5076. else
  5077. begin
  5078. str(Kind,Result);
  5079. case Typed of
  5080. reitByte: Result:=Result+':byte';
  5081. reitShortInt: Result:=Result+':shortint';
  5082. reitWord: Result:=Result+':word';
  5083. reitSmallInt: Result:=Result+':smallint';
  5084. reitUIntSingle: Result:=Result+':uintsingle';
  5085. reitIntSingle: Result:=Result+':intsingle';
  5086. reitLongWord: Result:=Result+':longword';
  5087. reitLongInt: Result:=Result+':longint';
  5088. reitUIntDouble: Result:=Result+':uintdouble';
  5089. reitIntDouble: Result:=Result+':intdouble';
  5090. end;
  5091. Result:=Result+'='+AsString;
  5092. end;
  5093. end;
  5094. { TResEvalFloat }
  5095. constructor TResEvalFloat.Create;
  5096. begin
  5097. inherited Create;
  5098. Kind:=revkFloat;
  5099. end;
  5100. constructor TResEvalFloat.CreateValue(const aValue: TMaxPrecFloat);
  5101. begin
  5102. Create;
  5103. FloatValue:=aValue;
  5104. end;
  5105. function TResEvalFloat.Clone: TResEvalValue;
  5106. begin
  5107. Result:=inherited Clone;
  5108. TResEvalFloat(Result).FloatValue:=FloatValue;
  5109. end;
  5110. function TResEvalFloat.AsString: string;
  5111. begin
  5112. str(FloatValue,Result);
  5113. end;
  5114. function TResEvalFloat.IsInt(out Int: TMaxPrecInt): boolean;
  5115. begin
  5116. Int:=0;
  5117. if Frac(FloatValue)<>0 then exit(false);
  5118. if FloatValue<TMaxPrecFloat(low(TMaxPrecInt)) then exit(false);
  5119. if FloatValue>TMaxPrecFloat(high(TMaxPrecInt)) then exit(false);
  5120. Int:=Trunc(FloatValue);
  5121. Result:=true;
  5122. end;
  5123. {$ifdef FPC_HAS_CPSTRING}
  5124. { TResEvalString }
  5125. constructor TResEvalString.Create;
  5126. begin
  5127. inherited Create;
  5128. Kind:=revkString;
  5129. end;
  5130. constructor TResEvalString.CreateValue(const aValue: RawByteString);
  5131. begin
  5132. Create;
  5133. S:=aValue;
  5134. end;
  5135. function TResEvalString.Clone: TResEvalValue;
  5136. begin
  5137. Result:=inherited Clone;
  5138. TResEvalString(Result).S:=S;
  5139. end;
  5140. function TResEvalString.AsString: string;
  5141. begin
  5142. Result:=RawStrToCaption(S,60);
  5143. end;
  5144. {$endif}
  5145. { TResEvalUTF16 }
  5146. constructor TResEvalUTF16.Create;
  5147. begin
  5148. inherited Create;
  5149. Kind:=revkUnicodeString;
  5150. end;
  5151. constructor TResEvalUTF16.CreateValue(const aValue: UnicodeString);
  5152. begin
  5153. Create;
  5154. S:=aValue;
  5155. end;
  5156. function TResEvalUTF16.Clone: TResEvalValue;
  5157. begin
  5158. Result:=inherited Clone;
  5159. TResEvalUTF16(Result).S:=S;
  5160. end;
  5161. function TResEvalUTF16.AsString: string;
  5162. begin
  5163. Result:=String(UnicodeStrToCaption(S,60));
  5164. end;
  5165. { TResEvalEnum }
  5166. constructor TResEvalEnum.Create;
  5167. begin
  5168. inherited Create;
  5169. Kind:=revkEnum;
  5170. end;
  5171. constructor TResEvalEnum.CreateValue(const aValue: integer;
  5172. aIdentEl: TPasEnumValue);
  5173. begin
  5174. Create;
  5175. Index:=aValue;
  5176. IdentEl:=aIdentEl;
  5177. ElType:=IdentEl.Parent as TPasEnumType;
  5178. if ElType=nil then
  5179. raise Exception.Create('');
  5180. end;
  5181. function TResEvalEnum.GetEnumValue: TPasEnumValue;
  5182. begin
  5183. Result:=nil;
  5184. if ElType<>nil then
  5185. if (Index>=0) and (Index<ElType.Values.Count) then
  5186. Result:=TObject(ElType.Values[Index]) as TPasEnumValue;
  5187. end;
  5188. function TResEvalEnum.GetEnumName: String;
  5189. var
  5190. V: TPasEnumValue;
  5191. begin
  5192. V:=GetEnumValue;
  5193. if V<>nil then
  5194. Result:=V.Name
  5195. else
  5196. Result:='';
  5197. end;
  5198. function TResEvalEnum.Clone: TResEvalValue;
  5199. begin
  5200. Result:=inherited Clone;
  5201. TResEvalEnum(Result).Index:=Index;
  5202. TResEvalEnum(Result).ElType:=ElType;
  5203. end;
  5204. function TResEvalEnum.AsDebugString: string;
  5205. begin
  5206. str(Kind,Result);
  5207. Result:=Result+'='+AsString+'='+IntToStr(Index);
  5208. end;
  5209. function TResEvalEnum.AsString: string;
  5210. begin
  5211. if IdentEl<>nil then
  5212. begin
  5213. Result:=IdentEl.Name;
  5214. if Result<>'' then exit;
  5215. end;
  5216. Result:=GetEnumName;
  5217. if Result<>'' then exit;
  5218. Result:=ElType.Name+'('+IntToStr(Index)+')';
  5219. end;
  5220. { TResEvalRangeInt }
  5221. constructor TResEvalRangeInt.Create;
  5222. begin
  5223. inherited Create;
  5224. Kind:=revkRangeInt;
  5225. end;
  5226. constructor TResEvalRangeInt.CreateValue(const aElKind: TRESetElKind;
  5227. aElType: TPasType; const aRangeStart, aRangeEnd: TMaxPrecInt);
  5228. begin
  5229. Create;
  5230. ElKind:=aElKind;
  5231. ElType:=aElType;
  5232. RangeStart:=aRangeStart;
  5233. RangeEnd:=aRangeEnd;
  5234. end;
  5235. function TResEvalRangeInt.Clone: TResEvalValue;
  5236. begin
  5237. Result:=inherited Clone;
  5238. TResEvalRangeInt(Result).ElKind:=ElKind;
  5239. TResEvalRangeInt(Result).RangeStart:=RangeStart;
  5240. TResEvalRangeInt(Result).RangeEnd:=RangeEnd;
  5241. end;
  5242. function TResEvalRangeInt.AsString: string;
  5243. begin
  5244. Result:=ElementAsString(RangeStart)+'..'+ElementAsString(RangeEnd);
  5245. end;
  5246. function TResEvalRangeInt.AsDebugString: string;
  5247. var
  5248. s: string;
  5249. begin
  5250. str(Kind,Result);
  5251. str(ElKind,s);
  5252. Result:=Result+'/'+s+':'+GetObjName(ElType)+'='+AsString;
  5253. end;
  5254. function TResEvalRangeInt.ElementAsString(El: TMaxPrecInt): string;
  5255. var
  5256. EnumValue: TPasEnumValue;
  5257. EnumType: TPasEnumType;
  5258. begin
  5259. case ElKind of
  5260. revskBool:
  5261. if El=0 then
  5262. Result:='false'
  5263. else
  5264. Result:='true';
  5265. revskEnum:
  5266. begin
  5267. EnumType:=ElType as TPasEnumType;
  5268. if (El>=0) and (El<EnumType.Values.Count) then
  5269. begin
  5270. EnumValue:=TPasEnumValue(EnumType.Values[El]);
  5271. Result:=EnumValue.Name;
  5272. end
  5273. else
  5274. Result:=ElType.Name+'('+IntToStr(El)+')';
  5275. end;
  5276. revskInt: Result:=IntToStr(El);
  5277. revskChar:
  5278. if ((El>=32) and (El<=38)) or ((El>=40) and (El<=126)) then
  5279. Result:=''''+Chr(El)+''''
  5280. else
  5281. Result:='#'+IntToStr(El);
  5282. end;
  5283. end;
  5284. { TResEvalSet }
  5285. constructor TResEvalSet.Create;
  5286. begin
  5287. inherited Create;
  5288. Kind:=revkSetOfInt;
  5289. end;
  5290. constructor TResEvalSet.CreateEmpty(const aElKind: TRESetElKind;
  5291. aElType: TPasType);
  5292. begin
  5293. Create;
  5294. ElKind:=aElKind;
  5295. ElType:=aElType;
  5296. end;
  5297. constructor TResEvalSet.CreateEmptySameKind(aSet: TResEvalSet);
  5298. begin
  5299. Create;
  5300. IdentEl:=aSet.IdentEl;
  5301. ElKind:=aSet.ElKind;
  5302. ElType:=aSet.ElType;
  5303. end;
  5304. constructor TResEvalSet.CreateValue(const aElKind: TRESetElKind;
  5305. aElType: TPasType; const aRangeStart, aRangeEnd: TMaxPrecInt);
  5306. begin
  5307. inherited CreateValue(aElKind, aElType, aRangeStart, aRangeEnd);
  5308. Add(aRangeStart,aRangeEnd);
  5309. end;
  5310. function TResEvalSet.Clone: TResEvalValue;
  5311. var
  5312. RS: TResEvalSet;
  5313. i: Integer;
  5314. begin
  5315. Result:=inherited Clone;
  5316. RS:=TResEvalSet(Result);
  5317. RS.ElKind:=ElKind;
  5318. RS.ElType:=ElType;
  5319. SetLength(RS.Ranges,length(Ranges));
  5320. for i:=0 to length(Ranges)-1 do
  5321. RS.Ranges[i]:=Ranges[i];
  5322. end;
  5323. function TResEvalSet.AsString: string;
  5324. var
  5325. i: Integer;
  5326. begin
  5327. Result:='[';
  5328. for i:=0 to length(Ranges)-1 do
  5329. begin
  5330. if i>0 then Result:=Result+',';
  5331. Result:=Result+ElementAsString(Ranges[i].RangeStart);
  5332. if Ranges[i].RangeStart<>Ranges[i].RangeEnd then
  5333. Result:=Result+'..'+ElementAsString(Ranges[i].RangeEnd);
  5334. end;
  5335. Result:=Result+']';
  5336. end;
  5337. function TResEvalSet.Add(aRangeStart, aRangeEnd: TMaxPrecInt): boolean;
  5338. {$IF FPC_FULLVERSION<30101}
  5339. procedure Insert(const Item: TItem; var Items: TItems; Index: integer);
  5340. var
  5341. i: Integer;
  5342. begin
  5343. Setlength(Items,length(Items)+1);
  5344. for i:=length(Items)-1 downto Index+1 do
  5345. Items[i]:=Items[i-1];
  5346. Items[Index]:=Item;
  5347. end;
  5348. procedure Delete(var Items: TItems; Start, Size: integer);
  5349. var
  5350. i: Integer;
  5351. begin
  5352. if Size=0 then exit;
  5353. for i:=Start+Size to length(Items)-1 do
  5354. Items[i-Size]:=Items[i];
  5355. Setlength(Items,length(Items)-Size);
  5356. end;
  5357. {$ENDIF}
  5358. var
  5359. StartIndex, l, EndIndex: Integer;
  5360. Item: TItem;
  5361. begin
  5362. Result:=false;
  5363. {$IFDEF VerbosePasResEval}
  5364. writeln('TResEvalSetInt.Add ',aRangeStart,'..',aRangeEnd);
  5365. {$ENDIF}
  5366. if aRangeStart>aRangeEnd then
  5367. raise Exception.Create('');
  5368. if ElKind=revskNone then
  5369. raise Exception.Create('');
  5370. l:=length(Ranges);
  5371. if l=0 then
  5372. begin
  5373. // first range
  5374. RangeStart:=aRangeStart;
  5375. RangeEnd:=aRangeEnd;
  5376. SetLength(Ranges,1);
  5377. Ranges[0].RangeStart:=aRangeStart;
  5378. Ranges[0].RangeEnd:=aRangeEnd;
  5379. exit(true);
  5380. end;
  5381. if RangeStart>aRangeStart then
  5382. RangeStart:=aRangeStart;
  5383. if RangeEnd<aRangeEnd then
  5384. RangeEnd:=aRangeEnd;
  5385. // find insert position
  5386. StartIndex:=IndexOfRange(aRangeStart,true);
  5387. if (StartIndex>0) and (Ranges[StartIndex-1].RangeEnd=aRangeStart-1) then
  5388. dec(StartIndex);
  5389. if StartIndex=l then
  5390. begin
  5391. // add new range
  5392. Item.RangeStart:=aRangeStart;
  5393. Item.RangeEnd:=aRangeEnd;
  5394. Insert(Item,Ranges,StartIndex);
  5395. Result:=true;
  5396. end
  5397. else
  5398. begin
  5399. // StartIndex is now the first affected range
  5400. EndIndex:=IndexOfRange(aRangeEnd,true);
  5401. if (EndIndex>StartIndex) then
  5402. if (EndIndex=l) or (Ranges[EndIndex].RangeStart>aRangeEnd+1) then
  5403. dec(EndIndex);
  5404. // EndIndex is now the last affected range
  5405. if StartIndex>EndIndex then
  5406. raise Exception.Create('');
  5407. if StartIndex=EndIndex then
  5408. begin
  5409. if (Ranges[StartIndex].RangeStart>aRangeEnd) then
  5410. begin
  5411. // range in front
  5412. if (Ranges[StartIndex].RangeStart>aRangeEnd+1) then
  5413. begin
  5414. // insert new range
  5415. Item.RangeStart:=aRangeStart;
  5416. Item.RangeEnd:=aRangeEnd;
  5417. Insert(Item,Ranges,StartIndex);
  5418. Result:=true;
  5419. end
  5420. else
  5421. begin
  5422. // enlarge range at its start
  5423. Ranges[StartIndex].RangeStart:=aRangeStart;
  5424. Result:=true;
  5425. end;
  5426. end
  5427. else if Ranges[StartIndex].RangeEnd<aRangeStart then
  5428. begin
  5429. // range behind
  5430. if Ranges[StartIndex].RangeEnd+1<aRangeStart then
  5431. begin
  5432. // insert new range
  5433. Item.RangeStart:=aRangeStart;
  5434. Item.RangeEnd:=aRangeEnd;
  5435. Insert(Item,Ranges,StartIndex+1);
  5436. Result:=true;
  5437. end
  5438. else
  5439. begin
  5440. // enlarge range at its end
  5441. Ranges[StartIndex].RangeEnd:=aRangeEnd;
  5442. Result:=true;
  5443. end;
  5444. end
  5445. else
  5446. begin
  5447. // intersection -> enlarge to union range
  5448. Result:=false;
  5449. if (Ranges[StartIndex].RangeStart>aRangeStart) then
  5450. Ranges[StartIndex].RangeStart:=aRangeStart;
  5451. if (Ranges[StartIndex].RangeEnd<aRangeEnd) then
  5452. Ranges[StartIndex].RangeEnd:=aRangeEnd;
  5453. end;
  5454. end
  5455. else
  5456. begin
  5457. // multiple ranges are merged to one
  5458. Result:=false;
  5459. if Ranges[StartIndex].RangeStart>aRangeStart then
  5460. Ranges[StartIndex].RangeStart:=aRangeStart;
  5461. if aRangeEnd<Ranges[EndIndex].RangeEnd then
  5462. aRangeEnd:=Ranges[EndIndex].RangeEnd;
  5463. Ranges[StartIndex].RangeEnd:=aRangeEnd;
  5464. Delete(Ranges,StartIndex+1,EndIndex-StartIndex);
  5465. end;
  5466. end;
  5467. {$IFDEF VerbosePasResEval}
  5468. writeln('TResEvalSetInt.Add END ',AsDebugString);
  5469. ConsistencyCheck;
  5470. {$ENDIF}
  5471. end;
  5472. function TResEvalSet.IndexOfRange(Index: TMaxPrecInt; FindInsertPos: boolean
  5473. ): integer;
  5474. var
  5475. l, r, m: Integer;
  5476. begin
  5477. l:=0;
  5478. r:=length(Ranges)-1;
  5479. while l<=r do
  5480. begin
  5481. m:=(l+r) div 2;
  5482. if Ranges[m].RangeStart>Index then
  5483. r:=m-1
  5484. else if Ranges[m].RangeEnd<Index then
  5485. l:=m+1
  5486. else
  5487. exit(m);
  5488. end;
  5489. if not FindInsertPos then
  5490. exit(-1);
  5491. // find insert position
  5492. if length(Ranges)=0 then
  5493. exit(0)
  5494. else if l>m then
  5495. exit(l)
  5496. else
  5497. exit(m);
  5498. Result:=-1;
  5499. end;
  5500. function TResEvalSet.Intersects(aRangeStart, aRangeEnd: TMaxPrecInt): integer;
  5501. var
  5502. Index: Integer;
  5503. begin
  5504. Index:=IndexOfRange(aRangeStart,true);
  5505. if (Index=length(Ranges)) or (Ranges[Index].RangeStart>aRangeEnd) then
  5506. Result:=-1
  5507. else
  5508. Result:=Index;
  5509. end;
  5510. procedure TResEvalSet.ConsistencyCheck;
  5511. procedure E(Msg: string);
  5512. begin
  5513. raise Exception.Create(Msg);
  5514. end;
  5515. var
  5516. i: Integer;
  5517. begin
  5518. if (ElKind=revskNone) and (length(Ranges)>0) then
  5519. E('');
  5520. for i:=0 to length(Ranges)-1 do
  5521. begin
  5522. if Ranges[i].RangeStart>Ranges[i].RangeEnd then
  5523. E('');
  5524. if (i>0) and (Ranges[i-1].RangeEnd+1>=Ranges[i].RangeStart) then
  5525. E('missing gap');
  5526. if RangeStart>Ranges[i].RangeStart then
  5527. E('wrong RangeStart='+IntToStr(RangeStart));
  5528. if RangeEnd<Ranges[i].RangeEnd then
  5529. E('wrong RangeEnd='+IntToStr(RangeEnd));
  5530. end;
  5531. end;
  5532. end.