hardcaml-waveterm simple waveform configuration

test_waveform.ml

#require "ppx_deriving_hardcaml,hardcaml-waveterm";;

open HardCaml
open Signal.Comb

module I = struct
  type 'a t = {
    arg_a : 'a[@bits 2];
    arg_b : 'a[@bits 2];
  }[@@deriving hardcaml]
end
module O = struct
  type 'a t = {
    xorer : 'a[@bits 1];
    ander : 'a[@bits 1];
    adder : 'a[@bits 2];
  }[@@deriving hardcaml]
end

let testcircuit i = 
  let open I in
  {
    O.xorer = lsb i.arg_a ^: lsb i.arg_b;
    O.ander = lsb i.arg_a &: lsb i.arg_b;
    O.adder = i.arg_a +: i.arg_b;
  }


(* standard set of modules needed for simulation with waveterm *)
module B = Bits.Comb.IntbitsList
module S = Cyclesim.Api
module W = HardCamlWaveTerm.Wave.Make(HardCamlWaveTerm.Wave.Bits(B))
module Ws = HardCamlWaveTerm.Sim.Make(B)(W)
module Widget = HardCamlWaveTerm.Widget.Make(B)(W)

(* short cut for quickly building the simulator *)
module G = Interface.Gen(B)(I)(O)

let testbench ?cfg () =

  (* build the simulator *)
  let circ, sim, i, o, n = G.make "mytest" testcircuit in

  (* record waveform data *)
  let sim, waves = Ws.wrap ?cfg sim in

  (* simulate *)
  let open I in
  for x=0 to 3 do
    for y=0 to 3 do
      i.arg_a := B.consti 2 x;
      i.arg_b := B.consti 2 y;
      S.cycle sim;
    done
  done;

  (* show the waveform *)
  Lwt_main.run (Widget.run W.({ cfg=default; waves})) 

(* show the waveform.  hardcaml will display signals in lexicographic order *)
let () = testbench ()

(* control the order of signal explictly; match the interface definition order *)
let () = testbench
  ~cfg:[
    "arg_a", W.B;
    "arg_b", W.B;
    "xorer", W.B;
    "ander", W.B;
    "adder", W.B;
  ] ()

(* as the previous test, but derive order automagically *)
let () = testbench
  ~cfg:(
    I.(to_list @@ map (fun (n,_) -> n,W.B) t) @
    O.(to_list @@ map (fun (n,_) -> n,W.B) t) 
  ) ()

(* ++++ A GOOD DEFALT ++++
   derive IO signal automatically and display 1 bit signals as lines,
   and multibit signals in hex *)
let fmt (n,b) = n, if b = 1 then W.B else W.H
let () = testbench
  ~cfg:(
    I.(to_list @@ map fmt t) @
    O.(to_list @@ map fmt t) 
  ) ()