| -- |
| -- mc-5.bnf grammar and associated actions for mcp5. |
| -- |
| -- Copyright (C) 2016-2025 Free Software Foundation, Inc. |
| -- Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
| -- |
| -- This file is part of GNU Modula-2. |
| -- |
| -- GNU Modula-2 is free software; you can redistribute it and/or modify |
| -- it under the terms of the GNU General Public License as published by |
| -- the Free Software Foundation; either version 3, or (at your option) |
| -- any later version. |
| -- |
| -- GNU Modula-2 is distributed in the hope that it will be useful, but |
| -- WITHOUT ANY WARRANTY; without even the implied warranty of |
| -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| -- General Public License for more details. |
| -- |
| -- You should have received a copy of the GNU General Public License |
| -- along with GNU Modula-2; see the file COPYING3. If not see |
| -- <http://www.gnu.org/licenses/>. |
| % module mcp5 begin |
| |
| (* output from mc-5.bnf, automatically generated do not edit. |
| |
| Copyright (C) 2016-2025 Free Software Foundation, Inc. |
| Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
| |
| This file is part of GNU Modula-2. |
| |
| GNU Modula-2 is free software; you can redistribute it and/or modify |
| it under the terms of the GNU General Public License as published by |
| the Free Software Foundation; either version 3, or (at your option) |
| any later version. |
| |
| GNU Modula-2 is distributed in the hope that it will be useful, but |
| WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| General Public License for more details. |
| |
| You should have received a copy of the GNU General Public License |
| along with GNU Modula-2; see the file COPYING. If not, |
| see <https://www.gnu.org/licenses/>. *) |
| |
| IMPLEMENTATION MODULE mcp5 ; |
| |
| FROM DynamicStrings IMPORT String, InitString, KillString, Mark, |
| ConCat, ConCatChar ; |
| |
| FROM mcError IMPORT errorStringAt, flushErrors ; |
| FROM nameKey IMPORT NulName, Name, makekey ; |
| FROM mcPrintf IMPORT printf0, printf1 ; |
| FROM mcDebug IMPORT assert ; |
| FROM mcReserved IMPORT toktype ; |
| FROM mcComment IMPORT setProcedureComment ; |
| FROM mcMetaError IMPORT metaError1, metaError2 ; |
| FROM mcStack IMPORT stack ; |
| |
| IMPORT mcStack ; |
| |
| FROM mcLexBuf IMPORT currentstring, currenttoken, getToken, insertToken, |
| insertTokenAndRewind, getTokenNo, lastcomment, |
| getBodyComment, getAfterComment ; |
| |
| FROM decl IMPORT node, lookupDef, lookupImp, lookupModule, getSymName, |
| enterScope, leaveScope, |
| makeEnum, makeEnumField, putType, lookupSym, isDef, makeSubrange, |
| makeSet, makePointer, |
| addParameter, |
| makeVarargs, makeVarParameter, makeNonVarParameter, |
| putSubrangeType, putConst, getType, skipType, |
| makeArray, putUnbounded, getCardinal, makeBinaryTok, makeUnaryTok, |
| makeRecord, isRecord, isRecordField, isVarientField, makeVarient, |
| addFieldsToRecord, isVarient, buildVarientSelector, |
| buildVarientFieldRecord, paramEnter, paramLeave, |
| makeIdentList, putIdent, addVarParameters, addNonVarParameters, |
| lookupInScope, import, lookupExported, isImp, isModule, isConst, |
| makeLiteralInt, makeLiteralReal, makeString, getBuiltinConst, |
| getNextEnum, makeComponentRef, makeArrayRef, makeDeRef, |
| makePointerRef, |
| makeExpList, putExpList, isExpList, isArray, isPointer, isVar, |
| isConst, isParameter, |
| makeStatementSequence, addStatement, putBegin, putFinally, |
| makeReturn, putReturn, makeExit, makeComment, |
| isStatementSequence, isWhile, makeWhile, putWhile, |
| makeAssignment, makeFuncCall, isReturn, |
| makeIf, makeElsif, putElse, isIf, |
| makeFor, putFor, isFor, |
| makeRepeat, putRepeat, |
| resetConstExpPos, getNextConstExp, |
| makeSetValue, putSetValue, includeSetValue, |
| makeCase, putCaseExpression, putCaseElse, |
| putCaseStatement, makeCaseList, putCaseRange, |
| dupExpr, makeLoop, putLoop, isLoop, |
| addCommentBody, addCommentAfter, addIfComments, |
| addElseComments, addIfEndComments, |
| addWhileDoComment, addWhileEndComment, |
| addRepeatComment, addUntilComment, |
| makeCommentS ; |
| |
| |
| CONST |
| Pass1 = FALSE ; |
| Debugging = FALSE ; |
| |
| VAR |
| WasNoError : BOOLEAN ; |
| curstring, |
| curident : Name ; |
| curproc, |
| frommodule, |
| qualid, |
| typeDes, |
| typeExp, |
| curmodule : node ; |
| loopNo : CARDINAL ; |
| loopStk, |
| stmtStk, |
| withStk, |
| stk : stack ; |
| |
| |
| (* |
| followNode - |
| *) |
| |
| PROCEDURE followNode (n: node) ; |
| BEGIN |
| IF isVar (n) |
| THEN |
| printf0 ("variable: ") |
| ELSIF isParameter (n) |
| THEN |
| printf0 ("parameter: ") |
| END ; |
| n := skipType (getType (n)) ; |
| IF isArray (n) |
| THEN |
| printf0 ("array\n") |
| ELSIF isPointer (n) |
| THEN |
| printf0 ("pointer\n") |
| ELSIF isRecord (n) |
| THEN |
| printf0 ("record\n") |
| ELSE |
| printf0 ("other\n") |
| END |
| END followNode ; |
| |
| |
| (* |
| push - |
| *) |
| |
| PROCEDURE push (n: node) : node ; |
| BEGIN |
| RETURN mcStack.push (stk, n) |
| END push ; |
| |
| |
| (* |
| pop - |
| *) |
| |
| PROCEDURE pop () : node ; |
| BEGIN |
| RETURN mcStack.pop (stk) |
| END pop ; |
| |
| |
| (* |
| replace - |
| *) |
| |
| PROCEDURE replace (n: node) : node ; |
| BEGIN |
| RETURN mcStack.replace (stk, n) |
| END replace ; |
| |
| |
| (* |
| peep - returns the top node on the stack without removing it. |
| *) |
| |
| PROCEDURE peep () : node ; |
| BEGIN |
| RETURN push (pop ()) |
| END peep ; |
| |
| |
| (* |
| depth - returns the depth of the stack. |
| *) |
| |
| PROCEDURE depth () : CARDINAL ; |
| BEGIN |
| RETURN mcStack.depth (stk) |
| END depth ; |
| |
| |
| (* |
| checkDuplicate - |
| *) |
| |
| PROCEDURE checkDuplicate (b: BOOLEAN) ; |
| BEGIN |
| |
| END checkDuplicate ; |
| |
| |
| (* |
| isQualident - returns TRUE if, n, is a qualident. |
| *) |
| |
| PROCEDURE isQualident (n: node) : BOOLEAN ; |
| VAR |
| type: node ; |
| BEGIN |
| IF isDef (n) |
| THEN |
| RETURN TRUE |
| ELSE |
| type := skipType (getType (n)) ; |
| RETURN (type # NIL) AND isRecord (type) |
| END ; |
| RETURN FALSE |
| END isQualident ; |
| |
| |
| |
| (* |
| startWith - |
| *) |
| |
| PROCEDURE startWith (n: node) ; |
| BEGIN |
| n := mcStack.push (withStk, n) |
| END startWith ; |
| |
| |
| (* |
| endWith - |
| *) |
| |
| PROCEDURE endWith ; |
| VAR |
| n: node ; |
| BEGIN |
| n := mcStack.pop (withStk) |
| END endWith ; |
| |
| |
| (* |
| lookupWithSym - |
| *) |
| |
| PROCEDURE lookupWithSym (i: Name) : node ; |
| VAR |
| d : CARDINAL ; |
| n, m, t: node ; |
| BEGIN |
| d := mcStack.depth (withStk) ; |
| WHILE d # 0 DO |
| n := mcStack.access (withStk, d) ; |
| t := skipType (getType (n)) ; |
| m := lookupInScope (t, i) ; |
| IF m # NIL |
| THEN |
| n := dupExpr (n) ; |
| RETURN makeComponentRef (n, m) |
| END ; |
| DEC (d) |
| END ; |
| RETURN lookupSym (i) |
| END lookupWithSym ; |
| |
| |
| (* |
| pushStmt - push a node, n, to the statement stack and return node, n. |
| *) |
| |
| PROCEDURE pushStmt (n: node) : node ; |
| BEGIN |
| RETURN mcStack.push (stmtStk, n) |
| END pushStmt ; |
| |
| |
| (* |
| popStmt - pop the top node from the statement stack. |
| *) |
| |
| PROCEDURE popStmt () : node ; |
| BEGIN |
| RETURN mcStack.pop (stmtStk) |
| END popStmt ; |
| |
| |
| (* |
| peepStmt - return the top node from the statement stack, |
| but leave the stack unchanged. |
| *) |
| |
| PROCEDURE peepStmt () : node ; |
| BEGIN |
| RETURN pushStmt (popStmt ()) |
| END peepStmt ; |
| |
| |
| (* |
| pushLoop - push a node, n, to the loop stack and return node, n. |
| *) |
| |
| PROCEDURE pushLoop (n: node) : node ; |
| BEGIN |
| RETURN mcStack.push (loopStk, n) |
| END pushLoop ; |
| |
| |
| (* |
| popLoop - pop the top node from the loop stack. |
| *) |
| |
| PROCEDURE popLoop () : node ; |
| BEGIN |
| RETURN mcStack.pop (loopStk) |
| END popLoop ; |
| |
| |
| (* |
| peepLoop - return the top node from the loop stack, |
| but leave the stack unchanged. |
| *) |
| |
| PROCEDURE peepLoop () : node ; |
| BEGIN |
| RETURN pushLoop (popLoop ()) |
| END peepLoop ; |
| |
| |
| PROCEDURE ErrorString (s: String) ; |
| BEGIN |
| errorStringAt (s, getTokenNo ()) ; |
| WasNoError := FALSE |
| END ErrorString ; |
| |
| |
| PROCEDURE ErrorArray (a: ARRAY OF CHAR) ; |
| BEGIN |
| ErrorString (InitString (a)) |
| END ErrorArray ; |
| |
| |
| (* |
| pushNunbounded - |
| *) |
| |
| PROCEDURE pushNunbounded (c: CARDINAL) ; |
| VAR |
| type, |
| array, |
| subrange: node ; |
| BEGIN |
| WHILE c#0 DO |
| type := pop () ; |
| subrange := makeSubrange (NIL, NIL) ; |
| putSubrangeType (subrange, getCardinal ()) ; |
| |
| array := makeArray (subrange, type) ; |
| putUnbounded (array) ; |
| type := push (array) ; |
| DEC (c) |
| END |
| END pushNunbounded ; |
| |
| |
| (* |
| makeIndexedArray - builds and returns an array of type, t, with, c, indices. |
| *) |
| |
| PROCEDURE makeIndexedArray (c: CARDINAL; t: node) : node ; |
| VAR |
| i: node ; |
| BEGIN |
| WHILE c>0 DO |
| t := makeArray (pop (), t) ; |
| DEC (c) |
| END ; |
| RETURN t |
| END makeIndexedArray ; |
| |
| |
| (* |
| importInto - from, m, import, name, into module, current. |
| It checks to see if curident is an enumeration type |
| and if so automatically includes all enumeration fields |
| as well. |
| *) |
| |
| PROCEDURE importInto (m: node; name: Name; current: node) ; |
| VAR |
| s, o: node ; |
| BEGIN |
| assert (isDef (m)) ; |
| assert (isDef (current) OR isModule (current) OR isImp (current)) ; |
| s := lookupExported (m, name) ; |
| IF s=NIL |
| THEN |
| metaError2 ('{%1k} was not exported from definition module {%2a}', name, m) |
| ELSE |
| o := import (current, s) ; |
| IF s#o |
| THEN |
| metaError2 ('{%1ad} cannot be imported into the current module as it causes a name clash with {%2ad}', |
| s, o) |
| END |
| END |
| END importInto ; |
| |
| |
| (* |
| checkEndName - if module does not have, name, then issue an error containing, desc. |
| *) |
| |
| PROCEDURE checkEndName (module: node; name: Name; desc: ARRAY OF CHAR) ; |
| VAR |
| s: String ; |
| BEGIN |
| IF getSymName (module)#name |
| THEN |
| s := InitString ('inconsistent module name found with this ') ; |
| s := ConCat (s, Mark (InitString (desc))) ; |
| ErrorString (s) |
| END |
| END checkEndName ; |
| |
| % declaration mcp5 begin |
| |
| |
| (* |
| SyntaxError - after a syntax error we skip all tokens up until we reach |
| a stop symbol. |
| *) |
| |
| PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; |
| BEGIN |
| DescribeError ; |
| IF Debugging |
| THEN |
| printf0('\nskipping token *** ') |
| END ; |
| (* |
| yes the ORD(currenttoken) looks ugly, but it is *much* safer than |
| using currenttoken<sometok as a change to the ordering of the |
| token declarations below would cause this to break. Using ORD() we are |
| immune from such changes |
| *) |
| WHILE NOT (((ORD(currenttoken)<32) AND (currenttoken IN stopset0)) OR |
| ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR |
| ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2))) |
| DO |
| getToken |
| END ; |
| IF Debugging |
| THEN |
| printf0(' ***\n') |
| END |
| END SyntaxError ; |
| |
| |
| (* |
| SyntaxCheck - |
| *) |
| |
| PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; |
| BEGIN |
| (* and again (see above re: ORD) |
| *) |
| IF NOT (((ORD(currenttoken)<32) AND (currenttoken IN stopset0)) OR |
| ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR |
| ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2))) |
| THEN |
| SyntaxError (stopset0, stopset1, stopset2) |
| END |
| END SyntaxCheck ; |
| |
| |
| (* |
| WarnMissingToken - generates a warning message about a missing token, t. |
| *) |
| |
| PROCEDURE WarnMissingToken (t: toktype) ; |
| VAR |
| s0 : SetOfStop0 ; |
| s1 : SetOfStop1 ; |
| s2 : SetOfStop2 ; |
| str: String ; |
| BEGIN |
| s0 := SetOfStop0{} ; |
| s1 := SetOfStop1{} ; |
| s2 := SetOfStop2{} ; |
| IF ORD(t)<32 |
| THEN |
| s0 := SetOfStop0{t} |
| ELSIF ORD(t)<64 |
| THEN |
| s1 := SetOfStop1{t} |
| ELSE |
| s2 := SetOfStop2{t} |
| END ; |
| str := DescribeStop (s0, s1, s2) ; |
| |
| str := ConCat (InitString ('syntax error,'), Mark (str)) ; |
| errorStringAt (str, getTokenNo ()) |
| END WarnMissingToken ; |
| |
| |
| (* |
| MissingToken - generates a warning message about a missing token, t. |
| *) |
| |
| PROCEDURE MissingToken (t: toktype) ; |
| BEGIN |
| WarnMissingToken (t) ; |
| IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok) |
| THEN |
| IF Debugging |
| THEN |
| printf0 ('inserting token\n') |
| END ; |
| insertToken (t) |
| END |
| END MissingToken ; |
| |
| |
| (* |
| CheckAndInsert - |
| *) |
| |
| PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ; |
| BEGIN |
| IF ((ORD(t)<32) AND (t IN stopset0)) OR |
| ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR |
| ((ORD(t)>=64) AND (t IN stopset2)) |
| THEN |
| WarnMissingToken (t) ; |
| insertTokenAndRewind (t) ; |
| RETURN( TRUE ) |
| ELSE |
| RETURN( FALSE ) |
| END |
| END CheckAndInsert ; |
| |
| |
| (* |
| InStopSet |
| *) |
| |
| PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ; |
| BEGIN |
| IF ((ORD(t)<32) AND (t IN stopset0)) OR |
| ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR |
| ((ORD(t)>=64) AND (t IN stopset2)) |
| THEN |
| RETURN( TRUE ) |
| ELSE |
| RETURN( FALSE ) |
| END |
| END InStopSet ; |
| |
| |
| (* |
| PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken |
| If it is not then it will insert a token providing the token |
| is one of ; ] ) } . OF END , |
| |
| if the stopset contains <identtok> then we do not insert a token |
| *) |
| |
| PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; |
| BEGIN |
| (* and again (see above re: ORD) |
| *) |
| IF (NOT (((ORD(currenttoken)<32) AND (currenttoken IN stopset0)) OR |
| ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR |
| ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND |
| (NOT InStopSet(identtok, stopset0, stopset1, stopset2)) |
| THEN |
| (* SyntaxCheck would fail since currentoken is not part of the stopset |
| we check to see whether any of currenttoken might be a commonly omitted token *) |
| IF CheckAndInsert(semicolontok, stopset0, stopset1, stopset2) OR |
| CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR |
| CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR |
| CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR |
| CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR |
| CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR |
| CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR |
| CheckAndInsert(commatok, stopset0, stopset1, stopset2) |
| THEN |
| END |
| END |
| END PeepToken ; |
| |
| |
| (* |
| Expect - |
| *) |
| |
| PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; |
| BEGIN |
| IF currenttoken=t |
| THEN |
| getToken ; |
| IF Pass1 |
| THEN |
| PeepToken(stopset0, stopset1, stopset2) |
| END |
| ELSE |
| MissingToken(t) |
| END ; |
| SyntaxCheck(stopset0, stopset1, stopset2) |
| END Expect ; |
| |
| |
| (* |
| CompilationUnit - returns TRUE if the input was correct enough to parse |
| in future passes. |
| *) |
| |
| PROCEDURE CompilationUnit () : BOOLEAN ; |
| BEGIN |
| stk := mcStack.init () ; |
| withStk := mcStack.init () ; |
| stmtStk := mcStack.init () ; |
| loopStk := mcStack.init () ; |
| loopNo := 0 ; |
| WasNoError := TRUE ; |
| FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ; |
| mcStack.kill (stk) ; |
| mcStack.kill (withStk) ; |
| mcStack.kill (stmtStk) ; |
| mcStack.kill (loopStk) ; |
| RETURN WasNoError |
| END CompilationUnit ; |
| |
| |
| (* |
| Ident - error checking varient of Ident |
| *) |
| |
| PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; |
| BEGIN |
| curident := makekey (currentstring) ; |
| Expect(identtok, stopset0, stopset1, stopset2) |
| END Ident ; |
| |
| |
| (* |
| string - |
| *) |
| |
| PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; |
| BEGIN |
| curstring := makekey (currentstring) ; |
| Expect(stringtok, stopset0, stopset1, stopset2) |
| END string ; |
| |
| |
| (* |
| Integer - |
| *) |
| |
| PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; |
| VAR |
| n: node ; |
| BEGIN |
| n := push (makeLiteralInt (makekey (currentstring))) ; |
| Expect(integertok, stopset0, stopset1, stopset2) |
| END Integer ; |
| |
| |
| (* |
| Real - |
| *) |
| |
| PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; |
| VAR |
| n: node ; |
| BEGIN |
| n := push (makeLiteralReal (makekey (currentstring))) ; |
| Expect(realtok, stopset0, stopset1, stopset2) |
| END Real ; |
| |
| % module mcp5 end |
| END mcp5. |
| % rules |
| error 'ErrorArray' 'ErrorString' |
| tokenfunc 'currenttoken' |
| |
| token '' eoftok -- internal token |
| token '+' plustok |
| token '-' minustok |
| token '*' timestok |
| token '/' dividetok |
| token ':=' becomestok |
| token '&' ambersandtok |
| token "." periodtok |
| token "," commatok |
| token ";" semicolontok |
| token '(' lparatok |
| token ')' rparatok |
| token '[' lsbratok -- left square brackets |
| token ']' rsbratok -- right square brackets |
| token '{' lcbratok -- left curly brackets |
| token '}' rcbratok -- right curly brackets |
| token '^' uparrowtok |
| token "'" singlequotetok |
| token '=' equaltok |
| token '#' hashtok |
| token '<' lesstok |
| token '>' greatertok |
| token '<>' lessgreatertok |
| token '<=' lessequaltok |
| token '>=' greaterequaltok |
| token '<*' ldirectivetok |
| token '*>' rdirectivetok |
| token '..' periodperiodtok |
| token ':' colontok |
| token '"' doublequotestok |
| token '|' bartok |
| token 'AND' andtok |
| token 'ARRAY' arraytok |
| token 'BEGIN' begintok |
| token 'BY' bytok |
| token 'CASE' casetok |
| token 'CONST' consttok |
| token 'DEFINITION' definitiontok |
| token 'DIV' divtok |
| token 'DO' dotok |
| token 'ELSE' elsetok |
| token 'ELSIF' elsiftok |
| token 'END' endtok |
| token 'EXCEPT' excepttok |
| token 'EXIT' exittok |
| token 'EXPORT' exporttok |
| token 'FINALLY' finallytok |
| token 'FOR' fortok |
| token 'FROM' fromtok |
| token 'IF' iftok |
| token 'IMPLEMENTATION' implementationtok |
| token 'IMPORT' importtok |
| token 'IN' intok |
| token 'LOOP' looptok |
| token 'MOD' modtok |
| token 'MODULE' moduletok |
| token 'NOT' nottok |
| token 'OF' oftok |
| token 'OR' ortok |
| token 'PACKEDSET' packedsettok |
| token 'POINTER' pointertok |
| token 'PROCEDURE' proceduretok |
| token 'QUALIFIED' qualifiedtok |
| token 'UNQUALIFIED' unqualifiedtok |
| token 'RECORD' recordtok |
| token 'REM' remtok |
| token 'REPEAT' repeattok |
| token 'RETRY' retrytok |
| token 'RETURN' returntok |
| token 'SET' settok |
| token 'THEN' thentok |
| token 'TO' totok |
| token 'TYPE' typetok |
| token 'UNTIL' untiltok |
| token 'VAR' vartok |
| token 'WHILE' whiletok |
| token 'WITH' withtok |
| token 'ASM' asmtok |
| token 'VOLATILE' volatiletok |
| token '...' periodperiodperiodtok |
| token '__DATE__' datetok |
| token '__LINE__' linetok |
| token '__FILE__' filetok |
| token '__ATTRIBUTE__' attributetok |
| token '__BUILTIN__' builtintok |
| token '__INLINE__' inlinetok |
| token 'integer number' integertok |
| token 'identifier' identtok |
| token 'real number' realtok |
| token 'string' stringtok |
| |
| special Ident first { < identtok > } follow { } |
| special Integer first { < integertok > } follow { } |
| special Real first { < realtok > } follow { } |
| special string first { < stringtok > } follow { } |
| |
| BNF |
| |
| -- the following are provided by the module m2flex and also handbuild procedures below |
| -- Ident := Letter { ( Letter | Digit ) } =: |
| -- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) | |
| -- Digit { HexDigit } " H " =: |
| -- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =: |
| -- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =: |
| -- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =: |
| -- Digit := OctalDigit | " 8 " | " 9 " =: |
| -- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =: |
| -- String |
| |
| FileUnit := DefinitionModule | ImplementationOrProgramModule |
| =: |
| |
| ProgramModule := "MODULE" |
| Ident % curmodule := lookupModule (curident) % |
| % addCommentBody (curmodule) % |
| % enterScope (curmodule) % |
| % resetConstExpPos (curmodule) % |
| [ Priority ] ";" |
| { Import } |
| Block |
| Ident % checkEndName (curmodule, curident, 'program module') % |
| % leaveScope % |
| |
| "." |
| =: |
| |
| ImplementationModule := "IMPLEMENTATION" "MODULE" |
| Ident % curmodule := lookupImp (curident) % |
| % addCommentBody (curmodule) % |
| % enterScope (lookupDef (curident)) % |
| % enterScope (curmodule) % |
| % resetConstExpPos (curmodule) % |
| [ Priority ] ";" |
| { Import } |
| Block |
| Ident % checkEndName (curmodule, curident, 'implementation module') % |
| % leaveScope ; leaveScope % |
| "." |
| =: |
| |
| ImplementationOrProgramModule := ImplementationModule | ProgramModule =: |
| |
| ConstInteger := Integer % VAR i: node ; % |
| % i := pop () % |
| =: |
| |
| ConstReal := Real % VAR r: node ; % |
| % r := pop () % |
| =: |
| |
| ConstNumber := ConstInteger | ConstReal =: |
| |
| Number := Integer | Real =: |
| |
| Qualident := Ident { "." Ident } =: |
| |
| ConstantDeclaration := Ident "=" ConstExpressionNop =: |
| |
| ConstExpressionNop := % VAR c: node ; % |
| % c := getNextConstExp () % |
| SimpleConstExpr [ Relation SimpleConstExpr ] =: |
| |
| ConstExpression := % VAR c: node ; % |
| % c := push (getNextConstExp ()) % |
| SimpleConstExpr [ Relation SimpleConstExpr ] =: |
| |
| Relation := "=" |
| | "#" |
| | "<>" |
| | "<" |
| | "<=" |
| | ">" |
| | ">=" |
| | "IN" |
| =: |
| |
| SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm } =: |
| |
| UnaryOrConstTerm := |
| "+" |
| ConstTerm |
| | |
| "-" |
| ConstTerm |
| | |
| ConstTerm |
| =: |
| |
| AddOperator := "+" |
| | "-" |
| | "OR" |
| =: |
| |
| ConstTerm := ConstFactor { MulOperator ConstFactor } =: |
| |
| MulOperator := "*" |
| | "/" |
| | "DIV" |
| | "MOD" |
| | "REM" |
| | "AND" |
| | "&" |
| =: |
| |
| NotConstFactor := "NOT" ConstFactor % VAR n: node ; % |
| % n := push (makeUnaryTok (nottok, pop ())) % |
| =: |
| |
| ConstFactor := ConstNumber | ConstString | ConstSetOrQualidentOrFunction | |
| "(" ConstExpressionNop ")" | NotConstFactor |
| | ConstAttribute =: |
| |
| -- to help satisfy LL1 |
| |
| ConstString := string =: |
| |
| ConstComponentElement := ConstExpressionNop [ ".." ConstExpressionNop ] |
| =: |
| |
| ConstComponentValue := ConstComponentElement [ 'BY' ConstExpressionNop ] |
| =: |
| |
| ConstArraySetRecordValue := ConstComponentValue { ',' ConstComponentValue } |
| =: |
| |
| ConstConstructor := '{' |
| [ ConstArraySetRecordValue ] |
| '}' =: |
| |
| ConstSetOrQualidentOrFunction := Qualident |
| [ ConstConstructor | ConstActualParameters ] |
| | |
| ConstConstructor =: |
| |
| ConstActualParameters := "(" [ ConstExpList ] ")" =: |
| |
| ConstExpList := ConstExpressionNop { "," ConstExpressionNop } |
| =: |
| |
| ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" |
| ConstAttributeExpression |
| ")" ")" =: |
| |
| ConstAttributeExpression := Ident | "<" Qualident ',' Ident ">" =: |
| |
| ByteAlignment := '<*' AttributeExpression '*>' |
| =: |
| |
| OptAlignmentExpression := [ AlignmentExpression ] =: |
| |
| AlignmentExpression := "(" ConstExpressionNop ")" =: |
| |
| Alignment := [ ByteAlignment ] =: |
| |
| IdentList := Ident { "," Ident } |
| =: |
| |
| SubrangeType := "[" ConstExpressionNop ".." ConstExpressionNop "]" =: |
| |
| ArrayType := "ARRAY" SimpleType { "," SimpleType } "OF" Type =: |
| |
| RecordType := "RECORD" [ DefaultRecordAttributes ] |
| FieldListSequence |
| "END" =: |
| |
| DefaultRecordAttributes := '<*' AttributeExpression '*>' =: |
| |
| RecordFieldPragma := [ '<*' FieldPragmaExpression |
| { ',' FieldPragmaExpression } '*>' ] =: |
| |
| FieldPragmaExpression := Ident PragmaConstExpression =: |
| |
| PragmaConstExpression := [ '(' ConstExpressionNop ')' ] =: |
| |
| AttributeExpression := Ident '(' ConstExpressionNop ')' =: |
| |
| FieldListSequence := FieldListStatement { ";" FieldListStatement } =: |
| |
| FieldListStatement := [ FieldList ] =: |
| |
| FieldList := IdentList ":" Type RecordFieldPragma |
| | "CASE" CaseTag "OF" Varient { "|" Varient } |
| [ "ELSE" |
| FieldListSequence |
| ] "END" |
| =: |
| |
| TagIdent := Ident | % curident := NulName % |
| =: |
| |
| CaseTag := TagIdent [ ":" Qualident ] |
| =: |
| |
| Varient := [ VarientCaseLabelList ":" FieldListSequence ] =: |
| |
| VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =: |
| |
| VarientCaseLabels := ConstExpressionNop [ ".." ConstExpressionNop ] |
| =: |
| |
| SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType =: |
| |
| PointerType := "POINTER" "TO" Type =: |
| |
| ProcedureType := "PROCEDURE" [ FormalTypeList ] =: |
| |
| FormalTypeList := "(" ( ")" FormalReturn | |
| ProcedureParameters ")" FormalReturn ) =: |
| |
| FormalReturn := [ ":" OptReturnType ] =: |
| |
| OptReturnType := "[" Qualident "]" | Qualident |
| =: |
| |
| ProcedureParameters := ProcedureParameter |
| { "," ProcedureParameter } =: |
| |
| ProcedureParameter := "..." | "VAR" FormalType | FormalType =: |
| |
| |
| VarIdent := Ident [ "[" ConstExpressionNop "]" ] |
| =: |
| |
| VarIdentList := VarIdent { "," VarIdent } =: |
| |
| VariableDeclaration := VarIdentList ":" Type Alignment |
| =: |
| |
| Designator := PushQualident { SubDesignator } =: |
| |
| SubDesignator := % VAR n, field, type: node ; % |
| % n := peep () % |
| % IF n = NIL |
| THEN |
| ErrorArray ('no expression found') ; |
| flushErrors ; |
| RETURN |
| END % |
| % type := skipType (getType (n)) % |
| ( "." |
| Ident % IF isRecord (type) |
| THEN |
| field := lookupInScope (type, curident) ; |
| IF field = NIL |
| THEN |
| metaError2 ('field {%1k} cannot be found in record {%2ad}', curident, type) |
| ELSE |
| n := replace (makeComponentRef (n, field)) |
| END |
| ELSE |
| metaError2 ('attempting to access a field {%1k} from {%2ad} which does not have a record type', curident, type) |
| END % |
| |
| | "[" ArrayExpList % IF isArray (type) |
| THEN |
| n := replace (makeArrayRef (n, pop ())) |
| ELSE |
| metaError1 ('attempting to access an array but the expression is not an array but a {%1d}', type) |
| END % |
| "]" |
| | SubPointer |
| ) |
| =: |
| |
| SubPointer := % VAR n, field, type: node ; % |
| % n := peep () % |
| % type := skipType (getType (n)) % |
| "^" ( "." Ident % IF isPointer (type) |
| THEN |
| type := skipType (getType (type)) ; |
| IF isRecord (type) |
| THEN |
| field := lookupInScope (type, curident) ; |
| IF field = NIL |
| THEN |
| metaError2 ('field {%1k} cannot be found in record {%2ad}', curident, type) |
| ELSE |
| n := replace (makePointerRef (n, field)) |
| END |
| ELSE |
| metaError2 ('attempting to access a field {%1k} from {%2ad} which does not have a record type', curident, type) |
| END |
| ELSE |
| metaError2 ('trying to dereference {%1k} which was not declared as a pointer but a {%2tad}', n, n) |
| END % |
| |
| | % IF isPointer (type) |
| THEN |
| n := replace (makeDeRef (n)) |
| ELSE |
| metaError1 ('attempting to dereference a pointer but the expression is not a pointer but a {%1d}', type) |
| END % |
| ) |
| =: |
| |
| |
| |
| ArrayExpList := % VAR l: node ; % |
| % l := push (makeExpList ()) % |
| Expression % putExpList (l, pop ()) % |
| % assert (isExpList (peep ())) % |
| { "," |
| Expression % putExpList (l, pop ()) % |
| % assert (isExpList (peep ())) % |
| } |
| =: |
| |
| ExpList := % VAR p, n: node ; % |
| % p := peep () % |
| % assert (isExpList (p)) % |
| Expression % putExpList (p, pop ()) % |
| % assert (isExpList (peep ())) % |
| { "," Expression % putExpList (p, pop ()) % |
| % assert (isExpList (peep ())) % |
| } |
| =: |
| |
| |
| Expression := % VAR c, l, r: node ; op: toktype ; % |
| SimpleExpression % op := currenttoken % |
| [ Relation % l := pop () % |
| SimpleExpression % r := pop () % |
| % r := push (makeBinaryTok (op, l, r)) % |
| ] |
| =: |
| |
| SimpleExpression := % VAR op: toktype ; n: node ; % |
| UnaryOrTerm { % op := currenttoken % |
| % n := pop () % |
| AddOperator Term % n := push (makeBinaryTok (op, n, pop ())) % |
| } |
| =: |
| |
| UnaryOrTerm := % VAR n: node ; % |
| "+" Term % n := push (makeUnaryTok (plustok, pop ())) % |
| | "-" Term % n := push (makeUnaryTok (minustok, pop ())) % |
| | Term |
| =: |
| |
| Term := % VAR op: toktype ; n: node ; % |
| Factor { % op := currenttoken % |
| MulOperator % n := pop () % |
| Factor % n := push (makeBinaryTok (op, n, pop ())) % |
| } =: |
| |
| PushString := string % VAR n: node ; % |
| % n := push (makeString (curstring)) % |
| =: |
| |
| Factor := Number | PushString | SetOrDesignatorOrFunction | |
| "(" Expression ")" | "NOT" ( Factor % VAR n: node ; % |
| % n := push (makeUnaryTok (nottok, pop ())) % |
| | ConstAttribute |
| % n := push (makeUnaryTok (nottok, pop ())) % |
| ) =: |
| |
| ComponentElement := Expression % VAR l, h, n: node ; % |
| % l := pop () % |
| % h := NIL % |
| [ ".." Expression % h := pop () % |
| % ErrorArray ('implementation restriction range is not allowed') % |
| ] % n := push (includeSetValue (pop (), l, h)) % |
| =: |
| |
| ComponentValue := ComponentElement [ 'BY' % ErrorArray ('implementation restriction BY not allowed') % |
| Expression ] |
| =: |
| |
| ArraySetRecordValue := ComponentValue { ',' ComponentValue } |
| =: |
| |
| Constructor := '{' % VAR n: node ; % |
| % n := push (makeSetValue ()) % |
| [ ArraySetRecordValue ] |
| '}' =: |
| |
| SetOrDesignatorOrFunction := PushQualident % VAR q, p, n: node ; % |
| [ Constructor % p := pop () % |
| % q := pop () % |
| % n := push (putSetValue (p, q)) % |
| | |
| SimpleDes |
| [ % q := pop () % |
| ActualParameters % p := pop () % |
| % p := push (makeFuncCall (q, p)) % |
| ] |
| ] | |
| Constructor =: |
| |
| -- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =: |
| SimpleDes := { SubDesignator } =: |
| |
| ActualParameters := "(" % VAR n: node ; % |
| % n := push (makeExpList ()) % |
| [ ExpList ] ")" % assert (isExpList (peep ())) % |
| =: |
| |
| |
| ExitStatement := % VAR n: node ; % |
| "EXIT" |
| % IF loopNo = 0 |
| THEN |
| ErrorArray ('EXIT can only be used inside a LOOP statement') |
| ELSE |
| n := pushStmt (makeExit (peepLoop (), loopNo)) |
| END % |
| =: |
| |
| ReturnStatement := % VAR n: node ; % |
| % n := pushStmt (makeReturn ()) % |
| "RETURN" [ Expression % putReturn (n, pop ()) % |
| ] % addCommentBody (peepStmt ()) % |
| % addCommentAfter (peepStmt ()) % |
| % assert (isReturn (peepStmt ())) % |
| =: |
| |
| Statement := ( AssignmentOrProcedureCall | IfStatement | CaseStatement | |
| WhileStatement | RepeatStatement | LoopStatement | |
| ForStatement | WithStatement | AsmStatement | |
| ExitStatement | ReturnStatement | RetryStatement | % VAR s: node ; % |
| % s := pushStmt (NIL) % |
| ) |
| =: |
| |
| RetryStatement := % VAR s: node ; % |
| % s := pushStmt (makeComment ("retry")) % |
| "RETRY" |
| =: |
| |
| AssignmentOrProcedureCall := % VAR d, a, p: node ; % |
| Designator % d := pop () % |
| ( ":=" Expression % a := pushStmt (makeAssignment (d, pop ())) % |
| | |
| ActualParameters % a := pushStmt (makeFuncCall (d, pop ())) % |
| | % a := pushStmt (makeFuncCall (d, NIL)) % |
| ) |
| % addCommentBody (peepStmt ()) % |
| % addCommentAfter (peepStmt ()) % |
| =: |
| |
| -- these two break LL1 as both start with a Designator |
| -- ProcedureCall := Designator [ ActualParameters ] =: |
| -- Assignment := Designator ":=" Expression =: |
| |
| StatementSequence := % VAR s, t: node ; % |
| % s := pushStmt (makeStatementSequence ()) % |
| % assert (isStatementSequence (peepStmt ())) % |
| Statement % addStatement (s, popStmt ()) % |
| % assert (isStatementSequence (peepStmt ())) % |
| { ";" Statement % addStatement (s, popStmt ()) % |
| % assert (isStatementSequence (peepStmt ())) % |
| } |
| =: |
| |
| IfStatement := % VAR i, a, b: node ; % |
| "IF" % b := makeCommentS (getBodyComment ()) % |
| Expression % a := makeCommentS (getAfterComment ()) % |
| "THEN" StatementSequence % i := pushStmt (makeIf (pop (), popStmt ())) % |
| % addIfComments (i, b, a) % |
| { "ELSIF" % b := makeCommentS (getBodyComment ()) % |
| Expression % a := makeCommentS (getAfterComment ()) % |
| "THEN" % addElseComments (peepStmt (), b, a) % |
| StatementSequence % i := makeElsif (i, pop (), popStmt ()) % |
| } |
| [ "ELSE" |
| StatementSequence % putElse (i, popStmt ()) % |
| ] "END" % b := makeCommentS (getBodyComment ()) % |
| % a := makeCommentS (getAfterComment ()) % |
| % assert (isIf (peepStmt ())) % |
| % addIfEndComments (peepStmt (), b, a) % |
| =: |
| |
| CaseStatement := % VAR s, e: node ; % |
| % s := pushStmt (makeCase ()) % |
| "CASE" |
| Expression % s := putCaseExpression (s, pop ()) % |
| "OF" Case { "|" Case } |
| CaseEndStatement |
| =: |
| |
| CaseEndStatement := % VAR c: node ; % |
| "END" |
| | "ELSE" |
| % c := peepStmt () % |
| StatementSequence % c := putCaseElse (c, popStmt ()) % |
| "END" |
| =: |
| |
| Case := [ CaseLabelList ":" % VAR l, c: node ; % |
| % l := pop () % |
| % c := peepStmt () % |
| StatementSequence % c := putCaseStatement (c, l, popStmt ()) % |
| ] |
| =: |
| |
| CaseLabelList := % VAR l: node ; % |
| % l := push (makeCaseList ()) % |
| CaseLabels { "," CaseLabels } =: |
| |
| CaseLabels := % VAR lo, hi, l: node ; % |
| % lo := NIL ; hi := NIL % |
| % l := peep () % |
| ConstExpression % lo := pop () % |
| [ ".." ConstExpression % hi := pop () % |
| ] % l := putCaseRange (l, lo, hi) % |
| =: |
| |
| WhileStatement := % VAR s, w, e, a, b: node ; % |
| % w := pushStmt (makeWhile ()) % |
| "WHILE" Expression "DO" % b := makeCommentS (getBodyComment ()) % |
| % a := makeCommentS (getAfterComment ()) % |
| % addWhileDoComment (w, b, a) % |
| % e := pop () % |
| StatementSequence % s := popStmt () % |
| "END" % (* assert (isStatementSequence (peepStmt ())) *) % |
| % putWhile (w, e, s) % |
| % b := makeCommentS (getBodyComment ()) % |
| % a := makeCommentS (getAfterComment ()) % |
| % addWhileEndComment (w, b, a) % |
| =: |
| |
| RepeatStatement := % VAR r, s, a, b: node ; % |
| % r := pushStmt (makeRepeat ()) % |
| "REPEAT" |
| % b := makeCommentS (getBodyComment ()) % |
| % a := makeCommentS (getAfterComment ()) % |
| % addRepeatComment (r, b, a) % |
| StatementSequence % s := popStmt () % |
| "UNTIL" Expression % putRepeat (r, s, pop ()) % |
| % b := makeCommentS (getBodyComment ()) % |
| % a := makeCommentS (getAfterComment ()) % |
| % addUntilComment (r, b, a) % |
| =: |
| |
| ForStatement := % VAR f, i, s, e, b: node ; % |
| % b := NIL % |
| % f := pushStmt (makeFor ()) % |
| "FOR" Ident % i := lookupWithSym (curident) % |
| ":=" Expression % s := pop () % |
| "TO" Expression % e := pop () % |
| [ "BY" ConstExpression % b := pop () % |
| ] "DO" |
| StatementSequence % putFor (f, i, s, e, b, popStmt ()) % |
| "END" |
| =: |
| |
| LoopStatement := % VAR l, s: node ; % |
| "LOOP" % l := pushStmt (pushLoop (makeLoop ())) % |
| % INC (loopNo) % |
| StatementSequence % s := popStmt () % |
| % putLoop (l, s) % |
| % DEC (loopNo) % |
| "END" % l := popLoop () % |
| % assert (isLoop (peepStmt ())) % |
| =: |
| |
| WithStatement := "WITH" Designator "DO" % startWith (pop ()) % |
| StatementSequence |
| "END" % endWith % |
| =: |
| |
| ProcedureDeclaration := ProcedureHeading ";" ProcedureBlock |
| Ident % leaveScope % |
| =: |
| |
| ProcedureIdent := Ident % curproc := lookupSym (curident) % |
| % enterScope (curproc) % |
| % setProcedureComment (lastcomment, curident) % |
| |
| =: |
| |
| DefProcedureIdent := Ident % curproc := lookupSym (curident) % |
| =: |
| |
| DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" | "__INLINE__" ] |
| =: |
| |
| ProcedureHeading := "PROCEDURE" DefineBuiltinProcedure ( ProcedureIdent |
| [ FormalParameters ] |
| AttributeNoReturn ) |
| =: |
| |
| Builtin := [ "__BUILTIN__" | "__INLINE__" ] =: |
| |
| DefProcedureHeading := "PROCEDURE" Builtin ( DefProcedureIdent |
| [ DefFormalParameters ] |
| AttributeNoReturn ) |
| =: |
| |
| -- introduced procedure block so we can produce more informative |
| -- error messages |
| |
| ProcedureBlock := { Declaration } [ "BEGIN" ProcedureBlockBody ] "END" |
| =: |
| |
| Block := { Declaration } InitialBlock FinalBlock "END" |
| =: |
| |
| InitialBlock := [ "BEGIN" InitialBlockBody ] =: |
| |
| FinalBlock := [ "FINALLY" FinalBlockBody ] =: |
| |
| InitialBlockBody := NormalPart % putBegin (curmodule, popStmt ()) % |
| [ "EXCEPT" ExceptionalPart ] =: |
| |
| FinalBlockBody := NormalPart % putFinally (curmodule, popStmt ()) % |
| [ "EXCEPT" ExceptionalPart ] =: |
| |
| ProcedureBlockBody := ProcedureNormalPart |
| [ "EXCEPT" ExceptionalPart ] =: |
| |
| ProcedureNormalPart := StatementSequence % putBegin (curproc, popStmt ()) % |
| =: |
| |
| NormalPart := StatementSequence |
| =: |
| |
| ExceptionalPart := StatementSequence |
| =: |
| |
| Declaration := "CONST" { ConstantDeclaration ";" } | |
| "TYPE" { TypeDeclaration } | |
| "VAR" { VariableDeclaration ";" } | |
| ProcedureDeclaration ";" | |
| ModuleDeclaration ";" =: |
| |
| DefFormalParameters := "(" % paramEnter (curproc) % |
| [ DefMultiFPSection ] ")" % paramLeave (curproc) % |
| FormalReturn =: |
| |
| AttributeNoReturn := [ "<*" Ident "*>" ] =: |
| |
| AttributeUnused := [ "<*" Ident "*>" ] =: |
| |
| DefMultiFPSection := DefExtendedFP | FPSection [ ";" DefMultiFPSection ] =: |
| |
| FormalParameters := "(" % paramEnter (curproc) % |
| [ MultiFPSection ] ")" % paramLeave (curproc) % |
| FormalReturn =: |
| |
| MultiFPSection := ExtendedFP | FPSection [ ";" MultiFPSection ] =: |
| |
| FPSection := NonVarFPSection | VarFPSection =: |
| |
| DefExtendedFP := DefOptArg | "..." =: |
| |
| ExtendedFP := OptArg | "..." =: |
| |
| VarFPSection := "VAR" IdentList ":" FormalType [ AttributeUnused ] |
| =: |
| |
| NonVarFPSection := IdentList ":" FormalType [ AttributeUnused ] |
| =: |
| |
| OptArg := "[" Ident ":" FormalType [ "=" ConstExpressionNop ] "]" =: |
| |
| DefOptArg := "[" Ident ":" FormalType "=" ConstExpressionNop "]" =: |
| |
| FormalType := { "ARRAY" "OF" } Qualident =: |
| |
| ModuleDeclaration := "MODULE" Ident [ Priority ] ";" |
| { Import } [ Export ] |
| Block Ident |
| =: |
| |
| Priority := "[" ConstExpressionNop "]" =: |
| |
| Export := "EXPORT" ( "QUALIFIED" |
| IdentList | |
| "UNQUALIFIED" |
| IdentList | |
| IdentList ) ";" =: |
| |
| FromIdentList := Ident { "," Ident } =: |
| |
| FromImport := "FROM" Ident "IMPORT" FromIdentList ";" |
| =: |
| |
| ImportModuleList := Ident { "," Ident } =: |
| |
| WithoutFromImport := "IMPORT" ImportModuleList ";" |
| =: |
| |
| Import := FromImport | WithoutFromImport =: |
| |
| DefinitionModule := "DEFINITION" "MODULE" [ "FOR" string ] Ident ";" % curmodule := lookupDef (curident) % |
| % enterScope (curmodule) % |
| { Import } [ Export ] |
| { Definition } |
| "END" Ident "." % checkEndName (curmodule, curident, 'definition module') % |
| % leaveScope % |
| =: |
| |
| PushQualident := % VAR type, field: node ; % |
| Ident % qualid := push (lookupWithSym (curident)) % |
| % IF qualid = NIL |
| THEN |
| metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident) |
| END % |
| [ "." |
| % IF NOT isQualident (qualid) |
| THEN |
| ErrorArray ('the first component of this qualident must be a definition module or a parameter/variable/constant which has record type') |
| END % |
| Ident % IF isDef (qualid) |
| THEN |
| qualid := replace (lookupInScope (qualid, curident)) |
| ELSE |
| type := skipType (getType (qualid)) ; |
| field := lookupInScope (type, curident) ; |
| IF field = NIL |
| THEN |
| metaError2 ('field {%1k} cannot be found in {%2ad}', curident, qualid) |
| ELSE |
| qualid := replace (makeComponentRef (qualid, field)) |
| END |
| END ; |
| IF qualid = NIL |
| THEN |
| metaError1 ('qualified component of the identifier {%1k} cannot be found', curident) |
| END % |
| ] |
| =: |
| |
| OptSubrange := [ SubrangeType ] =: |
| |
| TypeEquiv := Qualident OptSubrange =: |
| |
| EnumIdentList := Ident { "," Ident } =: |
| |
| Enumeration := "(" EnumIdentList ")" =: |
| |
| SimpleType := TypeEquiv | Enumeration | SubrangeType =: |
| |
| Type := SimpleType | ArrayType | RecordType | SetType | |
| PointerType | ProcedureType |
| =: |
| |
| TypeDeclaration := { Ident ( ";" | "=" Type Alignment ";" ) } |
| =: |
| |
| Definition := "CONST" { ConstantDeclaration ";" } | |
| "TYPE" { TypeDeclaration } | |
| "VAR" { VariableDeclaration ";" } | |
| DefProcedureHeading ";" =: |
| |
| AsmStatement := % VAR s: node ; % |
| % s := pushStmt (makeComment ("asm")) % |
| 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =: |
| |
| AsmOperands := string [ AsmOperandSpec ] |
| =: |
| |
| AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ] |
| =: |
| |
| AsmList := [ AsmElement ] { ',' AsmElement } =: |
| |
| NamedOperand := '[' Ident ']' =: |
| |
| AsmOperandName := [ NamedOperand ] |
| =: |
| |
| AsmElement := AsmOperandName string '(' Expression ')' |
| =: |
| |
| TrashList := [ string ] { ',' string } =: |
| |
| FNB |
