TiogaStreamsImpl.Mesa
Last Edited by: Spreitzer, September 18, 1985 5:59:06 pm PDT
DIRECTORY IO, IOUtils, Rope, TextNode, TiogaFileOps, TiogaOps, TiogaStreams;
TiogaStreamsImpl:
CEDAR
PROGRAM
IMPORTS IO, IOUtils, Rope, TN: TextNode, TFO: TiogaFileOps, TiogaOps
EXPORTS TiogaStreams =
BEGIN
ROPE: TYPE = Rope.ROPE;
CommentHandling: TYPE = TiogaStreams.CommentHandling;
DepthOp: TYPE = TiogaStreams.DepthOp;
IsATS:
PUBLIC
PROC [s:
IO.
STREAM]
RETURNS [is:
BOOLEAN] =
{is ←
s # NIL AND
s.streamData # NIL AND
(
ISTYPE[s.streamData, TiogaInStreamData] OR
ISTYPE[s.streamData, TiogaOutStreamData]);
};
CreateInput:
PUBLIC
PROC [from:
TN.Ref, commentHandling: CommentHandling ← discard, levelPrefix:
ROPE ←
NIL]
RETURNS [in:
IO.
STREAM] =
BEGIN
sd: TiogaInStreamData ←
NEW [TiogaInStreamDataRep ← [
commentHandling: commentHandling,
levelPrefix: levelPrefix,
node: NIL,
root: from
]];
GoToBeginning[sd];
in ← IO.CreateStream[streamProcs: tiogaInStreamProcs, streamData: sd];
END;
GoToBeginning:
PROC [sd: TiogaInStreamData] = {
dd: INT;
IF sd.root = NIL THEN {sd.end ← TRUE; RETURN};
[sd.node, dd] ← TN.Forward[sd.root];
IF sd.node = NIL THEN {sd.end ← TRUE; RETURN};
SELECT dd
FROM
<1 => {sd.end ← TRUE; RETURN};
=1 => {
sd.end ← FALSE;
sd.depth ← 1;
sd.indexAtNodeStart ← 0;
NodeHello[sd];
};
ENDCASE => ERROR;
};
tiogaInStreamProcs: REF IO.StreamProcs ← IO.CreateStreamProcs[variety: input, class: $TiogaInStream, getChar: GetChar, endOf: EndOf, backup: BackupIn, getIndex: GetInIndex, setIndex: SetInIndex];
GetChar:
PROC [self:
IO.
STREAM]
RETURNS [char:
CHAR] =
BEGIN
sd: TiogaInStreamData ← NARROW[self.streamData];
TryForNextChar[sd];
IF sd.end THEN ERROR IO.EndOfStream[self];
char ← sd.nodeRope.Fetch[sd.next];
sd.next ← sd.next + 1;
sd.index ← sd.index + 1;
END;
EndOf:
PROC [self:
IO.
STREAM]
RETURNS [end:
BOOLEAN] =
BEGIN
sd: TiogaInStreamData ← NARROW[self.streamData];
TryForNextChar[sd];
end ← sd.end;
END;
BackupIn:
PROC [self:
IO.
STREAM, char:
CHAR] = {
past: INT ← self.GetIndex[];
oldChar: CHAR;
IF past = 0 THEN ERROR IO.Error[IllegalBackup, self];
self.SetIndex[past-1];
oldChar ← self.GetChar[];
IF oldChar # char THEN ERROR IO.Error[IllegalBackup, self];
self.SetIndex[past-1];
};
GetInIndex:
PROC [self:
IO.
STREAM]
RETURNS [index:
INT] = {
sd: TiogaInStreamData ← NARROW[self.streamData];
index ← sd.index;
};
SetInIndex:
PROC [self:
IO.
STREAM, index:
INT] = {
sd: TiogaInStreamData ← NARROW[self.streamData];
local: INT;
TryForNextChar[sd];
local ← index - sd.indexAtNodeStart;
IF local
IN [0 .. sd.nodeLen]
THEN {
sd.next ← local;
sd.index ← index;
sd.end ← FALSE; --well, what this really means is that we don't yet know that it's at the end
}
ELSE {
GoToBeginning[sd];
sd.next ← sd.index ← index;
};
};
CurInNode:
PUBLIC
PROC [s:
IO.
STREAM]
RETURNS [n:
TN.Ref] = {
sd: TiogaInStreamData ← NARROW[s.streamData];
TryForNextChar[sd];
n ← sd.node;
};
SkipChildren:
PUBLIC
PROC [s:
IO.
STREAM] = {
sd: TiogaInStreamData = NARROW[s.streamData];
Work:
PROC [of:
TN.Ref]
RETURNS [next:
TN.Ref, dd, di:
INT] = {
rawSize: INT = TN.NodeRope[of].Length[];
di ←
IF
NOT of.comment
THEN rawSize+1
ELSE
SELECT sd.commentHandling
FROM
discard => 0,
useDirectly => rawSize+1,
prefixWithDashDash => rawSize+3,
ENDCASE => ERROR;
[next, dd] ← TN.Forward[of];
IF dd > 1 THEN ERROR;
IF dd < 1 THEN RETURN;
dd ← dd - 1;
WHILE dd = 0
DO
ddi: INT;
[next, dd, ddi] ← Work[next];
di ← di + ddi;
ENDLOOP;
dd ← dd + 1;
};
new: TN.Ref;
dd, di, newStart: INT;
TryForNextChar[sd];
[new, dd, di] ← Work[sd.node];
newStart ← sd.indexAtNodeStart + di;
IF newStart < sd.index THEN ERROR;
sd.index ← newStart;
IF sd.depth+dd <= 0 OR new = NIL THEN {sd.end ← TRUE; RETURN};
sd.node ← new;
sd.indexAtNodeStart ← newStart;
sd.depth ← sd.depth + dd;
sd.next ← 0;
NodeHello[sd];
};
TiogaInStreamData: TYPE = REF TiogaInStreamDataRep;
TiogaInStreamDataRep:
TYPE =
RECORD [
commentHandling: CommentHandling,
end: BOOLEAN ← FALSE,
next, nodeLen, depth: INT ← 0,
indexAtNodeStart, index: INT ← 0,
nodeRope: ROPE ← NIL,
levelPrefix: ROPE,
node, root: TN.Ref];
TryForNextChar:
PROC [sd: TiogaInStreamData] =
BEGIN
IF sd.end THEN RETURN;
WHILE sd.next >= sd.nodeLen
DO
dd: INT;
next: TN.Ref;
[next, dd] ← TN.Forward[sd.node];
IF sd.depth+dd <= 0 OR next = NIL THEN {sd.end ← TRUE; RETURN};
sd.next ← sd.next - sd.nodeLen;
sd.depth ← sd.depth + dd;
sd.indexAtNodeStart ← sd.indexAtNodeStart + sd.nodeLen;
sd.node ← next;
NodeHello[sd];
ENDLOOP;
END;
NodeHello:
PROC [sd: TiogaInStreamData] =
BEGIN
tn: TN.RefTextNode ← sd.node;
Use:
PROC [prefix:
ROPE] = {
sd.nodeRope ← TN.NodeRope[tn].Concat["\n"];
IF prefix # NIL THEN sd.nodeRope ← prefix.Concat[sd.nodeRope];
IF sd.levelPrefix.Length[] # 0
THEN
THROUGH [1 .. sd.depth)
DO
sd.nodeRope ← sd.levelPrefix.Concat[sd.nodeRope];
ENDLOOP;
sd.nodeLen ← sd.nodeRope.Length[];
};
IF tn.comment
THEN
SELECT sd.commentHandling
FROM
discard => {
sd.nodeRope ← NIL;
sd.nodeLen ← 0;
};
useDirectly => Use[NIL];
prefixWithDashDash => Use["--"];
ENDCASE => ERROR
ELSE Use[NIL];
END;
CreateOutput:
PUBLIC
PROC [to:
TFO.Ref, breakAtNewline:
BOOL ←
FALSE, levelPrefix, defaultFormat:
ROPE ←
NIL]
RETURNS [out:
IO.
STREAM] =
BEGIN
sd: TiogaOutStreamData ←
NEW [TiogaOutStreamDataRep ← [
breakAtNewline: breakAtNewline,
parsePrefix: levelPrefix # NIL,
levelPrefix: levelPrefix,
root: to,
nodes: LIST[to],
lpLength: levelPrefix.Length[],
nextDepth: 1,
defaultFormat: defaultFormat
]];
pfp: IOUtils.PFProcs;
out ← IO.CreateStream[streamProcs: tiogaOutStreamProcs, streamData: sd];
pfp ← IOUtils.CopyPFProcs[out];
[] ← IOUtils.SetPFCodeProc[pfProcs: pfp, char: 'l, codeProc: FormatL];
[] ← IOUtils.SetPFProcs[stream: out, pfProcs: pfp];
PrepareForChar[out, sd];
END;
tiogaOutStreamProcs: REF IO.StreamProcs ← IO.CreateStreamProcs[variety: output, class: $TiogaOutStream, putChar: PutChar, putBlock: PutBlock, close: CloseOut];
PutChar:
PROC [self:
IO.
STREAM, char:
CHAR] =
BEGIN
sd: TiogaOutStreamData ← NARROW[self.streamData];
SELECT
TRUE
FROM
sd.breakAtNewline AND char = '\n => EndNode[self, reset, FALSE];
sd.parsePrefix
AND (
NOT sd.ready)
AND char = sd.levelPrefix.Fetch[sd.lpCharsSeen] => {
sd.lpCharsSeen ← sd.lpCharsSeen + 1;
IF sd.lpCharsSeen = sd.lpLength
THEN {
sd.lpCharsSeen ← 0;
sd.nextDepth ← sd.nextDepth + 1;
};
};
ENDCASE => {
PrepareForChar[self, sd];
sd.contents ← sd.contents.Concat[Rope.FromChar[char]];
};
END;
PutBlock:
PROC [self:
IO.
STREAM, block:
REF
READONLY
TEXT, startIndex, count:
NAT] =
BEGIN
sd: TiogaOutStreamData ← NARROW[self.streamData];
next: NAT ← startIndex;
afterLast: NAT ← startIndex + count;
WHILE next < afterLast
DO
nextCR, subsize: NAT;
WHILE (
NOT sd.ready)
OR block[next] = '\n
DO
PutChar[self, block[next]];
next ← next + 1;
IF next >= afterLast THEN RETURN;
ENDLOOP;
FOR nextCR ← next, nextCR + 1 WHILE nextCR < afterLast AND block[nextCR] # '\n DO NULL ENDLOOP;
IF (subsize ← nextCR - next) # 0
THEN {
sd.contents ← sd.contents.Concat[RopeFromSubText[block, next, subsize]];
next ← nextCR;
};
ENDLOOP;
PrepareForChar[sd];
sd.contents ← sd.contents.Concat[Rope.FromRefText[block].Substr[start: startIndex, len: count]];
END;
CloseOut:
PROC [self:
IO.
STREAM, abort:
BOOL ←
FALSE] =
BEGIN
EndNode[self];
IOUtils.AmbushStream[self: self, streamProcs: IOUtils.closedStreamProcs, streamData: NIL];
END;
CurOutNode:
PUBLIC
PROC [s:
IO.
STREAM]
RETURNS [n:
TFO.Ref] =
BEGIN
sd: TiogaOutStreamData ← NARROW[s.streamData];
n ← sd.nodes.first;
END;
SetFormat:
PUBLIC
PROC [of:
IO.
STREAM, format:
ROPE] =
BEGIN
n: TFO.Ref ← CurOutNode[of];
TFO.SetFormat[n, format];
END;
FormatL:
PROC [stream:
IO.
STREAM, val:
IO.Value, format: IOUtils.Format, char:
CHAR] = {
sd: TiogaOutStreamData ← NARROW[stream.streamData];
PrepareForChar[stream, sd];
WITH val
SELECT
FROM
rv: IO.Value[rope] => LooksWork[stream, sd, rv.value];
ENDCASE => ERROR IO.Error[PFUnprintableValue, stream];
};
LooksWork:
PROC [stream:
IO.
STREAM, sd: TiogaOutStreamData, chars:
ROPE] = {
index: INT ← sd.contents.Length[];
FOR i:
INT
IN [0 .. chars.Length[])
DO
c: CHAR ← chars.Fetch[i];
SELECT c
FROM
' => LooksWork[stream, sd, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"];
IN ['a .. 'z] => {
IF sd.looks[c] = NIL OR sd.looks[c].first.afterLast # notClosed THEN sd.looks[c] ← CONS[[first: index, afterLast: notClosed], sd.looks[c]]
};
IN ['A .. 'Z] => {l: Look ← c + ('a - 'A);
IF sd.looks[l] # NIL AND sd.looks[l].first.afterLast = notClosed THEN sd.looks[l].first.afterLast ← index;
};
ENDCASE => ERROR IO.Error[PFUnprintableValue, stream];
ENDLOOP;
};
EndNode:
PUBLIC
PROC [s:
IO.
STREAM, depthOp: DepthOp ← reset, idempotently:
BOOLEAN ←
FALSE] =
BEGIN
sd: TiogaOutStreamData ← NARROW[s.streamData];
IF
NOT sd.ready
THEN
BEGIN
IF idempotently THEN RETURN;
PrepareForChar[s, sd];
END;
TFO.SetContents[sd.nodes.first, sd.contents];
SetLooks[sd];
sd.ready ← FALSE;
sd.lpCharsSeen ← 0;
sd.contents ← NIL;
sd.nextDepth ←
SELECT depthOp
FROM
same => sd.userDepth,
reset => 1,
ENDCASE => ERROR;
END;
SetLooks:
PROC [sd: TiogaOutStreamData] = {
len: INT ← sd.contents.Length[];
FOR l: Look
IN Look
DO
FOR lr: LooksRuns ← sd.looks[l], lr.rest
WHILE lr #
NIL
DO
afterLast: INT ← IF lr.first.afterLast = notClosed THEN len ELSE lr.first.afterLast;
TFO.AddLooks[x: sd.nodes.first, start: lr.first.first, len: afterLast - lr.first.first, look: l, root: sd.root];
ENDLOOP;
ENDLOOP;
sd.looks ← ALL[NIL];
};
ChangeDepth:
PUBLIC
PROC [s:
IO.
STREAM, deltaDepth:
INTEGER ← 0, autoEndNode:
BOOLEAN ←
TRUE, idempotently:
BOOLEAN ←
FALSE] =
BEGIN
sd: TiogaOutStreamData ← NARROW[s.streamData];
IF autoEndNode THEN EndNode[s, same, idempotently];
IF sd.ready THEN ERROR NotNow[s];
sd.nextDepth ← sd.nextDepth + deltaDepth;
END;
NotNow: PUBLIC ERROR [s: IO.STREAM] = CODE;
BadDepth: PUBLIC ERROR [s: IO.STREAM, depth: INT] = CODE;
TiogaOutStreamData: TYPE = REF TiogaOutStreamDataRep;
TiogaOutStreamDataRep:
TYPE =
RECORD [
breakAtNewline, parsePrefix: BOOL,
levelPrefix: ROPE,
root: TFO.Ref ← NIL,
nodes: LIST OF TFO.Ref ← NIL,
ready: BOOLEAN ← FALSE,
lpCharsSeen, lpLength: INT ← 0,
nodeDepth, userDepth, --deltaDepth--nextDepth: INT ← 0,
contents: ROPE ← NIL,
defaultFormat: ROPE ← NIL,
looks: ARRAY Look OF LooksRuns ← ALL[NIL]];
LooksRuns: TYPE = LIST OF LooksRun;
LooksRun: TYPE = RECORD [first, afterLast: INT];
Look: TYPE = CHAR['a .. 'z];
notClosed: INT = -1;
PrepareForChar:
PROC [s:
IO.
STREAM, sd: TiogaOutStreamData] =
BEGIN
IF sd.ready THEN RETURN;
IF sd.nextDepth < 0 THEN ERROR BadDepth[s, sd.nextDepth];
WHILE sd.nextDepth < sd.nodeDepth
DO
sd.nodes ← sd.nodes.rest;
sd.nodeDepth ← sd.nodeDepth - 1;
ENDLOOP;
IF sd.nextDepth > sd.nodeDepth
THEN {
sd.nodes ← CONS[TFO.InsertAsLastChild[x: sd.nodes.first], sd.nodes];
sd.nodeDepth ← sd.nodeDepth + 1}
ELSE {
sd.nodes.first ← TFO.InsertNode[x: sd.nodes.first, child: FALSE];
};
IF sd.defaultFormat # NIL THEN TFO.SetFormat[sd.nodes.first, sd.defaultFormat];
sd.contents ← NIL;
sd.ready ← TRUE;
sd.userDepth ← sd.nodeDepth;
WHILE sd.userDepth < sd.nextDepth
DO
sd.contents ← sd.contents.Concat[sd.levelPrefix];
sd.userDepth ← sd.userDepth + 1;
ENDLOOP;
IF sd.lpCharsSeen > 0
THEN {
sd.contents ← sd.contents.Concat[sd.levelPrefix.Substr[len: sd.lpCharsSeen]];
};
END;
true: REF ANY ← NEW [BOOL ← TRUE];
CopyChildren:
PUBLIC
PROC [from:
TN.Ref, to:
TFO.Ref] =
BEGIN
Work:
PROC [from:
TN.Ref, to:
TFO.Ref]
RETURNS [next:
TN.Ref, dd:
INT] =
TRUSTED {
last: TFO.Ref ← to;
lastIsParent: BOOLEAN ← TRUE;
[next, dd] ← TN.Forward[from];
IF dd > 1 THEN ERROR;
IF dd < 1 THEN RETURN;
dd ← dd - 1;
WHILE dd = 0
DO
toKid: TFO.Ref;
tn: TN.RefTextNode ← next;
r: ROPE ← TN.NodeRope[tn];
toKid ← last.InsertNode[child: lastIsParent];
toKid.SetContents[r];
IF tn.comment THEN TiogaOps.PutProp[n: LOOPHOLE[toKid], name: $Comment, value: true];
last ← toKid; lastIsParent ← FALSE;
[next, dd] ← Work[next, toKid];
ENDLOOP;
dd ← dd + 1;
};
[] ← Work[from, to];
END;
RopeFromSubText:
PROC [text:
REF
READONLY
TEXT, startIndex, count:
NAT]
RETURNS [rope:
ROPE] = {
GetChar:
PROC
RETURNS [c:
CHAR] = {
c ← text[startIndex];
startIndex ← startIndex + 1;
count ← count - 1;
};
rope ← Rope.FromProc[count, GetChar];
};
END.