Skip to content

Instantly share code, notes, and snippets.

@lshifr
Created December 12, 2012 08:35
  • Star 3 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save lshifr/4266126 to your computer and use it in GitHub Desktop.
Simple object-oriented extension for Mathematica

#OO

OO is a simple object-oriented extension for Mathematica language. The features include instantiation, inheritance and a type of polymorphism. In addition, one can add new methods (behavior) dynamically to a single instance of a given type, without altering the set of methods for the type in general.

##Installation

An easy option is to use the ProjectInstaller. Assuming you have it installed, here is the code to install the OO project:

Needs["ProjectInstaller`"] 
ProjectInstall[URL["https://gist.github.com/4266126/download"]]

##Examples

To bring up the notebook with examples, you have to execute

Needs["OO`"] 
GetExampleNotebook[]
Copyright (c) 2012 Leonid Shifrin
This project is licensed under the MIT license,
http://opensource.org/licenses/MIT
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and / or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
(* Mathematica Package *)
Unprotect[$Packages];
$Packages = $Packages ~ Join ~ {"OO`Methods`","OO`Errors`"};
Protect[$Packages]
BeginPackage["OO`",{"OO`Methods`","OO`Errors`"}]
(* Exported symbols added here with SymbolName::usage *)
AddMethods;
Object;
TypeQ;
TypeOf;
SuperType;
DeclareType;
Extends;
OOBlock;
$self;
$content;
$super;
GetExampleNotebook;
ThrowError;
OOError;
Begin["`Private`"] (* Begin Private Context *)
$projectLocation = DirectoryName[$InputFileName];
ClearAll[CleanUp];
SetAttributes[CleanUp, HoldAll];
CleanUp[expr_, cleanup_, resultWrapF_: Identity] :=
Module[{exprFn, result, abort = False, rethrow = True, seq},
exprFn[] := expr;
result =
resultWrapF@CheckAbort[
Catch[
Catch[result = exprFn[]; rethrow = False; result],
_,
seq[##] &
],
abort = True
];
cleanup;
If[abort, Abort[]];
If[rethrow, Throw[result /. seq -> Sequence]];
result];
(******************************************************************************)
(******************************************************************************)
(************ Core OO system implementation ***************)
(******************************************************************************)
(******************************************************************************)
ClearAll[ThrowError];
ThrowError[f_, args___] :=
Throw[$Failed, OOError[f, args]];
ClearAll[typeSymbols];
typeSymbols[_] := {};
ClearAll[vtable];
vtable[Object]:=object;
ClearAll[instanceValue];
SetAttributes[instanceValue,HoldAll];
instanceValue[_]:=
ThrowError[instanceValue,"invalid_instance"];
ClearAll[withInstanceEnvironment]
SetAttributes[withInstanceEnvironment,HoldAll];
withInstanceEnvironment[sym_,type_,code_]:=
Block[{
$self = sym,
$content = instanceValue[sym],
$super
}
,
SetAttributes[$super,HoldAll];
$content /: Set[$content, expr_] := Set[sym, expr];
$super[call_]:= vtable[SuperType[type]][sym,call];
code
];
$macros =
{
withInstanceEnvironment
};
ClearAll[codeGenerate];
SetAttributes[codeGenerate,HoldAll];
codeGenerate[code_]:=
ReleaseHold[Hold[code]//.Flatten[Map[DownValues,$macros]]];
ClearAll[addMethods];
SetAttributes[addMethods, HoldAll];
codeGenerate[
addMethods[SetDelayed[lhs_, rhs_], rest___][s_] :=
With[{ff = vtable[s]},
ff[sym_, lhs] := withInstanceEnvironment[sym,s,rhs];
addMethods[rest][s]
];
];
addMethods[][s_] :=
vtable[s][sym_, lhs_] :=
vtable[SuperType[s]][sym,lhs];
ClearAll[markInstanceCreated];
markInstanceCreated[sym_]:= Sow[sym,$OOTag];
ClearAll[defineMethods];
SetAttributes[defineMethods, HoldRest];
defineMethods[s_] := s;
defineMethods[s_, args___] :=
Module[{ff},
AppendTo[typeSymbols[s], ff];
SetAttributes[{ff}, HoldAll];
vtable[s] = ff;
self : (s[content_]) :=
Module[{sym},
markInstanceCreated[sym];
SetAttributes[sym, HoldAll];
sym /: instanceValue[sym] = content;
sym /: Normal[sym] :=
With[{cont = instanceValue[sym]},
HoldForm[s[cont]]
];
(* Note: this forces the arguments to be evaluated *)
sym[f_[argums___]] :=
Hold[f][argums]/.Hold[h_][x___]:>
ff[sym,f[x]];
sym /: Set[sym, newcontent_] :=
sym /: instanceValue[sym] = newcontent;
sym/: TypeOf[sym] = s;
enableInstanceMethods[sym,s];
makeFormattingRules[sym, s];
sym
];
addMethods[args][s];
];
ClearAll[SuperType];
SuperType[Object] = Null;
SuperType[_] = Object;
ClearAll[Object, object];
Object::nomethod = "Unknown method for type Object. The method call was `1`";
SetAttributes[{Object, object}, HoldAll];
Object[__] := object;
object[args___,methodCall_] :=
(
Message[Object::nomethod,ToString@HoldForm[methodCall]];
$Failed
);
ClearAll[TypeQ];
TypeQ[type_Symbol][instance_Symbol]/;TypeOf[instance] === type := True;
TypeQ[type_Symbol][instance_Symbol] :=
TypeQ[SuperType[type], instance];
TypeQ[_][_] := False;
ClearAll[DeclareType];
DeclareType[Object] = Null;
DeclareType[type_Symbol] := DeclareType[type~ Extends ~ Object];
DeclareType[Object ~ Extends ~ _] = Null;
DeclareType[type_Symbol ~ Extends ~ superType_Symbol] :=
Function[
Null
,
ClearAll[type];
Remove @@ typeSymbols[type];
If[ValueQ[vtable[type]], vtable[type] =.];
typeSymbols[type] = {};
SetAttributes[type, HoldAll];
defineMethods[type, ##];
SuperType[type] = superType;
type
,
HoldAll
];
(******************************************************************************)
(************ Mode advanced capabilities ***************)
(******************************************************************************)
ClearAll[enableInstanceMethods];
codeGenerate[
enableInstanceMethods[sym_Symbol,type_Symbol]:=
With[{dispatchF = vtable[type]},
sym[AddMethods[SetDelayed[lhs_, rhs_], rest___]] :=
(
sym /: dispatchF[sym, lhs] :=
withInstanceEnvironment[sym,type,rhs];
sym[AddMethods[rest]]
);
sym[AddMethods[]] := Null;
]
];
enableInstanceMethods[args___]:=
ThrowError[enableInstanceMethods,"internal_error"];
ClearAll[OOBlock];
SetAttributes[OOBlock, HoldAll];
OOBlock[code_] :=
Module[{symbols = {}},
CleanUp[
code
,
Remove @@ symbols
,
Function[
cd
,
With[{res = Reap[cd, $OOTag, #2 &]},
symbols = If[# === {}, {}, First@#] &@res[[2]];
First@res
]
,
HoldAll]
]
]
GetExampleNotebook[]:=
NotebookOpen[FileNameJoin[{$projectLocation,"OO_examples.nb"}]]
(******************************************************************************)
(************ Formatting ***************)
(******************************************************************************)
$openingDoubleAngularBracket = FromCharacterCode[171];
$closingDoubleAngularBracket = FromCharacterCode[187];
ClearAll[makeFormattingRules];
makeFormattingRules[s_Symbol, type_Symbol] :=
s /: MakeBoxes[s, fmt_] :=
With[{
stype = ToString[type],
openbr = $openingDoubleAngularBracket,
closebr = $closingDoubleAngularBracket
},
InterpretationBox[
RowBox[{
openbr,
RowBox[{stype, "[", RowBox[{}], "]"}],
closebr
}],
s
]
];
End[] (* End Private Context *)
EndPackage[]
(* Content-type: application/vnd.wolfram.mathematica *)
(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)
(* CreatedBy='Mathematica 9.0' *)
(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[ 157, 7]
NotebookDataLength[ 29283, 839]
NotebookOptionsPosition[ 24931, 686]
NotebookOutlinePosition[ 25311, 702]
CellTagsIndexPosition[ 25268, 699]
WindowFrame->Normal*)
(* Beginning of Notebook Content *)
Notebook[{
Cell[CellGroupData[{
Cell["Initialization", "Subsection",
CellChangeTimes->{{3.564303579321289*^9, 3.5643035816191406`*^9}}],
Cell[BoxData[
RowBox[{"Needs", "[", "\"\<OO`\>\"", "]"}]], "Input",
InitializationCell->True,
CellChangeTimes->{{3.564303585392578*^9, 3.564303590794922*^9}}]
}, Open ]],
Cell[CellGroupData[{
Cell["Examples", "Subsection",
CellChangeTimes->{{3.5640709249848595`*^9, 3.564070927249508*^9}}],
Cell[CellGroupData[{
Cell["\<\
Type declaration and method calls\
\>", "Subsubsection",
CellChangeTimes->{{3.5643036236054688`*^9, 3.5643036361728516`*^9}}],
Cell["\<\
Note that the use of OO`Methods` is recommended to avoid name collisions / \
shadowing when many different classes are used.\
\>", "Text",
CellChangeTimes->{{3.5643036546708984`*^9, 3.56430369196875*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{
RowBox[{
RowBox[{"DeclareType", "[", "Animal", "]"}], "[", "\[IndentingNewLine]",
RowBox[{
RowBox[{
RowBox[{"OO`Methods`breathe", "[", "]"}], ":=",
RowBox[{"Print", "[",
RowBox[{"\"\<I am breething \>\"", ",",
RowBox[{"First", "@", "$content"}]}], "]"}]}], ",",
"\[IndentingNewLine]",
RowBox[{
RowBox[{"OO`Methods`sleep", "[", "]"}], ":=", "\"\<I am sleeping\>\""}],
",", "\[IndentingNewLine]",
RowBox[{
RowBox[{"OO`Methods`move", "[", "]"}], ":=",
RowBox[{"Print", "[",
RowBox[{"\"\<I move \>\"", ",",
RowBox[{"$content", "[",
RowBox[{"[", "2", "]"}], "]"}]}], "]"}]}]}], "\[IndentingNewLine]",
"]"}], "\[IndentingNewLine]"}]], "Input",
CellChangeTimes->{{3.564070937443844*^9, 3.5640709385405235`*^9}, {
3.564074221229*^9, 3.56407423044775*^9}, {3.5642315041279297`*^9,
3.564231506046875*^9}}],
Cell[BoxData["Animal"], "Output",
CellChangeTimes->{
3.5640709405561485`*^9, 3.5640742315024376`*^9, 3.5640754291049767`*^9,
3.564125047919875*^9, 3.564125156417922*^9, 3.5641252314188986`*^9,
3.5641252865399923`*^9, 3.5641254467187033`*^9, 3.5641254810868673`*^9,
3.5641256071405783`*^9, 3.564125794020461*^9, 3.5641258605956564`*^9, {
3.564126031913039*^9, 3.5641260614032736`*^9}, 3.5641262732274923`*^9,
3.5641264096806173`*^9, 3.564126583009719*^9, 3.564127695768508*^9,
3.564128007835891*^9, 3.564128043900344*^9, {3.5641296918769064`*^9,
3.564129710116164*^9}, 3.5641298978583517`*^9, 3.56412994165718*^9,
3.564130168334914*^9, 3.564130220933547*^9, 3.56413103440425*^9,
3.5641310771063986`*^9, 3.5641311300868673`*^9, 3.5641312188271017`*^9,
3.56413166752925*^9, 3.5641323594208517`*^9, 3.564132428551711*^9,
3.564137345303664*^9, 3.5641391104813986`*^9, 3.564143277226516*^9,
3.5641442752021017`*^9, 3.5642293690429688`*^9, 3.564231506633789*^9,
3.564240620279297*^9, 3.564244351192383*^9, 3.5642452180791016`*^9,
3.564245259232422*^9, 3.564246786267578*^9, 3.5643025037783203`*^9,
3.564302776142578*^9, 3.564303006970703*^9, 3.5643031638466797`*^9,
3.5643041075908203`*^9}]
}, Open ]],
Cell["Create an instance", "Text",
CellChangeTimes->{{3.5643036990390625`*^9, 3.5643037022402344`*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"an", " ", "=", " ",
RowBox[{"Animal", "[",
RowBox[{"{",
RowBox[{"\"\<oxygen\>\"", ",", "\"\<fast\>\""}], "}"}], "]"}]}]], "Input",
CellChangeTimes->{{3.564067273619625*^9, 3.5640672792885704`*^9}, {
3.5640675922192345`*^9, 3.5640676228168907`*^9}, {3.5641256286249533`*^9,
3.5641256298681173`*^9}, 3.5641257959638205`*^9}],
Cell[BoxData[
InterpretationBox[
RowBox[{"\[LeftGuillemet]",
RowBox[{"Animal", "[", "]"}], "\[RightGuillemet]"}],
OO`Private`sym$634]], "Output",
CellChangeTimes->{
3.5640672821303673`*^9, 3.564067330059078*^9, {3.564067611121578*^9,
3.564067623267086*^9}, 3.5640682178022423`*^9, 3.564070954930172*^9,
3.5641250500126486`*^9, {3.564125608544875*^9, 3.564125630367141*^9},
3.5641257964355*^9, 3.564125861542922*^9, 3.564126024784133*^9,
3.5641260633026876`*^9, 3.564126411350539*^9, 3.564126585273391*^9,
3.564127697489211*^9, {3.5641280063856955`*^9, 3.564128009119094*^9},
3.5641280448319845`*^9, {3.5641296934325705`*^9, 3.564129711683547*^9},
3.5641298990282736`*^9, 3.564129942652297*^9, 3.564130169678664*^9,
3.5641302218993673`*^9, 3.564131035869094*^9, 3.564131077954055*^9,
3.564131130978469*^9, 3.5641312197763205`*^9, 3.5641316691874533`*^9,
3.5641323611874533`*^9, 3.5641324305771017`*^9, 3.5641373471806173`*^9,
3.5641391116181173`*^9, 3.564143278553664*^9, 3.5641442766737814`*^9,
3.5642293704414062`*^9, 3.5642315088154297`*^9, 3.5642406215898438`*^9,
3.564244352961914*^9, 3.5642452193554688`*^9, 3.564245260428711*^9,
3.5642467881845703`*^9, 3.564302505341797*^9, 3.564302777580078*^9,
3.5643030078896484`*^9, 3.564304108790039*^9}]
}, Open ]],
Cell["Call methods", "Text",
CellChangeTimes->{{3.5643037050371094`*^9, 3.5643037071914062`*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"an", "@",
RowBox[{"breathe", "[", "]"}]}]], "Input",
CellChangeTimes->{{3.5641310937138205`*^9, 3.5641310973271017`*^9}}],
Cell[BoxData[
InterpretationBox[
RowBox[{"\<\"I am breething \"\>", "\[InvisibleSpace]", "\<\"oxygen\"\>"}],
SequenceForm["I am breething ", "oxygen"],
Editable->False]], "Print",
CellChangeTimes->{3.5642315745439453`*^9, 3.5642406280429688`*^9,
3.5642443576367188`*^9, 3.5642452637441406`*^9, 3.5642467899189453`*^9,
3.5643025099882812`*^9, 3.564302778334961*^9, 3.564303008416992*^9,
3.564304110307617*^9}]
}, Open ]],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"an", "@",
RowBox[{"sleep", "[", "]"}]}]], "Input",
CellChangeTimes->{{3.5641324359774923`*^9, 3.564132439364211*^9}}],
Cell[BoxData["\<\"I am sleeping\"\>"], "Output",
CellChangeTimes->{3.56413243975093*^9, 3.564137349366164*^9,
3.564143280634719*^9, 3.5641442788769064`*^9, 3.564231595078125*^9,
3.5642316316816406`*^9, 3.564240657823242*^9, 3.5642443593779297`*^9,
3.564245266611328*^9, 3.564246792319336*^9, 3.564302514573242*^9,
3.564302779208008*^9, 3.5643030094365234`*^9, 3.5643041110214844`*^9}]
}, Open ]],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"an", "@",
RowBox[{"move", "[", "]"}]}]], "Input",
CellChangeTimes->{{3.5641324414687033`*^9, 3.5641324457157736`*^9}}],
Cell[BoxData[
InterpretationBox[
RowBox[{"\<\"I move \"\>", "\[InvisibleSpace]", "\<\"fast\"\>"}],
SequenceForm["I move ", "fast"],
Editable->False]], "Print",
CellChangeTimes->{3.564132446119094*^9, 3.564137350081008*^9,
3.564143281523391*^9, 3.564144280204055*^9, 3.5642316323623047`*^9,
3.564240659727539*^9, 3.564244360520508*^9, 3.564245268651367*^9,
3.5642467936845703`*^9, 3.5643025155341797`*^9, 3.564302779895508*^9,
3.5643030112646484`*^9, 3.5643041117246094`*^9}]
}, Open ]]
}, Open ]],
Cell[CellGroupData[{
Cell["Sub-typing (inheritance)", "Subsubsection",
CellChangeTimes->{{3.564303715176758*^9, 3.56430372296875*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{
RowBox[{"DeclareType", "[",
RowBox[{"Cat", " ", "~", " ", "Extends", " ", "~", " ", "Animal"}], "]"}],
"[", "\[IndentingNewLine]",
RowBox[{
RowBox[{"sleep", "[", "]"}], ":=", " ",
RowBox[{"StringJoin", "[",
RowBox[{
RowBox[{"$super", "@",
RowBox[{"sleep", "[", "]"}]}], ",",
RowBox[{"$content", "[",
RowBox[{"[", "3", "]"}], "]"}]}], "]"}]}], "\[IndentingNewLine]",
"]"}]], "Input",
CellChangeTimes->{{3.5640681006723595`*^9, 3.5640681352954063`*^9}, {
3.5640682668598595`*^9, 3.5640682798686485`*^9}, 3.564068425034664*^9, {
3.5640684601743126`*^9, 3.5640684712123985`*^9}, {3.564068642137203*^9,
3.564068667557125*^9}, {3.564071016997555*^9, 3.5640710179780235`*^9},
3.5640742403774376`*^9}],
Cell[BoxData["Cat"], "Output",
CellChangeTimes->{3.5640681648354454`*^9, 3.564068670702633*^9,
3.564071021074703*^9, 3.5640742422299767`*^9, 3.5641324609687033`*^9,
3.5641373741669455`*^9, 3.5641432831981955`*^9, 3.564144281652297*^9,
3.5642316366123047`*^9, 3.564240663173828*^9, 3.5642443612714844`*^9,
3.564245270251953*^9, 3.5642467961015625`*^9, 3.5643025168476562`*^9,
3.564302781182617*^9, 3.5643030357353516`*^9, 3.564303165305664*^9,
3.5643041159375*^9}]
}, Open ]],
Cell["Create an instance", "Text",
CellChangeTimes->{{3.5643037296396484`*^9, 3.5643037327382812`*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"cat", " ", "=", " ",
RowBox[{"Cat", "[",
RowBox[{"{",
RowBox[{
"\"\<oxygen\>\"", ",", "\"\<very fast\>\"", ",",
"\"\< on the floor\>\""}], "}"}], "]"}]}]], "Input",
CellChangeTimes->{{3.5640681663373985`*^9, 3.5640682358666954`*^9}, {
3.564071044146969*^9, 3.564071044787594*^9}, {3.5641324915019064`*^9,
3.5641324944062033`*^9}}],
Cell[BoxData[
InterpretationBox[
RowBox[{"\[LeftGuillemet]",
RowBox[{"Cat", "[", "]"}], "\[RightGuillemet]"}],
OO`Private`sym$642]], "Output",
CellChangeTimes->{
3.564068236216305*^9, 3.5640710452592735`*^9, 3.564074243182125*^9, {
3.564132465409133*^9, 3.5641324950419455`*^9}, 3.564137376704055*^9,
3.564143284371047*^9, 3.5641442852401876`*^9, 3.5642316386777344`*^9,
3.5642406653867188`*^9, 3.5642443632470703`*^9, 3.564245272283203*^9,
3.5642467980214844`*^9, 3.564302519279297*^9, 3.5643027828359375`*^9,
3.564303836616211*^9, 3.564304117274414*^9}]
}, Open ]],
Cell["Call methods", "Text",
CellChangeTimes->{{3.5643037371064453`*^9, 3.5643037387939453`*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"cat", "@",
RowBox[{"breathe", "[", "]"}]}]], "Input",
CellChangeTimes->{{3.5640682398168907`*^9, 3.564068243117672*^9}}],
Cell[BoxData[
InterpretationBox[
RowBox[{"\<\"I am breething \"\>", "\[InvisibleSpace]", "\<\"oxygen\"\>"}],
SequenceForm["I am breething ", "oxygen"],
Editable->False]], "Print",
CellChangeTimes->{
3.564068243716305*^9, 3.5640710461616173`*^9, 3.5640742439487267`*^9, {
3.5641324667177267`*^9, 3.5641324964931173`*^9}, 3.5641373781825705`*^9,
3.5641432869188986`*^9, 3.564144286042922*^9, 3.564231640301758*^9,
3.564240666830078*^9, 3.5642443648398438`*^9, 3.5642452732998047`*^9,
3.5642468002929688`*^9, 3.564302520201172*^9, 3.564302783708008*^9,
3.564303837680664*^9, 3.564304118955078*^9}]
}, Open ]],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"cat", "@",
RowBox[{"sleep", "[", "]"}]}]], "Input",
CellChangeTimes->{{3.5640682465004845`*^9, 3.564068261652828*^9}}],
Cell[BoxData["\<\"I am sleeping on the floor\"\>"], "Output",
CellChangeTimes->{
3.564068262023922*^9, 3.5640686734047813`*^9, 3.564071046996578*^9,
3.564074244610836*^9, {3.564132468134719*^9, 3.564132497797805*^9},
3.564137379147414*^9, 3.564143287964797*^9, 3.56414428687593*^9,
3.564231641709961*^9, 3.5642406674921875`*^9, 3.5642443656533203`*^9,
3.564245274286133*^9, 3.564246801975586*^9, 3.564302521080078*^9,
3.5643027849414062`*^9, 3.5643038383603516`*^9, 3.5643041202382812`*^9}]
}, Open ]],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"cat", "@",
RowBox[{"move", "[", "]"}]}]], "Input",
CellChangeTimes->{{3.5641324985243673`*^9, 3.564132502730422*^9}}],
Cell[BoxData[
InterpretationBox[
RowBox[{"\<\"I move \"\>", "\[InvisibleSpace]", "\<\"very fast\"\>"}],
SequenceForm["I move ", "very fast"],
Editable->False]], "Print",
CellChangeTimes->{3.5641325031249533`*^9, 3.564137386377883*^9,
3.5641432894843283`*^9, 3.564144288286086*^9, 3.5642316443554688`*^9,
3.56424066809375*^9, 3.564244367303711*^9, 3.5642452760966797`*^9,
3.564246803216797*^9, 3.5643025224404297`*^9, 3.564302787006836*^9,
3.564303839364258*^9, 3.5643041218046875`*^9}]
}, Open ]],
Cell[TextData[{
"Note that the instance is actually a ",
StyleBox["Mathematica",
FontSlant->"Italic"],
" symbol"
}], "Text",
CellChangeTimes->{{3.5643037504873047`*^9, 3.564303765770508*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"FullForm", "[", "cat", "]"}]], "Input",
CellChangeTimes->{{3.564303767442383*^9, 3.56430377953125*^9}}],
Cell[BoxData[
TagBox[
StyleBox["OO`Private`sym$642",
ShowSpecialCharacters->False,
ShowStringCharacters->True,
NumberMarks->True],
FullForm]], "Output",
CellChangeTimes->{3.564303787541992*^9, 3.564303840272461*^9,
3.564304123303711*^9}]
}, Open ]],
Cell["\<\
You can use Normal to see the object expression (wrapped in HoldForm)\
\>", "Text",
CellChangeTimes->{{3.564303794385742*^9, 3.5643038156435547`*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"cat", "//", "Normal"}]], "Input",
CellChangeTimes->{{3.5641325304120626`*^9, 3.564132534348586*^9}, {
3.564132568136672*^9, 3.5641325742802267`*^9}, {3.5643038264277344`*^9,
3.5643038451191406`*^9}}],
Cell[BoxData[
TagBox[
RowBox[{"Cat", "[",
RowBox[{"{",
RowBox[{"\<\"oxygen\"\>", ",", "\<\"very fast\"\>",
",", "\<\" on the floor\"\>"}], "}"}], "]"}],
HoldForm]], "Output",
CellChangeTimes->{
3.5641325347001486`*^9, {3.564132570929641*^9, 3.56413257465425*^9},
3.56413738865718*^9, 3.5641432904862814`*^9, 3.564144289664016*^9,
3.5642316455947266`*^9, 3.564240669288086*^9, 3.56424436846875*^9,
3.564245277142578*^9, 3.564246805341797*^9, 3.564302524631836*^9,
3.5643027885751953`*^9, {3.5643038183398438`*^9, 3.564303845586914*^9},
3.564304125520508*^9}]
}, Open ]]
}, Open ]],
Cell[CellGroupData[{
Cell["\<\
More subtyping, and changing the state of an instance\
\>", "Subsubsection",
CellChangeTimes->{{3.5643038568291016`*^9, 3.564303879751953*^9}}],
Cell["\<\
This sub-type has a method that changes the state of an instance\
\>", "Text",
CellChangeTimes->{{3.564303886727539*^9, 3.564303899229492*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{
RowBox[{"DeclareType", "[",
RowBox[{"ChangableCat", " ", "~", " ", "Extends", " ", "~", " ", "Cat"}],
"]"}], "[", "\[IndentingNewLine]",
RowBox[{
RowBox[{"OO`Methods`change", "[", "]"}], ":=",
RowBox[{"$content", "=",
RowBox[{"{",
RowBox[{
"\"\<oxygen\>\"", ",", "\"\<slowly\>\"", ",", "\"\< on the pillow\>\""}],
"}"}]}]}], "\[IndentingNewLine]", "]"}]], "Input",
CellChangeTimes->{{3.5641443252245626`*^9, 3.5641443349062033`*^9}, {
3.5641445085282736`*^9, 3.56414451856343*^9}, {3.5641445581737814`*^9,
3.5641445990312033`*^9}, 3.564224984390625*^9, {3.5642316508066406`*^9,
3.564231656607422*^9}, {3.5642407262509766`*^9, 3.5642407344453125`*^9}, {
3.564242177623047*^9, 3.564242179083008*^9}}],
Cell[BoxData["ChangableCat"], "Output",
CellChangeTimes->{3.5642407350810547`*^9, 3.564241042133789*^9,
3.564242179703125*^9, 3.5642443780117188`*^9, 3.5642453219072266`*^9,
3.564246812098633*^9, 3.5643025324853516`*^9, 3.564302789803711*^9,
3.564303041946289*^9, 3.5643031671367188`*^9, 3.564304127169922*^9}]
}, Open ]],
Cell["Create an object", "Text",
CellChangeTimes->{{3.5643039025371094`*^9, 3.5643039053125*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"chcat", "=",
RowBox[{"ChangableCat", "[",
RowBox[{"{",
RowBox[{
"\"\<oxygen\>\"", ",", "\"\<very fast\>\"", ",",
"\"\< on the floor\>\""}], "}"}], "]"}]}]], "Input",
CellChangeTimes->{{3.564144606044875*^9, 3.5641446218651876`*^9}}],
Cell[BoxData[
InterpretationBox[
RowBox[{"\[LeftGuillemet]",
RowBox[{"ChangableCat", "[", "]"}], "\[RightGuillemet]"}],
OO`Private`sym$652]], "Output",
CellChangeTimes->{
3.5641446228183126`*^9, 3.5642316592109375`*^9, {3.5642407153603516`*^9,
3.564240737236328*^9}, 3.5642410437285156`*^9, 3.5642421808134766`*^9,
3.564244379446289*^9, 3.564245323826172*^9, 3.564246813520508*^9,
3.564302534998047*^9, 3.5643027909541016`*^9, 3.5643030431347656`*^9,
3.5643031682597656`*^9, 3.5643041296679688`*^9}]
}, Open ]],
Cell["Call methods normally", "Text",
CellChangeTimes->{{3.5643039251054688`*^9, 3.5643039309648438`*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"chcat", "@",
RowBox[{"sleep", "[", "]"}]}]], "Input",
CellChangeTimes->{{3.5641446289120626`*^9, 3.5641446362499533`*^9}}],
Cell[BoxData["\<\"I am sleeping on the floor\"\>"], "Output",
CellChangeTimes->{
3.564144636917922*^9, 3.564231659966797*^9, {3.5642407161259766`*^9,
3.564240739091797*^9}, 3.5642410447109375`*^9, 3.564242181583008*^9,
3.564244380953125*^9, 3.564245325048828*^9, 3.5642468152041016`*^9,
3.5643025361132812`*^9, 3.5643027923847656`*^9, 3.5643030439208984`*^9,
3.5643031698066406`*^9, 3.5643041313671875`*^9}]
}, Open ]],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"chcat", "@",
RowBox[{"move", "[", "]"}]}]], "Input",
CellChangeTimes->{{3.564144647096633*^9, 3.5641446471737814`*^9}}],
Cell[BoxData[
InterpretationBox[
RowBox[{"\<\"I move \"\>", "\[InvisibleSpace]", "\<\"very fast\"\>"}],
SequenceForm["I move ", "very fast"],
Editable->False]], "Print",
CellChangeTimes->{
3.5641446477499533`*^9, 3.564231660798828*^9, {3.5642407168671875`*^9,
3.5642407398740234`*^9}, 3.5642410459365234`*^9, 3.5642421822998047`*^9,
3.564244382508789*^9, 3.5642453259521484`*^9, 3.564246816536133*^9,
3.5643025371601562`*^9, 3.5643027930371094`*^9, 3.5643030453671875`*^9,
3.564303170614258*^9, 3.564304132970703*^9}]
}, Open ]],
Cell["Change the state", "Text",
CellChangeTimes->{{3.5643039367265625`*^9, 3.564303938783203*^9}}],
Cell[BoxData[
RowBox[{"chcat", "@",
RowBox[{"change", "[", "]"}]}]], "Input",
CellChangeTimes->{{3.5641446517343283`*^9, 3.5641446583388205`*^9}}],
Cell["Call methods again", "Text",
CellChangeTimes->{{3.564303945791992*^9, 3.564303953161133*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"chcat", "@",
RowBox[{"sleep", "[", "]"}]}]], "Input"],
Cell[BoxData["\<\"I am sleeping on the pillow\"\>"], "Output",
CellChangeTimes->{3.564144665982375*^9, 3.564231662944336*^9,
3.5642407448935547`*^9, 3.564241048861328*^9, 3.5642421841347656`*^9,
3.5642443860859375`*^9, 3.5642453285322266`*^9, 3.5642468191191406`*^9,
3.5643025425615234`*^9, 3.5643027948066406`*^9, 3.5643031720634766`*^9,
3.5643041354873047`*^9}]
}, Open ]],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"chcat", "@",
RowBox[{"move", "[", "]"}]}]], "Input"],
Cell[BoxData[
InterpretationBox[
RowBox[{"\<\"I move \"\>", "\[InvisibleSpace]", "\<\"slowly\"\>"}],
SequenceForm["I move ", "slowly"],
Editable->False]], "Print",
CellChangeTimes->{3.56414467296968*^9, 3.5642316664296875`*^9,
3.5642410506191406`*^9, 3.5642421850664062`*^9, 3.5642443870371094`*^9,
3.5642453300615234`*^9, 3.564246821*^9, 3.5643025438535156`*^9,
3.5643027960117188`*^9, 3.5643031735634766`*^9, 3.5643041362851562`*^9}]
}, Open ]]
}, Open ]],
Cell[CellGroupData[{
Cell["\<\
Adding new methods to a single instance at run-time\
\>", "Subsubsection",
CellChangeTimes->{{3.5643039609072266`*^9, 3.564303975875*^9}}],
Cell["\<\
This cat does not initially know how to drink. But it can learn.\
\>", "Text",
CellChangeTimes->{{3.5642445300195312`*^9, 3.5642445430908203`*^9}, {
3.5643039853466797`*^9, 3.5643040092382812`*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{
RowBox[{"DeclareType", "[",
RowBox[{"LearningCat", " ", "~", " ", "Extends", " ", "~", " ", "Cat"}],
"]"}], "[", "\[IndentingNewLine]",
RowBox[{
RowBox[{"OO`Methods`learn", "[", "drinkAction_", "]"}], ":=",
RowBox[{"$self", "@",
RowBox[{"AddMethods", "[", "\[IndentingNewLine]",
RowBox[{
RowBox[{"OO`Methods`drink", "[", "]"}], ":=", "drinkAction"}],
"\[IndentingNewLine]", "]"}]}]}], "\[IndentingNewLine]", "]"}]], "Input",
CellChangeTimes->{{3.5642444419501953`*^9, 3.5642444525615234`*^9}, {
3.5642444903896484`*^9, 3.564244510366211*^9}, 3.5642445407460938`*^9, {
3.5642446335908203`*^9, 3.564244649671875*^9}, 3.5642446959091797`*^9,
3.564246914107422*^9}],
Cell[BoxData["LearningCat"], "Output",
CellChangeTimes->{{3.5642445213007812`*^9, 3.5642445443896484`*^9},
3.564244651430664*^9, 3.5642446964960938`*^9, 3.5642453330458984`*^9,
3.564246879583008*^9, 3.5642469174121094`*^9, 3.5643025490117188`*^9,
3.564302797307617*^9, 3.564303016301758*^9, 3.5643030481396484`*^9,
3.5643031749628906`*^9, 3.564304012055664*^9, 3.5643041445029297`*^9}]
}, Open ]],
Cell["Create an instance", "Text",
CellChangeTimes->{{3.5643040150185547`*^9, 3.5643040173271484`*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"lcat", " ", "=", " ",
RowBox[{"LearningCat", "[",
RowBox[{"{",
RowBox[{
"\"\<oxygen\>\"", ",", "\"\<very fast\>\"", ",",
"\"\< on the floor\>\""}], "}"}], "]"}]}]], "Input",
CellChangeTimes->{{3.5642445514697266`*^9, 3.5642445729365234`*^9}}],
Cell[BoxData[
InterpretationBox[
RowBox[{"\[LeftGuillemet]",
RowBox[{"LearningCat", "[", "]"}], "\[RightGuillemet]"}],
OO`Private`sym$664]], "Output",
CellChangeTimes->{3.5642445745351562`*^9, 3.5642446528066406`*^9,
3.564244699192383*^9, 3.564245336473633*^9, 3.564246882301758*^9,
3.564246922536133*^9, 3.564302553463867*^9, 3.5643027990078125`*^9,
3.5643030172939453`*^9, 3.5643030491435547`*^9, 3.5643031765507812`*^9,
3.5643041476240234`*^9}]
}, Open ]],
Cell["Call methods", "Text",
CellChangeTimes->{{3.5643040215390625`*^9, 3.5643040235429688`*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"lcat", "@",
RowBox[{"move", "[", "]"}]}]], "Input",
CellChangeTimes->{{3.564244576701172*^9, 3.5642445804658203`*^9}}],
Cell[BoxData[
InterpretationBox[
RowBox[{"\<\"I move \"\>", "\[InvisibleSpace]", "\<\"very fast\"\>"}],
SequenceForm["I move ", "very fast"],
Editable->False]], "Print",
CellChangeTimes->{3.5643030518046875`*^9, 3.5643031772226562`*^9,
3.564304150107422*^9}]
}, Open ]],
Cell["\<\
It does not know how to drink yet\
\>", "Text",
CellChangeTimes->{{3.5643040310058594`*^9, 3.564304041807617*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"lcat", "@",
RowBox[{"drink", "[", "]"}]}]], "Input",
CellChangeTimes->{{3.564244582379883*^9, 3.5642445876914062`*^9}}],
Cell[BoxData[
RowBox[{
StyleBox[
RowBox[{"Object", "::", "nomethod"}], "MessageName"],
RowBox[{
":", " "}], "\<\"Unknown method for type Object. The method call was \
\[NoBreak]\\!\\(\\\"drink[]\\\"\\)\[NoBreak]\"\>"}]], "Message", "MSG",
CellChangeTimes->{3.5643030547128906`*^9, 3.5643031781054688`*^9,
3.56430415178125*^9}],
Cell[BoxData["$Failed"], "Output",
CellChangeTimes->{
3.5642445883603516`*^9, 3.564244654573242*^9, 3.5642447013066406`*^9,
3.5642453383554688`*^9, {3.5642468847177734`*^9, 3.5642469249472656`*^9},
3.564302556064453*^9, 3.5643028015595703`*^9, 3.5643029998359375`*^9,
3.5643030547148438`*^9, 3.5643031781083984`*^9, 3.5643041517841797`*^9}]
}, Open ]],
Cell["It learns it now", "Text",
CellChangeTimes->{{3.564304048998047*^9, 3.5643040530976562`*^9}}],
Cell[BoxData[
RowBox[{"lcat", "@",
RowBox[{"learn", "[", "\"\<I drink water\>\"", "]"}]}]], "Input",
CellChangeTimes->{{3.5642445900585938`*^9, 3.5642445932802734`*^9}, {
3.5642446624023438`*^9, 3.56424466821875*^9}}],
Cell["Now it can drink", "Text",
CellChangeTimes->{{3.564304058254883*^9, 3.5643040641572266`*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"lcat", "@",
RowBox[{"drink", "[", "]"}]}]], "Input",
CellChangeTimes->{{3.564244594879883*^9, 3.5642445977421875`*^9}}],
Cell[BoxData["\<\"I drink water\"\>"], "Output",
CellChangeTimes->{3.564244598298828*^9, 3.5642447040146484`*^9,
3.564245341366211*^9, 3.5642469281972656`*^9, 3.5643031920009766`*^9,
3.564304156114258*^9}]
}, Open ]],
Cell["You can change that behavior", "Text",
CellChangeTimes->{{3.564304068788086*^9, 3.5643040744990234`*^9}}],
Cell[BoxData[
RowBox[{"lcat", "@",
RowBox[{"learn", "[", "\"\<I drink cold water\>\"", "]"}]}]], "Input",
CellChangeTimes->{{3.5642447110234375`*^9, 3.5642447116689453`*^9}, {
3.564244864489258*^9, 3.5642448658154297`*^9}, 3.5642453435664062`*^9}],
Cell["So that", "Text",
CellChangeTimes->{{3.5643040785029297`*^9, 3.5643040793916016`*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"lcat", "@",
RowBox[{"drink", "[", "]"}]}]], "Input"],
Cell[BoxData["\<\"I drink cold water\"\>"], "Output",
CellChangeTimes->{3.564244727196289*^9, 3.5642453454072266`*^9,
3.564246932864258*^9, 3.5643031956132812`*^9, 3.5643041593603516`*^9}]
}, Open ]]
}, Open ]]
}, Open ]]
},
WindowSize->{1902, 910},
WindowMargins->{{0, Automatic}, {Automatic, 0}},
Magnification->1.6000001430511475`,
FrontEndVersion->"9.0 for Microsoft Windows (64-bit) (November 14, 2012)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)
(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[579, 22, 104, 1, 68, "Subsection"],
Cell[686, 25, 161, 3, 47, "Input",
InitializationCell->True]
}, Open ]],
Cell[CellGroupData[{
Cell[884, 33, 98, 1, 68, "Subsection"],
Cell[CellGroupData[{
Cell[1007, 38, 136, 3, 54, "Subsubsection"],
Cell[1146, 43, 215, 4, 47, "Text"],
Cell[CellGroupData[{
Cell[1386, 51, 928, 23, 193, "Input"],
Cell[2317, 76, 1249, 18, 47, "Output"]
}, Open ]],
Cell[3581, 97, 104, 1, 47, "Text"],
Cell[CellGroupData[{
Cell[3710, 102, 366, 7, 47, "Input"],
Cell[4079, 111, 1321, 21, 47, "Output"]
}, Open ]],
Cell[5415, 135, 98, 1, 47, "Text"],
Cell[CellGroupData[{
Cell[5538, 140, 149, 3, 47, "Input"],
Cell[5690, 145, 425, 8, 33, "Print"]
}, Open ]],
Cell[CellGroupData[{
Cell[6152, 158, 145, 3, 47, "Input"],
Cell[6300, 163, 397, 5, 47, "Output"]
}, Open ]],
Cell[CellGroupData[{
Cell[6734, 173, 146, 3, 47, "Input"],
Cell[6883, 178, 494, 9, 33, "Print"]
}, Open ]]
}, Open ]],
Cell[CellGroupData[{
Cell[7426, 193, 114, 1, 54, "Subsubsection"],
Cell[CellGroupData[{
Cell[7565, 198, 784, 18, 106, "Input"],
Cell[8352, 218, 482, 7, 47, "Output"]
}, Open ]],
Cell[8849, 228, 104, 1, 47, "Text"],
Cell[CellGroupData[{
Cell[8978, 233, 382, 9, 47, "Input"],
Cell[9363, 244, 586, 11, 47, "Output"]
}, Open ]],
Cell[9964, 258, 98, 1, 47, "Text"],
Cell[CellGroupData[{
Cell[10087, 263, 148, 3, 47, "Input"],
Cell[10238, 268, 623, 11, 33, "Print"]
}, Open ]],
Cell[CellGroupData[{
Cell[10898, 284, 146, 3, 47, "Input"],
Cell[11047, 289, 513, 7, 47, "Output"]
}, Open ]],
Cell[CellGroupData[{
Cell[11597, 301, 145, 3, 47, "Input"],
Cell[11745, 306, 505, 9, 33, "Print"]
}, Open ]],
Cell[12265, 318, 197, 6, 48, "Text"],
Cell[CellGroupData[{
Cell[12487, 328, 128, 2, 47, "Input"],
Cell[12618, 332, 255, 8, 67, "Output"]
}, Open ]],
Cell[12888, 343, 161, 3, 47, "Text"],
Cell[CellGroupData[{
Cell[13074, 350, 229, 4, 47, "Input"],
Cell[13306, 356, 600, 13, 47, "Output"]
}, Open ]]
}, Open ]],
Cell[CellGroupData[{
Cell[13955, 375, 154, 3, 54, "Subsubsection"],
Cell[14112, 380, 154, 3, 47, "Text"],
Cell[CellGroupData[{
Cell[14291, 387, 779, 16, 106, "Input"],
Cell[15073, 405, 320, 4, 47, "Output"]
}, Open ]],
Cell[15408, 412, 98, 1, 47, "Text"],
Cell[CellGroupData[{
Cell[15531, 417, 279, 7, 47, "Input"],
Cell[15813, 426, 527, 10, 47, "Output"]
}, Open ]],
Cell[16355, 439, 107, 1, 47, "Text"],
Cell[CellGroupData[{
Cell[16487, 444, 150, 3, 47, "Input"],
Cell[16640, 449, 426, 6, 47, "Output"]
}, Open ]],
Cell[CellGroupData[{
Cell[17103, 460, 147, 3, 47, "Input"],
Cell[17253, 465, 543, 10, 33, "Print"]
}, Open ]],
Cell[17811, 478, 100, 1, 47, "Text"],
Cell[17914, 481, 151, 3, 47, "Input"],
Cell[18068, 486, 100, 1, 47, "Text"],
Cell[CellGroupData[{
Cell[18193, 491, 80, 2, 47, "Input"],
Cell[18276, 495, 376, 5, 47, "Output"]
}, Open ]],
Cell[CellGroupData[{
Cell[18689, 505, 79, 2, 47, "Input"],
Cell[18771, 509, 452, 8, 33, "Print"]
}, Open ]]
}, Open ]],
Cell[CellGroupData[{
Cell[19272, 523, 149, 3, 54, "Subsubsection"],
Cell[19424, 528, 211, 4, 47, "Text"],
Cell[CellGroupData[{
Cell[19660, 536, 739, 15, 164, "Input"],
Cell[20402, 553, 402, 5, 47, "Output"]
}, Open ]],
Cell[20819, 561, 104, 1, 47, "Text"],
Cell[CellGroupData[{
Cell[20948, 566, 289, 7, 47, "Input"],
Cell[21240, 575, 469, 9, 47, "Output"]
}, Open ]],
Cell[21724, 587, 98, 1, 47, "Text"],
Cell[CellGroupData[{
Cell[21847, 592, 146, 3, 47, "Input"],
Cell[21996, 597, 269, 6, 33, "Print"]
}, Open ]],
Cell[22280, 606, 125, 3, 47, "Text"],
Cell[CellGroupData[{
Cell[22430, 613, 147, 3, 47, "Input"],
Cell[22580, 618, 341, 8, 37, "Message"],
Cell[22924, 628, 355, 5, 47, "Output"]
}, Open ]],
Cell[23294, 636, 100, 1, 47, "Text"],
Cell[23397, 639, 224, 4, 47, "Input"],
Cell[23624, 645, 100, 1, 47, "Text"],
Cell[CellGroupData[{
Cell[23749, 650, 147, 3, 47, "Input"],
Cell[23899, 655, 212, 3, 47, "Output"]
}, Open ]],
Cell[24126, 661, 112, 1, 47, "Text"],
Cell[24241, 664, 255, 4, 47, "Input"],
Cell[24499, 670, 93, 1, 47, "Text"],
Cell[CellGroupData[{
Cell[24617, 675, 79, 2, 47, "Input"],
Cell[24699, 679, 192, 2, 47, "Output"]
}, Open ]]
}, Open ]]
}, Open ]]
}
]
*)
(* End of internal cache information *)
{
"author"->
{
"name" -> "lshifr",
"email" -> "lshifr@gmail.com",
"url" -> "http://www.mathprogramming-intro.org"
},
"name" -> "OO",
"mathematica_version" -> "8.0+",
"description" -> "Simple object-oriented extension for Mathematica",
"url" -> "https://gist.github.com/4266126"
}
@lshifr
Copy link
Author

lshifr commented Dec 12, 2012

Current treatment of $super is bad. A new instance is created when a method from a super-type has to be executed. Not only does this cause an overhead, but it won't work properly for instances with dynamically added methods. A different mechanism is needed here, perhaps based on vtable (just as the method lookup itself - perhaps we could piggyback on that one)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment