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