
(*         Copyright (C) 1990  Eran Yehudai, Alexander C. K. Hsieh          *)

BeginPackage["Class`"];

SuperClass::usage = "SuperClass[cl] is a list (possibly empty) of
super-classes of the class cl."

ClassQ::usage = "ClassQ[cl] is True if cl is a class."

Properties::usage = "Properties[cl] is a list of properties associated
with the class cl."

SetProperties::usage = "SetProperties[cl, pname -> x] sets the
property pname to have a value x in the class cl.  SetProperties[cl,
{pname1 -> x1, pname2 -> x2,...}] sets the properties pname1,
pname2,... to have values x1, x2,... for the class cl."

SetClass::usage = "SetClass[cl] sets cl to be a class with no
super-class.  SetClass[cl, spr] sets cl to be a class with spr as its
super-class.  SetClass[cl, {spr1, spr2, ...}] sets cl to be a class
with spr1, spr2, ... as its super-classes.  SetClass[cl, spr, {prop1,
prop2, ...}] is the same as SetClass[cl, spr] followed by
SetProperties[cl, prop1, prop2, ...]."

SetClassDelayed::usage = "SetClassDelayed[cl] sets cl to be a class
with no super-class.  SetClassDelayed[cl, spr] sets cl to be a class
with spr as its super-class.  SetClassDelayed[cl, {spr1, spr2, ...}]
sets cl to be a class with spr1, spr2, ... as its super-classes.
SetClassDelayed is related to SetClass in the same way that SetDelayed
is related to Set."

ClearProperties::usage = "ClearProperties[cl, prop1, prop2, ...]
removes the properties prop1, prop2, ... from the class cl]."

DescendentQ::usage = "DescendentQ[cl, spr] is True if cl is a
descendent class of spr.  DescendentQ[spr][cl] is the same as
DescendentQ[cl, spr], but is more convenient in specifying patterns
e.g.  x_?DescendentQ[super] will match only descendents of super."

NewProperties::usage = "NewProperties[cl] are those properties of cl
which are NOT inherited."

Self::usage = "Self can be used in defining the properties of
super-classes.  In a property assignment it stands for one of it's
descendent classes and is used whenever the property requires a
property value of the descendent class which was not inherited by the
descendent class."


Begin["`Private`"];

SetClass[cl_, r__Rule] := SetClass[cl, {}, r]
SetClass[cl_, {r__Rule}] := SetClass[cl, {}, {r}]
SetClass[{cls__}, sprs___] := SetClass[#, sprs]& /@ {cls}
SetClass[cl_] := SetClass[cl, {}]
SetClass[cl_, spr_?ClassQ, props___] := SetClass[cl, {spr}, props]
SetClass[cl_, sprs:{(_?ClassQ)...}, props___] := (
	ClassQ[cl] ^= True;
	SuperClass[cl] ^= sprs;
        Properties[cl] ^= Flatten[{Properties /@ sprs, {props}}];
	Scan[defineProperty[First[#]]&, Flatten[{props}]];
	)

SetClassDelayed[cl_, r__Rule] := SetClassDelayed[cl, {}, r]
SetClassDelayed[cl_, {r__Rule}] := SetClassDelayed[cl, {}, {r}]
SetClassDelayed[{cls__}, sprs___] := SetClassDelayed[#, sprs]& /@ {cls}
SetClassDelayed[cl_] := SetClassDelayed[cl, {}]
SetClassDelayed[cl_, spr_?ClassQ, props___] := 
					SetClassDelayed[cl, {spr}, props]
SetClassDelayed[cl_, sprs:{(_?ClassQ)...}, props___] := (
	ClassQ[cl] ^= True;
	SuperClass[cl] ^= sprs;
        Properties[cl] ^:= Flatten[{Properties /@ sprs, {props}}];
	Scan[defineProperty[First[#]]&, Flatten[{props}]];
	)

defineProperty[p_Symbol] := (p[x_?ClassQ] := Block[{hpp = p /. Properties[x]},
	       (hpp /. Self->x) /; hpp =!= p])

SetProperties[cl_?ClassQ, props__] := (
	Properties[cl] ^= Flatten[Join[{props}, Properties[cl]]];
        Scan[defineProperty[First[#]]&, Flatten[{props}]])
		     
ClearProperties[cl_?ClassQ, props__] :=
	Properties[cl] ^= Select[Properties[cl],
		!MemberQ[{props}, First[#]]&]

DescendentQ[cl_?ClassQ, spr_?ClassQ] :=
	If[cl === spr, True, 
	Or @@ (DescendentQ[#, spr]&) /@ SuperClass[cl]]

DescendentQ[spr_?ClassQ] := (DescendentQ[#, spr]&)

End[];

EndPackage[]
