-
Notifications
You must be signed in to change notification settings - Fork 0
/
chp4.ml
83 lines (64 loc) · 2.26 KB
/
chp4.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
(*
Original source code in SML from:
Purely Functional Data Structures
Chris Okasaki
Cambridge University Press, 1998
Copyright (c) 1998 Cambridge University Press
Translation from SML to OCAML (this file):
Copyright (C) 1999 - 2002 Markus Mottl
email: markus.mottl@gmail.com
www: http://www.ocaml.info
Unless this violates copyrights of the original sources, the following
licence applies to this file:
This source code is free software; you can redistribute it and/or
modify it without any restrictions. It is distributed in the hope
that it will be useful, but WITHOUT ANY WARRANTY.
*)
(***********************************************************************)
(* Chapter 4 *)
(***********************************************************************)
let (!$) = Lazy.force
module type STREAM = sig
type 'a stream = Nil | Cons of 'a * 'a stream Lazy.t
val (++) : 'a stream -> 'a stream -> 'a stream (* stream append *)
val take : int -> 'a stream -> 'a stream
val drop : int -> 'a stream -> 'a stream
val reverse : 'a stream -> 'a stream
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 *)
let reverse s =
let rec reverse' acc = function
| Nil -> acc
| Cons (hd, tl) -> reverse' (Cons (hd, lazy acc)) !$tl in
reverse' 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_iter f n = function
| Nil -> ()
| Cons (hd, tl) -> if n > 0 then begin f hd; l_iter f (n-1) !$tl end
let rec nat = Cons (0, lazy (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
*)