Пример работы с типами (внутри макроса)
От: VladD2 Российская Империя www.nemerle.org
Дата: 05.10.11 21:07
Оценка:
На англоязычном форуме задали вопрос как сгенерировать методы для ООП-ного решения так называемой "Expression problem".

Откровенно говоря никогда не мог понять значимость этой проблемы. И нафиг оно нужно вообще. Но реализация макроса, который хотел написать автор темы, отлично демонстрирует работу с базовыми типами.

Надеюсь, что этот пример поможет кому-то при создании своих макросов.

Оригинальная тема (в ней можно найти код проекта для VS 2010).

Код дублирую здесь, так как там нет подсветки и вообще код выглядит криво.

Макрос
  Скрытый текст
using Nemerle;
using Nemerle.Collections;
using Nemerle.Compiler;
using Nemerle.Compiler.Parsetree;
using Nemerle.Compiler.Typedtree;
using Nemerle.Text;
using Nemerle.Utility;

using System;
using System.Collections.Generic;
using System.Linq;

namespace ExprProblemMacros
{
  [MacroUsage(MacroPhase.BeforeTypedMembers, MacroTargets.Class)]
  macro ImplementIsAs(typeBuilder : TypeBuilder)
  {
    ImplementIsAsImpl.DoTransform(Macros.ImplicitCTX(), typeBuilder)
  }
  
  module ImplementIsAsImpl
  {
    public DoTransform(typer : Typer, typeBuilder : TypeBuilder) : void
    {
      Macros.DefineCTX(typer);
      //assert2(false); // uncomment to debug

      def defineMethod(ast : ClassMember) : void { typeBuilder.Define(ast) }
      //def defineMethod(ast : ClassMember) : void { _ = typeBuilder.DefineWithSource(ast) } // use to debug...
      def toCamelCase(str : string) : string
      {
        if (str.Length == 0) 
          str
        else if (str.Length > 1 && str[0] == 'I')
          $"$(char.ToLower(str[1]))$(str.Substring(2))"
        else if (char.IsUpper(str[0]))
          $"$(char.ToLower(str[0]))$(str.Substring(1))"
        else
          str + "_"
      }
      def toPascalCase(str : string) : string
      {
        if (str.Length == 0) 
          str
        else if (str.Length > 1 && str[0] == 'I')
          $"$(char.ToUpper(str[1]))$(str.Substring(2))"
        else
          $"$(char.ToUpper(str[0]))$(str.Substring(1))"
      }
      def typeParamToNames(typeParameter : TypeVar) : TypeVar * string * string
      {
        | FixedType.StaticTypeVarRef(typeArg) when !typeArg.Constraints.IsEmpty => 
          def baseType     = typeArg.Constraints.Head;
          def baseTypeName = baseType.ToString();
          def paramName    = toCamelCase(baseTypeName);
          def methodSufix  = toPascalCase(baseTypeName);
        
          (baseType, paramName, methodSufix)
              
        | _ => Message.FatalError(typeBuilder.NameLocation, "ImplementIsAs: The type parameter must have one constraint.");
      }
      
      if (typeBuilder.TyparmsCount == 1)
      {
        unless (typeBuilder.Attributes %&& NemerleModifiers.Abstract)
          Message.FatalError(typeBuilder.NameLocation, "ImplementIsAs: Type must be abstract.");
          
        def selfType = typeBuilder.GetMemType();
        def typeParam = selfType.args.Head;
        def  (baseType, paramName, methodSufix) = typeParamToNames(typeParam);
        defineMethod(<[ decl: 
          public abstract $("is" + methodSufix : usesite)($(paramName : usesite) : $(baseType : typed)) : bool;]>);

        defineMethod(<[ decl: 
          public abstract $("as" + methodSufix : usesite)($(paramName : usesite) : $(baseType : typed)) : $(typeParam : typed);]>);
      }
      else
      {
        def instantiatedSupertype = typeBuilder.BaseClass;
        unless (instantiatedSupertype.args is [_])
          Message.FatalError(typeBuilder.NameLocation, "ImplementIsAs: Expected supertype with one type parameter specified.");
        def castToType = instantiatedSupertype.args.Head;

        def supertype = typeBuilder.BaseType.GetMemType(); // non instantiated supertype
        unless (supertype.args is [_])
          Message.FatalError(typeBuilder.NameLocation, "ImplementIsAs: The supertype of this type must have one type parameter.");

        def  (baseType, paramName, methodSufix) = typeParamToNames(supertype.args.Head);
        defineMethod(<[ decl: 
          public override $("is" + methodSufix : usesite)($(paramName : usesite) : $(baseType : typed)) : bool
          {
            // Should work macro operator "is":
            // $(paramName : usesite) is $(castToType : typed)
            // But it does not work. It is a bug.
            // Use direct pattern matching instead:
            match ($(paramName : usesite))
            {
              | _ is $(castToType : typed) => true
              | _ => false
            }
          }]>);

        defineMethod(<[ decl: 
          public override $("as" + methodSufix : usesite)($(paramName : usesite) : $(baseType : typed)) : $(castToType : typed)
          {
            $(paramName : usesite) :> $(castToType : typed)
          }]>);
      }
    }
  }
}


Использование
  Скрытый текст
using Nemerle.Collections;
using Nemerle.Text;
using Nemerle.Utility;

using System;
using System.Collections.Generic;
using System.Console;
using System.Linq;

using ExprProblemMacros;

public interface IExpr
{
  handle(v: IVisitor) : void;
}

public interface IVisitor
{
  apply(e: IExpr): void;
  vdefault(e: IExpr): void;
}

[ImplementIsAs]
public abstract class Node[V] : IExpr where V : IVisitor
{
  public handle(v: IVisitor) : void
  {
    if (isVisitor(v))
      accept(asVisitor(v));
    else
      v.vdefault(this);
  }
  
  public abstract accept(v: V): void;
}

[ImplementIsAs]
public abstract class Op[E] : IVisitor where E: IExpr
{
  public apply(e: IExpr): void
  {
    if (isExpr(e))
      call(asExpr(e));
    else
      e.handle(this);
  }
  public abstract call(e: E): void;
  public vdefault(_e: IExpr) : void
  {
    throw ArgumentException("Expression problem occurred!");
  }
}

public interface IAleVisitor : IVisitor
{
  visitLit(lit: Lit): void;
  visitAdd(add: Add): void;
}

public interface IPrintExpr : IExpr
{
  print(print: Print): void;
}

[ImplementIsAs]
public class Print : Op[IPrintExpr], IVisitor
{
  public override call(e: IPrintExpr) : void { e.print(this); }
}

[ImplementIsAs, Record]
public class Lit : Node[IAleVisitor], IPrintExpr
{
  public mutable value: int;
  public print(_print: Print) : void { Write(value) }
  public override accept(v: IAleVisitor) : void { v.visitLit(this); }
}

[ImplementIsAs, Record]
public class Add : Node[IAleVisitor], IPrintExpr
{
  public mutable left: IExpr;
  public mutable right: IExpr;
  public print(print: Print) : void
  {
    print.apply(left); Write("+"); print.apply(right);
  }
  
  public override accept(v: IAleVisitor) : void
  {
    v.visitAdd(this);
  }
}

public interface IEvalExpr : IPrintExpr
{
  eval(eval: Eval) : int;
}

[ImplementIsAs]
public class Eval : Op[IEvalExpr], IAleVisitor
{
  mutable result: int;
  public eval(e: IExpr): int { apply(e); result; }
  public override call(e: IEvalExpr) : void { result = e.eval(this); }
  public visitLit(lit: Lit) : void{ result = lit.value; }
  public visitAdd(add: Add): void { result = eval(add.left) + eval(add.right); }
}

public interface INaleVisitor : IAleVisitor
{
  visitNeg(neg: Neg): void;
}

[ImplementIsAs, Record]
public class Neg : Node[INaleVisitor], IEvalExpr
{
  public mutable exp: IExpr;
  public print(print: Print): void
  {
    Write("-("); print.apply(exp); Write(")");
  }
  public eval(eval: Eval): int { -eval.eval(exp); }
  public override accept(v:INaleVisitor) : void { v.visitNeg(this); }
}

class ExpressionProblem
{
  static Main() : void
  {
    def lit = Lit(5);
    def neg = Neg(lit);
    def eval = Eval();
    WriteLine(eval.eval(neg));
    _ = ReadLine();
  }
}
Есть логика намерений и логика обстоятельств, последняя всегда сильнее.
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.