unison

Fork of Unison, a bi-directional file synchronization tool
git clone git://git.laack.co/unison.git
Log | Files | Refs | README | LICENSE

safelist.ml (4427B)

      1 (* Unison file synchronizer: src/ubase/safelist.ml *)
      2 (* Copyright 1999-2020, Benjamin C. Pierce
      3 
      4     This program is free software: you can redistribute it and/or modify
      5     it under the terms of the GNU General Public License as published by
      6     the Free Software Foundation, either version 3 of the License, or
      7     (at your option) any later version.
      8 
      9     This program is distributed in the hope that it will be useful,
     10     but WITHOUT ANY WARRANTY; without even the implied warranty of
     11     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12     GNU General Public License for more details.
     13 
     14     You should have received a copy of the GNU General Public License
     15     along with this program.  If not, see <http://www.gnu.org/licenses/>.
     16 *)
     17 
     18 
     19 let filterBoth f l =
     20   let rec loop r1 r2 = function
     21     [] -> (List.rev r1, List.rev r2)
     22   | hd::tl ->
     23       if f hd then loop (hd::r1) r2 tl
     24       else loop r1 (hd::r2) tl
     25   in loop [] [] l
     26 
     27 let filterMap f l =
     28   let rec loop r = function
     29     [] -> List.rev r
     30   | hd::tl -> begin
     31       match f hd with
     32         None -> loop r tl
     33       | Some x -> loop (x::r) tl
     34     end
     35   in loop [] l
     36 
     37 let filterMap2 f l =
     38   let rec loop r s = function
     39     [] -> List.rev r, List.rev s
     40   | hd::tl -> begin
     41       let (a, b) = f hd in
     42       let r' = match a with None -> r | Some x -> x::r in
     43       let s' = match b with None -> s | Some x -> x::s in
     44       loop r' s' tl
     45     end
     46   in loop [] [] l
     47 
     48 (* These are tail-recursive versions of the standard ones from the
     49    List module *)
     50 let rec concat_rec accu =
     51   function
     52     [] -> List.rev accu
     53   | l::r -> concat_rec (List.rev_append l accu) r
     54 let concat l = concat_rec [] l
     55 let flatten = concat
     56 
     57 let append l l' =
     58   match l' with [] -> l | _ -> List.rev_append (List.rev l) l'
     59 
     60 let rev_map f l =
     61   let rec rmap_f accu = function
     62     | [] -> accu
     63     | a::l -> rmap_f (f a :: accu) l
     64   in
     65   rmap_f [] l
     66 
     67 let map f l = List.rev (rev_map f l)
     68 
     69 let rev_map2 f l1 l2 =
     70   let rec rmap2_f accu l1 l2 =
     71     match (l1, l2) with
     72     | ([], []) -> accu
     73     | (a1::l1, a2::l2) -> rmap2_f (f a1 a2 :: accu) l1 l2
     74     | (_, _) -> invalid_arg "List.rev_map2"
     75   in
     76   rmap2_f [] l1 l2
     77 ;;
     78 
     79 let map2 f l1 l2 = List.rev (rev_map2 f l1 l2)
     80 
     81 let rec allElementsEqual = function
     82     [] -> true
     83   | [a] -> true
     84   | a::b::rest -> a=b && (allElementsEqual (b::rest))
     85 
     86 let rec fold_left f accu l =
     87   match l with
     88     [] -> accu
     89   | a::_ ->
     90       (* We don't want l to be live when f is called *)
     91       let l' = List.tl l in
     92       fold_left f (f accu a) l'
     93 
     94 let split l =
     95   let rec loop acc1 acc2 = function
     96     [] -> (List.rev acc1, List.rev acc2)
     97   | (x,y)::l -> loop (x::acc1) (y::acc2) l
     98   in
     99     loop [] [] l
    100 
    101 let rec transpose_rec accu l =
    102   match l with
    103     [] | []::_ ->
    104       accu
    105   | [x]::_ ->
    106       (map (function [x] -> x | _ -> invalid_arg "Safelist.transpose") l)::accu
    107   | _ ->
    108       let (l0, r) =
    109         fold_left
    110           (fun (l0, r) l1 ->
    111              match l1 with
    112                []    -> invalid_arg "Safelist.transpose (2)"
    113              | a::r1 -> (a::l0, r1::r))
    114           ([], []) l
    115       in
    116       transpose_rec ((List.rev l0)::accu) (List.rev r)
    117 
    118 let transpose l = List.rev (transpose_rec [] l)
    119 
    120 let combine l1 l2 =
    121   let rec loop acc = function
    122     ([], []) -> List.rev acc
    123   | (a1::l1r, a2::l2r) -> loop ((a1, a2)::acc) (l1r,l2r)
    124   | (_, _) -> invalid_arg "Util.combine"
    125   in
    126     loop [] (l1,l2)
    127 
    128 let remove_assoc x l =
    129   let rec loop acc = function
    130   | [] -> List.rev acc
    131   | (a, b as pair) :: rest ->
    132       if a = x then loop acc rest else loop (pair::acc) rest
    133   in
    134     loop [] l
    135 
    136 let fold_right f l accu =
    137   fold_left (fun x y -> f y x) accu (List.rev l)
    138 
    139 let flatten_map f l = flatten (map f l)
    140 
    141 let remove x l =
    142   let rec loop acc = function
    143   | [] -> List.rev acc
    144   | a :: rest ->
    145       if a = x then loop acc rest else loop (a::acc) rest
    146   in
    147     loop [] l
    148 
    149 let iteri f l =
    150   let rec loop n = function
    151     | [] -> ()
    152     | h::t -> ((f n h); loop (n+1) t)
    153   in loop 0 l
    154 
    155 (* These are already tail recursive in the List module *)
    156 let iter = List.iter
    157 let iter2 = List.iter2
    158 let rev = List.rev
    159 let rev_append = List.rev_append
    160 let hd = List.hd
    161 let tl = List.tl
    162 let nth = List.nth
    163 let length = List.length
    164 let mem = List.mem
    165 let assoc = List.assoc
    166 let for_all = List.for_all
    167 let exists = List.exists
    168 let find = List.find
    169 let filter = List.filter
    170 let stable_sort = List.stable_sort
    171 let sort = List.sort
    172 let partition = List.partition