diff --git a/CSM.ml b/CSM.ml index 8a2406a9..4c1066b1 100644 --- a/CSM.ml +++ b/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 diff --git a/CSM.mli b/CSM.mli index f656aec4..9ac70d80 100644 --- a/CSM.mli +++ b/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