Infinite lists, Scheme

Language: Layout:

;guile 2.2.3

(define-syntax cons-s
  (syntax-rules ()
    [(_ x y)(cons x (delay y))]))

(define (tail s)
  (force (cdr s)))

(define (take n s)
  (if (= n 0) '()
      (cons (car s)
            (take (- n 1) (tail s)))))

(define (map-s f . s)
  (if (null? (car s)) '()
    (let ([h (map car s)])
       (cons-s (apply f h)
               (apply map-s
                 (cons f
                   (map tail s)))))))

(define (grep-s f s)
  (cond [(null? s) '()]
        [(f (car s))
           (cons-s (car s) (grep-s f (tail s)))]
        [#t (grep-s f (tail s))]))

;;;EXAMPLES

(define ones (cons-s 1 ones))
(define nats (cons-s 1 (map-s + nats ones)))

(define cubes (map-s * nats nats nats))

(define fibs
  (cons-s 1
    (cons-s 1
      (map-s + fibs (tail fibs)))))

(define facs
  (cons-s 1
    (map-s * facs (map-s + ones nats))))

(define primes
  (letrec
    ([sieve (lambda (s)
              (cons-s (car s)
                (sieve
                  (grep-s (lambda (n)
                            (> (remainder n (car s)) 0))
                          (tail s)))))])
    (sieve (map-s + ones nats))))

(display "For n=1,...,15:") (newline)
(display "n^0       ")  (display (take 15 ones))   (newline)
(display "n^1       ")  (display (take 15 nats))   (newline)
(display "n^3       ")  (display (take 15 cubes))  (newline)
(display "fib_n     ")  (display (take 15 fibs))   (newline)
(display "n!        ")  (display (take 15 facs))   (newline)
(display "nth prime ")  (display (take 15 primes)) 
                    
;;; This should take a bit less than a second:
(newline)
(let* ([N 50000]
       [F (list-ref (take N fibs) (- N 1))])
  (display (string-append "fibo_" (number->string N) " = " (number->string F))))

[ + ] Show input
Absolute running time: 0.18 sec, cpu time: 0.05 sec, memory peak: 9 Mb, absolute service time: 0,26 sec