ASSetStructureImpl.mesa
Last Edited by: Arnon, April 28, 1987 9:22:39 am PDT
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;
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;
Structure Constructor
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];
};
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] ] ]
] ];
};
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 ]
};
Element Conversion and IO
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] ];
};
Start Code
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.