IPReaderImpl.mesa
Copyright © 1984 Xerox Corporation. All rights reserved.
Doug Wyatt, August 24, 1984 10:44:13 am PDT
DIRECTORY
Atom USING [MakeAtom],
FS USING [defaultStreamOptions, OpenFile, OpenFileFromStream, StreamFromOpenFile, StreamOpen, StreamOptions],
IO USING [atom, Backup, Close, Error, ErrorCode, GetChar, GetIndex, GetInfo, int, PutFR, SetIndex, STREAM, StreamVariety],
IPBasic USING [currentVersion, Op, Primitive, Rational, Version],
IPReader USING [Block, BlockRep, Class, ClassRep, ErrorCode, FinishBody, GetToken, Index, LargeVector, Node, NodeRep, nullIndex, Reader, ReaderRep, Token],
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.currentVersion, 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, 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,
readLargeVector: ClosedReadLargeVector
]];
closedExplanation: ROPE ~ "Tried to use a Reader that has been closed.";
ClosedGetToken:
PROC[reader: Reader, buffer:
REF
TEXT, flushComments:
BOOL]
RETURNS[token: Token, text: REF TEXT] ~ {
ERROR Error[$closed, closedExplanation];
};
ClosedReadInt:
PROC[reader: Reader, token: Token, text:
REF
TEXT]
RETURNS[INT] ~ {
ERROR Error[$closed, closedExplanation];
};
ClosedReadRational:
PROC[reader: Reader, token: Token, text:
REF
TEXT]
RETURNS[Rational] ~ {
ERROR Error[$closed, closedExplanation];
};
ClosedReadReal:
PROC[reader: Reader, token: Token, text:
REF
TEXT]
RETURNS[REAL] ~ {
ERROR Error[$closed, closedExplanation];
};
ClosedReadLargeVector:
PROC[reader: Reader, token: Token]
RETURNS[LargeVector] ~ {
ERROR Error[$closed, closedExplanation];
};
Close:
PUBLIC
PROC[reader: Reader] ~ {
reader.class ← closedClass;
reader.stream.Close[];
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];
};
ReadLargeVector:
PUBLIC
PROC[reader: Reader, token: Token]
RETURNS[LargeVector] ~ {
RETURN reader.class.readLargeVector[reader, token];
};
FinishBody:
PUBLIC
PROC[reader: Reader] ~ {
IF reader.class.finishBody#NIL THEN reader.class.finishBody[reader]
ELSE
DO token: Token ~ reader.GetToken[].token;
SELECT 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 token: Token ~ reader.GetToken[].token;
SELECT 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;
};
StreamFromInputStream:
PUBLIC
PROC[stream:
STREAM]
RETURNS[
STREAM] ~ {
variety: IO.StreamVariety; class: ATOM;
[variety, class] ← IO.GetInfo[stream];
IF variety=output THEN ERROR IO.Error[NotImplementedForThisStream, stream];
SELECT class
FROM
$File => {
openFile: FS.OpenFile ~ FS.OpenFileFromStream[stream];
options: FS.StreamOptions ← FS.defaultStreamOptions;
options[closeFSOpenFileOnClose] ← FALSE;
RETURN[FS.StreamFromOpenFile[openFile: openFile, streamOptions: options]];
};
ENDCASE => ERROR IO.Error[NotImplementedForThisStream, stream];
};
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;
token: Token ← reader.GetToken[].token;
IF token.op=$beginBody
THEN {
instructions ← ReadBody[reader, token];
token ← reader.GetToken[].token;
};
block ← ReadBlock[reader, token];
block.preamble.instructions ← instructions;
};
ReadBlock:
PROC[reader: Reader, first: Token]
RETURNS[block: Block] = {
IF first.op=$beginBlock
THEN {
noPages: BOOL ← FALSE;
preamble: Node ← NIL;
list: LIST OF Node ← NIL;
size: NAT ← 0;
token: Token ← reader.GetToken[].token;
IF token.op=$noPages THEN { noPages ← TRUE; token ← reader.GetToken[].token };
preamble ← ReadContent[reader, token];
DO token ← reader.GetToken[].token;
IF token.op=$endBlock THEN EXIT
ELSE {
node: Node ~ ReadNode[reader, token];
list ← CONS[node, 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, first: Token]
RETURNS[node: Node] ~ {
instructions: Index ← nullIndex;
token: Token ← first;
IF first.op=$pageInstructions
THEN {
token ← reader.GetToken[].token;
instructions ← ReadBody[reader, token];
token ← reader.GetToken[].token;
};
node ← ReadContent[reader, token];
node.instructions ← instructions;
};
ReadContent:
PROC[reader: Reader, first: Token]
RETURNS[node: Node] ~ {
SELECT first.op
FROM
$beginBody => node ← NEW[NodeRep[body] ← [content: body[ReadBody[reader, first]]]];
$beginBlock => node ← NEW[NodeRep[block] ← [content: block[ReadBlock[reader, first]]]];
ENDCASE => ERROR Error[$illegalStructure, "Missing body or block in skeleton."];
};
ReadBody:
PROC[reader: Reader, first: Token]
RETURNS[Index] ~ {
IF first.op=$beginBody THEN { reader.FinishBody[]; RETURN[first.index] }
ELSE ERROR Error[$illegalStructure, "Missing body in skeleton."];
};
END.