lib.ml.patch

70,75c70,74
< let rev =
<   let rec rev_append acc l =
<     match l with
<       [] -> acc
<     | h::t -> rev_append (h::acc) t in
<   fun l -> rev_append [] l;;
---
> let rec rev acc l =
>   match l with
>     [] -> acc
>   | h::t -> rev (h::acc) t;;
> let rev l = rev [] l;;
107a107,111
> let pp_exn e =
>   match e with
>   | Unchanged -> Pretty_printer.token "Unchanged"
>   | _ -> pp_exn e;;
> 
182c186
< let rec (--) = fun m n -> if m > n then [] else m::((m + 1) -- n);;
---
> let rec (--) m n = if m > n then [] else m::((m + 1) -- n);;
204,207c208,210
< let length =
<   let rec len k l =
<     if l = [] then k else len (k + 1) (tl l) in
<   fun l -> len 0 l;;
---
> let rec length k l =
>   if l = [] then k else length (k + 1) (tl l);;
> let length l = length 0 l;;
256c259
<     | (h::t) -> if Pervasives.compare x h = 0 then n else ind (n + 1) t in
---
>     | (h::t) -> if x = h then n else ind (n + 1) t in
266c269
<   | (h::t) -> Pervasives.compare x h = 0 || mem x t;;
---
>   | (h::t) -> x = h || mem x t;;
289c292
<     (x,y)::t -> if Pervasives.compare x a = 0 then y else assoc a t
---
>     (x,y)::t -> if x = a then y else assoc a t
294c297
<     (x,y)::t -> if Pervasives.compare y a = 0 then x else rev_assoc a t
---
>     (x,y)::t -> if y = a then x else rev_assoc a t
307,310c310,314
< let rec unzip =
<   function [] -> [],[]
<          | ((a,b)::rest) -> let alist,blist = unzip rest in
<                             (a::alist,b::blist);;
---
> let rec unzip xs =
>   match xs with
>   | [] -> [],[]
>   | ((a,b)::rest) -> let alist,blist = unzip rest in
>                      (a::alist,b::blist);;
348c352
<                       if Pervasives.compare x y = 0 then t' else
---
>                       if x = y then t' else
356c360
< let setify s = uniq (sort (fun x y -> Pervasives.compare x y <= 0) s);;
---
> let setify (<=) s = uniq (sort (fun x y -> x <= y) s);;
362c366,368
< let implode l = itlist (^) l "";;
---
> let implode  = String.concat;;
>   (* Woah: *)
>   (* itlist (^) l "";; *)
367,368c373,374
<       exap (n - 1) ((String.sub s n 1)::l) in
<   exap (String.length s - 1) [];;
---
>       exap (n - 1) ((String.substring s n 1)::l) in
>   exap (String.size s - 1) [];;
373a380,382
> let gcd = Int.gcd;;
> 
> (*
378a388
> *)
392,401c402
< let numdom r =
<   let r' = Ratio.normalize_ratio (ratio_of_num r) in
<   num_of_big_int(Ratio.numerator_ratio r'),
<   num_of_big_int(Ratio.denominator_ratio r');;
< 
< let numerator = fst o numdom
< and denominator = snd o numdom;;
< 
< let gcd_num n1 n2 =
<   num_of_big_int(Big_int.gcd_big_int (big_int_of_num n1) (big_int_of_num n2));;
---
> let numdom r = (Num.numerator r, Num.denominator r);;
421c422
<   Format.print_string s; Format.print_newline();;
---
>   print s; print "\n";;
450c451
<   let start_time = Sys.time() in
---
>   let start_time = (* Sys.time() *) Double.fromString "0.0" in
452c453
<       let finish_time = Sys.time() in
---
>       let finish_time = (* Sys.time()*) Double.fromString "0.0" in
456,458c457,459
<       let finish_time = Sys.time() in
<       Format.print_string("Failed after (user) CPU time of "^
<                           (string_of_float(finish_time -. start_time))^": ");
---
>       let finish_time = Double.fromString "0.0" (* Sys.time() *) in
>       print("Failed after (user) CPU time of "^
>             (string_of_float(finish_time -. start_time))^": ");
468c469
<   | (x,y)::t -> if Pervasives.compare x a = 0 then y else assocd a t d;;
---
>   | (x,y)::t -> if x = a then y else assocd a t d;;
473c474
<   | (x,y)::t -> if Pervasives.compare y a = 0 then x else rev_assocd a t d;;
---
>   | (x,y)::t -> if y = a then x else rev_assocd a t d;;
510c511,513
< let increasing f x y = Pervasives.compare (f x) (f y) < 0;;
---
> (* TODO These seem like they're not in use *)
> 
> let increasing (<) f x y = f x < f y;;
512c515
< let decreasing f x y = Pervasives.compare (f x) (f y) > 0;;
---
> let decreasing (>) f x y = f x > f y;;
523,526c526,538
< type ('a,'b)func =
<    Empty
<  | Leaf of int * ('a*'b)list
<  | Branch of int * int * ('a,'b)func * ('a,'b)func;;
---
> (* OA:
>      I can't map anything I want into an integer, but I can attach a comparison
>      function to the tree. You loose the canonicity property described above
>      but you'll probably always use the same comparison functions for the same
>      types, anyway, if you need to compare functions.
>  *)
> 
> type ('a,'b) func = Func of ('a -> 'a -> ordering) * ('a * 'b) list;;
> 
> let pp_func pk pv (Func (cmp, f)) =
>   Pretty_printer.app_block "func"
>     [Pretty_printer.pp_list (fun (k, v) ->
>       Pretty_printer.tuple [pk k; pv v]) f];;
532c544
< let undefined = Empty;;
---
> let undefined cmp = Func (cmp, []);;
538c550
< let is_undefined f =
---
> let is_undefined (Func (_, f)) =
540c552
<     Empty -> true
---
>     [] -> true
547,557c559
< let mapf =
<   let rec map_list f l =
<     match l with
<       [] -> []
<     | (x,y)::t -> (x,f(y))::(map_list f t) in
<   let rec mapf f t =
<     match t with
<       Empty -> Empty
<     | Leaf(h,l) -> Leaf(h,map_list f l)
<     | Branch(p,b,l,r) -> Branch(p,b,mapf f l,mapf f r) in
<   mapf;;
---
> let mapf f (Func (cmp, t)) = Func (cmp, map (I F_F f) t);;
563,585c565,573
< let foldl =
<   let rec foldl_list f a l =
<     match l with
<       [] -> a
<     | (x,y)::t -> foldl_list f (f a x y) t in
<   let rec foldl f a t =
<     match t with
<       Empty -> a
<     | Leaf(h,l) -> foldl_list f a l
<     | Branch(p,b,l,r) -> foldl f (foldl f a l) r in
<   foldl;;
< 
< let foldr =
<   let rec foldr_list f l a =
<     match l with
<       [] -> a
<     | (x,y)::t -> f x y (foldr_list f t a) in
<   let rec foldr f t a =
<     match t with
<       Empty -> a
<     | Leaf(h,l) -> foldr_list f l a
<     | Branch(p,b,l,r) -> foldr f l (foldr f r a) in
<   foldr;;
---
> let rec foldl f a =
>   function [] -> a
>          | (x,y)::xs -> foldl f (f a x y) xs;;
> let foldl f a (Func (_, t)) = foldl f a t;;
> 
> let rec foldr f a =
>   function [] -> a
>          | (x,y)::xs -> f x y (foldr f a xs);;
> let foldr f (Func (_, t)) a = foldr f a t;;
591c579,580
< let graph f = setify (foldl (fun a x y -> (x,y)::a) [] f);;
---
> let graph (Func (cmp, t)) vcmp =
>   setify (fun x y -> Pair.compare cmp vcmp x y <> Greater) t;;
593c582,583
< let dom f = setify(foldl (fun a x y -> x::a) [] f);;
---
> let dom (Func (cmp, t)) =
>   setify (fun x y -> cmp x y <> Greater) (map fst t);;
595c585,586
< let ran f = setify(foldl (fun a x y -> y::a) [] f);;
---
> let ran (Func (cmp, t)) vcmp =
>   setify (fun x y -> vcmp x y <> Greater) (map snd t);;
601,615c592,601
< let applyd =
<   let rec apply_listd l d x =
<     match l with
<       (a,b)::t -> let c = Pervasives.compare x a in
<                   if c = 0 then b else if c > 0 then apply_listd t d x else d x
<     | [] -> d x in
<   fun f d x ->
<     let k = Hashtbl.hash x in
<     let rec look t =
<       match t with
<         Leaf(h,l) when h = k -> apply_listd l d x
<       | Branch(p,b,l,r) when (k lxor p) land (b - 1) = 0
<                 -> look (if k land b = 0 then l else r)
<       | _ -> d x in
<     look f;;
---
> let applyd (Func (cmp, f)) d x' =
>   let rec look t =
>     match t with
>     | [] -> d x'
>     | (x,y)::xs ->
>         match cmp x' x with
>         | Less -> d x'
>         | Greater -> look xs
>         | Equal -> y in
>   look f;;
627,656c613,621
< let undefine =
<   let rec undefine_list x l =
<     match l with
<       (a,b as ab)::t ->
<           let c = Pervasives.compare x a in
<           if c = 0 then t
<           else if c < 0 then l else
<           let t' = undefine_list x t in
<           if t' == t then l else ab::t'
<     | [] -> [] in
<   fun x ->
<     let k = Hashtbl.hash x in
<     let rec und t =
<       match t with
<         Leaf(h,l) when h = k ->
<           let l' = undefine_list x l in
<           if l' == l then t
<           else if l' = [] then Empty
<           else Leaf(h,l')
<       | Branch(p,b,l,r) when k land (b - 1) = p ->
<           if k land b = 0 then
<             let l' = und l in
<             if l' == l then t
<             else (match l' with Empty -> r | _ -> Branch(p,b,l',r))
<           else
<             let r' = und r in
<             if r' == r then t
<             else (match r' with Empty -> l | _ -> Branch(p,b,l,r'))
<       | _ -> t in
<     und;;
---
> let rec undefine x' cmp t =
>   match t with
>   | [] -> t
>   | (x,y)::xs ->
>       match cmp x' x with
>       | Equal -> xs
>       | Less -> t
>       | Greater -> (x,y)::undefine x' cmp xs;;
> let undefine x' (Func (cmp, t)) = Func (cmp, undefine x' cmp t);;
662,751c627,651
< let (|->),combine =
<   let newbranch p1 t1 p2 t2 =
<     let zp = p1 lxor p2 in
<     let b = zp land (-zp) in
<     let p = p1 land (b - 1) in
<     if p1 land b = 0 then Branch(p,b,t1,t2)
<     else Branch(p,b,t2,t1) in
<   let rec define_list (x,y as xy) l =
<     match l with
<       (a,b as ab)::t ->
<           let c = Pervasives.compare x a in
<           if c = 0 then xy::t
<           else if c < 0 then xy::l
<           else ab::(define_list xy t)
<     | [] -> [xy]
<   and combine_list op z l1 l2 =
<     match (l1,l2) with
<       [],_ -> l2
<     | _,[] -> l1
<     | ((x1,y1 as xy1)::t1,(x2,y2 as xy2)::t2) ->
<           let c = Pervasives.compare x1 x2 in
<           if c < 0 then xy1::(combine_list op z t1 l2)
<           else if c > 0 then xy2::(combine_list op z l1 t2) else
<           let y = op y1 y2 and l = combine_list op z t1 t2 in
<           if z(y) then l else (x1,y)::l in
<   let (|->) x y =
<     let k = Hashtbl.hash x in
<     let rec upd t =
<       match t with
<         Empty -> Leaf (k,[x,y])
<       | Leaf(h,l) ->
<            if h = k then Leaf(h,define_list (x,y) l)
<            else newbranch h t k (Leaf(k,[x,y]))
<       | Branch(p,b,l,r) ->
<           if k land (b - 1) <> p then newbranch p t k (Leaf(k,[x,y]))
<           else if k land b = 0 then Branch(p,b,upd l,r)
<           else Branch(p,b,l,upd r) in
<     upd in
<   let rec combine op z t1 t2 =
<     match (t1,t2) with
<       Empty,_ -> t2
<     | _,Empty -> t1
<     | Leaf(h1,l1),Leaf(h2,l2) ->
<           if h1 = h2 then
<             let l = combine_list op z l1 l2 in
<             if l = [] then Empty else Leaf(h1,l)
<           else newbranch h1 t1 h2 t2
<     | (Leaf(k,lis) as lf),(Branch(p,b,l,r) as br) ->
<           if k land (b - 1) = p then
<             if k land b = 0 then
<               (match combine op z lf l with
<                  Empty -> r | l' -> Branch(p,b,l',r))
<             else
<               (match combine op z lf r with
<                  Empty -> l | r' -> Branch(p,b,l,r'))
<           else
<             newbranch k lf p br
<     | (Branch(p,b,l,r) as br),(Leaf(k,lis) as lf) ->
<           if k land (b - 1) = p then
<             if k land b = 0 then
<               (match combine op z l lf with
<                 Empty -> r | l' -> Branch(p,b,l',r))
<             else
<               (match combine op z r lf with
<                  Empty -> l | r' -> Branch(p,b,l,r'))
<           else
<             newbranch p br k lf
<     | Branch(p1,b1,l1,r1),Branch(p2,b2,l2,r2) ->
<           if b1 < b2 then
<             if p2 land (b1 - 1) <> p1 then newbranch p1 t1 p2 t2
<             else if p2 land b1 = 0 then
<               (match combine op z l1 t2 with
<                  Empty -> r1 | l -> Branch(p1,b1,l,r1))
<             else
<               (match combine op z r1 t2 with
<                  Empty -> l1 | r -> Branch(p1,b1,l1,r))
<           else if b2 < b1 then
<             if p1 land (b2 - 1) <> p2 then newbranch p1 t1 p2 t2
<             else if p1 land b2 = 0 then
<               (match combine op z t1 l2 with
<                  Empty -> r2 | l -> Branch(p2,b2,l,r2))
<             else
<               (match combine op z t1 r2 with
<                  Empty -> l2 | r -> Branch(p2,b2,l2,r))
<           else if p1 = p2 then
<            (match (combine op z l1 l2,combine op z r1 r2) with
<               (Empty,r) -> r | (l,Empty) -> l | (l,r) -> Branch(p1,b1,l,r))
<           else
<             newbranch p1 t1 p2 t2 in
<   (|->),combine;;
---
> let (|->) x y (Func (cmp, t)) =
>   let rec ins x y t =
>     match t with
>     | [] -> [(x,y)]
>     | (x',y')::xs ->
>         match cmp x x' with
>         | Less -> (x,y)::t
>         | Greater -> (x',y')::ins x y xs
>         | Equal -> (x,y)::xs in
>   Func (cmp, ins x y t);;
> 
> let combine op z (Func (cmp, t1)) (Func (_, t2)) =
>   let rec combine l1 l2 =
>     match l1, l2 with
>     | [], _ -> l2
>     | _, [] -> l1
>     | (x1,y1)::t1, (x2,y2)::t2 ->
>         match cmp x1 x2 with
>         | Less -> (x1,y1)::combine t1 l2
>         | Greater -> (x2,y2)::combine l1 t2
>         | Equal ->
>             let y = op y1 y2 in
>             let t = combine t1 t2 in
>             if z y then t else (x1,y)::t in
>   Func (cmp, combine t1 t2);;
757c657
< let (|=>) = fun x y -> (x |-> y) undefined;;
---
> let (|=>) = fun x y cmp -> (x |-> y) (undefined cmp);;
763,767c663,666
< let rec choose t =
<   match t with
<     Empty -> failwith "choose: completely undefined function"
<   | Leaf(h,l) -> hd l
<   | Branch(b,p,t1,t2) -> choose t1;;
---
> let choose (Func (_, t)) =
>   try hd t
>   with Failure _ ->
>     failwith "choose: completely undefined function";;
773,777c672
< let pp_print_fpf fmt (f:('a,'b)func) = Format.pp_print_string fmt "<func>";;
< 
< let print_fpf = pp_print_fpf Format.std_formatter;;
< 
< #install_printer pp_print_fpf;;
---
> (* Can't do it. *)
832,833c727,728
<   let fd = try Pervasives.open_in filename
<            with Sys_error _ ->
---
>   let fd = try Text_io.b_openIn filename
>            with Text_io.Bad_file_name ->
836,838c731,733
<     try let l = Pervasives.input_line fd in
<         suck_lines (l::acc)
<     with End_of_file -> rev acc in
---
>     match Text_io.b_inputLine fd with
>     | Some l -> suck_lines (l::acc)
>     | None -> rev acc in
840c735
<   (Pervasives.close_in fd; data);;
---
>   Text_io.b_closeIn fd; data;;
846,847c741,742
<   let fd = Pervasives.open_out filename in
<   output_string fd s; close_out fd;;
---
>   let fd = Text_io.openOut filename in
>   Text_io.output fd s; Text_io.closeOut fd;;