TiogaStreamsImpl.Mesa
Last Edited by: Spreitzer, September 18, 1985 5:59:06 pm PDT
Mike Spreitzer August 4, 1986 10:33:55 am 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: ROPENIL] 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;
};
};
CurInLoc: PUBLIC PROC [s: IO.STREAM] RETURNS [loc: TN.Location] = {
sd: TiogaInStreamData ← NARROW[s.streamData];
TryForNextChar[sd];
loc ← [sd.node, MAX[MIN[sd.nodeLen - sd.nodePostfixLength, sd.next] - sd.nodePrefixLength, 0]];
};
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: BOOLEANFALSE,
next, nodeLen, nodePrefixLength, nodePostfixLength, depth: INT ← 0,
indexAtNodeStart, index: INT ← 0,
nodeRope: ROPENIL,
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] = {
IF sd.levelPrefix.Length[] # 0 THEN THROUGH [1 .. sd.depth) DO
prefix ← sd.levelPrefix.Concat[prefix];
ENDLOOP;
sd.nodePrefixLength ← prefix.Length[];
sd.nodePostfixLength ← 1;
sd.nodeRope ← Rope.Cat[prefix, TN.NodeRope[tn], "\n"];
sd.nodeLen ← sd.nodeRope.Length[];
};
IF tn.comment
THEN SELECT sd.commentHandling FROM
discard => {
sd.nodeRope ← NIL;
sd.nodeLen ← 0;
sd.nodePrefixLength ← sd.nodePostfixLength ← 0;
};
useDirectly => Use[NIL];
prefixWithDashDash => Use["--"];
ENDCASE => ERROR
ELSE Use[NIL];
END;
CreateOutput: PUBLIC PROC [to: TFO.Ref, breakAtNewline: BOOLFALSE, levelPrefix, defaultFormat: ROPENIL] 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: BOOLFALSE] =
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: BOOLEANFALSE] =
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: INTIF 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: BOOLEANTRUE, idempotently: BOOLEANFALSE] =
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: BOOLEANFALSE,
lpCharsSeen, lpLength: INT ← 0,
nodeDepth, userDepth, --deltaDepth--nextDepth: INT ← 0,
contents: ROPENIL,
defaultFormat: ROPENIL,
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 ANYNEW [BOOLTRUE];
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: BOOLEANTRUE;
[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: ROPETN.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.