DIRECTORY AMBridge, AMTypes, Atom, Convert, Cucumber, IO, PrintTV, Rope, SafeStorage, TypeProps;

CucumberImpl: PROGRAM
IMPORTS AMB: AMBridge, AMT: AMTypes, Atom, Convert, IO, PrintTV, Rope, SS: SafeStorage, TypeProps
EXPORTS Cucumber =

BEGIN OPEN Cucumber;

Error: PUBLIC ERROR [msg: ROPE] = CODE;

ROPE: TYPE = Rope.ROPE;
TV: TYPE = AMT.TypedVariable;
Type: TYPE = AMT.Type;

Origin: TYPE = RECORD [
whole: REF ANY,
type: Type,
handler: Handler,
path: Path,
last: Path];

all: PUBLIC SelectorList _ LIST[NIL];

Register: PUBLIC SAFE PROC [handler: Handler, type: Type] = CHECKED
BEGIN
TypeProps.Put[type: type, key: $mjsCucumber, val: handler];
END;

GetHandler: PROC [type: Type] RETURNS [handler: Handler] =
BEGIN
asAny: REF ANY _ TypeProps.Get[type: type, key: $mjsCucumber];
IF NOT ISTYPE[asAny, Handler] THEN ERROR Error["Shoe in the machine"];
handler _ NARROW[asAny];
END;

Transfer: PUBLIC PROC [what: REF ANY, where: IO.STREAM, direction: Direction] =
BEGIN
tv: TV _ AMB.TVForReferent[what];
type: Type _ AMT.TVType[tv];
handler: Handler _ GetHandler[type];
forClient: SelectorList _ NIL;
IF (IF handler = NIL THEN FALSE ELSE handler.PrepareWhole # NIL) THEN forClient _ handler.PrepareWhole[whole: what, where: where, direction: direction, data: handler.data];
TransferWork[tv, [what, type, handler, NIL, NIL], where, direction, forClient, FALSE];
IF (IF handler = NIL THEN FALSE ELSE handler.FinishWhole # NIL) THEN IF handler.FinishWhole[whole: what, where: where, direction: direction, data: handler.data] # NIL THEN ERROR;
END;

space: IO.Value _ IO.char[' ];

Fmt: PROC [type: Type] RETURNS [rope: ROPE] =
BEGIN
s: IO.STREAM _ IO.ROS[];
PrintTV.PrintType[type, s];
rope _ s.RopeFromROS[];
END;

TransferWork: PROC [tv: TV, org: Origin, where: IO.STREAM, direction: Direction, forClient: SelectorList, useClient: BOOLEAN] =
BEGIN
Claimed: PROC [sel: Selector, index: INT, tv: TV] RETURNS [claimed: BOOLEAN] =
BEGIN
IF forClient = all THEN RETURN [TRUE]
ELSE IF tv # NIL THEN
BEGIN
FOR sl: SelectorList _ forClient, sl.rest WHILE sl # NIL DO
ltv: TV;
ltype: Type;
IF ISTYPE[sl.first, ATOM] THEN LOOP;
ltv _ AMB.TVForReferent[sl.first];
ltype _ AMT.UnderType[AMT.TVType[ltv]];
IF SS.EquivalentTypes[type, ltype] AND AMT.TVEqual[tv, ltv] THEN RETURN [TRUE];
ENDLOOP;
END
ELSE IF sel = NIL OR ISTYPE[sel, REF INT] THEN
BEGIN
FOR sl: SelectorList _ forClient, sl.rest WHILE sl # NIL DO
WITH sl.first SELECT FROM
ri: REF INT => IF ri^ = index THEN RETURN [TRUE];
ENDCASE;
ENDLOOP;
END
ELSE BEGIN
FOR sl: SelectorList _ forClient, sl.rest WHILE sl # NIL DO
WITH sl.first SELECT FROM
ri: REF INT => IF ri^ = index THEN RETURN [TRUE];
a: ATOM => IF a = sel THEN RETURN [TRUE];
ENDCASE => ERROR;
ENDLOOP;
END;
claimed _ FALSE;
END;
UseClient: PROC =
BEGIN
IF org.handler = NIL THEN ERROR Error[IO.PutFR["No handler for part %g in type %g", IO.refAny[org.path], IO.rope[Fmt[org.type]]]];
org.handler.PartTransfer[whole: org.whole, part: org.path, where: where, direction: direction, data: org.handler.data];
END;
type: Type = AMT.TVType[tv];
gType: Type = AMT.GroundStar[type];
class: AMT.Class = AMT.TypeClass[gType];
IF useClient THEN UseClient[]
ELSE SELECT class FROM
cardinal, longCardinal => BEGIN
SELECT direction FROM
in => {cardAsCard^ _ where.GetCard[!SS.NarrowRefFault => ERROR Error["Not a Card"]]; AMT.Assign[tv, AMT.Coerce[cardAsTV, type]]};
out => {AMT.Assign[cardAsTV, tv]; where.Put[IO.card[cardAsCard^], space]};
ENDCASE => ERROR;
END;
integer, longInteger => BEGIN
SELECT direction FROM
in => {intAsInt^ _ where.GetInt[!SS.NarrowRefFault => ERROR Error["Not an INT"]]; AMT.Assign[tv, AMT.Coerce[intAsTV, type]]};
out => {AMT.Assign[intAsTV, tv]; where.Put[IO.int[intAsInt^], space]};
ENDCASE => ERROR;
END;
real => BEGIN
SELECT direction FROM
in => {realAsReal^ _ where.GetReal[!SS.NarrowRefFault => ERROR Error["Not a Real"]]; AMT.Assign[tv, realAsTV]};
out => {AMT.Assign[realAsTV, tv]; where.Put[IO.real[realAsReal^], space]};
ENDCASE => ERROR;
END;
rope => BEGIN
SELECT direction FROM
in => {ropeAsRope^ _ NARROW[where.GetRefAny[!SS.NarrowRefFault => ERROR Error["Not a ROPE"]]]; AMT.Assign[tv, ropeAsTV]};
out => {AMT.Assign[ropeAsTV, tv]; where.Put[IO.refAny[ropeAsRope^], space]};
ENDCASE => ERROR;
END;
enumerated => BEGIN
SELECT direction FROM
in => BEGIN
name: ROPE = where.GetTokenRope[IO.IDProc].token;
nValues: INT = AMT.NValues[gType];
index: INT _ FIRST[INT];
this: TV;
SELECT name.Fetch[0] FROM
IN ['0 .. '9] => index _ Convert.IntFromRope[name !Convert.Error => CONTINUE] + 1;
IN ['a .. 'z], IN ['A .. 'Z] => index _ AMT.NameToIndex[gType, name !AMT.Error => CONTINUE];
ENDCASE => ERROR;
IF NOT index IN [1 .. nValues] THEN ERROR Error[name.Cat[" not a member of ", Fmt[gType]]];
this _ AMT.Value[gType, index];
this _ AMT.Coerce[this, type];
AMT.Assign[tv, this];
END;
out => BEGIN
name: ROPE;
this: TV = AMT.Coerce[tv, gType];
name _ AMT.TVToName[this !
AMT.Error => {name _ Convert.RopeFromCard[AMB.TVToCardinal[this]]; CONTINUE}
];
where.Put[IO.rope[name], space];
END;
ENDCASE => ERROR;
END;
record, structure => BEGIN
nComponents: CARDINAL _ AMT.NComponents[gType];
SELECT direction FROM
in => BEGIN
char: CHARACTER;
[] _ where.SkipWhitespace[flushComments: FALSE];
IF (char _ where.GetChar[]) # '[ THEN ERROR Error[IO.PutFR["Record did not start with a bracket, but %g instead", IO.char[char]]];
WHILE TRUE DO
sel: Selector;
index: CARDINAL;
[] _ where.SkipWhitespace[flushComments: FALSE];
IF where.PeekChar[] = '] THEN {
IF where.GetChar[] # '] THEN ERROR;
EXIT};
sel _ where.GetRefAny[];
WITH sel SELECT FROM
a: ATOM => index _ AMT.NameToIndex[gType, Atom.GetPName[a]];
ri: REF INT => index _ ri^;
ENDCASE => ERROR Error[IO.PutFR["Unknown field selector %g in %g", IO.refAny[sel], IO.rope[Fmt[gType]]]];
IF index IN [1 .. nComponents] THEN
BEGIN
component: TV _ AMT.IndexToTV[tv, index];
TransferWork[component, Append[org, sel], where, in, NIL, Claimed[sel, index, NIL]];
Unappend[org];
END
ELSE ERROR Error[IO.PutFR["Unknown field %g in %g", IO.refAny[sel], IO.rope[Fmt[gType]]]];
ENDLOOP;
END;
out => BEGIN
where.PutRope["["];
FOR index: CARDINAL IN [1 .. nComponents] DO
fieldName: ROPE _ AMT.IndexToName[gType, index];
component: TV _ AMT.IndexToTV[tv, index];
sel: Selector _ IF fieldName.Length[] < 1 THEN NEW [INT _ index]
ELSE Atom.MakeAtom[fieldName];
where.PutF["%g ", IO.refAny[sel]];
TransferWork[component, Append[org, sel], where, out, NIL, Claimed[sel, index, NIL]];
Unappend[org];
ENDLOOP;
where.PutRope["] "];
END;
ENDCASE => ERROR;
END;
union => BEGIN
bound: TV = AMT.Variant[tv];
TransferWork[bound, org, where, direction, forClient, useClient];
END;
array, sequence => BEGIN
ConvertNum: PROC = {AMT.Assign[intAsTV, domAsTV]};
ConvertEnum: PROC = {sel _ AMB.SomeRefFromTV[domAsTV]};
Convert: PROC;
dom: Type _ AMT.UnderType[AMT.Domain[gType]];
domGT: Type _ AMT.GroundStar[dom];
domClass: AMT.Class _ AMT.TypeClass[domGT];
domAsTV: TV _ AMT.New[domGT];
upper: TV _ NIL;
sel: Selector;
SELECT class FROM
array => NULL;
sequence => {
altUpper: TV;
upper _ AMT.Tag[tv];
altUpper _ SELECT direction FROM
in => AMT.Copy[upper],
out => upper,
ENDCASE => ERROR;
TransferWork[altUpper, Append[org, NEW [INT _ 0]], where, direction, NIL, FALSE];
IF direction = in AND NOT AMT.TVEqual[altUpper, upper] THEN ERROR Error["sequence length changed"];
};
ENDCASE => ERROR;
SELECT domClass FROM
integer, longInteger, cardinal, longCardinal => {sel _ intAsInt; Convert _ ConvertNum};
enumerated => {Convert _ ConvertEnum};
ENDCASE => ERROR Error[IO.PutFR["Can't handle ARRAY index type %g", IO.rope[Fmt[dom]]]];
FOR index: TV _ AMT.First[dom], AMT.Next[index] WHILE (index # NIL) AND ((upper = NIL) OR NOT AMT.TVEqual[upper, index]) DO
component: TV _ AMT.Apply[tv, index];
AMT.Assign[domAsTV, index];
Convert[];
TransferWork[component, Append[org, sel], where, direction, NIL, Claimed[NIL, -1, index]];
Unappend[org];
ENDLOOP;
END;
ENDCASE => UseClient[];
END;

cardAsCard: REF LONG CARDINAL _ NEW [LONG CARDINAL];
cardAsTV: TV _ AMB.TVForReferent[cardAsCard];

intAsInt: REF INT _ NEW [INT];
intAsTV: TV _ AMB.TVForReferent[intAsInt];

realAsReal: REF REAL _ NEW [REAL];
realAsTV: TV _ AMB.TVForReferent[realAsReal];

ropeAsRope: REF ROPE _ NEW [ROPE];
ropeAsTV: TV _ AMB.TVForReferent[ropeAsRope];

Append: PROC [org: Origin, sel: Selector] RETURNS [new: Origin] =
BEGIN
final: Path _ LIST[sel];
new _ org;
IF new.last = NIL THEN new.path _ final ELSE new.last.rest _ final;
new.last _ final;
END;

Unappend: PROC [org: Origin] =
BEGIN
IF org.last # NIL THEN org.last.rest _ NIL;
END;

END.
`CucumberImpl.Mesa
Last Edited by: Spreitzer, October 18, 1985 5:03:08 pm PDT PDT PDT PDT
Κ
C˜J™Jš
œF™FIcode˜KšΟk	œ-œ(˜`K˜šΠbxœ˜Kš
œ
œœœœ˜aKšœ˜—K˜Kšœ
œ
˜K˜Kš	œœ
œœœ
˜'K˜Kšœœœ
˜Kšœœœ˜Kšœœœ˜K˜šœœœ˜Kšœœ
œ
˜K˜K˜K˜K˜—K˜Kšœœœ
œ˜%K˜š	Οnœœ
œ
œ"˜CKš
˜Kš
œ;˜;Kšœ
˜—K˜šŸ
œœœ˜:Kš
˜Kšœœ
œ0˜>Kš
œ
œ
œœ
œ˜FKšœ
œ˜Kšœ
˜—K˜šŸœœ
œœ
œ	œ
œ˜OKš
˜Kšœœœ˜!Kšœ
œ˜Kš
œ$˜$Kšœœ
˜Kšœœœ
œ
œ
œœœg˜¬
Kšœ'œœ œ˜VKšœœœ
œ
œ
œœœ
œ\œ
œ
œ
˜²
Kšœ
˜—K˜Kšœœ	œ
˜K˜šŸœœœœ˜-Kš
˜Kš	œœ
œœ
œ˜K˜K˜Kšœ
˜—K˜šŸœœœœ
œ<œ˜Kš
˜šŸœœœœœœ˜NKš
˜Kšœœ
œœ
˜%šœ
œœ
˜Kš
˜šœ'œœ
˜;Kšœœ
˜K˜Kš
œ
œœœ
œ
˜$Kšœœ˜"Kšœœœ˜'Kšœ!œ
œœ
œœ˜OKšœ
˜—Kš
˜—šœ
œœ
œ
œœ
œ˜.Kš
˜šœ'œœ
˜;šœ
œ
˜Kš
œœ
œœ
œ
œœ˜1Kšœ
˜—Kšœ
˜—Kš
˜—šœ
˜
šœ'œœ
˜;šœ
œ
˜Kš
œœ
œœ
œ
œœ˜1Kšœœœ	œ
œœ˜)Kšœœ
˜—Kšœ
˜—Kšœ
˜—Kšœ
œ
˜Kšœ
˜—šŸ	œœ˜Kš
˜Kšœœ
œ
œœ,œœ˜‚
K˜wKšœ
˜—Kšœ
œ˜Kšœœ˜#Kšœœ	œ˜(Kšœœ˜šœ
œ˜šœ˜šœ˜Kš	œ$œœœœ˜
Kšœœ!œ˜JKšœœ
˜—Kšœ
˜—šœ˜šœ˜Kš	œ!œœœœ˜}Kšœœ œ˜FKšœœ
˜—Kšœ
˜—šœ˜
šœ˜Kšœ$œœœ˜oKšœœ!œ˜JKšœœ
˜—Kšœ
˜—šœ˜
šœ˜Kš	œœœœœ˜yKšœœ!œ˜LKšœœ
˜—Kšœ
˜—šœ˜šœ˜šœ˜Kšœœœ˜1Kšœ	œœ˜"Kšœœœ
œ˜Kšœœ
˜	šœ˜KšœBœ˜RKš
œ
œœœ
œ˜\Kšœœ
˜—Kš
œ
œœœ
œ2˜[Kšœœ˜Kšœœ˜Kšœ˜Kšœ
˜—šœ˜Kšœœ
˜Kšœœœ˜!šœœ˜Kšœ'œœ
˜LKš
œ˜—Kšœ
œ˜ Kšœ
˜—Kšœœ
˜—Kšœ
˜—šœ˜Kšœ
œœ˜/šœ˜šœ˜Kšœ	œ
˜Kšœ)œ˜0Kš
œœ
œœ>œ˜‚
šœ
œ
˜
K˜Kšœœ
˜Kšœ)œ˜0šœœ˜Kšœœ
œ
˜#Kšœ˜—K˜šœœ
˜Kšœœœ&˜<Kšœœ
œ˜Kš
œœœ*œœ˜i—šœœ˜#Kš
˜Kšœœœ˜)Kšœ5œœ˜TK˜Kš
˜—Kš
œ
œœ!œœ˜ZKšœ
˜—Kšœ
˜—šœ˜K˜šœœ
œ˜,Kšœœœ˜0Kšœœœ˜)š	œœœ
œœ	˜@Kšœ˜—Kšœœ˜"Kšœ6œœ˜UK˜Kšœ
˜—K˜Kšœ
˜—Kšœœ
˜—Kšœ
˜—šœ	˜Kšœœœ
˜Kš
œA˜AKšœ
˜—šœ˜KšŸ
œœœ˜2KšŸœœ
œ˜7KšŸœœ
˜Kšœœœ˜-Kšœœ˜"Kšœ
œ	œ˜+Kšœ	œœ˜Kšœœœ
˜K˜šœ˜Kšœ	œ
˜˜
Kšœ
œ
˜
Kšœœ	˜šœœ˜ Kšœœ
˜Kš
œ
˜
Kšœœ
˜—Kš	œ#œœœœ˜QKšœœ
œ
œœ
œ"˜cK˜—Kšœœ
˜—šœ
˜Kš
œW˜WKš
œ&˜&Kšœœœ+œ˜X—šœœœ
œ
œ
œœœœ
œ
œ˜{Kšœœœ˜%Kšœ˜K˜
Kšœ<œ
œ˜ZK˜Kšœ
˜—Kšœ
˜—Kšœ˜—Kšœ
˜—K˜Kš
œœ
œ
œœœ
œ˜4Kšœ
œœ˜-K˜Kš	œ
œ
œœœ˜Kšœ	œœ˜*K˜Kš	œœ
œœœ˜"Kšœ
œœ˜-K˜Kš	œœ
œœœ˜"Kšœ
œœ˜-K˜šŸœœœ˜AKš
˜Kšœœ˜K˜
Kšœœ
œœ˜CK˜Kšœ
˜—K˜šŸœœ˜Kš
˜Kšœœ
œœ
˜+Kšœ
˜—K˜Kšœ
˜—…—!h/