miscellaneous procedures related to interpreting expressions by the userexec
Last Edited by: Warren Teitelman, April 17, 1983 8:08 pm
DIRECTORY
AMBridge USING [RefFromTV, TVForReferent],
AMTypes USING [TVType, TVToName, TypeClass, TVToType],
BasicUserExec USING [Interface, InterfaceRec],
BBInterp USING [EvalExpr, ParseExpr, Tree],
BBContext USING [Context, ContextForGlobalFrame],
BBEval USING [EvalHead],
Commander USING [Lookup],
Convert USING [ValueToRope],
IO USING [CreateDribbleStream, EndOf, GetChar, GetIndex, GetOutputStreamRope, PeekChar, Put, PutChar, PutF, PutRope, PutTV, PutType, refAny, Reset, rope, ROPE, ROS, RIS, SetIndex, STREAM, Type, GetToken, GetRefAny, SkipOver, WhiteSpace],
PPTree USING [Handle],
PrintTV USING [PutClosure, PutProc],
Rope USING [Cat, Concat, Equal, Fetch, Find, FromChar, IsEmpty, Length, Replace, Run, Substr],
RTTypesBasic USING [EquivalentTypes],
SymTab USING [Store],
UserExec USING [HistoryEvent, ExecHandle, Expression, ExpressionRecord, RegisterCommand, CommandProc, TV, Viewer, ParseFailed, EvaluationFailed, GetStreams, CreateExpr, ErrorThisEvent, ReleaseStreams],
UserExecExtras USING [],
UserExecPrivate USING [EvalHeadData, CaptionForExec, GetPrivateStuff, GetEvalHead, DoesUserMean, ExecPrivateRecord, ExpressionPrivateRecord, Zone, CreateSubEvent, GetRestOfStream, ExecOwner, HistoryEventPrivateRecord]
;
UserExecInterpImpl: CEDAR PROGRAM
IMPORTS AMBridge, AMTypes, BBContext, BBInterp, Commander, Convert, IO, Rope, RTTypesBasic, SymTab, UserExec, UserExecPrivate
EXPORTS UserExec, UserExecExtras, UserExecPrivate
SHARES UserExecPrivate
BBEval: so can access private files in EvalTree
UserExecPrivate; Zone
= BEGIN OPEN IO, UserExec, UserExecPrivate;
connecting concrete and opaque types
ExecPrivateRecord:
PUBLIC
TYPE = UserExecPrivate.ExecPrivateRecord;
so can access continuation, idRope in TreatAsExpr, and evalMode in SetGlobalContextFromTV
HistoryEventPrivateRecord:
PUBLIC
TYPE = UserExecPrivate.HistoryEventPrivateRecord;
to access state and eventNum in TreatAsExpr
ExpressionPrivateRecord:
PUBLIC
TYPE = UserExecPrivate.ExpressionPrivateRecord;
so can access tree, etc. in TreatAsExpr
interpreting expressions
Eval: CommandProc =
{
commandLine: ROPE = event.commandLine;
len: INT;
len ← Rope.Length[commandLine];
IF Rope.Length[commandLine] > 1
AND Rope.Fetch[commandLine, len - 2] = '!
THEN
{
line: ROPE = Rope.Replace[base: commandLine, start: len - 2, len: 1];
subEvent: HistoryEvent = UserExecPrivate.CreateSubEvent[event: event, input: Rope.Concat["← ", line]];
expr: Expression ← UserExec.CreateExpr[""];
privateExpr: REF ExpressionPrivateRecord ← expr.privateStuff;
subEvent.commandLine ← line;
subEvent.commandLineStream ← IO.RIS[line];
privateExpr.goForIt ← TRUE;
subEvent.expression ← expr;
TreatAsExpr[subEvent, exec, 1000, 1000, TRUE];
}
ELSE TreatAsExpr[event, exec, defaultDepth, defaultWidth];
};
defaultDepth: PUBLIC INT ← 4;
defaultWidth: PUBLIC INT ← 32;
TreatAsExpr:
PROC [event: HistoryEvent, exec: ExecHandle, depth:
INT, width:
INT, verbose:
BOOL ←
FALSE] = {
out: STREAM = UserExec.GetStreams[exec].out;
expr: Expression;
privateExpr: REF ExpressionPrivateRecord;
EvalEvent[event, exec];
expr ← event.expression;
IF expr = NIL THEN RETURN; -- e.g. blank CR, perhaps you mean
privateExpr ← expr.privateStuff;
IF expr.numRtns = 1
AND
(AMTypes.TypeClass[AMTypes.TVType[expr.value]] = globalFrame
OR RTTypesBasic.EquivalentTypes[AMTypes.TVType[expr.value], CODE[BasicUserExec.Interface]]) THEN SetDefaultContextFromTV[exec: exec, expr: expr, out: out];
IF depth # 0
THEN
{
outRopeStream: STREAM = IO.ROS[];
out.PutF["*n"];
PrintValues[stream: IO.CreateDribbleStream[out, outRopeStream], expr: expr, depth: depth, width: width, verbose: verbose]; -- note that this creates a dribble stream for each new event. see earlier comments on allocation issues.
privateExpr.valueRope ← outRopeStream.GetOutputStreamRope[]; -- why not simply return this as the msg argument.
};
}; -- TreatAsExpr
EvalEvent:
PUBLIC PROC [event: HistoryEvent, exec: ExecHandle] = {
private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec];
eventPrivate: REF UserExecPrivate.HistoryEventPrivateRecord = event.privateStuff;
commandLineStream: STREAM = event.commandLineStream;
out: STREAM = UserExec.GetStreams[exec].out;
expr: Expression ← event.expression;
privateExpr: REF ExpressionPrivateRecord;
eventNumRope, assignRope, line: ROPE;
BEGIN
ENABLE {
EvaluationFailed => ERROR UserExec.ErrorThisEvent[event, msg];
ParseFailed =>
-- if failed to parse, and first token is a registered command, then perhaps user forgot he was in eval mode.
{
i: INT;
inRopeStream: STREAM;
secondToken: ROPE;
IF (i ← Rope.Find[msg, "←"]) = -1 THEN UserExec.ErrorThisEvent[event, msg];
inRopeStream ← RIS[msg, inRopeStream];
inRopeStream.SetIndex[i + 1];
secondToken ← IO.GetToken[inRopeStream]; -- first thing following eval key.
IF exec #
NIL
AND Commander.Lookup[secondToken].proc #
NIL
THEN {
UserExecPrivate.DoesUserMean[rope: Rope.Substr[base: line, len: Rope.Length[line] - 1], exec: exec];
event.expression ← NIL;
GOTO Out;
};
ERROR UserExec.ErrorThisEvent[event, msg];
};
};
IO.SkipOver[commandLineStream, IO.WhiteSpace];
IF commandLineStream.EndOf[]
THEN
-- e.g. user just types eval or types cr after ←. silly to give him an error.
{
IF private # NIL THEN private.continuation ← TRUE; took this out because the event might have consisted of just a comment, and might want this in the history. the expense is an extra, empty event if user types ←{cr}.
RETURN;
};
IF expr = NIL THEN event.expression ← expr ← CreateExpr[NIL];
privateExpr ← expr.privateStuff;
IF commandLineStream.PeekChar[] = '←
THEN
{
[] ← commandLineStream.GetChar[];
IO.SkipOver[commandLineStream, IO.WhiteSpace];
expr.correctionMade ← TRUE; -- to reprint
};
IF inRopeStream.PeekChar[] = '{ THEN -- evaluate in context of some other work area.
{
token, in: ROPE;
UNTIL Rope.Equal[(token ← IO.GetToken[inRopeStream]), "}"] DO
in ← token;
ENDLOOP;
FOR l: LIST OF ExecHandle ← UserExecPrivate.execHandleList, l.rest UNTIL l = NIL DO
private: REF ExecPrivateRecord = l.first.privateStuff;
IF Rope.Equal[private.idRope, in] THEN
{event.props ← Atom.PutPropOnList[propList: event.props, prop: $WorkArea, val: l.first];
EXIT};
REPEAT
FINISHED => ERROR UserExecPrivate.ErrorThisEvent[Rope.Concat["No Work Area with name ", in]];
ENDLOOP;
};
line ← UserExecPrivate.GetRestOfStream[commandLineStream];
expr.rope ← line;
expr.dontCorrect ← event.dontCorrect;
eventNumRope ← Convert.ValueToRope[[signed[eventPrivate.eventNum]]];
assignRope ← Rope.Cat["&", eventNumRope, " ← "];
ParseTree[assignRope: assignRope, input: line, expr: expr];
[expr.value, expr.numRtns] ← EvalTree[expr, exec];
IF expr.correctionMade
THEN {
expr.rope ← ReprintTree[privateExpr.tree];
event.input ← Rope.Concat["← ", expr.rope];
};
privateExpr.tree ← (NARROW[privateExpr.tree, PPTree.Handle]).son[2]; -- the tree to be stored is without the & assignment
GOTO Exit;
EXITS
Exit =>
{
IF expr.numRtns > 0 THEN
{IF private # NIL THEN [] ← SymTab.Store[x: BBEval.GetSymTab[], key: Rope.Cat["&", private.id, eventNumRope], val: expr.value];
};
eventPrivate.state ← completed;
};
Out => NULL
END;
}; -- EvalEvent
StoreInSymTab:
PUBLIC PROC [value:
TV, event: HistoryEvent, exec: ExecHandle] = {
makes the & variable associated with event have as its value the indicated tv. For use for those commands which return a value, e.g. walkstack, showframe, etc.
evalHead: BBEval.EvalHead = UserExecPrivate.GetEvalHead[exec];
eventPrivate: REF UserExecPrivate.HistoryEventPrivateRecord = event.privateStuff;
eventPrivate.value ← value;
[] ← SymTab.Store[x: evalHead.specials, key: Rope.Cat["&", Convert.ValueToRope[[signed[eventPrivate.eventNum]]]], val: value];
[] ← SymTab.Store[x: evalHead.specials, key: "&", val: value];
};
PrintValues:
PROCEDURE[stream:
STREAM, expr: Expression, depth:
INT ← -1, width:
INT ← -1, verbose:
BOOLEAN ←
FALSE] = {
IF expr.numRtns = 0 THEN stream.PutRope["{does not return a value}"]
ELSE IF expr.value = History.notAnExpression THEN NULL -- i.e. runs a program.
ELSE {
typ: Type = AMTypes.TVType[expr.value];
SELECT AMTypes.TypeClass[typ]
FROM
type => stream.PutType[type: AMTypes.TVToType[expr.value], depth: depth, width: width, verbose: TRUE]; -- if type is REF or POINTER, verbose= TRUE prints range.
ENDCASE => stream.PutTV[tv: expr.value, depth: depth, width: width, verbose: verbose];
};
}; -- of PrintValues
does evaluation when you dont have an event. called by execprocessinput to evaluate promptforms, executing forms..
EvalExpr:
PUBLIC
PROC [expr: Expression, exec: ExecHandle, viewer: Viewer ←
NIL]
RETURNS[value:
TV, numRtns:
INT] = {
oldExecOwner: UNSAFE PROCESS;
privateExpr: REF ExpressionPrivateRecord = expr.privateStuff;
{ENABLE UNWIND =>
IF exec # NIL AND oldExecOwner # UserExecPrivate.ExecOwner[exec] THEN UserExec.ReleaseStreams[exec]; -- somebody, e.g. in DWIM, did a GetStreams without releasing (this is ok to do).
IF exec # NIL THEN oldExecOwner ← UserExecPrivate.ExecOwner[exec];
IF privateExpr.tree = NIL THEN ParseTree[input: expr.rope, expr: expr];
[value, numRtns] ← EvalTree[expr, exec, viewer];
expr.value ← value;
expr.numRtns ← numRtns;
IF expr.correctionMade THEN expr.rope ← ReprintTree[privateExpr.tree];
IF exec # NIL AND oldExecOwner # UserExecPrivate.ExecOwner[exec] THEN UserExec.ReleaseStreams[exec]; -- somebody, e.g. in DWIM, did a GetStreams without releasing (this is ok to do).
};
}; -- of EvalExpr
CreateExpr:
PUBLIC
PROCEDURE [rope:
ROPE, dontCorrect:
BOOL ←
FALSE]
RETURNS [Expression] = {
RETURN[UserExecPrivate.Zone.
NEW[UserExec.ExpressionRecord ← [
rope: rope,
dontCorrect: dontCorrect,
privateStuff: UserExecPrivate.Zone.NEW[UserExecPrivate.ExpressionPrivateRecord ← []]
]]
];
};
parsing, evaluating, and printing trees
ReprintTree:
PROC [tree: BBInterp.Tree, outRopeStream:
IO.
STREAM ← NIL]
RETURNS[value:
ROPE] = {
r: ROPE = "{tree for: ";
i: INT;
IF outRopeStream = NIL THEN outRopeStream ← IO.ROS[] ELSE outRopeStream.Reset[];
outRopeStream.Put[refAny[(NARROW[tree, PPTree.Handle]).son[2]]]; -- the tree without the & assignment
value ← outRopeStream.GetOutputStreamRope[];
IF (i ← Rope.Find[value, "{tree for: "]) # -1
THEN {
value ← Rope.Substr[base: value, start: Rope.Length[r]];
value ← Rope.Substr[base: value, len: Rope.Length[value] - 1]; -- strip off }
};
WHILE Rope.Fetch[base: value, index: i ← (Rope.Length[value] - 1)] = '
DO
value ← Rope.Substr[base: value, len: i];
ENDLOOP;
};
parses input rope. does not know about events. sets CorrectionMade in event if the tree that it produces does not correspond to the input.
ParseTree:
PROC [input:
ROPE, assignRope:
ROPE ←
NIL, expr: Expression] = {
outRopeStream: STREAM = IO.ROS[];
inRopeStream: STREAM = IO.RIS[""];
privateExpr: REF UserExecPrivate.ExpressionPrivateRecord = expr.privateStuff;
{
outRopeStream.Reset[];
expr.rope ← input;
privateExpr.tree ← BBInterp.ParseExpr[expr: Rope.Concat[IF assignRope = NIL THEN "& ← " ELSE assignRope, input], errout: PrintTV.PutClosure[proc: ErrorOut, data: outRopeStream] ];
IF privateExpr.tree =
NIL
THEN
-- look at error message to see if anything can be done, e.g. fix up $( and $[ to be LIST[];
{
rope: ROPE ← outRopeStream.GetOutputStreamRope[];
pos: INT ← Rope.Find[rope, "*^*"];
char: CHARACTER;
IF pos = -1 THEN GOTO Failed;
IF Rope.Fetch[rope, pos + 4] = '$
AND (char ← Rope.Fetch[rope, pos + 5]) = '(
OR char = '[
THEN
{
pos: INT ← Rope.Find[input, Rope.Concat["$", Rope.FromChar[char]]];
ref: REF ANY;
PrintList:
PROC [stream:
IO.
STREAM, ref:
REF
ANY] = {
WITH ref
SELECT
FROM
l:
LIST
OF
REF
ANY =>
{stream.PutRope["LIST["];
FOR lst:
LIST
OF
REF
ANY ← l, lst.rest
UNTIL lst =
NIL
DO
PrintList[stream, lst.first];
IF lst.rest # NIL THEN stream.PutRope[", "];
ENDLOOP;
stream.PutChar[']];
};
ENDCASE => stream.Put[refAny[ref]];
};
IF pos = -1 THEN GOTO Failed;
[] ← RIS[rope: input, oldStream: inRopeStream];
inRopeStream.SetIndex[pos + 1];
ref ← IO.GetRefAny[inRopeStream];
outRopeStream.Reset[];
PrintList[stream: outRopeStream, ref: ref];
input ← Rope.Replace[base: input, start: pos, len: inRopeStream.GetIndex[] - pos, with: outRopeStream.GetOutputStreamRope[]];
expr.correctionMade ← TRUE;
ParseTree[input, assignRope, expr];
}
ELSE GOTO Failed;
};
RETURN;
EXITS
Failed => ERROR ParseFailed[expr: expr, msg: outRopeStream.GetOutputStreamRope[]];
};
}; -- of ParseTree
ErrorOut: PrintTV.PutProc -- [data: REF, c: char] -- = {NARROW[data, IO.STREAM].PutChar[c]};
EvalTree:
PROC [expr: Expression, exec: ExecHandle, viewer: Viewer ←
NIL]
RETURNS[value:
TV, numRtns:
INTEGER] = {
privateExpr: REF ExpressionPrivateRecord = expr.privateStuff;
[value, numRtns] ← BBInterp.EvalExpr[privateExpr.tree, UserExecPrivate.GetEvalHead[exec: exec, viewer: viewer, expr: expr]];
};
Setting default contexts
SetDefaultContext: UserExec.CommandProc
= {
ENABLE UserExec.EvaluationFailed => ERROR UserExec.ErrorThisEvent[event, msg];
commandLineStream: STREAM = event.commandLineStream;
out: STREAM = UserExec.GetStreams[exec].out;
name: ROPE;
expr: UserExec.Expression;
name ← IO.GetToken[commandLineStream];
IF NOT name.IsEmpty[] THEN [] ← EvalExpr[expr: expr ← CreateExpr[name], exec: exec];
SetDefaultContextFromTV[exec, expr, out];
};
SetDefaultContextFromTV:
PROC [exec: UserExec.ExecHandle, expr: UserExec.Expression, out:
STREAM] = {
private: REF ExecPrivateRecord = exec.privateStuff;
gf: TV;
defaultInterface, moduleName: ROPE;
globalContext: BBContext.Context ← NIL;
evalHead: BBEval.EvalHead = UserExecPrivate.GetEvalHead[expr: NIL, exec: exec];
evalHeadData: REF UserExecPrivate.EvalHeadData = NARROW[evalHead.data];
IF expr = NIL THEN NULL
ELSE IF AMTypes.TypeClass[AMTypes.TVType[expr.value]] = globalFrame THEN gf ← expr.value
ELSE TRUSTED {
interFace: REF BasicUserExec.Interface = NARROW[AMBridge.RefFromTV[expr.value]];
defaultInterface ← interFace^^;
};
IF gf #
NIL
THEN {
len: INT ← Rope.Length[expr.rope];
moduleName ← AMTypes.TVToName[gf];
WHILE
IO.WhiteSpace[Rope.Fetch[expr.rope, len - 1]] = sepr
DO
-- in most cases, expr.rope will have an extra space or cr at end (but not when it has been corrected)
len ← len - 1;
ENDLOOP;
defaultInterface ← Rope.Substr[base: expr.rope, len: len];
IF Rope.Equal[moduleName, defaultInterface]
OR Rope.Run[s1: moduleName, s2: defaultInterface, case:
FALSE] < Rope.Length[defaultInterface]
THEN {
-- second check is to handle situation where the value of an expression is a global frame, e.g. &9
globalContext ← BBContext.ContextForGlobalFrame[gf];
defaultInterface ← NIL;
}
ELSE
TRUSTED {
-- user typed in name of interface, for which there happened to also be an impl, so Russ converted it, e.g. type in IO, get IOImpl.
expr.value ← AMBridge.TVForReferent[NEW[BasicUserExec.Interface ← NEW[BasicUserExec.InterfaceRec ← [defaultInterface]]]]; -- so right thing is printed out
}
};
evalHead.globalContext ← globalContext;
evalHeadData.defaultInterface ← defaultInterface;
IF private.evalMode AND private.actionAreaData = NIL THEN [] ← UserExecPrivate.CaptionForExec[exec];
IF globalContext # NIL THEN out.PutF["*n*mdefault global context changed to: %g*s", rope[moduleName]]
ELSE IF defaultInterface # NIL THEN out.PutF["*n*mdefault interface changed to: %g*s", rope[defaultInterface]]
ELSE out.PutF["*n*mdefault global context/interface no longer set*s"];
};
UserExec.RegisterCommand["←", Eval, "Treat the remainder of the input line as a mesa expression to be evaluated.", "Treat the remainder of the input line as a mesa expression to be evaluated. Evaluate the expression and print its value. If the expression is terminated with !, print value showing the referents of all REFs and POINTERs to an unlimited depth. To call a registered command or load a file, backspace over the ←."];
UserExec.RegisterCommand["SetContext", SetDefaultContext, "(Re)Set default context.", "SetContext {name of module or interface} sets default context to given name. SetContext{cr} clears default context."];
END. -- of UserExecInterpImpl
Edited on January 28, 1983 4:30 pm, by Teitelman
fixed SetContext not to create new caption if in action area
changes to: SetDefaultContextFromTV
Edited on February 4, 1983 3:11 pm, by Teitelman
changes to: SetDefaultContextFromTV
Edited on March 6, 1983 5:44 pm, by Teitelman
changes to: Eval, defaultDepth, defaultWidth, TreatAsExpr, PrintValues, DIRECTORY, TreatAsExpr
Edited on March 10, 1983 2:51 am, by Teitelman
changes to: DIRECTORY, EXPORTS
Edited on March 24, 1983 4:27 pm, by Teitelman
removed storing of & expressions in global symbols table as well as local symbol table
changes to: EvalEvent, DIRECTORY, IMPORTS
Edited on April 6, 1983 11:07 am, by Teitelman
changes to: StoreInSymTab, PrintValues, DIRECTORY, IMPORTS, EvalEvent
Edited on April 8, 1983 1:30 pm, by Teitelman
changes to: DIRECTORY, SetDefaultContextFromTV
Edited on April 17, 1983 8:08 pm, by Teitelman
changes to: DIRECTORY, IMPORTS, EvalEvent