Generators which allow spawning of new tasks, and some composability

cyclesim_spawning_generators.ml

#require "delimcc";;
#require "hardcaml,hardcaml-waveterm";;

open Delimcc
open HardCaml
open Api

type ('a, 'b) t = Done | More of 'a * ('b -> ('a, 'b) t)
                                      
let gen f =
  (*
   * Note: the first value to yield gets thrown away as the generator
   * has not yet started.
   *)
  let start _ =
    let p = Delimcc.new_prompt () in
    Delimcc.push_prompt p begin fun () ->
      f (fun x -> Delimcc.shift0 p (fun k -> More (x, k))); Done
    end in
  let next = ref start in

  fun rv ->
    match !next rv with
      | More (x, k) -> next := k; Some x
      | Done        -> None

(* type of testbench generators. [let foo = `gen (fun yield -> ... )] *)
type gen = [ `gen of ('a list -> unit) -> unit ] as 'a

(* wait n cycles (default 1), then run the generator *)
let delay ?(n=1) (`gen f) = `gen begin fun yield ->
  for i=0 to n-1 do
    yield [];
  done;
  f yield
end

(* run generators in sequence *)
let seq : (gen list -> gen) = fun l -> `gen begin fun yield ->
  List.iter (fun (`gen f) -> f yield) l
end

(* run the given generator for n cycles.  
   
   The generator can 'yield' new generators which will start running
   in the current cycle.
   
   If n is not specified, run until there are no more generators *)
let run ?n sim (driver : gen) = 
  let rec runsim' (n,m) drivers = 
    match drivers, n with
    | _, Some(n) when n = !m -> ()
    | [], None -> ()
    | _ -> 
      if drivers = [] then ()
      else
        let rec f = function
          | [] -> Cs.cycle sim; incr m; []
          | h::t -> 
            match h () with
            | Some (x:gen list) -> h :: f (t @ (List.map (fun (`gen x) -> gen x) x)) 
            | None -> f t
        in
        runsim' (n,m) (f drivers)
  in
  runsim' (n, ref 0) [(function `gen f -> gen f) driver]

(********************************************************************)

open Comb
open Seq

module W = HardCamlWaveTerm.Wave.Make(HardCamlWaveTerm.Wave.Bits(B))
module Ws = HardCamlWaveTerm.Sim.Make(B)(W)
module Widget = HardCamlWaveTerm.Widget.Make(B)(W)

open Printf

let f a b = reg r_sync enable (a +: b)
let g a b = reg r_sync enable (a *: b)

let a = input "a" 8
let b = input "b" 8
let x = input "x" 8
let y = input "y" 8
let c = output "c" (f a b)
let d = output "d" (g x y)
let circ = Circuit.make "foo" [c;d]
let sim = Cyclesim.make circ
let sim, waves = Ws.wrap sim 

let clear = Cs.in_port sim "clear"
let enable = Cs.in_port sim "enable"
let a = Cs.in_port sim "a"
let b = Cs.in_port sim "b"
let x = Cs.in_port sim "x"
let y = Cs.in_port sim "y"
let c = Cs.out_port_next sim "c"
let d = Cs.out_port_next sim "d"

(********************************************************************)

(********************************************************************)

(* reset, enable and start generators *)
let rec start_gen : gen = `gen begin fun yield ->
  clear := B.vdd;
  yield [];
  clear := B.gnd;
  enable := B.vdd;
  yield [
    delay add_gen; (* run adder inputs *)
    delay (seq [mul_gen; mul_gen]); (* run multiplier inputs, twice *)
    delay ~n:2 (show 'a' c); (* show adder output *)
    delay ~n:2 (show 'm' d); (* show multiplier output *)
  ]
end

(* set the adder inputs for 10 cycles *)
and add_gen = `gen begin fun yield ->
  for i=0 to 9 do
    a := B.consti 8 (i+1);
    b := B.consti 8 (i+1);
    yield [];
  done
end

(* set the multiplier inputs for 5 cycles *)
and mul_gen = `gen begin fun yield ->
  for i=0 to 4 do
    x := B.consti 8 (i+1);
    y := B.consti 8 (i+1);
    yield [];
  done
end

(* show outputs *)
and show s p = `gen begin fun yield ->
  while true do
    printf "%c = %i\n" s (B.to_int !p);
    yield []
  done
end

(* run testbench *)
let test () = 
  let () = run ~n:18 sim start_gen in
  let waveform = new Widget.waveform () in
  let waves = W.{ cfg={default with wave_width=2}; waves } in
  waveform#set_waves waves;
  Lwt_main.run @@ Widget.run_widget waveform