Камил Скальски в пылу порыва рефакторинга компилятора реализовал еще один паттерн проектирования. На этот раз это "Абстрактаня фабрика".
Собстенно макрос так и незывается — AbstractFactory.
Пример использования:
http://nemerle.org/svn/nemerle/trunk/snippets/designpatt/factory.n
using Nemerle.DesignPatterns;
class X['a] {
public this (_x : int) { }
}
class Y {
public this (_x : int) { }
public this (_x : string) { }
}
class SX : X[int] {
public this (x : int) { base (x) }
}
class SY : Y {
public this (x : int) { base (x) }
public this (x : string) { base (x) }
}
class W ['a,'b] { }
class Z { }
[AbstractFactory (X[int],Y, W [_, string], System.Exception)]
class Factory { }
[AbstractFactory (Override (SX, X[int]), Override (SY, Y), Z)]
class SubFactory : Factory { }
mutable f : Factory = Factory ();
def sf = SubFactory ();
System.Console.WriteLine (f.CreateX (1));
System.Console.WriteLine (f.CreateY (1));
System.Console.WriteLine (f.CreateY ("aa"));
System.Console.WriteLine (f.CreateW ());
System.Console.WriteLine (f.CreateException ("aa"));
f = sf;
System.Console.WriteLine (f.CreateX (1));
System.Console.WriteLine (f.CreateY (1));
System.Console.WriteLine (f.CreateY ("aa"));
System.Console.WriteLine (f.CreateW ());
System.Console.WriteLine (sf.CreateZ ());
/*
BEGIN-OUTPUT
X`1[System.Int32]
Y
Y
W`2[System.Object,System.String]
System.Exception: aa
SX
SY
SY
W`2[System.Object,System.String]
Z
END-OUTPUT
*/
Исходник находится
здесь.
[Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeTypedMembers, Nemerle.MacroTargets.Class)]
macro AbstractFactory (tb : TypeBuilder, params classes : list [PExpr])
{
def interpret_generics (a, acc = ([], [])) {
match (a) {
| [] => (acc[0].Reverse (), acc[1].Reverse ())
| <[ _ ]> :: xs =>
def n = Macros.NewSymbol ();
def sym = <[ $(n : name) ]>;
interpret_generics (xs, (Splicable.Name (n) :: acc[0], sym :: acc [1]))
| x :: xs =>
interpret_generics (xs, (acc[0], x :: acc[1]))
}
}
def interpret_expr (e) {
| <[ $nm [..$generics] ]> =>
def (parms, args) = interpret_generics (generics);
(nm, parms, args, <[ $nm.[..$args] ]> )
| <[ Override ($current, $overriden) ]> =>
def (nm,parms,args,_) = interpret_expr (current);
(nm, parms, args, overriden)
| _ => (e, [], [], e)
}
def get_simple_name (e, nm) {
match (e) {
| <[ $e [..$_] ]>
| <[ $e . [..$_] ]>
| <[ $e ]> =>
match (Util.QidOfExpr (e)) {
| Some ((li, _)) => (li.Last, nm : object == e) // nm == e iff we didn't have Override specified
| _ => Message.FatalError (e.Location, $"invalid overriden type specified: $e");
}
}
}
def fetch_parameters_provider (tc : TypeInfo) {
| tc is TypeBuilder =>
mutable coll = [];
foreach (ClassMember.Function (head, _, _) as f in tc.GetParsedMembers (true))
when (f.Name == ".ctor" && (f.Attributes & NemerleAttributes.Public == NemerleAttributes.Public))
coll ::= (head : IParametersProvider);
if (coll.IsEmpty)
[Fun_header (tc.Location, null, null, [])] // empty ctor
else coll
| _ =>
tc.GetConstructors (BindingFlags.Instance | BindingFlags.Public | BindingFlags.DeclaredOnly).Map (_.GetHeader ())
}
foreach (expr in classes) {
def (nm, gparms, gargs, returned) = interpret_expr (expr);
match (Util.QidOfExpr (nm)) {
| Some ((li, _)) =>
match (tb.GlobalEnv.LookupType (li, tb, gargs.Length)) {
| Some (tc) =>
def (returned_name, is_base) = get_simple_name (returned, nm);
foreach (head in fetch_parameters_provider (tc)) {
def attrs = Modifiers (NemerleAttributes.Public, []);
if (is_base)
attrs.mods |= NemerleAttributes.Virtual;
else
attrs.mods |= NemerleAttributes.Override;
tb.Define (<[ decl:
..$attrs $("Create" + returned_name : usesite) [..$gparms] (..$(head.ParametersDeclarations)) : $returned
{
$nm .[..$gargs] (..$(head.ParametersReferences))
}
]>)
}
| _ => Message.Error (expr.Location, $"to generate factory methods, class names are required, which $nm is not");
}
| None =>
Message.Error (expr.Location, $"to generate factory methods, simple names are required, which $expr is not");
}
}
}
... << RSDN@Home 1.2.0 alpha rev. 637>>
30.01.07 17:58: Перенесено модератором из 'Декларативное программирование' — IT