[Shootout-list] dispatch

[Jon Harrop]

I've just written a few OCaml implementations of the dispatch test. This is 
another test which computes a trivially reducible expression (the answer is 
450N) and, unsurprisingly, a line must be drawn completely arbitrary to 
determine which implementations are and are not allowed, i.e. "print(450*n)" 
is probably not allowed.

The following implementation uses:

1. A functional style (rather than the original imperative style).
2. Static typing via modules and functors rather than dynamically-typed 
objects.
3. Variant types instead of inheritance hierarchies (the same as my ray 
tracer).

At about 55LOC, the resulting program is much shorter than all other 
implementations and is probably faster. It can be argued that this is a valid 
and interesting submission on the basis that it uses static typing to evade 
run-time type tests.

This test can be written in many different ways in OCaml. Potentially, all are 
interesting. For example:

1. Objects can be used either imperatively or functionally.
2. HOFs can be used to replace the functor.
3. Records of functions can be used to replace objects/modules.

Anyway, here's the code:

module BottleState = struct
  type t = Empty | Full | Sealed
  let initial = Empty
  let next = function Empty -> Full | Full -> Sealed | Sealed -> Empty
  let tag = function Empty -> 1 | Full -> 2 | Sealed -> 3
end

module PressurizedBottleState = struct
  type t = Empty | Full | Unsealed | Sealed
  let initial = Empty
  let next = function
      Empty -> Full | Full -> Unsealed | Unsealed -> Sealed | Sealed -> Empty
  let tag = function Empty -> 4 | Full -> 5 | Unsealed -> 6 | Sealed -> 7
end

module Make = functor (State : sig
			 type t
			 val initial : t
			 val next : t -> t
			 val tag : t -> int
		       end) -> struct
  type t = { state: State.t; id: int }
  let initial_state = State.initial
  let empty b = { b with state = State.next b.state }
  let fill b = { b with state = State.next b.state }
  let seal b = { b with state = State.next b.state }
  let cycle b = empty (seal (fill b))
  let check b c = State.tag b.state + b.id + c
  let make id = { state = State.initial; id = id }
  let bottle_check b1 b2 b3 b4 b5 i =
    let c = i mod 2 in
    check (cycle b1) c + check (cycle b2) c + check (cycle b3) c +
      check (cycle b4) c + check (cycle b5) c
end

module Bottle = Make(BottleState)

module PressurizedBottle = struct
  include (Make(PressurizedBottleState))
  let pressurize b = { b with state = PressurizedBottleState.next b.state }
  let cycle b = empty (seal (pressurize (fill b)))
end

let () =
  let n = int_of_string Sys.argv.(1) in
  let [b0;b1;b2;b3;b4;b5;b6;b7;b8;b9] =
    List.map Bottle.make [0;1;2;3;4;5;6;7;8;9] in
  let [p0;p1;p2;p3;p4;p5;p6;p7;p8;p9] =
    List.map PressurizedBottle.make [0;1;2;3;4;5;6;7;8;9] in
  let check = ref 0 in
  for i=1 to n do
    check := !check + Bottle.bottle_check b1 b2 b3 b4 b5 i;
    check := !check + Bottle.bottle_check b6 b7 b8 b9 b0 i;
    check := !check + PressurizedBottle.bottle_check p1 p2 p3 p4 p5 i;
    check := !check - PressurizedBottle.bottle_check p6 p7 p8 p9 p0 i;
  done;
  print_endline (string_of_int !check)

-- 
Dr Jon D Harrop, Flying Frog Consultancy Ltd.
Objective CAML for Scientists
http://www.ffconsultancy.com/products/ocaml_for_scientists