feat: simulation start

src/lib/common/dune

@@ -0,0 +1,2 @@
+(library
+  (name common))

src/lib/common/monad.ml

@@ -0,0 +1,26 @@
+
+module type Monad = sig
+  type 'a t
+
+  val return : 'a -> 'a t
+  val bind   : 'a t -> ('a -> 'b t) -> 'b t
+end
+
+module type FullMonad = sig
+  type 'a t
+
+  val return : 'a -> 'a t
+  val bind   : 'a t -> ('a -> 'b t) -> 'b t
+  val (>>=)  : 'a t -> ('a -> 'b t) -> 'b t
+  val (let*) : 'a t -> ('a -> 'b t) -> 'b t
+  val join   : 'a t t -> 'a t
+end
+
+module Expand (M : Monad) = struct
+  include M
+
+  let (>>=)  = M.bind
+  let (let*) = M.bind
+  let join m = M.bind m (fun m -> m)
+end
+

src/lib/common/monad.mli

@@ -0,0 +1,20 @@
+
+module type Monad = sig
+  type 'a t
+
+  val return : 'a -> 'a t
+  val bind   : 'a t -> ('a -> 'b t) -> 'b t
+end
+
+module type FullMonad = sig
+  type 'a t
+
+  val return : 'a -> 'a t
+  val bind   : 'a t -> ('a -> 'b t) -> 'b t
+  val (>>=)  : 'a t -> ('a -> 'b t) -> 'b t
+  val (let*) : 'a t -> ('a -> 'b t) -> 'b t
+  val join   : 'a t t -> 'a t
+end
+
+module Expand : functor (M : Monad) -> FullMonad with type 'a t = 'a M.t
+

src/lib/common/state.ml

@@ -0,0 +1,23 @@
+
+open Utils
+
+module Make (S : sig
+  type t
+end) =
+  struct
+
+    module State = struct
+      type 'a t = S.t -> 'a * S.t
+
+      let return   = pair
+      let bind m f = uncurry f @. m
+    end
+
+    module M = Monad.Expand (State)
+    include M
+
+    let get () s = s, s
+    let set x _  = (), x
+    let run m    = fst @. m
+  end
+

src/lib/common/state.mli

@@ -0,0 +1,17 @@
+
+module Make (S : sig
+  type t
+end) : sig
+  type 'a t
+
+  val return : 'a -> 'a t
+  val bind   : 'a t -> ('a -> 'b t) -> 'b t
+  val (>>=)  : 'a t -> ('a -> 'b t) -> 'b t
+  val (let*) : 'a t -> ('a -> 'b t) -> 'b t
+
+  val get    : unit -> S.t t
+  val set    : S.t -> unit t
+
+  val run    : 'a t -> S.t -> 'a
+end
+

src/lib/common/utils.ml

@@ -0,0 +1,7 @@
+
+let pair = fun a b -> a, b
+
+let uncurry = fun f (a, b) -> f a b
+
+let (@.) = fun f g x -> f @@ g x
+