Let's write a signature to describe the stacks we wrote before.
module type ListStackSig = sig
val empty : 'a list
val push : 'a -> 'a list -> 'a list
val peek : 'a list -> 'a
val pop : 'a list -> 'a list
end
module type ListStackSig =
sig
val empty : 'a list
val push : 'a -> 'a list -> 'a list
val peek : 'a list -> 'a
val pop : 'a list -> 'a list
end
Now let's grab our code from before.
module ListStack : ListStackSig = struct
type 'a stack = 'a list
let empty = []
let push x s = x :: s
let peek = function
| [] -> failwith "Empty"
| x :: _ -> x
let pop = function
| [] -> failwith "Empty"
| _ :: s -> s
end
module ListStack : ListStackSig
Yay, no error! The types match, but what about MyStack?
module MyStack : ListStackSig = struct
type 'a stack =
| Empty
| Entry of 'a * 'a stack
let empty = Empty
let push x s = Entry (x, s)
let peek = function
| Empty -> failwith "Empty"
| Entry (x, _) -> x
let pop = function
| Empty -> failwith "Empty"
| Entry (_, x) -> x
end
File "[3]", lines 1-17, characters 32-3:
1 | ................................struct
2 | type 'a stack =
3 | | Empty
4 | | Entry of 'a * 'a stack
5 |
...
14 | let pop = function
15 | | Empty -> failwith "Empty"
16 | | Entry (_, x) -> x
17 | end
Error: Signature mismatch:
...
Values do not match:
val empty : 'a stack
is not included in
val empty : 'a list
File "[1]", line 2, characters 1-20: Expected declaration
File "[3]", line 6, characters 5-10: Actual declaration
Uh oh... our signature required empty to have type 'a list.
The signature we wrote for stack wasn't general enough. Let's generalize it!
module type StackSig = sig
type 'a stack
val empty : 'a stack
val push : 'a -> 'a stack -> 'a stack
val peek : 'a stack -> 'a
val pop : 'a stack -> 'a stack
end
module type StackSig =
sig
type 'a stack
val empty : 'a stack
val push : 'a -> 'a stack -> 'a stack
val peek : 'a stack -> 'a
val pop : 'a stack -> 'a stack
end
module ListStack : StackSig = struct
type 'a stack = 'a list
let empty = []
let push x s = x :: s
let peek = function
| [] -> failwith "Empty"
| x :: _ -> x
let pop = function
| [] -> failwith "Empty"
| _ :: s -> s
end
module MyStack : StackSig = struct
type 'a stack =
| Empty
| Entry of 'a * 'a stack
let empty = Empty
let push x s = Entry (x, s)
let peek = function
| Empty -> failwith "Empty"
| Entry (x, _) -> x
let pop = function
| Empty -> failwith "Empty"
| Entry (_, x) -> x
end
module ListStack : StackSig
module MyStack : StackSig
Now our signature is general enough for both of these!
Let's make one for queues.
module type Queue = sig
type 'a queue
val empty : 'a queue
val enqueue : 'a -> 'a queue -> 'a queue
val peek : 'a queue -> 'a option
val dequeue : 'a queue -> 'a queue option
end
module type Queue =
sig
type 'a queue
val empty : 'a queue
val enqueue : 'a -> 'a queue -> 'a queue
val peek : 'a queue -> 'a option
val dequeue : 'a queue -> 'a queue option
end
And let's bring in our queues from earlier
module ListQueue : Queue = struct
type 'a queue = 'a list
let empty = []
(* use the append operator to put it at the end of the list *)
(* linear time :'( *)
let enqueue x q = q @ [x]
let dequeue = function
| [] -> None
| _ :: t -> Some t
let peek = function
| [] -> None
| h :: _ -> Some h
end
module TwoListQueue : Queue = struct
(*
[{front = [a; b;]; back = [e; d; c;]}] represents the queue [a; b; c; d; e]
If [front] is empty, then back is empty too.
*)
type 'a queue = {
front : 'a list;
back : 'a list;
}
let empty = {front = []; back = [];}
(* Precondition: If the front is empty, the back is also empty *)
let peek = function
| {front = []} -> None
| {front = x :: _} -> Some x
let enqueue x = function
| {front = []} -> {front = [x]; back = []}
| q -> {q with back = x :: q.back}
(* This dequeue operation is constant time, unless the front becomes empty. *)
let dequeue = function
| {front = []} -> None
| {front = h :: []; back} -> Some {front = (List.rev back); back = []}
| {front = _ :: t; back} -> Some {front = t ; back}
end
module ListQueue : Queue
module TwoListQueue : Queue
We can also use modules as values
module CoolQueue = TwoListQueue
module CoolQueue = TwoListQueue