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
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 INTEGER ← NEW[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:
BOOLEAN ←
TRUE]
RETURNS[
BOOLEAN] =
TRUSTED {
RETURN[ContainedInTV[AMBridge.TVForReferent[x], AMBridge.TVForReferent[y], useEqual]];
}; -- of ContainedIn
ContainedInTV:
PUBLIC
PROC [x, y:
TV, useEqual:
BOOLEAN ←
FALSE]
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 INTEGER ← NEW[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
ANY ←
NIL;
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.