ocaml-mm-1, Ocaml - rextester

Language: Layout:

module Memory =
  struct
    type cells = int array

let size = 4
    let alloc () = Array.make size 0
  end

module type CPU =
  sig
    type process = Memory.cells -> unit

val process_1 : process
    val process_2 : process
    val process_3 : process
    val process_4 : process

type decision = Memory.cells -> bool

val decision_1 : decision
    val decision_2 : decision
    val decision_3 : decision
    val decision_4 : decision
  end

module Machine (CPU : CPU) =
  struct
    open CPU

type machine =
      { mutable cpu_state   : cpu_state
      ; mutable cpu_counter : int
      ;         memory      : Memory.cells }

let new_machine ?(cpu_state=Process_1) ?(cpu_counter=0) ?(memory_init=[||]) () =
      let memory = Memory.alloc () in
      for i = 0 to min (Memory.size - 1) (Array.length memory_init - 1) do
        memory.(i) <- memory_init.(i)
      done ;
      { cpu_state   = cpu_state
      ; cpu_counter = cpu_counter
      ; memory      = memory }

let cpu process machine =
      process machine.memory ;
      { machine with cpu_counter = machine.cpu_counter + 1 }

let branch decision machine =
      (machine, decision machine.memory)

let yes y ~no (machine, flag) =
      { machine with cpu_state = if flag then y else no }

let ( ==> ) = ( |> )

let rec run machine =
      describe machine ;
      match machine.cpu_state with
      | Process_1 -> machine ==> cpu process_1 ==> branch decision_1 ==> yes Process_4 ~no: Process_3 ==> run
      | Process_2 -> machine ==> cpu process_2 ==> branch decision_2 ==> yes Process_3 ~no: Process_4 ==> run
      | Process_3 -> machine ==> cpu process_3 ==> branch decision_3 ==> yes Process_2 ~no: Process_1 ==> run
      | Process_4 -> machine ==> cpu process_4 ==> branch decision_4 ==> yes Stop      ~no: Process_2 ==> run
      | Stop      -> ()

and describe { cpu_state ; cpu_counter ; memory } =
      Printf.printf "Step: %2d    %-8s %s\n" cpu_counter (state_string cpu_state) (mem_string memory)

and mem_string mem =
      let str  = ref "" in
      for i = 0 to Memory.size - 1 do
        str := !str ^ Printf.sprintf " %3d" mem.(i)
      done ;
      !str

end

module Majestio_CPU : CPU =
  struct
    type process = Memory.cells -> unit

let process_1 mem =
      mem.(0) <- mem.(0) + 1

let process_2 mem =
      mem.(1) <- mem.(1) + mem.(3) + 1

let process_3 mem =
      let sum_0_1 = mem.(0) + mem.(1) in
      if sum_0_1 mod 3 <> 0 then
        mem.(2) <- mem.(2) + 7

let process_4 mem =
      let sum_0_2 = mem.(0) + mem.(2) in
      if sum_0_2 mod 5 <> 4 then
        mem.(3) <- mem.(3) + 1

type decision = Memory.cells -> bool

let sum = Array.fold_left (+) 0

let decision_1 mem =
      sum mem mod 2 = 0

let decision_2 mem =
      sum mem mod 7 > 0

let decision_3 mem =
      let is_even x = x mod 2 = 0 in
      Array.for_all is_even mem

let decision_4 mem =
      sum mem > 24

end

let main () =
  let module M = Machine (Majestio_CPU) in

M.new_machine () |> M.run ;
  print_endline "----------------------------------------------------------------" ;

M.new_machine
    ~cpu_state:   M.Process_4
    ~cpu_counter: 9
    ~memory_init: [| 3; 3; 14; 1 |]
    () |> M.run ;
  print_endline "----------------------------------------------------------------"

let () = main ()

Show compiler warnings [ + ] Show input
Compilation time: 0.12 sec, absolute running time: 0.16 sec, cpu time: 0.01 sec, memory peak: 5 Mb, absolute service time: 0,39 sec