Re: [Caml-list] Re: "Ref" and copy of functions

["Pierre-Evariste Dagand" <pedagand@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 5925 bytes --]

Hi,

> At least on this
> particular example, you can use the following encoding (I
> deliberately use rectypes here, but you can always use extra
> variant instead)
>
> (...)
>
> Since it doesn't use mutable variable, it's free to make copy.

Yes, that's a CPS-way of doing things. I am aware of it and my first
implementation was in this style.

The reasons why I decided to switch to Ref were that :
  1/ The implementation is much more "intuitive" (I don't have a CPS
pre-processor in my brain)
  2/ I thought I could get rid of my hack (Marshal/UnMarshal) easily
  3/ I used to think that I will be faster

Point 1 is not a problem, Santa Claus might bring me this CPS
pre-processor in a few days.

Point 2 seems to be wrong : being fast is nice but if it's for hitting
the wall, well... one should slow down. And for the moment, I haven't
found a clean solution and I'm not sure whether my hack is safe or
not.

So, remains point 3. That's why I have carried out an experience on my
initial Ref implementation, your Rectypes implementation and a CPS
implementation without rectypes (because rectypes frighten me).

%%%%%%%%%%%%%%%%%%%

----------------------------
Ref implementation :
----------------------------

type ('a,'b) arrow = Arrow of ( 'a -> 'b )
let arr f = Arrow (  f )
let (>>>) (Arrow f) (Arrow g) =Arrow ( fun  c -> g  ( f  c ) )
let loop init (Arrow f) =
  let state = ref init in
    Arrow ( fun c ->
                   let new_state , output = f ( !state , c ) in
                     state := new_state;
                     output
              )
let run (Arrow f) input =
  f  input

-----------------------------------
Rectypes implementation :
------------------------------------

let rec arr f x = f x, arr f

let rec (>>>) f g x =
  let rf,nf = f x in let rg,ng = g rf in
 rg, nf >>> ng

let rec run f x ?(i=0) max_inc =
  if i = max_inc then
    x
  else
    let _,n = f x in
      run n x ~i:(i+1) max_inc

--------------------------------------
Variant CPS implementation :
--------------------------------------

type ('a,'b) arrow = Arrow of ( 'a -> 'b * ('a,'b) arrow )

let rec arr f = Arrow ( fun x -> f x , arr f );;

let rec (>>>) (Arrow f) (Arrow g) =
  Arrow (
    fun x ->
      let rf,nf = f x in
      let rg,ng = g rf in
        rg , nf >>> ng
  )

let loop init f  =
  let rec loop_aux c (Arrow f) =
    Arrow (
      fun x->
        let ((c', r), n) = f (c,x) in
          r , loop_aux c' n
    )
  in
    loop_aux init f

let rec run (Arrow f) x ?(i=0) max_inc =
  if i = max_inc then
    x
  else
    let _,n = f x in
      run n x ~i:(i+1) max_inc


%%%%%%%%%%%%%%%%%%%%%

Then I wrote a small test :

%%%%%%%%%%%%%%%%%%%%%

let pair_to_simple (x,y) = x
let arr_pair_to_simple () = arr pair_to_simple
let simple_to_pair x = (x,x)
let arr_simple_to_pair () = arr simple_to_pair
let arr_incr = arr ( fun ( c , x ) -> c + 1 , c + x )
let arr_counter1 = loop 1 arr_incr
let arr_incr1 = (arr_pair_to_simple ()) >>> arr_counter1 >>>
(arr_simple_to_pair ())
let arr_counter2 = loop 2 arr_incr1
let arr_incr2 = (arr_pair_to_simple ()) >>> arr_counter2 >>>
(arr_simple_to_pair ())
let arr_counter3 = loop 3 arr_incr2
let arr_incr3 = (arr_pair_to_simple ()) >>> arr_counter3 >>>
(arr_simple_to_pair ())
let arr_counter4 = loop 4 arr_incr3
let arr_incr4 = (arr_pair_to_simple ()) >>> arr_counter4 >>>
(arr_simple_to_pair ())
let arr_counter5 = loop 5 arr_incr4
let arr_incr5 = (arr_pair_to_simple ()) >>> arr_counter5 >>>
(arr_simple_to_pair ())
let arr_counter6 = loop 6 arr_incr5
let arr_incr6 = (arr_pair_to_simple ()) >>> arr_counter6 >>>
(arr_simple_to_pair ())
let arr_counter7 = loop 7 arr_incr6
let arr_incr7 = (arr_pair_to_simple ()) >>> arr_counter7 >>>
(arr_simple_to_pair ())
let arr_counter8 = loop 8 arr_incr7
let arr_incr8 = (arr_pair_to_simple ()) >>> arr_counter8 >>>
(arr_simple_to_pair ())
let arr_counter9 = loop 9 arr_incr8
let arr_incr9 = (arr_pair_to_simple ()) >>> arr_counter9 >>>
(arr_simple_to_pair ())
let arr_counter10 = loop 10 arr_incr9
let arr_incr10 = (arr_pair_to_simple ()) >>> arr_counter10 >>>
(arr_simple_to_pair ())
let arr_counter11 = loop 11 arr_incr10
let arr_incr11 = (arr_pair_to_simple ()) >>> arr_counter11 >>>
(arr_simple_to_pair ())
let arr_counter12 = loop 12 arr_incr11
let arr_incr12 = (arr_pair_to_simple ()) >>> arr_counter12 >>>
(arr_simple_to_pair ())
let arr_my_arrow () = ( arr_simple_to_pair () ) >>> arr_incr12

%%%%%%%%%%%%%%%%%%%%%%%%

Finally, I measured the processing time with :

%%%%%%%%%%%%%%%%%%%%%%%%

-------------
For Ref
-------------

let _ =
  let ntest =  100000 in
  let start_time = Unix.gettimeofday () in
  let arr_my_arrow = arr_my_arrow () in
    for i=0 to ntest-1 do
      let _ = run arr_my_arrow 2 in
        ()
    done;
    let end_time = Unix.gettimeofday () in
    let time = ( end_time -. start_time ) /. (float_of_int ntest) *.
1000000.0 in
      Printf.printf "Mean processing time : %f microseconds\n" time;

--------------------
For CPS (both)
--------------------

let _ =
  let ntest = 100000 in
  let arr_my_arrow = arr_my_arrow () in
  let start_time = Unix.gettimeofday () in
  let _ = run arr_my_arrow 2 ntest in
    ();
    let end_time = Unix.gettimeofday () in
    let time = ( end_time -. start_time ) /. (float_of_int ntest) *.
1000000.0 in
      Printf.printf "Mean processing time : %f microseconds\n" time;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%

And the results are ...
  1/ Ref : 0.75 microseconds
  2/ Variant CPS : 2.69 microseconds
  3/ Rectypes : 2.80 microseconds
[ compiled with ocamlopt.opt, with -rectypes for 3/ ]

It's about 4 times longer and, against a C++ code, I fear that I can't
afford it.

> It looks like "arrow" is for some kind of flow-like
> programming, then you may also take a look at SDFlow [1].

Yes, it does. For more info : http://www.haskell.org/arrows/

I will take a look at SDFlow, thanks for the hint.

> HTH.

Thanks,

-- 
Pierre-Evariste DAGAND

[-- Attachment #2: measure_ref.ml --]
[-- Type: application/octet-stream, Size: 2495 bytes --]

type ('a,'b) arrow = Arrow of ( 'a -> 'b )

let arr f = Arrow (  f )

let (>>>) (Arrow f) (Arrow g) =
  Arrow ( 
    fun  c ->
      g  ( f  c )
  )

let loop init (Arrow f) = 
  let state = ref init in
    Arrow (
      fun c ->
	let new_state , output = f ( !state , c ) in
	  state := new_state;
	  output
    )

let run (Arrow f) input =
  f  input



let pair_to_simple (x,y) = x
let arr_pair_to_simple () = arr pair_to_simple

let simple_to_pair x = (x,x)
let arr_simple_to_pair () = arr simple_to_pair

let arr_incr = arr ( fun ( c , x ) -> c + 1 , c + x )

let arr_counter1 = loop 1 arr_incr
let arr_incr1 = (arr_pair_to_simple ()) >>> arr_counter1 >>> (arr_simple_to_pair ())

let arr_counter2 = loop 2 arr_incr1
let arr_incr2 = (arr_pair_to_simple ()) >>> arr_counter2 >>> (arr_simple_to_pair ())

let arr_counter3 = loop 3 arr_incr2
let arr_incr3 = (arr_pair_to_simple ()) >>> arr_counter3 >>> (arr_simple_to_pair ())

let arr_counter4 = loop 4 arr_incr3
let arr_incr4 = (arr_pair_to_simple ()) >>> arr_counter4 >>> (arr_simple_to_pair ())

let arr_counter5 = loop 5 arr_incr4
let arr_incr5 = (arr_pair_to_simple ()) >>> arr_counter5 >>> (arr_simple_to_pair ())

let arr_counter6 = loop 6 arr_incr5
let arr_incr6 = (arr_pair_to_simple ()) >>> arr_counter6 >>> (arr_simple_to_pair ())

let arr_counter7 = loop 7 arr_incr6
let arr_incr7 = (arr_pair_to_simple ()) >>> arr_counter7 >>> (arr_simple_to_pair ())

let arr_counter8 = loop 8 arr_incr7
let arr_incr8 = (arr_pair_to_simple ()) >>> arr_counter8 >>> (arr_simple_to_pair ())

let arr_counter9 = loop 9 arr_incr8
let arr_incr9 = (arr_pair_to_simple ()) >>> arr_counter9 >>> (arr_simple_to_pair ())

let arr_counter10 = loop 10 arr_incr9
let arr_incr10 = (arr_pair_to_simple ()) >>> arr_counter10 >>> (arr_simple_to_pair ())

let arr_counter11 = loop 11 arr_incr10
let arr_incr11 = (arr_pair_to_simple ()) >>> arr_counter11 >>> (arr_simple_to_pair ())

let arr_counter12 = loop 12 arr_incr11
let arr_incr12 = (arr_pair_to_simple ()) >>> arr_counter12 >>> (arr_simple_to_pair ())

let arr_my_arrow () = ( arr_simple_to_pair () ) >>> arr_incr12;;


let _ =
  let ntest =  100000 in
  let start_time = Unix.gettimeofday () in
  let arr_my_arrow = arr_my_arrow () in
    for i=0 to ntest-1 do
      let _ = run arr_my_arrow 2 in
	()
    done;
    let end_time = Unix.gettimeofday () in
    let time = ( end_time -. start_time ) /. (float_of_int ntest) *. 1000000.0 in
      Printf.printf "Mean processing time : %f microseconds\n" time;

[-- Attachment #3: measure_rectypes.ml --]
[-- Type: application/octet-stream, Size: 2434 bytes --]

let rec arr f x = f x, arr f;;

let rec (>>>) f g x =
  let rf,nf = f x in let rg,ng = g rf in
 rg, nf >>> ng;;

let rec loop init f x =
  let ((init', r), n) = f (init,x) in
 r, loop init' n;;

let rec run f x ?(i=0) max_inc = 
  if i = max_inc then
    x
  else
    let _,n = f x in
      run n x ~i:(i+1) max_inc
	

let pair_to_simple (x,y) = x
let arr_pair_to_simple () = arr pair_to_simple

let simple_to_pair x = (x,x)
let arr_simple_to_pair () = arr simple_to_pair

let arr_incr = arr ( fun ( c , x ) -> c + 1 , c + x )

let arr_counter1 = loop 1 arr_incr
let arr_incr1 = (arr_pair_to_simple ()) >>> arr_counter1 >>> (arr_simple_to_pair ())

let arr_counter2 = loop 2 arr_incr1
let arr_incr2 = (arr_pair_to_simple ()) >>> arr_counter2 >>> (arr_simple_to_pair ())

let arr_counter3 = loop 3 arr_incr2
let arr_incr3 = (arr_pair_to_simple ()) >>> arr_counter3 >>> (arr_simple_to_pair ())

let arr_counter4 = loop 4 arr_incr3
let arr_incr4 = (arr_pair_to_simple ()) >>> arr_counter4 >>> (arr_simple_to_pair ())

let arr_counter5 = loop 5 arr_incr4
let arr_incr5 = (arr_pair_to_simple ()) >>> arr_counter5 >>> (arr_simple_to_pair ())

let arr_counter6 = loop 6 arr_incr5
let arr_incr6 = (arr_pair_to_simple ()) >>> arr_counter6 >>> (arr_simple_to_pair ())

let arr_counter7 = loop 7 arr_incr6
let arr_incr7 = (arr_pair_to_simple ()) >>> arr_counter7 >>> (arr_simple_to_pair ())

let arr_counter8 = loop 8 arr_incr7
let arr_incr8 = (arr_pair_to_simple ()) >>> arr_counter8 >>> (arr_simple_to_pair ())

let arr_counter9 = loop 9 arr_incr8
let arr_incr9 = (arr_pair_to_simple ()) >>> arr_counter9 >>> (arr_simple_to_pair ())

let arr_counter10 = loop 10 arr_incr9
let arr_incr10 = (arr_pair_to_simple ()) >>> arr_counter10 >>> (arr_simple_to_pair ())

let arr_counter11 = loop 11 arr_incr10
let arr_incr11 = (arr_pair_to_simple ()) >>> arr_counter11 >>> (arr_simple_to_pair ())

let arr_counter12 = loop 12 arr_incr11
let arr_incr12 = (arr_pair_to_simple ()) >>> arr_counter12 >>> (arr_simple_to_pair ())

let arr_my_arrow () = ( arr_simple_to_pair () ) >>> arr_incr12;;

let _ =
  let ntest =  100000 in
  let arr_my_arrow = arr_my_arrow () in
  let start_time = Unix.gettimeofday () in
  let _ = run arr_my_arrow 2 ntest in
    ();
    let end_time = Unix.gettimeofday () in
    let time = ( end_time -. start_time ) /. (float_of_int ntest) *. 1000000.0 in
      Printf.printf "Mean processing time : %f microseconds\n" time;
      

[-- Attachment #4: measure_pure_cps.ml --]
[-- Type: application/octet-stream, Size: 2651 bytes --]

type ('a,'b) arrow = Arrow of ( 'a -> 'b * ('a,'b) arrow )

let rec arr f = Arrow ( fun x -> f x , arr f );;

let rec (>>>) (Arrow f) (Arrow g) =
  Arrow (
    fun x ->
      let rf,nf = f x in 
      let rg,ng = g rf in
	rg , nf >>> ng 
  )
;;

let loop init f  =
  let rec loop_aux c (Arrow f) =
    Arrow (
      fun x->
	let ((c', r), n) = f (c,x) in
	  r , loop_aux c' n
    )
  in
    loop_aux init f
;;

let rec run (Arrow f) x ?(i=0) max_inc = 
  if i = max_inc then
    x
  else
    let _,n = f x in
      run n x ~i:(i+1) max_inc


let pair_to_simple (x,y) = x
let arr_pair_to_simple () = arr pair_to_simple

let simple_to_pair x = (x,x)
let arr_simple_to_pair () = arr simple_to_pair


let arr_incr = arr ( fun ( c , x ) -> c + 1 , c + x )

let arr_counter1 = loop 1 arr_incr
let arr_incr1 = (arr_pair_to_simple ()) >>> arr_counter1 >>> (arr_simple_to_pair ())

let arr_counter2 = loop 2 arr_incr1
let arr_incr2 = (arr_pair_to_simple ()) >>> arr_counter2 >>> (arr_simple_to_pair ())

let arr_counter3 = loop 3 arr_incr2
let arr_incr3 = (arr_pair_to_simple ()) >>> arr_counter3 >>> (arr_simple_to_pair ())

let arr_counter4 = loop 4 arr_incr3
let arr_incr4 = (arr_pair_to_simple ()) >>> arr_counter4 >>> (arr_simple_to_pair ())

let arr_counter5 = loop 5 arr_incr4
let arr_incr5 = (arr_pair_to_simple ()) >>> arr_counter5 >>> (arr_simple_to_pair ())

let arr_counter6 = loop 6 arr_incr5
let arr_incr6 = (arr_pair_to_simple ()) >>> arr_counter6 >>> (arr_simple_to_pair ())

let arr_counter7 = loop 7 arr_incr6
let arr_incr7 = (arr_pair_to_simple ()) >>> arr_counter7 >>> (arr_simple_to_pair ())

let arr_counter8 = loop 8 arr_incr7
let arr_incr8 = (arr_pair_to_simple ()) >>> arr_counter8 >>> (arr_simple_to_pair ())

let arr_counter9 = loop 9 arr_incr8
let arr_incr9 = (arr_pair_to_simple ()) >>> arr_counter9 >>> (arr_simple_to_pair ())

let arr_counter10 = loop 10 arr_incr9
let arr_incr10 = (arr_pair_to_simple ()) >>> arr_counter10 >>> (arr_simple_to_pair ())

let arr_counter11 = loop 11 arr_incr10
let arr_incr11 = (arr_pair_to_simple ()) >>> arr_counter11 >>> (arr_simple_to_pair ())

let arr_counter12 = loop 12 arr_incr11
let arr_incr12 = (arr_pair_to_simple ()) >>> arr_counter12 >>> (arr_simple_to_pair ())

let arr_my_arrow () = ( arr_simple_to_pair () ) >>> arr_incr12;;


let _ =
  let ntest = 100000 in
  let arr_my_arrow = arr_my_arrow () in
  let start_time = Unix.gettimeofday () in
  let _ = run arr_my_arrow 2 ntest in
    ();
    let end_time = Unix.gettimeofday () in
    let time = ( end_time -. start_time ) /. (float_of_int ntest) *. 1000000.0 in
      Printf.printf "Mean processing time : %f microseconds\n" time;