FoxSyntaxTree.Mod 172 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261
  1. MODULE FoxSyntaxTree; (** AUTHOR "fof & fn"; PURPOSE "Oberon Compiler: Abstract Syntax Tree"; **)
  2. (* (c) fof ETHZ 2009 *)
  3. (**
  4. note on documentation:
  5. Most objects in this module are commented with an informal Oberon syntax example indicating which variables of the respective object stand for what symbol /expression etc.
  6. This syntax example should not be confused with a profound description of the syntax in an EBNF form, which can rather be found in the parser module.
  7. The informal Oberon syntax is marked with << ... >>
  8. **)
  9. IMPORT
  10. Basic := FoxBasic, Scanner := FoxScanner, BitSets, StringPool, Strings(* , D := Debugging (* only for debuggging / counting *) *) ;
  11. CONST
  12. (** general flags: used in statements, procedure types and symbols
  13. general flags are unique and may overlap with access flags only
  14. flag numbers have no meaning and are not used for object files etc., i.e. flag renumbering is possible without effect
  15. *)
  16. (** calling conventions *)
  17. OberonCallingConvention* = 0;
  18. CCallingConvention* = 1;
  19. WinAPICallingConvention* = 2;
  20. InterruptCallingConvention* = 3;
  21. PlatformCallingConvention* = 4;
  22. UndefinedCallingConvention* = 5;
  23. (** Access Flags *)
  24. InternalRead* = 0; (** can read symbol in same module *)
  25. InternalWrite* = 1; (** can write symbol in same module *)
  26. ProtectedRead* = 2; (** can read symbol in type extentions *)
  27. ProtectedWrite* = 3; (** can write symbol in type extentions *)
  28. PublicRead* = 4; (** can read everywhere *)
  29. PublicWrite* = 5; (** can write everywhere *)
  30. Hidden* = {};
  31. Internal* = {InternalRead, InternalWrite};
  32. Protected* = {ProtectedRead, ProtectedWrite} ;
  33. Public* = {PublicRead, PublicWrite} ;
  34. ReadOnly* = {InternalRead, ProtectedRead,PublicRead};
  35. (** parameter forms *)
  36. ValueParameter* = 0; VarParameter* = 1; ConstParameter* = 2;
  37. InPort*=3; OutPort*=4;
  38. (** array forms *)
  39. Static*=1; (* ARRAY x OF .. / ARRAY [x] OF ... *)
  40. Open*=2; (* ARRAY OF ... / ARRAY [*] OF ... *)
  41. Tensor*=3; (* ARRAY [?] OF ... *)
  42. SemiDynamic*=4;
  43. (** node states, important for checker to avoid cycles *)
  44. Undefined*={}; BeingResolved*=1; Resolved*=2; FingerPrinted*=3; Warned*=4;
  45. (* context in which a range expression is used *)
  46. ArrayIndex* = 0;
  47. SetElement* = 1;
  48. CaseGuard* = 2;
  49. (* reflection flags *)
  50. FlagProcedureDelegate*=0;
  51. FlagProcedureConstructor*=1;
  52. FlagParameterVar*=1;
  53. FlagParameterConst*=2;
  54. TYPE
  55. Position*= Scanner.Position;
  56. SourceCode*= Scanner.StringType;
  57. BinaryCode*= BitSets.BitSet;
  58. String*= Scanner.StringType;
  59. IdentifierString*= Scanner.IdentifierString;
  60. CallingConvention*= LONGINT;
  61. (** visitor pattern implementation *)
  62. (* to use this object in your implementation, copy and paste and replace "x: " by "x: SyntaxTree." *)
  63. Visitor* = OBJECT
  64. (** types *)
  65. PROCEDURE VisitType*(x: Type);
  66. BEGIN HALT(100) (* abstract *) END VisitType;
  67. PROCEDURE VisitBasicType*(x: BasicType);
  68. BEGIN HALT(100) (* abstract *) END VisitBasicType;
  69. PROCEDURE VisitByteType*(x: ByteType);
  70. BEGIN HALT(100) (* abstract *) END VisitByteType;
  71. PROCEDURE VisitAnyType*(x: AnyType);
  72. BEGIN HALT(100) (* abstract *) END VisitAnyType;
  73. PROCEDURE VisitObjectType*(x: ObjectType);
  74. BEGIN HALT(100) (* abstract *) END VisitObjectType;
  75. PROCEDURE VisitNilType*(x: NilType);
  76. BEGIN HALT(100) (* abstract *) END VisitNilType;
  77. PROCEDURE VisitAddressType*(x: AddressType);
  78. BEGIN HALT(100) (* abstract *) END VisitAddressType;
  79. PROCEDURE VisitSizeType*(x: SizeType);
  80. BEGIN HALT(100) (* abstract *) END VisitSizeType;
  81. PROCEDURE VisitBooleanType*(x: BooleanType);
  82. BEGIN HALT(100) (* abstract *) END VisitBooleanType;
  83. PROCEDURE VisitSetType*(x: SetType);
  84. BEGIN HALT(100) (* abstract *) END VisitSetType;
  85. PROCEDURE VisitCharacterType*(x: CharacterType);
  86. BEGIN HALT(100) END VisitCharacterType;
  87. PROCEDURE VisitIntegerType*(x: IntegerType);
  88. BEGIN HALT(100) END VisitIntegerType;
  89. PROCEDURE VisitFloatType*(x: FloatType);
  90. BEGIN HALT(100) END VisitFloatType;
  91. PROCEDURE VisitComplexType*(x: ComplexType);
  92. BEGIN HALT(100) END VisitComplexType;
  93. PROCEDURE VisitQualifiedType*(x: QualifiedType);
  94. BEGIN HALT(100) (* abstract *) END VisitQualifiedType;
  95. PROCEDURE VisitStringType*(x: StringType);
  96. BEGIN HALT(100) (* abstract *) END VisitStringType;
  97. PROCEDURE VisitEnumerationType*(x: EnumerationType);
  98. BEGIN HALT(100) (* abstract *) END VisitEnumerationType;
  99. PROCEDURE VisitRangeType*(x: RangeType);
  100. BEGIN HALT(100) (* abstract *) END VisitRangeType;
  101. PROCEDURE VisitArrayType*(x: ArrayType);
  102. BEGIN HALT(100) (* abstract *) END VisitArrayType;
  103. PROCEDURE VisitMathArrayType*(x: MathArrayType);
  104. BEGIN HALT(100) (* abstract *) END VisitMathArrayType;
  105. PROCEDURE VisitPointerType*(x: PointerType);
  106. BEGIN HALT(100) (* abstract *) END VisitPointerType;
  107. PROCEDURE VisitPortType*(x: PortType);
  108. BEGIN HALT(100) (* abstract *) END VisitPortType;
  109. PROCEDURE VisitRecordType*(x: RecordType);
  110. BEGIN HALT(100) (* abstract *) END VisitRecordType;
  111. PROCEDURE VisitCellType*(x: CellType);
  112. BEGIN HALT(100) (* abstract *) END VisitCellType;
  113. PROCEDURE VisitProcedureType*(x: ProcedureType);
  114. BEGIN HALT(100) (* abstract *) END VisitProcedureType;
  115. PROCEDURE VType*(x: Type);
  116. BEGIN
  117. (*x.Accept(SELF); RETURN;*)
  118. WITH x: ProcedureType DO VisitProcedureType(x)
  119. |CellType DO VisitCellType(x)
  120. |RecordType DO VisitRecordType(x)
  121. |PortType DO VisitPortType(x)
  122. |PointerType DO VisitPointerType(x)
  123. |MathArrayType DO VisitMathArrayType(x)
  124. |ArrayType DO VisitArrayType(x)
  125. |RangeType DO VisitRangeType(x)
  126. |EnumerationType DO VisitEnumerationType(x)
  127. |StringType DO VisitStringType(x)
  128. |QualifiedType DO VisitQualifiedType(x)
  129. |ComplexType DO VisitComplexType(x)
  130. |FloatType DO VisitFloatType(x)
  131. |IntegerType DO VisitIntegerType(x)
  132. |CharacterType DO VisitCharacterType(x)
  133. |SetType DO VisitSetType(x)
  134. |BooleanType DO VisitBooleanType(x)
  135. |SizeType DO VisitSizeType(x)
  136. |AddressType DO VisitAddressType(x)
  137. |NilType DO VisitNilType(x)
  138. |ObjectType DO VisitObjectType(x)
  139. |AnyType DO VisitAnyType(x)
  140. |ByteType DO VisitByteType(x)
  141. |BasicType DO VisitBasicType(x)
  142. ELSE VisitType(x)
  143. END;
  144. END VType;
  145. (** expressions *)
  146. PROCEDURE VisitExpression*(x: Expression);
  147. BEGIN HALT(100) (* abstract *) END VisitExpression;
  148. PROCEDURE VisitSet*(x: Set);
  149. BEGIN HALT(100) (* abstract *) END VisitSet;
  150. PROCEDURE VisitMathArrayExpression*(x: MathArrayExpression);
  151. BEGIN HALT(100) (* abstract *) END VisitMathArrayExpression;
  152. PROCEDURE VisitUnaryExpression*(x: UnaryExpression);
  153. BEGIN HALT(100) (* abstract *) END VisitUnaryExpression;
  154. PROCEDURE VisitBinaryExpression*(x: BinaryExpression);
  155. BEGIN HALT(100) (* abstract *) END VisitBinaryExpression;
  156. PROCEDURE VisitRangeExpression*(x: RangeExpression);
  157. BEGIN HALT(100) (* abstract *) END VisitRangeExpression;
  158. PROCEDURE VisitTensorRangeExpression*(x: TensorRangeExpression);
  159. BEGIN HALT(100) (* abstract *) END VisitTensorRangeExpression;
  160. PROCEDURE VisitConversion*(x: Conversion);
  161. BEGIN HALT(100) (* abstract *) END VisitConversion;
  162. (** designators (expressions) *)
  163. PROCEDURE VisitDesignator*(x: Designator);
  164. BEGIN HALT(100) (* abstract *) END VisitDesignator;
  165. PROCEDURE VisitIdentifierDesignator*(x: IdentifierDesignator);
  166. BEGIN HALT(100) (* abstract *) END VisitIdentifierDesignator;
  167. PROCEDURE VisitSelectorDesignator*(x: SelectorDesignator);
  168. BEGIN HALT(100) (* abstract *) END VisitSelectorDesignator;
  169. PROCEDURE VisitParameterDesignator*(x: ParameterDesignator);
  170. BEGIN HALT(100) (* abstract *) END VisitParameterDesignator;
  171. PROCEDURE VisitArrowDesignator*(x: ArrowDesignator);
  172. BEGIN HALT(100) (* abstract *) END VisitArrowDesignator;
  173. PROCEDURE VisitBracketDesignator*(x: BracketDesignator);
  174. BEGIN HALT(100) (* abstract *) END VisitBracketDesignator;
  175. PROCEDURE VisitSymbolDesignator*(x: SymbolDesignator);
  176. BEGIN HALT(100) (* abstract *) END VisitSymbolDesignator;
  177. PROCEDURE VisitIndexDesignator*(x: IndexDesignator);
  178. BEGIN HALT(100) (* abstract *) END VisitIndexDesignator;
  179. PROCEDURE VisitProcedureCallDesignator*(x: ProcedureCallDesignator);
  180. BEGIN HALT(100) (* abstract *) END VisitProcedureCallDesignator;
  181. PROCEDURE VisitStatementDesignator*(x: StatementDesignator);
  182. BEGIN HALT(100) (* abstract *) END VisitStatementDesignator;
  183. PROCEDURE VisitBuiltinCallDesignator*(x: BuiltinCallDesignator);
  184. BEGIN HALT(100) (* abstract *) END VisitBuiltinCallDesignator;
  185. PROCEDURE VisitTypeGuardDesignator*(x: TypeGuardDesignator);
  186. BEGIN HALT(100) (* abstract *) END VisitTypeGuardDesignator;
  187. PROCEDURE VisitDereferenceDesignator*(x: DereferenceDesignator);
  188. BEGIN HALT(100) (* abstract *) END VisitDereferenceDesignator;
  189. PROCEDURE VisitSupercallDesignator*(x: SupercallDesignator);
  190. BEGIN HALT(100) (* abstract *) END VisitSupercallDesignator;
  191. PROCEDURE VisitSelfDesignator*(x: SelfDesignator);
  192. BEGIN HALT(100) (* abstract *) END VisitSelfDesignator;
  193. PROCEDURE VisitResultDesignator*(x: ResultDesignator);
  194. BEGIN HALT(100) (* abstract *) END VisitResultDesignator;
  195. (** values *)
  196. PROCEDURE VisitValue*(x: Value);
  197. BEGIN HALT(100) (* abstract *) END VisitValue;
  198. PROCEDURE VisitBooleanValue*(x: BooleanValue);
  199. BEGIN HALT(100) (* abstract *) END VisitBooleanValue;
  200. PROCEDURE VisitIntegerValue*(x: IntegerValue);
  201. BEGIN HALT(100) (* abstract *) END VisitIntegerValue;
  202. PROCEDURE VisitCharacterValue*(x: CharacterValue);
  203. BEGIN HALT(100) (* abstract *) END VisitCharacterValue;
  204. PROCEDURE VisitSetValue*(x: SetValue);
  205. BEGIN HALT(100) (* abstract *) END VisitSetValue;
  206. PROCEDURE VisitMathArrayValue*(x: MathArrayValue);
  207. BEGIN HALT(100) (* abstract *) END VisitMathArrayValue;
  208. PROCEDURE VisitRealValue*(x: RealValue);
  209. BEGIN HALT(100) (* abstract *) END VisitRealValue;
  210. PROCEDURE VisitComplexValue*(x: ComplexValue);
  211. BEGIN HALT(100) (* abstract *) END VisitComplexValue;
  212. PROCEDURE VisitStringValue*(x: StringValue);
  213. BEGIN HALT(100) (* abstract *) END VisitStringValue;
  214. PROCEDURE VisitNilValue*(x: NilValue);
  215. BEGIN HALT(100) (* abstract *) END VisitNilValue;
  216. PROCEDURE VisitEnumerationValue*(x: EnumerationValue);
  217. BEGIN HALT(100) (* abstract *) END VisitEnumerationValue;
  218. PROCEDURE VExpression*(x: Expression);
  219. BEGIN
  220. x.Accept(SELF); RETURN;
  221. WITH x:
  222. ResultDesignator DO VisitResultDesignator(x)
  223. | SelfDesignator DO VisitSelfDesignator(x)
  224. | SupercallDesignator DO VisitSupercallDesignator(x)
  225. | DereferenceDesignator DO VisitDereferenceDesignator(x)
  226. | TypeGuardDesignator DO VisitTypeGuardDesignator(x)
  227. | BuiltinCallDesignator DO VisitBuiltinCallDesignator(x)
  228. | StatementDesignator DO VisitStatementDesignator(x)
  229. | ProcedureCallDesignator DO VisitProcedureCallDesignator(x)
  230. | IndexDesignator DO VisitIndexDesignator(x)
  231. | SymbolDesignator DO VisitSymbolDesignator(x)
  232. | BracketDesignator DO VisitBracketDesignator(x)
  233. | ArrowDesignator DO VisitArrowDesignator(x)
  234. | ParameterDesignator DO VisitParameterDesignator(x)
  235. | SelectorDesignator DO VisitSelectorDesignator(x)
  236. | IdentifierDesignator DO VisitIdentifierDesignator(x)
  237. | Designator DO VisitDesignator(x)
  238. | Conversion DO VisitConversion(x)
  239. | TensorRangeExpression DO VisitTensorRangeExpression(x)
  240. | RangeExpression DO VisitRangeExpression(x)
  241. | BinaryExpression DO VisitBinaryExpression(x)
  242. | UnaryExpression DO VisitUnaryExpression(x)
  243. | MathArrayExpression DO VisitMathArrayExpression(x)
  244. | Set DO VisitSet(x)
  245. | BooleanValue DO VisitBooleanValue(x)
  246. | IntegerValue DO VisitIntegerValue(x)
  247. | CharacterValue DO VisitCharacterValue(x)
  248. | SetValue DO VisitSetValue(x)
  249. | MathArrayValue DO VisitMathArrayValue(x)
  250. | RealValue DO VisitRealValue(x)
  251. | ComplexValue DO VisitComplexValue(x)
  252. | StringValue DO VisitStringValue(x)
  253. | NilValue DO VisitNilValue(x)
  254. | EnumerationValue DO VisitEnumerationValue(x);
  255. | Value DO VisitValue(x);
  256. ELSE
  257. VisitExpression(x)
  258. END;
  259. END VExpression;
  260. (** symbols *)
  261. PROCEDURE VisitSymbol*(x: Symbol);
  262. BEGIN HALT(100) (* abstract *) END VisitSymbol;
  263. PROCEDURE VisitModule*(x: Module);
  264. BEGIN HALT(100) (* abstract *) END VisitModule;
  265. PROCEDURE VisitTypeDeclaration*(x: TypeDeclaration);
  266. BEGIN HALT(100) (* abstract *) END VisitTypeDeclaration;
  267. PROCEDURE VisitConstant*(x: Constant);
  268. BEGIN HALT(100) (* abstract *) END VisitConstant;
  269. PROCEDURE VisitVariable*(x: Variable);
  270. BEGIN HALT(100) (* abstract *) END VisitVariable;
  271. PROCEDURE VisitParameter*(x: Parameter);
  272. BEGIN HALT(100) (* abstract *) END VisitParameter;
  273. PROCEDURE VisitProperty*(x: Property);
  274. BEGIN HALT(100) (* abstract *) END VisitProperty;
  275. PROCEDURE VisitProcedure*(x: Procedure);
  276. BEGIN HALT(100) (* abstract *) END VisitProcedure;
  277. PROCEDURE VisitBuiltin*(x: Builtin);
  278. BEGIN HALT(100) (* abstract *) END VisitBuiltin;
  279. PROCEDURE VisitOperator*(x: Operator);
  280. BEGIN HALT(100) (* abstract *) END VisitOperator;
  281. PROCEDURE VisitImport*(x: Import);
  282. BEGIN HALT(100) (* abstract *) END VisitImport;
  283. PROCEDURE VSymbol*(x: Symbol);
  284. BEGIN
  285. x.Accept(SELF); RETURN;
  286. WITH
  287. x: Module DO VisitModule(x)
  288. | TypeDeclaration DO VisitTypeDeclaration(x)
  289. | Constant DO VisitConstant(x)
  290. | Parameter DO VisitParameter(x)
  291. | Property DO VisitProperty(x)
  292. | Variable DO VisitVariable(x)
  293. | Operator DO VisitOperator(x)
  294. | Procedure DO VisitProcedure(x)
  295. | Builtin DO VisitBuiltin(x)
  296. | Import DO VisitImport(x)
  297. ELSE
  298. VisitSymbol(x)
  299. END;
  300. END VSymbol;
  301. (** statements *)
  302. PROCEDURE VisitStatement*(x: Statement);
  303. BEGIN HALT(100) (* abstract *) END VisitStatement;
  304. PROCEDURE VisitProcedureCallStatement*(x: ProcedureCallStatement);
  305. BEGIN HALT(100) (* abstract *) END VisitProcedureCallStatement;
  306. PROCEDURE VisitAssignment*(x: Assignment);
  307. BEGIN HALT(100) (* abstract *) END VisitAssignment;
  308. PROCEDURE VisitCommunicationStatement*(x: CommunicationStatement);
  309. BEGIN HALT(100) (* abstract *) END VisitCommunicationStatement;
  310. PROCEDURE VisitIfStatement*(x: IfStatement);
  311. BEGIN HALT(100) (* abstract *) END VisitIfStatement;
  312. PROCEDURE VisitWithStatement*(x: WithStatement);
  313. BEGIN HALT(100) (* abstract *) END VisitWithStatement;
  314. PROCEDURE VisitCaseStatement*(x: CaseStatement);
  315. BEGIN HALT(100) (* abstract *) END VisitCaseStatement;
  316. PROCEDURE VisitWhileStatement*(x: WhileStatement);
  317. BEGIN HALT(100) (* abstract *) END VisitWhileStatement;
  318. PROCEDURE VisitRepeatStatement*(x: RepeatStatement);
  319. BEGIN HALT(100) (* abstract *) END VisitRepeatStatement;
  320. PROCEDURE VisitForStatement*(x: ForStatement);
  321. BEGIN HALT(100) (* abstract *) END VisitForStatement;
  322. PROCEDURE VisitLoopStatement*(x: LoopStatement);
  323. BEGIN HALT(100) (* abstract *) END VisitLoopStatement;
  324. PROCEDURE VisitExitableBlock*(x: ExitableBlock);
  325. BEGIN HALT(100) (* abstract *) END VisitExitableBlock;
  326. PROCEDURE VisitExitStatement*(x: ExitStatement);
  327. BEGIN HALT(100) (* abstract *) END VisitExitStatement;
  328. PROCEDURE VisitReturnStatement*(x: ReturnStatement);
  329. BEGIN HALT(100) (* abstract *) END VisitReturnStatement;
  330. PROCEDURE VisitAwaitStatement*(x: AwaitStatement);
  331. BEGIN HALT(100) (* abstract *) END VisitAwaitStatement;
  332. PROCEDURE VisitStatementBlock*(x: StatementBlock);
  333. BEGIN HALT(100) (* abstract *) END VisitStatementBlock;
  334. PROCEDURE VisitCode*(x: Code);
  335. BEGIN HALT(100) (* abstract *) END VisitCode;
  336. PROCEDURE VStatement*(x: Statement);
  337. BEGIN
  338. x.Accept(SELF); RETURN;
  339. WITH x:
  340. ProcedureCallStatement DO VisitProcedureCallStatement(x)
  341. | Assignment DO VisitAssignment(x)
  342. | CommunicationStatement DO VisitCommunicationStatement(x)
  343. | IfStatement DO VisitIfStatement(x)
  344. | WithStatement DO VisitWithStatement(x)
  345. | CaseStatement DO VisitCaseStatement(x)
  346. | WhileStatement DO VisitWhileStatement(x)
  347. | RepeatStatement DO VisitRepeatStatement(x)
  348. | ForStatement DO VisitForStatement(x)
  349. | LoopStatement DO VisitLoopStatement(x)
  350. | ExitableBlock DO VisitExitableBlock(x)
  351. | ExitStatement DO VisitExitStatement(x)
  352. | ReturnStatement DO VisitReturnStatement(x)
  353. | AwaitStatement DO VisitAwaitStatement(x)
  354. | StatementBlock DO VisitStatementBlock(x)
  355. | Code DO VisitCode(x)
  356. ELSE VisitStatement(x)
  357. END;
  358. END VStatement;
  359. END Visitor;
  360. ArrayAccessOperators* = RECORD
  361. len*: Operator; (* length operator *)
  362. generalRead*, generalWrite*: Operator; (* operators on ARRAY [*] RANGE, for tensors *)
  363. read*, write*: POINTER TO ARRAY OF Operator; (* fixed-dim. operators *)
  364. END;
  365. FingerPrint*= RECORD
  366. shallow*,public*, private*: LONGINT;
  367. shallowAvailable*, deepAvailable*: BOOLEAN;
  368. END;
  369. (** identifiers in a program text **)
  370. Identifier* = Basic.String;
  371. (** qualified identifiers << Identifier.Identifier >> **)
  372. QualifiedIdentifier* = OBJECT
  373. VAR
  374. prefix-, suffix-: Identifier; (* use string index instead ? *)
  375. position-: Position;
  376. PROCEDURE & InitQualifiedIdentifier( position: Position; prefix, suffix: Identifier);
  377. BEGIN
  378. (* ASSERT(suffix # invalidIdentifier); can happen but should be catched by the parser with error report and not here with trap *)
  379. SELF.position := position;
  380. SELF.prefix := prefix; SELF.suffix := suffix;
  381. END InitQualifiedIdentifier;
  382. PROCEDURE GetName*(VAR name: Basic.SegmentedName);
  383. BEGIN
  384. Basic.InitSegmentedName(name);
  385. IF prefix # invalidIdentifier THEN Basic.SuffixSegmentedName(name, prefix) END;
  386. Basic.SuffixSegmentedName(name, suffix)
  387. END GetName;
  388. END QualifiedIdentifier;
  389. (**** types ****)
  390. (**
  391. Type
  392. BasicType
  393. ObjectType
  394. NilType
  395. AnyType
  396. ByteType
  397. AddressType
  398. SizeType
  399. BooleanType
  400. SetType
  401. CharacterType
  402. RangeType
  403. NumberType
  404. IntegerType
  405. FloatType
  406. ComplexType
  407. QualifiedType
  408. StringType
  409. EnumerationType
  410. ArrayType
  411. MathArrayType
  412. PointerType
  413. PortType
  414. RecordType
  415. CellType
  416. ProcedureType
  417. *)
  418. Type* = OBJECT
  419. VAR
  420. typeDeclaration-: TypeDeclaration; (* link to declaration (if any), needed for printing, debugging and symbol lookup *)
  421. scope-: Scope; (* scope where the type has been declared *)
  422. resolved-: Type; (* indirection to resolved type to preserve qualified types *)
  423. position-,end-: Position;
  424. state-: SET;
  425. hasPointers-: BOOLEAN;
  426. fingerprint-: FingerPrint;
  427. isRealtime-: BOOLEAN;
  428. recursion: BOOLEAN;
  429. sizeInBits-: LONGINT; (* allocation size of this type in bits *)
  430. alignmentInBits-: LONGINT;
  431. PROCEDURE & InitType*( position: Position);
  432. BEGIN
  433. SELF.position := position; state := Undefined;
  434. end := invalidPosition;
  435. typeDeclaration := NIL;
  436. scope := NIL;
  437. resolved := SELF;
  438. sizeInBits := MIN(LONGINT);
  439. alignmentInBits := 0;
  440. isRealtime := FALSE;
  441. recursion := FALSE;
  442. hasPointers := FALSE;
  443. InitFingerPrint(fingerprint);
  444. END InitType;
  445. PROCEDURE SetSize*(sizeInBits: LONGINT);
  446. BEGIN SELF.sizeInBits := sizeInBits
  447. END SetSize;
  448. PROCEDURE SetAlignmentInBits*(alignmentInBits: LONGINT);
  449. BEGIN SELF.alignmentInBits := alignmentInBits
  450. END SetAlignmentInBits;
  451. PROCEDURE End*( position: LONGINT );
  452. BEGIN SELF.position.end := position;
  453. END End;
  454. PROCEDURE SetFingerPrint*(CONST fp: FingerPrint);
  455. BEGIN
  456. SELF.fingerprint := fp
  457. END SetFingerPrint;
  458. PROCEDURE SetState*(state: LONGINT);
  459. BEGIN INCL(SELF.state,state);
  460. END SetState;
  461. PROCEDURE SetHasPointers*(has: BOOLEAN);
  462. BEGIN
  463. hasPointers := has
  464. END SetHasPointers;
  465. PROCEDURE RemoveState*(state: LONGINT);
  466. BEGIN EXCL(SELF.state,state)
  467. END RemoveState;
  468. PROCEDURE SetTypeDeclaration*(typeDeclaration: TypeDeclaration);
  469. BEGIN SELF.typeDeclaration := typeDeclaration
  470. END SetTypeDeclaration;
  471. PROCEDURE SetScope*(scope: Scope);
  472. BEGIN SELF.scope := scope
  473. END SetScope;
  474. PROCEDURE SetRealtime*(isRealtime: BOOLEAN);
  475. BEGIN SELF.isRealtime := isRealtime
  476. END SetRealtime;
  477. PROCEDURE SameType*(this: Type): BOOLEAN;
  478. BEGIN RETURN FALSE
  479. END SameType;
  480. (** assignment compatibility of this := SELF *)
  481. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  482. BEGIN RETURN FALSE
  483. END CompatibleTo;
  484. (** Returns if the type is a pointer *)
  485. PROCEDURE IsPointer*(): BOOLEAN;
  486. BEGIN RETURN FALSE
  487. END IsPointer;
  488. (** Returns if the type consists of more than one parts. Implies that an instance of this type cannot be (easily) represented in one register. *)
  489. PROCEDURE IsComposite*(): BOOLEAN;
  490. BEGIN RETURN FALSE
  491. END IsComposite;
  492. (** Returns if the type needs to be traced for garbage collection *)
  493. PROCEDURE NeedsTrace*(): BOOLEAN;
  494. BEGIN RETURN IsPointer ();
  495. END NeedsTrace;
  496. PROCEDURE Accept*(v: Visitor);
  497. VAR position: LONGINT;
  498. BEGIN position := SELF.position.start; v.VisitType(SELF)
  499. END Accept;
  500. PROCEDURE IsRecordType*(): BOOLEAN;
  501. BEGIN
  502. RETURN FALSE;
  503. END IsRecordType;
  504. END Type;
  505. (* basic types, defined in global name space *)
  506. BasicType*= OBJECT(Type)
  507. VAR name-: Identifier;
  508. PROCEDURE & InitBasicType(CONST id: ARRAY OF CHAR; sizeInBits: LONGINT);
  509. VAR str: IdentifierString;
  510. BEGIN
  511. COPY(id, str);Basic.AppendNumber(str,sizeInBits); name := NewIdentifier(str);
  512. InitType(invalidPosition);
  513. SetSize(sizeInBits);
  514. SELF.name := name
  515. END InitBasicType;
  516. PROCEDURE SetName*(CONST id: ARRAY OF CHAR);
  517. BEGIN
  518. name := NewIdentifier(id);
  519. END SetName;
  520. PROCEDURE SetTypeDeclaration*(typeDeclaration: TypeDeclaration);
  521. BEGIN HALT(100);
  522. END SetTypeDeclaration;
  523. PROCEDURE Accept*(v: Visitor);
  524. VAR position: LONGINT;
  525. BEGIN position := SELF.position.start; v.VisitBasicType(SELF)
  526. END Accept;
  527. END BasicType;
  528. (** <<OBJECT>>
  529. object type (base type of all objects)
  530. **)
  531. ObjectType*=OBJECT(BasicType)
  532. PROCEDURE & InitObjectType(sizeInBits: LONGINT);
  533. BEGIN
  534. InitBasicType("@Object",sizeInBits);
  535. hasPointers := TRUE;
  536. END InitObjectType;
  537. PROCEDURE SameType*(this: Type): BOOLEAN;
  538. BEGIN RETURN (this IS ObjectType)
  539. END SameType;
  540. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  541. BEGIN RETURN ((to IS AnyType) OR (to IS ObjectType))
  542. END CompatibleTo;
  543. PROCEDURE Accept*(v: Visitor);
  544. VAR position: LONGINT;
  545. BEGIN position := SELF.position.start; v.VisitObjectType(SELF)
  546. END Accept;
  547. PROCEDURE IsPointer*(): BOOLEAN;
  548. BEGIN RETURN TRUE
  549. END IsPointer;
  550. END ObjectType;
  551. (** <<NIL>>
  552. nil type (type of NIL pointers), may be replaced by any type
  553. **)
  554. NilType*=OBJECT(BasicType)
  555. PROCEDURE & InitNilType(sizeInBits: LONGINT);
  556. BEGIN
  557. InitBasicType("@Nil",sizeInBits);
  558. SetRealtime(TRUE);
  559. hasPointers := TRUE;
  560. END InitNilType;
  561. PROCEDURE SameType*(this: Type): BOOLEAN;
  562. BEGIN RETURN (this IS NilType)
  563. END SameType;
  564. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  565. BEGIN RETURN (to IS NilType) OR (to IS ObjectType) OR (to IS AnyType) OR (to IS PointerType) OR (to IS ProcedureType) OR (to IS AddressType)
  566. END CompatibleTo;
  567. PROCEDURE IsPointer*(): BOOLEAN;
  568. BEGIN RETURN TRUE
  569. END IsPointer;
  570. PROCEDURE Accept*(v: Visitor);
  571. VAR position: LONGINT;
  572. BEGIN position := SELF.position.start; v.VisitNilType(SELF)
  573. END Accept;
  574. END NilType;
  575. (** <<SYSTEM.BYTE>>
  576. any pointer type (pointer to record and pointer to array)
  577. **)
  578. AnyType*=OBJECT(BasicType)
  579. PROCEDURE & InitAnyType(sizeInBits: LONGINT);
  580. BEGIN
  581. InitBasicType("@Any",sizeInBits);
  582. hasPointers := TRUE;
  583. END InitAnyType;
  584. PROCEDURE SameType*(this: Type): BOOLEAN;
  585. BEGIN RETURN this IS AnyType
  586. END SameType;
  587. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  588. BEGIN RETURN (to IS AnyType)
  589. END CompatibleTo;
  590. PROCEDURE IsPointer*(): BOOLEAN;
  591. BEGIN RETURN TRUE
  592. END IsPointer;
  593. PROCEDURE Accept*(v: Visitor);
  594. VAR position: LONGINT;
  595. BEGIN position := SELF.position.start; v.VisitAnyType(SELF)
  596. END Accept;
  597. END AnyType;
  598. (** <<SYSTEM.BYTE>>
  599. byte type
  600. **)
  601. ByteType*=OBJECT(BasicType)
  602. PROCEDURE & InitByteType(sizeInBits: LONGINT);
  603. BEGIN
  604. InitBasicType("@Byte",sizeInBits);
  605. SetRealtime(TRUE);
  606. END InitByteType;
  607. PROCEDURE Accept*(v: Visitor);
  608. VAR position: LONGINT;
  609. BEGIN position := SELF.position.start; v.VisitByteType(SELF)
  610. END Accept;
  611. PROCEDURE SameType*(this: Type): BOOLEAN;
  612. BEGIN RETURN this IS ByteType
  613. END SameType;
  614. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  615. BEGIN RETURN (to IS ByteType)
  616. END CompatibleTo;
  617. END ByteType;
  618. (** <<ADDRESS>>
  619. address type
  620. **)
  621. AddressType*=OBJECT(BasicType)
  622. PROCEDURE & InitAddressType(sizeInBits: LONGINT);
  623. BEGIN
  624. InitBasicType("@Address",sizeInBits);
  625. SetRealtime(TRUE);
  626. END InitAddressType;
  627. PROCEDURE SameType*(this: Type): BOOLEAN;
  628. BEGIN RETURN (this IS AddressType)
  629. END SameType;
  630. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  631. BEGIN RETURN (to IS AddressType) OR (to IS SizeType) OR (to IS IntegerType) & (to.sizeInBits >= sizeInBits) OR (to IS PointerType) & to(PointerType).isUnsafe
  632. END CompatibleTo;
  633. PROCEDURE Accept*(v: Visitor);
  634. VAR position: LONGINT;
  635. BEGIN position := SELF.position.start; v.VisitAddressType(SELF)
  636. END Accept;
  637. END AddressType;
  638. (** <<SIZE>>
  639. size type (signed address type)
  640. **)
  641. SizeType*=OBJECT(BasicType)
  642. PROCEDURE & InitSizeType(sizeInBits: LONGINT);
  643. BEGIN
  644. InitBasicType("@Size",sizeInBits);
  645. SetRealtime(TRUE);
  646. END InitSizeType;
  647. PROCEDURE SameType*(this: Type): BOOLEAN;
  648. BEGIN RETURN (this IS SizeType)
  649. END SameType;
  650. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  651. BEGIN RETURN (to IS SizeType) OR (to IS AddressType) OR (to IS IntegerType) & (to.sizeInBits >= sizeInBits)
  652. END CompatibleTo;
  653. PROCEDURE Accept*(v: Visitor);
  654. VAR position: LONGINT;
  655. BEGIN position := SELF.position.start; v.VisitSizeType(SELF)
  656. END Accept;
  657. END SizeType;
  658. (** <<BOOLEAN>>
  659. boolean type
  660. **)
  661. BooleanType*=OBJECT(BasicType)
  662. PROCEDURE & InitBooleanType(sizeInBits: LONGINT);
  663. BEGIN
  664. InitBasicType("@Boolean",sizeInBits);
  665. SetRealtime(TRUE);
  666. END InitBooleanType;
  667. PROCEDURE SameType*(this: Type): BOOLEAN;
  668. BEGIN RETURN this IS BooleanType
  669. END SameType;
  670. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  671. BEGIN RETURN (to IS BooleanType)
  672. END CompatibleTo;
  673. PROCEDURE Accept*(v: Visitor);
  674. VAR position: LONGINT;
  675. BEGIN position := SELF.position.start; v.VisitBooleanType(SELF)
  676. END Accept;
  677. END BooleanType;
  678. (** <<SET>>
  679. set type
  680. **)
  681. SetType*=OBJECT(BasicType)
  682. PROCEDURE & InitSetType(sizeInBits: LONGINT);
  683. BEGIN
  684. InitBasicType("@Set",sizeInBits);
  685. SetRealtime(TRUE);
  686. END InitSetType;
  687. PROCEDURE SameType*(this: Type): BOOLEAN;
  688. BEGIN RETURN (this = SELF) OR (this IS SetType) & (this.sizeInBits = sizeInBits);
  689. END SameType;
  690. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  691. BEGIN RETURN (to IS SetType) & (to.sizeInBits >= sizeInBits)
  692. END CompatibleTo;
  693. PROCEDURE Accept*(v: Visitor);
  694. VAR position: LONGINT;
  695. BEGIN position := SELF.position.start; v.VisitSetType(SELF)
  696. END Accept;
  697. END SetType;
  698. (** <<CHAR, CHAR8, CHAR16, CHAR32>>
  699. character types
  700. **)
  701. CharacterType*=OBJECT(BasicType)
  702. PROCEDURE & InitCharacterType(sizeInBits: LONGINT);
  703. BEGIN
  704. InitBasicType("@Character", sizeInBits);
  705. SetRealtime(TRUE);
  706. END InitCharacterType;
  707. PROCEDURE SameType*(this: Type): BOOLEAN;
  708. BEGIN RETURN (this = SELF) OR (this IS CharacterType) & (this.sizeInBits = sizeInBits)
  709. END SameType;
  710. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  711. BEGIN RETURN ((to IS CharacterType) OR (to IS ByteType)) & (to.sizeInBits >= sizeInBits)
  712. END CompatibleTo;
  713. PROCEDURE Accept*(v: Visitor);
  714. VAR position: LONGINT;
  715. BEGIN position := SELF.position.start; v.VisitCharacterType(SELF)
  716. END Accept;
  717. END CharacterType;
  718. (** type of ranges (case constants, set elements, array indices)
  719. represented by basic type <<RANGE>>
  720. **)
  721. RangeType* = OBJECT(BasicType)
  722. PROCEDURE & InitRangeType(sizeInBits: LONGINT);
  723. BEGIN
  724. InitBasicType("@RangeType",sizeInBits);
  725. SetRealtime(TRUE);
  726. END InitRangeType;
  727. PROCEDURE SameType*(this: Type): BOOLEAN;
  728. BEGIN RETURN (this = SELF) OR (this IS RangeType)
  729. END SameType;
  730. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  731. BEGIN RETURN SameType(to)
  732. END CompatibleTo;
  733. PROCEDURE IsComposite*(): BOOLEAN;
  734. BEGIN RETURN TRUE
  735. END IsComposite;
  736. PROCEDURE Accept*(v: Visitor);
  737. VAR position: LONGINT;
  738. BEGIN position := SELF.position.start; v.VisitRangeType(SELF)
  739. END Accept;
  740. END RangeType;
  741. (* number types: IntegerType or FloatType *)
  742. NumberType*=OBJECT(BasicType)
  743. PROCEDURE & InitNumberType( CONST name: ARRAY OF CHAR; sizeInBits: LONGINT);
  744. BEGIN
  745. InitBasicType(name, sizeInBits);
  746. SetRealtime(TRUE);
  747. END InitNumberType;
  748. END NumberType;
  749. (** <<SHORTINT, INTEGER, LONGINT, HUGEINT>>
  750. integer types
  751. **)
  752. IntegerType*= OBJECT (NumberType)
  753. VAR signed-: BOOLEAN;
  754. PROCEDURE & InitIntegerType(sizeInBits: LONGINT; signed: BOOLEAN);
  755. BEGIN
  756. IF signed THEN
  757. InitNumberType("@Integer",sizeInBits);
  758. ELSE
  759. InitNumberType("@Unsigned",sizeInBits);
  760. END;
  761. SELF.signed := signed;
  762. END InitIntegerType;
  763. PROCEDURE SameType*(this: Type): BOOLEAN;
  764. BEGIN RETURN (this = SELF) OR (this IS IntegerType) & (this.sizeInBits = sizeInBits) & (this(IntegerType).signed = signed)
  765. END SameType;
  766. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  767. BEGIN RETURN ((to IS IntegerType) OR (to IS AddressType) OR (to IS SizeType) OR (to IS ByteType)) & (to.sizeInBits >= sizeInBits) OR (to IS FloatType)
  768. OR (to IS ComplexType) & CompatibleTo((to(ComplexType).componentType))
  769. END CompatibleTo;
  770. PROCEDURE Accept*(v: Visitor);
  771. VAR position: LONGINT;
  772. BEGIN position := SELF.position.start; v.VisitIntegerType(SELF)
  773. END Accept;
  774. END IntegerType;
  775. (** <<REAL,LONGREAL>>
  776. real types: REAL, LONGREAL
  777. **)
  778. FloatType*= OBJECT (NumberType)
  779. PROCEDURE & InitFloatType(sizeInBits: LONGINT);
  780. BEGIN
  781. InitNumberType("@Float",sizeInBits);
  782. END InitFloatType;
  783. PROCEDURE SameType*(this: Type): BOOLEAN;
  784. BEGIN RETURN (this = SELF) OR (this IS FloatType) & (this.sizeInBits = sizeInBits)
  785. END SameType;
  786. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  787. BEGIN
  788. RETURN (to IS FloatType) & (to.sizeInBits >= sizeInBits)
  789. OR (to IS ComplexType) & CompatibleTo((to(ComplexType).componentType))
  790. END CompatibleTo;
  791. PROCEDURE Accept*(v: Visitor);
  792. VAR position: LONGINT;
  793. BEGIN position := SELF.position.start; v.VisitFloatType(SELF)
  794. END Accept;
  795. END FloatType;
  796. (** <<COMPLEX,LONGCOMPLEX>>
  797. complex types: COMPLEX, LONGCOMPLEX
  798. **)
  799. ComplexType*= OBJECT (NumberType)
  800. VAR componentType-: Type; (* REAL or LONGREAL*)
  801. PROCEDURE & InitComplexType(componentType: Type);
  802. BEGIN
  803. ASSERT(componentType # NIL);
  804. SELF.componentType := componentType;
  805. sizeInBits := 2 * componentType.sizeInBits;
  806. InitNumberType("@Complex",sizeInBits);
  807. END InitComplexType;
  808. PROCEDURE SameType*(this: Type): BOOLEAN;
  809. BEGIN RETURN (this = SELF) OR (this IS ComplexType) & (componentType.SameType(this(ComplexType).componentType))
  810. END SameType;
  811. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  812. BEGIN RETURN (to IS ComplexType) & (componentType.CompatibleTo(to(ComplexType).componentType))
  813. END CompatibleTo;
  814. PROCEDURE IsComposite*(): BOOLEAN;
  815. BEGIN RETURN TRUE
  816. END IsComposite;
  817. PROCEDURE Accept*(v: Visitor);
  818. VAR position: LONGINT;
  819. BEGIN position := SELF.position.start; v.VisitComplexType(SELF)
  820. END Accept;
  821. END ComplexType;
  822. (** <<qualifiedIdentifier = resolved>>
  823. named reference to a type
  824. **)
  825. QualifiedType* = OBJECT (Type)
  826. VAR
  827. qualifiedIdentifier-: QualifiedIdentifier;
  828. PROCEDURE & InitQualifiedType( position: Position; scope: Scope; qualifiedIdentifier: QualifiedIdentifier);
  829. BEGIN
  830. ASSERT(qualifiedIdentifier # NIL);
  831. InitType( position);
  832. SELF.scope := scope;
  833. SELF.qualifiedIdentifier := qualifiedIdentifier;
  834. resolved := NIL;
  835. END InitQualifiedType;
  836. PROCEDURE SetResolved*(resolved: Type);
  837. BEGIN SELF.resolved := resolved; IF resolved # NIL THEN hasPointers := resolved.hasPointers END;
  838. END SetResolved;
  839. PROCEDURE SameType*(this: Type): BOOLEAN;
  840. BEGIN RETURN (this = SELF) OR (resolved # NIL) & (this.resolved # NIL) & resolved.SameType(this.resolved)
  841. END SameType;
  842. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  843. BEGIN RETURN (resolved # NIL) & resolved.CompatibleTo(to)
  844. END CompatibleTo;
  845. PROCEDURE IsPointer*(): BOOLEAN;
  846. BEGIN RETURN (resolved # NIL) & resolved.IsPointer()
  847. END IsPointer;
  848. PROCEDURE IsComposite*(): BOOLEAN;
  849. BEGIN RETURN (resolved # NIL) & resolved.IsComposite()
  850. END IsComposite;
  851. PROCEDURE Accept*(v: Visitor);
  852. VAR position: LONGINT;
  853. BEGIN position := SELF.position.start; v.VisitQualifiedType(SELF)
  854. END Accept;
  855. PROCEDURE NeedsTrace* (): BOOLEAN;
  856. BEGIN RETURN (resolved # NIL) & (resolved.NeedsTrace());
  857. END NeedsTrace;
  858. PROCEDURE IsRecordType*(): BOOLEAN;
  859. BEGIN
  860. RETURN (resolved # NIL) & (resolved.IsRecordType());
  861. END IsRecordType;
  862. END QualifiedType;
  863. (** string literal type **)
  864. StringType*= OBJECT(Type)
  865. VAR
  866. length-: LONGINT;
  867. baseType-: Type;
  868. PROCEDURE & InitStringType(position: Position; baseType: Type; length: LONGINT);
  869. BEGIN
  870. InitType(position);
  871. SetRealtime(TRUE);
  872. SELF.length := length;
  873. SELF.baseType := baseType;
  874. END InitStringType;
  875. PROCEDURE SetLength*(length: LONGINT);
  876. BEGIN SELF.length := length
  877. END SetLength;
  878. PROCEDURE SameType*(this: Type): BOOLEAN;
  879. BEGIN RETURN (this IS StringType) & (this(StringType).length = length)
  880. END SameType;
  881. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  882. BEGIN
  883. IF to IS ArrayType THEN
  884. WITH to: ArrayType DO
  885. RETURN to.arrayBase.SameType(baseType.resolved) & ((to.form = Open) OR (to.staticLength >= length))
  886. END;
  887. ELSIF to IS CharacterType THEN
  888. RETURN (length=2) & baseType.CompatibleTo(to)
  889. ELSE RETURN FALSE
  890. END;
  891. END CompatibleTo;
  892. PROCEDURE IsComposite*(): BOOLEAN;
  893. BEGIN RETURN TRUE
  894. END IsComposite;
  895. PROCEDURE Accept*(v: Visitor);
  896. VAR position: LONGINT;
  897. BEGIN position := SELF.position.start; v.VisitStringType(SELF)
  898. END Accept;
  899. END StringType;
  900. (** enumeration type of the form <<enum (base) red,green,blue end>> **)
  901. EnumerationType*=OBJECT(Type)
  902. VAR
  903. enumerationScope-: EnumerationScope;
  904. enumerationBase-: Type;
  905. rangeLowest-,rangeHighest-: Basic.Integer;
  906. PROCEDURE &InitEnumerationType(position: Position; scope: Scope; enumerationScope: EnumerationScope);
  907. BEGIN
  908. InitType(position);
  909. SetRealtime(TRUE);
  910. SELF.scope := scope;
  911. enumerationBase := NIL;
  912. rangeLowest := 0; rangeHighest := 0;
  913. SELF.enumerationScope := enumerationScope;
  914. enumerationScope.ownerEnumeration := SELF;
  915. END InitEnumerationType;
  916. PROCEDURE SetEnumerationBase*(base: Type);
  917. BEGIN enumerationBase := base
  918. END SetEnumerationBase;
  919. PROCEDURE SetRange*(lowest,highest: Basic.Integer);
  920. BEGIN rangeLowest := lowest; rangeHighest := highest;
  921. END SetRange;
  922. PROCEDURE Extends*(this: EnumerationType): BOOLEAN;
  923. BEGIN RETURN (SELF = this) OR (enumerationBase # NIL) & (enumerationBase.resolved(EnumerationType).Extends(this));
  924. END Extends;
  925. PROCEDURE SameType*(this: Type): BOOLEAN;
  926. BEGIN RETURN this = SELF
  927. END SameType;
  928. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  929. BEGIN RETURN (to IS EnumerationType) & (to(EnumerationType).Extends(SELF))
  930. END CompatibleTo;
  931. PROCEDURE Accept*(v: Visitor);
  932. VAR position: LONGINT;
  933. BEGIN position := SELF.position.start; v.VisitEnumerationType(SELF)
  934. END Accept;
  935. END EnumerationType;
  936. (** <<ARRAY [length] OF baseType>> *)
  937. ArrayType* = OBJECT (Type)
  938. VAR
  939. arrayBase-: Type;
  940. length-: Expression;
  941. staticLength-: LONGINT;
  942. form-: LONGINT; (* redundant: (form = Open) = (staticLength = 0) else (form = Static) *)
  943. PROCEDURE & InitArrayType(position: Position; scope: Scope; form: LONGINT);
  944. BEGIN
  945. length := NIL; arrayBase := NIL; InitType(position); staticLength := 0; SELF.form := form; SELF.scope := scope;
  946. END InitArrayType;
  947. PROCEDURE SetArrayBase*( type: Type );
  948. BEGIN
  949. arrayBase := type; IF (arrayBase # NIL) & (arrayBase.hasPointers) THEN SetHasPointers(TRUE) END;
  950. END SetArrayBase;
  951. PROCEDURE SetForm*(f: LONGINT);
  952. BEGIN
  953. form := f;
  954. END SetForm;
  955. PROCEDURE SetLength*(length: Expression);
  956. BEGIN
  957. SELF.length := length;
  958. IF (length.resolved # NIL) & (length.resolved IS IntegerValue) THEN
  959. staticLength := LONGINT (length.resolved(IntegerValue).value) (* TODO: staticLength should be of type Basic.Integer too *)
  960. END;
  961. END SetLength;
  962. PROCEDURE Child*(nr: LONGINT):Type;
  963. BEGIN
  964. IF nr = 0 THEN RETURN SELF;
  965. ELSIF nr = 1 THEN RETURN arrayBase.resolved;
  966. ELSE RETURN arrayBase.resolved(ArrayType).Child(nr-1);
  967. END;
  968. END Child;
  969. (* recursion safety for cases such as
  970. A= POINTER TO ARRAY OF B;
  971. B= POINTER TO ARRAY OF A;
  972. *)
  973. PROCEDURE SameType*(this: Type): BOOLEAN;
  974. VAR result : BOOLEAN;
  975. BEGIN
  976. result := FALSE;
  977. IF this = SELF THEN
  978. result := TRUE
  979. ELSIF recursion THEN
  980. result := TRUE;
  981. ELSIF this IS ArrayType THEN
  982. recursion := TRUE;
  983. WITH this: ArrayType DO
  984. result := (this.form = form) & (this.staticLength = staticLength) & arrayBase.SameType(this.arrayBase.resolved);
  985. END;
  986. END;
  987. recursion := FALSE;
  988. RETURN result
  989. END SameType;
  990. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  991. BEGIN
  992. RETURN (form = Static) & SameType(to)
  993. END CompatibleTo;
  994. PROCEDURE IsComposite*(): BOOLEAN;
  995. BEGIN RETURN TRUE
  996. END IsComposite;
  997. PROCEDURE NeedsTrace*(): BOOLEAN;
  998. BEGIN RETURN arrayBase.resolved.NeedsTrace ();
  999. END NeedsTrace;
  1000. PROCEDURE Accept*(v: Visitor);
  1001. VAR position: LONGINT;
  1002. BEGIN position := SELF.position.start; v.VisitArrayType(SELF)
  1003. END Accept;
  1004. END ArrayType;
  1005. (** <<ARRAY '[' length | '*' | '?' ']' OF baseType>> **)
  1006. MathArrayType* = OBJECT (Type)
  1007. VAR
  1008. modifiers-: Modifier; (* set by the parser *)
  1009. arrayBase-: Type;
  1010. length-: Expression;
  1011. staticLength-: LONGINT;
  1012. staticIncrementInBits-: LONGINT;
  1013. form-: LONGINT;
  1014. isUnsafe-: BOOLEAN;
  1015. PROCEDURE & InitMathArrayType(position: Position;scope: Scope; form: LONGINT);
  1016. BEGIN
  1017. length := NIL; arrayBase := NIL; InitType(position); staticLength := 0; staticIncrementInBits := 0; SetForm(form); SELF.scope := scope; isUnsafe := FALSE; modifiers := NIL;
  1018. END InitMathArrayType;
  1019. PROCEDURE SetModifiers*(m: Modifier);
  1020. BEGIN
  1021. modifiers := m;
  1022. END SetModifiers;
  1023. PROCEDURE SetUnsafe*(unsafe: BOOLEAN);
  1024. BEGIN
  1025. isUnsafe := unsafe;
  1026. END SetUnsafe;
  1027. PROCEDURE SetForm*(form: LONGINT);
  1028. BEGIN
  1029. SELF.form := form; IF form # Static THEN SetHasPointers(TRUE) END;
  1030. END SetForm;
  1031. PROCEDURE SetArrayBase*( type: Type );
  1032. BEGIN
  1033. arrayBase := type; IF (arrayBase # NIL) & (arrayBase.hasPointers) THEN SetHasPointers(TRUE) END;
  1034. END SetArrayBase;
  1035. PROCEDURE SetLength*(length: Expression);
  1036. BEGIN
  1037. SELF.length := length;
  1038. IF (length # NIL) & (length.resolved # NIL) & (length.resolved IS IntegerValue) THEN
  1039. staticLength := LONGINT (length.resolved(IntegerValue).value); (* TODO: staticLength should be of type Basic.Integer too *)
  1040. (* optimization: unless the base type is a dynamic array, make this array static *)
  1041. IF ~((arrayBase # NIL) & (arrayBase IS MathArrayType) & (arrayBase(MathArrayType).form # Static)) THEN
  1042. form := Static;
  1043. END
  1044. ELSIF length = NIL THEN
  1045. form := Open;
  1046. END;
  1047. END SetLength;
  1048. PROCEDURE SetIncrement*(increment: LONGINT);
  1049. BEGIN staticIncrementInBits := increment
  1050. END SetIncrement;
  1051. (* recursion safety for cases such as
  1052. A= POINTER TO ARRAY OF B;
  1053. B= POINTER TO ARRAY OF A;
  1054. *)
  1055. PROCEDURE SameType*(this: Type): BOOLEAN;
  1056. VAR result: BOOLEAN;
  1057. BEGIN
  1058. result := FALSE;
  1059. IF this = SELF THEN
  1060. result := TRUE
  1061. ELSIF recursion THEN
  1062. result := TRUE;
  1063. ELSIF this IS MathArrayType THEN
  1064. recursion := TRUE;
  1065. WITH this: MathArrayType DO
  1066. result := (this.form = form) & (this.staticLength = staticLength) &
  1067. ((arrayBase = NIL) & (this.arrayBase = NIL) OR (arrayBase # NIL) & (this.arrayBase # NIL) &
  1068. arrayBase.SameType(this.arrayBase.resolved));
  1069. END;
  1070. END;
  1071. recursion := FALSE;
  1072. RETURN result
  1073. END SameType;
  1074. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  1075. BEGIN
  1076. HALT(200); (*! implement *)
  1077. RETURN (form = Static) & SameType(to)
  1078. END CompatibleTo;
  1079. (** get the element type of a math array, i.e. the first type in the math array chain that is not a math array **)
  1080. PROCEDURE ElementType*(): Type;
  1081. VAR
  1082. type: Type;
  1083. BEGIN
  1084. type := SELF;
  1085. WHILE type IS MathArrayType DO
  1086. type := type(MathArrayType).arrayBase.resolved
  1087. END;
  1088. RETURN type
  1089. END ElementType;
  1090. (** get the number of dimensions of a math array; 0 in case of tensors **)
  1091. PROCEDURE Dimensionality*(): LONGINT;
  1092. VAR
  1093. type: Type;
  1094. dim: LONGINT;
  1095. BEGIN
  1096. IF form = Tensor THEN
  1097. dim := 0
  1098. ELSE
  1099. type := SELF;
  1100. dim := 0;
  1101. WHILE type IS MathArrayType DO
  1102. ASSERT(type(MathArrayType).form # Tensor);
  1103. INC(dim);
  1104. type := type(MathArrayType).arrayBase.resolved
  1105. END
  1106. END;
  1107. RETURN dim
  1108. END Dimensionality;
  1109. (** if the math array is of the form ARRAY [*, *, ..., *], i.e. contains no static length and is not a tensor either **)
  1110. PROCEDURE IsFullyDynamic*(): BOOLEAN;
  1111. VAR
  1112. type: Type;
  1113. result: BOOLEAN;
  1114. BEGIN
  1115. IF form = Tensor THEN
  1116. result := FALSE;
  1117. ELSE
  1118. result := TRUE;
  1119. type := SELF;
  1120. WHILE type IS MathArrayType DO
  1121. IF type(MathArrayType).form # Open THEN result := FALSE END;
  1122. type := type(MathArrayType).arrayBase.resolved
  1123. END
  1124. END;
  1125. RETURN result
  1126. END IsFullyDynamic;
  1127. PROCEDURE NeedsTrace*(): BOOLEAN;
  1128. BEGIN RETURN hasPointers OR (arrayBase # NIL) & (arrayBase.resolved.NeedsTrace());
  1129. END NeedsTrace;
  1130. PROCEDURE IsComposite*(): BOOLEAN;
  1131. BEGIN RETURN TRUE
  1132. END IsComposite;
  1133. PROCEDURE Accept*(v: Visitor);
  1134. VAR position: LONGINT;
  1135. BEGIN position := SELF.position.start; v.VisitMathArrayType(SELF)
  1136. END Accept;
  1137. END MathArrayType;
  1138. (** <<POINTER TO pointerBase>> **)
  1139. PointerType* = OBJECT (Type)
  1140. VAR
  1141. modifiers-: Modifier; (* set by the parser *)
  1142. pointerBase-: Type;
  1143. isPlain-: BOOLEAN;
  1144. isUnsafe-: BOOLEAN;
  1145. isUntraced-: BOOLEAN;
  1146. isDisposable-: BOOLEAN;
  1147. isHidden-: BOOLEAN;
  1148. PROCEDURE & InitPointerType(position: Position; scope: Scope);
  1149. BEGIN
  1150. modifiers := NIL;
  1151. pointerBase := NIL;
  1152. isPlain := FALSE;
  1153. isUnsafe := FALSE;
  1154. isDisposable := FALSE;
  1155. InitType(position);
  1156. SELF.scope := scope;
  1157. hasPointers := TRUE;
  1158. isHidden := FALSE;
  1159. isUntraced := FALSE;
  1160. END InitPointerType;
  1161. PROCEDURE SetHidden*(hidden: BOOLEAN);
  1162. BEGIN
  1163. isHidden := hidden;
  1164. END SetHidden; (** <<POINTER TO pointerBase>> **)
  1165. PROCEDURE SetModifiers*(flags: Modifier);
  1166. BEGIN modifiers := flags
  1167. END SetModifiers;
  1168. PROCEDURE SetPointerBase*( type: Type );
  1169. BEGIN
  1170. pointerBase := type;
  1171. END SetPointerBase;
  1172. PROCEDURE SetPlain*(plain: BOOLEAN);
  1173. BEGIN
  1174. isPlain := plain;
  1175. END SetPlain;
  1176. PROCEDURE SetUnsafe*(unsafe: BOOLEAN);
  1177. BEGIN
  1178. isUnsafe := unsafe;
  1179. END SetUnsafe;
  1180. PROCEDURE SetUntraced*(untraced: BOOLEAN);
  1181. BEGIN
  1182. isUntraced := untraced;
  1183. END SetUntraced;
  1184. PROCEDURE SetDisposable*(disposable: BOOLEAN);
  1185. BEGIN
  1186. isDisposable := disposable;
  1187. END SetDisposable;
  1188. PROCEDURE Extends*(this: Type): BOOLEAN;
  1189. VAR result: BOOLEAN; extension, base: Type;
  1190. BEGIN
  1191. result := FALSE;
  1192. IF ((this IS ObjectType) OR (this IS AnyType)) & (pointerBase.resolved IS RecordType) THEN result := TRUE
  1193. ELSE
  1194. extension := pointerBase.resolved;
  1195. IF this IS PointerType THEN
  1196. base := this(PointerType).pointerBase.resolved;
  1197. ELSIF this IS RecordType THEN
  1198. base := this
  1199. ELSE base := NIL
  1200. END;
  1201. IF (extension IS RecordType) & (base # NIL) THEN
  1202. result := extension(RecordType).Extends(base)
  1203. END;
  1204. END;
  1205. RETURN result
  1206. END Extends;
  1207. PROCEDURE SameType*(this: Type): BOOLEAN;
  1208. BEGIN RETURN (SELF = this) OR (this IS PointerType) & (this(PointerType).pointerBase.SameType(pointerBase.resolved) & (this(PointerType).isUnsafe = isUnsafe))
  1209. END SameType;
  1210. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  1211. BEGIN RETURN SameType(to) OR ~(to IS RecordType) & SELF.Extends(to)
  1212. END CompatibleTo;
  1213. PROCEDURE IsPointer*(): BOOLEAN;
  1214. BEGIN RETURN TRUE
  1215. END IsPointer;
  1216. PROCEDURE NeedsTrace*(): BOOLEAN;
  1217. BEGIN RETURN ~isUntraced;
  1218. END NeedsTrace;
  1219. PROCEDURE Accept*(v: Visitor);
  1220. VAR position: LONGINT;
  1221. BEGIN position := SELF.position.start; v.VisitPointerType(SELF)
  1222. END Accept;
  1223. END PointerType;
  1224. (** << PORT (IN | OUT) [(size)] >>**)
  1225. PortType* = OBJECT (Type)
  1226. VAR
  1227. direction-: LONGINT;
  1228. sizeExpression-: Expression; (* generated by parser *)
  1229. sizeInBits-: LONGINT; (* computed by checker *)
  1230. cellsAreObjects-: BOOLEAN;
  1231. PROCEDURE & InitPortType(position: Position; direction: LONGINT; sizeExpression: Expression; scope: Scope);
  1232. BEGIN
  1233. InitType(position);
  1234. SELF.sizeExpression := sizeExpression;
  1235. SELF.direction := direction;
  1236. SELF.scope := scope;
  1237. cellsAreObjects := FALSE;
  1238. END InitPortType;
  1239. PROCEDURE SetSize*(size: LONGINT);
  1240. BEGIN sizeInBits := size
  1241. END SetSize;
  1242. PROCEDURE SetSizeExpression*(sizeExpression: Expression);
  1243. BEGIN SELF.sizeExpression := sizeExpression
  1244. END SetSizeExpression;
  1245. PROCEDURE SetCellsAreObjects*(b: BOOLEAN);
  1246. BEGIN
  1247. cellsAreObjects := b;
  1248. hasPointers := b;
  1249. END SetCellsAreObjects;
  1250. PROCEDURE SameType*(this: Type): BOOLEAN;
  1251. BEGIN RETURN (this IS PortType) & (this(PortType).direction = direction) & (this(PortType).sizeInBits = sizeInBits)
  1252. END SameType;
  1253. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  1254. BEGIN RETURN SameType(to)
  1255. END CompatibleTo;
  1256. PROCEDURE IsPointer*(): BOOLEAN;
  1257. BEGIN RETURN cellsAreObjects;
  1258. END IsPointer;
  1259. PROCEDURE Accept*(v: Visitor);
  1260. VAR position: LONGINT;
  1261. BEGIN position := SELF.position.start; v.VisitPortType(SELF)
  1262. END Accept;
  1263. END PortType;
  1264. (** << recordType =
  1265. [POINTER TO] RECORD (baseType) .. END |
  1266. OBJECT (baseType) .. END
  1267. >> **)
  1268. RecordType* = OBJECT (Type)
  1269. VAR
  1270. recordScope-:RecordScope;
  1271. baseType-: Type;
  1272. pointerType-: PointerType; (* for support of A = POINTER TO RECORD ... END and B = POINTER TO RECORD (A) END; *)
  1273. modifiers-: Modifier;
  1274. isObject-,isProtected: BOOLEAN;
  1275. isAbstract-: BOOLEAN;
  1276. (* a math array type describing an object's array structure; NIL if the type does not exhibit an array structure *)
  1277. arrayStructure-: MathArrayType;
  1278. (* list of all operators needed to access an array-structured object type *)
  1279. arrayAccessOperators-: ArrayAccessOperators;
  1280. PROCEDURE & InitRecordType( position: Position; scope: Scope; recordScope: RecordScope);
  1281. BEGIN
  1282. InitType( position);
  1283. SELF.scope := scope;
  1284. baseType := NIL;
  1285. pointerType := NIL;
  1286. SELF.recordScope := recordScope;
  1287. ASSERT(recordScope # NIL);
  1288. ASSERT(recordScope.ownerRecord = NIL); (* cannot register twice ! *)
  1289. recordScope.ownerRecord := SELF;
  1290. isObject := FALSE; isProtected := FALSE;
  1291. arrayStructure := NIL;
  1292. modifiers := NIL;
  1293. isAbstract := FALSE;
  1294. END InitRecordType;
  1295. PROCEDURE SetAbstract*(abstract: BOOLEAN);
  1296. BEGIN
  1297. isAbstract := abstract;
  1298. END SetAbstract;
  1299. PROCEDURE SetModifiers*(flag: Modifier);
  1300. BEGIN SELF.modifiers := flag;
  1301. END SetModifiers;
  1302. PROCEDURE SetBaseType*( type: Type );
  1303. BEGIN
  1304. baseType := type; IF (baseType # NIL) & (baseType.hasPointers) THEN hasPointers := TRUE END;
  1305. END SetBaseType;
  1306. PROCEDURE SetPointerType*(pointerType: PointerType);
  1307. BEGIN SELF.pointerType := pointerType
  1308. END SetPointerType;
  1309. PROCEDURE IsObject*(isObject: BOOLEAN);
  1310. BEGIN SELF.isObject := isObject
  1311. END IsObject;
  1312. PROCEDURE IsActive*(): BOOLEAN;
  1313. VAR base: RecordType;
  1314. BEGIN
  1315. IF (recordScope.bodyProcedure # NIL) & (recordScope.bodyProcedure.procedureScope.body # NIL) & (recordScope.bodyProcedure.procedureScope.body.isActive) THEN RETURN TRUE END;
  1316. base := GetBaseRecord();
  1317. IF base # NIL THEN RETURN base.IsActive() END;
  1318. RETURN FALSE
  1319. END IsActive;
  1320. PROCEDURE IsProtected*(): BOOLEAN;
  1321. VAR base: RecordType;
  1322. BEGIN
  1323. IF isProtected THEN RETURN TRUE END;
  1324. base := GetBaseRecord();
  1325. IF base # NIL THEN RETURN base.IsProtected() END;
  1326. RETURN FALSE
  1327. END IsProtected;
  1328. PROCEDURE SetProtected*(protected: BOOLEAN);
  1329. BEGIN SELF.isProtected := protected
  1330. END SetProtected;
  1331. PROCEDURE Level*():LONGINT;
  1332. VAR type: RecordType; res: WORD;
  1333. BEGIN
  1334. type := SELF;
  1335. res := 0;
  1336. WHILE (type # NIL) & (type.baseType # NIL) DO
  1337. INC(res);
  1338. type := type.GetBaseRecord();
  1339. END;
  1340. RETURN res;
  1341. END Level;
  1342. PROCEDURE GetBaseRecord*():RecordType;
  1343. BEGIN
  1344. IF baseType = NIL THEN RETURN NIL; END;
  1345. IF baseType.resolved IS RecordType THEN
  1346. RETURN baseType.resolved(RecordType);
  1347. ELSIF baseType.resolved IS PointerType THEN
  1348. IF baseType.resolved(PointerType).pointerBase.resolved # NIL THEN
  1349. RETURN baseType.resolved(PointerType).pointerBase.resolved(RecordType);
  1350. END;
  1351. END;
  1352. RETURN NIL;
  1353. END GetBaseRecord;
  1354. PROCEDURE Extends*(this: Type): BOOLEAN;
  1355. VAR result: BOOLEAN; extension: Type;
  1356. BEGIN
  1357. result := FALSE;
  1358. IF this = SELF THEN result := TRUE
  1359. ELSIF this IS RecordType THEN
  1360. IF (baseType # NIL) THEN
  1361. extension := baseType.resolved;
  1362. IF extension IS PointerType THEN
  1363. result := extension(PointerType).Extends(this)
  1364. ELSIF extension IS RecordType THEN
  1365. result := extension(RecordType).Extends(this)
  1366. END;
  1367. END;
  1368. END;
  1369. RETURN result
  1370. END Extends;
  1371. PROCEDURE SameType*(this: Type): BOOLEAN;
  1372. BEGIN RETURN (this = SELF)
  1373. END SameType;
  1374. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  1375. BEGIN RETURN Extends(to)
  1376. END CompatibleTo;
  1377. PROCEDURE SetArrayStructure*(arrayStructure: MathArrayType);
  1378. BEGIN SELF.arrayStructure := arrayStructure
  1379. END SetArrayStructure;
  1380. PROCEDURE SetArrayAccessOperators*(arrayAccessOperators: ArrayAccessOperators);
  1381. BEGIN SELF.arrayAccessOperators := arrayAccessOperators
  1382. END SetArrayAccessOperators;
  1383. PROCEDURE HasArrayStructure*(): BOOLEAN;
  1384. BEGIN RETURN (arrayStructure # NIL)
  1385. END HasArrayStructure
  1386. ;
  1387. PROCEDURE IsComposite*(): BOOLEAN;
  1388. BEGIN RETURN TRUE
  1389. END IsComposite;
  1390. PROCEDURE NeedsTrace*(): BOOLEAN;
  1391. BEGIN RETURN recordScope.NeedsTrace();
  1392. END NeedsTrace;
  1393. PROCEDURE Accept*(v: Visitor);
  1394. VAR position: LONGINT;
  1395. BEGIN position := SELF.position.start; v.VisitRecordType(SELF)
  1396. END Accept;
  1397. PROCEDURE IsRecordType*(): BOOLEAN;
  1398. BEGIN
  1399. RETURN TRUE;
  1400. END IsRecordType;
  1401. END RecordType;
  1402. CellType*=OBJECT (Type)
  1403. VAR
  1404. firstParameter-,lastParameter-: Parameter; numberParameters-: LONGINT; (* parameters *)
  1405. firstProperty-, lastProperty-: Property; numberProperties: LONGINT; (* capabilities *)
  1406. cellScope-: CellScope;
  1407. isCellNet-: BOOLEAN;
  1408. modifiers-: Modifier;
  1409. baseType-: Type;
  1410. PROCEDURE &InitCellType(position: Position; scope: Scope; cellScope: CellScope);
  1411. BEGIN
  1412. InitType(position);
  1413. SELF.scope := scope;
  1414. numberParameters := 0; firstParameter := NIL; lastParameter := NIL;
  1415. numberProperties := 0; firstProperty := NIL; lastProperty := NIL;
  1416. SELF.cellScope := cellScope;
  1417. isCellNet := FALSE;
  1418. baseType := NIL;
  1419. END InitCellType;
  1420. PROCEDURE SetBaseType*(base: Type);
  1421. BEGIN
  1422. baseType := base;
  1423. END SetBaseType;
  1424. PROCEDURE GetBaseValueType*(): Type;
  1425. BEGIN
  1426. IF baseType = NIL THEN
  1427. RETURN NIL
  1428. ELSIF baseType.resolved IS PointerType THEN
  1429. RETURN baseType.resolved(PointerType).pointerBase.resolved
  1430. ELSE
  1431. RETURN baseType.resolved;
  1432. END;
  1433. END GetBaseValueType;
  1434. PROCEDURE GetBaseRecord*():RecordType;
  1435. BEGIN
  1436. IF baseType = NIL THEN RETURN NIL; END;
  1437. IF baseType.resolved IS CellType THEN
  1438. RETURN baseType.resolved(CellType).GetBaseRecord();
  1439. ELSIF baseType.resolved IS RecordType THEN
  1440. RETURN baseType.resolved(RecordType);
  1441. ELSIF baseType.resolved IS PointerType THEN
  1442. IF baseType.resolved(PointerType).pointerBase.resolved # NIL THEN
  1443. RETURN baseType.resolved(PointerType).pointerBase.resolved(RecordType);
  1444. END;
  1445. END;
  1446. RETURN NIL;
  1447. END GetBaseRecord;
  1448. PROCEDURE AddParameter*(p: Parameter);
  1449. BEGIN
  1450. ASSERT(p # NIL);
  1451. IF lastParameter= NIL THEN firstParameter := p ELSE lastParameter.nextParameter := p; p.prevParameter := lastParameter; END;
  1452. lastParameter := p;
  1453. INC(numberParameters);
  1454. END AddParameter;
  1455. PROCEDURE AddProperty*(p: Property);
  1456. BEGIN
  1457. ASSERT(p # NIL);
  1458. IF lastProperty= NIL THEN firstProperty := p ELSE lastProperty.nextProperty := p; p.prevProperty := lastProperty; END;
  1459. lastProperty := p;
  1460. INC(numberProperties);
  1461. END AddProperty;
  1462. PROCEDURE FindParameter*(identifier: Identifier): Parameter;
  1463. VAR p: Parameter;
  1464. BEGIN
  1465. p := NIL;
  1466. IF (baseType # NIL) & (baseType.resolved IS CellType) THEN
  1467. p := baseType.resolved(CellType).FindParameter(identifier);
  1468. END;
  1469. IF p = NIL THEN
  1470. p := firstParameter;
  1471. WHILE(p#NIL) & (p.name # identifier) DO p := p.nextParameter END;
  1472. END;
  1473. RETURN p;
  1474. END FindParameter;
  1475. PROCEDURE FindProperty*(identifier: Identifier): Property;
  1476. VAR p: Property;
  1477. BEGIN
  1478. p := firstProperty;
  1479. WHILE(p#NIL) & (p.name # identifier) DO p := p.nextProperty END;
  1480. IF p = NIL THEN
  1481. IF (baseType # NIL) & (baseType.resolved IS CellType) THEN
  1482. p := baseType.resolved(CellType).FindProperty(identifier);
  1483. END;
  1484. END;
  1485. RETURN p;
  1486. END FindProperty;
  1487. PROCEDURE SetModifiers*(flag: Modifier);
  1488. BEGIN SELF.modifiers := flag;
  1489. END SetModifiers;
  1490. PROCEDURE IsCellNet*(t: BOOLEAN);
  1491. BEGIN isCellNet := t
  1492. END IsCellNet;
  1493. PROCEDURE SameType*(this: Type): BOOLEAN;
  1494. BEGIN RETURN this = SELF
  1495. END SameType;
  1496. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  1497. BEGIN RETURN SameType(to)
  1498. END CompatibleTo;
  1499. PROCEDURE IsComposite*(): BOOLEAN;
  1500. BEGIN RETURN TRUE
  1501. END IsComposite;
  1502. PROCEDURE Accept*(v: Visitor);
  1503. VAR position: LONGINT;
  1504. BEGIN position := SELF.position.start; v.VisitCellType(SELF)
  1505. END Accept;
  1506. END CellType;
  1507. (** <<procedureType = PROCEDURE [{DELEGATE}] (firstParameter .. lastParameter): returnType>>
  1508. also used as type for procedures
  1509. **)
  1510. ProcedureType* = OBJECT (Type)
  1511. VAR
  1512. modifiers-: Modifier; (* set by the parser *)
  1513. returnType-: Type;
  1514. returnTypeModifiers-: Modifier;
  1515. hasUntracedReturn-: BOOLEAN;
  1516. firstParameter-,lastParameter-: Parameter; numberParameters-: LONGINT; (* parameters *)
  1517. returnParameter-: Parameter; (* not really necessary in syntax tree but very handy for backends *)
  1518. selfParameter-: Parameter;
  1519. isDelegate-,isInterrupt-,noPAF-,noReturn-: BOOLEAN;
  1520. pcOffset-: LONGINT; (* PC offset: used for ARM interrupt procedures *)
  1521. callingConvention-: CallingConvention;
  1522. stackAlignment-: LONGINT;
  1523. parametersOffset-: LONGINT; (* stack parameter offset -- in units of addresses: one pointer = 1 *)
  1524. PROCEDURE & InitProcedureType( position: Position; scope: Scope);
  1525. BEGIN
  1526. InitType( position);
  1527. SELF.scope := scope;
  1528. modifiers := NIL;
  1529. firstParameter := NIL; lastParameter := NIL; numberParameters := 0; returnParameter := NIL;
  1530. returnType := NIL;
  1531. stackAlignment := 1;
  1532. isDelegate := FALSE; isInterrupt := FALSE; noPAF := FALSE;
  1533. callingConvention := OberonCallingConvention;
  1534. parametersOffset := 0;
  1535. pcOffset := 0;
  1536. hasUntracedReturn := FALSE;
  1537. returnTypeModifiers := NIL;
  1538. selfParameter := NIL;
  1539. END InitProcedureType;
  1540. PROCEDURE SetNoPAF*(noPAF: BOOLEAN);
  1541. BEGIN SELF.noPAF := noPAF
  1542. END SetNoPAF;
  1543. PROCEDURE SetNoReturn*(noReturn: BOOLEAN);
  1544. BEGIN SELF.noReturn := noReturn
  1545. END SetNoReturn;
  1546. PROCEDURE SetPcOffset*(pcOffset: LONGINT);
  1547. BEGIN SELF.pcOffset := pcOffset
  1548. END SetPcOffset;
  1549. PROCEDURE SetInterrupt*(isInterrupt: BOOLEAN);
  1550. BEGIN SELF.isInterrupt := isInterrupt
  1551. END SetInterrupt;
  1552. PROCEDURE SetModifiers*(flags: Modifier);
  1553. BEGIN modifiers := flags
  1554. END SetModifiers;
  1555. PROCEDURE SetReturnTypeModifiers*(flags: Modifier);
  1556. BEGIN returnTypeModifiers := flags
  1557. END SetReturnTypeModifiers;
  1558. PROCEDURE SetDelegate*(delegate: BOOLEAN);
  1559. BEGIN SELF.isDelegate := delegate; SELF.hasPointers := delegate;
  1560. END SetDelegate;
  1561. PROCEDURE SetUntracedReturn*(untraced: BOOLEAN);
  1562. BEGIN
  1563. hasUntracedReturn := untraced;
  1564. END SetUntracedReturn;
  1565. PROCEDURE SetStackAlignment*(alignment: LONGINT);
  1566. BEGIN
  1567. stackAlignment := alignment;
  1568. END SetStackAlignment;
  1569. PROCEDURE SetParametersOffset*(ofs: LONGINT);
  1570. BEGIN parametersOffset := ofs
  1571. END SetParametersOffset;
  1572. PROCEDURE SetReturnParameter*(parameter: Parameter);
  1573. BEGIN returnParameter := parameter
  1574. END SetReturnParameter;
  1575. PROCEDURE SetSelfParameter*(parameter: Parameter);
  1576. BEGIN selfParameter := parameter
  1577. END SetSelfParameter;
  1578. PROCEDURE SetCallingConvention*(cc: CallingConvention);
  1579. BEGIN callingConvention := cc
  1580. END SetCallingConvention;
  1581. PROCEDURE AddParameter*(p: Parameter);
  1582. BEGIN
  1583. ASSERT(p # NIL);
  1584. IF lastParameter= NIL THEN firstParameter := p ELSE lastParameter.nextParameter := p; p.prevParameter := lastParameter; END;
  1585. lastParameter := p;
  1586. INC(numberParameters);
  1587. ASSERT(p.access # {}); (* no hidden parameters ! *)
  1588. END AddParameter;
  1589. PROCEDURE RevertParameters*;
  1590. VAR this,next: Parameter; pnum: LONGINT;
  1591. BEGIN
  1592. pnum := numberParameters;
  1593. IF lastParameter # NIL THEN
  1594. this := lastParameter;
  1595. lastParameter := NIL;
  1596. firstParameter := NIL;
  1597. numberParameters := 0;
  1598. WHILE this # NIL DO
  1599. next := this.prevParameter;
  1600. this.prevParameter := NIL; this.nextParameter := NIL;
  1601. AddParameter(this);
  1602. this := next;
  1603. END;
  1604. END;
  1605. ASSERT(pnum = numberParameters);
  1606. END RevertParameters;
  1607. PROCEDURE SetReturnType*( type: Type );
  1608. BEGIN
  1609. returnType := type;
  1610. END SetReturnType;
  1611. PROCEDURE SameSignature*(this: Type): BOOLEAN;
  1612. VAR result: BOOLEAN; p1,p2: Parameter;
  1613. BEGIN
  1614. result := FALSE;
  1615. IF recursion THEN
  1616. result := TRUE
  1617. ELSIF this = SELF THEN
  1618. result := TRUE
  1619. ELSIF this IS ProcedureType THEN
  1620. recursion := TRUE;
  1621. WITH this: ProcedureType DO
  1622. result := (returnType = NIL) & (this.returnType = NIL) OR (returnType # NIL) & (this.returnType # NIL) & returnType.SameType(this.returnType.resolved);
  1623. result := result & (callingConvention = this.callingConvention);
  1624. result := result & (noReturn = this.noReturn);
  1625. result := result & (isInterrupt = this.isInterrupt);
  1626. IF result THEN
  1627. p1 := selfParameter; p2 := this.selfParameter;
  1628. IF (p1 = NIL) # (p2=NIL) OR (p1 # NIL) & ((p1.kind # p2.kind)) THEN
  1629. RETURN FALSE
  1630. END;
  1631. p1 := firstParameter; p2 := this.firstParameter;
  1632. WHILE (p1 # NIL) & (p2 # NIL) & (p1.access # Hidden) & (p2.access # Hidden) & (p1.kind = p2.kind) & (p1.type.SameType(p2.type) OR (p2.type.resolved # NIL) & p1.type.SameType(p2.type.resolved) OR (p1.type.resolved IS AddressType) & (p2.type.resolved IS PointerType) & p2.type.resolved(PointerType).isUnsafe) DO
  1633. p1 := p1.nextParameter; p2 := p2.nextParameter
  1634. END;
  1635. result := ((p1=NIL) OR (p1.access = Hidden)) & ((p2=NIL) OR (p2.access= Hidden));
  1636. END;
  1637. END;
  1638. END;
  1639. recursion := FALSE;
  1640. RETURN result
  1641. END SameSignature;
  1642. PROCEDURE SameType*(this: Type): BOOLEAN;
  1643. BEGIN
  1644. RETURN SameSignature(this)
  1645. & (this(ProcedureType).isDelegate = isDelegate)
  1646. & (this(ProcedureType).isRealtime = isRealtime);
  1647. END SameType;
  1648. PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
  1649. BEGIN
  1650. RETURN SameSignature(to) & (~isDelegate OR to(ProcedureType).isDelegate) & (~to.isRealtime OR isRealtime)
  1651. & ((stackAlignment <=1) OR (stackAlignment <= to(ProcedureType).stackAlignment));
  1652. END CompatibleTo;
  1653. PROCEDURE IsComposite*(): BOOLEAN;
  1654. BEGIN RETURN isDelegate
  1655. END IsComposite;
  1656. PROCEDURE Accept*(v: Visitor);
  1657. VAR position: LONGINT;
  1658. BEGIN position := SELF.position.start; v.VisitProcedureType(SELF)
  1659. END Accept;
  1660. (** Returns if the type needs to be traced for garbage collection *)
  1661. PROCEDURE NeedsTrace*(): BOOLEAN;
  1662. BEGIN RETURN isDelegate;
  1663. END NeedsTrace;
  1664. END ProcedureType;
  1665. (**** expressions ****)
  1666. Expression* = OBJECT
  1667. VAR
  1668. type-: Type; (* the expression's type. Resolved by checker *)
  1669. assignable-: BOOLEAN; (* expression can be assigned to (or used as var-parameter): expression := ... *)
  1670. position-, end-: Position;
  1671. state-: SET;
  1672. resolved-: Value;
  1673. isHidden-: BOOLEAN;
  1674. PROCEDURE End*( position: Position);
  1675. BEGIN SELF.end := position;
  1676. END End;
  1677. PROCEDURE SetState*(state: LONGINT);
  1678. BEGIN INCL(SELF.state,state);
  1679. END SetState;
  1680. PROCEDURE &InitExpression(position: Position);
  1681. BEGIN SELF.position := position; end := invalidPosition; state := Undefined; type := NIL; assignable := FALSE; resolved := NIL; isHidden := FALSE;
  1682. END InitExpression;
  1683. PROCEDURE SetHidden*(hidden: BOOLEAN);
  1684. BEGIN isHidden := hidden
  1685. END SetHidden;
  1686. PROCEDURE SetType*(type: Type);
  1687. BEGIN
  1688. SELF.type := type;
  1689. END SetType;
  1690. PROCEDURE SetResolved*(value: Value);
  1691. BEGIN SELF.resolved := value
  1692. END SetResolved;
  1693. PROCEDURE SetAssignable*(assignable: BOOLEAN);
  1694. BEGIN SELF.assignable := assignable
  1695. END SetAssignable;
  1696. PROCEDURE Clone(): Expression;
  1697. VAR clone: Expression;
  1698. BEGIN
  1699. (* support cloning here for more robust error reporting -- should not happen normally *)
  1700. NEW(clone, position); RETURN clone
  1701. END Clone;
  1702. PROCEDURE Accept*(v: Visitor);
  1703. VAR position: LONGINT;
  1704. BEGIN position := SELF.position.start; v.VisitExpression(SELF)
  1705. END Accept;
  1706. PROCEDURE NeedsTrace* (): BOOLEAN;
  1707. BEGIN RETURN FALSE;
  1708. END NeedsTrace;
  1709. END Expression;
  1710. (** <<expression, expression, ...>> **)
  1711. ExpressionList* = OBJECT
  1712. VAR list: Basic.List;
  1713. PROCEDURE & InitList;
  1714. BEGIN NEW( list,8 );
  1715. END InitList;
  1716. PROCEDURE Length*( ): LONGINT;
  1717. BEGIN RETURN list.Length();
  1718. END Length;
  1719. PROCEDURE AddExpression*( d: Expression );
  1720. BEGIN list.Add(d)
  1721. END AddExpression;
  1722. PROCEDURE GetExpression*( index: LONGINT ): Expression;
  1723. VAR p: ANY;
  1724. BEGIN
  1725. p := list.Get(index); RETURN p(Expression);
  1726. END GetExpression;
  1727. PROCEDURE SetExpression*(index: LONGINT; expression: Expression);
  1728. BEGIN list.Set(index,expression)
  1729. END SetExpression;
  1730. PROCEDURE RemoveExpression*(i: LONGINT);
  1731. BEGIN list.RemoveByIndex(i);
  1732. END RemoveExpression;
  1733. PROCEDURE Revert*;
  1734. VAR i,j,last: LONGINT; ei,ej: ANY;
  1735. BEGIN
  1736. last := Length()-1;
  1737. FOR i := 0 TO last DO
  1738. j := last-i;
  1739. ei := list.Get(i);
  1740. ej := list.Get(j);
  1741. list.Set(i,ej);
  1742. list.Set(j,ei);
  1743. END;
  1744. END Revert;
  1745. PROCEDURE Clone*(VAR list: ExpressionList);
  1746. VAR i: LONGINT;
  1747. BEGIN
  1748. IF list = NIL THEN NEW(list) END;
  1749. FOR i := 0 TO Length()-1 DO
  1750. list.AddExpression(CloneExpression(GetExpression(i)));
  1751. END;
  1752. END Clone;
  1753. END ExpressionList;
  1754. (** << {elements} >> **)
  1755. Set* = OBJECT (Expression)
  1756. VAR elements-: ExpressionList; (* an element of the form from .. to is represented as a RangeExpression *)
  1757. PROCEDURE & InitSet( position: Position );
  1758. BEGIN
  1759. InitExpression( position );
  1760. elements := NewExpressionList();
  1761. END InitSet;
  1762. PROCEDURE Clone(): Expression;
  1763. VAR copy: Set;
  1764. BEGIN
  1765. NEW(copy, position); elements.Clone(copy.elements); RETURN copy
  1766. END Clone;
  1767. PROCEDURE Accept*(v: Visitor);
  1768. VAR position: LONGINT;
  1769. BEGIN position := SELF.position.start; v.VisitSet(SELF)
  1770. END Accept;
  1771. END Set;
  1772. (** << [elements] >> **)
  1773. MathArrayExpression* = OBJECT (Expression)
  1774. VAR elements-: ExpressionList; (* an element of the form from .. to is represented as a RangeExpression *)
  1775. PROCEDURE & InitMathArrayExpression( position: Position );
  1776. BEGIN
  1777. InitExpression( position );
  1778. elements := NewExpressionList();
  1779. END InitMathArrayExpression;
  1780. PROCEDURE Clone(): Expression;
  1781. VAR copy: MathArrayExpression;
  1782. BEGIN
  1783. NEW(copy, position); elements.Clone(copy.elements); RETURN copy
  1784. END Clone;
  1785. PROCEDURE Accept*(v: Visitor);
  1786. VAR position: LONGINT;
  1787. BEGIN position := SELF.position.start; v.VisitMathArrayExpression(SELF)
  1788. END Accept;
  1789. END MathArrayExpression;
  1790. (** <<operator left>> **)
  1791. UnaryExpression* = OBJECT (Expression)
  1792. VAR
  1793. left-: Expression;
  1794. operator-: LONGINT; (* one of Scanner.Minus ... Scanner.Not *)
  1795. PROCEDURE & InitUnaryExpression( position: Position; operand: Expression; operator: LONGINT );
  1796. BEGIN
  1797. InitExpression( position ); SELF.left := operand; SELF.operator := operator;
  1798. END InitUnaryExpression;
  1799. PROCEDURE SetLeft*(left: Expression);
  1800. BEGIN SELF.left := left
  1801. END SetLeft;
  1802. PROCEDURE Clone(): Expression;
  1803. VAR copy: UnaryExpression;
  1804. BEGIN
  1805. NEW(copy, position, CloneExpression(left), operator); RETURN copy
  1806. END Clone;
  1807. PROCEDURE Accept*(v: Visitor);
  1808. VAR position: LONGINT;
  1809. BEGIN position := SELF.position.start; v.VisitUnaryExpression(SELF)
  1810. END Accept;
  1811. END UnaryExpression;
  1812. (** <<left operator right>> **)
  1813. BinaryExpression* = OBJECT (Expression)
  1814. VAR
  1815. left-, right-: Expression;
  1816. operator-: LONGINT; (* one of Scanner.Equal ... Scanner.Minus *)
  1817. PROCEDURE & InitBinaryExpression( position: Position; left, right: Expression; operator: LONGINT );
  1818. BEGIN
  1819. InitExpression( position ); SELF.left := left; SELF.right := right; SELF.operator := operator;
  1820. END InitBinaryExpression;
  1821. PROCEDURE SetLeft*(left: Expression);
  1822. BEGIN SELF.left := left
  1823. END SetLeft;
  1824. PROCEDURE SetRight*(right: Expression);
  1825. BEGIN SELF.right := right
  1826. END SetRight;
  1827. PROCEDURE Clone(): Expression;
  1828. VAR copy: BinaryExpression;
  1829. BEGIN
  1830. NEW(copy, position, CloneExpression(left), CloneExpression(right), operator); RETURN copy
  1831. END Clone;
  1832. PROCEDURE Accept*(v: Visitor);
  1833. VAR position: LONGINT;
  1834. BEGIN position := SELF.position.start; v.VisitBinaryExpression(SELF)
  1835. END Accept;
  1836. END BinaryExpression;
  1837. (** expression that denotes a range
  1838. <<[first] '..' [last] ['by' step] | '*' >>
  1839. **)
  1840. RangeExpression* = OBJECT (Expression)
  1841. VAR
  1842. first-, last-, step-: Expression;
  1843. missingFirst-, missingLast-, missingStep-: BOOLEAN; (* only for printout*)
  1844. context-: SHORTINT; (* one of ArrayIndex, SetElement or CaseGuard *)
  1845. PROCEDURE &InitRangeExpression(position: Position; first, last, step: Expression);
  1846. BEGIN
  1847. context := ArrayIndex; (* by default, a range represents array indices *)
  1848. InitExpression(position);
  1849. missingFirst := (first = NIL);
  1850. missingLast := (last = NIL);
  1851. missingStep := (step = NIL);
  1852. SELF.first := first;
  1853. SELF.last := last;
  1854. SELF.step := step;
  1855. END InitRangeExpression;
  1856. PROCEDURE SetFirst*(first: Expression);
  1857. BEGIN
  1858. SELF.first := first
  1859. END SetFirst;
  1860. PROCEDURE SetLast*(last: Expression);
  1861. BEGIN SELF.last := last
  1862. END SetLast;
  1863. PROCEDURE SetStep*(step: Expression);
  1864. BEGIN SELF.step := step
  1865. END SetStep;
  1866. PROCEDURE SetContext*(context: SHORTINT);
  1867. BEGIN
  1868. SELF.context := context
  1869. END SetContext;
  1870. PROCEDURE Clone(): Expression;
  1871. VAR copy: RangeExpression;
  1872. BEGIN
  1873. NEW(copy, position, CloneExpression(first), CloneExpression(last), CloneExpression(step)); RETURN copy
  1874. END Clone;
  1875. PROCEDURE Accept*(v: Visitor);
  1876. VAR position: LONGINT;
  1877. BEGIN position := SELF.position.start; v.VisitRangeExpression(SELF)
  1878. END Accept;
  1879. END RangeExpression;
  1880. (** << ? >> **)
  1881. TensorRangeExpression*=OBJECT (Expression);
  1882. PROCEDURE &InitTensorRangeExpression(position: Position);
  1883. BEGIN
  1884. InitExpression(position);
  1885. END InitTensorRangeExpression;
  1886. PROCEDURE Clone(): Expression;
  1887. VAR copy: TensorRangeExpression;
  1888. BEGIN
  1889. NEW(copy, position); RETURN copy
  1890. END Clone;
  1891. PROCEDURE Accept*(v: Visitor);
  1892. VAR position: LONGINT;
  1893. BEGIN position := SELF.position.start; v.VisitTensorRangeExpression(SELF)
  1894. END Accept;
  1895. END TensorRangeExpression;
  1896. (** convert expression from expression.type to Conversion.type **)
  1897. Conversion* = OBJECT (Expression)
  1898. VAR
  1899. expression-: Expression;
  1900. typeExpression-: Expression; (* for printout *)
  1901. PROCEDURE & InitConversion( position: Position; expression: Expression; type: Type; typeExpression: Expression);
  1902. BEGIN
  1903. InitExpression( position ); SELF.expression := expression; SELF.typeExpression := typeExpression; SELF.type := type;
  1904. END InitConversion;
  1905. PROCEDURE SetExpression*(expression: Expression);
  1906. BEGIN SELF.expression := expression
  1907. END SetExpression;
  1908. PROCEDURE Clone(): Expression;
  1909. VAR copy: Conversion;
  1910. BEGIN
  1911. NEW(copy, position, CloneExpression(expression), type, CloneExpression(typeExpression)); RETURN copy
  1912. END Clone;
  1913. PROCEDURE Accept*(v: Visitor);
  1914. VAR position: LONGINT;
  1915. BEGIN position := SELF.position.start; v.VisitConversion(SELF)
  1916. END Accept;
  1917. END Conversion;
  1918. (**** designators ****)
  1919. (** abstract **)
  1920. Designator* = OBJECT(Expression)
  1921. VAR
  1922. left-: Expression; (* currently only designators are allowed but for later purposes ... (as for example (a+b).c) *)
  1923. relatedRhs-: Expression; (* the RHS of an assignment if this designator is used on the LHS: *)
  1924. (* used if this designator contains an index operator call, e.g. 'asot.^"[]"(indexList)': *)
  1925. relatedAsot-: Expression; (* the ASOT on which the index operator is called *)
  1926. relatedIndexList-: ExpressionList; (* the index list *)
  1927. modifiers-: Modifier;
  1928. PROCEDURE &InitDesignator*(position: Position);
  1929. BEGIN
  1930. InitExpression(position);
  1931. left := NIL;
  1932. relatedRhs := NIL;
  1933. relatedAsot := NIL;
  1934. relatedIndexList := NIL;
  1935. modifiers := NIL;
  1936. END InitDesignator;
  1937. PROCEDURE SetLeft*(expression: Expression);
  1938. BEGIN left := expression
  1939. END SetLeft;
  1940. PROCEDURE SetRelatedRhs*(relatedRhs: Expression);
  1941. BEGIN SELF.relatedRhs := relatedRhs
  1942. END SetRelatedRhs;
  1943. PROCEDURE SetRelatedAsot*(relatedAsot: Expression);
  1944. BEGIN SELF.relatedAsot := relatedAsot
  1945. END SetRelatedAsot;
  1946. PROCEDURE SetRelatedIndexList*(relatedIndexList: ExpressionList);
  1947. BEGIN SELF.relatedIndexList := relatedIndexList
  1948. END SetRelatedIndexList;
  1949. PROCEDURE SetModifiers*(flags: Modifier);
  1950. BEGIN modifiers := flags
  1951. END SetModifiers;
  1952. PROCEDURE Clone(): Expression;
  1953. VAR clone: Designator;
  1954. BEGIN
  1955. (* support cloning here for more robust error reporting -- should not happen normally *)
  1956. NEW(clone, position); RETURN clone
  1957. END Clone;
  1958. PROCEDURE Accept*(v: Visitor);
  1959. VAR position: LONGINT;
  1960. BEGIN position := SELF.position.start; v.VisitDesignator(SELF)
  1961. END Accept;
  1962. END Designator;
  1963. (*** first phase (parse time) designators ***)
  1964. (** <<identifier>>
  1965. may designate any symbol such as Variable, TypeDeclaration, Procedure
  1966. **)
  1967. IdentifierDesignator* = OBJECT(Designator)
  1968. VAR identifier-: Identifier;
  1969. PROCEDURE &InitIdentifierDesignator(position: Position; id: Identifier);
  1970. BEGIN InitDesignator(position); identifier := id
  1971. END InitIdentifierDesignator;
  1972. PROCEDURE Clone(): Expression;
  1973. VAR copy: IdentifierDesignator;
  1974. BEGIN
  1975. NEW(copy, position, identifier); RETURN copy
  1976. END Clone;
  1977. PROCEDURE Accept*(v: Visitor);
  1978. VAR position: LONGINT;
  1979. BEGIN position := SELF.position.start; v.VisitIdentifierDesignator(SELF)
  1980. END Accept;
  1981. END IdentifierDesignator;
  1982. (** <<left.identifier>>
  1983. may designate a record / module element (constant, type, variable, procedure)
  1984. **)
  1985. SelectorDesignator* = OBJECT (Designator)
  1986. VAR identifier-: Identifier;
  1987. PROCEDURE & InitSelector(position: Position; left: Designator; identifier: Identifier);
  1988. BEGIN InitDesignator(position); SELF.left := left; SELF.identifier := identifier;
  1989. END InitSelector;
  1990. PROCEDURE Clone(): Expression;
  1991. VAR copy: SelectorDesignator;
  1992. BEGIN
  1993. NEW(copy, position, CloneDesignator(left), identifier); RETURN copy
  1994. END Clone;
  1995. PROCEDURE Accept*(v: Visitor);
  1996. VAR position: LONGINT;
  1997. BEGIN position := SELF.position.start; v.VisitSelectorDesignator(SELF)
  1998. END Accept;
  1999. END SelectorDesignator;
  2000. (** <<left(arg1, arg2, ...)>>
  2001. may designate a function call or a type guard
  2002. **)
  2003. ParameterDesignator* = OBJECT(Designator)
  2004. VAR
  2005. parameters-: ExpressionList;
  2006. PROCEDURE &InitParameterDesignator(position: Position; left: Designator; parameters: ExpressionList);
  2007. BEGIN InitDesignator(position); SELF.left := left; SELF.parameters := parameters
  2008. END InitParameterDesignator;
  2009. PROCEDURE Clone(): Expression;
  2010. VAR copy: ParameterDesignator;
  2011. BEGIN
  2012. NEW(copy, position, CloneDesignator(left), CloneExpressionList(parameters)); RETURN copy
  2013. END Clone;
  2014. PROCEDURE Accept*(v: Visitor);
  2015. VAR position: LONGINT;
  2016. BEGIN position := SELF.position.start; v.VisitParameterDesignator(SELF)
  2017. END Accept;
  2018. END ParameterDesignator;
  2019. (** <<left^>>
  2020. may designate a pointer dereference or a method supercall
  2021. **)
  2022. ArrowDesignator* = OBJECT (Designator)
  2023. PROCEDURE &InitArrowDesignator(position: Position; left: Designator);
  2024. BEGIN InitDesignator(position); SELF.left := left;
  2025. END InitArrowDesignator;
  2026. PROCEDURE Clone(): Expression;
  2027. VAR copy: ArrowDesignator;
  2028. BEGIN
  2029. NEW(copy, position, CloneDesignator(left(Designator))); RETURN copy
  2030. END Clone;
  2031. PROCEDURE Accept*(v: Visitor);
  2032. VAR position: LONGINT;
  2033. BEGIN position := SELF.position.start; v.VisitArrowDesignator(SELF)
  2034. END Accept;
  2035. END ArrowDesignator;
  2036. (** <<left[parameters]>>
  2037. designates an index designator, before checker
  2038. **)
  2039. BracketDesignator* = OBJECT(Designator)
  2040. VAR parameters-: ExpressionList;
  2041. PROCEDURE &InitBracketDesignator(position: Position; left: Designator; parameters: ExpressionList);
  2042. BEGIN InitDesignator(position); SELF.left := left; SELF.parameters := parameters;
  2043. END InitBracketDesignator;
  2044. PROCEDURE Clone(): Expression;
  2045. VAR copy: BracketDesignator;
  2046. BEGIN
  2047. NEW(copy, position, CloneDesignator(left), CloneExpressionList(parameters)); RETURN copy
  2048. END Clone;
  2049. PROCEDURE Accept*(v: Visitor);
  2050. VAR position: LONGINT;
  2051. BEGIN position := SELF.position.start; v.VisitBracketDesignator(SELF)
  2052. END Accept;
  2053. END BracketDesignator;
  2054. (*** second phase (after checker) designators ***)
  2055. (** symbol designator emerged from IdentifierDesignator or from Selector **)
  2056. SymbolDesignator* = OBJECT(Designator)
  2057. VAR
  2058. symbol-: Symbol;
  2059. PROCEDURE &InitSymbolDesignator(position: Position; left: Designator; symbol: Symbol);
  2060. BEGIN
  2061. InitDesignator(position);
  2062. SELF.left := left;
  2063. SELF.symbol := symbol;
  2064. END InitSymbolDesignator;
  2065. PROCEDURE Accept*(v: Visitor);
  2066. VAR position: LONGINT;
  2067. BEGIN
  2068. position := SELF.position.start; v.VisitSymbolDesignator(SELF);
  2069. END Accept;
  2070. PROCEDURE Clone(): Expression;
  2071. VAR copy: SymbolDesignator;
  2072. BEGIN
  2073. NEW(copy, position, CloneDesignator(left), symbol); RETURN copy
  2074. END Clone;
  2075. PROCEDURE SetSymbol*(s: Symbol);
  2076. BEGIN SELF.symbol := s;
  2077. END SetSymbol;
  2078. PROCEDURE NeedsTrace* (): BOOLEAN;
  2079. BEGIN
  2080. RETURN symbol.NeedsTrace() & ((left = NIL) OR (left.NeedsTrace()));
  2081. END NeedsTrace;
  2082. END SymbolDesignator;
  2083. (** <<left[parameters]>>
  2084. (ranged) indexer
  2085. **)
  2086. IndexDesignator* = OBJECT(Designator)
  2087. VAR
  2088. parameters-: ExpressionList;
  2089. hasRange-: BOOLEAN;
  2090. hasTensorRange-: BOOLEAN;
  2091. PROCEDURE &InitIndexDesignator(position: Position; left: Designator);
  2092. BEGIN
  2093. InitDesignator(position);
  2094. SELF.left := left;
  2095. parameters := NewExpressionList();
  2096. hasRange := FALSE;
  2097. hasTensorRange := FALSE;
  2098. END InitIndexDesignator;
  2099. PROCEDURE HasRange*;
  2100. BEGIN hasRange := TRUE;
  2101. END HasRange;
  2102. PROCEDURE HasTensorRange*;
  2103. BEGIN hasTensorRange := TRUE;
  2104. END HasTensorRange;
  2105. PROCEDURE Clone(): Expression;
  2106. VAR copy: IndexDesignator;
  2107. BEGIN
  2108. NEW(copy, position, CloneDesignator(left));
  2109. parameters.Clone(copy.parameters);
  2110. copy.hasRange := hasRange; copy.hasTensorRange := hasTensorRange ; RETURN copy
  2111. END Clone;
  2112. PROCEDURE Accept*(v: Visitor);
  2113. VAR position: LONGINT;
  2114. BEGIN position := SELF.position.start; v.VisitIndexDesignator(SELF)
  2115. END Accept;
  2116. PROCEDURE NeedsTrace* (): BOOLEAN;
  2117. BEGIN RETURN type.NeedsTrace() & left.NeedsTrace(); (* for x[y]: if x is untraced, then also x[y] should be treated untraced *)
  2118. END NeedsTrace;
  2119. END IndexDesignator;
  2120. StatementDesignator* = OBJECT (Designator)
  2121. VAR
  2122. statement-: Statement;
  2123. result-: Expression;
  2124. PROCEDURE & InitStatementDesignator(position: Position; s: Statement);
  2125. BEGIN
  2126. InitDesignator(position); statement := s; result := NIL;
  2127. END InitStatementDesignator;
  2128. PROCEDURE Clone(): Expression;
  2129. VAR copy: StatementDesignator;
  2130. BEGIN
  2131. NEW(copy, position, CloneStatement(statement)) ;
  2132. copy.result := CloneExpression(result);
  2133. RETURN copy
  2134. END Clone;
  2135. PROCEDURE SetResult*(r: Expression);
  2136. BEGIN result := r
  2137. END SetResult;
  2138. PROCEDURE Accept*(v: Visitor);
  2139. VAR position: LONGINT;
  2140. BEGIN position := SELF.position.start; v.VisitStatementDesignator(SELF)
  2141. END Accept;
  2142. END StatementDesignator;
  2143. (** <<left(parameters)>>
  2144. procedure call
  2145. **)
  2146. ProcedureCallDesignator*= OBJECT (Designator)
  2147. VAR parameters-: ExpressionList;
  2148. PROCEDURE & InitProcedureCallDesignator(position: Position; left: Designator; parameters: ExpressionList);
  2149. BEGIN
  2150. InitDesignator(position); SELF.left := left; SELF.parameters := parameters;
  2151. END InitProcedureCallDesignator;
  2152. PROCEDURE Clone(): Expression;
  2153. VAR copy: ProcedureCallDesignator;
  2154. BEGIN
  2155. NEW(copy, position, CloneDesignator(left), CloneExpressionList(parameters)); RETURN copy
  2156. END Clone;
  2157. PROCEDURE Accept*(v: Visitor);
  2158. VAR position: LONGINT;
  2159. BEGIN position := SELF.position.start; v.VisitProcedureCallDesignator(SELF)
  2160. END Accept;
  2161. END ProcedureCallDesignator;
  2162. (** <<procedure(parameters)>>
  2163. builtin procedure call **)
  2164. BuiltinCallDesignator*= OBJECT (Designator) (*! should this be an extension of a procedure call designator ? *)
  2165. VAR
  2166. id-: LONGINT;
  2167. parameters-: ExpressionList;
  2168. builtin-: Builtin;
  2169. returnType-: Type;
  2170. PROCEDURE & InitBuiltinCallDesignator(position: Position; id: LONGINT; left: Designator; parameters: ExpressionList);
  2171. BEGIN
  2172. InitDesignator(position); SELF.parameters := parameters; SELF.id := id; SELF.left := left; returnType := NIL;
  2173. END InitBuiltinCallDesignator;
  2174. PROCEDURE SetReturnType*(type: Type);
  2175. BEGIN
  2176. returnType := type (* used for NEW Type() expression *)
  2177. END SetReturnType;
  2178. PROCEDURE Clone(): Expression;
  2179. VAR copy: BuiltinCallDesignator;
  2180. BEGIN
  2181. NEW(copy, position, id, CloneDesignator(left), CloneExpressionList(parameters)); RETURN copy
  2182. END Clone;
  2183. PROCEDURE Accept*(v: Visitor);
  2184. VAR position: LONGINT;
  2185. BEGIN position := SELF.position.start; v.VisitBuiltinCallDesignator(SELF)
  2186. END Accept;
  2187. END BuiltinCallDesignator;
  2188. (** <<left(type)>>
  2189. resolved parameter designator, designates a type guard
  2190. **)
  2191. TypeGuardDesignator* = OBJECT(Designator)
  2192. VAR
  2193. typeExpression-: Expression; (* for printing only *)
  2194. PROCEDURE &InitTypeGuardDesignator(position: Position; left: Designator; type: Type);
  2195. BEGIN InitDesignator(position); SELF.left := left; SELF.type := type; typeExpression := NIL;
  2196. END InitTypeGuardDesignator;
  2197. PROCEDURE SetTypeExpression*(typeExpression: Expression);
  2198. BEGIN SELF.typeExpression := typeExpression
  2199. END SetTypeExpression;
  2200. PROCEDURE Clone(): Expression;
  2201. VAR copy: TypeGuardDesignator;
  2202. BEGIN
  2203. NEW(copy, position, CloneDesignator(left), type); RETURN copy
  2204. END Clone;
  2205. PROCEDURE Accept*(v: Visitor);
  2206. VAR position: LONGINT;
  2207. BEGIN position := SELF.position.start; v.VisitTypeGuardDesignator(SELF)
  2208. END Accept;
  2209. PROCEDURE NeedsTrace* (): BOOLEAN;
  2210. BEGIN RETURN left.NeedsTrace() & type.NeedsTrace(); (* for x(Y): if x is untraced, then x as Y should also be treated untraced *)
  2211. END NeedsTrace;
  2212. END TypeGuardDesignator;
  2213. (** <<left^>> resolved as dereference operation on pointer variable left **)
  2214. DereferenceDesignator*= OBJECT (Designator)
  2215. PROCEDURE &InitDereferenceDesignator(position: Position; left: Designator);
  2216. BEGIN InitDesignator(position); SELF.left := left;
  2217. END InitDereferenceDesignator;
  2218. PROCEDURE Clone(): Expression;
  2219. VAR copy: DereferenceDesignator;
  2220. BEGIN
  2221. NEW(copy, position, CloneDesignator(left)); RETURN copy
  2222. END Clone;
  2223. PROCEDURE Accept*(v: Visitor);
  2224. VAR position: LONGINT;
  2225. BEGIN position := SELF.position.start; v.VisitDereferenceDesignator(SELF)
  2226. END Accept;
  2227. PROCEDURE NeedsTrace* (): BOOLEAN;
  2228. BEGIN
  2229. (*! semantic of x.y := new :
  2230. if x is untraced then assignments to x^.y can be traced, depending on traceability of field y in x
  2231. *)
  2232. RETURN type.NeedsTrace(); (* for x^: if x is an untraced pointer, the content of x^ is also treated untraced *)
  2233. END NeedsTrace;
  2234. END DereferenceDesignator;
  2235. (** <<left^>> resolved as supercall operation on method left **)
  2236. SupercallDesignator*= OBJECT (Designator)
  2237. PROCEDURE &InitSupercallDesignator(position: Position; left: Designator);
  2238. BEGIN InitDesignator(position); SELF.left := left;
  2239. END InitSupercallDesignator;
  2240. PROCEDURE Clone(): Expression;
  2241. VAR copy: SupercallDesignator;
  2242. BEGIN
  2243. NEW(copy, position, CloneDesignator(left)); RETURN copy
  2244. END Clone;
  2245. PROCEDURE Accept*(v: Visitor);
  2246. VAR position: LONGINT;
  2247. BEGIN position := SELF.position.start; v.VisitSupercallDesignator(SELF)
  2248. END Accept;
  2249. END SupercallDesignator;
  2250. (** <<SELF.x>> **)
  2251. SelfDesignator*= OBJECT (Designator)
  2252. PROCEDURE &InitSelfDesignator(position: Position);
  2253. BEGIN InitDesignator(position);
  2254. END InitSelfDesignator;
  2255. PROCEDURE Clone(): Expression;
  2256. VAR copy: SelfDesignator;
  2257. BEGIN
  2258. NEW(copy, position); RETURN copy
  2259. END Clone;
  2260. PROCEDURE Accept*(v: Visitor);
  2261. VAR position: LONGINT;
  2262. BEGIN position := SELF.position.start; v.VisitSelfDesignator(SELF)
  2263. END Accept;
  2264. PROCEDURE NeedsTrace* (): BOOLEAN;
  2265. BEGIN RETURN type.NeedsTrace();
  2266. END NeedsTrace;
  2267. END SelfDesignator;
  2268. (** <<RESULT>> **)
  2269. ResultDesignator*= OBJECT (Designator)
  2270. PROCEDURE &InitResultDesignator(position: Position);
  2271. BEGIN InitDesignator(position);
  2272. END InitResultDesignator;
  2273. PROCEDURE Clone(): Expression;
  2274. VAR copy: ResultDesignator;
  2275. BEGIN
  2276. NEW(copy, position); RETURN copy
  2277. END Clone;
  2278. PROCEDURE Accept*(v: Visitor);
  2279. VAR position: LONGINT;
  2280. BEGIN position := SELF.position.start; v.VisitResultDesignator(SELF)
  2281. END Accept;
  2282. END ResultDesignator;
  2283. (**** values ****)
  2284. Value* = OBJECT (Expression)
  2285. VAR fingerprint-: FingerPrint;
  2286. PROCEDURE &InitValue(position: Position);
  2287. BEGIN SELF.position := position; resolved := SELF; InitFingerPrint(fingerprint);
  2288. END InitValue;
  2289. PROCEDURE SetFingerPrint*(CONST fp: FingerPrint);
  2290. BEGIN
  2291. SELF.fingerprint := fp
  2292. END SetFingerPrint;
  2293. PROCEDURE Accept*(v: Visitor);
  2294. VAR position: LONGINT;
  2295. BEGIN position := SELF.position.start; v.VisitValue(SELF)
  2296. END Accept;
  2297. PROCEDURE Equals*(v: Value):BOOLEAN;
  2298. BEGIN HALT(100); (* abstract *) RETURN FALSE; END Equals;
  2299. END Value;
  2300. (** <<value = TRUE , FALSE>> **)
  2301. BooleanValue* = OBJECT (Value)
  2302. VAR
  2303. value-: BOOLEAN;
  2304. PROCEDURE & InitBooleanValue(position: Position; value: BOOLEAN);
  2305. BEGIN
  2306. InitValue(position); SELF.value := value;
  2307. END InitBooleanValue;
  2308. PROCEDURE SetValue*(value: BOOLEAN);
  2309. BEGIN SELF.value := value
  2310. END SetValue;
  2311. PROCEDURE Clone(): Expression;
  2312. VAR copy: BooleanValue;
  2313. BEGIN
  2314. NEW(copy, position, value); RETURN copy
  2315. END Clone;
  2316. PROCEDURE Accept*(v: Visitor);
  2317. VAR position: LONGINT;
  2318. BEGIN position := SELF.position.start; v.VisitBooleanValue(SELF)
  2319. END Accept;
  2320. PROCEDURE Equals*(v: Value):BOOLEAN;
  2321. BEGIN RETURN (v IS BooleanValue) & (v(BooleanValue).value = value); END Equals;
  2322. END BooleanValue;
  2323. (** <<value = 123456>> **)
  2324. IntegerValue* = OBJECT (Value)
  2325. VAR
  2326. value-: Basic.Integer;
  2327. PROCEDURE & InitIntegerValue(position: Position; value: Basic.Integer);
  2328. BEGIN
  2329. InitValue(position); SELF.value := value;
  2330. END InitIntegerValue;
  2331. PROCEDURE SetValue*(value: Basic.Integer);
  2332. BEGIN SELF.value := value;
  2333. END SetValue;
  2334. PROCEDURE Clone(): Expression;
  2335. VAR copy: IntegerValue;
  2336. BEGIN
  2337. NEW(copy, position, value); RETURN copy
  2338. END Clone;
  2339. PROCEDURE Accept*(v: Visitor);
  2340. VAR position: LONGINT;
  2341. BEGIN position := SELF.position.start; v.VisitIntegerValue(SELF)
  2342. END Accept;
  2343. PROCEDURE Equals*(v: Value):BOOLEAN;
  2344. BEGIN RETURN (v IS IntegerValue) & (v(IntegerValue).value = value); END Equals;
  2345. END IntegerValue;
  2346. (** <<value = 'c', 65X>> **)
  2347. CharacterValue*= OBJECT(Value)
  2348. VAR
  2349. value-: CHAR; (* potential for extension to support CHAR16 and CHAR32 *)
  2350. PROCEDURE & InitCharacterValue(position: Position; value: CHAR);
  2351. BEGIN
  2352. InitValue(position); SELF.value := value;
  2353. END InitCharacterValue;
  2354. PROCEDURE SetValue*(value: CHAR);
  2355. BEGIN SELF.value := value
  2356. END SetValue;
  2357. PROCEDURE Clone(): Expression;
  2358. VAR copy: CharacterValue;
  2359. BEGIN
  2360. NEW(copy, position, value); RETURN copy
  2361. END Clone;
  2362. PROCEDURE Accept*(v: Visitor);
  2363. VAR position: LONGINT;
  2364. BEGIN position := SELF.position.start; v.VisitCharacterValue(SELF)
  2365. END Accept;
  2366. PROCEDURE Equals*(v: Value):BOOLEAN;
  2367. BEGIN RETURN (v IS CharacterValue) & (v(CharacterValue).value = value); END Equals;
  2368. END CharacterValue;
  2369. SetValueType = SetValue;
  2370. (** <<value = {1,2,3..5}>> **)
  2371. SetValue* = OBJECT (Value)
  2372. VAR
  2373. value-: Basic.Set;
  2374. PROCEDURE & InitSetValue(position: Position; value: Basic.Set);
  2375. BEGIN
  2376. InitValue(position); SELF.value := value;
  2377. END InitSetValue;
  2378. PROCEDURE SetValue*(value: Basic.Set);
  2379. BEGIN SELF.value := value
  2380. END SetValue;
  2381. PROCEDURE Clone(): Expression;
  2382. VAR copy: SetValueType;
  2383. BEGIN
  2384. NEW(copy, position, value); RETURN copy
  2385. END Clone;
  2386. PROCEDURE Accept*(v: Visitor);
  2387. VAR position: LONGINT;
  2388. BEGIN position := SELF.position.start; v.VisitSetValue(SELF)
  2389. END Accept;
  2390. END SetValue;
  2391. (** << [elements] >> **)
  2392. MathArrayValue* = OBJECT (Value)
  2393. VAR array-: MathArrayExpression; (* an element of the form from .. to is represented as a RangeExpression *)
  2394. PROCEDURE & InitMathArrayValue(position: Position);
  2395. BEGIN
  2396. InitValue(position);
  2397. array := NIL;
  2398. END InitMathArrayValue;
  2399. PROCEDURE SetArray*(array: MathArrayExpression);
  2400. BEGIN SELF.array := array
  2401. END SetArray;
  2402. PROCEDURE Clone(): Expression;
  2403. VAR copy: MathArrayValue;
  2404. BEGIN
  2405. NEW(copy, position);
  2406. IF array # NIL THEN copy.array := array.Clone()(MathArrayExpression) END;
  2407. RETURN copy
  2408. END Clone;
  2409. PROCEDURE Accept*(v: Visitor);
  2410. VAR position: LONGINT;
  2411. BEGIN position := SELF.position.start; v.VisitMathArrayValue(SELF)
  2412. END Accept;
  2413. END MathArrayValue;
  2414. (** <<value = 1.2345E01>> **)
  2415. RealValue* = OBJECT (Value)
  2416. VAR
  2417. value-: LONGREAL;
  2418. subtype-: LONGINT; (* accuracy information: REAL vs. LONGREAL *)
  2419. PROCEDURE & InitRealValue(position: Position; value: LONGREAL);
  2420. BEGIN
  2421. InitValue(position); SELF.value := value; SELF.subtype := 0;
  2422. END InitRealValue;
  2423. PROCEDURE SetValue*(value: LONGREAL);
  2424. BEGIN SELF.value := value
  2425. END SetValue;
  2426. PROCEDURE SetSubtype*(subtype: LONGINT);
  2427. BEGIN SELF.subtype := subtype;
  2428. END SetSubtype;
  2429. PROCEDURE Clone(): Expression;
  2430. VAR copy: RealValue;
  2431. BEGIN
  2432. NEW(copy, position, value); RETURN copy
  2433. END Clone;
  2434. PROCEDURE Accept*(v: Visitor);
  2435. VAR position: LONGINT;
  2436. BEGIN position := SELF.position.start; v.VisitRealValue(SELF)
  2437. END Accept;
  2438. PROCEDURE Equals*(v: Value):BOOLEAN;
  2439. BEGIN RETURN (v IS RealValue) & (v(RealValue).value = value); END Equals;
  2440. END RealValue;
  2441. ComplexValue* = OBJECT (Value)
  2442. VAR
  2443. realValue-, imagValue-: LONGREAL;
  2444. subtype-: LONGINT; (* accuracy information of components: REAL vs. LONGREAL *)
  2445. PROCEDURE & InitComplexValue(position: Position; realValue, imagValue: LONGREAL);
  2446. BEGIN
  2447. InitValue(position); SELF.realValue := realValue; SELF.imagValue := imagValue; SELF.subtype := 0;
  2448. END InitComplexValue;
  2449. PROCEDURE SetValue*(realValue, imagValue: LONGREAL);
  2450. BEGIN SELF.realValue := realValue; SELF.imagValue := imagValue;
  2451. END SetValue;
  2452. PROCEDURE UpdateSubtype*;
  2453. BEGIN
  2454. ASSERT((type # NIL) & (type.resolved # NIL) & (type.resolved IS ComplexType) & (type.resolved(ComplexType).componentType IS FloatType));
  2455. CASE type.resolved(ComplexType).componentType(FloatType).sizeInBits OF
  2456. | 32: subtype := Scanner.Real
  2457. | 64: subtype := Scanner.Longreal
  2458. END
  2459. END UpdateSubtype;
  2460. PROCEDURE SetSubtype*(subtype: LONGINT);
  2461. BEGIN SELF.subtype := subtype;
  2462. END SetSubtype;
  2463. PROCEDURE Clone(): Expression;
  2464. VAR copy: ComplexValue;
  2465. BEGIN
  2466. NEW(copy, position, realValue, imagValue); copy.subtype := subtype; RETURN copy
  2467. END Clone;
  2468. PROCEDURE Accept*(v: Visitor);
  2469. VAR position: LONGINT;
  2470. BEGIN position := SELF.position.start; v.VisitComplexValue(SELF)
  2471. END Accept;
  2472. PROCEDURE Equals*(v: Value):BOOLEAN;
  2473. BEGIN RETURN (v IS ComplexValue) & (v(ComplexValue).realValue = realValue) & (v(ComplexValue).imagValue = imagValue);
  2474. (* TODO: append this?
  2475. OR (v IS RealValue) & (v(RealValue).value = realValue) & (imagValue := 0)
  2476. *)
  2477. END Equals;
  2478. END ComplexValue;
  2479. (** <<value = "string">> **)
  2480. StringValue* = OBJECT (Value)
  2481. VAR
  2482. value-: String;
  2483. length-: LONGINT;
  2484. PROCEDURE & InitStringValue(position: Position; value: String);
  2485. BEGIN
  2486. InitValue(position); SELF.value := value;
  2487. length := 0;
  2488. WHILE (length<LEN(value)) & (value[length] # 0X) DO
  2489. INC(length);
  2490. END;
  2491. IF length < LEN(value) THEN INC(length) END
  2492. END InitStringValue;
  2493. PROCEDURE SetValue*(CONST value: String);
  2494. BEGIN SELF.value := value
  2495. END SetValue;
  2496. PROCEDURE Append*(CONST value: String);
  2497. VAR new: String; len: LONGINT;
  2498. BEGIN
  2499. len := Strings.Length(SELF.value^) + Strings.Length(value^) + 1;
  2500. IF LEN(SELF.value) < len THEN
  2501. NEW(new, len);
  2502. COPY(SELF.value^, new^);
  2503. SELF.value := new
  2504. END;
  2505. Strings.Append(SELF.value^, value^);
  2506. length := len
  2507. END Append;
  2508. PROCEDURE AppendChar*(CONST ch: CHAR);
  2509. VAR v: String;
  2510. BEGIN
  2511. NEW(v,2); v[0] := ch;
  2512. Append(v);
  2513. END AppendChar;
  2514. PROCEDURE Clone(): Expression;
  2515. VAR copy: StringValue;
  2516. BEGIN
  2517. NEW(copy, position, value); RETURN copy
  2518. END Clone;
  2519. PROCEDURE Accept*(v: Visitor);
  2520. VAR position: LONGINT;
  2521. BEGIN position := SELF.position.start; v.VisitStringValue(SELF)
  2522. END Accept;
  2523. PROCEDURE Equals*(v: Value):BOOLEAN;
  2524. BEGIN RETURN (v IS StringValue) & (v(StringValue).value = value); END Equals;
  2525. END StringValue;
  2526. (** <<value = NIL>> **)
  2527. NilValue* = OBJECT (Value)
  2528. PROCEDURE Accept*(v: Visitor);
  2529. VAR position: LONGINT;
  2530. BEGIN position := SELF.position.start; v.VisitNilValue(SELF)
  2531. END Accept;
  2532. PROCEDURE Clone(): Expression;
  2533. VAR copy: NilValue;
  2534. BEGIN
  2535. NEW(copy, position); RETURN copy
  2536. END Clone;
  2537. PROCEDURE Equals*(v: Value):BOOLEAN;
  2538. BEGIN RETURN (v IS NilValue); END Equals;
  2539. END NilValue;
  2540. (** <<value = enum.x >> **)
  2541. EnumerationValue* = OBJECT (Value)
  2542. VAR
  2543. value-: Basic.Integer;
  2544. PROCEDURE & InitEnumerationValue(position: Position; value: Basic.Integer);
  2545. BEGIN
  2546. InitValue(position); SELF.value := value;
  2547. END InitEnumerationValue;
  2548. PROCEDURE SetValue*(value: Basic.Integer);
  2549. BEGIN SELF.value := value
  2550. END SetValue;
  2551. PROCEDURE Clone(): Expression;
  2552. VAR copy: EnumerationValue;
  2553. BEGIN
  2554. NEW(copy, position, value); RETURN copy
  2555. END Clone;
  2556. PROCEDURE Accept*(v: Visitor);
  2557. VAR position: LONGINT;
  2558. BEGIN position := SELF.position.start; v.VisitEnumerationValue(SELF)
  2559. END Accept;
  2560. PROCEDURE Equals*(v: Value):BOOLEAN;
  2561. BEGIN RETURN (v IS EnumerationValue) & (v(EnumerationValue).value = value); END Equals;
  2562. END EnumerationValue;
  2563. (**** symbols ****)
  2564. Symbol*= OBJECT
  2565. VAR
  2566. nextSymbol-: Symbol;
  2567. name-: Identifier; (* constant / variable / parameter / type name / module name *)
  2568. externalName-: Scanner.StringType; (* variable / procedure *)
  2569. access-: SET; (* access flags (exported, readonly etc.) *)
  2570. type-: Type; (* type of constant / variable / parameter / procedure return type *)
  2571. scope-:Scope; (* container of symbol *)
  2572. offsetInBits-: LONGINT; (* offset in stack or heap, in bits *)
  2573. used-, written-: BOOLEAN;
  2574. fixed-: BOOLEAN;
  2575. alignment-: LONGINT;
  2576. position-, end-: Position; state-: SET;
  2577. fingerprint-: FingerPrint;
  2578. comment-: Comment;
  2579. PROCEDURE & InitSymbol(position: Position; name:Identifier);
  2580. BEGIN
  2581. SELF.position := position; state := Undefined;
  2582. SELF.end := invalidPosition;
  2583. nextSymbol := NIL;
  2584. SELF.name := name;
  2585. externalName := NIL;
  2586. scope:= NIL;
  2587. type := NIL;
  2588. access := Internal;
  2589. state := Undefined;
  2590. offsetInBits := MIN(LONGINT);
  2591. alignment := 0; (* take default *)
  2592. fixed := FALSE;
  2593. used := FALSE; written := FALSE;
  2594. InitFingerPrint(fingerprint);
  2595. comment := NIL;
  2596. END InitSymbol;
  2597. PROCEDURE SetAlignment*(fix: BOOLEAN; align: LONGINT);
  2598. BEGIN SELF.alignment := align; fixed := fix;
  2599. END SetAlignment;
  2600. PROCEDURE SetFingerPrint*(CONST fp: FingerPrint);
  2601. BEGIN
  2602. SELF.fingerprint := fp
  2603. END SetFingerPrint;
  2604. PROCEDURE SetState*(state: LONGINT);
  2605. BEGIN INCL(SELF.state,state);
  2606. END SetState;
  2607. PROCEDURE SetScope*(scope: Scope);
  2608. BEGIN SELF.scope := scope
  2609. END SetScope;
  2610. PROCEDURE SetType*(type: Type);
  2611. BEGIN
  2612. SELF.type := type;
  2613. END SetType;
  2614. PROCEDURE SetNext*(symbol: Symbol);
  2615. BEGIN SELF.nextSymbol := symbol; END SetNext;
  2616. PROCEDURE SetAccess*(access: SET);
  2617. BEGIN
  2618. (* consistency guarantee *)
  2619. IF PublicWrite IN access THEN ASSERT(ProtectedWrite IN access) END;
  2620. IF ProtectedWrite IN access THEN ASSERT(InternalWrite IN access) END;
  2621. IF PublicRead IN access THEN ASSERT(ProtectedRead IN access) END;
  2622. IF ProtectedRead IN access THEN ASSERT(InternalRead IN access)END;
  2623. SELF.access := access;
  2624. END SetAccess;
  2625. PROCEDURE SetOffset*(ofs: LONGINT);
  2626. BEGIN offsetInBits := ofs
  2627. END SetOffset;
  2628. PROCEDURE MarkUsed*;
  2629. BEGIN used := TRUE
  2630. END MarkUsed;
  2631. PROCEDURE MarkWritten*;
  2632. BEGIN written := TRUE
  2633. END MarkWritten;
  2634. PROCEDURE GetName*(VAR str: ARRAY OF CHAR);
  2635. BEGIN Basic.GetString(name, str);
  2636. END GetName;
  2637. PROCEDURE SetComment*(comment: Comment);
  2638. BEGIN SELF.comment := comment
  2639. END SetComment;
  2640. PROCEDURE Accept*(v: Visitor);
  2641. VAR position: LONGINT;
  2642. BEGIN position := SELF.position.start; v.VisitSymbol(SELF)
  2643. END Accept;
  2644. PROCEDURE SetExternalName*(name: Scanner.StringType);
  2645. BEGIN externalName := name;
  2646. END SetExternalName;
  2647. PROCEDURE NeedsTrace* (): BOOLEAN;
  2648. BEGIN RETURN FALSE;
  2649. END NeedsTrace;
  2650. (* If a symbol needs to be vieible in the object file
  2651. A symbol needs to be visible in an object file when it is require during linking
  2652. This is the case for exported symbols but also for methods in a method table, for instance.
  2653. *)
  2654. PROCEDURE NeedsSection*(): BOOLEAN;
  2655. BEGIN
  2656. RETURN access * Public # {};
  2657. END NeedsSection;
  2658. END Symbol;
  2659. (**
  2660. <<TYPE name = declaredType>>
  2661. TypeDeclaration symbol represents a type declaration of the form TYPE name = declaredType.
  2662. Note that the declared type is not stored in the symbol's type field but rather in the declaredType field.
  2663. The type of a type declaration is set to "typeDeclarationType" in the semantic checker
  2664. **)
  2665. TypeDeclaration*= OBJECT(Symbol)
  2666. VAR
  2667. nextTypeDeclaration-: TypeDeclaration;
  2668. declaredType-: Type;
  2669. PROCEDURE &InitTypeDeclaration(position: Position; name: Identifier);
  2670. BEGIN
  2671. InitSymbol(position,name);
  2672. nextTypeDeclaration := NIL;
  2673. declaredType := NIL;
  2674. type := typeDeclarationType;
  2675. END InitTypeDeclaration;
  2676. PROCEDURE SetDeclaredType*(type: Type);
  2677. BEGIN
  2678. declaredType := type;
  2679. IF ~(type IS BasicType) THEN
  2680. type.typeDeclaration := SELF;
  2681. END;
  2682. END SetDeclaredType;
  2683. PROCEDURE SetType*(type: Type);
  2684. BEGIN
  2685. ASSERT(type = typeDeclarationType);
  2686. END SetType;
  2687. PROCEDURE Accept*(v: Visitor);
  2688. VAR position: LONGINT;
  2689. BEGIN position := SELF.position.start; v.VisitTypeDeclaration(SELF)
  2690. END Accept;
  2691. (* type declarations should be generally included in object files *)
  2692. PROCEDURE NeedsSection*(): BOOLEAN;
  2693. BEGIN
  2694. RETURN TRUE;
  2695. END NeedsSection;
  2696. END TypeDeclaration;
  2697. (** <<CONST name = value >>
  2698. Constant declaration symbol. Represents a constant being defined in the form CONST name = value
  2699. The type of the constant is stored in the type field and is resolved by the semantic checker.
  2700. **)
  2701. Constant* = OBJECT (Symbol)
  2702. VAR
  2703. value-: Expression;
  2704. nextConstant-: Constant;
  2705. PROCEDURE & InitConstant( position: Position; name: Identifier );
  2706. BEGIN
  2707. InitSymbol(position,name);
  2708. value := NIL;
  2709. nextConstant := NIL;
  2710. END InitConstant;
  2711. PROCEDURE SetValue*( value: Expression );
  2712. BEGIN
  2713. SELF.value := value;
  2714. END SetValue;
  2715. PROCEDURE Accept*(v: Visitor);
  2716. VAR position: LONGINT;
  2717. BEGIN position := SELF.position.start; v.VisitConstant(SELF)
  2718. END Accept;
  2719. END Constant;
  2720. (** <<VAR name: type >>
  2721. Variable declaration symbol. Represents a variable defined in the form VAR name: Type.
  2722. The type of the variable is stored in the symbol's type field and is resolved by the semantic checker.
  2723. **)
  2724. Variable* = OBJECT (Symbol)
  2725. VAR
  2726. nextVariable-: Variable;
  2727. untraced-: BOOLEAN;
  2728. fictive-: BOOLEAN; (* variable is not allocated but has a fixed offset *)
  2729. fictiveOffset-: LONGINT; (* offset of fictive as provided by the source code *)
  2730. useRegister-: BOOLEAN; registerNumber-: LONGINT;
  2731. modifiers-: Modifier;
  2732. initializer-: Expression;
  2733. usedAsReference-: BOOLEAN;
  2734. PROCEDURE & InitVariable*( position: Position; name: Identifier);
  2735. BEGIN
  2736. InitSymbol(position,name);
  2737. nextVariable := NIL;
  2738. modifiers := NIL;
  2739. untraced := FALSE;
  2740. modifiers := NIL;
  2741. useRegister := FALSE;
  2742. registerNumber := -1;
  2743. usedAsReference := FALSE;
  2744. initializer := NIL;
  2745. fictive := FALSE;
  2746. END InitVariable;
  2747. PROCEDURE UsedAsReference*;
  2748. BEGIN
  2749. usedAsReference := TRUE
  2750. END UsedAsReference;
  2751. PROCEDURE SetUntraced*(u: BOOLEAN);
  2752. BEGIN untraced := u
  2753. END SetUntraced;
  2754. PROCEDURE SetUseRegister*(u: BOOLEAN);
  2755. BEGIN
  2756. useRegister := u
  2757. END SetUseRegister;
  2758. PROCEDURE SetRegisterNumber*(reg: LONGINT);
  2759. BEGIN
  2760. registerNumber := reg
  2761. END SetRegisterNumber;
  2762. PROCEDURE SetFictive*(offset: LONGINT);
  2763. BEGIN
  2764. fictive := TRUE;
  2765. fictiveOffset := offset;
  2766. END SetFictive;
  2767. PROCEDURE SetModifiers*(flag: Modifier);
  2768. BEGIN SELF.modifiers := flag;
  2769. END SetModifiers;
  2770. PROCEDURE SetInitializer*(initializer: Expression);
  2771. BEGIN SELF.initializer := initializer;
  2772. END SetInitializer;
  2773. PROCEDURE Accept*(v: Visitor);
  2774. VAR position: LONGINT;
  2775. BEGIN position := SELF.position.start; v.VisitVariable(SELF)
  2776. END Accept;
  2777. PROCEDURE NeedsTrace* (): BOOLEAN;
  2778. BEGIN RETURN ~untraced & (externalName = NIL) & type.NeedsTrace ();
  2779. END NeedsTrace;
  2780. END Variable;
  2781. (** << [VAR | CONST] name: type >>
  2782. Parameter declaration symbol. Represents a parameter in the form [VAR | CONST] name: Type.
  2783. The parameter's type is stored in the symbol's type field and is resolved by the semantic checker.
  2784. **)
  2785. Parameter* = OBJECT (Symbol)
  2786. VAR
  2787. nextParameter-, prevParameter-: Parameter;
  2788. modifiers-: Modifier;
  2789. defaultValue-: Expression;
  2790. kind-: LONGINT; (* ValueParameter, ConstParameter, VarParameter *)
  2791. ownerType-: Type;
  2792. untraced-: BOOLEAN;
  2793. movable-: BOOLEAN;
  2794. selfParameter-: BOOLEAN;
  2795. PROCEDURE & InitParameter( position: Position; ownerType: Type ; name: Identifier; kind: LONGINT);
  2796. BEGIN
  2797. InitSymbol( position, name );
  2798. SELF.kind := kind;
  2799. IF kind = ConstParameter THEN access := access END;
  2800. nextParameter := NIL;
  2801. SELF.ownerType := ownerType;
  2802. modifiers := NIL;
  2803. untraced := FALSE;
  2804. defaultValue := NIL;
  2805. movable := FALSE;
  2806. selfParameter := FALSE;
  2807. END InitParameter;
  2808. PROCEDURE SetModifiers*(flag: Modifier);
  2809. BEGIN SELF.modifiers := flag;
  2810. END SetModifiers;
  2811. PROCEDURE SetUntraced*(untraced: BOOLEAN);
  2812. BEGIN SELF.untraced := untraced
  2813. END SetUntraced;
  2814. PROCEDURE SetMoveable*(movable: BOOLEAN);
  2815. BEGIN SELF.movable := movable
  2816. END SetMoveable;
  2817. PROCEDURE SetSelfParameter*(b: BOOLEAN);
  2818. BEGIN
  2819. selfParameter := b;
  2820. END SetSelfParameter;
  2821. PROCEDURE SetDefaultValue*(e: Expression);
  2822. BEGIN defaultValue := e
  2823. END SetDefaultValue;
  2824. PROCEDURE Accept*(v: Visitor);
  2825. VAR position: LONGINT;
  2826. BEGIN position := SELF.position.start; v.VisitParameter(SELF)
  2827. END Accept;
  2828. PROCEDURE SetKind*(kind: LONGINT);
  2829. BEGIN SELF.kind := kind; END SetKind;
  2830. PROCEDURE NeedsTrace* (): BOOLEAN;
  2831. BEGIN RETURN ~untraced & type.NeedsTrace ();
  2832. END NeedsTrace;
  2833. END Parameter;
  2834. Property* = OBJECT (Variable)
  2835. VAR
  2836. nextProperty-, prevProperty-: Property;
  2837. value-: Expression;
  2838. PROCEDURE & InitProperty(position: Position; name: Identifier);
  2839. BEGIN
  2840. InitSymbol( position, name );
  2841. END InitProperty;
  2842. PROCEDURE SetValue*(e: Expression);
  2843. BEGIN value := e
  2844. END SetValue;
  2845. PROCEDURE Accept*(v: Visitor);
  2846. VAR position: LONGINT;
  2847. BEGIN position := SELF.position.start; v.VisitProperty(SELF)
  2848. END Accept;
  2849. END Property;
  2850. (** Procedure declaration symbol. Represents a procedure being defined in the form PROCEDURE name(parameters): returnType;
  2851. Note that the type of a procedure is a ProcedureType (and not the return type of the procedure).
  2852. Parameters, local variables, constants and type declarations are stored in the procedureScope field.
  2853. **)
  2854. Procedure* = OBJECT (Symbol)
  2855. VAR
  2856. nextProcedure-: Procedure;
  2857. procedureScope- : ProcedureScope;
  2858. super-: Procedure;
  2859. level-, methodNumber-: LONGINT;
  2860. isBodyProcedure-, isConstructor-,isFinalizer-,isInline-,isOberonInline-, isEntry-, isExit-,isFinal-,isAbstract-,isOverwritten-: BOOLEAN;
  2861. PROCEDURE & InitProcedure( position: Position; name: Identifier; scope: ProcedureScope);
  2862. BEGIN
  2863. InitSymbol(position,name);
  2864. nextProcedure := NIL;
  2865. procedureScope := scope;
  2866. ASSERT(scope.ownerProcedure = NIL); (* cannot register twice ! *)
  2867. scope.ownerProcedure := SELF;
  2868. super := NIL;
  2869. level := 0;
  2870. methodNumber := -1;
  2871. isBodyProcedure := FALSE;
  2872. isConstructor := FALSE;
  2873. isFinalizer := FALSE;
  2874. isInline := FALSE;
  2875. isOberonInline := FALSE;
  2876. isEntry := FALSE;
  2877. isExit := FALSE;
  2878. isFinal := FALSE;
  2879. isAbstract := FALSE;
  2880. isOverwritten := FALSE;
  2881. END InitProcedure;
  2882. PROCEDURE SetSuper*(super: Procedure);
  2883. BEGIN
  2884. SELF.super := super
  2885. END SetSuper;
  2886. PROCEDURE SetBodyProcedure*(isBodyProcedure: BOOLEAN);
  2887. BEGIN SELF.isBodyProcedure := isBodyProcedure;
  2888. END SetBodyProcedure;
  2889. PROCEDURE SetConstructor*(isConstructor: BOOLEAN);
  2890. BEGIN SELF.isConstructor := isConstructor
  2891. END SetConstructor;
  2892. PROCEDURE SetFinalizer*(isFinalizer: BOOLEAN);
  2893. BEGIN SELF.isFinalizer := isFinalizer
  2894. END SetFinalizer;
  2895. PROCEDURE SetInline*(isInline: BOOLEAN);
  2896. BEGIN SELF.isInline := isInline
  2897. END SetInline;
  2898. PROCEDURE SetOberonInline*(isInline: BOOLEAN);
  2899. BEGIN SELF.isOberonInline := isInline
  2900. END SetOberonInline;
  2901. PROCEDURE SetEntry*(entry: BOOLEAN);
  2902. BEGIN SELF.isEntry := entry
  2903. END SetEntry;
  2904. PROCEDURE SetExit*(exit: BOOLEAN);
  2905. BEGIN SELF.isExit := exit
  2906. END SetExit;
  2907. PROCEDURE SetFinal*(final: BOOLEAN);
  2908. BEGIN SELF.isFinal := final
  2909. END SetFinal;
  2910. PROCEDURE SetOverwritten*(locallyOverwritten: BOOLEAN);
  2911. BEGIN SELF.isOverwritten := locallyOverwritten
  2912. END SetOverwritten;
  2913. PROCEDURE SetAbstract*(abstract: BOOLEAN);
  2914. BEGIN SELF.isAbstract := abstract
  2915. END SetAbstract;
  2916. PROCEDURE SetLevel*(level: LONGINT);
  2917. BEGIN SELF.level := level
  2918. END SetLevel;
  2919. PROCEDURE SetMethodNumber*(methodNumber: LONGINT);
  2920. BEGIN SELF.methodNumber := methodNumber
  2921. END SetMethodNumber;
  2922. PROCEDURE NeedsSection*(): BOOLEAN;
  2923. BEGIN
  2924. RETURN (access * Public # {}) OR (methodNumber >= 0);
  2925. END NeedsSection;
  2926. PROCEDURE Accept*(v: Visitor);
  2927. VAR position: LONGINT;
  2928. BEGIN position := SELF.position.start; v.VisitProcedure(SELF)
  2929. END Accept;
  2930. END Procedure;
  2931. (** Builtin symbol stands for a builtin procedure. Is resolved by the semantic checker. **)
  2932. Builtin* = OBJECT (Symbol)
  2933. VAR
  2934. nextBuiltin-: Builtin;
  2935. id-: LONGINT;
  2936. PROCEDURE & InitBuiltin(position: Position; name:Identifier; id: LONGINT);
  2937. BEGIN
  2938. InitSymbol(position,name); SELF.id := id;
  2939. END InitBuiltin;
  2940. PROCEDURE Accept*(v: Visitor);
  2941. VAR position: LONGINT;
  2942. BEGIN position := SELF.position.start; v.VisitBuiltin(SELF)
  2943. END Accept;
  2944. END Builtin;
  2945. CustomBuiltin*=OBJECT (Builtin)
  2946. VAR
  2947. subType-: SHORTINT;
  2948. PROCEDURE & InitCustomBuiltin(position: Position; name: Identifier; id: LONGINT; subType: SHORTINT);
  2949. BEGIN
  2950. InitBuiltin(position,name,id);
  2951. SELF.subType := subType;
  2952. END InitCustomBuiltin;
  2953. (* TODO: check if this is correct *)
  2954. PROCEDURE CompatibleTo*(otherType: Type): BOOLEAN;
  2955. BEGIN RETURN FALSE
  2956. END CompatibleTo;
  2957. END CustomBuiltin;
  2958. Operator* = OBJECT (Procedure)
  2959. VAR
  2960. nextOperator-: Operator;
  2961. isDynamic-: BOOLEAN; (* nopov *)
  2962. PROCEDURE & InitOperator(position: Position; name: Identifier; scope: ProcedureScope);
  2963. BEGIN
  2964. InitProcedure(position,name,scope);
  2965. nextOperator := NIL;
  2966. isDynamic := FALSE
  2967. END InitOperator;
  2968. (* nopov *)
  2969. PROCEDURE SetDynamic*(isDynamic: BOOLEAN);
  2970. BEGIN SELF.isDynamic := isDynamic
  2971. END SetDynamic;
  2972. PROCEDURE Accept*(v: Visitor);
  2973. VAR position: LONGINT;
  2974. BEGIN position := SELF.position.start; v.VisitOperator(SELF)
  2975. END Accept;
  2976. END Operator;
  2977. Import* = OBJECT (Symbol)
  2978. VAR
  2979. nextImport-: Import;
  2980. module-: Module;
  2981. moduleName-: Identifier;
  2982. context-: Identifier;
  2983. direct-: BOOLEAN; (* direct import *)
  2984. PROCEDURE & InitImport( position: Position; name, moduleName: Identifier; direct: BOOLEAN );
  2985. BEGIN
  2986. InitSymbol(position,name);
  2987. SELF.direct := direct;
  2988. module := NIL;
  2989. context := invalidIdentifier;
  2990. SELF.moduleName := moduleName;
  2991. type := importType;
  2992. END InitImport;
  2993. PROCEDURE SetType*(type: Type);
  2994. BEGIN
  2995. ASSERT(type = importType);
  2996. END SetType;
  2997. PROCEDURE SetModule*(module: Module);
  2998. BEGIN
  2999. SELF.module := module;
  3000. END SetModule;
  3001. PROCEDURE SetDirect*(d: BOOLEAN);
  3002. BEGIN
  3003. direct := d
  3004. END SetDirect;
  3005. PROCEDURE SetModuleName*(moduleName: Identifier);
  3006. BEGIN SELF.moduleName := moduleName
  3007. END SetModuleName;
  3008. PROCEDURE SetContext*(context: Identifier);
  3009. BEGIN
  3010. SELF.context := context
  3011. END SetContext;
  3012. PROCEDURE Accept*(v: Visitor);
  3013. VAR position: LONGINT;
  3014. BEGIN position := SELF.position.start; v.VisitImport(SELF)
  3015. END Accept;
  3016. END Import;
  3017. StatementSequence* = OBJECT
  3018. VAR
  3019. list: Basic.List;
  3020. PROCEDURE & InitList;
  3021. BEGIN NEW( list,32 );
  3022. END InitList;
  3023. PROCEDURE Length*( ): LONGINT;
  3024. BEGIN RETURN list.Length();
  3025. END Length;
  3026. PROCEDURE AddStatement*( statement: Statement);
  3027. BEGIN list.Add( statement );
  3028. END AddStatement;
  3029. PROCEDURE PrependStatement*( statement: Statement);
  3030. BEGIN list.Prepend( statement );
  3031. END PrependStatement;
  3032. PROCEDURE HasStatement*( statement: Statement):BOOLEAN;
  3033. BEGIN RETURN list.Contains(statement);
  3034. END HasStatement;
  3035. PROCEDURE GetStatement*( index: LONGINT ): Statement;
  3036. VAR p: ANY;
  3037. BEGIN p := list.Get( index ); RETURN p( Statement );
  3038. END GetStatement;
  3039. PROCEDURE SetStatement*(index: LONGINT; statement: Statement);
  3040. BEGIN
  3041. list.Set(index,statement);
  3042. END SetStatement;
  3043. PROCEDURE RemoveStatement*(statement: Statement);
  3044. BEGIN
  3045. list.Remove(statement);
  3046. END RemoveStatement;
  3047. PROCEDURE InsertBefore*(search, new: Statement);
  3048. BEGIN
  3049. list.Insert(list.IndexOf(search), new);
  3050. END InsertBefore;
  3051. PROCEDURE Clone(VAR copy: StatementSequence);
  3052. VAR i: LONGINT;
  3053. BEGIN
  3054. IF copy = NIL THEN NEW(copy) END;
  3055. FOR i := 0 TO Length()-1 DO
  3056. copy.AddStatement(CloneStatement(GetStatement(i)))
  3057. END;
  3058. END Clone;
  3059. END StatementSequence;
  3060. (**** statements ****)
  3061. Statement*= OBJECT
  3062. VAR outer-: Statement;
  3063. position-,end-: Position;
  3064. isUnreachable-: BOOLEAN;
  3065. comment-: Comment;
  3066. PROCEDURE & InitStatement*(position: Position; outer: Statement);
  3067. BEGIN
  3068. SELF.position := position;
  3069. end := invalidPosition;
  3070. SELF.outer := outer;
  3071. isUnreachable := FALSE;
  3072. comment := NIL;
  3073. END InitStatement;
  3074. PROCEDURE SetOuter*(o: Statement);
  3075. BEGIN outer := o
  3076. END SetOuter;
  3077. PROCEDURE SetUnreachable*(unreachable: BOOLEAN);
  3078. BEGIN isUnreachable := unreachable
  3079. END SetUnreachable;
  3080. PROCEDURE Accept*(v: Visitor);
  3081. VAR position: LONGINT;
  3082. BEGIN position := SELF.position.start; v.VisitStatement(SELF)
  3083. END Accept;
  3084. PROCEDURE SetComment*(comment: Comment);
  3085. BEGIN SELF.comment := comment
  3086. END SetComment;
  3087. PROCEDURE Clone(): Statement;
  3088. BEGIN
  3089. HALT(200) (* abstract *)
  3090. END Clone;
  3091. PROCEDURE End*(pos: Position);
  3092. BEGIN
  3093. end := pos;
  3094. END End;
  3095. END Statement;
  3096. (** << call(...) >> **)
  3097. ProcedureCallStatement*= OBJECT(Statement)
  3098. VAR call-: Designator;
  3099. PROCEDURE & InitProcedureCallStatement(position: Position; call: Designator; outer: Statement);
  3100. BEGIN InitStatement(position,outer); SELF.call := call;
  3101. END InitProcedureCallStatement;
  3102. PROCEDURE SetCall*(call: Designator);
  3103. BEGIN SELF.call := call;
  3104. END SetCall;
  3105. PROCEDURE Clone(): Statement;
  3106. VAR copy: ProcedureCallStatement;
  3107. BEGIN
  3108. NEW(copy, position, CloneDesignator(call), outer);
  3109. RETURN copy
  3110. END Clone;
  3111. PROCEDURE Accept*(v: Visitor);
  3112. VAR position: LONGINT;
  3113. BEGIN position := SELF.position.start; v.VisitProcedureCallStatement(SELF)
  3114. END Accept;
  3115. END ProcedureCallStatement;
  3116. (** << left := right >> **)
  3117. Assignment* = OBJECT (Statement)
  3118. VAR left-: Designator; right-: Expression;
  3119. PROCEDURE & InitAssignment*( position: Position; left: Designator; right: Expression; outer: Statement );
  3120. BEGIN
  3121. InitStatement( position,outer ); SELF.left := left; SELF.right := right;
  3122. END InitAssignment;
  3123. PROCEDURE SetLeft*(left: Designator);
  3124. BEGIN SELF.left := left
  3125. END SetLeft;
  3126. PROCEDURE SetRight*(right: Expression);
  3127. BEGIN SELF.right := right
  3128. END SetRight;
  3129. PROCEDURE Clone(): Statement;
  3130. VAR copy: Assignment;
  3131. BEGIN
  3132. NEW(copy, position, CloneDesignator(left), CloneExpression(right), outer);
  3133. RETURN copy
  3134. END Clone;
  3135. PROCEDURE Accept*(v: Visitor);
  3136. VAR position: LONGINT;
  3137. BEGIN position := SELF.position.start; v.VisitAssignment(SELF)
  3138. END Accept;
  3139. END Assignment;
  3140. (** << left ('!' | '?' | '<<' | '>>') right >> **)
  3141. CommunicationStatement* = OBJECT (Statement)
  3142. VAR
  3143. left-: Designator; right-: Expression; op-: LONGINT;
  3144. PROCEDURE & InitAssignment*( position: Position; op: LONGINT; left: Designator; right: Expression; outer: Statement );
  3145. BEGIN
  3146. InitStatement( position,outer ); SELF.op := op; SELF.left := left; SELF.right := right;
  3147. END InitAssignment;
  3148. PROCEDURE SetLeft*(left: Designator);
  3149. BEGIN SELF.left := left
  3150. END SetLeft;
  3151. PROCEDURE SetRight*(right: Expression);
  3152. BEGIN SELF.right := right
  3153. END SetRight;
  3154. PROCEDURE Accept*(v: Visitor);
  3155. VAR position: LONGINT;
  3156. BEGIN position := SELF.position.start; v.VisitCommunicationStatement(SELF)
  3157. END Accept;
  3158. END CommunicationStatement;
  3159. Part*= OBJECT
  3160. VAR
  3161. position-, end-: Position;
  3162. PROCEDURE InitPart;
  3163. BEGIN
  3164. position := invalidPosition; end := invalidPosition;
  3165. END InitPart;
  3166. PROCEDURE SetPosition*(pos: Position);
  3167. BEGIN
  3168. position := pos;
  3169. END SetPosition;
  3170. PROCEDURE SetEnd*(pos: Position);
  3171. BEGIN
  3172. end := pos;
  3173. END SetEnd;
  3174. END Part;
  3175. (** << ... condition THEN statements ... >> **)
  3176. IfPart*= OBJECT (Part)
  3177. VAR
  3178. condition-: Expression;
  3179. statements-: StatementSequence;
  3180. comment-: Comment;
  3181. PROCEDURE & InitIfPart;
  3182. BEGIN
  3183. InitPart;
  3184. statements := NIL; condition := NIL; comment := NIL;
  3185. END InitIfPart;
  3186. PROCEDURE SetCondition*(condition: Expression);
  3187. BEGIN SELF.condition := condition
  3188. END SetCondition;
  3189. PROCEDURE SetStatements*(statements: StatementSequence);
  3190. BEGIN SELF.statements := statements
  3191. END SetStatements;
  3192. PROCEDURE SetComment*(comment: Comment);
  3193. BEGIN SELF.comment := comment
  3194. END SetComment;
  3195. PROCEDURE Clone(): IfPart;
  3196. VAR copy: IfPart;
  3197. BEGIN
  3198. NEW(copy); copy.condition := CloneExpression(condition);
  3199. copy.statements := CloneStatementSequence(statements);
  3200. RETURN copy
  3201. END Clone;
  3202. END IfPart;
  3203. (** << IF ifPart {ELSIF elsifParts} ELSE elseParts >> **)
  3204. IfStatement* = OBJECT (Statement)
  3205. VAR
  3206. ifPart-: IfPart;
  3207. elsifParts: Basic.List;
  3208. elsePart-: StatementSequence;
  3209. PROCEDURE & InitIfStatement( position: Position ; outer: Statement);
  3210. BEGIN
  3211. InitStatement( position,outer ); ifPart := NewIfPart();
  3212. ifPart.SetPosition(position);
  3213. elsePart := NIL; elsifParts := NIL;
  3214. END InitIfStatement;
  3215. PROCEDURE SetElsePart*( elsePart: StatementSequence );
  3216. BEGIN
  3217. SELF.elsePart := elsePart;
  3218. END SetElsePart;
  3219. PROCEDURE AddElsifPart*( elsifPart: IfPart );
  3220. BEGIN
  3221. IF elsifParts = NIL THEN NEW(elsifParts,4); END;
  3222. elsifParts.Add( elsifPart );
  3223. END AddElsifPart;
  3224. PROCEDURE GetElsifPart*( i: LONGINT ): IfPart;
  3225. VAR a: ANY;
  3226. BEGIN a := elsifParts.Get( i ); RETURN a( IfPart )
  3227. END GetElsifPart;
  3228. PROCEDURE ElsifParts*( ): LONGINT;
  3229. BEGIN
  3230. IF elsifParts = NIL THEN RETURN 0 ELSE RETURN elsifParts.Length(); END;
  3231. END ElsifParts;
  3232. PROCEDURE Clone(): Statement;
  3233. VAR copy: IfStatement; i: LONGINT;
  3234. BEGIN
  3235. NEW(copy, position, outer);
  3236. copy.ifPart := ifPart.Clone();
  3237. FOR i := 0 TO ElsifParts()-1 DO
  3238. copy.AddElsifPart(GetElsifPart(i).Clone());
  3239. END;
  3240. copy.SetElsePart(CloneStatementSequence(elsePart));
  3241. RETURN copy
  3242. END Clone;
  3243. PROCEDURE Accept*(v: Visitor);
  3244. VAR position: LONGINT;
  3245. BEGIN position := SELF.position.start; v.VisitIfStatement(SELF)
  3246. END Accept;
  3247. END IfStatement;
  3248. WithPart*= OBJECT (Part)
  3249. VAR
  3250. type-: Type; (* initially is qualified type *)
  3251. statements-: StatementSequence;
  3252. comment-: Comment;
  3253. PROCEDURE &InitWithPart();
  3254. BEGIN
  3255. InitPart();
  3256. type := NIL; statements := NIL; comment := NIL;
  3257. END InitWithPart;
  3258. PROCEDURE SetType*( type: Type );
  3259. BEGIN
  3260. SELF.type := type
  3261. END SetType;
  3262. PROCEDURE SetStatements*( statements: StatementSequence );
  3263. BEGIN
  3264. SELF.statements := statements;
  3265. END SetStatements;
  3266. PROCEDURE SetComment*(comment: Comment);
  3267. BEGIN SELF.comment := comment
  3268. END SetComment;
  3269. PROCEDURE Clone(): WithPart;
  3270. VAR copy: WithPart;
  3271. BEGIN
  3272. NEW(copy);
  3273. copy.SetType(type);
  3274. copy.SetStatements(CloneStatementSequence(statements));
  3275. RETURN copy
  3276. END Clone;
  3277. END WithPart;
  3278. (** << WITH variable : type DO statements END >> **)
  3279. WithStatement* = OBJECT (Statement)
  3280. VAR
  3281. variable-: Designator;
  3282. withParts-: Basic.List;
  3283. elsePart-: StatementSequence;
  3284. PROCEDURE & InitWithStatement( position: Position; outer: Statement );
  3285. BEGIN
  3286. InitStatement( position,outer );
  3287. NEW(withParts,4); elsePart := NIL;
  3288. variable := NIL;
  3289. END InitWithStatement;
  3290. PROCEDURE SetVariable*( variable: Designator);
  3291. BEGIN
  3292. SELF.variable := variable
  3293. END SetVariable;
  3294. PROCEDURE AddWithPart*( withPart: WithPart );
  3295. BEGIN withParts.Add( withPart );
  3296. END AddWithPart;
  3297. PROCEDURE GetWithPart*( i: LONGINT ): WithPart;
  3298. VAR a: ANY;
  3299. BEGIN a := withParts.Get( i ); RETURN a( WithPart )
  3300. END GetWithPart;
  3301. PROCEDURE WithParts*( ): LONGINT;
  3302. BEGIN
  3303. IF withParts = NIL THEN RETURN 0 ELSE RETURN withParts.Length(); END;
  3304. END WithParts;
  3305. PROCEDURE SetElsePart*( elsePart: StatementSequence );
  3306. BEGIN
  3307. SELF.elsePart := elsePart;
  3308. END SetElsePart;
  3309. PROCEDURE Clone(): Statement;
  3310. VAR copy: WithStatement; i: LONGINT;
  3311. BEGIN
  3312. NEW(copy, position, outer);
  3313. FOR i := 0 TO WithParts()-1 DO
  3314. copy.AddWithPart(GetWithPart(i).Clone());
  3315. END;
  3316. copy.SetVariable(CloneDesignator(variable));
  3317. copy.SetElsePart(CloneStatementSequence(elsePart));
  3318. RETURN copy
  3319. END Clone;
  3320. PROCEDURE Accept*(v: Visitor);
  3321. VAR position: LONGINT;
  3322. BEGIN position := SELF.position.start; v.VisitWithStatement(SELF)
  3323. END Accept;
  3324. END WithStatement;
  3325. CaseConstant*= POINTER TO RECORD min*,max*: Basic.Integer; next*: CaseConstant END;
  3326. (** << elements : statements >> **)
  3327. CasePart* = OBJECT (Part)
  3328. VAR
  3329. elements-: ExpressionList; (* expression list inserted by the parser *)
  3330. firstConstant-: CaseConstant; (* expression list resolved to int32s, inserted by checker *)
  3331. statements-: StatementSequence;
  3332. comment-: Comment;
  3333. PROCEDURE & InitCasePart;
  3334. BEGIN
  3335. InitPart;
  3336. elements := NewExpressionList(); firstConstant := NIL;
  3337. END InitCasePart;
  3338. PROCEDURE SetStatements*( statements: StatementSequence );
  3339. BEGIN
  3340. SELF.statements := statements;
  3341. END SetStatements;
  3342. PROCEDURE SetConstants*(firstConstant: CaseConstant);
  3343. BEGIN SELF.firstConstant := firstConstant
  3344. END SetConstants;
  3345. PROCEDURE SetComment*(comment: Comment);
  3346. BEGIN SELF.comment := comment
  3347. END SetComment;
  3348. PROCEDURE Clone(): CasePart;
  3349. VAR copy: CasePart;
  3350. BEGIN
  3351. NEW(copy);
  3352. copy.SetStatements(CloneStatementSequence(statements));
  3353. copy.firstConstant := firstConstant;
  3354. elements.Clone(copy.elements);
  3355. RETURN copy
  3356. END Clone;
  3357. END CasePart;
  3358. (** << CASE varaible OF caseParts ELSE elsePart >> **)
  3359. CaseStatement* = OBJECT (Statement)
  3360. VAR
  3361. variable-: Expression;
  3362. elsePart-: StatementSequence;
  3363. caseParts-: Basic.List;
  3364. min-,max-: Basic.Integer;
  3365. PROCEDURE & InitCaseStatement( position: Position ; outer: Statement);
  3366. BEGIN
  3367. InitStatement(position,outer ); variable := NIL; elsePart := NIL; caseParts := NIL;
  3368. min := MAX(Basic.Integer); max := MIN(Basic.Integer);
  3369. END InitCaseStatement;
  3370. PROCEDURE SetVariable*( expression: Expression );
  3371. BEGIN SELF.variable := expression;
  3372. END SetVariable;
  3373. PROCEDURE SetElsePart*( elsePart: StatementSequence );
  3374. BEGIN SELF.elsePart := elsePart;
  3375. END SetElsePart;
  3376. PROCEDURE AddCasePart*( casePart: CasePart );
  3377. BEGIN
  3378. IF caseParts = NIL THEN NEW(caseParts,4); END;
  3379. caseParts.Add( casePart );
  3380. END AddCasePart;
  3381. PROCEDURE GetCasePart*( i: LONGINT ): CasePart;
  3382. VAR a: ANY;
  3383. BEGIN a := caseParts.Get( i ); RETURN a( CasePart )
  3384. END GetCasePart;
  3385. PROCEDURE CaseParts*( ): LONGINT;
  3386. BEGIN
  3387. IF caseParts = NIL THEN RETURN 0 ELSE RETURN caseParts.Length(); END;
  3388. END CaseParts;
  3389. PROCEDURE Clone(): Statement;
  3390. VAR copy: CaseStatement; i: LONGINT;
  3391. BEGIN
  3392. NEW(copy, position, outer);
  3393. copy.SetVariable(CloneExpression(variable));
  3394. copy.SetElsePart(CloneStatementSequence(elsePart));
  3395. FOR i := 0 TO CaseParts()-1 DO
  3396. copy.AddCasePart(GetCasePart(i).Clone());
  3397. END;
  3398. copy.min := min; copy.max := max;
  3399. RETURN copy
  3400. END Clone;
  3401. PROCEDURE Accept*(v: Visitor);
  3402. VAR position: LONGINT;
  3403. BEGIN position := SELF.position.start; v.VisitCaseStatement(SELF)
  3404. END Accept;
  3405. PROCEDURE MaxConstant*(): Basic.Integer;
  3406. VAR val: Basic.Integer; i: LONGINT; part: CasePart; const: CaseConstant;
  3407. BEGIN
  3408. val := -1;
  3409. FOR i := 0 TO CaseParts() - 1 DO
  3410. part := GetCasePart(i);
  3411. const := part.firstConstant;
  3412. WHILE(const # NIL) DO
  3413. IF const.max > val THEN val := const.max; END;
  3414. const := const.next;
  3415. END;
  3416. END;
  3417. RETURN val;
  3418. END MaxConstant;
  3419. PROCEDURE SetMinMax*(min,max: Basic.Integer);
  3420. BEGIN
  3421. SELF.min := min; SELF.max := max;
  3422. END SetMinMax;
  3423. END CaseStatement;
  3424. (** << WHILE condition DO statements END >> **)
  3425. WhileStatement* = OBJECT (Statement)
  3426. VAR
  3427. condition-: Expression;
  3428. statements-: StatementSequence;
  3429. PROCEDURE & InitWhileStatement( position: Position ; outer: Statement);
  3430. BEGIN
  3431. InitStatement( position,outer ); condition := NIL; statements := NIL;
  3432. END InitWhileStatement;
  3433. PROCEDURE SetCondition*( condition: Expression );
  3434. BEGIN
  3435. SELF.condition := condition
  3436. END SetCondition;
  3437. PROCEDURE SetStatements*( statements: StatementSequence );
  3438. BEGIN
  3439. SELF.statements := statements;
  3440. END SetStatements;
  3441. PROCEDURE Clone(): Statement;
  3442. VAR copy: WhileStatement;
  3443. BEGIN
  3444. NEW(copy, position, outer);
  3445. copy.SetCondition(CloneExpression(condition));
  3446. copy.SetStatements(CloneStatementSequence(statements));
  3447. RETURN copy
  3448. END Clone;
  3449. PROCEDURE Accept*(v: Visitor);
  3450. VAR position: LONGINT;
  3451. BEGIN position := SELF.position.start; v.VisitWhileStatement(SELF)
  3452. END Accept;
  3453. END WhileStatement;
  3454. (** << REPEAT statements UNTIL condition >> **)
  3455. RepeatStatement* = OBJECT (Statement)
  3456. VAR
  3457. condition-: Expression;
  3458. statements-: StatementSequence;
  3459. PROCEDURE & InitRepeatStatement( position: Position; outer: Statement );
  3460. BEGIN
  3461. InitStatement( position,outer ); condition := NIL; statements := NIL;
  3462. END InitRepeatStatement;
  3463. PROCEDURE SetCondition*( condition: Expression );
  3464. BEGIN
  3465. SELF.condition := condition
  3466. END SetCondition;
  3467. PROCEDURE SetStatements*( statements: StatementSequence );
  3468. BEGIN
  3469. SELF.statements := statements;
  3470. END SetStatements;
  3471. PROCEDURE Clone(): Statement;
  3472. VAR copy: RepeatStatement;
  3473. BEGIN
  3474. NEW(copy, position, outer);
  3475. copy.SetCondition(CloneExpression(condition));
  3476. copy.SetStatements(CloneStatementSequence(statements));
  3477. RETURN copy
  3478. END Clone;
  3479. PROCEDURE Accept*(v: Visitor);
  3480. VAR position: LONGINT;
  3481. BEGIN position := SELF.position.start; v.VisitRepeatStatement(SELF)
  3482. END Accept;
  3483. END RepeatStatement;
  3484. (** << FOR variable := from TO to BY by DO statements END >> **)
  3485. ForStatement* = OBJECT (Statement)
  3486. VAR
  3487. variable-: Designator;
  3488. from-, to-, by-: Expression;
  3489. statements-: StatementSequence;
  3490. PROCEDURE & InitForStatement( position: Position; outer: Statement );
  3491. BEGIN
  3492. InitStatement( position,outer ); variable := NIL;from := NIL; to := NIL; by := NIL; statements := NIL;
  3493. END InitForStatement;
  3494. PROCEDURE SetVariable*( variable: Designator);
  3495. BEGIN
  3496. SELF.variable := variable
  3497. END SetVariable;
  3498. PROCEDURE SetFrom*( from: Expression );
  3499. BEGIN
  3500. SELF.from := from
  3501. END SetFrom;
  3502. PROCEDURE SetTo*( to: Expression );
  3503. BEGIN
  3504. SELF.to := to
  3505. END SetTo;
  3506. PROCEDURE SetBy*( by: Expression );
  3507. BEGIN SELF.by := by
  3508. END SetBy;
  3509. PROCEDURE SetStatements*( statements: StatementSequence );
  3510. BEGIN SELF.statements := statements;
  3511. END SetStatements;
  3512. PROCEDURE Clone(): Statement;
  3513. VAR copy: ForStatement;
  3514. BEGIN
  3515. NEW(copy, position, outer);
  3516. copy.SetVariable(CloneDesignator(variable));
  3517. copy.SetFrom(CloneExpression(from));
  3518. copy.SetTo(CloneExpression(to));
  3519. copy.SetBy(CloneExpression(by));
  3520. copy.SetStatements(CloneStatementSequence(statements));
  3521. RETURN copy
  3522. END Clone;
  3523. PROCEDURE Accept*(v: Visitor);
  3524. VAR position: LONGINT;
  3525. BEGIN position := SELF.position.start; v.VisitForStatement(SELF)
  3526. END Accept;
  3527. END ForStatement;
  3528. ExitableBlock*= OBJECT (Statement)
  3529. VAR statements-: StatementSequence;
  3530. PROCEDURE & InitExitableBlock( position: Position ; outer: Statement);
  3531. BEGIN
  3532. InitStatement( position ,outer); statements := NIL;
  3533. END InitExitableBlock;
  3534. PROCEDURE SetStatements*( statements: StatementSequence );
  3535. BEGIN SELF.statements := statements;
  3536. END SetStatements;
  3537. PROCEDURE Clone(): Statement;
  3538. VAR copy: ExitableBlock;
  3539. BEGIN
  3540. NEW(copy, position, outer);
  3541. copy.SetStatements(CloneStatementSequence(statements));
  3542. RETURN copy
  3543. END Clone;
  3544. PROCEDURE Accept*(v: Visitor);
  3545. VAR position: LONGINT;
  3546. BEGIN position := SELF.position.start; v.VisitExitableBlock(SELF)
  3547. END Accept;
  3548. END ExitableBlock;
  3549. (** << LOOP statements END >> **)
  3550. LoopStatement* = OBJECT (ExitableBlock)
  3551. PROCEDURE Clone(): Statement;
  3552. VAR copy: LoopStatement;
  3553. BEGIN
  3554. NEW(copy, position, outer);
  3555. copy.SetStatements(CloneStatementSequence(statements));
  3556. RETURN copy
  3557. END Clone;
  3558. PROCEDURE Accept*(v: Visitor);
  3559. VAR position: LONGINT;
  3560. BEGIN position := SELF.position.start; v.VisitLoopStatement(SELF)
  3561. END Accept;
  3562. END LoopStatement;
  3563. (** << EXIT >> **)
  3564. ExitStatement* = OBJECT (Statement)
  3565. PROCEDURE Accept*(v: Visitor);
  3566. VAR position: LONGINT;
  3567. BEGIN position := SELF.position.start; v.VisitExitStatement(SELF)
  3568. END Accept;
  3569. PROCEDURE Clone(): Statement;
  3570. VAR copy: ExitStatement;
  3571. BEGIN
  3572. NEW(copy, position, outer);
  3573. RETURN copy
  3574. END Clone;
  3575. END ExitStatement;
  3576. (** << RETURN returnValue >> **)
  3577. ReturnStatement* = OBJECT (Statement)
  3578. VAR returnValue-: Expression; (* strictly speaking this is not a value but this term is in common use here *)
  3579. PROCEDURE & InitReturnStatement( position: Position ; outer: Statement);
  3580. BEGIN
  3581. InitStatement( position,outer ); returnValue := NIL
  3582. END InitReturnStatement;
  3583. PROCEDURE SetReturnValue*( returnValue: Expression );
  3584. BEGIN SELF.returnValue := returnValue
  3585. END SetReturnValue;
  3586. PROCEDURE Clone(): Statement;
  3587. VAR copy: ReturnStatement;
  3588. BEGIN
  3589. NEW(copy, position, outer);
  3590. copy.SetReturnValue(CloneExpression(returnValue));
  3591. RETURN copy
  3592. END Clone;
  3593. PROCEDURE Accept*(v: Visitor);
  3594. VAR position: LONGINT;
  3595. BEGIN position := SELF.position.start; v.VisitReturnStatement(SELF)
  3596. END Accept;
  3597. END ReturnStatement;
  3598. (** << AWAIT condition >> **)
  3599. AwaitStatement* = OBJECT (Statement)
  3600. VAR condition-: Expression;
  3601. PROCEDURE & InitAwaitStatement( position: Position; outer: Statement );
  3602. BEGIN
  3603. InitStatement( position,outer ); condition := NIL
  3604. END InitAwaitStatement;
  3605. PROCEDURE SetCondition*( condition: Expression );
  3606. BEGIN SELF.condition := condition
  3607. END SetCondition;
  3608. PROCEDURE Clone(): Statement;
  3609. VAR copy: AwaitStatement;
  3610. BEGIN
  3611. NEW(copy, position, outer);
  3612. copy.SetCondition(CloneExpression(condition));
  3613. RETURN copy
  3614. END Clone;
  3615. PROCEDURE Accept*(v: Visitor);
  3616. VAR position: LONGINT;
  3617. BEGIN position := SELF.position.start; v.VisitAwaitStatement(SELF)
  3618. END Accept;
  3619. END AwaitStatement;
  3620. (* << Identifier ( Expression) >> *)
  3621. Modifier*= OBJECT
  3622. VAR
  3623. identifier-: Identifier; expression-: Expression;
  3624. resolved-: BOOLEAN;
  3625. nextModifier-: Modifier;
  3626. position-: Position;
  3627. PROCEDURE & InitModifier(position: Position; identifier: Identifier; expression: Expression);
  3628. BEGIN
  3629. SELF.position := position;
  3630. SELF.identifier := identifier; SELF.expression := expression; nextModifier := NIL; resolved := FALSE;
  3631. END InitModifier;
  3632. PROCEDURE Resolved*;
  3633. BEGIN resolved := TRUE
  3634. END Resolved;
  3635. PROCEDURE SetExpression*(e: Expression);
  3636. BEGIN SELF.expression := e
  3637. END SetExpression;
  3638. PROCEDURE SetNext*(modifier: Modifier);
  3639. BEGIN nextModifier := modifier
  3640. END SetNext;
  3641. END Modifier;
  3642. (** << BEGIN {Modifier, Modifier ... } statements END >> **)
  3643. StatementBlock* = OBJECT (Statement)
  3644. VAR
  3645. statements-: StatementSequence;
  3646. blockModifiers-: Modifier;
  3647. isExclusive-: BOOLEAN;
  3648. isRealtime-: BOOLEAN;
  3649. isUnchecked-: BOOLEAN;
  3650. isUncooperative-: BOOLEAN;
  3651. PROCEDURE & InitStatementBlock( position: Position ; outer: Statement);
  3652. BEGIN
  3653. InitStatement( position ,outer); statements := NIL; blockModifiers := NIL;
  3654. isExclusive := FALSE;
  3655. isRealtime := FALSE;
  3656. isUnchecked := FALSE;
  3657. isUncooperative := FALSE;
  3658. END InitStatementBlock;
  3659. PROCEDURE SetRealtime*(b: BOOLEAN);
  3660. BEGIN
  3661. isRealtime := b
  3662. END SetRealtime;
  3663. PROCEDURE SetUnchecked*(unchecked: BOOLEAN);
  3664. BEGIN
  3665. isUnchecked := unchecked
  3666. END SetUnchecked;
  3667. PROCEDURE SetUncooperative*(uncooperative: BOOLEAN);
  3668. BEGIN
  3669. isUncooperative := uncooperative
  3670. END SetUncooperative;
  3671. PROCEDURE SetModifier*(modifier: Modifier);
  3672. BEGIN
  3673. blockModifiers := modifier;
  3674. END SetModifier;
  3675. PROCEDURE SetExclusive*(excl: BOOLEAN);
  3676. BEGIN isExclusive := excl
  3677. END SetExclusive;
  3678. PROCEDURE SetStatementSequence*( statements: StatementSequence );
  3679. BEGIN SELF.statements := statements;
  3680. END SetStatementSequence;
  3681. PROCEDURE Accept*(v: Visitor);
  3682. VAR position: LONGINT;
  3683. BEGIN position := SELF.position.start; v.VisitStatementBlock(SELF)
  3684. END Accept;
  3685. END StatementBlock;
  3686. (** << CODE {flags} {character} END >> **)
  3687. Code*= OBJECT(Statement)
  3688. VAR
  3689. sourceCode-: SourceCode; sourceCodeLength-: LONGINT;
  3690. inlineCode-: BinaryCode;
  3691. inRules-, outRules-: StatementSequence;
  3692. PROCEDURE & InitCode(position: Position; outer: Statement);
  3693. BEGIN
  3694. InitStatement(position,outer);
  3695. inlineCode := NIL;
  3696. sourceCode := NIL; sourceCodeLength := 0;
  3697. NEW(inRules); NEW(outRules);
  3698. END InitCode;
  3699. PROCEDURE SetSourceCode*(source: SourceCode; length: LONGINT);
  3700. BEGIN sourceCode := source; sourceCodeLength := length;
  3701. ASSERT(sourceCodeLength <= LEN(source));
  3702. END SetSourceCode;
  3703. PROCEDURE SetBinaryCode*(code: BinaryCode);
  3704. BEGIN
  3705. inlineCode := code;
  3706. END SetBinaryCode;
  3707. PROCEDURE Clone(): Statement;
  3708. VAR copy: Code; s: Scanner.StringType;
  3709. BEGIN
  3710. NEW(copy, position, outer);
  3711. NEW(s, sourceCodeLength);
  3712. Strings.Copy(sourceCode^,0,sourceCodeLength,s^);
  3713. copy.SetSourceCode(s, sourceCodeLength);
  3714. copy.inRules := CloneStatementSequence(inRules);
  3715. copy.outRules := CloneStatementSequence(outRules);
  3716. RETURN copy
  3717. END Clone;
  3718. PROCEDURE Accept*(v: Visitor);
  3719. VAR position: LONGINT;
  3720. BEGIN position := SELF.position.start; v.VisitCode(SELF)
  3721. END Accept;
  3722. END Code;
  3723. (** << BEGIN {flags} statements FINALLY statements END >> **)
  3724. Body*= OBJECT(StatementBlock)
  3725. VAR
  3726. finally-: StatementSequence;
  3727. priority-: Expression; (* set by checker *)
  3728. inScope-: ProcedureScope;
  3729. code-: Code;
  3730. isActive-, isSafe-: BOOLEAN;
  3731. PROCEDURE & InitBody(position: Position; scope: ProcedureScope);
  3732. BEGIN
  3733. InitStatementBlock(position,NIL); finally := NIL; priority := NIL; inScope := scope; code := NIL;
  3734. isActive := FALSE; isSafe := FALSE; isRealtime := FALSE;
  3735. END InitBody;
  3736. PROCEDURE SetActive*(active: BOOLEAN);
  3737. BEGIN SELF.isActive := active
  3738. END SetActive;
  3739. PROCEDURE SetSafe*(safe: BOOLEAN);
  3740. BEGIN SELF.isSafe := safe
  3741. END SetSafe;
  3742. PROCEDURE SetFinally*( finally: StatementSequence );
  3743. BEGIN SELF.finally := finally
  3744. END SetFinally;
  3745. PROCEDURE SetPriority*(expression: Expression);
  3746. BEGIN priority := expression
  3747. END SetPriority;
  3748. PROCEDURE SetCode*(code: Code);
  3749. BEGIN SELF.code := code;
  3750. END SetCode;
  3751. END Body;
  3752. (** (* comment *) *)
  3753. Comment*=OBJECT
  3754. VAR position-: Position;
  3755. source-: String; (* currently: POINTER TO ARRAY OF CHAR *)
  3756. scope-: Scope;
  3757. item-: ANY; sameLine-: BOOLEAN;
  3758. nextComment-: Comment;
  3759. PROCEDURE & InitComment(pos: Position; scope: Scope; CONST s: ARRAY OF CHAR; length: LONGINT);
  3760. VAR i: LONGINT;
  3761. BEGIN
  3762. SELF.scope := scope;
  3763. NEW(source,length);
  3764. FOR i := 0 TO length-1 DO
  3765. source[i] := s[i];
  3766. END;
  3767. SELF.position := pos;
  3768. nextComment := NIL;
  3769. item := NIL; sameLine := FALSE;
  3770. END InitComment;
  3771. PROCEDURE SetItem*(p: ANY; sameLine: BOOLEAN);
  3772. BEGIN
  3773. item := p; SELF.sameLine := sameLine
  3774. END SetItem;
  3775. END Comment;
  3776. (**** building blocks ****)
  3777. Scope*=OBJECT
  3778. VAR
  3779. firstSymbol-: Symbol; numberSymbols-: LONGINT; (* all symbols in scope (sorted) *)
  3780. symbolTable: Basic.HashTableInt;
  3781. firstConstant-,lastConstant-: Constant; numberConstants-: LONGINT; (* constants *)
  3782. firstTypeDeclaration-,lastTypeDeclaration-: TypeDeclaration; numberTypeDeclarations-: LONGINT; (* type declarations *)
  3783. firstVariable-,lastVariable-: Variable; numberVariables-: LONGINT; (* variables *)
  3784. firstProcedure-,lastProcedure-: Procedure; numberProcedures-: LONGINT; (* procedures *)
  3785. procedures-: ProcedureList;
  3786. outerScope-: Scope; nextScope-: Scope;
  3787. ownerModule-: Module;
  3788. PROCEDURE & InitScope(outer: Scope);
  3789. BEGIN
  3790. firstSymbol := NIL; numberSymbols := 0;
  3791. firstConstant := NIL; lastConstant := NIL; numberConstants := 0;
  3792. firstTypeDeclaration := NIL; lastTypeDeclaration := NIL; numberTypeDeclarations := 0;
  3793. firstVariable := NIL; lastVariable := NIL; numberVariables := 0;
  3794. firstProcedure := NIL; lastProcedure := NIL; numberProcedures := 0;
  3795. outerScope := outer;
  3796. IF outer # NIL THEN
  3797. ownerModule := outer.ownerModule
  3798. ELSE
  3799. ownerModule := NIL;
  3800. END;
  3801. nextScope := NIL;
  3802. NEW(symbolTable,11);
  3803. END InitScope;
  3804. PROCEDURE Clear*;
  3805. BEGIN
  3806. firstConstant := NIL; lastConstant := NIL; numberConstants := 0;
  3807. firstTypeDeclaration := NIL; lastTypeDeclaration := NIL; numberTypeDeclarations := 0;
  3808. firstVariable := NIL; lastVariable := NIL; numberVariables := 0;
  3809. firstProcedure := NIL; lastProcedure := NIL; numberProcedures := 0;
  3810. END Clear;
  3811. (** Enter a symbol in the scope, aplhabetically sorted, duplicate = TRUE if multiply identifier *)
  3812. PROCEDURE EnterSymbol*(symbol: Symbol; VAR duplicate: BOOLEAN);
  3813. VAR p,q: Symbol;
  3814. BEGIN
  3815. ASSERT(symbol.nextSymbol = NIL,101); (* symbol may only be present in one scope at a time ! *)
  3816. ASSERT(symbol.scope = NIL,102);
  3817. ASSERT(symbol.name # invalidIdentifier,103);
  3818. p := firstSymbol; q := NIL;
  3819. WHILE (p # NIL) & (StringPool.CompareString(p.name,symbol.name)<0) DO q := p; p := p.nextSymbol END;
  3820. IF (p#NIL) & (symbol.name = p.name) THEN
  3821. duplicate := TRUE;
  3822. ELSE
  3823. duplicate := FALSE
  3824. END;
  3825. symbol.nextSymbol := p;
  3826. IF q = NIL THEN firstSymbol := symbol ELSE q.nextSymbol := symbol END;
  3827. symbol.SetScope(SELF);
  3828. symbolTable.Put(symbol.name,symbol);
  3829. INC(numberSymbols);
  3830. END EnterSymbol;
  3831. (** Find symbol by name *)
  3832. PROCEDURE FindSymbol*(identifier: Identifier): Symbol;
  3833. VAR p: Symbol; a: ANY;
  3834. BEGIN
  3835. IF identifier # invalidIdentifier THEN
  3836. a := symbolTable.Get(identifier);
  3837. IF (a # NIL) & ~(a IS Operator) THEN
  3838. p := a(Symbol);
  3839. END;
  3840. (*
  3841. p := firstSymbol;
  3842. WHILE(p#NIL) & ((p.name # identifier) OR (p IS Operator)) DO p := p.nextSymbol END;
  3843. *)
  3844. END;
  3845. RETURN p;
  3846. END FindSymbol;
  3847. PROCEDURE AddConstant*(c: Constant);
  3848. BEGIN
  3849. ASSERT(c # NIL);
  3850. IF lastConstant= NIL THEN firstConstant := c ELSE lastConstant.nextConstant := c END;
  3851. lastConstant := c;
  3852. INC(numberConstants);
  3853. END AddConstant;
  3854. PROCEDURE FindConstant*(identifier: Identifier): Constant;
  3855. VAR p: Constant;
  3856. BEGIN
  3857. p := firstConstant;
  3858. WHILE(p#NIL) & (p.name # identifier) DO p := p.nextConstant END;
  3859. RETURN p;
  3860. END FindConstant;
  3861. PROCEDURE AddTypeDeclaration*(t: TypeDeclaration);
  3862. BEGIN
  3863. ASSERT(t # NIL);
  3864. IF lastTypeDeclaration= NIL THEN firstTypeDeclaration := t ELSE lastTypeDeclaration.nextTypeDeclaration := t END;
  3865. INC(numberTypeDeclarations);
  3866. lastTypeDeclaration := t;
  3867. END AddTypeDeclaration;
  3868. PROCEDURE FindTypeDeclaration*(identifier: Identifier): TypeDeclaration;
  3869. VAR p: TypeDeclaration;
  3870. BEGIN
  3871. p := firstTypeDeclaration;
  3872. WHILE(p#NIL) & (p.name # identifier) DO p := p.nextTypeDeclaration END;
  3873. RETURN p;
  3874. END FindTypeDeclaration;
  3875. PROCEDURE AddVariable*(v: Variable);
  3876. BEGIN
  3877. ASSERT(v # NIL);
  3878. IF lastVariable= NIL THEN firstVariable := v ELSE lastVariable.nextVariable := v END;
  3879. INC(numberVariables);
  3880. lastVariable := v;
  3881. END AddVariable;
  3882. PROCEDURE PushVariable*(v: Variable);
  3883. BEGIN
  3884. ASSERT(v # NIL);
  3885. IF lastVariable= NIL THEN lastVariable := v ELSE v.nextVariable := firstVariable END;
  3886. INC(numberVariables);
  3887. firstVariable := v;
  3888. END PushVariable;
  3889. (* insert variable after variable in list -- can be important to keep variable offsets in order *)
  3890. (* pre: v # NIL, after # NIL *)
  3891. PROCEDURE InsertVariable*(v: Variable; after: Variable);
  3892. BEGIN
  3893. ASSERT(v # NIL);
  3894. ASSERT(after # NIL);
  3895. v.nextVariable := after.nextVariable;
  3896. after.nextVariable := v;
  3897. IF after = lastVariable THEN lastVariable := v END;
  3898. END InsertVariable;
  3899. PROCEDURE FindVariable*(identifier: Identifier): Variable;
  3900. VAR p: Variable;
  3901. BEGIN
  3902. p := firstVariable;
  3903. WHILE(p#NIL) & (p.name # identifier) DO p := p.nextVariable END;
  3904. RETURN p;
  3905. END FindVariable;
  3906. PROCEDURE AddProcedure*(p: Procedure);
  3907. BEGIN
  3908. ASSERT(p # NIL);
  3909. IF lastProcedure= NIL THEN firstProcedure := p ELSE lastProcedure.nextProcedure := p END;
  3910. INC(numberProcedures);
  3911. lastProcedure := p;
  3912. END AddProcedure;
  3913. PROCEDURE AddProcedureDeclaration*(p: Procedure);
  3914. BEGIN
  3915. IF procedures = NIL THEN NEW(procedures) END;
  3916. procedures.AddProcedure(p);
  3917. END AddProcedureDeclaration;
  3918. PROCEDURE FindProcedure*(identifier: Identifier): Procedure;
  3919. VAR p: Procedure;
  3920. BEGIN
  3921. p := firstProcedure;
  3922. WHILE (p#NIL) & ((p.name # identifier) OR (p IS Operator)) DO p := p.nextProcedure END;
  3923. RETURN p;
  3924. END FindProcedure;
  3925. PROCEDURE FindMethod*(number: LONGINT): Procedure;
  3926. VAR p: Procedure;
  3927. BEGIN
  3928. p := firstProcedure;
  3929. WHILE (p# NIL) & (p.methodNumber # number) DO
  3930. p := p.nextProcedure
  3931. END;
  3932. RETURN p;
  3933. END FindMethod;
  3934. PROCEDURE Level*(): LONGINT;
  3935. VAR scope: Scope; level: LONGINT;
  3936. BEGIN
  3937. level := 0;
  3938. scope := SELF;
  3939. WHILE(scope.outerScope # NIL) DO
  3940. scope := scope.outerScope;
  3941. INC(level);
  3942. END;
  3943. RETURN level;
  3944. END Level;
  3945. PROCEDURE NeedsTrace* (): BOOLEAN;
  3946. VAR variable: Variable;
  3947. BEGIN
  3948. variable := firstVariable;
  3949. WHILE variable # NIL DO
  3950. IF variable.NeedsTrace () THEN RETURN TRUE END;
  3951. variable := variable.nextVariable;
  3952. END;
  3953. RETURN FALSE;
  3954. END NeedsTrace;
  3955. END Scope;
  3956. ProcedureScope*=OBJECT (Scope)
  3957. VAR
  3958. ownerProcedure-: Procedure;
  3959. body-: Body;
  3960. PROCEDURE & InitProcedureScope(outer: Scope);
  3961. BEGIN
  3962. InitScope(outer);
  3963. ownerProcedure := NIL;
  3964. body := NIL;
  3965. END InitProcedureScope;
  3966. PROCEDURE SetBody*(body: Body);
  3967. BEGIN
  3968. SELF.body := body;
  3969. END SetBody;
  3970. PROCEDURE NeedsTrace* (): BOOLEAN;
  3971. VAR parameter: Parameter;
  3972. BEGIN
  3973. parameter := ownerProcedure.type.resolved(ProcedureType).firstParameter;
  3974. WHILE parameter # NIL DO
  3975. IF parameter.NeedsTrace () THEN RETURN TRUE END;
  3976. parameter := parameter.nextParameter;
  3977. END;
  3978. RETURN NeedsTrace^();
  3979. END NeedsTrace;
  3980. END ProcedureScope;
  3981. EnumerationScope*= OBJECT(Scope)
  3982. VAR
  3983. ownerEnumeration-: EnumerationType;
  3984. (** Find symbol by name *)
  3985. PROCEDURE FindSymbol*(identifier: Identifier): Symbol;
  3986. VAR p: Symbol; base: Type;
  3987. BEGIN
  3988. p := FindSymbol^(identifier);
  3989. IF p = NIL THEN
  3990. base := ownerEnumeration.enumerationBase;
  3991. IF (base # NIL) & (base.resolved IS EnumerationType) THEN
  3992. p := base.resolved(EnumerationType).enumerationScope.FindSymbol(identifier)
  3993. END;
  3994. END;
  3995. RETURN p;
  3996. END FindSymbol;
  3997. PROCEDURE &InitEnumerationScope(outer: Scope);
  3998. BEGIN
  3999. InitScope(outer);
  4000. ownerEnumeration := NIL; (* must be set by EnumerationType *)
  4001. END InitEnumerationScope;
  4002. END EnumerationScope;
  4003. RecordScope*= OBJECT(Scope)
  4004. VAR
  4005. ownerRecord-: RecordType;
  4006. bodyProcedure-: Procedure;
  4007. constructor-: Procedure;
  4008. finalizer-: Procedure;
  4009. numberMethods-: LONGINT;
  4010. firstParameter-,lastParameter-: Parameter; numberParameters-: LONGINT; (* parameters for Active Cells programming*)
  4011. firstOperator-, lastOperator-: Operator; numberOperators: LONGINT; (* defined operators *)
  4012. PROCEDURE & InitRecordScope(outer: Scope);
  4013. BEGIN
  4014. InitScope(outer);
  4015. ownerRecord := NIL;
  4016. numberMethods := 0;
  4017. bodyProcedure := NIL;
  4018. constructor := NIL;
  4019. finalizer := NIL;
  4020. firstOperator := NIL; lastOperator := NIL; numberOperators := 0;
  4021. END InitRecordScope;
  4022. PROCEDURE SetBodyProcedure*(body: Procedure);
  4023. BEGIN SELF.bodyProcedure := body;
  4024. END SetBodyProcedure;
  4025. PROCEDURE SetConstructor*(body: Procedure);
  4026. BEGIN SELF.constructor := body
  4027. END SetConstructor;
  4028. PROCEDURE SetFinalizer*(body: Procedure);
  4029. BEGIN SELF.finalizer := body
  4030. END SetFinalizer;
  4031. PROCEDURE SetNumberMethods*(numberMethods: LONGINT);
  4032. BEGIN SELF.numberMethods := numberMethods;
  4033. END SetNumberMethods;
  4034. PROCEDURE AddOperator*(p: Operator);
  4035. BEGIN
  4036. ASSERT(p # NIL);
  4037. IF lastOperator= NIL THEN firstOperator := p ELSE lastOperator.nextOperator := p END;
  4038. INC(numberOperators);
  4039. lastOperator := p;
  4040. END AddOperator;
  4041. (** Find symbol by name *)
  4042. PROCEDURE FindSymbol*(identifier: Identifier): Symbol;
  4043. VAR p: Symbol; base: RecordType;
  4044. BEGIN
  4045. p := FindSymbol^(identifier);
  4046. IF p = NIL THEN
  4047. base := ownerRecord.GetBaseRecord();
  4048. IF (base # NIL) THEN
  4049. p := base.recordScope.FindSymbol(identifier)
  4050. END;
  4051. END;
  4052. RETURN p;
  4053. END FindSymbol;
  4054. (* if there is an abstract procedure in the scope, return it. Otherwise return nil *)
  4055. PROCEDURE AbstractProcedure*(inScope: Scope): Procedure;
  4056. VAR p: Procedure; s: Symbol; base: RecordType;
  4057. BEGIN
  4058. p := firstProcedure;
  4059. WHILE p # NIL DO
  4060. IF p.isAbstract THEN
  4061. IF inScope # SELF THEN (* elevate to mother scope, if necesary *)
  4062. s := inScope.FindSymbol(p.name);
  4063. IF s = p THEN (* procedure is not overwritten *)
  4064. RETURN p
  4065. ELSE
  4066. ASSERT(s # NIL);
  4067. ASSERT(s IS Procedure);
  4068. END;
  4069. ELSE
  4070. RETURN p
  4071. END;
  4072. END;
  4073. p := p.nextProcedure;
  4074. END;
  4075. base := ownerRecord.GetBaseRecord();
  4076. IF (base # NIL) THEN
  4077. RETURN base.recordScope.AbstractProcedure(inScope);
  4078. END;
  4079. RETURN NIL;
  4080. END AbstractProcedure;
  4081. PROCEDURE FindConstant*(identifier: Identifier): Constant;
  4082. VAR p: Constant; base: RecordType;
  4083. BEGIN
  4084. p := FindConstant^(identifier);
  4085. IF p = NIL THEN
  4086. base := ownerRecord.GetBaseRecord();
  4087. IF (base # NIL) THEN
  4088. p := base.recordScope.FindConstant(identifier)
  4089. END;
  4090. END;
  4091. RETURN p;
  4092. END FindConstant;
  4093. PROCEDURE FindTypeDeclaration*(identifier: Identifier): TypeDeclaration;
  4094. VAR p: TypeDeclaration; base: RecordType;
  4095. BEGIN
  4096. p := FindTypeDeclaration^(identifier);
  4097. IF p = NIL THEN
  4098. base := ownerRecord.GetBaseRecord();
  4099. IF (base # NIL) THEN
  4100. p := base.recordScope.FindTypeDeclaration(identifier)
  4101. END;
  4102. END;
  4103. RETURN p;
  4104. END FindTypeDeclaration;
  4105. PROCEDURE FindVariable*(identifier: Identifier): Variable;
  4106. VAR p: Variable; base: RecordType;
  4107. BEGIN
  4108. p := FindVariable^(identifier);
  4109. IF p = NIL THEN
  4110. base := ownerRecord.GetBaseRecord();
  4111. IF (base # NIL) THEN
  4112. p := base.recordScope.FindVariable(identifier)
  4113. END;
  4114. END;
  4115. RETURN p;
  4116. END FindVariable;
  4117. PROCEDURE FindProcedure*(identifier: Identifier): Procedure;
  4118. VAR p: Procedure; base: RecordType;
  4119. BEGIN
  4120. p := FindProcedure^(identifier);
  4121. IF p = NIL THEN
  4122. base := ownerRecord.GetBaseRecord();
  4123. IF (base # NIL) THEN
  4124. p := base.recordScope.FindProcedure(identifier)
  4125. END;
  4126. END;
  4127. RETURN p;
  4128. END FindProcedure;
  4129. PROCEDURE FindMethod*(number: LONGINT): Procedure;
  4130. VAR p: Procedure; base: RecordType;
  4131. BEGIN
  4132. p := FindMethod^(number);
  4133. IF p = NIL THEN
  4134. base := ownerRecord.GetBaseRecord();
  4135. IF (base # NIL) THEN
  4136. p := base.recordScope.FindMethod(number)
  4137. END;
  4138. END;
  4139. RETURN p;
  4140. END FindMethod;
  4141. PROCEDURE NeedsTrace* (): BOOLEAN;
  4142. VAR base: RecordType;
  4143. BEGIN
  4144. base := ownerRecord.GetBaseRecord();
  4145. IF (base # NIL) & (base.NeedsTrace ()) THEN RETURN TRUE END;
  4146. RETURN NeedsTrace^();
  4147. END NeedsTrace;
  4148. END RecordScope;
  4149. CellScope*=OBJECT (Scope)
  4150. VAR
  4151. ownerCell-: CellType;
  4152. bodyProcedure-: Procedure;
  4153. constructor-: Procedure;
  4154. firstImport-,lastImport-: Import; numberImports: LONGINT; (* imported modules *)
  4155. PROCEDURE & InitCellScope(outer: Scope);
  4156. BEGIN
  4157. InitScope(outer);
  4158. ownerCell := NIL;
  4159. bodyProcedure := NIL;
  4160. constructor := NIL;
  4161. firstImport := NIL; lastImport := NIL; numberImports := 0;
  4162. END InitCellScope;
  4163. PROCEDURE Clear*;
  4164. BEGIN
  4165. Clear^;
  4166. firstImport := NIL; lastImport := NIL; numberImports := 0;
  4167. constructor := NIL;
  4168. bodyProcedure := NIL;
  4169. END Clear;
  4170. PROCEDURE SetOwnerCell*(owner: CellType);
  4171. BEGIN
  4172. ownerCell := owner
  4173. END SetOwnerCell;
  4174. PROCEDURE SetBodyProcedure*(bodyProcedure: Procedure);
  4175. BEGIN
  4176. SELF.bodyProcedure := bodyProcedure;
  4177. END SetBodyProcedure;
  4178. PROCEDURE SetConstructor*(p: Procedure);
  4179. BEGIN constructor := p
  4180. END SetConstructor;
  4181. PROCEDURE AddImport*(i: Import);
  4182. BEGIN
  4183. ASSERT(i # NIL);
  4184. ASSERT(i.nextImport = NIL);
  4185. IF lastImport= NIL THEN firstImport:= i ELSE lastImport.nextImport := i END;
  4186. lastImport := i;
  4187. INC(numberImports);
  4188. END AddImport;
  4189. PROCEDURE FindImport*(identifier: Identifier): Import;
  4190. VAR p: Import;
  4191. BEGIN
  4192. p := firstImport;
  4193. WHILE(p#NIL) & (p.name # identifier) DO p := p.nextImport END; (* finds imports and re-imports! *)
  4194. RETURN p;
  4195. END FindImport;
  4196. PROCEDURE GetImport*( index: LONGINT ): Import;
  4197. VAR import: Import;
  4198. BEGIN
  4199. import := firstImport;
  4200. WHILE(import # NIL) & (index > 0) DO
  4201. import := import.nextImport;
  4202. DEC(index);
  4203. END;
  4204. RETURN import;
  4205. END GetImport;
  4206. PROCEDURE FindSymbol*(identifier: Identifier): Symbol;
  4207. VAR p: Symbol; base: Type;
  4208. BEGIN
  4209. p := FindSymbol^(identifier);
  4210. IF p = NIL THEN
  4211. IF ownerCell.isCellNet THEN
  4212. RETURN ownerCell.FindProperty(identifier);
  4213. END;
  4214. END;
  4215. IF p = NIL THEN
  4216. base := ownerCell.baseType;
  4217. IF (base # NIL) THEN
  4218. base := base.resolved;
  4219. IF base IS PointerType THEN
  4220. base := base(PointerType).pointerBase.resolved;
  4221. END;
  4222. WITH base:
  4223. CellType DO
  4224. p := base.cellScope.FindSymbol(identifier)
  4225. |RecordType DO
  4226. p := base.recordScope.FindSymbol(identifier)
  4227. END;
  4228. END;
  4229. END;
  4230. RETURN p;
  4231. END FindSymbol;
  4232. END CellScope;
  4233. (**
  4234. <<
  4235. IMPORT firstImport .. lastImport;
  4236. ...
  4237. firstOperator ... lastOperator
  4238. ....
  4239. >>
  4240. **)
  4241. ModuleScope*= OBJECT(Scope)
  4242. VAR
  4243. firstImport-,lastImport-: Import; numberImports: LONGINT; (* imported modules *)
  4244. firstOperator-,lastOperator-: Operator; numberOperators: LONGINT; (* defined operators *)
  4245. firstBuiltin-,lastBuiltin-: Builtin; numberBuiltins: LONGINT; (* defined builtins, only for global and system module *)
  4246. firstComment-,lastComment-: Comment; numberComments-: LONGINT; (* comments *)
  4247. bodyProcedure-: Procedure;
  4248. PROCEDURE & InitModuleScope;
  4249. BEGIN
  4250. InitScope(NIL);
  4251. firstComment := NIL; lastComment := NIL; numberComments := 0;
  4252. firstImport:= NIL; lastImport := NIL; numberImports := 0;
  4253. firstOperator := NIL; lastOperator := NIL; numberOperators := 0;
  4254. END InitModuleScope;
  4255. PROCEDURE SetBodyProcedure*(body: Procedure);
  4256. BEGIN SELF.bodyProcedure := body;
  4257. END SetBodyProcedure;
  4258. PROCEDURE SetGlobalScope*(outer: Scope);
  4259. BEGIN
  4260. SELF.outerScope := outer;
  4261. END SetGlobalScope;
  4262. PROCEDURE AddBuiltin*(p: Builtin);
  4263. BEGIN
  4264. ASSERT(p # NIL);
  4265. IF lastBuiltin= NIL THEN firstBuiltin := p ELSE lastBuiltin.nextBuiltin := p END;
  4266. INC(numberBuiltins);
  4267. lastBuiltin := p;
  4268. END AddBuiltin;
  4269. PROCEDURE AddOperator*(p: Operator);
  4270. BEGIN
  4271. ASSERT(p # NIL);
  4272. IF lastOperator= NIL THEN firstOperator := p ELSE lastOperator.nextOperator := p END;
  4273. INC(numberOperators);
  4274. lastOperator := p;
  4275. END AddOperator;
  4276. PROCEDURE FindOperator*(identifier: Identifier): Operator;
  4277. VAR p: Operator;
  4278. BEGIN
  4279. p := firstOperator;
  4280. WHILE(p#NIL) & (p.name # identifier) DO p := p.nextOperator END;
  4281. RETURN p;
  4282. END FindOperator;
  4283. PROCEDURE AddImport*(i: Import);
  4284. BEGIN
  4285. ASSERT(i # NIL);
  4286. ASSERT(i.nextImport = NIL);
  4287. IF lastImport= NIL THEN firstImport:= i ELSE lastImport.nextImport := i END;
  4288. lastImport := i;
  4289. INC(numberImports);
  4290. END AddImport;
  4291. PROCEDURE FindImport*(identifier: Identifier): Import;
  4292. VAR p: Import;
  4293. BEGIN
  4294. p := firstImport;
  4295. WHILE(p#NIL) & (p.name # identifier) DO p := p.nextImport END; (* finds imports and re-imports! *)
  4296. RETURN p;
  4297. END FindImport;
  4298. PROCEDURE GetImport*( index: LONGINT ): Import;
  4299. VAR import: Import;
  4300. BEGIN
  4301. import := firstImport;
  4302. WHILE(import # NIL) & (index > 0) DO
  4303. import := import.nextImport;
  4304. DEC(index);
  4305. END;
  4306. RETURN import;
  4307. END GetImport;
  4308. PROCEDURE AddComment*(comment: Comment);
  4309. BEGIN
  4310. ASSERT(comment # NIL);
  4311. IF lastComment= NIL THEN firstComment := comment ELSE lastComment.nextComment := comment END;
  4312. INC(numberComments);
  4313. lastComment := comment;
  4314. END AddComment;
  4315. PROCEDURE ImportByModuleName*(moduleName,context: Identifier): Import;
  4316. VAR p: Import;
  4317. BEGIN
  4318. p := firstImport;
  4319. WHILE(p#NIL) & ~((moduleName = p.moduleName) & (context = p.context)) DO p := p.nextImport END;
  4320. RETURN p;
  4321. END ImportByModuleName;
  4322. PROCEDURE RemoveImporters*(moduleName,context: Identifier);
  4323. VAR this: Import;
  4324. PROCEDURE Check(p: Import): BOOLEAN;
  4325. VAR result: BOOLEAN;
  4326. BEGIN
  4327. IF (moduleName = p.moduleName) & (context = p.context) THEN
  4328. result := TRUE
  4329. ELSE
  4330. result := p.module.moduleScope.ImportByModuleName(moduleName,context) # NIL;
  4331. END;
  4332. RETURN result
  4333. END Check;
  4334. BEGIN
  4335. WHILE(firstImport # NIL) & Check(firstImport) DO
  4336. firstImport := firstImport.nextImport;
  4337. DEC(numberImports);
  4338. END;
  4339. IF firstImport = NIL THEN lastImport := NIL
  4340. ELSE
  4341. this :=firstImport;
  4342. WHILE(this.nextImport # NIL) DO
  4343. IF Check(this.nextImport) THEN
  4344. this.nextImport := this.nextImport.nextImport;
  4345. DEC(numberImports);
  4346. ELSE
  4347. this := this.nextImport
  4348. END;
  4349. END;
  4350. lastImport := this;
  4351. END;
  4352. END RemoveImporters;
  4353. END ModuleScope;
  4354. (* << MODULE name ['in' context] moduleScope name '.' >> *)
  4355. Module* = OBJECT (Symbol)
  4356. VAR
  4357. sourceName-: Basic.FileName;
  4358. moduleScope-: ModuleScope;
  4359. context-:Identifier; (* modules context *)
  4360. case-: LONGINT; (* module notation in lower or upper case, important for printout and operators *)
  4361. isCellNet-: BOOLEAN;
  4362. firstScope-,lastScope-: Scope; numberScopes-: LONGINT; (* list of all scopes for checker / backend traversal etc. *)
  4363. closingComment-: Comment;
  4364. modifiers-: Modifier;
  4365. PROCEDURE & InitModule( CONST sourceName: ARRAY OF CHAR; position: Position; name: Identifier; scope: ModuleScope; case: LONGINT);
  4366. BEGIN
  4367. InitSymbol(position,name);
  4368. COPY (sourceName, SELF.sourceName);
  4369. moduleScope := scope;
  4370. ASSERT(scope.ownerModule = NIL); (* cannot register twice ! *)
  4371. scope.ownerModule := SELF;
  4372. context := invalidIdentifier;
  4373. SELF.case := case;
  4374. firstScope := NIL; lastScope := NIL; numberScopes := 0;
  4375. SetType(moduleType);
  4376. closingComment := NIL;
  4377. isCellNet := FALSE;
  4378. modifiers := NIL;
  4379. END InitModule;
  4380. PROCEDURE SetCase*(case: LONGINT);
  4381. BEGIN
  4382. SELF.case := case
  4383. END SetCase;
  4384. PROCEDURE SetCellNet*(isCellNet: BOOLEAN);
  4385. BEGIN SELF.isCellNet := isCellNet
  4386. END SetCellNet;
  4387. PROCEDURE SetContext*(context: Identifier);
  4388. BEGIN SELF.context := context;
  4389. END SetContext;
  4390. PROCEDURE SetName*(name: Identifier);
  4391. BEGIN SELF.name := name
  4392. END SetName;
  4393. PROCEDURE SetClosingComment*(comment: Comment);
  4394. BEGIN SELF.closingComment := comment
  4395. END SetClosingComment;
  4396. PROCEDURE SetModifiers*(modifiers: Modifier);
  4397. BEGIN SELF.modifiers := modifiers
  4398. END SetModifiers;
  4399. PROCEDURE AddScope*(c: Scope);
  4400. BEGIN
  4401. IF lastScope= NIL THEN firstScope := c ELSE lastScope.nextScope := c END;
  4402. lastScope := c;
  4403. INC(numberScopes);
  4404. END AddScope;
  4405. PROCEDURE Accept*(v: Visitor);
  4406. VAR position: LONGINT;
  4407. BEGIN position := SELF.position.start; v.VisitModule(SELF)
  4408. END Accept;
  4409. END Module;
  4410. (** <<expression, expression, ...>> **)
  4411. SymbolList* = OBJECT
  4412. VAR list: Basic.List;
  4413. PROCEDURE & InitList*;
  4414. BEGIN NEW( list,8 );
  4415. END InitList;
  4416. PROCEDURE Length*( ): LONGINT;
  4417. BEGIN RETURN list.Length();
  4418. END Length;
  4419. PROCEDURE AddSymbol*( d: Symbol );
  4420. BEGIN list.Add(d)
  4421. END AddSymbol;
  4422. PROCEDURE GetSymbol*( index: LONGINT ): Symbol;
  4423. VAR p: ANY;
  4424. BEGIN
  4425. p := list.Get(index); RETURN p(Symbol);
  4426. END GetSymbol;
  4427. PROCEDURE SetSymbol*(index: LONGINT; expression: Symbol);
  4428. BEGIN list.Set(index,expression)
  4429. END SetSymbol;
  4430. PROCEDURE RemoveSymbol*(i: LONGINT);
  4431. BEGIN list.RemoveByIndex(i);
  4432. END RemoveSymbol;
  4433. (*
  4434. PROCEDURE Clone*(VAR list: SymbolList);
  4435. VAR i: LONGINT;
  4436. BEGIN
  4437. IF list = NIL THEN NEW(list) END;
  4438. FOR i := 0 TO Length()-1 DO
  4439. list.AddSymbol(CloneSymbol(GetSymbol(i)));
  4440. END;
  4441. END Clone;
  4442. *)
  4443. END SymbolList;
  4444. ProcedureList* = OBJECT
  4445. VAR list: Basic.List;
  4446. PROCEDURE & InitList*;
  4447. BEGIN NEW( list,8 );
  4448. END InitList;
  4449. PROCEDURE Length*( ): LONGINT;
  4450. BEGIN RETURN list.Length();
  4451. END Length;
  4452. PROCEDURE AddProcedure*( d: Procedure );
  4453. BEGIN list.Add(d)
  4454. END AddProcedure;
  4455. PROCEDURE GetProcedure*( index: LONGINT ): Procedure;
  4456. VAR p: ANY;
  4457. BEGIN
  4458. IF index >= list.Length() THEN RETURN NIL END;
  4459. p := list.Get(index);
  4460. IF p = NIL THEN
  4461. RETURN NIL
  4462. ELSE
  4463. RETURN p(Procedure);
  4464. END;
  4465. END GetProcedure;
  4466. PROCEDURE SetProcedure*(index: LONGINT; expression: Procedure);
  4467. BEGIN list.GrowAndSet(index,expression)
  4468. END SetProcedure;
  4469. PROCEDURE RemoveProcedure*(i: LONGINT);
  4470. BEGIN list.RemoveByIndex(i);
  4471. END RemoveProcedure;
  4472. (*
  4473. PROCEDURE Clone*(VAR list: ProcedureList);
  4474. VAR i: LONGINT;
  4475. BEGIN
  4476. IF list = NIL THEN NEW(list) END;
  4477. FOR i := 0 TO Length()-1 DO
  4478. list.AddProcedure(CloneProcedure(GetProcedure(i)));
  4479. END;
  4480. END Clone;
  4481. *)
  4482. END ProcedureList;
  4483. VAR
  4484. (* invalid items used, for example, by parser and checker *)
  4485. invalidIdentifier-: Identifier;
  4486. invalidQualifiedIdentifier-: QualifiedIdentifier;
  4487. invalidType-: Type;
  4488. invalidExpression-: Expression; (* mapped to invalidDesignator for better error handling in checker *)
  4489. invalidDesignator-: Designator;
  4490. invalidValue-: Value;
  4491. invalidSymbol-: Symbol;
  4492. invalidPosition-: Position;
  4493. anonymousIdentifier-: Identifier;
  4494. importType-: Type;
  4495. typeDeclarationType-: Type;
  4496. moduleType-: Type;
  4497. indexListSeparator-: Expression;
  4498. PROCEDURE InitFingerPrint*(VAR fingerprint: FingerPrint);
  4499. BEGIN
  4500. fingerprint.shallowAvailable := FALSE;
  4501. fingerprint.deepAvailable := FALSE;
  4502. fingerprint.shallow := 0;
  4503. fingerprint.private := 0;
  4504. fingerprint.public := 0;
  4505. END InitFingerPrint;
  4506. PROCEDURE NewModule*( CONST sourceName: ARRAY OF CHAR; position: Position; name: Identifier;scope: ModuleScope; case: LONGINT ): Module;
  4507. VAR module: Module;
  4508. BEGIN
  4509. NEW( module, sourceName, position, name, scope, case); RETURN module;
  4510. END NewModule;
  4511. PROCEDURE NewComment*(position: Position; scope: Scope; CONST source: ARRAY OF CHAR; length: LONGINT): Comment;
  4512. VAR comment: Comment;
  4513. BEGIN
  4514. NEW(comment,position,scope,source,length); RETURN comment;
  4515. END NewComment;
  4516. PROCEDURE NewImport*( position: Position; alias, name: Identifier; direct: BOOLEAN): Import;
  4517. VAR import: Import;
  4518. BEGIN
  4519. NEW( import, position, alias, name, direct ); RETURN import
  4520. END NewImport;
  4521. PROCEDURE NewConstant*( position: Position; name: Identifier ): Constant;
  4522. VAR constant: Constant;
  4523. BEGIN
  4524. NEW( constant, position, name ); RETURN constant
  4525. END NewConstant;
  4526. PROCEDURE NewProcedure*( position: Position; name: Identifier; scope: ProcedureScope ): Procedure;
  4527. VAR procedure: Procedure;
  4528. BEGIN
  4529. NEW( procedure, position, name, scope); RETURN procedure
  4530. END NewProcedure;
  4531. PROCEDURE NewBuiltin*(position: Position; name: Identifier; id: LONGINT): Builtin;
  4532. VAR builtin: Builtin;
  4533. BEGIN
  4534. NEW(builtin,position,name,id); RETURN builtin
  4535. END NewBuiltin;
  4536. PROCEDURE NewCustomBuiltin*(position: Position; name: Identifier; id: LONGINT; subType: SHORTINT): CustomBuiltin;
  4537. VAR builtin:CustomBuiltin;
  4538. BEGIN
  4539. NEW(builtin,position,name,id,subType); RETURN builtin
  4540. END NewCustomBuiltin;
  4541. PROCEDURE NewOperator*( position: Position; name: Identifier; scope: ProcedureScope): Operator;
  4542. VAR operator: Operator;
  4543. BEGIN
  4544. NEW( operator, position, name, scope); RETURN operator
  4545. END NewOperator;
  4546. PROCEDURE NewType*(): Type; (* for error handling: invalid Type, is realtime type *)
  4547. VAR type: Type;
  4548. BEGIN
  4549. NEW( type, invalidPosition);
  4550. type.SetRealtime(TRUE);
  4551. RETURN type
  4552. END NewType;
  4553. PROCEDURE NewByteType*(sizeInBits: LONGINT): ByteType;
  4554. VAR basicType: ByteType;
  4555. BEGIN
  4556. NEW(basicType, sizeInBits); RETURN basicType;
  4557. END NewByteType;
  4558. PROCEDURE NewAnyType*(sizeInBits: LONGINT): AnyType;
  4559. VAR basicType: AnyType;
  4560. BEGIN
  4561. NEW(basicType, sizeInBits); RETURN basicType;
  4562. END NewAnyType;
  4563. PROCEDURE NewObjectType*(sizeInBits: LONGINT): ObjectType;
  4564. VAR basicType: ObjectType;
  4565. BEGIN
  4566. NEW(basicType, sizeInBits); RETURN basicType;
  4567. END NewObjectType;
  4568. PROCEDURE NewNilType*(sizeInBits: LONGINT): NilType;
  4569. VAR basicType: NilType;
  4570. BEGIN
  4571. NEW(basicType, sizeInBits); RETURN basicType;
  4572. END NewNilType;
  4573. PROCEDURE NewAddressType*(sizeInBits: LONGINT): AddressType;
  4574. VAR basicType: AddressType;
  4575. BEGIN
  4576. NEW(basicType, sizeInBits); RETURN basicType;
  4577. END NewAddressType;
  4578. PROCEDURE NewSizeType*(sizeInBits: LONGINT): SizeType;
  4579. VAR basicType: SizeType;
  4580. BEGIN
  4581. NEW(basicType, sizeInBits); RETURN basicType;
  4582. END NewSizeType;
  4583. PROCEDURE NewBooleanType*(sizeInBits: LONGINT): BooleanType;
  4584. VAR basicType: BooleanType;
  4585. BEGIN
  4586. NEW(basicType, sizeInBits); RETURN basicType;
  4587. END NewBooleanType;
  4588. PROCEDURE NewSetType*(sizeInBits: LONGINT): SetType;
  4589. VAR basicType: SetType;
  4590. BEGIN
  4591. NEW(basicType, sizeInBits); RETURN basicType;
  4592. END NewSetType;
  4593. PROCEDURE NewCharacterType*(sizeInBits: LONGINT): CharacterType;
  4594. VAR basicType: CharacterType;
  4595. BEGIN
  4596. NEW(basicType, sizeInBits); RETURN basicType;
  4597. END NewCharacterType;
  4598. PROCEDURE NewRangeType*(sizeInBits: LONGINT): RangeType;
  4599. VAR basicType: RangeType;
  4600. BEGIN
  4601. NEW(basicType, sizeInBits); RETURN basicType;
  4602. END NewRangeType;
  4603. PROCEDURE NewComplexType*(base: Type): ComplexType;
  4604. VAR basicType: ComplexType;
  4605. BEGIN
  4606. NEW(basicType, base); RETURN basicType;
  4607. END NewComplexType;
  4608. PROCEDURE NewIntegerType*(size: LONGINT; signed: BOOLEAN): IntegerType;
  4609. VAR basicType: IntegerType;
  4610. BEGIN
  4611. NEW(basicType, size, signed); RETURN basicType;
  4612. END NewIntegerType;
  4613. PROCEDURE NewFloatType*(sizeInBits: LONGINT): FloatType;
  4614. VAR basicType: FloatType;
  4615. BEGIN
  4616. NEW(basicType, sizeInBits); RETURN basicType;
  4617. END NewFloatType;
  4618. PROCEDURE NewTypeDeclaration*(position: Position; name: Identifier): TypeDeclaration;
  4619. VAR typeDeclaration: TypeDeclaration;
  4620. BEGIN
  4621. ASSERT(name # invalidIdentifier);
  4622. NEW(typeDeclaration,position,name); RETURN typeDeclaration
  4623. END NewTypeDeclaration;
  4624. PROCEDURE NewStringType*( position: Position; baseType: Type; length: LONGINT): StringType;
  4625. VAR stringType: StringType;
  4626. BEGIN
  4627. NEW( stringType, position, baseType, length); RETURN stringType;
  4628. END NewStringType;
  4629. PROCEDURE NewEnumerationType*( position: Position; scope: Scope; enumerationScope: EnumerationScope): EnumerationType;
  4630. VAR enumerationType: EnumerationType;
  4631. BEGIN
  4632. NEW( enumerationType, position, scope, enumerationScope); RETURN enumerationType;
  4633. END NewEnumerationType;
  4634. PROCEDURE NewArrayType*( position: Position; scope: Scope; form: LONGINT): ArrayType;
  4635. VAR arrayType: ArrayType;
  4636. BEGIN
  4637. NEW( arrayType, position,scope, form); RETURN arrayType;
  4638. END NewArrayType;
  4639. PROCEDURE NewMathArrayType*( position: Position; scope: Scope; form: LONGINT): MathArrayType;
  4640. VAR mathArrayType: MathArrayType;
  4641. BEGIN
  4642. NEW( mathArrayType, position,scope,form); RETURN mathArrayType;
  4643. END NewMathArrayType;
  4644. PROCEDURE NewPointerType*( position: Position; scope: Scope): PointerType;
  4645. VAR pointerType: PointerType;
  4646. BEGIN
  4647. NEW( pointerType, position,scope); RETURN pointerType;
  4648. END NewPointerType;
  4649. PROCEDURE NewPortType*( position: Position; direction: LONGINT; sizeExpression: Expression; scope: Scope): PortType;
  4650. VAR portType: PortType;
  4651. BEGIN
  4652. NEW( portType, position, direction, sizeExpression, scope); RETURN portType;
  4653. END NewPortType;
  4654. PROCEDURE NewRecordType*( position: Position; scope: Scope; recordScope: RecordScope): RecordType;
  4655. VAR recordType: RecordType;
  4656. BEGIN
  4657. NEW( recordType, position, scope, recordScope); RETURN recordType
  4658. END NewRecordType;
  4659. PROCEDURE NewCellType*(position: Position; scope:Scope; cellScope: CellScope): CellType;
  4660. VAR actorType: CellType;
  4661. BEGIN
  4662. NEW(actorType, position, scope, cellScope); RETURN actorType;
  4663. END NewCellType;
  4664. PROCEDURE NewProcedureType*( position: Position; scope: Scope): ProcedureType;
  4665. VAR procedureType: ProcedureType;
  4666. BEGIN
  4667. NEW( procedureType, position,scope); RETURN procedureType;
  4668. END NewProcedureType;
  4669. PROCEDURE NewQualifiedType*( position: Position; scope: Scope; qualifiedIdentifier: QualifiedIdentifier): QualifiedType;
  4670. VAR qualifiedType: QualifiedType;
  4671. BEGIN
  4672. NEW( qualifiedType, position,scope,qualifiedIdentifier ); RETURN qualifiedType
  4673. END NewQualifiedType;
  4674. PROCEDURE NewSymbol*(name: Identifier): Symbol; (* for error handling: invalid Symbol *)
  4675. VAR symbol: Symbol;
  4676. BEGIN
  4677. NEW(symbol,invalidPosition,name); RETURN symbol
  4678. END NewSymbol;
  4679. PROCEDURE NewVariable*( position: Position; name: Identifier): Variable;
  4680. VAR variable: Variable;
  4681. BEGIN
  4682. NEW( variable, position, name ); RETURN variable
  4683. END NewVariable;
  4684. PROCEDURE NewQualifiedIdentifier*( position: Position; prefix, suffix: Identifier ): QualifiedIdentifier;
  4685. VAR qualifiedIdentifier: QualifiedIdentifier;
  4686. BEGIN
  4687. NEW( qualifiedIdentifier, position, prefix, suffix ); RETURN qualifiedIdentifier
  4688. END NewQualifiedIdentifier;
  4689. PROCEDURE NewIdentifier*(CONST name: ARRAY OF CHAR): Identifier;
  4690. BEGIN
  4691. RETURN Basic.MakeString(name);
  4692. END NewIdentifier;
  4693. PROCEDURE NewParameter*( position: Position; ownerType:Type ; name: Identifier; passAs: LONGINT): Parameter;
  4694. VAR parameter: Parameter;
  4695. BEGIN
  4696. NEW( parameter, position, ownerType, name, passAs); RETURN parameter;
  4697. END NewParameter;
  4698. PROCEDURE NewProperty*( position: Position; name: Identifier): Property;
  4699. VAR property: Property;
  4700. BEGIN
  4701. NEW( property, position, name); RETURN property;
  4702. END NewProperty;
  4703. PROCEDURE NewExpressionList*(): ExpressionList;
  4704. VAR expressionList: ExpressionList;
  4705. BEGIN
  4706. NEW(expressionList); RETURN expressionList
  4707. END NewExpressionList;
  4708. PROCEDURE CloneExpressionList*(l: ExpressionList): ExpressionList;
  4709. VAR copy: ExpressionList;
  4710. BEGIN
  4711. IF l = NIL THEN RETURN NIL ELSE l.Clone(copy); RETURN copy END;
  4712. END CloneExpressionList;
  4713. PROCEDURE NewDesignator*(): Designator; (* for error handling: invalid Designator *)
  4714. VAR designator: Designator;
  4715. BEGIN
  4716. NEW(designator,invalidPosition); RETURN designator;
  4717. END NewDesignator;
  4718. PROCEDURE NewIdentifierDesignator*( position: Position; identifier: Identifier): IdentifierDesignator;
  4719. VAR identifierDesignator: IdentifierDesignator;
  4720. BEGIN
  4721. NEW( identifierDesignator, position, identifier ); RETURN identifierDesignator
  4722. END NewIdentifierDesignator;
  4723. PROCEDURE NewSelectorDesignator*( position: Position; left: Designator; name: Identifier ): SelectorDesignator;
  4724. VAR selectorDesignator: SelectorDesignator;
  4725. BEGIN
  4726. NEW( selectorDesignator, position, left, name ); RETURN selectorDesignator
  4727. END NewSelectorDesignator;
  4728. PROCEDURE NewParameterDesignator*( position: Position; left: Designator; expressionList: ExpressionList ): ParameterDesignator;
  4729. VAR parameterDesignator: ParameterDesignator;
  4730. BEGIN
  4731. NEW( parameterDesignator,position, left, expressionList ); RETURN parameterDesignator
  4732. END NewParameterDesignator;
  4733. PROCEDURE NewArrowDesignator*( position: Position; left: Designator ): ArrowDesignator;
  4734. VAR dereferenceDesignator: ArrowDesignator;
  4735. BEGIN
  4736. NEW( dereferenceDesignator, position, left ); RETURN dereferenceDesignator;
  4737. END NewArrowDesignator;
  4738. PROCEDURE NewBracketDesignator*( position: Position; left: Designator; expressionList: ExpressionList ): BracketDesignator;
  4739. VAR bracketDesignator: BracketDesignator;
  4740. BEGIN
  4741. NEW( bracketDesignator, position, left, expressionList ); RETURN bracketDesignator
  4742. END NewBracketDesignator;
  4743. PROCEDURE NewSymbolDesignator*( position: Position; left: Designator; symbol: Symbol ): SymbolDesignator;
  4744. VAR symbolDesignator: SymbolDesignator;
  4745. BEGIN
  4746. NEW( symbolDesignator, position, left, symbol); RETURN symbolDesignator
  4747. END NewSymbolDesignator;
  4748. PROCEDURE NewIndexDesignator*( position: Position; left: Designator): IndexDesignator;
  4749. VAR indexDesignator: IndexDesignator;
  4750. BEGIN
  4751. NEW( indexDesignator, position, left); RETURN indexDesignator
  4752. END NewIndexDesignator;
  4753. PROCEDURE NewProcedureCallDesignator*(position: Position; left: Designator; parameters: ExpressionList): ProcedureCallDesignator;
  4754. VAR procedureCallDesignator: ProcedureCallDesignator;
  4755. BEGIN
  4756. NEW(procedureCallDesignator, position, left, parameters); RETURN procedureCallDesignator
  4757. END NewProcedureCallDesignator;
  4758. PROCEDURE NewBuiltinCallDesignator*(position: Position; id: LONGINT; left: Designator; parameters: ExpressionList): BuiltinCallDesignator;
  4759. VAR builtinCallDesignator: BuiltinCallDesignator;
  4760. BEGIN
  4761. NEW(builtinCallDesignator, position, id, left,parameters); RETURN builtinCallDesignator
  4762. END NewBuiltinCallDesignator;
  4763. PROCEDURE NewTypeGuardDesignator*(position: Position; left: Designator; type: Type): TypeGuardDesignator;
  4764. VAR guardDesignator: TypeGuardDesignator;
  4765. BEGIN
  4766. NEW(guardDesignator,position,left,type); RETURN guardDesignator;
  4767. END NewTypeGuardDesignator;
  4768. PROCEDURE NewDereferenceDesignator*( position: Position; left: Designator): DereferenceDesignator;
  4769. VAR dereferenceDesignator: DereferenceDesignator;
  4770. BEGIN
  4771. NEW( dereferenceDesignator, position, left); RETURN dereferenceDesignator
  4772. END NewDereferenceDesignator;
  4773. PROCEDURE NewSupercallDesignator*( position: Position; left: Designator): SupercallDesignator;
  4774. VAR supercallDesignator: SupercallDesignator;
  4775. BEGIN
  4776. NEW( supercallDesignator, position, left); RETURN supercallDesignator
  4777. END NewSupercallDesignator;
  4778. PROCEDURE NewSelfDesignator*( position: Position): SelfDesignator;
  4779. VAR selfDesignator: SelfDesignator;
  4780. BEGIN
  4781. NEW( selfDesignator, position); RETURN selfDesignator
  4782. END NewSelfDesignator;
  4783. PROCEDURE NewResultDesignator*( position: Position): ResultDesignator;
  4784. VAR resultDesignator: ResultDesignator;
  4785. BEGIN
  4786. NEW( resultDesignator, position); RETURN resultDesignator
  4787. END NewResultDesignator;
  4788. PROCEDURE NewExpression*(): Expression; (* for error handling: invalid Expression *)
  4789. VAR expression: Expression;
  4790. BEGIN
  4791. NEW(expression,invalidPosition); RETURN expression;
  4792. END NewExpression;
  4793. PROCEDURE CloneExpression*(e: Expression): Expression;
  4794. VAR copy: Expression;
  4795. BEGIN
  4796. IF e = NIL THEN
  4797. RETURN NIL
  4798. ELSE
  4799. copy := e.Clone();
  4800. copy.type := e.type;
  4801. copy.assignable := e.assignable;
  4802. copy.position := e.position;
  4803. copy.state := e.state;
  4804. IF e.resolved = e THEN copy.resolved := copy(Value);
  4805. ELSIF e.resolved # NIL THEN copy.resolved := CloneExpression(e.resolved)(Value);
  4806. END;
  4807. RETURN copy
  4808. END;
  4809. END CloneExpression;
  4810. PROCEDURE CloneDesignator*(e: Expression): Designator;
  4811. BEGIN
  4812. IF e = NIL THEN RETURN NIL ELSE RETURN CloneExpression(e)(Designator) END;
  4813. END CloneDesignator;
  4814. PROCEDURE NewElement*( position: Position; from,to: Expression ): Expression;
  4815. BEGIN
  4816. IF from = to THEN RETURN from
  4817. ELSE RETURN NewRangeExpression(position,from,to,NIL)
  4818. END;
  4819. END NewElement;
  4820. PROCEDURE NewSet*( position: Position ): Set;
  4821. VAR set: Set;
  4822. BEGIN NEW( set, position ); RETURN set
  4823. END NewSet;
  4824. PROCEDURE NewMathArrayExpression*( position: Position ): MathArrayExpression;
  4825. VAR mathArrayExpression: MathArrayExpression;
  4826. BEGIN NEW( mathArrayExpression, position ); RETURN mathArrayExpression
  4827. END NewMathArrayExpression;
  4828. PROCEDURE NewBinaryExpression*( position: Position; left, right: Expression; operator: LONGINT ): BinaryExpression;
  4829. VAR binaryExpression: BinaryExpression;
  4830. BEGIN
  4831. NEW( binaryExpression, position, left, right, operator ); RETURN binaryExpression;
  4832. END NewBinaryExpression;
  4833. PROCEDURE NewRangeExpression*(position: Position; first, last, step: Expression): RangeExpression;
  4834. VAR rangeExpression: RangeExpression;
  4835. BEGIN
  4836. NEW(rangeExpression, position, first, last, step); RETURN rangeExpression
  4837. END NewRangeExpression;
  4838. PROCEDURE NewTensorRangeExpression*(position: Position): TensorRangeExpression;
  4839. VAR tensorRangeExpression: TensorRangeExpression;
  4840. BEGIN
  4841. NEW(tensorRangeExpression,position); RETURN tensorRangeExpression
  4842. END NewTensorRangeExpression;
  4843. PROCEDURE NewUnaryExpression*( position: Position; operand: Expression; operator: LONGINT ): UnaryExpression;
  4844. VAR unaryExpression: UnaryExpression;
  4845. BEGIN
  4846. NEW( unaryExpression, position, operand, operator ); RETURN unaryExpression;
  4847. END NewUnaryExpression;
  4848. PROCEDURE NewConversion*( position: Position; expression: Expression; type: Type; typeExpression: Expression): Conversion;
  4849. VAR conversion: Conversion;
  4850. BEGIN
  4851. ASSERT(type # NIL);
  4852. NEW( conversion, position, expression,type, typeExpression ); RETURN conversion;
  4853. END NewConversion;
  4854. PROCEDURE NewValue*(): Value;(* for error handling: invalid Value *)
  4855. VAR value: Value;
  4856. BEGIN
  4857. NEW(value,invalidPosition); RETURN value;
  4858. END NewValue;
  4859. PROCEDURE NewIntegerValue*( position: Position; value: Basic.Integer): IntegerValue;
  4860. VAR integerValue: IntegerValue;
  4861. BEGIN
  4862. NEW( integerValue, position, value); RETURN integerValue;
  4863. END NewIntegerValue;
  4864. PROCEDURE NewCharacterValue*( position: Position; value: CHAR): CharacterValue;
  4865. VAR characterValue: CharacterValue;
  4866. BEGIN
  4867. NEW( characterValue, position, value); RETURN characterValue;
  4868. END NewCharacterValue;
  4869. PROCEDURE NewSetValue*(position: Position; value: Basic.Set): SetValue;
  4870. VAR setValue: SetValue;
  4871. BEGIN
  4872. NEW(setValue, position, value); RETURN setValue
  4873. END NewSetValue;
  4874. PROCEDURE NewMathArrayValue*( position: Position ): MathArrayValue;
  4875. VAR mathArrayValue: MathArrayValue;
  4876. BEGIN NEW( mathArrayValue, position ); RETURN mathArrayValue
  4877. END NewMathArrayValue;
  4878. PROCEDURE NewRealValue*( position: Position; value: LONGREAL): RealValue;
  4879. VAR realValue: RealValue;
  4880. BEGIN
  4881. NEW( realValue, position, value); RETURN realValue
  4882. END NewRealValue;
  4883. PROCEDURE NewComplexValue*( position: Position; realValue, imagValue: LONGREAL): ComplexValue;
  4884. VAR complexValue: ComplexValue;
  4885. BEGIN
  4886. NEW( complexValue, position, realValue, imagValue); RETURN complexValue
  4887. END NewComplexValue;
  4888. PROCEDURE NewStringValue*( position: Position; value: String): StringValue;
  4889. VAR stringValue: StringValue;
  4890. BEGIN
  4891. NEW( stringValue, position, value ); RETURN stringValue
  4892. END NewStringValue;
  4893. PROCEDURE NewBooleanValue*( position: Position; value: BOOLEAN): BooleanValue;
  4894. VAR booleanValue: BooleanValue;
  4895. BEGIN
  4896. NEW( booleanValue, position, value ); RETURN booleanValue;
  4897. END NewBooleanValue;
  4898. PROCEDURE NewNilValue*( position: Position ): NilValue;
  4899. VAR nilValue: NilValue;
  4900. BEGIN
  4901. NEW( nilValue, position ); RETURN nilValue
  4902. END NewNilValue;
  4903. PROCEDURE NewEnumerationValue*( position: Position; value: Basic.Integer ): EnumerationValue;
  4904. VAR enumeratorValue: EnumerationValue;
  4905. BEGIN
  4906. NEW( enumeratorValue, position, value ); RETURN enumeratorValue
  4907. END NewEnumerationValue;
  4908. PROCEDURE NewStatement*(outer: Statement): Statement; (* for error handling: invalid Statement *)
  4909. VAR statement: Statement;
  4910. BEGIN NEW(statement,invalidPosition,outer); RETURN statement;
  4911. END NewStatement;
  4912. PROCEDURE CloneStatement*(statement: Statement): Statement;
  4913. BEGIN IF statement = NIL THEN RETURN NIL ELSE RETURN statement.Clone() END
  4914. END CloneStatement;
  4915. PROCEDURE NewStatementSequence*(): StatementSequence;
  4916. VAR statementSequence: StatementSequence;
  4917. BEGIN
  4918. NEW( statementSequence); RETURN statementSequence
  4919. END NewStatementSequence;
  4920. PROCEDURE CloneStatementSequence*(statementSequence: StatementSequence): StatementSequence;
  4921. VAR copy: StatementSequence;
  4922. BEGIN IF statementSequence = NIL THEN RETURN NIL ELSE statementSequence.Clone(copy); RETURN copy END
  4923. END CloneStatementSequence;
  4924. PROCEDURE NewModifier*(position: Position; identifier: Identifier; expression: Expression): Modifier;
  4925. VAR blockModifier: Modifier;
  4926. BEGIN
  4927. NEW(blockModifier,position,identifier,expression); RETURN blockModifier
  4928. END NewModifier;
  4929. PROCEDURE NewStatementBlock*( position: Position ; outer: Statement): StatementBlock;
  4930. VAR statementBlock: StatementBlock;
  4931. BEGIN
  4932. NEW( statementBlock, position, outer ); RETURN statementBlock
  4933. END NewStatementBlock;
  4934. PROCEDURE NewStatementDesignator*(position: Position; s: Statement): StatementDesignator;
  4935. VAR statementDesignator: StatementDesignator;
  4936. BEGIN
  4937. NEW( statementDesignator, position, s); RETURN statementDesignator
  4938. END NewStatementDesignator;
  4939. PROCEDURE NewBody*( position: Position ; scope: ProcedureScope): Body;
  4940. VAR body: Body;
  4941. BEGIN
  4942. NEW( body, position,scope ); RETURN body
  4943. END NewBody;
  4944. PROCEDURE NewIfPart*(): IfPart;
  4945. VAR ifPart: IfPart;
  4946. BEGIN
  4947. NEW( ifPart); RETURN ifPart
  4948. END NewIfPart;
  4949. PROCEDURE NewIfStatement*( position: Position ; outer: Statement): IfStatement;
  4950. VAR ifStatement: IfStatement;
  4951. BEGIN
  4952. NEW( ifStatement, position,outer ); RETURN ifStatement
  4953. END NewIfStatement;
  4954. PROCEDURE NewAssignment*( position: Position; left: Designator; right: Expression; outer: Statement): Assignment;
  4955. VAR assignment: Assignment;
  4956. BEGIN
  4957. NEW( assignment, position, left, right,outer ); RETURN assignment
  4958. END NewAssignment;
  4959. PROCEDURE NewCommunicationStatement*( position: Position; op: LONGINT; left: Designator; right: Expression; outer: Statement): CommunicationStatement;
  4960. VAR communication: CommunicationStatement;
  4961. BEGIN
  4962. NEW( communication, position, op, left, right,outer ); RETURN communication
  4963. END NewCommunicationStatement;
  4964. PROCEDURE NewProcedureCallStatement*(position: Position; call: Designator; outer: Statement): ProcedureCallStatement;
  4965. VAR caller: ProcedureCallStatement;
  4966. BEGIN
  4967. NEW(caller,position,call,outer); RETURN caller
  4968. END NewProcedureCallStatement;
  4969. PROCEDURE NewCaseStatement*( position: Position ; outer: Statement): CaseStatement;
  4970. VAR caseStatement: CaseStatement;
  4971. BEGIN
  4972. NEW( caseStatement, position,outer ); RETURN caseStatement
  4973. END NewCaseStatement;
  4974. PROCEDURE NewCasePart*(): CasePart;
  4975. VAR casePart: CasePart;
  4976. BEGIN
  4977. NEW( casePart); RETURN casePart
  4978. END NewCasePart;
  4979. PROCEDURE NewWithPart*(): WithPart;
  4980. VAR withPart: WithPart;
  4981. BEGIN
  4982. NEW( withPart); RETURN withPart
  4983. END NewWithPart;
  4984. PROCEDURE NewWithStatement*( position: Position; outer: Statement): WithStatement;
  4985. VAR withStatement: WithStatement;
  4986. BEGIN
  4987. NEW( withStatement, position, outer ); RETURN withStatement
  4988. END NewWithStatement;
  4989. PROCEDURE NewWhileStatement*( position: Position ; outer: Statement): WhileStatement;
  4990. VAR whileStatement: WhileStatement;
  4991. BEGIN
  4992. NEW( whileStatement, position,outer ); RETURN whileStatement
  4993. END NewWhileStatement;
  4994. PROCEDURE NewRepeatStatement*( position: Position ; outer: Statement): RepeatStatement;
  4995. VAR repeatStatement: RepeatStatement;
  4996. BEGIN
  4997. NEW( repeatStatement, position ,outer); RETURN repeatStatement
  4998. END NewRepeatStatement;
  4999. PROCEDURE NewForStatement*( position: Position; outer: Statement ): ForStatement;
  5000. VAR forStatement: ForStatement;
  5001. BEGIN
  5002. NEW( forStatement, position,outer ); RETURN forStatement
  5003. END NewForStatement;
  5004. PROCEDURE NewLoopStatement*( position: Position ; outer: Statement): LoopStatement;
  5005. VAR loopStatement: LoopStatement;
  5006. BEGIN
  5007. NEW( loopStatement, position ,outer); RETURN loopStatement
  5008. END NewLoopStatement;
  5009. PROCEDURE NewExitableBlock*( position: Position ; outer: Statement): ExitableBlock;
  5010. VAR loopStatement: ExitableBlock;
  5011. BEGIN
  5012. NEW( loopStatement, position ,outer); RETURN loopStatement
  5013. END NewExitableBlock;
  5014. PROCEDURE NewExitStatement*( position: Position ; outer: Statement): ExitStatement;
  5015. VAR exitStatement: ExitStatement;
  5016. BEGIN
  5017. NEW( exitStatement, position, outer); RETURN exitStatement
  5018. END NewExitStatement;
  5019. PROCEDURE NewReturnStatement*( position: Position; outer: Statement ): ReturnStatement;
  5020. VAR returnStatement: ReturnStatement;
  5021. BEGIN
  5022. NEW( returnStatement, position,outer ); RETURN returnStatement
  5023. END NewReturnStatement;
  5024. PROCEDURE NewAwaitStatement*( position: Position; outer: Statement ): AwaitStatement;
  5025. VAR awaitStatement: AwaitStatement;
  5026. BEGIN
  5027. NEW( awaitStatement, position, outer ); RETURN awaitStatement
  5028. END NewAwaitStatement;
  5029. PROCEDURE NewCode*(position: Position; outer: Statement): Code;
  5030. VAR code: Code;
  5031. BEGIN
  5032. NEW(code,position,outer); RETURN code
  5033. END NewCode;
  5034. PROCEDURE NewProcedureScope*(outer: Scope): ProcedureScope;
  5035. VAR scope: ProcedureScope;
  5036. BEGIN NEW(scope,outer); RETURN scope
  5037. END NewProcedureScope;
  5038. PROCEDURE NewModuleScope*(): ModuleScope;
  5039. VAR scope: ModuleScope;
  5040. BEGIN NEW(scope); RETURN scope
  5041. END NewModuleScope;
  5042. PROCEDURE NewRecordScope*(outer: Scope): RecordScope;
  5043. VAR scope: RecordScope;
  5044. BEGIN NEW(scope,outer); RETURN scope
  5045. END NewRecordScope;
  5046. PROCEDURE NewCellScope*(outer: Scope): CellScope;
  5047. VAR scope: CellScope;
  5048. BEGIN NEW(scope,outer); RETURN scope
  5049. END NewCellScope;
  5050. PROCEDURE NewEnumerationScope*(outer: Scope): EnumerationScope;
  5051. VAR scope: EnumerationScope;
  5052. BEGIN NEW(scope,outer); RETURN scope
  5053. END NewEnumerationScope;
  5054. PROCEDURE Init;
  5055. BEGIN;
  5056. invalidPosition.start := -1;
  5057. invalidIdentifier := Basic.invalidString;
  5058. invalidQualifiedIdentifier := NewQualifiedIdentifier(invalidPosition,invalidIdentifier,Basic.emptyString);
  5059. invalidType := NewType();
  5060. invalidDesignator := NewDesignator();
  5061. invalidDesignator.SetType(invalidType);
  5062. invalidExpression := invalidDesignator;
  5063. invalidValue := NewValue();
  5064. invalidSymbol := NewSymbol(NewIdentifier(""));
  5065. invalidSymbol.SetType(invalidType);
  5066. importType := NewType();
  5067. importType.SetState(Resolved);
  5068. typeDeclarationType := NewType();
  5069. typeDeclarationType.SetState(Resolved);
  5070. moduleType := NewType();
  5071. moduleType.SetState(Resolved);
  5072. anonymousIdentifier := NewIdentifier("");
  5073. indexListSeparator := NewDesignator();
  5074. indexListSeparator.SetType(invalidType);
  5075. END Init;
  5076. BEGIN
  5077. Init;
  5078. END FoxSyntaxTree.