A new Python - inspired implementation of an object-oriented extension for Mathematica language, which enables creation of garbage-collectable objects

NewOO.m

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