<> <> 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 <> <> = BEGIN OPEN IO, UserExec, UserExecPrivate; <> ExecPrivateRecord: PUBLIC TYPE = UserExecPrivate.ExecPrivateRecord; <> HistoryEventPrivateRecord: PUBLIC TYPE = UserExecPrivate.HistoryEventPrivateRecord; <> ExpressionPrivateRecord: PUBLIC TYPE = UserExecPrivate.ExpressionPrivateRecord; <> <> 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. { <> 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 }; <> 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]]; }; <> 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 <> <> <> <> <> <> <> <<>> <> <> <> <> <> <<>> <> <> <<>> <> <> <> <> <<>>