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 =
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 =
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.

MispImpl.Mesa
Last Edited by: Spreitzer, July 30, 1985 3:27:59 pm PDT
Pavel, June 20, 1985 1:59:32 pm PDT
(catch) => [evalArgs: FALSE, data: NIL]
(catchq) => [evalArgs: FALSE, data: $Q]
(throw) => [evalArgs: TRUE, data: NIL]
(throwq) => [evalArgs: FALSE, data: $Q]
Κ ώ–

"cedar" style˜J™
™7Icode™#—J˜KšΟk	œœœ:˜hK˜šΠbxœœ
˜KšœœœC˜bKšœ˜—K˜Kšœ
œ˜K˜Kš	œœ
œ'œœ
˜GK˜Kšœœ
œ(œ	œœ
˜XK˜Kšœ
œ˜K˜Kšœ
œœ˜'šœœœ˜Kš
œ˜Kšœœ
œ
˜Kšœœœ
˜K˜—K˜Kšœœ
œ8œ
˜OK˜Kšœ
œ
œœ
˜(Kšœœ
œœ
˜,K˜Kšœœœ
˜K˜šΟn
œœ
œœ
œœœ˜<Kšœœ˜—K˜šŸœœ
œœ
œœ˜IKšœœ˜—K˜šŸœœ
œœ
œ*œ
œ
œ˜dKš
˜Kš
œ*˜*šœ$œœ˜EKšœ ˜%K˜—šœœ
˜šœœ˜Kšœœ
œ(˜6Kšœ	œ
œ
œ.˜Gšœ
œœ
˜šœ˜š
Ÿœœœœ
œ˜3Kš
˜Kšœœ
˜Kšœœ˜Kšœ	œ
˜
šœœœ
˜*šœœ˜(Kšœ
œ	œœ˜3—Kšœœ
œœ˜7K˜Kšœ
˜—Kšœ
˜—Kš	œœœœœ˜CK˜.Kšœ
˜—Kšœœ9˜I—Kšœ
˜—Kšœœ2˜<Kšœ˜—K˜Kšœ
˜—K˜šŸœœ
œœ(œœ
œ˜mKš
˜Kšœœ˜-š
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜š
œ ˜ šœ
œœœ
œœ
œ˜-Kšœœ
˜
K˜&K˜#Kšœœ˜1Kš
œ˜Kšœ˜#———Kšœ
˜—K˜šœœœ˜OK˜Kš
œ"˜"Kš
œ"˜"K˜ K˜—K˜š
Ÿœœœœ
œ˜OKšœœ
œ
œ
˜Kš
œ#˜#K˜—K˜šŸœœœœ	œœ
œ˜eKšœœ
˜"K˜!K˜—K˜šŸœœœœ
œœ˜cKšœœ
˜"Kšœœœœ"˜NK˜—K˜šŸœœœœœ
œ˜^Kšœœ
˜"šŸœœœ
œœœ˜=Kšœœœ˜K˜Kšœœ
˜
K˜—Kš
œ˜K˜—K˜šŸœœœœ˜:Kšœœ
˜"Kšœ˜K˜—K˜šŸ
œœœ"œœ
œ˜ZKš
˜šœ"œœ
˜6Kšœœ
˜Kš
œ1˜1Kšœœ
œ
˜Kšœ
˜—Kšœœœ˜@Kšœ
˜—K˜šŸœœ
œœ	œ
œœœ˜nKš
˜šœ	˜Kšœ
˜	šœ
œœ
˜Kšœœ
œ
œ!˜CKšœ
˜——š
œ
œœ
œ"œœ
˜LKšœ
œ(œ
œ
˜8Kšœ(œ˜.Kšœ
˜Kšœ
˜—Kšœ*œ˜0Kšœ
˜—K˜šŸœœ
œœ
œœœ˜dš
œ
˜
šŸœœœ
œ˜%š
˜š	œœ
œ	œ
˜%Kšœ˜—K˜šœ	œ
˜šœ	œ˜Kšœ	œœ˜K˜šœœ
˜šœœ
˜Kšœ
œ
œœ˜—K˜"K˜K˜Kšœ
˜—K˜šœœ
˜Kšœ˜—Kš
œ˜—šœœ˜
Kš
œ-˜-—šœ˜
šœ˜Kšœ6œœ˜mKš
œ
˜
—Kš
œ˜——K˜š
˜š
œ˜šœ˜Kšœ5œœ˜sKš
œ
˜
—Kš
œ˜———KšœΟc˜—K˜K˜—K˜—K˜šŸœœ
œœœœ
œœ
œvœ
œœœ˜KšœœSœ˜nK˜%K˜—K˜šŸœœ
œœ˜Pšœ(œœ
˜;Kšœ
œœ
œ
˜=Kšœ
˜—Kšœ
œ˜#K˜—K˜šŸœœ
œ"œœœœ˜\Kš
˜Kšœœœ
œ$œœ˜‹
Kšœ
˜—K˜šŸ	œœ$œ
œœœ˜rKš
˜K˜ Kšœœ
œ	œ
œœ	˜LKšœ
˜—K˜šŸœœ
œœœœœ
œœœ˜†
Kš
˜Kšœœœg˜‘
Kšœ
˜—K˜šŸœœ
œ˜2š
˜Kš
œ/˜/Kš
œ/˜/Kš
œ;˜;Kš
œ1˜1Kšœ:œ˜AKšœ;œ˜LKšœGœ˜NKšœ3œ˜:Kš
œ5˜5Kš
œ:˜:Kš
œ)˜)Kš
œ/˜/Kš
œ-˜-Kš
œ<˜<Kšœ3œ˜:Kšœ;œ˜BKšœ5œ˜<Kšœ;œ˜BKš
œ-˜-Kš
œ<˜<Kš
œ-˜-Kš
œ/˜/Kšœ=œ˜DKš
œ@˜@Kš
œ/˜/Kš
œ/˜/Kš
œ3˜3Kš
œ5˜5Kš
œ-˜-Kšœ9œ˜@Kš
œ-˜-Kš
œ<˜<Kš
œ+˜+Kšœ7œ˜>Kš
œ>˜>Kš
œ/˜/Kšœ:œ˜KKš
œ5˜5K˜šœœ
œ&œœ
˜HKš
œ˜Kšœ
˜——Kšœ
˜—K˜šŸœœ
œ+˜Pšœ˜˜
Kšœœ˜Kšœœ
œ˜3K˜—˜	šœœ
œ˜Kšœœœ˜(K˜
—šœ˜Kšœœœ˜"Kš
œ!˜!K˜—K˜—Kšœœ
˜—K˜—K˜Kšœœœ,˜FK˜šŸ
œœ œ˜FKšœ#œ˜(K˜—K˜šŸ	œ˜Kš
˜K˜Kšœ
˜—K˜šŸœ˜Kš
˜K˜Kšœ
˜—K˜šŸœ˜Kš
˜Kšœ	œ
œ˜š
œ˜šœœ
˜Kšœ˜—š
˜Kš
œ˜——K˜K˜Kšœ;œ˜PKšœ
˜—K˜šŸœ˜Kš
˜Kšœ	œ
œ˜š
œ˜šœœ
˜Kšœ0˜6—š
˜Kš
œ˜——K˜K˜3Kšœ;œ˜PKšœ
˜—K˜šŸ
œ˜Kš
˜Kšœœœ
˜ š
œ˜Kš
œ
œ
œ
œœ
˜A—Kšœ	œœ
˜K˜Kšœ6œœ˜HKš
œ˜Kšœ
˜—K˜šŸœ˜Kšœœ
œ˜š
œ˜Kš
œ
œ
œ
œœ
˜A—K˜ K˜—K˜šŸ	œ˜š
˜Jšœœœ˜Jšœœ
œ˜J˜šœ˜Kšœœœ˜.Kšœœ˜4Kšœœ˜1Kšœœœ˜.Kšœœœ
œœ
œ
˜YKšœœœ˜.Kšœœ˜1Kšœœ
˜——Kšœ
˜—K˜šŸ
œ˜Kš
˜KšœœX˜mKšœœœ$˜PKšœ
˜—K˜šŸœ˜Kš
˜KšœœEœ˜{Kšœœœ#œ
˜aKšœ
˜—K˜šŸœ˜Kš
˜Kšœ
œ
˜ Kšœœ
œœ
˜"Kš
œœ
œœœ
œ
œ˜.šœœ
˜š
œ˜Kš
œ˜K˜K˜K˜—Kšœ
˜—Kšœ	œ"˜/Kšœ
˜—K˜šŸœ˜Kš
˜Kšœœ˜K˜šœ
˜KšœFœ3˜
Kšœk˜o—K˜*Kšœ
˜—K˜šŸœ˜Kš
˜Kšœœœ
˜Kšœœ
˜šœœ
œ˜Kšœœ
˜Kšœ
œ
œ
œ˜9K˜—Kš
œ&˜&Kšœ
˜—K˜šŸ	œ˜Kš
˜Kšœœ
˜!Kšœœœ˜&K˜0Kšœ
˜—K˜šŸœ˜Kš
˜Kšœ	œ
˜
šœœœ
˜.K˜Kšœ
˜—Kšœ
˜—K˜šŸœ˜Kš
˜Kšœ
œœ
˜$Kšœœ
œ˜ Kšœœœ
˜K˜š	œœœœ
˜2Kšœœœ˜Kšœ
œ˜!Kšœ
œ2˜@Kšœ
˜—K˜=K˜ Kšœ
˜—K˜šŸ
œ˜Kš
˜Kšœ
œœ
˜$Kšœœ
œ˜ Kšœœœ
˜K˜9š	œœœœ
˜2Kšœœœ˜Kšœœ
œ˜Kšœœ
œ"˜1Kšœœ	˜'Kšœ
˜—K˜ Kšœ
˜—K˜šŸœ˜š
˜Kšœœ
œ(˜5K˜š
œ˜šœœ
˜Kš
œ)˜)—š
˜šœœ
˜Kš
œ.˜.—š
˜Kšœ
˜————Kšœ
˜—K˜šŸœ˜Kš
˜Kšœœœ
˜ Kšœœœ˜%Kšœœ
œ˜%Kšœœœ
˜K˜š	œœœœ
˜.Kšœœœ˜Kšœ
œ˜!Kš
œ
œœ
œ
œ(œ
œ˜`Kšœ
˜—Kš
œ<˜<Kšœ	œ
˜
š
˜Kšœœ
œ ˜-Kšœœ
œ
œœ
œ
œœ$˜bK˜ š	œœœœ
˜.Kšœœœ˜Kšœ
œ
œœ
œgœ˜˜
Kšœ
˜—Kšœ
˜—Kšœ
˜—K˜šŸœ˜Kš
˜Kšœ*˜0Kšœ
˜—K˜šŸ	œ˜Kš
˜Kšœœ&˜2Kš
œ˜Kšœ
˜—K˜šŸœœœ
œœœ˜=Kš
˜Kšœ	œ
œ˜&Kš	œ
œ
œ
œ˜+šœ
œœ
˜šœœœ
˜"K˜K˜Kšœœ˜0Kšœ
œ
˜—šœœœ
˜#K˜K˜Kšœœ˜0Kšœ
œ
˜—šœœœ
˜#Kšœœ˜/Kšœœ˜0K˜Kšœ
œ
˜—šœœœœ
˜#Kšœœ˜Kšœ
œ
˜—šœœœ
˜'K˜$Kšœ
œ
˜—šœœœœ
˜#šœœ˜Kšœœ
˜š	œœœœ˜"Kšœ
œ#œ
œ
˜3K˜
K˜
Kšœ
˜—Kšœœœœ˜ Kšœ
˜—Kšœ
œ
˜—Kšœ˜ —Kšœ
˜—K˜šŸœ˜Kš
˜Kšœœœ$˜6Kš
œ˜Kšœ
˜—K˜šŸ	œ˜Kš
˜Kšœœ
œ˜%K˜šœœ
˜KšœI˜N—K˜Kšœ	œ
˜
šœœœ
˜.K˜Kšœœ˜!Kšœ
˜—K˜Kšœ
˜—K˜šŸœ˜Kš
˜Kš
œS˜SKšœœ<˜UKšœ
˜—K˜•StartOfExpansion| -- [args: LIST OF REF ANY, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY]šΟbœ˜Kšœœ
œ˜%K˜šœœ
˜KšœI˜N—K˜Kšœ	œ
˜
šœœœ
˜.K˜Kšœœ˜ Kšœ
˜—K˜Kš
œ˜—K˜šŸœœ
œœ
œœ
œœœ˜Qšœœ
˜šœœ˜
š
œ
˜
Kšœœ˜Kš
œ˜šœœœ
˜3Kšœœ˜Kš
œ˜Kšœ
˜—Kšœœ˜—K˜—Kšœœ˜"Kšœœ˜&š
œ
˜
Kš	œœœœœ˜_—Kšœœœ˜4Kšœ"œ˜6Kšœœœœ	œœ˜Q˜Kšœœ˜+—KšœœœœJœœ˜Ά
Kšœœ˜*—K˜—K˜–| -- [args: LIST OF REF ANY, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY]šŸœœ
œœ
œœœœœ˜ZKš	œœ
œœ
œ˜K˜Kš
œ˜K˜K˜—K˜–| -- [args: LIST OF REF ANY, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY]š‘œ˜Kšœœ
œ˜#K˜šœœ
œ
˜KšœG˜L—K˜Kšœ	œ˜K˜—K˜š‘	œ˜Kš
˜Kšœ	œ*˜7šœœœ˜EKšœ1˜5Kšœ6˜:—K˜Kšœ	œœ˜Kšœ
˜—K˜š‘	œ˜Kš
˜Jšœ
œ˜Kšœ
˜—K˜š‘œ˜Kš
˜Kšœœ
œ˜Kšœ	œ
œ˜#Kšœ(œ1œ˜kKšœ
˜—K˜š‘	œ˜Kš
œ'™'Kš
œ'™'š
˜Kšœ
œœ˜!šœœœ
˜šœ
œ
˜Kš
œ$˜$—š
˜Kš
œ
˜
—Kš
œ˜—Kšœœ
œ˜ š
œ˜šœœ
˜Kšœ0˜6—š
˜Kšœ
˜——K˜š
œ(˜(˜
šœœ˜š
œ˜šœœ
˜Kšœœ˜,—š
˜K˜——Kšœ
˜	K˜
—š
˜Kšœ
˜—K˜—Kš
œ˜——Kšœ
˜—K˜šŸ	œ˜Kš
œ&™&Kš
œ'™'š
˜Kšœ	œ˜Kšœœœ
˜ šœœ
œ˜šœ	˜Kš
œ)˜)—š
˜Kš
œ˜——J˜JšœA˜F—Kšœ
˜—K˜šŸœ˜Kš
˜Kšœ
œœ
˜$Kš
œ#˜#K˜Kšœ
˜—K˜šŸœœ
œœ#˜Dš
˜Kšœœ
œ
˜Kšœœ
˜Kšœœ˜K˜Kšœœ˜)š
œ˜šœ1˜7Kš
œ˜—š
˜Kš
œ	˜	——šœ	œ7˜B–[error: 
FS.ErrorDesc]šœ
˜Kšœ[˜`—Kš
œ˜—K˜š
˜Kšœœ
œ
˜
K˜Kšœœ
œ
˜K˜Kš
œ˜Kšœ
˜—K˜—Kšœ
˜—K˜šŸœœ
œœœ
œ˜AKš
˜Kš
œœ
œ
œœ˜Kšœœ
œ
œ˜'K˜Kšœ
˜—K˜šŸœœ
œœœ
œ˜?Kš
˜Kš
œœ
œ
œœ˜Kšœ
œ
œ
œ
˜%K˜Kšœ
˜—K˜š
Ÿœœœœœ
œ˜9Kšœœœœœ
œ˜(—K˜KšŸœœ
œœœœ˜=KšŸœœ
œœœœ˜=K˜šŸœœ˜Kš
œ(˜(K˜—K˜K˜K˜Kšœ
˜—…—TŠv˜