pasresolveeval.pas 184 KB

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