blob: 09a6455fef6540c16fbd8999b4db7c7c00cdbb6e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
(***************************************************************************)
(* This is part of aac_tactics, it is distributed under the terms of the *)
(* GNU Lesser General Public License version 3 *)
(* (see file LICENSE for more details) *)
(* *)
(* Copyright 2009-2010: Thomas Braibant, Damien Pous. *)
(***************************************************************************)
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 ->
(List.fold_left (fun acc x ->
match x with
| (N []) -> acc
| x -> aux acc x
) acc l)
in
aux acc m
let rec (>>) : 'a m -> ('a -> 'b m) -> 'b m =
fun m f ->
match m with
| F x -> f x
| N l ->
N (List.fold_left (fun acc x ->
match x with
| (N []) -> acc
| x -> (x >> f)::acc
) [] l)
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)
| N l, F x -> N (F x::l)
| x,y -> N [x;y]
let return : 'a -> 'a m = fun x -> F x
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
| F _ -> 1
| N l -> List.fold_left (fun acc x -> acc+count x) 0 l
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 ->
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)))
(* preserve the structure of the heap *)
let filter f m =
fold (fun x acc -> (if f x then return x else fail ()) >>| acc) m (N [])
|
