| 23150 |      1 | (*  Title:      HOL/Tools/TFL/utils.ML
 | 
|  |      2 |     Author:     Konrad Slind, Cambridge University Computer Laboratory
 | 
|  |      3 | 
 | 
|  |      4 | Basic utilities.
 | 
|  |      5 | *)
 | 
|  |      6 | 
 | 
|  |      7 | signature UTILS =
 | 
|  |      8 | sig
 | 
|  |      9 |   exception ERR of {module: string, func: string, mesg: string}
 | 
|  |     10 |   val C: ('a -> 'b -> 'c) -> 'b -> 'a -> 'c
 | 
|  |     11 |   val end_itlist: ('a -> 'a -> 'a) -> 'a list -> 'a
 | 
|  |     12 |   val itlist2: ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
 | 
|  |     13 |   val pluck: ('a -> bool) -> 'a list -> 'a * 'a list
 | 
|  |     14 |   val zip3: 'a list -> 'b list -> 'c list -> ('a*'b*'c) list
 | 
|  |     15 |   val take: ('a -> 'b) -> int * 'a list -> 'b list
 | 
|  |     16 | end;
 | 
|  |     17 | 
 | 
|  |     18 | structure Utils: UTILS =
 | 
|  |     19 | struct
 | 
|  |     20 | 
 | 
|  |     21 | (*standard exception for TFL*)
 | 
|  |     22 | exception ERR of {module: string, func: string, mesg: string};
 | 
|  |     23 | 
 | 
|  |     24 | fun UTILS_ERR func mesg = ERR {module = "Utils", func = func, mesg = mesg};
 | 
|  |     25 | 
 | 
|  |     26 | 
 | 
|  |     27 | fun C f x y = f y x
 | 
|  |     28 | 
 | 
|  |     29 | fun end_itlist f [] = raise (UTILS_ERR "end_itlist" "list too short")
 | 
|  |     30 |   | end_itlist f [x] = x 
 | 
|  |     31 |   | end_itlist f (x :: xs) = f x (end_itlist f xs);
 | 
|  |     32 | 
 | 
|  |     33 | fun itlist2 f L1 L2 base_value =
 | 
|  |     34 |  let fun it ([],[]) = base_value
 | 
|  |     35 |        | it ((a::rst1),(b::rst2)) = f a b (it (rst1,rst2))
 | 
|  |     36 |        | it _ = raise UTILS_ERR "itlist2" "different length lists"
 | 
|  |     37 |  in  it (L1,L2)
 | 
|  |     38 |  end;
 | 
|  |     39 | 
 | 
|  |     40 | fun pluck p  =
 | 
|  |     41 |   let fun remv ([],_) = raise UTILS_ERR "pluck" "item not found"
 | 
|  |     42 |         | remv (h::t, A) = if p h then (h, rev A @ t) else remv (t,h::A)
 | 
|  |     43 |   in fn L => remv(L,[])
 | 
|  |     44 |   end;
 | 
|  |     45 | 
 | 
|  |     46 | fun take f =
 | 
|  |     47 |   let fun grab(0,L) = []
 | 
|  |     48 |         | grab(n, x::rst) = f x::grab(n-1,rst)
 | 
|  |     49 |   in grab
 | 
|  |     50 |   end;
 | 
|  |     51 | 
 | 
|  |     52 | fun zip3 [][][] = []
 | 
|  |     53 |   | zip3 (x::l1) (y::l2) (z::l3) = (x,y,z)::zip3 l1 l2 l3
 | 
|  |     54 |   | zip3 _ _ _ = raise UTILS_ERR "zip3" "different lengths";
 | 
|  |     55 | 
 | 
|  |     56 | 
 | 
|  |     57 | end;
 |