;;	      Equational Proof Procedures Using Matching     
;; Albert R. Meyer                                           2/24/03


(define (axioms)
  '(
    ((?e = ?e) reflexivity)
    ((((?e + ?f) + ?g) = (?e + (?f + ?g))) associativity+)
    ((((?e * ?f) * ?g) = (?e * (?f * ?g))) associativity*)
    (((?e + ?f) = (?f + ?e)) commutativity+)
    (((?e * ?f) = (?f * ?e)) commutativity*)
    (((0 + ?e) = ?e) identity+)
    (((1 * ?e) = ?e) identity*)
    (((?e + (- ?e)) = 0) inverse+)
    (((?e * (?f + ?g)) = ((?e * ?f) + (?e * ?g))) distributivity)
    ))

(define (one-antecedent-inferences)
  ;of the form (?consequent ?name ~antecedents)
    '(
      ((?f = ?e) symmetry (?e = ?f))
      (((- ?e) = (- ?f)) congruence- (?e = ?f))
      ))

(define (two-antecedent-inferences)
  ;of the form (?consequent ?name ~antecedents)
  ;two versions of each inference so the order of the antecedents doesn't matter
  '(
     (((?e1 + ?f1) = (?e2 + ?f2)) congruence+ (?e1 = ?e2) (?f1 = ?f2))
     (((?e1 + ?f1) = (?e2 + ?f2)) congruence+ (?f1 = ?f2) (?e1 = ?e2))
     (((?e1 * ?f1) = (?e2 * ?f2)) congruence* (?e1 = ?e2) (?f1 = ?f2))
     (((?e1 * ?f1) = (?e2 * ?f2)) congruence* (?f1 = ?f2) (?e1 = ?e2))
     ((?e = ?g) transitivity (?e = ?f) (?f = ?g))
     ((?e = ?g) transitivity (?f = ?g) (?e = ?f))
     ))


(define (try-axiom axiom proof-sequence)
  ;returns tree-proof if proof-sequence ends with an instance of an axiom,
  ;otherwise returns #f
  (let* ((consequent (inference.consequent axiom))
	 (dicts (match `(,consequent ~aeqs) proof-sequence)))
    (and dicts
	 (instantiate
	  `(,consequent ,(inference.name axiom))
	  (car dicts)))))


(define (try-one-antecedent-inference inference proof-sequence)
  ;returns tree-proof if final equation of proof-sequence follows from inference,
  ;otherwise returns #f
  (let* ((consequent (inference.consequent inference))
	 (antecedent (car (inference.antecedents inference)))
	 (dicts (match `(,consequent ~aeqs1 ,antecedent ~aeqs2) proof-sequence)))
    (and dicts
	 (let ((dict (car dicts)))
	   (make-proof-tree
	    (instantiate consequent dict)
	    (inference.name inference)
	    (linear->tree
	     (instantiate `(,antecedent ~aeqs2) dict)))))))


(define (try-two-antecedent-inference inference proof-sequence)
  ;returns tree-proof if final equation of proof-sequence follows from inference,
  ;otherwise returns #f
  (let* ((consequent (inference.consequent inference))
	 (antecedent1 (car (inference.antecedents inference)))
	 (antecedent2 (cadr (inference.antecedents inference)))
	 (dicts (match `(,consequent ~aeqs1 ,antecedent1 ~aeqs2 ,antecedent2 ~aeqs3)
		       proof-sequence)))
    (and dicts
	 (let ((dict (car dicts)))
	   (make-proof-tree
	    (instantiate consequent dict)
	    (inference.name inference)
	    (linear->tree
	     (instantiate `(,antecedent1 ~aeqs2 ,antecedent2 ~aeqs3) dict))
	    (linear->tree
	     (instantiate `(,antecedent2 ~aeqs3) dict)))))))
     

(define (linear->tree proof-sequence)
  (or
   (for-some
    (map (lambda (axiom) (lambda (proof) (try-axiom axiom proof)))
	 (axioms)) proof-sequence)
   (for-some
    (map (lambda (inference) (lambda (proof) (try-one-antecedent-inference inference proof)))
	 (one-antecedent-inferences)) proof-sequence)
   (for-some
    (map (lambda (inference) (lambda (proof) (try-two-antecedent-inference inference proof)))
	 	 (two-antecedent-inferences)) proof-sequence)))


;;                        PROOF DATA TYPES

(define inference.consequent car)
(define inference.name cadr)
(define inference.antecedents cddr)

(define make-proof-tree list)


;;                             UTILITY

(define (for-some tests object)
  ;;Return first non-#f result of applying a test to object;
  ;;return #f if all tests return #f
  (and tests
       (or ((car tests) object)
	   (for-some (cdr tests) object))))

;;                            EXAMPLES

(define (test)
  (reverse
  '(((g + (- g)) = 0)
    (f = f)
    ((f + (g + (- g))) = (f + 0))
    (((f + g) + (- g)) = (f + (g + (- g))))
    (((f + g) + (- g)) = (f + 0))
    ((f + 0) = (0 + f))
    (((f + g) + (- g)) = (0 + f))
    ((0 + f) = f)
    (((f + g) + (- g)) = f))))

(define (test1)
  '(
    ((a + (0 + b)) = (b + a))
    ((a + (0 + b)) = (a + b))
    (a = a)
    ((0 + b) = b)
    ((a + b) = (b + a))
    ))

(define (test2)
  (reverse
   '(((0 + 1) = 1)
     (e = e)
     ((e * (0 + 1)) = (e * 1))
     ((e * 1) = (e * (0 + 1)))
     ((e * (0 + 1)) = ((e * 0) + (e * 1)))
     ((e * 1) = ((e * 0) + (e * 1)))
     ((- (e * 1)) = (- (e * 1)))
     (((e * 1) + (- (e * 1))) = (((e * 0) + (e * 1)) + (- (e * 1))))
     (((e * 1) + (- (e * 1))) = 0)
     ((e * 0) = (e * 0))
     (((e * 0) + ((e * 1) + (- (e * 1)))) = ((e * 0) + 0))
     ((((e * 0) + (e * 1)) + (- (e * 1))) = ((e * 0) + ((e * 1) + (- (e * 1)))))
     ((((e * 0) + (e * 1)) + (- (e * 1))) = ((e * 0) + 0))
     (((e * 0) + 0) = (0 + (e * 0)))
     ((((e * 0) + (e * 1)) + (- (e * 1))) = (0 + (e * 0)))
     ((0 + (e * 0)) = (e * 0))
     ((((e * 0) + (e * 1)) + (- (e * 1))) = (e * 0))
     (((e * 1) + (- (e * 1))) = (e * 0))
     (((e * 1) + (- (e * 1))) = 0)
     (0 = ((e * 1) + (- (e * 1))))
     (0 = ( e * 0))
     )))

#!
(pretty-print (linear->tree (test)))


((((f + g) + (- g)) = f)
 transitivity
 (((0 + f) = f) identity+)
 ((((f + g) + (- g)) = (0 + f))
  transitivity
  (((f + 0) = (0 + f)) commutativity+)
  ((((f + g) + (- g)) = (f + 0))
   transitivity
   ((((f + g) + (- g)) = (f + (g + (- g)))) associativity+)
   (((f + (g + (- g))) = (f + 0)) congruence+
                                  ((f = f) reflexivity)
                                  (((g + (- g)) = 0) inverse+)))))



(pretty-print (linear->tree (test1)))

(((a + (0 + b)) = (b + a))
 transitivity
 (((a + (0 + b)) = (a + b)) congruence+ ((a = a) reflexivity) (((0 + b) = b) identity+))
 (((a + b) = (b + a)) commutativity+))

(pretty-print (linear->tree (test2)))

((0 = (e * 0))
 transitivity
 ((0 = ((e * 1) + (- (e * 1)))) symmetry ((((e * 1) + (- (e * 1))) = 0) inverse+))
 ((((e * 1) + (- (e * 1))) = (e * 0))
  transitivity
  (((((e * 0) + (e * 1)) + (- (e * 1))) = (e * 0))
   transitivity
   (((0 + (e * 0)) = (e * 0)) identity+)
   (((((e * 0) + (e * 1)) + (- (e * 1))) = (0 + (e * 0)))
    transitivity
    ((((e * 0) + 0) = (0 + (e * 0))) commutativity+)
    (((((e * 0) + (e * 1)) + (- (e * 1))) = ((e * 0) + 0))
     transitivity
     (((((e * 0) + (e * 1)) + (- (e * 1))) = ((e * 0) + ((e * 1) + (- (e * 1)))))
      associativity+)
     ((((e * 0) + ((e * 1) + (- (e * 1)))) = ((e * 0) + 0))
      congruence+
      (((e * 0) = (e * 0)) reflexivity)
      ((((e * 1) + (- (e * 1))) = 0) inverse+)))))
  ((((e * 1) + (- (e * 1))) = (((e * 0) + (e * 1)) + (- (e * 1))))
   congruence+
   (((- (e * 1)) = (- (e * 1))) reflexivity)
   (((e * 1) = ((e * 0) + (e * 1)))
    transitivity
    (((e * (0 + 1)) = ((e * 0) + (e * 1))) distributivity)
    (((e * 1) = (e * (0 + 1)))
     symmetry
     (((e * (0 + 1)) = (e * 1)) congruence*
                                ((e = e) reflexivity)
                                (((0 + 1) = 1) identity+)))))))
|#