fork download
  1. ; doubled pairs
  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 (g xs)
  32. (list-of (list y z)
  33. (y in xs)
  34. (z in xs)
  35. (= (+ y y) z)))
  36.  
  37. (display (g '(1 2 3 4))) (newline)
  38. (display (g '(1 3 5 7 9))) (newline)
  39.  
  40. (define (f xs)
  41. (let ((ht (make-eq-hashtable)) (zs (list)))
  42. (do ((xs xs (cdr xs))) ((null? xs))
  43. (hashtable-set! ht (car xs) (car xs)))
  44. (do ((xs xs (cdr xs))) ((null? xs) zs)
  45. (when (hashtable-contains? ht (* (car xs) 2))
  46. (set! zs (cons (list (car xs) (* (car xs) 2)) zs))))))
  47.  
  48. (display (f '(1 2 3 4))) (newline)
  49. (display (f '(1 3 5 7 9))) (newline)
Runtime error #stdin #stdout #stderr 0.01s 8480KB
stdin
Standard input is empty
stdout
((1 2) (2 4))
()
stderr
Error: unbound variable: make-eq-hashtable

	Call history:

	<syntax>	  [f] (car xs)
	<syntax>	  [f] (##core#undefined)
	<syntax>	  [f] (##core#app doloop359 (cdr xs))
	<syntax>	  [f] (cdr xs)
	<syntax>	  [f] (##core#let () doloop359)
	<syntax>	  [f] (##core#begin doloop359)
	<syntax>	  [f] (##core#undefined)
	<syntax>	  [f] (make-eq-hashtable)
	<syntax>	  [f] (list)
	<syntax>	  (display (f (quote (1 2 3 4))))
	<syntax>	  (f (quote (1 2 3 4)))
	<syntax>	  (quote (1 2 3 4))
	<syntax>	  (##core#quote (1 2 3 4))
	<eval>	  (display (f (quote (1 2 3 4))))
	<eval>	  (f (quote (1 2 3 4)))
	<eval>	  [f] (make-eq-hashtable)	<--