fork download
  1. ; remove multiples
  2.  
  3. (define-syntax fold-of
  4. (syntax-rules (range in is)
  5. ((_ "z" f b e) (set! b (f b e)))
  6. ((_ "z" f b e (v range fst pst stp) c ...)
  7. (let* ((x fst) (p pst) (s stp)
  8. (le? (if (positive? s) <= >=)))
  9. (do ((v x (+ v s))) ((le? p v) b)
  10. (fold-of "z" f b e c ...))))
  11. ((_ "z" f b e (v range fst pst) c ...)
  12. (let* ((x fst) (p pst) (s (if (< x p) 1 -1)))
  13. (fold-of "z" f b e (v range x p s) c ...)))
  14. ((_ "z" f b e (v range pst) c ...)
  15. (fold-of "z" f b e (v range 0 pst) c ...))
  16. ((_ "z" f b e (x in xs) c ...)
  17. (do ((t xs (cdr t))) ((null? t) b)
  18. (let ((x (car t)))
  19. (fold-of "z" f b e c ...))))
  20. ((_ "z" f b e (x is y) c ...)
  21. (let ((x y)) (fold-of "z" f b e c ...)))
  22. ((_ "z" f b e p? c ...)
  23. (if p? (fold-of "z" f b e c ...)))
  24. ((_ f i e c ...)
  25. (let ((b i)) (fold-of "z" f b e c ...)))))
  26.  
  27. (define-syntax list-of (syntax-rules ()
  28. ((_ arg ...) (reverse (fold-of
  29. (lambda (d a) (cons a d)) '() arg ...)))))
  30.  
  31. (define (all? pred? xs)
  32. (cond ((null? xs) #t)
  33. ((pred? (car xs))
  34. (all? pred? (cdr xs)))
  35. (else #f)))
  36.  
  37. (define (del-mult n ss)
  38. (list-of x
  39. (x range 1 (+ n 1))
  40. (all? positive? (map (lambda (s) (modulo x s)) ss))))
  41.  
  42. (display (del-mult 10 '(2 4 5))) (newline)
Success #stdin #stdout 0.01s 8384KB
stdin
Standard input is empty
stdout
(1 3 7 9)