fork download
copy 
  1. ; damsel and suitor
  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. (display
  32.   (list-of (list x y)
  33.     (x range 1 100)
  34.     (y range 1 100)
  35.     (= (+ (* x x x) (* x y y)) (* 4640 y))
  36.     (= (- (* x x y) (* y y y)) (* 5376 (/ 10) x))))
Success #stdin #stdout 0.1s 43728KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
((40 16))
https://ideone.com/jaqKZ8
language:
Scheme (guile 2.2.4)
created:
7 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!