fork download
copy 
  1. ; sum and xor
  2.  
  3. (define (bitwise-xor a b)
  4.   (cond ((zero? a) b)
  5.         ((zero? b) a)
  6.         (else
  7.          (+ (* (logxor (floor (/ a 2)) (floor (/ b 2))) 2)
  8.             (if (even? a)
  9.                 (if (even? b) 0 1)
  10.                 (if (even? b) 1 0))))))
  11.  
  12. (define-syntax fold-of
  13.   (syntax-rules (range in is)
  14.     ((_ "z" f b e) (set! b (f b e)))
  15.     ((_ "z" f b e (v range fst pst stp) c ...)
  16.       (let* ((x fst) (p pst) (s stp)
  17.              (le? (if (positive? s) <= >=)))
  18.         (do ((v x (+ v s))) ((le? p v) b)
  19.           (fold-of "z" f b e c ...))))
  20.     ((_ "z" f b e (v range fst pst) c ...)
  21.       (let* ((x fst) (p pst) (s (if (< x p) 1 -1)))
  22.         (fold-of "z" f b e (v range x p s) c ...)))
  23.     ((_ "z" f b e (v range pst) c ...)
  24.       (fold-of "z" f b e (v range 0 pst) c ...))
  25.     ((_ "z" f b e (x in xs) c ...)
  26.       (do ((t xs (cdr t))) ((null? t) b)
  27.         (let ((x (car t)))
  28.           (fold-of "z" f b e c ...))))
  29.     ((_ "z" f b e (x is y) c ...)
  30.       (let ((x y)) (fold-of "z" f b e c ...)))
  31.     ((_ "z" f b e p? c ...)
  32.       (if p? (fold-of "z" f b e c ...)))
  33.           ((_ f i e c ...)
  34.       (let ((b i)) (fold-of "z" f b e c ...)))))
  35.  
  36. (define-syntax list-of (syntax-rules ()
  37.   ((_ arg ...) (reverse (fold-of
  38.     (lambda (d a) (cons a d)) '() arg ...)))))
  39.  
  40. (define (sum-xor s x)
  41.   (list-of (list (- s b) b)
  42.     (b range 1 s)
  43.     (= x (bitwise-xor (- s b) b))))
  44.  
  45. (display (sum-xor 9 5)) (newline)
Success #stdin #stdout 0.06s 8952KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
((7 2) (6 3) (3 6) (2 7))
https://ideone.com/eDfLxn
language:
Scheme (guile 2.2.4)
created:
8 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!