diff options
Diffstat (limited to 'AAC_search_monad.ml')
| -rw-r--r-- | AAC_search_monad.ml | 28 |
1 files changed, 14 insertions, 14 deletions
diff --git a/AAC_search_monad.ml b/AAC_search_monad.ml index f5ea243..b7aabbd 100644 --- a/AAC_search_monad.ml +++ b/AAC_search_monad.ml @@ -8,32 +8,32 @@ type 'a m = | F of 'a | N of 'a m list - + let fold (f : 'a -> 'b -> 'b) (m : 'a m) (acc : 'b) = let rec aux acc = function F x -> f x acc - | N l -> + | N l -> (List.fold_left (fun acc x -> - match x with + match x with | (N []) -> acc | x -> aux acc x ) acc l) in aux acc m - -let rec (>>) : 'a m -> ('a -> 'b m) -> 'b m = + +let rec (>>) : 'a m -> ('a -> 'b m) -> 'b m = fun m f -> - match m with - | F x -> f x - | N l -> + match m with + | F x -> f x + | N l -> N (List.fold_left (fun acc x -> - match x with + match x with | (N []) -> acc | x -> (x >> f)::acc ) [] l) -let (>>|) (m : 'a m) (n :'a m) : 'a m = match (m,n) with +let (>>|) (m : 'a m) (n :'a m) : 'a m = match (m,n) with | N [],_ -> n | _,N [] -> m | F x, N l -> N (F x::l) @@ -41,11 +41,11 @@ let (>>|) (m : 'a m) (n :'a m) : 'a m = match (m,n) with | x,y -> N [x;y] let return : 'a -> 'a m = fun x -> F x -let fail : unit -> 'a m = fun () -> N [] +let fail : unit -> 'a m = fun () -> N [] let sprint f m = fold (fun x acc -> Printf.sprintf "%s\n%s" acc (f x)) m "" -let rec count = function +let rec count = function | F _ -> 1 | N l -> List.fold_left (fun acc x -> acc+count x) 0 l @@ -53,13 +53,13 @@ let opt_comb f x y = match x with None -> f y | _ -> x let rec choose = function | F x -> Some x - | N l -> List.fold_left (fun acc x -> + | N l -> List.fold_left (fun acc x -> opt_comb choose acc x ) None l let is_empty = fun x -> choose x = None let to_list m = (fold (fun x acc -> x::acc) m []) - + let sort f m = N (List.map (fun x -> F x) (List.sort f (to_list m))) |