Method Operations
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
] ] ]
};
DesiredArgStructures:
PUBLIC
PROC [methodSelector:
ATOM, structure: Object]
RETURNS[
LIST
OF Object] = {
method: Method ← LookupMethodInStructure[methodSelector, structure];
IF method.desiredArgStructures =
NIL
THEN
RETURN[
NIL]
ELSE
RETURN[ method.desiredArgStructures^[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] ];
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.
ROPE, superClass: Object, methodDictionary: MethodDictionary]
RETURNS[class: Object] ~ {
RETURN[
NEW[ObjectRec ← [
flavor: Class,
name: name,
class: superClass,
data: methodDictionary
] ] ];
};
AddMethodToClass:
PUBLIC
PROC [methodSelector:
ATOM, method: Method, class: Object] = {
methodDict: Atom.PropList ← 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: Atom.PropList ← 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;
};