MispLists.Mesa
Last Edited by: Spreitzer, July 30, 1985 2:08:27 pm PDT
Pavel, June 20, 1985 1:34:09 pm PDT
DIRECTORY Atom, IO, List, Misp, Real, Rope;
MispLists:
CEDAR
PROGRAM
IMPORTS Atom, IO, List, Misp, Rope
EXPORTS Misp =
BEGIN OPEN Misp;
BoolSeq: TYPE = REF BoolSequence;
BoolSequence: TYPE = RECORD [seq: SEQUENCE length: NAT OF BOOL];
CXRCode: ARRAY BOOL OF ROPE = [FALSE: "a", TRUE: "d"];
true: PUBLIC REF ANY ← $T;
false: PUBLIC REF ANY ← NIL;
ToBool:
PUBLIC
PROC [ra:
REF
ANY, e: Environment, s: Stack]
RETURNS [
BOOL] = {
RETURN [ra # NIL]};
BoolDecode:
PUBLIC
PROC [ra:
REF
ANY]
RETURNS [isBool, value:
BOOL] = {
isBool ← TRUE;
value ← ra # NIL;
};
DefineListStuff:
PROC [environment: Environment]
--EnvironmentProc-- =
BEGIN
DefineCXRs:
PROC [n, i:
NAT, pbs: BoolSeq] = {
Work:
PROC [b:
BOOL] = {
bs: BoolSeq ← NEW [BoolSequence[n]];
name: ROPE ← Rope.Cat["c", CXRCode[b]];
FOR j:
NAT
IN (i .. n]
DO
name ← name.Cat[CXRCode[bs[j-1] ← pbs[j-1]]];
ENDLOOP;
bs[i-1] ← b;
SELECT i
FROM
=1 => Defun[env: environment, name: Atom.MakeAtom[name.Cat["r"]], eval: EvalCXR, data: bs];
>1 => DefineCXRs[n, i-1, bs];
ENDCASE => ERROR;
};
Work[TRUE];
Work[FALSE];
};
FOR n:
NAT
IN [1 .. 4]
DO
DefineCXRs[n, n, NIL]
ENDLOOP;
Defun[environment, $cons, EvalCons];
Defun[environment, $car, EvalCar]; -- See DefineCXRs
Defun[environment, $cdr, EvalCdr];
Defun[environment, $and, EvalAnd, FALSE];
Defun[environment, $or, EvalOr, FALSE];
Defun[environment, $not, EvalNot];
Defun[environment, $cond, EvalCond, FALSE];
Defun[environment, $append, EvalAppend];
Defun[environment, $mapcar, EvalMapCar];
Defun[environment, $nth, EvalNth];
Defun[environment, $length, EvalLength];
Defun[environment, $rplaca, EvalRplaca];
Defun[environment, $rplacd, EvalRplacd];
Bind[$NIL, NIL, environment, FALSE];
Bind[$T, $T, environment, FALSE];
Bind[$nil, NIL, environment, FALSE];
Bind[$t, $T, environment, FALSE];
Bind[$true, true, environment, FALSE];
Bind[$false, false, environment, FALSE];
END;
EvalCXR: EvalProc = {
bs: BoolSeq ← NARROW[data];
arg: REF ANY ← args.first;
FOR i:
NAT
DECREASING
IN [0 .. bs.length)
DO
lora: LORA ← NARROW[arg];
arg ←
SELECT bs[i]
FROM
FALSE => lora.first,
TRUE => lora.rest,
ENDCASE => ERROR;
ENDLOOP;
cooked ← arg;
};
EvalCons: EvalProc =
BEGIN
Tail:
PROC [args:
LORA]
RETURNS [ans:
LORA] =
BEGIN
IF args.rest = NIL THEN RETURN [NARROW[args.first]];
ans ← CONS[args.first, Tail[args.rest]];
END;
cooked ← IF args = NIL THEN NIL ELSE Tail[args];
END;
EvalCar: EvalProc =
BEGIN
list: LORA ← NARROW[args.first];
cooked ← list.first;
END;
EvalCdr: EvalProc =
BEGIN
list: LORA ← NARROW[args.first];
cooked ← list.rest;
END;
EvalRplaca: EvalProc =
BEGIN
cons: LORA ← NARROW[args.first];
elt: REF ANY ← args.rest.first;
cons.first ← elt;
cooked ← cons;
END;
EvalRplacd: EvalProc =
BEGIN
cons: LORA ← NARROW[args.first];
elt: LORA ← NARROW[args.rest.first];
cons.rest ← elt;
cooked ← cons;
END;
EvalAnd: EvalProc =
BEGIN
cooked ← $T;
FOR args ← args, args.rest
WHILE args #
NIL
DO
IF (cooked ← Eval[args.first, environment, stack]) = NIL THEN RETURN;
ENDLOOP;
END;
EvalOr: EvalProc =
BEGIN
cooked ← NIL;
FOR args ← args, args.rest
WHILE args #
NIL
DO
IF (cooked ← Eval[args.first, environment, stack]) # NIL THEN RETURN;
ENDLOOP;
END;
EvalNot: EvalProc =
BEGIN
RETURN [IF args.first = NIL THEN $T ELSE NIL];
END;
EvalCond: EvalProc =
BEGIN
FOR args ← args, args.rest
WHILE args #
NIL
DO
arm: LORA ← NARROW[args.first];
test: REF ANY ← Eval[arm.first, environment, stack];
IF ToBool[test, environment, stack] THEN RETURN [IF arm.rest # NIL THEN Eval[arm.rest.first, environment, stack] ELSE test];
ENDLOOP;
cooked ← NIL;
END;
EvalAppend: EvalProc =
BEGIN
ans: LORA ← NIL;
FOR args ← args, args.rest
WHILE args #
NIL
DO
next: LORA ← NARROW[args.first];
ans ← List.Append[ans, next];
ENDLOOP;
cooked ← ans;
END;
EvalMapCar: EvalProc =
BEGIN
first, last: LORA ← NIL;
fargs: LIST OF LORA ← NIL;
fn: Closure ← NARROW[args.first];
someNonEmpty, done: BOOLEAN ← FALSE;
FOR args ← args.rest, args.rest
WHILE args #
NIL
DO
arg: LORA ← NARROW[args.first];
fargs ← CONS[arg, fargs];
IF arg # NIL THEN someNonEmpty ← TRUE;
ENDLOOP;
IF someNonEmpty
THEN
WHILE
NOT done
DO
this: LORA;
theseArgs: LORA ← NIL;
done ← TRUE;
FOR al:
LIST
OF
LORA ← fargs, al.rest
WHILE al #
NIL
DO
theseArgs ← CONS[al.first.first, theseArgs];
IF al.first.rest # NIL THEN {done ← FALSE; al.first ← al.first.rest};
ENDLOOP;
this ← LIST[ApplyFn[fn, theseArgs, environment, stack]];
IF last = NIL THEN first ← this ELSE last.rest ← this;
last ← this;
ENDLOOP;
cooked ← first;
END;
EvalNth: EvalProc =
BEGIN
nr: Int ← NARROW[args.first];
lora: LORA ← NARROW[args.rest.first];
n: CARDINAL ← nr^;
FOR i:
CARDINAL
IN [1 .. n)
DO
IF (lora ← lora.rest) = NIL THEN ERROR Error[environment, stack, IO.PutFR["nth %g on list of length %g", IO.card[n], IO.card[i]]];
ENDLOOP;
cooked ← lora.first;
END;
EvalLength: EvalProc =
BEGIN
ans: INT ← 0;
arg: LORA ← NARROW[args.first];
FOR arg ← arg, arg.rest WHILE arg # NIL DO ans ← ans+1 ENDLOOP;
cooked ← NEW [INT ← ans];
END;
Setup:
PROC =
BEGIN
RegisterPrimitiveDefiner[DefineListStuff, front];
END;
Setup[];
END.