FoxSyntaxTree.Mod 164 KB

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