Skip to content

Instantly share code, notes, and snippets.

@lshifr lshifr/NewOO.m
Last active Jul 4, 2016

Embed
What would you like to do?
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
You can’t perform that action at this time.