JunoGlobalAlistImpl.mesa (ex OldParseWindowImpl.mesa)
Coded September 6, 1982 12:26 am
Last Edited by: Gnelson, January 17, 1984 11:56 am
Last Edited by: Stolfi June 13, 1984 12:47:24 pm PDT
Maintains a text viewer containing the current set of Juno procedures. Exports procedures that search this list and that append new procedures to it.
The viewer has two extra menu buttons:
Parse: parses the viewer contents, saves the result as the "current global alist",unparses it, and stuffs the unparsed text back into the viewer.
NewProc: Appends a new node to the viewer, with the skeleton of a procedure declaration (to be edited by the user).
NewProc: Appends a new node to the viewer, with the skeleton of a procedure declaration (to be edited by the user).
TO FIX: Everything.
DIRECTORY
JunoGlobalAlist,
JunoProcViewer USING
[Viewer, NewViewer, ParseViewer, DestroyViewer, AddBranch, BranchVisitProc],
JunoUserEvents USING [Blink],
Rope USING [ROPE, Substr, SkipTo, Length, Fetch, Cat, Equal],
Atom USING [GetPName],
ViewerClasses USING [Viewer],
JunoExpressions USING [leftPren, colon, lambda, Definition, Cadr, Caddr],
JunoParseSyntax USING [junoParseTable],
JunoParseUnparse USING
[Se, VerdictAndCulprit, Stream, StreamFromRope, Parse, Contents, Unparse];
JunoGlobalAlistImpl:
CEDAR PROGRAM
IMPORTS
JunoProcViewer,
JunoExpressions,
JunoParseUnparse,
JunoParseSyntax,
JunoUserEvents,
Rope,
Atom
EXPORTS
JunoGlobalAlist =
BEGIN
OPEN
Rope,
JunoGlobalAlist,
PView: JunoProcViewer,
Expr: JunoExpressions,
Evs: JunoUserEvents,
Synt: JunoParseSyntax,
Parse: JunoParseUnparse;
- - - - IMPORTED TYPES
ROPE: TYPE = Rope.ROPE;
Se: TYPE = Parse.Se;
Viewer: TYPE = ViewerClasses.Viewer;
- - - - THE GLOBAL ALIST
The global alist consists of a list of viewers, in the search order. This list needs not be protected by the monitor, since it is altered/consulted only by the client process (JunoTop). A viewer are added to the list through AddViewer below, and is removed by ParseAll when the latter notices it has been destroyed by the user.
Segment: TYPE = RECORD
[viewer: Viewer,
entries: LIST OF Entry ← NIL, -- entries parsed from this viewer, in reverse order
nerrors: INTEGER ← 0 -- Number of errors detected in last parse
];
firstSegment, lastSegment: LIST OF Segment ← NIL;
Entry:
TYPE =
RECORD
[text1, text2: ROPE, -- UnParsed contents of header and body nodes for this entry
name: ATOM, -- key (procedure name)
value: Se -- value (lambda expression)
];
StartUp:
PUBLIC
PROC =
BEGIN
IF firstSegment # NIL THEN ERROR;
END;
AddNewViewer:
PUBLIC
PROC =
Adds a new empty viewer at the end the global Alist.
BEGIN
viewer: Viewer = PView.NewViewer[];
new: LIST OF Segment = LIST [[viewer: PView.NewViewer[], entries: NIL]];
IF firstSegment = NIL
THEN {firstSegment ← new}
ELSE {lastSegment.rest ← new};
lastSegment ← new
END;
AddDef:
PUBLIC PROC [name:
ATOM, value: Se] =
Adds a new entry in the global Alist. The entry is appended at the end of the last active viewer .
BEGIN
text1, text2: ROPE;
[text1, text2] ← UnparseDef[ToOldStyleDecl[name, value]];
IF firstSegment = NIL THEN AddNewViewer[];
PView.AddBranch[lastSegment.first.viewer, text1, text2];
lastSegment.first.entries ← CONS [[text1, text2, name, value], lastSegment.first.entries]
END;
ParseAll:
PUBLIC
PROC =
Parses the contents of the viewer and rebuilds AList. Resets the notParsed flag.
To be called by the top level program before refreshing the image
BEGIN
FOR seg: LIST OF Segment ← firstSegment, seg.rest WHILE seg # NIL DO
oldEntries:
LIST
OF Entry ← seg.first.entries;
ParseUnparseEntry: PView.BranchVisitProc =
-- [text1, text2: ROPE] RETURNS [new1, new2: ROPE, errBeg, errEnd ← -1]
TRUSTED BEGIN
old, ant: LIST OF Entry ← NIL;
FOR old ← oldEntries, old.rest WHILE old # NIL DO
IF Equal[old.first.text1, text1] AND Equal[old.first.text2, text2] THEN
{IF ant = NIL THEN seg.first.entries ← old.rest ELSE ant.rest ← old.rest; EXIT};
ant ← old
ENDLOOP;
IF old = NIL THEN
{def: Se;
ldef: LIST OF Se;
error, unp: ROPE;
vc: Parse.VerdictAndCulprit;
openCount: INTEGER;
stream: Parse.Stream = Parse.StreamFromRope[Cat[text1, text2]];
[def, error, openCount] ← Parse.Parse[stream, Synt.junoParseTable];
IF error = NIL AND stream.pos < stream.len THEN
{error ← "excess input"};
ldef ← LIST [def];
IF error = NIL THEN
{vc ← Expr.Definition[ldef];
IF vc.verdict # yes THEN error ← "not a wff"}
ELSE
{vc ← [yes, NIL]};
unp ← Parse.Unparse[ldef, Synt.junoParseTable, vc.culprit, openCount, 0, 57];
errBeg ← errEnd ← unp.Length;
unp ← Cat[unp, Parse.Contents[stream]];
{lenh: INT ← SkipTo[unp, 0, "\n"];
IF lenh >= unp.Length THEN lenh ← SkipTo[unp, 0, ":"];
new1 ← unp.Substr[0, lenh]; new2 ← unp.Substr[lenh]};
IF error # NIL THEN
{Evs.Blink["Parse error: ", error]}
ELSE
{head: Se = Expr.Cadr[def];
name: Se ← IF ISTYPE [head, ATOM] THEN head ELSE Expr.Cadr[head];
formals: Se ← IF ISTYPE [head, ATOM] THEN NIL ELSE Expr.Caddr[head];
body: Se = Expr.Caddr[def];
errBeg ← errEnd ← -1;
seg.first.entries ← CONS
[[new1, new2, NARROW[name], LIST [Expr.lambda, formals, body]],
seg.first.entries]}}
ELSE
{old.rest ← seg.first.entries; seg.first.entries ← old;
new1← text1; new2 ← text2; errBeg ← errEnd ← -1}
END;
seg.first.entries ← NIL;
seg.first.nerrors ← PView.ParseViewer[seg.first.viewer, ParseUnparseEntry];
IF seg.first.nerrors # 0 THEN
{WHILE oldEntries # NIL DO
t: LIST OF Entry = oldEntries.rest;
oldEntries.rest ← seg.first.entries;
seg.first.entries ← oldEntries;
oldEntries ← t
ENDLOOP}
ENDLOOP
END;
GetDef:
PUBLIC
PROC [name:
ATOM]
RETURNS [value: Se] =
BEGIN
FOR seg: LIST OF Segment ← firstSegment, seg.rest WHILE seg # NIL DO
FOR e: LIST OF Entry ← seg.first.entries, e.rest UNTIL e=NIL DO
IF e.first.name = name THEN RETURN[e.first.value]
ENDLOOP;
IF seg.first.nerrors > 0 THEN
{Evs.Blink["Can't evaluate ", Atom.GetPName[name], " - syntax errors in viewer"];
ERROR};
ENDLOOP;
RETURN [NIL]
END;
Terminate:
PUBLIC
PROC =
BEGIN
FOR seg: LIST OF Segment ← firstSegment, seg.rest WHILE seg # NIL DO
PView.DestroyViewer[seg.first.viewer]
ENDLOOP;
firstSegment ← lastSegment ← NIL
END;
ToOldStyleDecl:
PROC [name:
ATOM, value: Se]
RETURNS [tree: Se] =
Converts a (name, lambda-expression) pair to a definition in the old juno format,
(Expr.colon (Expr.leftPren <name> <paramters>) <body>) or
(Expr.colon <name> <body>) pair.
{expr: LIST OF Se = NARROW [value];
formals: Se = expr.rest.first;
body: Se = expr.rest.rest.first;
header: Se = IF formals = NIL THEN name ELSE LIST[Expr.leftPren, name, formals];
IF expr.first # Expr.lambda THEN ERROR;
RETURN [LIST [Expr.colon, header, body]]};
UnparseDef:
PROC [def: Se]
RETURNS [text1, text2:
ROPE] =
Unparses the given tree. The latter must be a procedure definition in the old juno format,
(Expr.colon (Expr.leftPren <name> <paramters>) <body>) or
(Expr.colon <name> <body>) pair.
{unp: ROPE ← Parse.Unparse[LIST[def], Synt.junoParseTable, NIL, 0, 0, 57];
lenh: INT ← unp.SkipTo[0, "\n"];
IF lenh >= unp.Length THEN lenh ← MIN [unp.SkipTo[0, ":"], 57];
text1 ← unp.Substr[0, lenh];
text2 ← unp.Substr[IF lenh < unp.Length AND unp.Fetch[lenh] = ':
THEN lenh ELSE lenh + 1]};
END.
- - - - STUFF UNDER DEVELOPMENT
GetCurrentDef:
PUBLIC
PROC [name:
ATOM]
RETURNS [value: Expr.e] =
BEGIN
toParse: Handle ← NIL; -- DoGetDef needs this to be parsed before retrying
DoGetDef:
ENTRY
PROC =
{ENABLE {UNWIND => NULL};
toParse ← NIL;
FOR lst: LIST OF Handle ← handleList, lst.rest WHILE lst # NIL DO
handle: Handle = lst.first;
IF handle.notParsed THEN
{toParse ← handle; RETURN}; -- can't call ParseViewer here: deadl(ock)y danger
FOR elst: LIST OF Entry ← handle.entryList, elst.rest WHILE elst # NIL DO
IF NOT elst.first.valid THEN RETURN WITH ERROR ParseErrors;
IF elst.first.name = name THEN
{value ← elst.first.value; RETURN}
ENDLOOP
ENDLOOP};
value ← NIL;
DO
DoGetDef[];
IF toParse = NIL THEN RETURN;
ParseViewer[toParse.viewer]
ENDLOOP
END;
AddDef:
PUBLIC
PROC [name:
ATOM, value: Se] =
BEGIN
firstLine, remainingLines: ROPE;
DoAppendDef:
ENTRY
PROC =
{IF handleList = NIL THEN
{RETURN WITH ERROR ParseErrors}
ELSE
{ENABLE {UNWIND => NULL};
handle: Handle = lastHandle.first;
elst: LIST OF Entry = LIST [[name: name, value: value, valid: TRUE]];
IF handle.lastEntry = NIL THEN {handle.lastEntry ← elst} ELSE {handle.entryList ← elst};
handle.lastEntry ← elst}};
[firstLine, remainingLines] ← UnparseDecl[ToOldStyleDecl [name, value]];
AddBranch[handle.viewer, firstLine, remainingLines];
DoAddDef
END;
ParseNode:
PROC [n: TiogaNode] =
RETURNS [success:
BOOL, tree:
REF
ANY, firstLine, remainingLines:
ROPE] =
{r: Rope.ROPE;
vc: VerdictAndCulprit;
errorMessage: ROPE ← NIL;
firstLine ← TiogaOps.GetRope[n];
remainingLines ← TiogaOps.GetRope[TiogaOps.FirstChild[n]];
-- next three lines try to skip parsing if old parsed result is present in pw.contents:
{l: LIST OF NodeContent ← pw.content;
WHILE l # NIL
AND NOT(Rope.Equal[l.first.text1, text1] AND Rope.Equal[l.first.text2, text2])
DO l ← l.rest ENDLOOP
; IF l # NIL THEN { success ← TRUE ; tree ← l.first.tree ; text1 ← l.first.text1; text2 ← l.first.text2 ; RETURN } };
IF ~ pw.contentValid THEN RETURN;
pw.ph.in.in ← IO.RIS[Rope.Cat[text1, text2, " "]];
pw.ph.in.eof ← FALSE;
pw.ph.in.error ← NIL;
pw.ph.in.Lex[];
IF pw.ph.in.eof THEN {success ← TRUE; tree ← text1 ← text2 ← NIL; RETURN};
pw.ph.Parse[];
pw.ph.result ← tree ← CONS[pw.ph.result, NIL];
-- necessary because WellFormed and Unparse work on the CAR of their argument
-- and ignore the cdr.
IF pw.ph.error = NIL AND pw.ph.eof
THEN {vc ← pw.WellFormed[pw.ph.result];
IF vc.verdict # Yes
THEN errorMessage ← "Not a WFF"
ELSE {vc.culprit ← NIL; errorMessage ← NIL}}
ELSE {vc.culprit ← NIL;
errorMessage ← IF pw.ph.error # NIL THEN pw.ph.error ELSE "Bad Syntax"};
r ← Unparser.Unparse[pw.ph.result, vc.culprit, 57, pw.ph.table, pw.ph.openCount];
--! change "57" to "width of window"
tree ← NARROW[pw.ph.result, LIST OF REF ANY].first;
IF pw.ph.error # NIL OR ~pw.ph.eof
THEN {r ← Rope.Cat[r, " \000", Rope.FromRefText[pw.ph.in.buf], "\000"];
WHILE ~ IO.EndOf[pw.ph.in.in]
DO r ← Rope.Cat[r, Rope.FromChar[IO.GetChar[pw.ph.in.in]]]
ENDLOOP};
{i: INT ← r.SkipTo[0, "\000"];
j: INT;
endOfHeader: INT = r.SkipTo[0, "\n"];
firstLine: Rope.ROPE = r.Substr[0, endOfHeader];
restOfLines: Rope.ROPE =
IF endOfHeader = r.Length THEN NIL ELSE r.Substr[endOfHeader + 1];
Foo: SAFE PROC[root: TiogaOps.Ref] = TRUSTED
{m: TiogaNode = IF TiogaOps.FirstChild[n] = NIL THEN n ELSE TiogaOps.FirstChild[n];
TiogaOps.SelectNodes[viewer: pw.viewer, start:n, end:m, pendingDelete: TRUE, level:char];
IF i = r.Length[]
THEN {TiogaOps.InsertRope[firstLine];
TiogaOps.Break[];
TiogaOps.Nest[];
TiogaOps.InsertRope[restOfLines]}
ELSE {j ← r.SkipTo[i + 1, "\000"];
TiogaOps.InsertRope[Rope.Cat[r.Substr[0, i], r.Substr[i+1, j - i - 1], r.Substr[j+1]]];
TiogaOps.SetSelection[pw.viewer, [n, i], [n, j - 1]]}};
TiogaOps.CallWithLocks[Foo, TiogaOps.ViewerDoc[pw.viewer]];
success ← (errorMessage = NIL);
text1 ← firstLine;
text2 ← restOfLines}};
ParseViewer:
PROC [viewer: Viewer] =
BEGIN
DoParseViewer:
ENTRY
PROC [root: REF] =
{ENABLE {UNWIND => NULL};
junoA: PWin.Handle = PEtc.junoA;
PEtc.Parse[];
IF NOT junoA.contentValid THEN Gr.Blink["Parse error"]
ELSE {p: LIST OF PWin.NodeContent ← junoA.content;
-- p is a list of pairs [text: rope, tree: REF ANY]; the trees
-- are all valid definitions, which we will add to the list of
-- definitions. Except that some are NILs that should be skipped.
WHILE p # NIL DO
IF p.first.tree # NIL
THEN {t: REF ANY = p.first.tree;
AddDef[Cadr[Cadr[t]], Caddr[Cadr[t]], Caddr[t]]};
p ← p.rest
ENDLOOP}};
{newContent: LIST OF NodeContent ← NIL;
n: TiogaNode ← TiogaOps.FirstChild[TiogaOps.ViewerDoc[pw.viewer]];
success: BOOL ← TRUE;
tree: REF;
text1: ROPE;
text2: ROPE;
pw.contentValid ← TRUE;
WHILE success AND n # NIL DO
[success, tree, text1, text2] ← PN2[n, pw];
IF success THEN newContent ← CONS[[text1, text2, tree], newContent];
n ← TiogaOps.Next[n];
ENDLOOP;
pw.contentValid ← success;
IF success THEN pw.content ← newContent ELSE pw.content ← AppendNodeContentList[newContent, pw.content]};
TiogaOps.CallWithLocks[DoParseViewer, TiogaOps.ViewerDoc[viewer]];
END;
- - - - OLD STUFF
ROPE:
TYPE = Rope.
ROPE;
SyntacticPredicate: TYPE =
PROC [f: REF ANY] RETURNS [VerdictAndCulprit];
VerdictAndCulprit:
TYPE =
RECORD [verdict: Verdict, culprit:
REF
ANY];
culprit relevant only if verdict is No or OfCourseNot
Verdict: TYPE = {Yes, No, OfCourseNot}; -- Yes == innocent
NewHandle:
PUBLIC
PROC [v: ViewerClasses.Viewer]
RETURNS [handle: Handle] =
{ handle ← NEW[HandleRep]
; handle.ph ← Parser.NewHandle[]
; handle.ph.in ← Lexer.NewHandle[]
; handle.viewer ← v
; handle.content ← NIL
; handle.contentValid ← FALSE};
- - - - MENU PROCEDURES
Moved here from JunoTop on April 6, 1984 3:52:04 pm PST; need to be fixed!!!
Parse:
PUBLIC
PROC =
{junoA: PWin.Handle = PEtc.junoA;
PEtc.Parse[];
IF NOT junoA.contentValid THEN Gr.Blink["Parse error"]
ELSE {p: LIST OF PWin.NodeContent ← junoA.content;
-- p is a list of pairs [text: rope, tree: REF ANY]; the trees
-- are all valid definitions, which we will add to the list of
-- definitions. Except that some are NILs that should be skipped.
WHILE p # NIL DO
IF p.first.tree # NIL
THEN {t: REF ANY = p.first.tree;
AddDef[Cadr[Cadr[t]], Caddr[Cadr[t]], Caddr[t]]};
p ← p.rest
ENDLOOP}};
NewProc:
PUBLIC
PROC =
{junoA: PWin.Handle = PEtc.junoA;
PWin.AddBranch[junoA, " CommandName(Args)", ": Body\n"]};
ProcFile:
PUBLIC
PROC[fileName: Rope.
ROPE] =
{PEtc.Algebra[fileName]; Parse[]};
Moved from JunoStorageImpl on April 6, 1984 3:52:04 pm PST; need to be fixed!!!
lambdaAlist: LIST OF REF ANY;
GetBody:
PUBLIC
PROC [name:
REF
ANY]
RETURNS [
REF
ANY] =
{deflist : LIST OF REF ANY ← lambdaAlist;
WHILE deflist # NIL AND deflist.first # name DO deflist ← deflist.rest.rest.rest ENDLOOP;
IF deflist # NIL THEN RETURN [Car[Cddr[deflist]]] ELSE RETURN [NIL]};
GetLocals:
PUBLIC
PROC [name:
REF
ANY]
RETURNS [
REF
ANY] =
{deflist : LIST OF REF ANY ← lambdaAlist;
WHILE deflist # NIL AND deflist.first # name DO deflist ← deflist.rest.rest.rest ENDLOOP;
IF deflist = NIL THEN RETURN [NIL] ELSE RETURN [Cadr[deflist]] };
AddDef:
PUBLIC
PROC [name, locals, body:
REF
ANY] =
{lambdaAlist ← CONS[name, CONS[locals, CONS[body, lambdaAlist]]]};
- - - - OLD STUFF
AddOp:
PUBLIC
PROC
[handle: Handle,
op: Rope.
ROPE,
alias:
ROPE,
bp:
INTEGER,
f: OperatorType,
c: Rope.
ROPE,
u:
INT ← 0] =
{p: PT.Properties ← NEW[PT.PRec ← [name: Atom.MakeAtom[op]]];
IF alias # NIL THEN p.alias ← Atom.MakeAtom[alias];
p.bindingPower ← bp;
p.closer ← IF c = NIL THEN NIL ELSE handle.ph.table.Search[Atom.MakeAtom[c], NIL];
p.unparserType ← u;
SELECT f FROM
infix => p.infix ← TRUE;
subfixMatchfix => p.subfix ← p.matchfix ← TRUE;
matchfix => p.matchfix ← TRUE;
prefix => p.prefix ← TRUE;
infixPrefix => p.infix ← p.prefix ← TRUE;
closefix => p.closefix ← TRUE
ENDCASE => ERROR;
handle.ph.table.Enter[p];
IF Rope.Length[alias] = 2 AND handle.ph.in.type[Rope.Fetch[alias, 0]] = op
THEN handle.ph.in.AddOpPair[alias.Fetch[0], alias.Fetch[1]];
IF Rope.Length[op] = 2 AND handle.ph.in.type[Rope.Fetch[op, 0]] = op
THEN handle.ph.in.AddOpPair[op.Fetch[0], op.Fetch[1]]};
TiogaNode: TYPE = TiogaOps.Ref;
Next: PROC[n:TiogaNode] RETURNS [TiogaNode] = {RETURN[TiogaOps.Next[n]]};
FirstChild: PROC[n:TiogaNode] RETURNS [TiogaNode] = {RETURN[TiogaOps.FirstChild[n]]};
GetRope: PROC[n:TiogaNode] RETURNS [ROPE] = {RETURN[TiogaOps.GetRope[n]]};
ViewerDoc:
PROC[v: ViewerClasses.Viewer]
RETURNS [TiogaNode]
= {RETURN[TiogaOps.ViewerDoc[v]]};
ParseViewer:
PUBLIC
PROC [pw: Handle] =
{newContent: LIST OF NodeContent ← NIL;
n: TiogaNode ← TiogaOps.FirstChild[TiogaOps.ViewerDoc[pw.viewer]];
success: BOOL ← TRUE;
tree: REF;
text1: ROPE;
text2: ROPE;
pw.contentValid ← TRUE;
WHILE success AND n # NIL DO
[success, tree, text1, text2] ← PN2[n, pw];
IF success THEN newContent ← CONS[[text1, text2, tree], newContent];
n ← TiogaOps.Next[n];
ENDLOOP;
pw.contentValid ← success;
IF success THEN pw.content ← newContent ELSE pw.content ← AppendNodeContentList[newContent, pw.content]};
AppendNodeContentList:
PROC[a, b:
LIST
OF NodeContent]
RETURNS [aa:
LIST
OF NodeContent] =
{
IF a=NIL THEN RETURN [b]
ELSE {aa ← a; WHILE a.rest#NIL DO a ← a.rest ENDLOOP; a.rest ← b};
};
PN2:
PROC [n: TiogaNode, pw: Handle]
RETURNS [success:
BOOL, tree:
REF
ANY, text1:
ROPE, text2:
ROPE] =
{r: Rope.ROPE;
vc: VerdictAndCulprit;
errorMessage: ROPE ← NIL;
text1 ← TiogaOps.GetRope[n];
text2 ← TiogaOps.GetRope[TiogaOps.FirstChild[n]];
-- next three lines try to skip parsing if old parsed result is present in pw.contents:
{ l: LIST OF NodeContent ← pw.content
; WHILE l # NIL
AND NOT(Rope.Equal[l.first.text1, text1] AND Rope.Equal[l.first.text2, text2])
DO l ← l.rest ENDLOOP
; IF l # NIL THEN { success ← TRUE ; tree ← l.first.tree ; text1 ← l.first.text1; text2 ← l.first.text2 ; RETURN } };
IF ~ pw.contentValid THEN RETURN;
pw.ph.in.in ← IO.RIS[Rope.Cat[text1, text2, " "]];
pw.ph.in.eof ← FALSE;
pw.ph.in.error ← NIL;
pw.ph.in.Lex[];
IF pw.ph.in.eof THEN {success ← TRUE; tree ← text1 ← text2 ← NIL; RETURN};
pw.ph.Parse[];
pw.ph.result ← tree ← CONS[pw.ph.result, NIL];
-- necessary because WellFormed and Unparse work on the CAR of their argument
-- and ignore the cdr.
IF pw.ph.error = NIL AND pw.ph.eof
THEN {vc ← pw.WellFormed[pw.ph.result];
IF vc.verdict # Yes
THEN errorMessage ← "Not a WFF"
ELSE {vc.culprit ← NIL; errorMessage ← NIL}}
ELSE {vc.culprit ← NIL;
errorMessage ← IF pw.ph.error # NIL THEN pw.ph.error ELSE "Bad Syntax"};
r ← Unparser.Unparse[pw.ph.result, vc.culprit, 57, pw.ph.table, pw.ph.openCount];
--! change "57" to "width of window"
tree ← NARROW[pw.ph.result, LIST OF REF ANY].first;
IF pw.ph.error # NIL OR ~pw.ph.eof
THEN {r ← Rope.Cat[r, " \000", Rope.FromRefText[pw.ph.in.buf], "\000"];
WHILE ~ IO.EndOf[pw.ph.in.in]
DO r ← Rope.Cat[r, Rope.FromChar[IO.GetChar[pw.ph.in.in]]]
ENDLOOP};
{i: INT ← r.SkipTo[0, "\000"];
j: INT;
endOfHeader: INT = r.SkipTo[0, "\n"];
firstLine: Rope.ROPE = r.Substr[0, endOfHeader];
restOfLines: Rope.ROPE =
IF endOfHeader = r.Length THEN NIL ELSE r.Substr[endOfHeader + 1];
Foo: SAFE PROC[root: TiogaOps.Ref] = TRUSTED
{m: TiogaNode = IF TiogaOps.FirstChild[n] = NIL THEN n ELSE TiogaOps.FirstChild[n];
TiogaOps.SelectNodes[viewer: pw.viewer, start:n, end:m, pendingDelete: TRUE, level:char];
IF i = r.Length[]
THEN {TiogaOps.InsertRope[firstLine];
TiogaOps.Break[];
TiogaOps.Nest[];
TiogaOps.InsertRope[restOfLines]}
ELSE {j ← r.SkipTo[i + 1, "\000"];
TiogaOps.InsertRope[Rope.Cat[r.Substr[0, i], r.Substr[i+1, j - i - 1], r.Substr[j+1]]];
TiogaOps.SetSelection[pw.viewer, [n, i], [n, j - 1]]}};
TiogaOps.CallWithLocks[Foo, TiogaOps.ViewerDoc[pw.viewer]];
success ← (errorMessage = NIL);
text1 ← firstLine;
text2 ← restOfLines}};
AddTree:
PUBLIC
PROC[pw: Handle, tree:
REF]=
{r: ROPE ← Unparser.Unparse[LIST[tree], NIL, 57, pw.ph.table, 0];
End: PROC[r: ROPE] RETURNS [e: INT] = {
ee: INT ← r.SkipTo[0, ":"];
e ← r.SkipTo[0, "\n"];
IF e = r.Length THEN r ← Rope.Cat[r, "\n"];
IF ee < e THEN e ← ee};
endOfHeader: INT = End[r];
firstLine: Rope.ROPE = r.Substr[0, endOfHeader];
restOfLines: Rope.ROPE =
IF r.Fetch[endOfHeader] = ':
THEN r.Substr[endOfHeader]
ELSE r.Substr[endOfHeader + 1];
nd: TiogaNode ← TiogaOps.LastWithin[TiogaOps.ViewerDoc[pw.viewer]];
Foo: SAFE PROC[root: TiogaOps.Ref] = CHECKED
{TiogaOps.SelectNodes[pw.viewer, nd, nd, node, FALSE];
TiogaOps.Break[];
TiogaOps.UnNest[];
TiogaOps.InsertRope[firstLine];
TiogaOps.Break[];
TiogaOps.Nest[];
TiogaOps.InsertRope[restOfLines]};
TiogaOps.CallWithLocks[Foo, TiogaOps.ViewerDoc[pw.viewer]];
pw.content ← CONS[[firstLine, restOfLines, tree], pw.content]};
AddBranch:
PUBLIC
PROC[pw: Handle, text1, text2:
ROPE] =
{nd: TiogaNode ← TiogaOps.LastWithin[TiogaOps.ViewerDoc[pw.viewer]];
Foo: SAFE PROC[root: TiogaOps.Ref] = CHECKED
{TiogaOps.SelectNodes[pw.viewer, nd, nd, node, FALSE];
TiogaOps.Break[];
TiogaOps.UnNest[];
TiogaOps.InsertRope[text1];
TiogaOps.Break[];
TiogaOps.Nest[];
TiogaOps.InsertRope[text2]};
TiogaOps.CallWithLocks[Foo, TiogaOps.ViewerDoc[pw.viewer]]};
HasForm:
PUBLIC
PROC[f:
REF
ANY,
op:
ATOM,
Arg1: SyntacticPredicate,
Arg2: SyntacticPredicate ←
NIL]
RETURNS [VerdictAndCulprit] =
{WITH Car[NARROW[f]] SELECT FROM
g: LIST OF REF ANY =>
{IF Car[g] # op THEN RETURN [[OfCourseNot, g]];
IF (Arg2 = NIL) # (Cddr[g] = NIL)
THEN RETURN[[OfCourseNot, f]];
{aw: VerdictAndCulprit ← Arg1[Cdr[g]];
IF aw.verdict # Yes THEN RETURN [[No, aw.culprit]];
IF Cddr[g] = NIL THEN RETURN [[Yes, NIL]];
aw ← Arg2[Cddr[g]];
IF aw.verdict # Yes THEN RETURN [[No, aw.culprit]];
RETURN [[Yes, NIL]]}}
ENDCASE => RETURN [[OfCourseNot, f]]};
Or:
PUBLIC
PROC [aw1, aw2: VerdictAndCulprit]
RETURNS [r: VerdictAndCulprit] =
{SELECT TRUE FROM
aw1.verdict = Yes OR aw2.verdict = Yes => r ← [Yes, NIL];
aw1.verdict = No => r ← aw1;
aw2.verdict = No => r ← aw2;
aw1.verdict = OfCourseNot AND aw2.verdict = OfCourseNot
=> r ← aw1
ENDCASE => ERROR};
Se: TYPE = REF ANY;
Car: PROC [r: Se] RETURNS [Se] = {RETURN[NARROW[r, LIST OF REF ANY].first]};
Cdr: PROC [r: Se] RETURNS [Se] = {RETURN[NARROW[r, LIST OF REF ANY].rest]};
Cadr: PROC [r: Se] RETURNS [Se] = {RETURN[Car[Cdr[r]]]};
Caddr: PROC [r: Se] RETURNS [Se] = {RETURN[Car[Cdr[Cdr[r]]]]};
Cddr: PROC [r: Se] RETURNS [Se] = {RETURN[Cdr[Cdr[r]]]};
Caar: PROC [r: Se] RETURNS [Se] = {RETURN[Car[Car[r]]]};
Cadar: PROC [l: Se] RETURNS [Se] =
{ RETURN[ Car[ Cdr[ Car[ l ] ] ] ] };
Caddar: PROC [l: Se] RETURNS [Se] =
{ RETURN[ Car[ Cdr[ Cdr[ Car[ l ] ] ] ] ] };
Cadddar: PROC [l: Se] RETURNS [Se] =
{ RETURN[ Car[ Cdr[ Cdr[ Cdr[ Car[ l ] ] ] ] ] ] };
Cadddr: PROC [l: Se] RETURNS [Se] =
{ RETURN[ Car[ Cdr[ Cdr[ Cdr[ l ] ] ] ] ] };
Caddddar: PROC [l: Se] RETURNS [Se] =
{ RETURN[ Car[ Cdr[ Cdr[ Cdr[ Cdr[ Car[ l ] ] ] ] ] ] ] };
Cddar: PROC [l: Se] RETURNS [Se] =
{ RETURN[ Cdr[ Cdr[ Car[ l ] ] ] ] };
END.