5.6. Utilities
Generic (non Felix dependent) utilities.
Start ocaml section to src/flx_util.mli[1
/1
]
1: # 5 "./lpsrc/flx_types.ipk"
2: (** Generic utilities *)
3:
4: (** n spaces
5: *)
6: val spaces : int -> string
7:
8: (** String.concat sep (map fun lst)
9: *)
10: val catmap : string -> ('a -> string) -> 'a list -> string
11:
12: (** reverse application *)
13: val (+>) : 'a -> ('a ->'b) -> 'b
14:
15: (** hmmm *)
16: val transpose: 'a list list -> 'a list list
17:
18: (** last element of list
19: *)
20: val list_last: 'a list -> 'a
21:
22: (** position in list of value *)
23: val list_index: 'a list -> 'a -> int option
24: val list_assoc_index: ('a * 'b) list -> 'a -> int option
25:
26: (** forward order map *)
27: val list_omap: ('a -> 'b) -> 'a list -> 'b list
28:
29: (** convert exception to option *)
30: val catch_all : ('a -> 'b) -> 'a -> 'b option
31:
32: (** test if option not None *)
33: val is_some: 'a option -> bool
34:
35: (** list of n integers 0 to n-1 *)
36: val nlist: int -> int list
37:
38: (** first n elements of a list *)
39: val list_prefix: 'a list -> int -> 'a list
40:
41: (** synonym for string_of_int *)
42: val si: int -> string
43:
44: (** synonym for String.concat *)
45: val cat: string -> string list -> string
46:
47: (** synonym for Buffer.add_string *)
48: val bcat: Buffer.t -> string -> unit
49:
50: (** make a hashtable from an assoc list *)
51: val hashtable_of_list:
52: ('a * 'b) list ->
53: ('a,'b) Hashtbl.t
54:
55: (** fixpoint combinator *)
56: val fix:
57: (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b
58:
59: (** add elements to unique list *)
60: val uniq_cat: 'a list -> 'a list -> 'a list
61:
62: (** make a list of unique elements *)
63: val uniq_list: 'a list -> 'a list
64:
Start ocaml section to src/flx_util.ml[1
/1
]
1: # 70 "./lpsrc/flx_types.ipk"
2: open List
3: let spaces level = String.make (level*2) ' '
4: let catmap sep fn ls = String.concat sep (map fn ls)
5: let (+>) x f = f x (* reverse application *)
6: let transpose x =
7: let dtor ls =
8: split (map (fun x -> hd x, tl x) ls)
9: in let rec cons ls (h,t) = match hd t with
10: | [] -> h :: ls
11: | _ -> cons (h :: ls) (dtor t)
12: in tl (rev (cons [] ([],x)))
13:
14: let list_last l = hd (rev l)
15:
16: let list_prefix lst n =
17: let rec aux ol nl n =
18: if n>0 then aux (tl ol) (hd ol :: nl) (n-1)
19: else rev nl
20: in aux lst [] n
21:
22: let rec list_index l x =
23: let rec aux l i =
24: match l with
25: | [] -> None
26: | h::t ->
27: if x = h then Some i
28: else aux t (i+1)
29: in aux l 0
30:
31: let rec list_assoc_index l x =
32: let rec aux l i =
33: match l with
34: | [] -> None
35: | (h,_)::t ->
36: if x = h then Some i
37: else aux t (i+1)
38: in aux l 0
39:
40: let list_omap f ls =
41: rev (rev_map f ls)
42:
43: let catch_all f x =
44: try Some (f x) with _ -> None
45:
46: let is_some = function | Some _ -> true | None -> false
47:
48: let nlist n =
49: let lst = ref [] in
50: for i = 1 to n do lst := (n-i) :: !lst done;
51: !lst
52:
53: let si = string_of_int
54: let cat = String.concat
55: let bcat = Buffer.add_string
56:
57: let hashtable_of_list lst =
58: let t = Hashtbl.create (length lst) in
59: iter
60: (fun (k,v) -> Hashtbl.add t k v)
61: lst
62: ;
63: t
64:
65: let rec fix f x = f (fix f) x
66:
67: let uniq_cat u nu =
68: fold_left
69: (fun l i -> if mem i l then l else i :: l)
70: u
71: nu
72:
73: let uniq_list lst = uniq_cat [] lst
74:
Start ocaml section to src/flx_dlst.mli[1
/1
]
1: # 145 "./lpsrc/flx_types.ipk"
2: type direction = Fwd | Rev
3: val dir_rev : direction -> direction
4: type 'a dlst = { dir : direction; lst : 'a list; }
5: val dfwd : 'a dlst -> 'a list
6: val drev : 'a dlst -> 'a list
7: val dlst_fwd : 'a list -> 'a dlst
8: val dlst_rev : 'a list -> 'a dlst
9: val dlst_lst : 'a dlst -> 'a list
10: val dlst_dir : 'a dlst -> direction
11: val dlst_map : ('a -> 'b) -> 'a dlst -> 'b dlst
12: val append : 'a dlst -> 'a -> 'a dlst
13: val prepend : 'a dlst -> 'a -> 'a dlst
14: val cons : 'a list -> 'a -> 'a list
15: val concat : 'a dlst -> 'a dlst -> 'a dlst
16:
Start ocaml section to src/flx_dlst.ml[1
/1
]
1: # 162 "./lpsrc/flx_types.ipk"
2: open List
3: type direction = Fwd | Rev
4: let dir_rev = function | Fwd -> Rev | Rev->Fwd
5:
6: type 'a dlst = { dir:direction; lst: 'a list }
7:
8: let dfwd = function
9: | {dir=Fwd; lst=l} -> l
10: | {dir=Rev; lst=l} -> rev l
11:
12: let drev = function
13: | {dir=Fwd; lst=l} -> l
14: | {dir=Rev; lst=l} -> rev l
15:
16: let dlst_fwd = function l -> {dir=Fwd; lst=l}
17: let dlst_rev = function l -> {dir=Rev; lst=l}
18:
19: let dlst_lst = function {lst=l} -> l
20: let dlst_dir = function {dir=d} -> d
21:
22: let dlst_map f {dir=d; lst=l} = {dir=dir_rev d; lst=rev_map f l}
23:
24: let append = function
25: | {dir=Fwd; lst=l} -> (fun e -> {dir=Rev; lst=e::rev l})
26: | {dir=Rev; lst=l} as d -> (fun e -> {d with lst=e::l})
27:
28: let prepend = function
29: | {dir=Rev; lst=l} -> (function e -> {dir=Fwd; lst=e::rev l})
30: | {dir=Fwd; lst=l} as d -> (function e -> {d with lst=e::l})
31:
32: let cons = function lst -> (function elt -> elt :: lst)
33:
34: let concat a b = match (a,b) with
35: | {dir=Rev; lst=l1}, {dir=Fwd; lst=l2} ->
36: {dir=Rev; lst=fold_left cons l1 l2}
37:
38: | {dir=Fwd; lst=l1}, {dir=Fwd; lst=l2} ->
39: {dir=Rev; lst=fold_left cons (rev l1) (rev l2)}
40:
41: | {dir=Rev; lst=l1}, {dir=Rev; lst=l2} ->
42: {dir=Rev; lst=fold_left cons l1 (rev l2)}
43:
44: | {dir=Fwd; lst=l1}, {dir=Rev; lst=l2} ->
45: {dir=Rev; lst=fold_left cons (rev l1) l2}
46: