(* bnflex.mod provides a simple lexical package for pg.
Copyright (C) 2001-2023 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
This file is part of GNU Modula-2.
GNU Modula-2 is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.
GNU Modula-2 is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Modula-2; see the file COPYING3. If not see
<http://www.gnu.org/licenses/>. *)
IMPLEMENTATION MODULE bnflex ;
FROM PushBackInput IMPORT GetCh, PutCh, PutString, WarnError ;
FROM SymbolKey IMPORT SymbolTree, InitTree, PutSymKey, GetSymKey ;
FROM ASCII IMPORT tab, lf, nul ;
FROM Debug IMPORT Halt ;
FROM NameKey IMPORT Name, LengthKey, MakeKey, GetKey, WriteKey, NulName ;
FROM StrLib IMPORT StrEqual, StrLen ;
FROM FIO IMPORT File, IsNoError ;
FROM StrCase IMPORT Lower ;
FROM StdIO IMPORT Write ;
IMPORT PushBackInput ;
CONST
MaxNameLength = 8192 ;
VAR
f : File ;
ReservedWords: SymbolTree ;
CurrentToken : Name ;
CurrentType : TokenType ;
Debugging ,
InQuote : BOOLEAN ;
QuoteChar : CHAR ;
(*
OpenSource - Attempts to open the source file, a.
The success of the operation is returned.
*)
PROCEDURE OpenSource (a: ARRAY OF CHAR) : BOOLEAN ;
BEGIN
f := PushBackInput.Open(a) ;
RETURN( IsNoError(f) )
END OpenSource ;
(*
CloseSource - Closes the current open file.
*)
PROCEDURE CloseSource ;
BEGIN
PushBackInput.Close(f)
END CloseSource ;
(*
GetChar - returns the current character on the input stream.
*)
PROCEDURE GetChar () : CHAR ;
BEGIN
RETURN( PushBackInput.GetCh(f) )
END GetChar ;
(*
PutChar - pushes a character onto the push back stack, it also
returns the character which has been pushed.
*)
PROCEDURE PutChar (ch: CHAR) : CHAR ;
BEGIN
RETURN( PushBackInput.PutCh(ch) )
END PutChar ;
(*
EatChar - consumes the next character in the input.
*)
PROCEDURE EatChar ;
BEGIN
IF PushBackInput.GetCh(f)=nul
THEN
END
END EatChar ;
(*
IsWhite - returns TRUE if, ch, is a space or a tab.
*)
PROCEDURE IsWhite (ch: CHAR) : BOOLEAN ;
BEGIN
RETURN( (ch=' ') OR (ch=tab) OR (ch=lf) )
END IsWhite ;
(*
SkipWhite - skips all white space.
*)
PROCEDURE SkipWhite ;
BEGIN
WHILE IsWhite(PutChar(GetChar())) DO
EatChar
END
END SkipWhite ;
(*
SkipUntilEoln - skips until a lf is seen. It consumes the lf.
*)
PROCEDURE SkipUntilEoln ;
BEGIN
WHILE (PutChar(GetChar())#lf) AND (PutChar(GetChar())#nul) DO
EatChar
END ;
IF PutChar(GetChar())=lf
THEN
EatChar
END
END SkipUntilEoln ;
(*
SkipUntilWhite - skips all characters until white space is seen.
*)
PROCEDURE SkipUntilWhite ;
BEGIN
WHILE ((NOT IsWhite(PutChar(GetChar()))) AND (PutChar(GetChar())#nul)) OR
(PutChar(GetChar())=lf) DO
EatChar
END
END SkipUntilWhite ;
(*
IsReserved - returns TRUE if the name is a reserved word.
*)
PROCEDURE IsReserved (name: Name) : BOOLEAN ;
BEGIN
RETURN (GetSymKey(ReservedWords, name)#0)
END IsReserved ;
(*
GetCurrentTokenType - returns the type of current token.
*)
PROCEDURE GetCurrentTokenType () : TokenType ;
BEGIN
RETURN( CurrentType )
END GetCurrentTokenType ;
(*
GetCurrentToken - returns the NameKey of the current token.
*)
PROCEDURE GetCurrentToken () : Name ;
BEGIN
RETURN( CurrentToken )
END GetCurrentToken ;
(*
SkipComments - consumes comments.
*)
PROCEDURE SkipComments ;
BEGIN
SkipWhite ;
WHILE PutChar(GetChar())='-' DO
IF (GetChar()='-') AND (PutChar(GetChar())='-')
THEN
(* found comment, skip it *)
SkipUntilEoln ;
SkipWhite
ELSE
(* no second '-' found thus restore first '-' *)
IF PutChar('-')='-'
THEN
END ;
RETURN
END
END
END SkipComments ;
(*
WriteToken -
*)
PROCEDURE WriteToken ;
BEGIN
WriteKey(CurrentToken) ; Write(' ')
END WriteToken ;
(*
AdvanceToken - advances to the next token.
*)
PROCEDURE AdvanceToken ;
VAR
a: ARRAY [0..MaxNameLength] OF CHAR ;
i: CARDINAL ;
BEGIN
i := 0 ;
IF InQuote
THEN
IF CurrentType=literaltok
THEN
IF PutChar(GetChar())=QuoteChar
THEN
a[i] := GetChar() ;
InQuote := FALSE ;
INC(i) ;
a[i] := nul ;
CurrentToken := MakeKey(a) ;
CurrentType := VAL(TokenType, GetSymKey(ReservedWords, CurrentToken))
ELSE
IF QuoteChar='"'
THEN
WarnError('missing " at the end of a literal')
ELSE
WarnError("missing ' at the end of a literal")
END ;
InQuote := FALSE (* to avoid a contineous list of the same error message *)
END
ELSE
WHILE (i<MaxNameLength) AND (PutChar(GetChar())#nul) AND
(PutChar(GetChar())#lf) AND (PutChar(GetChar())#QuoteChar) DO
a[i] := GetChar() ;
INC(i)
END ;
IF PutChar(GetChar())=QuoteChar
THEN
CurrentType := literaltok ;
a[i] := nul ;
CurrentToken := MakeKey(a)
ELSE
IF QuoteChar='"'
THEN
WarnError('missing " at the end of a literal')
ELSE
WarnError("missing ' at the end of a literal")
END ;
InQuote := FALSE (* to avoid a contineous list of the same error message *)
END
END
ELSE
SkipComments ;
IF (PutChar(GetChar())='"') OR (PutChar(GetChar())="'")
THEN
a[i] := GetChar() ;
QuoteChar := a[i] ;
INC(i) ;
InQuote := TRUE ;
a[i] := nul ;
CurrentToken := MakeKey(a) ;
CurrentType := VAL(TokenType, GetSymKey(ReservedWords, CurrentToken))
ELSE
WHILE (i<MaxNameLength) AND (PutChar(GetChar())#nul) AND
(PutChar(GetChar())#lf) AND (PutChar(GetChar())#QuoteChar) AND
(NOT IsWhite(PutChar(GetChar()))) DO
a[i] := GetChar() ;
INC(i)
END ;
a[i] := nul ;
CurrentToken := MakeKey(a) ;
IF GetSymKey(ReservedWords, CurrentToken)=0
THEN
CurrentType := identtok
ELSE
CurrentType := VAL(TokenType, GetSymKey(ReservedWords, CurrentToken))
END
END
END ;
IF Debugging
THEN
WriteToken
END
END AdvanceToken ;
(*
SymIs - if t is equal to the current token the next token is read
and true is returned, otherwise false is returned.
*)
PROCEDURE SymIs (t: TokenType) : BOOLEAN ;
BEGIN
IF CurrentType=t
THEN
AdvanceToken ;
RETURN( TRUE )
ELSE
RETURN( FALSE )
END
END SymIs ;
(*
IsSym - returns the result of the comparison between the current token
type and t.
*)
PROCEDURE IsSym (t: TokenType) : BOOLEAN ;
BEGIN
RETURN( t=CurrentType )
END IsSym ;
(*
PushBackToken - pushes a token back onto input.
*)
PROCEDURE PushBackToken (t: Name) ;
VAR
a: ARRAY [0..MaxNameLength] OF CHAR ;
BEGIN
GetKey(t, a) ;
PutString(a)
END PushBackToken ;
(*
SetDebugging - sets the debugging flag.
*)
PROCEDURE SetDebugging (flag: BOOLEAN) ;
BEGIN
Debugging := flag
END SetDebugging ;
(*
Init - initialize the modules global variables.
*)
PROCEDURE Init ;
VAR
a: ARRAY [0..1] OF CHAR ;
BEGIN
InitTree(ReservedWords) ;
Debugging := FALSE ;
a[0] := nul ;
PutSymKey(ReservedWords, MakeKey(a) , ORD(eoftok)) ;
PutSymKey(ReservedWords, MakeKey('%') , ORD(codetok)) ;
PutSymKey(ReservedWords, MakeKey(':=') , ORD(lbecomestok)) ;
PutSymKey(ReservedWords, MakeKey('=:') , ORD(rbecomestok)) ;
PutSymKey(ReservedWords, MakeKey('|') , ORD(bartok)) ;
PutSymKey(ReservedWords, MakeKey('[') , ORD(lsparatok)) ;
PutSymKey(ReservedWords, MakeKey(']') , ORD(rsparatok)) ;
PutSymKey(ReservedWords, MakeKey('{') , ORD(lcparatok)) ;
PutSymKey(ReservedWords, MakeKey('}') , ORD(rcparatok)) ;
PutSymKey(ReservedWords, MakeKey('(') , ORD(lparatok)) ;
PutSymKey(ReservedWords, MakeKey(')') , ORD(rparatok)) ;
PutSymKey(ReservedWords, MakeKey('<') , ORD(lesstok)) ;
PutSymKey(ReservedWords, MakeKey('>') , ORD(gretok)) ;
PutSymKey(ReservedWords, MakeKey('error') , ORD(errortok)) ;
PutSymKey(ReservedWords, MakeKey('tokenfunc') , ORD(tfunctok)) ;
PutSymKey(ReservedWords, MakeKey('symfunc') , ORD(symfunctok)) ;
PutSymKey(ReservedWords, MakeKey("'") , ORD(squotetok)) ;
PutSymKey(ReservedWords, MakeKey('"') , ORD(dquotetok)) ;
PutSymKey(ReservedWords, MakeKey('module') , ORD(moduletok)) ;
PutSymKey(ReservedWords, MakeKey('begin') , ORD(begintok)) ;
PutSymKey(ReservedWords, MakeKey('rules') , ORD(rulestok)) ;
PutSymKey(ReservedWords, MakeKey('end') , ORD(endtok)) ;
PutSymKey(ReservedWords, MakeKey('declaration'), ORD(declarationtok)) ;
PutSymKey(ReservedWords, MakeKey('token') , ORD(tokentok)) ;
PutSymKey(ReservedWords, MakeKey('special') , ORD(specialtok)) ;
PutSymKey(ReservedWords, MakeKey('first') , ORD(firsttok)) ;
PutSymKey(ReservedWords, MakeKey('follow') , ORD(followtok)) ;
PutSymKey(ReservedWords, MakeKey('epsilon') , ORD(epsilontok)) ;
PutSymKey(ReservedWords, MakeKey('BNF') , ORD(BNFtok)) ;
PutSymKey(ReservedWords, MakeKey('FNB') , ORD(FNBtok)) ;
CurrentToken := NulName ;
CurrentType := identtok ;
InQuote := FALSE
END Init ;
BEGIN
Init
END bnflex.
(*
* Local variables:
* compile-command: "../bin2/m2f -quiet -g -verbose -M \"../libs ../gm2s\" bnflex.mod"
* End:
*)