7a77367040
Fix the ttt tests (which I don't think have been run in years). Fix the lists shootout benchmark to use mpairs. Fix the regexmatch shootout benchmark, although it still needs input. Require a current version of ssax, so that it compiles. Fix finding the collections path. svn: r16654
45 lines
1.3 KiB
Scheme
45 lines
1.3 KiB
Scheme
(module lists mzscheme
|
|
(require scheme/mpair)
|
|
(define SIZE 10000)
|
|
|
|
(define (sequence start stop)
|
|
(if (> start stop)
|
|
'()
|
|
(mcons start (sequence (+ start 1) stop))))
|
|
|
|
(define (head-to-tail! headlist taillist)
|
|
(when (null? taillist) (begin
|
|
(set! taillist (mlist (mcar headlist)))
|
|
(set! headlist (mcdr headlist))))
|
|
(letrec ((htt-helper (lambda (dest)
|
|
(when (not (null? headlist))
|
|
(let ((headlink headlist))
|
|
(set-mcdr! dest headlink)
|
|
(set! headlist (mcdr headlist))
|
|
(htt-helper headlink))))))
|
|
(htt-helper taillist)
|
|
(values headlist taillist)))
|
|
|
|
(define (test-lists)
|
|
(let* ([L1 (sequence 1 SIZE)]
|
|
[L2 (mappend L1 '())]
|
|
[L3 '()])
|
|
(set!-values (L2 L3) (head-to-tail! L2 L3))
|
|
(set!-values (L3 L2) (head-to-tail! (mreverse! L3) L2))
|
|
(set! L1 (mreverse! L1))
|
|
(cond ((not (= SIZE (mcar L1))) 0)
|
|
((not (equal? L1 L2)) 0)
|
|
(else (mlength L1)))))
|
|
|
|
(define (main args)
|
|
(let ((result #f))
|
|
(let loop ((counter (if (= (vector-length args) 0)
|
|
1
|
|
(string->number (vector-ref args 0)))))
|
|
(when (> counter 0)
|
|
(set! result (test-lists))
|
|
(loop (- counter 1))))
|
|
(printf "~s~n" result)))
|
|
|
|
(main (current-command-line-arguments)))
|