DIRECTORY
Convert USING [IntFromRope, RealFromRope],
IO USING [Backup, EndOfStream, GetChar, GetIndex, PutFR, STREAM, text],
IPBasic USING [Op, Rational],
IPReader,
IPWritten,
RefText USING [Append, Find, InlineAppendChar, ObtainScratch, ReleaseScratch, TrustTextAsRope],
Rope USING [ROPE],
SymTab USING [Create, Fetch, Insert, Ref];

IPWrittenReaderImpl: CEDAR PROGRAM
IMPORTS Convert, IO, IPReader, IPWritten, RefText, SymTab
~ BEGIN OPEN IPReader, IPWritten;

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

Op: TYPE ~ IPBasic.Op;
Rational: TYPE ~ IPBasic.Rational;

InvertEncodingTable: PROC[encode: EncodingTable] RETURNS[SymTab.Ref] = {
decode: SymTab.Ref ~ SymTab.Create[mod: 101, case: TRUE];
FOR op: Op IN Op DO
key: ROPE ~ encode[op];
IF key#NIL THEN {
opRef: REF Op ~ NEW[Op _ op];
IF decode.Insert[key: key, val: opRef] THEN NULL ELSE ERROR;
};
ENDLOOP;
RETURN[decode];
};

decode: SymTab.Ref ~ InvertEncodingTable[GetEncodingTable[]];

Decode: PROC[rope: ROPE] RETURNS[Op] ~ {
found: BOOL; val: REF;
[found: found, val: val] _ decode.Fetch[key: rope];
IF found THEN { opRef: REF Op ~ NARROW[val]; RETURN[opRef^] }
ELSE RETURN[nil];
};


writtenReader: Class ~ NEW[ClassRep _ [
encoding: $Written,
getToken: WrittenGetToken,
readInt: WrittenReadInt,
readReal: WrittenReadReal,
readRational: WrittenReadRational,
readVector: WrittenReadVector
]];


WrittenGetToken: PROC[reader: Reader, flushComments: BOOL _ TRUE] ~ {
stream: STREAM ~ reader.stream;
token: Token _ nullToken;
text: REF TEXT _ NIL;
DO
state: {begin, op, id, plus, minus, ast, int, den1, den2, den3, dot, frac, exp1, exp2, exp3, string, escape, com, com1, file, file1, ann, ann1} _ begin;
err: {ok, illegalChar, invalidRational, invalidReal, invalidEscape} _ ok;
char: CHAR; -- last character fetched
got: BOOL _ TRUE; -- true if got char from stream, false if char is fake space at end
esc: NAT; -- starting index of escape sequence
BeginEscape: PROC ~ { esc _ text.length-1 };
EndEscape: PROC ~ {
start: NAT ~ esc+1; stop: NAT ~ text.length-1;
val: CARDINAL _ 0;
IF stop<=start THEN err _ invalidEscape
ELSE FOR i: NAT IN[start..stop) DO c: CHAR ~ text[i];
IF c IN['0..'9] THEN val _ val*10+(c-'0) ELSE { err _ invalidEscape; EXIT };
IF val>255 THEN { val _ 0; err _ invalidEscape; EXIT };
ENDLOOP;
text[esc] _ 0C+val; text.length _ esc+1;
};
reader.index _ stream.GetIndex[];
DO -- skip white space
char _ stream.GetChar[! IO.EndOfStream => GOTO EndOfFile];
IF char IN['\041..'\176] THEN EXIT ELSE reader.index _ reader.index+1;
ENDLOOP;
text _ reader.buffer; text.length _ 0;
DO -- scan a token
text _ RefText.InlineAppendChar[text, char]; -- tentatively append char to token text
{
SELECT state FROM
begin => SELECT char FROM
IN['A..'Z] => { state _ op }; -- begin op
IN['a..'z] => { state _ id }; -- begin identifier
IN['0..'9] => { state _ int }; -- begin number
'{ => { token.op _ beginBody; GOTO SingleOp };
'} => { token.op _ endBody; GOTO SingleOp };
'[ => { token.op _ beginVec; GOTO SingleOp };
'] => { token.op _ endVec; GOTO SingleOp };
', => { token.op _ comma; GOTO SingleOp };
'< => { state _ string; GOTO Begin }; -- begin string
'+ => { state _ plus }; -- might begin number or insertfile
'- => { state _ minus }; -- might begin number or annotation
'* => { state _ ast }; -- might begin comment
'. => { state _ dot }; -- might begin real
ENDCASE => { err _ illegalChar; GOTO Stop };
op => SELECT char FROM
IN['A..'Z], IN['0..'9] => { }; -- extend op
IN['a..'z], '- => { state _ id }; -- switch to id
ENDCASE => { token.type _ op; GOTO Back }; -- op token
id => SELECT char FROM
IN['a..'z], IN['A..'Z], IN['0..'9], '- => { }; -- extend id
ENDCASE => { token.type _ identifier; GOTO Back };
plus => SELECT char FROM
IN['0..'9] => { state _ int }; -- first integer digit
'+ => { state _ file; GOTO Begin }; -- begin insertfile
ENDCASE => { err _ illegalChar; GOTO Back }; -- plus sign alone
minus => SELECT char FROM
IN['0..'9] => { state _ int }; -- first integer digit
'- => { state _ ann; GOTO Begin }; -- begin annotation
ENDCASE => { err _ illegalChar; GOTO Back }; -- minus sign alone
ast => SELECT char FROM
'* => { state _ com; GOTO Begin }; -- begin comment
ENDCASE => { err _ illegalChar; GOTO Back }; -- asterisk alone
int => SELECT char FROM
IN['0..'9] => { }; -- integer digit
'. => { state _ frac }; -- fraction follows
'/ => { state _ den1 }; -- denominator follows
'E, 'e => { state _ exp1 }; -- exponent follows
ENDCASE => { token.type _ integer; GOTO Back }; -- integer token
den1 => SELECT char FROM
IN['0..'9] => { state _ den3 }; -- first denominator digit
'+, '- => { state _ den2 }; -- denominator sign
ENDCASE => { err _ invalidRational; GOTO Back };
den2 => SELECT char FROM
IN['0..'9] => { state _ den3 }; -- first denominator digit (after sign)
ENDCASE => { err _ invalidRational; GOTO Back };
den3 => SELECT char FROM
IN['0..'9] => { }; -- denominator digit
ENDCASE => { token.type _ rational; GOTO Back }; -- rational token
dot => SELECT char FROM
IN['0..'9] => { state _ frac }; -- first fraction digit
ENDCASE => { err _ illegalChar; GOTO Back }; -- dot alone
frac => SELECT char FROM
IN['0..'9] => { }; -- fraction digit
'E, 'e => { state _ exp1 }; -- exponent follows
ENDCASE => { token.type _ real; GOTO Back }; -- real token (no exponent)
exp1 => SELECT char FROM
IN['0..'9] => { state _ exp3 }; -- first exponent digit
'+, '- => { state _ exp2 }; -- exponent sign
ENDCASE => { err _ invalidReal; GOTO Back };
exp2 => SELECT char FROM
IN['0..'9] => { state _ exp3 }; -- first exponent digit (after sign)
ENDCASE => { err _ invalidReal; GOTO Back };
exp3 => SELECT char FROM
IN['0..'9] => { }; -- exponent digit
ENDCASE => { token.type _ real; GOTO Back }; -- real token (with exponent)
string => SELECT char FROM
'> => { token.type _ string; GOTO Lop1 }; -- end string token
'# => { BeginEscape[]; state _ escape }; -- begin escape sequence
ENDCASE => { }; -- extend string
escape => SELECT char FROM
'# => { EndEscape[]; state _ string }; -- end escape sequence
ENDCASE => { }; -- extend escape sequence
com => SELECT char FROM
'* => { state _ com1 }; -- look for second *
ENDCASE => { }; -- extend comment
com1 => SELECT char FROM
'* => { token.type _ comment; GOTO Lop2 }; -- end comment
ENDCASE => { state _ com }; -- continue comment
file => SELECT char FROM
'+ => { state _ file1 }; -- look for second +
ENDCASE => { }; -- extend file name
file1 => SELECT char FROM
'+ => { token.type _ insertfile; GOTO Lop2 }; -- end insertfile
ENDCASE => { state _ file }; -- continue file name
ann => SELECT char FROM
'- => { state _ ann1 }; -- look for second -
ENDCASE => { }; -- extend annotation
ann1 => SELECT char FROM
'- => { token.type _ annotation; GOTO Lop2 }; -- end annotation
ENDCASE => { state _ ann }; -- continue annotation
ENDCASE => ERROR; -- unknown state
EXITS
Begin => text.length _ 0;
SingleOp => { token.type _ op; EXIT };
Stop => { EXIT };
Lop1 => { text.length _ text.length-1; EXIT };
Lop2 => { text.length _ text.length-2; EXIT };
Back => { IF got THEN stream.Backup[char]; text.length _ text.length-1; EXIT };
};
char _ stream.GetChar[!
IO.EndOfStream => IF got THEN { char _ ' ; got _ FALSE; CONTINUE }];
ENDLOOP;
reader.text _ text;
IF err#ok THEN ERROR Error[$illegalToken, SELECT err FROM
illegalChar => "Illegal character.",
invalidRational => "Invalid rational.",
invalidReal => "Invalid real number.",
invalidEscape => "Invalid escape sequence in string.",
ENDCASE => NIL];
SELECT token.type FROM
$nil => ERROR Error[$bug, "WrittenGetToken didn't set token type."];
$op => IF token.op=$nil THEN {
token.op _ Decode[RefText.TrustTextAsRope[text]];
IF token.op=$nil THEN ERROR Error[$illegalToken,
IO.PutFR["%g is not a primitive.", IO.text[text]]];
};
$comment, $annotation => IF flushComments THEN LOOP;
ENDCASE;
EXIT;
REPEAT
EndOfFile => token.type _ eof;
ENDLOOP;
reader.token _ token;
};

ParseInt: PROC[text: REF TEXT, start: NAT _ 0, len: NAT _ NAT.LAST] RETURNS[x: INT] ~ {
s: NAT ~ MIN[start, text.length];
n: NAT ~ MIN[len, text.length-s];
IF s=0 AND n=text.length THEN x _ Convert.IntFromRope[RefText.TrustTextAsRope[text]]
ELSE {
scratch: REF TEXT ~ RefText.ObtainScratch[n];
{ ENABLE UNWIND => RefText.ReleaseScratch[scratch];
temp: REF TEXT ~ RefText.Append[to: scratch, from: text, start: s, len: n];
x _ Convert.IntFromRope[RefText.TrustTextAsRope[temp]];
};
RefText.ReleaseScratch[scratch];
};
};

ParseReal: PROC[text: REF TEXT, start: NAT _ 0, len: NAT _ NAT.LAST] RETURNS[x: REAL] ~ {
s: NAT ~ MIN[start, text.length];
n: NAT ~ MIN[len, text.length-s];
IF s=0 AND n=text.length THEN x _ Convert.RealFromRope[RefText.TrustTextAsRope[text]]
ELSE {
scratch: REF TEXT ~ RefText.ObtainScratch[n];
{ ENABLE UNWIND => RefText.ReleaseScratch[scratch];
temp: REF TEXT ~ RefText.Append[to: scratch, from: text, start: s, len: n];
x _ Convert.RealFromRope[RefText.TrustTextAsRope[temp]];
};
RefText.ReleaseScratch[scratch];
};
};

WrittenReadInt: PROC[reader: Reader] RETURNS[INT] ~ {
SELECT reader.token.type FROM
$shortNumber => RETURN[reader.shortNumber];
$integer => RETURN[ParseInt[reader.text]];
ENDCASE => ERROR Error[$wrongType, "Token is not an integer."];
};

WrittenReadRational: PROC[reader: Reader] RETURNS[Rational] ~ {
text: REF TEXT ~ reader.text;
SELECT reader.token.type FROM
$rational => {
slash: NAT ~ RefText.Find[s1: text, s2: "/"];
{ ENABLE Error => IF code=$overflow THEN GOTO Overflow;
num: INT ~ ParseInt[text: text, len: slash];
den: INT ~ ParseInt[text: text, start: slash+1];
RETURN[[num: num, den: den]];
EXITS Overflow => Error[$overflow, "Number is too big for an INT."];
};
};
ENDCASE => ERROR Error[$wrongType, "Token is not a rational."];
};

WrittenReadReal: PROC[reader: Reader] RETURNS[REAL] ~ {
SELECT reader.token.type FROM
$integer, $real => RETURN[ParseReal[reader.text]];
ENDCASE => ERROR Error[$wrongType, "Token type is not $integer or $real."];
};

WrittenReadVector: PROC[reader: Reader] RETURNS[EncodedVector] ~ {
type: TokenType ~ reader.token.type;
SELECT reader.token.type FROM
$vector => ERROR Error[$unimplemented, "Can't handle $vector yet."];
ENDCASE => ERROR Error[$wrongType, "Token is not a vector."];
};


Register[writtenReader];

END.
ZIPWrittenReaderImpl.mesa

Last edited by:
Doug Wyatt, March 9, 1984 4:59:23 pm PST
�ÊH˜Jš
œ™J™š
œ™Jš
œ(™(—J˜š
Ïk	˜	Jšœ�œ˜*Jš�œ
�œ1�œ˜GJšœ�œ˜J˜	J˜
Jšœ�œR˜_Jšœ�œ�œ˜Jšœ�œ˜*J˜—Jšœ�œ
�˜"Jš�œ
�œ&˜9Jšœ�œ
�œ˜!J˜Jš�œ�œ�œ
˜Jš�œ�œ�œ
�œ
˜J˜Jšœ�œ˜Jšœ
�œ˜"J˜šÏnœ�œ�œ˜HJšœ3�œ˜9š�œ�œ�˜Jšœ�œ˜š�œ�œ
�œ˜Jšœ�œ�œ
˜Jš
�œ%�œ
�œ
�œ
�œ
˜<J˜—Jš�œ
˜—Jš�œ	˜J˜J˜—Jš
œ=˜=J˜šžœ�œ�œ�œ˜(Jšœ�œ�œ
˜Jš
œ3˜3Jš
�œ�œ
�œ�œ�œ
˜=Jš�œ
�œ˜J˜J˜—J˜šœ�œ
˜'J˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ"˜"Jš
œ˜Jš
œ˜J˜—J˜šžœ�œ �œ�œ˜EJšœ�œ˜Jš
œ˜Jšœ�œ
�œ�œ
˜š
�˜J˜˜
Jš
œI˜IJšœ�œÏc˜%Jšœ�œ�œŸC˜UJšœ�œŸ$˜.Jšžœ�œ˜,šž	œ�œ˜Jšœ�œ�œ˜.Jšœ�œ˜Jš�œ
�œ˜'š�œ
�œ�œ
�œ�œ�œ˜5Jš
�œ�œ	�œ�œ�œ˜LJš�œ	�œ!�œ˜7Jš�œ
˜—Jš
œ(˜(J˜—Jš
œ!˜!š�œ
Ÿ˜Jšœ�œ�œ˜:Jš
�œ�œ�œ
�œ
�œ˜FJš�œ
˜—J˜&š�œ
Ÿ˜Jšœ-Ÿ(˜UJ˜
š�œ�˜šœ	�œ�˜Jš�œŸ˜)Jš�œŸ˜1Jš�œŸ˜.Jšœ�œ˜.Jšœ�œ˜,Jšœ�œ˜-Jšœ�œ˜+Jšœ�œ˜*Jšœ�œ
Ÿ˜5JšœŸ#˜;JšœŸ#˜<JšœŸ˜-JšœŸ˜*Jš�œ�œ˜,—šœ�œ�˜Jš�œ
�œŸ˜+Jš�œ Ÿ˜1Jš�œ�œ	Ÿ˜6—šœ�œ�˜Jš�œ
�œ
�œŸ˜;Jš�œ�œ˜2—šœ�œ�˜Jš�œŸ˜5Jšœ�œ
Ÿ˜7Jš�œ�œ	Ÿ˜?—šœ	�œ�˜Jš�œŸ˜5Jšœ�œ
Ÿ˜6Jš�œ�œ	Ÿ˜@—šœ�œ�˜Jšœ�œ
Ÿ˜3Jš�œ�œ	Ÿ˜>—šœ�œ�˜Jš�œŸ˜#JšœŸ˜+JšœŸ˜.JšœŸ˜/Jš�œ�œ	Ÿ˜@—šœ�œ�˜Jš�œŸ˜:JšœŸ˜/Jš�œ�œ˜0—šœ�œ�˜Jš�œŸ'˜GJš�œ�œ˜0—šœ�œ�˜Jš�œŸ˜'Jš�œ�œŸ˜B—šœ�œ�˜Jš�œŸ˜7Jš�œ�œ	Ÿ˜9—šœ�œ�˜Jš�œŸ˜$JšœŸ˜/Jš�œ�œ	Ÿ˜H—šœ�œ�˜Jš�œŸ˜7JšœŸ˜,Jš�œ�œ˜,—šœ�œ�˜Jš�œŸ$˜DJš�œ�œ˜,—šœ�œ�˜Jš�œŸ˜$Jš�œ�œ	Ÿ˜J—šœ
�œ�˜Jšœ�œ	Ÿ˜=Jšœ)Ÿ˜AJš�œ	Ÿ˜ —šœ
�œ�˜Jšœ'Ÿ˜=Jš�œ	Ÿ˜)—šœ�œ�˜JšœŸ˜,Jš�œ	Ÿ˜!—šœ�œ�˜Jšœ�œ	Ÿ˜9Jš�œŸ˜/—šœ�œ�˜JšœŸ˜-Jš�œ	Ÿ˜#—šœ	�œ�˜Jšœ!�œ	Ÿ˜?Jš�œŸ˜2—šœ�œ�˜JšœŸ˜,Jš�œ	Ÿ˜$—šœ�œ�˜Jšœ!�œ	Ÿ˜?Jš�œŸ˜2—Jš�œ�œŸ˜"—š
�˜J˜Jšœ�œ˜&Jšœ
�œ˜Jšœ'�œ˜.Jšœ'�œ˜.Jšœ
�œ�œ3�œ˜O—J˜š
œ˜Jš
�œ�œ�œ�œ�œ˜D—Jš�œ
˜—J˜š	�œ�œ
�œ�œ�˜9Jš
œ$˜$Jš
œ'˜'Jš
œ&˜&Jš
œ6˜6Jš�œ�œ˜—š�œ�˜Jšœ�œ7˜Dšœ�œ�œ˜Jš
œ1˜1š�œ�œ
�œ˜0Jš�œ!�œ˜3—Jš
œ˜—Jšœ�œ�œ
�œ
˜4Jš�œ
˜—Jš�œ
˜š
�˜Jš
œ˜—Jš�œ
˜—J˜J˜—J˜šžœ�œ�œ
�œ	�œ�œ�œ
�œ�œ�œ˜WJšœ�œ�œ˜!Jšœ�œ�œ˜!Jš�œ�œ�œ7˜Tš�œ˜Jšœ	�œ
�œ˜-šœ�œ
�œ$˜3Jšœ�œ
�œ=˜KJš
œ7˜7J˜—Jš
œ ˜ J˜—J˜J˜—šž	œ�œ�œ
�œ	�œ�œ�œ
�œ�œ�œ˜YJšœ�œ�œ˜!Jšœ�œ�œ˜!Jš�œ�œ�œ8˜Uš�œ˜Jšœ	�œ
�œ˜-šœ�œ
�œ$˜3Jšœ�œ
�œ=˜KJš
œ8˜8J˜—Jš
œ ˜ J˜—J˜J˜—šžœ�œ�œ
�œ˜5š�œ�˜Jšœ�œ˜+Jšœ�œ˜*Jš�œ�œ/˜?—J˜J˜—šžœ�œ�œ˜?Jšœ�œ
�œ˜š�œ�˜š
œ˜Jšœ�œ#˜-š	œ�œ
�œ�œ
�œ
˜7Jšœ�œ$˜,Jšœ�œ(˜0Jš�œ˜Jš�œ?˜DJ˜—J˜—Jš�œ�œ/˜?—J˜J˜—šžœ�œ�œ
�œ˜7š�œ�˜Jšœ�œ˜2Jš�œ�œ;˜K—J˜J˜—šžœ�œ�œ˜BJ˜$š�œ�˜Jšœ�œ4˜DJš�œ�œ-˜=—J˜J˜—J˜J˜J˜Jš�œ
˜—…—'¶4X