Exercises
Stacks as Objects
Let us reconsider the stacks example, this time in object oriented style.
-
Define a class intstack using Objective CAML's lists,
implementing methods push, pop, top and
size.
# exception
EmptyStack
class
intstack
()
=
object
val
p
=
ref
([]
:
int
list)
method
emstack
i
=
p
:=
i::
!
p
method
push
i
=
p
:=
i
::
!
p
method
pop
()
=
if
!
p
=
[]
then
raise
EmptyStack
else
p
:=
List.tl
!
p
method
top
()
=
if
!
p
=
[]
then
raise
EmptyStack
else
List.hd
!
p
method
size
()
=
List.length
!
p
end
;;
exception EmptyStack
class intstack :
unit ->
object
val p : int list ref
method emstack : int -> unit
method pop : unit -> unit
method push : int -> unit
method size : unit -> int
method top : unit -> int
end
- Create an instance containing 3 and 4 as stack elements.
# let
p
=
new
intstack
()
;;
val p : intstack = <obj>
# p#push
3
;;
- : unit = ()
# p#push
4
;;
- : unit = ()
- Define a new class stack containing elements
answering the method
print : unit -> unit
.
# class
stack
()
=
object
val
p
=
ref
([]
:
<
print
:
unit
->
unit>
list)
method
push
i
=
p
:=
i::
!
p
method
pop
()
=
if
!
p
=
[]
then
raise
EmptyStack
else
p
:=
List.tl
!
p
method
top
()
=
if
!
p
=
[]
then
raise
EmptyStack
else
List.hd
!
p
method
size
()
=
List.length
!
p
end
;;
class stack :
unit ->
object
val p : < print : unit -> unit > list ref
method pop : unit -> unit
method push : < print : unit -> unit > -> unit
method size : unit -> int
method top : unit -> < print : unit -> unit >
end
- Define a parameterized class ['a] stack,
using the same methods.
# class
[
'a]
pstack
()
=
object
val
p
=
ref
([]
:
'a
list)
method
push
i
=
p
:=
i::
!
p
method
pop
()
=
if
!
p
=
[]
then
raise
EmptyStack
else
p
:=
List.tl
!
p
method
top
()
=
if
!
p
=
[]
then
raise
EmptyStack
else
(List.hd
!
p)
method
size
()
=
List.length
!
p
end
;;
class ['a] pstack :
unit ->
object
val p : 'a list ref
method pop : unit -> unit
method push : 'a -> unit
method size : unit -> int
method top : unit -> 'a
end
- Compare the different classes of stacks.
Delayed Binding
This exercise illustrates how delayed binding can be used in a setting
other than subtyping.
Given the program below:
-
Draw the relations between classes.
- Draw the different messages.
- Assuming you are in character mode without echo, what does the program display?
exception
CrLf;;
class
chain_read
(m)
=
object
(self)
val
msg
=
m
val
mutable
res
=
""
method
char_read
=
let
c
=
input_char
stdin
in
if
(c
!=
'\n'
)
then
begin
output_char
stdout
c;
flush
stdout
end;
String.make
1
c
method
private
chain_read_aux
=
while
true
do
let
s
=
self#char_read
in
if
s
=
"\n"
then
raise
CrLf
else
res
<-
res
^
s;
done
method
private
chain_read_aux2
=
let
s
=
self#lire_char
in
if
s
=
"\n"
then
raise
CrLf
else
begin
res
<-
res
^
s;
self#chain_read_aux2
end
method
chain_read
=
try
self#chain_read_aux
with
End_of_file
->
()
|
CrLf
->
()
method
input
=
res
<-
""
;
print_string
msg;
flush
stdout;
self#chain_read
method
get
=
res
end;;
class
mdp_read
(m)
=
object
(self)
inherit
chain_read
m
method
char_read
=
let
c
=
input_char
stdin
in
if
(c
!=
'\n'
)
then
begin
output_char
stdout
'*'
;
flush
stdout
end;
let
s
=
" "
in
s.[
0
]
<-
c;
s
end;;
let
login
=
new
chain_read("Login : "
);;
let
passwd
=
new
mdp_read("Passwd : "
);;
login#input;;
passwd#input;;
print_string
(login#get);;print_newline();;
print_string
(passwd#get);;print_newline();;
Abstract Classes and an Expression Evaluator
This exercise illustrates code factorization with abstract classes.
All constructed arithmetic expressions are instances of a subclass of
the abstract class expr_ar.
-
Define an abstract class expr_ar for
arithmetic expressions with two abstract methods: eval of type
float, and print of type unit, which respectively
evaluates and displays an arithmetic expression.
# class
virtual
expr_ar
()
=
object
method
virtual
eval
:
unit
->
float
method
virtual
print
:
unit
->
unit
end
;;
class virtual expr_ar :
unit ->
object
method virtual eval : unit -> float
method virtual print : unit -> unit
end
- Define a concrete class constant, a subclass
of expr_ar.
# class
constant
x
=
object
inherit
expr_ar
()
val
c
=
x
method
eval
()
=
c
method
print
()
=
print_float
c
end
;;
class constant :
float ->
object
val c : float
method eval : unit -> float
method print : unit -> unit
end
(* autre solution : *)
# class
const
x
=
object
inherit
expr_ar
()
method
eval
()
=
x
method
print
()
=
print_float
x
end
;;
class const :
float -> object method eval : unit -> float method print : unit -> unit end
- Define an abstract subclass bin_op of
expr_ar implementing methods eval and print
using two new abstract methods oper,
of type (float * float) -> float (used by eval) and
symbol of type string
(used by print).
# class
virtual
bin_op
g
d
=
object
(this)
inherit
expr_ar
()
val
fg
=
g
val
fd
=
d
method
virtual
symbol
:
string
method
virtual
oper
:
float
*
float
->
float
method
eval
()
=
let
x
=
fg#eval()
and
y
=
fd#eval()
in
this#oper(x,
y)
method
print
()
=
fg#print
()
;
print_string
(this#symbol)
;
fd#print
()
end
;;
class virtual bin_op :
(< eval : unit -> float; print : unit -> 'b; .. > as 'a) ->
(< eval : unit -> float; print : unit -> unit; .. > as 'c) ->
object
val fd : 'c
val fg : 'a
method eval : unit -> float
method virtual oper : float * float -> float
method print : unit -> unit
method virtual symbol : string
end
- Define concrete classes add and mul as
subclasses of bin_op that implement the methods oper and
symbol.
# class
add
x
y
=
object
inherit
bin_op
x
y
method
symbol
=
"+"
method
oper(x,
y)
=
x
+.
y
end
;;
class add :
(< eval : unit -> float; print : unit -> 'b; .. > as 'a) ->
(< eval : unit -> float; print : unit -> unit; .. > as 'c) ->
object
val fd : 'c
val fg : 'a
method eval : unit -> float
method oper : float * float -> float
method print : unit -> unit
method symbol : string
end
# class
mul
x
y
=
object
inherit
bin_op
x
y
method
symbol
=
"*"
method
oper(x,
y)
=
x
*.
y
end
;;
class mul :
(< eval : unit -> float; print : unit -> 'b; .. > as 'a) ->
(< eval : unit -> float; print : unit -> unit; .. > as 'c) ->
object
val fd : 'c
val fg : 'a
method eval : unit -> float
method oper : float * float -> float
method print : unit -> unit
method symbol : string
end
- Draw the inheritance tree.
- Write a function that takes a sequence of
Genlex.token, and constructs an object of type expr_ar.
# open
Genlex
;;
# exception
Found
of
expr_ar
;;
exception Found of expr_ar
# let
rec
create
accu
l
=
let
r
=
match
Stream.next
l
with
Float
f
->
new
constant
f
|
Int
i
->
(
new
constant
(float
i)
:>
expr_ar)
|
Kwd
k
->
let
v1
=
accu#top()
in
accu#pop();
let
v2
=
accu#top()
in
accu#pop();
(
match
k
with
"+"
->
(
new
add
v2
v1
:>
expr_ar)
|
"*"
->
(
new
mul
v2
v1
:>
expr_ar)
|
";"
->
raise
(Found
(accu#top()))
|
_
->
failwith
"aux : bad keyword"
)
|
_
->
failwith
"aux : bad case"
in
create
(accu#push
(r
:>
expr_ar);
accu)
l
;;
val create :
< pop : unit -> 'a; push : expr_ar -> 'b; top : unit -> expr_ar; .. > ->
Genlex.token Stream.t -> 'c = <fun>
# let
gl
=
Genlex.make_lexer
[
"+"
;
"*"
;
";"
]
;;
val gl : char Stream.t -> Genlex.token Stream.t = <fun>
# let
run
()
=
let
s
=
Stream.of_channel
stdin
in
create
(new
pstack
())
(gl
s)
;;
val run : unit -> 'a = <fun>
- Test this program by reading the standard input using the generic
lexical analyzer Genlex. You can enter the expressions in post-fix
form.
The Game of Life and Objects.
Define the following two classes:
-
Write the class cell.
# class
cell
a
=
object
val
mutable
v
=
(a
:
bool)
method
isAlive
=
v
end
;;
class cell : bool -> object val mutable v : bool method isAlive : bool end
- Write an abstract class absWorld that implements
the abstract methods
display
, getCell
and setCell
.
Leave the method nextGen
abstract.
# class
virtual
absWorld
n
m
=
object(self)
val
mutable
tcell
=
Array.create_matrix
n
m
(new
cell
false)
val
maxx
=
n
val
maxy
=
m
val
mutable
gen
=
0
method
private
draw(c)
=
if
c#isAlive
then
print_string
"*"
else
print_string
"."
method
display()
=
for
i
=
0
to
(maxx-
1
)
do
for
j=
0
to
(maxy
-
1
)
do
print_string
" "
;
self#draw(tcell.
(i).
(j))
done
;
print_newline()
done
method
getCell(i,
j)
=
tcell.
(i).
(j)
method
setCell(i,
j,
c)
=
tcell.
(i).
(j)
<-
c
method
getCells
=
tcell
end
;;
class virtual absWorld :
int ->
int ->
object
val mutable gen : int
val maxx : int
val maxy : int
val mutable tcell : cell array array
method display : unit -> unit
method private draw : cell -> unit
method getCell : int * int -> cell
method getCells : cell array array
method setCell : int * int * cell -> unit
end
- Write the class world, a subclass of
absWorld
,
that implements the method nextGen
according to the growth rules.
# class
world
n
m
=
object(self)
inherit
absWorld
n
m
method
neighbors(x,
y)
=
let
r
=
ref
0
in
for
i=
x-
1
to
x+
1
do
let
k
=
(i+
maxx)
mod
maxx
in
for
j=
y-
1
to
y+
1
do
let
l
=
(j
+
maxy)
mod
maxy
in
if
tcell.
(k).
(l)#isAlive
then
incr
r
done
done;
if
tcell.
(x).
(y)#isAlive
then
decr
r
;
!
r
method
nextGen()
=
let
w2
=
new
world
maxx
maxy
in
for
i=
0
to
maxx-
1
do
for
j=
0
to
maxy
-
1
do
let
n
=
self#neighbors(i,
j)
in
if
tcell.
(i).
(j)#isAlive
then
(if
(n
=
2
)
||
(n
=
3
)
then
w2#setCell(i,
j,
new
cell
true))
else
(if
n
=
3
then
w2#setCell(i,
j,
new
cell
true))
done
done
;
tcell
<-
w2#getCells
;
gen
<-
gen
+
1
end
;;
class world :
int ->
int ->
object
val mutable gen : int
val maxx : int
val maxy : int
val mutable tcell : cell array array
method display : unit -> unit
method private draw : cell -> unit
method getCell : int * int -> cell
method getCells : cell array array
method neighbors : int * int -> int
method nextGen : unit -> unit
method setCell : int * int * cell -> unit
end
- Write the main program which creates an empty world,
adds some cells, and then enters an interactive loop that iterates displaying the world, waiting
for an interaction and computing the next generation.
# exception
The_end;;
exception The_end
# let
main
()
=
let
a
=
1
0
and
b
=
1
2
in
let
w
=
new
world
a
b
in
w#setCell(4
,
4
,
new
cell
true)
;
w#setCell(4
,
5
,
new
cell
true)
;
w#setCell(4
,
6
,
new
cell
true)
;
try
while
true
do
w#display()
;
if
((read_line())
=
"F"
)
then
raise
The_end
else
w#nextGen()
done
with
The_end
->
()
;;
val main : unit -> unit = <fun>