Toy register machine based VM in D (Translate the OCaml version into D) (OCaml Version : https://gist.github.com/alphaKAI/e916c7c540817c4b3d119d7f095f29b9)

vm.d

import std.algorithm;
import std.string;
import std.array;
import std.regex;
import std.range;
import std.stdio;

struct Stack(T) {
  T[] stack;

  @property T pop() {
    T t = stack[$ - 1];
    stack.length--;
    return t;
  }

  @property size_t length() {
    return stack.length;
  }

  @property void push(T value) {
    stack ~= value;
  }

  @property bool empty() {
    return stack.empty;
  }

  @property T front() {
    return pop;
  }

  @property void popFront() {
    pop;
  }

  @property void popAll() {
    foreach (_; this) {
    }
  }
}

struct Registers {
  int a;
  int b;
  int c;
  int d;
  int e;
  int f;
}

enum Register {
  A,
  B,
  C,
  D,
  E,
  F
}

enum InstructionType {
  Func,
  CallF,
  CallFA,
  CallFAR,
  HLT,
  Print,
  Eq,
  Neq,
  Leq,
  Geq,
  Lt,
  Gt,
  EqI,
  NeqI,
  LeqI,
  GeqI,
  LtI,
  GtI,
  If,
  RetR,
  RetI,
  AddR,
  AddI,
  SubR,
  SubI,
  MulR,
  MulI,
  MovR,
  MovI,
  PopTo,
  PushR,
  PushI
}

interface Instruction {
  InstructionType type();
}

class Func : Instruction {
  int id;
  Instruction[] proc;
  this(int id, Instruction[] proc) {
    this.id = id;
    this.proc = proc;
  }

  InstructionType type() {
    return InstructionType.Func;
  }
}

Instruction func(int id, Instruction[] proc) {
  return new Func(id, proc);
}

class CallF : Instruction {
  int id;
  this(int id) {
    this.id = id;
  }

  InstructionType type() {
    return InstructionType.CallF;
  }
}

Instruction callf(int id) {
  return new CallF(id);
}

class CallFA : Instruction {
  int id;
  int[] args;
  this(int id, int[] args) {
    this.id = id;
    this.args = args;
  }

  InstructionType type() {
    return InstructionType.CallFA;
  }
}

Instruction callfa(int id, int[] args) {
  return new CallFA(id, args);
}

class CallFAR : Instruction {
  int id;
  Register[] args;
  this(int id, Register[] args) {
    this.id = id;
    this.args = args;
  }

  InstructionType type() {
    return InstructionType.CallFAR;
  }
}

Instruction callfar(int id, Register[] args) {
  return new CallFAR(id, args);
}

class HLT : Instruction {
  InstructionType type() {
    return InstructionType.HLT;
  }
}

HLT hlt() {
  return new HLT;
}

string opR(string className)() {
  string helperName = className.toLower;
  return `
    class ` ~ className ~ ` : Instruction {
      Register r;
      this(Register r) {
        this.r = r;
      }

      InstructionType type() {
        return InstructionType.` ~ className ~ `;
      }
    }
    
    Instruction ` ~ helperName
    ~ `(Register r) {
      return new ` ~ className ~ `(r);
    }`;
}

string opI(string className)() {
  string helperName = className.toLower;
  return `
    class ` ~ className ~ ` : Instruction {
      int i;
      this(int i) {
        this.i = i;
      }

      InstructionType type() {
        return InstructionType.` ~ className ~ `;
      }
    }
    
    Instruction ` ~ helperName
    ~ `(int i) {
      return new ` ~ className ~ `(i);
    }`;
}

string opR2(string className)() {
  string helperName = className.toLower;
  return `
    class ` ~ className ~ ` : Instruction {
      Register r1, r2;
      this(Register r1, Register r2) {
        this.r1 = r1;
        this.r2 = r2;
      }

      InstructionType type() {
        return InstructionType.` ~ className ~ `;
      }
    }

    Instruction ` ~ helperName
    ~ `(Register r1, Register r2) {
      return new ` ~ className ~ `(r1, r2);
    }`;
}

string opRI(string className)() {
  string helperName = className.toLower;
  return `
    class ` ~ className ~ ` : Instruction {
      Register r;
      int i;
      this(Register r, int i) {
        this.r = r;
        this.i = i;
      }

      InstructionType type() {
        return InstructionType.` ~ className ~ `;
      }
    }
    
    Instruction ` ~ helperName
    ~ `(Register r, int i) {
      return new ` ~ className ~ `(r, i);
    }`;
}

mixin(opR!("Print"));
mixin(opR2!("Eq"));
mixin(opR2!("Neq"));
mixin(opR2!("Leq"));
mixin(opR2!("Geq"));
mixin(opR2!("Lt"));
mixin(opR2!("Gt"));
mixin(opRI!("EqI"));
mixin(opRI!("NeqI"));
mixin(opRI!("LeqI"));
mixin(opRI!("GeqI"));
mixin(opRI!("LtI"));
mixin(opRI!("GtI"));

class If : Instruction {
  Register r;
  Instruction[][] insts;
  this(Register r, Instruction[][] insts) {
    this.r = r;
    this.insts = insts;
  }

  InstructionType type() {
    return InstructionType.If;
  }
}

Instruction _if(Register r, Instruction[][] insts) {
  return new If(r, insts);
}

mixin(opR!("RetR"));
mixin(opI!("RetI"));
mixin(opR2!("AddR"));
mixin(opRI!("AddI"));
mixin(opR2!("SubR"));
mixin(opRI!("SubI"));
mixin(opR2!("MulR"));
mixin(opRI!("MulI"));
mixin(opR2!("MovR"));
mixin(opRI!("MovI"));
mixin(opR!("PopTo"));
mixin(opR!("PushR"));
mixin(opI!("PushI"));

Stack!int stack = Stack!int();
Registers registers;
Instruction[][int] functions;

void setRegister(Register r, int v) {
  final switch (r) with (Register) {
  case A:
    registers.a = v;
    break;
  case B:
    registers.b = v;
    break;
  case C:
    registers.c = v;
    break;
  case D:
    registers.d = v;
    break;
  case E:
    registers.e = v;
    break;
  case F:
    registers.f = v;
    break;
  }
}

int getRegister(Register r) {
  final switch (r) with (Register) {
  case A:
    return registers.a;
  case B:
    return registers.b;
  case C:
    return registers.c;
  case D:
    return registers.d;
  case E:
    return registers.e;
  case F:
    return registers.f;
  }
}

void popTo(ref Stack!int stack, Register r) {
  if (stack.empty) {
    setRegister(r, 0);
  }
  else {
    int x = stack.pop;
    setRegister(r, x);
  }
}

void reduceStack(ref Stack!int stack, int result, int function(int, int) f) {
  if (stack.empty) {
    stack.push(result);
  }
  else {
    int x = stack.pop;
    reduceStack(stack, f(result, x), f);
  }
}

void saveFunction(int id, Instruction[] insts) {
  functions[id] = insts;
}

Instruction[] getFunction(int id) {
  return functions[id];
}

/*
  関数を呼ぶ場合，
  F -> 第1引数
  E -> 第2引数
  D -> 第3引数
  C -> 第4引数
*/

void setArgs(int[] args) {
  with (Register) {
    Register[] rs = [F, E, D, C];
    foreach (i, v; args) {
      setRegister(rs[i], v);
    }
  }
}

void compOpR2(T, alias pred)(Instruction inst) {
  T v = cast(T)inst;
  Register x = v.r1, y = v.r2;
  if (pred(getRegister(x), getRegister(y))) {
    setRegister(Register.B, 1);
  }
  else {
    setRegister(Register.B, 0);
  }
}

void compOpRI(T, alias pred)(Instruction inst) {
  T v = cast(T)inst;
  Register x = v.r;
  int y = v.i;
  if (pred(getRegister(x), y)) {
    setRegister(Register.B, 1);
  }
  else {
    setRegister(Register.B, 0);
  }
}

void arithmaticOpR2(T, alias pred)(Instruction inst) {
  T v = cast(T)inst;
  Register x = v.r1, y = v.r2;
  setRegister(Register.A, pred(getRegister(x), getRegister(y)));
}

void arithmaticOpRI(T, alias pred)(Instruction inst) {
  T v = cast(T)inst;
  Register x = v.r;
  int y = v.i;
  setRegister(Register.A, pred(getRegister(x), y));
}

void run(Instruction[] prog) {
  if (prog.empty) {
    //writeln("No more instruction");
  }
  else {
    Instruction inst = prog[0];
    Instruction[] rest = prog[1 .. $];

    final switch (inst.type) {
    case InstructionType.Func:
      Func func = cast(Func)inst;
      int id = func.id;
      Instruction[] proc = func.proc;
      saveFunction(id, proc);
      run(rest);
      break;
    case InstructionType.CallF:
      CallF callf = cast(CallF)inst;
      int id = callf.id;
      getFunction(id).run;
      run(rest);
      break;
    case InstructionType.CallFA:
      CallFA callfa = cast(CallFA)inst;
      int id = callfa.id;
      int[] args = callfa.args;
      setArgs(args);
      getFunction(id).run;
      run(rest);
      break;
    case InstructionType.CallFAR:
      CallFAR callfar = cast(CallFAR)inst;
      int id = callfar.id;
      Register[] args = callfar.args;
      args.map!(x => getRegister(x)).array.setArgs;
      getFunction(id).run;
      run(rest);
      break;
    case InstructionType.HLT:
      writeln("execution stopped");
      break;
    case InstructionType.Print:
      Print print = cast(Print)inst;
      Register r = print.r;
      writefln("%s : %d", r, getRegister(r));
      run(rest);
      break;
    case InstructionType.Eq:
      compOpR2!(Eq, ((int x, int y) => x == y))(inst);
      run(rest);
      break;
    case InstructionType.Neq:
      compOpR2!(Neq, ((int x, int y) => x != y))(inst);
      run(rest);
      break;
    case InstructionType.Leq:
      compOpR2!(Leq, ((int x, int y) => x <= y))(inst);
      run(rest);
      break;
    case InstructionType.Geq:
      compOpR2!(Geq, ((int x, int y) => x >= y))(inst);
      run(rest);
      break;
    case InstructionType.Lt:
      compOpR2!(Lt, ((int x, int y) => x < y))(inst);
      run(rest);
      break;
    case InstructionType.Gt:
      compOpR2!(Lt, ((int x, int y) => x > y))(inst);
      run(rest);
      break;
    case InstructionType.EqI:
      compOpRI!(EqI, ((int x, int y) => x == y))(inst);
      run(rest);
      break;
    case InstructionType.NeqI:
      compOpRI!(NeqI, ((int x, int y) => x != y))(inst);
      run(rest);
      break;
    case InstructionType.LeqI:
      compOpRI!(LeqI, ((int x, int y) => x <= y))(inst);
      run(rest);
      break;
    case InstructionType.GeqI:
      compOpRI!(GeqI, ((int x, int y) => x >= y))(inst);
      run(rest);
      break;
    case InstructionType.LtI:
      compOpRI!(LtI, ((int x, int y) => x < y))(inst);
      run(rest);
      break;
    case InstructionType.GtI:
      compOpRI!(GtI, ((int x, int y) => x > y))(inst);
      run(rest);
      break;
    case InstructionType.If:
      If _if = cast(If)inst;
      Register r = _if.r;
      Instruction[][] insts = _if.insts;

      if (getRegister(r) == 1) {
        run(insts[0]);
      }
      else if (insts.length == 2) {
        run(insts[1]);
      }
      run(rest);
      break;
    case InstructionType.RetR:
      RetR retr = cast(RetR)inst;
      Register x = retr.r;
      setRegister(Register.A, (getRegister(x)));
      run(rest);
      break;
    case InstructionType.RetI:
      RetI reti = cast(RetI)inst;
      int x = reti.i;
      setRegister(Register.A, x);
      run(rest);
      break;
    case InstructionType.AddR:
      arithmaticOpR2!(AddR, ((int x, int y) => x + y))(inst);
      run(rest);
      break;
    case InstructionType.AddI:
      arithmaticOpRI!(AddI, ((int x, int y) => x + y))(inst);
      run(rest);
      break;
    case InstructionType.SubR:
      arithmaticOpR2!(SubR, ((int x, int y) => x - y))(inst);
      run(rest);
      break;
    case InstructionType.SubI:
      arithmaticOpRI!(SubI, ((int x, int y) => x - y))(inst);
      run(rest);
      break;
    case InstructionType.MulR:
      arithmaticOpR2!(MulR, ((int x, int y) => x * y))(inst);
      run(rest);
      break;
    case InstructionType.MulI:
      arithmaticOpRI!(MulI, ((int x, int y) => x * y))(inst);
      run(rest);
      break;
    case InstructionType.MovR:
      MovR movr = cast(MovR)inst;
      Register x = movr.r1, y = movr.r2;
      setRegister(x, getRegister(y));
      run(rest);
      break;
    case InstructionType.MovI:
      MovI movi = cast(MovI)inst;
      Register x = movi.r;
      int y = movi.i;
      setRegister(x, y);
      run(rest);
      break;
    case InstructionType.PopTo:
      PopTo popto = cast(PopTo)inst;
      Register r = popto.r;
      popTo(stack, r);
      run(rest);
      break;
    case InstructionType.PushR:
      PushR pr = cast(PushR)inst;
      stack.push(getRegister(pr.r));
      run(rest);
      break;
    case InstructionType.PushI:
      PushI pi = cast(PushI)inst;
      stack.push(pi.i);
      run(rest);
      break;
    }
  }
}

void main() {
  /*
  Func#1 is same as
  let rec fact n =
    if n = 0 then 1
    else
      let m = n - 1 in
      let k = fact m in
      return n * k;;
  
  [
    func(1, [
      eqi(F, 0),
      _if(B, [[
        reti(1)
      ], [
        subi(F, 1),
        movr(D, A),
        pushr(F),
        callfar(1, [D]),
        popto(E),
        mulr(E, A),
        retr(A)]
      ])
    ]),
    callfa(1, [10]),
    print(A)
  ]
*/
  with (Register) {
    Instruction[] program = [func(1, [eqi(F, 0), _if(B, [[reti(1)], [subi(F,
        1), movr(D, A), pushr(F), callfar(1, [D]), popto(E), mulr(E, A), retr(A)]])]),
      callfa(1, [10]), print(A)];
    run(program);
  }
}