DIRECTORY
Rope,
IO,
MathExpr,
MathConstructors,
AlgebraClasses,
Structures,
Variables,
Sets;

ASSetStructureImpl: 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;
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];
};
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] ];
};
singleSetClass: AC.Object _ AC.MakeClass["SingleSetClass", NIL, NIL];

setCategoryMethod: Method _ AC.MakeMethod[Value, FALSE, NEW[AC.Category _ set], NIL, NIL];

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"];



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];



END.

όASSetStructureImpl.mesa
Last Edited by: Arnon, April 28, 1987 9:22:39 am PDT

Errors and Types
Structure Constructor
Structure Operations
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] ] ]
] ];
};

Element Conversion and IO
Args are a StructureElement and a Structure
See if firstArg is (can be recast into) an element of thisStructureUnderlyingSet; if so, do it.
Args are either [Structure, Structure] or [StructureElement, Structure]
firstArgStructure must be a SingleSetStructure, and its underlying set must be (recastable into) a subset of secondArg's underlying set.
Use method for UnderlyingSet universe
Use method for UnderlyingSet universe
Use method for UnderlyingSet universe
Use method for UnderlyingSet universe

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
check whether arg is a variable represented as an element of a SingleSetStructure
Start Code
ΚΚ˜Jš
œ™J™4J™š
Οk	˜	Jš
œ˜Icode˜K˜	K˜Kš
œ˜Kš
œ˜Kš
œ
˜
Jš
œ˜—J˜
head2šœœ
˜!Jšœœ:˜JJšœ˜J˜—Jšœ
œ
œœ˜5
head™Jš	œ
œ
œ
œœ
˜0Jš	œ
œ
œœœ
˜7Jš	œœ
œœœ
˜>Jšœœœ˜Jšœœœ˜—š
œ™šΟnœœ
œ ˜Ašœ1œ˜RKš
œ˜Kš
œ˜—šœœ˜Kšœœ
˜
Kš
œ˜Kš
œ$˜$Kš
œ˜—Kš
œ4˜4Kšœ5˜7Kš
œ
œ#œ
œ
œ˜PJšœ˜K˜——š
œ™šžœ	œ
™*Jšœœ
™/Kšœœ9™Ušœ
™Jš
œ™Jšœ
œ,œ™QJš
œ™—J™J™—šžœœ
œ
˜/Jšœœ
˜/Kšœœ<˜Ušœ
˜J˜Jšœ
œ8œ˜]Jš
œ˜—J˜J˜—šžœ	œ˜2Jšœœ
œ
œ˜.Jšœœ3œ˜CJš
œ˜J˜—šž
œ	œ˜$Jšœ/œ˜@Jšœ&˜,Jš
œ˜——š
œ™šžœœ
œ
˜'Jš
œ+™+J˜%Jšœ/œ˜MJš
œK˜KJšœ œ&˜LJšœ7œ˜ZJš
œK˜KK˜Jšœœ
˜J˜Jš	œ
œ+œ
œΟc˜WJ˜Jš
œ_™_Jšœœ7œ-Ÿ;˜¬
šœœ˜Jšœœ@œ,˜
Jšœ'ŸA˜hJšœ˜J˜
—Jšœ
œ
œ˜K˜J˜—šžœœ
œ˜1Jš
œG™GJ˜%Jšœ/œ˜MJš
œK˜KJšœ œ&˜LJšœ7œ˜ZJš
œK˜KJšœœ
˜Jšœœ$œœ
œœ
œ
œ
˜“
J˜Jš
œ
œ5œ
œ
œ˜LJ˜Jš
œˆ
™ˆ
šœ)œ˜1Jšœ3œ˜RJš
œP˜PJšœœ4œCŸ8˜Ό
Jšœ˜
K˜K˜—Kšœ
œ˜K˜J˜—šžœœ
œ
˜'Jš
œ%™%J˜$Jšœ/œ˜MJš
œK˜KJšœ œ&˜LJšœ7œ˜ZJš
œ6˜6Kšœœ,˜?Kšœ=ŸE˜‚
Kšœœ
œœ˜FJš
œ˜J˜—šžœœ
œ˜7Jš
œ%™%Jš
œ%˜%Jšœ/œ˜MJš
œK˜KJšœ œ&˜LJšœ7œ˜ZJš
œ6˜6Kšœœ4˜GKšœœ5˜?J˜J˜—šž
œœ
œ˜#Jš
œ%™%Jš
œ%˜%Jšœ/œ˜MJš
œK˜KJšœ œ&˜LJšœ7œ˜ZJš
œ6˜6Kšœœ*˜=Kšœœ(˜@KšœDŸ+˜oKšœœ
œ
œ
˜Kšœ
˜J˜J˜—šžœœ
œ˜+Jšœœ
œ˜+J˜J˜—šžœœ
œ˜(Jš
œ%™%J˜$Jšœ/œ˜MJš
œK˜KJšœ œ&˜LJšœ7œ˜ZJš
œ6˜6Kšœœ,˜?Kšœ=ŸE˜‚
Kšœœ
œœ˜FK˜J˜—šžœœ
œ˜%Jš
œ%˜%Jš
œ˜K™—šž"œœ
œ˜9J˜%Jšœ/œ˜MJš
œK˜KJšœ œ&˜LJšœ7œ˜ZJš
œ6˜6Jšœ	œ˜Jš
œ˜Kš
œ˜K˜—šž"œ	œ
˜:K™Ν
Jšœ	œ˜Jš
œ˜Kš
œ˜K˜—šž
œœ
œ˜(K™QJš
œ˜Jš
œ-˜-Jš
œ&˜&Jš
œ˜Kšœœ
œ
œ˜2Jš
œ˜Kš
œ
œ(œ
œ
œ˜AJšœœ˜5Jš
œC˜CJšœœ&˜DJšœ
œ
œ5œ
œ
œ˜QKšœ
œ˜
K˜K˜—šžœœ
œ˜*Jšœœœ˜5Jšœœ˜4Jš
œ9˜9JšœD˜JJš
œ˜——™
Kš	œœ
œœœ˜EJ˜Jš
œœœœ
œœœ˜ZJ˜Jš	œ#œœœœ˜_J˜Jšœœœœ
œœ˜dJšœœœœ
œœ˜sJ˜J˜Jšœœœœ
œ)œ˜„
Jšœœœœ
œ!œ˜kJšœœœœ
œ+œ˜‚
Jšœœœœ
œ!œ
œœ)˜Ÿ
Jšœœœœ
œ1œ˜”
Jšœœœœ
œœ
˜bJšœœœœ
œ%œ˜uJšœœœœ
œ!œ˜lJ˜Jšœœœœ
œœ˜wJš
œ!œœœ
œž"œœ˜
Jš
œ!œœœ
œž"œœ˜
J˜J˜J˜Jšœœœœ
œ&œ˜yJšœœœœ
œœ˜`Jšœœœœ
œ(œ˜wJšœœœœ
œœ
œœ)˜”
Jšœœœœ
œ.œ˜‰
Jšœ
œœœ
œœ
˜WJšœœœœ
œ"œ˜jJšœœœœ
œœ˜aJ˜Jšœ@˜BJšœQ˜SJšœG˜IJšœI˜KJšœ9˜;Jšœ?˜AJšœ9˜;JšœI˜KJšœ5˜7Jšœ=˜?Jšœ9˜;JšœA˜CJšœM˜OJšœM˜OJšœ7˜9J˜Jšœe˜gJ˜—˜J˜—Jšœ
˜J˜—…—04@ϊ