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 = 10 and b = 12 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>