pasresolveeval.pas 200 KB

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