FoxSyntaxTree.Mod 158 KB

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