ASPowerSetStructureImpl.mesa
Last Edited by: Arnon, April 28, 1987 9:22:39 am PDT
DIRECTORY
Rope,
IO,
MathExpr,
MathConstructors,
AlgebraClasses,
Structures,
Variables,
Sets;
ASPowerSetStructureImpl: CEDAR PROGRAM
IMPORTS Rope, IO, MathConstructors, AlgebraClasses, Structures, Variables
EXPORTS Sets =
BEGIN OPEN AC: AlgebraClasses, VARS: Variables, Sets;
Errors and Types
SyntaxError: PUBLIC ERROR [reason: ATOM] = CODE;
BadUniverse: PUBLIC ERROR [universe: AC.Object] = CODE;
TypeError: PUBLIC ERROR [message: ATOM ← $Unspecified] = CODE;
Method: TYPE = AC.Method;
Object: TYPE = AC.Object;
Operations for Family of Sets Structures
MakeFamilyOfSetsStructure: PUBLIC AC.SequenceStructureConstructor ~ {
familyOfSetsStructureData: FamilyOfSetsStructureData ← NEW[FamilyOfSetsStructureDataRec ← [
universe: elementStructure
] ];
sequenceStructure ← AC.MakeStructure[
name: NIL,
class: familyOfSetsClass,
instanceData: familyOfSetsStructureData
];
sequenceStructure.name ← FamilyOfSetsShortPrintName[sequenceStructure];
IF AC.LookupStructure[sequenceStructure.name] = NIL THEN AC.InstallStructure[sequenceStructure];
RETURN[sequenceStructure];
};
FamilyOfSetsPrintName: PUBLIC AC.ToRopeOp = {
data: FamilyOfSetsStructureData ← NARROW[in.data];
printNameMethod: Method ← AC.LookupMethodInStructure[$printName, data.universe];
RETURN[Rope.Concat[
""Subsets of ",
NARROW[AC.ApplyNoLkpNoRecastRef[shortPrintNameMethod,LIST[data.universe] ] ]
] ];
};
FamilyOfSetsShortPrintName: PUBLIC AC.ToRopeOp = {
data: FamilyOfSetsStructureData ← NARROW[in.data];
shortPrintNameMethod: Method ← AC.LookupMethodInStructure[$shortPrintName, data.universe];
RETURN[Rope.Cat[
"Sets(",
NARROW[AC.ApplyNoLkpNoRecastRef[shortPrintNameMethod,LIST[data.universe] ] ],
")"
] ];
};
IsFamilyOfSetsStructure: PUBLIC AC.UnaryPredicate = {
IF ~arg.flavor = Structure THEN RETURN[FALSE];
RETURN[ AC.LookupMethodInStructure[$familyOfSetsStructure, arg]#NIL ]
};
Universe: PUBLIC AC.UnaryOp = {
thisSetStructureData: FamilyOfSetsStructureData ← NARROW[arg.data];
RETURN[ thisSetStructureData.universe ]
};
Conversion and IO for Elements of Family of Sets Structures
FamilyOfSetsRecast: PUBLIC AC.BinaryOp = {
Args are a StructureElement and a Structure
thisSetStructure: Object ← secondArg;
thisSetStructureData: FamilyOfSetsStructureData ← NARROW[thisSetStructure.data];
thisStructureUniverse: Object ← thisSetStructureData.universe;
canRecastMethod: Method ← AC.LookupMethodInStructure[$canRecast, thisStructureUniverse];
recastMethod: Method ← AC.LookupMethodInStructure[$recast, thisStructureUniverse];
flag: BOOL;
IF AC.StructureEqual[firstArg.class, secondArg] THEN RETURN[firstArg]; -- nothing to do
See if can recast firstArg as an element of thisStructureUniverse
flag ← AC.ApplyPredNoLkpNoRecast[canRecastMethod, LIST[firstArg.class, thisStructureUniverse] ];
IF flag THEN {
recastElement: Object ← AC.ApplyNoLkpNoRecastObject[recastMethod, LIST[firstArg, thisStructureUniverse] ];
RETURN[ MakeSet[LIST[recastElement], thisSetStructure] ];
};
If firstArg is an element of a FamilyOfSetsStructure, see if can recast that Structure's universe into thisStructureUniverse; if so, recast (each element of) firstArg.
IF AC.LookupMethodInStructure[$familyOfSetsStructure, firstArg.class]#NIL THEN {
inputSetStructure: Object ← firstArg.class;
inputSetStructureData: FamilyOfSetsStructureData ← NARROW[inputSetStructure.data];
inputStructureUniverse: Object ← inputSetStructureData.universe;
argData: SetData ← NARROW[firstArg.data];
resultData, resultDataPtr: SetData ← NIL;
flag ← AC.ApplyPredNoLkpNoRecast[canRecastMethod,LIST[inputStructureUniverse, thisStructureUniverse] ];
IF NOT flag THEN RETURN[NIL]; -- give up
WHILE argData#NIL DO
IF resultData = NIL THEN
resultData ← resultDataPtr ← LIST[AC.ApplyNoLkpNoRecastObject[recastMethod, LIST[argData.first, thisStructureUniverse] ] ]
ELSE
resultDataPtr ← resultDataPtr.rest ← LIST[AC.ApplyNoLkpNoRecastObject[recastMethod, LIST[argData.first, thisStructureUniverse] ] ];
argData ← argData.rest
ENDLOOP;
RETURN[ NEW[AC.ObjectRec ← [
flavor: StructureElement,
class: thisSetStructure,
data: resultData
] ] ];
};
Can't do it
RETURN[NIL];
};
FamilyOfSetsCanRecast: PUBLIC AC.BinaryPredicate = {
Args are either [Structure, Structure] or [StructureElement, Structure]
thisSetStructure: Object ← secondArg;
thisSetStructureData: FamilyOfSetsStructureData ← NARROW[thisSetStructure.data];
thisStructureUniverse: Object ← thisSetStructureData.universe;
canRecastMethod: Method ← AC.LookupMethodInStructure[$canRecast, thisStructureUniverse];
flag: BOOL;
firstArgStructure: Object ← IF firstArg.flavor = StructureElement THEN firstArg.class ELSE IF firstArg.flavor = Structure THEN firstArg ELSE ERROR;
IF AC.StructureEqual[firstArgStructure, thisSetStructure] THEN RETURN[TRUE];
flag ← AC.ApplyPredNoLkpNoRecast[canRecastMethod,LIST[firstArgStructure, thisStructureUniverse] ];
IF flag THEN RETURN[TRUE];
IF AC.LookupMethodInStructure[$familyOfSetsStructure, firstArgStructure]#NIL THEN {
inputSetStructure: Object ← firstArgStructure;
inputSetStructureData: FamilyOfSetsStructureData ← NARROW[inputSetStructure.data];
inputStructureUniverse: Object ← inputSetStructureData.universe;
flag ← AC.ApplyPredNoLkpNoRecast[canRecastMethod,LIST[inputStructureUniverse, thisStructureUniverse] ];
RETURN[flag];
};
RETURN[FALSE];
};
FamilyOfSetsToExpr: PUBLIC AC.ToExprOp = {
setData: SetData ← NARROW[in.data];
setStructureData: FamilyOfSetsStructureData ← NARROW[in.class.data];
cardinality: NAT ← 0;
outColumn, outColumnPtr: LIST OF MathExpr.EXPR ← NIL;
method: Method ← AC.LookupMethodInStructure[$toExpr, setStructureData.universe];
WHILE setData # NIL DO
cardinality ← cardinality + 1;
IF outColumn = NIL THEN
outColumn ← outColumnPtr ← LIST[NARROW[AC.ApplyNoLkpNoRecastRef[method, LIST[setData.first] ] ] ]
ELSE
outColumnPtr ← outColumnPtr.rest ← LIST[NARROW[AC.ApplyNoLkpNoRecastRef[method, LIST[setData.first] ] ] ];
setData ← setData.rest;
ENDLOOP;
out ← MathConstructors.MakeSet[cardinality, outColumn, TRUE]; -- row (not column) set
};
FamilyOfSetsLegalFirstChar: PUBLIC AC.LegalFirstCharOp = {
SELECT char FROM
'{=> RETURN[TRUE];
ENDCASE;
RETURN[FALSE];
};
FamilyOfSetsRead: PUBLIC AC.ReadOp ~ {
structureData: FamilyOfSetsStructureData ← NARROW[structure.data];
universe: AC.Object ← structureData.universe;
readMethod: AC.Method ← AC.LookupMethodInStructure[$read, universe];
puncChar: CHAR;
nextElement: AC.Object;
length: NAT ← 0;
ReadFail: PUBLIC ERROR [subclass: ATOM ← $Unspecified] = CODE;
list, listTail: SetData ← NIL;
[]← in.SkipWhitespace[];
puncChar ← in.GetChar[];
[]← in.SkipWhitespace[];
IF puncChar # '{ THEN ReadFail[$LeftCurlyBracketExpected];
[]← in.SkipWhitespace[];
puncChar ← in.PeekChar[];
IF puncChar = '} THEN puncChar ← in.GetChar[];
WHILE puncChar # '} DO
nextElement ← AC.ApplyReadMethod[readMethod, in, universe];
length ← length + 1;
[]← in.SkipWhitespace[];
IF list=NIL THEN
list ← listTail ←LIST[nextElement]
ELSE
listTail ← listTail.rest ← LIST[nextElement];
puncChar ← in.GetChar[];
[]← in.SkipWhitespace[];
IF puncChar # '} THEN
IF puncChar # ', THEN ReadFail[$CommaExpected];
ENDLOOP;
out ← NEW[AC.ObjectRec ← [flavor: StructureElement, class: structure, data: list] ];
};
FamilyOfSetsFromRope: PUBLIC AC.FromRopeOp ~ {
out ← FamilyOfSetsRead[IO.RIS[in], structure];
};
FamilyOfSetsToRope: PUBLIC AC.ToRopeOp ~ {
setStructureData: FamilyOfSetsStructureData ← NARROW[in.class.data];
universe: AC.Object ← setStructureData.universe;
toRopeMethod: AC.Method ← AC.LookupMethodInStructure[$toRope, universe];
inData: SetData ← NARROW[in.data];
out ← "{ ";
WHILE inData#NIL DO
out ← Rope.Concat[out, NARROW[AC.ApplyNoLkpNoRecastRef[toRopeMethod, LIST[inData.first] ] ] ];
IF inData.rest#NIL THEN out ← Rope.Concat[out,", "];
inData ← inData.rest;
ENDLOOP;
out ← Rope.Concat[ out, " }" ];
};
FamilyOfSetsWrite: PUBLIC AC.WriteOp ~ {
stream.PutRope[ FamilyOfSetsToRope[in] ]
};
Constructor for Family of Sets Structures
MakeSet: PUBLIC AC.ListImbedOp ~ {
Currently no checks for repetitions of elements, or for proper ordering if OrderedSet.
Does check that supplied elements actually belong to universe (recasts if necessary).
data = NIL => empty set.
structureData: FamilyOfSetsStructureData ← NARROW[structure.data];
universe: AC.Object ← structureData.universe;
outData, outDataPtr: SetData ← NIL;
recastMethod: Method ← AC.LookupMethodInStructure[$recast, universe];
recastElement: Object;
WHILE data#NIL DO
recastElement ← AC.ApplyNoLkpNoRecastObject[recastMethod, LIST[data.first, universe] ];
IF recastElement = NIL THEN TypeError[];
IF outData=NIL THEN
outData ← outDataPtr ← LIST[recastElement]
ELSE
outDataPtr ← outDataPtr.rest ← LIST[recastElement];
data ← data.rest;
ENDLOOP;
out ← NEW[AC.ObjectRec ← [flavor: StructureElement, class: structure, data: outData] ];
};
Operations for Single Set Structures
MakeSingleSetStructure: PUBLIC AC.StructureFromSetConstructor ~ {
singleSetStructureData: SingleSetStructureData ← NEW[SingleSetStructureDataRec ← [
underlyingSet: set
] ];
structure ← AC.MakeStructure[
name: NIL,
class: singleSetClass,
instanceData: singleSetStructureData
];
structure.name ← SingleSetShortPrintName[structure];
AC.SetSuperClass[singleSetClass, Universe[set.class] ];
IF AC.LookupStructure[structure.name] = NIL THEN AC.InstallStructure[structure];
RETURN[structure];
};
SingleSetPrintName: PUBLIC AC.ToRopeOp = {
data: SingleSetStructureData ← NARROW[in.data];
printNameMethod: Method ← AC.LookupMethodInStructure[$printName, data.underlyingSet];
RETURN[Rope.Concat[
""Subsets of ",
NARROW[AC.ApplyNoLkpNoRecastRef[shortPrintNameMethod,LIST[data.underlyingSet] ] ]
] ];
};
SingleSetShortPrintName: PUBLIC AC.ToRopeOp = {
data: SingleSetStructureData ← NARROW[in.data];
toRopeMethod: Method ← AC.LookupMethodInStructure[$toRope, data.underlyingSet.class];
RETURN[Rope.Concat[
"SetStruct",
NARROW[AC.ApplyLkpNoRecastRef[$toRope, data.underlyingSet.class, LIST[data.underlyingSet] ] ]
] ];
};
IsSingleSetStructure: PUBLIC AC.UnaryPredicate = {
IF ~arg.flavor = Structure THEN RETURN[FALSE];
RETURN[ AC.LookupMethodInStructure[$singleSetStructure, arg]#NIL ];
};
UnderlyingSet: PUBLIC AC.UnaryOp = {
thisSetStructureData: SingleSetStructureData ← NARROW[arg.data];
RETURN[ thisSetStructureData.underlyingSet ]
};
Conversion and IO for Elements of Single Set Structures
SingleSetRecast: PUBLIC AC.BinaryOp = {
Args are a StructureElement and a Structure
thisSetStructure: Object ← secondArg;
thisSetStructureData: SingleSetStructureData ← NARROW[thisSetStructure.data];
thisSetStructureUnderlyingSet: Object ← thisSetStructureData.underlyingSet;
familyOfSetsStructure: Object ← NARROW[thisSetStructureUnderlyingSet.class];
familyOfSetsStructureData: FamilyOfSetsStructureData ← NARROW[familyOfSetsStructure.data];
familyOfSetsStructureUniverse: Object ← familyOfSetsStructureData.universe;
recastObject: Object;
flag: BOOL;
IF AC.StructureEqual[firstArg.class, secondArg] THEN RETURN[firstArg]; -- nothing to do
See if firstArg is (can be recast into) an element of thisStructureUnderlyingSet; if so, do it.
flag ← AC.ApplyPredLkpRecast[$elementOf, familyOfSetsStructure, LIST[firstArg, thisSetStructureUnderlyingSet] ]; -- apply method, instead of call IsElementOf, to get recast
IF flag THEN {
recastObject ← AC.ApplyLkpNoRecastObject[$recast, familyOfSetsStructureUniverse, LIST[firstArg, familyOfSetsStructureUniverse] ];
recastObject.class ← thisSetStructure; -- reset class field to point to this Structure; no need for copy
RETURN[recastObject]
}
ELSE RETURN[NIL];
};
SingleSetCanRecast: PUBLIC AC.BinaryPredicate = {
Args are either [Structure, Structure] or [StructureElement, Structure]
thisSetStructure: Object ← secondArg;
thisSetStructureData: SingleSetStructureData ← NARROW[thisSetStructure.data];
thisSetStructureUnderlyingSet: Object ← thisSetStructureData.underlyingSet;
familyOfSetsStructure: Object ← NARROW[thisSetStructureUnderlyingSet.class];
familyOfSetsStructureData: FamilyOfSetsStructureData ← NARROW[familyOfSetsStructure.data];
familyOfSetsStructureUniverse: Object ← familyOfSetsStructureData.universe;
flag: BOOL;
firstArgStructure: Object ← IF firstArg.flavor = StructureElement THEN firstArg.class ELSE IF firstArg.flavor = Structure THEN firstArg ELSE ERROR;
IF AC.StructureEqual[firstArgStructure, thisSetStructure] THEN RETURN[TRUE];
firstArgStructure must be a SingleSetStructure, and its underlying set must be (recastable into) a subset of secondArg's underlying set.
IF IsSingleSetStructure[firstArgStructure] THEN {
firstArgSetStructureData: SingleSetStructureData ← NARROW[firstArgStructure.data];
firstArgStructureUnderlyingSet: Object ← firstArgSetStructureData.underlyingSet;
flag ← AC.ApplyPredLkpRecast[$subset, familyOfSetsStructure, LIST[firstArgStructureUnderlyingSet, thisSetStructureUnderlyingSet] ]; -- apply method, instead of call IsSubset, to get recast
RETURN[flag];
};
RETURN[FALSE];
};
SingleSetToExpr: PUBLIC AC.ToExprOp = {
Use method for UnderlyingSet universe
thisSetStructure: Object ← in.class;
thisSetStructureData: SingleSetStructureData ← NARROW[thisSetStructure.data];
thisSetStructureUnderlyingSet: Object ← thisSetStructureData.underlyingSet;
familyOfSetsStructure: Object ← NARROW[thisSetStructureUnderlyingSet.class];
familyOfSetsStructureData: FamilyOfSetsStructureData ← NARROW[familyOfSetsStructure.data];
universe: Object ← familyOfSetsStructureData.universe;
method: Method ← AC.LookupMethodInStructure[$toExpr, universe];
convertIn: Object ← UnderlyingSetUniverseEltFromSSSElt[in]; -- need to have an element of UnderlyingSet universe to apply it to.
RETURN[ NARROW[AC.ApplyNoLkpNoRecastRef[method, LIST[convertIn] ] ] ];
};
SingleSetLegalFirstChar: PUBLIC AC.LegalFirstCharOp = {
Use method for UnderlyingSet universe
thisSetStructure: Object ← structure;
thisSetStructureData: SingleSetStructureData ← NARROW[thisSetStructure.data];
thisSetStructureUnderlyingSet: Object ← thisSetStructureData.underlyingSet;
familyOfSetsStructure: Object ← NARROW[thisSetStructureUnderlyingSet.class];
familyOfSetsStructureData: FamilyOfSetsStructureData ← NARROW[familyOfSetsStructure.data];
universe: Object ← familyOfSetsStructureData.universe;
method: Method ← AC.LookupMethodInStructure[$legalFirstChar, universe];
RETURN [AC.ApplyLegalFirstCharMethod[method, char, universe] ];
};
SingleSetRead: PUBLIC AC.ReadOp ~ {
Use method for UnderlyingSet universe
thisSetStructure: Object ← structure;
thisSetStructureData: SingleSetStructureData ← NARROW[thisSetStructure.data];
thisSetStructureUnderlyingSet: Object ← thisSetStructureData.underlyingSet;
familyOfSetsStructure: Object ← NARROW[thisSetStructureUnderlyingSet.class];
familyOfSetsStructureData: FamilyOfSetsStructureData ← NARROW[familyOfSetsStructure.data];
universe: Object ← familyOfSetsStructureData.universe;
method: Method ← AC.LookupMethodInStructure[$read, universe];
universeElt: Object ← AC.ApplyReadMethod[method, in, structure];
recastElt: Object ← SingleSetRecast[universeElt, thisSetStructure]; -- try to imbed in the Single Set Structure
IF recastElt=NIL THEN ERROR;
RETURN [recastElt];
};
SingleSetFromRope: PUBLIC AC.FromRopeOp ~ {
out ← SingleSetRead[IO.RIS[in], structure];
};
SingleSetToRope: PUBLIC AC.ToRopeOp ~ {
Use method for UnderlyingSet universe
thisSetStructure: Object ← in.class;
thisSetStructureData: SingleSetStructureData ← NARROW[thisSetStructure.data];
thisSetStructureUnderlyingSet: Object ← thisSetStructureData.underlyingSet;
familyOfSetsStructure: Object ← NARROW[thisSetStructureUnderlyingSet.class];
familyOfSetsStructureData: FamilyOfSetsStructureData ← NARROW[familyOfSetsStructure.data];
universe: Object ← familyOfSetsStructureData.universe;
method: Method ← AC.LookupMethodInStructure[$toRope, universe];
convertIn: Object ← UnderlyingSetUniverseEltFromSSSElt[in]; -- need to have an element of UnderlyingSet universe to apply it to.
RETURN[ NARROW[AC.ApplyNoLkpNoRecastRef[method, LIST[convertIn] ] ] ];
};
SingleSetWrite: PUBLIC AC.WriteOp ~ {
stream.PutRope[ SingleSetToRope[in] ]
};
UnderlyingSetUniverseEltFromSSSElt: PUBLIC AC.UnaryOp ~ {
thisSetStructure: Object ← arg.class;
thisSetStructureData: SingleSetStructureData ← NARROW[thisSetStructure.data];
thisSetStructureUnderlyingSet: Object ← thisSetStructureData.underlyingSet;
familyOfSetsStructure: Object ← NARROW[thisSetStructureUnderlyingSet.class];
familyOfSetsStructureData: FamilyOfSetsStructureData ← NARROW[familyOfSetsStructure.data];
universe: Object ← familyOfSetsStructureData.universe;
result ← AC.Copy[arg];
result.class ← universe;
};
SSSEltFromUnderlyingSetUniverseElt: PUBLIC AC.BinaryOp ~ {
secondArg is a Single Set Structure, firstArg is an element of its underlyingSet represented as an element of the underlyingSet's universe. result is (a copy of) firstArg with its class reset to secondArg
result ← AC.Copy[firstArg];
result.class ← secondArg;
};
IsVariable: PUBLIC AC.UnaryPredicate ~ {
check whether arg is a variable represented as an element of a SingleSetStructure
thisSetStructure: Object;
thisSetStructureData: SingleSetStructureData;
thisSetStructureUnderlyingSet: Object;
familyOfSetsStructure: Object;
IF arg.flavor#StructureElement THEN RETURN[FALSE];
thisSetStructure ← arg.class;
IF NOT IsSingleSetStructure[thisSetStructure] THEN RETURN[FALSE];
thisSetStructureData ← NARROW[thisSetStructure.data];
thisSetStructureUnderlyingSet ← thisSetStructureData.underlyingSet;
familyOfSetsStructure ← NARROW[thisSetStructureUnderlyingSet.class];
IF NOT AC.StructureEqual[familyOfSetsStructure, VariableSets] THEN RETURN[FALSE];
RETURN[TRUE];
};
VariableFromRope: PUBLIC AC.FromRopeOp ~ {
variable: Object ← VARS.FromRope[in, VARS.Variables];
set: Object ← MakeSet[LIST[variable], VariableSets];
singleSetStructure: Object ← MakeSingleSetStructure[set];
RETURN[SSSEltFromUnderlyingSetUniverseElt[variable, singleSetStructure] ];
};
Set Predicates
IsElement: PUBLIC AC.BinaryPredicate ~ {
firstArg is an Object, and secondArg is a Set. Returns TRUE if firstArg is an element of secondArg.
secondSetData: SetData ← NARROW[secondArg.data];
secondStructureData: FamilyOfSetsStructureData ← NARROW[secondArg.class.data];
secondUniverse: Object ← secondStructureData.universe;
elementEqualsMethod: Method ← AC.LookupMethodInStructure[$eqFormula, secondUniverse];
IF NOT AC.StructureEqual[firstArg.class, secondUniverse] THEN RETURN[FALSE]; -- if args are being recast, we don't need this check, but leave in anyway.
WHILE secondSetData#NIL DO
IF AC.ApplyPredNoLkpNoRecast[elementEqualsMethod, LIST[firstArg, secondSetData.first] ] THEN RETURN[TRUE];
secondSetData ← secondSetData.rest;
ENDLOOP;
RETURN[FALSE];
};
IsElDesiredArgStructures: AC.UnaryToListOp ~ {
structureData: FamilyOfSetsStructureData ← NARROW[arg.data];
universe: AC.Object ← structureData.universe;
RETURN[LIST[universe, arg] ];
};
IsSubset: PUBLIC AC.BinaryPredicate ~ {
firstArg and secondArg are Sets. Returns TRUE if firstArg is a subset of secondArg. Returns FALSE if args have different universes.
firstSetData: SetData ← NARROW[firstArg.data];
secondSetData: SetData ← NARROW[secondArg.data];
firstStructureData: FamilyOfSetsStructureData ← NARROW[firstArg.class.data];
secondStructureData: FamilyOfSetsStructureData ← NARROW[firstArg.class.data];
firstUniverse: Object ← firstStructureData.universe;
secondUniverse: Object ← firstStructureData.universe;
IF NOT AC.StructureEqual[firstUniverse, secondUniverse] THEN RETURN[FALSE]; -- if args are being recast, we don't need this check, but leave in anyway.
WHILE firstSetData#NIL DO
IF NOT IsElement[firstSetData.first, secondArg] THEN RETURN[FALSE];
firstSetData ← firstSetData.rest;
ENDLOOP;
RETURN[TRUE];
};
Set Operations
Cardinality: PUBLIC AC.ElementRankOp ~ {
ptr: SetData ← NARROW[arg.data];
length: CARDINAL ← 0;
WHILE ptr#NIL DO length ← length + 1; ptr ← ptr.rest ENDLOOP;
RETURN[length];
};
Equal: PUBLIC AC.BinaryPredicate ~ {
RETURN[ IsSubset[firstArg, secondArg] AND IsSubset[secondArg, firstArg] ];
};
Union: PUBLIC AC.BinaryOp ~ {
firstSetData: SetData ← NARROW[firstArg.data];
secondSetData: SetData ← NARROW[secondArg.data];
firstStructureData: FamilyOfSetsStructureData ← NARROW[firstArg.class.data];
secondStructureData: FamilyOfSetsStructureData ← NARROW[firstArg.class.data];
firstUniverse: Object ← firstStructureData.universe;
secondUniverse: Object ← firstStructureData.universe;
resultData: SetData ← secondSetData;
IF NOT AC.StructureEqual[firstUniverse, secondUniverse] THEN ERROR; -- if args are being recast, we don't need this check, but leave in anyway.
WHILE firstSetData#NIL DO
IF NOT IsElement[firstSetData.first, secondArg] THEN resultData ← CONS[firstSetData.first, resultData];
firstSetData ← firstSetData.rest;
ENDLOOP;
RETURN[MakeSet[resultData, firstArg.class] ];
};
Intersection: PUBLIC AC.BinaryOp ~ {
firstSetData: SetData ← NARROW[firstArg.data];
secondSetData: SetData ← NARROW[secondArg.data];
firstStructureData: FamilyOfSetsStructureData ← NARROW[firstArg.class.data];
secondStructureData: FamilyOfSetsStructureData ← NARROW[firstArg.class.data];
firstUniverse: Object ← firstStructureData.universe;
secondUniverse: Object ← firstStructureData.universe;
resultData: SetData ← NIL;
IF NOT AC.StructureEqual[firstUniverse, secondUniverse] THEN ERROR; -- if args are being recast, we don't need this check, but leave in anyway.
WHILE firstSetData#NIL DO
IF IsElement[firstSetData.first, secondArg] THEN resultData ← CONS[firstSetData.first, resultData];
firstSetData ← firstSetData.rest;
ENDLOOP;
RETURN[MakeSet[resultData, firstArg.class] ];
};
Difference: PUBLIC AC.BinaryOp ~ {
firstSetData: SetData ← NARROW[firstArg.data];
secondSetData: SetData ← NARROW[secondArg.data];
firstStructureData: FamilyOfSetsStructureData ← NARROW[firstArg.class.data];
secondStructureData: FamilyOfSetsStructureData ← NARROW[firstArg.class.data];
firstUniverse: Object ← firstStructureData.universe;
secondUniverse: Object ← firstStructureData.universe;
resultData: SetData ← NIL;
IF NOT AC.StructureEqual[firstUniverse, secondUniverse] THEN ERROR; -- if args are being recast, we don't need this check, but leave in anyway.
WHILE firstSetData#NIL DO
IF NOT IsElement[firstSetData.first, secondArg] THEN resultData ← CONS[firstSetData.first, resultData];
firstSetData ← firstSetData.rest;
ENDLOOP;
RETURN[MakeSet[resultData, firstArg.class] ];
};
MapUnaryElementOp: PUBLIC AC.BinaryMixedOp ~ {
firstArg is a Set, secondArg is REF to UnaryOp on its universe
seqData: SetData ← NARROW[firstArg.data];
refOp: REF AC.UnaryOp ← NARROW[secondArg];
newUniverse, newSeqStructure: AC.Object ← NIL;
newData: SetData ← NEW[SetDataRec[seqData.lengthPlus1-1] ];
FOR i:INT IN [1..seqData.lengthPlus1) DO
newData[i] ← refOp^[seqData[i]];
IF newData[i]# NIL THEN newUniverse ← newData[i].class;
ENDLOOP;
IF newUniverse = NIL THEN RETURN[NIL];
newSeqStructure ← MakeSetStructure[newUniverse];
RETURN[ NEW[AC.ObjectRec ← [
flavor: StructureElement,
class: newSeqStructure,
data: newData
] ] ];
};
Set Selection (OrderedSets only)
Select: PUBLIC AC.BinaryOp ~ {
firstData: SetData ← NARROW[firstArg.data];
index: INT ← Ints.ToINT[secondArg];
IF index<1 OR firstData.lengthPlus1-1<index THEN RETURN[NIL];
RETURN[firstData[index] ];
};
First: PUBLIC AC.UnaryOp ~ {
firstArg = Set, return first element. Return NIL if empty.
RETURN[ Select[arg, Ints.FromINT[1] ] ];
};
Last: PUBLIC AC.UnaryOp ~ {
firstArg = Set, return last element. Return NIL if empty.
firstData: SetData ← NARROW[arg.data];
IF firstData.lengthPlus1-1=0 THEN RETURN[NIL];
RETURN[firstData[firstData.lengthPlus1-1] ];
};
Start Code
familyOfSetsClass: AC.Object ← AC.MakeClass["FamilyOfSetsClass", NIL, NIL];
singleSetClass: AC.Object ← AC.MakeClass["SingleSetClass", NIL, NIL];
Kludge up special subclass for VariableSets, containing special evaluation for variables
VariableSets: PUBLIC AC.Object ← MakeFamilyOfSetsStructure[VARS.Variables]; -- this is initialization only; n.b. must be done after familyOfSetsClass initialized, so that gets it as non-NIL class, so that class pointer in variableSetsClass points to something non-NIL as superclass.
variableMethod: Method ← AC.MakeMethod[FromRopeOp, FALSE, NEW[AC.FromRopeOp ← VariableFromRope], NIL, "variable"];
variableSetsClass: AC.Object ← AC.MakeClass["variableSetsClass", VariableSets.class, NIL];
setCategoryMethod: Method ← AC.MakeMethod[Value, FALSE, NEW[AC.Category ← set], NIL, NIL];
familyOfSetsStructureMethod: Method ← AC.MakeMethod[Value, FALSE, NIL, NIL, "familyOfSetsStructure"];
singleSetStructureMethod: Method ← AC.MakeMethod[Value, FALSE, NIL, NIL, "singleSetStructure"];
universeMethod: Method ← AC.MakeMethod[UnaryOp, FALSE, NEW[AC.UnaryOp ← Universe], NIL, "universe"];
underlyingSetMethod: Method ← AC.MakeMethod[UnaryOp, FALSE, NEW[AC.UnaryOp ← UnderlyingSet], NIL, "underlyingSet"];
shortPrintNameMethod: Method ← AC.MakeMethod[ToRopeOp, FALSE, NEW[AC.ToRopeOp ← FamilyOfSetsShortPrintName], NIL, "shortPrintName"];
recastMethod: Method ← AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp ← FamilyOfSetsRecast], NIL, "recast"];
canRecastMethod: Method ← AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate ← FamilyOfSetsCanRecast], NIL, "canRecast"];
toExprMethod: Method ← AC.MakeMethod[ToExprOp, FALSE, NEW[AC.ToExprOp ← FamilyOfSetsToExpr], NEW[AC.UnaryToListOp ← AC.DefaultDesiredArgStructures], "toExpr"];
legalFirstCharMethod: Method ← AC.MakeMethod[LegalFirstCharOp, FALSE, NEW[AC.LegalFirstCharOp ← FamilyOfSetsLegalFirstChar], NIL, "legalFirstChar"];
readMethod: Method ← AC.MakeMethod[ReadOp, FALSE, NEW[AC.ReadOp ← FamilyOfSetsRead], NIL, "read"];
fromRopeMethod: Method ← AC.MakeMethod[FromRopeOp, TRUE, NEW[AC.FromRopeOp ← FamilyOfSetsFromRope], NIL, "fromRope"];
toRopeMethod: Method ← AC.MakeMethod[ToRopeOp, FALSE, NEW[AC.ToRopeOp ← FamilyOfSetsToRope], NIL, "toRope"];
isVariableMethod: Method ← AC.MakeMethod[UnaryPredicate, TRUE, NEW[AC.UnaryPredicate ← IsVariable], NIL, "isVarInSSS"];
USUEltFromSSSEltMethod: Method ← AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp ← UnderlyingSetUniverseEltFromSSSElt], NIL, "USUEltFromSSSElt"];
SSSEltFromUSUEltMethod: Method ← AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp ← SSSEltFromUnderlyingSetUniverseElt], NIL, "SSSEltFromUSUElt"];
parenMethod: Method ← AC.MakeMethod[UnaryOp, FALSE, NEW[AC.UnaryOp ← AC.Copy], NIL, "paren"];
setMethod: Method ← AC.MakeMethod[ListImbedOp, FALSE, NEW[AC.ListImbedOp ← MakeSet], NIL, "set"];
elementOfMethod: Method ← AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate ← IsElement], NEW[AC.UnaryToListOp ← IsElDesiredArgStructures], "elementOf"];
subsetMethod: Method ← AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate ← IsSubset], NEW[AC.UnaryToListOp ← AC.DefaultDesiredArgStructures], "subset"];
cardinalityMethod: Method ← AC.MakeMethod[ElementRankOp, TRUE, NEW[AC.ElementRankOp ← Cardinality], NEW[AC.UnaryToListOp ← AC.DefaultDesiredArgStructures], "cardinality"];
equalMethod: Method ← AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate ← Equal], NEW[AC.UnaryToListOp ← AC.DefaultDesiredArgStructures], "equals"];
unionMethod: Method ← AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp ← Union], NIL, "union"];
intersectionMethod: Method ← AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp ← Intersection], NIL, "intersection"];
differenceMethod: Method ← AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp ← Difference], NIL, "difference"];
makeSingleSetStructureMethod: Method ← AC.MakeMethod[StructureFromSetConstructor, FALSE, NEW[AC.StructureFromSetConstructor ← MakeSingleSetStructure], NIL, "makeSingleSetStructure"];
makeFamilyOfSetsStructureMethod: Method ← AC.MakeMethod[SequenceStructureConstructor, FALSE, NEW[AC.SequenceStructureConstructor ← MakeFamilyOfSetsStructure], NIL, "makeFamilyOfSetsStructure"];
AC.AddMethodToClass[$category, setCategoryMethod, familyOfSetsClass];
AC.AddMethodToClass[$familyOfSetsStructure, familyOfSetsStructureMethod, familyOfSetsClass];
AC.AddMethodToClass[$universe, universeMethod, familyOfSetsClass];
AC.AddMethodToClass[$shortPrintName, shortPrintNameMethod, familyOfSetsClass];
AC.AddMethodToClass[$recast, recastMethod, familyOfSetsClass];
AC.AddMethodToClass[$canRecast, canRecastMethod, familyOfSetsClass];
AC.AddMethodToClass[$toExpr, toExprMethod, familyOfSetsClass];
AC.AddMethodToClass[$legalFirstChar, legalFirstCharMethod, familyOfSetsClass];
AC.AddMethodToClass[$read, readMethod, familyOfSetsClass];
AC.AddMethodToClass[$fromRope, fromRopeMethod, familyOfSetsClass];
AC.AddMethodToClass[$toRope, toRopeMethod, familyOfSetsClass];
AC.AddMethodToClass[$paren, parenMethod, familyOfSetsClass];
AC.AddMethodToClass[$set, setMethod, familyOfSetsClass];
AC.AddMethodToClass[$elementOf, elementOfMethod, familyOfSetsClass];
AC.AddMethodToClass[$subset, subsetMethod, familyOfSetsClass];
AC.AddMethodToClass[$cardinality, cardinalityMethod, familyOfSetsClass];
AC.AddMethodToClass[$eqFormula, equalMethod, familyOfSetsClass];
AC.AddMethodToClass[$union, unionMethod, familyOfSetsClass];
AC.AddMethodToClass[$intersect, intersectionMethod, familyOfSetsClass];
AC.AddMethodToClass[$difference, differenceMethod, familyOfSetsClass];
AC.AddMethodToClass[$makeFamilyOfSetsStructure, makeFamilyOfSetsStructureMethod, Structures.StructuresClass];
shortPrintNameMethod ← AC.MakeMethod[ToRopeOp, FALSE, NEW[AC.ToRopeOp ← SingleSetShortPrintName], NIL, "shortPrintName"];
recastMethod ← AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp ← SingleSetRecast], NIL, "recast"];
canRecastMethod ← AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate ← SingleSetCanRecast], NIL, "canRecast"];
toExprMethod ← AC.MakeMethod[ToExprOp, FALSE, NEW[AC.ToExprOp ← SingleSetToExpr], NEW[AC.UnaryToListOp ← AC.DefaultDesiredArgStructures], "toExpr"];
legalFirstCharMethod ← AC.MakeMethod[LegalFirstCharOp, FALSE, NEW[AC.LegalFirstCharOp ← SingleSetLegalFirstChar], NIL, "legalFirstChar"];
readMethod ← AC.MakeMethod[ReadOp, FALSE, NEW[AC.ReadOp ← SingleSetRead], NIL, "read"];
fromRopeMethod ← AC.MakeMethod[FromRopeOp, TRUE, NEW[AC.FromRopeOp ← SingleSetFromRope], NIL, "fromRope"];
toRopeMethod ← AC.MakeMethod[ToRopeOp, FALSE, NEW[AC.ToRopeOp ← SingleSetToRope], NIL, "toRope"];
AC.AddMethodToClass[$category, setCategoryMethod, singleSetClass];
AC.AddMethodToClass[$singleSetStructure, singleSetStructureMethod, singleSetClass];
AC.AddMethodToClass[$underlyingSet, underlyingSetMethod, singleSetClass];
AC.AddMethodToClass[$shortPrintName, shortPrintNameMethod, singleSetClass];
AC.AddMethodToClass[$recast, recastMethod, singleSetClass];
AC.AddMethodToClass[$canRecast, canRecastMethod, singleSetClass];
AC.AddMethodToClass[$toExpr, toExprMethod, singleSetClass];
AC.AddMethodToClass[$legalFirstChar, legalFirstCharMethod, singleSetClass];
AC.AddMethodToClass[$read, readMethod, singleSetClass];
AC.AddMethodToClass[$fromRope, fromRopeMethod, singleSetClass];
AC.AddMethodToClass[$toRope, toRopeMethod, singleSetClass];
AC.AddMethodToClass[$isVarInSSS, isVariableMethod, singleSetClass];
AC.AddMethodToClass[$USUEltFromSSSElt, USUEltFromSSSEltMethod, singleSetClass];
AC.AddMethodToClass[$SSSEltFromUSUElt, SSSEltFromUSUEltMethod, singleSetClass];
AC.AddMethodToClass[$paren, parenMethod, singleSetClass];
AC.AddMethodToClass[$makeSingleSetStructure, makeSingleSetStructureMethod, Structures.StructuresClass];
Start Code for Public Structure
AC.AddMethodToClass[$variable, variableMethod, variableSetsClass];
VariableSets.class ← variableSetsClass;
AC.InstallStructure[VariableSets]; -- update value of VariableSets installed by MakeFamilyOfSetsStructure; now its class is not just the standard one, but a subclass containing variableMethod.
END.