[Nemerle] Метапрограммирование в действии - AbstractFactory
От: VladD2 Российская Империя www.nemerle.org
Дата: 20.01.07 13:42
Оценка: 1 (1)
Камил Скальски в пылу порыва рефакторинга компилятора реализовал еще один паттерн проектирования. На этот раз это "Абстрактаня фабрика".

Собстенно макрос так и незывается — 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
Есть логика намерений и логика обстоятельств, последняя всегда сильнее.
Re: [Nemerle] Метапрограммирование в действии - AbstractFact
От: ie Россия http://ziez.blogspot.com/
Дата: 21.01.07 04:44
Оценка: +1
Здравствуйте, VladD2, Вы писали:

VD>Камил Скальски в пылу порыва рефакторинга компилятора реализовал еще один паттерн проектирования. На этот раз это "Абстрактаня фабрика".


Камил — Мужик!

VD>Собстенно макрос так и незывается — AbstractFactory.


VD>
VD>[AbstractFactory (X[int],Y, W [_, string], System.Exception)]
VD>class Factory { }

VD>[AbstractFactory (Override (SX, X[int]), Override (SY, Y), Z)]
VD>class SubFactory : Factory { }
VD>


В идеале (для болшего соответсвия банде 4-х), следовало бы сделать 2 макроса: AbstractFactory и ConcreteFactory. В AbstractFactory убрать возможность Override, а сделать ее в ConcreteFactory. В ConcreteFactory, напротив, запретить возможность добавления новых фабричных методов.
... << RSDN@Home 1.2.0 alpha rev. 655>>
Превратим окружающую нас среду в воскресенье.
Re[2]: [Nemerle] Метапрограммирование в действии - AbstractF
От: konsoletyper Россия https://github.com/konsoletyper
Дата: 21.01.07 08:32
Оценка:
Здравствуйте, ie, Вы писали:

ie>Камил — Мужик!


+1

ie>В идеале (для болшего соответсвия банде 4-х), следовало бы сделать 2 макроса: AbstractFactory и ConcreteFactory. В AbstractFactory убрать возможность Override, а сделать ее в ConcreteFactory. В ConcreteFactory, напротив, запретить возможность добавления новых фабричных методов.


Да, ещё бы не помешало, чтобы AbstractFactory выдавал абстрактный класс или интерфейс.
... << RSDN@Home 1.1.4 stable SR1 rev. 568>>
Re[2]: [Nemerle] Метапрограммирование в действии - AbstractF
От: VladD2 Российская Империя www.nemerle.org
Дата: 21.01.07 12:46
Оценка:
Здравствуйте, ie, Вы писали:

ie>Камил — Мужик!


А ты сомневался? Таких страшных девочек я еще не видел.

ie>В идеале (для болшего соответсвия банде 4-х), следовало бы сделать 2 макроса: AbstractFactory и ConcreteFactory. В AbstractFactory убрать возможность Override, а сделать ее в ConcreteFactory. В ConcreteFactory, напротив, запретить возможность добавления новых фабричных методов.


Я думал над этом, но первое же использование показало, что астрактной фабрики по сути нет. Как нет и абстрактного интерфейса. Базовая фабрика создает конкретную фабрику, а подфабрики перегружют ее и изменяют поведение. Это наверно не так чисто как в описании. Но зачем плодить сущности сверх необходимости? Плюс каноническая реализация подразумевает создание базового класса, а это может оказаться не приемлемо в некоторых случаях (при наличии уже существующей иерархии например). Наследование довольно зесткая связь, и ее лучше избегать если это возможно.

Так что текущая реализация вполне разумна. Незнаю, стоит ли ломать копья?
... << RSDN@Home 1.2.0 alpha rev. 637>>
Есть логика намерений и логика обстоятельств, последняя всегда сильнее.
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.