DIRECTORY
Atom USING [MakeAtom, GetPName--, PutPropOnList, PropList, DottedPair, DottedPairNode--],
IO USING [GetBlock, GetIndex, SetIndex, STREAM, PutChar, ROS, RopeFromROS, --EndOfStream, PutF,-- PutFR, --PutChar,-- rope, int, atom],
Rope USING [ROPE, Find, Length, Substr, FromRefText, Concat, Cat, Fetch, Equal],
ISTiogaIntern,
ISMessage USING [--GetIndex, PutF, CloseTempFile, ReopenTempFile, GetTempFileChar,-- TiogaDeltaLevel, WriteTiogaRope, WriteTiogaProp, WriteTiogaFormat],
ISBinding USING [ObtainBinding, Handle, StackHandle, Anchor],
ISToken USING [InitialInterscriptContext, EndInterscriptContext, EmbeddedInterscriptContext, ContentInterscriptContext, BindingsInterscriptContext, TVHandle, CharactersTVHandle, NodeTVHandle, AtomTVHandle, IntegerTVHandle, InterscriptContext],
ISNode USING [InternalizeProc, TiogaPrintProc, Handle, TagHandle, ContextHandle, ContextRecord, GetContext, SetContext, HasTag];
localBindingLimit: PUBLIC ISBinding.Anchor; --tells where top (innermost) stack frame ends--
SetTiogaProps:
PROC [bc: ISToken.BindingsInterscriptContext, tag: Rope.
ROPE, node: ISNode.Handle, includeTag:
BOOL ←
FALSE] ~ {
prefix: Rope.ROPE = Rope.Concat[tag, "."];
FOR b: ISBinding.Handle ←
NARROW[bc.bindings, ISBinding.StackHandle].top, b.previous
UNTIL b=
NIL
DO {
n: Rope.ROPE = Atom.GetPName[b.name];
IF b=localBindingLimit THEN EXIT;
IF Rope.Find[n, prefix]=0
THEN {
p: ATOM = IF includeTag THEN Atom.MakeAtom[n] ELSE Atom.MakeAtom[Rope.Substr[n, Rope.Length[prefix]+1]];
node.taggedBindingsList ← CONS[b, node.taggedBindingsList];
};
};
ENDLOOP;
};
ObtainTaggedBinding:
PROC [tag: Rope.
ROPE, name: Rope.
ROPE, node: ISNode.Handle]
RETURNS [ISToken.TVHandle] ~ {
taggedName: ATOM ← Atom.MakeAtom[Rope.Cat[tag, ".", name]];
FOR l:
LIST
OF ISBinding.Handle ← node.taggedBindingsList, l.rest
UNTIL l=
NIL
DO
IF l.first.name=taggedName THEN RETURN[l.first.value];
ENDLOOP;
RETURN[NIL];
};
PrintToken:
PUBLIC PROC [t: ISToken.TVHandle]
RETURNS [r: Rope.
ROPE] ~ {
WITH t
SELECT
FROM
i: ISToken.IntegerTVHandle =>
r ← IO.PutFR[" %g ", IO.int[i.value]];
a: ISToken.AtomTVHandle =>
r ← IO.PutFR[" %g ", IO.atom[a.value]];
c: ISToken.CharactersTVHandle =>
r ← IO.PutFR[" <%g> ", IO.rope[RopeFromChars[c]]];
n: ISToken.NodeTVHandle =>
r ← PrintNodeContents[NARROW[n.isnode]];
ENDCASE => ERROR;
};
PrintNodeContents:
PUBLIC
PROC [n: ISNode.Handle, wrap:
BOOL←
TRUE]
RETURNS [r: Rope.
ROPE ← ""] ~ {
IF n.primaryTag#NIL THEN r ← IO.PutFR["%g$ ", IO.atom[n.primaryTag]];
FOR tl: ISNode.TagHandle ← n.tagThread, tl.next
UNTIL tl=
NIL
DO
IF tl.tag#n.primaryTag THEN r ← IO.PutFR["%g%g$ ", IO.rope[r], IO.atom[tl.tag]];
ENDLOOP;
FOR bl:
LIST
OF ISBinding.Handle ← n.taggedBindingsList, bl.rest
UNTIL bl=
NIL
DO
b: ISBinding.Handle ← bl.first;
r ← IO.PutFR["%g%g=%g ", IO.rope[r], IO.atom[b.name], IO.rope[PrintToken[b.value]]];
ENDLOOP;
FOR ct: ISNode.ContextHandle ← n.contextThread, ct.next
UNTIL ct=
NIL DO
WITH ct.context
SELECT
FROM
c: ISToken.ContentInterscriptContext =>
r ← IO.PutFR["%g%g ", IO.rope[r], IO.rope[PrintToken[c.content]]];
m: ISToken.EmbeddedInterscriptContext =>
r ← IO.PutFR["%g%g ", IO.rope[r], IO.rope[PrintNodeContents[NARROW[m.content.isnode]]]];
ENDCASE => ERROR;
ENDLOOP;
IF wrap THEN r ← IO.PutFR["{ %g }\n", IO.rope[r]];
};
WriteTiogaProps:
PROC [node: ISNode.Handle] ~ {
FOR l:
LIST
OF ISBinding.Handle ← node.taggedBindingsList, l.rest
UNTIL l=
NIL
DO
b: ISBinding.Handle ← l.first;
n: Rope.ROPE = Atom.GetPName[b.name];
p:
ATOM ←
IF Rope.Find[n, "PROPERTIES."]=0
THEN Atom.MakeAtom[Rope.Substr[n, Rope.Length["PROPERTIES."]]]
ELSE b.name;
IF p=$Comment
AND Rope.Equal[RopeFromChars[
NARROW[b.value]], "TRUE"]
THEN ISMessage.WriteTiogaProp[prop: p, value: "TRUE"] --TiogaAccess treats Comment specially--
ELSE ISMessage.WriteTiogaProp[prop: p, value: PrintToken[b.value]];
ENDLOOP;
};
Primary Tags:
DefaultInternalizeProc:
PUBLIC ISNode.InternalizeProc = {
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
This tag has no equivalent in Tioga. Just put it on the Tioga node's property list, together with appropriate bindings.
WITH interscriptContext
SELECT
FROM
i: ISToken.InitialInterscriptContext =>
node.primaryTag ← node.tag;
c: ISToken.ContentInterscriptContext =>
ISNode.SetContext[node, NIL, c];
m: ISToken.EmbeddedInterscriptContext =>
ISNode.SetContext[node, NIL, m];
b: ISToken.BindingsInterscriptContext =>
SetTiogaProps[b, Atom.GetPName[node.tag], node, TRUE];
ENDCASE => NULL; --No special action on contents of Nodes of Wonder.--
};
DefaultPrintProc:
PUBLIC ISNode.TiogaPrintProc = {
[deltaLevel: INT, node: ISNode.Handle] RETURNS [nests: INT ← 0]
printedSubnode: BOOL ← FALSE;
ISMessage.TiogaDeltaLevel[deltaLevel+1]; -- +1 because we're starting a new node--
ISMessage.WriteTiogaRope[rope: IO.PutFR["[%g$ node]\n", IO.atom[IF node.primaryTag=NIL THEN $Anonymous ELSE node.primaryTag]], lookChars: "e"];
ISMessage.WriteTiogaProp[prop: Atom.MakeAtom["ISTag"], value: IF node.tag=NIL THEN "Set" ELSE Atom.GetPName[node.tag]];
WriteTiogaProps[node];
IF node.contextThread#
NIL
THEN
BEGIN
FOR c: ISNode.ContextHandle ← node.contextThread, c.next
UNTIL c=
NIL
DO
WITH c.context
SELECT
FROM
con: ISToken.ContentInterscriptContext =>
BEGIN
WriteContentNode:
PROC [r: Rope.
ROPE] ~ {
ISMessage.TiogaDeltaLevel[nests+1];
nests ← -1;
ISMessage.WriteTiogaProp[prop: Atom.MakeAtom["ISTag"], value: "<Literal>"];
ISMessage.WriteTiogaRope[rope: r, lookChars: ""];
};
WITH con.content
SELECT
FROM
i: ISToken.IntegerTVHandle => {
WriteContentNode[IO.PutFR["%g\n", IO.int[i.value]]];
};
a: ISToken.AtomTVHandle => {
WriteContentNode[IO.PutFR["%g\n", IO.atom[a.value]]];
};
c: ISToken.CharactersTVHandle => {
WriteContentNode[IO.PutFR["<%g>\n", IO.rope[RopeFromChars[c]]]];
};
ENDCASE => ERROR; -- Unsupported content object--
END;
emb: ISToken.EmbeddedInterscriptContext =>
WITH emb.content
SELECT
FROM
n: ISToken.NodeTVHandle => {
node: ISNode.Handle ← NARROW[n.isnode, ISNode.Handle];
nests ← -1 + node.printProc[nests, node];
printedSubnode ← TRUE;
};
ENDCASE => ERROR; --Only nodes in embedded contexts--
ENDCASE => NULL;
ENDLOOP;
END;
};
InternalizeDocument:
PUBLIC ISNode.InternalizeProc = {
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
WITH interscriptContext
SELECT
FROM
c: ISToken.InitialInterscriptContext =>
node.primaryTag ← node.tag;
m: ISToken.EmbeddedInterscriptContext => {
ISNode.SetContext[node, $Node, m];
};
e: ISToken.EndInterscriptContext =>
BEGIN
--Only look at first node. Is this not fair?-
context: ISToken.InterscriptContext = ISNode.GetContext[node, $Node];
IF context=NIL THEN ERROR
ELSE
WITH context
SELECT
FROM
m: ISToken.EmbeddedInterscriptContext => {
node: ISNode.Handle ← NARROW[m.content.isnode];
ISMessage.TiogaDeltaLevel[node.printProc[1, node]];
};
ENDCASE => ERROR; --Document should only contain nodes--
END;
ENDCASE => NULL;
};
unNests: INT ← 1;
InternalizePara:
PUBLIC ISNode.InternalizeProc = {
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
WITH interscriptContext
SELECT
FROM
i: ISToken.InitialInterscriptContext =>
node.primaryTag ← node.tag;
m: ISToken.EmbeddedInterscriptContext => {
ISNode.SetContext[node, NIL, m];
};
e: ISToken.EndInterscriptContext => {
unNests ← unNests+1;
};
ENDCASE => NULL;
};
PrintPara:
PUBLIC ISNode.TiogaPrintProc = {
[deltaLevel: INT, node: ISNode.Handle] RETURNS [nests: INT ← 0]
printedSubnode: BOOL ← FALSE;
ISMessage.TiogaDeltaLevel[deltaLevel+1]; --+1 because we're starting a new node--
WriteTiogaProps[node];
ISMessage.WriteTiogaProp[prop: Atom.MakeAtom["ISTag"], value: "PARA"];
ISMessage.WriteTiogaFormat[node.format];
IF node.contextThread#
NIL
THEN
BEGIN
FOR c: ISNode.ContextHandle ← node.contextThread, c.next
UNTIL c=
NIL
DO
WITH c.context
SELECT
FROM
con: ISToken.EmbeddedInterscriptContext =>
BEGIN
WITH con.content
SELECT
FROM
n: ISToken.NodeTVHandle => {
subnode: ISNode.Handle = NARROW[n.isnode];
IF ISNode.HasTag[subnode, $CHARS]
THEN {
commentBinding: ISToken.TVHandle;
IF printedSubnode
THEN
--Continuation text (non-standard tioga structure). Treat as first class subnode--
nests ← -1 + subnode.printProc[nests, subnode]
ELSE {
commentBinding ← ObtainTaggedBinding["PROPERTIES", "Comment", node];
ISMessage.WriteTiogaRope[rope: subnode.text,
lookChars: subnode.looks,
comment: IF commentBinding#NIL THEN TRUE ELSE FALSE];
};
}
ELSE {
nests ← -1 + subnode.printProc[nests, subnode];
printedSubnode ← TRUE;
};
};
ENDCASE => ERROR; -- Unsupported content object--
END;
ENDCASE => ERROR;
ENDLOOP;
END;
};
InternalizeChars:
PUBLIC ISNode.InternalizeProc = {
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
WITH interscriptContext
SELECT
FROM
i: ISToken.InitialInterscriptContext => {
node.primaryTag ← node.tag;
node.text ← "";
};
c: ISToken.ContentInterscriptContext => {
WITH c.content
SELECT
FROM
cv: ISToken.CharactersTVHandle => {
node.text ← Rope.Concat[node.text, RopeFromChars[cv]];
ISNode.SetContext[node, NIL, c];
};
ENDCASE => ERROR; --Only Characters should be content of CHARS$--
};
e: ISToken.EndInterscriptContext => {
};
ENDCASE => NULL;
};
PrintChars:
PUBLIC ISNode.TiogaPrintProc = {
[deltaLevel: INT, node: ISNode.Handle] RETURNS [nests: INT ← 0]
printedSubnode: BOOL ← FALSE;
ISMessage.TiogaDeltaLevel[deltaLevel+1]; --+1 because we're starting a new node--
ISMessage.WriteTiogaProp[prop: Atom.MakeAtom["ISTag"], value: "CHARS"];
WriteTiogaProps[node];
IF Rope.Length[node.text]=0
OR Rope.Fetch[node.text, Rope.Length[node.text]-1]#'\n
THEN node.text ← Rope.Concat[node.text, "\n"]; --Tioga nodes end in newline--
BEGIN
commentBinding: ISToken.TVHandle = ObtainTaggedBinding["PROPERTIES", "Comment", node];
ISMessage.WriteTiogaRope[rope: IO.PutFR["%g", IO.rope[node.text]], lookChars: "", comment: IF commentBinding#NIL THEN TRUE ELSE FALSE];
END;
};
Secondary Tags:
InternalizeLooks:
PUBLIC ISNode.InternalizeProc = {
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
WITH interscriptContext
SELECT
FROM
bc: ISToken.BindingsInterscriptContext => {
FOR b: ISBinding.Handle ←
NARROW[bc.bindings, ISBinding.StackHandle].top, b.previous
UNTIL b=
NIL
DO {
n: Rope.ROPE = Atom.GetPName[b.name];
IF b=localBindingLimit THEN EXIT;
IF Rope.Find[n, "LOOKS"]=0
THEN {
l: Rope.ROPE = Rope.Substr[n, Rope.Length["LOOKS."]];
v: ATOM;
vtv: ISToken.TVHandle = b.value;
WITH vtv
SELECT
FROM
c: ISToken.AtomTVHandle =>
v ← c.value;
ENDCASE => ERROR;
IF v = $TRUE THEN node.looks ← Rope.Concat[node.looks, l];
};
};
ENDLOOP;
};
ENDCASE => ERROR; --This is a secondary tag, so should only get bindings--
};
InternalizeStyle:
PUBLIC ISNode.InternalizeProc = {
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
WITH interscriptContext
SELECT
FROM
b: ISToken.BindingsInterscriptContext => {
WITH ISBinding.ObtainBinding[Atom.MakeAtom["STYLE.FORMAT"],
NARROW[b.bindings, ISBinding.StackHandle]]
SELECT
FROM
c: ISToken.CharactersTVHandle => {
node.format ← Atom.MakeAtom[RopeFromChars[c]];
};
ENDCASE => NULL;
};
ENDCASE => ERROR; --This is a secondary tag, so should only get bindings--
};
InternalizeProperties:
PUBLIC ISNode.InternalizeProc = {
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
WITH interscriptContext
SELECT
FROM
bc: ISToken.BindingsInterscriptContext => SetTiogaProps[bc, "PROPERTIES", node, TRUE];
ENDCASE => ERROR; --This is a secondary tag, so should only get bindings--
};
RopeFromChars:
PROC [c: ISToken.CharactersTVHandle]
RETURNS [r: Rope.
ROPE] ~ {
i: INT = IO.GetIndex[c.stream];
charsStream: IO.STREAM ← IO.ROS[];
t: REF TEXT = NEW[TEXT[c.length]];
ignoreEOS: BOOL ← FALSE;
charsRope: Rope.ROPE;
IO.SetIndex[c.stream, c.startIndex];
IF IO.GetBlock[c.stream, t, 0, c.length]#c.length THEN ERROR;
charsRope ← Rope.FromRefText[t];
FOR j:
INT
IN [0..Rope.Length[charsRope])
DO
char: CHAR ← Rope.Fetch[charsRope, j];
IF char='>
THEN {
ignoreEOS ← NOT ignoreEOS;
IF ignoreEOS THEN LOOP;
};
IO.PutChar[charsStream, char];
ENDLOOP;
r ← IO.RopeFromROS[charsStream];
IO.SetIndex[c.stream, i];
RETURN;
};
textContexts: ISNode.ContextHandle ← NIL;
GetContexts:
PROC [n: ISNode.Handle] ~ {
FOR c: ISNode.ContextHandle ← n.contextThread, c.next
UNTIL c=
NIL
DO
IF c.type=$CharacterNode THEN textContexts ← NEW[ISNode.ContextRecord ← [context: c.context, next: textContexts]];
ENDLOOP;
};
NextContext:
PROC
RETURNS [context: ISToken.InterscriptContext] ~ {
IF textContexts=
NIL
THEN
context ← NIL ELSE {
context ← textContexts.context;
textContexts ← textContexts.next;
};
RETURN;
};