1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821 |
- MODULE FoxSyntaxTree; (** AUTHOR "fof & fn"; PURPOSE "Oberon Compiler: Abstract Syntax Tree"; **)
- (* (c) fof ETHZ 2009 *)
- (**
- note on documentation:
- 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.
- 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.
- The informal Oberon syntax is marked with << ... >>
- **)
- IMPORT
- Basic := FoxBasic, Scanner := FoxScanner, BitSets, StringPool, Strings(* , D := Debugging (* only for debuggging / counting *) *) ;
- CONST
- (** general flags: used in statements, procedure types and symbols
- general flags are unique and may overlap with access flags only
- flag numbers have no meaning and are not used for object files etc., i.e. flag renumbering is possible without effect
- *)
- (** calling conventions *)
- OberonCallingConvention* = 0;
- CCallingConvention* = 1;
- WinAPICallingConvention* = 2;
- InterruptCallingConvention* = 3;
- PlatformCallingConvention* = 4;
- UndefinedCallingConvention* = 5;
- (** Access Flags *)
- InternalRead* = 0; (** can read symbol in same module *)
- InternalWrite* = 1; (** can write symbol in same module *)
- ProtectedRead* = 2; (** can read symbol in type extentions *)
- ProtectedWrite* = 3; (** can write symbol in type extentions *)
- PublicRead* = 4; (** can read everywhere *)
- PublicWrite* = 5; (** can write everywhere *)
- Hidden* = {};
- Internal* = {InternalRead, InternalWrite};
- Protected* = {ProtectedRead, ProtectedWrite} ;
- Public* = {PublicRead, PublicWrite} ;
- ReadOnly* = {InternalRead, ProtectedRead,PublicRead};
- (** parameter forms *)
- ValueParameter* = 0; VarParameter* = 1; ConstParameter* = 2;
- InPort*=3; OutPort*=4;
- (** array forms *)
- Static*=1; (* ARRAY x OF .. / ARRAY [x] OF ... *)
- Open*=2; (* ARRAY OF ... / ARRAY [*] OF ... *)
- Tensor*=3; (* ARRAY [?] OF ... *)
- SemiDynamic*=4;
- (** node states, important for checker to avoid cycles *)
- Undefined*={}; BeingResolved*=1; Resolved*=2; FingerPrinted*=3; Warned*=4;
- (* context in which a range expression is used *)
- ArrayIndex* = 0;
- SetElement* = 1;
- CaseGuard* = 2;
-
- (* reflection flags *)
- FlagProcedureDelegate*=0;
- FlagProcedureConstructor*=1;
-
- FlagParameterVar*=1;
- FlagParameterConst*=2;
- TYPE
- Position*= Scanner.Position;
- SourceCode*= Scanner.StringType;
- BinaryCode*= BitSets.BitSet;
- String*= Scanner.StringType;
- IdentifierString*= Scanner.IdentifierString;
- CallingConvention*= LONGINT;
- (** visitor pattern implementation *)
- (* to use this object in your implementation, copy and paste and replace "x: " by "x: SyntaxTree." *)
- Visitor* = OBJECT
- (** types *)
- PROCEDURE VisitType*(x: Type);
- BEGIN HALT(100) (* abstract *) END VisitType;
- PROCEDURE VisitBasicType*(x: BasicType);
- BEGIN HALT(100) (* abstract *) END VisitBasicType;
- PROCEDURE VisitByteType*(x: ByteType);
- BEGIN HALT(100) (* abstract *) END VisitByteType;
- PROCEDURE VisitAnyType*(x: AnyType);
- BEGIN HALT(100) (* abstract *) END VisitAnyType;
- PROCEDURE VisitObjectType*(x: ObjectType);
- BEGIN HALT(100) (* abstract *) END VisitObjectType;
- PROCEDURE VisitNilType*(x: NilType);
- BEGIN HALT(100) (* abstract *) END VisitNilType;
- PROCEDURE VisitAddressType*(x: AddressType);
- BEGIN HALT(100) (* abstract *) END VisitAddressType;
- PROCEDURE VisitSizeType*(x: SizeType);
- BEGIN HALT(100) (* abstract *) END VisitSizeType;
- PROCEDURE VisitBooleanType*(x: BooleanType);
- BEGIN HALT(100) (* abstract *) END VisitBooleanType;
- PROCEDURE VisitSetType*(x: SetType);
- BEGIN HALT(100) (* abstract *) END VisitSetType;
- PROCEDURE VisitCharacterType*(x: CharacterType);
- BEGIN HALT(100) END VisitCharacterType;
- PROCEDURE VisitIntegerType*(x: IntegerType);
- BEGIN HALT(100) END VisitIntegerType;
- PROCEDURE VisitFloatType*(x: FloatType);
- BEGIN HALT(100) END VisitFloatType;
- PROCEDURE VisitComplexType*(x: ComplexType);
- BEGIN HALT(100) END VisitComplexType;
- PROCEDURE VisitQualifiedType*(x: QualifiedType);
- BEGIN HALT(100) (* abstract *) END VisitQualifiedType;
- PROCEDURE VisitStringType*(x: StringType);
- BEGIN HALT(100) (* abstract *) END VisitStringType;
- PROCEDURE VisitEnumerationType*(x: EnumerationType);
- BEGIN HALT(100) (* abstract *) END VisitEnumerationType;
- PROCEDURE VisitRangeType*(x: RangeType);
- BEGIN HALT(100) (* abstract *) END VisitRangeType;
- PROCEDURE VisitArrayType*(x: ArrayType);
- BEGIN HALT(100) (* abstract *) END VisitArrayType;
- PROCEDURE VisitMathArrayType*(x: MathArrayType);
- BEGIN HALT(100) (* abstract *) END VisitMathArrayType;
- PROCEDURE VisitPointerType*(x: PointerType);
- BEGIN HALT(100) (* abstract *) END VisitPointerType;
- PROCEDURE VisitPortType*(x: PortType);
- BEGIN HALT(100) (* abstract *) END VisitPortType;
- PROCEDURE VisitRecordType*(x: RecordType);
- BEGIN HALT(100) (* abstract *) END VisitRecordType;
- PROCEDURE VisitCellType*(x: CellType);
- BEGIN HALT(100) (* abstract *) END VisitCellType;
- PROCEDURE VisitProcedureType*(x: ProcedureType);
- BEGIN HALT(100) (* abstract *) END VisitProcedureType;
-
- PROCEDURE VType*(x: Type);
- BEGIN
- WITH x: ProcedureType DO VisitProcedureType(x)
- |CellType DO VisitCellType(x)
- |RecordType DO VisitRecordType(x)
- |PortType DO VisitPortType(x)
- |PointerType DO VisitPointerType(x)
- |MathArrayType DO VisitMathArrayType(x)
- |ArrayType DO VisitArrayType(x)
- |RangeType DO VisitRangeType(x)
- |EnumerationType DO VisitEnumerationType(x)
- |StringType DO VisitStringType(x)
- |QualifiedType DO VisitQualifiedType(x)
- |ComplexType DO VisitComplexType(x)
- |FloatType DO VisitFloatType(x)
- |IntegerType DO VisitIntegerType(x)
- |CharacterType DO VisitCharacterType(x)
- |SetType DO VisitSetType(x)
- |BooleanType DO VisitBooleanType(x)
- |SizeType DO VisitSizeType(x)
- |AddressType DO VisitAddressType(x)
- |NilType DO VisitNilType(x)
- |ObjectType DO VisitObjectType(x)
- |AnyType DO VisitAnyType(x)
- |ByteType DO VisitByteType(x)
- |BasicType DO VisitBasicType(x)
- ELSE VisitType(x)
- END;
- END VType;
- (** expressions *)
- PROCEDURE VisitExpression*(x: Expression);
- BEGIN HALT(100) (* abstract *) END VisitExpression;
- PROCEDURE VisitSet*(x: Set);
- BEGIN HALT(100) (* abstract *) END VisitSet;
- PROCEDURE VisitMathArrayExpression*(x: MathArrayExpression);
- BEGIN HALT(100) (* abstract *) END VisitMathArrayExpression;
- PROCEDURE VisitUnaryExpression*(x: UnaryExpression);
- BEGIN HALT(100) (* abstract *) END VisitUnaryExpression;
- PROCEDURE VisitBinaryExpression*(x: BinaryExpression);
- BEGIN HALT(100) (* abstract *) END VisitBinaryExpression;
- PROCEDURE VisitRangeExpression*(x: RangeExpression);
- BEGIN HALT(100) (* abstract *) END VisitRangeExpression;
- PROCEDURE VisitTensorRangeExpression*(x: TensorRangeExpression);
- BEGIN HALT(100) (* abstract *) END VisitTensorRangeExpression;
- PROCEDURE VisitConversion*(x: Conversion);
- BEGIN HALT(100) (* abstract *) END VisitConversion;
- (** designators (expressions) *)
- PROCEDURE VisitDesignator*(x: Designator);
- BEGIN HALT(100) (* abstract *) END VisitDesignator;
- PROCEDURE VisitIdentifierDesignator*(x: IdentifierDesignator);
- BEGIN HALT(100) (* abstract *) END VisitIdentifierDesignator;
- PROCEDURE VisitSelectorDesignator*(x: SelectorDesignator);
- BEGIN HALT(100) (* abstract *) END VisitSelectorDesignator;
- PROCEDURE VisitParameterDesignator*(x: ParameterDesignator);
- BEGIN HALT(100) (* abstract *) END VisitParameterDesignator;
- PROCEDURE VisitArrowDesignator*(x: ArrowDesignator);
- BEGIN HALT(100) (* abstract *) END VisitArrowDesignator;
- PROCEDURE VisitBracketDesignator*(x: BracketDesignator);
- BEGIN HALT(100) (* abstract *) END VisitBracketDesignator;
- PROCEDURE VisitSymbolDesignator*(x: SymbolDesignator);
- BEGIN HALT(100) (* abstract *) END VisitSymbolDesignator;
- PROCEDURE VisitIndexDesignator*(x: IndexDesignator);
- BEGIN HALT(100) (* abstract *) END VisitIndexDesignator;
- PROCEDURE VisitProcedureCallDesignator*(x: ProcedureCallDesignator);
- BEGIN HALT(100) (* abstract *) END VisitProcedureCallDesignator;
- PROCEDURE VisitInlineCallDesignator*(x: InlineCallDesignator);
- BEGIN HALT(100) (* abstract *) END VisitInlineCallDesignator;
- PROCEDURE VisitStatementDesignator*(x: StatementDesignator);
- BEGIN HALT(100) (* abstract *) END VisitStatementDesignator;
- PROCEDURE VisitBuiltinCallDesignator*(x: BuiltinCallDesignator);
- BEGIN HALT(100) (* abstract *) END VisitBuiltinCallDesignator;
- PROCEDURE VisitTypeGuardDesignator*(x: TypeGuardDesignator);
- BEGIN HALT(100) (* abstract *) END VisitTypeGuardDesignator;
- PROCEDURE VisitDereferenceDesignator*(x: DereferenceDesignator);
- BEGIN HALT(100) (* abstract *) END VisitDereferenceDesignator;
- PROCEDURE VisitSupercallDesignator*(x: SupercallDesignator);
- BEGIN HALT(100) (* abstract *) END VisitSupercallDesignator;
- PROCEDURE VisitSelfDesignator*(x: SelfDesignator);
- BEGIN HALT(100) (* abstract *) END VisitSelfDesignator;
- PROCEDURE VisitResultDesignator*(x: ResultDesignator);
- BEGIN HALT(100) (* abstract *) END VisitResultDesignator;
- (** values *)
- PROCEDURE VisitValue*(x: Value);
- BEGIN HALT(100) (* abstract *) END VisitValue;
- PROCEDURE VisitBooleanValue*(x: BooleanValue);
- BEGIN HALT(100) (* abstract *) END VisitBooleanValue;
- PROCEDURE VisitIntegerValue*(x: IntegerValue);
- BEGIN HALT(100) (* abstract *) END VisitIntegerValue;
- PROCEDURE VisitCharacterValue*(x: CharacterValue);
- BEGIN HALT(100) (* abstract *) END VisitCharacterValue;
- PROCEDURE VisitSetValue*(x: SetValue);
- BEGIN HALT(100) (* abstract *) END VisitSetValue;
- PROCEDURE VisitMathArrayValue*(x: MathArrayValue);
- BEGIN HALT(100) (* abstract *) END VisitMathArrayValue;
- PROCEDURE VisitRealValue*(x: RealValue);
- BEGIN HALT(100) (* abstract *) END VisitRealValue;
- PROCEDURE VisitComplexValue*(x: ComplexValue);
- BEGIN HALT(100) (* abstract *) END VisitComplexValue;
- PROCEDURE VisitStringValue*(x: StringValue);
- BEGIN HALT(100) (* abstract *) END VisitStringValue;
- PROCEDURE VisitNilValue*(x: NilValue);
- BEGIN HALT(100) (* abstract *) END VisitNilValue;
- PROCEDURE VisitEnumerationValue*(x: EnumerationValue);
- BEGIN HALT(100) (* abstract *) END VisitEnumerationValue;
- PROCEDURE VExpression*(x: Expression);
- BEGIN
- WITH x:
- ResultDesignator DO VisitResultDesignator(x)
- | SelfDesignator DO VisitSelfDesignator(x)
- | SupercallDesignator DO VisitSupercallDesignator(x)
- | DereferenceDesignator DO VisitDereferenceDesignator(x)
- | TypeGuardDesignator DO VisitTypeGuardDesignator(x)
- | BuiltinCallDesignator DO VisitBuiltinCallDesignator(x)
- | StatementDesignator DO VisitStatementDesignator(x)
- | ProcedureCallDesignator DO VisitProcedureCallDesignator(x)
- | InlineCallDesignator DO VisitInlineCallDesignator(x)
- | IndexDesignator DO VisitIndexDesignator(x)
- | SymbolDesignator DO VisitSymbolDesignator(x)
- | BracketDesignator DO VisitBracketDesignator(x)
- | ArrowDesignator DO VisitArrowDesignator(x)
- | ParameterDesignator DO VisitParameterDesignator(x)
- | SelectorDesignator DO VisitSelectorDesignator(x)
- | IdentifierDesignator DO VisitIdentifierDesignator(x)
- | Designator DO VisitDesignator(x)
- | Conversion DO VisitConversion(x)
- | TensorRangeExpression DO VisitTensorRangeExpression(x)
- | RangeExpression DO VisitRangeExpression(x)
- | BinaryExpression DO VisitBinaryExpression(x)
- | UnaryExpression DO VisitUnaryExpression(x)
- | MathArrayExpression DO VisitMathArrayExpression(x)
- | Set DO VisitSet(x)
- | BooleanValue DO VisitBooleanValue(x)
- | IntegerValue DO VisitIntegerValue(x)
- | CharacterValue DO VisitCharacterValue(x)
- | SetValue DO VisitSetValue(x)
- | MathArrayValue DO VisitMathArrayValue(x)
- | RealValue DO VisitRealValue(x)
- | ComplexValue DO VisitComplexValue(x)
- | StringValue DO VisitStringValue(x)
- | NilValue DO VisitNilValue(x)
- | EnumerationValue DO VisitEnumerationValue(x);
- | Value DO VisitValue(x);
- ELSE
- VisitExpression(x)
- END;
- END VExpression;
- (** symbols *)
- PROCEDURE VisitSymbol*(x: Symbol);
- BEGIN HALT(100) (* abstract *) END VisitSymbol;
-
- PROCEDURE VisitModule*(x: Module);
- BEGIN HALT(100) (* abstract *) END VisitModule;
- PROCEDURE VisitTypeDeclaration*(x: TypeDeclaration);
- BEGIN HALT(100) (* abstract *) END VisitTypeDeclaration;
- PROCEDURE VisitConstant*(x: Constant);
- BEGIN HALT(100) (* abstract *) END VisitConstant;
- PROCEDURE VisitVariable*(x: Variable);
- BEGIN HALT(100) (* abstract *) END VisitVariable;
- PROCEDURE VisitParameter*(x: Parameter);
- BEGIN HALT(100) (* abstract *) END VisitParameter;
- PROCEDURE VisitProperty*(x: Property);
- BEGIN HALT(100) (* abstract *) END VisitProperty;
- PROCEDURE VisitProcedure*(x: Procedure);
- BEGIN HALT(100) (* abstract *) END VisitProcedure;
- PROCEDURE VisitBuiltin*(x: Builtin);
- BEGIN HALT(100) (* abstract *) END VisitBuiltin;
- PROCEDURE VisitOperator*(x: Operator);
- BEGIN HALT(100) (* abstract *) END VisitOperator;
- PROCEDURE VisitImport*(x: Import);
- BEGIN HALT(100) (* abstract *) END VisitImport;
-
- PROCEDURE VSymbol*(x: Symbol);
- BEGIN
- WITH
- x: Module DO VisitModule(x)
- | TypeDeclaration DO VisitTypeDeclaration(x)
- | Constant DO VisitConstant(x)
- | Parameter DO VisitParameter(x)
- | Property DO VisitProperty(x)
- | Variable DO VisitVariable(x)
- | Operator DO VisitOperator(x)
- | Procedure DO VisitProcedure(x)
- | Builtin DO VisitBuiltin(x)
- | Import DO VisitImport(x)
- ELSE
- VisitSymbol(x)
- END;
- END VSymbol;
-
- (** statements *)
- PROCEDURE VisitStatement*(x: Statement);
- BEGIN HALT(100) (* abstract *) END VisitStatement;
- PROCEDURE VisitProcedureCallStatement*(x: ProcedureCallStatement);
- BEGIN HALT(100) (* abstract *) END VisitProcedureCallStatement;
- PROCEDURE VisitAssignment*(x: Assignment);
- BEGIN HALT(100) (* abstract *) END VisitAssignment;
- PROCEDURE VisitCommunicationStatement*(x: CommunicationStatement);
- BEGIN HALT(100) (* abstract *) END VisitCommunicationStatement;
- PROCEDURE VisitIfStatement*(x: IfStatement);
- BEGIN HALT(100) (* abstract *) END VisitIfStatement;
- PROCEDURE VisitWithStatement*(x: WithStatement);
- BEGIN HALT(100) (* abstract *) END VisitWithStatement;
- PROCEDURE VisitCaseStatement*(x: CaseStatement);
- BEGIN HALT(100) (* abstract *) END VisitCaseStatement;
- PROCEDURE VisitWhileStatement*(x: WhileStatement);
- BEGIN HALT(100) (* abstract *) END VisitWhileStatement;
- PROCEDURE VisitRepeatStatement*(x: RepeatStatement);
- BEGIN HALT(100) (* abstract *) END VisitRepeatStatement;
- PROCEDURE VisitForStatement*(x: ForStatement);
- BEGIN HALT(100) (* abstract *) END VisitForStatement;
- PROCEDURE VisitLoopStatement*(x: LoopStatement);
- BEGIN HALT(100) (* abstract *) END VisitLoopStatement;
- PROCEDURE VisitExitableBlock*(x: ExitableBlock);
- BEGIN HALT(100) (* abstract *) END VisitExitableBlock;
- PROCEDURE VisitExitStatement*(x: ExitStatement);
- BEGIN HALT(100) (* abstract *) END VisitExitStatement;
- PROCEDURE VisitReturnStatement*(x: ReturnStatement);
- BEGIN HALT(100) (* abstract *) END VisitReturnStatement;
- PROCEDURE VisitAwaitStatement*(x: AwaitStatement);
- BEGIN HALT(100) (* abstract *) END VisitAwaitStatement;
- PROCEDURE VisitStatementBlock*(x: StatementBlock);
- BEGIN HALT(100) (* abstract *) END VisitStatementBlock;
- PROCEDURE VisitCode*(x: Code);
- BEGIN HALT(100) (* abstract *) END VisitCode;
-
- PROCEDURE VStatement*(x: Statement);
- BEGIN
- WITH x:
- ProcedureCallStatement DO VisitProcedureCallStatement(x)
- | Assignment DO VisitAssignment(x)
- | CommunicationStatement DO VisitCommunicationStatement(x)
- | IfStatement DO VisitIfStatement(x)
- | WithStatement DO VisitWithStatement(x)
- | CaseStatement DO VisitCaseStatement(x)
- | WhileStatement DO VisitWhileStatement(x)
- | RepeatStatement DO VisitRepeatStatement(x)
- | ForStatement DO VisitForStatement(x)
- | LoopStatement DO VisitLoopStatement(x)
- | ExitableBlock DO VisitExitableBlock(x)
- | ExitStatement DO VisitExitStatement(x)
- | ReturnStatement DO VisitReturnStatement(x)
- | AwaitStatement DO VisitAwaitStatement(x)
- | StatementBlock DO VisitStatementBlock(x)
- | Code DO VisitCode(x)
- ELSE VisitStatement(x)
- END;
- END VStatement;
-
- END Visitor;
- ArrayAccessOperators* = RECORD
- len*: Operator; (* length operator *)
- generalRead*, generalWrite*: Operator; (* operators on ARRAY [*] RANGE, for tensors *)
- read*, write*: POINTER TO ARRAY OF Operator; (* fixed-dim. operators *)
- END;
- FingerPrint*= RECORD
- shallow*,public*, private*: LONGINT;
- shallowAvailable*, deepAvailable*: BOOLEAN;
- END;
- (** identifiers in a program text **)
- Identifier* = Basic.String;
- (** qualified identifiers << Identifier.Identifier >> **)
- QualifiedIdentifier* = OBJECT
- VAR
- prefix-, suffix-: Identifier; (* use string index instead ? *)
- position-: Position;
- PROCEDURE & InitQualifiedIdentifier( position: Position; prefix, suffix: Identifier);
- BEGIN
- (* ASSERT(suffix # invalidIdentifier); can happen but should be catched by the parser with error report and not here with trap *)
- SELF.position := position;
- SELF.prefix := prefix; SELF.suffix := suffix;
- END InitQualifiedIdentifier;
- PROCEDURE GetName*(VAR name: Basic.SegmentedName);
- BEGIN
- Basic.InitSegmentedName(name);
- IF prefix # invalidIdentifier THEN Basic.SuffixSegmentedName(name, prefix) END;
- Basic.SuffixSegmentedName(name, suffix)
- END GetName;
- END QualifiedIdentifier;
- (**** types ****)
- (**
- Type
- BasicType
- ObjectType
- NilType
- AnyType
- ByteType
- AddressType
- SizeType
- BooleanType
- SetType
- CharacterType
- RangeType
- NumberType
- IntegerType
- FloatType
- ComplexType
- QualifiedType
- StringType
- EnumerationType
- ArrayType
- MathArrayType
- PointerType
- PortType
- RecordType
- CellType
- ProcedureType
- *)
- Type* = OBJECT
- VAR
- typeDeclaration-: TypeDeclaration; (* link to declaration (if any), needed for printing, debugging and symbol lookup *)
- scope-: Scope; (* scope where the type has been declared *)
- resolved-: Type; (* indirection to resolved type to preserve qualified types *)
- position-,end-: Position;
- state-: SET;
- hasPointers-: BOOLEAN;
- fingerprint-: FingerPrint;
- isRealtime-: BOOLEAN;
- recursion: BOOLEAN;
- sizeInBits-: LONGINT; (* allocation size of this type in bits *)
- alignmentInBits-: LONGINT;
- PROCEDURE & InitType*( position: Position);
- BEGIN
- SELF.position := position; state := Undefined;
- end := invalidPosition;
- typeDeclaration := NIL;
- scope := NIL;
- resolved := SELF;
- sizeInBits := MIN(LONGINT);
- alignmentInBits := 0;
- isRealtime := FALSE;
- recursion := FALSE;
- hasPointers := FALSE;
- InitFingerPrint(fingerprint);
- END InitType;
-
- PROCEDURE SetSize*(sizeInBits: LONGINT);
- BEGIN SELF.sizeInBits := sizeInBits
- END SetSize;
- PROCEDURE SetAlignmentInBits*(alignmentInBits: LONGINT);
- BEGIN SELF.alignmentInBits := alignmentInBits
- END SetAlignmentInBits;
- PROCEDURE End*( position: LONGINT );
- BEGIN SELF.position.end := position;
- END End;
- PROCEDURE SetFingerPrint*(CONST fp: FingerPrint);
- BEGIN
- SELF.fingerprint := fp
- END SetFingerPrint;
- PROCEDURE SetState*(state: LONGINT);
- BEGIN INCL(SELF.state,state);
- END SetState;
- PROCEDURE SetHasPointers*(has: BOOLEAN);
- BEGIN
- hasPointers := has
- END SetHasPointers;
- PROCEDURE RemoveState*(state: LONGINT);
- BEGIN EXCL(SELF.state,state)
- END RemoveState;
- PROCEDURE SetTypeDeclaration*(typeDeclaration: TypeDeclaration);
- BEGIN SELF.typeDeclaration := typeDeclaration
- END SetTypeDeclaration;
- PROCEDURE SetScope*(scope: Scope);
- BEGIN SELF.scope := scope
- END SetScope;
- PROCEDURE SetRealtime*(isRealtime: BOOLEAN);
- BEGIN SELF.isRealtime := isRealtime
- END SetRealtime;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN FALSE
- END SameType;
- (** assignment compatibility of this := SELF *)
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN FALSE
- END CompatibleTo;
- (** Returns if the type is a pointer *)
- PROCEDURE IsPointer*(): BOOLEAN;
- BEGIN RETURN FALSE
- END IsPointer;
- (** Returns if the type consists of more than one parts. Implies that an instance of this type cannot be (easily) represented in one register. *)
- PROCEDURE IsComposite*(): BOOLEAN;
- BEGIN RETURN FALSE
- END IsComposite;
- (** Returns if the type needs to be traced for garbage collection *)
- PROCEDURE NeedsTrace*(): BOOLEAN;
- BEGIN RETURN IsPointer ();
- END NeedsTrace;
-
- PROCEDURE IsRecordType*(): BOOLEAN;
- BEGIN
- RETURN FALSE;
- END IsRecordType;
- END Type;
- (* basic types, defined in global name space *)
- BasicType*= OBJECT(Type)
- VAR name-: Identifier;
- PROCEDURE & InitBasicType(CONST id: ARRAY OF CHAR; sizeInBits: LONGINT);
- VAR str: IdentifierString;
- BEGIN
- COPY(id, str);Basic.AppendNumber(str,sizeInBits); name := NewIdentifier(str);
- InitType(invalidPosition);
- SetSize(sizeInBits);
- SELF.name := name
- END InitBasicType;
- PROCEDURE SetName*(CONST id: ARRAY OF CHAR);
- BEGIN
- name := NewIdentifier(id);
- END SetName;
- PROCEDURE SetTypeDeclaration*(typeDeclaration: TypeDeclaration);
- BEGIN HALT(100);
- END SetTypeDeclaration;
- END BasicType;
- (** <<OBJECT>>
- object type (base type of all objects)
- **)
- ObjectType*=OBJECT(BasicType)
- PROCEDURE & InitObjectType(sizeInBits: LONGINT);
- BEGIN
- InitBasicType("@Object",sizeInBits);
- hasPointers := TRUE;
- END InitObjectType;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this IS ObjectType)
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN ((to IS AnyType) OR (to IS ObjectType))
- END CompatibleTo;
- PROCEDURE IsPointer*(): BOOLEAN;
- BEGIN RETURN TRUE
- END IsPointer;
- END ObjectType;
- (** <<NIL>>
- nil type (type of NIL pointers), may be replaced by any type
- **)
- NilType*=OBJECT(BasicType)
- PROCEDURE & InitNilType(sizeInBits: LONGINT);
- BEGIN
- InitBasicType("@Nil",sizeInBits);
- SetRealtime(TRUE);
- hasPointers := TRUE;
- END InitNilType;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this IS NilType)
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- 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)
- END CompatibleTo;
- PROCEDURE IsPointer*(): BOOLEAN;
- BEGIN RETURN TRUE
- END IsPointer;
- END NilType;
- (** <<SYSTEM.BYTE>>
- any pointer type (pointer to record and pointer to array)
- **)
- AnyType*=OBJECT(BasicType)
- PROCEDURE & InitAnyType(sizeInBits: LONGINT);
- BEGIN
- InitBasicType("@Any",sizeInBits);
- hasPointers := TRUE;
- END InitAnyType;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN this IS AnyType
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN (to IS AnyType)
- END CompatibleTo;
- PROCEDURE IsPointer*(): BOOLEAN;
- BEGIN RETURN TRUE
- END IsPointer;
- END AnyType;
- (** <<SYSTEM.BYTE>>
- byte type
- **)
- ByteType*=OBJECT(BasicType)
- PROCEDURE & InitByteType(sizeInBits: LONGINT);
- BEGIN
- InitBasicType("@Byte",sizeInBits);
- SetRealtime(TRUE);
- END InitByteType;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN this IS ByteType
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN (to IS ByteType)
- END CompatibleTo;
- END ByteType;
- (** <<ADDRESS>>
- address type
- **)
- AddressType*=OBJECT(BasicType)
- PROCEDURE & InitAddressType(sizeInBits: LONGINT);
- BEGIN
- InitBasicType("@Address",sizeInBits);
- SetRealtime(TRUE);
- END InitAddressType;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this IS AddressType)
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN (to IS AddressType) OR (to IS SizeType) OR (to IS IntegerType) & (to.sizeInBits >= sizeInBits) OR (to IS PointerType) & to(PointerType).isUnsafe
- END CompatibleTo;
- END AddressType;
- (** <<SIZE>>
- size type (signed address type)
- **)
- SizeType*=OBJECT(BasicType)
- PROCEDURE & InitSizeType(sizeInBits: LONGINT);
- BEGIN
- InitBasicType("@Size",sizeInBits);
- SetRealtime(TRUE);
- END InitSizeType;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this IS SizeType)
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN (to IS SizeType) OR (to IS AddressType) OR (to IS IntegerType) & (to.sizeInBits >= sizeInBits)
- END CompatibleTo;
- END SizeType;
- (** <<BOOLEAN>>
- boolean type
- **)
- BooleanType*=OBJECT(BasicType)
- PROCEDURE & InitBooleanType(sizeInBits: LONGINT);
- BEGIN
- InitBasicType("@Boolean",sizeInBits);
- SetRealtime(TRUE);
- END InitBooleanType;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN this IS BooleanType
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN (to IS BooleanType)
- END CompatibleTo;
- END BooleanType;
- (** <<SET>>
- set type
- **)
- SetType*=OBJECT(BasicType)
- PROCEDURE & InitSetType(sizeInBits: LONGINT);
- BEGIN
- InitBasicType("@Set",sizeInBits);
- SetRealtime(TRUE);
- END InitSetType;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this = SELF) OR (this IS SetType) & (this.sizeInBits = sizeInBits);
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN (to IS SetType) & (to.sizeInBits >= sizeInBits)
- END CompatibleTo;
- END SetType;
- (** <<CHAR, CHAR8, CHAR16, CHAR32>>
- character types
- **)
- CharacterType*=OBJECT(BasicType)
- PROCEDURE & InitCharacterType(sizeInBits: LONGINT);
- BEGIN
- InitBasicType("@Character", sizeInBits);
- SetRealtime(TRUE);
- END InitCharacterType;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this = SELF) OR (this IS CharacterType) & (this.sizeInBits = sizeInBits)
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN ((to IS CharacterType) OR (to IS ByteType)) & (to.sizeInBits >= sizeInBits)
- END CompatibleTo;
- END CharacterType;
- (** type of ranges (case constants, set elements, array indices)
- represented by basic type <<RANGE>>
- **)
- RangeType* = OBJECT(BasicType)
- PROCEDURE & InitRangeType(sizeInBits: LONGINT);
- BEGIN
- InitBasicType("@RangeType",sizeInBits);
- SetRealtime(TRUE);
- END InitRangeType;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this = SELF) OR (this IS RangeType)
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN SameType(to)
- END CompatibleTo;
- PROCEDURE IsComposite*(): BOOLEAN;
- BEGIN RETURN TRUE
- END IsComposite;
- END RangeType;
- (* number types: IntegerType or FloatType *)
- NumberType*=OBJECT(BasicType)
- PROCEDURE & InitNumberType( CONST name: ARRAY OF CHAR; sizeInBits: LONGINT);
- BEGIN
- InitBasicType(name, sizeInBits);
- SetRealtime(TRUE);
- END InitNumberType;
- END NumberType;
- (** <<SHORTINT, INTEGER, LONGINT, HUGEINT>>
- integer types
- **)
- IntegerType*= OBJECT (NumberType)
- VAR signed-: BOOLEAN;
- PROCEDURE & InitIntegerType(sizeInBits: LONGINT; signed: BOOLEAN);
- BEGIN
- IF signed THEN
- InitNumberType("@Integer",sizeInBits);
- ELSE
- InitNumberType("@Unsigned",sizeInBits);
- END;
- SELF.signed := signed;
- END InitIntegerType;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this = SELF) OR (this IS IntegerType) & (this.sizeInBits = sizeInBits) & (this(IntegerType).signed = signed)
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN ((to IS IntegerType) OR (to IS AddressType) OR (to IS SizeType) OR (to IS ByteType)) & (to.sizeInBits >= sizeInBits) OR (to IS FloatType)
- OR (to IS ComplexType) & CompatibleTo((to(ComplexType).componentType))
- END CompatibleTo;
- END IntegerType;
- (** <<REAL,LONGREAL>>
- real types: REAL, LONGREAL
- **)
- FloatType*= OBJECT (NumberType)
- PROCEDURE & InitFloatType(sizeInBits: LONGINT);
- BEGIN
- InitNumberType("@Float",sizeInBits);
- END InitFloatType;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this = SELF) OR (this IS FloatType) & (this.sizeInBits = sizeInBits)
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN
- RETURN (to IS FloatType) & (to.sizeInBits >= sizeInBits)
- OR (to IS ComplexType) & CompatibleTo((to(ComplexType).componentType))
- END CompatibleTo;
- END FloatType;
- (** <<COMPLEX,LONGCOMPLEX>>
- complex types: COMPLEX, LONGCOMPLEX
- **)
- ComplexType*= OBJECT (NumberType)
- VAR componentType-: Type; (* REAL or LONGREAL*)
- PROCEDURE & InitComplexType(componentType: Type);
- BEGIN
- ASSERT(componentType # NIL);
- SELF.componentType := componentType;
- sizeInBits := 2 * componentType.sizeInBits;
- InitNumberType("@Complex",sizeInBits);
- END InitComplexType;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this = SELF) OR (this IS ComplexType) & (componentType.SameType(this(ComplexType).componentType))
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN (to IS ComplexType) & (componentType.CompatibleTo(to(ComplexType).componentType))
- END CompatibleTo;
- PROCEDURE IsComposite*(): BOOLEAN;
- BEGIN RETURN TRUE
- END IsComposite;
- END ComplexType;
- (** <<qualifiedIdentifier = resolved>>
- named reference to a type
- **)
- QualifiedType* = OBJECT (Type)
- VAR
- qualifiedIdentifier-: QualifiedIdentifier;
- PROCEDURE & InitQualifiedType( position: Position; scope: Scope; qualifiedIdentifier: QualifiedIdentifier);
- BEGIN
- ASSERT(qualifiedIdentifier # NIL);
- InitType( position);
- SELF.scope := scope;
- SELF.qualifiedIdentifier := qualifiedIdentifier;
- resolved := NIL;
- END InitQualifiedType;
- PROCEDURE SetResolved*(resolved: Type);
- BEGIN SELF.resolved := resolved; IF resolved # NIL THEN hasPointers := resolved.hasPointers END;
- END SetResolved;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this = SELF) OR (resolved # NIL) & (this.resolved # NIL) & resolved.SameType(this.resolved)
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN (resolved # NIL) & resolved.CompatibleTo(to)
- END CompatibleTo;
- PROCEDURE IsPointer*(): BOOLEAN;
- BEGIN RETURN (resolved # NIL) & resolved.IsPointer()
- END IsPointer;
- PROCEDURE IsComposite*(): BOOLEAN;
- BEGIN RETURN (resolved # NIL) & resolved.IsComposite()
- END IsComposite;
- PROCEDURE NeedsTrace* (): BOOLEAN;
- BEGIN RETURN (resolved # NIL) & (resolved.NeedsTrace());
- END NeedsTrace;
-
- PROCEDURE IsRecordType*(): BOOLEAN;
- BEGIN
- RETURN (resolved # NIL) & (resolved.IsRecordType());
- END IsRecordType;
-
- END QualifiedType;
- (** string literal type **)
- StringType*= OBJECT(Type)
- VAR
- length-: LONGINT;
- baseType-: Type;
- PROCEDURE & InitStringType(position: Position; baseType: Type; length: LONGINT);
- BEGIN
- InitType(position);
- SetRealtime(TRUE);
- SELF.length := length;
- SELF.baseType := baseType;
- END InitStringType;
- PROCEDURE SetLength*(length: LONGINT);
- BEGIN SELF.length := length
- END SetLength;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this IS StringType) & (this(StringType).length = length)
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN
- IF to IS ArrayType THEN
- WITH to: ArrayType DO
- RETURN to.arrayBase.SameType(baseType.resolved) & ((to.form = Open) OR (to.staticLength >= length))
- END;
- ELSIF to IS CharacterType THEN
- RETURN (length=2) & baseType.CompatibleTo(to)
- ELSE RETURN FALSE
- END;
- END CompatibleTo;
- PROCEDURE IsComposite*(): BOOLEAN;
- BEGIN RETURN TRUE
- END IsComposite;
- END StringType;
- (** enumeration type of the form <<enum (base) red,green,blue end>> **)
- EnumerationType*=OBJECT(Type)
- VAR
- enumerationScope-: EnumerationScope;
- enumerationBase-: Type;
- rangeLowest-,rangeHighest-: Basic.Integer;
- PROCEDURE &InitEnumerationType(position: Position; scope: Scope; enumerationScope: EnumerationScope);
- BEGIN
- InitType(position);
- SetRealtime(TRUE);
- SELF.scope := scope;
- enumerationBase := NIL;
- rangeLowest := 0; rangeHighest := 0;
- SELF.enumerationScope := enumerationScope;
- enumerationScope.ownerEnumeration := SELF;
- END InitEnumerationType;
- PROCEDURE SetEnumerationBase*(base: Type);
- BEGIN enumerationBase := base
- END SetEnumerationBase;
- PROCEDURE SetRange*(lowest,highest: Basic.Integer);
- BEGIN rangeLowest := lowest; rangeHighest := highest;
- END SetRange;
- PROCEDURE Extends*(this: EnumerationType): BOOLEAN;
- BEGIN RETURN (SELF = this) OR (enumerationBase # NIL) & (enumerationBase.resolved(EnumerationType).Extends(this));
- END Extends;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN this = SELF
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN (to IS EnumerationType) & (to(EnumerationType).Extends(SELF))
- END CompatibleTo;
- END EnumerationType;
- (** <<ARRAY [length] OF baseType>> *)
- ArrayType* = OBJECT (Type)
- VAR
- arrayBase-: Type;
- length-: Expression;
- staticLength-: LONGINT;
- form-: LONGINT; (* redundant: (form = Open) = (staticLength = 0) else (form = Static) *)
- PROCEDURE & InitArrayType(position: Position; scope: Scope; form: LONGINT);
- BEGIN
- length := NIL; arrayBase := NIL; InitType(position); staticLength := 0; SELF.form := form; SELF.scope := scope;
- END InitArrayType;
- PROCEDURE SetArrayBase*( type: Type );
- BEGIN
- arrayBase := type; IF (arrayBase # NIL) & (arrayBase.hasPointers) THEN SetHasPointers(TRUE) END;
- END SetArrayBase;
- PROCEDURE SetForm*(f: LONGINT);
- BEGIN
- form := f;
- END SetForm;
-
- PROCEDURE SetLength*(length: Expression);
- BEGIN
- SELF.length := length;
- IF (length.resolved # NIL) & (length.resolved IS IntegerValue) THEN
- staticLength := LONGINT (length.resolved(IntegerValue).value) (* TODO: staticLength should be of type Basic.Integer too *)
- END;
- END SetLength;
- PROCEDURE Child*(nr: LONGINT):Type;
- BEGIN
- IF nr = 0 THEN RETURN SELF;
- ELSIF nr = 1 THEN RETURN arrayBase.resolved;
- ELSE RETURN arrayBase.resolved(ArrayType).Child(nr-1);
- END;
- END Child;
- (* recursion safety for cases such as
- A= POINTER TO ARRAY OF B;
- B= POINTER TO ARRAY OF A;
- *)
- PROCEDURE SameType*(this: Type): BOOLEAN;
- VAR result : BOOLEAN;
- BEGIN
- result := FALSE;
- IF this = SELF THEN
- result := TRUE
- ELSIF recursion THEN
- result := TRUE;
- ELSIF this IS ArrayType THEN
- recursion := TRUE;
- WITH this: ArrayType DO
- result := (this.form = form) & (this.staticLength = staticLength) & arrayBase.SameType(this.arrayBase.resolved);
- END;
- END;
- recursion := FALSE;
- RETURN result
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN
- RETURN (form = Static) & SameType(to)
- END CompatibleTo;
- PROCEDURE IsComposite*(): BOOLEAN;
- BEGIN RETURN TRUE
- END IsComposite;
- PROCEDURE NeedsTrace*(): BOOLEAN;
- BEGIN RETURN arrayBase.resolved.NeedsTrace ();
- END NeedsTrace;
- END ArrayType;
- (** <<ARRAY '[' length | '*' | '?' ']' OF baseType>> **)
- MathArrayType* = OBJECT (Type)
- VAR
- modifiers-: Modifier; (* set by the parser *)
- arrayBase-: Type;
- length-: Expression;
- staticLength-: LONGINT;
- staticIncrementInBits-: LONGINT;
- form-: LONGINT;
- isUnsafe-: BOOLEAN;
- PROCEDURE & InitMathArrayType(position: Position;scope: Scope; form: LONGINT);
- BEGIN
- length := NIL; arrayBase := NIL; InitType(position); staticLength := 0; staticIncrementInBits := 0; SetForm(form); SELF.scope := scope; isUnsafe := FALSE; modifiers := NIL;
- END InitMathArrayType;
-
- PROCEDURE SetModifiers*(m: Modifier);
- BEGIN
- modifiers := m;
- END SetModifiers;
-
- PROCEDURE SetUnsafe*(unsafe: BOOLEAN);
- BEGIN
- isUnsafe := unsafe;
- END SetUnsafe;
-
- PROCEDURE SetForm*(form: LONGINT);
- BEGIN
- SELF.form := form; IF form # Static THEN SetHasPointers(TRUE) END;
- END SetForm;
- PROCEDURE SetArrayBase*( type: Type );
- BEGIN
- arrayBase := type; IF (arrayBase # NIL) & (arrayBase.hasPointers) THEN SetHasPointers(TRUE) END;
- END SetArrayBase;
- PROCEDURE SetLength*(length: Expression);
- BEGIN
- SELF.length := length;
- IF (length # NIL) & (length.resolved # NIL) & (length.resolved IS IntegerValue) THEN
- staticLength := LONGINT (length.resolved(IntegerValue).value); (* TODO: staticLength should be of type Basic.Integer too *)
- (* optimization: unless the base type is a dynamic array, make this array static *)
- IF ~((arrayBase # NIL) & (arrayBase IS MathArrayType) & (arrayBase(MathArrayType).form # Static)) THEN
- form := Static;
- END
- ELSIF length = NIL THEN
- form := Open;
- END;
- END SetLength;
- PROCEDURE SetIncrement*(increment: LONGINT);
- BEGIN staticIncrementInBits := increment
- END SetIncrement;
- (* recursion safety for cases such as
- A= POINTER TO ARRAY OF B;
- B= POINTER TO ARRAY OF A;
- *)
- PROCEDURE SameType*(this: Type): BOOLEAN;
- VAR result: BOOLEAN;
- BEGIN
- result := FALSE;
- IF this = SELF THEN
- result := TRUE
- ELSIF recursion THEN
- result := TRUE;
- ELSIF this IS MathArrayType THEN
- recursion := TRUE;
- WITH this: MathArrayType DO
- result := (this.form = form) & (this.staticLength = staticLength) &
- ((arrayBase = NIL) & (this.arrayBase = NIL) OR (arrayBase # NIL) & (this.arrayBase # NIL) &
- arrayBase.SameType(this.arrayBase.resolved));
- END;
- END;
- recursion := FALSE;
- RETURN result
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN
- HALT(200); (*! implement *)
- RETURN (form = Static) & SameType(to)
- END CompatibleTo;
- (** get the element type of a math array, i.e. the first type in the math array chain that is not a math array **)
- PROCEDURE ElementType*(): Type;
- VAR
- type: Type;
- BEGIN
- type := SELF;
- WHILE type IS MathArrayType DO
- type := type(MathArrayType).arrayBase.resolved
- END;
- RETURN type
- END ElementType;
- (** get the number of dimensions of a math array; 0 in case of tensors **)
- PROCEDURE Dimensionality*(): LONGINT;
- VAR
- type: Type;
- dim: LONGINT;
- BEGIN
- IF form = Tensor THEN
- dim := 0
- ELSE
- type := SELF;
- dim := 0;
- WHILE type IS MathArrayType DO
- ASSERT(type(MathArrayType).form # Tensor);
- INC(dim);
- type := type(MathArrayType).arrayBase.resolved
- END
- END;
- RETURN dim
- END Dimensionality;
- (** if the math array is of the form ARRAY [*, *, ..., *], i.e. contains no static length and is not a tensor either **)
- PROCEDURE IsFullyDynamic*(): BOOLEAN;
- VAR
- type: Type;
- result: BOOLEAN;
- BEGIN
- IF form = Tensor THEN
- result := FALSE;
- ELSE
- result := TRUE;
- type := SELF;
- WHILE type IS MathArrayType DO
- IF type(MathArrayType).form # Open THEN result := FALSE END;
- type := type(MathArrayType).arrayBase.resolved
- END
- END;
- RETURN result
- END IsFullyDynamic;
- PROCEDURE NeedsTrace*(): BOOLEAN;
- BEGIN RETURN hasPointers OR (arrayBase # NIL) & (arrayBase.resolved.NeedsTrace());
- END NeedsTrace;
-
- PROCEDURE IsComposite*(): BOOLEAN;
- BEGIN RETURN TRUE
- END IsComposite;
- END MathArrayType;
- (** <<POINTER TO pointerBase>> **)
- PointerType* = OBJECT (Type)
- VAR
- modifiers-: Modifier; (* set by the parser *)
- pointerBase-: Type;
- isPlain-: BOOLEAN;
- isUnsafe-: BOOLEAN;
- isUntraced-: BOOLEAN;
- isDisposable-: BOOLEAN;
- isHidden-: BOOLEAN;
- PROCEDURE & InitPointerType(position: Position; scope: Scope);
- BEGIN
- modifiers := NIL;
- pointerBase := NIL;
- isPlain := FALSE;
- isUnsafe := FALSE;
- isDisposable := FALSE;
- InitType(position);
- SELF.scope := scope;
- hasPointers := TRUE;
- isHidden := FALSE;
- isUntraced := FALSE;
- END InitPointerType;
- PROCEDURE SetHidden*(hidden: BOOLEAN);
- BEGIN
- isHidden := hidden;
- END SetHidden; (** <<POINTER TO pointerBase>> **)
- PROCEDURE SetModifiers*(flags: Modifier);
- BEGIN modifiers := flags
- END SetModifiers;
- PROCEDURE SetPointerBase*( type: Type );
- BEGIN
- pointerBase := type;
- END SetPointerBase;
- PROCEDURE SetPlain*(plain: BOOLEAN);
- BEGIN
- isPlain := plain;
- END SetPlain;
- PROCEDURE SetUnsafe*(unsafe: BOOLEAN);
- BEGIN
- isUnsafe := unsafe;
- END SetUnsafe;
-
- PROCEDURE SetUntraced*(untraced: BOOLEAN);
- BEGIN
- isUntraced := untraced;
- END SetUntraced;
- PROCEDURE SetDisposable*(disposable: BOOLEAN);
- BEGIN
- isDisposable := disposable;
- END SetDisposable;
- PROCEDURE Extends*(this: Type): BOOLEAN;
- VAR result: BOOLEAN; extension, base: Type;
- BEGIN
- result := FALSE;
- IF ((this IS ObjectType) OR (this IS AnyType)) & (pointerBase.resolved IS RecordType) THEN result := TRUE
- ELSE
- extension := pointerBase.resolved;
- IF this IS PointerType THEN
- base := this(PointerType).pointerBase.resolved;
- ELSIF this IS RecordType THEN
- base := this
- ELSE base := NIL
- END;
- IF (extension IS RecordType) & (base # NIL) THEN
- result := extension(RecordType).Extends(base)
- END;
- END;
- RETURN result
- END Extends;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (SELF = this) OR (this IS PointerType) & (this(PointerType).pointerBase.SameType(pointerBase.resolved) & (this(PointerType).isUnsafe = isUnsafe))
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN SameType(to) OR ~(to IS RecordType) & SELF.Extends(to)
- END CompatibleTo;
- PROCEDURE IsPointer*(): BOOLEAN;
- BEGIN RETURN TRUE
- END IsPointer;
-
- PROCEDURE NeedsTrace*(): BOOLEAN;
- BEGIN RETURN ~isUntraced;
- END NeedsTrace;
- END PointerType;
- (** << PORT (IN | OUT) [(size)] >>**)
- PortType* = OBJECT (Type)
- VAR
- direction-: LONGINT;
- sizeExpression-: Expression; (* generated by parser *)
- sizeInBits-: LONGINT; (* computed by checker *)
- cellsAreObjects-: BOOLEAN;
- PROCEDURE & InitPortType(position: Position; direction: LONGINT; sizeExpression: Expression; scope: Scope);
- BEGIN
- InitType(position);
- SELF.sizeExpression := sizeExpression;
- SELF.direction := direction;
- SELF.scope := scope;
- cellsAreObjects := FALSE;
- END InitPortType;
- PROCEDURE SetSize*(size: LONGINT);
- BEGIN sizeInBits := size
- END SetSize;
- PROCEDURE SetSizeExpression*(sizeExpression: Expression);
- BEGIN SELF.sizeExpression := sizeExpression
- END SetSizeExpression;
-
- PROCEDURE SetCellsAreObjects*(b: BOOLEAN);
- BEGIN
- cellsAreObjects := b;
- hasPointers := b;
- END SetCellsAreObjects;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this IS PortType) & (this(PortType).direction = direction) & (this(PortType).sizeInBits = sizeInBits)
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN SameType(to)
- END CompatibleTo;
-
- PROCEDURE IsPointer*(): BOOLEAN;
- BEGIN RETURN cellsAreObjects;
- END IsPointer;
- END PortType;
- (** << recordType =
- [POINTER TO] RECORD (baseType) .. END |
- OBJECT (baseType) .. END
- >> **)
- RecordType* = OBJECT (Type)
- VAR
- recordScope-:RecordScope;
- baseType-: Type;
- pointerType-: PointerType; (* for support of A = POINTER TO RECORD ... END and B = POINTER TO RECORD (A) END; *)
- modifiers-: Modifier;
- isObject-,isProtected: BOOLEAN;
- isAbstract-: BOOLEAN;
- PROCEDURE & InitRecordType( position: Position; scope: Scope; recordScope: RecordScope);
- BEGIN
- InitType( position);
- SELF.scope := scope;
- baseType := NIL;
- pointerType := NIL;
- SELF.recordScope := recordScope;
- ASSERT(recordScope # NIL);
- ASSERT(recordScope.ownerRecord = NIL); (* cannot register twice ! *)
- recordScope.ownerRecord := SELF;
- isObject := FALSE; isProtected := FALSE;
- modifiers := NIL;
- isAbstract := FALSE;
- END InitRecordType;
-
- PROCEDURE SetAbstract*(abstract: BOOLEAN);
- BEGIN
- isAbstract := abstract;
- END SetAbstract;
- PROCEDURE SetModifiers*(flag: Modifier);
- BEGIN SELF.modifiers := flag;
- END SetModifiers;
-
- PROCEDURE SetBaseType*( type: Type );
- BEGIN
- baseType := type; IF (baseType # NIL) & (baseType.hasPointers) THEN hasPointers := TRUE END;
- END SetBaseType;
- PROCEDURE SetPointerType*(pointerType: PointerType);
- BEGIN SELF.pointerType := pointerType
- END SetPointerType;
- PROCEDURE IsObject*(isObject: BOOLEAN);
- BEGIN SELF.isObject := isObject
- END IsObject;
- PROCEDURE IsActive*(): BOOLEAN;
- VAR base: RecordType;
- BEGIN
- IF (recordScope.bodyProcedure # NIL) & (recordScope.bodyProcedure.procedureScope.body # NIL) & (recordScope.bodyProcedure.procedureScope.body.isActive) THEN RETURN TRUE END;
- base := GetBaseRecord();
- IF base # NIL THEN RETURN base.IsActive() END;
- RETURN FALSE
- END IsActive;
- PROCEDURE IsProtected*(): BOOLEAN;
- VAR base: RecordType;
- BEGIN
- IF isProtected THEN RETURN TRUE END;
- base := GetBaseRecord();
- IF base # NIL THEN RETURN base.IsProtected() END;
- RETURN FALSE
- END IsProtected;
- PROCEDURE SetProtected*(protected: BOOLEAN);
- BEGIN SELF.isProtected := protected
- END SetProtected;
- PROCEDURE Level*(): LONGINT;
- VAR type: RecordType; res: LONGINT;
- BEGIN
- type := SELF;
- res := 0;
- WHILE (type # NIL) & (type.baseType # NIL) DO
- INC(res);
- type := type.GetBaseRecord();
- END;
- RETURN res;
- END Level;
- PROCEDURE GetBaseRecord*():RecordType;
- BEGIN
- IF baseType = NIL THEN RETURN NIL; END;
- IF baseType.resolved IS RecordType THEN
- RETURN baseType.resolved(RecordType);
- ELSIF baseType.resolved IS PointerType THEN
- IF baseType.resolved(PointerType).pointerBase.resolved # NIL THEN
- RETURN baseType.resolved(PointerType).pointerBase.resolved(RecordType);
- END;
- END;
- RETURN NIL;
- END GetBaseRecord;
- PROCEDURE Extends*(this: Type): BOOLEAN;
- VAR result: BOOLEAN; extension: Type;
- BEGIN
- result := FALSE;
- IF this = SELF THEN result := TRUE
- ELSIF this IS RecordType THEN
- IF (baseType # NIL) THEN
- extension := baseType.resolved;
- IF extension IS PointerType THEN
- result := extension(PointerType).Extends(this)
- ELSIF extension IS RecordType THEN
- result := extension(RecordType).Extends(this)
- END;
- END;
- END;
- RETURN result
- END Extends;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN (this = SELF)
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN Extends(to)
- END CompatibleTo;
- PROCEDURE IsComposite*(): BOOLEAN;
- BEGIN RETURN TRUE
- END IsComposite;
- PROCEDURE NeedsTrace*(): BOOLEAN;
- BEGIN RETURN recordScope.NeedsTrace();
- END NeedsTrace;
-
- PROCEDURE IsRecordType*(): BOOLEAN;
- BEGIN
- RETURN TRUE;
- END IsRecordType;
- END RecordType;
- CellType*=OBJECT (Type)
- VAR
- firstParameter-,lastParameter-: Parameter; numberParameters-: LONGINT; (* parameters *)
- firstProperty-, lastProperty-: Property; numberProperties: LONGINT; (* capabilities *)
- cellScope-: CellScope;
- isCellNet-: BOOLEAN;
- modifiers-: Modifier;
- baseType-: Type;
- PROCEDURE &InitCellType(position: Position; scope: Scope; cellScope: CellScope);
- BEGIN
- InitType(position);
- SELF.scope := scope;
- numberParameters := 0; firstParameter := NIL; lastParameter := NIL;
- numberProperties := 0; firstProperty := NIL; lastProperty := NIL;
- SELF.cellScope := cellScope;
- isCellNet := FALSE;
- baseType := NIL;
- END InitCellType;
- PROCEDURE SetBaseType*(base: Type);
- BEGIN
- baseType := base;
- END SetBaseType;
-
- PROCEDURE GetBaseValueType*(): Type;
- BEGIN
- IF baseType = NIL THEN
- RETURN NIL
- ELSIF baseType.resolved IS PointerType THEN
- RETURN baseType.resolved(PointerType).pointerBase.resolved
- ELSE
- RETURN baseType.resolved;
- END;
- END GetBaseValueType;
-
- PROCEDURE GetBaseRecord*():RecordType;
- BEGIN
- IF baseType = NIL THEN RETURN NIL; END;
- IF baseType.resolved IS CellType THEN
- RETURN baseType.resolved(CellType).GetBaseRecord();
- ELSIF baseType.resolved IS RecordType THEN
- RETURN baseType.resolved(RecordType);
- ELSIF baseType.resolved IS PointerType THEN
- IF baseType.resolved(PointerType).pointerBase.resolved # NIL THEN
- RETURN baseType.resolved(PointerType).pointerBase.resolved(RecordType);
- END;
- END;
- RETURN NIL;
- END GetBaseRecord;
- PROCEDURE AddParameter*(p: Parameter);
- BEGIN
- ASSERT(p # NIL);
- IF lastParameter= NIL THEN firstParameter := p ELSE lastParameter.nextParameter := p; p.prevParameter := lastParameter; END;
- lastParameter := p;
- INC(numberParameters);
- END AddParameter;
- PROCEDURE AddProperty*(p: Property);
- BEGIN
- ASSERT(p # NIL);
- IF lastProperty= NIL THEN firstProperty := p ELSE lastProperty.nextProperty := p; p.prevProperty := lastProperty; END;
- lastProperty := p;
- INC(numberProperties);
- END AddProperty;
-
- PROCEDURE FindParameter*(identifier: Identifier): Parameter;
- VAR p: Parameter;
- BEGIN
- p := NIL;
- IF (baseType # NIL) & (baseType.resolved IS CellType) THEN
- p := baseType.resolved(CellType).FindParameter(identifier);
- END;
- IF p = NIL THEN
- p := firstParameter;
- WHILE(p#NIL) & (p.name # identifier) DO p := p.nextParameter END;
- END;
- RETURN p;
- END FindParameter;
- PROCEDURE FindProperty*(identifier: Identifier): Property;
- VAR p: Property;
- BEGIN
- p := firstProperty;
- WHILE(p#NIL) & (p.name # identifier) DO p := p.nextProperty END;
- IF p = NIL THEN
- IF (baseType # NIL) & (baseType.resolved IS CellType) THEN
- p := baseType.resolved(CellType).FindProperty(identifier);
- END;
- END;
- RETURN p;
- END FindProperty;
- PROCEDURE SetModifiers*(flag: Modifier);
- BEGIN SELF.modifiers := flag;
- END SetModifiers;
- PROCEDURE IsCellNet*(t: BOOLEAN);
- BEGIN isCellNet := t
- END IsCellNet;
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN RETURN this = SELF
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN RETURN SameType(to)
- END CompatibleTo;
- PROCEDURE IsComposite*(): BOOLEAN;
- BEGIN RETURN TRUE
- END IsComposite;
- END CellType;
- (** <<procedureType = PROCEDURE [{DELEGATE}] (firstParameter .. lastParameter): returnType>>
- also used as type for procedures
- **)
- ProcedureType* = OBJECT (Type)
- VAR
- modifiers-: Modifier; (* set by the parser *)
- returnType-: Type;
- returnTypeModifiers-: Modifier;
- hasUntracedReturn-: BOOLEAN;
- firstParameter-,lastParameter-: Parameter; numberParameters-: LONGINT; (* parameters *)
- returnParameter-: Parameter; (* not really necessary in syntax tree but very handy for backends *)
- selfParameter-: Parameter;
- isDelegate-,isInterrupt-,noPAF-,noReturn-: BOOLEAN;
- pcOffset-: LONGINT; (* PC offset: used for ARM interrupt procedures *)
- callingConvention-: CallingConvention;
- stackAlignment-: LONGINT;
- parametersOffset-: LONGINT; (* stack parameter offset -- in units of addresses: one pointer = 1 *)
- PROCEDURE & InitProcedureType( position: Position; scope: Scope);
- BEGIN
- InitType( position);
- SELF.scope := scope;
- modifiers := NIL;
- firstParameter := NIL; lastParameter := NIL; numberParameters := 0; returnParameter := NIL;
- returnType := NIL;
- stackAlignment := 1;
- isDelegate := FALSE; isInterrupt := FALSE; noPAF := FALSE;
- callingConvention := OberonCallingConvention;
- parametersOffset := 0;
- pcOffset := 0;
- hasUntracedReturn := FALSE;
- returnTypeModifiers := NIL;
- selfParameter := NIL;
- END InitProcedureType;
- PROCEDURE SetNoPAF*(noPAF: BOOLEAN);
- BEGIN SELF.noPAF := noPAF
- END SetNoPAF;
- PROCEDURE SetNoReturn*(noReturn: BOOLEAN);
- BEGIN SELF.noReturn := noReturn
- END SetNoReturn;
- PROCEDURE SetPcOffset*(pcOffset: LONGINT);
- BEGIN SELF.pcOffset := pcOffset
- END SetPcOffset;
- PROCEDURE SetInterrupt*(isInterrupt: BOOLEAN);
- BEGIN SELF.isInterrupt := isInterrupt
- END SetInterrupt;
- PROCEDURE SetModifiers*(flags: Modifier);
- BEGIN modifiers := flags
- END SetModifiers;
- PROCEDURE SetReturnTypeModifiers*(flags: Modifier);
- BEGIN returnTypeModifiers := flags
- END SetReturnTypeModifiers;
- PROCEDURE SetDelegate*(delegate: BOOLEAN);
- BEGIN SELF.isDelegate := delegate; SELF.hasPointers := delegate;
- END SetDelegate;
-
- PROCEDURE SetUntracedReturn*(untraced: BOOLEAN);
- BEGIN
- hasUntracedReturn := untraced;
- END SetUntracedReturn;
- PROCEDURE SetStackAlignment*(alignment: LONGINT);
- BEGIN
- stackAlignment := alignment;
- END SetStackAlignment;
- PROCEDURE SetParametersOffset*(ofs: LONGINT);
- BEGIN parametersOffset := ofs
- END SetParametersOffset;
- PROCEDURE SetReturnParameter*(parameter: Parameter);
- BEGIN returnParameter := parameter
- END SetReturnParameter;
-
- PROCEDURE SetSelfParameter*(parameter: Parameter);
- BEGIN selfParameter := parameter
- END SetSelfParameter;
- PROCEDURE SetCallingConvention*(cc: CallingConvention);
- BEGIN callingConvention := cc
- END SetCallingConvention;
- PROCEDURE AddParameter*(p: Parameter);
- BEGIN
- ASSERT(p # NIL);
- IF lastParameter= NIL THEN firstParameter := p ELSE lastParameter.nextParameter := p; p.prevParameter := lastParameter; END;
- lastParameter := p;
- INC(numberParameters);
- ASSERT(p.access # {}); (* no hidden parameters ! *)
- END AddParameter;
- PROCEDURE RevertParameters*;
- VAR this,next: Parameter; pnum: LONGINT;
- BEGIN
- pnum := numberParameters;
- IF lastParameter # NIL THEN
- this := lastParameter;
- lastParameter := NIL;
- firstParameter := NIL;
- numberParameters := 0;
- WHILE this # NIL DO
- next := this.prevParameter;
- this.prevParameter := NIL; this.nextParameter := NIL;
- AddParameter(this);
- this := next;
- END;
- END;
- ASSERT(pnum = numberParameters);
- END RevertParameters;
- PROCEDURE SetReturnType*( type: Type );
- BEGIN
- returnType := type;
- END SetReturnType;
-
- PROCEDURE SameSignature*(this: Type): BOOLEAN;
- VAR result: BOOLEAN; p1,p2: Parameter;
- BEGIN
- result := FALSE;
- IF recursion THEN
- result := TRUE
- ELSIF this = SELF THEN
- result := TRUE
- ELSIF this IS ProcedureType THEN
- recursion := TRUE;
- WITH this: ProcedureType DO
- result := (returnType = NIL) & (this.returnType = NIL) OR (returnType # NIL) & (this.returnType # NIL) & returnType.SameType(this.returnType.resolved);
- result := result & (callingConvention = this.callingConvention);
- result := result & (noReturn = this.noReturn);
- result := result & (isInterrupt = this.isInterrupt);
- IF result THEN
-
- p1 := selfParameter; p2 := this.selfParameter;
- IF (p1 = NIL) # (p2=NIL) OR (p1 # NIL) & ((p1.kind # p2.kind)) THEN
- RETURN FALSE
- END;
-
- p1 := firstParameter; p2 := this.firstParameter;
- 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
- p1 := p1.nextParameter; p2 := p2.nextParameter
- END;
- result := ((p1=NIL) OR (p1.access = Hidden)) & ((p2=NIL) OR (p2.access= Hidden));
- END;
- END;
- END;
- recursion := FALSE;
- RETURN result
- END SameSignature;
-
- PROCEDURE SameType*(this: Type): BOOLEAN;
- BEGIN
- RETURN SameSignature(this)
- & (this(ProcedureType).isDelegate = isDelegate)
- & (this(ProcedureType).isRealtime = isRealtime);
- END SameType;
- PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
- BEGIN
- RETURN SameSignature(to) & (~isDelegate OR to(ProcedureType).isDelegate) & (~to.isRealtime OR isRealtime)
- & ((stackAlignment <=1) OR (stackAlignment <= to(ProcedureType).stackAlignment));
- END CompatibleTo;
- PROCEDURE IsComposite*(): BOOLEAN;
- BEGIN RETURN isDelegate
- END IsComposite;
-
- (** Returns if the type needs to be traced for garbage collection *)
- PROCEDURE NeedsTrace*(): BOOLEAN;
- BEGIN RETURN isDelegate;
- END NeedsTrace;
- END ProcedureType;
- (**** expressions ****)
- Expression* = OBJECT
- VAR
- type-: Type; (* the expression's type. Resolved by checker *)
- assignable-: BOOLEAN; (* expression can be assigned to (or used as var-parameter): expression := ... *)
- position-, end-: Position;
- state-: SET;
- resolved-: Value;
- isHidden-: BOOLEAN;
- PROCEDURE End*( position: Position);
- BEGIN SELF.end := position;
- END End;
- PROCEDURE SetState*(state: LONGINT);
- BEGIN INCL(SELF.state,state);
- END SetState;
- PROCEDURE &InitExpression(position: Position);
- BEGIN SELF.position := position; end := invalidPosition; state := Undefined; type := NIL; assignable := FALSE; resolved := NIL; isHidden := FALSE;
- END InitExpression;
- PROCEDURE SetHidden*(hidden: BOOLEAN);
- BEGIN isHidden := hidden
- END SetHidden;
-
- PROCEDURE SetType*(type: Type);
- BEGIN
- SELF.type := type;
- END SetType;
- PROCEDURE SetResolved*(value: Value);
- BEGIN SELF.resolved := value
- END SetResolved;
- PROCEDURE SetAssignable*(assignable: BOOLEAN);
- BEGIN SELF.assignable := assignable
- END SetAssignable;
- PROCEDURE Clone(): Expression;
- VAR clone: Expression;
- BEGIN
- (* support cloning here for more robust error reporting -- should not happen normally *)
- NEW(clone, position); RETURN clone
- END Clone;
- PROCEDURE NeedsTrace* (): BOOLEAN;
- BEGIN RETURN FALSE;
- END NeedsTrace;
- END Expression;
- (** <<expression, expression, ...>> **)
- ExpressionList* = OBJECT
- VAR list: Basic.List;
- PROCEDURE & InitList;
- BEGIN NEW( list,8 );
- END InitList;
- PROCEDURE Length*( ): LONGINT;
- BEGIN RETURN list.Length();
- END Length;
- PROCEDURE AddExpression*( d: Expression );
- BEGIN list.Add(d)
- END AddExpression;
- PROCEDURE GetExpression*( index: LONGINT ): Expression;
- VAR p: ANY;
- BEGIN
- p := list.Get(index); RETURN p(Expression);
- END GetExpression;
- PROCEDURE SetExpression*(index: LONGINT; expression: Expression);
- BEGIN list.Set(index,expression)
- END SetExpression;
- PROCEDURE RemoveExpression*(i: LONGINT);
- BEGIN list.RemoveByIndex(i);
- END RemoveExpression;
- PROCEDURE Revert*;
- VAR i,j,last: LONGINT; ei,ej: ANY;
- BEGIN
- last := Length()-1;
- FOR i := 0 TO last DO
- j := last-i;
- ei := list.Get(i);
- ej := list.Get(j);
- list.Set(i,ej);
- list.Set(j,ei);
- END;
- END Revert;
- PROCEDURE Clone*(VAR list: ExpressionList);
- VAR i: LONGINT;
- BEGIN
- IF list = NIL THEN NEW(list) END;
- FOR i := 0 TO Length()-1 DO
- list.AddExpression(CloneExpression(GetExpression(i)));
- END;
- END Clone;
- END ExpressionList;
- (** << {elements} >> **)
- Set* = OBJECT (Expression)
- VAR elements-: ExpressionList; (* an element of the form from .. to is represented as a RangeExpression *)
- PROCEDURE & InitSet( position: Position );
- BEGIN
- InitExpression( position );
- elements := NewExpressionList();
- END InitSet;
- PROCEDURE Clone(): Expression;
- VAR copy: Set;
- BEGIN
- NEW(copy, position); elements.Clone(copy.elements); RETURN copy
- END Clone;
- END Set;
- (** << [elements] >> **)
- MathArrayExpression* = OBJECT (Expression)
- VAR elements-: ExpressionList; (* an element of the form from .. to is represented as a RangeExpression *)
- PROCEDURE & InitMathArrayExpression( position: Position );
- BEGIN
- InitExpression( position );
- elements := NewExpressionList();
- END InitMathArrayExpression;
- PROCEDURE Clone(): Expression;
- VAR copy: MathArrayExpression;
- BEGIN
- NEW(copy, position); elements.Clone(copy.elements); RETURN copy
- END Clone;
- END MathArrayExpression;
- (** <<operator left>> **)
- UnaryExpression* = OBJECT (Expression)
- VAR
- left-: Expression;
- operator-: LONGINT; (* one of Scanner.Minus ... Scanner.Not *)
- PROCEDURE & InitUnaryExpression( position: Position; operand: Expression; operator: LONGINT );
- BEGIN
- InitExpression( position ); SELF.left := operand; SELF.operator := operator;
- END InitUnaryExpression;
- PROCEDURE SetLeft*(left: Expression);
- BEGIN SELF.left := left
- END SetLeft;
- PROCEDURE Clone(): Expression;
- VAR copy: UnaryExpression;
- BEGIN
- NEW(copy, position, CloneExpression(left), operator); RETURN copy
- END Clone;
- END UnaryExpression;
- (** <<left operator right>> **)
- BinaryExpression* = OBJECT (Expression)
- VAR
- left-, right-: Expression;
- operator-: LONGINT; (* one of Scanner.Equal ... Scanner.Minus *)
- PROCEDURE & InitBinaryExpression( position: Position; left, right: Expression; operator: LONGINT );
- BEGIN
- InitExpression( position ); SELF.left := left; SELF.right := right; SELF.operator := operator;
- END InitBinaryExpression;
- PROCEDURE SetLeft*(left: Expression);
- BEGIN SELF.left := left
- END SetLeft;
- PROCEDURE SetRight*(right: Expression);
- BEGIN SELF.right := right
- END SetRight;
- PROCEDURE Clone(): Expression;
- VAR copy: BinaryExpression;
- BEGIN
- NEW(copy, position, CloneExpression(left), CloneExpression(right), operator); RETURN copy
- END Clone;
- END BinaryExpression;
- (** expression that denotes a range
- <<[first] '..' [last] ['by' step] | '*' >>
- **)
- RangeExpression* = OBJECT (Expression)
- VAR
- first-, last-, step-: Expression;
- missingFirst-, missingLast-, missingStep-: BOOLEAN; (* only for printout*)
- context-: SHORTINT; (* one of ArrayIndex, SetElement or CaseGuard *)
- PROCEDURE &InitRangeExpression(position: Position; first, last, step: Expression);
- BEGIN
- context := ArrayIndex; (* by default, a range represents array indices *)
- InitExpression(position);
- missingFirst := (first = NIL);
- missingLast := (last = NIL);
- missingStep := (step = NIL);
- SELF.first := first;
- SELF.last := last;
- SELF.step := step;
- END InitRangeExpression;
- PROCEDURE SetFirst*(first: Expression);
- BEGIN
- SELF.first := first
- END SetFirst;
- PROCEDURE SetLast*(last: Expression);
- BEGIN SELF.last := last
- END SetLast;
- PROCEDURE SetStep*(step: Expression);
- BEGIN SELF.step := step
- END SetStep;
- PROCEDURE SetContext*(context: SHORTINT);
- BEGIN
- SELF.context := context
- END SetContext;
- PROCEDURE Clone(): Expression;
- VAR copy: RangeExpression;
- BEGIN
- NEW(copy, position, CloneExpression(first), CloneExpression(last), CloneExpression(step)); RETURN copy
- END Clone;
- END RangeExpression;
- (** << ? >> **)
- TensorRangeExpression*=OBJECT (Expression);
- PROCEDURE &InitTensorRangeExpression(position: Position);
- BEGIN
- InitExpression(position);
- END InitTensorRangeExpression;
- PROCEDURE Clone(): Expression;
- VAR copy: TensorRangeExpression;
- BEGIN
- NEW(copy, position); RETURN copy
- END Clone;
- END TensorRangeExpression;
- (** convert expression from expression.type to Conversion.type **)
- Conversion* = OBJECT (Expression)
- VAR
- expression-: Expression;
- typeExpression-: Expression; (* for printout *)
- PROCEDURE & InitConversion( position: Position; expression: Expression; type: Type; typeExpression: Expression);
- BEGIN
- InitExpression( position ); SELF.expression := expression; SELF.typeExpression := typeExpression; SELF.type := type;
- END InitConversion;
- PROCEDURE SetExpression*(expression: Expression);
- BEGIN SELF.expression := expression
- END SetExpression;
- PROCEDURE Clone(): Expression;
- VAR copy: Conversion;
- BEGIN
- NEW(copy, position, CloneExpression(expression), type, CloneExpression(typeExpression)); RETURN copy
- END Clone;
- END Conversion;
- (**** designators ****)
- (** abstract **)
- Designator* = OBJECT(Expression)
- VAR
- left-: Expression; (* currently only designators are allowed but for later purposes ... (as for example (a+b).c) *)
- modifiers-: Modifier;
- relatedRhs-: Expression;
- PROCEDURE &InitDesignator*(position: Position);
- BEGIN
- InitExpression(position);
- left := NIL;
- modifiers := NIL;
- relatedRhs := NIL;
- END InitDesignator;
- PROCEDURE SetLeft*(expression: Expression);
- BEGIN left := expression
- END SetLeft;
- PROCEDURE SetModifiers*(flags: Modifier);
- BEGIN modifiers := flags
- END SetModifiers;
-
- PROCEDURE SetRelatedRhs*(expression: Expression);
- BEGIN
- relatedRhs := expression;
- END SetRelatedRhs;
-
- PROCEDURE Clone(): Expression;
- VAR clone: Designator;
- BEGIN
- (* support cloning here for more robust error reporting -- should not happen normally *)
- NEW(clone, position); RETURN clone
- END Clone;
- END Designator;
- (*** first phase (parse time) designators ***)
- (** <<identifier>>
- may designate any symbol such as Variable, TypeDeclaration, Procedure
- **)
- IdentifierDesignator* = OBJECT(Designator)
- VAR identifier-: Identifier;
- PROCEDURE &InitIdentifierDesignator(position: Position; id: Identifier);
- BEGIN InitDesignator(position); identifier := id
- END InitIdentifierDesignator;
- PROCEDURE Clone(): Expression;
- VAR copy: IdentifierDesignator;
- BEGIN
- NEW(copy, position, identifier); RETURN copy
- END Clone;
- END IdentifierDesignator;
- (** <<left.identifier>>
- may designate a record / module element (constant, type, variable, procedure)
- **)
- SelectorDesignator* = OBJECT (Designator)
- VAR identifier-: Identifier;
- PROCEDURE & InitSelector(position: Position; left: Designator; identifier: Identifier);
- BEGIN InitDesignator(position); SELF.left := left; SELF.identifier := identifier;
- END InitSelector;
- PROCEDURE Clone(): Expression;
- VAR copy: SelectorDesignator;
- BEGIN
- NEW(copy, position, CloneDesignator(left), identifier); RETURN copy
- END Clone;
- END SelectorDesignator;
- (** <<left(arg1, arg2, ...)>>
- may designate a function call or a type guard
- **)
- ParameterDesignator* = OBJECT(Designator)
- VAR
- parameters-: ExpressionList;
- PROCEDURE &InitParameterDesignator(position: Position; left: Designator; parameters: ExpressionList);
- BEGIN InitDesignator(position); SELF.left := left; SELF.parameters := parameters
- END InitParameterDesignator;
- PROCEDURE Clone(): Expression;
- VAR copy: ParameterDesignator;
- BEGIN
- NEW(copy, position, CloneDesignator(left), CloneExpressionList(parameters)); RETURN copy
- END Clone;
- END ParameterDesignator;
- (** <<left^>>
- may designate a pointer dereference or a method supercall
- **)
- ArrowDesignator* = OBJECT (Designator)
- PROCEDURE &InitArrowDesignator(position: Position; left: Designator);
- BEGIN InitDesignator(position); SELF.left := left;
- END InitArrowDesignator;
- PROCEDURE Clone(): Expression;
- VAR copy: ArrowDesignator;
- BEGIN
- NEW(copy, position, CloneDesignator(left(Designator))); RETURN copy
- END Clone;
- END ArrowDesignator;
- (** <<left[parameters]>>
- designates an index designator, before checker
- **)
- BracketDesignator* = OBJECT(Designator)
- VAR parameters-: ExpressionList;
- PROCEDURE &InitBracketDesignator(position: Position; left: Designator; parameters: ExpressionList);
- BEGIN InitDesignator(position); SELF.left := left; SELF.parameters := parameters;
- END InitBracketDesignator;
- PROCEDURE Clone(): Expression;
- VAR copy: BracketDesignator;
- BEGIN
- NEW(copy, position, CloneDesignator(left), CloneExpressionList(parameters)); RETURN copy
- END Clone;
- END BracketDesignator;
- (*** second phase (after checker) designators ***)
- (** symbol designator emerged from IdentifierDesignator or from Selector **)
- SymbolDesignator* = OBJECT(Designator)
- VAR
- symbol-: Symbol;
- PROCEDURE &InitSymbolDesignator(position: Position; left: Designator; symbol: Symbol);
- BEGIN
- InitDesignator(position);
- SELF.left := left;
- SELF.symbol := symbol;
- END InitSymbolDesignator;
- PROCEDURE Clone(): Expression;
- VAR copy: SymbolDesignator;
- BEGIN
- NEW(copy, position, CloneDesignator(left), symbol); RETURN copy
- END Clone;
- PROCEDURE SetSymbol*(s: Symbol);
- BEGIN SELF.symbol := s;
- END SetSymbol;
- PROCEDURE NeedsTrace* (): BOOLEAN;
- BEGIN
- RETURN symbol.NeedsTrace() & ((left = NIL) OR (left.NeedsTrace()));
- END NeedsTrace;
- END SymbolDesignator;
- (** <<left[parameters]>>
- (ranged) indexer
- **)
- IndexDesignator* = OBJECT(Designator)
- VAR
- parameters-: ExpressionList;
- hasRange-: BOOLEAN;
- hasTensorRange-: BOOLEAN;
- PROCEDURE &InitIndexDesignator(position: Position; left: Designator);
- BEGIN
- InitDesignator(position);
- SELF.left := left;
- parameters := NewExpressionList();
- hasRange := FALSE;
- hasTensorRange := FALSE;
- END InitIndexDesignator;
- PROCEDURE HasRange*;
- BEGIN hasRange := TRUE;
- END HasRange;
- PROCEDURE HasTensorRange*;
- BEGIN hasTensorRange := TRUE;
- END HasTensorRange;
- PROCEDURE Clone(): Expression;
- VAR copy: IndexDesignator;
- BEGIN
- NEW(copy, position, CloneDesignator(left));
- parameters.Clone(copy.parameters);
- copy.hasRange := hasRange; copy.hasTensorRange := hasTensorRange ; RETURN copy
- END Clone;
-
- PROCEDURE NeedsTrace* (): BOOLEAN;
- BEGIN RETURN type.NeedsTrace() & left.NeedsTrace(); (* for x[y]: if x is untraced, then also x[y] should be treated untraced *)
- END NeedsTrace;
- END IndexDesignator;
- StatementDesignator* = OBJECT (Designator)
- VAR
- statement-: Statement;
- result-: Expression;
- PROCEDURE & InitStatementDesignator(position: Position; s: Statement);
- BEGIN
- InitDesignator(position); statement := s; result := NIL;
- END InitStatementDesignator;
- PROCEDURE Clone(): Expression;
- VAR copy: StatementDesignator;
- BEGIN
- NEW(copy, position, CloneStatement(statement)) ;
- copy.result := CloneExpression(result);
- RETURN copy
- END Clone;
- PROCEDURE SetResult*(r: Expression);
- BEGIN result := r
- END SetResult;
- END StatementDesignator;
- (** <<left(parameters)>>
- procedure call
- **)
- ProcedureCallDesignator*= OBJECT (Designator)
- VAR parameters-: ExpressionList;
- PROCEDURE & InitProcedureCallDesignator(position: Position; left: Designator; parameters: ExpressionList);
- BEGIN
- InitDesignator(position); SELF.left := left; SELF.parameters := parameters;
- END InitProcedureCallDesignator;
- PROCEDURE Clone(): Expression;
- VAR copy: ProcedureCallDesignator;
- BEGIN
- NEW(copy, position, CloneDesignator(left), CloneExpressionList(parameters)); RETURN copy
- END Clone;
- END ProcedureCallDesignator;
-
- InlineCallDesignator*= OBJECT(Designator)
- VAR
- procedureCall-: ProcedureCallDesignator;
- block-: StatementBlock; (* contains scope *)
-
- PROCEDURE & InitInlineCall*(position: Position; o: ProcedureCallDesignator; b: StatementBlock);
- BEGIN
- InitDesignator(position);
- procedureCall := o;
- block := b;
- END InitInlineCall;
-
- END InlineCallDesignator;
- (** <<procedure(parameters)>>
- builtin procedure call **)
- BuiltinCallDesignator*= OBJECT (Designator) (*! should this be an extension of a procedure call designator ? *)
- VAR
- id-: LONGINT;
- parameters-: ExpressionList;
- builtin-: Builtin;
- returnType-: Type;
- PROCEDURE & InitBuiltinCallDesignator(position: Position; id: LONGINT; left: Designator; parameters: ExpressionList);
- BEGIN
- InitDesignator(position); SELF.parameters := parameters; SELF.id := id; SELF.left := left; returnType := NIL;
- END InitBuiltinCallDesignator;
-
- PROCEDURE SetReturnType*(type: Type);
- BEGIN
- returnType := type (* used for NEW Type() expression *)
- END SetReturnType;
-
- PROCEDURE Clone(): Expression;
- VAR copy: BuiltinCallDesignator;
- BEGIN
- NEW(copy, position, id, CloneDesignator(left), CloneExpressionList(parameters)); RETURN copy
- END Clone;
- END BuiltinCallDesignator;
- (** <<left(type)>>
- resolved parameter designator, designates a type guard
- **)
- TypeGuardDesignator* = OBJECT(Designator)
- VAR
- typeExpression-: Expression; (* for printing only *)
- PROCEDURE &InitTypeGuardDesignator(position: Position; left: Designator; type: Type);
- BEGIN InitDesignator(position); SELF.left := left; SELF.type := type; typeExpression := NIL;
- END InitTypeGuardDesignator;
- PROCEDURE SetTypeExpression*(typeExpression: Expression);
- BEGIN SELF.typeExpression := typeExpression
- END SetTypeExpression;
- PROCEDURE Clone(): Expression;
- VAR copy: TypeGuardDesignator;
- BEGIN
- NEW(copy, position, CloneDesignator(left), type); RETURN copy
- END Clone;
-
- PROCEDURE NeedsTrace* (): BOOLEAN;
- BEGIN RETURN left.NeedsTrace() & type.NeedsTrace(); (* for x(Y): if x is untraced, then x as Y should also be treated untraced *)
- END NeedsTrace;
- END TypeGuardDesignator;
- (** <<left^>> resolved as dereference operation on pointer variable left **)
- DereferenceDesignator*= OBJECT (Designator)
- PROCEDURE &InitDereferenceDesignator(position: Position; left: Designator);
- BEGIN InitDesignator(position); SELF.left := left;
- END InitDereferenceDesignator;
- PROCEDURE Clone(): Expression;
- VAR copy: DereferenceDesignator;
- BEGIN
- NEW(copy, position, CloneDesignator(left)); RETURN copy
- END Clone;
- PROCEDURE NeedsTrace* (): BOOLEAN;
- BEGIN
- (*! semantic of x.y.z := new : if x is untraced then the effect of y.z := new remains untraced!
- In other words: difference between y := x.y; y.z := new and x.y.z := new.
- *)
- RETURN left.NeedsTrace() & type.NeedsTrace(); (* for x^: if x is an untraced pointer, the content of x^ is also treated untraced *)
- END NeedsTrace;
- END DereferenceDesignator;
- (** <<left^>> resolved as supercall operation on method left **)
- SupercallDesignator*= OBJECT (Designator)
- PROCEDURE &InitSupercallDesignator(position: Position; left: Designator);
- BEGIN InitDesignator(position); SELF.left := left;
- END InitSupercallDesignator;
- PROCEDURE Clone(): Expression;
- VAR copy: SupercallDesignator;
- BEGIN
- NEW(copy, position, CloneDesignator(left)); RETURN copy
- END Clone;
- END SupercallDesignator;
- (** <<SELF.x>> **)
- SelfDesignator*= OBJECT (Designator)
- PROCEDURE &InitSelfDesignator(position: Position);
- BEGIN InitDesignator(position);
- END InitSelfDesignator;
- PROCEDURE Clone(): Expression;
- VAR copy: SelfDesignator;
- BEGIN
- NEW(copy, position); RETURN copy
- END Clone;
- PROCEDURE NeedsTrace* (): BOOLEAN;
- BEGIN RETURN type.NeedsTrace();
- END NeedsTrace;
- END SelfDesignator;
- (** <<RESULT>> **)
- ResultDesignator*= OBJECT (Designator)
- PROCEDURE &InitResultDesignator(position: Position);
- BEGIN InitDesignator(position);
- END InitResultDesignator;
- PROCEDURE Clone(): Expression;
- VAR copy: ResultDesignator;
- BEGIN
- NEW(copy, position); RETURN copy
- END Clone;
- END ResultDesignator;
- (**** values ****)
- Value* = OBJECT (Expression)
- VAR fingerprint-: FingerPrint;
- PROCEDURE &InitValue(position: Position);
- BEGIN SELF.position := position; resolved := SELF; InitFingerPrint(fingerprint);
- END InitValue;
- PROCEDURE SetFingerPrint*(CONST fp: FingerPrint);
- BEGIN
- SELF.fingerprint := fp
- END SetFingerPrint;
- PROCEDURE Equals*(v: Value):BOOLEAN;
- BEGIN HALT(100); (* abstract *) RETURN FALSE; END Equals;
- END Value;
- (** <<value = TRUE , FALSE>> **)
- BooleanValue* = OBJECT (Value)
- VAR
- value-: BOOLEAN;
- PROCEDURE & InitBooleanValue(position: Position; value: BOOLEAN);
- BEGIN
- InitValue(position); SELF.value := value;
- END InitBooleanValue;
- PROCEDURE SetValue*(value: BOOLEAN);
- BEGIN SELF.value := value
- END SetValue;
- PROCEDURE Clone(): Expression;
- VAR copy: BooleanValue;
- BEGIN
- NEW(copy, position, value); RETURN copy
- END Clone;
- PROCEDURE Equals*(v: Value):BOOLEAN;
- BEGIN RETURN (v IS BooleanValue) & (v(BooleanValue).value = value); END Equals;
- END BooleanValue;
- (** <<value = 123456>> **)
- IntegerValue* = OBJECT (Value)
- VAR
- value-: Basic.Integer;
- PROCEDURE & InitIntegerValue(position: Position; value: Basic.Integer);
- BEGIN
- InitValue(position); SELF.value := value;
- END InitIntegerValue;
- PROCEDURE SetValue*(value: Basic.Integer);
- BEGIN SELF.value := value;
- END SetValue;
- PROCEDURE Clone(): Expression;
- VAR copy: IntegerValue;
- BEGIN
- NEW(copy, position, value); RETURN copy
- END Clone;
- PROCEDURE Equals*(v: Value):BOOLEAN;
- BEGIN RETURN (v IS IntegerValue) & (v(IntegerValue).value = value); END Equals;
- END IntegerValue;
- (** <<value = 'c', 65X>> **)
- CharacterValue*= OBJECT(Value)
- VAR
- value-: CHAR; (* potential for extension to support CHAR16 and CHAR32 *)
- PROCEDURE & InitCharacterValue(position: Position; value: CHAR);
- BEGIN
- InitValue(position); SELF.value := value;
- END InitCharacterValue;
- PROCEDURE SetValue*(value: CHAR);
- BEGIN SELF.value := value
- END SetValue;
- PROCEDURE Clone(): Expression;
- VAR copy: CharacterValue;
- BEGIN
- NEW(copy, position, value); RETURN copy
- END Clone;
- PROCEDURE Equals*(v: Value):BOOLEAN;
- BEGIN RETURN (v IS CharacterValue) & (v(CharacterValue).value = value); END Equals;
- END CharacterValue;
- SetValueType = SetValue;
- (** <<value = {1,2,3..5}>> **)
- SetValue* = OBJECT (Value)
- VAR
- value-: Basic.Set;
- PROCEDURE & InitSetValue(position: Position; value: Basic.Set);
- BEGIN
- InitValue(position); SELF.value := value;
- END InitSetValue;
- PROCEDURE SetValue*(value: Basic.Set);
- BEGIN SELF.value := value
- END SetValue;
- PROCEDURE Clone(): Expression;
- VAR copy: SetValueType;
- BEGIN
- NEW(copy, position, value); RETURN copy
- END Clone;
- END SetValue;
- (** << [elements] >> **)
- MathArrayValue* = OBJECT (Value)
- VAR array-: MathArrayExpression; (* an element of the form from .. to is represented as a RangeExpression *)
- PROCEDURE & InitMathArrayValue(position: Position);
- BEGIN
- InitValue(position);
- array := NIL;
- END InitMathArrayValue;
- PROCEDURE SetArray*(array: MathArrayExpression);
- BEGIN SELF.array := array
- END SetArray;
- PROCEDURE Clone(): Expression;
- VAR copy: MathArrayValue;
- BEGIN
- NEW(copy, position);
- IF array # NIL THEN copy.array := array.Clone()(MathArrayExpression) END;
- RETURN copy
- END Clone;
- END MathArrayValue;
- (** <<value = 1.2345E01>> **)
- RealValue* = OBJECT (Value)
- VAR
- value-: LONGREAL;
- subtype-: LONGINT; (* accuracy information: REAL vs. LONGREAL *)
- PROCEDURE & InitRealValue(position: Position; value: LONGREAL);
- BEGIN
- InitValue(position); SELF.value := value; SELF.subtype := 0;
- END InitRealValue;
- PROCEDURE SetValue*(value: LONGREAL);
- BEGIN SELF.value := value
- END SetValue;
- PROCEDURE SetSubtype*(subtype: LONGINT);
- BEGIN SELF.subtype := subtype;
- END SetSubtype;
- PROCEDURE Clone(): Expression;
- VAR copy: RealValue;
- BEGIN
- NEW(copy, position, value); RETURN copy
- END Clone;
- PROCEDURE Equals*(v: Value):BOOLEAN;
- BEGIN RETURN (v IS RealValue) & (v(RealValue).value = value); END Equals;
- END RealValue;
- ComplexValue* = OBJECT (Value)
- VAR
- realValue-, imagValue-: LONGREAL;
- subtype-: LONGINT; (* accuracy information of components: REAL vs. LONGREAL *)
- PROCEDURE & InitComplexValue(position: Position; realValue, imagValue: LONGREAL);
- BEGIN
- InitValue(position); SELF.realValue := realValue; SELF.imagValue := imagValue; SELF.subtype := 0;
- END InitComplexValue;
- PROCEDURE SetValue*(realValue, imagValue: LONGREAL);
- BEGIN SELF.realValue := realValue; SELF.imagValue := imagValue;
- END SetValue;
- PROCEDURE UpdateSubtype*;
- BEGIN
- ASSERT((type # NIL) & (type.resolved # NIL) & (type.resolved IS ComplexType) & (type.resolved(ComplexType).componentType IS FloatType));
- CASE type.resolved(ComplexType).componentType(FloatType).sizeInBits OF
- | 32: subtype := Scanner.Real
- | 64: subtype := Scanner.Longreal
- END
- END UpdateSubtype;
- PROCEDURE SetSubtype*(subtype: LONGINT);
- BEGIN SELF.subtype := subtype;
- END SetSubtype;
- PROCEDURE Clone(): Expression;
- VAR copy: ComplexValue;
- BEGIN
- NEW(copy, position, realValue, imagValue); copy.subtype := subtype; RETURN copy
- END Clone;
- PROCEDURE Equals*(v: Value):BOOLEAN;
- BEGIN RETURN (v IS ComplexValue) & (v(ComplexValue).realValue = realValue) & (v(ComplexValue).imagValue = imagValue);
- (* TODO: append this?
- OR (v IS RealValue) & (v(RealValue).value = realValue) & (imagValue := 0)
- *)
- END Equals;
- END ComplexValue;
- (** <<value = "string">> **)
- StringValue* = OBJECT (Value)
- VAR
- value-: String;
- length-: LONGINT;
- PROCEDURE & InitStringValue(position: Position; value: String);
- BEGIN
- InitValue(position); SELF.value := value;
- length := 0;
- WHILE (length<LEN(value)) & (value[length] # 0X) DO
- INC(length);
- END;
- IF length < LEN(value) THEN INC(length) END
- END InitStringValue;
- PROCEDURE SetValue*(CONST value: String);
- BEGIN SELF.value := value
- END SetValue;
- PROCEDURE Append*(CONST value: String);
- VAR new: String; len: LONGINT;
- BEGIN
- len := Strings.Length(SELF.value^) + Strings.Length(value^) + 1;
- IF LEN(SELF.value) < len THEN
- NEW(new, len);
- COPY(SELF.value^, new^);
- SELF.value := new
- END;
- Strings.Append(SELF.value^, value^);
- length := len
- END Append;
- PROCEDURE AppendChar*(CONST ch: CHAR);
- VAR v: String;
- BEGIN
- NEW(v,2); v[0] := ch;
- Append(v);
- END AppendChar;
- PROCEDURE Clone(): Expression;
- VAR copy: StringValue;
- BEGIN
- NEW(copy, position, value); RETURN copy
- END Clone;
- PROCEDURE Equals*(v: Value):BOOLEAN;
- BEGIN RETURN (v IS StringValue) & (v(StringValue).value = value); END Equals;
- END StringValue;
- (** <<value = NIL>> **)
- NilValue* = OBJECT (Value)
- PROCEDURE Clone(): Expression;
- VAR copy: NilValue;
- BEGIN
- NEW(copy, position); RETURN copy
- END Clone;
- PROCEDURE Equals*(v: Value):BOOLEAN;
- BEGIN RETURN (v IS NilValue); END Equals;
- END NilValue;
- (** <<value = enum.x >> **)
- EnumerationValue* = OBJECT (Value)
- VAR
- value-: Basic.Integer;
- PROCEDURE & InitEnumerationValue(position: Position; value: Basic.Integer);
- BEGIN
- InitValue(position); SELF.value := value;
- END InitEnumerationValue;
- PROCEDURE SetValue*(value: Basic.Integer);
- BEGIN SELF.value := value
- END SetValue;
- PROCEDURE Clone(): Expression;
- VAR copy: EnumerationValue;
- BEGIN
- NEW(copy, position, value); RETURN copy
- END Clone;
- PROCEDURE Equals*(v: Value):BOOLEAN;
- BEGIN RETURN (v IS EnumerationValue) & (v(EnumerationValue).value = value); END Equals;
- END EnumerationValue;
- (**** symbols ****)
- Symbol*= OBJECT
- VAR
- nextSymbol-: Symbol;
- name-: Identifier; (* constant / variable / parameter / type name / module name *)
- externalName-: Scanner.StringType; (* variable / procedure *)
- access-: SET; (* access flags (exported, readonly etc.) *)
- type-: Type; (* type of constant / variable / parameter / procedure return type *)
- scope-:Scope; (* container of symbol *)
- offsetInBits-: LONGINT; (* offset in stack or heap, in bits *)
- used-, written-: BOOLEAN;
- fixed-: BOOLEAN;
- alignment-: LONGINT;
- position-, end-: Position; state-: SET;
- fingerprint-: FingerPrint;
- comment-: Comment;
- PROCEDURE & InitSymbol(position: Position; name:Identifier);
- BEGIN
- SELF.position := position; state := Undefined;
- SELF.end := invalidPosition;
- nextSymbol := NIL;
- SELF.name := name;
- externalName := NIL;
- scope:= NIL;
- type := NIL;
- access := Internal;
- state := Undefined;
- offsetInBits := MIN(LONGINT);
- alignment := 0; (* take default *)
- fixed := FALSE;
- used := FALSE; written := FALSE;
- InitFingerPrint(fingerprint);
- comment := NIL;
- END InitSymbol;
- PROCEDURE SetAlignment*(fix: BOOLEAN; align: LONGINT);
- BEGIN SELF.alignment := align; fixed := fix;
- END SetAlignment;
- PROCEDURE SetFingerPrint*(CONST fp: FingerPrint);
- BEGIN
- SELF.fingerprint := fp
- END SetFingerPrint;
- PROCEDURE SetState*(state: LONGINT);
- BEGIN INCL(SELF.state,state);
- END SetState;
- PROCEDURE SetScope*(scope: Scope);
- BEGIN SELF.scope := scope
- END SetScope;
- PROCEDURE SetType*(type: Type);
- BEGIN
- SELF.type := type;
- END SetType;
- PROCEDURE SetNext*(symbol: Symbol);
- BEGIN SELF.nextSymbol := symbol; END SetNext;
- PROCEDURE SetAccess*(access: SET);
- BEGIN
- (* consistency guarantee *)
- IF PublicWrite IN access THEN ASSERT(ProtectedWrite IN access) END;
- IF ProtectedWrite IN access THEN ASSERT(InternalWrite IN access) END;
- IF PublicRead IN access THEN ASSERT(ProtectedRead IN access) END;
- IF ProtectedRead IN access THEN ASSERT(InternalRead IN access)END;
- SELF.access := access;
- END SetAccess;
- PROCEDURE SetOffset*(ofs: LONGINT);
- BEGIN offsetInBits := ofs
- END SetOffset;
- PROCEDURE MarkUsed*;
- BEGIN used := TRUE
- END MarkUsed;
- PROCEDURE MarkWritten*;
- BEGIN written := TRUE
- END MarkWritten;
- PROCEDURE GetName*(VAR str: ARRAY OF CHAR);
- BEGIN Basic.GetString(name, str);
- END GetName;
- PROCEDURE SetComment*(comment: Comment);
- BEGIN SELF.comment := comment
- END SetComment;
-
- PROCEDURE SetExternalName*(name: Scanner.StringType);
- BEGIN externalName := name;
- END SetExternalName;
- PROCEDURE NeedsTrace* (): BOOLEAN;
- BEGIN RETURN FALSE;
- END NeedsTrace;
-
- (* If a symbol needs to be vieible in the object file
- A symbol needs to be visible in an object file when it is require during linking
- This is the case for exported symbols but also for methods in a method table, for instance.
- *)
- PROCEDURE NeedsSection*(): BOOLEAN;
- BEGIN
- RETURN access * Public # {};
- END NeedsSection;
- END Symbol;
- (**
- <<TYPE name = declaredType>>
- TypeDeclaration symbol represents a type declaration of the form TYPE name = declaredType.
- Note that the declared type is not stored in the symbol's type field but rather in the declaredType field.
- The type of a type declaration is set to "typeDeclarationType" in the semantic checker
- **)
- TypeDeclaration*= OBJECT(Symbol)
- VAR
- nextTypeDeclaration-: TypeDeclaration;
- declaredType-: Type;
- PROCEDURE &InitTypeDeclaration(position: Position; name: Identifier);
- BEGIN
- InitSymbol(position,name);
- nextTypeDeclaration := NIL;
- declaredType := NIL;
- type := typeDeclarationType;
- END InitTypeDeclaration;
- PROCEDURE SetDeclaredType*(type: Type);
- BEGIN
- declaredType := type;
- IF ~(type IS BasicType) THEN
- type.typeDeclaration := SELF;
- END;
- END SetDeclaredType;
- PROCEDURE SetType*(type: Type);
- BEGIN
- ASSERT(type = typeDeclarationType);
- END SetType;
-
- (* type declarations should be generally included in object files *)
- PROCEDURE NeedsSection*(): BOOLEAN;
- BEGIN
- RETURN TRUE;
- END NeedsSection;
- END TypeDeclaration;
- (** <<CONST name = value >>
- Constant declaration symbol. Represents a constant being defined in the form CONST name = value
- The type of the constant is stored in the type field and is resolved by the semantic checker.
- **)
- Constant* = OBJECT (Symbol)
- VAR
- value-: Expression;
- nextConstant-: Constant;
- PROCEDURE & InitConstant( position: Position; name: Identifier );
- BEGIN
- InitSymbol(position,name);
- value := NIL;
- nextConstant := NIL;
- END InitConstant;
- PROCEDURE SetValue*( value: Expression );
- BEGIN
- SELF.value := value;
- END SetValue;
- END Constant;
- (** <<VAR name: type >>
- Variable declaration symbol. Represents a variable defined in the form VAR name: Type.
- The type of the variable is stored in the symbol's type field and is resolved by the semantic checker.
- **)
- Variable* = OBJECT (Symbol)
- VAR
- nextVariable-: Variable;
- untraced-: BOOLEAN;
- fictive-: BOOLEAN; (* variable is not allocated but has a fixed offset *)
- fictiveOffset-: LONGINT; (* offset of fictive as provided by the source code *)
- useRegister-: BOOLEAN; registerNumber-: LONGINT;
- modifiers-: Modifier;
- initializer-: Expression;
- usedAsReference-: BOOLEAN;
- PROCEDURE & InitVariable*( position: Position; name: Identifier);
- BEGIN
- InitSymbol(position,name);
- nextVariable := NIL;
- modifiers := NIL;
- untraced := FALSE;
- modifiers := NIL;
- useRegister := FALSE;
- registerNumber := -1;
- usedAsReference := FALSE;
- initializer := NIL;
- fictive := FALSE;
- END InitVariable;
- PROCEDURE UsedAsReference*;
- BEGIN
- usedAsReference := TRUE
- END UsedAsReference;
- PROCEDURE SetUntraced*(u: BOOLEAN);
- BEGIN untraced := u
- END SetUntraced;
- PROCEDURE SetUseRegister*(u: BOOLEAN);
- BEGIN
- useRegister := u
- END SetUseRegister;
- PROCEDURE SetRegisterNumber*(reg: LONGINT);
- BEGIN
- registerNumber := reg
- END SetRegisterNumber;
-
- PROCEDURE SetFictive*(offset: LONGINT);
- BEGIN
- fictive := TRUE;
- fictiveOffset := offset;
- END SetFictive;
-
- PROCEDURE SetModifiers*(flag: Modifier);
- BEGIN SELF.modifiers := flag;
- END SetModifiers;
- PROCEDURE SetInitializer*(initializer: Expression);
- BEGIN SELF.initializer := initializer;
- END SetInitializer;
- PROCEDURE NeedsTrace* (): BOOLEAN;
- BEGIN RETURN ~untraced & (externalName = NIL) & type.NeedsTrace ();
- END NeedsTrace;
- END Variable;
- (** << [VAR | CONST] name: type >>
- Parameter declaration symbol. Represents a parameter in the form [VAR | CONST] name: Type.
- The parameter's type is stored in the symbol's type field and is resolved by the semantic checker.
- **)
- Parameter* = OBJECT (Symbol)
- VAR
- nextParameter-, prevParameter-: Parameter;
- modifiers-: Modifier;
- defaultValue-: Expression;
- kind-: LONGINT; (* ValueParameter, ConstParameter, VarParameter *)
- ownerType-: Type;
- untraced-: BOOLEAN;
- movable-: BOOLEAN;
- selfParameter-: BOOLEAN;
- PROCEDURE & InitParameter( position: Position; ownerType: Type ; name: Identifier; kind: LONGINT);
- BEGIN
- InitSymbol( position, name );
- SELF.kind := kind;
- IF kind = ConstParameter THEN access := access END;
- nextParameter := NIL;
- SELF.ownerType := ownerType;
- modifiers := NIL;
- untraced := FALSE;
- defaultValue := NIL;
- movable := FALSE;
- selfParameter := FALSE;
- END InitParameter;
- PROCEDURE SetModifiers*(flag: Modifier);
- BEGIN SELF.modifiers := flag;
- END SetModifiers;
- PROCEDURE SetUntraced*(untraced: BOOLEAN);
- BEGIN SELF.untraced := untraced
- END SetUntraced;
- PROCEDURE SetMoveable*(movable: BOOLEAN);
- BEGIN SELF.movable := movable
- END SetMoveable;
-
- PROCEDURE SetSelfParameter*(b: BOOLEAN);
- BEGIN
- selfParameter := b;
- END SetSelfParameter;
- PROCEDURE SetDefaultValue*(e: Expression);
- BEGIN defaultValue := e
- END SetDefaultValue;
- PROCEDURE SetKind*(kind: LONGINT);
- BEGIN SELF.kind := kind; END SetKind;
- PROCEDURE NeedsTrace* (): BOOLEAN;
- BEGIN RETURN ~untraced & type.NeedsTrace ();
- END NeedsTrace;
- END Parameter;
-
- Property* = OBJECT (Variable)
- VAR
- nextProperty-, prevProperty-: Property;
- value-: Expression;
- PROCEDURE & InitProperty(position: Position; name: Identifier);
- BEGIN
- InitSymbol( position, name );
- END InitProperty;
- PROCEDURE SetValue*(e: Expression);
- BEGIN value := e
- END SetValue;
- END Property;
- (** Procedure declaration symbol. Represents a procedure being defined in the form PROCEDURE name(parameters): returnType;
- Note that the type of a procedure is a ProcedureType (and not the return type of the procedure).
- Parameters, local variables, constants and type declarations are stored in the procedureScope field.
- **)
- Procedure* = OBJECT (Symbol)
- VAR
- nextProcedure-: Procedure;
- procedureScope- : ProcedureScope;
- super-: Procedure;
- level-, methodNumber-: LONGINT;
- isBodyProcedure-, isConstructor-,isFinalizer-,isInline-,isOberonInline-, isEntry-, isExit-,isFinal-,isAbstract-,isOverwritten-: BOOLEAN;
- PROCEDURE & InitProcedure( position: Position; name: Identifier; scope: ProcedureScope);
- BEGIN
- InitSymbol(position,name);
- nextProcedure := NIL;
- procedureScope := scope;
- ASSERT(scope.ownerProcedure = NIL); (* cannot register twice ! *)
- scope.ownerProcedure := SELF;
- super := NIL;
- level := 0;
- methodNumber := -1;
- isBodyProcedure := FALSE;
- isConstructor := FALSE;
- isFinalizer := FALSE;
- isInline := FALSE;
- isOberonInline := FALSE;
- isEntry := FALSE;
- isExit := FALSE;
- isFinal := FALSE;
- isAbstract := FALSE;
- isOverwritten := FALSE;
- END InitProcedure;
- PROCEDURE SetSuper*(super: Procedure);
- BEGIN
- SELF.super := super
- END SetSuper;
- PROCEDURE SetBodyProcedure*(isBodyProcedure: BOOLEAN);
- BEGIN SELF.isBodyProcedure := isBodyProcedure;
- END SetBodyProcedure;
- PROCEDURE SetConstructor*(isConstructor: BOOLEAN);
- BEGIN SELF.isConstructor := isConstructor
- END SetConstructor;
- PROCEDURE SetFinalizer*(isFinalizer: BOOLEAN);
- BEGIN SELF.isFinalizer := isFinalizer
- END SetFinalizer;
- PROCEDURE SetInline*(isInline: BOOLEAN);
- BEGIN SELF.isInline := isInline
- END SetInline;
- PROCEDURE SetOberonInline*(isInline: BOOLEAN);
- BEGIN SELF.isOberonInline := isInline
- END SetOberonInline;
- PROCEDURE SetEntry*(entry: BOOLEAN);
- BEGIN SELF.isEntry := entry
- END SetEntry;
- PROCEDURE SetExit*(exit: BOOLEAN);
- BEGIN SELF.isExit := exit
- END SetExit;
- PROCEDURE SetFinal*(final: BOOLEAN);
- BEGIN SELF.isFinal := final
- END SetFinal;
- PROCEDURE SetOverwritten*(locallyOverwritten: BOOLEAN);
- BEGIN SELF.isOverwritten := locallyOverwritten
- END SetOverwritten;
- PROCEDURE SetAbstract*(abstract: BOOLEAN);
- BEGIN SELF.isAbstract := abstract
- END SetAbstract;
- PROCEDURE SetLevel*(level: LONGINT);
- BEGIN SELF.level := level
- END SetLevel;
- PROCEDURE SetMethodNumber*(methodNumber: LONGINT);
- BEGIN SELF.methodNumber := methodNumber
- END SetMethodNumber;
- PROCEDURE NeedsSection*(): BOOLEAN;
- BEGIN
- RETURN (access * Public # {}) OR (methodNumber >= 0);
- END NeedsSection;
- END Procedure;
- (** Builtin symbol stands for a builtin procedure. Is resolved by the semantic checker. **)
- Builtin* = OBJECT (Symbol)
- VAR
- nextBuiltin-: Builtin;
- id-: LONGINT;
- PROCEDURE & InitBuiltin(position: Position; name:Identifier; id: LONGINT);
- BEGIN
- InitSymbol(position,name); SELF.id := id;
- END InitBuiltin;
- END Builtin;
- CustomBuiltin*=OBJECT (Builtin)
- VAR
- subType-: SHORTINT;
- PROCEDURE & InitCustomBuiltin(position: Position; name: Identifier; id: LONGINT; subType: SHORTINT);
- BEGIN
- InitBuiltin(position,name,id);
- SELF.subType := subType;
- END InitCustomBuiltin;
- (* TODO: check if this is correct *)
- PROCEDURE CompatibleTo*(otherType: Type): BOOLEAN;
- BEGIN RETURN FALSE
- END CompatibleTo;
- END CustomBuiltin;
- Operator* = OBJECT (Procedure)
- VAR
- nextOperator-: Operator;
- isDynamic-: BOOLEAN; (* nopov *)
- PROCEDURE & InitOperator(position: Position; name: Identifier; scope: ProcedureScope);
- BEGIN
- InitProcedure(position,name,scope);
- nextOperator := NIL;
- isDynamic := FALSE
- END InitOperator;
- (* nopov *)
- PROCEDURE SetDynamic*(isDynamic: BOOLEAN);
- BEGIN SELF.isDynamic := isDynamic
- END SetDynamic;
- END Operator;
- Import* = OBJECT (Symbol)
- VAR
- nextImport-: Import;
- module-: Module;
- moduleName-: Identifier;
- context-: Identifier;
- direct-: BOOLEAN; (* direct import *)
- PROCEDURE & InitImport( position: Position; name, moduleName: Identifier; direct: BOOLEAN );
- BEGIN
- InitSymbol(position,name);
- SELF.direct := direct;
- module := NIL;
- context := invalidIdentifier;
- SELF.moduleName := moduleName;
- type := importType;
- END InitImport;
- PROCEDURE SetType*(type: Type);
- BEGIN
- ASSERT(type = importType);
- END SetType;
- PROCEDURE SetModule*(module: Module);
- BEGIN
- SELF.module := module;
- END SetModule;
- PROCEDURE SetDirect*(d: BOOLEAN);
- BEGIN
- direct := d
- END SetDirect;
- PROCEDURE SetModuleName*(moduleName: Identifier);
- BEGIN SELF.moduleName := moduleName
- END SetModuleName;
- PROCEDURE SetContext*(context: Identifier);
- BEGIN
- SELF.context := context
- END SetContext;
- END Import;
- StatementSequence* = OBJECT
- VAR
- list: Basic.List;
- PROCEDURE & InitList;
- BEGIN NEW( list,32 );
- END InitList;
- PROCEDURE Length*( ): LONGINT;
- BEGIN RETURN list.Length();
- END Length;
- PROCEDURE AddStatement*( statement: Statement);
- BEGIN list.Add( statement );
- END AddStatement;
- PROCEDURE PrependStatement*( statement: Statement);
- BEGIN list.Prepend( statement );
- END PrependStatement;
- PROCEDURE HasStatement*( statement: Statement):BOOLEAN;
- BEGIN RETURN list.Contains(statement);
- END HasStatement;
- PROCEDURE GetStatement*( index: LONGINT ): Statement;
- VAR p: ANY;
- BEGIN p := list.Get( index ); RETURN p( Statement );
- END GetStatement;
- PROCEDURE SetStatement*(index: LONGINT; statement: Statement);
- BEGIN
- list.Set(index,statement);
- END SetStatement;
- PROCEDURE RemoveStatement*(statement: Statement);
- BEGIN
- list.Remove(statement);
- END RemoveStatement;
- PROCEDURE InsertBefore*(search, new: Statement);
- BEGIN
- list.Insert(list.IndexOf(search), new);
- END InsertBefore;
- PROCEDURE Clone(VAR copy: StatementSequence);
- VAR i: LONGINT;
- BEGIN
- IF copy = NIL THEN NEW(copy) END;
- FOR i := 0 TO Length()-1 DO
- copy.AddStatement(CloneStatement(GetStatement(i)))
- END;
- END Clone;
- END StatementSequence;
- (**** statements ****)
- Statement*= OBJECT
- VAR outer-: Statement;
- position-,end-: Position;
- isUnreachable-: BOOLEAN;
- comment-: Comment;
- PROCEDURE & InitStatement*(position: Position; outer: Statement);
- BEGIN
- SELF.position := position;
- end := invalidPosition;
- SELF.outer := outer;
- isUnreachable := FALSE;
- comment := NIL;
- END InitStatement;
- PROCEDURE SetOuter*(o: Statement);
- BEGIN outer := o
- END SetOuter;
- PROCEDURE SetUnreachable*(unreachable: BOOLEAN);
- BEGIN isUnreachable := unreachable
- END SetUnreachable;
- PROCEDURE SetComment*(comment: Comment);
- BEGIN SELF.comment := comment
- END SetComment;
- PROCEDURE Clone(): Statement;
- BEGIN
- HALT(200) (* abstract *)
- END Clone;
- PROCEDURE End*(pos: Position);
- BEGIN
- end := pos;
- END End;
-
- END Statement;
- (** << call(...) >> **)
- ProcedureCallStatement*= OBJECT(Statement)
- VAR ignore-: BOOLEAN;
- VAR call-: Designator;
- PROCEDURE & InitProcedureCallStatement(position: Position; ignore: BOOLEAN; call: Designator; outer: Statement);
- BEGIN InitStatement(position,outer); SELF.ignore := ignore; SELF.call := call;
- END InitProcedureCallStatement;
- PROCEDURE SetIgnore*(ignore: BOOLEAN);
- BEGIN SELF.ignore := ignore;
- END SetIgnore;
- PROCEDURE SetCall*(call: Designator);
- BEGIN SELF.call := call;
- END SetCall;
- PROCEDURE Clone(): Statement;
- VAR copy: ProcedureCallStatement;
- BEGIN
- NEW(copy, position, ignore, CloneDesignator(call), outer);
- RETURN copy
- END Clone;
- END ProcedureCallStatement;
- (** << left := right >> **)
- Assignment* = OBJECT (Statement)
- VAR left-: Designator; right-: Expression;
- PROCEDURE & InitAssignment*( position: Position; left: Designator; right: Expression; outer: Statement );
- BEGIN
- InitStatement( position,outer ); SELF.left := left; SELF.right := right;
- END InitAssignment;
- PROCEDURE SetLeft*(left: Designator);
- BEGIN SELF.left := left
- END SetLeft;
- PROCEDURE SetRight*(right: Expression);
- BEGIN SELF.right := right
- END SetRight;
- PROCEDURE Clone(): Statement;
- VAR copy: Assignment;
- BEGIN
- NEW(copy, position, CloneDesignator(left), CloneExpression(right), outer);
- RETURN copy
- END Clone;
- END Assignment;
- (** << left ('!' | '?' | '<<' | '>>') right >> **)
- CommunicationStatement* = OBJECT (Statement)
- VAR
- left-: Designator; right-: Expression; op-: LONGINT;
- PROCEDURE & InitAssignment*( position: Position; op: LONGINT; left: Designator; right: Expression; outer: Statement );
- BEGIN
- InitStatement( position,outer ); SELF.op := op; SELF.left := left; SELF.right := right;
- END InitAssignment;
- PROCEDURE SetLeft*(left: Designator);
- BEGIN SELF.left := left
- END SetLeft;
- PROCEDURE SetRight*(right: Expression);
- BEGIN SELF.right := right
- END SetRight;
- END CommunicationStatement;
- Part*= OBJECT
- VAR
- position-, end-: Position;
- PROCEDURE InitPart;
- BEGIN
- position := invalidPosition; end := invalidPosition;
- END InitPart;
-
- PROCEDURE SetPosition*(pos: Position);
- BEGIN
- position := pos;
- END SetPosition;
- PROCEDURE SetEnd*(pos: Position);
- BEGIN
- end := pos;
- END SetEnd;
-
- END Part;
-
- (** << ... condition THEN statements ... >> **)
- IfPart*= OBJECT (Part)
- VAR
- condition-: Expression;
- statements-: StatementSequence;
- comment-: Comment;
- PROCEDURE & InitIfPart;
- BEGIN
- InitPart;
- statements := NIL; condition := NIL; comment := NIL;
- END InitIfPart;
- PROCEDURE SetCondition*(condition: Expression);
- BEGIN SELF.condition := condition
- END SetCondition;
- PROCEDURE SetStatements*(statements: StatementSequence);
- BEGIN SELF.statements := statements
- END SetStatements;
- PROCEDURE SetComment*(comment: Comment);
- BEGIN SELF.comment := comment
- END SetComment;
- PROCEDURE Clone(): IfPart;
- VAR copy: IfPart;
- BEGIN
- NEW(copy); copy.condition := CloneExpression(condition);
- copy.statements := CloneStatementSequence(statements);
- RETURN copy
- END Clone;
- END IfPart;
- (** << IF ifPart {ELSIF elsifParts} ELSE elseParts >> **)
- IfStatement* = OBJECT (Statement)
- VAR
- ifPart-: IfPart;
- elsifParts: Basic.List;
- elsePart-: StatementSequence;
- PROCEDURE & InitIfStatement( position: Position ; outer: Statement);
- BEGIN
- InitStatement( position,outer ); ifPart := NewIfPart();
- ifPart.SetPosition(position);
- elsePart := NIL; elsifParts := NIL;
- END InitIfStatement;
- PROCEDURE SetElsePart*( elsePart: StatementSequence );
- BEGIN
- SELF.elsePart := elsePart;
- END SetElsePart;
- PROCEDURE AddElsifPart*( elsifPart: IfPart );
- BEGIN
- IF elsifParts = NIL THEN NEW(elsifParts,4); END;
- elsifParts.Add( elsifPart );
- END AddElsifPart;
- PROCEDURE GetElsifPart*( i: LONGINT ): IfPart;
- VAR a: ANY;
- BEGIN a := elsifParts.Get( i ); RETURN a( IfPart )
- END GetElsifPart;
- PROCEDURE ElsifParts*( ): LONGINT;
- BEGIN
- IF elsifParts = NIL THEN RETURN 0 ELSE RETURN elsifParts.Length(); END;
- END ElsifParts;
- PROCEDURE Clone(): Statement;
- VAR copy: IfStatement; i: LONGINT;
- BEGIN
- NEW(copy, position, outer);
- copy.ifPart := ifPart.Clone();
- FOR i := 0 TO ElsifParts()-1 DO
- copy.AddElsifPart(GetElsifPart(i).Clone());
- END;
- copy.SetElsePart(CloneStatementSequence(elsePart));
- RETURN copy
- END Clone;
- END IfStatement;
- WithPart*= OBJECT (Part)
- VAR
- type-: Type; (* initially is qualified type *)
- statements-: StatementSequence;
- comment-: Comment;
- PROCEDURE &InitWithPart();
- BEGIN
- InitPart();
- type := NIL; statements := NIL; comment := NIL;
- END InitWithPart;
- PROCEDURE SetType*( type: Type );
- BEGIN
- SELF.type := type
- END SetType;
- PROCEDURE SetStatements*( statements: StatementSequence );
- BEGIN
- SELF.statements := statements;
- END SetStatements;
- PROCEDURE SetComment*(comment: Comment);
- BEGIN SELF.comment := comment
- END SetComment;
- PROCEDURE Clone(): WithPart;
- VAR copy: WithPart;
- BEGIN
- NEW(copy);
- copy.SetType(type);
- copy.SetStatements(CloneStatementSequence(statements));
- RETURN copy
- END Clone;
- END WithPart;
- (** << WITH variable : type DO statements END >> **)
- WithStatement* = OBJECT (Statement)
- VAR
- variable-: Designator;
- withParts-: Basic.List;
- elsePart-: StatementSequence;
- PROCEDURE & InitWithStatement( position: Position; outer: Statement );
- BEGIN
- InitStatement( position,outer );
- NEW(withParts,4); elsePart := NIL;
- variable := NIL;
- END InitWithStatement;
- PROCEDURE SetVariable*( variable: Designator);
- BEGIN
- SELF.variable := variable
- END SetVariable;
- PROCEDURE AddWithPart*( withPart: WithPart );
- BEGIN withParts.Add( withPart );
- END AddWithPart;
- PROCEDURE GetWithPart*( i: LONGINT ): WithPart;
- VAR a: ANY;
- BEGIN a := withParts.Get( i ); RETURN a( WithPart )
- END GetWithPart;
- PROCEDURE WithParts*( ): LONGINT;
- BEGIN
- IF withParts = NIL THEN RETURN 0 ELSE RETURN withParts.Length(); END;
- END WithParts;
- PROCEDURE SetElsePart*( elsePart: StatementSequence );
- BEGIN
- SELF.elsePart := elsePart;
- END SetElsePart;
- PROCEDURE Clone(): Statement;
- VAR copy: WithStatement; i: LONGINT;
- BEGIN
- NEW(copy, position, outer);
- FOR i := 0 TO WithParts()-1 DO
- copy.AddWithPart(GetWithPart(i).Clone());
- END;
- copy.SetVariable(CloneDesignator(variable));
- copy.SetElsePart(CloneStatementSequence(elsePart));
- RETURN copy
- END Clone;
- END WithStatement;
- CaseConstant*= POINTER TO RECORD min*,max*: Basic.Integer; next*: CaseConstant END;
- (** << elements : statements >> **)
- CasePart* = OBJECT (Part)
- VAR
- elements-: ExpressionList; (* expression list inserted by the parser *)
- firstConstant-: CaseConstant; (* expression list resolved to int32s, inserted by checker *)
- statements-: StatementSequence;
- comment-: Comment;
- PROCEDURE & InitCasePart;
- BEGIN
- InitPart;
- elements := NewExpressionList(); firstConstant := NIL;
- END InitCasePart;
- PROCEDURE SetStatements*( statements: StatementSequence );
- BEGIN
- SELF.statements := statements;
- END SetStatements;
- PROCEDURE SetConstants*(firstConstant: CaseConstant);
- BEGIN SELF.firstConstant := firstConstant
- END SetConstants;
- PROCEDURE SetComment*(comment: Comment);
- BEGIN SELF.comment := comment
- END SetComment;
- PROCEDURE Clone(): CasePart;
- VAR copy: CasePart;
- BEGIN
- NEW(copy);
- copy.SetStatements(CloneStatementSequence(statements));
- copy.firstConstant := firstConstant;
- elements.Clone(copy.elements);
- RETURN copy
- END Clone;
- END CasePart;
- (** << CASE varaible OF caseParts ELSE elsePart >> **)
- CaseStatement* = OBJECT (Statement)
- VAR
- variable-: Expression;
- elsePart-: StatementSequence;
- caseParts-: Basic.List;
- min-,max-: Basic.Integer;
- PROCEDURE & InitCaseStatement( position: Position ; outer: Statement);
- BEGIN
- InitStatement(position,outer ); variable := NIL; elsePart := NIL; caseParts := NIL;
- min := MAX(Basic.Integer); max := MIN(Basic.Integer);
- END InitCaseStatement;
- PROCEDURE SetVariable*( expression: Expression );
- BEGIN SELF.variable := expression;
- END SetVariable;
- PROCEDURE SetElsePart*( elsePart: StatementSequence );
- BEGIN SELF.elsePart := elsePart;
- END SetElsePart;
- PROCEDURE AddCasePart*( casePart: CasePart );
- BEGIN
- IF caseParts = NIL THEN NEW(caseParts,4); END;
- caseParts.Add( casePart );
- END AddCasePart;
- PROCEDURE GetCasePart*( i: LONGINT ): CasePart;
- VAR a: ANY;
- BEGIN a := caseParts.Get( i ); RETURN a( CasePart )
- END GetCasePart;
- PROCEDURE CaseParts*( ): LONGINT;
- BEGIN
- IF caseParts = NIL THEN RETURN 0 ELSE RETURN caseParts.Length(); END;
- END CaseParts;
- PROCEDURE Clone(): Statement;
- VAR copy: CaseStatement; i: LONGINT;
- BEGIN
- NEW(copy, position, outer);
- copy.SetVariable(CloneExpression(variable));
- copy.SetElsePart(CloneStatementSequence(elsePart));
- FOR i := 0 TO CaseParts()-1 DO
- copy.AddCasePart(GetCasePart(i).Clone());
- END;
- copy.min := min; copy.max := max;
- RETURN copy
- END Clone;
- PROCEDURE MaxConstant*(): Basic.Integer;
- VAR val: Basic.Integer; i: LONGINT; part: CasePart; const: CaseConstant;
- BEGIN
- val := -1;
- FOR i := 0 TO CaseParts() - 1 DO
- part := GetCasePart(i);
- const := part.firstConstant;
- WHILE(const # NIL) DO
- IF const.max > val THEN val := const.max; END;
- const := const.next;
- END;
- END;
- RETURN val;
- END MaxConstant;
- PROCEDURE SetMinMax*(min,max: Basic.Integer);
- BEGIN
- SELF.min := min; SELF.max := max;
- END SetMinMax;
- END CaseStatement;
- (** << WHILE condition DO statements END >> **)
- WhileStatement* = OBJECT (Statement)
- VAR
- condition-: Expression;
- statements-: StatementSequence;
- PROCEDURE & InitWhileStatement( position: Position ; outer: Statement);
- BEGIN
- InitStatement( position,outer ); condition := NIL; statements := NIL;
- END InitWhileStatement;
- PROCEDURE SetCondition*( condition: Expression );
- BEGIN
- SELF.condition := condition
- END SetCondition;
- PROCEDURE SetStatements*( statements: StatementSequence );
- BEGIN
- SELF.statements := statements;
- END SetStatements;
- PROCEDURE Clone(): Statement;
- VAR copy: WhileStatement;
- BEGIN
- NEW(copy, position, outer);
- copy.SetCondition(CloneExpression(condition));
- copy.SetStatements(CloneStatementSequence(statements));
- RETURN copy
- END Clone;
- END WhileStatement;
- (** << REPEAT statements UNTIL condition >> **)
- RepeatStatement* = OBJECT (Statement)
- VAR
- condition-: Expression;
- statements-: StatementSequence;
- PROCEDURE & InitRepeatStatement( position: Position; outer: Statement );
- BEGIN
- InitStatement( position,outer ); condition := NIL; statements := NIL;
- END InitRepeatStatement;
- PROCEDURE SetCondition*( condition: Expression );
- BEGIN
- SELF.condition := condition
- END SetCondition;
- PROCEDURE SetStatements*( statements: StatementSequence );
- BEGIN
- SELF.statements := statements;
- END SetStatements;
- PROCEDURE Clone(): Statement;
- VAR copy: RepeatStatement;
- BEGIN
- NEW(copy, position, outer);
- copy.SetCondition(CloneExpression(condition));
- copy.SetStatements(CloneStatementSequence(statements));
- RETURN copy
- END Clone;
- END RepeatStatement;
- (** << FOR variable := from TO to BY by DO statements END >> **)
- ForStatement* = OBJECT (Statement)
- VAR
- variable-: Designator;
- from-, to-, by-: Expression;
- statements-: StatementSequence;
- PROCEDURE & InitForStatement( position: Position; outer: Statement );
- BEGIN
- InitStatement( position,outer ); variable := NIL;from := NIL; to := NIL; by := NIL; statements := NIL;
- END InitForStatement;
- PROCEDURE SetVariable*( variable: Designator);
- BEGIN
- SELF.variable := variable
- END SetVariable;
- PROCEDURE SetFrom*( from: Expression );
- BEGIN
- SELF.from := from
- END SetFrom;
- PROCEDURE SetTo*( to: Expression );
- BEGIN
- SELF.to := to
- END SetTo;
- PROCEDURE SetBy*( by: Expression );
- BEGIN SELF.by := by
- END SetBy;
- PROCEDURE SetStatements*( statements: StatementSequence );
- BEGIN SELF.statements := statements;
- END SetStatements;
- PROCEDURE Clone(): Statement;
- VAR copy: ForStatement;
- BEGIN
- NEW(copy, position, outer);
- copy.SetVariable(CloneDesignator(variable));
- copy.SetFrom(CloneExpression(from));
- copy.SetTo(CloneExpression(to));
- copy.SetBy(CloneExpression(by));
- copy.SetStatements(CloneStatementSequence(statements));
- RETURN copy
- END Clone;
- END ForStatement;
- ExitableBlock*= OBJECT (Statement)
- VAR statements-: StatementSequence;
- PROCEDURE & InitExitableBlock( position: Position ; outer: Statement);
- BEGIN
- InitStatement( position ,outer); statements := NIL;
- END InitExitableBlock;
- PROCEDURE SetStatements*( statements: StatementSequence );
- BEGIN SELF.statements := statements;
- END SetStatements;
- PROCEDURE Clone(): Statement;
- VAR copy: ExitableBlock;
- BEGIN
- NEW(copy, position, outer);
- copy.SetStatements(CloneStatementSequence(statements));
- RETURN copy
- END Clone;
- END ExitableBlock;
- (** << LOOP statements END >> **)
- LoopStatement* = OBJECT (ExitableBlock)
- PROCEDURE Clone(): Statement;
- VAR copy: LoopStatement;
- BEGIN
- NEW(copy, position, outer);
- copy.SetStatements(CloneStatementSequence(statements));
- RETURN copy
- END Clone;
- END LoopStatement;
- (** << EXIT >> **)
- ExitStatement* = OBJECT (Statement)
- PROCEDURE Clone(): Statement;
- VAR copy: ExitStatement;
- BEGIN
- NEW(copy, position, outer);
- RETURN copy
- END Clone;
- END ExitStatement;
- (** << RETURN returnValue >> **)
- ReturnStatement* = OBJECT (Statement)
- VAR returnValue-: Expression; (* strictly speaking this is not a value but this term is in common use here *)
- PROCEDURE & InitReturnStatement( position: Position ; outer: Statement);
- BEGIN
- InitStatement( position,outer ); returnValue := NIL
- END InitReturnStatement;
- PROCEDURE SetReturnValue*( returnValue: Expression );
- BEGIN SELF.returnValue := returnValue
- END SetReturnValue;
- PROCEDURE Clone(): Statement;
- VAR copy: ReturnStatement;
- BEGIN
- NEW(copy, position, outer);
- copy.SetReturnValue(CloneExpression(returnValue));
- RETURN copy
- END Clone;
- END ReturnStatement;
- (** << AWAIT condition >> **)
- AwaitStatement* = OBJECT (Statement)
- VAR condition-: Expression;
- PROCEDURE & InitAwaitStatement( position: Position; outer: Statement );
- BEGIN
- InitStatement( position,outer ); condition := NIL
- END InitAwaitStatement;
- PROCEDURE SetCondition*( condition: Expression );
- BEGIN SELF.condition := condition
- END SetCondition;
- PROCEDURE Clone(): Statement;
- VAR copy: AwaitStatement;
- BEGIN
- NEW(copy, position, outer);
- copy.SetCondition(CloneExpression(condition));
- RETURN copy
- END Clone;
- END AwaitStatement;
- (* << Identifier ( Expression) >> *)
- Modifier*= OBJECT
- VAR
- identifier-: Identifier; expression-: Expression;
- resolved-: BOOLEAN;
- nextModifier-: Modifier;
- position-: Position;
- PROCEDURE & InitModifier(position: Position; identifier: Identifier; expression: Expression);
- BEGIN
- SELF.position := position;
- SELF.identifier := identifier; SELF.expression := expression; nextModifier := NIL; resolved := FALSE;
- END InitModifier;
- PROCEDURE Resolved*;
- BEGIN resolved := TRUE
- END Resolved;
- PROCEDURE SetExpression*(e: Expression);
- BEGIN SELF.expression := e
- END SetExpression;
- PROCEDURE SetNext*(modifier: Modifier);
- BEGIN nextModifier := modifier
- END SetNext;
- END Modifier;
- (** << BEGIN {Modifier, Modifier ... } statements END >> **)
- StatementBlock* = OBJECT (Statement)
- VAR
- statements-: StatementSequence;
- blockModifiers-: Modifier;
- isExclusive-: BOOLEAN;
- isRealtime-: BOOLEAN;
- isUnchecked-: BOOLEAN;
- isUncooperative-: BOOLEAN;
- scope-: Scope;
- PROCEDURE & InitStatementBlock( position: Position ; outer: Statement; s: Scope);
- BEGIN
- InitStatement( position ,outer); statements := NIL; blockModifiers := NIL;
- isExclusive := FALSE;
- isRealtime := FALSE;
- isUnchecked := FALSE;
- isUncooperative := FALSE;
- scope := s;
- END InitStatementBlock;
- PROCEDURE SetRealtime*(b: BOOLEAN);
- BEGIN
- isRealtime := b
- END SetRealtime;
- PROCEDURE SetUnchecked*(unchecked: BOOLEAN);
- BEGIN
- isUnchecked := unchecked
- END SetUnchecked;
- PROCEDURE SetUncooperative*(uncooperative: BOOLEAN);
- BEGIN
- isUncooperative := uncooperative
- END SetUncooperative;
- PROCEDURE SetModifier*(modifier: Modifier);
- BEGIN
- blockModifiers := modifier;
- END SetModifier;
- PROCEDURE SetExclusive*(excl: BOOLEAN);
- BEGIN isExclusive := excl
- END SetExclusive;
- PROCEDURE SetStatementSequence*( statements: StatementSequence );
- BEGIN SELF.statements := statements;
- END SetStatementSequence;
- END StatementBlock;
- (** << CODE {flags} {character} END >> **)
- Code*= OBJECT(Statement)
- VAR
- sourceCode-: SourceCode; sourceCodeLength-: LONGINT;
- inlineCode-: BinaryCode;
- inRules-, outRules-: StatementSequence;
- PROCEDURE & InitCode(position: Position; outer: Statement);
- BEGIN
- InitStatement(position,outer);
- inlineCode := NIL;
- sourceCode := NIL; sourceCodeLength := 0;
- NEW(inRules); NEW(outRules);
- END InitCode;
- PROCEDURE SetSourceCode*(source: SourceCode; length: LONGINT);
- BEGIN sourceCode := source; sourceCodeLength := length;
- ASSERT(sourceCodeLength <= LEN(source));
- END SetSourceCode;
- PROCEDURE SetBinaryCode*(code: BinaryCode);
- BEGIN
- inlineCode := code;
- END SetBinaryCode;
- PROCEDURE Clone(): Statement;
- VAR copy: Code; s: Scanner.StringType;
- BEGIN
- NEW(copy, position, outer);
- NEW(s, sourceCodeLength);
- Strings.Copy(sourceCode^,0,sourceCodeLength,s^);
- copy.SetSourceCode(s, sourceCodeLength);
- copy.inRules := CloneStatementSequence(inRules);
- copy.outRules := CloneStatementSequence(outRules);
- RETURN copy
- END Clone;
- END Code;
- (** << BEGIN {flags} statements FINALLY statements END >> **)
- Body*= OBJECT(StatementBlock)
- VAR
- finally-: StatementSequence;
- priority-: Expression; (* set by checker *)
- inScope-: ProcedureScope;
- code-: Code;
- isActive-, isSafe-: BOOLEAN;
- PROCEDURE & InitBody(position: Position; scope: ProcedureScope);
- BEGIN
- InitStatementBlock(position,NIL,scope); finally := NIL; priority := NIL; inScope := scope; code := NIL;
- isActive := FALSE; isSafe := FALSE; isRealtime := FALSE;
- END InitBody;
- PROCEDURE SetActive*(active: BOOLEAN);
- BEGIN SELF.isActive := active
- END SetActive;
- PROCEDURE SetSafe*(safe: BOOLEAN);
- BEGIN SELF.isSafe := safe
- END SetSafe;
- PROCEDURE SetFinally*( finally: StatementSequence );
- BEGIN SELF.finally := finally
- END SetFinally;
- PROCEDURE SetPriority*(expression: Expression);
- BEGIN priority := expression
- END SetPriority;
- PROCEDURE SetCode*(code: Code);
- BEGIN SELF.code := code;
- END SetCode;
- END Body;
-
- (** (* comment *) *)
- Comment*=OBJECT
- VAR position-: Position;
- source-: String; (* currently: POINTER TO ARRAY OF CHAR *)
- scope-: Scope;
- item-: ANY; sameLine-: BOOLEAN;
- nextComment-: Comment;
- PROCEDURE & InitComment(pos: Position; scope: Scope; CONST s: ARRAY OF CHAR; length: LONGINT);
- VAR i: LONGINT;
- BEGIN
- SELF.scope := scope;
- NEW(source,length);
- FOR i := 0 TO length-1 DO
- source[i] := s[i];
- END;
- SELF.position := pos;
- nextComment := NIL;
- item := NIL; sameLine := FALSE;
- END InitComment;
- PROCEDURE SetItem*(p: ANY; sameLine: BOOLEAN);
- BEGIN
- item := p; SELF.sameLine := sameLine
- END SetItem;
- END Comment;
- (**** building blocks ****)
- Scope*=OBJECT
- VAR
- firstSymbol-: Symbol; numberSymbols-: LONGINT; (* all symbols in scope (sorted) *)
- symbolTable: Basic.HashTableInt;
- firstConstant-,lastConstant-: Constant; numberConstants-: LONGINT; (* constants *)
- firstTypeDeclaration-,lastTypeDeclaration-: TypeDeclaration; numberTypeDeclarations-: LONGINT; (* type declarations *)
- firstVariable-,lastVariable-: Variable; numberVariables-: LONGINT; (* variables *)
- firstProcedure-,lastProcedure-: Procedure; numberProcedures-: LONGINT; (* procedures *)
- procedures-: ProcedureList;
-
- outerScope-: Scope; nextScope-: Scope;
- ownerModule-: Module;
- PROCEDURE & InitScope*(outer: Scope);
- BEGIN
- firstSymbol := NIL; numberSymbols := 0;
- firstConstant := NIL; lastConstant := NIL; numberConstants := 0;
- firstTypeDeclaration := NIL; lastTypeDeclaration := NIL; numberTypeDeclarations := 0;
- firstVariable := NIL; lastVariable := NIL; numberVariables := 0;
- firstProcedure := NIL; lastProcedure := NIL; numberProcedures := 0;
- outerScope := outer;
- IF outer # NIL THEN
- ownerModule := outer.ownerModule
- ELSE
- ownerModule := NIL;
- END;
- nextScope := NIL;
- NEW(symbolTable,11);
- END InitScope;
-
- PROCEDURE Clear*;
- BEGIN
- firstConstant := NIL; lastConstant := NIL; numberConstants := 0;
- firstTypeDeclaration := NIL; lastTypeDeclaration := NIL; numberTypeDeclarations := 0;
- firstVariable := NIL; lastVariable := NIL; numberVariables := 0;
- firstProcedure := NIL; lastProcedure := NIL; numberProcedures := 0;
- END Clear;
- (** Enter a symbol in the scope, aplhabetically sorted, duplicate = TRUE if multiply identifier *)
- PROCEDURE EnterSymbol*(symbol: Symbol; VAR duplicate: BOOLEAN);
- VAR p,q: Symbol;
- BEGIN
- ASSERT(symbol.nextSymbol = NIL,101); (* symbol may only be present in one scope at a time ! *)
- ASSERT(symbol.scope = NIL,102);
- ASSERT(symbol.name # invalidIdentifier,103);
- p := firstSymbol; q := NIL;
- WHILE (p # NIL) & (StringPool.CompareString(p.name,symbol.name)<0) DO q := p; p := p.nextSymbol END;
- IF (p#NIL) & (symbol.name = p.name) THEN
- duplicate := TRUE;
- ELSE
- duplicate := FALSE
- END;
- symbol.nextSymbol := p;
- IF q = NIL THEN firstSymbol := symbol ELSE q.nextSymbol := symbol END;
- symbol.SetScope(SELF);
- symbolTable.Put(symbol.name,symbol);
- INC(numberSymbols);
- END EnterSymbol;
- (** Find symbol by name *)
- PROCEDURE FindSymbol*(identifier: Identifier): Symbol;
- VAR p: Symbol; a: ANY;
- BEGIN
- IF identifier # invalidIdentifier THEN
- a := symbolTable.Get(identifier);
- IF (a # NIL) & ~(a IS Operator) THEN
- p := a(Symbol);
- END;
- (*
- p := firstSymbol;
- WHILE(p#NIL) & ((p.name # identifier) OR (p IS Operator)) DO p := p.nextSymbol END;
- *)
- END;
- RETURN p;
- END FindSymbol;
- PROCEDURE AddConstant*(c: Constant);
- BEGIN
- ASSERT(c # NIL);
- IF lastConstant= NIL THEN firstConstant := c ELSE lastConstant.nextConstant := c END;
- lastConstant := c;
- INC(numberConstants);
- END AddConstant;
- PROCEDURE FindConstant*(identifier: Identifier): Constant;
- VAR p: Constant;
- BEGIN
- p := firstConstant;
- WHILE(p#NIL) & (p.name # identifier) DO p := p.nextConstant END;
- RETURN p;
- END FindConstant;
- PROCEDURE AddTypeDeclaration*(t: TypeDeclaration);
- BEGIN
- ASSERT(t # NIL);
- IF lastTypeDeclaration= NIL THEN firstTypeDeclaration := t ELSE lastTypeDeclaration.nextTypeDeclaration := t END;
- INC(numberTypeDeclarations);
- lastTypeDeclaration := t;
- END AddTypeDeclaration;
- PROCEDURE FindTypeDeclaration*(identifier: Identifier): TypeDeclaration;
- VAR p: TypeDeclaration;
- BEGIN
- p := firstTypeDeclaration;
- WHILE(p#NIL) & (p.name # identifier) DO p := p.nextTypeDeclaration END;
- RETURN p;
- END FindTypeDeclaration;
- PROCEDURE AddVariable*(v: Variable);
- BEGIN
- ASSERT(v # NIL);
- IF lastVariable= NIL THEN firstVariable := v ELSE lastVariable.nextVariable := v END;
- INC(numberVariables);
- lastVariable := v;
- END AddVariable;
- PROCEDURE PushVariable*(v: Variable);
- BEGIN
- ASSERT(v # NIL);
- IF lastVariable= NIL THEN lastVariable := v ELSE v.nextVariable := firstVariable END;
- INC(numberVariables);
- firstVariable := v;
- END PushVariable;
-
- (* insert variable after variable in list -- can be important to keep variable offsets in order *)
- (* pre: v # NIL, after # NIL *)
- PROCEDURE InsertVariable*(v: Variable; after: Variable);
- BEGIN
- ASSERT(v # NIL);
- ASSERT(after # NIL);
- v.nextVariable := after.nextVariable;
- after.nextVariable := v;
- IF after = lastVariable THEN lastVariable := v END;
- END InsertVariable;
- PROCEDURE FindVariable*(identifier: Identifier): Variable;
- VAR p: Variable;
- BEGIN
- p := firstVariable;
- WHILE(p#NIL) & (p.name # identifier) DO p := p.nextVariable END;
- RETURN p;
- END FindVariable;
- PROCEDURE AddProcedure*(p: Procedure);
- BEGIN
- ASSERT(p # NIL);
- IF lastProcedure= NIL THEN firstProcedure := p ELSE lastProcedure.nextProcedure := p END;
- INC(numberProcedures);
- lastProcedure := p;
- END AddProcedure;
-
- PROCEDURE AddProcedureDeclaration*(p: Procedure);
- BEGIN
- IF procedures = NIL THEN NEW(procedures) END;
- procedures.AddProcedure(p);
- END AddProcedureDeclaration;
-
- PROCEDURE FindProcedure*(identifier: Identifier): Procedure;
- VAR p: Procedure;
- BEGIN
- p := firstProcedure;
- WHILE (p#NIL) & ((p.name # identifier) OR (p IS Operator)) DO p := p.nextProcedure END;
- RETURN p;
- END FindProcedure;
-
- PROCEDURE FindMethod*(number: LONGINT): Procedure;
- VAR p: Procedure;
- BEGIN
- p := firstProcedure;
- WHILE (p# NIL) & (p.methodNumber # number) DO
- p := p.nextProcedure
- END;
- RETURN p;
- END FindMethod;
- PROCEDURE Level*(): LONGINT;
- VAR scope: Scope; level: LONGINT;
- BEGIN
- level := 0;
- scope := SELF;
- WHILE(scope.outerScope # NIL) DO
- scope := scope.outerScope;
- INC(level);
- END;
- RETURN level;
- END Level;
- PROCEDURE NeedsTrace* (): BOOLEAN;
- VAR variable: Variable;
- BEGIN
- variable := firstVariable;
- WHILE variable # NIL DO
- IF variable.NeedsTrace () THEN RETURN TRUE END;
- variable := variable.nextVariable;
- END;
- RETURN FALSE;
- END NeedsTrace;
- END Scope;
- ProcedureScope*=OBJECT (Scope)
- VAR
- ownerProcedure-: Procedure;
- body-: Body;
- PROCEDURE & InitProcedureScope(outer: Scope);
- BEGIN
- InitScope(outer);
- ownerProcedure := NIL;
- body := NIL;
- END InitProcedureScope;
- PROCEDURE SetBody*(body: Body);
- BEGIN
- SELF.body := body;
- END SetBody;
- PROCEDURE NeedsTrace* (): BOOLEAN;
- VAR parameter: Parameter;
- BEGIN
- parameter := ownerProcedure.type.resolved(ProcedureType).firstParameter;
- WHILE parameter # NIL DO
- IF parameter.NeedsTrace () THEN RETURN TRUE END;
- parameter := parameter.nextParameter;
- END;
- RETURN NeedsTrace^();
- END NeedsTrace;
- END ProcedureScope;
- EnumerationScope*= OBJECT(Scope)
- VAR
- ownerEnumeration-: EnumerationType;
- (** Find symbol by name *)
- PROCEDURE FindSymbol*(identifier: Identifier): Symbol;
- VAR p: Symbol; base: Type;
- BEGIN
- p := FindSymbol^(identifier);
- IF p = NIL THEN
- base := ownerEnumeration.enumerationBase;
- IF (base # NIL) & (base.resolved IS EnumerationType) THEN
- p := base.resolved(EnumerationType).enumerationScope.FindSymbol(identifier)
- END;
- END;
- RETURN p;
- END FindSymbol;
- PROCEDURE &InitEnumerationScope(outer: Scope);
- BEGIN
- InitScope(outer);
- ownerEnumeration := NIL; (* must be set by EnumerationType *)
- END InitEnumerationScope;
- END EnumerationScope;
- RecordScope*= OBJECT(Scope)
- VAR
- ownerRecord-: RecordType;
- bodyProcedure-: Procedure;
- constructor-: Procedure;
- finalizer-: Procedure;
- numberMethods-: LONGINT;
- firstParameter-,lastParameter-: Parameter; numberParameters-: LONGINT; (* parameters for Active Cells programming*)
- firstOperator-, lastOperator-: Operator; numberOperators: LONGINT; (* defined operators *)
-
- PROCEDURE & InitRecordScope(outer: Scope);
- BEGIN
- InitScope(outer);
- ownerRecord := NIL;
- numberMethods := 0;
- bodyProcedure := NIL;
- constructor := NIL;
- finalizer := NIL;
- firstOperator := NIL; lastOperator := NIL; numberOperators := 0;
- END InitRecordScope;
- PROCEDURE SetBodyProcedure*(body: Procedure);
- BEGIN SELF.bodyProcedure := body;
- END SetBodyProcedure;
- PROCEDURE SetConstructor*(body: Procedure);
- BEGIN SELF.constructor := body
- END SetConstructor;
- PROCEDURE SetFinalizer*(body: Procedure);
- BEGIN SELF.finalizer := body
- END SetFinalizer;
- PROCEDURE SetNumberMethods*(numberMethods: LONGINT);
- BEGIN SELF.numberMethods := numberMethods;
- END SetNumberMethods;
- PROCEDURE AddOperator*(p: Operator);
- BEGIN
- ASSERT(p # NIL);
- IF lastOperator= NIL THEN firstOperator := p ELSE lastOperator.nextOperator := p END;
- INC(numberOperators);
- lastOperator := p;
- END AddOperator;
- (** Find symbol by name *)
- PROCEDURE FindSymbol*(identifier: Identifier): Symbol;
- VAR p: Symbol; base: RecordType;
- BEGIN
- p := FindSymbol^(identifier);
- IF p = NIL THEN
- base := ownerRecord.GetBaseRecord();
- IF (base # NIL) THEN
- p := base.recordScope.FindSymbol(identifier)
- END;
- END;
- RETURN p;
- END FindSymbol;
- (* if there is an abstract procedure in the scope, return it. Otherwise return nil *)
- PROCEDURE AbstractProcedure*(inScope: Scope): Procedure;
- VAR p: Procedure; s: Symbol; base: RecordType;
- BEGIN
- p := firstProcedure;
- WHILE p # NIL DO
- IF p.isAbstract THEN
- IF inScope # SELF THEN (* elevate to mother scope, if necesary *)
- s := inScope.FindSymbol(p.name);
- IF s = p THEN (* procedure is not overwritten *)
- RETURN p
- ELSE
- ASSERT(s # NIL);
- ASSERT(s IS Procedure);
- END;
- ELSE
- RETURN p
- END;
- END;
- p := p.nextProcedure;
- END;
- base := ownerRecord.GetBaseRecord();
- IF (base # NIL) THEN
- RETURN base.recordScope.AbstractProcedure(inScope);
- END;
- RETURN NIL;
- END AbstractProcedure;
- PROCEDURE FindConstant*(identifier: Identifier): Constant;
- VAR p: Constant; base: RecordType;
- BEGIN
- p := FindConstant^(identifier);
- IF p = NIL THEN
- base := ownerRecord.GetBaseRecord();
- IF (base # NIL) THEN
- p := base.recordScope.FindConstant(identifier)
- END;
- END;
- RETURN p;
- END FindConstant;
- PROCEDURE FindTypeDeclaration*(identifier: Identifier): TypeDeclaration;
- VAR p: TypeDeclaration; base: RecordType;
- BEGIN
- p := FindTypeDeclaration^(identifier);
- IF p = NIL THEN
- base := ownerRecord.GetBaseRecord();
- IF (base # NIL) THEN
- p := base.recordScope.FindTypeDeclaration(identifier)
- END;
- END;
- RETURN p;
- END FindTypeDeclaration;
- PROCEDURE FindVariable*(identifier: Identifier): Variable;
- VAR p: Variable; base: RecordType;
- BEGIN
- p := FindVariable^(identifier);
- IF p = NIL THEN
- base := ownerRecord.GetBaseRecord();
- IF (base # NIL) THEN
- p := base.recordScope.FindVariable(identifier)
- END;
- END;
- RETURN p;
- END FindVariable;
- PROCEDURE FindProcedure*(identifier: Identifier): Procedure;
- VAR p: Procedure; base: RecordType;
- BEGIN
- p := FindProcedure^(identifier);
- IF p = NIL THEN
- base := ownerRecord.GetBaseRecord();
- IF (base # NIL) THEN
- p := base.recordScope.FindProcedure(identifier)
- END;
- END;
- RETURN p;
- END FindProcedure;
- PROCEDURE FindMethod*(number: LONGINT): Procedure;
- VAR p: Procedure; base: RecordType;
- BEGIN
- p := FindMethod^(number);
- IF p = NIL THEN
- base := ownerRecord.GetBaseRecord();
- IF (base # NIL) THEN
- p := base.recordScope.FindMethod(number)
- END;
- END;
- RETURN p;
- END FindMethod;
- PROCEDURE NeedsTrace* (): BOOLEAN;
- VAR base: RecordType;
- BEGIN
- base := ownerRecord.GetBaseRecord();
- IF (base # NIL) & (base.NeedsTrace ()) THEN RETURN TRUE END;
- RETURN NeedsTrace^();
- END NeedsTrace;
- END RecordScope;
- CellScope*=OBJECT (Scope)
- VAR
- ownerCell-: CellType;
- bodyProcedure-: Procedure;
- constructor-: Procedure;
- firstImport-,lastImport-: Import; numberImports: LONGINT; (* imported modules *)
- PROCEDURE & InitCellScope(outer: Scope);
- BEGIN
- InitScope(outer);
- ownerCell := NIL;
- bodyProcedure := NIL;
- constructor := NIL;
- firstImport := NIL; lastImport := NIL; numberImports := 0;
- END InitCellScope;
-
- PROCEDURE Clear*;
- BEGIN
- Clear^;
- firstImport := NIL; lastImport := NIL; numberImports := 0;
- constructor := NIL;
- bodyProcedure := NIL;
- END Clear;
-
- PROCEDURE SetOwnerCell*(owner: CellType);
- BEGIN
- ownerCell := owner
- END SetOwnerCell;
- PROCEDURE SetBodyProcedure*(bodyProcedure: Procedure);
- BEGIN
- SELF.bodyProcedure := bodyProcedure;
- END SetBodyProcedure;
- PROCEDURE SetConstructor*(p: Procedure);
- BEGIN constructor := p
- END SetConstructor;
- PROCEDURE AddImport*(i: Import);
- BEGIN
- ASSERT(i # NIL);
- ASSERT(i.nextImport = NIL);
- IF lastImport= NIL THEN firstImport:= i ELSE lastImport.nextImport := i END;
- lastImport := i;
- INC(numberImports);
- END AddImport;
- PROCEDURE FindImport*(identifier: Identifier): Import;
- VAR p: Import;
- BEGIN
- p := firstImport;
- WHILE(p#NIL) & (p.name # identifier) DO p := p.nextImport END; (* finds imports and re-imports! *)
- RETURN p;
- END FindImport;
- PROCEDURE GetImport*( index: LONGINT ): Import;
- VAR import: Import;
- BEGIN
- import := firstImport;
- WHILE(import # NIL) & (index > 0) DO
- import := import.nextImport;
- DEC(index);
- END;
- RETURN import;
- END GetImport;
-
- PROCEDURE FindSymbol*(identifier: Identifier): Symbol;
- VAR p: Symbol; base: Type;
- BEGIN
- p := FindSymbol^(identifier);
- IF p = NIL THEN
- IF ownerCell.isCellNet THEN
- RETURN ownerCell.FindProperty(identifier);
- END;
- END;
- IF p = NIL THEN
- base := ownerCell.baseType;
- IF (base # NIL) THEN
- base := base.resolved;
- IF base IS PointerType THEN
- base := base(PointerType).pointerBase.resolved;
- END;
- WITH base:
- CellType DO
- p := base.cellScope.FindSymbol(identifier)
- |RecordType DO
- p := base.recordScope.FindSymbol(identifier)
-
- END;
- END;
- END;
- RETURN p;
- END FindSymbol;
- END CellScope;
- (**
- <<
- IMPORT firstImport .. lastImport;
- ...
- firstOperator ... lastOperator
- ....
- >>
- **)
- ModuleScope*= OBJECT(Scope)
- VAR
- firstImport-,lastImport-: Import; numberImports: LONGINT; (* imported modules *)
- firstOperator-,lastOperator-: Operator; numberOperators: LONGINT; (* defined operators *)
- firstBuiltin-,lastBuiltin-: Builtin; numberBuiltins: LONGINT; (* defined builtins, only for global and system module *)
- firstComment-,lastComment-: Comment; numberComments-: LONGINT; (* comments *)
- bodyProcedure-: Procedure;
- PROCEDURE & InitModuleScope;
- BEGIN
- InitScope(NIL);
- firstComment := NIL; lastComment := NIL; numberComments := 0;
- firstImport:= NIL; lastImport := NIL; numberImports := 0;
- firstOperator := NIL; lastOperator := NIL; numberOperators := 0;
- END InitModuleScope;
- PROCEDURE SetBodyProcedure*(body: Procedure);
- BEGIN SELF.bodyProcedure := body;
- END SetBodyProcedure;
- PROCEDURE SetGlobalScope*(outer: Scope);
- BEGIN
- SELF.outerScope := outer;
- END SetGlobalScope;
- PROCEDURE AddBuiltin*(p: Builtin);
- BEGIN
- ASSERT(p # NIL);
- IF lastBuiltin= NIL THEN firstBuiltin := p ELSE lastBuiltin.nextBuiltin := p END;
- INC(numberBuiltins);
- lastBuiltin := p;
- END AddBuiltin;
- PROCEDURE AddOperator*(p: Operator);
- BEGIN
- ASSERT(p # NIL);
- IF lastOperator= NIL THEN firstOperator := p ELSE lastOperator.nextOperator := p END;
- INC(numberOperators);
- lastOperator := p;
- END AddOperator;
- PROCEDURE FindOperator*(identifier: Identifier): Operator;
- VAR p: Operator;
- BEGIN
- p := firstOperator;
- WHILE(p#NIL) & (p.name # identifier) DO p := p.nextOperator END;
- RETURN p;
- END FindOperator;
- PROCEDURE AddImport*(i: Import);
- BEGIN
- ASSERT(i # NIL);
- ASSERT(i.nextImport = NIL);
- IF lastImport= NIL THEN firstImport:= i ELSE lastImport.nextImport := i END;
- lastImport := i;
- INC(numberImports);
- END AddImport;
- PROCEDURE FindImport*(identifier: Identifier): Import;
- VAR p: Import;
- BEGIN
- p := firstImport;
- WHILE(p#NIL) & (p.name # identifier) DO p := p.nextImport END; (* finds imports and re-imports! *)
- RETURN p;
- END FindImport;
- PROCEDURE GetImport*( index: LONGINT ): Import;
- VAR import: Import;
- BEGIN
- import := firstImport;
- WHILE(import # NIL) & (index > 0) DO
- import := import.nextImport;
- DEC(index);
- END;
- RETURN import;
- END GetImport;
- PROCEDURE AddComment*(comment: Comment);
- BEGIN
- ASSERT(comment # NIL);
- IF lastComment= NIL THEN firstComment := comment ELSE lastComment.nextComment := comment END;
- INC(numberComments);
- lastComment := comment;
- END AddComment;
- PROCEDURE ImportByModuleName*(moduleName,context: Identifier): Import;
- VAR p: Import;
- BEGIN
- p := firstImport;
- WHILE(p#NIL) & ~((moduleName = p.moduleName) & (context = p.context)) DO p := p.nextImport END;
- RETURN p;
- END ImportByModuleName;
- PROCEDURE RemoveImporters*(moduleName,context: Identifier);
- VAR this: Import;
- PROCEDURE Check(p: Import): BOOLEAN;
- VAR result: BOOLEAN;
- BEGIN
- IF (moduleName = p.moduleName) & (context = p.context) THEN
- result := TRUE
- ELSE
- result := p.module.moduleScope.ImportByModuleName(moduleName,context) # NIL;
- END;
- RETURN result
- END Check;
- BEGIN
- WHILE(firstImport # NIL) & Check(firstImport) DO
- firstImport := firstImport.nextImport;
- DEC(numberImports);
- END;
- IF firstImport = NIL THEN lastImport := NIL
- ELSE
- this :=firstImport;
- WHILE(this.nextImport # NIL) DO
- IF Check(this.nextImport) THEN
- this.nextImport := this.nextImport.nextImport;
- DEC(numberImports);
- ELSE
- this := this.nextImport
- END;
- END;
- lastImport := this;
- END;
- END RemoveImporters;
- END ModuleScope;
- (* << MODULE name ['in' context] moduleScope name '.' >> *)
- Module* = OBJECT (Symbol)
- VAR
- sourceName-: Basic.FileName;
- moduleScope-: ModuleScope;
- context-:Identifier; (* modules context *)
- case-: LONGINT; (* module notation in lower or upper case, important for printout and operators *)
- isCellNet-: BOOLEAN;
- firstScope-,lastScope-: Scope; numberScopes-: LONGINT; (* list of all scopes for checker / backend traversal etc. *)
- closingComment-: Comment;
- modifiers-: Modifier;
- PROCEDURE & InitModule( CONST sourceName: ARRAY OF CHAR; position: Position; name: Identifier; scope: ModuleScope; case: LONGINT);
- BEGIN
- InitSymbol(position,name);
- COPY (sourceName, SELF.sourceName);
- moduleScope := scope;
- ASSERT(scope.ownerModule = NIL); (* cannot register twice ! *)
- scope.ownerModule := SELF;
- context := invalidIdentifier;
- SELF.case := case;
- firstScope := NIL; lastScope := NIL; numberScopes := 0;
- SetType(moduleType);
- closingComment := NIL;
- isCellNet := FALSE;
- modifiers := NIL;
- END InitModule;
- PROCEDURE SetCase*(case: LONGINT);
- BEGIN
- SELF.case := case
- END SetCase;
- PROCEDURE SetCellNet*(isCellNet: BOOLEAN);
- BEGIN SELF.isCellNet := isCellNet
- END SetCellNet;
- PROCEDURE SetContext*(context: Identifier);
- BEGIN SELF.context := context;
- END SetContext;
- PROCEDURE SetName*(name: Identifier);
- BEGIN SELF.name := name
- END SetName;
- PROCEDURE SetClosingComment*(comment: Comment);
- BEGIN SELF.closingComment := comment
- END SetClosingComment;
- PROCEDURE SetModifiers*(modifiers: Modifier);
- BEGIN SELF.modifiers := modifiers
- END SetModifiers;
- PROCEDURE AddScope*(c: Scope);
- BEGIN
- IF lastScope= NIL THEN firstScope := c ELSE lastScope.nextScope := c END;
- lastScope := c;
- INC(numberScopes);
- END AddScope;
- END Module;
- (** <<expression, expression, ...>> **)
- SymbolList* = OBJECT
- VAR list: Basic.List;
- PROCEDURE & InitList*;
- BEGIN NEW( list,8 );
- END InitList;
- PROCEDURE Length*( ): LONGINT;
- BEGIN RETURN list.Length();
- END Length;
- PROCEDURE AddSymbol*( d: Symbol );
- BEGIN list.Add(d)
- END AddSymbol;
- PROCEDURE GetSymbol*( index: LONGINT ): Symbol;
- VAR p: ANY;
- BEGIN
- p := list.Get(index); RETURN p(Symbol);
- END GetSymbol;
- PROCEDURE SetSymbol*(index: LONGINT; expression: Symbol);
- BEGIN list.Set(index,expression)
- END SetSymbol;
- PROCEDURE RemoveSymbol*(i: LONGINT);
- BEGIN list.RemoveByIndex(i);
- END RemoveSymbol;
- (*
- PROCEDURE Clone*(VAR list: SymbolList);
- VAR i: LONGINT;
- BEGIN
- IF list = NIL THEN NEW(list) END;
- FOR i := 0 TO Length()-1 DO
- list.AddSymbol(CloneSymbol(GetSymbol(i)));
- END;
- END Clone;
- *)
- END SymbolList;
- ProcedureList* = OBJECT
- VAR list: Basic.List;
- PROCEDURE & InitList*;
- BEGIN NEW( list,8 );
- END InitList;
- PROCEDURE Length*( ): LONGINT;
- BEGIN RETURN list.Length();
- END Length;
- PROCEDURE AddProcedure*( d: Procedure );
- BEGIN list.Add(d)
- END AddProcedure;
- PROCEDURE GetProcedure*( index: LONGINT ): Procedure;
- VAR p: ANY;
- BEGIN
- IF index >= list.Length() THEN RETURN NIL END;
- p := list.Get(index);
- IF p = NIL THEN
- RETURN NIL
- ELSE
- RETURN p(Procedure);
- END;
- END GetProcedure;
- PROCEDURE SetProcedure*(index: LONGINT; expression: Procedure);
- BEGIN list.GrowAndSet(index,expression)
- END SetProcedure;
- PROCEDURE RemoveProcedure*(i: LONGINT);
- BEGIN list.RemoveByIndex(i);
- END RemoveProcedure;
- (*
- PROCEDURE Clone*(VAR list: ProcedureList);
- VAR i: LONGINT;
- BEGIN
- IF list = NIL THEN NEW(list) END;
- FOR i := 0 TO Length()-1 DO
- list.AddProcedure(CloneProcedure(GetProcedure(i)));
- END;
- END Clone;
- *)
- END ProcedureList;
- VAR
- (* invalid items used, for example, by parser and checker *)
- invalidIdentifier-: Identifier;
- invalidQualifiedIdentifier-: QualifiedIdentifier;
- invalidType-: Type;
- invalidExpression-: Expression; (* mapped to invalidDesignator for better error handling in checker *)
- invalidDesignator-: Designator;
- invalidValue-: Value;
- invalidSymbol-: Symbol;
- invalidPosition-: Position;
- anonymousIdentifier-: Identifier;
- importType-: Type;
- typeDeclarationType-: Type;
- moduleType-: Type;
- indexListSeparator-: Expression;
- PROCEDURE InitFingerPrint*(VAR fingerprint: FingerPrint);
- BEGIN
- fingerprint.shallowAvailable := FALSE;
- fingerprint.deepAvailable := FALSE;
- fingerprint.shallow := 0;
- fingerprint.private := 0;
- fingerprint.public := 0;
- END InitFingerPrint;
- PROCEDURE NewModule*( CONST sourceName: ARRAY OF CHAR; position: Position; name: Identifier;scope: ModuleScope; case: LONGINT ): Module;
- VAR module: Module;
- BEGIN
- NEW( module, sourceName, position, name, scope, case); RETURN module;
- END NewModule;
- PROCEDURE NewComment*(position: Position; scope: Scope; CONST source: ARRAY OF CHAR; length: LONGINT): Comment;
- VAR comment: Comment;
- BEGIN
- NEW(comment,position,scope,source,length); RETURN comment;
- END NewComment;
- PROCEDURE NewImport*( position: Position; alias, name: Identifier; direct: BOOLEAN): Import;
- VAR import: Import;
- BEGIN
- NEW( import, position, alias, name, direct ); RETURN import
- END NewImport;
- PROCEDURE NewConstant*( position: Position; name: Identifier ): Constant;
- VAR constant: Constant;
- BEGIN
- NEW( constant, position, name ); RETURN constant
- END NewConstant;
- PROCEDURE NewProcedure*( position: Position; name: Identifier; scope: ProcedureScope ): Procedure;
- VAR procedure: Procedure;
- BEGIN
- NEW( procedure, position, name, scope); RETURN procedure
- END NewProcedure;
- PROCEDURE NewBuiltin*(position: Position; name: Identifier; id: LONGINT): Builtin;
- VAR builtin: Builtin;
- BEGIN
- NEW(builtin,position,name,id); RETURN builtin
- END NewBuiltin;
- PROCEDURE NewCustomBuiltin*(position: Position; name: Identifier; id: LONGINT; subType: SHORTINT): CustomBuiltin;
- VAR builtin:CustomBuiltin;
- BEGIN
- NEW(builtin,position,name,id,subType); RETURN builtin
- END NewCustomBuiltin;
- PROCEDURE NewOperator*( position: Position; name: Identifier; scope: ProcedureScope): Operator;
- VAR operator: Operator;
- BEGIN
- NEW( operator, position, name, scope); RETURN operator
- END NewOperator;
- PROCEDURE NewType*(): Type; (* for error handling: invalid Type, is realtime type *)
- VAR type: Type;
- BEGIN
- NEW( type, invalidPosition);
- type.SetRealtime(TRUE);
- RETURN type
- END NewType;
- PROCEDURE NewByteType*(sizeInBits: LONGINT): ByteType;
- VAR basicType: ByteType;
- BEGIN
- NEW(basicType, sizeInBits); RETURN basicType;
- END NewByteType;
- PROCEDURE NewAnyType*(sizeInBits: LONGINT): AnyType;
- VAR basicType: AnyType;
- BEGIN
- NEW(basicType, sizeInBits); RETURN basicType;
- END NewAnyType;
- PROCEDURE NewObjectType*(sizeInBits: LONGINT): ObjectType;
- VAR basicType: ObjectType;
- BEGIN
- NEW(basicType, sizeInBits); RETURN basicType;
- END NewObjectType;
- PROCEDURE NewNilType*(sizeInBits: LONGINT): NilType;
- VAR basicType: NilType;
- BEGIN
- NEW(basicType, sizeInBits); RETURN basicType;
- END NewNilType;
- PROCEDURE NewAddressType*(sizeInBits: LONGINT): AddressType;
- VAR basicType: AddressType;
- BEGIN
- NEW(basicType, sizeInBits); RETURN basicType;
- END NewAddressType;
- PROCEDURE NewSizeType*(sizeInBits: LONGINT): SizeType;
- VAR basicType: SizeType;
- BEGIN
- NEW(basicType, sizeInBits); RETURN basicType;
- END NewSizeType;
- PROCEDURE NewBooleanType*(sizeInBits: LONGINT): BooleanType;
- VAR basicType: BooleanType;
- BEGIN
- NEW(basicType, sizeInBits); RETURN basicType;
- END NewBooleanType;
- PROCEDURE NewSetType*(sizeInBits: LONGINT): SetType;
- VAR basicType: SetType;
- BEGIN
- NEW(basicType, sizeInBits); RETURN basicType;
- END NewSetType;
- PROCEDURE NewCharacterType*(sizeInBits: LONGINT): CharacterType;
- VAR basicType: CharacterType;
- BEGIN
- NEW(basicType, sizeInBits); RETURN basicType;
- END NewCharacterType;
- PROCEDURE NewRangeType*(sizeInBits: LONGINT): RangeType;
- VAR basicType: RangeType;
- BEGIN
- NEW(basicType, sizeInBits); RETURN basicType;
- END NewRangeType;
- PROCEDURE NewComplexType*(base: Type): ComplexType;
- VAR basicType: ComplexType;
- BEGIN
- NEW(basicType, base); RETURN basicType;
- END NewComplexType;
- PROCEDURE NewIntegerType*(size: LONGINT; signed: BOOLEAN): IntegerType;
- VAR basicType: IntegerType;
- BEGIN
- NEW(basicType, size, signed); RETURN basicType;
- END NewIntegerType;
- PROCEDURE NewFloatType*(sizeInBits: LONGINT): FloatType;
- VAR basicType: FloatType;
- BEGIN
- NEW(basicType, sizeInBits); RETURN basicType;
- END NewFloatType;
- PROCEDURE NewTypeDeclaration*(position: Position; name: Identifier): TypeDeclaration;
- VAR typeDeclaration: TypeDeclaration;
- BEGIN
- ASSERT(name # invalidIdentifier);
- NEW(typeDeclaration,position,name); RETURN typeDeclaration
- END NewTypeDeclaration;
- PROCEDURE NewStringType*( position: Position; baseType: Type; length: LONGINT): StringType;
- VAR stringType: StringType;
- BEGIN
- NEW( stringType, position, baseType, length); RETURN stringType;
- END NewStringType;
- PROCEDURE NewEnumerationType*( position: Position; scope: Scope; enumerationScope: EnumerationScope): EnumerationType;
- VAR enumerationType: EnumerationType;
- BEGIN
- NEW( enumerationType, position, scope, enumerationScope); RETURN enumerationType;
- END NewEnumerationType;
- PROCEDURE NewArrayType*( position: Position; scope: Scope; form: LONGINT): ArrayType;
- VAR arrayType: ArrayType;
- BEGIN
- NEW( arrayType, position,scope, form); RETURN arrayType;
- END NewArrayType;
- PROCEDURE NewMathArrayType*( position: Position; scope: Scope; form: LONGINT): MathArrayType;
- VAR mathArrayType: MathArrayType;
- BEGIN
- NEW( mathArrayType, position,scope,form); RETURN mathArrayType;
- END NewMathArrayType;
- PROCEDURE NewPointerType*( position: Position; scope: Scope): PointerType;
- VAR pointerType: PointerType;
- BEGIN
- NEW( pointerType, position,scope); RETURN pointerType;
- END NewPointerType;
- PROCEDURE NewPortType*( position: Position; direction: LONGINT; sizeExpression: Expression; scope: Scope): PortType;
- VAR portType: PortType;
- BEGIN
- NEW( portType, position, direction, sizeExpression, scope); RETURN portType;
- END NewPortType;
- PROCEDURE NewRecordType*( position: Position; scope: Scope; recordScope: RecordScope): RecordType;
- VAR recordType: RecordType;
- BEGIN
- NEW( recordType, position, scope, recordScope); RETURN recordType
- END NewRecordType;
- PROCEDURE NewCellType*(position: Position; scope:Scope; cellScope: CellScope): CellType;
- VAR actorType: CellType;
- BEGIN
- NEW(actorType, position, scope, cellScope); RETURN actorType;
- END NewCellType;
- PROCEDURE NewProcedureType*( position: Position; scope: Scope): ProcedureType;
- VAR procedureType: ProcedureType;
- BEGIN
- NEW( procedureType, position,scope); RETURN procedureType;
- END NewProcedureType;
- PROCEDURE NewQualifiedType*( position: Position; scope: Scope; qualifiedIdentifier: QualifiedIdentifier): QualifiedType;
- VAR qualifiedType: QualifiedType;
- BEGIN
- NEW( qualifiedType, position,scope,qualifiedIdentifier ); RETURN qualifiedType
- END NewQualifiedType;
- PROCEDURE NewSymbol*(name: Identifier): Symbol; (* for error handling: invalid Symbol *)
- VAR symbol: Symbol;
- BEGIN
- NEW(symbol,invalidPosition,name); RETURN symbol
- END NewSymbol;
- PROCEDURE NewVariable*( position: Position; name: Identifier): Variable;
- VAR variable: Variable;
- BEGIN
- NEW( variable, position, name ); RETURN variable
- END NewVariable;
- PROCEDURE NewQualifiedIdentifier*( position: Position; prefix, suffix: Identifier ): QualifiedIdentifier;
- VAR qualifiedIdentifier: QualifiedIdentifier;
- BEGIN
- NEW( qualifiedIdentifier, position, prefix, suffix ); RETURN qualifiedIdentifier
- END NewQualifiedIdentifier;
- PROCEDURE NewIdentifier*(CONST name: ARRAY OF CHAR): Identifier;
- BEGIN
- RETURN Basic.MakeString(name);
- END NewIdentifier;
- PROCEDURE NewParameter*( position: Position; ownerType:Type ; name: Identifier; passAs: LONGINT): Parameter;
- VAR parameter: Parameter;
- BEGIN
- NEW( parameter, position, ownerType, name, passAs); RETURN parameter;
- END NewParameter;
- PROCEDURE NewProperty*( position: Position; name: Identifier): Property;
- VAR property: Property;
- BEGIN
- NEW( property, position, name); RETURN property;
- END NewProperty;
- PROCEDURE NewExpressionList*(): ExpressionList;
- VAR expressionList: ExpressionList;
- BEGIN
- NEW(expressionList); RETURN expressionList
- END NewExpressionList;
- PROCEDURE CloneExpressionList*(l: ExpressionList): ExpressionList;
- VAR copy: ExpressionList;
- BEGIN
- IF l = NIL THEN RETURN NIL ELSE l.Clone(copy); RETURN copy END;
- END CloneExpressionList;
- PROCEDURE NewDesignator*(): Designator; (* for error handling: invalid Designator *)
- VAR designator: Designator;
- BEGIN
- NEW(designator,invalidPosition); RETURN designator;
- END NewDesignator;
- PROCEDURE NewIdentifierDesignator*( position: Position; identifier: Identifier): IdentifierDesignator;
- VAR identifierDesignator: IdentifierDesignator;
- BEGIN
- NEW( identifierDesignator, position, identifier ); RETURN identifierDesignator
- END NewIdentifierDesignator;
- PROCEDURE NewSelectorDesignator*( position: Position; left: Designator; name: Identifier ): SelectorDesignator;
- VAR selectorDesignator: SelectorDesignator;
- BEGIN
- NEW( selectorDesignator, position, left, name ); RETURN selectorDesignator
- END NewSelectorDesignator;
- PROCEDURE NewParameterDesignator*( position: Position; left: Designator; expressionList: ExpressionList ): ParameterDesignator;
- VAR parameterDesignator: ParameterDesignator;
- BEGIN
- NEW( parameterDesignator,position, left, expressionList ); RETURN parameterDesignator
- END NewParameterDesignator;
- PROCEDURE NewArrowDesignator*( position: Position; left: Designator ): ArrowDesignator;
- VAR dereferenceDesignator: ArrowDesignator;
- BEGIN
- NEW( dereferenceDesignator, position, left ); RETURN dereferenceDesignator;
- END NewArrowDesignator;
- PROCEDURE NewBracketDesignator*( position: Position; left: Designator; expressionList: ExpressionList ): BracketDesignator;
- VAR bracketDesignator: BracketDesignator;
- BEGIN
- NEW( bracketDesignator, position, left, expressionList ); RETURN bracketDesignator
- END NewBracketDesignator;
- PROCEDURE NewSymbolDesignator*( position: Position; left: Designator; symbol: Symbol ): SymbolDesignator;
- VAR symbolDesignator: SymbolDesignator;
- BEGIN
- NEW( symbolDesignator, position, left, symbol); RETURN symbolDesignator
- END NewSymbolDesignator;
- PROCEDURE NewIndexDesignator*( position: Position; left: Designator): IndexDesignator;
- VAR indexDesignator: IndexDesignator;
- BEGIN
- NEW( indexDesignator, position, left); RETURN indexDesignator
- END NewIndexDesignator;
- PROCEDURE NewProcedureCallDesignator*(position: Position; left: Designator; parameters: ExpressionList): ProcedureCallDesignator;
- VAR procedureCallDesignator: ProcedureCallDesignator;
- BEGIN
- NEW(procedureCallDesignator, position, left, parameters); RETURN procedureCallDesignator
- END NewProcedureCallDesignator;
-
- PROCEDURE NewInlineCallDesignator*(position: Position; o: ProcedureCallDesignator; block: StatementBlock): InlineCallDesignator;
- VAR inlineCall: InlineCallDesignator;
- BEGIN
- NEW(inlineCall, position, o, block); RETURN inlineCall;
- END NewInlineCallDesignator;
- PROCEDURE NewBuiltinCallDesignator*(position: Position; id: LONGINT; left: Designator; parameters: ExpressionList): BuiltinCallDesignator;
- VAR builtinCallDesignator: BuiltinCallDesignator;
- BEGIN
- NEW(builtinCallDesignator, position, id, left,parameters); RETURN builtinCallDesignator
- END NewBuiltinCallDesignator;
- PROCEDURE NewTypeGuardDesignator*(position: Position; left: Designator; type: Type): TypeGuardDesignator;
- VAR guardDesignator: TypeGuardDesignator;
- BEGIN
- NEW(guardDesignator,position,left,type); RETURN guardDesignator;
- END NewTypeGuardDesignator;
- PROCEDURE NewDereferenceDesignator*( position: Position; left: Designator): DereferenceDesignator;
- VAR dereferenceDesignator: DereferenceDesignator;
- BEGIN
- NEW( dereferenceDesignator, position, left); RETURN dereferenceDesignator
- END NewDereferenceDesignator;
- PROCEDURE NewSupercallDesignator*( position: Position; left: Designator): SupercallDesignator;
- VAR supercallDesignator: SupercallDesignator;
- BEGIN
- NEW( supercallDesignator, position, left); RETURN supercallDesignator
- END NewSupercallDesignator;
- PROCEDURE NewSelfDesignator*( position: Position): SelfDesignator;
- VAR selfDesignator: SelfDesignator;
- BEGIN
- NEW( selfDesignator, position); RETURN selfDesignator
- END NewSelfDesignator;
- PROCEDURE NewResultDesignator*( position: Position): ResultDesignator;
- VAR resultDesignator: ResultDesignator;
- BEGIN
- NEW( resultDesignator, position); RETURN resultDesignator
- END NewResultDesignator;
- PROCEDURE NewExpression*(): Expression; (* for error handling: invalid Expression *)
- VAR expression: Expression;
- BEGIN
- NEW(expression,invalidPosition); RETURN expression;
- END NewExpression;
- PROCEDURE CloneExpression*(e: Expression): Expression;
- VAR copy: Expression;
- BEGIN
- IF e = NIL THEN
- RETURN NIL
- ELSE
- copy := e.Clone();
- copy.type := e.type;
- copy.assignable := e.assignable;
- copy.position := e.position;
- copy.state := e.state;
- IF e.resolved = e THEN copy.resolved := copy(Value);
- ELSIF e.resolved # NIL THEN copy.resolved := CloneExpression(e.resolved)(Value);
- END;
- RETURN copy
- END;
- END CloneExpression;
- PROCEDURE CloneDesignator*(e: Expression): Designator;
- BEGIN
- IF e = NIL THEN RETURN NIL ELSE RETURN CloneExpression(e)(Designator) END;
- END CloneDesignator;
- PROCEDURE NewElement*( position: Position; from,to: Expression ): Expression;
- BEGIN
- IF from = to THEN RETURN from
- ELSE RETURN NewRangeExpression(position,from,to,NIL)
- END;
- END NewElement;
- PROCEDURE NewSet*( position: Position ): Set;
- VAR set: Set;
- BEGIN NEW( set, position ); RETURN set
- END NewSet;
- PROCEDURE NewMathArrayExpression*( position: Position ): MathArrayExpression;
- VAR mathArrayExpression: MathArrayExpression;
- BEGIN NEW( mathArrayExpression, position ); RETURN mathArrayExpression
- END NewMathArrayExpression;
- PROCEDURE NewBinaryExpression*( position: Position; left, right: Expression; operator: LONGINT ): BinaryExpression;
- VAR binaryExpression: BinaryExpression;
- BEGIN
- NEW( binaryExpression, position, left, right, operator ); RETURN binaryExpression;
- END NewBinaryExpression;
- PROCEDURE NewRangeExpression*(position: Position; first, last, step: Expression): RangeExpression;
- VAR rangeExpression: RangeExpression;
- BEGIN
- NEW(rangeExpression, position, first, last, step); RETURN rangeExpression
- END NewRangeExpression;
- PROCEDURE NewTensorRangeExpression*(position: Position): TensorRangeExpression;
- VAR tensorRangeExpression: TensorRangeExpression;
- BEGIN
- NEW(tensorRangeExpression,position); RETURN tensorRangeExpression
- END NewTensorRangeExpression;
- PROCEDURE NewUnaryExpression*( position: Position; operand: Expression; operator: LONGINT ): UnaryExpression;
- VAR unaryExpression: UnaryExpression;
- BEGIN
- NEW( unaryExpression, position, operand, operator ); RETURN unaryExpression;
- END NewUnaryExpression;
- PROCEDURE NewConversion*( position: Position; expression: Expression; type: Type; typeExpression: Expression): Conversion;
- VAR conversion: Conversion;
- BEGIN
- ASSERT(type # NIL);
- NEW( conversion, position, expression,type, typeExpression ); RETURN conversion;
- END NewConversion;
- PROCEDURE NewValue*(): Value;(* for error handling: invalid Value *)
- VAR value: Value;
- BEGIN
- NEW(value,invalidPosition); RETURN value;
- END NewValue;
- PROCEDURE NewIntegerValue*( position: Position; value: Basic.Integer): IntegerValue;
- VAR integerValue: IntegerValue;
- BEGIN
- NEW( integerValue, position, value); RETURN integerValue;
- END NewIntegerValue;
- PROCEDURE NewCharacterValue*( position: Position; value: CHAR): CharacterValue;
- VAR characterValue: CharacterValue;
- BEGIN
- NEW( characterValue, position, value); RETURN characterValue;
- END NewCharacterValue;
- PROCEDURE NewSetValue*(position: Position; value: Basic.Set): SetValue;
- VAR setValue: SetValue;
- BEGIN
- NEW(setValue, position, value); RETURN setValue
- END NewSetValue;
- PROCEDURE NewMathArrayValue*( position: Position ): MathArrayValue;
- VAR mathArrayValue: MathArrayValue;
- BEGIN NEW( mathArrayValue, position ); RETURN mathArrayValue
- END NewMathArrayValue;
- PROCEDURE NewRealValue*( position: Position; value: LONGREAL): RealValue;
- VAR realValue: RealValue;
- BEGIN
- NEW( realValue, position, value); RETURN realValue
- END NewRealValue;
- PROCEDURE NewComplexValue*( position: Position; realValue, imagValue: LONGREAL): ComplexValue;
- VAR complexValue: ComplexValue;
- BEGIN
- NEW( complexValue, position, realValue, imagValue); RETURN complexValue
- END NewComplexValue;
- PROCEDURE NewStringValue*( position: Position; value: String): StringValue;
- VAR stringValue: StringValue;
- BEGIN
- NEW( stringValue, position, value ); RETURN stringValue
- END NewStringValue;
- PROCEDURE NewBooleanValue*( position: Position; value: BOOLEAN): BooleanValue;
- VAR booleanValue: BooleanValue;
- BEGIN
- NEW( booleanValue, position, value ); RETURN booleanValue;
- END NewBooleanValue;
- PROCEDURE NewNilValue*( position: Position ): NilValue;
- VAR nilValue: NilValue;
- BEGIN
- NEW( nilValue, position ); RETURN nilValue
- END NewNilValue;
- PROCEDURE NewEnumerationValue*( position: Position; value: Basic.Integer ): EnumerationValue;
- VAR enumeratorValue: EnumerationValue;
- BEGIN
- NEW( enumeratorValue, position, value ); RETURN enumeratorValue
- END NewEnumerationValue;
- PROCEDURE NewStatement*(outer: Statement): Statement; (* for error handling: invalid Statement *)
- VAR statement: Statement;
- BEGIN NEW(statement,invalidPosition,outer); RETURN statement;
- END NewStatement;
- PROCEDURE CloneStatement*(statement: Statement): Statement;
- BEGIN IF statement = NIL THEN RETURN NIL ELSE RETURN statement.Clone() END
- END CloneStatement;
- PROCEDURE NewStatementSequence*(): StatementSequence;
- VAR statementSequence: StatementSequence;
- BEGIN
- NEW( statementSequence); RETURN statementSequence
- END NewStatementSequence;
- PROCEDURE CloneStatementSequence*(statementSequence: StatementSequence): StatementSequence;
- VAR copy: StatementSequence;
- BEGIN IF statementSequence = NIL THEN RETURN NIL ELSE statementSequence.Clone(copy); RETURN copy END
- END CloneStatementSequence;
- PROCEDURE NewModifier*(position: Position; identifier: Identifier; expression: Expression): Modifier;
- VAR blockModifier: Modifier;
- BEGIN
- NEW(blockModifier,position,identifier,expression); RETURN blockModifier
- END NewModifier;
- PROCEDURE NewStatementBlock*( position: Position ; outer: Statement; scope: Scope): StatementBlock;
- VAR statementBlock: StatementBlock;
- BEGIN
- NEW( statementBlock, position, outer, scope ); RETURN statementBlock
- END NewStatementBlock;
- PROCEDURE NewStatementDesignator*(position: Position; s: Statement): StatementDesignator;
- VAR statementDesignator: StatementDesignator;
- BEGIN
- NEW( statementDesignator, position, s); RETURN statementDesignator
- END NewStatementDesignator;
- PROCEDURE NewBody*( position: Position ; scope: ProcedureScope): Body;
- VAR body: Body;
- BEGIN
- NEW( body, position,scope ); RETURN body
- END NewBody;
- PROCEDURE NewIfPart*(): IfPart;
- VAR ifPart: IfPart;
- BEGIN
- NEW( ifPart); RETURN ifPart
- END NewIfPart;
- PROCEDURE NewIfStatement*( position: Position ; outer: Statement): IfStatement;
- VAR ifStatement: IfStatement;
- BEGIN
- NEW( ifStatement, position,outer ); RETURN ifStatement
- END NewIfStatement;
- PROCEDURE NewAssignment*( position: Position; left: Designator; right: Expression; outer: Statement): Assignment;
- VAR assignment: Assignment;
- BEGIN
- NEW( assignment, position, left, right,outer ); RETURN assignment
- END NewAssignment;
- PROCEDURE NewCommunicationStatement*( position: Position; op: LONGINT; left: Designator; right: Expression; outer: Statement): CommunicationStatement;
- VAR communication: CommunicationStatement;
- BEGIN
- NEW( communication, position, op, left, right,outer ); RETURN communication
- END NewCommunicationStatement;
- PROCEDURE NewProcedureCallStatement*(position: Position; ignore: BOOLEAN; call: Designator; outer: Statement): ProcedureCallStatement;
- VAR caller: ProcedureCallStatement;
- BEGIN
- NEW(caller,position,ignore,call,outer); RETURN caller
- END NewProcedureCallStatement;
- PROCEDURE NewCaseStatement*( position: Position ; outer: Statement): CaseStatement;
- VAR caseStatement: CaseStatement;
- BEGIN
- NEW( caseStatement, position,outer ); RETURN caseStatement
- END NewCaseStatement;
- PROCEDURE NewCasePart*(): CasePart;
- VAR casePart: CasePart;
- BEGIN
- NEW( casePart); RETURN casePart
- END NewCasePart;
- PROCEDURE NewWithPart*(): WithPart;
- VAR withPart: WithPart;
- BEGIN
- NEW( withPart); RETURN withPart
- END NewWithPart;
- PROCEDURE NewWithStatement*( position: Position; outer: Statement): WithStatement;
- VAR withStatement: WithStatement;
- BEGIN
- NEW( withStatement, position, outer ); RETURN withStatement
- END NewWithStatement;
- PROCEDURE NewWhileStatement*( position: Position ; outer: Statement): WhileStatement;
- VAR whileStatement: WhileStatement;
- BEGIN
- NEW( whileStatement, position,outer ); RETURN whileStatement
- END NewWhileStatement;
- PROCEDURE NewRepeatStatement*( position: Position ; outer: Statement): RepeatStatement;
- VAR repeatStatement: RepeatStatement;
- BEGIN
- NEW( repeatStatement, position ,outer); RETURN repeatStatement
- END NewRepeatStatement;
- PROCEDURE NewForStatement*( position: Position; outer: Statement ): ForStatement;
- VAR forStatement: ForStatement;
- BEGIN
- NEW( forStatement, position,outer ); RETURN forStatement
- END NewForStatement;
- PROCEDURE NewLoopStatement*( position: Position ; outer: Statement): LoopStatement;
- VAR loopStatement: LoopStatement;
- BEGIN
- NEW( loopStatement, position ,outer); RETURN loopStatement
- END NewLoopStatement;
- PROCEDURE NewExitableBlock*( position: Position ; outer: Statement): ExitableBlock;
- VAR loopStatement: ExitableBlock;
- BEGIN
- NEW( loopStatement, position ,outer); RETURN loopStatement
- END NewExitableBlock;
- PROCEDURE NewExitStatement*( position: Position ; outer: Statement): ExitStatement;
- VAR exitStatement: ExitStatement;
- BEGIN
- NEW( exitStatement, position, outer); RETURN exitStatement
- END NewExitStatement;
- PROCEDURE NewReturnStatement*( position: Position; outer: Statement ): ReturnStatement;
- VAR returnStatement: ReturnStatement;
- BEGIN
- NEW( returnStatement, position,outer ); RETURN returnStatement
- END NewReturnStatement;
- PROCEDURE NewAwaitStatement*( position: Position; outer: Statement ): AwaitStatement;
- VAR awaitStatement: AwaitStatement;
- BEGIN
- NEW( awaitStatement, position, outer ); RETURN awaitStatement
- END NewAwaitStatement;
- PROCEDURE NewCode*(position: Position; outer: Statement): Code;
- VAR code: Code;
- BEGIN
- NEW(code,position,outer); RETURN code
- END NewCode;
- PROCEDURE NewProcedureScope*(outer: Scope): ProcedureScope;
- VAR scope: ProcedureScope;
- BEGIN NEW(scope,outer); RETURN scope
- END NewProcedureScope;
- PROCEDURE NewModuleScope*(): ModuleScope;
- VAR scope: ModuleScope;
- BEGIN NEW(scope); RETURN scope
- END NewModuleScope;
- PROCEDURE NewRecordScope*(outer: Scope): RecordScope;
- VAR scope: RecordScope;
- BEGIN NEW(scope,outer); RETURN scope
- END NewRecordScope;
- PROCEDURE NewCellScope*(outer: Scope): CellScope;
- VAR scope: CellScope;
- BEGIN NEW(scope,outer); RETURN scope
- END NewCellScope;
- PROCEDURE NewEnumerationScope*(outer: Scope): EnumerationScope;
- VAR scope: EnumerationScope;
- BEGIN NEW(scope,outer); RETURN scope
- END NewEnumerationScope;
- PROCEDURE Init;
- BEGIN;
- invalidPosition.start := -1;
- invalidIdentifier := Basic.invalidString;
- invalidQualifiedIdentifier := NewQualifiedIdentifier(invalidPosition,invalidIdentifier,Basic.emptyString);
- invalidType := NewType();
- invalidDesignator := NewDesignator();
- invalidDesignator.SetType(invalidType);
- invalidExpression := invalidDesignator;
- invalidValue := NewValue();
- invalidSymbol := NewSymbol(NewIdentifier(""));
- invalidSymbol.SetType(invalidType);
- importType := NewType();
- importType.SetState(Resolved);
- typeDeclarationType := NewType();
- typeDeclarationType.SetState(Resolved);
- moduleType := NewType();
- moduleType.SetState(Resolved);
- anonymousIdentifier := NewIdentifier("");
- indexListSeparator := NewDesignator();
- indexListSeparator.SetType(invalidType);
- END Init;
- BEGIN
- Init;
- END FoxSyntaxTree.
|