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.