Darn, my stack-lang implementation sucks:
(import
(only (rnrs) define let write newline)
(prefix (only (rnrs) <= - + if) scheme:)
(only (xitomatl common) time)
(xitomatl stack-lang))
(define <=
(λS (x y) (r) (scheme:<= x y)))
(define -
(λS (x y) (r) (scheme:- x y)))
(define +
(λS (x y) (r) (scheme:+ x y)))
(define fib
(Q dup 1 <= (Q drop 1) (Q dup 1 - fib swap 2 - fib +) if))
(define (scheme-fib n)
(scheme:if (scheme:<= n 1)
1
(scheme:+ (scheme-fib (scheme:- n 1))
(scheme-fib (scheme:- n 2)))))
(time (S 34 fib))
(newline)
(S current-stack print)
(newline)
(let ((v (time (scheme-fib 34))))
(newline)
(write v) (newline))
$ ikarus -O2 --r6rs-script fib.sps
running stats for (S 34 fib):
335 collections
6732 ms elapsed cpu time, including 168 ms collecting
7213 ms elapsed real time, including 187 ms collecting
1402578680 bytes allocated
(9227465)
running stats for (scheme-fib 34):
no collections
317 ms elapsed cpu time, including 0 ms collecting
331 ms elapsed real time, including 0 ms collecting
0 bytes allocated
9227465
$
$ factor -run=listener
( scratchpad ) : fib ( m -- n )
dup 1 <= [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] if ;
( scratchpad ) [ 34 fib ] time
== Running time ==
0.587815 seconds
== Garbage collection == == Megamorphic caches ==
Times are in microseconds. Hits 0
Misses 0
Nursery Aging Tenured
GC count: 0 0 0 == Polymorphic inline caches ==
Total GC time: 0 0 0
Longest GC pause: 0 0 0 Transitions:
Average GC pause: 0 0 0 Cold to monomorphic 0
Objects copied: 0 0 0 Mono to polymorphic 0
Bytes copied: 0 0 0 Poly to megamorphic 0
Total GC time: 0 Type check stubs:
Cards scanned: 0 Tag only 0
Decks scanned: 0 Hi-tag 0
Card scan time: 0 Tuple 0
Code heap literal scans: 0 Hi-tag and tuple 0
--- Data stack:
9227465
( scratchpad )
As you can see, the same algorithm took mine 7.2 seconds and took Factor
only 0.6 second.
I'm not sure why mine is so slow. I suspect it's because my data stack
is an SRFI-39 parameter and it is used heavily. I'm going to change my
implementation to pass and return the data stack through "word"
procedure calls, to see if that helps.
--
: Derick
----------------------------------------------------------------
