 
 
 
 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,getCellandsetCell.
 Leave the methodnextGenabstract.
 # 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 methodnextGenaccording 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>
 
 
 
 
