; http://cap-lore.com/MathPhys/Algebras/Clifford/CliffProg4.html
(list
(lambda (f)
(apply (lambda (sg / tr bar alpha zer zer? one + - * rls basis) (list
  (lambda () (cons (sg) (sg))) ; sg
  (lambda (x) (let* ((a (car x))(b (cdr x))(ai (/ a)))
    (if ai (let* ((aib (* ai b))(c (/ (+ a (* b (alpha aib)))))
        (d (- (* aib (alpha c))))) (cons c d))
    (let ((bi (/ b)))
       (if bi (let* ((bia (* bi a))(d (- (/ (+ (* (alpha a) bia) (alpha b)))))
         (c (alpha (- (* bia d))))) (cons c d))
    #f)))))
  (lambda (x) (cons (tr (car x)) (bar (cdr x)))) ; tr
  (lambda (x) (cons (bar (car x)) (- (tr (cdr x))))) ; bar
  (lambda (x) (cons (alpha (car x)) (- (alpha (cdr x))))) ; alpha
  (cons zer zer) ; zer
  (lambda (a) (and (zer? (car a)) (zer? (cdr a)))) ; zer?
  (cons one zer) ; one
  (lambda (a b) (cons (+ (car a)(car b))(+ (cdr a)(cdr b)))) ; +
  (lambda (a) (cons (-(car a))(-(cdr a)))) ; - (negation)
  (lambda (a b) (cons (+ (* (car a)(car b))(-(* (cdr a)(alpha (cdr b))))) ; *
                     (+ (* (car a)(cdr b))(* (cdr a)(alpha (car b))))))
  (lambda (x)(cons (rls x) zer)) ; rls
  (cons (cons zer one) (map (lambda (x) (cons x zer)) basis)) ; basis
  )) f))

(let ((i (lambda (x) x))) (list (lambda (x)(and (not (zero? x)) (/ x))) i i i 
   0 zero? 1 + - * i '())))