FoxSyntaxTree.Mod 167 KB

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