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, $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; 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. tMispLists.Mesa Last Edited by: Spreitzer, July 30, 1985 2:08:27 pm PDT Pavel, June 20, 1985 1:34:09 pm PDT Defun[environment, $car, EvalCar]; -- See DefineCXRs Defun[environment, $cdr, EvalCdr]; EvalCar: EvalProc = BEGIN list: LORA _ NARROW[args.first]; cooked _ list.first; END; EvalCdr: EvalProc = BEGIN list: LORA _ NARROW[args.first]; cooked _ list.rest; END; Κ =– "cedar" style˜J™™7Icode™#—J˜KšΟk œœ˜+K˜šΠbx œœ˜Kšœœ˜"Kšœ˜—K˜Kšœœ˜K˜Kšœ œœ˜!Kš œœœœ œœœ˜@K˜Kš œ œœœœœœ˜6K˜Kšœœœœ˜Kš œœœœœ˜K˜šΟnœœœœœœœ˜NKšœœ˜—K˜šŸ œœœœœœœ˜GKšœ œ˜Kšœ œ˜K˜—K˜šŸœœΟcœ˜FKš˜šŸ œœœ˜.šŸœœœ˜Kšœœ˜$Kšœœ˜'šœœœ ˜Kšœ-˜-Kšœ˜—K˜ šœ˜ Kšœ[˜[Kšœ˜Kšœœ˜—K˜—Kšœœ˜ Kšœœ˜ K˜—K˜šœœœ ˜Kšœœ˜Kšœ˜K˜—Kšœ$˜$Kšœ4™4Kšœ"™"Kšœ"œ˜)Kšœ œ˜'K˜"Kšœ$œ˜+K˜(K˜(K˜"K˜(K˜(K˜(Kšœ œœ˜$Kšœœ˜!Kšœ œœ˜$Kšœœ˜!Kšœœ˜&Kšœ!œ˜(Kšœ˜—K˜šŸœ˜Kšœœ˜Kšœœœ˜š œœ œœ˜,Kšœœœ˜šœœ˜Kšœ˜Kšœ˜Kšœœ˜—Kšœ˜—K˜ K˜—K˜šŸœ ˜Kš˜š Ÿœœœœœ˜-Kš˜Kš œ œœœœ˜4Kšœœ˜(Kšœ˜—Kš œ œœœœœ ˜0Kšœ˜—K˜šŸœ ™Kš™Kšœœœ ™ Kšœ™Kšœ™—K™šŸœ ™Kš™Kšœœœ ™ K™Kšœ™—K˜šŸ œ ˜Kš˜Kšœœœ ˜ Kšœœœ˜K˜K˜Kšœ˜—K˜šŸ œ ˜Kš˜Kšœœœ ˜ Kšœœœ˜$K˜K˜Kšœ˜—K˜šŸœ ˜Kš˜Kšœ ˜ šœœœ˜.Kšœ3œœœ˜EKšœ˜—Kšœ˜—K˜šŸœ ˜Kš˜Kšœ œ˜ šœœœ˜.Kšœ3œœœ˜EKšœ˜—Kšœ˜—K˜šŸœ ˜Kš˜Kš œœœœœœ˜.Kšœ˜—K˜šŸœ ˜Kš˜šœœœ˜.Kšœœœ ˜Kšœœœ'˜4Kšœ"œœœ œœ*œ˜|Kšœ˜—Kšœ œ˜ Kšœ˜—K˜šŸ œ ˜Kš˜Kšœœœ˜šœœœ˜.Kšœœœ ˜ K˜Kšœ˜—K˜ Kšœ˜—K˜šŸ œ ˜Kš˜Kšœ œœ˜Kš œœœœœ˜Kšœœ ˜!Kšœœœ˜$šœœœ˜3Kšœœœ ˜Kšœœ ˜Kšœœœœ˜&Kšœ˜—š œœœœ˜&Kšœœ˜ Kšœ œœ˜Kšœœ˜ š œœœœœœ˜7Kšœ œ˜,Kšœœœ œ˜EKšœ˜—Kšœœ-˜8Kšœœœœ˜6K˜ Kšœ˜—K˜Kšœ˜—K˜šŸœ ˜Kš˜Kšœ œ ˜Kšœœœ˜%Kšœœ˜šœœœ ˜Kšœœœœœ&œ œ ˜‚Kšœ˜—K˜Kšœ˜—K˜šŸ œ ˜Kš˜Kšœœ˜ Kšœœœ ˜Kš œœœœ œ˜?Kšœ œœ˜Kšœ˜—K˜šŸœœ˜ Kš˜Kšœ1˜1Kšœ˜—K˜K˜K˜Kšœ˜—…—¬]