Inheritance in Mathematica using pattern matching on UpValues

Edit:

I think in my original post, I missed emphasizing the main point. This is mainly a pattern matching question. If you're interested in the 'why' of this question, please read the original post below. The short question:

Suppose I have a newly defined, unevaluated Head, called NewHead. I define a function associated with NewHead as (I add in the x & y to emphasize that the argument list can be arbitrary so long as it contains n_NewHead)

In[1]= NewHead /: func[x_, n_NewHead, y_] := n


This has

In[2]= UpValues[NewHead]
Out[2]= {HoldPattern[func[x_, n_NewHead, y_]] :> n}


I would like to use pattern matching so I can transform this UpValue list like

In[3]= UpValues[NewHead] /. (* Some pattern matching here resulting in: *)
Out[3]= {HoldPattern[func[x_, d_DerivedHead, y_]] :> func[x, d[[1]], y]}


The point is to make a 'class' DerivedHead that inherits all the functions of the 'class' NewHead. A NewHead object would be stored in Part 1 of a DerivedHead object. For an example, read the original post below.

The thing I can't figure out is how to pattern match on n_NewHead (in Out[2]) . The name of the pattern _NewHead can, in principle, be anything, and the argument list to func is similarly arbitrary.

Any advice is appreciated! - Seth

Original post below:

I have read some posts here on object oriented programming as well as many pattern matching posts, but nothing (I have found) seems to address this case, so I thought I'd ask a question.

I am trying to implement some features of object oriented programming in Mathematica, most notably inheritance. Imagine I have a polygon class with Head Poly created like

ToPoly[l : {{_, _} ..}] :=
Module[{},
If[Length@l < 3, Print["Poly object must have at least 3 points"]; Abort[]];
Poly @@ l
]


It has functions associated with it like (note TagSetDelayed)

distance[{x1_, y1_}, {x2_, y2_}] := Sqrt[(x2 - x1)^2 + (y2 - y1)^2]
Poly /: Perimeter[p_Poly] :=
Module[{pts, ptsShift},
pts = List @@ p;
ptsShift = Join[{Last@pts}, Most@pts];
]
Poly /: Vertices[p_Poly] := Length@p


Now, I want to create a quadrilateral sub-class with Head Quad. Suppose a Quad can have a color associated with it. So we have

ToQuad[l : {{_, _} ..}, color_String] :=
Module[{},
If[Length@l =!= 4, Print["Quad object must have exactly 4 points"]; Abort[]];
]



At this point, I would like to be able to inherit Perimeter and Vertices from the Poly class. Since they have been defined with TagSetDelayed, I can see those definitions using

UpValues[Poly]

(* {HoldPattern[Perimeter[p_Poly]] :>
Module[{pts, ptsShift}, pts = List @@ p;
ptsShift = Join[{Last[pts]}, Most[pts]];
HoldPattern[Vertices[p_Poly]] :> Length[p]} *)


Then, I want to define a function that assigns those UpValues to Quad like:

SuperClass[x_]:=x[[1]]
DefineDerivedClass[class_,superClass_]:=
Module[{},

]


So, after this is called like

DefineDerivedClass[Quad,Poly]


I would have

UpValues[Quad]



The problem is that I cannot figure out the pattern matching to turn the UpValues of Poly into the correct form for Quad for a generic pattern sequence. I can use Part to get inside the HoldPattern, but I cannot match on the p_Poly part. So far, the only way I can figure out to do this is by converting the UpValue expressions into strings, but that is very inelegant. Any ideas?

Thanks,

Seth

-
Like this? DefineDerivedClass[class_, superClass_] := Module[{uvs},(*Assign UpValues associated with superClass to class*) uvs = UpValues[superClass]; uvs = uvs /. superClass :> class; UpValues[class] = Join[UpValues[class], uvs] ] – Daniel Lichtblau Mar 13 '14 at 19:19
@DanielLichtblau: Thanks for your response, but that's not exactly what I'm looking for. I've posted an edit that will hopefully clarify things a bit. – shopper Mar 15 '14 at 14:16
Related: library.wolfram.com/infocenter/MathSource/671 I don't know if this would solve your problem, you would have to test. – faysou Mar 15 '14 at 22:56
@FaysalAberkane: Yeah, I was looking at that. It definitely has some elements of what I'm trying to do, but not everything. Perhaps more directly applicable is Leonid's impressive question/answer here: link My only problem with his OOP implementation is that the functionality he has provided yields a syntax that is much closer to C++ or Java than Mathematica. – shopper Mar 16 '14 at 13:48
Personally I use the ideas exposed in my answer here mathematica.stackexchange.com/a/999/66 with MyClass[object], methods are in the UpValues of MyClass and properties in the DownValues of object. I use the package I quoted above for inheritance. – faysou Mar 17 '14 at 9:42

I believe the crux of your problem is, as you say, how to match n_NewHead. Let's look at the FullForm:

FullForm[n_NewHead]

Pattern[n, Blank[NewHead]]


As you can see this is composed of Blank and Pattern, both of which are special heads with regard to pattern matching. You therefore need to wrap them in Verbatim to make a literal match:

MatchQ[
]

True


You can use the same methods to extract the parts:

n_NewHead /. Verbatim[Pattern][name_, Verbatim[Blank][head_]] :> {name, head}

{n, NewHead}


As a more complete example perhaps you want something like this:

SetAttributes[replace, HoldAll]

replace[old_, new_, body_] :=
Replace[
UpValues[old],
(lhs_ :> rhs_) :> (Replace[lhs,
Verbatim[Pattern][_, Verbatim[Blank][old]] :> new, {2}] :> body),
{1}
]


Now:

NewHead /: func[x_, n_NewHead, y_] := n


{HoldPattern[func[x_, d_DerivedHead, y_]] :> func[x, d[[1]], y]}