<> <> <<>> DIRECTORY Rope, IO, MathExpr, MathConstructors, AlgebraClasses, Structures, Variables, Sets; SetsImpl: CEDAR PROGRAM IMPORTS Rope, IO, MathConstructors, AlgebraClasses, Structures, Variables EXPORTS Sets = BEGIN OPEN AC: AlgebraClasses, VARS: Variables, Sets; <> 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; <> 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]; }; <> <> <> <> <<""Subsets of ",>> <> <<] ];>> <<};>> <<>> 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 ] }; <> FamilyOfSetsRecast: PUBLIC AC.BinaryOp = { <> 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 <> 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 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 ] ] ]; }; <> RETURN[NIL]; }; FamilyOfSetsCanRecast: PUBLIC AC.BinaryPredicate = { <> 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] ] }; <> MakeSet: PUBLIC AC.ListImbedOp ~ { <> <> < 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] ]; }; <> 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]; }; <> <> <> <> <<""Subsets of ",>> <> <<] ];>> <<};>> <<>> 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 ] }; <> SingleSetRecast: PUBLIC AC.BinaryOp = { <> 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 <> 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 = { <> 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]; <> 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 = { <> 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 = { <> 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 ~ { <> 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 ~ { <> 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 ~ { <> result _ AC.Copy[firstArg]; result.class _ secondArg; }; IsVariable: PUBLIC AC.UnaryPredicate ~ { <> 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] ]; }; <> IsElement: PUBLIC AC.BinaryPredicate ~ { <> 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 ~ { <> 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]; }; <> 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] ]; }; <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<] ] ];>> <<};>> <> <> <> <> <> <> <<};>> <<>> <> <> <> <<}; >> <<>> <> <> <> <> <> <<};>> <<>> <> familyOfSetsClass: AC.Object _ AC.MakeClass["FamilyOfSetsClass", NIL, NIL]; singleSetClass: AC.Object _ AC.MakeClass["SingleSetClass", NIL, NIL]; <> <<>> 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]; <> 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.