DIRECTORY
Atom USING [MakeAtomFromRefText],
Convert USING [Error, IntFromRope, RealFromRope],
IO USING [Backup, Close, EndOfStream, GetChar, RIS, STREAM],
RefText USING [InlineAppendChar, ObtainScratch, ReleaseScratch, TrustTextAsRope],
Rope USING [Concat, FromRefText, ROPE],
TJaM USING [Array, AStore, CountToMark, ExecuteAtom, Frame, Mark, MarkRep, NewArray, NumberRep, PopMark, ProduceError, PushArray, PushAtom, PushInt, PushMark, PushNum, PushReal, PushRope];

TJaMScannerImpl: CEDAR PROGRAM
IMPORTS Atom, Convert, IO, RefText, Rope, TJaM
EXPORTS TJaM
= BEGIN OPEN TJaM;

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

Class: TYPE ~ {other, space, plus, minus, dot, digit, letterB, letterE, name};
ClassArray: TYPE ~ ARRAY CHAR OF Class;

InitClassArray: PROC RETURNS[REF ClassArray] ~ {
class: REF ClassArray ~ NEW[ClassArray _ ALL[other]];
FOR char: CHAR IN CHAR DO
SELECT char FROM
'{, '}, '(, '), '", '% => class[char] _ other; -- delimiting characters
'\n, '\l, '\t, ' , ', => class[char] _ space; -- white space
'+ => class[char] _ plus; -- plus sign
'- => class[char] _ minus; -- minus sign
'. => class[char] _ dot; -- decimal point
IN['0..'9] => class[char] _ digit; -- digits
'b, 'B => class[char] _ letterB; -- marks octal numbers
'e, 'E => class[char] _ letterE; -- introduces exponent
IN['\041..'\176] => class[char] _ name; -- may occur in a name
ENDCASE;
ENDLOOP;
RETURN[class];
};

classFromChar: REF ClassArray ~ InitClassArray[];

State: TYPE ~ {
null, name, plus, minus, int, oct, dot, real1, realF, real2, real3, realE,
single, double -- these states terminate a token
};
ActionType: TYPE ~ PROC[state: State, text: REF TEXT, stream: STREAM] 
RETURNS[quit: BOOL _ FALSE];
MapTokens: PROC[stream: STREAM, buffer: REF TEXT, action: ActionType] 
RETURNS[quit: BOOL _ FALSE] ~ {
text: REF TEXT _ buffer;
char: CHAR; class: Class;
peeked: BOOL _ FALSE;
Cleanup: PROC ~ { IF peeked THEN { IO.Backup[stream, char]; peeked _ FALSE } };
UNTIL quit DO -- for each token
state: State _ null;
text.length _ 0;
WHILE state<single DO -- for each char
IF peeked THEN peeked _ FALSE
ELSE {
char _ IO.GetChar[stream ! IO.EndOfStream => EXIT];
class _ classFromChar[char];
};
{ -- block for EXITS below
SELECT state FROM
null => SELECT class FROM
other => state _ single;
space => GOTO Skip;
digit => state _ int;
plus => state _ plus;
minus => state _ minus;
dot => state _ dot;
ENDCASE => state _ name;
name => GOTO Test;
plus => SELECT class FROM
digit => state _ int;
dot => state _ real1;
ENDCASE => GOTO Test;
minus => SELECT class FROM
digit => state _ int;
minus => state _ double;
dot => state _ real1;
ENDCASE => GOTO Test;
int => SELECT class FROM
digit => NULL;
dot => state _ realF;
letterE => state _ real2;
letterB => state _ oct;
ENDCASE => GOTO Test;
oct => GOTO Test;
dot => SELECT class FROM
digit => state _ realF;
ENDCASE => GOTO Test;
real1 => SELECT class FROM
digit => state _ realF;
ENDCASE => GOTO Test;
realF => SELECT class FROM
digit => NULL;
letterE => state _ real2;
ENDCASE => GOTO Test;
real2 => SELECT class FROM
digit => state _ realE;
plus, minus => state _ real3;
ENDCASE => GOTO Test;
real3 => SELECT class FROM
digit => state _ realE;
ENDCASE => GOTO Test;
realE => SELECT class FROM
digit => NULL;
ENDCASE => GOTO Test;
ENDCASE;
EXITS
Skip => LOOP; -- skip white space, don't append to text
Test => SELECT class FROM -- test for end of token
other => { peeked _ TRUE; EXIT }; -- put back delimiting character and stop
space => EXIT; -- stop with current state, don't bother to put back space
ENDCASE => state _ name; -- turn token into a name and keep scanning
};
text _ RefText.InlineAppendChar[to: text, from: char];
ENDLOOP;
IF state=null THEN EXIT; -- normal EndOfStream
quit _ action[state: state, text: text, stream: stream ! UNWIND => Cleanup[]];
ENDLOOP;
IF peeked THEN Cleanup[];
};


DoWithScratchText: PROC[action: PROC[REF TEXT], len: NAT _ 100] ~ {
scratch: REF TEXT ~ RefText.ObtainScratch[len];
action[scratch ! UNWIND => RefText.ReleaseScratch[scratch]];
RefText.ReleaseScratch[scratch];
};


StringProc: TYPE ~ PROC[stream: STREAM, put: PROC[CHAR]];

SyntaxError: ERROR ~ CODE;

PString: StringProc ~ {
DO char: CHAR ~ IO.GetChar[stream];
SELECT char FROM
') => EXIT;
'( => { put['(]; PString[stream, put]; put[')] };
'" => { put['"]; QString[stream, put]; put['"] };
ENDCASE => put[char];
ENDLOOP;
};

QString: StringProc ~ {
state: {null, esc1, esc2, esc3} _ null;
code: [0..377B];
DO char: CHAR ~ IO.GetChar[stream];
SELECT state FROM
null => SELECT char FROM
'" => EXIT;
'\\ => state _ esc1;
ENDCASE => put[char];
esc1 => SELECT char FROM
'n, 'N => { put['\n]; state _ null };
'r, 'R => { put['\r]; state _ null };
'l, 'L => { put['\l]; state _ null };
't, 'T => { put['\t]; state _ null };
'b, 'B => { put['\b]; state _ null };
'f, 'F => { put['\f]; state _ null };
'', '", '\\ => { put[char]; state _ null };
IN['0..'3] => { code _ char-'0; state _ esc2 };
ENDCASE => ERROR SyntaxError;
esc2 => SELECT char FROM
IN['0..'7] => { code _ code*10B+(char-'0); state _ esc3 };
ENDCASE => ERROR SyntaxError;
esc3 => SELECT char FROM
IN['0..'7] => { code _ code*10B+(char-'0); put[VAL[code]]; state _ null };
ENDCASE => ERROR SyntaxError;
ENDCASE => ERROR;
ENDLOOP;
};


RopeFromString: PROC[stream: STREAM, string: StringProc] RETURNS[rope: ROPE _ NIL] ~ {
action: PROC[text: REF TEXT] ~ {
put: PROC[char: CHAR] ~ {
IF NOT text.length<NAT.LAST THEN {
rope _ Rope.Concat[rope, Rope.FromRefText[text]];
text.length _ 0;
};
text _ RefText.InlineAppendChar[text, char];
};
string[stream, put];
IF text.length#0 THEN rope _ Rope.Concat[rope, Rope.FromRefText[text]];
};
DoWithScratchText[action];
};

SkipString: PROC[stream: STREAM, string: StringProc] ~ {
put: PROC[char: CHAR] ~ { };
string[stream, put];
};

SkipJaMComment: PROC[stream: STREAM] ~ {
DO
char: CHAR ~ IO.GetChar[stream ! IO.EndOfStream => EXIT];
IF char='\n THEN EXIT;
ENDLOOP;
};

SkipCedarComment: PROC[stream: STREAM] ~ {
state: {null, dash} _ null;
DO
char: CHAR ~ IO.GetChar[stream ! IO.EndOfStream => EXIT];
SELECT state FROM
null => SELECT char FROM
'\n => EXIT;
'- => state _ dash;
ENDCASE;
dash => SELECT char FROM
'\n, '- => EXIT;
ENDCASE => state _ null;
ENDCASE;
ENDLOOP;
};

IntFromText: PROC[text: REF READONLY TEXT] RETURNS[INT] ~ {
RETURN[Convert.IntFromRope[RefText.TrustTextAsRope[text]]];
};

RealFromText: PROC[text: REF READONLY TEXT] RETURNS[REAL] ~ {
RETURN[Convert.RealFromRope[RefText.TrustTextAsRope[text]]];
};

NumFromText: PROC[text: REF READONLY TEXT] RETURNS[NumberRep] ~ {
RETURN[[int[IntFromText[text ! Convert.Error => IF reason=overflow THEN CONTINUE]]]];
RETURN[[real[RealFromText[text]]]];
};


arrayMark: Mark ~ NEW[MarkRep];

ExecuteStream: PUBLIC PROC[frame: Frame, stream: STREAM, closeAtEnd: BOOL _ TRUE] ~ {
arrayNest: INT _ 0;
tokenAction: ActionType ~ {
SELECT state FROM
single => SELECT text[0] FROM
'( => PushRope[frame, RopeFromString[stream, PString]];
'" => PushRope[frame, RopeFromString[stream, QString]];
'{ => {
arrayNest _ arrayNest+1;
PushMark[frame, arrayMark];
};
'} => IF arrayNest=0 THEN GOTO Name ELSE {
len: INT ~ CountToMark[frame];
array: Array ~ NewArray[len];
AStore[frame, array];
IF PopMark[frame]#arrayMark THEN ProduceError[bug];
PushArray[frame, array];
arrayNest _ arrayNest-1;
};
'% => SkipJaMComment[stream];
ENDCASE => GOTO Name;
double => SELECT text[0] FROM
'- => SELECT text[1] FROM
'- => SkipCedarComment[stream];
ENDCASE => GOTO Name;
ENDCASE => GOTO Name;
int => PushNum[frame, NumFromText[text]];
oct => PushInt[frame, IntFromText[text]];
realF, realE => PushReal[frame, RealFromText[text]];
ENDCASE => GOTO Name;
EXITS Name => {
atom: ATOM ~ Atom.MakeAtomFromRefText[text];
IF arrayNest>0 THEN PushAtom[frame, atom]
ELSE ExecuteAtom[frame, atom];
};
};
bufferAction: PROC[buffer: REF TEXT] ~ {
[] _ MapTokens[stream: stream, buffer: buffer, action: tokenAction !
IO.EndOfStream => GOTO EndOfStreamExit;
SyntaxError => GOTO SyntaxErrorExit;
];
IF arrayNest>0 THEN ProduceError[endOfStream];
EXITS
EndOfStreamExit => ProduceError[endOfStream];
SyntaxErrorExit => ProduceError[syntaxError];
};
DoWithScratchText[bufferAction];
IF closeAtEnd THEN IO.Close[stream];
};

ExecuteRope: PUBLIC PROC[frame: Frame, rope: ROPE] ~ {
stream: STREAM ~ IO.RIS[rope];
ExecuteStream[frame, stream];
};

LineComplete: PUBLIC PROC[rope: ROPE] RETURNS[BOOL] ~ {
stream: STREAM ~ IO.RIS[rope];
arrayNest: INT _ 0;
endOfStream: BOOL _ FALSE;
tokenAction: ActionType ~ {
SELECT state FROM
single => SELECT text[0] FROM
'( => SkipString[stream, PString];
'" => SkipString[stream, QString];
'{ => arrayNest _ arrayNest+1;
'} => IF arrayNest>0 THEN arrayNest _ arrayNest-1;
'% => SkipJaMComment[stream];
ENDCASE => NULL;
double => SELECT text[0] FROM
'- => SELECT text[1] FROM
'- => SkipCedarComment[stream];
ENDCASE => NULL;
ENDCASE => NULL;
ENDCASE => NULL;
};
bufferAction: PROC[buffer: REF TEXT] ~ {
[] _ MapTokens[stream: stream, buffer: buffer, action: tokenAction !
IO.EndOfStream => GOTO EndOfStreamExit;
SyntaxError => GOTO SyntaxErrorExit;
];
IF arrayNest>0 THEN endOfStream _ TRUE;
EXITS
EndOfStreamExit => endOfStream _ TRUE;
SyntaxErrorExit => NULL;
};
DoWithScratchText[bufferAction];
RETURN[NOT endOfStream];
};


END.
DTJaMScannerImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Original version by John Warnock, March 7, 1979 
Paxton, 22-Jan-82 10:19:46
Maureen Stone February 14, 1984 4:04:32 pm PST
Doug Wyatt, March 23, 1985 6:14:16 pm PST


GetToken: PROC[stream: STREAM, buffer: REF TEXT] 
RETURNS[state: State, index: INT, text: REF TEXT] ~ {
stateT: State _ null; indexT: INT _ 0; textT: REF TEXT _ NIL;
action: ActionType ~ { stateT _ state; indexT _ index; textT _ text; RETURN[TRUE] };
[] _ MapTokens[stream, buffer, action];
RETURN[stateT, indexT, textT];
};
Κ
Ρ˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ0™0Kš
œ™K™.Kš
œ)™)—K˜š
Οk	˜	Kšœžœ˜!Kšœžœ$˜1Kšžœ
žœ'žœžœ˜<KšœžœD˜QKšœžœžœ˜'Kšœžœ²
˜Ό
—K˜KšΠblœžœ
ž˜Kšžœžœ˜.Kšžœ˜Kšœžœ
žœ˜K˜Kšžœžœžœ
˜Kšžœžœžœ
žœ
˜K˜KšœžœC˜Nš	œžœžœ
žœ
žœ˜'J˜—šΟnœžœ
žœ
žœ˜0Jšœžœžœžœ	˜5š	žœžœ
žœ
žœ
ž˜šžœž˜Jšœ/Οc˜GJšœ.‘˜<Jšœ‘˜&Jšœ‘
˜(Jšœ‘˜)Jšžœ!‘	˜,Jšœ!‘˜7Jšœ!‘˜7Jšžœ&‘˜>Jšžœ
˜—Jšžœ
˜—Jšžœ˜J˜J˜—Jšœžœ˜1K˜šœžœ˜Kš
œJ˜JKšœ‘!˜0Kš
œ˜J™—šœžœžœžœ
žœ
žœžœžœžœ˜cK™—š 	œžœ	žœ
žœ
žœžœžœžœ˜fKšœžœ
žœ
˜Kšœžœ˜Kšœžœžœ
˜Kš œžœžœžœžœ žœ˜Ošžœžœ
‘˜Kš
œ˜Kš
œ˜šžœžœ
‘˜&Kšžœžœ
ž˜šžœ˜Kšœžœžœžœ˜3K˜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šœ	žœ
˜Kš
œ˜Kšžœžœ˜—šœ	žœž˜Kš
œ˜Kš
œ˜Kšžœžœ˜—šœ	žœž˜Kš
œ˜Kšžœžœ˜—šœ	žœž˜Kšœ	žœ
˜Kšžœžœ˜—Kšžœ
˜—š
ž˜Kšœžœ‘)˜7šœžœžœ
‘˜2Kšœžœžœ‘)˜KKšœ	žœ‘:˜IKšžœ‘+˜D——K˜K˜6Kšžœ
˜—Kšžœžœ
žœ‘˜.Kšœ9žœ˜NKšžœ
˜—Kšžœžœ˜K˜K˜—š œžœ	žœ
žœ
žœžœžœžœ
žœ™gKš	œžœ
žœ
žœžœ
™=KšœEžœ
žœ™TKš
œ'™'Kšžœ™K™—K˜š œžœ	žœ
žœ
žœžœ˜CKšœ	žœ
žœ˜/Kšœžœ%˜<Kš
œ ˜ K˜K˜—K˜šœžœžœ	žœžœ
žœ˜9K˜—šœ
žœžœ
˜K˜—š œ˜šžœžœžœ˜#šžœž˜Kšœžœ
˜Kš
œ1˜1Kš
œ1˜1Kšžœ˜—Kšžœ
˜—K˜K˜—š œ˜Kš
œ'˜'K˜šžœžœžœ˜#šžœž˜šœžœž˜Kšœžœ
˜Kš
œ˜Kšžœ˜—šœžœž˜Kš
œ%˜%Kš
œ%˜%Kš
œ%˜%Kš
œ%˜%Kš
œ%˜%Kš
œ%˜%Kš
œ+˜+Kšžœ-˜/Kšžœžœ
˜—šœžœž˜Kšžœ8˜:Kšžœžœ
˜—šœžœž˜Kšžœ-žœ˜JKšžœžœ
˜—Kšžœžœ
˜—Kšžœ
˜—K˜K˜—K˜š œžœ	žœžœžœžœ˜Všœžœžœ
žœ˜ šœžœžœ˜š
žœ
žœ
žœ
žœ
žœ˜"Kš
œ1˜1Kš
œ˜Kš
œ˜—Kš
œ,˜,Kš
œ˜—K˜Kšžœžœ2˜GK˜—K˜K˜K˜—š 
œžœ	žœ˜8Kšœžœžœ˜K˜K˜K˜—š œžœ	žœ˜(š
ž˜Kš	œžœžœžœžœ˜9Kšžœ
žœ
žœ
˜Kšžœ
˜—K˜K˜—š œžœ	žœ˜*K˜š
ž˜Kš	œžœžœžœžœ˜9šžœž˜šœžœž˜Jšœžœ
˜J˜Jšžœ
˜—šœžœž˜Jšœžœ
˜Jšžœ˜—Jšžœ
˜—Kšžœ
˜—K˜K˜—š œžœžœ
žœ
žœžœ
žœ˜;Kšžœ5˜;K˜K˜—š œžœžœ
žœ
žœžœ
žœ˜=Kšžœ6˜<K˜K˜—š œžœžœ
žœ
žœžœ˜AKšžœ*žœžœ
žœ˜UKšžœ˜#K˜K˜—K˜šœžœ
˜K˜—š 
œžœ
žœžœžœžœ˜UKšœžœ˜˜šžœž˜šœ
žœ	ž˜Kš
œ7˜7Kš
œ7˜7˜K˜K˜K˜—š	œžœ
žœ
žœžœ˜*Kšœžœ˜Kš
œ˜K˜Kšžœžœ˜3K˜Kš
œ˜Kš
œ˜—K˜Kšžœžœ˜—šœ
žœ	ž˜šœžœ	ž˜K˜Kšžœžœ˜—Kšžœžœ˜—K˜)K˜)K˜4Kšžœžœ˜—šžœ
˜Kšœžœ"˜,Kšžœ
žœ˜)Kšžœ˜K˜—K˜—šœžœ	žœ
žœ˜(š
œD˜DKšžœžœ˜'Kšœžœ˜$Kš
œ˜—Kšžœ
žœ˜.š
ž˜Kš
œ-˜-Kš
œ-˜-—K˜—Kš
œ ˜ Kšžœžœ
žœ˜$K˜K˜—š œžœ
žœžœ˜6Kšœžœžœ
žœ˜Kš
œ˜K˜K˜—š œžœ
žœžœžœ
žœ˜7Kšœžœžœ
žœ˜Kšœžœ˜Kšœ
žœžœ
˜˜šžœž˜šœ
žœ	ž˜Kš
œ"˜"Kš
œ"˜"K˜Kšœžœ
žœ˜2K˜Kšžœžœ
˜—šœ
žœ	ž˜šœžœ	ž˜K˜Kšžœžœ
˜—Kšžœžœ
˜—Kšžœžœ
˜—K˜—šœžœ	žœ
žœ˜(š
œD˜DKšžœžœ˜'Kšœžœ˜$K˜—Kšžœ
žœžœ
˜'š
ž˜Kšœ!žœ
˜&Kšœžœ
˜—K˜—Kš
œ ˜ Kšžœ
žœ˜K˜K˜—K˜Kšžœ
˜—…—$4