Monadic Templates in D

gistfile1.d

import std.typecons;

template MakeNumberedValue(alias tag, alias val) {
  enum MakeNumberedValue = tuple(tag, val);
}

template NumberedValue(alias tv) {
  enum NumberedValue = tv[1];
}

template NumberedTag(alias tv) {
  enum NumberedTag = tv[0];
}

template Return(alias value) {
  template Return(alias counter) {
    alias MakeNumberedValue!(counter, value) Return;
  }
}

template Bind(alias M, alias F) {
  template Bind(alias counter) {
    enum t = NumberedTag!(M!counter);
    enum v = NumberedValue!(M!counter);
    alias F!v M1;

    alias M1!t Bind;
  }
}

template Increment(alias n) {
  enum Increment = MakeNumberedValue!(n+1, n);
}

template MakeNode(alias value, alias kids) {
  template __Lambda(alias counter) {
    alias Return!(tuple(MakeNumberedValue!(counter, value), kids)) __Lambda;
  }

  alias Bind!(Increment, __Lambda) MakeNode;
}

template BuildBtree(alias depth) {
  static if(depth == 0) {
    alias MakeNode!(depth, "leaf") BuildBtree;
  }
  else {
    template __Lambda1(alias left) {
      template __Lambda2(alias right) {
        alias MakeNode!(depth, tuple(left, right)) __Lambda2;
      }

      alias Bind!(BuildBtree!(depth-1), __Lambda2) __Lambda1;
    }

    alias Bind!(BuildBtree!(depth-1), __Lambda1) BuildBtree;
  }
}

template RunMonad(alias M, alias counter) {
  alias M!counter RunMonad;
}

void main() {
  enum numberedBinaryTree = RunMonad!(BuildBtree!3, 100);
  pragma(msg, numberedBinaryTree);

  /*
  Tuple(115,Tuple(
    Tuple(114,3),Tuple(Tuple(
      Tuple(106,2), Tuple(Tuple(
        Tuple(102,1),Tuple(Tuple(
          Tuple(100,0),"leaf"),Tuple(
          Tuple(101,0),"leaf"))),Tuple(
        Tuple(105,1),Tuple(Tuple(
          Tuple(103,0),"leaf"),Tuple(
          Tuple(104,0),"leaf"))))),Tuple(
      Tuple(113,2),Tuple(Tuple(
        Tuple(109,1),Tuple(Tuple(
          Tuple(107,0),"leaf"),Tuple(
          Tuple(108,0),"leaf"))),Tuple(
        Tuple(112,1),Tuple(Tuple(
          Tuple(110,0),"leaf"),Tuple(
          Tuple(111,0),"leaf"))))))))
  */
}