more instances and mutable automata

CSM.ml

@@ -122,12 +122,20 @@ let _flatmap_opt f o = match o with
   | None -> None
   | Some x -> f x
 
-let append a1 a2 state x =
+type ('s1,'s2) append_state =
+  | Left of 's1 * 's2
+  | Right of 's2
+
+let rec append a1 a2 state x =
   match state with
-  | `Left s1 ->
-      _flatmap_opt (fun (y,s1) -> Some (y,`Left s1)) (a1 s1 x)
-  | `Right s2 ->
-      _flatmap_opt (fun (y,s2) -> Some (y,`Right s2)) (a2 s2 x)
+  | Left (s1,s2) ->
+      begin match a1 s1 x with
+      | None -> append a1 a2 (Right s2) x
+      | Some (y, s1') ->
+          Some (y, Left (s1', s2))
+      end
+  | Right s2 ->
+      _flatmap_opt (fun (y,s2) -> Some (y,Right s2)) (a2 s2 x)
 
 let rec flatten (automata,state) x = match automata with
   | [] -> None
@@ -162,6 +170,25 @@ let rec flat_map f a state x =
           Some (z, state')
       end
 
+(** {2 Instances} *)
+
+module Int = struct
+  let range j state () =
+    if state > j then None
+    else Some (state, state+1)
+end
+
+let list_map = List.map
+let list_split = List.split
+
+module List = struct
+  let iter state () = match state with
+    | [] -> None
+    | x::l -> Some (x, l)
+
+  let build state x = Some (x::state, x::state)
+end
+
 (** {2 Mutable Interface} *)
 
 module Mut = struct
@@ -181,12 +208,44 @@ module Mut = struct
         Some y
 
   let copy a = { a with state=a.state; }
-end
 
-(** {2 Instances} *)
+  let cur_state a = a.state
+
+  let get_state a = {
+    next=get_state a.next;
+    state=a.state;
+  }
+
+  let scan a = {
+    next = scan a.next;
+    state = a.state, [];
+  }
+
+  let nest l =
+    let nexts, states =
+      list_split (list_map (fun a -> a.next, a.state) l)
+    in
+    { next=nest nexts; state=states; }
+
+  let append a1 a2 = {
+    next = append a1.next a2.next;
+    state = Left (a1.state, a2.state);
+  }
+
+  let rec iter f a = match next a () with
+    | None -> ()
+    | Some y -> f y; iter f a
 
   module Int = struct
-  let range j state () =
-    if state > j then None
-    else Some (state, state+1)
+    let range i j = {
+      next=Int.range j;
+      state=i;
+    }
+  end
+
+  module List = struct
+    let iter l = create List.iter ~init:l
+
+    let build l = create List.build ~init:l
+  end
 end

CSM.mli

@@ -88,8 +88,12 @@ val (>>>) : ('a, 's1, 'b) t -> ('b, 's2, 'c) t ->
 (** composition (outputs of the first automaton are fed to
     the second one's input) *)
 
+type ('s1,'s2) append_state =
+  | Left of 's1 * 's2
+  | Right of 's2
+
 val append : ('a, 's1, 'b) t -> ('a, 's2, 'b) t ->
-             ('a, [`Left of 's1 | `Right of 's2], 'b) t
+             ('a, ('s1, 's2) append_state, 'b) t
 (** [append a b] first behaves like [a], then behaves like [a2]
     once [a1] is exhausted. *)
 
@@ -109,6 +113,21 @@ 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 *)
 
+(** {2 Instances} *)
+
+module Int : sig
+  val range : int -> (unit, int, int) t
+  (** yields all integers smaller than the argument, then stops *)
+end
+
+module List : sig
+  val iter : (unit, 'a list, 'a) t
+  (** iterate on the list *)
+
+  val build : ('a, 'a list, 'a list) t
+  (** build a list from its inputs *)
+end
+
 (** {2 Mutable Interface} *)
 
 module Mut : sig
@@ -120,17 +139,39 @@ module Mut : sig
   val create : ('a, 's, 'b) automaton -> init:'s -> ('a, 's, 'b) t
   (** create a new mutable automaton *)
 
+  val get_state : ('a, 's, _) t -> ('a, 's, 's) t
+  (** Erases the outputs with the states *)
+
+  val cur_state : (_, 's, _) t -> 's
+  (** current state *)
+
   val next : ('a, 's, 'b) t -> 'a -> 'b option
   (** feed an input into the automaton, obtainin and output (unless
       the automaton has stopped) and updating the automaton's state *)
 
   val copy : ('a, 's, 'b) t -> ('a, 's, 'b) t
   (** copy the automaton into a new one, that can evolve independently *)
-end
 
-(** {2 Instances} *)
+  val scan : ('a, 's, 'b) t -> ('a, 's * 'b list, 'b list) t
+
+  val nest : ('a, 's, 'b) t list -> ('a, 's list, 'b list) t
+
+  val append : ('a, 's1, 'b) t -> ('a, 's2, 'b) t ->
+               ('a, ('s1,'s2) append_state, 'b) t
+
+  val iter : ('a -> unit) -> (unit, _, 'a) t -> unit
+  (** iterate on the given left-unit automaton *)
 
   module Int : sig
-  val range : int -> (unit, int, int) t
-  (** yields all integers smaller than the argument, then stops *)
+    val range : int -> int -> (unit, int, int) t
+  end
+
+  module List : sig
+    val iter : 'a list -> (unit, 'a list, 'a) t
+    (** Iterate on the given list *)
+
+    val build : 'a list -> ('a, 'a list, 'a list) t
+    (** build a list from its inputs and the initial list (prepending
+        inputs to it) *)
+  end
 end