1 (* M2Lex.mod provides a non tokenised lexical analyser.
3 Copyright (C) 2001-2024 Free Software Foundation, Inc.
4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6 This file is part of GNU Modula-2.
8 GNU Modula-2 is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Modula-2 is distributed in the hope that it will be useful, but
14 WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Modula-2; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. *)
22 IMPLEMENTATION MODULE M2Lex ;
25 FROM FIO IMPORT File, OpenToRead, ReadChar, Close, IsNoError ;
26 FROM StrIO IMPORT ReadString, WriteString, WriteLn ;
27 FROM StdIO IMPORT Write ;
28 FROM NumberIO IMPORT WriteCard ;
29 FROM ASCII IMPORT nul, lf, cr, EOL ;
30 FROM StrLib IMPORT StrCopy, StrEqual, StrLen ;
44 FileName : ARRAY [0..MaxLine] OF CHAR ;
45 Lines : ARRAY [0..LineBuf] OF ARRAY [0..255] OF CHAR ;
46 (* Need two lines since the delimiter of the CurrentSymbol *)
47 (* maybe on the next line. *)
48 HighNext : CARDINAL ; (* Length of the NextChar line. *)
49 CurLine : CARDINAL ; (* Line number of the Current Char Line. *)
50 NextLine : CARDINAL ; (* Line number of the Next Char Line. *)
51 IndexCur : CARDINAL ; (* Index to the Lines array for Current Ln *)
52 IndexNext : CARDINAL ; (* Index to the Lines array for NextChar Ln *)
53 CurSym : CARDINAL ; (* Character start of the CurrentSymbol *)
54 CurSymLine : CARDINAL ; (* Line number of the CurrentSymbol *)
55 CurCharIndex : CARDINAL ; (* Character number of CurChar. *)
56 NextCharIndex : CARDINAL ; (* Character number of NextChar. *)
57 Eof : BOOLEAN ; (* End of source file. *)
58 InQuotes : BOOLEAN ; (* If we are in quotes. *)
59 QuoteChar : CHAR ; (* Quote character expected. *)
60 Stack : ARRAY [0..MaxStack] OF ARRAY [0..255] OF CHAR ;
65 IsSym - returns the result of the comparison between CurrentSymbol
69 PROCEDURE IsSym (Name: ARRAY OF CHAR) : BOOLEAN ;
71 RETURN( StrEqual(CurrentSymbol, Name) )
76 SymIs - if Name is equal to the CurrentSymbol the next Symbol is read
77 and true is returned, otherwise false is returned.
80 PROCEDURE SymIs (Name: ARRAY OF CHAR) : BOOLEAN ;
82 IF StrEqual(CurrentSymbol, Name)
93 WriteError - displays the source line and points to the symbol in error.
94 The message, a, is displayed.
97 PROCEDURE WriteError (a: ARRAY OF CHAR) ;
101 WriteString(FileName) ; Write(':') ; WriteCard(CurSymLine, 0) ; Write(':') ; WriteString(a) ;
103 WriteString( Lines[IndexCur] ) ; WriteLn ;
109 i := StrLen(CurrentSymbol) ;
115 WriteString(a) ; WriteLn ;
120 OpenSource - Attempts to open the source file, a.
121 The success of the operation is returned.
124 PROCEDURE OpenSource (a: ARRAY OF CHAR) : BOOLEAN ;
129 StrCopy(a, FileName) ;
142 CloseSource - Closes the current open file.
145 PROCEDURE CloseSource ;
156 GetSymbol - gets the next Symbol into CurrentSymbol.
159 PROCEDURE GetSymbol ;
161 StrCopy( CurrentSymbol, LastSymbol ) ;
165 StrCopy( Stack[StackPtr], CurrentSymbol )
167 ReadSymbol( CurrentSymbol )
173 PutSymbol - pushes a symbol, Name, back onto the input.
174 GetSymbol will set CurrentSymbol to, Name.
177 PROCEDURE PutSymbol (Name: ARRAY OF CHAR) ;
181 WriteError('Maximum push back symbol exceeded - Increase CONST MaxStack')
183 StrCopy(Name, Stack[StackPtr]) ;
189 PROCEDURE ReadSymbol (VAR a: ARRAY OF CHAR) ;
201 IF CurrentChar=QuoteChar
208 (* Fill in string or character *)
211 a[i] := CurrentChar ;
214 UNTIL (CurrentChar=QuoteChar) OR Eof OR (i>high) ;
217 (* Get rid of all excess spaces *)
222 WHILE (CurrentChar=' ') AND (NOT Eof) DO
226 ELSIF (CurrentChar='(') AND (NextChar='*')
235 CurSym := CurCharIndex ;
236 CurSymLine := CurLine ;
237 IF (CurrentChar='"') OR (CurrentChar="'")
240 QuoteChar := CurrentChar ;
241 a[i] := CurrentChar ;
244 ELSIF DoubleDelimiter()
246 a[i] := CurrentChar ;
249 a[i] := CurrentChar ;
254 a[i] := CurrentChar ;
259 a[i] := CurrentChar ;
262 UNTIL Delimiter() OR (i>high) OR (CurrentChar=' ') OR Eof
279 ConsumeComments - consumes Modula-2 comments.
282 PROCEDURE ConsumeComments ;
288 IF (CurrentChar='(') AND (NextChar='*')
291 ELSIF (CurrentChar='*') AND (NextChar=')')
296 UNTIL (Level=0) OR Eof ;
301 (* Delimiter returns true if and only if CurrentChar is a delimiter *)
303 PROCEDURE Delimiter() : BOOLEAN ;
305 IF (CurrentChar='-') OR
306 (CurrentChar='+') OR (CurrentChar='*') OR (CurrentChar='\') OR
307 (CurrentChar='|') OR (CurrentChar='(') OR (CurrentChar=')') OR
308 (CurrentChar='"') OR (CurrentChar="'") OR (CurrentChar='{')
312 (CurrentChar='}') OR (CurrentChar='[') OR (CurrentChar=']') OR
313 (CurrentChar='#') OR (CurrentChar='=') OR (CurrentChar='<')
317 (CurrentChar='>') OR (CurrentChar='.') OR (CurrentChar=';') OR
318 (CurrentChar=':') OR (CurrentChar='^') OR (CurrentChar=',')
327 PROCEDURE DoubleDelimiter () : BOOLEAN ;
330 ((CurrentChar='>') AND (NextChar='=')) OR
331 ((CurrentChar='<') AND (NextChar='=')) OR
332 ((CurrentChar='<') AND (NextChar='>')) OR
333 ((CurrentChar=':') AND (NextChar='=')) OR
334 ((CurrentChar='.') AND (NextChar='.'))
336 END DoubleDelimiter ;
339 PROCEDURE AdvanceChar ;
343 CurrentChar := NextChar ;
344 CurCharIndex := NextCharIndex ;
345 IndexCur := IndexNext ;
346 CurLine := NextLine ;
350 ELSIF NextCharIndex=HighNext
352 IndexNext := (IndexCur+1) MOD Wrap ;
355 NextChar := ReadChar(f) ;
359 Lines[IndexNext][HighNext] := NextChar ;
362 WHILE (NextChar#eof) AND (NextChar#lf) AND (NextChar#cr) AND (HighNext<MaxLine) DO
363 Lines[IndexNext][HighNext] := NextChar ;
365 NextChar := ReadChar(f) ;
371 IF (NextChar=eof) OR (NextChar=lf) OR (NextChar=cr)
375 Lines[IndexNext][HighNext] := ' ' ; (* Space for delimiter *)
376 Lines[IndexNext][HighNext+1] := nul ;
377 WriteError('missing end of quote on this source line') ; HALT
382 IF HighNext>=MaxLine THEN WriteError('Line too long') ; HALT END ;
383 Lines[IndexNext][HighNext] := ' ' ; (* Space for delimiter *)
384 Lines[IndexNext][HighNext+1] := nul ;
386 NextChar := Lines[IndexNext][NextCharIndex]
389 NextChar := Lines[IndexNext][NextCharIndex]
403 Lines[IndexCur][0] := nul ;
410 StrCopy("", CurrentSymbol) ;
411 StrCopy("", LastSymbol) ;
412 IndexCur := IndexNext