├── .gitattributes ├── ASCII.def ├── AST.def ├── AstNodeType.def ├── AstQueue.def ├── BuildParams.def ├── DepGraph.def ├── FileSystem.def ├── Fileutils.def ├── LexQueue.def ├── Lexer.def ├── MatchLex.def ├── ModuleKey.def ├── NonTerminals.def ├── Parser.def ├── Pathnames.def ├── README.md ├── SimpleFileIO.def ├── Source.def ├── String.def ├── Symbol.def ├── Token.def ├── TokenSet.def ├── imp ├── ASCII.mod ├── Lexer.mod ├── MatchLex.mod ├── SimpleFileIO.mod ├── Source.mod └── Token.mod └── m2r10-grammar.gll /.gitattributes: -------------------------------------------------------------------------------- 1 | *.def linguist-language=modula-2 2 | -------------------------------------------------------------------------------- /ASCII.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE ASCII; 4 | 5 | (* Mnemonics and Tests for 7-bit ISO-646 code points *) 6 | 7 | 8 | (* Control Codes *) 9 | 10 | CONST 11 | NUL = 0u0; 12 | SOH = 0u01; 13 | STX = 0u02; 14 | ETX = 0u03; 15 | EOL = 0u04; 16 | ENQ = 0u05; 17 | ACK = 0u06; 18 | BEL = 0u07; 19 | BS = 0u08; 20 | HT = 0u09; 21 | LF = 0u0A; 22 | VT = 0u0B; 23 | FF = 0u0C; 24 | CR = 0u0D; 25 | SO = 0u0E; 26 | SI = 0u0F; 27 | DLE = 0u10; 28 | DC1 = 0u11; 29 | DC2 = 0u12; 30 | DC3 = 0u13; 31 | DC4 = 0u14; 32 | NAK = 0u15; 33 | SYN = 0u16; 34 | ETB = 0u17; 35 | CAN = 0u18; 36 | EM = 0u19; 37 | SUB = 0u1A; 38 | ESC = 0u1B; 39 | FS = 0u1C; 40 | GS = 0u1D; 41 | RS = 0u1E; 42 | US = 0u1F; 43 | DEL = 0u7F; 44 | 45 | 46 | (* Whitespace *) 47 | 48 | SP = 0u20; 49 | 50 | 51 | (* Digits *) 52 | 53 | DIGIT_ZERO = 0u30; 54 | DIGIT_ONE = 0u31; 55 | DIGIT_TWO = 0u32; 56 | DIGIT_THREE = 0u33; 57 | DIGIT_FOUR = 0u34; 58 | DIGIT_FIVE = 0u35; 59 | DIGIT_SIX = 0u36; 60 | DIGIT_SEVEN = 0u37; 61 | DIGIT_EIGHT = 0u38; 62 | DIGIT_NINE = 0u39; 63 | 64 | 65 | (* Letters *) 66 | 67 | SMALL_LETTER_A = 0u61; 68 | SMALL_LETTER_B = 0u62; 69 | SMALL_LETTER_C = 0u63; 70 | SMALL_LETTER_D = 0u64; 71 | SMALL_LETTER_E = 0u65; 72 | SMALL_LETTER_F = 0u66; 73 | SMALL_LETTER_G = 0u67; 74 | SMALL_LETTER_H = 0u68; 75 | SMALL_LETTER_I = 0u69; 76 | SMALL_LETTER_J = 0u6A; 77 | SMALL_LETTER_K = 0u6B; 78 | SMALL_LETTER_L = 0u6C; 79 | SMALL_LETTER_M = 0u6D; 80 | SMALL_LETTER_N = 0u6E; 81 | SMALL_LETTER_O = 0u6F; 82 | SMALL_LETTER_P = 0u70; 83 | SMALL_LETTER_Q = 0u71; 84 | SMALL_LETTER_R = 0u72; 85 | SMALL_LETTER_S = 0u73; 86 | SMALL_LETTER_T = 0u74; 87 | SMALL_LETTER_U = 0u75; 88 | SMALL_LETTER_V = 0u76; 89 | SMALL_LETTER_W = 0u77; 90 | SMALL_LETTER_X = 0u78; 91 | SMALL_LETTER_Y = 0u79; 92 | SMALL_LETTER_Z = 0u7A; 93 | 94 | CAPITAL_LETTER_A = 0u41; 95 | CAPITAL_LETTER_B = 0u42; 96 | CAPITAL_LETTER_C = 0u43; 97 | CAPITAL_LETTER_D = 0u44; 98 | CAPITAL_LETTER_E = 0u45; 99 | CAPITAL_LETTER_F = 0u46; 100 | CAPITAL_LETTER_G = 0u47; 101 | CAPITAL_LETTER_H = 0u48; 102 | CAPITAL_LETTER_I = 0u49; 103 | CAPITAL_LETTER_J = 0u4A; 104 | CAPITAL_LETTER_K = 0u4B; 105 | CAPITAL_LETTER_L = 0u4C; 106 | CAPITAL_LETTER_M = 0u4D; 107 | CAPITAL_LETTER_N = 0u4E; 108 | CAPITAL_LETTER_O = 0u4F; 109 | CAPITAL_LETTER_P = 0u50; 110 | CAPITAL_LETTER_Q = 0u51; 111 | CAPITAL_LETTER_R = 0u52; 112 | CAPITAL_LETTER_S = 0u53; 113 | CAPITAL_LETTER_T = 0u54; 114 | CAPITAL_LETTER_U = 0u55; 115 | CAPITAL_LETTER_V = 0u56; 116 | CAPITAL_LETTER_W = 0u57; 117 | CAPITAL_LETTER_X = 0u58; 118 | CAPITAL_LETTER_Y = 0u59; 119 | CAPITAL_LETTER_Z = 0u5A; 120 | 121 | 122 | (* Non-Alphanumeric *) 123 | 124 | EXCLAMATION_MARK = 0u21; 125 | QUOTATION_MARK = 0u22; 126 | NUMBER_SIGN = 0u23; 127 | DOLLAR_SIGN = 0u24; 128 | PERCENT_SIGN = 0u25; 129 | AMPERSAND = 0u26; 130 | APOSTROPHE = 0u27; 131 | LEFT_PARENTHESIS = 0u28; 132 | RIGHT_PARENTHESIS = 0u29; 133 | ASTERISK = 0u2A; 134 | PLUS = 0u2B; 135 | COMMA = 0u2C; 136 | HYPHEN_MINUS = 0u2D; 137 | FULLSTOP = 0u2E; 138 | SOLIDUS = 0u2F; 139 | COLON = 0u3A; 140 | SEMICOLON = 0u3B; 141 | LESS_THAN_SIGN = 0u3C; 142 | EQUALS_SIGN = 0u3D; 143 | GREATER_THAN_SIGN = 0u3E; 144 | QUESTION_MARK = 0u3F; 145 | COMMERCIAL_AT = 0u40; 146 | LEFT_SQUARE_BRACKET = 0u5B; 147 | REVERSE_SOLIDUS = 0u5C; 148 | RIGHT_SQUARE_BRACKET = 0u5D; 149 | CIRCUMFLEX_ACCENT = 0u5E; 150 | LOW_LINE = 0u5F; 151 | GRAVE_ACCENT = 0u60; 152 | LEFT_CURLY_BRACKET = 0u7B; 153 | VERTICAL_LINE = 0u7C; 154 | RIGHT_CURLY_BRACKET = 0u7D; 155 | TILDE = 0u7E; 156 | 157 | 158 | (* Aliases *) 159 | 160 | NEWLINE = LF; 161 | 162 | TAB = HT; 163 | 164 | SPACE = SP; 165 | 166 | EXCLAMATION = EXCLAMATION_MARK; 167 | QUOTATION = QUOTATION_MARK; 168 | SINGLEQUOTE = APOSTROPHE; 169 | DOUBLEQUOTE = QUOTATION_MARK; 170 | OCTOTHORPE = NUMBER_SIGN; 171 | MINUS = HYPHEN_MINUS; 172 | SLASH = SOLIDUS; 173 | LESS = LESS_THAN_SIGN; 174 | EQUALS = EQUALS_SIGN; 175 | GREATER = GREATER_THAN_SIGN; 176 | QMARK = QUESTION_MARK; 177 | BACKSLASH = REVERSE_SOLIDUS; 178 | CARET = CIRCUMFLEX_ACCENT; 179 | BACKQUOTE = GRAVE_ACCENT; 180 | 181 | LPAREN = LEFT_PARENTHESIS; 182 | RPAREN = RIGHT_PARENTHESIS; 183 | LBRACKET = LEFT_SQUARE_BRACKET; 184 | RBRACKET = RIGHT_SQUARE_BRACKET; 185 | LBRACE = LEFT_CURLY_BRACKET; 186 | RBRACE = RIGHT_CURLY_BRACKET; 187 | 188 | 189 | (* Operations *) 190 | 191 | PROCEDURE isControl ( ch : CHAR ) : BOOLEAN; 192 | (* Returns TRUE if ch is a control code, otherwise FALSE. *) 193 | 194 | PROCEDURE isDigit ( ch : CHAR ) : BOOLEAN; 195 | (* Returns TRUE if ch is a digit, otherwise FALSE. *) 196 | 197 | PROCEDURE isLetter ( ch : CHAR ) : BOOLEAN; 198 | (* Returns TRUE if ch is a letter, otherwise FALSE. *) 199 | 200 | PROCEDURE isAlphaNum ( ch : CHAR ) : BOOLEAN; 201 | (* Returns TRUE if ch is alpha-numeric, otherwise FALSE. *) 202 | 203 | PROCEDURE isUpper ( ch : CHAR ) : BOOLEAN; 204 | (* Returns TRUE if ch is an uppercase letter, otherwise FALSE. *) 205 | 206 | PROCEDURE isLower ( ch : CHAR ) : BOOLEAN; 207 | (* Returns TRUE if ch is a lowercase letter, otherwise FALSE. *) 208 | 209 | PROCEDURE toUpper ( VAR ch : CHAR ); 210 | (* Passes back the uppercase equivalent of ch if ch is a lowercase letter. *) 211 | 212 | PROCEDURE toLower ( VAR ch : CHAR ); 213 | (* Passes back the lowercase equivalent of ch if ch is an uppercase letter. *) 214 | 215 | 216 | END ASCII. -------------------------------------------------------------------------------- /AST.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE AST; 4 | 5 | (* AST for Modula-2 R10 Core Compiler *) 6 | 7 | IMPORT AstQueue, LexQueue; 8 | 9 | 10 | TYPE AST = OPAQUE; 11 | 12 | (* Constructors *) 13 | 14 | PROCEDURE NewNode 15 | ( VAR ast : AST; nodeType : AstNodeType; subnodes : ARGLIST OF AST ); 16 | (* Allocates a new branch node of the given node type, stores the subnodes of 17 | the argument list in the node and passes back node, or NIL on failure. *) 18 | 19 | PROCEDURE NewListNode 20 | ( VAR ast : AST; nodeType : AstNodeType; subnodes : AstQueue ); 21 | (* Allocates a new branch node of the given node type, stores the subnodes of 22 | * the given node queue in the node and passes back node, or NIL on failure. *) 23 | 24 | PROCEDURE NewTerminalNode 25 | ( VAR ast : AST; nodeType : AstNodeType; value : Lexeme ); 26 | (* Allocates a new terminal node of the given node type, stores the given 27 | value in the node and passes back node, or NIL on failure. *) 28 | 29 | PROCEDURE NewTerminalListNode 30 | ( VAR ast : AST; nodeType : AstNodeType; values : LexQueue ); 31 | (* Allocates a new terminal node of the given node type, stores the values of 32 | the given value queue in the node and passes node, or NIL on failure. *) 33 | 34 | 35 | (* Destructor *) 36 | 37 | PROCEDURE Release ( VAR ast : AST ); 38 | (* Releases ast and passes back NIL if successful. *) 39 | 40 | 41 | (* Operations *) 42 | 43 | PROCEDURE nodeType ( node : AST ) : AstNodeType; 44 | (* Returns the node type of node, or AST.Invalid if node is NIL. *) 45 | 46 | PROCEDURE subnodeCount ( node : AST ) : CARDINAL; 47 | (* Returns the number of subnodes or values of node. *) 48 | 49 | PROCEDURE subnodeForIndex ( node : AST; index : CARDINAL ) : AST; 50 | (* Returns the subnode of node with the given index or NIL if no subnode of 51 | the given index is stored in node. *) 52 | 53 | PROCEDURE valueForIndex ( node : AST; index : CARDINAL ) : Lexeme; 54 | (* Returns the value stored at the given index in a terminal node, 55 | * or NIL if the node does not store any value at the given index. *) 56 | 57 | PROCEDURE value ( node : AST ) : Lexeme; 58 | (* Calls function valueForIndex with an index of zero. *) 59 | 60 | PROCEDURE replaceSubnode 61 | ( node : AST; atIndex : CARDINAL; withSubnode : AST ) : AST; 62 | (* Replaces a subnode and returns the replaced node, or NIL on failure. *) 63 | 64 | PROCEDURE replaceValue 65 | ( node : AST; atIndex : CARDINAL; withValue : Lexeme ) : Lexeme; 66 | (* Replaces a subnode and returns the replaced value, or NIL on failure. *) 67 | 68 | 69 | END AST. -------------------------------------------------------------------------------- /AstNodeType.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE AstNodeType; 4 | 5 | (* AST Node Type Definitions for Modula-2 R10 Core Compiler *) 6 | 7 | TYPE AstNodeType = 8 | ( Invalid, 9 | 10 | (* Empty Node Type *) 11 | 12 | Empty, 13 | 14 | (* Root Node Type *) 15 | 16 | Root, 17 | 18 | (* Definition Module Non-Terminal Node Types *) 19 | 20 | DefMod, (* definition module node type *) 21 | ImpList, (* qualified import list node type *) 22 | Import, (* qualified import list node type *) 23 | DefList, (* definition list node type *) 24 | 25 | ConstDef, (* constant definition node type *) 26 | TypeDef, (* type definition node type *) 27 | ProcDef, (* procedure definition node type *) 28 | 29 | Subr, (* subrange type node type *) 30 | Enum, (* enumeration type node type *) 31 | Set, (* set type node type *) 32 | Array, (* array type node type *) 33 | Record, (* simple record type node type *) 34 | Pointer, (* pointer type node type *) 35 | Proctype, (* procedure type node type *) 36 | 37 | ExtRec, (* extensible record type node type *) 38 | 39 | IndexList, (* array index type list node type *) 40 | 41 | FieldListSeq, (* field list sequence node type *) 42 | FieldList, (* field list node type *) 43 | CLabelList, (* case label list node type *) 44 | Clabels, (* case labels node type *) 45 | 46 | FTypeList, (* formal type list node type *) 47 | ArgList, (* variadic parameter list formal type node type *) 48 | OpenArray, (* open array formal type node type *) 49 | ConstP, (* CONST formal type node type *) 50 | VarP, (* VAR formal type node type *) 51 | FParamList, (* formal parameter list node type *) 52 | FParams, (* formal parameters node type *) 53 | 54 | (* Implementation/Program Module AST Node Types *) 55 | 56 | ImpMod, (* implementation/program module node type *) 57 | Block, (* block node type *) 58 | DeclList, (* declaration list node type *) 59 | 60 | TypeDecl, (* type declaration node type *) 61 | VarDecl, (* variable declaration node type *) 62 | Proc, (* procedure declaration node type *) 63 | ModDecl, (* local module declaration node type *) 64 | 65 | VSR, (* variable size record type node type *) 66 | VSField, (* variable size field node type *) 67 | 68 | StmtSeq, (* statement sequence node type *) 69 | 70 | Assign, (* assignment node type *) 71 | PCall, (* procedure call node type *) 72 | Return, (* RETURN statement node type *) 73 | IF, (* IF statement node type *) 74 | Switch, (* CASE statement node type *) 75 | Loop, (* LOOP statement node type *) 76 | While, (* WHILE statement node type *) 77 | Repeat, (* REPEAT statement node type *) 78 | For, (* FOR IN statement node type *) 79 | Exit, (* EXIT statement node type *) 80 | 81 | Args, (* actual parameter list node type *) 82 | 83 | ElsifSeq, (* ELSIF branch sequence node type *) 84 | Elsif, (* ELSIF branch node type *) 85 | CaseList, (* case list node type *) 86 | Case, (* case branch node type *) 87 | ElemList, (* element list node type *) 88 | Range, (* expression range node type *) 89 | 90 | (* Designator Subnode Types *) 91 | 92 | Field, (* record field selector node type *) 93 | Index, (* array subscript node type *) 94 | 95 | (* Expression Node Types *) 96 | 97 | Desig, (* designator node type *) 98 | Deref, (* pointer dereference node type *) 99 | 100 | Neg, (* arithmetic negation sub-expression node *) 101 | Not, (* logical negation sub-expression node *) 102 | 103 | Eq, (* equality sub-expression node *) 104 | NEq, (* inequality sub-expression node *) 105 | Lt, (* less-than sub-expression node *) 106 | LtEq, (* less-than-or-equal sub-expression node *) 107 | Gt, (* greater-than sub-expression node *) 108 | GtEq, (* greater-than-or-equal sub-expression node *) 109 | In, (* set membership sub-expression node *) 110 | Plus, (* plus sub-expression node *) 111 | Minus, (* minus sub-expression node *) 112 | Or, (* logical disjunction sub-expression node *) 113 | Star, (* asterisk sub-expression node *) 114 | Slash, (* solidus sub-expression node *) 115 | Div, (* euclidean division sub-expression node *) 116 | Mod, (* modulus sub-expression node *) 117 | And, (* logical conjunction expression node *) 118 | 119 | FCall, (* function call node *) 120 | SetVal, (* set value node *) 121 | 122 | (* Identifier Node Types *) 123 | 124 | Ident, (* identifier node type *) 125 | Qualident, (* qualified identifier node type *) 126 | 127 | (* Literal Value Node Types *) 128 | 129 | IntVal, (* whole number value node *) 130 | RealVal, (* real number value node *) 131 | ChrVal, (* character code value node *) 132 | QuotedVal, (* quoted literal value node *) 133 | 134 | IdentList, (* identifier list node type *) 135 | 136 | (* Compilation Parameter Node Types *) 137 | 138 | Filename, (* filename node type *) 139 | Options); (* compiler option list node type *) 140 | 141 | 142 | (* Introspection *) 143 | 144 | PROCEDURE isValid ( t : AstNodeType ) : BOOLEAN; 145 | (* Returns TRUE if t is a valid node type, otherwise FALSE. *) 146 | 147 | PROCEDURE isNonTerminal ( t : AstNodeType ) : BOOLEAN; 148 | (* Returns TRUE if t is a non-terminal node type, otherwise FALSE. *) 149 | 150 | PROCEDURE isTerminal ( t : AstNodeType ) : BOOLEAN; 151 | (* Returns TRUE if t is a terminal node type, otherwise FALSE. *) 152 | 153 | PROCEDURE isNonTerminalList ( t : AstNodeType ) : BOOLEAN; 154 | (* Returns TRUE if t is a non-terminal list node type, otherwise FALSE. *) 155 | 156 | PROCEDURE isTerminalList ( t : AstNodeType ) : BOOLEAN; 157 | (* Returns TRUE if t is a terminal list node type, otherwise FALSE. *) 158 | 159 | PROCEDURE isLegalSubnodeCount 160 | ( t : AstNodeType; count : CARDINAL ) : BOOLEAN; 161 | (* Returns TRUE if the given subnode count is legal for node type t, 162 | otherwise FALSE. *) 163 | 164 | PROCEDURE isLegalSubnodeType 165 | ( t, subnodeType : AstNodeType; atIndex : CARDINAL) : BOOLEAN; 166 | (* Returns TRUE if the given subnode type is legal at the given index 167 | for node type t, otherwise FALSE. *) 168 | 169 | PROCEDURE nameForNodeType ( t : AstNodeType ) : String; 170 | (* Returns a human readable name for node type t. *) 171 | 172 | 173 | END AstNodeType. -------------------------------------------------------------------------------- /AstQueue.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE AstQueue; 4 | 5 | (* AST Node Queue for Modula-2 R10 Core Compiler *) 6 | 7 | IMPORT AST; 8 | 9 | 10 | TYPE AstQueue = OPAQUE; 11 | 12 | (* Constructor *) 13 | 14 | PROCEDURE New ( VAR queue : AstQueue ); 15 | (* Allocates a new empty queue object and passes it back in queue. 16 | Passes NIL if the allocation failed. *) 17 | 18 | 19 | (* Destructor *) 20 | 21 | PROCEDURE Release ( VAR queue : AstQueue ); 22 | (* Releases queue and passes back NIL if successful. *) 23 | 24 | 25 | (* Operations *) 26 | 27 | PROCEDURE enqueue ( queue : AstQueue; node : AST ) : Queue; 28 | (* Adds node to the head of queue and returns queue, or NIL on failure. *) 29 | 30 | PROCEDURE enqueueUnique ( queue : AstQueue; node : AST ) : Queue; 31 | (* Adds node to the head of queue if and only if the value is not already 32 | * present in queue. Returns queue on success, or NIL on failure. *) 33 | 34 | PROCEDURE dequeue ( queue : AstQueue ) : AST; 35 | (* Removes the node at the tail of queue and returns it, or NIL on failure. *) 36 | 37 | PROCEDURE isEmpty ( queue : AstQueue ) : BOOLEAN; 38 | (* Returns TRUE if queue is empty, otherwise FALSE. *) 39 | 40 | PROCEDURE isElem ( queue : AstQueue; node : AST ) : BOOLEAN; 41 | (* Returns TRUE if node is stored in queue, otherwise FALSE. *) 42 | 43 | PROCEDURE count ( queue : AstQueue ) : CARDINAL; 44 | (* Returns the number of nodes in queue. *) 45 | 46 | PROCEDURE Reset ( queue : AstQueue ) : AST; 47 | (* Removes all nodes from queue but does not deallocate it. 48 | Returns queue on success, or NIL if queue is NIL. *) 49 | 50 | 51 | END AstQueue. -------------------------------------------------------------------------------- /BuildParams.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE BuildParams; 4 | 5 | (* Build Parameters for Modula-2 R10 Bootstrap Compiler *) 6 | 7 | 8 | (* In-File Parameters *) 9 | 10 | CONST 11 | MaxInFileSize = 65536; 12 | MaxInFileLines = 12000; 13 | MaxInFileColumns = 160; 14 | 15 | TYPE 16 | LineCounter = [0 .. MaxInFileLines-1] OF CARDINAL; 17 | ColumnCounter = [0 .. MaxInFileColums-1] OF CARDINAL; 18 | 19 | 20 | (* Lexical Parameters *) 21 | 22 | CONST 23 | MaxIdentLength = 32; 24 | MaxNumberLength = 32; 25 | MaxStringLength = 160; 26 | MaxCommentLength = 4096; 27 | 28 | 29 | END BuildParams. -------------------------------------------------------------------------------- /DepGraph.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2016 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE DepGraph; 4 | 5 | (* Dependency Graph for Modula-2 R10 Core Compiler *) 6 | 7 | IMPORT Source; 8 | IMPORT Lexeme; 9 | 10 | 11 | (* Dependency Graph Type *) 12 | 13 | TYPE DepGraph = OPAQUE; 14 | 15 | 16 | (* Iterator Procedure Type *) 17 | 18 | TYPE IteratorBody = PROCEDURE ( Lexeme ); 19 | 20 | 21 | (* Operations *) 22 | 23 | PROCEDURE New ( VAR graph : DepGraph; forSource : Source ); 24 | (* Allocates a new branch node of the given node type, stores the subnodes of 25 | the argument list in the node and passes back node, or NIL on failure. *) 26 | 27 | PROCEDURE count ( graph : DepGraph ) : CARDINAL; 28 | (* Returns the number of entries in graph. *) 29 | 30 | PROCEDURE isDependent 31 | ( graph : DepGraph; module1, module2 : Lexeme ) : BOOLEAN; 32 | (* Returns TRUE if module1 depends on module2, otherwise FALSE. *) 33 | 34 | PROCEDURE isMutuallyDependent 35 | ( graph : DepGraph; module1, module2 : Lexeme ) : BOOLEAN; 36 | (* Returns TRUE if module1 and module2 are mutually dependent, else FALSE. *) 37 | 38 | PROCEDURE Iterate ( graph : DepGraph; p : IteratorBody ); 39 | (* Calls p for every module in graph, passing the module identifier to p. *) 40 | 41 | PROCEDURE Release ( VAR graph : DepGraph ); 42 | (* Releases graph and passes back NIL if successful. *) 43 | 44 | 45 | END DepGraph. -------------------------------------------------------------------------------- /FileSystem.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE FileSystem; 4 | 5 | (* File System Access library *) 6 | 7 | 8 | TYPE Access = ( Read, Write, Execute ); 9 | 10 | TYPE AccessFlags = SET OF Access; 11 | 12 | TYPE Permissions = RECORD 13 | owner, group, world : AccessFlags; 14 | END; 15 | 16 | TYPE Timestamp = RECORD 17 | year : [1970..9999] OF CARDINAL; 18 | month : [1..12] OF CARDINAL; 19 | day : [1..31] OF CARDINAL; 20 | hour : [0..23] OF CARDINAL; 21 | minute, 22 | second : [0..59] OF CARDINAL; 23 | millisec : [0..999] OF CARDINAL 24 | END; 25 | 26 | 27 | (* Operations *) 28 | 29 | PROCEDURE fileExists ( CONST path : ARRAY OF CHAR ) : BOOLEAN; 30 | 31 | PROCEDURE isDirectory ( CONST path : ARRAY OF CHAR ) : BOOLEAN; 32 | 33 | PROCEDURE GetFileSize 34 | ( CONST path : ARRAY OF CHAR; VAR size : LONGCARD; VAR s : Status ); 35 | 36 | PROCEDURE GetPermissions 37 | ( CONST path : ARRAY OF CHAR; VAR p : Permissions; VAR s : Status ); 38 | 39 | PROCEDURE GetCreationTimeStamp 40 | ( CONST path : ARRAY OF CHAR; VAR ts : Timestamp; VAR s : Status ); 41 | 42 | PROCEDURE GetModificationTimeStamp 43 | ( CONST path : ARRAY OF CHAR; VAR ts : Timestamp; VAR s : Status ); 44 | 45 | PROCEDURE CreateFile ( CONST path : ARRAY OF CHAR; VAR s : Status ); 46 | 47 | PROCEDURE RemoveFile ( CONST path : ARRAY OF CHAR; VAR s : Status ); 48 | 49 | PROCEDURE CreateDir ( CONST path : ARRAY OF CHAR; VAR s : Status ); 50 | 51 | PROCEDURE RemoveDir ( CONST path : ARRAY OF CHAR; VAR s : Status ); 52 | 53 | 54 | END FileSystem. -------------------------------------------------------------------------------- /Fileutils.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Fileutils; 4 | 5 | (* File Utility Interface for Modula-2 R10 Core Compiler *) 6 | 7 | (* -------------------------------------------------------------------------- 8 | * function fileExists(path) 9 | * -------------------------------------------------------------------------- 10 | * Returns TRUE if path is a valid pathname to an existing file system entry, 11 | * otherwise FALSE. 12 | * -------------------------------------------------------------------------- 13 | *) 14 | PROCEDURE fileExists ( CONST path : ARRAY OF CHAR ) : BOOLEAN; 15 | 16 | 17 | (* -------------------------------------------------------------------------- 18 | * function isDirectory(path) 19 | * -------------------------------------------------------------------------- 20 | * Returns TRUE if path is a valid pathname to an existing directory, 21 | * otherwise FALSE. 22 | * -------------------------------------------------------------------------- 23 | *) 24 | PROCEDURE isDirectory ( CONST path : ARRAY OF CHAR ) : BOOLEAN; 25 | 26 | 27 | (* -------------------------------------------------------------------------- 28 | * function isRegularFile(path) 29 | * -------------------------------------------------------------------------- 30 | * Returns TRUE if path is a valid pathname to an existing regular file, 31 | * otherwise FALSE. 32 | * -------------------------------------------------------------------------- 33 | *) 34 | PROCEDURE isRegularFile ( CONST path : ARRAY OF CHAR ) : BOOLEAN; 35 | 36 | 37 | (* -------------------------------------------------------------------------- 38 | * procedure getFileSize(path, valid, size) 39 | * -------------------------------------------------------------------------- 40 | * Tests if path is a valid pathname indicating an existing regular file and 41 | * if so, passes TRUE in out-parameter valid and the file's size in out-para- 42 | * meter size. Otherwise it passes FALSE in out-parameter valid and leaves 43 | * out-parameter size unmodified. 44 | * -------------------------------------------------------------------------- 45 | *) 46 | PROCEDURE GetFileSize 47 | ( CONST path : ARRAY OF CHAR; VAR valid : BOOLEAN; VAR size : LONGCARD ); 48 | 49 | 50 | (* -------------------------------------------------------------------------- 51 | * procedure GetFileTime(path, valid, time) 52 | * -------------------------------------------------------------------------- 53 | * Tests if path is a valid pathname indicating an existing regular file and 54 | * if so, it passes TRUE in out-parameter valid and the file's last modifica- 55 | * tion time to out-parameter time. Otherwise it passes FALSE in out-para- 56 | * meter valid and leaves out-parameter time unmodified. 57 | * -------------------------------------------------------------------------- 58 | *) 59 | PROCEDURE GetFileTime 60 | ( CONST path : ARRAY OF CHAR; VAR valid : BOOLEAN; VAR time : LONGINT ); 61 | 62 | 63 | (* -------------------------------------------------------------------------- 64 | * procedure NewPathWithCurrentWorkdir(path) 65 | * -------------------------------------------------------------------------- 66 | * Returns a newly allocated NUL terminated character string containing the 67 | * absolute path of the current working directory. Returns NIL on failure. 68 | * -------------------------------------------------------------------------- 69 | *) 70 | PROCEDURE newPathWithCurrentWorkdir : String; 71 | 72 | 73 | END Fileutils. -------------------------------------------------------------------------------- /LexQueue.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE LexQueue; 4 | 5 | (* Lexeme Queue for Modula-2 R10 Core Compiler *) 6 | 7 | IMPORT Lexeme; 8 | 9 | 10 | TYPE LexQueue = OPAQUE; 11 | 12 | (* Constructor *) 13 | 14 | PROCEDURE New ( VAR queue : LexQueue ); 15 | (* Allocates a new empty queue object and passes it back in queue. 16 | Passes NIL if the allocation failed. *) 17 | 18 | 19 | (* Destructor *) 20 | 21 | PROCEDURE Release ( VAR queue : LexQueue ); 22 | (* Releases queue and passes back NIL if successful. *) 23 | 24 | 25 | (* Operations *) 26 | 27 | PROCEDURE enqueue ( queue : LexQueue; lexeme : Lexeme ) : Queue; 28 | (* Adds lexeme to the head of queue and returns queue, or NIL on failure. *) 29 | 30 | PROCEDURE enqueueUnique ( queue : LexQueue; lexeme : Lexeme ) : Queue; 31 | (* Adds lexeme to the head of queue if and only if the value is not already 32 | * present in queue. Returns queue on success, or NIL on failure. *) 33 | 34 | PROCEDURE dequeue ( queue : LexQueue ) : Lexeme; 35 | (* Removes the lexeme at the tail queue and returns it, or NIL on failure. *) 36 | 37 | PROCEDURE isEmpty ( queue : LexQueue ) : BOOLEAN; 38 | (* Returns TRUE if queue is empty, otherwise FALSE. *) 39 | 40 | PROCEDURE isElem ( queue : LexQueue; lexeme : Lexeme ) : BOOLEAN; 41 | (* Returns TRUE if node is stored in queue, otherwise FALSE. *) 42 | 43 | PROCEDURE count ( queue : LexQueue ) : CARDINAL; 44 | (* Returns the number of nodes in queue. *) 45 | 46 | PROCEDURE Reset ( queue : LexQueue ) : AST; 47 | (* Removes all nodes from queue but does not deallocate it. 48 | Returns queue on success, or NIL if queue is NIL. *) 49 | 50 | 51 | END LexQueue. -------------------------------------------------------------------------------- /Lexer.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Lexer; 4 | 5 | (* Lexer for Modula-2 R10 Core Compiler *) 6 | 7 | 8 | IMPORT Symbol, Filename; 9 | 10 | 11 | (* Lexer Type *) 12 | 13 | TYPE Lexer = OPAQUE; 14 | 15 | 16 | (* Lexer Status *) 17 | 18 | TYPE Status = 19 | ( Success, 20 | AlreadyInitialised, 21 | UnableToAllocate, 22 | IllegalSymbolFound, 23 | UnescapedBackslash, 24 | IllegalCharInCharOrString, 25 | EndOfLineInCharOrString, 26 | LexemeCapacityExceded, 27 | CommentNestingLimitExceded, 28 | PrematureEndOfFile ); 29 | 30 | 31 | (* Constructor *) 32 | 33 | PROCEDURE New ( VAR lexer : Lexer; filename : Filename; VAR s : Status ); 34 | (* Create newly allocated and initialised lexer instance associated with 35 | source file filename. Passes back the status of the operation in s. *) 36 | 37 | 38 | (* Destructor *) 39 | 40 | PROCEDURE Release ( VAR lexer : Lexer ); 41 | (* Release lexer instance. Passes back NIL in lexer if successful. *) 42 | 43 | 44 | (* Static Methods *) 45 | 46 | PROCEDURE GetSym ( self : Lexer; VAR current, next : Symbol ); 47 | (* Passes back the current lookahead symbol in current and consumes it. 48 | Passes back the new lookahead symbol in next without consuming it. *) 49 | 50 | PROCEDURE consumeSym ( self : Lexer ) : Symbol; 51 | (* Returns the current lookahead symbol and consumes it. *) 52 | 53 | PROCEDURE lookaheadSym ( self : Lexer ) : Symbol; 54 | (* Returns the current lookahead symbol without consuming it. *) 55 | 56 | PROCEDURE warnCount ( self : Lexer ) : CARDINAL; 57 | (* Returns the lexer's accumulated warning count. *) 58 | 59 | PROCEDURE errorCount ( self : Lexer ) : CARDINAL; 60 | (* Returns the lexer's accumulated error count. *) 61 | 62 | PROCEDURE status ( self : Lexer ) : Status; 63 | (* Returns the status of the last operation. *) 64 | 65 | END Lexer. -------------------------------------------------------------------------------- /MatchLex.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE MatchLex; 4 | 5 | (* Lexer Support Library for Modula-2 R10 Core Compiler *) 6 | 7 | IMPORT Source; 8 | 9 | 10 | (* Semantic Symbols *) 11 | 12 | PROCEDURE Ident ( source : Source; VAR diag : Diagnostic ); 13 | (* Matches the input in source to an identifier and consumes it. *) 14 | 15 | 16 | PROCEDURE IdentOrResword ( source : Source; VAR diag : Diagnostic ); 17 | (* Matches the input in source to an identifier or reserved word 18 | and consumes it. *) 19 | 20 | 21 | PROCEDURE NumericLiteral ( source : Source; VAR diag : Diagnostic ); 22 | (* Matches the input in source to a numeric literal and consumes it. *) 23 | 24 | 25 | PROCEDURE QuotedLiteral ( source : Source; VAR diag : Diagnostic ); 26 | (* Matches the input in source to a quoted literal and consumes it. *) 27 | 28 | 29 | (* Non-Semantic Symbols *) 30 | 31 | PROCEDURE LineComment ( source : Source; VAR diag : Diagnostic ); 32 | (* Matches the input in source to an opening line comment delimiter and 33 | consumes the line, including its closing NEWLINE control character. *) 34 | 35 | 36 | PROCEDURE BlockComment ( source : Source; VAR diag : Diagnostic ); 37 | (* Matches the input in source to an opening block comment delimiter 38 | and consumes the comment, including its closing delimiter. *) 39 | 40 | 41 | PROCEDURE Pragma ( source : Source; VAR diag : Diagnostic ); 42 | (* Matches the input in source to an opening pragma delimiter 43 | and consumes the pragma, including its closing delimiter. *) 44 | 45 | 46 | (* Disabled Code Sections *) 47 | 48 | PROCEDURE DisabledCodeBlock ( source : Source; VAR diag : Diagnostic ); 49 | (* Matches the input in source to an opening disabled code block delimiter 50 | and consumes the disabled code block, including its closing delimiter. *) 51 | 52 | 53 | END MatchLex. -------------------------------------------------------------------------------- /ModuleKey.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2016 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE ModuleKey; 4 | 5 | (* Module Key Generator for Modula-2 Core Compiler *) 6 | 7 | 8 | CONST 9 | BitsPerKey = 128; 10 | KeySize = BitsPerKey DIV 8; 11 | 12 | 13 | (* Key Type *) 14 | 15 | TYPE Key = ARRAY KeySize + 1 OF CHAR; 16 | 17 | 18 | (* Key Generator *) 19 | 20 | PROCEDURE GenKey ( VAR key : Key; CONST forBuffer : ARRAY OF CHAR ); 21 | 22 | 23 | END ModuleKey. -------------------------------------------------------------------------------- /NonTerminals.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE NonTerminals; 4 | 5 | (* FIRST/FOLLOW set database for Modula-2 R10 Bootstrap Compiler *) 6 | 7 | IMPORT M2Token, M2TokenSet; 8 | 9 | 10 | (* Productions *) 11 | 12 | TYPE NonTerminals = 13 | ( CompilationUnit, 14 | ProgramModule, 15 | DefintionModule, 16 | Blueprint, 17 | IdentList, 18 | ModuleTypeSpec, 19 | PropertySpec, 20 | LiteralSpec, 21 | ProtoLiteral, 22 | StructuredProtoLiteral, 23 | ReqValueCount, 24 | Requirement, 25 | ConstRequirement, 26 | SimpleConstRequirement, 27 | ProcedureRequirement, 28 | EntityToBindTo, 29 | LibGenDirective, 30 | ImportDirective, 31 | IdentifiersToImport, 32 | Block, 33 | StatementSequence, 34 | Definition, 35 | ConstDefinition, 36 | VariableDeclaration, 37 | Declaration, 38 | Type, 39 | DerivedSubType, 40 | Range, 41 | EnumType, 42 | SetType, 43 | ArrayType, 44 | RecordType, 45 | PointerType, 46 | CoroutineType, 47 | ProcedureType, 48 | FormalType, 49 | SimpleFormalType, 50 | AttributedFormalType, 51 | VariadicFormalType, 52 | SimpleVariadicFormalType, 53 | NonVariadicFormalType, 54 | ProcedureHeader, 55 | ProcedureSignature, 56 | FormalParameters, 57 | AttributedFormalParams, 58 | VariadicFormalParams, 59 | NonVariadicFormalParams, 60 | Qualident, 61 | Statement, 62 | MemMgtOperation, 63 | UpdateOrProcCall, 64 | IfStatement, 65 | CaseStatement, 66 | Case, 67 | LoopStatement, 68 | WhileStatement, 69 | RepeatStatement, 70 | ForStatement, 71 | Designator, 72 | DesignatorTail, 73 | ExprListOrSlice, 74 | Expression, 75 | SimpleExpression, 76 | Term, 77 | FactorOrNegation, 78 | FactorOrTypeConv, 79 | Factor, 80 | ActualParameters, 81 | ExpressionList, 82 | StructuredValue, 83 | ValueComponent ); 84 | 85 | 86 | (* Operations *) 87 | 88 | PROCEDURE FIRST ( p : NonTerminals ) : M2TokenSet; 89 | (* Returns a reference to the FIRST set of production p. *) 90 | 91 | PROCEDURE inFIRST ( p : NonTerminals; token : M2Token ) : BOOLEAN; 92 | (* Returns TRUE if token is an element of FIRST(p), otherwise FALSE. *) 93 | 94 | PROCEDURE FOLLOW ( p : NonTerminals ) : M2TokenSet; 95 | (* Returns a reference to the FOLLOW set of production p. *) 96 | 97 | PROCEDURE inFOLLOW ( p : NonTerminals; token : M2Token ) : BOOLEAN; 98 | (* Returns TRUE if token is an element of FOLLOW(p), otherwise FALSE. *) 99 | 100 | 101 | END NonTerminals. -------------------------------------------------------------------------------- /Parser.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Parser; 4 | 5 | (* Parser for Modula-2 R10 Core Compiler *) 6 | 7 | 8 | IMPORT Filename, AST; 9 | 10 | 11 | (* Return Status *) 12 | 13 | TYPE Status = ( Success, Failure ); 14 | 15 | 16 | (* Result Summary *) 17 | 18 | TYPE Statistics = RECORD 19 | lexicalWarnings, 20 | lexicalErrors, 21 | syntaxWarnings, 22 | syntaxErrors : CARDINAL; 23 | END; 24 | 25 | 26 | (* Operations *) 27 | 28 | PROCEDURE parseDef 29 | ( source : Filename; VAR stats : Statistics; VAR status : Status ) : AST; 30 | (* Parses .def source file, returns AST on success, NIL on failure. *) 31 | 32 | 33 | PROCEDURE parseMod 34 | ( source : Filename; VAR stats : Statistics; VAR status : Status ) : AST; 35 | (* Parses .mod source file, returns AST on success, NIL on failure. *) 36 | 37 | 38 | END Parser. -------------------------------------------------------------------------------- /Pathnames.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Pathnames; 4 | 5 | (* Pathname Parser Interface for Modula-2 R10 Core Compiler *) 6 | 7 | TYPE Status = 8 | ( Success, 9 | InvalidPath, 10 | InvalidFilename, 11 | InvalidReference, 12 | AllocationFailed ); 13 | 14 | 15 | (* Operations *) 16 | 17 | (* -------------------------------------------------------------------------- 18 | * function isValidPathname(path) 19 | * -------------------------------------------------------------------------- 20 | * Returns TRUE if path is a valid pathname, otherwise FALSE. 21 | * -------------------------------------------------------------------------- 22 | *) 23 | PROCEDURE isValidPathname ( CONST path : ARRAY OF CHAR ) : BOOLEAN; 24 | 25 | 26 | (* -------------------------------------------------------------------------- 27 | * procedure SplitPathname (path, dirpath, filename, charsProcessed, status) 28 | * -------------------------------------------------------------------------- 29 | * Verifies path against the host system's prevailing pathname grammar and 30 | * returns a status code. If path is valid, its directory path component and 31 | * filename component are copied to newly allocated NUL terminated C strings 32 | * and passed back in out-parameters dirpath and filename respectively. If 33 | * path does not contain a directory path component, NULL is passed back in 34 | * dirpath. If path does not contain a filename component, NULL is passed 35 | * back in filename. However, if NIL is passed in for an out-parameter, 36 | * the out-parameter is ignored and no value is passed back in it. The index 37 | * of the last processed character is passed back in charsProcessed. Upon 38 | * success it represents the length of path. Upon failure, it represents 39 | * the index of the first offending character found in path. 40 | * -------------------------------------------------------------------------- 41 | *) 42 | PROCEDURE SplitPathname 43 | ( CONST path : ARRAY OF CHAR; (* in, may not be empty *) 44 | VAR dirpath : ARRAY OF CHAR; (* out, pass NIL to ignore *) 45 | VAR filename : ARRAY OF CHAR; (* out, pass NIL to ignore *) 46 | VAR charsProcessed : CARDINAL; (* out, pass NIL to ignore *) 47 | VAR status : Status ); (* out, pass NIL to ignore *) 48 | 49 | 50 | (* -------------------------------------------------------------------------- 51 | * function isValidFilename(filename) 52 | * -------------------------------------------------------------------------- 53 | * Returns TRUE if filename is a valid filename, otherwise FALSE. 54 | * -------------------------------------------------------------------------- 55 | *) 56 | PROCEDURE isValidFilename ( CONST filename : ARRAY OF CHAR ) : BOOLEAN; 57 | 58 | 59 | (* -------------------------------------------------------------------------- 60 | * function splitFilename(filename, basename, suffix, charsProcessed, status) 61 | * -------------------------------------------------------------------------- 62 | * Verifies filename against the host system's prevailing pathname grammar 63 | * and returns a status code. If filename is valid, its basename and suffix 64 | * components are copied to newly allocated NUL terminated C strings and 65 | * passed back in out-parameters basename and suffix respectively. If 66 | * filename does not contain a suffix component, NIL is passed back in 67 | * suffix. However, if NIL is passed in for an out-parameter, the out- 68 | * parameter is ignored and no value is passed back in it. The index of the 69 | * last processed character is passed back in charsProcessed. Upon success 70 | * it represents the length of filename. Upon failure, it represents the 71 | * index of the first offending character found in filename. 72 | * -------------------------------------------------------------------------- 73 | *) 74 | PROCEDURE SplitFilename 75 | ( CONST filename : ARRAY OF CHAR; (* in, may not be empty *) 76 | VAR basename : ARRAY OF CHAR; (* out, pass NIL to ignore *) 77 | VAR suffix : ARRAY OF CHAR; (* out, pass NIL to ignore *) 78 | VAR charsProcessed : CARDINAL; (* out, pass NIL to ignore *) 79 | VAR status : Status ); (* out, pass NIL to ignore *) 80 | 81 | 82 | (* -------------------------------------------------------------------------- 83 | * function isDefSuffix(suffix) 84 | * -------------------------------------------------------------------------- 85 | * Returns TRUE if suffix is ".def" or ".DEF", otherwise FALSE. 86 | * -------------------------------------------------------------------------- 87 | *) 88 | PROCEDURE isDefSuffix ( CONST suffix : ARRAY OF CHAR ) : BOOLEAN; 89 | 90 | 91 | (* -------------------------------------------------------------------------- 92 | * function isModSuffix(suffix) 93 | * -------------------------------------------------------------------------- 94 | * Returns TRUE if suffix is ".mod" or ".MOD", otherwise FALSE. 95 | * -------------------------------------------------------------------------- 96 | *) 97 | PROCEDURE isModSuffix ( CONST suffix : ARRAY OF CHAR ) : BOOLEAN; 98 | 99 | 100 | (* -------------------------------------------------------------------------- 101 | * function newPathFromComponents(dirpath, basename, suffix) 102 | * -------------------------------------------------------------------------- 103 | * Returns a newly allocated NUL terminated C string containing a pathname 104 | * composed of components dirpath, basename and file suffix. Returns NIL 105 | * if any of dirpath or basename is NIL or empty or if allocation failed. 106 | * -------------------------------------------------------------------------- 107 | *) 108 | PROCEDURE newPathFromComponents 109 | ( VAR newPath : ARRAY OF CHAR; 110 | CONST dirpath : ARRAY OF CHAR; 111 | CONST basename : ARRAY OF CHAR; 112 | CONST suffix : ARRAY OF CHAR; 113 | VAR status : Status ): 114 | 115 | 116 | END Pathnames. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # m2cc 2 | 3 | Modula-2 Core Compiler 4 | 5 | M2CC is a self hosting Modula-2 compiler. 6 | 7 | The compiler implements a subset of the revised language by B.Kowarsch and R.Sutcliffe "Modula-2 Revision 2010" (M2R10). It is written in the extended Modula-2 dialect of the [M2C](https://github.com/trijezdci/m2c)/[M2J](https://github.com/m2sf/m2j)/[M2Sharp](https://github.com/m2sf/m2sharp) compiler suite and may therefore be bootstrapped using any of these compilers. 8 | 9 | In translator mode, M2CC translates Modula-2 source to C99 source files. In compiler mode, M2CC compiles Modula-2 source via C99 source files to object code or executables using the host system's C99 compiler. An LLVM back-end will be added later. 10 | 11 | For more details please visit the project wiki at the URL: https://github.com/trijezdci/m2cc/wiki 12 | -------------------------------------------------------------------------------- /SimpleFileIO.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE SimpleFileIO; 4 | 5 | (* Simple File IO library *) 6 | 7 | TYPE File = OPAQUE; 8 | 9 | TYPE Mode = ( Read, Write, Append ); 10 | 11 | TYPE Status = ( Success, Failure ); (* TO DO: refine *) 12 | 13 | 14 | (* Operations *) 15 | 16 | (* Support for an operation depends on the mode in which the file has 17 | * been opened. Any attempt to carry out an unsupported operation will 18 | * fail with status failure. 19 | * 20 | * operation supported in file mode 21 | * Read Write Append 22 | * ------------------------------------ 23 | * Open yes yes yes 24 | * Close yes yes yes 25 | * GetMode yes yes yes 26 | * GetStatus yes yes yes 27 | * GetPos yes yes no 28 | * SetPos yes no no 29 | * eof yes no no 30 | * ReadOctets yes no no 31 | * ReadChars yes no no 32 | * WriteOctets no yes yes 33 | * WriteChars no yes yes 34 | * ------------------------------------ 35 | *) 36 | 37 | 38 | (* Open and close *) 39 | 40 | PROCEDURE Open 41 | ( VAR f : File; filename : ARRAY OF CHAR; mode : Mode; VAR s : Status ); 42 | (* Opens file filename in mode. Passes file handle in f and status in s. 43 | If the file does not exist, it will be created when opened in write mode, 44 | otherwise status failure is passed back in s. When opening an already 45 | existing file in write mode, all of its current contents are replaced. *) 46 | 47 | PROCEDURE Close ( VAR f : File; s : Status ); 48 | (* Closes file associated with file handle f. Passes status in s. *) 49 | 50 | 51 | (* Introspection *) 52 | 53 | PROCEDURE GetMode ( f : File; VAR m : Mode ); 54 | (* Passes the mode of file f in m. *) 55 | 56 | PROCEDURE GetStatus ( f : File; VAR s : Status ); 57 | (* Passes the status of the last operation on file f in s. *) 58 | 59 | 60 | (* Positioning *) 61 | 62 | PROCEDURE GetPos ( f : File; VAR pos : LONGCARD ); 63 | (* Passes the current reading or writing position of file f in pos. *) 64 | 65 | PROCEDURE SetPos ( f : File; pos : LONGCARD ); 66 | (* Sets the reading position of file f to pos. *) 67 | 68 | PROCEDURE eof ( f : File ) : BOOLEAN; 69 | (* Returns TRUE if the end of file f has been reached, otherwise FALSE. *) 70 | 71 | 72 | (* IO operations *) 73 | 74 | PROCEDURE ReadOctets 75 | ( f : File; VAR buffer : ARRAY OF OCTET; VAR bytesRead : LONGCARD ); 76 | (* Reads contents starting at the current reading position of file f into 77 | buffer until either buffer is full or eof is reached. The number of octets 78 | actually read is passed in bytesRead. *) 79 | 80 | PROCEDURE ReadChars 81 | ( f : File; VAR buffer : ARRAY OF CHAR; VAR charsRead : LONGCARD ); 82 | (* Reads contents starting at the current reading position of file f into 83 | buffer until either the pen-ultimate index of buffer is written or eof 84 | is reached. The buffer is then terminated with ASCII NUL. The number of 85 | characters actually read is passed in charsRead. *) 86 | 87 | PROCEDURE WriteOctets 88 | ( f : File; buffer : ARRAY OF OCTET; VAR bytesWritten : LONGCARD ); 89 | (* Writes the contents of buffer at the current writing position to file f. 90 | The number of octets actually written is passed in bytesWritten. *) 91 | 92 | PROCEDURE WriteChars 93 | ( f : File; buffer : ARRAY OF CHAR; VAR charsWritten : LONGCARD ); 94 | (* Writes the contents of buffer up to and excluding the first ASCII NUL 95 | character code at the current writing position to file f. 96 | The number of characters actually written is passed in charsWritten. *) 97 | 98 | 99 | END SimpleFileIO. -------------------------------------------------------------------------------- /Source.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Source; 4 | 5 | (* Modula-2 Source File Reader *) 6 | 7 | IMPORT Filename, LexTab; 8 | 9 | 10 | TYPE Source = OPAQUE; 11 | 12 | TYPE Status = 13 | ( Success, 14 | InvalidReference, 15 | InvalidFileType, 16 | MaxFileSizeExceeded, 17 | AllocationFailed ); 18 | 19 | 20 | (* --------------------------------------------------------------------------- 21 | * Definitions 22 | * 23 | * start position : 24 | * the position of the first character in the source. 25 | * 26 | * end position : 27 | * the position of the last character in the source. 28 | * 29 | * lookahead position : 30 | * the position of the character to be consumed next. 31 | * 32 | * second lookahead position : 33 | * the position immediately following the lookahead position. 34 | * 35 | * marked position : 36 | * a position recorded as the start of a lexeme. 37 | * it is end position + 1 if no marker has been set. 38 | * 39 | * lookahead character : 40 | * the character at the lookahead position, 41 | * it is ASCII.NUL if its position > end position or if eof is set. 42 | * 43 | * second lookahead character : 44 | * the character at the second lookahead position, 45 | * it is ASCII.NUL if its position > end position or if eof is set. 46 | * 47 | * marked lexeme : 48 | * a character sequence that starts at the marked position (inclusively) 49 | * and ends at the lookahead position (exclusively). 50 | * 51 | * character consumption : 52 | * a character is consumed by advancing the lookahead position 53 | * to the character's second lookahead position or by setting eof. 54 | * 55 | * end-of-line marker: 56 | * an ASCII.LF, 57 | * or a sequence consisting of an ASCII.CR followed by an ASCII.LF, 58 | * or a sole ASCII.CR that is not immediately followed by ASCII.LF. 59 | * 60 | * The lookahead position of an end-of-line marker is the position 61 | * following the last character of the end-of-line marker. 62 | * 63 | * end-of-file flag: 64 | * abbreviated as eof flag, is a boolean value that is set when 65 | * the character at the end position has been consumed. 66 | * 67 | * --------------------------------------------------------------------------- 68 | *) 69 | 70 | (* Construtor *) 71 | 72 | PROCEDURE New 73 | ( VAR s : Source; CONST filename : String; VAR status : Status ); 74 | (* Passes back a newly allocated source instance associated with name in s. 75 | The associated file is opened for reading and the lookahead position is 76 | set to the start position. Passes back NIL in s if unsuccessful. 77 | The status of the operation is passed back in status. *) 78 | 79 | 80 | (* Destructor *) 81 | 82 | PROCEDURE Release ( VAR s : Source; VAR status : Status ); 83 | (* Deallocates s. Passes back NIL in s if successful. 84 | The status of the operation is passed back in status. *) 85 | 86 | 87 | (* Operations *) 88 | 89 | PROCEDURE GetChar ( s : Source; VAR ch, next : CHAR ); 90 | (* Passes back the lookahead character in ch and consumes it. 91 | Passes back the new lookahead character in next without consuming it. *) 92 | 93 | 94 | PROCEDURE consumeChar ( s : Source ) : CHAR; 95 | (* Consumes the current character of s, returns new lookahead char. *) 96 | 97 | 98 | PROCEDURE lookaheadChar ( s : Source ) : CHAR; 99 | (* Returns the lookahead character of s. 100 | Does not consume any character and does not set eof. *) 101 | 102 | 103 | PROCEDURE la2Char ( s : Source ) : CHAR; 104 | (* Returns the second lookahead character of s. 105 | Does not consume any character and does not set eof. *) 106 | 107 | 108 | PROCEDURE MarkLexeme ( s : Source; VAR line, col : CARDINAL ); 109 | (* Marks the lookahead position in s as the start of the marked lexeme. 110 | Passes back lookahead position line and column counters in line and col. *) 111 | 112 | 113 | PROCEDURE CopyLexeme ( s : Source; dict : LexDict; VAR handle : DictHandle ); 114 | (* Adds the marked lexeme in s to lexeme dictionary dict, passes its access 115 | handle back in handle and clears the lexeme marker. If no lexeme marker 116 | has been set, no content is copied and zero is passed back in handle. *) 117 | 118 | 119 | PROCEDURE GetLineAndColumn ( s : Source; VAR line, col : CARDINAL ); 120 | (* Passes back the current line and column counters of s in line and col. *) 121 | 122 | 123 | PROCEDURE eof ( s : Source ) : BOOLEAN; 124 | (* Returns TRUE if the last character in s has been consumed, else FALSE. *) 125 | 126 | 127 | END Source. 128 | -------------------------------------------------------------------------------- /String.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE String; 4 | 5 | (* Variable Length String Library *) 6 | 7 | IMPORT Hash; 8 | 9 | 10 | TYPE String = OPAQUE; 11 | 12 | (* The payload of a string is stored with its meta-data: length, hash value and 13 | reference count. Upon initialisation, the reference count is set to one. *) 14 | 15 | 16 | (* Constructors *) 17 | 18 | PROCEDURE New ( VAR s : String; CONST initWith : ARRAY OF CHAR ); 19 | (* Passes back a newly allocated string in s, initialised with the contents of 20 | initWith. Passes back NIL if unsuccessful. *) 21 | 22 | PROCEDURE NewWithSlice 23 | ( VAR s : String; CONST copyFrom : ARRAY OF CHAR; start, end : CARDINAL ); 24 | (* Passes back a newly allocated string in s, initialised with the contents of 25 | slice copyFrom[start .. end]. Passes back NIL if unsuccessful. *) 26 | 27 | 28 | (* Memory Management *) 29 | 30 | PROCEDURE Retain ( s : String ); 31 | (* Increments the reference count of s. *) 32 | 33 | PROCEDURE Release ( VAR s : String ); 34 | (* Decrements the reference count of s, deallocates if the result is zero. 35 | Passes back NIL in s if s has been deallocated. *) 36 | 37 | 38 | (* Operations *) 39 | 40 | PROCEDURE length ( s : String ) : CARDINAL; 41 | (* Returns the length of s. Returns zero if s is NIL. *) 42 | 43 | 44 | PROCEDURE hash ( s : String ) : Hash; 45 | (* Returns the hash value of s. Returns zero if s is NIL. *) 46 | 47 | 48 | PROCEDURE toAOC ( s : String; VAR aoc : ARRAY OF CHAR ); 49 | (* Passes back the contents of s as an ASCII.NUL terminated character array 50 | in aoc. Passes back ASCII.NUL if the operation is unsuccessful. *) 51 | 52 | 53 | PROCEDURE matches ( s1, s2 : String ) : BOOLEAN; 54 | (* Returns TRUE if the contents of s1 and s2 match, otherwise FALSE. *) 55 | 56 | 57 | PROCEDURE matchesAOC ( s : String; aoc : ARRAY OF CHAR ) : BOOLEAN; 58 | (* Returns TRUE if the contents of s match those of aoc, otherwise FALSE. *) 59 | 60 | 61 | END String. -------------------------------------------------------------------------------- /Symbol.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Symbol; 4 | 5 | (* Symbol Definition for Modula-2 R10 Bootstrap Compiler *) 6 | 7 | IMPORT Token, LexTab, LexDiag; 8 | 9 | 10 | (* Symbol to be returned by lexer *) 11 | 12 | TYPE Symbol = RECORD 13 | token : Token; 14 | line, col : CARDINAL; 15 | lexeme : LexemeHandle; 16 | diagnostic : DiagnosticHandle 17 | END; (* Symbol *) 18 | 19 | 20 | END Symbol. -------------------------------------------------------------------------------- /Token.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Token; 4 | 5 | (* Token Definitions for Modula-2 R10 Core Compiler *) 6 | 7 | 8 | (* Semantic Tokens *) 9 | 10 | TYPE Semantic = [Invalid..EOF] OF Token; 11 | 12 | 13 | (* Semantic and Non-Semantic Tokens *) 14 | 15 | TYPE Token = 16 | ( Invalid, (* 0 *) 17 | 18 | (* Reserved Words *) 19 | Alias, (* 1 *) 20 | And, (* 2 *) 21 | Arglist, (* 3 *) 22 | Array, (* 4 *) 23 | Bare, (* 5 *) 24 | Begin, (* 6 *) 25 | Blueprint, (* 7 *) 26 | By, (* 8 *) 27 | Case, (* 9 *) 28 | Const, (* 10 *) 29 | Copy, (* 11 *) 30 | Definition, (* 12 *) 31 | Div, (* 13 *) 32 | Do, (* 14 *) 33 | Else, (* 15 *) 34 | Elsif, (* 16 *) 35 | End, (* 17 *) 36 | Exit, (* 18 *) 37 | For, (* 19 *) 38 | From, (* 20 *) 39 | Genlib, (* 21 *) 40 | If, (* 22 *) 41 | Implementation, (* 23 *) 42 | Import, (* 24 *) 43 | In, (* 25 *) 44 | Loop, (* 26 *) 45 | Mod, (* 27 *) 46 | Module, (* 28 *) 47 | New, (* 29 *) 48 | None, (* 30 *) 49 | Not, (* 31 *) 50 | Of, (* 32 *) 51 | Opaque, (* 33 *) 52 | Or, (* 34 *) 53 | Pointer, (* 35 *) 54 | Procedure, (* 36 *) 55 | Record, (* 37 *) 56 | Referential, (* 38 *) 57 | Release, (* 39 *) 58 | Repeat, (* 40 *) 59 | Retain, (* 41 *) 60 | Return, (* 42 *) 61 | Set, (* 43 *) 62 | Then, (* 44 *) 63 | To, (* 45 *) 64 | Type, (* 46 *) 65 | Until, (* 47 *) 66 | Var, (* 48 *) 67 | While, (* 49 *) 68 | Yield, (* 50 *) 69 | 70 | (* Dual-Use RW-Identifiers *) 71 | 72 | (* Constant Bindable Identifiers *) 73 | Tflags, (* 51 *) 74 | Tdyn, (* 52 *) 75 | Trefc, (* 53 *) 76 | Tordered, (* 54 *) 77 | Tsorted, (* 55 *) 78 | Tlimit, (* 56 *) 79 | Tscalar, (* 57 *) 80 | Tmax, (* 58 *) 81 | Tmin, (* 59 *) 82 | 83 | (* Procedure Bindable Identifiers *) 84 | Abs, (* 60 *) 85 | Length, (* 61 *) 86 | Exists, (* 62 *) 87 | Seek, (* 63 *) 88 | Subset, (* 64 *) 89 | Read, (* 65 *) 90 | Readnew, (* 66 *) 91 | Write, (* 67 *) 92 | Writef, (* 68 *) 93 | Sxf, (* 69 *) 94 | Val, (* 70 *) 95 | Count, (* 71 *) 96 | Value, (* 72 *) 97 | Store, (* 73 *) 98 | Insert, (* 74 *) 99 | Remove, (* 75 *) 100 | Append, (* 76 *) 101 | 102 | (* Other Dual-Use Identifiers *) 103 | Address, (* 77 *) 104 | Cast, (* 78 *) 105 | Coroutine, (* 79 *) 106 | Octet, (* 80 *) 107 | Tliteral, (* 81 *) 108 | Unsafe, (* 82 *) 109 | 110 | (* Any Other Identifiers *) 111 | OtherIdent, (* 83 *) 112 | 113 | (* Literals *) 114 | WholeNumber, (* 84 *) 115 | RealNumber, (* 85 *) 116 | Character, (* 86 *) 117 | QuotedString, (* 87 *) 118 | ChevronText, (* 88 *) 119 | 120 | (* Punctuation *) 121 | Dot, (* 89 *) 122 | Comma, (* 90 *) 123 | Colon, (* 91 *) 124 | Semicolon, (* 92 *) 125 | VerticalBar, (* 93 *) 126 | Deref, (* 94 *) 127 | DotDot, (* 95 *) 128 | Assign, (* 96 *) 129 | PlusPlus, (* 97 *) 130 | MinusMinus, (* 98 *) 131 | OneWayDep, (* 99 *) 132 | MutualDep, (* 100 *) 133 | MutualExcl, (* 101 *) 134 | PlusMinus, (* 102 *) 135 | 136 | (* Paired Delimiters *) 137 | LParen, (* 103 *) 138 | RParen, (* 104 *) 139 | LBracket, (* 105 *) 140 | RBracket, (* 106 *) 141 | LBrace, (* 107 *) 142 | RBrace, (* 108 *) 143 | 144 | (* Operators *) 145 | 146 | (* Non-Resword Level-1 Operators *) 147 | Equal, (* 109 *) 148 | NotEqual, (* 110 *) 149 | Greater, (* 111 *) 150 | GreaterOrEq, (* 112 *) 151 | Less, (* 113 *) 152 | LessOrEq, (* 114 *) 153 | Identity, (* 115 *) 154 | 155 | (* Non-Resword Level-2 Operators *) 156 | Plus, (* 116 *) (* also used as punctuation *) 157 | Minus, (* 117 *) (* also used as punctuation *) 158 | Concat, (* 118 *) 159 | SetDiff, (* 119 *) 160 | 161 | (* Non-Resword Level-3 Operators *) 162 | Asterisk, (* 120 *) (* also used as punctuation *) 163 | RealDiv, (* 121 *) 164 | DotProd, (* 122 *) (* reserved for future use *) 165 | 166 | (* Non-Resword Level-4 Operators *) 167 | Power, (* 123 *) (* reserved for future use *) 168 | 169 | (* Non-Resword Level-5 Operators *) 170 | TypeConv, (* 124 *) 171 | 172 | (* End Of File Marker *) 173 | EOF, (* 125 *) 174 | 175 | (* Non-Semantic Tokens *) 176 | 177 | (* Pragmas *) 178 | Pragma, (* 126 *) 179 | 180 | (* Comments *) 181 | LineComment, (* 127 *) 182 | BlockComment); (* 128 *) 183 | 184 | 185 | (* Functions To Determine Token Classification *) 186 | 187 | PROCEDURE isResWord ( t : Token ) : BOOLEAN; 188 | (* Returns TRUE if t is a reserved word, otherwise FALSE. *) 189 | 190 | PROCEDURE isIdentifier ( t : Token ) : BOOLEAN; 191 | (* Returns TRUE if t is an identifier, otherwise FALSE. *) 192 | 193 | PROCEDURE isConstBindableIdent ( t : Token ) : BOOLEAN; 194 | (* Returns TRUE if t is a constant bindable identifier, otherwise FALSE. *) 195 | 196 | PROCEDURE isProcBindableIdent ( t : Token ) : BOOLEAN; 197 | (* Returns TRUE if t is a procedure bindable identifier, otherwise FALSE. *) 198 | 199 | PROCEDURE isNumber ( t : Token ) : BOOLEAN; 200 | (* Returns TRUE if t is a number literal, otherwise FALSE. *) 201 | 202 | PROCEDURE isCharOrString ( t : Token ) : BOOLEAN; 203 | (* Returns TRUE if t is a character or string, otherwise FALSE. *) 204 | 205 | PROCEDURE isOperL1 ( t : Token ) : BOOLEAN; 206 | (* Returns TRUE if t is a level-1 operator, otherwise FALSE. *) 207 | 208 | PROCEDURE isOperL2 ( t : Token ) : BOOLEAN; 209 | (* Returns TRUE if t is a level-2 operator, otherwise FALSE. *) 210 | 211 | PROCEDURE isOperL3 ( t : Token ) : BOOLEAN; 212 | (* Returns TRUE if t is a level-3 operator, otherwise FALSE. *) 213 | 214 | PROCEDURE isComment ( t : Token ) : BOOLEAN; 215 | (* Returns TRUE if t is a comment, otherwise FALSE. *) 216 | 217 | PROCEDURE isPragma ( t : Token ) : BOOLEAN; 218 | (* Returns TRUE if t is a pragma, otherwise FALSE. *) 219 | 220 | 221 | END Token. -------------------------------------------------------------------------------- /TokenSet.def: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE TokenSet; 4 | 5 | (* Token Set ADT for Modula-2 R10 Core Compiler *) 6 | 7 | IMPORT Token; 8 | 9 | 10 | TYPE TokenSet = OPAQUE; 11 | 12 | (* Constructor *) 13 | 14 | PROCEDURE New 15 | ( VAR set : TokenSet; segment3, segment2, segment1, segment0 : LONGCARD ); 16 | (* Passes a newly allocated and initialised TokenSet instance back in set. 17 | The set is initalised from parameters segment3 to segment0 as follows: 18 | 19 | bit 127 bit 0 20 | v v 21 | [<-----------------set---------------->] 22 | [segment3][segment2][segment1][segment0] 23 | ^ ^ ^ ^ 24 | bit 32 bit 32 bit 32 bit 32 25 | 26 | The bits in set correspond to the token values of type Token. 27 | If the bitwidth of type LONGCARD is larger than 32, any higher bits are 28 | ignored. The procedure passes back NIL if allocation is unsuccessful. *) 29 | 30 | 31 | (* Destructor *) 32 | 33 | PROCEDURE Release ( VAR set : TokenSet ); 34 | (* Releases set and passes back NIL if successful. *) 35 | 36 | 37 | (* Operations *) 38 | 39 | PROCEDURE Insert ( set : TokenSet; token : Token ); 40 | (* Inserts token into set. *) 41 | 42 | PROCEDURE Remove ( set : TokenSet; token : Token ); 43 | (* Removes token from set. *) 44 | 45 | PROCEDURE isEmpty ( set : TokenSet ) : BOOLEAN; 46 | (* Returns TRUE if set is empty, otherwise FALSE. *) 47 | 48 | PROCEDURE isElem ( set : TokenSet; token : Token ) : BOOLEAN; 49 | (* Returns TRUE if token is an element of set, otherwise FALSE. *) 50 | 51 | PROCEDURE count ( set : TokenSet ) : CARDINAL; 52 | (* Returns the number of tokens in set. *) 53 | 54 | 55 | (* Data Output *) 56 | 57 | PROCEDURE PrintTokenList ( set : TokenSet ); 58 | (* Prints a comma separated list of tokens in set. *) 59 | 60 | PROCEDURE PrintSegments ( set : TokenSet ); 61 | (* Prints a comma separated list of the data segments of set in base-16. *) 62 | 63 | 64 | END TokenSet. -------------------------------------------------------------------------------- /imp/ASCII.mod: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | IMPLEMENTATION MODULE ASCII; 4 | 5 | 6 | (* Operations *) 7 | 8 | PROCEDURE isControl ( ch : CHAR ) : BOOLEAN; 9 | (* Returns TRUE if ch is a control code, otherwise FALSE. *) 10 | 11 | BEGIN 12 | RETURN (ch <= US) OR (ch = DEL) 13 | END isControl; 14 | 15 | 16 | PROCEDURE isDigit ( ch : CHAR ) : BOOLEAN; 17 | (* Returns TRUE if ch is a digit, otherwise FALSE. *) 18 | 19 | BEGIN 20 | RETURN (ch >= DIGIT_ZERO) AND (ch <= DIGIT_NINE) 21 | END isDigit; 22 | 23 | 24 | PROCEDURE isLetter ( ch : CHAR ) : BOOLEAN; 25 | (* Returns TRUE if ch is a letter, otherwise FALSE. *) 26 | 27 | BEGIN 28 | RETURN ((ch >= SMALL_LETTER_A) AND (ch <= SMALL_LETTER_Z)) 29 | OR ((ch >= CAPITAL_LETTER_A) AND (ch <= CAPITAL_LETTER_Z)) 30 | END isLetter; 31 | 32 | 33 | PROCEDURE isAlphaNum ( ch : CHAR ) : BOOLEAN; 34 | (* Returns TRUE if ch is alpha-numeric, otherwise FALSE. *) 35 | 36 | BEGIN 37 | RETURN ((ch >= DIGIT_ZERO) AND (ch <= DIGIT_NINE)) 38 | OR ((ch >= SMALL_LETTER_A) AND (ch <= SMALL_LETTER_Z)) 39 | OR ((ch >= CAPITAL_LETTER_A) AND (ch <= CAPITAL_LETTER_Z)) 40 | END isAlphaNum; 41 | 42 | 43 | PROCEDURE isUpper ( ch : CHAR ) : BOOLEAN; 44 | (* Returns TRUE if ch is an uppercase letter, otherwise FALSE. *) 45 | 46 | BEGIN 47 | RETURN (ch >= CAPITAL_LETTER_A) AND (ch <= CAPITAL_LETTER_Z) 48 | END isUpper; 49 | 50 | 51 | PROCEDURE isLower ( ch : CHAR ) : BOOLEAN; 52 | (* Returns TRUE if ch is a lowercase letter, otherwise FALSE. *) 53 | 54 | BEGIN 55 | RETURN (ch >= SMALL_LETTER_A) AND (ch <= SMALL_LETTER_Z) 56 | END isUpper; 57 | 58 | 59 | PROCEDURE toUpper ( VAR ch : CHAR ); 60 | (* Passes back the uppercase equivalent of ch if ch is a lowercase letter. *) 61 | 62 | BEGIN 63 | IF (ch >= SMALL_LETTER_A) AND (ch <= SMALL_LETTER_Z) THEN 64 | ch := CHR(ORD(ch) + 32) 65 | END 66 | END toUpper; 67 | 68 | 69 | PROCEDURE toLower ( VAR ch : CHAR ); 70 | (* Passes back the lowercase equivalent of ch if ch is an uppercase letter. *) 71 | 72 | BEGIN 73 | IF (ch >= CAPITAL_LETTER_A) AND (ch <= CAPITAL_LETTER_Z) THEN 74 | ch := CHR(ORD(ch) - 32) 75 | END 76 | END toLower; 77 | 78 | 79 | END ASCII. -------------------------------------------------------------------------------- /imp/Lexer.mod: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | IMPLEMENTATION MODULE Lexer; 4 | 5 | (* Lexer for Modula-2 R10 Core Compiler *) 6 | 7 | IMPORT ASCII, Capabilities, Source, Token, Symbol, MatchLex; 8 | 9 | 10 | (* Lexer Type *) 11 | 12 | TYPE Lexer = POINTER TO LexerDescriptor; 13 | 14 | TYPE LexerDescriptor = RECORD 15 | source : Source; 16 | nextSymbol : Symbol; 17 | warnings, 18 | errors : CARDINAL; 19 | lastStatus : Status 20 | END; (* LexerDescriptor *) 21 | 22 | 23 | (* Operations *) 24 | 25 | (* --------------------------------------------------------------------------- 26 | * procedure New ( newLexer, filename, status ) 27 | * creates a new lexer instance, associated with filename 28 | * --------------------------------------------------------------------------- 29 | * pre-conditions: 30 | * TO DO 31 | * 32 | * post-conditions: 33 | * TO DO 34 | * 35 | * error-conditions: 36 | * TO DO 37 | * --------------------------------------------------------------------------- 38 | *) 39 | PROCEDURE New ( VAR newLexer : Lexer; filename : Filename; VAR s : Status ); 40 | 41 | VAR 42 | source : Source; 43 | sourceStatus : Source.Status; 44 | 45 | BEGIN 46 | 47 | (* lexer must not have been initialised *) 48 | IF newLexer # NIL THEN 49 | status := Status.AlreadyInitialised; 50 | RETURN 51 | END; 52 | 53 | (* allocate and initialise source *) 54 | Source.New(source, filename, sourceStatus); 55 | IF sourceStatus # Source.Status.Success THEN 56 | s := Status.UnableToAllocate; 57 | RETURN 58 | END; 59 | 60 | (* allocate a lexer instance *) 61 | NEW newLexer; 62 | IF newLexer = NIL THEN 63 | s := Status.UnableToAllocate; 64 | RELEASE source; 65 | RETURN 66 | END; 67 | 68 | (* initialise lexer *) 69 | newLexer^.source := source; 70 | newLexer^.warnings := 0; 71 | newLexer^.errors := 0; 72 | newLexer^.lastStatus := Status.Success; 73 | 74 | (* read the first symbol to be returned *) 75 | newLexer^.nextSymbol := newLexer.consumeSym(); 76 | 77 | s := Status.Success 78 | END New; 79 | 80 | 81 | (* --------------------------------------------------------------------------- 82 | * procedure GetSym ( lexer, symbol, lookaheadSymbol ) 83 | * passes and consumes current lookahead symbol, passes new lookahead symbol 84 | * --------------------------------------------------------------------------- 85 | * pre-conditions: 86 | * TO DO 87 | * 88 | * post-conditions: 89 | * TO DO 90 | * 91 | * error-conditions: 92 | * TO DO 93 | * --------------------------------------------------------------------------- 94 | *) 95 | PROCEDURE GetSym ( self : Lexer; VAR sym, next : Symbol ); 96 | 97 | BEGIN 98 | 99 | (* nextSymbol holds current lookahead, pass it back in sym *) 100 | sym := self^.nextSymbol; 101 | 102 | (* consume the current lookahead, 103 | read the new lookahead symbol, pass it back in next *) 104 | next := self.consumeSym(); 105 | 106 | RETURN 107 | END GetSym; 108 | 109 | 110 | (* --------------------------------------------------------------------------- 111 | * procedure consumeSym ( lexer ) 112 | * consumes current lookahead symbol and returns new lookahead symbol 113 | * --------------------------------------------------------------------------- 114 | * pre-conditions: 115 | * TO DO 116 | * 117 | * post-conditions: 118 | * TO DO 119 | * 120 | * error-conditions: 121 | * TO DO 122 | * --------------------------------------------------------------------------- 123 | *) 124 | PROCEDURE consumeSym ( self : Lexer ) : Symbol; 125 | 126 | VAR 127 | ch, next, la2 : CHAR; 128 | source : Source; 129 | sym : Symbol; 130 | 131 | BEGIN 132 | (* ensure source is valid *) 133 | IF lexer = NIL THEN 134 | (* TO DO: report and handle error *) 135 | RETURN 136 | END; 137 | 138 | source := self^.source; 139 | 140 | (* all decisions are based on lookahead *) 141 | next := source.lookaheadChar(); 142 | 143 | (* skip any whitespace, tab and new line *) 144 | WHILE NOT source.eof() AND 145 | (next = ASCII.SPACE OR next = ASCII.TAB OR next = ASCII.NEWLINE) DO 146 | source.GetChar(ch, next) 147 | END; (* WHILE *) 148 | 149 | (* get current position *) 150 | source.GetLineAndColumn(sym.line, sym.column); 151 | 152 | (* check for end-of-file *) 153 | IF source.eof() THEN 154 | sym.token := Token.EOF; 155 | sym.lexeme := 0 156 | 157 | (* check for reserved word or identifier *) 158 | ELSIF next >= "A" AND next <= "Z" THEN 159 | source.MarkLexeme(sym.line, sym.column); 160 | MatchLex.IdentOrResword(source, sym.token); 161 | source.CopyLexeme(self^.dict, sym.lexeme) 162 | 163 | (* check for identifier *) 164 | ELSIF (next >= "a" AND next <= "z") OR 165 | (next = "$" AND Capabilities.dollarIdentifiers()) THEN 166 | source.MarkLexeme(sym.line, sym.column); 167 | MatchLex.Ident(source, sym.token); 168 | source.CopyLexeme(self^.dict, sym.lexeme) 169 | 170 | (* check for numeric literal *) 171 | ELSIF next >= "0" AND next <= "9" THEN 172 | source.MarkLexeme(sym.line, sym.column); 173 | MatchLex.NumericLiteral(source, sym.token); 174 | source.CopyLexeme(self^.dict, sym.lexeme) 175 | 176 | (* check for quoted literal *) 177 | ELSIF next = ASCII.SINGLEQUOTE OR next = ASCII.DOUBLEQUOTE THEN 178 | source.MarkLexeme(sym.line, sym.column); 179 | MatchLex.QuotedLiteral(source, sym.token); 180 | source.CopyLexeme(self^.dict, sym.lexeme) 181 | 182 | (* check for any other symbol *) 183 | ELSE 184 | CASE next OF 185 | 186 | (* next symbol is line comment *) 187 | | "!" : 188 | source.MarkLexeme(sym.line, sym.column); 189 | MatchLex.LineComment(source, sym.token); 190 | source.CopyLexeme(self^.dict, sym.lexeme) 191 | 192 | (* next symbol is "#" *) 193 | | "#" : 194 | source.ConsumeChar(); 195 | source.GetLineAndColumn(sym.line, sym.column); 196 | sym.token := Token.NotEqual; 197 | sym.lexeme := Token.lexemeForToken(Token.NotEqual) 198 | 199 | (* next symbol is "&" *) 200 | | "&" : 201 | source.ConsumeChar(); 202 | source.GetLineAndColumn(sym.line, sym.column); 203 | sym.token := Token.Concat; 204 | sym.lexeme := Token.lexemeForToken(Token.Concat) 205 | 206 | (* next symbol is "(" or block comment *) 207 | | "(" : 208 | IF source.la2Char() = "*" THEN (* found block comment *) 209 | source.MarkLexeme(sym.line, sym.column); 210 | MatchLex.BlockComment(source, sym.token); 211 | source.CopyLexeme(self^.dict, sym.lexeme) 212 | 213 | ELSE (* found "(" *) 214 | source.ConsumeChar(); 215 | source.GetLineAndColumn(sym.line, sym.column); 216 | sym.token := Token.LParen; 217 | sym.lexeme := Token.lexemeForToken(Token.LParen) 218 | 219 | END (* "(" and block comment *) 220 | 221 | (* next symbol is ")" *) 222 | | ")" : 223 | source.ConsumeChar(); 224 | source.GetLineAndColumn(sym.line, sym.column); 225 | sym.value := Token.RParen; 226 | sym.lexeme := Token.lexemeForToken(Token.RParen) 227 | 228 | (* next symbol is "*" or "**" *) 229 | | "*" : 230 | source.GetChar(ch, next); 231 | source.GetLineAndColumn(sym.line, sym.column); 232 | 233 | IF next # "*" THEN (* found sole "*" *) 234 | sym.token := Token.Asterisk; 235 | sym.lexeme := Token.lexemeForToken(Token.Asterisk) 236 | 237 | ELSE (* found "**" *) 238 | source.ConsumeChar(); 239 | sym.token := Token.Power; 240 | sym.lexeme := Token.lexemeForToken(Token.Power) 241 | 242 | END (* "*" or "**" *) 243 | 244 | (* next symbol is "+" or "++" *) 245 | | "+" : 246 | source.GetChar(ch, next); 247 | source.GetLineAndColumn(sym.line, sym.column); 248 | 249 | IF next # "+" THEN (* found sole "+" *) 250 | sym.token := Token.Plus; 251 | sym.lexeme := Token.lexemeForToken(Token.Plus) 252 | 253 | ELSE (* found "++" *) 254 | source.ConsumeChar(); 255 | sym.token := Token.PlusPlus; 256 | sym.lexeme := Token.lexemeForToken(Token.PlusPlus) 257 | 258 | END (* "+" and "++" *) 259 | 260 | (* next symbol is "," *) 261 | | "," : 262 | source.ConsumeChar(); 263 | source.GetLineAndColumn(sym.line, sym.column); 264 | sym.token := Token.Comma; 265 | sym.lexeme := Token.lexemeForToken(Token.Comma) 266 | 267 | (* next symbol is "-", "--" or "->" *) 268 | | "-" : 269 | source.GetChar(ch, next); 270 | source.GetLineAndColumn(sym.line, sym.column); 271 | 272 | IF next = "-" THEN (* found "--" *) 273 | source.ConsumeChar(); 274 | sym.token := Token.MinusMinus; 275 | sym.lexeme := Token.lexemeForToken(Token.MinusMinus) 276 | 277 | ELSIF next = ">" THEN (* found "->" *) 278 | source.ConsumeChar(); 279 | sym.token := Token.OneWayDep; 280 | sym.lexeme := Token.lexemeForToken(Token.OneWayDep) 281 | 282 | ELSE (* found sole "-" *) 283 | sym.token := Token.Minus; 284 | sym.lexeme := Token.lexemeForToken(Token.Minus) 285 | 286 | END (* "-", "--" or "->" *) 287 | 288 | (* next symbol is ".", ".." or ".*" *) 289 | | "." : 290 | source.GetChar(ch, next); 291 | source.GetLineAndColumn(sym.line, sym.column); 292 | 293 | IF next = "." THEN (* found ".." *) 294 | source.ConsumeChar(); 295 | sym.token := Token.DotDot; 296 | sym.lexeme := Token.lexemeForToken(Token.DotDot) 297 | 298 | ELSIF next = "*" THEN (* found ".*" *) 299 | source.ConsumeChar(); 300 | sym.token := Token.DotStar; 301 | sym.lexeme := Token.lexemeForToken(Token.DotStar) 302 | 303 | ELSE (* found sole "." *) 304 | sym.token := Token.Dot; 305 | sym.lexeme := Token.lexemeForToken(Token.Dot) 306 | 307 | END (* ".", ".." and ".*" *) 308 | 309 | (* next symbol is "/" *) 310 | | "/" : 311 | source.ConsumeChar(); 312 | source.GetLineAndColumn(sym.line, sym.column); 313 | sym.token := Token.RealDiv; 314 | sym.lexeme := Token.lexemeForToken(Token.RealDiv) 315 | 316 | (* next symbol is ":", ":=" or "::" *) 317 | | ":" : 318 | source.GetChar(ch, next); 319 | source.GetLineAndColumn(sym.line, sym.column); 320 | 321 | IF next = "=" THEN (* found ":=" *) 322 | source.ConsumeChar(); 323 | sym.token := Token.Assign; 324 | sym.lexeme := Token.lexemeForToken(Token.Assign) 325 | 326 | ELSIF next = ":" THEN (* found "::" *) 327 | source.ConsumeChar(); 328 | sym.token := Token.TypeConv; 329 | sym.lexeme := Token.lexemeForToken(Token.TypeConv) 330 | 331 | ELSE (* found sole ":" *) 332 | sym.token := Token.Colon; 333 | sym.lexeme := Token.lexemeForToken(Token.Colon) 334 | 335 | END (* ":", ":=" and "::" *) 336 | 337 | (* next symbol is ";" *) 338 | | ";" : 339 | source.ConsumeChar(); 340 | source.GetLineAndColumn(sym.line, sym.column); 341 | sym.token := Token.Semicolon; 342 | sym.lexeme := Token.lexemeForToken(Token.Semicolon) 343 | 344 | (* next symbol is "<", "<=", "<>", chevron text or pragma *) 345 | | "<" : 346 | la2 := source.la2Char(); 347 | 348 | IF la2 = "<" THEN (* found "<<" *) 349 | source.MarkLexeme(sym.line, sym.column); 350 | MatchLex.ChevronText(source, sym.token); 351 | source.CopyLexeme(self^.dict, sym.lexeme) 352 | 353 | ELSIF la2 = "*" THEN (* found "<*" *) 354 | source.MarkLexeme(sym.line, sym.column); 355 | MatchLex.Pragma(source, sym.token); 356 | source.CopyLexeme(self^.dict, sym.lexeme) 357 | 358 | ELSE (* "<", "<=" or "<> "*) 359 | source.GetChar(ch, next); 360 | source.GetLineAndColumn(sym.line, sym.column); 361 | 362 | IF next = "=" THEN (* found "<=" *) 363 | source.ConsumeChar(); 364 | sym.token := Token.LessEq; 365 | sym.lexeme := Token.lexemeForToken(Token.LessEq) 366 | 367 | ELSIF next = ">" THEN (* found "<>" *) 368 | sym.token := Token.MutualDep; 369 | sym.lexeme := Token.lexemeForToken(Token.MutualDep) 370 | 371 | ELSE (* found "<" *) 372 | sym.token := Token.Less; 373 | sym.lexeme := Token.lexemeForToken(Token.Less) 374 | 375 | END (* "<", "<=" or "<>" *) 376 | 377 | END (* chevron text or pragma *) 378 | 379 | (* next symbol is "=" or "==" *) 380 | | "=" : 381 | source.GetChar(ch, next); 382 | source.GetLineAndColumn(sym.line, sym.column); 383 | 384 | IF next # "=" THEN (* found "=" *) 385 | sym.token := Token.Equal; 386 | sym.lexeme := Token.lexemeForToken(Token.Equal) 387 | 388 | ELSE (* found "==" *) 389 | source.ConsumeChar(); 390 | sym.token := Token.Identity; 391 | sym.lexeme := Token.lexemeForToken(Token.Identity) 392 | 393 | END (* "=" or "==" *) 394 | 395 | (* next symbol is ">", ">=" or "><" *) 396 | | ">" : 397 | source.GetChar(ch, next); 398 | source.GetLineAndColumn(sym.line, sym.column); 399 | 400 | IF next = "=" THEN (* found ">=" *) 401 | source.ConsumeChar(); 402 | sym.token := Token.GreaterEq; 403 | sym.lexeme := Token.lexemeForToken(Token.GreaterEq) 404 | 405 | ELSIF next = "<" THEN (* found "><" *) 406 | source.ConsumeChar(); 407 | sym.token := Token.MutualExcl; 408 | sym.lexeme := Token.lexemeForToken(Token.MutualExcl) 409 | 410 | ELSE (* found sole ">" *) 411 | sym.token := Token.Greater; 412 | sym.lexeme := Token.lexemeForToken(Token.Greater) 413 | 414 | END (* ">", ">=" or "><" *) 415 | 416 | (* next symbol is "[" *) 417 | | "[" : 418 | source.ConsumeChar(); 419 | source.GetLineAndColumn(sym.line, sym.column); 420 | sym.token := Token.LBracket; 421 | sym.lexeme := Token.lexemeForToken(Token.LBracket) 422 | 423 | (* next symbol is backslash *) 424 | | ASCII.BACKSLASH : 425 | source.ConsumeChar(); 426 | source.GetLineAndColumn(sym.line, sym.column); 427 | sym.token := Token.SetDiff; 428 | sym.lexeme := Token.lexemeForToken(Token.SetDiff) 429 | 430 | (* next symbol is "]" *) 431 | | "]" : 432 | source.ConsumeChar(); 433 | source.GetLineAndColumn(sym.line, sym.column); 434 | sym.token := Token.RBracket; 435 | sym.lexeme := Token.lexemeForToken(Token.RBracket) 436 | 437 | (* next symbol is "^" *) 438 | | "^" : 439 | source.ConsumeChar(); 440 | source.GetLineAndColumn(sym.line, sym.column); 441 | sym.token := Token.Deref; 442 | sym.lexeme := Token.lexemeForToken(Token.Deref) 443 | 444 | (* next symbol is "{" *) 445 | | "{" : 446 | source.ConsumeChar(); 447 | source.GetLineAndColumn(sym.line, sym.column); 448 | sym.token := Token.LBrace; 449 | sym.lexeme := Token.lexemeForToken(Token.LBrace) 450 | 451 | (* next symbol is "|" *) 452 | | "|" : 453 | source.ConsumeChar(); 454 | source.GetLineAndColumn(sym.line, sym.column); 455 | sym.token := Token.VerticalBar; 456 | sym.lexeme := Token.lexemeForToken(Token.VerticalBar) 457 | 458 | (* next symbol is "}" *) 459 | | "}" : 460 | source.ConsumeChar(); 461 | source.GetLineAndColumn(sym.line, sym.column); 462 | sym.token := Token.RBrace; 463 | sym.lexeme := Token.lexemeForToken(Token.RBrace) 464 | 465 | (* next symbol is invalid *) 466 | ELSE 467 | source.MarkLexeme(sym.line, sym.column); 468 | source.ConsumeChar(); 469 | sym.token := Token.Invalid; 470 | source.CopyLexeme(self^.dict, sym.lexeme); 471 | self^.errors++ 472 | 473 | END; (* CASE *) 474 | 475 | END (* IF *); 476 | 477 | (* store symbol for use by lookaheadSym *) 478 | self^.nextSymbol := sym; 479 | 480 | RETURN 481 | END consumeSym; 482 | 483 | 484 | (* --------------------------------------------------------------------------- 485 | * procedure lookaheadSym ( lexer ) : Symbol 486 | * returns current lookahead symbol 487 | * --------------------------------------------------------------------------- 488 | * pre-conditions: 489 | * TO DO 490 | * 491 | * post-conditions: 492 | * TO DO 493 | * 494 | * error-conditions: 495 | * TO DO 496 | * --------------------------------------------------------------------------- 497 | *) 498 | PROCEDURE lookaheadSym ( self : Lexer ) : Symbol; 499 | 500 | BEGIN 501 | RETURN self^.nextSymbol 502 | END lookaheadSym; 503 | 504 | 505 | (* --------------------------------------------------------------------------- 506 | * procedure GetStatus ( lexer, status ) 507 | * returns status of last operation 508 | * --------------------------------------------------------------------------- 509 | * pre-conditions: 510 | * TO DO 511 | * 512 | * post-conditions: 513 | * TO DO 514 | * 515 | * error-conditions: 516 | * TO DO 517 | * --------------------------------------------------------------------------- 518 | *) 519 | PROCEDURE status ( self : Lexer ) : Status; 520 | 521 | BEGIN 522 | 523 | IF lexer = NIL THEN 524 | RETURN Status.NotInitialised 525 | ELSE 526 | RETURN self^.lastStatus 527 | END 528 | 529 | END status; 530 | 531 | 532 | (* --------------------------------------------------------------------------- 533 | * procedure warnCount ( lexer ) : CARDINAL 534 | * returns current lexical warning count 535 | * --------------------------------------------------------------------------- 536 | * pre-conditions: 537 | * TO DO 538 | * 539 | * post-conditions: 540 | * TO DO 541 | * 542 | * error-conditions: 543 | * TO DO 544 | * --------------------------------------------------------------------------- 545 | *) 546 | PROCEDURE warnCount ( self : Lexer ) : CARDINAL; (* PURE *) 547 | 548 | BEGIN 549 | RETURN self^.warnings 550 | END warnCount; 551 | 552 | 553 | (* --------------------------------------------------------------------------- 554 | * procedure errorCount ( lexer ) : CARDINAL 555 | * returns current lexical error count 556 | * --------------------------------------------------------------------------- 557 | * pre-conditions: 558 | * TO DO 559 | * 560 | * post-conditions: 561 | * TO DO 562 | * 563 | * error-conditions: 564 | * TO DO 565 | * --------------------------------------------------------------------------- 566 | *) 567 | PROCEDURE errorCount ( self : Lexer ) : CARDINAL; (* PURE *) 568 | 569 | BEGIN 570 | RETURN self^.errors 571 | END errorCount; 572 | 573 | 574 | (* --------------------------------------------------------------------------- 575 | * procedure release ( lexer ) 576 | * releases lexer instance 577 | * --------------------------------------------------------------------------- 578 | * pre-conditions: 579 | * (1) lexer must not be NIL 580 | * 581 | * post-conditions: 582 | * (1) lexer is deallocated 583 | * (2) NIL is passed back in lexer 584 | * 585 | * error-conditions: 586 | * (1) reference to lexer remains unmodified 587 | * --------------------------------------------------------------------------- 588 | *) 589 | PROCEDURE Release ( VAR lexer : Lexer ); 590 | 591 | BEGIN 592 | 593 | (* lexer must not be NIL *) 594 | IF lexer = NIL THEN 595 | RETURN 596 | END; 597 | 598 | (* release source and lexer *) 599 | Source.Release(self^.source); 600 | RELEASE lexer 601 | 602 | END Release; 603 | 604 | 605 | END Lexer. -------------------------------------------------------------------------------- /imp/MatchLex.mod: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | IMPLEMENTATION MODULE MatchLex; 4 | 5 | (* Lexer Support Library for Modula-2 R10 Core Compiler *) 6 | 7 | IMPORT ASCII, Capabilities, Source, Token; 8 | 9 | 10 | (* Semantic Symbols *) 11 | 12 | (* --------------------------------------------------------------------------- 13 | * procedure Ident ( source, token ) 14 | * matches the input in s to an identifier 15 | * --------------------------------------------------------------------------- 16 | * EBNF 17 | * 18 | * Ident : 19 | * Letter LetterOrDigit* ( ( '_' | '$' ) LetterOrDigit+ )* 20 | * ; 21 | * 22 | * pre-conditions: 23 | * (1) s is the current input source and it must not be NIL. 24 | * (2) lookahead of s is the first character of the identifier. 25 | * 26 | * post-conditions: 27 | * (1) lookahead of s is the character immediately following the last 28 | * character of the identifier whose first character was the 29 | * lookahead of s upon entry into the procedure. 30 | * (2) token value identifier is passed back in token. 31 | * 32 | * error-conditions: 33 | * (1) identifier consists entirely of non-alphanumeric characters 34 | * TO DO 35 | * (2) maximum length exceeded 36 | * TO DO 37 | * --------------------------------------------------------------------------- 38 | *) 39 | PROCEDURE Ident 40 | ( source : Source; token : Token; VAR diag : Diagnostic ); 41 | 42 | VAR 43 | next : CHAR; 44 | isIdentChar, lowlinePermitted, dollarPermitted : BOOLEAN; 45 | 46 | BEGIN 47 | 48 | lowlinePermitted := Capabilities.lowlineIdentifiers(); 49 | dollarPermitted := Capabilities.dollarIdentifiers(); 50 | 51 | REPEAT 52 | next := source.consumeChar(); 53 | 54 | isIdentChar := 55 | ASCII.isAlphanum(next) OR 56 | (lowlinePermitted AND 57 | next = '_' AND ASCII.isAlphanum(source.la2Char())) OR 58 | (dollarPermitted AND 59 | next = '$' AND ASCII.isAlphanum(source.la2Char())); 60 | 61 | UNTIL NOT isIdentChar 62 | 63 | END Ident; 64 | 65 | 66 | (* --------------------------------------------------------------------------- 67 | * procedure IdentOrResword ( source, token ) 68 | * matches the input in s to an identifier or reserved word 69 | * --------------------------------------------------------------------------- 70 | * EBNF 71 | * 72 | * Ident : 73 | * Letter LetterOrDigit* ( ( '_' | '$' ) LetterOrDigit+ )* 74 | * ; 75 | * 76 | * pre-conditions: 77 | * (1) s is the current input source and it must not be NIL. 78 | * (2) lookahead of s is the first character of the identifier or RW. 79 | * 80 | * post-conditions: 81 | * (1) lookahead of s is the character immediately following the last 82 | * character of the identifier or RW whose first character was the 83 | * lookahead of s upon entry into the procedure. 84 | * (2) if the input represents a reserved word or dual-use identifier, 85 | * its token value is passed back in token. 86 | * if the input represents any other identifier, 87 | * token value identifier is passed back in token. 88 | * 89 | * error-conditions: 90 | * (1) identifier consists entirely of non-alphanumeric characters 91 | * TO DO 92 | * (2) maximum length exceeded 93 | * TO DO 94 | * --------------------------------------------------------------------------- 95 | *) 96 | PROCEDURE IdentOrResword 97 | ( source : Source; token : Token; VAR diag : Diagnostic ); 98 | 99 | VAR 100 | next : CHAR; 101 | allChars, upperChars : CARDINAL; 102 | isIdentChar, isUpperChar, lowlinePermitted, dollarPermitted : BOOLEAN; 103 | 104 | BEGIN 105 | 106 | allChars := 0; 107 | upperChars := 0; 108 | lowlinePermitted := Capabilities.lowlineIdentifiers(); 109 | dollarPermitted := Capabilities.dollarIdentifiers(); 110 | 111 | next := source.lookaheadChar(); 112 | isUpperChar := (next >= 'A' AND next <= 'Z'); 113 | 114 | REPEAT 115 | 116 | next := source.consumeChar(); 117 | allChars++; 118 | 119 | IF isUpperChar THEN 120 | upperChars++ 121 | END; 122 | 123 | isUpperChar := (next >= 'A' AND next <= 'Z'); 124 | 125 | isIdentChar := 126 | isUpperChar OR 127 | (next >= 'a' AND next <= 'z') OR 128 | (next >= '0' AND next <= '9') OR 129 | (lowlinePermitted AND 130 | next = '_' AND ASCII.isAlphanum(source.la2Char())) OR 131 | (dollarPermitted AND 132 | next = '$' AND ASCII.isAlphanum(source.la2Char())); 133 | 134 | UNTIL NOT isIdentChar; 135 | 136 | IF allChars = upperChars THEN (* possibly reserved word found *) 137 | (* TO DO check for reserved word match *) 138 | 139 | ELSE (* not a reserved word *) 140 | token := Token.Identifier 141 | END 142 | 143 | END IdentOrResword; 144 | 145 | 146 | (* --------------------------------------------------------------------------- 147 | * procedure NumericLiteral ( source, token ) 148 | * matches the input in s to a numeric literal 149 | * --------------------------------------------------------------------------- 150 | * EBNF 151 | * 152 | * NumericLiteral : 153 | * '0' ( RealNumberTail | NonDecimalNumberTail )? | 154 | * ( '1' .. '9' ) DecimalNumberTail? 155 | * ; 156 | * 157 | * NonDecimalNumberTail : 158 | * 'b' Base2DigitSeq | ( 'u' | 'x' ) Base16DigitSeq 159 | * ; 160 | * 161 | * pre-conditions: 162 | * (1) s is the current input source and it must not be NIL. 163 | * (2) lookahead of s is the first digit of the literal. 164 | * 165 | * post-conditions: 166 | * (1) lookahead of s is the character immediately following the last digit 167 | * of the literal whose first digit was the lookahead of s upon entry 168 | * into the procedure. 169 | * (2) if the numeric literal represents a whole number, 170 | * token value WholeNumber is passed back in token. 171 | * if the numeric literal represents a character code, 172 | * token value QuotedChar is passed back in token. 173 | * if the numeric literal represents a real number, 174 | * token value RealNumber is passed back in token. 175 | * 176 | * error-conditions: 177 | * (1) missing digit after prefix 178 | * TO DO 179 | * (2) missing fractional part after decimal point 180 | * TO DO 181 | * (3) missing exponent part after exponent prefix 182 | * TO DO 183 | * (4) maximum length exceeded 184 | * TO DO 185 | * --------------------------------------------------------------------------- 186 | *) 187 | PROCEDURE NumericLiteral 188 | ( source : Source; token : Token; VAR diag : Diagnostic ); 189 | 190 | VAR 191 | ch, next : CHAR; 192 | 193 | BEGIN 194 | 195 | source.GetChar(ch, next); 196 | 197 | IF ch = '0' THEN 198 | 199 | CASE next OF 200 | | '.' : (* sole '0' or real number *) 201 | IF source.la2Char() # '.' THEN 202 | (* real number found *) 203 | next := matchRealNumberTail(source) 204 | END (* IF *) 205 | 206 | | 'b' : (* base-2 integer *) 207 | next := matchBase2DigitSeq(source) 208 | 209 | | 'u' : (* character code *) 210 | next := matchBase16DigitSeq(source) 211 | 212 | | 'x' : (* base-16 integer *) 213 | next := matchBase16DigitSeq(source) 214 | 215 | END (* CASE *) 216 | 217 | ELSIF ch >= '1' AND ch <= '9' THEN 218 | (* decimal integer or real number *) 219 | next := matchDecimalNumberTail(source) 220 | END (* IF *) 221 | 222 | END NumericLiteral; 223 | 224 | 225 | (* --------------------------------------------------------------------------- 226 | * procedure QuotedLiteral ( source, token ) 227 | * matches the input in s to a quoted literal 228 | * --------------------------------------------------------------------------- 229 | * EBNF 230 | * 231 | * QuotedLiteral : 232 | * SingleQuotedLiteral | DoubleQuotedLiteral 233 | * ; 234 | * 235 | * SingleQuotedLiteral : 236 | * "'" ( QuotableCharacter | '"' )* "'" 237 | * ; 238 | * 239 | * DoubleQuotedLiteral : 240 | * '"' ( QuotableCharacter | "'" )* '"' 241 | * ; 242 | * 243 | * pre-conditions: 244 | * (1) s is the current input source and it must not be NIL. 245 | * (2) lookahead of s is the opening quotation mark of the literal. 246 | * 247 | * post-conditions: 248 | * (1) lookahead of s is the character immediately following the closing 249 | * quotation mark that closes the literal whose opening quotation mark 250 | * was the lookahead of s upon entry into the procedure. 251 | * (2) if the quoted literal represents the empty string or a single 252 | * character, token value quotedChar is passed back in token. 253 | * Otherwise, token value quotedString is passed back in token. 254 | * 255 | * error-conditions: 256 | * (1) eof reached 257 | * TO DO 258 | * (2) illegal character encountered 259 | * TO DO 260 | * (3) unescaped backslash encountered 261 | * TO DO 262 | * (4) maximum length exceeded 263 | * TO DO 264 | * --------------------------------------------------------------------------- 265 | *) 266 | PROCEDURE QuotedLiteral 267 | ( source : Source; token : Token; VAR diag : Diagnostic ); 268 | 269 | VAR 270 | next, delimiter : CHAR; 271 | 272 | BEGIN 273 | 274 | (* consume string delimiter *) 275 | source.GetChar(delimiter, next); 276 | 277 | WHILE next # delimiter DO 278 | 279 | (* check for control characters *) 280 | IF ASCII.isControl(next) THEN 281 | 282 | IF next = ASCII.NEWLINE THEN 283 | 284 | (* error: new line in string literal *) 285 | 286 | ELSIF source.eof() THEN 287 | 288 | (* error: EOF in string literal *) 289 | 290 | ELSE (* any other control character *) 291 | 292 | (* error: illegal character in string literal *) 293 | 294 | END (* IF *) 295 | END (* IF *) 296 | 297 | (* check for escape sequence *) 298 | IF next = ASCII.BACKSLASH THEN 299 | 300 | next := source.consumeChar(); 301 | 302 | IF next # 'n' AND # = 't' AND next # ASCII.BACKSLASH THEN 303 | 304 | (* error: invalid escape sequence *) 305 | 306 | END (* IF *) 307 | END (* IF *) 308 | 309 | next := source.consumeChar() 310 | END (* WHILE *) 311 | 312 | (* consume closing delimiter *) 313 | IF next = delimiter THEN 314 | next := source.consumeChar(); 315 | END (* IF *) 316 | 317 | END QuotedLiteral; 318 | 319 | 320 | (* --------------------------------------------------------------------------- 321 | * procedure ChevronText ( source, token ) 322 | * matches the input in s to chevron text 323 | * --------------------------------------------------------------------------- 324 | * EBNF 325 | * 326 | * ChevronText : 327 | * "<<" ( QuotableCharacter | "'" | '"' )* ">>" 328 | * ; 329 | * 330 | * pre-conditions: 331 | * (1) s is the current input source and it must not be NIL. 332 | * (2) lookahead of s is the first character of the opening chevron. 333 | * 334 | * post-conditions: 335 | * (1) lookahead of s is the character immediately following the last 336 | * character of the closing chevron that closes the chevron text whose 337 | * opening delimiter was the lookahead of s upon entry into the procedure. 338 | * (2) token value chevronText is passed back in token 339 | * 340 | * error-conditions: 341 | * (1) eof reached 342 | * TO DO 343 | * (2) illegal character encountered 344 | * TO DO 345 | * (3) maximum length exceeded 346 | * TO DO 347 | * --------------------------------------------------------------------------- 348 | *) 349 | PROCEDURE MatchChevronText 350 | ( source : Source; VAR token : Token; VAR diag : Diagnostic ); 351 | 352 | BEGIN 353 | 354 | (* TO DO *) 355 | 356 | END ChevronText; 357 | 358 | 359 | (* Non-Semantic Symbols *) 360 | 361 | (* --------------------------------------------------------------------------- 362 | * procedure Pragma ( source, diag ) 363 | * matches the input in source to a pragma 364 | * --------------------------------------------------------------------------- 365 | * EBNF 366 | * 367 | * Pragma : 368 | * "<*" ( QuotableCharacter | QuotedLiteral )* "*>" 369 | * ; 370 | * 371 | * pre-conditions: 372 | * (1) s is the current input source and it must not be NIL. 373 | * (2) lookahead of s is the first character of the opening pragma delimiter. 374 | * 375 | * post-conditions: 376 | * (1) lookahead of s is the character immediately following the last 377 | * character of the closing delimiter that closes the pragma whose 378 | * opening delimiter was the lookahead of s upon entry into the procedure. 379 | * (2) token value pragma is passed back in token 380 | * 381 | * error-conditions: 382 | * (1) eof reached 383 | * TO DO 384 | * (2) illegal character encountered 385 | * TO DO 386 | * (3) maximum length exceeded 387 | * TO DO 388 | * --------------------------------------------------------------------------- 389 | *) 390 | PROCEDURE Pragma ( source : Source; VAR diag : Diagnostic ); 391 | 392 | VAR 393 | next : CHAR; 394 | delimiterFound : BOOLEAN; 395 | 396 | BEGIN 397 | 398 | delimiterFound := FALSE; 399 | 400 | (* consume opening '<' and '*' *) 401 | next := source.consumeChar(); 402 | next := source.consumeChar(); 403 | 404 | WHILE NOT delimiterFound DO 405 | 406 | IF next = '*' AND source.la2Char() = '>' THEN 407 | delimiterFound := TRUE; 408 | 409 | (* consume closing '*' and '>' *) 410 | next := source.consumeChar(); 411 | next := source.consumeChar(); 412 | ELSE (* not closing delimiter *) 413 | 414 | (* consume this character *) 415 | next := source.consumeChar() 416 | 417 | (* TO DO check for eof, illegal chars, report diagnostics *) 418 | 419 | END (* IF *) 420 | END (* WHILE *) 421 | 422 | END Pragma; 423 | 424 | 425 | (* --------------------------------------------------------------------------- 426 | * procedure LineComment ( source, diag ) 427 | * matches the input in source to a line comment 428 | * --------------------------------------------------------------------------- 429 | * EBNF 430 | * 431 | * LineComment : 432 | * "!" CommentCharacter* EndOfLine 433 | * ; 434 | * 435 | * pre-conditions: 436 | * (1) s is the current input source and it must not be NIL. 437 | * (2) lookahead of s is the opening exclamation point of a line comment. 438 | * 439 | * post-conditions: 440 | * (1) if the comment is terminated by end-of-line: 441 | * lookahead of s is the new-line character that closes the line comment 442 | * whose opening exclamation point was the lookahead of s upon entry 443 | * into the procedure, or 444 | * if the comment is terminated by end-of-file: 445 | * the last character in input s has been consumed. 446 | * (2) token value lineComment is passed back in token 447 | * 448 | * error-conditions: 449 | * (1) illegal character encountered 450 | * TO DO 451 | * (2) maximum comment length exceeded 452 | * TO DO 453 | * --------------------------------------------------------------------------- 454 | *) 455 | PROCEDURE LineComment ( source : Source; VAR diag : Diagnostic ); 456 | 457 | VAR 458 | next : CHAR; 459 | 460 | BEGIN 461 | 462 | REPEAT 463 | next := source.consumeChar(); 464 | UNTIL source.eof() OR (next = ASCII.NEWLINE); 465 | 466 | END LineComment; 467 | 468 | 469 | (* --------------------------------------------------------------------------- 470 | * procedure BlockComment ( source, diag ) 471 | * matches the input in source to a block comment 472 | * --------------------------------------------------------------------------- 473 | * EBNF 474 | * 475 | * BlockComment : 476 | * '(' '*' ( CommentCharacter | BlockComment | EndOfLine )* '*' ')' 477 | * ; 478 | * 479 | * pre-conditions: 480 | * (1) s is the current input source and it must not be NIL. 481 | * (2) lookahead of s is the opening parenthesis of a block comment. 482 | * 483 | * post-conditions: 484 | * (1) lookahead of s is the character immediately following the closing 485 | * parenthesis that closes the block comment whose opening parenthesis 486 | * was the lookahead of s upon entry into the procedure. 487 | * (2) token value blockComment is passed back in token 488 | * 489 | * error-conditions: 490 | * (1) eof reached 491 | * TO DO 492 | * (2) illegal character encountered 493 | * TO DO 494 | * (3) maximum comment length exceeded 495 | * TO DO 496 | * (4) maximum nesting level exceeded 497 | * TO DO 498 | * --------------------------------------------------------------------------- 499 | *) 500 | PROCEDURE BlockComment ( source : Source; VAR diag : Diagnostic ); 501 | 502 | VAR 503 | ch, next : CHAR; 504 | nestLevel : CARDINAL; 505 | 506 | BEGIN 507 | 508 | nestLevel := 1; 509 | 510 | WHILE NOT source.eof() AND (nestLevel > 0) DO 511 | source.GetChar(ch, next); 512 | 513 | IF (ch = "*") AND (next = ")") THEN 514 | source.ConsumeChar(); 515 | nestLevel-- 516 | 517 | ELSIF (ch = "(") AND (next = "*") THEN 518 | source.ConsumeChar(); 519 | nestLevel++ 520 | 521 | END; 522 | 523 | source.ConsumeChar() 524 | 525 | END; (* WHILE *) 526 | 527 | (* TO DO : diagnostics *) 528 | 529 | END BlockComment; 530 | 531 | 532 | (* Disabled Code Sections *) 533 | 534 | (* --------------------------------------------------------------------------- 535 | * procedure DisabledCode ( source, diag ) 536 | * matches the input in source to a disabled code block 537 | * --------------------------------------------------------------------------- 538 | * EBNF 539 | * 540 | * DisabledCode : 541 | * ( StartOfSourceFile | EndOfLine ) '?' '<' 542 | * ( PrintableCharacter | Tabulator | EndOfLine )* 543 | * EndOfLine '>' '?' 544 | * ; 545 | * 546 | * pre-conditions: 547 | * (1) s is the current input source and it must not be NIL. 548 | * (2) lookahead of s is the opening '?' of a disabled code block. 549 | * 550 | * post-conditions: 551 | * (1) lookahead of s is the character immediately following the closing 552 | * '?' that closes the disabled code block whose opening '?' 553 | * was the lookahead of s upon entry into the procedure. 554 | * 555 | * error-conditions: 556 | * (1) illegal character encountered 557 | * TO DO 558 | * --------------------------------------------------------------------------- 559 | *) 560 | PROCEDURE DisabledCode ( source : Source; VAR diag : Diagnostic ); 561 | 562 | VAR 563 | next : CHAR; 564 | delimiterFound : BOOLEAN; 565 | BEGIN 566 | 567 | delimiterFound := FALSE; 568 | 569 | (* consume opening '?' and '<' *) 570 | next := source.consumeChar(); 571 | next := source.consumeChar(); 572 | 573 | WHILE NOT delimiterFound AND NOT source.eof() DO 574 | 575 | (* check for closing delimiter *) 576 | IF next = '>' AND source.la2Char() = '?' AND source.currentCol() = 1 THEN 577 | delimiterFound := TRUE; 578 | 579 | (* consume closing '>' and '?' *) 580 | next := source.consumeChar(); 581 | next := source.consumeChar(); 582 | 583 | ELSE (* not closing delimiter *) 584 | (* consume this character *) 585 | next := source.consumeChar() 586 | 587 | (* TO DO check for illegal chars, report diagnostics *) 588 | 589 | END (* IF *) 590 | 591 | END (* WHILE *) 592 | 593 | END DisabledCode; 594 | 595 | 596 | (* Private Procedures *) 597 | 598 | (* --------------------------------------------------------------------------- 599 | * procedure matchDecimalNumberTail ( source, diag ) 600 | * matches the input in source to a decimal number tail 601 | * --------------------------------------------------------------------------- 602 | * EBNF 603 | * 604 | * DecimalNumberTail : 605 | * ; 606 | * 607 | * pre-conditions: 608 | * (1) s is the current input source and it must not be NIL. 609 | * (2) lookahead of s is a digit between 1 and 9 or a decimal point. 610 | * 611 | * post-conditions: 612 | * (1) lookahead of s is the character immediately following the last digit 613 | * of the literal whose first digit was the lookahead of s upon entry 614 | * into the procedure. 615 | * 616 | * error-conditions: 617 | * (1) illegal character encountered 618 | * TO DO 619 | * --------------------------------------------------------------------------- 620 | *) 621 | PROCEDURE matchDecimalNumberTail ( source : Source ) : CHAR; 622 | 623 | VAR 624 | next : CHAR; 625 | 626 | BEGIN 627 | 628 | (* TO DO *) 629 | 630 | END matchDecimalNumberTail; 631 | 632 | 633 | (* --------------------------------------------------------------------------- 634 | * procedure matchRealNumberTail ( source, diag ) 635 | * matches the input in source to a real number tail 636 | * --------------------------------------------------------------------------- 637 | * EBNF 638 | * 639 | * RealNumberTail : 640 | * ; 641 | * 642 | * pre-conditions: 643 | * (1) s is the current input source and it must not be NIL. 644 | * (2) lookahead of s is a decimal point. 645 | * 646 | * post-conditions: 647 | * (1) lookahead of s is the character immediately following the last digit 648 | * of the literal whose decimal point was the lookahead of s upon entry 649 | * into the procedure. 650 | * 651 | * error-conditions: 652 | * (1) illegal character encountered 653 | * TO DO 654 | * --------------------------------------------------------------------------- 655 | *) 656 | PROCEDURE matchRealNumberTail ( source : Source ) : CHAR; 657 | 658 | VAR 659 | next : CHAR; 660 | 661 | BEGIN 662 | 663 | (* TO DO *) 664 | 665 | END matchRealNumberTail; 666 | 667 | 668 | (* --------------------------------------------------------------------------- 669 | * procedure matchBase2DigitSeq ( source, diag ) 670 | * matches the input in source to a base-2 digit sequence 671 | * --------------------------------------------------------------------------- 672 | * EBNF 673 | * 674 | * Base2DigitSeq : 675 | * ; 676 | * 677 | * pre-conditions: 678 | * (1) s is the current input source and it must not be NIL. 679 | * (2) lookahead of s is a base-2 digit. 680 | * 681 | * post-conditions: 682 | * (1) lookahead of s is the character immediately following the last digit 683 | * of the literal whose first digit was the lookahead of s upon entry 684 | * into the procedure. 685 | * 686 | * error-conditions: 687 | * (1) illegal character encountered 688 | * TO DO 689 | * --------------------------------------------------------------------------- 690 | *) 691 | PROCEDURE matchBase2DigitSeq ( source : Source ) : CHAR; 692 | 693 | VAR 694 | next : CHAR; 695 | 696 | BEGIN 697 | 698 | (* TO DO *) 699 | 700 | END matchBase2DigitSeq; 701 | 702 | 703 | (* --------------------------------------------------------------------------- 704 | * procedure matchBase16DigitSeq ( source, diag ) 705 | * matches the input in source to a base-16 digit sequence 706 | * --------------------------------------------------------------------------- 707 | * EBNF 708 | * 709 | * Base16DigitSeq : 710 | * ; 711 | * 712 | * pre-conditions: 713 | * (1) s is the current input source and it must not be NIL. 714 | * (2) lookahead of s is a base-16 digit. 715 | * 716 | * post-conditions: 717 | * (1) lookahead of s is the character immediately following the last digit 718 | * of the literal whose first digit was the lookahead of s upon entry 719 | * into the procedure. 720 | * 721 | * error-conditions: 722 | * (1) illegal character encountered 723 | * TO DO 724 | * --------------------------------------------------------------------------- 725 | *) 726 | PROCEDURE matchBase16DigitSeq ( source : Source ) : CHAR; 727 | 728 | VAR 729 | next : CHAR; 730 | 731 | BEGIN 732 | 733 | (* TO DO *) 734 | 735 | END matchBase16DigitSeq; 736 | 737 | 738 | END MatchLex. -------------------------------------------------------------------------------- /imp/SimpleFileIO.mod: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | IMPLEMENTATION MODULE SimpleFileIO; 4 | 5 | (* Low Level File IO library *) 6 | 7 | IMPORT UNSAFE; 8 | 9 | 10 | TYPE File = POINTER TO FileDescriptor; 11 | 12 | TYPE FileDescriptor = RECORD 13 | handle : CStdIOFile; 14 | mode : Mode; 15 | status : Status 16 | END; 17 | 18 | TYPE CStdIOFile = UNSAFE.ADDRESS; 19 | 20 | TYPE CStdIOMode = ARRAY 2 OF CHAR; 21 | 22 | 23 | (* TO DO : port to R10 using FFI pragma *) 24 | 25 | (* C StdIO Library Interface -- legacy M2C syntax *) 26 | %{ 27 | #include 28 | 29 | #define stdio_fopen(fptr, name, mode) \ 30 | (fptr = (void *)fopen((char *)name, (char *)mode)) 31 | 32 | #define stdio_fclose(fptr, result) \ 33 | (result = fclose((FILE *)fptr)) 34 | 35 | #define stdio_fread(fptr, bufptr, item_size, item_count, items_read) \ 36 | (items_read = fread((void *)bufptr, item_size, item_count, (FILE *)fptr)) 37 | 38 | #define stdio_fwrite(fptr, bufptr, item_size, item_count, items_read) \ 39 | (items_read = fwrite((void *)bufptr, item_size, item_count, (FILE *)fptr)) 40 | 41 | #define stdio_ftell(fptr, offset) \ 42 | (offset = ftell((FILE *)fptr)) 43 | 44 | #define stdio_fseek(fptr, offset, result) \ 45 | (result = fseek(FILE *)fptr, (long)offset) 46 | 47 | #define stdio_ferror(fptr, result) \ 48 | (result = ferror((FILE *)fptr)) 49 | 50 | #define stdio_feof(fptr, result) \ 51 | (result = feof((FILE *)fptr)) 52 | 53 | %} 54 | 55 | (* Operations common to all modes *) 56 | 57 | PROCEDURE Open 58 | ( VAR f : File; 59 | CONST filename : ARRAY OF CHAR; mode : Mode; VAR s : Status ); 60 | (* Opens file filename in mode. Passes file handle in f and status in s. *) 61 | 62 | VAR 63 | fmode : CStdIOMode; 64 | fhandle : CStdIOFile; 65 | 66 | BEGIN 67 | 68 | (* compose C file mode string *) 69 | CASE mode OF 70 | | Read : fmode[0] := "r"; 71 | | Write : fmode[0] := "w"; 72 | | Append : fmode[0] := "a" 73 | END; (* CASE *) 74 | fmode[1] := CHR(0); 75 | 76 | (* open file via C stdio fopen *) 77 | stdio_fopen(fhandle, fpath, fmode); 78 | 79 | IF fhandle = NIL THEN 80 | (* fopen failed *) 81 | s := Status.Failure; 82 | RETURN 83 | END; 84 | 85 | NEW(f); 86 | 87 | IF f = NIL THEN 88 | (* allocation failed *) 89 | s := Status.Failure; 90 | RETURN 91 | END; 92 | 93 | s := Status.Success; 94 | f^.handle := fhandle; 95 | f^.mode := mode; 96 | f^.status := s; 97 | 98 | RETURN 99 | END Open; 100 | 101 | 102 | PROCEDURE GetStatus ( f : File; VAR s : Status ); 103 | (* Passes the status of the last operation on file f in s. *) 104 | 105 | BEGIN 106 | 107 | IF f = NIL THEN 108 | s := invalidFileRef 109 | ELSE 110 | s := f^.status 111 | END; 112 | 113 | RETURN 114 | END GetStatus; 115 | 116 | 117 | PROCEDURE Close ( VAR f : File; s : Status ); 118 | (* Closes file associated with file handle f. Passes status in s. *) 119 | 120 | VAR 121 | result : INTEGER; 122 | 123 | BEGIN 124 | 125 | IF f = NIL THEN 126 | s := invalidFileRef 127 | 128 | ELSE 129 | stdio_fclose(f^.handle, result); 130 | 131 | IF result = 0 THEN 132 | s := Status.Success; 133 | RELEASE(f) 134 | 135 | ELSE (* result # 0 *) 136 | (* TO DO : error handling *) 137 | 138 | END; 139 | 140 | RETURN 141 | END Close; 142 | 143 | 144 | (* Operations exclusive to mode read *) 145 | 146 | PROCEDURE SetPos ( f : File; pos : LONGCARD ); 147 | (* Sets the reading position of file f to pos. *) 148 | 149 | BEGIN 150 | (* TO DO *) 151 | END SetPos; 152 | 153 | 154 | PROCEDURE ReadOctets 155 | ( f : File; VAR buffer : ARRAY OF OCTET; VAR bytesRead : LONGCARD ); 156 | (* Reads contents starting at the current reading position of file f into 157 | buffer until either buffer is full or eof is reached. The number of octets 158 | actually read is passed in bytesRead. *) 159 | 160 | BEGIN 161 | (* TO DO *) 162 | END ReadOctets; 163 | 164 | 165 | PROCEDURE ReadChars 166 | ( f : File; VAR buffer : ARRAY OF CHAR; VAR charsRead : LONGCARD ); 167 | (* Reads contents starting at the current reading position of file f into 168 | buffer until either the pen-ultimate index of buffer is written or eof 169 | is reached. The buffer is then terminated with ASCII NUL. The number of 170 | characters actually read is passed in charsRead. *) 171 | 172 | BEGIN 173 | (* TO DO *) 174 | END ReadOctets; 175 | 176 | 177 | PROCEDURE eof ( f : File ) : BOOLEAN; 178 | (* Returns TRUE if the end of file f has been reached, otherwise FALSE. *) 179 | 180 | BEGIN 181 | (* TO DO *) 182 | END eof; 183 | 184 | 185 | (* Operations common to modes read and write *) 186 | 187 | PROCEDURE GetPos ( f : File; VAR pos : LONGCARD ); 188 | (* Passes the current reading or writing position of file f in pos. *) 189 | 190 | BEGIN 191 | (* TO DO *) 192 | END GetPos; 193 | 194 | 195 | (* Operations common to modes write and append *) 196 | 197 | PROCEDURE WriteOctets 198 | ( f : File; CONST buffer : ARRAY OF OCTET; VAR bytesWritten : LONGCARD ); 199 | (* Writes the contents of buffer at the current writing position to file f. 200 | The number of bytes actually written is passed in bytesWritten. *) 201 | 202 | BEGIN 203 | (* TO DO *) 204 | END WriteOctets; 205 | 206 | 207 | PROCEDURE WriteChars 208 | ( f : File; CONST buffer : ARRAY OF CHAR; VAR charsWritten : LONGCARD ); 209 | (* Writes the contents of buffer up to and excluding the first ASCII NUL 210 | character code at the current writing position to file f. 211 | The number of characters actually written is passed in charsWritten. *) 212 | 213 | BEGIN 214 | (* TO DO *) 215 | END WriteChars; 216 | 217 | 218 | END SimpleFileIO. -------------------------------------------------------------------------------- /imp/Source.mod: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | IMPLEMENTATION MODULE Source; 4 | 5 | (* Modula-2 Source File Reader *) 6 | 7 | IMPORT ASCII, SimpleFileIO, BuildParams, LexTab; 8 | 9 | 10 | (* Source Type *) 11 | 12 | TYPE Source = POINTER TO SourceDescriptor; 13 | 14 | 15 | (* Source Descriptor *) 16 | 17 | TYPE SourceDescriptor = RECORD 18 | index, (* lookahead index in source buffer *) 19 | endPos, (* end position index in source buffer *) 20 | lexPos : CARDINAL; (* marked position index in source buffer *) 21 | buffer : SourceBuffer; (* source buffer with entire source *) 22 | line : BuildParams.LineCounter; (* lookahead position line counter *) 23 | column : BuildParams.ColumnCounter (* lookahead position column counter *) 24 | END; 25 | 26 | 27 | (* Source Buffer *) 28 | 29 | TYPE SourceBuffer = ARRAY BuildParams.MaxSourceFileSize + 1 OF CHAR; 30 | (* always to be terminated by ASCII.NUL, therefore max index = size + 1 *) 31 | 32 | 33 | (* --------------------------------------------------------------------------- 34 | * Definitions 35 | * 36 | * start position : 37 | * the position of the first character in the source. 38 | * 39 | * end position : 40 | * the position of the last character in the source. 41 | * 42 | * lookahead position : 43 | * the position of the character to be consumed next. 44 | * 45 | * second lookahead position : 46 | * the position immediately following the lookahead position. 47 | * 48 | * marked position : 49 | * a position recorded as the start of a lexeme. 50 | * it is end position + 1 if no marker has been set. 51 | * 52 | * lookahead character : 53 | * the character at the lookahead position, 54 | * it is ASCII.NUL if its position > end position or if eof is set. 55 | * 56 | * second lookahead character : 57 | * the character at the second lookahead position, 58 | * it is ASCII.NUL if its position > end position or if eof is set. 59 | * 60 | * marked lexeme : 61 | * a character sequence that starts at the marked position (inclusively) 62 | * and ends at the lookahead position (exclusively). 63 | * 64 | * character consumption : 65 | * a character is consumed by advancing the lookahead position 66 | * to the character's second lookahead position or by setting eof. 67 | * 68 | * end-of-line marker: 69 | * an ASCII.LF, 70 | * or a sequence consisting of an ASCII.CR followed by an ASCII.LF, 71 | * or a sole ASCII.CR that is not immediately followed by ASCII.LF. 72 | * 73 | * The lookahead position of an end-of-line marker is the position 74 | * following the last character of the end-of-line marker. 75 | * 76 | * end-of-file flag: 77 | * abbreviated as eof flag, is a boolean value that is set when 78 | * the character at the end position has been consumed. 79 | * 80 | * --------------------------------------------------------------------------- 81 | *) 82 | 83 | 84 | (* Operations *) 85 | 86 | (* --------------------------------------------------------------------------- 87 | * procedure New ( source, filename, status ) 88 | * creates a new source instance, associated with filename 89 | * --------------------------------------------------------------------------- 90 | * pre-conditions: 91 | * TO DO 92 | * 93 | * post-conditions: 94 | * TO DO 95 | * 96 | * error-conditions: 97 | * TO DO 98 | * --------------------------------------------------------------------------- 99 | *) 100 | PROCEDURE New 101 | ( VAR s : Source; CONST filename : Filename; VAR status : Status ); 102 | (* Passes back a newly allocated source instance associated with name in s. 103 | The associated file is opened for reading and the lookahead position is 104 | set to the start position. Passes back NIL in s if unsuccessful. 105 | The status of the operation is passed back in status. *) 106 | 107 | VAR 108 | file : FileIO.File; 109 | source : Source; 110 | octetsRead : CARDINAL; 111 | 112 | BEGIN 113 | 114 | (* source must be NIL *) 115 | IF s # NIL THEN 116 | status := Status.AllocTargetNotNil; 117 | RETURN 118 | END; (* IF *) 119 | 120 | IF FileSizeOf(filename) > MaxSourceFileSize THEN 121 | status := Status.SourceExceedsMaxFileSize; 122 | RETURN 123 | END; (* IF *) 124 | 125 | (* allocate source instance *) 126 | NEW(source); 127 | 128 | (* read source file contents into buffer *) 129 | SimpleFileIO.Open(file, filename); 130 | SimpleFileIO.ReadOctets(file, source^.buffer, octetsRead); 131 | SimpleFileIO.Close(file); 132 | 133 | (* TO DO : check for and handle file IO errors *) 134 | 135 | (* set start and end position *) 136 | source^.index := 0; 137 | source^.endPos := octetsRead - 1; 138 | 139 | (* clear lexeme marker by setting it beyond end position *) 140 | source^.lexPos := source^.endPos + 1; 141 | 142 | (* terminate buffer *) 143 | source^.buffer[source^.endPos+1] := ASCII.NUL; 144 | 145 | (* initialise line and column counters *) 146 | source^.line := 1; source^.column := 1; 147 | 148 | (* pass back status and source *) 149 | status := Status.Success; 150 | s := source; 151 | 152 | END New; 153 | 154 | 155 | (* --------------------------------------------------------------------------- 156 | * procedure GetChar ( source, ch, next ) 157 | * consumes current lookahead character, passes back new lookahead character 158 | * --------------------------------------------------------------------------- 159 | * pre-conditions: 160 | * TO DO 161 | * 162 | * post-conditions: 163 | * TO DO 164 | * 165 | * error-conditions: 166 | * TO DO 167 | * --------------------------------------------------------------------------- 168 | *) 169 | PROCEDURE GetChar ( s : Source; VAR ch, next : CHAR ); 170 | (* Passes back the lookahead character in ch and consumes it. 171 | Passes back the new lookahead character in next without consuming it. *) 172 | 173 | BEGIN 174 | 175 | (* pass and consume lookahead character *) 176 | ch := s^.buffer[s^.index]; 177 | ConsumeChar(s); 178 | 179 | (* pass LF instead of CR *) 180 | IF ch = ASCII.CR THEN 181 | ch := ASCII.LF 182 | END; (* IF *) 183 | 184 | (* pass new lookahead character *) 185 | next := s^.buffer[s^.index]; 186 | 187 | (* pass LF instead of CR *) 188 | IF next := ASCII.CR THEN 189 | next := ASCII.LF 190 | END; (* IF *) 191 | 192 | END GetChar; 193 | 194 | 195 | (* --------------------------------------------------------------------------- 196 | * procedure consumeChar ( source ) 197 | * consumes current lookahead character, returns new lookahead character 198 | * --------------------------------------------------------------------------- 199 | * pre-conditions: 200 | * TO DO 201 | * 202 | * post-conditions: 203 | * TO DO 204 | * 205 | * error-conditions: 206 | * TO DO 207 | * --------------------------------------------------------------------------- 208 | *) 209 | PROCEDURE consumeChar ( s : source ); 210 | 211 | VAR 212 | ch : CHAR; 213 | 214 | BEGIN 215 | 216 | (* remember the lookahead character *) 217 | ch := s^.buffer[s^.index]; 218 | 219 | (* ... and consume it *) 220 | IF s^.index <= s^.endPos THEN 221 | s^.index++ 222 | 223 | END; (* IF *) 224 | 225 | (* check for new line *) 226 | IF (* new line *) (ch = ASCII.LF) OR (ch = ASCII.CR) THEN 227 | (* update line and column counters *) 228 | s^.line++; s^.column := 1; 229 | 230 | (* check for CR LF sequence *) 231 | IF (ch = ASCII.CR) AND (s^.buffer[s^.index] = ASCII.LF) THEN 232 | (* consume trailing LF *) 233 | s^.index++ 234 | 235 | END (* IF *) 236 | 237 | ELSE (* no new line *) 238 | (* update column counter only *) 239 | s^.column++ 240 | 241 | END (* IF *) 242 | 243 | (* return new lookahead *) 244 | RETURN ch 245 | END consumeChar; 246 | 247 | 248 | (* --------------------------------------------------------------------------- 249 | * procedure lookaheadChar ( source ) : CHAR 250 | * returns current lookahead character 251 | * --------------------------------------------------------------------------- 252 | * pre-conditions: 253 | * TO DO 254 | * 255 | * post-conditions: 256 | * TO DO 257 | * 258 | * error-conditions: 259 | * TO DO 260 | * --------------------------------------------------------------------------- 261 | *) 262 | PROCEDURE lookaheadChar ( s : Source ) : CHAR; 263 | (* Returns the lookahead character of s. 264 | Does not consume any character and does not set eof. *) 265 | 266 | VAR 267 | next : CHAR; 268 | 269 | BEGIN 270 | 271 | (* get lookahead character *) 272 | next := s^.buffer[s^.index]; 273 | 274 | (* return LF instead of CR *) 275 | IF next = ASCII.CR THEN 276 | next := ASCII.LF 277 | END; (* IF *) 278 | 279 | RETURN next 280 | END lookaheadChar; 281 | 282 | 283 | (* --------------------------------------------------------------------------- 284 | * procedure la2Char ( source ) : CHAR 285 | * returns second lookahead character 286 | * --------------------------------------------------------------------------- 287 | * pre-conditions: 288 | * TO DO 289 | * 290 | * post-conditions: 291 | * TO DO 292 | * 293 | * error-conditions: 294 | * TO DO 295 | * --------------------------------------------------------------------------- 296 | *) 297 | PROCEDURE la2Char ( s : Source ) : CHAR; 298 | (* Returns the second lookahead character of s. 299 | Does not consume any character and does not set eof. *) 300 | 301 | VAR 302 | next, la2 : CHAR; 303 | 304 | BEGIN 305 | 306 | (* return ASCII.NUL if lookahead is last character or beyond eof *) 307 | IF s^.index >= s^.endPos THEN 308 | RETURN ASCII.NUL 309 | END; (* IF *) 310 | 311 | (* get lookahead and tentative second lookahead *) 312 | next := s^.buffer[s^.index]; 313 | la2 := s^.buffer[s^.index+1]; 314 | 315 | (* check if lookahead is CR LF sequence *) 316 | IF (next = ASCII.CR) AND (la2 = ASCII.LF) THEN 317 | 318 | (* return ASCII.NUL if CR LF is at the very end of source *) 319 | IF s^.index+1 >= s^.endPos THEN 320 | RETURN ASCII.NUL 321 | END; (* IF *) 322 | 323 | (* otherwise second lookahead is character after CR LF sequence *) 324 | la2 := s^.buffer[s^.index+2] 325 | END (* IF *) 326 | 327 | (* return LF instead of CR *) 328 | IF la2 = ASCII.CR THEN 329 | la2 := ASCII.LF 330 | END; (* IF *) 331 | 332 | RETURN la2 333 | END la2Char; 334 | 335 | 336 | (* --------------------------------------------------------------------------- 337 | * procedure MarkLexeme ( source, line, col ) 338 | * marks current lookahead position as the start of a lexeme 339 | * --------------------------------------------------------------------------- 340 | * pre-conditions: 341 | * TO DO 342 | * 343 | * post-conditions: 344 | * TO DO 345 | * 346 | * error-conditions: 347 | * TO DO 348 | * --------------------------------------------------------------------------- 349 | *) 350 | PROCEDURE MarkLexeme ( s : Source; VAR line, col : CARDINAL ); 351 | (* Marks the lookahead position in s as the start of the marked lexeme. 352 | Passes back lookahead position line and column counters in line and col. *) 353 | 354 | BEGIN 355 | 356 | s^.lexPos := s^.index; 357 | line := s^.line; 358 | col := s^.column 359 | 360 | END MarkLexeme; 361 | 362 | 363 | (* --------------------------------------------------------------------------- 364 | * procedure CopyLexeme ( source, dict, handle ) 365 | * adds a marked lexeme to lexeme dictionary dict 366 | * --------------------------------------------------------------------------- 367 | * pre-conditions: 368 | * TO DO 369 | * 370 | * post-conditions: 371 | * TO DO 372 | * 373 | * error-conditions: 374 | * TO DO 375 | * --------------------------------------------------------------------------- 376 | *) 377 | PROCEDURE CopyLexeme ( s : Source; dict : LexDict; VAR handle : DictHandle ); 378 | (* Adds the marked lexeme in s to lexeme dictionary dict, passes its access 379 | handle back in handle and clears the lexeme marker. If no lexeme marker 380 | has been set, no content is copied and zero is passed back in handle. *) 381 | 382 | VAR 383 | length : CARDINAL; 384 | 385 | BEGIN 386 | 387 | (* return zero handle if no lexeme marker is set *) 388 | IF s^.lexPos >= s^.index THEN 389 | handle := 0; 390 | RETURN 391 | END; 392 | 393 | (* store marked lexeme in lexeme dictionary *) 394 | length := s^.index - s^.lexPos; 395 | store(dict, s^.buffer, s^.lexPos, length, handle); 396 | 397 | (* clear lexeme marker by setting it beyond end position *) 398 | s^.lexPos := s^.endPos + 1 399 | 400 | END CopyLexeme; 401 | 402 | 403 | (* --------------------------------------------------------------------------- 404 | * procedure GetLineAndColumn ( source, line, column ) 405 | * passes back line and column counters for current lookahead position 406 | * --------------------------------------------------------------------------- 407 | * pre-conditions: 408 | * TO DO 409 | * 410 | * post-conditions: 411 | * TO DO 412 | * 413 | * error-conditions: 414 | * TO DO 415 | * --------------------------------------------------------------------------- 416 | *) 417 | PROCEDURE GetLineAndColumn ( s : Source; VAR line, col : CARDINAL ); 418 | (* Passes back the current line and column counters of s in line and col. *) 419 | 420 | BEGIN 421 | 422 | line := s^.line; 423 | col := s^.column 424 | 425 | END GetLineAndColumn; 426 | 427 | 428 | (* --------------------------------------------------------------------------- 429 | * procedure eof ( source ) : BOOLEAN 430 | * returns TRUE if last character in source has been consumed, else FALSE 431 | * --------------------------------------------------------------------------- 432 | * pre-conditions: 433 | * TO DO 434 | * 435 | * post-conditions: 436 | * TO DO 437 | * 438 | * error-conditions: 439 | * TO DO 440 | * --------------------------------------------------------------------------- 441 | *) 442 | PROCEDURE eof ( s : Source ) : BOOLEAN; 443 | 444 | BEGIN 445 | (* eof is set if lookahead position is greater than end position *) 446 | RETURN s^.index > s^.endPos 447 | END eof; 448 | 449 | 450 | (* --------------------------------------------------------------------------- 451 | * procedure Release ( source ) 452 | * releases source instance 453 | * --------------------------------------------------------------------------- 454 | * pre-conditions: 455 | * (1) source must not be NIL 456 | * 457 | * post-conditions: 458 | * (1) lexer is deallocated 459 | * (2) NIL is passed back in source 460 | * 461 | * error-conditions: 462 | * (1) reference to source remains unmodified 463 | * --------------------------------------------------------------------------- 464 | *) 465 | PROCEDURE Release ( VAR s : Source; VAR status : Status ); 466 | 467 | BEGIN 468 | 469 | IF s # NIL THEN 470 | RELEASE(s); 471 | status := Status.Success; 472 | s := NIL 473 | ELSE 474 | status := invalidReference 475 | END (* IF *) 476 | 477 | END Release; 478 | 479 | 480 | END Source. -------------------------------------------------------------------------------- /imp/Token.mod: -------------------------------------------------------------------------------- 1 | (*!m2r10*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | IMPLEMENTATION MODULE Token; 4 | 5 | (* Token Subranges *) 6 | 7 | TYPE 8 | ResWords = [Alias..Yield] OF Token; 9 | ProcBindables = [Abs..Writef] OF Token; 10 | ConstBindables = [Tbase..Trefc] OF Token; 11 | Identifiers = [Abs..OtherIdent] OF Token; 12 | Numbers = [WholeNumber..RealNumber] OF Token; 13 | CharsAndStrings = [CharCode..QuotedString] OF Token; 14 | NonOpPunctuation = [Dot..Minus] OF Token; 15 | Operators = [Equal..TypeConv] OF Token; 16 | NonRWOperL1 = [Equal..Identity] OF Token; 17 | NonRWOperL2 = [Plus..SetDiff] OF Token; 18 | NonRWOperL3 = [Asterisk..RealDiv] OF Token; 19 | 20 | 21 | (* Functions To Determine Token Classification *) 22 | 23 | PROCEDURE isResWord ( t : Token ) : BOOLEAN; 24 | (* Returns TRUE if t is a reserved word, otherwise FALSE. *) 25 | BEGIN 26 | RETURN (t >= TMIN(ResWords) AND t <= TMAX(ResWords)) 27 | END isResWord; 28 | 29 | 30 | PROCEDURE isIdentifier ( t : Token ) : BOOLEAN; 31 | (* Returns TRUE if t is an identifier, otherwise FALSE. *) 32 | BEGIN 33 | RETURN (t >= TMIN(Identifiers) AND t <= TMAX(Identifiers)) 34 | END isResWord; 35 | 36 | 37 | PROCEDURE isConstBindableIdent ( t : Token ) : BOOLEAN; 38 | (* Returns TRUE if t is a constant bindable identifier, otherwise FALSE. *) 39 | BEGIN 40 | RETURN (t >= TMIN(ConstBindables) AND t <= TMAX(ConstBindables)) 41 | END isResWord; 42 | 43 | 44 | PROCEDURE isProcBindableIdent ( t : Token ) : BOOLEAN; 45 | (* Returns TRUE if t is a procedure bindable identifier, otherwise FALSE. *) 46 | BEGIN 47 | RETURN (t >= TMIN(ProcBindables) AND t <= TMAX(ProcBindables)) 48 | END isResWord; 49 | 50 | 51 | PROCEDURE isNumber ( t : Token ) : BOOLEAN; 52 | (* Returns TRUE if t is a number literal, otherwise FALSE. *) 53 | BEGIN 54 | RETURN (t >= TMIN(Numbers) AND t <= TMAX(Numbers)) 55 | END isNumber; 56 | 57 | 58 | PROCEDURE isCharOrString ( t : Token ) : BOOLEAN; 59 | (* Returns TRUE if t is a character or string, otherwise FALSE. *) 60 | BEGIN 61 | RETURN (t >= TMIN(CharsAndStrings) AND t <= TMAX(CharsAndStrings)) 62 | END isResWord; 63 | 64 | 65 | PROCEDURE isPunctuation ( t : Token ) : BOOLEAN; 66 | (* Returns TRUE if t is a number literal, otherwise FALSE. *) 67 | BEGIN 68 | RETURN 69 | (t >= TMIN(NonOpPunctuation) AND t <= TMAX(NonOpPunctuation)) OR 70 | (t = Token.Aster) OR (t = Token.Plus) OR (t = Token.Minus) 71 | END isPunctuation; 72 | 73 | 74 | PROCEDURE isOperL1 ( t : Token ) : BOOLEAN; 75 | (* Returns TRUE if t is a level-1 operator, otherwise FALSE. *) 76 | BEGIN 77 | RETURN 78 | (t = Token.In) OR 79 | (t >= TMIN(OperatorsL1) AND t <= TMAX(OperatorsL1)) 80 | END isOperL1; 81 | 82 | 83 | PROCEDURE isOperL2 ( t : Token ) : BOOLEAN; 84 | (* Returns TRUE if t is a level-2 operator, otherwise FALSE. *) 85 | BEGIN 86 | RETURN 87 | (t = Token.Or) OR 88 | (t >= TMIN(NonRWOperL2) AND t <= TMAX(NonRWOperL2)) 89 | END isOperL2; 90 | 91 | 92 | PROCEDURE isOperL3 ( t : Token ) : BOOLEAN; 93 | (* Returns TRUE if t is a level-3 operator, otherwise FALSE. *) 94 | BEGIN 95 | RETURN 96 | (t = Token.And) OR (t = Token.Div) OR (t = Token.Mod) OR 97 | (t >= TMIN(NonRWOperL2) AND t <= TMAX(NonRWOperL2)) 98 | END isOperL3; 99 | 100 | 101 | PROCEDURE isComment ( t : Token ) : BOOLEAN; 102 | (* Returns TRUE if t is a comment, otherwise FALSE. *) 103 | BEGIN 104 | RETURN (t = Token.Comment) 105 | END isComment; 106 | 107 | 108 | PROCEDURE isPragma ( t : Token ) : BOOLEAN; 109 | (* Returns TRUE if t is a pragma, otherwise FALSE. *) 110 | BEGIN 111 | RETURN (t = Token.Pragma) 112 | END isPragma; 113 | 114 | 115 | END Token. -------------------------------------------------------------------------------- /m2r10-grammar.gll: -------------------------------------------------------------------------------- 1 | /* M2R10 -- EBNF Grammar for Modula-2 Revision 2010, status Nov 15, 2016. 2 | * 3 | * Copyright (c) 2016 The Modula-2 Software Foundation 4 | * 5 | * Author & Maintainer: Benjamin Kowarsch 6 | * 7 | * @synopsis 8 | * 9 | * Modula-2 R10 is a modern revision of Modula-2 by B.Kowarsch and R.Sutcliffe 10 | * specified in "Modula-2 Revision 2010". 11 | * 12 | * This document describes the grammar of Modula-2 R10 in EBNF. 13 | * 14 | * @repository 15 | * 16 | * https://github.com/m2sf/m2r10 17 | * 18 | * @file 19 | * 20 | * m2r10-grammar.gll 21 | * 22 | * Grammar of Modula-2 R10 source files. 23 | * 24 | */ 25 | 26 | grammar Modula2; 27 | 28 | /* * * R e s e r v e d W o r d s * * */ 29 | 30 | reserved 31 | ALIAS, AND, ARGLIST, ARRAY, BARE, BEGIN, BLUEPRINT, BY, CASE, CONST, 32 | DEFINITION, DIV, DO, ELSE, ELSIF, END, EXIT, FOR, FROM, GENLIB, IF, 33 | IMPLEMENTATION, IMPORT, IN, LOOP, MOD, MODULE, NEW, NONE, NOT, OF, OPAQUE, 34 | OR, POINTER, PROCEDURE, RECORD, REFERENTIAL, RELEASE, REPEAT, RETAIN, 35 | RETURN, SET, THEN, TO, TYPE, UNTIL, VAR, WHILE, YIELD; 36 | 37 | 38 | /* * * N o n - T e r m i n a l S y m b o l s * * */ 39 | 40 | /* Compilation Unit */ 41 | 42 | compilationUnit := 43 | definitionModule | implOrPrgmModule | blueprint 44 | ; 45 | 46 | 47 | /*** Definition Module Syntax ***/ 48 | 49 | /* Definition Module */ 50 | 51 | definitionModule := 52 | DEFINITION MODULE moduleIdent 53 | ( '[' blueprintToObey ']' )? ( FOR typeToExtend )? ';' 54 | import* definition* END moduleIdent '.' 55 | ; 56 | 57 | /* Module Identifier */ 58 | 59 | alias moduleIdent = Ident ; 60 | 61 | /* Blueprint To Obey */ 62 | 63 | alias blueprintToObey = blueprintIdent ; 64 | 65 | /* Type To Extend */ 66 | 67 | alias typeToExtend = blueprintIdent ; 68 | 69 | /* Blueprint Identifier */ 70 | 71 | alias blueprintIdent = Ident ; 72 | 73 | 74 | /* Import */ 75 | 76 | import := 77 | IMPORT impexLib ( ',' impexLib )* | libGenDirective 78 | ; 79 | 80 | /* Import/Re-Export Library */ 81 | 82 | impexLib := 83 | libIdent reExport? 84 | ; 85 | 86 | /* Library Identifier */ 87 | 88 | alias libIdent = Ident ; 89 | 90 | /* Re-Export Tag */ 91 | 92 | alias reExport := '+' ; 93 | 94 | 95 | /* Library Generation Directive */ 96 | 97 | libGenDirective := 98 | GENLIB libIdent FROM template FOR substitutionList END 99 | ; 100 | 101 | /* Substitution List */ 102 | 103 | substitutionList := 104 | substitution ( ';' substitution )* 105 | ; 106 | 107 | /* Template */ 108 | 109 | alias template = Ident ; 110 | 111 | /* Substitution */ 112 | 113 | substitution := 114 | placeholder '=' replacement 115 | ; 116 | 117 | /* Placeholder */ 118 | 119 | alias placeholder = Ident ; 120 | 121 | /* Replacement */ 122 | 123 | replacement := 124 | NumberLiteral | StringLiteral | ChevronText 125 | ; 126 | 127 | 128 | /* Qualified Identifier */ 129 | 130 | qualident := 131 | Ident ( '.' Ident )* 132 | ; 133 | 134 | 135 | /* Identifier List */ 136 | 137 | identList := 138 | Ident ( ',' Ident )* 139 | ; 140 | 141 | 142 | /* Definition */ 143 | 144 | definition := 145 | CONST ( constDefinition ';' )+ | 146 | TYPE ( typeDefinition ';' )+ | 147 | VAR ( identList ':' typeIdent ';' )+ | 148 | procedureHeader ';' | 149 | toDoList ';' 150 | ; 151 | 152 | 153 | /* Constant Definition */ 154 | 155 | constDefinition := 156 | ( '[' propertyToBindTo ']' | restrictedExport )? 157 | Ident ( ':' typeIdent )? '=' constExpression 158 | ; 159 | 160 | /* Property To Bind To */ 161 | 162 | alias propertyToBindTo = Ident ; 163 | 164 | /* restricted Export */ 165 | 166 | alias restrictedExport = '*' ; 167 | 168 | /* Type Identifier */ 169 | 170 | alias typeIdent = qualident ; 171 | 172 | /* Constant Expression */ 173 | 174 | alias constExpression = expression ; 175 | 176 | 177 | /* Type Definition */ 178 | 179 | typeDefinition := 180 | restrictedExport? Ident '=' ( type | OPAQUE ) 181 | ; 182 | 183 | 184 | /* Type */ 185 | 186 | type := 187 | aliasType | derivedType | immutableType | subrangeType | enumType | 188 | setType | arrayType | recordType | pointerType | coroutineType | 189 | procedureType 190 | ; 191 | 192 | 193 | /* Alias Type */ 194 | 195 | aliasType := 196 | ALIAS OF typeIdent 197 | ; 198 | 199 | 200 | /* Derived Type */ 201 | 202 | alias derivedType = typeIdent ; 203 | 204 | 205 | /* Immutable Type */ 206 | 207 | immutableType := 208 | CONST typeIdent 209 | ; 210 | 211 | 212 | /* Subrange Type */ 213 | 214 | subrangeType := 215 | range OF ordinalOrScalarType 216 | ; 217 | 218 | /* Range */ 219 | 220 | range := 221 | '[' greaterThan? constExpression '..' lessThan? constExpression ']' 222 | ; 223 | 224 | /* Greater Than */ 225 | 226 | alias greaterThan = '>' ; 227 | 228 | /* Less Than */ 229 | 230 | alias lessThan = '<' ; 231 | 232 | /* Ordinal Or Scalar Type */ 233 | 234 | alias ordinalOrScalarType = typeIdent ; 235 | 236 | 237 | /* Enumeration Type */ 238 | 239 | enumType := 240 | '(' ( '+' enumTypeToExtend ',' )? identList 241 | ; 242 | 243 | 244 | /* Set Type */ 245 | 246 | setType := 247 | SET OF enumTypeIdent 248 | ; 249 | 250 | /* Enumeration Type Identifier */ 251 | 252 | alias enumTypeIdent = typeIdent ; 253 | 254 | 255 | /* Array Type */ 256 | 257 | arrayType := 258 | BARE? ARRAY valueCount ( ',' valueCount )* OF typeIdent 259 | ; 260 | 261 | /* Value Count */ 262 | 263 | alias valueCount = constExpression ; 264 | 265 | 266 | /* Record Type */ 267 | 268 | recordType := 269 | RECORD ( '(' recTypeToExtend ')' )? 270 | fieldList ( ';' fieldList )* END 271 | ; 272 | 273 | /* Record Type To Extend */ 274 | 275 | recTypeToExtend := 276 | typeIdent | NIL 277 | ; 278 | 279 | 280 | /* Field List */ 281 | 282 | fieldList := 283 | restrictedExport? varOrFieldDeclaration ( '=' constExpression )? 284 | ; 285 | 286 | 287 | /* Pointer Type */ 288 | 289 | pointerType := 290 | POINTER TO typeIdent 291 | ; 292 | 293 | 294 | /* Coroutine Type */ 295 | COROUTINE '(' assocProcType ')' 296 | ; 297 | 298 | /* Associated Procedure Type */ 299 | 300 | alias assocProcType = typeIdent ; 301 | 302 | 303 | /* Procedure Type */ 304 | 305 | procedureType := 306 | PROCEDURE ( '(' formalType ( ',' formalType )* ')' )? ( ':' returnedType )? 307 | ; 308 | 309 | 310 | /* Formal Type */ 311 | 312 | formalType := 313 | nonAttrFormalType | attributedFormalType | 314 | allocatingFormalType | variadicFormalType 315 | ; 316 | 317 | /* Returned Type */ 318 | 319 | alias returnedType = typeIdent ; 320 | 321 | 322 | /* Non-Attributed Formal Type */ 323 | 324 | nonAttrFormalType := 325 | ( BARE? ARRAY identList? OF )? typeIdent | castingFormalType 326 | ; 327 | 328 | 329 | /* Casting Formal Type */ 330 | 331 | castingFormalType := 332 | CAST ( BARE ARRAY OF OCTET | addressTypeIdent ) 333 | ; 334 | 335 | /* Address Type Ident */ 336 | 337 | addressTypeIdent := 338 | ( UNSAFE '.' )? ADDRESS 339 | ; 340 | 341 | 342 | /* Attributed Formal Type */ 343 | 344 | attributedFormalType := 345 | ( CONST | VAR ) ( nonAttrFormalType | simpleVariadicFormalType ) 346 | ; 347 | 348 | 349 | /* Allocating Formal Type */ 350 | 351 | allocatingFormalType := 352 | NEW ( pointerTypeIdent | CAST addressTypeIdent ) 353 | ; 354 | 355 | /* Pointer Type Identifier */ 356 | 357 | alias pointerTypeIdent = typeIdent ; 358 | 359 | 360 | /* Simple Variadic Formal Type */ 361 | 362 | simpleVariadicFormalType := 363 | ARGLIST reqNumOrArgs? OF nonAttrFormalType terminator? 364 | ; 365 | 366 | /* Required Number Of Arguments */ 367 | 368 | reqNumOrArgs := 369 | greaterThan? constExpression 370 | ; 371 | 372 | /* Terminator */ 373 | 374 | terminator := 375 | '|' constQualident 376 | ; 377 | 378 | /* Constant Qualified Identifier */ 379 | 380 | alias constQualident = qualident ; 381 | 382 | 383 | /* Variadic Formal Type */ 384 | 385 | variadicFormalType := 386 | ARGLIST reqNumOrArgs? OF 387 | ( '{' componentType ( ';' componentType)+ '}' | nonAttrFormalType ) 388 | terminator? 389 | ; 390 | 391 | 392 | /* Component Type */ 393 | 394 | componentType := 395 | ( CONST | VAR )? nonAttrFormalType 396 | ; 397 | 398 | 399 | /* Procedure Header */ 400 | 401 | procedureHeader := 402 | PROCEDURE ( '[' ( entityToBindTo | COROUTINE ) ']' | restrictedExport )? 403 | procedureSignature 404 | ; 405 | 406 | 407 | /* Procedure Signature */ 408 | 409 | procedureSignature := 410 | Ident ( '(' formalParams ( ';' formalParams )* ')' )? 411 | ( ':' returnedType )? defaultArg? 412 | ; 413 | 414 | /* Default Argument */ 415 | 416 | defaultArg := 417 | Ident '=' constExprOrConstArgFuncCall 418 | ; 419 | 420 | /* Constant Expression Or Constant Argument Function Call */ 421 | 422 | alias constExprOrConstArgFuncCall = expression ; 423 | 424 | /* PROCEDURE [WRITE] Write ( chan : Chan; val : T ) [chan=StdIO.StdOut]; 425 | replaces WRITE(value) with T.WriteF(StdIO.StdOut, value) */ 426 | 427 | 428 | /* Formal Parameters */ 429 | 430 | formalParams := 431 | identList ':' ( nonAttrFormalType | variadicFormalParams ) | 432 | attributedFormalParams | allocatingFormalParams 433 | ; 434 | 435 | 436 | /* Attributed Formal Parameters */ 437 | 438 | attributedFormalParams := 439 | ( CONST | VAR ) identList ':' 440 | ( nonAttrFormalType | simpleVariadicFormalType ) 441 | ; 442 | 443 | 444 | /* Allocating Formal Parameters */ 445 | 446 | allocatingFormalParams := 447 | NEW identList ':' ( pointerTypeIdent | CASE addressTypeIdent ) 448 | ; 449 | 450 | 451 | /* Variadic Formal Parameters */ 452 | 453 | variadicFormalParams := 454 | ARGLIST reqNumOfArgs? OF 455 | ( '{' componentParam ( componentParam ';' )+ '}' | nonAttrFormalType ) 456 | terminator? 457 | ; 458 | 459 | 460 | /* Component Parameter */ 461 | 462 | componentParam := 463 | ( CONST | VAR )? identList ':' nonAttrFormalType 464 | ; 465 | 466 | 467 | /*** Implementation and Program Module Syntax ***/ 468 | 469 | /* Implementation or Program Module */ 470 | 471 | implOrPrgmModule := 472 | IMPLEMENTATION MODULE moduleIdent ';' 473 | privateImport* block moduleIdent '.' 474 | ; 475 | 476 | 477 | /* Private Import */ 478 | 479 | privateImport := 480 | IMPORT libIdent ( ',' libIdent )* 481 | ; 482 | 483 | 484 | /* Block */ 485 | 486 | block := 487 | declaration* 488 | BEGIN statementSequence END 489 | ; 490 | 491 | 492 | /* Declaration */ 493 | 494 | declaration := 495 | ALIAS ( aliasDeclaration ';' )+ | 496 | CONST ( ident '=' constExpression ';' )+ | 497 | TYPE ( typeDeclaration ';' )+ | 498 | VAR ( varOrFieldDeclaration ';' )+ | 499 | procedureHeader ';' block Ident ';' | 500 | toDoList ';' 501 | ; 502 | 503 | 504 | /* Alias Declaration */ 505 | 506 | aliasDeclaration := 507 | namedAliasDecl | wildcardAliasDecl 508 | ; 509 | 510 | /* Named Alias Declaration */ 511 | 512 | namedAliasDecl := 513 | aliasName 514 | ( '=' qualifiedName | ( ',' aliasName )* '=' qualifiedWildcard ) 515 | ; 516 | 517 | /* Alias Name */ 518 | 519 | alias aliasName = Ident ; 520 | 521 | /* Qualified Name */ 522 | 523 | alias qualifiedName = qualident ; 524 | 525 | 526 | /* Qualified Wildcard */ 527 | 528 | qualifiedWildcard := 529 | qualident '.*' 530 | ; 531 | 532 | /* Wildcard Alias Declaration */ 533 | 534 | wildcardAliasDecl := 535 | '*' '=' qualifiedWildcard 536 | ; 537 | 538 | 539 | /* Type Declaration */ 540 | 541 | typeDeclaration := 542 | Ident '=' ( type | indeterminateType ) 543 | ; 544 | 545 | /* Indeterminate Type */ 546 | 547 | indeterminateType := 548 | IN RECORD fieldDeclaration ( fieldDeclaration ';' ) indeterminateField END 549 | ; 550 | 551 | /* Field Declaration */ 552 | 553 | alias fieldDeclaration = varOrFieldDeclaration ; 554 | 555 | /* Indeterminate Field */ 556 | 557 | indeterminateField := 558 | '+' Ident ':' BARE ARRAY discriminantFieldIdent OF typeIdent 559 | ; 560 | 561 | /* Discriminant Field Identifier */ 562 | 563 | alias discriminantFieldIdent = Ident ; 564 | 565 | 566 | /* Variable or Field Declaration */ 567 | 568 | varOrFieldDeclaration := 569 | identList ':' 570 | ( ( BARE? ARRAY valueCount OF )? typeIdent | subrangeType | procedureType ) 571 | ; 572 | 573 | 574 | /* Statement Sequence */ 575 | 576 | statementSequence := 577 | statement ( ';' statement )* 578 | ; 579 | 580 | 581 | /* Statement */ 582 | 583 | statement := 584 | emptyStatement | memMgtOperation | updateOrProcCall | returnStatement | 585 | ifStatement | caseStatement | loopStatement | whileStatement | 586 | repeatStatement | forStatement | EXIT 587 | ; 588 | 589 | /* Empty Statement */ 590 | 591 | alias emptyStatement = toDoList ; 592 | 593 | 594 | /* TO DO List */ 595 | 596 | toDoList := 597 | TO DO ( trackingRef ',' weight )? toDoTask ( ';' toDoTask )* END 598 | ; 599 | 600 | /* Issue Tracking Reference */ 601 | 602 | alias trackingRef = StringLiteral ; 603 | 604 | /* Weight */ 605 | 606 | alias weight = constExpression ; 607 | 608 | /* TO DO Task */ 609 | 610 | toDoTask := 611 | description ( ',' estimatedHours )? 612 | ; 613 | 614 | /* Description */ 615 | 616 | alias description = StringLiteral ; 617 | 618 | /* Estimated Hours */ 619 | 620 | alias estimatedHours = constExpression ; 621 | 622 | 623 | /* Memory Management Operation */ 624 | 625 | memMgtOperation := 626 | NEW designator ( OF initSize | := initValue ) | 627 | RETAIN designator | 628 | RELEASE designator 629 | ; 630 | 631 | /* Initialised Size */ 632 | 633 | alias initSize = expression ; 634 | 635 | /* Initialising Value */ 636 | 637 | alias initValue = expression ; 638 | 639 | 640 | /* Update Or Procedure Call */ 641 | 642 | updateOrProcCall := 643 | designator ( IncOrDecSuffix | ':=' expression | '(' expressionList ')' )? | 644 | COPY designator ':=' expression 645 | ; 646 | 647 | /* Increment Or Decrement Suffix */ 648 | 649 | .IncOrDecSuffix := '++' | '--' ; 650 | 651 | 652 | /* RETURN Or YIELD Statement */ 653 | 654 | returnStatement := 655 | ( RETURN | YIELD ) expression? 656 | ; 657 | 658 | 659 | /* IF Statement */ 660 | 661 | ifStatement := 662 | IF boolExpression THEN statementSequence 663 | ( ELSIF boolExpression THEN statementSequence )* 664 | ( ELSE statementSequence )? 665 | END 666 | ; 667 | 668 | /* Boolean Expression */ 669 | 670 | alias boolExpression = expression ; 671 | 672 | 673 | /* CASE Statement */ 674 | 675 | caseStatement := 676 | CASE expression OF ( '|' case )+ ( ELSE statementSequece )? END 677 | ; 678 | 679 | /* Case */ 680 | 681 | case := 682 | caseLabels ( ',' caseLabels )* : StatementSequence 683 | ; 684 | 685 | /* Case Labels */ 686 | 687 | caseLabels := 688 | constExpression ( .. constExpression )? 689 | ; 690 | 691 | 692 | /* LOOP Statement */ 693 | 694 | loopStatement := 695 | LOOP statementSequence END 696 | ; 697 | 698 | 699 | /* WHILE Statement */ 700 | 701 | whileStatement := 702 | WHILE boolExpression DO statementSequence END 703 | ; 704 | 705 | 706 | /* REPEAT Statement */ 707 | 708 | repeatStatement := 709 | REPEAT statementSequence UNTIL boolExpression 710 | ; 711 | 712 | 713 | /* FOR Statement */ 714 | 715 | forStatement := 716 | FOR forLoopVariants IN iterableExpr DO statementSequence END 717 | ; 718 | 719 | /* FOR Loop Variants */ 720 | 721 | forLoopVariants := 722 | accessor ascOrDesc? ( ',' value )? 723 | ; 724 | 725 | /* Accessor */ 726 | 727 | alias accessor = Ident ; 728 | 729 | /* Ascender Or Descender */ 730 | 731 | alias ascOrDesc = IncOrDecSuffix ; 732 | 733 | /* Value */ 734 | 735 | alias value = Ident ; 736 | 737 | /* Iterable Expression */ 738 | 739 | iterableExpr := 740 | designator | ordinalRange OF ordinalType 741 | ; 742 | 743 | /* Ordinal Range */ 744 | 745 | ordinalRange := 746 | '[' expression '..' expression ']' 747 | ; 748 | 749 | /* Ordinal Type */ 750 | 751 | alias ordinalType = typeIdent ; 752 | 753 | 754 | /* Designator */ 755 | 756 | designator := 757 | qualident designatorTail? 758 | ; 759 | 760 | /* Designator Tail */ 761 | 762 | designatorTail := 763 | ( ( '[' exprListOrSlice ']' | '^' ) ( '.' Ident )* )+ 764 | ; 765 | 766 | /* Expression List Or Slice */ 767 | 768 | exprListOrSlice := 769 | expression ( exprListTail | sliceTail )? 770 | ; 771 | 772 | /* Expression List Tail */ 773 | 774 | exprListTail := 775 | ( ',' expression )+ 776 | ; 777 | 778 | /* Slice Tail */ 779 | 780 | sliceTail := 781 | '..' expression? 782 | ; 783 | 784 | 785 | /* Expression List */ 786 | 787 | expressionList := 788 | expression ( ',' expression )* 789 | ; 790 | 791 | 792 | /* Expression */ 793 | 794 | expression := 795 | simpleExpression ( OperL1 simpleExpression )? 796 | ; 797 | 798 | /* Level-1 Operator */ 799 | 800 | .OperL1 := 801 | '=' | '#' | '<' | '<=' | '>' | '>=' | IN | IdentityOp 802 | ; 803 | 804 | /* Identity Operator */ 805 | 806 | alias IdentityOp = '==' ; 807 | 808 | 809 | /* Simple Expression */ 810 | 811 | simpleExpression := 812 | term ( OperL2 term )* | '-' simpleFactor 813 | ; 814 | 815 | /* Level-2 Operator */ 816 | 817 | .OperL2 := 818 | '+' | '-' | OR | ConcatOp | SetDiffOp 819 | ; 820 | 821 | /* Concatenation Operator */ 822 | 823 | alias ConcatOp = '&' ; 824 | 825 | /* Set Difference Operator */ 826 | 827 | alias SetDiffOp = '\' ; 828 | 829 | 830 | /* Term */ 831 | 832 | term := 833 | simpleTerm ( OperL3 simpleTerm )* 834 | ; 835 | 836 | /* Level-3 Operator */ 837 | 838 | .OperL2 := 839 | '*' | '/' | DIV | MOD | AND 840 | ; 841 | 842 | 843 | /* Simple Term */ 844 | 845 | simpleTerm := 846 | factor ( ExpOp factor )* | NOT factor 847 | ; 848 | 849 | /* Exponentiation Operator */ 850 | 851 | alias ExpOp = '**' ; 852 | 853 | 854 | /* Factor */ 855 | 856 | factor := 857 | simpleFactor ( TypeConvOp typeIdent )? 858 | ; 859 | 860 | /* Type Conversion Operator */ 861 | 862 | alias TypeConvOp = '::' ; 863 | 864 | 865 | /* Simple Factor */ 866 | 867 | simpleFactor := 868 | NumberLiteral | StringLiteral | 869 | structuredValue | designatorOrFuncCall | '(' expression ')' 870 | ; 871 | 872 | /* Designator Or Function Call */ 873 | 874 | designatorOrFuncCall := 875 | designator ( '(' expressionList? ')' )? 876 | ; 877 | 878 | /* Structured Value */ 879 | structuredValue := 880 | '{' valueComponent ( ',' valueComponent )* '}' 881 | ; 882 | 883 | /* Value Component */ 884 | 885 | valueComponent := 886 | constExpression ( ( '..' | 'BY' ) constExpression )? | 887 | runtimeExpression 888 | ; 889 | 890 | /* Runtime Expression */ 891 | 892 | alias runtimeExpression = expression ; 893 | 894 | 895 | /*** Blueprint Syntax ***/ 896 | 897 | /* Blueprint */ 898 | 899 | blueprint := 900 | BLUEPRINT blueprintIdent ( '[' blueprintToRefine ']' )? 901 | ( FOR blueprintForTypeToExtend )? 902 | ( ';' REFERENTIAL identList )? ';' 903 | MODULE TYPE '=' 904 | ( typeClassification ( ';' literalCompatibility )? | NONE ) ';' 905 | constraint* requirement* END blueprintIdent '.' 906 | ; 907 | 908 | /* Blueprint Identifier */ 909 | 910 | alias blueprintIdent = Ident ; 911 | 912 | /* Blueprint To Refine */ 913 | 914 | alias blueprintToRefine = blueprintIdent ; 915 | 916 | /* Blueprint For Type To Extend */ 917 | 918 | alias blueprintForTypeToExtend = blueprintIdent ; 919 | 920 | 921 | /* Type Classification */ 922 | 923 | typeClassification := 924 | '{' attributedClassification ( ',' attributedClassification )* ';' '*' '}' | 925 | '*' 926 | ; 927 | 928 | /* Attributed Classification */ 929 | 930 | attributedClassification := 931 | ( '+' | '-' ) classificationIdent 932 | ; 933 | 934 | /* Classification Identifier */ 935 | 936 | alias classificationIdent = Ident ; 937 | 938 | 939 | /* Literal Compatibility */ 940 | 941 | literalCompatibility := 942 | LITERAL '=' protoLiteral ( '|' protoLiteral )* 943 | ; 944 | 945 | /* Proto Literal */ 946 | 947 | protoLiteral := 948 | protoLiteralIdent | structuredProtoLiteral 949 | ; 950 | 951 | /* Proto Literal Identifier */ 952 | 953 | alias protoLiteralIdent = Ident ; 954 | 955 | 956 | /* Structured Proto Literal */ 957 | 958 | structuredProtoLiteral := 959 | '{' ( variadicProtoLiteral | protoLiteralComponentList ) '}' 960 | ; 961 | 962 | /* Variadic Proto Literal */ 963 | 964 | variadicProtoLiteral := 965 | ARGLIST reqValueCount? OF 966 | ( builtinOrReferential | '{' protoLiteralComponentList '}' ) 967 | ; 968 | 969 | /* Proto Literal Component List */ 970 | 971 | protoLiteralComponentList := 972 | builtinOrReferential ( ',' builtinOrReferential )* 973 | ; 974 | 975 | /* Required Value Count */ 976 | 977 | reqValueCount := 978 | greaterThan? wholeNumber 979 | ; 980 | 981 | /* Whole Number */ 982 | 983 | alias wholeNumber = NumberLiteral ; 984 | 985 | /* Built-in Or Referential Identifier */ 986 | 987 | alias builtinOrReferential = Ident ; 988 | 989 | 990 | /* Constraint */ 991 | 992 | constraint := 993 | constraintTerm ( oneWayDependency | mutualDependencyOrExclusion ) 994 | ; 995 | 996 | /* Constraint Term */ 997 | 998 | constraintTerm := 999 | '(' classificationOrFlagIdent ')' | '[' bindableEntityOrProperty ']' 1000 | ; 1001 | 1002 | /* Classification Or Flag Identifier */ 1003 | 1004 | alias classificationOrFlagIdent = Ident ; 1005 | 1006 | /* Bindable Entity Or Property */ 1007 | 1008 | bindableEntityOrProperty := 1009 | entityToBindTo | propertyToBindTo 1010 | ; 1011 | 1012 | /* One-Way Dependency */ 1013 | 1014 | oneWayDependency := 1015 | '->' termList ( '|' termList ) 1016 | ; 1017 | 1018 | /* Mutual Dependency Or Exclusion */ 1019 | 1020 | mutalDependencyOrExclusion := 1021 | ( '<>' | '><' ) termList 1022 | ; 1023 | 1024 | /* Term List */ 1025 | 1026 | termList := 1027 | constraintTerm ( ',' constraintTerm )* 1028 | ; 1029 | 1030 | 1031 | /* Requirement */ 1032 | 1033 | requirement := 1034 | ( condition '->' )? 1035 | ( constRequirement | typeRequirement | procRequirement ) 1036 | ; 1037 | 1038 | /* Condition */ 1039 | 1040 | condition := 1041 | NOT? boolConstant 1042 | ; 1043 | 1044 | /* Boolean Constant Identifier */ 1045 | 1046 | alias boolConstant = Ident ; 1047 | 1048 | 1049 | /* Constant Requirement */ 1050 | 1051 | constRequirement := 1052 | CONST 1053 | ( '[' propertyToBindTo ']' ( simpleConstRequirement | '=' NONE ) | 1054 | restrictedExport? simpleConstRequirement ) 1055 | ; 1056 | 1057 | /* Property To Bind To */ 1058 | 1059 | propertyToBindTo := 1060 | memMgtProperty | collectionProperty | scalarProperty | TFLAGS 1061 | ; 1062 | 1063 | /* Memory Management Property */ 1064 | 1065 | memMgtProperty := 1066 | TDYN | TREFC 1067 | ; 1068 | 1069 | /* Collection Property */ 1070 | 1071 | collectionProperty := 1072 | TORDERED | TSORTED | TLIMIT 1073 | ; 1074 | 1075 | /* Scalar Property */ 1076 | 1077 | scalarProperty := 1078 | TSCALAR | TMAX | TMIN 1079 | ; 1080 | 1081 | /* Simple Constant Requirement */ 1082 | 1083 | simpleConstRequirement := 1084 | Ident ( '=' constExpression | ':' builtInTypeIdent ) 1085 | ; 1086 | 1087 | /* Built-in Type Identifier */ 1088 | 1089 | alias builtInTypeIdent = Ident ; 1090 | 1091 | /* Restricted Export */ 1092 | 1093 | alias restrictedExport = '*' ; 1094 | 1095 | 1096 | /* Type Requirement */ 1097 | 1098 | typeRequirement := 1099 | TYPE typeDefinition 1100 | ; 1101 | 1102 | 1103 | /* Procedure Requirement */ 1104 | 1105 | procedureRequirement := 1106 | PROCEDURE 1107 | ( '[' ( entityToBindTo | COROUTINE ) ']' ( procedureSignature | '=' NONE ) | 1108 | restrictedExport? procedureSignature ) 1109 | ; 1110 | 1111 | /* Entity To Bind To */ 1112 | 1113 | entityToBindTo := 1114 | bindableResWord | bindableOperator | bindableMacro 1115 | ; 1116 | 1117 | /* Bindable Reserved Word */ 1118 | 1119 | bindableResWord := 1120 | NEW | RETAIN | RELEASE | COPY | bindableFor 1121 | ; 1122 | 1123 | /* Bindable FOR */ 1124 | 1125 | bindableFor := 1126 | FOR forBindingDifferentiator? 1127 | ; 1128 | 1129 | /* FOR Binding Differentiator */ 1130 | 1131 | alias forBindingDifferentiator = ascOrDesc ; 1132 | 1133 | /* Bindable Operator */ 1134 | 1135 | .BindableOperator := 1136 | '+' | '-' | '*' | '/' | '\' | '=' | '<' | '>' | '::' | 1137 | IN | DIV | MOD | UnaryMinus 1138 | ; 1139 | 1140 | /* Unary Minus */ 1141 | 1142 | alias UnaryMinus = '+/-' ; 1143 | 1144 | /* Bindable Macro */ 1145 | 1146 | bindableMacro := 1147 | ABS | LENGTH | EXISTS | SUBSET | READ | READNEW | WRITE | WRITEF | 1148 | SXF | VAL | multiBindableMacro1 | multiBindableMacro2 | multiBindableMacro3 1149 | ; 1150 | 1151 | /* Multi-Bindable Macro 1 */ 1152 | 1153 | multiBindableMacro1 := 1154 | ( COUNT | VALUE | SEEK ) bindingDifferentiator1? 1155 | ; 1156 | 1157 | /* Binding Differentiator 1 */ 1158 | 1159 | bindingDifferentiator1 := 1160 | ':' '#' 1161 | ; 1162 | 1163 | /* Multi-Bindable Macro 2 */ 1164 | 1165 | multiBindableMacro2 := 1166 | ( STORE | INSERT | REMOVE ) bindingDifferentiator2? 1167 | ; 1168 | 1169 | /* Binding Differentiator 2 */ 1170 | 1171 | bindingDifferentiator2 := 1172 | ':' ( ',' | '#' | '*' ) 1173 | ; 1174 | 1175 | /* Multi-Bindable Macro 3 */ 1176 | 1177 | multiBindableMacro3 := 1178 | APPEND bindingDifferentiator3? 1179 | ; 1180 | 1181 | /* Binding Differentiator 2 */ 1182 | 1183 | bindingDifferentiator3 := 1184 | ':' ( ',' | '*' ) 1185 | ; 1186 | 1187 | 1188 | /* * * T e r m i n a l S y m b o l s * * */ 1189 | 1190 | /* Identifier */ 1191 | 1192 | Ident := 1193 | Letter ( Letter | Digit )* 1194 | ; 1195 | 1196 | /* Foreign Identifier */ 1197 | 1198 | ForeignIdent := 1199 | Ident ForeignIdentTail+ | 1200 | '$' ( Letter | Digit ) ForeignIdentTail* 1201 | ; 1202 | 1203 | /* Foreign Identifier Tail */ 1204 | 1205 | .ForeignIdentTail := 1206 | ( '_' | '$' ) ( Letter | Digit )+ 1207 | ; 1208 | 1209 | 1210 | /* Number Literal */ 1211 | 1212 | NumberLiteral := 1213 | '0' ( RealNumberTail | 'b' Base2DigitSeq | ( 'x' | 'u' ) Base16DigitSeq )? | 1214 | ( '1' .. '9' ) DecimalNumberTail? 1215 | ; 1216 | 1217 | /* Real Number Tail */ 1218 | 1219 | .RealNumberTail := 1220 | '.' DigitSeq ( 'E' ( '+' | '-' )? DigitSeq )? 1221 | ; 1222 | 1223 | /* Decimal Number Tail */ 1224 | 1225 | .DecimalNumberTail := 1226 | DigitSep? DigitSeq RealNumberTail? 1227 | ; 1228 | 1229 | /* Digit Sequence */ 1230 | 1231 | .DigitSeq := 1232 | Digit+ ( DigitSep Digit+ )* 1233 | ; 1234 | 1235 | /* Base-2 Digit Sequence */ 1236 | 1237 | .Base2DigitSeq := 1238 | Base2Digit+ ( DigitSep Base2Digit+ )* 1239 | ; 1240 | 1241 | /* Base-16 Digit Sequence */ 1242 | 1243 | .Base16DigitSeq := 1244 | Base16Digit+ ( DigitSep Base16Digit+ )* 1245 | ; 1246 | 1247 | /* Digit Separator */ 1248 | 1249 | alias DigitSep = "'" ; 1250 | 1251 | /* Digit */ 1252 | 1253 | .Digit := '0' .. '9' ; 1254 | 1255 | /* Base-2 Digit */ 1256 | 1257 | .Base2Digit := '0' | '1' ; 1258 | 1259 | /* Base-16 Digit */ 1260 | 1261 | .Base16Digit := Digit | ( 'A' .. 'F' ) ; 1262 | 1263 | 1264 | /* String Literal */ 1265 | 1266 | StringLiteral := 1267 | SingleQuotedString | DoubleQuotedString 1268 | ; 1269 | 1270 | /* Single-Quoted String Literal */ 1271 | 1272 | .SingleQuotedString := 1273 | "'" ( QuotableCharacter | '"' )* "'" 1274 | ; 1275 | 1276 | /* Double-Quoted String Literal */ 1277 | 1278 | .DoubleQuotedString := 1279 | '"' ( QuotableCharacter | "'" )* '"' 1280 | ; 1281 | 1282 | /* Quotable Character */ 1283 | 1284 | .QuotableCharacter := 1285 | Digit | Letter | Space | NonAlphaNumQuotable | EscapedCharacter ; 1286 | 1287 | /* Letter */ 1288 | 1289 | .Letter := 'a' .. 'z' | 'A' .. 'Z' ; 1290 | 1291 | /* Whitespace */ 1292 | 1293 | .Space := 0u20 ; 1294 | 1295 | /* Non-Alphanumeric Quotable Character */ 1296 | 1297 | .NonAlphaNumQuotable := 1298 | '!' | '#' | '$' | '%' | '&' | '(' | ')' | '*' | '+' | ',' | 1299 | '-' | '.' | '/' | ':' | ';' | '<' | '=' | '>' | '?' | '@' | 1300 | '[' | '\' | ']' | '^' | '_' | '`' | '{' | '|' | '}' | '~' 1301 | ; 1302 | 1303 | /* Escaped Character */ 1304 | 1305 | .EscapedCharacter := 1306 | '\' ( 'n' | 't' | '\' ) 1307 | ; 1308 | 1309 | /* Chevron Delimited Source Text */ 1310 | 1311 | ChevronText := 1312 | '<<' ( QuotableCharacter | "'" | '"' )* '>>' 1313 | ; 1314 | 1315 | 1316 | /* * * I g n o r e S y m b o l s * * */ 1317 | 1318 | /* Whitespace */ 1319 | 1320 | Whitespace := 1321 | Space | Tabulator 1322 | ; 1323 | 1324 | /* Tabulator */ 1325 | .Tabulator := 0u9 ; 1326 | 1327 | 1328 | /* Line Comment */ 1329 | 1330 | LineComment := 1331 | '!' AnyPrintable* EndOfLine 1332 | ; 1333 | 1334 | /* Any Printable Character */ 1335 | 1336 | .AnyPrintable := 0u20 .. 0u7E ; /* greedy */ 1337 | 1338 | 1339 | /* Block Comment */ 1340 | 1341 | BlockComment := 1342 | '(*' ( AnyPrintable | BlockComment | EndOfLine )* '*)' 1343 | ; 1344 | 1345 | 1346 | /* Disabled Code Section */ 1347 | 1348 | DisabledCodeSection := 1349 | '?<' /* strictly in first column of a line */ 1350 | ( AnyPrintable | BlockComment | EndOfLine )* 1351 | '>?' /* strictly in first column of a line */ 1352 | ; 1353 | 1354 | 1355 | /* End of Line Marker */ 1356 | 1357 | EndOfLine := 1358 | LF | CR ( LF )? 1359 | ; 1360 | 1361 | /* ASCII LF */ 1362 | 1363 | .LF := 0uA ; 1364 | 1365 | /* ASCII CR */ 1366 | 1367 | .CR := 0uD ; 1368 | 1369 | 1370 | endg Modula2. 1371 | 1372 | /* END OF FILE */ --------------------------------------------------------------------------------