<> <> <> DIRECTORY AMModel USING [Context, ContextWorld, ContextClass, RootContext], AMTypes USING [TVType], BBContext USING [ContextForWorld, ContextForGlobalFrame, ContextForLocalFrame, Context], BBEval USING [AbortProc, GetSymTab, NewEvalHead, HelpFatal], BBInterp USING [ParseExpr, EvalExpr], BBSafety USING [Mother], CedarScanner USING [ContentsFromToken, GetProc, GetToken, Token], Commander USING [CommandProc, Enumerate, Lookup, Register], Interpreter USING [AbortClosure, AbortProc], IO USING [CreateOutputStreamToRope, GetOutputStreamRope, PutChar, PutF, PutRope, PutTV, PutType, STREAM], List USING [Assoc], ProcessProps USING [GetPropList], Rope USING [Cat, Fetch, Find, Flatten, Match, ROPE, Size], RTBasic USING [TV], RTProcess USING [GetTotalPageFaults, StartWatchingFaults], SafeStorage USING [IsCollectorActive, NWordsAllocated], ShowTime USING [GetMark, Microseconds, ShowDelta, SinceMark], SymTab USING [Create, Delete, EachPairAction, Fetch, Pairs, Ref, Store], TVGuide USING [Ruminant], UserProfile USING [Boolean], WorldVM USING [LocalWorld, World]; InterpreterImpl: CEDAR MONITOR IMPORTS AMModel, AMTypes, BBContext, BBEval, BBInterp, BBSafety, CedarScanner, Commander, IO, List, ProcessProps, Rope, RTProcess, SafeStorage, ShowTime, SymTab, UserProfile, WorldVM EXPORTS Interpreter, TVGuide = BEGIN OPEN Interpreter; <> AvoidanceMemorial: TYPE = RECORD[s: IO.STREAM, abort: AbortClosure]; Context: TYPE = AMModel.Context; ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; TV: TYPE = RTBasic.TV; World: TYPE = WorldVM.World; FatalInterpreterError: ERROR[msg: ROPE] = CODE; EvaluateToRope: PUBLIC PROC [rope: ROPE, context: Context _ NIL, -- NIL means use ContextForWorld[LocalWorld[]] global: Context _ NIL, -- NIL means no global context symTab: SymTab.Ref _ NIL, -- look here first for name to TV lookup abort: AbortClosure _ [NIL, NIL] -- default is to never abort ] RETURNS[result: ROPE _ NIL, errorRope: ROPE _ NIL, noResult: BOOL _ FALSE] = TRUSTED { tv: TV _ NIL; [tv, errorRope, noResult] _ Evaluate[rope, context, global, symTab, abort]; IF noResult OR errorRope # NIL THEN RETURN ELSE { s: IO.STREAM _ IO.CreateOutputStreamToRope[]; inner: SAFE PROC = TRUSTED {s.PutTV[tv]}; s.PutRope[BBSafety.Mother[inner]]; result _ IO.GetOutputStreamRope[s]; }; }; Evaluate: PUBLIC PROC [rope: ROPE, context: Context _ NIL, -- NIL means use ContextForWorld[LocalWorld[]] global: Context _ NIL, -- NIL means no global context symTab: SymTab.Ref _ NIL, -- look here first for name to TV lookup abort: AbortClosure _ [NIL, NIL] -- default is to never abort ] RETURNS[result: TV _ NIL, errorRope: ROPE _ NIL, noResult: BOOL _ FALSE] = TRUSTED { errorStream: IO.STREAM _ IO.CreateOutputStreamToRope[]; g,c: BBContext.Context; numRtns: NAT _ 0; IF context = NIL THEN c _ BBContext.ContextForWorld[WorldVM.LocalWorld[]] ELSE SELECT AMModel.ContextClass[context] FROM world => c _ BBContext.ContextForWorld[AMModel.ContextWorld[context]]; prog => c _ BBContext.ContextForGlobalFrame[context]; proc => c _ BBContext.ContextForLocalFrame[context]; ENDCASE => ERROR; IF global = NIL THEN g _ NIL ELSE SELECT AMModel.ContextClass[global] FROM world => g _ BBContext.ContextForWorld[AMModel.ContextWorld[global]]; prog => g _ BBContext.ContextForGlobalFrame[global]; proc => g _ BBContext.ContextForLocalFrame[global]; ENDCASE => ERROR; [result, numRtns] _ BBInterp.EvalExpr [tree: BBInterp.ParseExpr [expr: Rope.Cat["& _ ", rope], errout: [proc: printOneChar, data: errorStream]], head: BBEval.NewEvalHead [context: c, globalContext: g, data: NEW[AvoidanceMemorial _ [s: errorStream, abort: abort]], specials: symTab, helpFatal: myHelpFatal, abortProc: myAbortProc] ! FatalInterpreterError => {errorStream.PutRope[msg]; CONTINUE}]; errorRope _ IO.GetOutputStreamRope[errorStream]; noResult _ numRtns = 0; }; ContextForLocalFrame: PUBLIC PROC [lf: TV] RETURNS [Context] = { <> <> RETURN [lf]; }; ContextForGlobalFrame: PUBLIC PROC [gf: TV] RETURNS [Context] = { <> <> RETURN [gf]; }; ContextForWorld: PUBLIC PROC [world: World _ NIL] RETURNS [Context] = TRUSTED { < LocalWorld[])>> IF world = NIL THEN world _ WorldVM.LocalWorld[]; RETURN [AMModel.RootContext[world]]; }; printOneChar: SAFE PROC [data: REF, c: CHAR] = TRUSTED { NARROW[data, IO.STREAM].PutChar[c ! ANY => CONTINUE]; }; myHelpFatal: BBEval.HelpFatal = TRUSTED { <> ERROR FatalInterpreterError[msg]; }; myAbortProc: BBEval.AbortProc = TRUSTED { <> am: REF AvoidanceMemorial _ NARROW[data, REF AvoidanceMemorial]; RETURN[am # NIL AND am.abort.proc # NIL AND am.abort.proc[am.abort.data]]; }; <> helpTable: SymTab.Ref _ SymTab.Create[]; RegisterTV: PUBLIC ENTRY PROC [name: ROPE, tv: TV, help: ROPE _ NIL, overwriteOld: BOOL _ TRUE] RETURNS [old: TV, oldHelp: ROPE, found: BOOL] = { <> ENABLE UNWIND => NULL; tab: SymTab.Ref = BBEval.GetSymTab[]; [found, old] _ SymTab.Fetch[tab, name]; oldHelp _ NARROW[SymTab.Fetch[helpTable, name].val]; IF found AND NOT overwriteOld THEN RETURN; [] _ SymTab.Store[tab, name, tv]; [] _ SymTab.Store[helpTable, name, help]; }; UnregisterTV: PUBLIC ENTRY PROC [name: ROPE, overwriteOld: BOOL _ TRUE] RETURNS [old: TV, oldHelp: ROPE, found: BOOL] = { <> ENABLE UNWIND => NULL; tab: SymTab.Ref = BBEval.GetSymTab[]; [found, old] _ SymTab.Fetch[tab, name]; oldHelp _ NARROW[SymTab.Fetch[helpTable, name].val]; IF found THEN { [] _ SymTab.Delete[tab, name]; [] _ SymTab.Delete[helpTable, name]}; }; LookupTV: PUBLIC ENTRY PROC [name: ROPE] RETURNS [tv: TV, help: ROPE, found: BOOL] = { <> ENABLE UNWIND => NULL; tab: SymTab.Ref = BBEval.GetSymTab[]; [found, tv] _ SymTab.Fetch[tab, name]; help _ NARROW[SymTab.Fetch[helpTable, name].val]; }; Browse: PUBLIC PROC [proc: TVGuide.Ruminant, data: REF _ NIL] RETURNS [stopped: BOOL] = { <> <> <<[name: ROPE, help: ROPE, tv: TV, data: REF] RETURNS [stop: BOOL]>> localAction: SymTab.EachPairAction = { <<[key: Key, val: Val] RETURNS [quit: BOOL]>> name: ROPE = NARROW[val, ROPE]; quit _ proc[key, name, SymTab.Fetch[tab, name].val, data]; }; tab: SymTab.Ref = BBEval.GetSymTab[]; stopped _ SymTab.Pairs[helpTable, localAction]; }; <> EvalCommand: PUBLIC Commander.CommandProc = TRUSTED { context: Context = NARROW[List.Assoc[$Context, ProcessProps.GetPropList[]]]; rope: ROPE _ cmd.commandLine.Flatten[]; out: STREAM = cmd.out; start, pos, end: INT _ 0; size: INT _ rope.Size[]; get1: CedarScanner.GetProc = TRUSTED { c: CHAR _ 0C; IF index < size THEN { c _ rope.Fetch[index]; SELECT c FROM '& => c _ 'a; '? => c _ '!; ENDCASE; }; RETURN [c]; }; get2: CedarScanner.GetProc = TRUSTED { c: CHAR _ 0C; IF index < size THEN { c _ rope.Fetch[index]; }; RETURN [c]; }; outChar: PROC [c: CHAR] RETURNS [BOOL] = TRUSTED {out.PutChar[c]; RETURN [FALSE]}; DO next: INT _ 0; result: TV _ NIL; errorRope: ROPE _ NIL; noResult: BOOL _ TRUE; depth: INT _ 4; width: INT _ 32; anySeen: BOOL _ FALSE; needType: NAT _ 0; mark: ShowTime.Microseconds; DO token: CedarScanner.Token = CedarScanner.GetToken[[get1], pos]; pos _ token.next; SELECT token.kind FROM tokenCOMMENT => {IF noResult THEN start _ pos; LOOP}; tokenEOF => EXIT; tokenSINGLE => { c: CHAR = get2[NIL, token.start]; SELECT c FROM '! => {depth _ depth + 1; width _ width + width; LOOP}; '_ => IF noResult THEN {start _ pos; LOOP}; '? => {needType _ needType + 1; LOOP}; '; => {next _ pos; EXIT}; ENDCASE; }; ENDCASE; noResult _ FALSE; end _ pos; ENDLOOP; IF NOT noResult THEN { collections: CARDINAL _ SafeStorage.IsCollectorActive[].previousIncarnation; faults: INT _ RTProcess.GetTotalPageFaults[]; words: INT _ SafeStorage.NWordsAllocated[]; flat: ROPE _ rope.Flatten[start, end-start]; mark _ ShowTime.GetMark[]; [result, errorRope, noResult] _ Evaluate[flat, context]; mark _ ShowTime.SinceMark[mark]; words _ SafeStorage.NWordsAllocated[] - words; faults _ RTProcess.GetTotalPageFaults[] - faults; collections _ SafeStorage.IsCollectorActive[].previousIncarnation - collections; SELECT TRUE FROM errorRope # NIL => { out.PutRope["Error: "]; out.PutRope[errorRope]; }; noResult => {}; ENDCASE => { IF needType # 1 THEN { out.PutRope[" => "]; IO.PutTV[out, result, depth, width]; IF needType # 0 THEN out.PutRope["\n"]; }; IF needType # 0 THEN { out.PutRope[" ("]; IO.PutType[out, AMTypes.TVType[result], depth, width]; out.PutRope[")"]; }; }; IF showStats THEN { out.PutRope["\n {"]; ShowTime.ShowDelta[mark, outChar, 2]; out.PutRope[" seconds"]; IF words # 0 THEN { IO.PutF[out, ", %g words", [integer[words]]]; }; SELECT faults FROM 0 => {}; 1 => out.PutRope[", 1 fault"]; ENDCASE => out.PutF[", %g faults", [integer[faults]]]; SELECT collections FROM 0 => {}; 1 => out.PutRope[", 1 GC"]; ENDCASE => out.PutF[", %g GCs", [integer[collections]]]; out.PutRope["}"]; }; out.PutRope["\n"]; }; IF next = 0 THEN EXIT; pos _ next; ENDLOOP; }; HelpCommand: PUBLIC Commander.CommandProc = TRUSTED { context: Context = NARROW[List.Assoc[$Context, ProcessProps.GetPropList[]]]; rope: ROPE _ cmd.commandLine.Flatten[]; out: STREAM = cmd.out; start, pos, end: INT _ 0; size: INT _ rope.Size[]; any: BOOL _ FALSE; get1: CedarScanner.GetProc = TRUSTED { c: CHAR _ 0C; IF index < size THEN { c _ rope.Fetch[index]; SELECT c FROM IN [0C..40C], IN [177C..377C] => {}; -- identity for non-printing (and space) '', '", '\\ => {}; -- identity for quotes '(, '[, '{, '<, '>, '}, '], ') => {}; -- identity for parens '-, '/ => {}; -- identity for comment starters ',, ';, ':, '. => {}; -- identity for separators ENDCASE => c _ 'a; -- all others take part in the token }; RETURN [c]; }; get2: CedarScanner.GetProc = TRUSTED { c: CHAR _ 0C; IF index < size THEN { c _ rope.Fetch[index]; }; RETURN [c]; }; outChar: PROC [c: CHAR] RETURNS [BOOL] = TRUSTED {out.PutChar[c]; RETURN [FALSE]}; DO token: CedarScanner.Token = CedarScanner.GetToken[[get1], pos]; pos _ token.next; SELECT token.kind FROM tokenEOF => { IF NOT any THEN ShowHelp[out, "help", "prints out the documentation for registered commands. Pattern-matching is supported, as in 'help foo*', which would print out all commands starting with 'foo'."]; EXIT; }; tokenCOMMENT => {}; ENDCASE => { pattern: ROPE _ CedarScanner.ContentsFromToken[[get2], token]; any _ TRUE; SELECT TRUE FROM Rope.Find[pattern, "&"] # -1 => { <> cow: TVGuide.Ruminant = TRUSTED { <<[name: ROPE, help: ROPE, tv: TV, data: REF] RETURNS [stop: BOOL]>> IF help # NIL AND Rope.Match[pattern, name, FALSE] THEN ShowHelp[out, name, help]; RETURN [FALSE]; }; [] _ Browse[cow]; }; Rope.Find[pattern, "*"] = -1 => { <> doc: ROPE _ Commander.Lookup[pattern].doc; IF doc # NIL THEN ShowHelp[out, pattern, doc]; }; ENDCASE => { <> inner: PROC [name: ROPE, proc: Commander.CommandProc, doc: ROPE] RETURNS [stop: BOOL] = TRUSTED { IF Rope.Match[pattern, name, FALSE] THEN ShowHelp[out, name, doc]; RETURN [FALSE]; }; [] _ Commander.Enumerate[inner]; }; }; ENDLOOP; }; EvalStatsCommand: PUBLIC Commander.CommandProc = TRUSTED { out: STREAM = cmd.out; showStats _ NOT showStats; IF out = NIL THEN RETURN; out.PutRope["Evaluation statistics "]; IF showStats THEN out.PutRope["on.\n"] ELSE out.PutRope["off.\n"]; }; ShowHelp: PROC [out: STREAM, name: ROPE, help: ROPE] = TRUSTED { out.PutRope[" "]; out.PutRope[name]; out.PutRope[": "]; out.PutRope[help]; out.PutRope["\n"]; }; <> showStats: BOOL _ UserProfile.Boolean["ShowEvalStatistics", FALSE]; Commander.Register["_", EvalCommand, "a simple evaluation command"]; Commander.Register["eval", EvalCommand, "a simple evaluation command"]; Commander.Register["help", HelpCommand, "provides help on registered commands"]; Commander.Register["evalStats", EvalStatsCommand, "toggles evaluation statistics"]; TRUSTED {RTProcess.StartWatchingFaults[]}; END.