evaluation monitor in ocaml

Question

What I am trying to achieve is similar to a logging facility but for monitoring and streaming arbitrary data from a running simulation. Here is the simplified situation:

module Sim (V:VEC) = struct
  module V = V
  module M = struct type data = V.t end
  let loop n init_data = 
    let running_data = ref init_data in
    for _i = 1 to n do 
      (*?*) (* monitor here: data => outside world *)
      rdata := process_data !rdata
    done
end

While simulation loops, at the ? I may want to 'tap' data and accumulate it. Other times, I want to just let it run and disable the data stream with minimal overhead -- the ? is in a tight loop. So I want the streaming to be configurable with little cost.

What I have now is this:

module Sim (V:VEC) = struct
  module V = V
  module M = struct type data = V.t end
  let data_monitor : (M.data -> unit) ref = ref (fun d -> ())
  let loop n init_data = 
    let running_data = ref init_data in
    for _i = 1 to n do 
      !data_monitor !rdata; (* monitor here *)
      rdata := process_data !rdata
    done
end

Ie. I put a stub monitoring function reference in there. In the actual application script I can then assign a function which e.g. accumulates the data values into a list or some such. It works.

So the question is: is this the best/lowest overhead/nicest way to achieve what I want?

This approach seems a bit hackish, I would rather use the module system instead of function pointers. However, the data type to be streamed is only defined inside the functor Sim. So making a monitoring function in another module Sampler outside of Sim and parametrizing Sim by that, seems not convenient and/or requires duplication of code or recursive modules. I tried, but I was not able to make all types equal.

Edit: Here is roughly what it tried without function refs:

module Sampler (V:VEC) : sig
  module V : VEC
  type data = V.t
  val monitor_data : data -> unit
end 
with type data = V.t = struct
  module V = V
  type data = V.t
  let monitor_data data = store_away_the data
end

module Sim (V:VEC) (Sampler:??) : sig
  ...
end with type M.data = V.t

At the ?? I was not sure how to specify the output signature of Sampler, since the input signature VEC is still free; also I was not sure how exactly to make the type equality work. Maybe I'm doing it wrong here.

Answer 1

For completeness:

Building on the functor part of antron's answer, this is what I am currently using. It is still a bit involved, and maybe it could be made more concise, but it has some nice advantages. Namely: the monitoring of individual aspects can be switched on and off in a centralized place (a module of type SAMPLER) and arbitrary types can be exported, even if they become defined only somewhere inside the simulator module.

I define the monitoring (=sampling) modules and module types like so:

module type STYPE = sig type t end

module type SSAMPLER = sig
  type t
  val ev : t React.event
  val mon : t -> unit
end

module type SAMPLER_FN = functor (Data : STYPE) -> SSAMPLER
  with type t := Data.t

(* stub sampler function for a single one *)
module Never : SAMPLER_FN = functor (Data : STYPE) -> struct
  let ev = React.E.never
  let mon = ignore
end

(* event primitive generating sampling function *)
module Event : SAMPLER_FN = functor (Data : STYPE) -> struct
  let (ev : Data.t React.event), mon' = React.E.create ()
  let mon = mon' ?step:None
end

Here, I am using the React library to generate output streams of data. The React.E.never event does nothing and corresponds to sampling being switched off. Then the full sampling configuration is specified like so:

(* the full sampling config *)
module type SAMPLER = sig
  val sampler_pos : (module SAMPLER_FN)
  val sampler_step : (module SAMPLER_FN)
  (* and several more... *)
end

module NoSampling : SAMPLER = struct
  let sampler_pos = (module Never: SAMPLER_FN)
  let sampler_step = (module Never: SAMPLER_FN)
  (* ... *)
end

(* default sampling config *)
module DefaultSampling : SAMPLER = struct
  include NoSampling
  (* this is only possible when using first class modules *)
  let sampler_pos = (module Event : SAMPLER_FN)
end

One could avoid the first-class modules, but then the convenient inclusion and override in DefaultSampling would not be allowed.

In the simulation library code this is used like this:

module type VEC = sig
  type t
  val zeropos : t
  val wiggle : t -> t
end

module Sim (V:VEC) (Sampler:SAMPLER) = struct
  module V = V                  

  module M = struct
    type t = { mutable pos : V.t }
    val create () = { pos=V.zeropos }
    module Sampler_pos = (val Sampler.sampler_pos) (struct type nonrec t = t end)
    let update f m = m.pos <- f m.pos
  end

  module Sampler_b = (val Sampler.sampler_b) (struct type t = int end)

  let loop n (running_data:M.t) = 
    for i = 1 to n do 
      (* monitor step number: *)
      Sampler_b.mon i;
      (* monitor current pos: *)
      Sampler_pos.mon running_data;
      M.update V.wiggle running_data
    done 

end

Here, the sampling functors are applied at appropriate places in the simulation loop. (val ...) is again necessary only because of the first class module wrapping.

Finally, in an application script, one would then do this:

module Simulator = Sim (V) (DefaultSampling);;

let trace = Simulator.M.Sampler_pos.ev
          |> React.E.fold (fun l h -> h :: l) []
          |> React.S.hold [];;

let init_m = Simulator.M.create () in
Simulator.loop 100 init_m;;

React.S.value trace;;

The last line then contains the accumulated list of values of type Simulator.M.t that occurred during the loop. Monitoring of the step counter (a silly example) is switched off. By making another sampling functor of type SAMPLER and parametrizing Sim by that, one could further customize the monitoring, if desired.

Answer 2

As discussed in the comments, you may be able to do something like this using higher-order functions (instead of having to resort to a higher-order functor):

module type VEC = sig type t end
module Vec = struct type t = unit end

module Sim (V : VEC) =
struct
  module M = struct type data = V.t list end

  let process x = x

  let rec loop ?(monitor : M.data -> unit = ignore) n data =
    if n <= 0 then data
    else
      (monitor [];
      process data |> loop ~monitor (n - 1))
end

module MySim = Sim (Vec)

let monitor _ = print_endline "foo"

let () =
  MySim.loop ~monitor 5 ()

loop above takes an optional function as argument, which you can pass with the syntax ~monitor:my_fun or ~monitor:(fun data -> ...). If you already have a value called monitor in scope, you can simply do ~monitor to pass it. If you don't pass anything, the default value is ignore (i.e. fun _ -> ()).

I also rewrote loop in recursive style. The code above prints foo 5 times. Note that your monitor function can still come from Sampler module, you just have no need to pass the whole module in when instantiating Sim.

EDIT: If you still want to declare a higher-order functor, here is how you do it (...)

EDIT 2: Changed the example given additional information that the reason for the higher-order functor is that there are multiple monitoring functions to call. Note that in this case, there are still other solutions besides a higher-order functor: you could group the functions into a record, and pass the record to loop. Similar to this, you could pass a first-class module. Or, you could create one function that takes a variant type whose cases indicate at what stage the monitoring function is being called, and carry the data associated with each stage. You can also use classes for this, though I wouldn't recommend it. The functor approach does have an advantage, however, if you are committed to declaring M inside Sim.

I have omitted the signature VEC from the sketch because I'm under the impression that the questioner understands where to add it, and there is no problem with it :)

module type SAMPLER =
sig
  type data
  val monitor : data -> unit
  val monitor' : data list -> unit
end

(* These are created inside Sim. *)
module type DATA =
sig
  type data
  val show : data -> string
end

(* Note that I am using destructive substitution (:=) to avoid the need
   to have a type data declared in the body of MySampler below. If you
   use a regular type equality constraint, you need to add a field
   "type data = Data.data" to the body. *)
module type SAMPLER_FN =
  functor (Data : DATA) -> SAMPLER with type data := Data.data

(* This is the higher-order functor (it takes another functor as an
   argument). *)
module Sim (Sampler_fn : SAMPLER_FN) =
struct
  (* Corresponds to module "Sim.M" in the question. *)
  module Data =
  struct
    type data = string
    let show s = s
  end

  (* Note that without additional type constraints or rearrangements,
     the type data is abstract to Sampler (more precisely, Sampler_fn
     is parametric over Data). This means that Sampler_fn can't
     analyze values of type data, which is why we need to provide
     functions such as Data.show to Sampler_fn for instances of
     Sampler_fn to be "useful". If you are trying to avoid this and
     are having trouble with these specific constraints, let me
     know. The ability to pass types and related values (functions
     in this case) to Sampler_fn is the main argument in favor of
     using a higher-order functor. *)
  module Sampler = Sampler_fn (Data)

  let simulate x =
    (* Call one monitoring function. *)
    Sampler.monitor "hi!";
    (* Do some computation and call another monitoring function. *)
    Sampler.monitor' ["hello"; "world"]
end

---

Usage:

module MySampler (Data : DATA) =
struct
  let monitor data = data |> Data.show |> print_endline
  let monitor' data =
    data
    |> List.map Data.show
    |> String.concat " "
    |> print_endline
end

module MySim = Sim (MySampler)

let () = MySim.simulate ()

This prints

hi!
hello world