InterpreterImpl.mesa
Paul Rovner, April 13, 1983 4:57 pm
Russ Atkinson, May 2, 1983 5:26 pm
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;
Useful types
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] = {
returns context for the given local frame
the world and gf components are inherited
RETURN [lf];
};
ContextForGlobalFrame: PUBLIC PROC [gf: TV] RETURNS [Context] = {
returns context for the given global frame
the world component is inherited
RETURN [gf];
};
ContextForWorld: PUBLIC PROC [world: World ← NIL] RETURNS [Context] = TRUSTED {
returns context for the given world (NIL => 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 {
PROC [head: EvalHead, parent: Tree, msg: ROPE];
ERROR FatalInterpreterError[msg];
};
myAbortProc: BBEval.AbortProc = TRUSTED {
PROC [data: REF] RETURNS [abort: BOOL];
am: REF AvoidanceMemorial ← NARROW[data, REF AvoidanceMemorial];
RETURN[am # NIL AND am.abort.proc # NIL AND am.abort.proc[am.abort.data]];
};
EXPORTS to TVGuide
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] = {
Registers the TV under the given name in the global TV table. It is recommended that the name contain the & character to avoid obscuring variables names. This routine returns the old TV under the given name (if one existed) and a flag indicating whether or not there was an old TV (it is perfectly OK to have NIL as a TV).
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] = {
Removes the name-value association from the global TV table. This routine returns the old TV under the given name (if one existed) and a flag indicating whether or not there was an old TV (it is perfectly OK to have NIL as a TV).
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] = {
Finds the named TV in the global TV table.
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] = {
Browses through the registered in no particular order. Returns TRUE if the user stopped the enumeration, FALSE if not.
Ruminant: TYPE = PROC
[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];
};
Commands registered with Commander
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 => {
expression finder
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 => {
single name, so don't bother enumerating
doc: ROPE ← Commander.Lookup[pattern].doc;
IF doc # NIL THEN ShowHelp[out, pattern, doc];
};
ENDCASE => {
enumerate, printing all matching entries
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"];
};
initialization code
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.