AlgebraClassesImpl.mesa
Last Edited by: Arnon, June 10, 1985 4:19:22 pm PDT
DIRECTORY
Atom,
Rope,
IO,
List,
Convert,
Basics,
MathDB,
MathExpr,
AlgebraClasses;
AlgebraClassesImpl: CEDAR PROGRAM
IMPORTS Atom, Rope, List, Convert, MathDB
EXPORTS AlgebraClasses =
BEGIN
Types from Imported Interfaces
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
EXPR: TYPE ~ MathExpr.EXPR;
ObjectFlavor: TYPE ~ AlgebraClasses.ObjectFlavor;
MethodType: TYPE ~ AlgebraClasses.MethodType;
StructureElement: TYPE ~ AlgebraClasses.StructureElement;
Structure: TYPE ~ AlgebraClasses.Structure;
Category: TYPE ~ AlgebraClasses.Category;
UnaryToListOp: TYPE ~ AlgebraClasses.UnaryToListOp;
UnaryOp: TYPE ~ AlgebraClasses.UnaryOp;
LegalFirstCharOp: TYPE ~ AlgebraClasses.LegalFirstCharOp;
FromRopeOp: TYPE ~ AlgebraClasses.FromRopeOp;
ToRopeOp: TYPE ~ AlgebraClasses.ToRopeOp;
ReadOp: TYPE ~ AlgebraClasses.ReadOp;
FromEXPROp: TYPE ~ AlgebraClasses.FromEXPROp;
ToEXPROp: TYPE ~ AlgebraClasses.ToEXPROp;
TrueNullaryOp: TYPE ~ AlgebraClasses.TrueNullaryOp;
NullaryOp: TYPE ~ AlgebraClasses.NullaryOp;
BinaryOp: TYPE ~ AlgebraClasses.BinaryOp;
TernaryOp: TYPE ~ AlgebraClasses.TernaryOp;
QuaternaryOp: TYPE ~ AlgebraClasses.QuaternaryOp;
UnaryImbedOp: TYPE ~ AlgebraClasses.UnaryImbedOp;
BinaryImbedOp: TYPE ~ AlgebraClasses.BinaryImbedOp;
ListImbedOp: TYPE ~ AlgebraClasses.ListImbedOp;
MatrixImbedOp: TYPE ~ AlgebraClasses.MatrixImbedOp;
FromBOOLOp: TYPE ~ AlgebraClasses.FromBOOLOp;
FromINTOp: TYPE ~ AlgebraClasses.FromINTOp;
CompareToZeroOp: TYPE ~ AlgebraClasses.CompareToZeroOp;
BinaryCompareOp: TYPE ~ AlgebraClasses.BinaryCompareOp;
BinaryMixedOp: TYPE ~ AlgebraClasses.BinaryMixedOp;
TernaryMixedOp: TYPE ~ AlgebraClasses.TernaryMixedOp;
UnaryPredicate: TYPE ~ AlgebraClasses.UnaryPredicate;
BinaryPredicate: TYPE ~ AlgebraClasses.BinaryPredicate;
ElementRankOp: TYPE ~ AlgebraClasses.ElementRankOp;
StructuredToGroundOp: TYPE ~ AlgebraClasses.StructuredToGroundOp;
PolynomialStructureConstructor: TYPE ~ AlgebraClasses.PolynomialStructureConstructor;
Object Types
ObjectRec: PUBLIC TYPE = RECORD [
flavor: ObjectFlavor, -- 3/87 unclear this field needed; even if so, bundle into name
name: ROPE ← NIL, -- Structure => nonNIL name
class: Object ← NIL, -- StructureElement => Structure; Structure => Class; Class => Class (the superclass)
data: REF ← NIL -- StructureElement => value; Structure => instanceData; Class => Method Dictionary
];
Object: TYPE = REF ObjectRec;
Object Selectors and Constructor
Flavor: PUBLIC PROC [o: Object] RETURNS [ObjectFlavor] ~ {
RETURN[o.flavor]
};
Name: PUBLIC PROC [o: Object] RETURNS [Rope.ROPE] ~ {
RETURN[o.name]
};
Class: PUBLIC UnaryOp ~ {
SELECT arg.flavor FROM
StructureElement => RETURN[arg.class];
Structure => RETURN[Structures.Structures];
ENDCASE => ERROR;
};
Data: PUBLIC PROC [o: Object] RETURNS [REF] ~ {
RETURN[o.data]
};
MakeObject: PUBLIC PROC [flavor: ObjectFlavor, name: ROPE ← NIL, class: Object ← NIL, data: REF ← NIL] RETURNS [Object] ~ {
RETURN[NEW[ObjectRec ← [
flavor: flavor,
name: name,
class: class,
data: data
] ] ];
};
Method, Method Dictionary Types
MethodDictionary: PUBLIC TYPE = Atom.PropList;
MethodRec: PUBLIC TYPE = RECORD [
type: MethodType,
operator: BOOL ← TRUE, -- TRUE if this method is an Operator, as opposed to a Constructor. Only Operators are offered in a user menu of a Structure's methods
value: REF, -- REF proc if type # Value; should never be NIL, since confuses with absence of method. If don't care about Value, set value ← methodKey
desiredArgStructures: REF UnaryToListOp ← NIL, -- Proc[Structure -> LIST OF Structure]; if ouptut LIST contains only one Structure, then expected that all args belong to it (useful e.g. for vector and matrix constructors).
doc: ROPE -- documentation, for menus
];
Method: TYPE = REF MethodRec;
Method Selectors and Constructor
MType: PUBLIC PROC [m: Method] RETURNS [MethodType] ~ {
RETURN[m.type]
};
MOperator: PUBLIC PROC [m: Method] RETURNS [BOOL] ~ {
RETURN[m.operator]
};
MValue: PUBLIC PROC [m: Method] RETURNS [REF] ~ {
RETURN[m.value]
};
MDesiredArgStructures: PUBLIC PROC [m: Method] RETURNS [UnaryToListOp] ~ {
RETURN[m.desiredArgStructures^]
};
MDoc: PUBLIC PROC [m: Method] RETURNS [ROPE] ~ {
RETURN[m.doc]
};
MakeMethod: PUBLIC PROC [type: MethodType, operator: BOOL, value: REF, desiredArgStructures: REF UnaryToListOp, doc: ROPE] RETURNS[Method] ~ {
RETURN[ NEW[MethodRec ← [
type: type,
operator: operator,
value: value,
desiredArgStructures: desiredArgStructures,
doc: doc
] ] ]
};
Method Operations
DesiredArgStructures: PUBLIC PROC [methodSelector: ATOM, structure: Object] RETURNS[LIST OF Object] = {
method: Method ← LookupMethodInStructure[methodSelector, structure];
proc: REF UnaryToListOp ← method.desiredArgStructures;
IF proc = NIL THEN RETURN[NIL] ELSE
RETURN[ proc^[structure] ];
};
DefaultDesiredArgStructures: PUBLIC UnaryToListOp ~ {
RETURN[ LIST[arg] ]; -- arg assumed to be a Structure
};
GetMethodAndRecastArgs: PUBLIC PROC [methodSelector: ATOM, structure: Object, inArgs: LIST OF Object] RETURNS [ok: BOOL, method: Method, outArgs: LIST OF Object ← NIL] ~ {
method ← LookupMethodInStructure[methodSelector, structure];
IF method = NIL THEN RETURN[FALSE, NIL, NIL];
IF inArgs = NIL THEN RETURN[TRUE, method, NIL]; -- nothing to do if no args
[ok, outArgs] ← RecastArgs[method, structure, inArgs];
RETURN[ok, method, outArgs];
};
RecastArgs: PUBLIC PROC [method: Method, structure: Object, inArgs: LIST OF Object] RETURNS [ok: BOOL, outArgs: LIST OF Object ← NIL] ~ {
desiredArgStructures: LIST OF Object;
desiredArgStructure: Object;
recastArg, arg: Object;
outArgsPointer: LIST OF Object;
IF method = NIL THEN RETURN[FALSE, NIL];
IF inArgs = NIL THEN RETURN[TRUE, NIL]; -- nothing to do if no args
IF method.desiredArgStructures=NIL THEN RETURN[TRUE, inArgs];
Get desiredArgStructures
desiredArgStructures ← method.desiredArgStructures^[structure];
desiredArgStructure ← NIL;
Try to recast args into desiredArgStructures, if there are any
FOR l: LIST OF Object ← inArgs, l.rest WHILE l # NIL DO
IF desiredArgStructures # NIL THEN { -- retain last desiredArgStructure if no more
desiredArgStructure ← desiredArgStructures.first;
desiredArgStructures ← desiredArgStructures.rest;
};
recastArg ← arg ← l.first;
IF desiredArgStructure # NIL AND NOT StructureEqual[desiredArgStructure, arg.class] THEN { -- recast if there is some desiredArgStructure
canRecastMethod: Method ← LookupMethodInStructure[$canRecast, desiredArgStructure];
recastMethod: Method ← LookupMethodInStructure[$recast, desiredArgStructure];
IF ApplyPredNoLkpNoRecast[canRecastMethod, LIST[arg, desiredArgStructure] ] THEN
recastArg ← ApplyNoLkpNoRecastObject[recastMethod, LIST[arg, desiredArgStructure] ] -- apply canRecastMethod to arg, not arg.class, so arg is avail if needed
ELSE RETURN[FALSE, NIL]; -- recast failed
};
IF outArgs = NIL THEN outArgs ← outArgsPointer ← LIST[recastArg] ELSE outArgsPointer ← outArgsPointer.rest ← LIST[recastArg];
ENDLOOP;
RETURN[TRUE, outArgs];
};
ApplyLegalFirstCharMethod: PUBLIC PROC [method: Method, char: CHAR, structure: Object ← NIL] RETURNS[BOOL]~{
RETURN[ NARROW[method.value, REF LegalFirstCharOp]^[char, structure] ] };
ApplyFromRopeMethod: PUBLIC PROC [method: Method, in: ROPE, structure: Object ← NIL] RETURNS[Object]~{
RETURN[ NARROW[method.value, REF FromRopeOp]^[in, structure] ] };
ApplyReadMethod: PUBLIC PROC [method: Method, in: STREAM, structure: Object ← NIL] RETURNS[Object]~{
RETURN[ NARROW[method.value, REF ReadOp]^[in, structure] ] };
ApplyFromExprMethod: PUBLIC PROC [method: Method, in: EXPR, structure: Object] RETURNS[Object]~{
RETURN[ NARROW[method.value, REF FromEXPROp]^[in, structure] ] };
ApplyCompareToZeroMethod: PUBLIC PROC [method: Method, arg: Object] RETURNS[Basics.Comparison]~{
RETURN[ NARROW[method.value, REF CompareToZeroOp]^[arg] ] };
ApplyBinaryCompareMethod: PUBLIC PROC [method: Method, firstArg, secondArg: Object] RETURNS[Basics.Comparison]~{
RETURN[ NARROW[method.value, REF BinaryCompareOp]^[firstArg, secondArg] ] };
ApplyBinaryImbedMethod: PUBLIC PROC [method: Method, data1: Object, data2: REF, structure: Object] RETURNS[Object]~{
RETURN[ NARROW[method.value, REF BinaryImbedOp]^[data1, data2, structure] ] };
ApplyMixedMethod: PUBLIC PROC [method: Method, objectArgs: LIST OF Object, refArg: REF] RETURNS[Object] ~ {
SELECT method.type FROM
BinaryMixedOp => RETURN[ NARROW[method.value, REF BinaryMixedOp]^[objectArgs.first, refArg] ];
TernaryMixedOp => RETURN[NARROW[method.value, REF TernaryMixedOp]^[objectArgs.first, objectArgs.rest.first, refArg] ];
ENDCASE => ERROR;
};
ApplyPredNoLkpNoRecast: PUBLIC PROC [method: Method, argList: LIST OF Object] RETURNS[BOOL] ~ {
SELECT method.type FROM
BinaryPredicate => RETURN[ NARROW[method.value, REF BinaryPredicate]^[argList.first, argList.rest.first] ];
UnaryPredicate => RETURN[NARROW[method.value, REF UnaryPredicate]^[argList.first] ];
ENDCASE => ERROR;
};
ApplyPredNoLkpRecast: PUBLIC PROC [method: Method, structure: Object, argList: LIST OF Object] RETURNS[BOOL] ~ {
ok: BOOL;
outArgs: LIST OF Object;
[ok, outArgs] ← RecastArgs[method, structure, argList];
IF ok THEN RETURN[ApplyPredNoLkpNoRecast[method, outArgs] ] ELSE ERROR;
};
ApplyPredLkpNoRecast: PUBLIC PROC [methodSelector: ATOM, structure: Object, argList: LIST OF Object] RETURNS[BOOL] ~ {
method: Method ← LookupMethodInStructure[methodSelector, structure];
RETURN[ApplyPredNoLkpNoRecast[method, argList] ];
};
ApplyPredLkpRecast: PUBLIC PROC [methodSelector: ATOM, structure: Object, argList: LIST OF Object] RETURNS[BOOL] = {
ok: BOOL;
method: Method;
outArgs: LIST OF Object;
[ok, method, outArgs] ← GetMethodAndRecastArgs[methodSelector, structure, argList];
IF ok THEN RETURN[ApplyPredNoLkpNoRecast[method, outArgs] ] ELSE ERROR;
};
ApplyNoLkpNoRecastRef: PUBLIC PROC [method: Method, argList: LIST OF Object] RETURNS[value: REF] = {
SELECT method.type FROM
Value => RETURN[method.value];
ToRopeOp => RETURN[NARROW[method.value, REF ToRopeOp]^[argList.first] ];
ToEXPROp => RETURN[NARROW[method.value, REF ToEXPROp]^[argList.first] ];
ElementRankOp => RETURN[NEW[CARDINAL ← NARROW[method.value, REF ElementRankOp]^[argList.first] ] ]; -- Return REF CARDINAL
UnaryPredicate => RETURN[NEW[BOOL ← NARROW[method.value, REF UnaryPredicate]^[argList.first] ] ]; -- Return REF BOOL
BinaryPredicate => RETURN[NEW[BOOL ← NARROW[method.value, REF BinaryPredicate]^[argList.first, argList.rest.first] ] ]; -- Return REF BOOL
StructuredToGroundOp => RETURN[NARROW[method.value, REF StructuredToGroundOp]^[argList.first] ];
TrueNullaryOp => RETURN[NARROW[method.value, REF TrueNullaryOp]^[] ];
NullaryOp => RETURN[NARROW[method.value, REF NullaryOp]^[argList.first] ]; -- arg here expected to be a Structure
UnaryOp => RETURN[NARROW[method.value, REF UnaryOp]^[argList.first] ]; -- 6/4/87 - ??? unclear why ApplyNoLkpNoRecastRef would ever be used for method.type's like UnaryOp that return Objects. same for BinaryOp, ListImbedOp, etc.; should use ApplyNoLkpNoRecastObject
BinaryOp => RETURN[NARROW[method.value, REF BinaryOp]^[argList.first, argList.rest.first] ];
ListImbedOp => RETURN[NARROW[method.value, REF ListImbedOp]^[argList.rest, argList.first] ]; -- first Arg here is a Structure
MatrixImbedOp => RETURN[NARROW[method.value, REF MatrixImbedOp]^[argList.rest, argList.first] ]; -- first Arg here is a Structure
ENDCASE => ERROR;
};
ApplyNoLkpRecastRef: PUBLIC PROC [method: Method, structure: Object, argList: LIST OF Object] RETURNS[value: REF] ~ {
ok: BOOL;
outArgs: LIST OF Object;
[ok, outArgs] ← RecastArgs[method, structure, argList];
IF ok THEN RETURN[ApplyNoLkpNoRecastRef[method, outArgs] ] ELSE ERROR;
};
ApplyLkpNoRecastRef: PUBLIC PROC [methodSelector: ATOM, structure: Object, argList: LIST OF Object] RETURNS[value: REF] ~ {
method: Method ← LookupMethodInStructure[methodSelector, structure];
RETURN[ApplyNoLkpNoRecastRef[method, argList] ];
};
ApplyLkpRecastRef: PUBLIC PROC [methodSelector: ATOM, structure: Object, argList: LIST OF Object] RETURNS[value: REF] = {
ok: BOOL;
method: Method;
outArgs: LIST OF Object;
[ok, method, outArgs] ← GetMethodAndRecastArgs[methodSelector, structure, argList];
IF ok THEN RETURN[ApplyNoLkpNoRecastRef[method, outArgs] ] ELSE ERROR;
};
ApplyNoLkpNoRecastObject: PUBLIC PROC [method: Method, argList: LIST OF Object] RETURNS[value: Object] ~ {
SELECT method.type FROM
UnaryPredicate => {
fromBOOLMethod: Method;
structure: Object;
val: BOOL ← NARROW[method.value, REF UnaryPredicate]^[argList.first];
[fromBOOLMethod, structure] ← LookupMethodInAllStructures[$fromBOOL];
RETURN[NARROW[fromBOOLMethod.value, REF FromBOOLOp]^[val] ];
};
BinaryPredicate => {
fromBOOLMethod: Method;
structure: Object;
val: BOOL ← NARROW[method.value, REF BinaryPredicate]^[argList.first, argList.rest.first];
[fromBOOLMethod, structure] ← LookupMethodInAllStructures[$fromBOOL];
RETURN[NARROW[fromBOOLMethod.value, REF FromBOOLOp]^[val] ];
};
ElementRankOp => {
fromINTMethod: Method;
structure: Object;
val: CARDINAL ← NARROW[method.value, REF ElementRankOp]^[argList.first];
[fromINTMethod, structure] ← LookupMethodInAllStructures[$fromINT];
RETURN[NARROW[fromINTMethod.value, REF FromINTOp]^[val] ];
};
StructuredToGroundOp => RETURN[NARROW[method.value, REF StructuredToGroundOp]^[argList.first] ];
TrueNullaryOp => RETURN[NARROW[method.value, REF TrueNullaryOp]^[] ];
NullaryOp => RETURN[NARROW[method.value, REF NullaryOp]^[argList.first] ]; -- arg here expected to be a Structure
UnaryOp => RETURN[NARROW[method.value, REF UnaryOp]^[argList.first] ];
BinaryOp => RETURN[NARROW[method.value, REF BinaryOp]^[argList.first, argList.rest.first] ];
PolynomialStructureConstructor => RETURN[NARROW[method.value, REF PolynomialStructureConstructor]^[argList.first, argList.rest.first] ];
TernaryOp => RETURN[NARROW[method.value, REF TernaryOp]^[argList.first, argList.rest.first, argList.rest.rest.first] ];
QuaternaryOp => RETURN[NARROW[method.value, REF QuaternaryOp]^[argList.first, argList.rest.first, argList.rest.rest.first, argList.rest.rest.rest.first] ];
UnaryImbedOp => RETURN[NARROW[method.value, REF UnaryImbedOp]^[argList.first, argList.rest.first] ];
BinaryImbedOp => RETURN[NARROW[method.value, REF BinaryImbedOp]^[argList.first, argList.rest.first, argList.rest.rest.first] ];
ListImbedOp => RETURN[NARROW[method.value, REF ListImbedOp]^[argList.rest, argList.first] ]; -- first Arg here is a Structure
MatrixImbedOp => RETURN[NARROW[method.value, REF MatrixImbedOp]^[argList.rest, argList.first] ]; -- first Arg here is a Structure
ENDCASE => ERROR;
};
ApplyNoLkpRecastObject: PUBLIC PROC [method: Method, structure: Object, argList: LIST OF Object] RETURNS[value: Object]~ {
ok: BOOL;
outArgs: LIST OF Object;
[ok, outArgs] ← RecastArgs[method, structure, argList];
IF ok THEN RETURN[ApplyNoLkpNoRecastObject[method, outArgs] ] ELSE ERROR;
};
ApplyLkpNoRecastObject: PUBLIC PROC [methodSelector: ATOM, structure: Object, argList: LIST OF Object] RETURNS[value: Object] ~ {
method: Method ← LookupMethodInStructure[methodSelector, structure];
RETURN[ApplyNoLkpNoRecastObject[method, argList] ];
};
ApplyLkpRecastObject: PUBLIC PROC [methodSelector: ATOM, structure: Object, argList: LIST OF Object] RETURNS[value: Object] = {
ok: BOOL;
method: Method;
outArgs: LIST OF Object;
[ok, method, outArgs] ← GetMethodAndRecastArgs[methodSelector, structure, argList];
IF ok THEN RETURN[ApplyNoLkpNoRecastObject[method, outArgs] ] ELSE ERROR;
};
ApplyNoLkpNoRecastExpr: PUBLIC PROC [method: Method, argList: LIST OF Object] RETURNS[value: EXPR] ~ {
RETURN[NARROW[ApplyNoLkpNoRecastRef[method, argList] ] ];
};
ApplyLkpNoRecastExpr: PUBLIC PROC [methodSelector: ATOM, structure: Object, argList: LIST OF Object] RETURNS[value: EXPR] ~ {
method: Method ← LookupMethodInStructure[methodSelector, structure];
RETURN[NARROW[ApplyNoLkpNoRecastRef[method, argList] ] ];
};
Class Operations
MakeClass: PUBLIC PROC [name: ROPE, superClass: Object, methodDictionary: MethodDictionary ← NIL] RETURNS[class: Object] ~ {
RETURN[MakeObject[Class, name, superClass, methodDictionary] ];
};
AddMethodToClass: PUBLIC PROC [methodSelector: ATOM, method: Method, class: Object] = {
methodDict: MethodDictionary ← NARROW[class.data];
class.data ← Atom.PutPropOnList[methodDict, methodSelector, method];
};
SetSuperClass: PUBLIC PROC [object: Object, superClass: Object] = {
Sets class field of a Class, or class.class field of a Structure
class: Object ← IF object.flavor = Structure THEN object.class ELSE object;
IF object.flavor = StructureElement THEN ERROR;
class.class ← superClass;
};
LookupMethodInClass: PUBLIC PROC [methodSelector: ATOM, class: Object] RETURNS[method: Method] = {
5/3/87 - should also examine operands of $superClass methods in class and each superClass, to pick up additional superclasses (multiple inheritance)
methodDict: MethodDictionary ← NARROW[class.data];
superClass: Object ← class.class;
method ← NARROW[Atom.GetPropFromList[methodDict, methodSelector] ];
IF method # NIL THEN RETURN[method];
WHILE superClass#NIL DO
IF superClass.flavor = Structure THEN superClass ← superClass.class; -- get a Class
methodDict ← NARROW[superClass.data];
method ← NARROW[Atom.GetPropFromList[methodDict, methodSelector]];
IF method # NIL THEN RETURN[method];
superClass ← superClass.class;
ENDLOOP;
RETURN[NIL];
};
BuildClassOperators: PUBLIC PROC [class: Object] RETURNS[opNames: LIST OF ROPE, operators: LIST OF Method] = {
opNamesPtr: LIST OF ROPE ← NIL;
operatorsPtr: LIST OF Method ← NIL;
superClass: Object;
DoClass: PROC [c: Object] ~ {
FOR methodDict: MethodDictionary ← NARROW[c.data], methodDict.rest WHILE methodDict # NIL DO
method: Method ← NARROW[methodDict.first.val];
IF method.operator THEN {
IF opNames = NIL THEN opNames ← opNamesPtr ← LIST[method.doc] ELSE opNamesPtr ← opNamesPtr.rest ← LIST[method.doc];
IF operators = NIL THEN operators ← operatorsPtr ← LIST[method] ELSE operatorsPtr ← operatorsPtr.rest ← LIST[method];
};
ENDLOOP;
};
opNames ← NIL;
operators ← NIL;
DoClass[class];
superClass ← class.class;
WHILE superClass # NIL DO
IF superClass.flavor = Structure THEN superClass ← superClass.class; -- check whether superClass is a Structure or a Class; in former case, use the Structure's class. At present (3/87), former case will mean that methods that occur in two Structures will get listed twice. Maybe that's ok; user can know that the one listed first is most specific.
DoClass[superClass];
superClass ← superClass.class;
ENDLOOP;
};
Structure Operations
IsCategory: PUBLIC PROC [structure: Object, category: Category] RETURNS [BOOL] ~ {
categoryMethod: Method ← LookupMethodInStructure[$category, structure];
RETURN[NARROW[categoryMethod.value, REF Category]^ = category];
};
HasProperty: PUBLIC PROC [structure: Object, property: ATOM] RETURNS [BOOL] ~ {
RETURN[LookupMethodInStructure[property, structure] # NIL];
};
MakeStructure: PUBLIC PROC [name: Rope.ROPE, class: Object, instanceData: REF] RETURNS[structure: Object] ~ {
RETURN[NEW[ObjectRec ← [
flavor: Structure,
name: name,
class: class,
data: instanceData
] ] ];
};
StructureEqual: PUBLIC PROC [structure1, structure2: Object] RETURNS [BOOL] ~ {
RETURN[Rope.Equal[structure1.name, structure2.name] ];
};
LookupMethodInStructure: PUBLIC PROC [methodSelector: ATOM, structure: Object] RETURNS[Method] = {
RETURN[ LookupMethodInClass[methodSelector, structure.class] ];
};
LookupMethodInAllStructures: PUBLIC PROC [methodSelector: ATOM] RETURNS[method: Method, structure: Object] ~ {
FOR l: List.AList ← StructureRegistry, l.rest UNTIL l = NIL DO
structure: Object ← NARROW[l.first.val];
method: Method ← LookupMethodInStructure[methodSelector, structure ];
IF method # NIL THEN RETURN[method, structure];
ENDLOOP;
RETURN[NIL, NIL];
};
Structure Registry
StructureRegistry: List.AList ← NIL;
Global "DataBase" List
StructureNames: PUBLIC LIST OF ROPE ← NIL;
Exported DB Index
ResetStructureRegistry: PUBLIC PROC[] ~ {
effects: Resets (i.e. destroys) the global Structure DataBase
StructureRegistry ← NIL;
StructureNames ← NIL;
};
InstallStructure: PUBLIC PROC[structure: Object] ~ {
effects: Installs structure in global StructureRegistry DataBase
key: REF ANY ← Convert.AtomFromRope[structure.name];
oldVal: REF ANY ← List.Assoc[key, StructureRegistry];
StructureRegistry ← List.PutAssoc[key, structure, StructureRegistry];
IF oldVal=NIL THEN StructureNames ← CONS[structure.name, StructureNames];
};
LookupStructure: PUBLIC PROC[name: ROPE] RETURNS[structure: Object] ~ {
effects: Returns the Structure object associated with name.
returns NIL if not found
RETURN[NARROW[List.Assoc[key: Convert.AtomFromRope[name], aList: StructureRegistry] ] ];
};
KillStructure: PUBLIC PROC[name: ROPE] ~ {
effects: delete structure from global StructureRegistry DataBase, if present.
StructureRegistry ← MathDB.KillAssoc[key: Convert.AtomFromRope[name], aList: StructureRegistry];
};
Structure Element Operations
Copy: PUBLIC UnaryOp ~ {
RETURN[NEW[ObjectRec ← [
flavor: arg.flavor,
class: arg.class,
data: arg.data
] ] ];
};
Signals & Errors
badAtomClass: PUBLIC ERROR = CODE;
badCompoundClass: PUBLIC ERROR = CODE;
badMatrixClass: PUBLIC ERROR = CODE;
badExprs: PUBLIC ERROR[reason: ATOM] = CODE;
exprNotFound: PUBLIC ERROR = CODE;
wrongExprType: PUBLIC ERROR = CODE;
parseError: PUBLIC ERROR = CODE;
Start Code
ResetStructureRegistry[];
END.