
<<IPReaderImpl.mesa>>
<<>>
<<Last edited by:>>
<<Doug Wyatt, March 8, 1984 5:16:59 pm PST>>

DIRECTORY
Atom USING [MakeAtom],
FS USING [StreamOpen],
IO USING [atom, Backup, Close, GetChar, GetIndex, int, PutFR, SetIndex, STREAM],
IPBasic USING [Op, Primitive, Rational, version, Version],
IPReader USING [Block, BlockRep, Class, ClassRep, EncodedVector, ErrorCode, FinishBody, GetToken, Index, Node, NodeRep, nullIndex, 
nullToken, Reader, ReaderRep],
RefText USING [AppendChar, ObtainScratch, ReleaseScratch],
Rope USING [Fetch, FromProc, ROPE, Size];

IPReaderImpl: CEDAR MONITOR
IMPORTS Atom, FS, IO, IPReader, RefText, Rope
EXPORTS IPReader
~ BEGIN OPEN IPReader, IPBasic;

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

Error: PUBLIC ERROR[code: ErrorCode, explanation: ROPE _ NIL] ~ CODE;

classList: LIST OF Class _ NIL; -- monitored data

Register: PUBLIC ENTRY PROC[class: Class] ~ {
classList _ CONS[class, classList];
};

ClassList: ENTRY PROC RETURNS[LIST OF Class] ~ {
RETURN[classList];
};

VersionGe: PROC[a, b: Version] RETURNS[BOOL] = {
RETURN[a.major>b.major OR (a.major=b.major AND a.minor>=b.minor)];
};

GetClass: PROC[encoding: ATOM, version: Version] RETURNS[Class] = {
IF NOT VersionGe[IPBasic.version, version] THEN ERROR Error[$unknownEncoding,
IO.PutFR["This implementation is older than Interpress version %g.%g.",
IO.int[version.major], IO.int[version.minor]]];
FOR list: LIST OF Class _ ClassList[], list.rest UNTIL list=NIL DO
class: Class ~ list.first;
IF class.encoding=encoding THEN RETURN[class];
ENDLOOP;
ERROR Error[$unknownEncoding,
IO.PutFR["\"%g\" is an unrecognized encoding type.", IO.atom[encoding]]];
};

MatchRope: PROC[stream: STREAM, rope: ROPE] RETURNS[BOOL] ~ {
FOR i: INT IN[0..rope.Size[]) DO
char: CHAR ~ stream.GetChar[];
IF char#rope.Fetch[i] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
};

AtomFromText: PROC[text: REF TEXT, start, len: NAT] RETURNS[ATOM] ~ {
i: NAT _ start;
proc: PROC RETURNS[char: CHAR] ~ { char _ text[i]; i _ i+1 };
RETURN[Atom.MakeAtom[Rope.FromProc[len: len, p: proc]]];
};

CardinalFromText: PROC[text: REF TEXT, start, len: NAT] RETURNS[CARDINAL] ~ {
value: LONG CARDINAL _ 0;
FOR i: NAT IN[start..start+len) DO
char: CHAR ~ text[i];
IF char IN['0..'9] THEN value _ value*10+(char-'0) ELSE ERROR Error[$bug];
IF value>CARDINAL.LAST THEN ERROR Error[$illegalHeader, "Version number is too big."];
ENDLOOP;
RETURN[value];
};

bufferSize: NAT ~ 200;

Create: PUBLIC PROC[stream: STREAM, encoding: ATOM, version: Version] RETURNS[Reader] ~ {
class: Class ~ GetClass[encoding, version];
RETURN[NEW[ReaderRep _ [class: class, stream: stream,
index: 0, token: nullToken, shortNumber: 0, text: NIL,
buffer: NEW[TEXT[bufferSize]]]]];
};

Open: PUBLIC PROC[name: ROPE] RETURNS[Reader] ~ {
stream: STREAM ~ FS.StreamOpen[name];
buffer: REF TEXT _ NIL;
encoding: ATOM; version: Version;
IF stream.GetIndex[]=0 THEN { -- ignore leading CR that Tioga might have inserted
char: CHAR ~ stream.GetChar[];
IF char='\n THEN NULL ELSE stream.Backup[char];
};
IF NOT MatchRope[stream, "Interpress/"] THEN
ERROR Error[$illegalHeader, "Header does not begin with \"Interpress/\"."];
buffer _ RefText.ObtainScratch[100];
{ ENABLE UNWIND => RefText.ReleaseScratch[buffer];
text: REF TEXT _ buffer;
nameStart, nameLen, majorStart, majorLen, minorStart, minorLen: NAT _ 0;
state: {null, name, slash, major, dot, minor} _ null;
text.length _ 0;
THROUGH[0..NAT.LAST) DO
char: CHAR ~ stream.GetChar[];
i: NAT ~ text.length;
text _ RefText.AppendChar[text, char];
SELECT state FROM
$null => SELECT char FROM
IN['A..'Z], IN['a..'z] => { nameStart _ i; state _ $name };
ENDCASE => GOTO BadSyntax;
$name => SELECT char FROM
IN['A..'Z], IN['a..'z] => NULL;
'/ => { nameLen _ i-nameStart; state _ $slash };
ENDCASE => GOTO BadSyntax;
$slash => SELECT char FROM
IN['A..'Z], IN['a..'z] => state _ $name;
IN['0..'9] => { majorStart _ i; state _ $major };
ENDCASE => GOTO BadSyntax;
$major => SELECT char FROM
IN['0..'9] => NULL;
'. => { majorLen _ i-majorStart; state _ $dot };
ENDCASE => GOTO BadSyntax;
$dot => SELECT char FROM
IN['0..'9] => { minorStart _ i; state _ $minor };
ENDCASE => GOTO BadSyntax;
$minor => SELECT char FROM
IN['0..'9] => NULL;
'  => { minorLen _ i-minorStart; EXIT };
ENDCASE => GOTO BadSyntax;
ENDCASE => ERROR;
REPEAT
BadSyntax => ERROR Error[$illegalHeader, "Header has invalid syntax."];
FINISHED => ERROR Error[$illegalHeader, "Header is too long!"];
ENDLOOP;
encoding _ AtomFromText[text: text, start: nameStart, len: nameLen];
version.major _ CardinalFromText[text: text, start: majorStart, len: majorLen];
version.minor _ CardinalFromText[text: text, start: minorStart, len: minorLen];
};
RefText.ReleaseScratch[buffer];
RETURN[Create[stream, encoding, version]];
};

closedClass: Class ~ NEW[ClassRep _ [encoding: $Closed, getToken: ClosedGetToken, readInt: ClosedReadInt, readRational: 
ClosedReadRational, readReal: ClosedReadReal, readVector: ClosedReadVector]];

ClosedGetToken: PROC[reader: Reader, flushComments: BOOL _ TRUE] ~ {
ERROR Error[$closed, "Called GetToken on a Reader that has been closed."];
};
ClosedReadInt: PROC[reader: Reader] RETURNS[INT] ~ {
ERROR Error[$closed, "Called ReadInt on a Reader that has been closed."];
};
ClosedReadRational: PROC[reader: Reader] RETURNS[Rational] ~ {
ERROR Error[$closed, "Called ReadRational on a Reader that has been closed."];
};
ClosedReadReal: PROC[reader: Reader] RETURNS[REAL] ~ {
ERROR Error[$closed, "Called ReadReal on a Reader that has been closed."];
};
ClosedReadVector: PROC[reader: Reader] RETURNS[EncodedVector] ~ {
ERROR Error[$closed, "Called ReadVector on a Reader that has been closed."];
};

Close: PUBLIC PROC[reader: Reader] ~ {
reader.class _ closedClass;
reader.stream.Close[];
reader.token _ nullToken;
reader.text _ NIL;
reader.buffer _ NIL;
};

GetIndex: PUBLIC PROC[reader: Reader] RETURNS[INT] ~ {
RETURN[reader.stream.GetIndex[]];
};

SetIndex: PUBLIC PROC[reader: Reader, index: INT] ~ {
reader.stream.SetIndex[index];
reader.token _ nullToken; reader.text _ NIL;
};


FinishBody: PUBLIC PROC[reader: Reader] ~ {
IF reader.class.finishBody#NIL THEN reader.class.finishBody[reader]
ELSE DO reader.GetToken[];
SELECT reader.token.op FROM
IN Primitive => NULL;
$endBody => EXIT;
$beginBody => FinishBody[reader];
$beginVec => FinishVec[reader];
ENDCASE => ERROR Error[$illegalStructure, "Misplaced token inside body."];
ENDLOOP;
};

FinishVec: PROC[reader: Reader] ~ {
DO reader.GetToken[];
SELECT reader.token.op FROM
IN Primitive => NULL;
$comma => NULL;
$endVec => EXIT;
$beginBody => FinishBody[reader];
$beginVec => FinishVec[reader];
ENDCASE => ERROR Error[$illegalStructure, "Misplaced token inside vector."];
ENDLOOP;
};

<<Parsing the skeleton:>>
<<>>
<<skeleton ::= [body] block>>
<<block ::= BEGIN [NOPAGES] content node* END>>
<<content ::= body | block>>
<<node ::= [PAGEINSTRUCTIONS body] content>>


GetSkeleton: PUBLIC PROC[reader: Reader] RETURNS[block: Block] ~ {
instructions: Index _ nullIndex;
reader.GetToken[];
IF reader.token.op=$beginBody THEN {
instructions _ ReadBody[reader];
reader.GetToken[];
};
block _ ReadBlock[reader];
block.preamble.instructions _ instructions;
};

ReadBlock: PROC[reader: Reader] RETURNS[block: Block] = {
IF reader.token.op=$beginBlock THEN {
noPages: BOOL _ FALSE;
preamble: Node _ NIL;
list: LIST OF Node _ NIL;
size: NAT _ 0;
reader.GetToken[];
IF reader.token.op=$noPages THEN { noPages _ TRUE; reader.GetToken[] };
preamble _ ReadContent[reader];
DO reader.GetToken[];
IF reader.token.op=$endBlock THEN EXIT
ELSE { list _ CONS[ReadNode[reader], list]; size _ size+1 };
ENDLOOP;
block _ NEW[BlockRep[size] _ [noPages: noPages, preamble: preamble, nodes: ]];
WHILE size>0 DO block[size _ size-1] _ list.first; list _ list.rest; ENDLOOP;
RETURN[block];
}
ELSE ERROR Error[$illegalStructure, "Missing block in skeleton."];
};

ReadNode: PROC[reader: Reader] RETURNS[node: Node] ~ {
instructions: Index _ nullIndex;
IF reader.token.op=$pageInstructions THEN {
reader.GetToken[];
instructions _ ReadBody[reader];
reader.GetToken[];
};
node _ ReadContent[reader];
node.instructions _ instructions;
};

ReadContent: PROC[reader: Reader] RETURNS[node: Node] ~ {
SELECT reader.token.op FROM
$beginBody => node _ NEW[NodeRep[body] _ [content: body[ReadBody[reader]]]];
$beginBlock => node _ NEW[NodeRep[block] _ [content: block[ReadBlock[reader]]]];
ENDCASE => ERROR Error[$illegalStructure, "Missing body or block in skeleton."];
};

ReadBody: PROC[reader: Reader] RETURNS[index: Index] ~ {
IF reader.token.op=$beginBody THEN { index _ reader.index; reader.FinishBody[] }
ELSE ERROR Error[$illegalStructure, "Missing body in skeleton."];
};


END.