; http://cap-lore.com/MathPhys/Algebras/Clifford/CliffProg3.html
(list
(lambda (f)
(apply (lambda (sg tr bar alpha zer one + - * rls basis) (list
  (lambda () (cons (sg) (sg))) ; sg
  (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, called conj earlier
  (cons zer zer) ; 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 i i i 0 1 + - * i '())))

; test
(ylppa (fileVal "Clifford1") (lambda (G reals)
  (ylppa (G (G (G (G (cons ((fileVal "rr") "fli0") reals)))))
    (lambda (sg tr bar alpha zer one + - * rls basis)
    (let ((a (sg))(b (sg))(c (sg))(= equal?)) (and
      (= (+ a b)(+ b a))
      (= (+ a (+ b c)) (+ (+ a b) c))
      (= (* a (* b c)) (* (* a b) c))
      (equal? zer (* a zer))
      (= (* a one) a)
      (= (* (+ a b) c) (+ (* a c) (* b c)))

      (= (* (tr a)(tr b))(tr (* b a)))
      (= (+ (tr a)(tr b))(tr (+ a b)))
      (= (* (alpha a)(alpha b))(alpha (* a b)))
      (= (+ (alpha a)(alpha b))(alpha (+ a b)))
      (= (* (bar a)(bar b))(bar (* b a)))
      (= (+ (bar a)(bar b))(bar (+ a b)))))))))