lift operators for CSM; interface to gen/sequence

CSM.ml

@@ -53,6 +53,16 @@ let scan a (st, prev) x =
   | Some (y,state') ->
       Some (y::prev, (state', y::prev))
 
+let lift f state x =
+  let state' = f state x in
+  Some (state', state')
+
+let ignore_state f state x = Some (f x, state)
+
+let ignore_arg f state _x =
+  let state' = f state in
+  Some (state', state')
+
 let map_in f a state x = a state (f x)
 let map_out f a state x = match a state x with
   | None -> None
@@ -170,6 +180,17 @@ let rec flat_map f a state x =
           Some (z, state')
       end
 
+let run_list a ~init l =
+  let rec aux acc state l = match l with
+  | [] -> List.rev acc
+  | x::l' ->
+      match next a state x with
+      | None -> List.rev acc
+      | Some (y, state') ->
+          aux (y::acc) state' l'
+  in
+  aux [] init l
+
 (** {2 Instances} *)
 
 module Int = struct
@@ -189,6 +210,40 @@ module List = struct
   let build state x = Some (x::state, x::state)
 end
 
+module Gen = struct
+  type 'a gen = unit -> 'a option
+
+  let map a state gen =
+    let st = ref state in
+    fun () ->
+      match gen() with
+      | None -> None
+      | Some x ->
+          begin match a !st x with
+          | None -> None
+          | Some (y, state') ->
+              st := state';
+              Some y
+          end
+end
+
+module Sequence = struct
+  type 'a sequence = ('a -> unit) -> unit
+
+  exception ExitSeq
+
+  let map a state seq =
+    fun k ->
+      let st = ref state in
+      try
+        seq (fun x -> match a !st x with
+          | None -> raise ExitSeq
+          | Some (y, state') ->
+              st := state';
+              k y)
+      with ExitSeq -> ()
+end
+
 (** {2 Mutable Interface} *)
 
 module Mut = struct

CSM.mli

@@ -55,6 +55,15 @@ val scan : ('a, 's, 'b) t -> ('a, 's * 'b list, 'b list) t
 (** [scan a] accumulates all the successive outputs of [a]
     as its output *)
 
+val lift : ('b -> 'a -> 'b) -> ('a, 'b, 'b) t
+(** Lift a function into an automaton *)
+
+val ignore_state : ('a -> 'b) -> ('a, 's, 'b) t
+(** Lift a function that ignores the state into an automaton *)
+
+val ignore_arg : ('s -> 's) -> ('a, 's, 's) t
+(** Lift a function that ignores the input into an automaton *)
+
 val map_in : ('a2 -> 'a) -> ('a, 's, 'b) t -> ('a2, 's, 'b) t
 
 val map_out : ('b -> 'b2) -> ('a, 's, 'b) t -> ('a, 's, 'b2) t
@@ -113,6 +122,9 @@ val flat_map : ('b -> ('a, 's2, 'c) t * 's2) -> ('a, 's1, 'b) t ->
     to produce outputs until they are exhausted, at which point the
     first one is used again, and so on *)
 
+val run_list : ('a, 's, 'b) t -> init:'s -> 'a list -> 'b list
+(** Run the automaton on a list of inputs *)
+
 (** {2 Instances} *)
 
 module Int : sig
@@ -128,6 +140,18 @@ module List : sig
   (** build a list from its inputs *)
 end
 
+module Gen : sig
+  type 'a gen = unit -> 'a option
+
+  val map : ('a, 's, 'b) t -> 's -> 'a gen -> 'b gen
+end
+
+module Sequence : sig
+  type 'a sequence = ('a -> unit) -> unit
+
+  val map : ('a, 's, 'b) t -> 's -> 'a sequence -> 'b sequence
+end
+
 (** {2 Mutable Interface} *)
 
 module Mut : sig