CucumberImpl.Mesa
Last Edited by: Spreitzer, October 18, 1985 5:03:08 pm PDT PDT PDT PDT
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.