pasresolveeval.pas 174 KB

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