A new Python - inspired implementation of an object-oriented extension for Mathematica language, which enables creation of garbage-collectable objects
BeginPackage["OO`"] | |
new | |
EndPackage[] | |
BeginPackage["OO`Core`", "RuleBasedFunction`"] | |
TypeQ; | |
ObjectQ; | |
Type; | |
SuperType; | |
SubTypeQ; | |
Object; | |
Constructor; | |
New; | |
Super; | |
Extends; | |
GetMethod; | |
Fields; | |
Methods; | |
DeclareType; | |
def; | |
fulleval; | |
Begin["`Private`"] | |
ClearAll[$types, addType, removeType]; | |
$types = <||>; | |
addType[type_Symbol]:= $types[type] = True; | |
removeType[type_Symbol]:=KeyDropFrom[$types, type]; | |
ClearAll[msgFail]; | |
SetAttributes[msgFail, HoldFirst]; | |
msgFail[msgname_, args___]:= (Message[msgname, args];$Failed); | |
ClearAll[Raise, Error]; | |
Raise[f_, args___]:=Throw[$Failed, Error[f, {args}]]; | |
ClearAll[TypeQ, ObjectQ]; | |
TypeQ[t_Symbol]:=KeyExistsQ[$types, t]; | |
ObjectQ[t_?TypeQ[o_Symbol]]:=True; | |
ObjectQ[_]:=False; | |
ClearAll[Type]; | |
Type::noatt = "The type `1` has no attribute `2`"; | |
Type[t_[obj_]]:=obj[Type]; | |
ClearAll[SuperType]; | |
SuperType[Object]=Object; | |
SuperType[_?TypeQ] = Object; | |
SuperType[arg_]:= Raise[SuperType, arg]; | |
ClearAll[SubTypeQ]; | |
SetAttributes[SubTypeQ, HoldAll]; | |
SubTypeQ[type_, Object] = True; | |
SubTypeQ[type_, type_]:=True; | |
SubTypeQ[Object, type_]:=False; | |
SubTypeQ[sub_, type_]:= SubTypeQ[Evaluate[SuperType[sub]], type]; | |
SubTypeQ[type_]:=Function[sub, SubTypeQ[sub, type], HoldAll]; | |
ClearAll[Object]; | |
SetAttributes[Object, HoldAll]; | |
Object::noatt = "The object `1` has no attribute `2`"; | |
Object::nomethod = "The object `1` has no method with the name `2` and matching signature"; | |
Object::badargs = "Wrong number / type of arguments `1` for method `2` of object `3`"; | |
Object[obj_][f_[___]]:= msgFail[Object::nomethod, obj[Type][obj], f]; | |
addType[Object]; | |
ClearAll[Constructor]; | |
Constructor[Object] = Identity; (* This is always the last step on the way "up", in constructor chain *) | |
ClearAll[New]; | |
New[Super, self_, args___]:= New[SuperType[Type[self]],self, args]; | |
New[args___]:= Raise[New, args]; | |
ClearAll[Super]; | |
Super[type_[obj_]]:=SuperType[type][obj]; (* It is really that simple *) | |
ClearAll[GetMethod]; | |
GetMethod[_Object, _]:=$Failed; | |
GetMethod[obj: type_[o_], methodName_]:= | |
With[{key = {type, methodName}}, | |
If[KeyExistsQ[o, key], | |
o[key], | |
(* else *) | |
GetMethod[Super[obj], methodName] | |
] | |
]; | |
ClearAll[Fields]; | |
Fields[type_[obj_]]:= | |
Keys @ KeyDrop[Type] @ KeySelect[Head[#] === Symbol&] @ obj; | |
ClearAll[Methods]; | |
Methods[o:type_[obj_]]:= | |
With[{ | |
methodNames = Composition[ | |
DeleteDuplicates, | |
Last, | |
Transpose, | |
Keys, | |
KeySelect[MatchQ[{_,Except["Private"]}]] | |
] @ obj | |
}, | |
AssociationMap[GetMethod[o, #]&, methodNames] | |
]; | |
ClearAll[makeRawObject]; | |
makeRawObject[type_]:= | |
Module[{obj}, | |
obj = <|Type -> type|>; | |
type[obj] | |
]; | |
ClearAll[DeclareType]; | |
DeclareType[type_Symbol]:= | |
Function[ | |
code | |
, | |
defineTypeSymbol[type]; | |
Constructor[type] = defineConstructorCode[type, code]; | |
New[type, self_?ObjectQ, args___]:=Constructor[type][self, args]; | |
New[type, args___]:= New[type, makeRawObject[type], args]; | |
addType[type]; | |
type | |
, | |
HoldAll | |
]; | |
DeclareType[type_Symbol ~ Extends ~ superType_Symbol?TypeQ]:= | |
Module[{}, | |
SuperType[type] = superType; | |
DeclareType[type] | |
]; | |
ClearAll[defineTypeSymbol]; | |
defineTypeSymbol[t_Symbol]:= | |
Module[{}, | |
ClearAll[t]; | |
SetAttributes[t, HoldAll]; | |
(* Method calls *) | |
(self:t[obj_])[f_[args___]] /; KeyExistsQ[obj, {t, f}] := | |
obj[{t,f}][self, args]; | |
t[obj_][fcall:_[___]]:=SuperType[t][obj][fcall]; | |
(* Field lookup *) | |
t[obj_][field_] /; KeyExistsQ[obj, field] := obj[field]; | |
(self:t[obj_])[field_]:= msgFail[Object::noatt, self, field]; | |
(* Setting fields and methods *) | |
t /: Set[t[obj_][field_], rhs_Function]:= | |
obj[{t, field}] = rhs; | |
t /: Set[t[obj_][field_], rhs_]:= obj[field] = rhs; | |
(* Return back the symbol *) | |
Return[t] | |
]; | |
(* NOTE: does not support conditional defs, unless condition is on the right *) | |
ClearAll[def]; | |
def /: (h:(Set | SetDelayed))[def[fulleval[lhs_]], rhs_]:= defSpecial[h, lhs, rhs, Normal]; | |
def /: (h:(Set | SetDelayed))[def[lhs_], rhs_]:= defSpecial[h, lhs, rhs]; | |
ClearAll[defSpecial]; | |
SetAttributes[defSpecial, HoldRest]; | |
defSpecial[h_, f_[args___], rhs_, ftype_:None]:= | |
AppendTo[$methodDefContainer, {f, h, Hold[f[args]], Hold[rhs], ftype}]; | |
defSpecial[h_, field_, rhs_]:= | |
AppendTo[$fieldDefContainer, {h, Hold[field], Hold[rhs]}]; | |
ClearAll[varRegisteringModule]; | |
SetAttributes[varRegisteringModule, HoldAll]; | |
varRegisteringModule[vars_, body_]:= | |
Module[{getVars, strvars}, | |
SetAttributes[getVars, {HoldAll, Listable}]; | |
getVars[Set[v_Symbol, rhs_]]:=Hold[v]; | |
getVars[v_Symbol]:=Hold[v]; | |
(* String names for private variables *) | |
strvars = Function[v, ToString[Unevaluated[v]], {HoldAll, Listable}][vars]; | |
Module[vars, | |
$privateVarContainer = AssociationThread[strvars, getVars[vars]]; | |
body | |
] | |
]; | |
ClearAll[defineConstructorCode]; | |
SetAttributes[defineConstructorCode, HoldRest]; | |
defineConstructorCode[type_Symbol, Module[args__]]:= | |
defineConstructorCode[type, varRegisteringModule[args]]; | |
defineConstructorCode[type_Symbol, code_]:= | |
Function[Null, | |
With[{self = #1, args = ##2}, | |
(* | |
Print["In constructor for the type ", type]; | |
Print["Self now: ", self]; | |
*) | |
Module[{privateQ, callableQ, call}, | |
Replace[ | |
self, { | |
t_?(SubTypeQ[type])[o_] :> Module[{}, | |
callableQ[key_]:= KeyExistsQ[o, key]; | |
call[key_, args___]:= o[key][args] | |
], | |
_ :> Return[$Failed, Module] | |
} | |
]; | |
Block[{$methodDefContainer = {}, $fieldDefContainer = {}, $privateVarContainer=<||>}, | |
code; | |
With[{prassoc = Association @ Thread[Values[$privateVarContainer] -> True]}, | |
privateQ = Function[var, Lookup[prassoc, var, False]] | |
]; | |
bindFields[self, type, $fieldDefContainer]; | |
bindPrivateFields[self, type, $privateVarContainer]; | |
bindMethods[self, type, $methodDefContainer, privateQ]; | |
(* | |
Print["Current keys: ", Keys[First@self]]; | |
Print["Self - before calling the supertype constructor: ", self]; | |
*) | |
If[callableQ[{type, OO`new}], | |
(* It is assumed that the custom constructor does call a super-constructor *) | |
call[{type, OO`new}, self, args]; | |
self, | |
(* else *) | |
Constructor[SuperType[type]][self] | |
] | |
] | |
] | |
] | |
]; | |
ClearAll[bindFields]; | |
SetAttributes[bindFields, HoldFirst]; | |
bindFields[self: tp_[obj_], type_, {{h_, Hold[field_], Hold[rhs_]}, rest___}]:= | |
Module[{}, | |
AppendTo[obj, field ~ Replace[h, {Set -> Rule, SetDelayed -> RuleDelayed}] ~ rhs]; | |
bindFields[self, type, {rest}] | |
]; | |
ClearAll[bindPrivateFields]; | |
SetAttributes[bindPrivateFields, HoldFirst]; | |
bindPrivateFields[tp_[obj_], type_, privateFields_Association]:= | |
obj[{type, "Private"}] = privateFields; | |
showIt[x_]:=(Print[x];x) | |
ClearAll[bindMethods]; | |
SetAttributes[bindMethods, HoldFirst]; | |
bindMethods[self:tp_[obj_], type_, methodsDefs_List, privateQ_]:= | |
Module[{processDefList, groupedMethods, bind, assign}, | |
(* A function to lexically process the definition list, and form a | |
real set of definitions from it, for a given function / method *) | |
processDefList[{f_, h_, Hold[f_[args___]], Hold[rhs_], ftype_}]:= | |
Replace[ | |
Hold[rhs] /. $self -> self, | |
Hold[code_]:> { | |
Hold[assign[Fn[args], code]] /. { | |
(* Do not transform supercalls, since they are performed | |
by another bound function *) | |
superCall : HoldPattern[Super[o_][f[x___]]]:>superCall, | |
HoldPattern[o_[f[x___]]] :> Fn[o, x] | |
} /. assign -> h, | |
ftype | |
} | |
]; | |
(* A function to form Function - based definitions for a method, and bind | |
them to the object *) | |
bind[f_ -> heldDefs:{{_Hold, _}...}]:= | |
With[{selfstr = ToString[self]}, (* To avoid self ref. capture *) | |
With[{ | |
normalQ = MemberQ[heldDefs[[All,2]], Normal], | |
catchAll = Hold[Fn[args__]:= msgFail[Object::badargs, Rest @ {args}, f, selfstr]] | |
}, | |
bind[ | |
f -> Append[heldDefs[[All, 1]], catchAll], | |
(* Using the much heavier "standard" evaluator, if at least one | |
definition for this function requires full evaluator *) | |
If[normalQ, Sequence @@ {}, Evaluator -> ReplaceRepeated] | |
] | |
] | |
]; | |
bind[f_ -> heldDefs:{___Hold}, opts___?OptionQ]:= | |
With[{fn = RuleBasedFunction @@ Join[Thread[heldDefs, Hold], Hold[opts]]}, | |
If[privateQ[Hold @ f], | |
f = fn (* Bind private symbol. Need this in order to avoid private symbols with DownValues *) | |
, | |
obj[{type, f}] = fn | |
] | |
]; | |
(* Grouping method definitions, and processing them *) | |
groupedMethods = GroupBy[methodsDefs, First -> processDefList]; | |
(* Go through the processed definitions and bind them to the object / instance *) | |
Scan[bind, Normal @ groupedMethods] | |
]; | |
End[] | |
EndPackage[] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment