

<<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 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.