;;; adaptation of language shootout pidigits.py in plain scheme
(cond-expand
 (guile   (use-modules (ice-9 format) (ice-9 time)))
 (else    #t)) ; hope for the best

(define (my-quotient a b) (quotient a b))
(define (my-remainder a b) (remainder a b))
(define (my-modulo a b) (modulo a b))

(define (my-quotient&remainder a b) (quotient&remainder a b))

(define (my-*1 a b) (* a b))
(define (my-*2 a b) (* a b))
(define (my-*3 a b) (* a b))
(define (my-*4 a b) (* a b))
(define (my-*5 a b) (* a b))
(define (my-*6 a b) (* a b))
(define (my-*7 a b) (* a b))
(define (my-*8 a b) (* a b))
(define (my-*9 a b) (* a b))

(define (my-+1 a b) (+ a b))
(define (my-+2 a b) (+ a b))
(define (my-+3 a b) (+ a b))
(define (my-+4 a b) (+ a b))
(define (my-+5 a b) (+ a b))
(define (my-+6 a b) (+ a b))
(define (my-+7 a b) (+ a b))

(define (my--1 a b) (- a b))

(define (my-> a b) (> a b))
(define (my-< a b) (< a b))
(define (my->= a b) (>= a b))
(define (my-= a b) (= a b))

(define spigot
  (lambda (m . opt-output-port)
    (let ((n 1) (a 0) (d 1) (t 0) (u 0) (i 0) (k 0) (ns 0) (k1 1)
          (output-port (if (null? opt-output-port)
                           current-output-port
                           (car opt-output-port))))
      (let loop ()
        (if (my-< i m)
            (begin
              (set! k (my-+1 k 1))
              (set! t (my-*6 n 2))
              (set! n (my-*7 n k))
              (set! a (my-+2 a t))
              (set! k1 (my-+3 k1 2))
              (set! a (my-*4 a k1))
              (set! d (my-*5 d k1))
              (if (my->= a n)
                  (let ((n3a (my-+4 (my-*8 n 3) a)))
;(receive (x y) (my-quotient&remainder n3a d) (set! t x) (set! u y))
                    (set! t (my-quotient n3a d))
                    (set! u (my-+5 (my-remainder n3a d) n))
                    (if (my-> d u)
                        (begin
                          (set! ns (my-+6 (my-*1 ns 10) t))
                          (set! i (my-+7 i 1))
                          (if (my-= (my-modulo i 10) 0)
                              (begin
                                ;(println ns i output-port)
                                (set! ns 0)))
                          (set! a (my-*2 (my--1 a (my-*9 d t)) 10))
                          (set! n (my-*3 n 10))))))
              (loop)))))))

(define println
  (lambda (ns i output-port)
    ;(format (if (eq? output-port current-output-port) #t output-port)
    ;        "~10,,,'0@a     :~d~%" ns i)))
    (display ns output-port)
    (display "    :" output-port)
    (display i output-port)
    (newline output-port)))

(define spigot-to-file
  (lambda (filename n)
    (call-with-output-file filename
      (lambda (port)
        (spigot n port)))))

(define benchmark
  (lambda ()
    (time (spigot-to-file "/dev/null" 10000))))

(benchmark)