Common Lisp loop in the D programming lanugage (WIP)

1main.d

import std.algorithm;
import std.stdio;
import std.typecons;

import cl.loop;

void main(string[] args) {
    args = args[1 .. $];             // Get rid of the process name.

    int[] array = [1, 2, 3, 4, 5];

    mixin Loop!q{
      with array2 as result          // Declare the result.
      with max = 23                  // At most 23 iterations.
      with str = ". Hello "

      for arg in args
      for i from 0 to max
      for element in array
          print $$i, str, arg, "!"$$ // Embeded D code.

          do $$array[i] = i$$

          do $$                      // Multiple Do clauses.
              // Foreach? Why not!
              foreach(c; arg) {
                  if("Lisp".canFind(c)) write(c);
              }
              writeln();
          $$

          collect $$tuple(element, arg)$$
    };

    writeln(array);
    writeln(array2);
}

2output

$ ./loop Hello Common Lisp!
0. Hello Hello!

1. Hello Common!

2. Hello Lisp!!
Lisp
[0, 1, 2, 4, 5]
[Tuple!(int,string)(1, "Hello"), Tuple!(int,string)(2, "Common"), Tuple!(int,string)(3, "Lisp!")]

3gen.d

auto array2 = (() {
    auto max = 23;
    auto str = ". Hello ";
    auto __arg = 0;
    auto __arg_max = args.length;
    typeof(args.init[0]) arg;
    auto i = 0;
    auto __element = 0;
    auto __element_max = array.length;
    typeof(array.init[0]) element;
    typeof(tuple(element, arg))[] array2;

    for(;;) {
        if(__arg >= __arg_max) break;
        arg = args[__arg];
        if(i >= max) break;
        if(__element >= __element_max) break;
        element = array[__element];

        writeln(i, str, arg, "!");
        array[i] = i;
        // Multiple Do clauses.
              // Foreach? Why not!
              foreach(c; arg) {
                  if("Lisp".canFind(c)) write(c);
              }
              writeln();;
        array2 ~= tuple(element, arg);

        ++__arg;
        ++i;
        ++__element;
    }
    return array2;
})();

4loop.d

module cl.loop;

import std.string;
import pegged.grammar;

/*******************************************************************************
 * Loop grammar:
 * TODO Special case "with foo as result"
 * TODO Add hex numbers to Number.
 * TODO Extend DCode grammar.
 * TODO Lose the return value when it's not needed.
 * TODO Use range interfaces in ForIn loop.
 * TODO Add type constraints to make the error messages more useful.
 * TODO Add comments.
 * TODO Add While and Repeat loops.
 * TODO Add Return clause.
 * TODO Add AA support.
 * TODO Add If clause.
 ******************/

mixin(grammar(q{
    LoopCode     < (With / For / Print / Do / Return / Comment)* Collecting?

    With         < :"with" Variable (:"=" / :"as") (Atom / DCode)
    For          < :"for" Variable (ForIn / FromTo)
    ForIn        < :"in" (Variable / String)
    FromTo       < :"from" Atom :"to" Atom

    Print        < (:"print" / :"printing") (Atom / DCode)

    Do           < (:"do" / :"doing") DCode

    Return       < :"return" (Atom / DCode)

    Collecting   < (:"collect" / :"collecting") (Atom / DCode)

    Atom         < Number / String / Variable

    Number       <~ Floating ( ('e' / 'E') )?
    Floating     <~ Integer ('.' Unsigned)?
    Unsigned     <~ [0-9]+
    Integer      <~ Sign? Unsigned
    Sign         <- '-' / '+'

    String       <~ DoubleQuote (!DoubleQuote Char)* DoubleQuote
    Char         <~ BackSlash ( DoubleQuote
                              / Quote
                              / BackSlash
                              / [bfnrt]
                              / [0-2][0-7][0-7]
                              / [0-7][0-7]?
                              / 'x' Hex Hex
                              / 'u' Hex Hex Hex Hex
                              / 'U' Hex Hex Hex Hex Hex Hex Hex Hex
                              )
                    / Anything
    Hex          <~ [0-9a-fA-F]

    Variable     <~ Identifier

    DCode        <~ :DEscape (!DEscape Anything)* :DEscape
    DEscape      < "$$"

    Anything     <~ .

    Comment      <~ Slash Slash (!'\n' Anything)* '\n'
}));

/*******************************************************************************
 * Compiles loop code into valid D code.
 ******************/

string compile(string code) {
    auto o = LoopCode.parse(code).parseTree;

    // Used to make the code readable:
    dstring ind(uint depth) {
        enum bodyIndent = "    ";
        dstring result = "";
        foreach(i; 0 .. depth) result ~= bodyIndent;
        return result;
    }

    dstring loopResult = "result";      // The result of the loop (if needed).
    bool resultDeclared = false;

    dstring loopPre = "";               // Anything that happens before the loop.
    dstring loopHeader = "";            // Header of the loop body.
    dstring loopBody = "";              // Working loop body.
    dstring loopFooter = "";            // Footer of the loop body.
    dstring loopPost = "";              // Anything that happens after the loop.

    // Code generation goes here:
    foreach(ref decl; o.children) {
        switch(decl.ruleName) {
            case "With":
                 dstring var = decl.capture[0];
                 dstring value = decl.capture[1];

                 if(value == "result") loopResult = var;
                 else loopPre ~= ind(1) ~ "auto " ~ var ~ " = " ~ value ~ ";\n";
            break;

            case "For":
                 dstring var = decl.capture[0];
                 auto loopVariant = decl.children[1];

                 switch(loopVariant.ruleName) {
                     case "ForIn":
                          dstring range = loopVariant.capture[0];

                          loopPre    ~= ind(1) ~ "auto __" ~ var ~ " = 0;\n";
                          loopPre    ~= ind(1) ~ "auto __" ~ var ~ "_max = " ~ range ~".length;\n";
                          loopPre    ~= ind(1) ~ "typeof(" ~ range ~ ".init[0]) " ~ var ~ ";\n";
                          loopHeader ~= ind(2) ~ "if(__" ~ var ~ " >= __" ~ var ~ "_max) break;\n";
                          loopHeader ~= ind(2) ~ var ~ " = " ~ range ~ "[__" ~ var ~ "];\n";
                          loopFooter ~= ind(2) ~ "++__" ~ var ~ ";\n";
                     break;

                     case "FromTo":
                          dstring low = loopVariant.capture[0];
                          dstring high = loopVariant.capture[1];

                          loopPre    ~= ind(1) ~ "auto " ~ var ~ " = " ~ low ~ ";\n";
                          loopHeader ~= ind(2) ~ "if(" ~ var ~ " >= " ~ high ~ ") break;\n";
                          loopFooter ~= ind(2) ~ "++" ~ var ~ ";\n";
                     break;

                     default: assert(0, "Unrecognized For loop variant.");
                 }
            break;

            case "Print":
                 loopBody ~= ind(2) ~ "writeln(" ~ strip(decl.capture[0]) ~ ");\n";
            break;

            case "Do":
                 loopBody ~= ind(2) ~ strip(decl.capture[0]) ~ ";\n";
            break;

            case "Return":
                 loopBody ~= ind(2) ~ "return " ~ strip(decl.capture[0]) ~ ";\n";
            break;

            case "Collecting":
                 dstring value = strip(decl.capture[0]);

                 if(!resultDeclared) {
                     loopPre  ~= ind(1) ~ "typeof(" ~ value ~ ")[] " ~ loopResult ~ ";\n";
                     loopBody ~= ind(2) ~ loopResult ~ " ~= " ~ value ~ ";\n";
                     resultDeclared = true;
                 }
                 else assert(0, "Can only collect one item at a time.");
            break;

            case "Comment": break; // Nothing to compile.

            default: assert(0, "Unrecognized Loop declaration.");
        }
    }

    if(!resultDeclared) {
        loopPre ~= ind(1) ~ "uint " ~ loopResult ~ " = 0xDEAD_BEEF;\n";
    }

    loopPost ~= ind(1) ~ "return " ~ loopResult ~ ";\n";

    // Delegate and type inference magic:
    dstring result = "auto " ~ loopResult ~ " = (() {\n"
                   ~ loopPre ~ "\n"
                   ~ ind(1) ~ "for(;;) {\n"
                   ~ loopHeader ~ "\n"
                   ~ loopBody ~ "\n"
                   ~ loopFooter
                   ~ ind(1) ~ "}\n"
                   ~ loopPost
                   ~ "})();";

    return to!string(result);
}

/*******************************************************************************
 * Conviniece template to make the use cases neat.
 ******************/

mixin template Loop(string code) {
    enum dcode = compile(code);

    pragma(msg, dcode);

    mixin(dcode);
}

unittest {
    import std.stdio;
    auto array0 = [1, 2, 3, 4, 5];

    mixin Loop!q{
        with array1 as result
        for i in array0
        collect i
    };

    assert(array0 == array1);

    mixin Loop!q{
        with array2 as result
        with len = $$array0.length$$
        with foo = 0

        for i from 0 to len
        do $$foo = array0[i]^^2$$
        collect foo
    };

    assert(array2 == [1, 4, 9, 16, 25]);
}