[Projects] [genericity-support-comparison] 41: Add OO and module-based OCaml versions

https://svn.lrde.epita.fr/svn/genericity-support-comparison/trunk 2.0/src/oo/ocaml/oo_ocaml.ml | 126 +++++++++++++++++++++++++++++++++++ 2.0/src/st/ocaml/st_ocaml.ml | 151 +++++++++++++++++++++++++++++++++++++++++++ ChangeLog | 8 ++ 3 files changed, 285 insertions(+) Index: ChangeLog from Roland Levillain &lt;roland(a)lrde.epita.fr&gt; Add object-oriented and static (module-based) Objective Caml versions. * 2.0/src/oo/ocaml/oo_ocaml.ml, 2.0/src/st/ocaml/st_ocaml.ml: New files. Index: 2.0/src/st/ocaml/st_ocaml.ml --- 2.0/src/st/ocaml/st_ocaml.ml (révision 0) +++ 2.0/src/st/ocaml/st_ocaml.ml (révision 0) @@ -0,0 +1,151 @@ +(* Compile with : + + ocamlc -o oo_ocaml unix.cma st_ocaml.ml + + or : + + ocamlopt -o oo_ocaml.opt unix.cmxa st_ocaml.ml + +*) + + +(* value *) + +module type VALUE = +sig + type t + val zero : t +end;; + +module Integer = +struct + type t = int + let zero = 0 +end;; + + +(* point *) + +module type POINT = +sig + type t + type contents + val create : contents -> t + val create_default : unit -> t +end;; + +module Point1d = +struct + type contents = int + type t = { index : contents } + let create i = { index = i } + let create_default () = { index = -1 } +end;; + + +(* piter *) + +module type PITER = +sig + type t + module Point : POINT + val create : int -> t + val start : t -> t + val next : t -> t + val is_valid : t -> bool + val point : t -> Point.t +end;; + +module Piter1d = +struct + module Point = Point1d + type t = { p : Point1d.t ; n : int } + let create n = { p = Point1d.create_default (); n = n } + let start i = { i with p = Point1d.create 0 } + let next i = { i with p = Point1d.create (i.p.Point1d.index + 1) } + let is_valid i = i.p.Point1d.index < i.n + let point i = i.p +end;; + + +(* image *) + +module type IMAGE = +sig + module Value : VALUE + module Point : POINT + module Piter : PITER with module Point = Point + type t + type size + val create : size -> Value.t -> t + val get : t -> Point.t -> Value.t + val set : t -> Point.t -> Value.t -> unit + val new_piter : t -> Piter.t +end;; + +module Image1d (Value : VALUE) = +struct + module Value = Value + module Point = Point1d + module Piter = Piter1d + type t = { data : Value.t array ; n : int } + type size = int + let create size value = { data = Array.create size value ; n = size } + let get ima p = ima.data.(p.Point1d.index) + let set ima p v = ima.data.(p.Point1d.index) <- v + let new_piter ima = Piter1d.create ima.n +end +;; + +module Image1dInt = Image1d (Integer);; + + +(* assign *) + +module Assign (Image : IMAGE) = +struct + let go (ima : Image.t) (v : Image.Value.t) = + let rec iter_ p = + if (Image.Piter.is_valid p) then + begin + Image.set ima (Image.Piter.point p) v; + iter_ (Image.Piter.next p) + end + in + iter_ (Image.Piter.start (Image.new_piter ima)) +end;; + +module Assign1d = Assign (Image1dInt);; + + +(* main *) + +let usage () = + prerr_string ("usage: " ^ Sys.argv.(0) ^ " [nsteps = 1]"); + prerr_newline () + +let _ = + if Array.length Sys.argv > 2 then + begin + usage (); + exit 1; + end; + + let size = 1024 * 1024 in + let nsteps = + if Array.length Sys.argv == 2 then + int_of_string Sys.argv.(1) + else + 1 + in + + let ima = Image1dInt.create size 0 in + let value = 51 in + + let t0 = Unix.gettimeofday () in + for step = 0 to nsteps do + Assign1d.go ima value + done; + print_float (Unix.gettimeofday () -. t0); + print_newline () +;; Index: 2.0/src/oo/ocaml/oo_ocaml.ml --- 2.0/src/oo/ocaml/oo_ocaml.ml (révision 0) +++ 2.0/src/oo/ocaml/oo_ocaml.ml (révision 0) @@ -0,0 +1,126 @@ +(* Compile with : + + ocamlc -o oo_ocaml unix.cma oo_ocaml.ml + + or : + + ocamlopt -o oo_ocaml.opt unix.cmxa oo_ocaml.ml + +*) + + +(* value <|-- integer *) + +class virtual value = +object + method virtual assign : value -> value +end;; + +class integer (value : int) = +object (self) + inherit value + val mutable value_ = value + method assign (value : value) = + value_ <- (Obj.magic value); + (self :> value) +end;; + + +(* point <|-- point1d *) + +class virtual point = +object +end;; + +class point1d (i : int) = +object + inherit point + val mutable index_ = i + method index () = index_ + method set_index i = index_ <- i +end;; + + +(* piter <|-- piter1d *) + +class virtual piter = +object + method virtual start : unit -> unit + method virtual next : unit -> unit + method virtual is_valid : unit -> bool + method virtual point : unit -> point +end;; + +class piter1d (n : int) = +object + inherit piter + val mutable n_ = n + val mutable p_ = new point1d 0 + method start () = p_#set_index 0 + method next () = p_#set_index (p_#index () + 1) + method is_valid () = (p_#index ()) < n_ + method point () = (p_ :> point) +end;; + + +(* image <|-- image1d *) + +class virtual image = +object + method virtual get : point -> value + method virtual new_piter : unit -> piter +end;; + +class ['a] image1d (n : int) (v : 'a) = +object + inherit image + val n_ = n + val data_ = Array.make n v + method get (p : point) = data_.((Obj.magic p)#index ()) + method new_piter () = (new piter1d n_ :> piter) +end;; + + +(* assign *) + +let assign (ima : image) (value : value) = + let p = ima#new_piter() in + p#start (); + while p#is_valid () do + ignore ((ima#get (p#point ()))#assign (value)); + p#next () + done +;; + + +(* main *) + +let usage () = + prerr_string ("usage: " ^ Sys.argv.(0) ^ " [nsteps = 1]"); + prerr_newline () + +let _ = + if Array.length Sys.argv > 2 then + begin + usage (); + exit 1; + end; + + let size = 1024 * 1024 in + let nsteps = + if Array.length Sys.argv == 2 then + int_of_string Sys.argv.(1) + else + 1 + in + + let ima = new image1d size (new integer 0) in + let value = new integer 51 in + + let t0 = Unix.gettimeofday () in + for step = 0 to nsteps do + assign ima value + done; + print_float (Unix.gettimeofday () -. t0); + print_newline () +;;