update the klist type in other modules

This commit is contained in:
Simon Cruanes 2014-05-26 21:55:29 +02:00
parent ffcdfa8625
commit 9a10d477ee
10 changed files with 64 additions and 37 deletions

View file

@ -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'

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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");;

View file

@ -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}