TFL/utils.sml
author paulson
Wed Jan 27 10:31:31 1999 +0100 (1999-01-27)
changeset 6153 bff90585cce5
parent 3391 5e45dd3b64e9
child 9867 bf8300fa4238
permissions -rw-r--r--
new typechecking solver for the simplifier
paulson@3302
     1
(*  Title:      TFL/utils
paulson@3302
     2
    ID:         $Id$
paulson@3302
     3
    Author:     Konrad Slind, Cambridge University Computer Laboratory
paulson@3302
     4
    Copyright   1997  University of Cambridge
paulson@2112
     5
paulson@3302
     6
Basic utilities
paulson@3302
     7
*)
paulson@3245
     8
paulson@3245
     9
structure Utils = 
paulson@2112
    10
struct
paulson@2112
    11
paulson@2112
    12
(* Standard exception for TFL. *)
paulson@2112
    13
exception ERR of {module:string,func:string, mesg:string};
paulson@2112
    14
fun UTILS_ERR{func,mesg} = ERR{module = "Utils",func=func,mesg=mesg};
paulson@2112
    15
paulson@2112
    16
paulson@2112
    17
(* Simple combinators *)
paulson@2112
    18
paulson@2112
    19
fun C f x y = f y x
paulson@2112
    20
paulson@2112
    21
fun itlist f L base_value =
paulson@2112
    22
   let fun it [] = base_value
paulson@2112
    23
         | it (a::rst) = f a (it rst)
paulson@2112
    24
   in it L 
paulson@2112
    25
   end;
paulson@2112
    26
paulson@2112
    27
fun rev_itlist f =
paulson@2112
    28
   let fun rev_it [] base = base
paulson@2112
    29
         | rev_it (a::rst) base = rev_it rst (f a base)
paulson@2112
    30
   in rev_it
paulson@2112
    31
   end;
paulson@2112
    32
paulson@2112
    33
fun end_itlist f =
paulson@2112
    34
   let fun endit [] = raise UTILS_ERR{func="end_itlist", mesg="list too short"}
paulson@2112
    35
         | endit alist = 
paulson@2112
    36
            let val (base::ralist) = rev alist
paulson@2112
    37
            in itlist f (rev ralist) base
paulson@2112
    38
            end
paulson@2112
    39
   in endit
paulson@2112
    40
   end;
paulson@2112
    41
paulson@2112
    42
fun itlist2 f L1 L2 base_value =
paulson@2112
    43
 let fun it ([],[]) = base_value
paulson@2112
    44
       | it ((a::rst1),(b::rst2)) = f a b (it (rst1,rst2))
paulson@2112
    45
       | it _ = raise UTILS_ERR{func="itlist2",mesg="different length lists"}
paulson@2112
    46
 in  it (L1,L2)
paulson@2112
    47
 end;
paulson@2112
    48
paulson@2112
    49
fun pluck p  =
paulson@2112
    50
  let fun remv ([],_) = raise UTILS_ERR{func="pluck",mesg = "item not found"}
paulson@2112
    51
        | remv (h::t, A) = if p h then (h, rev A @ t) else remv (t,h::A)
paulson@2112
    52
  in fn L => remv(L,[])
paulson@2112
    53
  end;
paulson@2112
    54
paulson@2112
    55
fun take f =
paulson@2112
    56
  let fun grab(0,L) = []
paulson@2112
    57
        | grab(n, x::rst) = f x::grab(n-1,rst)
paulson@2112
    58
  in grab
paulson@2112
    59
  end;
paulson@2112
    60
paulson@2112
    61
fun zip3 [][][] = []
paulson@2112
    62
  | zip3 (x::l1) (y::l2) (z::l3) = (x,y,z)::zip3 l1 l2 l3
paulson@2112
    63
  | zip3 _ _ _ = raise UTILS_ERR{func="zip3",mesg="different lengths"};
paulson@2112
    64
paulson@2112
    65
paulson@2112
    66
fun can f x = (f x ; true) handle _ => false;
paulson@2112
    67
fun holds P x = P x handle _ => false;
paulson@2112
    68
paulson@2112
    69
paulson@2112
    70
fun sort R = 
paulson@2112
    71
let fun part (m, []) = ([],[])
paulson@2112
    72
      | part (m, h::rst) =
paulson@2112
    73
         let val (l1,l2) = part (m,rst)
paulson@2112
    74
         in if (R h m) then (h::l1, l2)
paulson@2112
    75
                       else (l1,  h::l2) end
paulson@2112
    76
    fun qsort [] = []
paulson@2112
    77
      | qsort (h::rst) = 
paulson@2112
    78
        let val (l1,l2) = part(h,rst)
paulson@2112
    79
        in qsort l1@ [h] @qsort l2
paulson@2112
    80
        end
paulson@2112
    81
in qsort
paulson@2112
    82
end;
paulson@2112
    83
paulson@2112
    84
paulson@2112
    85
paulson@2112
    86
end; (* Utils *)