Permalink
Browse files

Fixed potential complexity bug with stream representation

  • Loading branch information...
1 parent 5fd5967 commit f0dbf3c29994651cd6fc3bf721bd4265a048703d @mmottl mmottl committed Mar 27, 2012
Showing with 239 additions and 206 deletions.
  1. +45 −35 chp4.ml
  2. +41 −34 chp6.ml
  3. +81 −72 chp7.ml
  4. +72 −65 chp8.ml
View
@@ -8,7 +8,7 @@
Translation from SML to OCAML (this file):
- Copyright (C) 1999 - 2002 Markus Mottl
+ Copyright (C) 1999 - 2012 Markus Mottl
email: markus.mottl@gmail.com
www: http://www.ocaml.info
@@ -27,7 +27,8 @@
let (!$) = Lazy.force
module type STREAM = sig
- type 'a stream = Nil | Cons of 'a * 'a stream Lazy.t
+ type 'a stream_cell = Nil | Cons of 'a * 'a stream
+ and 'a stream = 'a stream_cell Lazy.t
val (++) : 'a stream -> 'a stream -> 'a stream (* stream append *)
val take : int -> 'a stream -> 'a stream
@@ -36,48 +37,57 @@ module type STREAM = sig
end
module Stream : STREAM = struct
- type 'a stream = Nil | Cons of 'a * 'a stream Lazy.t
-
- (* function lazy *)
- let rec (++) s1 s2 = match s1 with
- | Nil -> s2
- | Cons (hd, tl) -> Cons (hd, lazy (!$tl ++ s2))
-
- (* function lazy *)
- let rec take n = function
- | _ when n = 0 -> Nil
- | Nil -> Nil
- | Cons (hd, tl) -> Cons (hd, lazy (take (n - 1) !$tl))
-
- (* function lazy *)
- let rec drop n = function
- | s when n = 0 -> s
- | Nil -> Nil
- | Cons (_, tl) -> drop (n - 1) !$tl
-
- (* function lazy *)
+ type 'a stream_cell = Nil | Cons of 'a * 'a stream
+ and 'a stream = 'a stream_cell Lazy.t
+
+ let rec (++) s1 s2 =
+ lazy (
+ match s1 with
+ | lazy Nil -> Lazy.force s2
+ | lazy (Cons (hd, tl)) -> Cons (hd, tl ++ s2))
+
+ let rec take n s =
+ lazy (
+ if n = 0 then Nil
+ else
+ match s with
+ | lazy Nil -> Nil
+ | lazy (Cons (hd, tl)) -> Cons (hd, take (n - 1) tl))
+
+ let rec drop n s =
+ lazy (
+ match n, s with
+ | 0, _ -> !$s
+ | _, lazy Nil -> Nil
+ | _, lazy (Cons (_, tl)) -> !$ (drop (n - 1) tl))
+
let reverse s =
- let rec reverse' acc = function
- | Nil -> acc
- | Cons (hd, tl) -> reverse' (Cons (hd, lazy acc)) !$tl in
- reverse' Nil s
+ let rec reverse' acc s =
+ lazy (
+ match s with
+ | lazy Nil -> !$ acc
+ | lazy (Cons (hd, tl)) -> !$ (reverse' (lazy (Cons (hd, acc))) tl))
+ in
+ reverse' (lazy Nil) s
end
-(*
(* MM: for demonstration purposes *)
+(*
open Stream
-let rec l_map f = function
- | Nil -> Nil
- | Cons (hd, tl) -> Cons (f hd, lazy (l_map f !$tl))
+let rec l_map f s =
+ lazy (
+ match s with
+ | lazy Nil -> Nil
+ | lazy (Cons (hd, tl)) -> Cons (f hd, l_map f tl))
let rec l_iter f n = function
- | Nil -> ()
- | Cons (hd, tl) -> if n > 0 then begin f hd; l_iter f (n-1) !$tl end
+ | lazy (Cons (hd, tl)) when n > 0 -> f hd; l_iter f (n - 1) tl
+ | _ -> ()
-let rec nat = Cons (0, lazy (l_map succ nat))
+let rec nat = lazy (Cons (0, l_map succ nat))
let _ =
- let test = reverse (take 10 (drop 50 (take 1000000000 nat))) in
- l_iter (fun n -> print_int n; print_newline ()) 1000 test
+ let test = reverse (take 10 (drop 50 (take 1_000_000_000 nat))) in
+ l_iter (fun n -> Printf.printf "%d\n" n) 1_000 test
*)
View
@@ -73,7 +73,8 @@ end
let (!$) = Lazy.force
module type STREAM = sig
- type 'a stream = Nil | Cons of 'a * 'a stream Lazy.t
+ type 'a stream_cell = Nil | Cons of 'a * 'a stream
+ and 'a stream = 'a stream_cell Lazy.t
val (++) : 'a stream -> 'a stream -> 'a stream (* stream append *)
val take : int -> 'a stream -> 'a stream
@@ -82,33 +83,38 @@ module type STREAM = sig
end
module Stream : STREAM = struct
- type 'a stream = Nil | Cons of 'a * 'a stream Lazy.t
-
- (* function lazy *)
- let rec (++) s1 s2 = match s1 with
- | Nil -> s2
- | Cons (hd, tl) -> Cons (hd, lazy (!$tl ++ s2))
-
- (* function lazy *)
- let rec take n s = match n, s with
- | 0, _ -> Nil
- | _, Nil -> Nil
- | _, Cons (hd, tl) -> Cons (hd, lazy (take (n - 1) !$tl))
-
- (* function lazy *)
- let drop n s =
- let rec drop' n s = match n, s with
- | 0, _ -> s
- | _, Nil -> Nil
- | _, Cons (_, tl) -> drop' (n - 1) !$tl in
- drop' n s
-
- (* function lazy *)
+ type 'a stream_cell = Nil | Cons of 'a * 'a stream
+ and 'a stream = 'a stream_cell Lazy.t
+
+ let rec (++) s1 s2 =
+ lazy (
+ match s1 with
+ | lazy Nil -> Lazy.force s2
+ | lazy (Cons (hd, tl)) -> Cons (hd, tl ++ s2))
+
+ let rec take n s =
+ lazy (
+ if n = 0 then Nil
+ else
+ match s with
+ | lazy Nil -> Nil
+ | lazy (Cons (hd, tl)) -> Cons (hd, take (n - 1) tl))
+
+ let rec drop n s =
+ lazy (
+ match n, s with
+ | 0, _ -> !$s
+ | _, lazy Nil -> Nil
+ | _, lazy (Cons (_, tl)) -> !$ (drop (n - 1) tl))
+
let reverse s =
- let rec reverse' acc = function
- | Nil -> acc
- | Cons (hd, tl) -> reverse' (Cons (hd, lazy acc)) !$tl in
- reverse' Nil s
+ let rec reverse' acc s =
+ lazy (
+ match s with
+ | lazy Nil -> !$ acc
+ | lazy (Cons (hd, tl)) -> !$ (reverse' (lazy (Cons (hd, acc))) tl))
+ in
+ reverse' (lazy Nil) s
end
@@ -117,22 +123,23 @@ open Stream
module BankersQueue : QUEUE = struct
type 'a queue = int * 'a stream * int * 'a stream
- let empty = 0, Nil, 0, Nil
+ let empty = 0, lazy Nil, 0, lazy Nil
let is_empty (lenf, _, _, _) = lenf = 0
let check (lenf, f, lenr, r as q) =
if lenr <= lenf then q
- else (lenf + lenr, f ++ reverse r, 0, Nil)
+ else (lenf + lenr, f ++ reverse r, 0, lazy Nil)
- let snoc (lenf, f, lenr, r) x = check (lenf, f, lenr + 1, Cons (x, lazy r))
+ let snoc (lenf, f, lenr, r) x =
+ check (lenf, f, lenr + 1, lazy (Cons (x, r)))
let head = function
- | _, Nil, _, _ -> raise Empty
- | _, Cons (x, _), _, _ -> x
+ | _, lazy Nil, _, _ -> raise Empty
+ | _, lazy (Cons (x, _)), _, _ -> x
let tail = function
- | _, Nil, _, _ -> raise Empty
- | lenf, Cons (_, f'), lenr, r -> check (lenf - 1, !$f', lenr, r)
+ | _, lazy Nil, _, _ -> raise Empty
+ | lenf, lazy (Cons (_, f')), lenr, r -> check (lenf - 1, f', lenr, r)
end
Oops, something went wrong.

0 comments on commit f0dbf3c

Please sign in to comment.