DIRECTORY AMBridge USING [TVForReferent, TVToLI], AMTypes USING [Apply, Class, Error, IndexToTV, IndexToType, IsAtom, IsRope, Length, NComponents, Referent, TVEqual, TVToName, TVType, Type, TypeClass, UnderType, Variant], Atom USING [IsAnAtom], List USING [IsAList, Nconc1], RefAnyOps USING [TV], Rope USING [Equal, ROPE], RTTypesBasic USING [Type, EquivalentTypes] ; RefAnyOpsImpl: CEDAR PROGRAM IMPORTS AMBridge, AMTypes, Atom, List, Rope, RTTypesBasic EXPORTS RefAnyOps = BEGIN OPEN RefAnyOps, List; 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 ~RTTypesBasic.EquivalentTypes[AMTypes.TVType[tv1], AMTypes.TVType[tv2]] THEN RETURN[FALSE] ELSE RETURN[AMTypes.TVEqual[tv1, tv2]]; }; }; -- of EqRefs 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: RTTypesBasic.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 ~RTTypesBasic.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 ~List.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: RTTypesBasic.Type _ TVType[y]; underType: Type _ UnderType[type]; class: Class _ TypeClass[underType]; IF Test[x, y] THEN RETURN[TRUE] ELSE IF Atom.IsAnAtom[type: type, dereferenced: TRUE] THEN RETURN[FALSE] ELSE IF RTTypesBasic.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 ~List.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] = { 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. ъEdited by Teitelman on October 28, 1982 3:33 pm 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. 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. short term implementation that covers most common cases. Э╩ ╩Ц"Mesa" styleШJШJЪ╧c0Щ0JШЪ╧k Ш JЪЬ ЮЬШ'JЪЬЮЬЯШмJЪЬЮЬШJЪЬЮЬШJЪЬ ЮЬЮЬШJЪЬЮЬ ЮЬШJЪЬ ЮЬШ*JШJШЧJШJЪЬЮЬЮШJШJЪЮЬ2Ш9JШЪЮЬ ШJШЧJШJЪЮЬЮЬШШJЪЭ┐Щ┐ЧJШЪ╧nЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШAJЪЬЮЬЮЬШJЪЬЮЬЮЬШJЪЮЬЮЬЮЬЮЬШJЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ)JЪЬЮЬШJЪЬЮЬШJЪ ЮЬ ЮЬЮЬЮЬЭLШkШJЪЬЮЬШ$JЪЬЮЬШ$JЪЮЬIЮЬЮЬЮЬШ]JЪЮЬЮЬШ'JЪЮЬШЧJЪЮЬЭШJЪЭ╕Щ╕ЧJШЪЯ ЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШEJЪЮЬAШGJЪЮЬЭШЧJШЪЯЬЮЬЮЬЮЬЮЬЮЬШ5JЪЮЬ6Ш:JШJШЪЯЬЮЬЮЬЮЬЮЬЭ;ШpЪЮШJЪЮЬЮЬЮЬЮЬШJЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ)JЪЮЬ-ЮЬЮЬЮЬШCJШJШJЪЮЬШЧJЪЮЬЭШЧJШJЪЮЬ0ЮЬЮЬЮЬШDJЪЮЬЮЬЮЬЮЬЮЬЭ1ШQJЪ ЮЬЮЬЮЬЮЬЮЬШ-JЪЮЬЮЬЮЬЮЬ&ШKJЪ ЮЬЮЬЮЬЮЬЮЬШ(JШJШJШЪЮЬЮЬШJШJЪЬЮЬ&ШDJШJЪЬЮЬ&Э5ШhJШJЪЬЮЬ+Ш9JШШJЪЮЬ%ЮЬЮЬ@ЭШРJЪЮЬШJЪЮЬЭШЧJШШЪЯЬЮ ЬЮЬЮЬЮЬЮЬЮЬШ\JЪЬЮЬШЪЮЬЮЬЮЬЮШJЪЮЬ-ЮЬЮЬЮЬШBЪЮЬ ЮЬ)ЮШ