base/hList.ml

   1 open Base
   2
   3 let rec last =
   4   function
   5       [] ->
   6         invalid_arg "HList.last"
   7     | [x] ->
   8         x
   9     | _::xs ->
  10         last xs
  11
  12 let init xs =
  13   let rec init' ys =
  14     function
  15         []  ->
  16           invalid_arg "HList.init"
  17       | [_] ->
  18           List.rev ys
  19       | x::xs ->
  20           init' (x::ys) xs in
  21     init' [] xs
  22
  23 let null =
  24   function
  25       [] ->
  26         true
  27     | _ ->
  28         false
  29
  30 let fold_left1 f =
  31   function
  32       [] ->
  33         invalid_arg "HList.fold_left1"
  34     | x::xs ->
  35         List.fold_left f x xs
  36
  37 let rec fold_right1 f =
  38   function
  39       []    ->
  40         invalid_arg "HList.fold_right1"
  41     | [x]   ->
  42         x
  43     | x::xs ->
  44         f x (fold_right1 f xs)
  45
  46 let conj =
  47   List.fold_left (&&) true
  48
  49 let disj =
  50   List.fold_left (||) false
  51
  52 let sum =
  53   List.fold_left (+) 0
  54
  55 let product =
  56   List.fold_left ( * ) 1
  57
  58 let concat_map f xs =
  59   List.fold_right ((@) $ f) xs []
  60
  61 let maximum xs =
  62   fold_left1 max xs
  63
  64 let minimum xs =
  65   fold_left1 min xs
  66
  67 let rec scanl f y =
  68   function
  69       [] ->
  70         [y]
  71     | x::xs ->
  72         y::scanl f (f y x) xs
  73
  74 let scanl1 f =
  75   function
  76       [] ->
  77         []
  78     | x::xs ->
  79         scanl f x xs
  80
  81 let rec scanr f z =
  82   function
  83       [] ->
  84         [z]
  85     | x::xs ->
  86         match scanr f z xs with
  87             y::_ as yss ->
  88               (f x y) :: yss
  89           | _ ->
  90               failwith "must not happen"
  91
  92 let scanr1 f =
  93   function
  94     [] ->
  95       []
  96   | x::xs ->
  97       scanr f x xs
  98
  99 let replicate n x =
 100   let rec loop i ys =
 101     if i = 0 then
 102       ys
 103     else
 104       loop (i-1) (x::ys) in
 105     loop n []
 106
 107 let rec take n =
 108   function
 109       [] ->
 110         []
 111     | x::xs ->
 112         if n <= 0 then
 113           []
 114         else
 115           x :: take (n - 1) xs
 116
 117 let rec drop n =
 118   function
 119       [] ->
 120         []
 121     | xs when n <= 0 ->
 122         xs
 123     | _::xs ->
 124       drop (n-1) xs
 125
 126 let rec splitAt n xs =
 127   match n,xs with
 128       0,_  | _,[] ->
 129         [],xs
 130     | _,y::ys ->
 131         let p,q =
 132           splitAt (n-1) ys in
 133           y::p,q
 134
 135 let rec takeWhile f =
 136   function
 137       x::xs when f x ->
 138         x :: takeWhile f xs
 139     | _ ->
 140         []
 141
 142 let rec dropWhile f =
 143   function
 144       x::xs when f x ->
 145         dropWhile f xs
 146     | xs ->
 147         xs
 148
 149 let rec span f =
 150   function
 151       x::xs when f x ->
 152         let ys,zs =
 153           span f xs in
 154           x::ys,zs
 155     | xs ->
 156         [],xs
 157
 158 let break f =
 159   span (not $ f)
 160
 161 let rec zip_with f xs ys =
 162   match xs,ys with
 163       [],_ | _,[] ->
 164         []
 165     | x::xs',y::ys' ->
 166         (f x y)::zip_with f xs' ys'
 167
 168 let rec zip_with3 f xs ys zs =
 169   match xs,ys,zs with
 170       [],_,_ | _,[],_ | _,_,[] ->
 171         []
 172     | x::xs',y::ys',z::zs' ->
 173         (f x y z)::zip_with3 f xs' ys' zs'
 174
 175 let zip xs ys =
 176   zip_with (fun x y -> (x,y)) xs ys
 177
 178 let zip3 xs ys zs =
 179   zip_with3 (fun x y z -> (x,y,z)) xs ys zs
 180
 181 let unzip xs =
 182   List.fold_right (fun (x,y) (xs,ys) -> (x::xs,y::ys)) xs ([],[])
 183
 184 let unzip3 xs =
 185   List.fold_right (fun (x,y,z) (xs,ys,zs) -> (x::xs,y::ys,z::zs)) xs ([],[],[])
 186
 187 let lookup x xs =
 188   try
 189     Some (List.assoc x xs)
 190   with Not_found ->
 191     None