weird.results.re

// include Example;
// include DCPS;

module DCPS = {
  type instr('b, 'a) =
    | Add(instr((int, 'rest), 'a)): instr((int, (int, 'rest)), 'a)
    | Sub(instr((int, 'rest), 'a)): instr((int, (int, 'rest)), 'a)
    | Gt(instr((bool, 'rest), 'a)): instr((int, (int, 'rest)), 'a)
    | If(instr('bef, 'aft), instr('bef, 'aft)): instr((bool, 'bef), 'aft)
    | Halt: instr('b, 'b);

  let rec eval: type b a. (instr(b, a), b) => a =
    (instr, stack) =>
      switch (instr, stack) {
      | (Add(k), (x, (y, rest))) => eval(k, (x + y, rest))
      | (Sub(k), (x, (y, rest))) => eval(k, (x - y, rest))
      | (Gt(k), (x, (y, rest))) => eval(k, (x > y, rest))
      | (If(left, _), (true, rest)) => eval(left, rest)
      | (If(_, right), (false, rest)) => eval(right, rest)
      | (Halt, stack) => stack
      };

  let example = Add(Gt(If(Sub(Halt), Add(Halt))));
};
module DCPS' = {
  type instr('b, 'a) =
    | Add: instr((int, (int, 'rest)), (int, 'rest))
    | Sub: instr((int, (int, 'rest)), (int, 'rest))
    | Gt: instr((int, (int, 'rest)), (bool, 'rest))
  and cont('b, 'a) =
    | Next(instr('b, 't), cont('t, 'a)): cont('b, 'a)
    | If(cont('bef, 'aft), cont('bef, 'aft)): cont((bool, 'bef), 'aft)
    | Halt: cont('a, 'a);

  let rec eval: type b a. (cont(b, a), b) => a =
    (cont, before) => {
      let eval_instr: type b t a. (instr(b, t), cont(t, a), b) => a =
        (instr, cont, stack) =>
          switch (instr, stack) {
          | (Add, (x, (y, rest))) => eval(cont, (x + y, rest))
          | (Sub, (x, (y, rest))) => eval(cont, (x - y, rest))
          | (Gt, (x, (y, rest))) => eval(cont, (x > y, rest))
          };
      switch (cont, before) {
      | (Next(current, cont), before) =>
        ([@inlined] eval_instr)(current, cont, before)
      | (If(left, _), (true, rest)) => eval(left, rest)
      | (If(_, right), (false, rest)) => eval(right, rest)
      | (Halt, before) => before
      };
    };

  let example = Next(Add, Next(Gt, If(Next(Sub, Halt), Next(Add, Halt))));
};

open Core;
open Core_bench;
let main = () => {
  Random.self_init();
  let a = Random.int(100);
  let b = Random.int(100);
  let c = Random.int(100);
  let d = Random.int(100);
  let e = Random.int(100);
  let input_a = (a, (b, (c, (d, (e, ())))));
  let input_b = (e, (d, (c, (b, (a, ())))));
  Command.run(
    Bench.make_command([
      Bench.Test.create(~name="dcps_a", () =>
        DCPS.eval(DCPS.example, input_a)
      ),
      Bench.Test.create(~name="dcps_b", () =>
        DCPS.eval(DCPS.example, input_b)
      ),
      Bench.Test.create(~name="dcps'_a", () =>
        DCPS'.eval(DCPS'.example, input_a)
      ),
      Bench.Test.create(~name="dcps'_a", () =>
        DCPS'.eval(DCPS'.example, input_b)
      ),
    ]),
  );
};

let () = main();

/*
┌─────────┬──────────┬─────────┬────────────┐
│ Name    │ Time/Run │ mWd/Run │ Percentage │
├─────────┼──────────┼─────────┼────────────┤
│ dcps_a  │   9.18ns │   9.00w │    100.00% │
│ dcps_b  │   9.05ns │   9.00w │     98.62% │
│ dcps'_a │   7.42ns │   9.00w │     80.82% │
│ dcps'_a │   7.64ns │   9.00w │     83.23% │
└─────────┴──────────┴─────────┴────────────┘
*/