Scheme - скорость выполнения кода

BiwaScheme Interpreter version 0.6.4
Copyright (C) 2007-2014 Yutaka HARA and the BiwaScheme team

Welcome to Racket v6.6.
> (time (define (divs n)
    (define (go i a)
        (cond ((> (* i i) n) a)
              ((= (* i i) n) (+ 1 a))
              ((= 0 (modulo n i)) (go (+ 1 i) (+ 2 a)))
              (else (go (+ 1 i) a))))
    (go 1 0))

(define (task n k)
    (cond ((>= 500 (divs k)) (task (+ 1 n) (+ k n 1))) (else k)))

(display (task 1 1)))

76576500cpu time: 1108 real time: 1109 gc time: 0

$ cat /proc/cpuinfo | grep -m 1 "model name"     
model name	: Intel(R) Xeon(R) CPU E5-1620 v3 @ 3.50GHz

$ time racket -f ./scheme-speed.scm
76576500
racket -f ./scheme-speed.scm  1.06s user 0.05s system 99% cpu 1.111 total

$ time scheme --script ./scheme-speed.scm 
76576500
scheme --script ./scheme-speed.scm  1.24s user 0.01s system 99% cpu 1.248 total

$ time guile ./scheme-speed.scm
76576500
guile ./scheme-speed.scm  4.63s user 0.01s system 99% cpu 4.638 total

$ csc scheme-speed.scm 
$ time ./scheme-speed
76576500
./scheme-speed  4.74s user 0.01s system 99% cpu 4.748 total

$ time chibi-scheme ./scheme-speed.scm
76576500
chibi-scheme ./scheme-speed.scm  9.47s user 0.00s system 99% cpu 9.472 total

 ~/tmp > cat test.rkt 
#lang racket

(define (divs n)
    (define (go i a)
        (cond ((> (* i i) n) a)
              ((= (* i i) n) (+ 1 a))
              ((= 0 (modulo n i)) (go (+ 1 i) (+ 2 a)))
              (else (go (+ 1 i) a))))
    (go 1 0))
 
(define (task n k)
    (cond ((>= 500 (divs k)) (task (+ 1 n) (+ k n 1))) (else k)))
 
(display (task 1 1))
 ~/tmp > raco exe test.rkt 
 ~/tmp > time ./test 
76576500./test  1,25s user 0,03s system 99% cpu 1,287 total

$ time larceny -- ./scheme-speed.scm
Larceny v0.98 "General Ripper" (Mar  7 2015 01:06:26, precise:Linux:unified)
76576500
larceny -- ./scheme-speed.scm  3.60s user 0.01s system 99% cpu 3.612 total

#lang racket

(define (noelem x l) (cond ((null? l) #t) ((equal? x (car l)) #f) (else (noelem x (cdr l)))))
(define (take n l) (cond ((null? l) nil) ((> n 0) (cons (car l) (take (- n 1) (cdr l)))) (else nil)))
(define (drop n l) (cond ((null? l) nil) ((> n 0) (drop (- n 1) (cdr l))) (else l)))
(define nil '())

(begin (display "ЗАДАЧА - решение судоку, реализация поиска в глубину:") (display "\n"))
(define field (quote (0 0 9 3 0 1 8 0 0 0 0 0 0 0 0 0 3 0 2 0 0 0 7 0 0 0 9 1 0 0 2 0 9 0 0 4 0 0 4 0 8 0 2 0 0 8 0 0 7 0 6 0 0 1 9 0 0 0 1 0 0 0 5 0 2 0 0 0 0 0 7 0 0 0 5 6 0 2 4 0 0)))
(define (showField f) (define (go f) (cond ((null? f) "") (else (string-append (foldl (lambda (x a) (string-append a (number->string x) " ")) "" (take 9 f)) "\n" (go (drop 9 f)))))) (cond ((null? f) "Нет решений") (else (go f))))
(begin (display "Стартовое поле:") (display "\n")) (display (showField field))

(define (steps field)
  (define (step-vars i) (begin (define r (/ i 9)) (define c (modulo i 9)) (define rs0 (* 3 (/ r 3))) (define cs0 (* 3 (/ c 3)))) (define (squ-row n) (take 3 (drop (+ cs0 (* 9 (+ rs0 n))) field))) (define (sieve-nth l a) (cond ((null? l) a) (else (sieve-nth (drop 9 l) (cons (car l) a))))) (foldl (lambda (l a) (filter (lambda (x) (noelem x l)) a)) (quote (1 2 3 4 5 6 7 8 9)) (list (squ-row 0) (squ-row 1) (sieve-nth (drop c field) (squ-row 2)) (take 9 (drop (* 9 r) field)) nil)))

  (define (rep-by-ind i e l) (cond ((null? l) nil) ((= 0 i) (cons e (cdr l))) (else (cons (car l) (rep-by-ind (- i 1) e (cdr l))))))

  (define (go i min-i min-step-counts min-step-vars f)
    (cond ((null? f) (cond ((= min-step-counts 100) (cons field nil))
                           ((= min-step-counts 0) nil)
                           (else (map (lambda (v) (rep-by-ind min-i v field)) min-step-vars))))
          ((= 0 (car f)) (begin (define i-step-vars (step-vars i))
                                 (define i-step-counts (length i-step-vars))
                          (cond ((< i-step-counts min-step-counts)
                                 (go (+ i 1) i i-step-counts i-step-vars (cdr f)))
                                (else (go (+ i 1) min-i min-step-counts min-step-vars (cdr f))))))
          (else (go (+ i 1) min-i min-step-counts min-step-vars (cdr f)))))

  (go 0 0 100 0 field))

(define (solve-depth field)
  (define (go f) (define vars (steps f)) (cond ((noelem 0 f) f) ((null? vars) nil) (else (foldl (lambda (x a) (cond ((null? a) (go x)) (else a))) nil vars))))
  (go field))

(begin (display "Решение поиском в глубину:") (display "\n"))
(begin (display (showField (solve-depth field))) (display "\n"))

(define (solve-wide field)
  (display "Количество анализируемых вариантов: ")
  (define (go vars)
    (display (string-append (number->string (length vars)) " "))
    (cond ((null? vars) nil)
          ((noelem 0 (car vars)) vars)
          (else (go (concat (map steps vars))))))
  (go (cons field nil)))

(begin (display "Поиск в ширину ....") (display "\n"))
(define solunions (solve-wide field))
(begin (display "\n") (display "Решения поиском в ширину:") (display "\n"))
(display (cond ((null? solunions) (string-append "Нет решений" "\n"))
               (else (foldl (lambda (x a) (string-append a (showField x) "\n")) "" solunions))))