2
0

pasresolveeval.pas 183 KB

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