diff --git a/core/CCHash.ml b/core/CCHash.ml index af0b9a3b..e485d228 100644 --- a/core/CCHash.ml +++ b/core/CCHash.ml @@ -58,7 +58,7 @@ let hash_triple h1 h2 h3 (x,y,z) = (h1 x) <<>> (h2 y) <<>> (h3 z) type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option -type 'a klist = [`Nil | `Cons of 'a * (unit -> 'a klist)] +type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] let hash_seq f h seq = let h = ref h in @@ -70,7 +70,6 @@ let rec hash_gen f h g = match g () with | Some x -> hash_gen f (h <<>> f x) g -let rec hash_klist f h l = match l with +let rec hash_klist f h l = match l () with | `Nil -> h - | `Cons (x,l') -> hash_klist f (h <<>> f x) (l' ()) - + | `Cons (x,l') -> hash_klist f (h <<>> f x) l' diff --git a/core/CCHash.mli b/core/CCHash.mli index 2233e240..e250ed10 100644 --- a/core/CCHash.mli +++ b/core/CCHash.mli @@ -57,7 +57,7 @@ val hash_triple : 'a hash_fun -> 'b hash_fun -> 'c hash_fun -> ('a * 'b * 'c) ha type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option -type 'a klist = [`Nil | `Cons of 'a * (unit -> 'a klist)] +type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] val hash_seq : 'a hash_fun -> t -> 'a sequence hash_fun val hash_gen : 'a hash_fun -> t -> 'a gen hash_fun diff --git a/core/CCList.ml b/core/CCList.ml index 0d446ed8..a60428db 100644 --- a/core/CCList.ml +++ b/core/CCList.ml @@ -388,7 +388,7 @@ end type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option -type 'a klist = [`Nil | `Cons of 'a * (unit -> 'a klist)] +type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] type 'a printer = Buffer.t -> 'a -> unit type 'a formatter = Format.formatter -> 'a -> unit @@ -422,17 +422,17 @@ let to_klist l = let rec make l () = match l with | [] -> `Nil | x::l' -> `Cons (x, make l') - in make l () + in make l let of_klist l = let rec direct i g = if i = 0 then safe [] g - else match l with + else match l () with | `Nil -> [] - | `Cons (x,l') -> x :: direct (i-1) (l' ()) - and safe acc l = match l with + | `Cons (x,l') -> x :: direct (i-1) l' + and safe acc l = match l () with | `Nil -> List.rev acc - | `Cons (x,l') -> safe (x::acc) (l' ()) + | `Cons (x,l') -> safe (x::acc) l' in direct _direct_depth l diff --git a/core/CCList.mli b/core/CCList.mli index 1691ed75..6f9adf77 100644 --- a/core/CCList.mli +++ b/core/CCList.mli @@ -171,7 +171,7 @@ end type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option -type 'a klist = [`Nil | `Cons of 'a * (unit -> 'a klist)] +type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] type 'a printer = Buffer.t -> 'a -> unit type 'a formatter = Format.formatter -> 'a -> unit diff --git a/misc/AVL.ml b/misc/AVL.ml index 97e53436..592113a1 100644 --- a/misc/AVL.ml +++ b/misc/AVL.ml @@ -356,26 +356,26 @@ let rec _before~cmp stack t key = match t with else _yield k v (_push_swap l stack) module KList = struct - type 'a t = [ `Nil | `Cons of 'a * (unit -> 'a t) ] + type 'a t = unit -> [ `Nil | `Cons of 'a * 'a t ] - let rec _next (l:('a,'b) explore list) () : ('a*'b) t = match l with + let rec _next (l:('a,'b) explore list) () = match l with | [] -> `Nil | _::_ -> let k, v, l' = _pop l in `Cons ((k,v), _next l') - let iter {t; _} = _next (_push t []) () + let iter {t; _} = _next (_push t []) - let rec _add ~cmp t (l:'a t) = match l with + let rec _add ~cmp t (l:'a t) = match l () with | `Nil -> t | `Cons ((k,v), l') -> - _add ~cmp (_insert ~cmp t k v) (l' ()) + _add ~cmp (_insert ~cmp t k v) l' let add {cmp; t} l = {cmp; t=_add ~cmp t l} - let after {cmp; t} key = _next (_after ~cmp [] t key) () + let after {cmp; t} key = _next (_after ~cmp [] t key) - let before {cmp; t} key = _next (_before ~cmp [] t key) () + let before {cmp; t} key = _next (_before ~cmp [] t key) end module Gen = struct diff --git a/misc/AVL.mli b/misc/AVL.mli index 788f2aa1..5ff71ffa 100644 --- a/misc/AVL.mli +++ b/misc/AVL.mli @@ -93,7 +93,7 @@ module type ITERATOR = sig end module KList : sig - type 'a t = [ `Nil | `Cons of 'a * (unit -> 'a t) ] + type 'a t = unit -> [ `Nil | `Cons of 'a * 'a t ] include ITERATOR with type 'a iter := 'a t end diff --git a/misc/CSM.ml b/misc/CSM.ml index 158f5b3a..6d72cd7b 100644 --- a/misc/CSM.ml +++ b/misc/CSM.ml @@ -210,7 +210,7 @@ module List = struct let build state x = Some (x::state, x::state) end -module CCGen = struct +module Gen = struct type 'a gen = unit -> 'a option let map a state gen = @@ -227,7 +227,7 @@ module CCGen = struct end end -module CCSequence = struct +module Sequence = struct type 'a sequence = ('a -> unit) -> unit exception ExitSeq @@ -244,6 +244,20 @@ module CCSequence = struct with ExitSeq -> () end +module KList = struct + type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] + + let rec map f state (l:'a klist) () = + match l () with + | `Nil -> `Nil + | `Cons (x, l') -> + begin match f state x with + | None -> `Nil + | Some (y, state') -> + `Cons (y, map f state' l') + end +end + (** {2 Mutable Interface} *) module Mut = struct diff --git a/misc/CSM.mli b/misc/CSM.mli index abd59af1..0f60cfca 100644 --- a/misc/CSM.mli +++ b/misc/CSM.mli @@ -26,10 +26,11 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (** {1 Composable State Machines} This module defines state machines that should help design applications -with a more explicit control of state (e.g. for networking applications. *) +with a more explicit control of state (e.g. for networking applications). *) type ('a, 's, 'b) t = 's -> 'a -> ('b * 's) option -(** transition function that fully describes an automaton *) +(** transition function that fully describes an automaton. It returns + [None] to indicate that it stops. *) type ('a, 's, 'b) automaton = ('a, 's, 'b) t @@ -140,18 +141,24 @@ module List : sig (** build a list from its inputs *) end -module CCGen : sig +module Gen : sig type 'a gen = unit -> 'a option val map : ('a, 's, 'b) t -> 's -> 'a gen -> 'b gen end -module CCSequence : sig +module Sequence : sig type 'a sequence = ('a -> unit) -> unit val map : ('a, 's, 'b) t -> 's -> 'a sequence -> 'b sequence end +module KList : sig + type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] + + val map : ('a, 's, 'b) t -> 's -> 'a klist -> 'b klist +end + (** {2 Mutable Interface} *) module Mut : sig diff --git a/string/levenshtein.ml b/string/levenshtein.ml index 9aec05c8..cf9b4f9d 100644 --- a/string/levenshtein.ml +++ b/string/levenshtein.ml @@ -37,15 +37,15 @@ module type STRING = sig end (** Continuation list *) -type 'a klist = +type 'a klist = unit -> [ | `Nil - | `Cons of 'a * (unit -> 'a klist) + | `Cons of 'a * 'a klist ] -let rec klist_to_list = function +let rec klist_to_list l = match l () with | `Nil -> [] - | `Cons (x,k) -> x :: klist_to_list (k ()) + | `Cons (x,k) -> x :: klist_to_list k module type S = sig type char_ @@ -568,7 +568,7 @@ module Make(Str : STRING) = struct let dfa = of_string ~limit s in (* traverse at index i in automaton, with [fk] the failure continuation *) - let rec traverse node i ~(fk:unit->'a klist) = + let rec traverse node i ~(fk:'a klist) () = match node with | Node (opt, m) -> (* all alternatives: continue exploring [m], or call [fk] *) @@ -577,7 +577,7 @@ module Make(Str : STRING) = struct (fun c node' fk -> try let next = __transition dfa i c in - (fun () -> traverse node' next ~fk) + traverse node' next ~fk with Not_found -> fk) m fk in @@ -617,13 +617,13 @@ module Make(Str : STRING) = struct fold (fun acc str v -> (str,v) :: acc) [] idx let to_klist idx = - let rec traverse node trail ~(fk:unit->(string_*'a) klist) = + let rec traverse node trail ~(fk:(string_*'a) klist) () = match node with | Node (opt, m) -> (* all alternatives: continue exploring [m], or call [fk] *) let fk = M.fold - (fun c node' fk () -> traverse node' (c::trail) ~fk) + (fun c node' fk -> traverse node' (c::trail) ~fk) m fk in match opt with @@ -650,6 +650,13 @@ end) let debug_print = debug_print output_char +(*$T + edit_distance "foo" "fo0" = 1 + edit_distance "foob" "foo" = 1 + edit_distance "yolo" "yoyo" = 1 + edit_distance "aaaaaaab" "aaaa" = 4 +*) + (* open Batteries;; let words = File.with_file_in "/usr/share/dict/cracklib-small" (fun i -> IO.read_all i |> String.nsplit ~by:"\\n");; diff --git a/string/levenshtein.mli b/string/levenshtein.mli index d571415e..9affac48 100644 --- a/string/levenshtein.mli +++ b/string/levenshtein.mli @@ -58,13 +58,13 @@ strings, we return a continuation list so that, even if there are many results, only those actually asked for are evaluated. *) type 'a klist = - [ + unit -> [ | `Nil - | `Cons of 'a * (unit -> 'a klist) + | `Cons of 'a * 'a klist ] val klist_to_list : 'a klist -> 'a list - (** Helper. *) + (** Helper for short lists. *) (** {2 Signature}