MispImpl.Mesa
Last Edited by: Spreitzer, July 30, 1985 3:27:59 pm PDT
Pavel, June 20, 1985 1:59:32 pm PDT
DIRECTORY Atom, BasicTime, FS, Interpreter, IO, Misp, PrintTV, Process, Real, RefTab, Rope, SafeStorage;
MispImpl: CEDAR PROGRAM
IMPORTS Atom, BasicTime, FS, IO, Misp, PrintTV, Process, RealDefs: Real, RefTab, Rope, SafeStorage
EXPORTS Misp =
BEGIN OPEN Misp;
Error: PUBLIC ERROR [env: Environment, stack: Stack, msg: ROPE] = CODE;
Throw: PUBLIC ERROR [env: Environment, stack: Stack, atom: ATOM, value: REF ANY] = CODE;
SymbolTable: TYPE = RefTab.Ref;
UserDefined: TYPE = REF UserDefinedRep;
UserDefinedRep: TYPE = RECORD [
c: Closure,
args, body: REF ANY,
envToo: BOOL ← FALSE,
environment: Environment];
Stop: PUBLIC ERROR [env: Environment, stack: Stack, stop: AbortClosure] = CODE;
definers: LIST OF EnvironmentProc ← NIL;
definersTail: LIST OF EnvironmentProc ← NIL;
debug: BOOLEAN ← FALSE;
IsEnvironment: PUBLIC PROC [ra: REF ANY] RETURNS [b: BOOL] =
{b ← ISTYPE[ra, Environment]};
NarrowToEnvironment: PUBLIC PROC [ra: REF ANY] RETURNS [e: Environment] =
{e ← NARROW[ra]};
Eval: PUBLIC PROC [raw: REF ANY, environment: Environment, stack: Stack] RETURNS [cooked: REF ANY] =
BEGIN
stop: AbortClosure ← EnvStop[environment];
IF stop # Interpreter.nilAbortClosure AND stop.proc[stop.data] THEN {
ERROR Stop[environment, stack, stop];
};
WITH raw SELECT FROM
lora: LORA => BEGIN
first: REF ANY ← Eval[lora.first, environment, stack];
IF first = NIL THEN ERROR Error[environment, stack, "NIL head of list"]
ELSE WITH first SELECT FROM
c: Closure => BEGIN
EvalArgs: PROC [raw: LORA] RETURNS [cooked: LORA] =
BEGIN
next, last: LORA;
n: INT ← 0;
cooked ← NIL;
FOR raw ← raw, raw.rest WHILE raw # NIL DO
next ← LIST[Eval[raw.first, environment,
CONS[LIST[c.name, NEW [INT ← n ← n + 1]], stack]]];
IF last = NIL THEN cooked ← next ELSE last.rest ← next;
last ← next;
ENDLOOP;
END;
args: LORA ← IF c.evalArgs THEN EvalArgs[lora.rest] ELSE lora.rest;
cooked ← ApplyFn[c, args, environment, stack];
END;
ENDCASE => ERROR Error[environment, stack, "Head of list not a Closure"];
END;
atom: ATOM => cooked ← GetBinding[atom, environment, stack];
ENDCASE => cooked ← raw;
Process.CheckForAbort[];
END;
ApplyFn: PUBLIC PROC [fn: Closure, args: LORA, env: Environment, parentStack: Stack] RETURNS [ans: REF ANY] =
BEGIN
subStack: Stack ← CONS[fn.name, parentStack];
ans ← fn.eval[
args: args,
data: fn.data,
environment: env,
stack: subStack
!SafeStorage.NarrowRefFault => {
IF NOT debug THEN {ros: IO.STREAM ← IO.ROS[];
msg: ROPE;
ros.PutRope["NARROW failed: wanted "];
PrintTV.PrintType[targetType, ros];
ros.PutF[", got %g", IO.rope[PrintValRope[ref]]];
msg ← ros.RopeFromROS[];
ERROR Error[env, subStack, msg]}}];
END;
defaultEnvironmentClass: PUBLIC EnvironmentClass ← NEW [EnvironmentClassRep ← [
Init: InitSymbolTable,
GetBinding: GetSymbolTableBinding,
SetBinding: SetSymbolTableBinding,
Enumerate: EnumerateSymbolTable,
Size: SymbolTableSize]];
InitSymbolTable: PROC [env: Environment, sizeGuess: NAT, initData: REF ANY] = {
IF initData # NIL THEN ERROR;
env.rep ← RefTab.Create[sizeGuess];
};
GetSymbolTableBinding: PROC [env: Environment, key: ATOM] RETURNS [found: BOOL, binding: REF ANY] = {
st: SymbolTable ← NARROW[env.rep];
[found, binding] ← st.Fetch[key];
};
SetSymbolTableBinding: PROC [env: Environment, key: ATOM, binding: REF ANY, overwriteOld: BOOL] = {
st: SymbolTable ← NARROW[env.rep];
[] ← (IF overwriteOld THEN RefTab.Store ELSE RefTab.Insert)[st, key, binding];
};
EnumerateSymbolTable: PROC [env: Environment, consume: PROC [key: ATOM, binding: REF ANY]] = {
st: SymbolTable ← NARROW[env.rep];
Consume: PROC [key, val: REF ANY] RETURNS [quit: BOOLEAN] = {
atom: ATOM ← NARROW[key];
consume[atom, val];
quit ← FALSE;
};
[] ← st.Pairs[Consume];
};
SymbolTableSize: PROC [env: Environment] RETURNS [NAT] = {
st: SymbolTable ← NARROW[env.rep];
RETURN [st.GetSize[]];
};
GetBinding: PROC [atom: ATOM, env: Environment, stack: Stack] RETURNS [binding: REF ANY] =
BEGIN
FOR et: Environment ← env, et.parent WHILE et # NIL DO
found: BOOL;
[found, binding] ← et.class.GetBinding[et, atom];
IF found THEN RETURN;
ENDLOOP;
Error[env, stack, IO.PutFR["No binding for %g", IO.atom[atom]]];
END;
BindAtom: PUBLIC PROC [pattern: ATOM, value: REF ANY, env: Environment, introduce: BOOL, stack: Stack ← NIL] =
BEGIN
IF value = NIL
THEN NULL
ELSE WITH value SELECT FROM
c: Closure => IF c.name = NIL THEN c.name ← Atom.GetPName[pattern];
ENDCASE;
IF NOT introduce THEN FOR et: Environment ← env, et.parent WHILE et # NIL DO
IF NOT et.class.GetBinding[et, pattern].found THEN LOOP;
et.class.SetBinding[et, pattern, value, TRUE];
RETURN;
ENDLOOP;
env.class.SetBinding[env, pattern, value, TRUE];
END;
Bind: PUBLIC PROC [pattern, value: REF ANY, env: Environment, introduce: BOOL, stack: Stack ← NIL] =
{
Add: PROC [pattern, value: REF ANY] =
BEGIN
IF pattern = NIL AND value # NIL THEN
GOTO PatternTooShort;
WITH pattern SELECT FROM
patList: LORA => {
valList: LORA ← NARROW[value];
WHILE patList # NIL DO
IF valList = NIL THEN
valList ← CONS[NIL, NIL];
Add[patList.first, valList.first];
patList ← patList.rest;
valList ← valList.rest;
ENDLOOP;
IF valList # NIL THEN
GOTO PatternTooShort;
};
atom: ATOM =>
BindAtom[atom, value, env, introduce, stack];
ENDCASE =>
ERROR Error[env, stack,
IO.PutFR["Attempt to introduce bad pattern %g onto %g", IO.rope[PrintValRope[pattern]], IO.rope[EnvName[env]]
]
];
EXITS
PatternTooShort =>
ERROR Error[env, stack,
IO.PutFR["pattern list %g shorter than value list %g", IO.rope[PrintValRope[pattern]], IO.rope[PrintValRope[value]]
]
];
END; -- Add
Add[pattern, value];
};
NewEnvironment: PUBLIC PROC [name: ROPE, parent: Environment ← NIL, in, out: IO.STREAM ← NIL, sizeGuess: NAT ← 10, stop: AbortClosure ← Interpreter.nilAbortClosure, class: EnvironmentClass ← defaultEnvironmentClass, initData: REF ANY ← NIL] RETURNS [e: Environment] = {
e ← NEW [EnvironmentRep ← [name: name, in: in, out: out, stop: stop, parent: parent, rep: NIL, class: class]];
e.class.Init[e, sizeGuess, initData];
};
EnvStop: PUBLIC PROC [environment: Environment] RETURNS [stop: AbortClosure] = {
FOR e: Environment ← environment, e.parent WHILE e # NIL DO
IF e.stop # Interpreter.nilAbortClosure THEN RETURN [e.stop];
ENDLOOP;
stop ← Interpreter.nilAbortClosure;
};
EnvName: PUBLIC PROC [environment: Environment, long: BOOLEAN ← TRUE] RETURNS [name: ROPE] =
BEGIN
IF long AND environment.parent # NIL THEN name ← EnvName[environment.parent, TRUE].Cat[".", environment.name] ELSE name ← environment.name;
END;
Introduce: PROC [old: Environment, pattern, value: REF ANY, name: ROPE, stack: Stack] RETURNS [new: Environment] =
BEGIN
new ← NewEnvironment[name, old];
IF pattern # NIL OR value # NIL THEN Bind[pattern, value, new, TRUE, stack];
END;
Defun: PUBLIC PROC [env: Environment, name: ATOM, eval: EvalProc, evalArgs: BOOLEAN ← TRUE, data: REF ANY ← NIL, stack: Stack ← NIL] =
BEGIN
Bind[env: env, introduce: FALSE, pattern: name, value: NEW [ClosureRep ← [name: Atom.GetPName[name], eval: eval, data: data, evalArgs: evalArgs]], stack: stack];
END;
DefinePrimitives: PUBLIC PROC [env: Environment] =
BEGIN
Defun[env: env, name: $abort, eval: EvalAbort];
Defun[env: env, name: $apply, eval: EvalApply];
Defun[env: env, name: $atom, eval: EvalTypeP, data: $Atom];
Defun[env: env, name: $boundp, eval: EvalBoundp];
Defun[env: env, name: $catch, eval: EvalCatch,  evalArgs: FALSE];
Defun[env: env, name: $catchq, eval: EvalCatch,  evalArgs: FALSE, data: $Q];
Defun[env: env, name: $catchAborted, eval: EvalCatchAborted, evalArgs: FALSE];
Defun[env: env, name: $do, eval: EvalDo, evalArgs: FALSE];
Defun[env: env, name: $emptyEnv, eval: EvalEmptyEnv];
Defun[env: env, name: $envp, eval: EvalTypeP, data: $Env];
Defun[env: env, name: $eq, eval: EvalEq];
Defun[env: env, name: $equal, eval: EvalEqual];
Defun[env: env, name: $eval, eval: EvalEval];
Defun[env: env, name: $funcp, eval: EvalTypeP, data: $Func];
Defun[env: env, name: $if, eval: EvalIf, evalArgs: FALSE];
Defun[env: env, name: $lambda, eval: EvalLambda, evalArgs: FALSE];
Defun[env: env, name: $let, eval: EvalLet, evalArgs: FALSE];
Defun[env: env, name: $letrec, eval: EvalLetrec, evalArgs: FALSE];
Defun[env: env, name: $list, eval: EvalList];
Defun[env: env, name: $listp, eval: EvalTypeP, data: $List];
Defun[env: env, name: $load, eval: EvalLoad];
Defun[env: env, name: $ne, eval: EvalNotEqual];
Defun[env: env, name: $nlambda, eval: EvalNLambda, evalArgs: FALSE];
Defun[env: env, name: $numberp, eval: EvalTypeP, data: $Number];
Defun[env: env, name: $pause, eval: EvalPause];
Defun[env: env, name: $print, eval: EvalPrint];
Defun[env: env, name: $println, eval: EvalPrintLn];
Defun[env: env, name: $printval, eval: EvalPrintVal];
Defun[env: env, name: $prog, eval: EvalProg];
Defun[env: env, name: $quote, eval: EvalQuote, evalArgs: FALSE];
Defun[env: env, name: $read, eval: EvalRead];
Defun[env: env, name: $ropep, eval: EvalTypeP, data: $Rope];
Defun[env: env, name: $set, eval: EvalSet];
Defun[env: env, name: $setq, eval: EvalSetq, evalArgs: FALSE];
Defun[env: env, name: $stringp, eval: EvalTypeP, data: $Rope];
Defun[env: env, name: $throw, eval: EvalThrow];
Defun[env: env, name: $throwq, eval: EvalThrow, evalArgs: FALSE, data: $Q];
Defun[env: env, name: $unlambda, eval: EvalUnlambda];
FOR epl: LIST OF EnvironmentProc ← definers, epl.rest WHILE epl # NIL DO
epl.first[env];
ENDLOOP;
END;
RegisterPrimitiveDefiner: PUBLIC PROC [ep: EnvironmentProc, end: End ← back] = {
SELECT end FROM
front => {
definers ← CONS[ep, definers];
IF definersTail = NIL THEN definersTail ← definers;
};
back => {
IF definersTail = NIL THEN {
definers ← definersTail ← CONS[ep, NIL];
}
ELSE {
definersTail.rest ← CONS[ep, NIL];
definersTail ← definersTail.rest;
};
};
ENDCASE => ERROR;
};
preLoadFileName: ROPE ← FS.ExpandName["MispStandards.misp"].fullFName;
LoadStandards: PROC [environment: Environment] --EnvironmentProc-- = {
Load[preLoadFileName, environment, NIL];
};
EvalQuote: EvalProc =
BEGIN
cooked ← args.first;
END;
EvalList: EvalProc =
BEGIN
cooked ← args;
END;
EvalSet: EvalProc =
BEGIN
pattern: REF ANY ← args.first;
env: Environment ←
IF args.rest.rest # NIL THEN
NARROW[args.rest.rest.first]
ELSE
environment;
cooked ← args.rest.first;
Bind[pattern: pattern, value: cooked, env: env, introduce: FALSE, stack: stack];
END;
EvalSetq: EvalProc =
BEGIN
pattern: REF ANY ← args.first;
env: Environment ←
IF args.rest.rest # NIL THEN
NARROW[Eval[args.rest.rest.first, environment, stack]]
ELSE
environment;
cooked ← Eval[args.rest.first, environment, stack];
Bind[pattern: pattern, value: cooked, env: env, introduce: FALSE, stack: stack];
END;
EvalBoundp: EvalProc =
BEGIN
name: ATOM ← NARROW[args.first];
env: Environment ←
IF args.rest # NIL THEN NARROW[args.rest.first] ELSE environment;
isBound: BOOL ← TRUE;
[] ← GetBinding[name, env, stack !Error => {isBound ← FALSE; CONTINUE}];
cooked ← MispBool[isBound];
END;
EvalEval: EvalProc = {
form: REF ANY ← args.first;
env: Environment ←
IF args.rest # NIL THEN NARROW[args.rest.first] ELSE environment;
cooked ← Eval[form, env, stack];
};
EvalTypeP: EvalProc =
BEGIN
atom: ATOM ← NARROW[data];
val: REF ANY ← args.first;
SELECT atom FROM
$Atom => cooked ← MispBool[ISTYPE[val, ATOM]];
$Env => cooked ← MispBool[ISTYPE[val, Environment]];
$Func => cooked ← MispBool[ISTYPE[val, Closure]];
$List => cooked ← MispBool[ISTYPE[val, LORA]];
$Number =>
cooked ← MispBool[ISTYPE[val, Int] OR ISTYPE[val, Real] OR ISTYPE[val, Comp]];
$Rope => cooked ← MispBool[ISTYPE[val, ROPE]];
$Time => cooked ← MispBool[ISTYPE[val, RefTime]];
ENDCASE => ERROR;
END;
EvalLambda: EvalProc =
BEGIN
ud: UserDefined ← NEW [UserDefinedRep ← [args: args.first, body: args.rest.first, environment: environment]];
cooked ← ud.c ← NEW [ClosureRep ← [name: NIL, eval: EvalUserDefined, data: ud]];
END;
EvalNLambda: EvalProc =
BEGIN
ud: UserDefined ← NEW [UserDefinedRep ← [args: args.first, body: args.rest.first, envToo: TRUE, environment: environment]];
cooked ← ud.c ← NEW [ClosureRep ← [name: NIL, eval: EvalUserDefined, evalArgs: FALSE, data: ud]];
END;
EvalUnlambda: EvalProc =
BEGIN
c: Closure ← NARROW[args.first];
pattern, body, env: REF ANY ← NIL;
isN: REF ANY ← IF c.evalArgs THEN NIL ELSE $T;
WITH c.data SELECT FROM
ud: UserDefined => {
pattern ← ud.args;
body ← ud.body;
env ← ud.environment;
};
ENDCASE;
cooked ← LIST[c.name, pattern, body, env, isN];
END;
EvalUserDefined: EvalProc =
BEGIN
ud: UserDefined ← NARROW[data];
activation: Environment;
IF ud.envToo
THEN activation ← Introduce[old: ud.environment, pattern: ud.args, value: LIST[args, environment], name: ud.c.name, stack: stack]
ELSE activation ← Introduce[old: ud.environment, pattern: ud.args, value: args, name: ud.c.name, stack: stack];
cooked ← Eval[ud.body, activation, stack];
END;
EvalEmptyEnv: EvalProc =
BEGIN
name: ROPE ← NIL;
parent: Environment ← NIL;
IF args # NIL THEN {
name ← NARROW[args.first];
IF args.rest # NIL THEN parent ← NARROW[args.rest.first];
};
cooked ← NewEnvironment[name, parent];
END;
EvalApply: EvalProc =
BEGIN
fn: Closure ← NARROW[args.first];
fargs: LORA ← NARROW[args.rest.first];
cooked ← ApplyFn[fn, fargs, environment, stack];
END;
EvalProg: EvalProc =
BEGIN
cooked ← NIL;
FOR args ← args, args.rest WHILE args # NIL DO
cooked ← args.first;
ENDLOOP;
END;
EvalLet: EvalProc =
BEGIN
bindings: LORA ← NARROW[args.first];
body: REF ANY ← args.rest.first;
newVars, newVals: LORA ← NIL;
new: Environment;
FOR vt: LORA ← bindings, vt.rest WHILE vt # NIL DO
v: LORA ← NARROW[vt.first];
newVars ← CONS[v.first, newVars];
newVals ← CONS[Eval[v.rest.first, environment, stack], newVals];
ENDLOOP;
new ← Introduce[environment, newVars, newVals, "let", stack];
cooked ← Eval[body, new, stack];
END;
EvalLetrec: EvalProc =
BEGIN
bindings: LORA ← NARROW[args.first];
body: REF ANY ← args.rest.first;
newVars, newVals: LORA ← NIL;
new: Environment ← NewEnvironment["letrec", environment];
FOR vt: LORA ← bindings, vt.rest WHILE vt # NIL DO
v: LORA ← NARROW[vt.first];
newVar: REF ANY ← v.first;
newVal: REF ANY ← Eval[v.rest.first, new, stack];
Bind[newVar, newVal, new, TRUE, stack];
ENDLOOP;
cooked ← Eval[body, new, stack];
END;
EvalIf: EvalProc =
BEGIN
test: REF ANY ← Eval[args.first, environment, stack];
cooked ←
IF test # NIL THEN
Eval[args.rest.first, environment, stack]
ELSE
IF args.rest.rest # NIL THEN
Eval[args.rest.rest.first, environment, stack]
ELSE
NIL;
END;
EvalDo: EvalProc =
BEGIN
vars: LORA ← NARROW[args.first];
test: LORA ← NARROW[args.rest.first];
body: REF ANY ← args.rest.rest.first;
newVars, newVals: LORA ← NIL;
new: Environment;
FOR vt: LORA ← vars, vt.rest WHILE vt # NIL DO
v: LORA ← NARROW[vt.first];
newVars ← CONS[v.first, newVars];
newVals ← CONS[(IF v.rest # NIL THEN Eval[v.rest.first, environment, stack] ELSE NIL), newVals];
ENDLOOP;
new ← Introduce[environment, newVars, newVals, "do", stack];
cooked ← NIL;
DO
exit: REF ANY ← Eval[test.first, new, stack];
IF exit = NIL THEN RETURN [IF test.rest = NIL THEN cooked ELSE Eval[test.rest.first, new, stack]];
cooked ← Eval[body, new, stack];
FOR vt: LORA ← vars, vt.rest WHILE vt # NIL DO
v: LORA ← NARROW[vt.first];
IF v.rest # NIL AND v.rest.rest # NIL THEN Bind[pattern: v.first, env: new, value: Eval[v.rest.rest.first, new, stack], stack: stack, introduce: FALSE];
ENDLOOP;
ENDLOOP;
END;
EvalEq: EvalProc =
BEGIN
RETURN [MispBool[args.first = args.rest.first]];
END;
EvalEqual: EvalProc =
BEGIN
ans: BOOLEAN ← Equal[args.first, args.rest.first];
cooked ← MispBool[ans];
END;
Equal: PROC [first, second: REF ANY] RETURNS [ans: BOOLEAN] =
BEGIN
IF first = NIL THEN ans ← second = NIL
ELSE IF second = NIL THEN ans ← first = NIL
ELSE WITH first SELECT FROM
i1: Int => WITH second SELECT FROM
r2: Real => ans ← r2^ = i1^;
i2: Int => ans ← i1^ = i2^;
c2: Comp => ans ← Im[c2^] = 0 AND Re[c2^] = i1^;
ENDCASE => ans ← FALSE;
r1: Real => WITH second SELECT FROM
r2: Real => ans ← r2^ = r1^;
i2: Int => ans ← r1^ = i2^;
c2: Comp => ans ← Im[c2^] = 0 AND Re[c2^] = r1^;
ENDCASE => ans ← FALSE;
c1: Comp => WITH second SELECT FROM
i2: Int => ans ← Im[c1^] = 0 AND Re[c1^] = i2^;
r2: Real => ans ← Im[c1^] = 0 AND Re[c1^] = r2^;
c2: Comp => ans ← c1^ = c2^;
ENDCASE => ans ← FALSE;
r1: ROPE => WITH second SELECT FROM
r2: ROPE => ans ← r1.Equal[r2];
ENDCASE => ans ← FALSE;
rt1: RefTime => WITH second SELECT FROM
rt2: RefTime => ans ← rt1.t = rt2.t;
ENDCASE => ans ← FALSE;
l1: LORA => WITH second SELECT FROM
l2: LORA => BEGIN
ans ← TRUE;
WHILE (l1 # NIL) AND (l2 # NIL) DO
IF NOT (ans ← Equal[l1.first, l2.first]) THEN EXIT;
l1 ← l1.rest;
l2 ← l2.rest;
ENDLOOP;
ans ← (l1 = NIL) AND (l2 = NIL);
END;
ENDCASE => ans ← FALSE;
ENDCASE => ans ← first = second;
END;
EvalNotEqual: EvalProc =
BEGIN
ans: BOOLEAN ← NOT Equal[args.first, args.rest.first];
cooked ← MispBool[ans];
END;
EvalPrint: EvalProc =
BEGIN
out: IO.STREAM ← GetOut[environment];
IF out = NIL THEN
ERROR Error[environment, stack, "No output stream found on which to print\n"];
cooked ← NIL;
FOR args ← args, args.rest WHILE args # NIL DO
cooked ← args.first;
PrintVal[out, args.first, FALSE];
ENDLOOP;
END;
EvalPrintLn: EvalProc =
BEGIN
cooked ← EvalPrint[args: args, environment: environment, data: data, stack: stack];
[] ← EvalPrint[args: LIST["\n"], environment: environment, data: data, stack: stack];
END;
EvalPrintVal: EvalProc = {
out: IO.STREAM ← GetOut[environment];
IF out = NIL THEN
ERROR Error[environment, stack, "No output stream found on which to print\n"];
cooked ← NIL;
FOR args ← args, args.rest WHILE args # NIL DO
cooked ← args.first;
PrintVal[out, args.first, TRUE];
ENDLOOP;
};
PrintVal: PUBLIC PROC [out: IO.STREAM, val: REF ANY, quoteRopes: BOOL ← TRUE] = {
WITH val SELECT FROM
list: LORA =>
{
out.Put[IO.char['(]];
PrintVal[out, list.first];
FOR list ← list.rest, list.rest WHILE list # NIL DO
out.Put[IO.char[' ]];
PrintVal[out, list.first];
ENDLOOP;
out.Put[IO.char[')]];
};
int: Int => out.Put[IO.int[int^]];
real: Real => out.Put[IO.real[real^]];
comp: Comp =>
out.PutF["<%g + %g%li%l>", IO.real[Re[comp^]], IO.real[Im[comp^]], IO.rope["i"], IO.rope["I"]];
atom: ATOM => out.Put[IO.rope[Atom.GetPName[atom]]];
func: Closure => out.PutF["<%g>", IO.rope[func.name]];
rope: ROPE => IF quoteRopes THEN out.Put[IO.refAny[rope]] ELSE out.PutRope[rope];
env: Environment =>
out.PutF["<Env: %g>", IO.refAny[env.name]];
rt: RefTime => IF rt.t # BasicTime.nullGMT THEN out.PutF["%g", IO.time[rt.t] !BasicTime.OutOfRange => {out.PutRope["?time out of range?"]; CONTINUE}] ELSE out.PutRope["?null time?"];
ENDCASE => out.PutF["%g", IO.refAny[val]];
};
PrintValRope: PUBLIC PROC [val: REF ANY, quoteRopes: BOOL ← TRUE] RETURNS [rope: ROPE] = {
out: IO.STREAM ← IO.ROS[];
PrintVal[out, val, quoteRopes];
rope ← out.RopeFromROS[];
};
EvalRead: EvalProc = {
in: IO.STREAM ← GetIn[environment];
IF in = NIL THEN
ERROR Error[environment, stack, "No input stream found on which to read\n"];
cooked ← IO.GetRefAny[in];
};
EvalPause: EvalProc =
BEGIN
seconds: REAL ← ToReal[args.first, environment, stack];
ticks: Process.Ticks ← IF seconds*1000.0 > LAST[Process.Milliseconds]
THEN Process.SecondsToTicks[RealDefs.RoundC[seconds]]
ELSE Process.MsecToTicks[RealDefs.RoundC[seconds*1000.0]];
Process.Pause[ticks];
cooked ← NEW [REAL ← seconds];
END;
EvalAbort: EvalProc =
BEGIN
ERROR ABORTED[];
END;
EvalCatchAborted: EvalProc =
BEGIN
body: REF ANY ← args.first;
ifCatch: REF ANY ← args.rest.first;
cooked ← Eval[body, environment, stack !ABORTED => {cooked ← Eval[ifCatch, environment, stack]; CONTINUE}];
END;
EvalCatch: EvalProc =
(catch) => [evalArgs: FALSE, data: NIL]
(catchq) => [evalArgs: FALSE, data: $Q]
BEGIN
evalAtom: BOOLEAN ← (data = NIL);
catchAtom: ATOM ← NARROW[
IF evalAtom THEN
Eval[args.first, environment, stack]
ELSE
args.first
];
body: REF ANY ← args.rest.first;
fn: Closure ←
IF args.rest.rest # NIL THEN
NARROW[Eval[args.rest.rest.first, environment, stack]]
ELSE
NIL;
cooked ← Eval[body, environment, stack !
Throw => {
IF atom = catchAtom THEN {
cooked ←
IF fn # NIL THEN
ApplyFn[fn, LIST[value], environment, stack]
ELSE
value;
CONTINUE;
}
ELSE
REJECT;
};
];
END;
EvalThrow: EvalProc =
(throw) => [evalArgs: TRUE, data: NIL]
(throwq) => [evalArgs: FALSE, data: $Q]
BEGIN
evalArg: BOOLEAN ← (data = $Q);
atom: ATOM ← NARROW[args.first];
value: REF ANY ←
IF evalArg THEN
Eval[args.rest.first, environment, stack]
ELSE
args.rest.first;
ERROR Throw[atom: atom, value: value, env: environment, stack: stack];
END;
EvalLoad: EvalProc =
BEGIN
fileName: ROPE ← NARROW[args.first];
Load[fileName, environment, stack];
cooked ← $T;
END;
Load: PUBLIC PROC [fileName: ROPE, env: Environment, stack: Stack] =
BEGIN
stream: IO.STREAM;
fullName, sourceName: ROPE;
cp: FS.ComponentPositions;
[fullName, cp] ← FS.ExpandName[fileName];
sourceName ←
IF cp.ext.start = (cp.base.start + cp.base.length) THEN
fileName.Cat[".misp"]
ELSE
fileName;
stream ← FS.StreamOpen[fileName: sourceName, accessOptions: read !
FS.Error =>
ERROR Error[env, stack, Rope.Cat["FS.Error while loading ", fileName, ": ", error.explanation]];
];
DO
any: REF ANY;
[] ← stream.SkipWhitespace[];
IF stream.EndOf[] THEN EXIT;
any ← stream.GetRefAny[];
[] ← Eval[any, env, stack];
ENDLOOP;
stream.Close[];
END;
GetOut: PUBLIC PROC [env: Environment] RETURNS [out: IO.STREAM] =
BEGIN
IF env = NIL THEN RETURN [NIL];
IF env.out # NIL THEN RETURN [env.out];
out ← GetOut[env.parent];
END;
GetIn: PUBLIC PROC [env: Environment] RETURNS [in: IO.STREAM] =
BEGIN
IF env = NIL THEN RETURN [NIL];
IF env.in # NIL THEN RETURN [env.in];
in ← GetOut[env.parent];
END;
MispBool: PROC [bool: BOOLEAN] RETURNS [REF ANY] ~ INLINE
{ RETURN[ IF bool THEN $T ELSE NIL ]; };
Re: PUBLIC PROC [c: COMPLEX] RETURNS [re: REAL] = {re ← c.x};
Im: PUBLIC PROC [c: COMPLEX] RETURNS [im: REAL] = {im ← c.y};
Start: PROC = {
RegisterPrimitiveDefiner[LoadStandards];
};
Start[];
END.