Author: Christian.Queinnec@lip6.fr

## Exercises

### Stacks as Objects

Let us reconsider the stacks example, this time in object oriented style.

1. 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

2. 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 = ()

3. 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

4. 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

5. 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:

1. Draw the relations between classes.
2. Draw the different messages.
3. 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.

1. 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

2. 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

3. 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

4. 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

5. Draw the inheritance tree.
6. 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>

7. 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:

- `cell` : for the cells of the world, with the method `isAlive : unit -> bool`
- `world` : with an array of `cell`, and the messages:

      display : unit -> unit
      nextGen : unit -> unit
      setCell : int * int -> cell -> unit
      getCell : int * int -> cell

1. 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

2. 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

3. 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

4. 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>