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