🚀 go-pugleaf

On Jul 31, 11:50 am, "Kjetil S. Matheussen"
<k.s.matheus...@notam02.no> wrote:



> Well, Stalin scheme is not on the list. My results:

>

> * GCC:

> kjetil@ttleush ~/c $ time ./recursive.gcc_run 11

> Ack(3,11): 16381

> Fib(38.0): 63245986.0

> Tak(30,20,10): 11

> Fib(3): 3

> Tak(3.0,2.0,1.0): 2.0

>

> real    0m2.112s

> user    0m2.021s

> sys     0m0.002s

>

> * Stalin 0.11:

> kjetil@ttleush ~/c $ time ./recursive 11

> Ack(3,11): 16381

> Fib(3.7999999523162841796875e1.0): 6.32459926605224609375e7.0

> Tak(30,20,10): 11

> Fib(3): 3

> Tak(3.0,2.0,1.0): 2.0.0

>

> real    0m1.725s

> user    0m1.635s

> sys     0m0.003s

>

> Which means that Stalin scheme is about 22% faster than C

> for this particular benchmark, and stalin scheme is a

> dynamic typed functional language.

>

> Source:http://www.notam02.no/~kjetism/recursive.scm





Hi:



I used your Scheme code under the latest Bigloo on my Mac OSX and
INTEL 2.0 GHz dual core machine:



for n=10:



the c version (downloade from the link given by the original poster):



==

$ gcc -pipe -Wall -O3 -fomit-frame-pointer -march=pentium4   test33.c

$ time ./a.out

Ack(3,11): 16381
Fib(38.0): 63245986.0
Tak(30,20,10): 11
Fib(3): 3
Tak(3.0,2.0,1.0): 2.0


real	0m1.655s
user	0m1.631s
sys	0m0.008s
==


The Bigloo version (code enclosed: all I did was to change + to Bigloo
its +fx, and +fl, etc. and using bit-or):


==

$ bigloo test.scm  -Obench
ld64: warning: option -s is obsolete and being ignored
$ time ./a.out

Ack(3,11): 16381
Fib(38.0): 63245986.0
Tak(30,20,10): 11
Fib(3): 3
Tak(3.0,2.0,1.0): 2.0

real	0m1.620s
user	0m1.601s
sys	0m0.009s
==

Note: in the Bigloo code i haven't used roundto for printing fib
because this is always the fucking and annoying nightmare whe using
scheme implementations and shared code: what works fine for one
implementation does not work for the other. however, this does not
lessen the benchmark results.

==
;;; Code from Kjetil S. Matheussen"
;;; I changed the operators +,-, etc. to Bigloo its native ones: +fl,
+fx,etc.
;;; and the code been using bit-or
(module test)


(define
   (ack::bint x::bint y::bint)
   (if (=fx 0 x)
       (+fx y 1)
       (ack (-fx x 1)
	    (if (=fx 0 (bit-or y 0)) ;;(not (= 0 y))
		1
		(ack x (-fx y 1))))))


(define
   (fib::bint n::bint)
   (cond ((<fx n 2) 1)
	 (else (+fx (fib (-fx n 2)) (fib (-fx n 1))))))

;; TODO: optimize on ikarus, it's allocing around 400MB but the GC is
fast
;; TODO: is the main problem that floats are always boxed in Ikarus?
(define
   (fibflt::double n::double)
   (cond ((<fl n 2.0) 1.0)
	 (else (+fl (fibflt (-fl n 2.0))
		    (fibflt (-fl n 1.0))))))


(define
   (tak::bint x::bint y::bint z::bint)
   (if (<fx y x)
       (tak (tak (-fx x 1) y z)
	    (tak (-fx y 1) z x)
	    (tak (-fx z 1) x y))
       z))

(define
   (takflt::double x::double y::double z::double)
   (if (<fl y x)
       (takflt (takflt (-fl x 1.0) y z)
	       (takflt (-fl y 1.0) z x)
	       (takflt (-fl z 1.0) x y))
       z))

;; -------------------------------

;;; Stupid boiler-plate for formatting floating point values
(define
   (roundto digits n)
   (let* ((e (expt 10 digits))
	  (num (round (abs (* e (inexact->exact n)))))
	  (str (number->string (remainder num e))))
      ;(print "sr" str " " num " " e "dig " digits "n " n)
      (string-append
       (if (negative? n) "-" "")
       (number->string (/ num e))
       "."
       (make-string (- digits (string-length str)) #\0)
       str)))

(define
   (main args)
   (let ((n (inexact->exact (string->number (vector-ref args 1)))))
      (display "Ack(3,")  (display n) (display "): ") (display (ack 3
n)) (newline)
      (display "Fib(") (display (roundto 1 (+ 27.0 n))) (display "):
")
      ;(print n) (exit)
      ;(display "Fib(") (display (+ 27.0 n)) (display "): ")
      ;(display (roundto 1 (fibflt (+ 27.0 n)))) (newline)
      (display  (fibflt (+ 27.0 n))) (newline)
      (set! n (-fx n 1))
      (display "Tak(") (display (*fx n 3))
      (display ",") (display (*fx n 2))
      (display ",") (display n) (display "): ")
      (display (tak (*fx n 3) (*fx n 2) n)) (newline)
      (display "Fib(3): ") (display (fib 3)) (newline)
      (display "Tak(3.0,2.0,1.0): ") (display (roundto 1 (takflt 3.0
2.0 1.0)))
      (newline)))

;; -------------------------------

(main (vector "scheme-compatibiliy-sucks" "11"))
==