

DIRECTORY
Convert, 
IO, 
MPLeaves USING [HTIndex, HTNode, LTIndex, LTNode],
MPP1, 
MPParseTable,
Real USING [RealException],
Rope USING [Fetch, Flatten, Length, ROPE, Size];

MPScanner: PROGRAM
IMPORTS Convert, IO, MPParseTable, Real, Rope
EXPORTS MPP1
SHARES Rope
= BEGIN OPEN MPLeaves, MPParseTable, MPP1;

ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;

hashTab: HashTableRef;
scanTab: ScanTableRef м NIL;
vocab: VocabularyRef м NIL;
vocabIndex: IndexTableRef м NIL;
<<
hashTab: LONG POINTER TO ARRAY HashIndex OF VocabHashEntry м NIL; 
scanTab: LONG POINTER TO ARRAY CHAR [40C..177C] OF TSymbol м NIL; 
vocab: LONG STRING м NIL;
vocabIndex: LONG POINTER TO ARRAY TSymbol OF CARDINAL м NIL; >>

rf: ROPE м NIL;  -- the source
rs: STREAM м NIL;  -- the source as stream

toklen: NAT м 0;      -- current token length
tokpos: INT м 0;    -- source index for start of token
nTokens: CARDINAL м 0;    -- token count
nErrors: CARDINAL;    -- lexical errors
lastToken: INT м 0;

IdFromRope: PROC [r: ROPE, index: INT] RETURNS [HTIndex] = {
RETURN [NEW[HTNode м [index: index, name: r]]]}; 

IdFirst: HTIndex м IdFromRope["first", LAST[INT]]; 
IDLock: HTIndex м IdFromRope["LOCK", LAST[INT]]; 
IDRest: HTIndex м IdFromRope["rest", LAST[INT]]; 

IdOfFirst: PUBLIC SAFE PROC RETURNS [HTIndex] = TRUSTED {RETURN [IdFirst]}; 
IdOfLock: PUBLIC SAFE PROC RETURNS [HTIndex] = TRUSTED {RETURN [IDLock]}; 
IdOfRest: PUBLIC SAFE PROC RETURNS [HTIndex] = TRUSTED {RETURN [IDRest]}; 

Atom: PUBLIC SAFE PROC [errPut: IO.STREAM] RETURNS [token: MPP1.Token м MPP1.nullToken] = TRUSTED {
tokenKind: IO.TokenKind;
rope: ROPE;
charsSkipped: INT;
DO
peek: CHAR м 0C;
[] м IO.SkipWhitespace[rs, TRUE ! IO.EndOfStream => EXIT];
peek м IO.PeekChar[rs ! IO.EndOfStream => EXIT];
tokpos м IO.GetIndex[rs];
token.index м tokpos;
SELECT peek FROM
'%, '& => {
DO
[] м IO.GetChar[rs];
peek м IO.PeekChar[rs ! IO.EndOfStream => EXIT];
SELECT peek FROM
IN ['a..'z], IN ['A..'Z], IN ['0..'9], '%, '& => {};
ENDCASE => EXIT;
ENDLOOP;
toklen м IO.GetIndex[rs] - tokpos;
token.class м tokenID;
token.value.r м IdFromRope[rf.Flatten[tokpos, toklen], tokpos];
EXIT;
};
ENDCASE;
[tokenKind, rope, charsSkipped] м IO.GetCedarTokenRope[rs
!
IO.Error => {
ErrorContext["Syntax error", IO.GetIndex[rs], errPut]; EXIT};
IO.EndOfStream => {
tokenKind м tokenEOF;
rope м "";
CONTINUE;
}
];
toklen м rope.Length[];
tokpos м rs.GetIndex[] - toklen;
SELECT tokenKind FROM
tokenID => {
allcaps: BOOL м TRUE;
r: ROPE м NIL;
token.class м tokenID;

FOR i: INT IN [0..rope.Size[]) DO
IF rope.Fetch[i] IN ['a..'z] THEN {allcaps м FALSE; EXIT};
ENDLOOP;
IF allcaps THEN {
first: CARDINAL м ORD[rope.Fetch[0]];
last: CARDINAL м ORD[rope.Fetch[rope.Size[]-1]];
h: CARDINAL м (first * 128 - first + last) MOD LAST[HashIndex] + 1;
j: CARDINAL м 0;
len: NAT м rope.Size[];
WHILE (j м hashTab[h].symbol) # 0 DO
s2: CARDINAL м vocabIndex[j - 1];
IF vocabIndex[j] - s2 = len THEN 
FOR s1: CARDINAL IN [0..len) DO
IF rope.Fetch[s1] # vocab[s2] THEN EXIT; 
s2 м s2 + 1;
REPEAT
FINISHED => {token.class м j; GO TO CheckEnd};
ENDLOOP; 
IF (h м hashTab[h].link) = 0 THEN EXIT
ENDLOOP; 
};
token.value.r м IdFromRope[rope, tokpos];
};
tokenDECIMAL, tokenOCTAL, tokenHEX => {
ENABLE Convert.Error => GO TO badNumber;
token.class м tokenLNUM;
token.value.r м WrapLit[NEW[DINT м Convert.DIntFromRope[rope]]];
};
tokenREAL => {
ENABLE Convert.Error, Real.RealException => TRUSTED{GO TO badNumber};
token.class м tokenFLNUM;
token.value.r м WrapLit[NEW[REAL м Convert.RealFromLiteral[rope]]];
};
tokenROPE => {
token.class м tokenSTR; 
token.value.r м WrapLit[NEW[ROPE м Convert.RopeFromLiteral[rope]]];
};
tokenCHAR => {
token.class м tokenCHAR; 
token.value.r м WrapLit[NEW[CHAR м Convert.CharFromLiteral[rope]]];
};
tokenATOM => {
token.class м tokenATOM; 
token.value.r м WrapLit[NEW[ATOM м Convert.AtomFromRope[rope]]];
};
tokenSINGLE => {
XeroxOtherDollar: CHAR	= 244C;  -- д
XeroxLeftArrow: CHAR	= 254C;  -- м
XeroxUpArrow: CHAR	= 255C;  -- н
XeroxMultiply: CHAR	= 264C;  -- ┤
XeroxDivide: CHAR	= 270C;  -- ╕
c: CHAR м rf.Fetch[tokpos];
SELECT c FROM
XeroxOtherDollar => c м '$;
XeroxLeftArrow => c м '_;
XeroxUpArrow => c м '^;
XeroxMultiply => c м '*;
XeroxDivide => c м '/;
ENDCASE;
IF c = ': AND NOT IO.EndOf[rs] AND IO.PeekChar[rs]='=
THEN {
[] м IO.GetChar[rs];
rope м ":=";
toklen м 2;
token.class м scanTab['_];
}
ELSE { token.class м scanTab[c] };
};
tokenDOUBLE => {
c1: CHAR м rf.Fetch[tokpos];
SELECT c1 FROM
'* => token.class м tokenPOWER;	-- for **
'= => token.class м tokenARROW;	-- for ==
'< => token.class м tokenLE;	-- for <=
'> => token.class м tokenGE;	-- for >=
'. => token.class м tokenDOTS;	-- for ..
': => token.class м scanTab['_];	-- for :=
'~ => SELECT rf.Fetch[tokpos+1] FROM
'= => token.class м scanTab['#];	-- for ~=
'< => token.class м tokenGE;	-- for ~<
'> => token.class м tokenLE;	-- for ~>
ENDCASE => GO TO syntaxError;
ENDCASE => GO TO syntaxError;
};
tokenCOMMENT => {
LOOP;
};
tokenEOF => {
token.class м endMarker;
token.value м MPP1.nullValue;
};
tokenERROR => GO TO syntaxError;
ENDCASE => ERROR;  -- all cases should have been covered
EXIT;
REPEAT
syntaxError => {
ErrorContext["Syntax error", tokpos, errPut];
};
badNumber => {
ErrorContext["invalid number", tokpos, errPut];
};
CheckEnd => {};
ENDLOOP; 
nTokens м nTokens + 1; 
lastToken м tokpos;
RETURN;
}; 


WrapLit: PROC [r: REF ANY] RETURNS [LTIndex] = {
RETURN [NEW[LTNode м [index: tokpos, value: r, literal: rf.Flatten[tokpos, toklen]]]]}; 


ScanInit: PUBLIC SAFE PROC [source: ROPE] RETURNS [vIndex: IndexTableRef, vBody: VocabularyRef] = TRUSTED {
IF vocab = NIL THEN {
scanTab м MPParseTable.InitScanTable[];
hashTab м MPParseTable.InitHashTable[];
vocabIndex м MPParseTable.InitIndexTable[];
vocab м MPParseTable.InitVocabulary[];
};
<<
hashTab м @table[table.scanTable.hashTab]; 
scanTab м @table[table.scanTable.scanTab]; 
vocab м LOOPHOLE[@table[table.scanTable.vocabBody]]; 
vocabIndex м @table[table.scanTable.vocabIndex];
>>
rf м source;
rs м IO.RIS[rf];
tokpos м 0;
lastToken м 0; 
nTokens м nErrors м 0;
RETURN[vIndex, vBody];
}; 

ScanReset: PUBLIC SAFE PROC RETURNS [CARDINAL, CARDINAL] = TRUSTED {
rf м NIL;
rs м NIL;
RETURN [nTokens, nErrors];
}; 


ResetScanIndex: PUBLIC SAFE PROC [index: INT] RETURNS [success: BOOL] = TRUSTED {
tokpos м index;
RETURN [TRUE];
}; 

ErrorContext: PUBLIC SAFE PROC [message: ROPE, tokenIndex: INT, put: IO.STREAM] = TRUSTED {
low: INT м tokenIndex - 40;
high: INT м tokenIndex + 40;
nErrors м nErrors + 1; 
IF low < 0 THEN low м 0;
IF high >= rf.Size[] THEN high м rf.Size[]-1;
put.PutChar['\n];
IF low > 0 THEN put.PutRope["..."];
FOR i: INT IN [low..high] DO
c: CHAR м rf.Fetch[i];
IF i = tokenIndex THEN put.PutRope[" *^* "];
put.PutChar[c];
ENDLOOP;
IF high < rf.Size[]-1 THEN put.PutRope["..."];
put.PutChar['\n];
put.PutRope[message]; 
put.PutChar['\n];
};

END.


   v  MPScanner.mesa
Copyright ╙ 1985, 1986, 1987, 1990, 1991 by Xerox Corporation.  All rights reserved.
Russ Atkinson (RRA) May 13, 1987 10:45:07 pm PDT
Last tweaked by Mike Spreitzer on December 2, 1987 4:17:27 pm PST
JKF August 4, 1989 9:44:53 am PDT
Michael Plass, March 22, 1993 4:48 pm PST
stuff supporting the scanner
special case of identifier, don't let IO.GetCedarTokenRope see it!
ErrorContext["Unexpected end of stream", IO.GetIndex[rs], errPut]; EXIT
an identifier or reserved word
This could be a reserved word...
an OCTAL literal
a REAL literal
a ROPE literal
a CHAR literal
an ATOM literal
a single-character token
Should really come through as a tokenDOUBLE; ought to change IOScanImpl.
a double-character token
a comment
token.msg describes the scanning error
Every token return must come through here
numerical conversion
initialization/finalization
error handling
 Э╩<  ХNewlineDelimiter
Ц(cedarcode) styleШ codeЪЬЩKЪЬ
╧eЬIЩTKЩ0KЩAKЩ!KЩ)ЧKШ Ъ╧k	Ш	KЪЬ	Ш	KЪЮЬШKЪЬ	ЮЬ$Ш2KЪЮЬШKЪЬШKЪЬЮЬШKЪЬЮЬЮЬШ0KШ ЧЪ╧n	ЬЮШKЪЮЬ
ЮЬШ-KЪЮЬЮШKЪЮЬШKЪЬЮЬЮЬЮЬШ*KШ KЪЮЬЮЬЮЬШKЪЮЬЮЬЮЬЮЬШKШ ЪЬЩKШKЪЬЮЬШKЪЬЮЬШKЪЬЮЬШ KШKЪЬ	ЮЬЮЬЮЬЮЬЮЬЮЬШBKЪЬ	ЮЬЮЬЮЬЮЬЮЬЮЬЮЬШBKЪЬЮЬЮЬЮЬШKЪЬЮЬЮЬЮЬЮЬ	ЮЬЮЬЮЬШ?KШ KЪЬЮЬЮЬ╧cШKЪЬЮЬЮЬаШ*KШ KЪЬЮЬаШ-KЪЬЮЬ	а"Ш6KЪЬ	ЮЬ	аШ(KЪЬ	ЮЬаШ'KЪЬЮЬШKШ ЧЪ
Я
ЬЮЬЮЬ	ЮЬЮЬШ<KЪЮЬЮЬ&Ш1KШ ЧKЪЯЬ ЮЬЮЬШ3KЪЯЬЮЬЮЬШ1KЪЯЬЮЬЮЬШ1KШ KЪЯ	ЬЮЬЮЬЮЬЮЬЮЬЮЬШLKЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬШJЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬШJKШ ЧЧЪЯЬЮЬЮЬЮЬ
ЮЬЮЬЮЬ	ЮЬ	ЮЬЮЬШcKЪЬЮЬШKЪЬЮЬШKЪЬЮЬШЪЮШKЪЬЮЬШKЪ	ЬЮЬЮЬЮЬЮЬШ:KЪЬЮЬЮЬЮЬШ0KЪЬ	ЮЬШKШЪЮЬЮШШKЪЬBЩBЪЮШKЪЬЮЬШKЪЬЮЬЮЬЮЬШ0ЪЮЬЮШKЪЮЬЮЬЮЬШ4KЪЮЬЮЬШЧKЪЮЬШЧKЪЬ	ЮЬШ"KЪЬШKЪЬ?Ш?KЪЮЬШKШЧKЪЮЬШЧЪЬ"ЮЬШ9ЪЬШЪЮЬШKЪЬЮЬЮЬШ=ЧЪЮЬШKЪЬ)ЮЬЮЩGKЪЬШKШ
KЪЮЬШ	KЪЬШЧKЪЬШЧЧKЪЬШKЪЬ Ш ЪЮЬЮШЪЬШKЪЬЩKЪЬ	ЮЬЮЬШKЪЬЮЬЮЬШKЪЬШKШ ЪЮЬЮЬЮЬЮШ!KЪ
ЮЬЮЬ
ЮЬЮЬЮЬШ:KЪЮЬШЧЪЮЬ	ЮЬШKЪЬ Щ KЪЬЮЬЮЬШ%KЪЬЮЬЮЬШ0KЪЬЮЬ ЮЬЮЬШCKЪЬЮЬШKЪЬЮЬШЪЮЬЮШ$KЪЬЮЬШ!ЪЮЬЮЬШ!ЪЮЬЮЬЮЬ
ЮШKЪЮЬЮЬЮЬШ)KШЪЮШKЪЮЬЮЬЮЬШ.ЧKЪЮЬШ	ЧЧKЪЮЬЮЬЮШ&KЪЮЬШ	ЧKШЧKЪЬ)Ш)KЪЬШЧЪЬ'Ш'KЪЬЩKЪЮЬЮЬЮЬШ(KЪЬШKЪЬЮЬЮЬ Ш@KЪЬШЧЪЬШKЪЬЩKЪЮЬ&ЮЬЮЬЮЬШEKЪЬШKЪЬЮЬЮЬ#ШCKЪЬШЧЪЬШKЪЬЩKЪЬШKЪЬЮЬЮЬ#ШCKЪЬШЧЪЬШKЪЬЩKЪЬШKЪЬЮЬЮЬ#ШCKЪЬШЧЪЬШKЪЬЩKЪЬШKЪЬЮЬЮЬ Ш@KЪЬШЧЪЬШKЪЬЩKЦ3 in tabStopsЪЯЬЮЬ
аШ$KЦ3 in tabStopsЪЯЬЮЬ
аШ"KЦ3 in tabStopsЪЯЬЮЬ
аШ KЦ3 in tabStopsЪЯЬЮЬ
аШ!KЦ3 in tabStopsЪЯЬЮЬ
аШKЪЬЮЬШЪЮЬЮШKЪЬШKЪЬШKЪЬШKЪЬШKЪЬШKЪЮЬШЧЪЮЬЮЬЮЬЮЬЮЬЮЬШ5ЪЮЬШKЩHKЪЬЮЬШKЪЬШKЪЬШKЪЬШKЪЬШЧKЪЮЬШ"ЧKЪЬШЧЪЬШKЪЬЩKЪЬЮЬШЪЮЬЮШKЪЬ а	Ш)KЪЬ а	Ш)KЪЬа	Ш&KЪЬа	Ш&KЪЬа	Ш(KЪЬ!а	Ш*ЪЬЮЬЮШ$KЪЬ!а	Ш*KЪЬа	Ш&KЪЬа	Ш&KЪЮЬЮЬЮЬШЧKЪЮЬЮЬЮЬШЧKЪЬШЧЪЬШKЪЬ	Щ	KЪЮЬШKШЧЪЬШKЪЬШKЪЬЮЬШKЪЬШЧЪЬЮЬЮЬШ KЪЬ&Щ&ЧKЪЮЬЮЬа%Ш8ЧKЪЮЬШЪЮШШKЪЬ-Ш-KШЧШKЪЬ/Ш/KШЧKШЧKЪЮЬШ	ЧKЪЬ)Щ)KШKШKЪЮЬШKЪЬШKШ ЧKЪЬЩKШ Ъ
ЯЬЮЬЮЬЮЬЮЬШ0KЪЮЬЮЬMШXKШ ЧKЪЬЩKШ ЪЯЬЮЬЮЬЮЬ
ЮЬЮЬ1ЮЬШkЪЮЬ	ЮЬЮЬШKЪЬ'Ш'KЪЬ'Ш'KЪЬ+Ш+KЪЬ&Ш&KШЧKЪЬШKЪЬ+Ш+KЪЬ+Ш+KЪЬЮЬ%Ш5KЪЬ0Ш0KШKЪЬШKЪЬЮЬЮЬШKШKШKШKЪЮЬШKШKШ ЧЪЯ	ЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШDKЪЬЮЬШ	KЪЬЮЬШ	KЪЮЬШKЪЬШKШ ЧKЪЬЩKШ ЪЯЬЮЬЮЬЮЬ	ЮЬЮЬЮЬЮЬШQKШKЪЮЬЮЬШKЪЬШKШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ[KЪЬЮЬШKЪЬЮЬШKШKЪЮЬ	ЮЬ	ШKЪЮЬЮЬШ-KЪЬШKЪЮЬ	ЮЬШ#ЪЮЬЮЬЮЬЮШKЪЬЮЬШKЪЮЬЮЬШ,KЪЬШKЪЮЬШЧKЪЮЬЮЬШ.KЪЬШKЪЬШKЪЬШKШKШ ЧЪЮЬШKШ KШ KШ ЧЧ ЕЧ    ╨  *В  