RefAnyOpsImpl.mesa
Edited by Teitelman on October 28, 1982 3:33 pm
Edited by Paul Rovner on May 13, 1983 10:36 am
DIRECTORY
AMBridge USING [TVForReferent, TVToLI],
AMList USING [IsAList],
AMTypes USING [Apply, Class, Error, IndexToTV, IndexToType, IsAtom, IsRope, Length, NComponents, Referent, TVEqual, TVToName, TVType, Type, TypeClass, UnderType, Variant], 
AMAtom USING [IsAnAtom],
List USING [Nconc1],
RefAnyOps USING [TV],
Rope USING [Equal, ROPE],
SafeStorage USING [Type, EquivalentTypes]
;
RefAnyOpsImpl: CEDAR PROGRAM
IMPORTS AMBridge, AMList, AMTypes, AMAtom, List, Rope, SafeStorage
EXPORTS RefAnyOps =
BEGIN OPEN List, RefAnyOps, SafeStorage;
EqRefs returns TRUE if x and y are both refs to the same bits, e.g. if x and y are both REF LONG INTEGER, then this says that x^ = y^. Note that x=y is true only if x and y are the same REFs.
EqRefs: PUBLIC PROC [x, y: REF ANY] RETURNS [BOOLEAN] = TRUSTED {
m: REF INTEGER;
n: REF INTEGER;
IF x = y THEN RETURN[TRUE];
IF x = NIL OR y = NIL THEN RETURN[FALSE];
m ← LOOPHOLE[x];
n ← LOOPHOLE[y];
IF m^ # n^ THEN RETURN[FALSE]; -- quick and dirty check to eliminate a lot of cases before doing extra work
{
tv1: TV ← AMBridge.TVForReferent[x];
tv2: TV ← AMBridge.TVForReferent[y];
IF ~EquivalentTypes[AMTypes.TVType[tv1], AMTypes.TVType[tv2]] THEN RETURN[FALSE]
ELSE RETURN[AMTypes.TVEqual[tv1, tv2]];
};
}; -- of EqRefs
Equalrefs returns TRUE if x and y would print identically using PrintRefAny, i.e. decomposes x and y through all of its nested refs and substructures, applying Equal to the components.
EqualRefs: PUBLIC PROC [x, y: REF ANY] RETURNS [BOOLEAN] = TRUSTED {
RETURN[EqualTVs[AMBridge.TVForReferent[x], AMBridge.TVForReferent[y]]];
}; -- of EqualTVs
EqualTVs: PUBLIC PROC [x, y: TV] RETURNS[BOOLEAN] = {
OPEN AMTypes;
type: Type = AMTypes.TVType[x];
underType: Type;
class: Class;
EqualListNodes: PROC [x, y: TV] RETURNS[BOOLEAN] = { -- x, y tvs that describe the node of a list, i.e. referent
DO
IF x = y THEN RETURN[TRUE];
IF x = NIL OR y = NIL THEN RETURN[FALSE];
IF ~EqualTVs[IndexToTV[x, 1], IndexToTV[y, 1]] THEN RETURN[FALSE];
x ← Referent[IndexToTV[x, 2]];
y ← Referent[IndexToTV[y, 2]];
ENDLOOP;
}; -- of EqualListNodes
IF ~EquivalentTypes[type, TVType[y]] THEN RETURN[FALSE]
ELSE IF x = y THEN RETURN[TRUE] -- TVEqual gives an error if both x and y are NIL
ELSE IF AMTypes.IsAtom[x] THEN RETURN[FALSE]
ELSE IF AMTypes.IsRope[x] THEN RETURN[Rope.Equal[TVToName[x], TVToName[y]]]
ELSE IF TVEqual[x, y] THEN RETURN[TRUE];
underType ← UnderType[type];
class ← TypeClass[underType];
SELECT class FROM
pointer, longPointer => RETURN[EqualTVs[Referent[x], Referent[y]]];
ref => RETURN[EqualTVs[Referent[x], Referent[y]]]; --should there be special checks for LIST OF REF ANY?
list => RETURN[EqualListNodes[Referent[x], Referent[y]]];
structure => {
IF ~AMList.IsAList[underType: underType] THEN ERROR AMTypes.Error[notImplemented, "Some Other Kind of Structure"]; -- some other kind of structure
RETURN[EqualListNodes[x, y]];
}; -- of list, structure
record => {
EqualRecords: PROCEDURE [x, y: TV, type: Type, start: NAT ← 1] RETURNS[BOOLEAN] = TRUSTED {
last: NAT = NComponents[type];
FOR i: NAT IN [start..last] DO
IF ~EqualTVs[IndexToTV[x, i], IndexToTV[y, i]] THEN RETURN[FALSE];
IF i = last AND TypeClass[IndexToType[type, i]] = union THEN
{variantx: TV ← Variant[IndexToTV[x, i]];
varianty: TV ← Variant[IndexToTV[y, i]];
RETURN[EqualRecords[variantx, varianty, TVType[variantx], i]]
}
ELSE IF i = last AND TypeClass[IndexToType[type, i]] = sequence THEN
{
sequenceTVx: TV ← IndexToTV[x, i];
sequenceTVy: TV ← IndexToTV[y, i];
length: INT ← Length[sequenceTVx];
index: REF INTEGERNEW[INTEGER ← 0]; -- will hold length
indexTV: TV ← AMBridge.TVForReferent[index];
IF length # Length[sequenceTVy] THEN RETURN[FALSE]; -- diferent lengths
FOR i: INTEGER IN [0..length) DO
index^ ← i;
IF ~EqualTVs[Apply[sequenceTVx, indexTV], Apply[sequenceTVy, indexTV]] THEN RETURN[FALSE];
ENDLOOP;
};
ENDLOOP;
RETURN[TRUE];
}; -- of EqualRecords
RETURN[EqualRecords[x, y, type]];
};
longInteger => TRUSTED {RETURN[AMBridge.TVToLI[x] = AMBridge.TVToLI[y]]};
ENDCASE;
RETURN[FALSE];
}; -- of EqualREfs
-- returns TRUE if x is contained somewhere in the components of y, using Equal as the test if useEqual is TRUE, otherwise using eq.
ContainedIn: PUBLIC PROC [x: REF ANY, y: REF ANY, useEqual: BOOLEANTRUE] RETURNS[BOOLEAN] = TRUSTED {
RETURN[ContainedInTV[AMBridge.TVForReferent[x], AMBridge.TVForReferent[y], useEqual]];
}; -- of ContainedIn
ContainedInTV: PUBLIC PROC [x, y: TV, useEqual: BOOLEANFALSE] RETURNS[BOOLEAN] = {
OPEN AMTypes;
Test: PROC [x, y: TV] RETURNS[BOOLEAN] =
{RETURN[x = y OR (IF x = NIL OR y = NIL THEN FALSE ELSE IF useEqual THEN EqualTVs[x, y] ELSE TVEqual[x, y])]
};
ContainedInListNode: PROC [x, y: TV] RETURNS[BOOLEAN] = {
-- x, y tvs that describe the node of a list, i.e. referent
DO
IF y = NIL THEN RETURN[FALSE];
IF ContainedInTV1[x, Referent[IndexToTV[y, 1]]] THEN RETURN[TRUE];
y ← Referent[IndexToTV[y, 2]];
ENDLOOP;
}; -- of ContainedInListNode
ContainedInTV1: PROC [x, y: TV] RETURNS[BOOLEAN] = {
type: Type ← TVType[y];
underType: Type ← UnderType[type];
class: Class ← TypeClass[underType];
IF Test[x, y] THEN RETURN[TRUE]
ELSE IF AMAtom.IsAnAtom[type: type, dereferenced: TRUE] THEN RETURN[FALSE]
ELSE IF EquivalentTypes[type, CODE[TEXT]] THEN RETURN[FALSE];
SELECT class FROM
pointer, longPointer => RETURN[ContainedInTV1[x, Referent[y]]];
ref => RETURN[ContainedInTV1[x, Referent[y]]];
list => RETURN[ContainedInListNode[x, Referent[y]]];
structure =>
{
IF ~AMList.IsAList[underType: underType] THEN ERROR AMTypes.Error[notImplemented, "Some Other Kind Of Structure"]; -- some other kind of structure
RETURN[ContainedInListNode[x, y]];
}; -- of structure
record =>
{
ContainedInRecord: PROCEDURE [x, y: TV, type: Type, start: NAT ← 1] RETURNS[BOOLEAN] = TRUSTED {
last: NAT = NComponents[type];
FOR i: NAT IN [start..last] DO
IF ContainedInTV1[x, IndexToTV[y, i]] THEN RETURN[TRUE];
IF i = last AND TypeClass[IndexToType[type, i]] = union THEN
{
variant: TV ← Variant[IndexToTV[y, i]];
RETURN[ContainedInRecord[x, variant, TVType[variant], i]]
}
ELSE IF i = last AND TypeClass[IndexToType[type, i]] = sequence THEN
{
sequenceTV: TV ← IndexToTV[y, i];
length: INT ← Length[sequenceTV];
index: REF INTEGERNEW[INTEGER ← 0]; -- will hold length
indexTV: TV ← AMBridge.TVForReferent[index];
IF length # Length[sequenceTV] THEN RETURN[FALSE]; -- diferent lengths
FOR i: INTEGER IN [0..length) DO
index^ ← i;
IF ContainedInTV1[x, Apply[sequenceTV, indexTV]] THEN RETURN[TRUE];
ENDLOOP;
};
ENDLOOP;
RETURN[FALSE];
}; -- of ContainedInRecord
RETURN[ContainedInRecord[x, y, type]];
};
ENDCASE;
RETURN[FALSE];
}; -- of ContainedInTV1
RETURN[ContainedInTV1[x, y]]; -- so don't have to rebind usequal at each call
}; -- of ContainedInTV
Copy: PUBLIC PROC [ref: REF ANY] RETURNS[REF ANY] = {
short term implementation that covers most common cases.
CopyList: PROC [l: LIST OF REF ANY] RETURNS[LIST OF REF ANY] = {
val: LIST OF REF ANYNIL;
FOR lst: LIST OF REF ANY ← l, lst.rest UNTIL lst = NIL DO
val ← List.Nconc1[val, Copy[lst.first]];
ENDLOOP;
RETURN[val];
};
IF ref = NIL THEN RETURN[NIL];
WITH ref SELECT FROM
l: LIST OF REF ANY => RETURN[CopyList[l]];
l: LIST OF LIST OF REF ANY => TRUSTED {RETURN[CopyList[LOOPHOLE[l, LIST OF REF ANY]]]};
a: ATOM => RETURN[a];
i: REF LONG INTEGER => RETURN[NEW[LONG INTEGER ← i^]];
r: REF REAL => RETURN[NEW[REAL ← r^]];
rope: Rope.ROPE => RETURN[rope];
ENDCASE => ERROR;
}; -- of Copy
Subst: PUBLIC PROC [new, old, expr: REF ANY] RETURNS[REF ANY] = {
Subst1: PUBLIC PROC [new, old: REF ANY, lst: LIST OF REF ANY] RETURNS[LIST OF REF ANY] = {
RETURN[CONS[Subst[new,old,lst.first], IF lst.rest = NIL THEN NIL ELSE Subst1[new,old,lst.rest]]];
}; -- of Subst1
IF EqualRefs[old, expr] THEN RETURN[new]
ELSE IF expr = NIL THEN RETURN [NIL]
ELSE WITH expr SELECT FROM
x: LIST OF REF ANY =>
RETURN[Subst1[new, old, x]];
x: ATOM => RETURN[expr];
ENDCASE => RETURN[expr];
}; -- of Subst
DSubst: PUBLIC PROC [new, old, expr: REF ANY ] RETURNS[REF ANY] = {
DSubst1: PUBLIC PROC [new,old: REF ANY, lst: LIST OF REF ANY] = {
FOR l: LIST OF REF ANY ← lst, l.rest UNTIL l=NIL DO
IF EqualRefs[l.first, old] THEN
WITH new SELECT FROM
z: LIST OF REF ANY => l.first ← Copy[z]; -- dont want the exact same structure for new to appear in several places in the resulting list
ENDCASE => l.first ← new;
WITH l.first SELECT FROM
z: LIST OF REF ANY => DSubst1[new,old,z];
ENDCASE;
ENDLOOP;
}; -- of DSubst1
IF EqualRefs[old,expr] THEN RETURN[new]
ELSE IF expr = NIL THEN RETURN [NIL]
ELSE WITH expr SELECT FROM
x: LIST OF REF ANY => {DSubst1[new,old,x]; RETURN[x]};
ENDCASE =>RETURN[expr];
}; -- of DSubst
END.
September 10, 1982 1:26 pm changes relating to AMTypes change to Length to return INT, rather than tv for Int.