StdCorpse3.mesa
Copyright Ó 1991, 1992 by Xerox Corporation. All rights reserved.
Michael Plass, June 3, 1991 12:32 pm PDT
Spreitze, January 10, 1992 7:00 am PST
Laurie Horton, February 10, 1992 2:50 pm PST
DIRECTORY Atom, Basics, Commander, CommanderOps, Convert, ImagerState, IO, Rope;
StdCorpse3: CEDAR PROGRAM
IMPORTS Atom, Commander, CommanderOps, Convert, ImagerState
~ BEGIN
ROPE: TYPE ~ Rope.ROPE;
doc: ROPE ~ "Options:
singlet <a>
pair <a> <b>
triple <a> <b> <c>
quad <a> <b> <c> <d>
array <a0> <a1> <a2>
sequence <a0> <a1> ...
sequence2 <a0> <a1> ...
";
DebugMe: SIGNAL [ref: REF, p, w: CARD] ~ CODE;
state: ImagerState.State ¬ ImagerState.CreateState[];
ESub: TYPE ~ Basics.PartialComparison;
TagdVRT: TYPE ~ RECORD [SELECT tag: ESub FROM
greater => [i: INT],
incomparable => [c: CHAR]
ENDCASE];
BoundTagdVRT: TYPE ~ TagdVRT[greater];
tvr: TagdVRT ¬ [greater[12]];
btvr: BoundTagdVRT ¬ [greater[13]];
CmpdVRT: TYPE ~ RECORD [SELECT COMPUTED ESub FROM
greater => [i: INT],
incomparable => [c: CHAR]
ENDCASE];
BoundCmpdVRT: TYPE ~ CmpdVRT[greater];
cvr: CmpdVRT ¬ [greater[12]];
bcvr: BoundCmpdVRT ¬ [greater[13]];
OvldVRT: TYPE ~ RECORD [SELECT OVERLAID ESub FROM
greater => [i: INT],
incomparable => [c: CHAR]
ENDCASE];
BoundOvldVRT: TYPE ~ OvldVRT[greater];
ovr: OvldVRT ¬ [greater[12]];
bovr: BoundOvldVRT ¬ [greater[13]];
NestedTagdVRT: TYPE ~ RECORD [SELECT tag: ESub FROM
greater => [i: INT],
incomparable => [c: CHAR],
equal => [nest: TagdVRT],
less => [s: REF Sequence]
ENDCASE];
BoundNestedTagdVRT: TYPE ~ NestedTagdVRT[equal];
ntvr: NestedTagdVRT ¬ [equal[[greater[14]]]];
bntvr: BoundNestedTagdVRT ¬ [equal[[greater[15]]]];
bntvr2: NestedTagdVRT ¬ [less[NEW [Sequence[4]]]];
NestedCmpdVRT: TYPE ~ RECORD [SELECT COMPUTED ESub FROM
greater => [i: INT],
incomparable => [c: CHAR],
equal => [nest: CmpdVRT],
less => [s: REF Sequence]
ENDCASE];
BoundNestedCmpdVRT: TYPE ~ NestedCmpdVRT[equal];
ncvr: NestedCmpdVRT ¬ [equal[[greater[14]]]];
bncvr: BoundNestedCmpdVRT ¬ [equal[[greater[15]]]];
bncvr2: NestedCmpdVRT ¬ [less[NEW [Sequence[4]]]];
NestedOvldVRT: TYPE ~ RECORD [SELECT OVERLAID ESub FROM
greater => [i: INT],
incomparable => [c: CHAR],
equal => [nest: OvldVRT],
less => [s: REF Sequence]
ENDCASE];
BoundNestedOvldVRT: TYPE ~ NestedOvldVRT[equal];
novr: NestedOvldVRT ¬ [equal[[greater[14]]]];
bnovr: BoundNestedOvldVRT ¬ [equal[[greater[15]]]];
bnovr2: NestedOvldVRT ¬ [less[NEW [Sequence[4]]]];
Singlet: TYPE ~ MACHINE DEPENDENT RECORD [a: [0..1024)];
TestSinglet: PROC [a: CARD, si: Singlet] ~ {
s: Singlet ~ [a];
r: REF Singlet ~ NEW[Singlet ¬ s];
p: CARD ~ LOOPHOLE[r];
w: CARD ~ LOOPHOLE[s];
DebugMe[r, p, w];
};
Pair: TYPE ~ MACHINE DEPENDENT RECORD [a: [0..1024), b: [0..4096)];
TestPair: PROC [a, b: CARD, pi: Pair] ~ {
s: Pair ~ [a, b];
r: REF Pair ~ NEW[Pair ¬ s];
p: CARD ~ LOOPHOLE[r];
w: CARD ~ LOOPHOLE[s];
DebugMe[r, p, w];
};
Triple: TYPE ~ MACHINE DEPENDENT RECORD [a: [0..2**10), b: [0..2**12), c: [0..2**10)];
TestTriple: PROC [a, b, c: CARD, ti: Triple] ~ {
s: Triple ~ [a, b, c];
r: REF Triple ~ NEW[Triple ¬ s];
p: CARD ~ LOOPHOLE[r];
w: CARD ~ LOOPHOLE[s];
DebugMe[r, p, w];
};
Quad: TYPE ~ MACHINE DEPENDENT RECORD [a: [0..2**10), b: [0..2**12), c, d: [0..2**10)];
TestQuad: PROC [a, b, c, d: CARD, qi: Quad] ~ TRUSTED {
s: Quad ~ [a, b, c, d];
r: REF Quad ~ NEW[Quad ¬ s];
p: CARD ~ LOOPHOLE[r];
es: Quad ¬ s;
w: CARD ¬ LOOPHOLE[@es];
DebugMe[r, p, w];
};
Array: TYPE ~ PACKED ARRAY [0..3) OF Singlet;
TestArray: PROC [a, b, c: CARD, ai: Array] ~ {
s: Array ~ [[a], [b], [c]];
r: REF Array ~ NEW[Array ¬ s];
p: CARD ~ LOOPHOLE[r];
DebugMe[r, p, BITS[Array]];
};
Nybble: TYPE ~ MACHINE DEPENDENT RECORD [a: [0..16)];
Sequence: TYPE ~ MACHINE DEPENDENT RECORD [
PACKED SEQUENCE size: CARD16 OF Nybble
];
Sequence2: TYPE ~ MACHINE DEPENDENT RECORD [
PACKED SEQUENCE size: INT OF Nybble
];
TestSequence: PROC [n: INT, list: LIST OF CARD] ~ {
s: REF Sequence ~ NEW[Sequence[n]];
r: REF Sequence ~ s;
p: CARD ~ LOOPHOLE[r];
i: CARD16 ¬ 0;
FOR tail: LIST OF CARD ¬ list, tail.rest UNTIL tail = NIL DO
s[i] ¬ [tail.first];
i ¬ i + 1;
ENDLOOP;
DebugMe[r, p, n];
};
TestSequence2: PROC [n: INT, list: LIST OF CARD] ~ {
s: REF Sequence2 ~ NEW[Sequence2[n]];
r: REF Sequence2 ~ s;
p: CARD ~ LOOPHOLE[r];
i: CARD16 ¬ 0;
FOR tail: LIST OF CARD ¬ list, tail.rest UNTIL tail = NIL DO
s[i] ¬ [tail.first];
i ¬ i + 1;
ENDLOOP;
DebugMe[r, p, n];
};
Cmd: Commander.CommandProc ~ {
ENABLE Convert.Error => CommanderOps.Failed[cmd.procData.doc];
arg0: ROPE ¬ CommanderOps.NextArgument[cmd];
Get: PROC RETURNS [CARD] ~ { RETURN [Convert.CardFromRope[CommanderOps.NextArgument[cmd]]] };
IF arg0 = NIL THEN CommanderOps.Failed[cmd.procData.doc] ELSE {
FOR arg: ROPE ¬ arg0, CommanderOps.NextArgument[cmd] UNTIL arg = NIL DO
SELECT Atom.MakeAtom[arg] FROM
$singlet => { a: CARD ~ Get[]; TestSinglet[a, [a]] };
$pair => { a: CARD ~ Get[]; b: CARD ~ Get[]; TestPair[a, b, [a, b]] };
$triple => { a: CARD ~ Get[]; b: CARD ~ Get[]; c: CARD ~ Get[]; TestTriple[a, b, c, [a, b, c]] };
$quad => { a: CARD ~ Get[]; b: CARD ~ Get[]; c: CARD ~ Get[]; d: CARD ~ Get[]; TestQuad[a, b, c, d, [a, b, c, d]] };
$array => { a: CARD ~ Get[]; b: CARD ~ Get[]; c: CARD ~ Get[]; TestArray[a, b, c, [[a], [b], [c]]] };
$sequence => {
head: LIST OF CARD ~ LIST[0];
last: LIST OF CARD ¬ head;
n: INT ¬ 0;
FOR num: ROPE ¬ CommanderOps.NextArgument[cmd], CommanderOps.NextArgument[cmd] UNTIL num = NIL DO
last ¬ last.rest ¬ LIST[Convert.CardFromRope[num]];
n ¬ n + 1;
ENDLOOP;
TestSequence[n, head.rest];
};
$sequence2 => {
head: LIST OF CARD ~ LIST[0];
last: LIST OF CARD ¬ head;
n: INT ¬ 0;
FOR num: ROPE ¬ CommanderOps.NextArgument[cmd], CommanderOps.NextArgument[cmd] UNTIL num = NIL DO
last ¬ last.rest ¬ LIST[Convert.CardFromRope[num]];
n ¬ n + 1;
ENDLOOP;
TestSequence2[n, head.rest];
};
ENDCASE => CommanderOps.Failed[cmd.procData.doc];
ENDLOOP;
};
};
Commander.Register["CirioMachineDependentRecordsTest", Cmd, doc];
END.