fork(1) download
copy 
  1. ; 8/10 palindromes
  2.  
  3. (define (digits n . args)
  4.   (let ((b (if (null? args) 10 (car args))))
  5.     (let loop ((n n) (d '()))
  6.       (if (zero? n) d
  7.           (loop (quotient n b)
  8.                 (cons (modulo n b) d))))))
  9.  
  10. (define (undigits ds . args)
  11.   (let ((b (if (null? args) 10 (car args))))
  12.     (let loop ((ds ds) (n 0))
  13.       (if (null? ds) n
  14.           (loop (cdr ds) (+ (* n b) (car ds)))))))
  15.  
  16. (define (pal? xs) (equal? xs (reverse xs)))
  17.  
  18. (do ((n 0 (+ n 1))) ((< 100000 n))
  19.   (when (and (pal? (digits n)) (pal? (digits n 8)))
  20.     (display n) (newline)))
  21.  
  22. (define-syntax define-generator
  23.   (lambda (x)
  24.     (syntax-case x (lambda)
  25.       ((stx name (lambda formals e0 e1 ...))
  26.          (with-syntax ((yield (datum->syntax (syntax stx) 'yield)))
  27.            (syntax (define name
  28.              (lambda formals
  29.                (let ((resume #f) (return #f))
  30.                  (define yield
  31.                    (lambda args
  32.                      (call-with-current-continuation
  33.                       (lambda (cont)
  34.                         (set! resume cont)
  35.                         (apply return args)))))
  36.                  (lambda ()
  37.                    (call-with-current-continuation
  38.                     (lambda (cont)
  39.                       (set! return cont)
  40.                       (cond (resume (resume))
  41.                       (else (let () e0 e1 ...)
  42.                             (error 'name "unexpected return"))))))))))))
  43.         ((stx (name . formals) e0 e1 ...)
  44.           (syntax (stx name (lambda formals e0 e1 ...)))))))
  45.  
  46. (define-generator (palindromes)
  47.   (do ((k 0 (+ k 1))) ((= k 10))
  48.     (yield k))
  49.   (do ((i 1 (* i 10))) (#f)
  50.     (do ((j i (+ j 1))) ((= j (* 10 i)))
  51.       (let ((ds (digits j)))
  52.         (yield (undigits (append ds (reverse ds))))))
  53.     (do ((j i (+ j 1))) ((= j (* 10 i)))
  54.       (let ((ds (digits j)))
  55.         (do ((k 0 (+ k 1))) ((= k 10))
  56.           (yield (undigits (append ds (list k) (reverse ds)))))))))
  57.  
  58. (let ((p (palindromes)))
  59.   (do ((n (p) (p))) ((< 100000000 n))
  60.     (when (pal? (digits n 8))
  61.       (display n) (newline))))
Success #stdin #stdout 9.9s 10904KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
0
1
2
3
4
5
6
7
9
121
292
333
373
414
585
3663
8778
13131
13331
26462
26662
30103
30303
0
1
2
3
4
5
6
7
9
121
292
333
373
414
585
3663
8778
13131
13331
26462
26662
30103
30303
207702
628826
660066
1496941
1935391
1970791
4198914
55366355
https://ideone.com/a8fCvF
language:
Scheme (guile 2.2.4)
created:
5 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!