section4.ml 3.98 KB
Newer Older
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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
(* CSE 341, Section 4, Completed/Solution Code *)

(* mutual recursion, just since we haven't shown it to you *)

(* can do any finite state machine this way -- this one checks 
   for strictly alternating even/odd
   mutual recursion is often not tail-recursive, but for 
   finite state machines it is
*)
let rec start xs =
  match xs with 
  | [] -> true
  | i::xs' -> if i mod 2 = 0 then saw_even xs' else saw_odd xs'
and saw_even xs = 
  match xs with
  | [] -> true
  | i::xs' -> i mod 2 <> 0 && saw_odd xs' 
and saw_odd xs =
  match xs with
  | [] -> true
  | i::xs' -> i mod 2 = 0 && saw_even xs'

(* style above is correct, but we could if we really had to 
   use first-class functions to encode mutual recursion by
   having earlier functions take function arguments and then
   calling them with later functions
  *)
let saw_even2 f xs = 
  match xs with
  | [] -> true
  | i::xs' -> i mod 2 <> 0 && f xs' 

let rec saw_odd2 xs =
  match xs with
  | [] -> true
  | i::xs' -> i mod 2 = 0 && saw_even2 saw_odd2 xs'
let start2 xs =
  match xs with 
  | [] -> true
  | i::xs' -> if i mod 2 = 0 then saw_even2 saw_odd2 xs' else saw_odd2 xs'
    
(* module system *)

(* NO CODE CAN DEPEND ON ANYTHING NOT IN THE MODULE TYPE! *)

module type NONEGINT = sig
  type t 
  val mknni : int -> t option
  val add : t -> t -> t (* why not t -> t -> int  or t -> t -> t option? *)
  val mul : t -> t -> t
  val sub : t -> t -> t option
  val to_int : t -> int (* why not t -> t ? *)
end

(* this example, thanks to the abstract type in NONEGINT, makes it impossible for a client 
   to make a value of type NonNegInt.t that is negative.
   
   However, this is assuming (wrongly) that ints do not overflow.  That assumption is useful 
   for a simple example that conveys the idea of relying on an abstraction, but in practice
   due to overflow, we would need add and mul to check for negatives and return an option,
   like sub, which makes the example less compelling. *)
module NonNegInt : NONEGINT = struct
  type t = int

  let mknni i =
    if i < 0 then
      None
    else
      Some i

  let add a b =
    a + b (* why not mknni (a * b) ? See comment above. *)

  let mul a b = 
    a * b (* why not mknni (a * b) ? See comment above. *)

  let sub a b =
    mknni (a - b) (* why not a - b ? *)

  let to_int a = a (* external world doesn't know this "is it" *)
end

(* This example shows three different ways to implement the same abstraction where,
   thanks to the abstract type, all three behave exactly the same for all clients.
   Each uses a different data structure and therefore has different algorithms and 
   invariants.
*)

module type NONEMPTYLIST = sig
  type 'a t

  val single : 'a -> 'a t

  val cons : 'a -> 'a t -> 'a t

  val tl : 'a t -> 'a t
  val hd : 'a t -> 'a
  val len : 'a t -> int
  val map : ('a -> 'b) -> 'a t -> 'b t
end

module Nel_A : NONEMPTYLIST = struct
  type 'a t =
  | Single of 'a
  | Cons of 'a * 'a t

  let single x = Single x
  let cons x xs = Cons (x,xs)
  let tl xs = 
    match xs with
    | Single _ -> failwith "tl of one-element list"
    | Cons(_,xs') -> xs'
  let hd xs =
    match xs with
    | Single x -> x
    | Cons(x,_) -> x
  let rec len xs =
    match xs with
    | Single _ -> 1
    | Cons(_,xs') -> 1 + len xs'
  let rec map f xs =
    match xs with
    | Single x -> Single (f x)
    | Cons (x,xs') -> Cons(f x, map f xs')
end

module Nel_B : NONEMPTYLIST = struct
  type 'a t = 'a * ('a list)
  let single x = (x,[])
  let cons x (y,xs) = (x,y::xs)
  let tl xs =
    match xs with
    | (_,[]) -> failwith "tl of one-element list"
    | (_,y::ys) -> (y,ys)
  let hd = fst
  let len (_,xs') = 
    1 + List.length xs'
  let map f (x,xs') =
    (f x, List.map f xs')
end

module Nel_C : NONEMPTYLIST = struct
  type 'a t = 'a list
  let single x = [x]
  let cons x xs = x::xs
  let tl xs =
    match xs with
    | [] -> failwith "impossible -- can never happen"
    | x::[] -> failwith "tl of one-element list"
    | x::xs' -> xs'
  let hd = List.hd
  let len = List.length
  let map = List.map
end