; $Id: reflection.scm 2156 2008-01-25 13:25:12Z schimans $

#| Reflection for Semi-Rings

The aim here is to provide a tactic command to simplify/sort
an atomic goal formula of type boolean. The reflection method
can deal with every semi-ring satisfying the axioms.

First step is to initialise the semi-ring which one wants to
use. This is done by (prepare-reflection ...). Here you have
to specify (all parameters must be strings)
  - name of the semi-ring,
  - identity element of addition,
  - identity element of multiplication,
  - name of addition,
  - name of multiplication,
  - theorem name of associativity (addition),
    (form: "all r1,r2,r3.r1+(r2+r3)=(r1+r2)+r3")
  - theorem name of neutrality (addition),
    (form: "all r.Null+r=r")
  - theorem name of commutativity (addition),
    (form: "all r1,r2.r1+r2=r2+r1")
  - theorem name of associativity (multiplication),
    (form: "all r1,r2,r3.r1*(r2*r3) = (r1*r2)*r3"
  - theorem name of neutrality (multiplication),
    (form: "all r.One*r = r")
  - theorem name of commutativity (multiplication).
    (form: "all r1,r2.r1*r2 = r2*r1")
  - theorem name of distributivity
    (form: "all r1,r2,r3.r1*(r2+r3) = (r1*r2)+(r1*r3)"

Note, that the theorems must have exactly the same form as
stated above. 

After preparing has finished, one can use the command
(reflection ring-name) to solve atomic goals of type
boolean. The general form of possible goals is as follows.

Assume the goal to be R(s,t) where R is of type
ring->ring->boole. Let s' and t' be the sorted terms
of s and t respectively.

(reflection ring-name) tries to find proofs of s'=s and t'=t.
Then the theorem R(s',t') -> s'=s -> t'=t -> R(s,t) is applied
so that we are left with the goal R(s',t') that is given back
as a new goal to be proven. Since s' and t' are sorted the
chances that R(s',t') normalises to True are quite high.


EXAMPLE

(aga "IntPlusAssoc"  
     (pf "all i1,i2,i3.i1+(i2+i3) = (i1+i2)+i3"))
(aga "IntPlusNeutral"
     (pf "all i.IntZero+i = i"))
(aga "IntPlusComm" 
     (pf "all i1,i2.i1+i2 = i2+i1"))

(aga "IntTimesAssoc"
     (pf "all i1,i2,i3.i1*(i2*i3) = (i1*i2)*i3"))
(aga "IntTimesNeutral" 
     (pf "all i. (IntPos One)*i = i"))
(aga "IntTimesComm"
     (pf "all i1,i2.i1*i2 = i2*i1"))

(aga "IntDistr"  
     (pf "all i1,i2,i3.i1*(i2+i3) = (i1*i2)+(i1*i3)"))


(prepare-reflection "int" "IntZero" "IntPos One"
		    "IntPlus" "IntTimes" 
		    "IntPlusAssoc" "IntPlusNeutral" "IntPlusComm"
		    "IntTimesAssoc" "IntTimesNeutral" "IntTimesComm"
		    "IntDistr")
; Preparing Reflection for int.
; Preparing Program Constants...
; Preparing Proofs...
; Reflection for int loaded.

(sg "3+(181+i2)*i3+2+i1*i3*2+2*i2
     = 2*i2+i3*(171+i2+i1*2)+5+10*i3")
(strip)
(reflection "int")
; ok, ?_2 can be obtained from
; ?_3: 5+2*i2+181*i3+i2*i3+2*i3*i1=5+2*i2+181*i3+i2*i3+2*i3*i1 from
;   i2  i3  i1
(use "Truth-Axiom")
; Proof finished.

|#


(display "
Begin of reflection.scm
")

; (load "~/minlog/init.scm")


; new definition of (simp-with )
; ought to be moved to src/pproof.scm
(begin

  (define (simp-with-intern num-goals proof maxgoal . opt-dir-and-xs)
    (let* ((opt-dir
            (if (null? opt-dir-and-xs)
                (myerror "simp-with-intern" "more arguments expected")
                        (car opt-dir-and-xs)))
           (left-to-right
            (not (and (string? opt-dir) (string=? "<-" opt-dir))))
           (x-and-x-list (if left-to-right
                             opt-dir-and-xs
                             (cdr opt-dir-and-xs)))
           (x (if (null? x-and-x-list)
                  (myerror "simp-with-intern" "more arguments expected")
                  (car x-and-x-list)))
           (x-list (cdr x-and-x-list))
           (num-goal (car num-goals))
           (goal (num-goal-to-goal num-goal))
           (drop-info (num-goal-to-drop-info num-goal))
           (hypname-info (num-goal-to-hypname-info num-goal))
           (context (goal-to-context goal))
           (cvars (goal-to-cvars goal))
           (proof-and-new-num-goals-and-maxgoal
            (if (and (string? x)
                     (let ((info
                            (assoc
                             x (append THEOREMS GLOBAL-ASSUMPTIONS))))
                       (and info
                            (let*
                                ((aconst (cadr info))
                                 (aconst-formula
                                  (aconst-to-formula aconst))
                                 (final-concl
                                  (imp-all-allnc-form-to-final-conclusion
                                   aconst-formula)))
                              (and (predicate-form? final-concl)
                                   (pvar? (predicate-form-to-predicate
                                           final-concl)))))))
                (myerror "simp-with-intern" "unexpected aconst name" x)
                (apply
                 x-and-x-list-to-proof-and-new-num-goals-and-maxgoal
                       (append (list num-goal (+ 1 maxgoal) x)
                               x-list))))
           (negatom-or-eq-proof
            (car proof-and-new-num-goals-and-maxgoal))
           (new-num-goals (cadr proof-and-new-num-goals-and-maxgoal))
           (new-maxgoal (caddr proof-and-new-num-goals-and-maxgoal))
           (goal-formula (goal-to-formula goal))
           (used-formula (proof-to-formula negatom-or-eq-proof))
           (used-prime-formula
            (cond ((prime-form? used-formula) used-formula)
                  ((and (imp-form? used-formula)
                        (atom-form? (imp-form-to-premise used-formula))
                        (classical-formula=?
                         falsity (imp-form-to-conclusion used-formula)))
                   (imp-form-to-premise used-formula))
                  (else
                   (myerror "simp-with-intern"
                            "negated atom or prime formula expected"
                                 used-formula))))
           (used-nprime-formula (normalize-formula used-prime-formula))
           (bvar (type-to-new-var (make-alg "boole")))
           (bvarterm (make-term-in-var-form bvar))
           (used-kernel (if (atom-form? used-prime-formula)
                            (atom-form-to-kernel used-prime-formula)
                            bvarterm)) ;anything would do
           (used-nkernel (nt used-kernel))
           (op (term-in-app-form-to-final-op used-kernel))
           (nop (term-in-app-form-to-final-op used-nkernel))
           (goal-formula-without-kernel
            (if (atom-form? used-prime-formula)
                (formula-gen-subst goal-formula used-kernel bvarterm)
                goal-formula))
           (ngoal-formula-without-nkernel
            (if (atom-form? used-prime-formula)
                (formula-gen-subst
                 (nf goal-formula) used-nkernel bvarterm)
                goal-formula))
           (kernel-present? (not (classical-formula=?
                                  goal-formula-without-kernel
                                  goal-formula)))
           (nkernel-present? (not (classical-formula=?
                                   ngoal-formula-without-nkernel
                                   goal-formula))))
      (cond
       ((and kernel-present?
             (not (term=?
                   used-kernel (make-term-in-const-form true-const)))
             (not (term=?
                   used-kernel (make-term-in-const-form false-const)))
             (or (atom-form? used-formula) (synt-total? used-kernel)))
        (simp-with-kernel-aux
         num-goals proof maxgoal
         negatom-or-eq-proof new-num-goals new-maxgoal
         used-kernel bvar goal-formula-without-kernel))
       ((and nkernel-present?
             (not (term=? used-nkernel
                          (make-term-in-const-form true-const)))
             (not (term=? used-nkernel
                          (make-term-in-const-form false-const)))
             (or (atom-form? used-formula) (synt-total? used-nkernel)))
        (simp-with-kernel-aux
         num-goals proof maxgoal
         negatom-or-eq-proof new-num-goals new-maxgoal
         used-nkernel bvar ngoal-formula-without-nkernel))
       ((and (term-in-const-form? op)
             (string=? "="
                       (const-to-name(term-in-const-form-to-const op)))
             (let* ((args (term-in-app-form-to-args used-kernel))
                    (lhs (car args))
                    (rhs (cadr args))
                    (type (term-to-type lhs))
                    (var (type-to-new-var type))
                    (varterm (make-term-in-var-form var))
                    (simp-formula
                     (if left-to-right
                         (formula-gen-subst goal-formula lhs varterm)
                         (formula-gen-subst goal-formula rhs varterm))))
               (not (classical-formula=? simp-formula goal-formula))))
        (let* ((args (term-in-app-form-to-args used-kernel))
               (lhs (car args))
               (rhs (cadr args))
               (type (term-to-type lhs))
               (var (type-to-new-var type))
               (varterm (make-term-in-var-form var))
               (simp-formula
                (if left-to-right
                    (formula-gen-subst goal-formula lhs varterm)
                    (formula-gen-subst goal-formula rhs varterm)))
               (all-formula (mk-all var simp-formula))
               (new-goal ;A(rhs) or A(lhs)
                (context-and-cvars-and-formula-to-new-goal
                 context cvars
                 (formula-subst simp-formula var
                                (if left-to-right rhs lhs))))
               (new-num-goal
                (make-num-goal
                 (+ 1 maxgoal) new-goal drop-info hypname-info))
               (new-proof ;of A(lhs) or A(rhs)
                (mk-proof-in-elim-form
                 (if
                  left-to-right
;allnc n,m.n=m -> A(m) -> A(n)
                  (compat-rev-at all-formula)
;allnc n,m.n=m -> A(n) -> A(m)
                  (compat-at all-formula))
                 lhs rhs negatom-or-eq-proof new-goal)))
          (make-pproof-state
           (append (list new-num-goal) new-num-goals (cdr num-goals))
           (goal-subst proof goal new-proof)
           new-maxgoal)))
       ((and (term-in-const-form? nop)
             (string=? "="
                       (const-to-name(term-in-const-form-to-const nop)))
             (let* ((args (term-in-app-form-to-args used-nkernel))
                    (lhs (car args))
                    (rhs (cadr args))
                    (type (term-to-type lhs))
                    (var (type-to-new-var type))
                    (varterm (make-term-in-var-form var))
                    (simp-formula
                     (if left-to-right
                         (formula-gen-subst goal-formula lhs varterm)
                         (formula-gen-subst goal-formula rhs varterm))))
               (not (classical-formula=? simp-formula goal-formula))))
        (let* ((args (term-in-app-form-to-args used-nkernel))
               (lhs (car args))
               (rhs (cadr args))
               (type (term-to-type lhs))
               (var (type-to-new-var type))
               (varterm (make-term-in-var-form var))
               (simp-formula
                (if left-to-right
                    (formula-gen-subst goal-formula lhs varterm)
                    (formula-gen-subst goal-formula rhs varterm)))
               (all-formula (mk-all var simp-formula))
               (new-goal ;A(rhs) or A(lhs)
                (context-and-cvars-and-formula-to-new-goal
                 context cvars
                 (formula-subst simp-formula var
                                (if left-to-right rhs lhs))))
               (new-num-goal
                (make-num-goal
                 (+ 1 maxgoal) new-goal drop-info hypname-info))
               (new-proof ;of A(lhs) or A(rhs)
                (mk-proof-in-elim-form
                 (if
                  left-to-right
;allnc n,m.n=m -> A(m) -> A(n)
                  (compat-rev-at all-formula)
;allnc n,m.n=m -> A(n) -> A(m)
                  (compat-at all-formula))
                 lhs rhs negatom-or-eq-proof new-goal)))
          (make-pproof-state
           (append (list new-num-goal) new-num-goals (cdr num-goals))
           (goal-subst proof goal new-proof)
           new-maxgoal)))
       ((and (predicate-form? used-prime-formula)
             (string=? "Equal" (predconst-to-name
                                (predicate-form-to-predicate
                                 used-prime-formula)))
             (let* ((args (predicate-form-to-args used-prime-formula))
                    (lhs (car args))
                    (rhs (cadr args))
                    (type (term-to-type lhs))
                    (var (type-to-new-var type))
                    (varterm (make-term-in-var-form var))
                    (simp-formula
                     (if left-to-right
                         (formula-gen-subst goal-formula lhs varterm)
                         (formula-gen-subst goal-formula rhs varterm))))
               (not (classical-formula=? simp-formula goal-formula))))
        (let* ((args (predicate-form-to-args used-prime-formula))
               (lhs (car args))
               (rhs (cadr args))
               (type (term-to-type lhs))
               (var (type-to-new-var type))
               (varterm (make-term-in-var-form var))
               (simp-formula
                (if left-to-right
                    (formula-gen-subst goal-formula lhs varterm)
                    (formula-gen-subst goal-formula rhs varterm)))
               (all-formula (mk-all var simp-formula))
               (new-goal ;A(rhs) or A(lhs)
                (context-and-cvars-and-formula-to-new-goal
                 context cvars
                 (formula-subst simp-formula var
                                (if left-to-right rhs lhs))))
               (new-num-goal
                (make-num-goal
                 (+ 1 maxgoal) new-goal drop-info hypname-info))
               (new-proof ;of A(lhs) or A(rhs)
                (mk-proof-in-elim-form
                 (if
                  left-to-right
 ;allnc n,m.n=m -> A(m) -> A(n)
                  (eq-compat-rev-at all-formula)
 ;allnc n,m.n=m -> A(n) -> A(m)
                  (eq-compat-at all-formula))
                 lhs rhs negatom-or-eq-proof new-goal)))
          (make-pproof-state
           (append (list new-num-goal) new-num-goals (cdr num-goals))
           (goal-subst proof goal new-proof)
           new-maxgoal)))
       ((and (predicate-form? used-nprime-formula)
             (string=? "Equal" (predconst-to-name
                                (predicate-form-to-predicate
                                 used-nprime-formula)))
             (let* ((args (predicate-form-to-args used-nprime-formula))
                    (lhs (car args))
                    (rhs (cadr args))
                    (type (term-to-type lhs))
                    (var (type-to-new-var type))
                    (varterm (make-term-in-var-form var))
                    (simp-formula
                     (if left-to-right
                         (formula-gen-subst goal-formula lhs varterm)
                         (formula-gen-subst goal-formula rhs varterm))))
               (not (classical-formula=? simp-formula goal-formula))))
        (let* ((args (predicate-form-to-args used-nprime-formula))
               (lhs (car args))
               (rhs (cadr args))
               (type (term-to-type lhs))
               (var (type-to-new-var type))
               (varterm (make-term-in-var-form var))
               (simp-formula
                (if left-to-right
                    (formula-gen-subst goal-formula lhs varterm)
                    (formula-gen-subst goal-formula rhs varterm)))
               (all-formula (mk-all var simp-formula))
               (new-goal ;A(rhs) or A(lhs)
                (context-and-cvars-and-formula-to-new-goal
                 context cvars
                 (formula-subst simp-formula var
                                (if left-to-right rhs lhs))))
               (new-num-goal
                (make-num-goal
                 (+ 1 maxgoal) new-goal drop-info hypname-info))
               (new-proof ;of A(lhs) or A(rhs)
                (mk-proof-in-elim-form
                 (if
                  left-to-right
;allnc n,m.n=m -> A(m) -> A(n)
                  (eq-compat-rev-at all-formula)
;allnc n,m.n=m -> A(n) -> A(m)
                  (eq-compat-at all-formula))
                 lhs rhs negatom-or-eq-proof new-goal)))
          (make-pproof-state
           (append (list new-num-goal) new-num-goals (cdr num-goals))
           (goal-subst proof goal new-proof)
           new-maxgoal)))
       (else #f))))

  (define (simp-with opt-dir . rest)
    (let* ((num-goals (pproof-state-to-num-goals))
           (proof (pproof-state-to-proof))
           (maxgoal (pproof-state-to-maxgoal))
           (number (num-goal-to-number (car num-goals)))
           (simp-result
            (apply simp-with-intern
                   (append (list num-goals proof maxgoal opt-dir)
                           rest))))
      (if (not simp-result)
          (begin (display-comment "no simplification possible")
                 (if COMMENT-FLAG (newline)))
          (begin
            (set! PPROOF-STATE simp-result)
            (pproof-state-history-push PPROOF-STATE)
            (display-new-goals num-goals number)))))

  )


(begin


(set! COMMENT-FLAG #f)

(define DEBUG-FLAG #f)

(define (display-debug . debug-string-list)
  (if DEBUG-FLAG
      (letrec
          ((debug-string
            (lambda (ds)
              (cond ((=(length ds) 0) "")
                    ((=(length ds) 1) (car ds))
                    (else
                     (debug-string
                      (append
                       (list(string-append (car ds)(cadr ds)))
                       (cddr ds))))))))
        (display (debug-string debug-string-list))
        (newline))))

(exload "ordinals/nat.scm")
(libload "list.scm")
(srcload "unicode.scm") ; OPTIONAL
(exload "ordinals/reflection_thms.scm")
(remove-nat-tokens)
(remove-var-name "n" "m" "k")


#| In reflection_thms.scm we have shown the following theorems:

(display-theorems "BooleTrue")
; boole -> True=boole & boole=True
(display-theorems "alphaFunctional")
; (alpha1=>alpha2)_2≈(alpha1=>alpha2)_1 -> (alpha1)_2≈(alpha1)_1
;   -> (alpha1=>alpha2)_1(alpha1)_1≈(alpha1=>alpha2)_2(alpha1)_2
(display-theorems "alphaBinaryBooleFunctional")
; (alpha1)_3≈(alpha1)_1 -> (alpha2)_4≈(alpha2)_2
; -> alpha1=>alpha2=>boole(alpha1)_1(alpha2)_2
;                     = alpha1=>alpha2=>boole(alpha1)_3(alpha2)_4
(display-theorems "alphaBinaryBooleCompat")
; (alpha1)_3≈(alpha1)_1 -> (alpha2)_4≈(alpha2)_2
; -> alpha1=>alpha2=>boole(alpha1)_3(alpha2)_4
; -> alpha1=>alpha2=>boole(alpha1)_1(alpha2)_2

|#

)


; variable, to list all initialised algebras incl. all parameters

(define INITIALISED-RINGS '())

(define (display-reflection-rings) INITIALISED-RINGS)

; (prepare-reflection ...)
; initialises new semi-rings for use with reflection

(define (prepare-reflection
	 Ring
	 Null Unum
	 RingAdd RingTimes
	 RingAddAssoc RingAddNeutral RingAddComm
	 RingTimesAssoc RingTimesNeutral RingTimesComm
	 Distr)
  (if (assoc Ring INITIALISED-RINGS)
      (begin (display
	      (string-append "Reflection for "
			     Ring " already initialised."))
	     (newline))
      (begin
	(set! INITIALISED-RINGS
	      (cons (list Ring 
			  (list Null Unum
				RingAdd RingTimes
				RingAddAssoc RingAddNeutral RingAddComm
				RingTimesAssoc RingTimesNeutral RingTimesComm
				Distr))
		    INITIALISED-RINGS))
	(set! COMMENT-FLAG #f)
	(newline)
	(display (string-append "Preparing Reflection for " Ring "."))
	(newline)
    (display "Checking axioms")
    (newline)
    (check-axioms  Null Unum
                   RingAddAssoc   RingAddNeutral   RingAddComm
                   RingTimesAssoc RingTimesNeutral RingTimesComm Distr)
	(display "Preparing Program Constants...")
	(newline)
	(prepare-program-constants Ring
				   Null Unum
				   RingAdd RingTimes)
	(display "Preparing Proofs...")
	(newline)
	(prepare-proofs Ring
			Null Unum
			RingAdd RingTimes
			RingAddAssoc RingAddNeutral RingAddComm
			RingTimesAssoc RingTimesNeutral RingTimesComm
			Distr)
	(display (string-append "Reflection for " Ring " loaded."))
	(remove-var-name "r" "rs"
			 "e" "f" "g" "h"
			 "es" "fs"
			 "ees")
	(set! COMMENT-FLAG #t)
	(newline))))



; (axiom-form? ) takes as arguments a formula and a list of length ≥ 1
; with first element being a string identifying which form the axiom
; ought to be, e.g. "assoc". The (optional) second argument ought to
; be the neutral element if the first argument is "neutral". All other
; elements of the list are ignored. (axiom-form? ) is not restricted to
; + and * , it accepts any binary functions.

(define (axiom-form? formula form)
  (let* ((top   term-in-app-form-to-op)
         (targ  term-in-app-form-to-arg)
         (maf   mk-term-in-app-form)
         (mvf   make-term-in-var-form)
         (test  (car form))
         (vars-and-kernel (all-form-to-vars-and-final-kernel formula))
         (vars  (car vars-and-kernel))
         (kernel-term (atom-form-to-kernel(cadr vars-and-kernel)))
         (ft (lambda (fm lg) (and (string=? test fm)(= (length vars) lg)))))
    (cond ((ft "assoc" 3)
           (let* ((fun (top(top(targ kernel-term))))
                  (vt1 (mvf   (car vars)))
                  (vt2 (mvf  (cadr vars)))
                  (vt3 (mvf (caddr vars)))
                  (axform (make-=-term (maf fun vt1 (maf fun vt2 vt3))
                                       (maf fun (maf fun vt1 vt2) vt3))))
             (term=? axform kernel-term)))
          ((ft "neutral" 1)
           (let* ((fun    (top(targ(top kernel-term))))
                  (vt1    (mvf (car vars)))
                  (axform (make-=-term (maf fun vt1) vt1)))
             (and (term=? (cadr form) (targ fun))
                  (term=? axform kernel-term))))
          ((and (string=? test "comm")(= (length vars) 2))
           (let* ((fun (top(top(targ kernel-term))))
                  (vt1 (mvf (car vars)))
                  (vt2 (mvf(cadr vars)))
                  (axform
                   (make-=-term
                    (maf fun vt1 vt2)
                    (maf fun vt2 vt1))))
             (term=? axform kernel-term)))
          ((ft "distr" 3)
           (let* ((fun1 (top(top(targ kernel-term))))
                  (fun2 (top(top(targ(targ kernel-term)))))
                  (vt1 (mvf  (car vars)))
                  (vt2 (mvf (cadr vars)))
                  (vt3 (mvf(caddr vars)))
                  (axform
                   (make-=-term
                    (maf fun2 vt1 (maf fun1 vt2 vt3))
                    (maf fun1 (maf fun2 vt1 vt2) (maf fun2 vt1 vt3)))))
             (term=? axform kernel-term)))
          (else #f))))


(define
  (check-axioms
   Null Unum
   RingAddAssoc     RingAddNeutral   RingAddComm
   RingTimesAssoc   RingTimesNeutral RingTimesComm Distr)
  (do ((axioms
        (list RingAddAssoc  RingAddNeutral RingAddComm
              RingTimesAssoc  RingTimesNeutral RingTimesComm
              Distr)
        (cdr axioms))
       (i 0 (+ i 1)))
      ((null? axioms) #t)
    (let* ((ax (car axioms))
           (aconst
            (cond
             ((and (string? ax) (assoc ax THEOREMS))
              (theorem-name-to-aconst ax))
             ((and (string? ax) (assoc ax GLOBAL-ASSUMPTIONS))
              (global-assumption-name-to-aconst ax))
             (else
              (myerror "check-axioms"
                       "Name of theorem or global assumption expected!"
                       ax))))
           (formula (aconst-to-formula aconst))
           (form (cond ((or (= i 0)(= i 3)) (list "assoc"))
                       ((or (= i 2)(= i 5)) (list "comm"))
                       (    (= i 1)         (list "neutral" (pt Null)))
                       (    (= i 4)         (list "neutral" (pt Unum)))
                       (    (= i 6)         (list "distr"))
                       (else (myerror "check-axioms"
                                      "Something went wrong !")))))
      (if (not (axiom-form? formula form))
          (myerror "check-axiom"
                   "Axiom not of appropriate form !"
                   (formula-to-string formula))))))

; variables

(begin
  (av "al"  (py "alpha"))
  (av "als" (py "list alpha"))
  (av "rel" (py "alpha=>alpha=>boole"))
)

; some program constants concerning sorting of lists


(begin
  
  ; takes a single element and inserts it at right position
  (add-program-constant
   "SortListInsert"
   (py "(alpha=>alpha=>boole)=>alpha=>list alpha=>list alpha") 1)
  
  (acrs
   "(SortListInsert alpha) rel al (Nil alpha)"
   "al:"
   "(SortListInsert alpha) rel al (al0::als)"
   "[if (rel al al0) (al::al0::als)
        (al0::(SortListInsert alpha) rel al als)]")
  
  ; Insert-Sort for lists (uses SortListInsert)
  (add-program-constant
   "SortList"
   (py "(alpha=>alpha=>boole)=>list alpha=>list alpha") 1)
  
  (acrs
   "(SortList alpha)(rel)(Nil alpha)"
   "(Nil alpha)"
   "(SortList alpha)(rel)(al::als)"
   "(SortListInsert alpha)(rel)(al)((SortList alpha)(rel)(als))")
  
  ; Sort method for (general) list alpha
  (add-program-constant
   "OrderList"
   (py "(alpha=>alpha=>boole)=>list alpha=>list alpha=>boole") 1)
  
  (acrs
   "(OrderList alpha)rel(Nil alpha) als"      
   "True"
   "(OrderList alpha)rel(al::als)(Nil alpha)"   
   "False"
   "(OrderList alpha)rel(al1::als1)(al2::als2)"
   "[if (NatLt Lh(al1::als1) Lh(al2::als2))
        True
        [if (Lh(al1::als1)=Lh(al2::als2))
            [if (rel al1 al2)
                True
                [if (rel al2 al1)
                    False
                    ((OrderList alpha)rel(als1)(als2))]]
            False]]")
)


(define (prepare-program-constants 
	 Ring Null Unum RingAdd RingTimes)
  (let ((VarConstructor
	 (list (string-append Ring"Var")
	       (string-append "nat=>"Ring"expr")))
	(ConstConstructor 
	 (list (string-append Ring"Const")
	       (string-append Ring "=>"Ring"expr")))
	(AddConstructor
	 (list (string-append Ring"Add")
	       (string-append Ring"expr=>"Ring"expr=>"Ring"expr")))
	(MultConstructor
	 (list (string-append Ring"Mult")
	       (string-append Ring"expr=>"Ring"expr=>"Ring"expr")))
	(Relationtype (string-append Ring"=>"Ring"=>boole"))
	(Evaltype (string-append Ring"expr=>list "Ring"=>"Ring)))
    (begin
      
      ; For Testing:
      (add-program-constant
       (string-append Ring"Relation") (py Relationtype) 1)

      ; Algebra Expressions
      (add-alg (string-append Ring"expr")
	       VarConstructor
	       ConstConstructor
	       AddConstructor
	       MultConstructor)
    
      ; variables    
      (av "r" (py Ring))
      (av "rs" (py (string-append "list "Ring)))
      (av "e" "f" "g" "h" (py (string-append Ring"expr")))
      (av "es" "fs" (py (string-append "list "Ring"expr")))
      (av "ees" (py (string-append "list list "Ring"expr")))

      ; Eval
      ; Evaluation
      (add-program-constant (string-append Ring"Eval") 
			    (py Evaltype) 1)
      
      (acrs
       (string-append Ring"Eval("Ring"Var nat)(Nil "Ring")")
         Null
       (string-append Ring"Eval("Ring"Var Zero)(r::rs)")
         "r"
       (string-append Ring"Eval("Ring"Var(Succ nat))(r::rs)")
         (string-append Ring"Eval("Ring"Var nat)rs")
       (string-append Ring"Eval("Ring"Const r)rs")
         "r"
       (string-append Ring"Eval("Ring"Add e f)rs")
         (string-append RingAdd"("Ring"Eval e rs)
                                ("Ring"Eval f rs)")
       (string-append Ring"Eval("Ring"Mult e f)rs")
         (string-append RingTimes"("Ring"Eval e rs)
                                  ("Ring"Eval f rs)"))
    
      ; Ht
      ; height of a expression
      (add-program-constant (string-append Ring"Ht")
			    (py (string-append Ring"expr=>nat")) 1)
      
      (acrs
       (string-append Ring"Ht ("Ring"Var nat)")    "Zero"
       (string-append Ring"Ht ("Ring"Const r)")    "Zero"
       (string-append Ring"Ht ("Ring"Add e f)")
         (string-append "Succ (NatMax ("Ring"Ht e) ("Ring"Ht f))")
       (string-append Ring"Ht ("Ring"Mult e f)")
         (string-append "Succ (NatMax ("Ring"Ht e) ("Ring"Ht f))"))
    
      ; Dist
      ; applies distributivity
      ; second argument is a bound for the number of applications
      ; (bound will be the height of the expression)
      (add-program-constant (string-append Ring"Dist")
			    (py (string-append 
				 Ring"expr=>nat=>"Ring"expr")) 1)
    
      (acrs
       (string-append Ring"Dist e Zero")
         "e"
       (string-append Ring"Dist ("Ring"Var nat) (Succ(nat1))")
         (string-append "("Ring"Var nat)")
       (string-append Ring"Dist ("Ring"Const r) (Succ(nat))")
         (string-append "("Ring"Const r)")
       (string-append Ring"Dist ("Ring"Add e f) (Succ(nat))")
         (string-append "("Ring"Add ("Ring"Dist e nat)
                                    ("Ring"Dist f nat))")

       (string-append 
	Ring"Dist ("Ring"Mult ("Ring"Var nat)
                              ("Ring"Var nat1)) (Succ(nat2))")
         (string-append
	  "("Ring"Mult ("Ring"Var nat) ("Ring"Var nat1))")
       (string-append 
	Ring"Dist ("Ring"Mult ("Ring"Var nat)
                              ("Ring"Const r)) (Succ(nat1))")
         (string-append "("Ring"Mult ("Ring"Var nat)
                                     ("Ring"Const r))")
       (string-append 
	Ring"Dist ("Ring"Mult ("Ring"Var nat)
                              ("Ring"Mult e f)) (Succ(nat1))")
         (string-append
	  Ring"Dist ("Ring"Mult
                       ("Ring"Var nat)
                       ("Ring"Dist ("Ring"Mult e f) nat1)) nat1")
       (string-append
	Ring"Dist ("Ring"Mult ("Ring"Var nat)
                              ("Ring"Add e f)) (Succ(nat1))")
         (string-append
	  Ring"Dist ("Ring"Add
                     ("Ring"Mult ("Ring"Var nat) e)
                     ("Ring"Mult ("Ring"Var nat) f)) nat1")
       
       (string-append 
	Ring"Dist ("Ring"Mult ("Ring"Const r)
                              ("Ring"Var nat)) (Succ(nat1))")
         (string-append
	  Ring"Dist ("Ring"Mult ("Ring"Var nat) 
                                ("Ring"Const r)) (Succ(nat1))")
       (string-append 
	Ring"Dist ("Ring"Mult ("Ring"Const r1)
                              ("Ring"Const r2)) (Succ(nat))")
         (string-append 
	  "("Ring"Mult ("Ring"Const r1) ("Ring"Const r2))")
       (string-append
	Ring"Dist ("Ring"Mult ("Ring"Const r)
                              ("Ring"Mult e f)) (Succ(nat))")
         (string-append 
	  Ring"Dist ("Ring"Mult ("Ring"Const r)
                                ("Ring"Dist 
                                  ("Ring"Mult e f) nat)) nat")
       (string-append
	Ring"Dist ("Ring"Mult ("Ring"Const r)
                              ("Ring"Add e f))  (Succ(nat))")
         (string-append 
	  Ring"Dist ("Ring"Add ("Ring"Mult ("Ring"Const r) e)
                               ("Ring"Mult ("Ring"Const r) f)) nat")
     
       (string-append 
	Ring"Dist ("Ring"Mult ("Ring"Mult e f) 
                              ("Ring"Var nat)) (Succ(nat1))")
         (string-append 
	  Ring"Dist ("Ring"Mult ("Ring"Var nat)
                                ("Ring"Mult e f)) (Succ(nat1))")
       (string-append 
	Ring"Dist ("Ring"Mult ("Ring"Mult e f)
                              ("Ring"Const r)) (Succ(nat))")
         (string-append
	  Ring"Dist ("Ring"Mult ("Ring"Const r)
                                ("Ring"Mult e f)) (Succ(nat))")
       (string-append 
	Ring"Dist ("Ring"Mult ("Ring"Mult e f)
                              ("Ring"Mult g h)) (Succ(nat))")
         (string-append
	  Ring"Dist ("Ring"Mult 
                     ("Ring"Dist ("Ring"Mult e f) nat)
                     ("Ring"Dist ("Ring"Mult g h) nat)) nat")
       (string-append
	Ring"Dist ("Ring"Mult ("Ring"Mult e f)
                              ("Ring"Add g h)) (Succ(nat))")
         (string-append
	  Ring"Dist ("Ring"Add ("Ring"Mult ("Ring"Mult e f) g)
                               ("Ring"Mult ("Ring"Mult e f) h)) nat")
     
       (string-append 
	Ring"Dist ("Ring"Mult ("Ring"Add e f) 
                              ("Ring"Var nat)) (Succ(nat1))")
         (string-append 
	  Ring"Dist ("Ring"Mult ("Ring"Var nat)
                                ("Ring"Add e f)) (Succ(nat1))")
       (string-append 
	Ring"Dist ("Ring"Mult ("Ring"Add e f) 
                              ("Ring"Const r)) (Succ(nat))")
         (string-append
	  Ring"Dist ("Ring"Mult ("Ring"Const r)
                                ("Ring"Add e f)) (Succ(nat))")
       (string-append
	Ring"Dist ("Ring"Mult ("Ring"Add e f)
                              ("Ring"Mult g h)) (Succ(nat))")
         (string-append
	  Ring"Dist ("Ring"Mult ("Ring"Mult g h)
                                ("Ring"Add e f)) (Succ(nat))")
       (string-append 
	Ring"Dist ("Ring"Mult ("Ring"Add e f)
                              ("Ring"Add g h)) (Succ(nat))")
         (string-append
	  Ring"Dist ("Ring"Add 
                     ("Ring"Add ("Ring"Add ("Ring"Mult e g)
                                ("Ring"Mult e h)) ("Ring"Mult f g))
                     ("Ring"Mult f h)) nat"))
    
	; ; DistNormal
	; ; checks whether no more Add's occur in Mult
	; ; (always use with 2nd argument True)
	; (add-program-constant "DistNormal"
        ;  (py "expr=>boole=>boole") 1)
    	; (acrs
	;  "DistNormal (Var nat) boole" "True"
	;  "DistNormal (Const ring) boole" "True"
	;  "DistNormal (Add e f) False" "False"
	;  "DistNormal (Add e f) True" 
        ;  "DistNormal(e)(True) andb DistNormal(f)(True)"
	;  "DistNormal (Mult e f) boole" 
        ;  "DistNormal(e)(False) andb DistNormal(f)(False)")


      ; after Dist is applied, we can assume that we do not have
      ; an Add occuring in a Mult
    

      ; linearizes Mult, Var and Const expressions
      (add-program-constant 
       (string-append Ring"LinearExprAux")
       (py (string-append Ring"expr=>list "Ring"expr")) 1)
      
      (acrs
       (string-append Ring"LinearExprAux ("Ring"Var nat)")
         (string-append "("Ring"Var nat):")
       (string-append Ring"LinearExprAux ("Ring"Const r)")
         (string-append "("Ring"Const r):")
       (string-append Ring"LinearExprAux ("Ring"Add e f)")
         (string-append "("Ring"Add e f):")
       (string-append Ring"LinearExprAux ("Ring"Mult e f)")
         (string-append 
	  "("Ring"LinearExprAux e):+:("Ring"LinearExprAux f)"))
    

      ; linearizes every kind of expression
      (add-program-constant
       (string-append Ring"LinearExpr")
       (py (string-append Ring"expr=>list list "Ring"expr")) 1)
    
      (acrs
       (string-append Ring"LinearExpr ("Ring"Var nat)")
         (string-append "(("Ring"Var nat):):")
       (string-append Ring"LinearExpr ("Ring"Const r)")
         (string-append "(("Ring"Const r):):")
       (string-append Ring"LinearExpr ("Ring"Add e f)")
         (string-append 
	  "("Ring"LinearExpr e):+:("Ring"LinearExpr f)")
       (string-append Ring"LinearExpr ("Ring"Mult e f)")
         (string-append
	  "("Ring"LinearExprAux ("Ring"Mult e f)):"))
    

      ; Order of expressions, for use in SortExprAux
      (add-program-constant
       (string-append Ring"POExpr")
       (py (string-append Ring"expr=>"Ring"expr=>boole")) 1)
      
      (acrs
       (string-append Ring"POExpr ("Ring"Const r) e")
         "True" 
       (string-append
	Ring"POExpr ("Ring"Var nat) ("Ring"Const r)")
         "False" 
       (string-append
	Ring"POExpr ("Ring"Var nat1) ("Ring"Var nat2)") 
         "NatLt nat1 nat2"
       (string-append
	Ring"POExpr ("Ring"Var nat) ("Ring"Add e f)")
         "True" 
       (string-append 
	Ring"POExpr ("Ring"Var nat) ("Ring"Mult e f)")
         "True"
       (string-append Ring"POExpr ("Ring"Add e f) g")
         "False"
       (string-append Ring"POExpr ("Ring"Mult e f) g")
         "False")


      ; Order of expressions, for use in SortExpr
      (add-program-constant
       (string-append Ring"POExprTwo")
       (py (string-append Ring"expr=>"Ring"expr=>boole")) 1)
      
      (acrs
       (string-append Ring"POExprTwo ("Ring"Const r) e")
         "False" 
       (string-append
	Ring"POExprTwo ("Ring"Var nat) ("Ring"Const r)")
         "False" 
       (string-append
	Ring"POExprTwo ("Ring"Var nat1) ("Ring"Var nat2)") 
         "NatLt nat1 nat2"
       (string-append
	Ring"POExprTwo ("Ring"Var nat) ("Ring"Add e f)")
         "True" 
       (string-append
	Ring"POExprTwo ("Ring"Var nat) ("Ring"Mult e f)")
         "True"
       (string-append Ring"POExprTwo ("Ring"Add e f) g")
         "False"
       (string-append Ring"POExprTwo ("Ring"Mult e f) g")
         "False")
    

      ; sorts multiplication lists 
      (add-program-constant 
       (string-append Ring"SortExprAux")
       (py (string-append "list list "Ring"expr=>
                           list list "Ring"expr")) 1)
    
      (acrs
       (string-append Ring"SortExprAux(Nil list "Ring"expr)")
         (string-append "(Nil list "Ring"expr)")
       (string-append Ring"SortExprAux(es::ees)")
         (string-append 
	  "((SortList "Ring"expr)("Ring"POExpr)(es))
           ::"Ring"SortExprAux(ees)"))    
    

      ; sorts lists of multiplication lists
      (add-program-constant
       (string-append Ring"SortExpr")
       (py (string-append "list list "Ring"expr=>
                           list list "Ring"expr")) 1)
    
      (acrs
       (string-append Ring"SortExpr(Nil list "Ring"expr)")
         (string-append "(Nil list "Ring"expr)")
       (string-append Ring"SortExpr(es::ees)")
         (string-append
	  "((SortList list "Ring"expr)((OrderList "Ring"expr)
           "Ring"POExprTwo)(es::ees))"))
    


      ; simplifies a multiplication list such that there is
      ; exactly one constant factor
      (add-program-constant 
       (string-append Ring"SimpConstAux")
       (py (string-append "list "Ring"expr=>list "Ring"expr")) 1)
      
      (acrs
       (string-append Ring"SimpConstAux (Nil "Ring"expr)")
         (string-append "(Nil "Ring"expr)")
       (string-append Ring"SimpConstAux (("Ring"Var nat)::es)")
         (string-append
	  "(("Ring"Const ("Unum"))::("Ring"Var nat)::es)")
       (string-append Ring"SimpConstAux (("Ring"Add e f)::es)")
         (string-append
	  "(("Ring"Const ("Unum"))::("Ring"Add e f)::es)")
       (string-append Ring"SimpConstAux (("Ring"Mult e f)::es)")
         (string-append 
	  "(("Ring"Const ("Unum"))::("Ring"Mult e f)::es)")
       (string-append Ring"SimpConstAux ("Ring"Const r):")
         (string-append "("Ring"Const r):")
       (string-append
	Ring"SimpConstAux (("Ring"Const r)::("Ring"Var nat)::es)")
         (string-append "(("Ring"Const r)::("Ring"Var nat)::es)")
       (string-append 
	Ring"SimpConstAux (("Ring"Const r1)::("Ring"Const r2)::es)")
         (string-append 
	  Ring"SimpConstAux (("Ring"Const 
                                ("RingTimes" r1 r2))::es)") 
       (string-append 
	Ring"SimpConstAux (("Ring"Const r)::("Ring"Add e f)::es)")
         (string-append "(("Ring"Const r)::("Ring"Add e f)::es)")
       (string-append
	Ring"SimpConstAux (("Ring"Const r)::("Ring"Mult e f)::es)")
         (string-append "(("Ring"Const r)::("Ring"Mult e f)::es)"))
      

      ; simplifies an expression such that there is exactly
      ; one constant factor in front of multiplication list
      (add-program-constant 
       (string-append Ring"SimpConst")
       (py (string-append "list list "Ring"expr=>
                           list list "Ring"expr")) 1)
      
      (acrs
       (string-append Ring"SimpConst (Nil list "Ring"expr)")
         (string-append "(Nil list "Ring"expr)")
       (string-append Ring"SimpConst (es::ees)")
         (string-append 
	  "("Ring"SimpConstAux es)::("Ring"SimpConst ees)"))
    

      ; sums up equal monomials
      (add-program-constant
       (string-append Ring"SimpConstTwo")
       (py (string-append "list list "Ring"expr=>
                           list list "Ring"expr")) 1)
      
      (acrs
       (string-append Ring"SimpConstTwo (Nil list "Ring"expr)")
         (string-append "(Nil list "Ring"expr)")
       (string-append Ring"SimpConstTwo ((Nil "Ring"expr)::ees)")
         (string-append
	  Ring"SimpConstTwo((("Ring"Const ("Unum")):)::ees)")
       (string-append Ring"SimpConstTwo ((("Ring"Const r)::es):)")
         (string-append "((("Ring"Const r)::es):)")
       (string-append
	Ring"SimpConstTwo 
             ((("Ring"Const r)::es)::(Nil "Ring"expr)::ees)")
         (string-append
	  "[if (es=(Nil "Ring"expr))
               ("Ring"SimpConstTwo ((("Ring"Const
                              ("RingAdd" r ("Unum"))):)::ees))
               ((("Ring"Const r)::es)::(Nil "Ring"expr)
                              ::("Ring"SimpConstTwo ees))]")
       (string-append 
	Ring"SimpConstTwo 
             ((("Ring"Const r1)::es)::(("Ring"Const r2)::fs)::ees)")
         (string-append
	  "[if (es=fs) 
            ("Ring"SimpConstTwo
                   ((("Ring"Const ("RingAdd" r1 r2))::es)::ees))
            ((("Ring"Const r1)::es)::("Ring"SimpConstTwo
                                  ((("Ring"Const r2)::fs)::ees)))]")
       (string-append 
	Ring"SimpConstTwo
             ((("Ring"Const r)::es)::(("Ring"Var nat)::fs)::ees)")
         (string-append 
	  "((("Ring"Const r)::es)::(("Ring"Var nat)::fs)
                                 ::("Ring"SimpConstTwo ees))")
       (string-append
	Ring"SimpConstTwo
             ((("Ring"Const r)::es)::(("Ring"Add e f)::fs)::ees)")
         (string-append
	  "((("Ring"Const r)::es)::(("Ring"Add e f)::fs)
                                 ::("Ring"SimpConstTwo ees))")
       (string-append
	Ring"SimpConstTwo
             ((("Ring"Const r)::es)::(("Ring"Mult e f)::fs)::ees)")
         (string-append
	  "((("Ring"Const r)::es)::(("Ring"Mult e f)::fs)
                                 ::("Ring"SimpConstTwo ees))")
       (string-append
	Ring"SimpConstTwo ((("Ring"Var nat)::es)::ees)")
         (string-append "((("Ring"Var nat)::es)::("Ring"SimpConstTwo ees))")
       (string-append
	Ring"SimpConstTwo ((("Ring"Add e f)::es)::ees)")
         (string-append "((("Ring"Add e f)::es)::("Ring"SimpConstTwo ees))")
       (string-append
	Ring"SimpConstTwo ((("Ring"Mult e f)::es)::ees)")
         (string-append "((("Ring"Mult e f)::es)::("Ring"SimpConstTwo ees))"))
    

      ; builds up Mult expressions from linearized expressions
      (add-program-constant 
       (string-append Ring"BuildExprAux")
       (py (string-append "list "Ring"expr=>"Ring"expr")) 1)
      
      (acrs
       (string-append Ring"BuildExprAux (Nil "Ring"expr)")
         (string-append Ring"Const ("Unum")")
       (string-append Ring"BuildExprAux (e:)")
         "e"
       (string-append Ring"BuildExprAux (e::f::es)")
         (string-append Ring"BuildExprAux (("Ring"Mult e f)::es)"))
    

      ; builds up expressions from linearized expressions
      (add-program-constant 
       (string-append Ring"BuildExpr")
       (py (string-append "list list "Ring"expr=>"Ring"expr")) 1)
      
      (acrs
       (string-append Ring"BuildExpr (Nil list "Ring"expr)")
         (string-append Ring"Const ("Null")")
       (string-append Ring"BuildExpr (es:)")
         (string-append Ring"BuildExprAux es")
       (string-append Ring"BuildExpr (es::fs::ees)")
         (string-append 
	  Ring"BuildExpr((("Ring"Add ("Ring"BuildExprAux es)
                             ("Ring"BuildExprAux fs)):)::ees)"))
    
      ; NormalizeAndSortExpr
      ; applies the following functions on expressions:
      ; - Dist
      ; - LinearExpr
      ; - SortExprAux
      ; - SimpConst
      ; - SortExpr
      ; - SimpConstTwo
      ; - BuildExpr
      (add-program-constant
       (string-append Ring"NormalizeAndSortExpr") 
       (py (string-append Ring"expr=>"Ring"expr")) 1)

      (acrs
       (string-append Ring"NormalizeAndSortExpr e")
         (string-append 
	  Ring"BuildExpr("Ring"SimpConstTwo
           ("Ring"SortExpr("Ring"SimpConst
            ("Ring"SortExprAux("Ring"LinearExpr
             ("Ring"Dist e ("Ring"Ht e)))))))"))

      )))

(define (prepare-proofs Ring
			Null Unum
			RingAdd RingTimes
			RingAddAssoc RingAddNeutral RingAddComm
			RingTimesAssoc RingTimesNeutral RingTimesComm
			Distr)

  (sg "all rs,nat,e. "Ring"Eval("Ring"Dist e nat)rs
                       = "Ring"Eval e rs")
  ; first prove another distributivity lemma,
  ; i.e. (r1+r2)*r3 = r1*r3+r2*r3
  (assert (pf (string-append "all "Ring"1,"Ring"2,"Ring"3."
      RingTimes"("
      RingAdd"("Ring"1)("Ring"2))("
      Ring"3) = "
      RingAdd"("
      RingTimes"("Ring"1)("Ring"3))("
      RingTimes"("Ring"2)("Ring"3))")))
  (strip)
  (simp-with RingTimesComm
	     (pt (string-append RingAdd"("Ring"1)("Ring"2)"))
	     (pt (string-append Ring"3")))
  (simp-with Distr
	     (pt (string-append Ring"3"))
	     (pt (string-append Ring"1"))
	     (pt (string-append Ring"2")))
  (simp-with RingTimesComm
	     (pt (string-append Ring"1"))
	     (pt (string-append Ring"3")))
  (simp-with RingTimesComm
	     (pt (string-append Ring"3"))
	     (pt (string-append Ring"2")))
  (use "Truth-Axiom")
  ; Proof of lemma finished.
  (assume "DistrTwo" "rs")
  (ind)
  (strip)
  (use "Truth-Axiom")
  (assume "nat" "IH")
  (cases)
  (strip)
  (use "Truth-Axiom")
  (strip)
  (use "Truth-Axiom")
  (assume "e1" "e2")
  (ng)
  (simp-with "IH" (pt "e1"))
  (simp-with "IH" (pt "e2"))
  (use "Truth-Axiom")
  (cases)
  (assume "nat1")
  (cases)
  (strip)
  (use "Truth-Axiom")
  (strip)
  (use "Truth-Axiom")
  (assume "e1" "e2")
  (ng)
  (simp-with
   "IH"
   (pt
    (string-append
     Ring"Add("Ring"Mult("Ring"Var nat1)e1)
                 ("Ring"Mult("Ring"Var nat1)e2)")))
  (ng)
  (simp-with Distr (pt (string-append Ring"Eval("Ring"Var nat1)rs"))
	     (pt (string-append Ring"Eval e1 rs"))
	     (pt (string-append Ring"Eval e2 rs")))
  (use "Truth-Axiom")
  (assume "e1" "e2")
  (ng)
  (simp-with
   "IH"
   (pt 
    (string-append Ring"Mult("Ring"Var nat1)
                                ("Ring"Dist("Ring"Mult e1 e2)nat)")))
  (ng)
  (simp-with
   "IH" 
   (pt (string-append Ring"Mult e1 e2")))
  (use "Truth-Axiom")
  (assume "r")
  (cases)
  (assume "nat1")
  (ng)
  (simp-with
   RingTimesComm (pt "r")
   (pt (string-append Ring"Eval("Ring"Var nat1)rs")))
  (use "Truth-Axiom")
  (strip)
  (use "Truth-Axiom")
  (assume "e1" "e2")
  (ng)
  (simp-with
   "IH" 
   (pt
    (string-append
     Ring"Add("Ring"Mult("Ring"Const r)e1)
                 ("Ring"Mult("Ring"Const r)e2)")))
  (ng)
  (simp-with Distr
	     (pt "r")
	     (pt (string-append Ring"Eval e1 rs"))
	     (pt (string-append Ring"Eval e2 rs")))
  (use "Truth-Axiom")
  (assume "e1" "e2")
  (ng)
  (simp-with "IH" 
	     (pt
	      (string-append Ring"Mult("Ring"Const r)("Ring
			     "Dist("Ring"Mult e1 e2)nat)")))
  (ng)
  (simp-with "IH" (pt (string-append Ring"Mult e1 e2")))
  (use "Truth-Axiom")
  (assume "e1" "e2")
  (cases)
  (assume "nat1")
  (ng)
  (simp-with 
   "IH"
   (pt
    (string-append Ring"Add("Ring"Mult("Ring"Var nat1)e1)
                               ("Ring"Mult("Ring"Var nat1)e2)")))
  (ng)
  (simp-with "DistrTwo"
	     (pt (string-append Ring"Eval e1 rs"))
	     (pt (string-append Ring"Eval e2 rs"))
	     (pt (string-append Ring"Eval("Ring"Var nat1)rs")))
  (simp-with 
   RingTimesComm
   (pt (string-append Ring"Eval e1 rs"))
   (pt (string-append Ring"Eval("Ring"Var nat1)rs")))
  (simp-with
   RingTimesComm
   (pt (string-append Ring"Eval e2 rs"))
   (pt (string-append Ring"Eval("Ring"Var nat1)rs")))
  (use "Truth-Axiom")
  (assume "r")
  (ng)
  (simp-with
   "IH"
   (pt (string-append Ring"Add("Ring"Mult("Ring"Const r)e1)
                                  ("Ring"Mult("Ring"Const r)e2)")))
  (ng)
  (simp-with "DistrTwo"
	     (pt (string-append Ring"Eval e1 rs"))
	     (pt (string-append Ring"Eval e2 rs"))
	     (pt "r"))
  (simp-with
   RingTimesComm
   (pt (string-append Ring"Eval e1 rs"))
   (pt "r"))
  (simp-with 
   RingTimesComm
   (pt (string-append Ring"Eval e2 rs"))
   (pt "r"))
  (use "Truth-Axiom")
  (assume "e3" "e4")
  (ng)
  (simp-with
   "IH"
   (pt
    (string-append Ring"Add("Ring"Add("Ring"Add
                            ("Ring"Mult e1 e3)
                            ("Ring"Mult e1 e4))
                            ("Ring"Mult e2 e3))
                            ("Ring"Mult e2 e4)")))
  (ng)
  (simp-with
   Distr
   (pt (string-append RingAdd"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval e3 rs"))
   (pt (string-append Ring"Eval e4 rs")))
  (simp-with "DistrTwo" (pt (string-append Ring"Eval e1 rs"))
	     (pt (string-append Ring"Eval e2 rs"))
	     (pt (string-append Ring"Eval e3 rs")))
  (simp-with "DistrTwo" (pt (string-append Ring"Eval e1 rs"))
	     (pt (string-append Ring"Eval e2 rs"))
	     (pt (string-append Ring"Eval e4 rs")))
  (simp-with
   RingAddAssoc
   (pt (string-append 
	RingAdd "("RingTimes " ("Ring"Eval e1 rs)
                                   ("Ring"Eval e3 rs))
                     ("RingTimes " ("Ring"Eval e2 rs)
                                   ("Ring"Eval e3 rs))"))
   (pt (string-append
	RingTimes " ("Ring"Eval e1 rs) ("Ring"Eval e4 rs)"))
   (pt (string-append
	RingTimes " ("Ring"Eval e2 rs) ("Ring"Eval e4 rs)")))
  (simp-with
   "<-"
   RingAddAssoc
   (pt (string-append
	RingTimes" ("Ring"Eval e1 rs) ("Ring"Eval e3 rs)"))
   (pt (string-append
	RingTimes" ("Ring"Eval e2 rs) ("Ring"Eval e3 rs)"))
   (pt (string-append 
	RingTimes" ("Ring"Eval e1 rs) ("Ring"Eval e4 rs)")))
  (simp-with
   RingAddComm
   (pt (string-append
	RingTimes" ("Ring"Eval e2 rs) ("Ring"Eval e3 rs)"))
   (pt (string-append
	RingTimes" ("Ring"Eval e1 rs) ("Ring"Eval e4 rs)")))
  (simp-with
   RingAddAssoc
   (pt (string-append
	RingTimes" ("Ring"Eval e1 rs) ("Ring"Eval e3 rs)"))
   (pt (string-append
	RingTimes" ("Ring"Eval e1 rs) ("Ring"Eval e4 rs)"))
   (pt (string-append 
	RingTimes" ("Ring"Eval e2 rs) ("Ring"Eval e3 rs)")))
  (use "Truth-Axiom")
  (assume "e3" "e4")
  (ng)
  (simp-with
   "IH" 
   (pt 
    (string-append
     Ring"Add("Ring"Mult("Ring"Mult e3 e4)e1)("Ring
     "Mult("Ring"Mult e3 e4)e2)")))
  (ng)
  (simp-with
   "DistrTwo"
   (pt (string-append Ring"Eval e1 rs"))
   (pt (string-append Ring"Eval e2 rs"))
   (pt (string-append RingTimes"("Ring"Eval e3 rs)("Ring"Eval e4 rs)")))
  (simp-with
   RingTimesComm
   (pt (string-append Ring"Eval e1 rs"))
   (pt (string-append RingTimes" ("Ring"Eval e3 rs) ("Ring"Eval e4 rs)")))
  (simp-with
   RingTimesComm
   (pt (string-append Ring"Eval e2 rs"))
   (pt (string-append RingTimes" ("Ring"Eval e3 rs) ("Ring"Eval e4 rs)")))
  (use "Truth-Axiom")
  (assume "e1" "e2")
  (cases)
  (assume "nat1")
  (ng)
  (simp-with
   "IH" 
   (pt
    (string-append Ring"Mult("Ring"Var nat1)("Ring"Dist("Ring
		   "Mult e1 e2)nat)")))
  (ng)
  (simp-with "IH" (pt (string-append Ring"Mult e1 e2")))
  (ng)
  (simp-with
   RingTimesComm
   (pt (string-append Ring"Eval("Ring"Var nat1)rs"))
   (pt (string-append
	RingTimes" ("Ring"Eval e1 rs) ("Ring"Eval e2 rs)")))
  (use "Truth-Axiom")
  (assume "r")
  (ng)
  (simp-with
   "IH" 
   (pt
    (string-append Ring"Mult("Ring"Const r)("
		   Ring"Dist("Ring"Mult e1 e2)nat)")))
  (ng)
  (simp-with "IH" (pt (string-append Ring"Mult e1 e2")))
  (ng)
  (simp-with
   RingTimesComm (pt "r")
   (pt (string-append
	RingTimes" ("Ring"Eval e1 rs) ("Ring"Eval e2 rs)")))
  (use "Truth-Axiom")
  (assume "e3" "e4")
  (ng)
  (simp-with
   "IH"
   (pt
    (string-append Ring"Add("Ring"Mult("Ring
		   "Mult e1 e2)e3)("Ring"Mult("
		   Ring"Mult e1 e2)e4)")))
  (ng)
  (simp-with
   Distr
   (pt (string-append RingTimes"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval e3 rs"))
   (pt (string-append Ring"Eval e4 rs")))
  (use "Truth-Axiom")
  (assume "e3" "e4")
  (ng)
  (simp-with 
   "IH"
   (pt
    (string-append Ring"Mult("Ring"Dist("
		   Ring"Mult e1 e2)nat)("
		   Ring"Dist("Ring"Mult e3 e4)nat)")))
  (ng)
  (simp-with "IH" (pt (string-append Ring"Mult e1 e2")))
  (simp-with "IH" (pt (string-append Ring"Mult e3 e4")))
  (use "Truth-Axiom")
  ; Proof finished.
  (arw (string-append Ring"Eval("Ring"Dist e nat)rs")
       (string-append Ring"Eval e rs"))


  (sg "all rs,es,e. "
      Ring"Eval("Ring"BuildExprAux(e::es))rs
        = "RingTimes" ("Ring"Eval e rs) ("
	Ring"Eval("Ring"BuildExprAux(es))rs)")
  (assume "rs")
  (ind)
  (ng)
  (strip)
  (simp-with RingTimesComm 
	     (pt (string-append Ring"Eval e rs"))
	     (pt Unum))
  (simp-with RingTimesNeutral
	     (pt (string-append Ring"Eval e rs")))
  (use "Truth-Axiom")
  (assume "e" "es" "IH")
  (cases)
  (assume "nat")
  (ng)
  (simp-with
   "IH"
   (pt (string-append Ring"Mult ("Ring"Var nat) e")))
  (simp-with "IH" (pt "e"))
  (ng)
  (simp-with
   RingTimesAssoc
   (pt (string-append Ring"Eval("Ring"Var nat)rs"))
   (pt (string-append Ring"Eval e rs"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  (use "Truth-Axiom")
  (assume "r")
  (ng)
  (simp "IH")
  (ng)
  (simp "IH")
  (ng)
  (simp-with 
   RingTimesAssoc (pt "r")
   (pt (string-append Ring"Eval e rs"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  (use "Truth-Axiom")
  (assume "e1" "e2")
  (ng)
  (simp "IH")
  (ng)
  (simp "IH")
  (simp-with
   RingTimesAssoc
   (pt (string-append RingAdd"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval e rs"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  (use "Truth-Axiom")
  (assume "e1" "e2")
  (ng)
  (simp "IH")
  (ng)
  (simp "IH")
  (simp-with
   RingTimesAssoc
   (pt (string-append RingTimes"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval e rs"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  (use "Truth-Axiom")
  ; Proof finished.
  (arw (string-append Ring"Eval("Ring"BuildExprAux(e::es))rs")
       (string-append
        RingTimes" ("Ring"Eval e rs) ("
	Ring"Eval("Ring"BuildExprAux(es))rs)"))


  (sg "all rs,es1,es2. "
      Ring"Eval("Ring"BuildExprAux(es1:+:es2))rs
        = "RingTimes" ("Ring"Eval("Ring"BuildExprAux es1)rs) ("
	Ring"Eval("Ring"BuildExprAux es2)rs)")
  (assume "rs")
  (ind)
  (ng)
  (assume "es2")
  (simp-with RingTimesNeutral
	     (pt (string-append Ring"Eval("Ring"BuildExprAux es2)rs")))
  (use "Truth-Axiom")
  (assume "e1" "es1" "IH" "es2")
  (ng)
  (simp "IH")
  (simp-with RingTimesAssoc
	     (pt (string-append Ring"Eval e1 rs"))
	     (pt (string-append Ring"Eval("Ring"BuildExprAux es1)rs"))
	     (pt (string-append Ring"Eval("Ring"BuildExprAux es2)rs")))
  (use "Truth-Axiom")
  ; Proof finished.
  (arw (string-append Ring"Eval("Ring"BuildExprAux(es1:+:es2))rs")
       (string-append RingTimes" ("Ring"Eval("Ring"BuildExprAux es1)rs) ("
		      Ring"Eval("Ring"BuildExprAux es2)rs)"))


  (sg "all rs,ees,es. "
      Ring"Eval("Ring"BuildExpr(es::ees))rs
        = "RingAdd" ("Ring"Eval("Ring"BuildExprAux es)rs) ("
	Ring"Eval("Ring"BuildExpr(ees))rs)")
  (assume "rs")
  (ind)
  (strip)
  (ng)
  (simp-with RingAddComm
	     (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs"))
	     (pt Null))
  (simp-with RingAddNeutral 
	     (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  (use "Truth-Axiom")
  (assume "es" "ees" "IH" "fs")
  (simp "IH")
  (ng)
  (simp "IH")
  (ng)
  (simp-with RingAddAssoc
	     (pt (string-append Ring"Eval("Ring"BuildExprAux fs)rs"))
	     (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs"))
	     (pt (string-append Ring"Eval("Ring"BuildExpr ees)rs")))
  (use-with "Truth-Axiom")
  ; Proof finished.
  (arw (string-append Ring"Eval("Ring"BuildExpr(es::ees))rs")
       (string-append RingAdd" ("Ring"Eval("Ring"BuildExprAux es)rs) ("
		      Ring"Eval("Ring"BuildExpr(ees))rs)"))


  (sg "all rs,ees,es."
      Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo(es::ees)))rs
        = "RingAdd" ("Ring"Eval("Ring"BuildExprAux(es))rs) ("
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo(ees)))rs)")
  ; first prove another distributivity lemma,
  ; i.e. (r1+r2)*r3 = r1*r3+r2*r3
  (assert (pf (string-append "all "Ring"1,"Ring"2,"Ring"3."
      RingTimes"("
      RingAdd"("Ring"1)("Ring"2))("
      Ring"3) = "
      RingAdd"("
      RingTimes"("Ring"1)("Ring"3))("
      RingTimes"("Ring"2)("Ring"3))")))
  (strip)
  (simp-with RingTimesComm
	     (pt (string-append RingAdd"("Ring"1)("Ring"2)"))
	     (pt (string-append Ring"3")))
  (simp-with Distr
	     (pt (string-append Ring"3"))
	     (pt (string-append Ring"1"))
	     (pt (string-append Ring"2")))
  (simp-with RingTimesComm
	     (pt (string-append Ring"1"))
	     (pt (string-append Ring"3")))
  (simp-with RingTimesComm
	     (pt (string-append Ring"3"))
	     (pt (string-append Ring"2")))
  (use "Truth-Axiom")
  ; Proof of lemma finished.
  (assume "DistrTwo" "rs")
  (ind)
  (ng)
  (ind)
  (ng)
  (simp-with RingAddComm
	     (pt Unum)
	     (pt Null))
  (simp-with RingAddNeutral
	     (pt Unum))
  (search)
  (ng)
  (cases)
  ;(ng)
  (assume "nat" "es" "IH")
  (ng)
  (simp-with
   RingAddComm
   (pt (string-append 
	Ring"Eval("Ring"BuildExprAux("Ring"Var nat::es))rs"))
   (pt Null))
  (simp-with
   RingAddNeutral
   (pt (string-append
	Ring"Eval("Ring"BuildExprAux("Ring"Var nat::es))rs")))
  (search)
  ;(ng)
  (assume "r" "es" "IH")
  (ng)
  (simp-with
   RingAddComm
   (pt (string-append
	Ring"Eval("Ring"BuildExprAux("Ring"Const r::es))rs"))
   (pt Null))
  (simp-with
   RingAddNeutral
   (pt (string-append
	Ring"Eval("Ring"BuildExprAux("Ring"Const r::es))rs")))
  (search)
  ;(ng)
  (assume "e1" "e2" "es" "IH")
  (ng)
  (simp-with
   RingAddComm
   (pt (string-append
	Ring"Eval("Ring"BuildExprAux("Ring"Add e1 e2::es))rs"))
   (pt Null))
  (simp-with
   RingAddNeutral
   (pt (string-append 
	Ring"Eval("Ring"BuildExprAux("Ring"Add e1 e2::es))rs")))
  (search)
  ;(ng)
  (assume "e1" "e2" "es" "IH")
  (ng)
  (simp-with
   RingAddComm
   (pt (string-append
	Ring"Eval("Ring"BuildExprAux("Ring"Mult e1 e2::es))rs"))
   (pt Null))
  (simp-with
   RingAddNeutral
   (pt (string-append
	Ring"Eval("Ring"BuildExprAux("Ring"Mult e1 e2::es))rs")))
  (search)
  (cases)
  (ng)
  (assume "ees" "IH")
  (cases)
  (ng)
  (simp "IH")
  (simp "IH")
  (ng)
  (simp-with
   RingAddAssoc
   (pt Unum)
   (pt Unum)
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (ng)
  (cases)
  ;(ng)
  ;(assume "nat" "es")
  (search)
  (assume "r" "es")
  (ng)
  (cases (pt (string-append "es=(Nil "Ring"expr)")))
  ;(ng)
  (assume "case")
  (ng)
  (simp "IH")
  (ng)
  (simp "case")
  (ng)
  (simp "IH")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append RingTimes"(r)("Unum")"))
   (pt Unum)
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  ;(ng)
  (simp-with RingTimesComm
	     (pt "r")
	     (pt Unum))
  (simp-with RingTimesNeutral
	     (pt "r"))
  (search)
  (strip)
  (ng)
  (simp "IH")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append
	RingTimes"(r)("Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt Unum)
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  ;(assume "e1" "e2" "es")
  ;(ng)
  (search)
  ;(assume "e1" "e2" "es")
  (search)
  (cases)
  ;(ng)
  (assume "nat" "es" "ees" "IH")
  (ng)
  (cases)
  (ng)
  (simp-with
   RingAddAssoc
   (pt Unum)
   (pt (string-append
	RingTimes"("Ring"Eval("Ring"Var nat)rs)("
	Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append 
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (ng)
  (cases)
  (assume "nat2" "es2")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append
	RingTimes"("Ring"Eval("Ring"Var nat2)rs)("
	Ring"Eval("Ring"BuildExprAux es2)rs)"))
   (pt (string-append
	RingTimes"("Ring"Eval("Ring"Var nat)rs)("
	Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (assume "r" "es2")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append 
	RingTimes"(r)("Ring"Eval("Ring"BuildExprAux es2)rs)"))
   (pt (string-append
	RingTimes"("Ring"Eval("Ring"Var nat)rs)("
	Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (assume "e1" "e2" "es2")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append 
	RingTimes"("RingAdd"("Ring"Eval e1 rs)("
	Ring"Eval e2 rs))("Ring"Eval("Ring"BuildExprAux es2)rs)"))
   (pt (string-append
	RingTimes"("Ring"Eval("Ring"Var nat)rs)("
	Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (assume "e1" "e2" "es2")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append
	RingTimes"("RingTimes"("Ring"Eval e1 rs)("
	Ring"Eval e2 rs))("Ring"Eval("Ring"BuildExprAux es2)rs)"))
   (pt (string-append 
	RingTimes"("Ring"Eval("Ring"Var nat)rs)("
	Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (assume "r" "es" "ees" "IH")
  (ng)
  (cases)
  (ng)
  (cases (pt (string-append "(Nil "Ring"expr)=es")))
  (assume "ifcase")
  (ng)
  (simp "IH")
  (simp "IH")
  (ng)
  (simp "<-" "ifcase")
  (simp-with
   RingAddAssoc
   (pt Unum)
   (pt (string-append
	RingTimes"(r)("Ring"Eval("Ring"BuildExprAux(Nil "Ring"expr))rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (ng)
  (simp-with RingTimesComm
	     (pt "r")
	     (pt Unum))
  (simp-with RingTimesNeutral
	     (pt "r"))
  (search)
  ;(strip)
  ;(ng)
  (search)
  (cases)
  ;(assume "nat" "es2")
  ;(ng)
  (search)
  (assume "r2" "es2")
  (ng)
  (cases (pt "es2=es"))
  (assume "es2=es")
  (ng)
  (simp "IH")
  (ng)
  (simp "IH")
  (ng)
  (simp-with 
   RingAddAssoc
   (pt (string-append
	RingTimes"(r2)("Ring"Eval("Ring"BuildExprAux es2)rs)"))
   (pt (string-append
	RingTimes"(r)("Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  ;(ng)
  (simp-with 
   "DistrTwo"
   (pt "r2")
   (pt "r")
   (pt (string-append Ring"Eval("Ring"BuildExprAux es2)rs")))
  (ng)
  (simp "es2=es")
  (search)
  ;(ng)
  ;(strip)
  ;(ng)
  (search)
  ;(assume "e" "f" "es2")
  (search)
  ;(assume "e" "f" "es2")
  (search)
  (assume "e1" "e2" "es" "ees" "IH")
  (cases)
  (ng)
  (simp-with
   RingAddAssoc
   (pt Unum)
   (pt (string-append 
	RingTimes"("RingAdd"("Ring"Eval e1 rs)("
	Ring"Eval e2 rs))("Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (cases)
  (assume "nat" "es2")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append
	RingTimes"("Ring"Eval("Ring"Var nat)rs)("
	Ring"Eval("Ring"BuildExprAux es2)rs)"))
   (pt (string-append
	RingTimes"("RingAdd"("Ring"Eval e1 rs)("
	Ring"Eval e2 rs))("Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append 
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (assume "r" "es2")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append
	RingTimes"(r)("Ring"Eval("Ring"BuildExprAux es2)rs)"))
   (pt (string-append
	RingTimes"("RingAdd"("Ring"Eval e1 rs)("
	Ring"Eval e2 rs))("Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append 
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (assume "e3" "e4" "es2")
  (simp "IH")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append
	RingTimes"("RingAdd"("Ring"Eval e3 rs)("Ring"Eval e4 rs))("
	Ring"Eval("Ring"BuildExprAux es2)rs)"))
   (pt (string-append
	RingTimes"("RingAdd"("Ring"Eval e1 rs)("Ring"Eval e2 rs))("
	Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (assume "e3" "e4" "es2")
  (simp "IH")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append
	RingTimes"("RingTimes"("Ring"Eval e3 rs)("
	Ring"Eval e4 rs))("Ring"Eval("Ring"BuildExprAux es2)rs)"))
   (pt (string-append
	RingTimes"("RingAdd"("Ring"Eval e1 rs)("
	Ring"Eval e2 rs))("Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (assume "e1" "e2" "es" "ees" "IH")
  (cases)
  (ng)
  (simp-with
   RingAddAssoc
   (pt Unum)
   (pt (string-append
	RingTimes"("RingTimes"("Ring"Eval e1 rs)("
	Ring"Eval e2 rs))("Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (cases)
  (assume "nat" "es2")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append
	RingTimes"("Ring"Eval("Ring"Var nat)rs)("
	Ring"Eval("Ring"BuildExprAux es2)rs)"))
   (pt (string-append
	RingTimes"("RingTimes"("Ring"Eval e1 rs)("
	Ring"Eval e2 rs))("Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (assume "r" "es2")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append
	RingTimes"(r)("Ring"Eval("Ring"BuildExprAux es2)rs)"))
   (pt (string-append
	RingTimes"("RingTimes"("Ring"Eval e1 rs)("
	Ring"Eval e2 rs))("Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (assume "e3" "e4" "es2")
  (simp "IH")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append
	RingTimes"("RingAdd"("Ring"Eval e3 rs)("
	Ring"Eval e4 rs))("Ring"Eval("Ring"BuildExprAux es2)rs)"))
   (pt (string-append
	RingTimes"("RingTimes"("Ring"Eval e1 rs)("
	Ring"Eval e2 rs))("Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  (assume "e3" "e4" "es2")
  (simp "IH")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append
	RingTimes"("RingTimes"("Ring"Eval e3 rs)("
	Ring"Eval e4 rs))("Ring"Eval("Ring"BuildExprAux es2)rs)"))
   (pt (string-append 
	RingTimes"("RingTimes"("Ring"Eval e1 rs)("
	Ring"Eval e2 rs))("Ring"Eval("Ring"BuildExprAux es)rs)"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo ees))rs")))
  (search)
  ; Proof finished.
  (arw (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo(es::ees)))rs")
       (string-append
	RingAdd"("Ring"Eval("Ring"BuildExprAux(es))rs)("
	Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo(ees)))rs)"))
  
  
  (sg "all rs,ees."Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo(ees)))rs
                  = "Ring"Eval("Ring"BuildExpr(ees))rs")
  (assume "rs")
  (ind)
  ;(ng)
  (search)
  (cases)
  (assume "ees" "IH")
  (ng)
  (simp "IH")
  (search)
  (assume "e" "es" "ees" "IH")
  (ng)
  (simp "IH")
  (search)
  ; Proof finished.
  (arw 
   (string-append Ring"Eval("Ring"BuildExpr("Ring"SimpConstTwo(ees)))rs")
   (string-append Ring"Eval("Ring"BuildExpr(ees))rs"))
  
  
  (sg "all rs,ees,es."
      Ring"Eval("Ring"BuildExpr((SortListInsert list "
      Ring"expr)((OrderList "Ring"expr) "
      Ring"POExprTwo) es ees))rs = "
      Ring"Eval("Ring"BuildExpr(es::ees))rs")
  (assume "rs")
  (ind)
  ;(ng)
  (search)
  ;(ng)
  (assume "es" "ees" "IH" "es2")
  (ng)
  (cases (pt (string-append
	      "((OrderList "Ring"expr)"Ring"POExprTwo es2 es)")))
  ;(strip)
  ;(ng)
  (search)
  (strip)
  (ng)
  (simp "IH")
  (ng)
  (simp-with
   RingAddAssoc
   (pt (string-append
	Ring"Eval("Ring"BuildExprAux es)rs"))
   (pt (string-append
	Ring"Eval("Ring"BuildExprAux es2)rs"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr ees)rs")))
  (simp-with
   RingAddComm
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es2)rs")))
  (search)
  ; Proof finished.
  (arw (string-append
	Ring"Eval("Ring"BuildExpr((SortListInsert list "
	Ring"expr)((OrderList "Ring"expr) "Ring"POExprTwo) es ees))rs")
       (string-append Ring"Eval("Ring"BuildExpr(es::ees))rs"))

  
  (sg "all rs,ees."
      Ring"Eval("Ring"BuildExpr((SortList list "
      Ring"expr)((OrderList "Ring"expr) "Ring"POExprTwo)ees))rs
      = "Ring"Eval("Ring"BuildExpr(ees))rs")
  (assume "rs")
  (ind)
  ;(ng)
  (search)
  (assume "es" "ees" "IH")
  (ng)
  (simp "IH")
  (search)
  ; Proof finished.
  (arw (string-append
	Ring"Eval("Ring"BuildExpr((SortList list "
	Ring"expr)((OrderList "Ring"expr) "Ring"POExprTwo)ees))rs")
       (string-append Ring"Eval("Ring"BuildExpr(ees))rs"))


  (sg "all rs,ees."
      Ring"Eval("Ring"BuildExpr("Ring"SortExpr ees))rs
       = "Ring"Eval("Ring"BuildExpr(ees))rs")
  (assume "rs")
  (cases)
  ;(ng)
  (search)
  (search)
  ; Proof finished.
  (arw (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SortExpr ees))rs")
       (string-append Ring"Eval("Ring"BuildExpr(ees))rs"))


  (sg "all rs,es,e."
      Ring"Eval("Ring"BuildExprAux("Ring"SimpConstAux(e::es)))rs
      = "RingTimes" ("Ring"Eval(e)rs) ("
      Ring"Eval("Ring"BuildExprAux es)rs)")
  (assume "rs")
  (ind)
  (cases)
  (assume "nat")
  (ng)
  (simp-with RingTimesComm
	     (pt (string-append Ring"Eval("Ring"Var nat)rs"))
	     (pt Unum))
  (search)
  (assume "r")
  (ng)
  (simp-with RingTimesComm
	     (pt "r")
	     (pt Unum))
  (simp-with RingTimesNeutral
	     (pt "r"))
  (search)
  (assume "e1" "e2")
  (ng)
  (simp-with 
   RingTimesComm
   (pt (string-append RingAdd" ("Ring"Eval e1 rs) ("Ring"Eval e2 rs)"))
   (pt Unum))
  (search)
  (assume "e1" "e2")
  (ng)
  (simp-with
   RingTimesComm
   (pt (string-append RingTimes" ("Ring"Eval e1 rs) ("Ring"Eval e2 rs)"))
   (pt Unum))
  (search)
  (ng)
  (cases)
  (assume "nat" "es" "IH")
  (cases)
  (assume "nat2")
  (ng)
  (simp-with RingTimesAssoc
	     (pt (string-append Ring"Eval("Ring"Var nat2)rs"))
	     (pt (string-append Ring"Eval("Ring"Var nat)rs"))
	     (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  (simp-with RingTimesNeutral
	     (pt (string-append Ring"Eval("Ring"Var nat2)rs")))
  (search)
  ;(ng)
  (assume "r")
  (ng)
  (simp-with
   RingTimesAssoc
   (pt "r")
   (pt (string-append Ring"Eval("Ring"Var nat)rs"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  (search)
  (assume "e1" "e2")
  (ng)
  (simp-with
   RingTimesAssoc
   (pt (string-append RingAdd"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval("Ring"Var nat)rs"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  ;(ng)
  (simp-with 
   RingTimesNeutral
   (pt (string-append RingAdd" ("Ring"Eval e1 rs) ("Ring"Eval e2 rs)")))
  (search)
  (assume "e1" "e2")
  (ng)
  (simp-with
   RingTimesAssoc
   (pt (string-append RingTimes"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval("Ring"Var nat)rs"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  ;(ng)
  (simp-with
   RingTimesNeutral
   (pt (string-append RingTimes"("Ring"Eval e1 rs)("Ring"Eval e2 rs)")))
  (search)
  (assume "r" "es" "IH")
  (cases)
  (assume "nat")
  (ng)
  (simp-with
   RingTimesAssoc
   (pt (string-append Ring"Eval("Ring"Var nat)rs"))
   (pt "r")
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  ;(ng)
  (simp-with
   RingTimesNeutral
   (pt (string-append Ring"Eval("Ring"Var nat)rs")))
  (search)
  (assume "r2")
  (ng)
  (simp "IH")
  (ng)
  (simp-with
   RingTimesAssoc
   (pt "r2")
   (pt "r")
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  (search)
  (assume "e1" "e2")
  (ng)
  (simp-with
   RingTimesAssoc
   (pt (string-append RingAdd"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt "r")
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  ;(ng)
  (simp-with
   RingTimesNeutral
   (pt (string-append RingAdd" ("Ring"Eval e1 rs) ("Ring"Eval e2 rs)")))
  (search)
  (assume "e1" "e2")
  (ng)
  (simp-with
   RingTimesAssoc
   (pt (string-append RingTimes"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt "r")
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  ;(ng)
  (simp-with
   RingTimesNeutral
   (pt (string-append RingTimes"("Ring"Eval e1 rs)("Ring"Eval e2 rs)")))
  (search)
  (assume "e1" "e2" "es" "IH")
  (cases)
  (assume "nat")
  (ng)
  (simp-with
   RingTimesAssoc
   (pt (string-append Ring"Eval("Ring"Var nat)rs"))
   (pt (string-append RingAdd"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  ;(ng)
  (simp-with RingTimesNeutral
	     (pt (string-append Ring"Eval("Ring"Var nat)rs")))
  (search)
  (assume "r")
  (ng)
  (simp-with
   RingTimesAssoc
   (pt "r")
   (pt (string-append RingAdd"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  (search)
  (assume "e3" "e4")
  (ng)
  (simp-with
   RingTimesAssoc
   (pt (string-append RingAdd"("Ring"Eval e3 rs)("Ring"Eval e4 rs)"))
   (pt (string-append RingAdd"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  ;(ng)
  (simp-with
   RingTimesNeutral
   (pt (string-append RingAdd" ("Ring"Eval e3 rs) ("Ring"Eval e4 rs)")))
  (search)
  (assume "e3" "e4")
  (ng)
  (simp-with
   RingTimesAssoc
   (pt (string-append RingTimes"("Ring"Eval e3 rs)("Ring"Eval e4 rs)"))
   (pt (string-append RingAdd"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  ;(ng)
  (simp-with
   RingTimesNeutral
   (pt (string-append RingTimes"("Ring"Eval e3 rs)("Ring"Eval e4 rs)")))
  (search)
  (assume "e1" "e2" "es" "IH")
  (cases)
  (assume "nat")
  (ng)
  (simp-with
   RingTimesNeutral
   (pt (string-append Ring"Eval("Ring"Var nat)rs")))
  (simp-with
   RingTimesAssoc
   (pt (string-append Ring"Eval("Ring"Var nat)rs"))
   (pt (string-append Ring"Eval e1 rs"))
   (pt (string-append Ring"Eval e2 rs")))
  (simp-with
   RingTimesAssoc
   (pt (string-append Ring"Eval("Ring"Var nat)rs"))
   (pt (string-append RingTimes"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  (simp-with
   RingTimesAssoc
   (pt (string-append Ring"Eval("Ring"Var nat)rs"))
   (pt (string-append Ring"Eval e1 rs"))
   (pt (string-append Ring"Eval e2 rs")))
  (search)
  (assume "r")
  (ng)
  (simp-with
   RingTimesAssoc
   (pt "r")
   (pt (string-append Ring"Eval e1 rs"))
   (pt (string-append Ring"Eval e2 rs")))
  (simp-with
   RingTimesAssoc
   (pt "r")
   (pt (string-append RingTimes"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  (simp-with
   RingTimesAssoc
   (pt "r")
   (pt (string-append Ring"Eval e1 rs"))
   (pt (string-append Ring"Eval e2 rs")))
  (search)
  (assume "e3" "e4")
  (ng)
  (simp-with
   RingTimesNeutral
   (pt (string-append RingAdd" ("Ring"Eval e3 rs) ("Ring"Eval e4 rs)")))
  (simp-with
   RingTimesAssoc
   (pt (string-append RingAdd"("Ring"Eval e3 rs)("Ring"Eval e4 rs)"))
   (pt (string-append Ring"Eval e1 rs"))
   (pt (string-append Ring"Eval e2 rs")))
  (simp-with
   RingTimesAssoc
   (pt (string-append RingAdd"("Ring"Eval e3 rs)("Ring"Eval e4 rs)"))
   (pt (string-append RingTimes"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  ;(ng)
  (simp-with
   RingTimesAssoc
   (pt (string-append RingAdd"("Ring"Eval e3 rs)("Ring"Eval e4 rs)"))
   (pt (string-append Ring"Eval e1 rs"))
   (pt (string-append Ring"Eval e2 rs")))
  (search)
  (assume "e3" "e4")
  (ng)
  (simp-with
   RingTimesNeutral
   (pt (string-append RingTimes"("Ring"Eval e3 rs)("Ring"Eval e4 rs)")))
  (simp-with
   RingTimesAssoc
   (pt (string-append RingTimes"("Ring"Eval e3 rs)("Ring"Eval e4 rs)"))
   (pt (string-append RingTimes"("Ring"Eval e1 rs)("Ring"Eval e2 rs)"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  (search)
  ; Proof finished.
  (arw (string-append
	Ring"Eval("Ring"BuildExprAux("Ring"SimpConstAux(e::es)))rs")
       (string-append
	RingTimes" ("Ring"Eval(e)rs) ("Ring"Eval("Ring"BuildExprAux es)rs)"))
  

  (sg "all rs,es."Ring"Eval("Ring"BuildExprAux("Ring"SimpConstAux es))rs
                  = "Ring"Eval("Ring"BuildExprAux es)rs")
  (assume "rs")
  (ind)
  (search)
  ;(ng)
  (search)
  ; Proof finished.
  (arw (string-append
	Ring"Eval("Ring"BuildExprAux("Ring"SimpConstAux es))rs")
       (string-append
	Ring"Eval("Ring"BuildExprAux es)rs"))
  

  (sg "all rs,ees ."Ring"Eval("Ring"BuildExpr("Ring"SimpConst(ees)))rs
                  = "Ring"Eval("Ring"BuildExpr ees)rs")
  (assume "rs")
  (ind)
  (search)
  (assume "es" "ees" "IH")
  (ng)
  (simp "IH")
  (search)
  ; Proof finished.
  (arw (string-append Ring"Eval("Ring"BuildExpr("Ring"SimpConst(ees)))rs")
       (string-append Ring"Eval("Ring"BuildExpr ees)rs"))


  (sg "all rs,ees2,ees1.
            "Ring"Eval("Ring"BuildExpr("Ring"SortExprAux(ees1:+:ees2)))rs
             = "RingAdd" ("Ring"Eval("Ring"BuildExpr
             ("Ring"SortExprAux(ees1)))rs)
              ("Ring"Eval("Ring"BuildExpr
             ("Ring"SortExprAux(ees2)))rs)")
  (assume "rs" "ees2")
  (ind)
  (ng)
  (simp-with
   RingAddNeutral
   (pt (string-append 
	Ring"Eval("Ring"BuildExpr("
	Ring"SimpConst("Ring"SortExprAux ees2)))rs")))
  (search)
  (cases)
  (assume "ees" "IH")
  (ng)
  (simp "IH")
  (simp-with
   RingAddAssoc
   (pt Unum)
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SortExprAux ees))rs"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SortExprAux ees2))rs")))
  (search)
  (assume "e" "es" "ees" "IH")
  (ng)
  (simp "IH")
  (simp-with
   RingAddAssoc
   (pt (string-append 
	Ring"Eval("Ring"BuildExprAux((SortListInsert "
	Ring"expr)"Ring"POExpr e ((SortList "
	Ring"expr)"Ring"POExpr es)))rs"))
   (pt (string-append
	Ring"Eval("Ring"BuildExpr("Ring"SortExprAux ees))rs"))
   (pt (string-append 
	Ring"Eval("Ring"BuildExpr("Ring"SortExprAux ees2))rs")))
  (search)
  ; Proof finshed.
  (arw (string-append Ring"Eval("Ring"BuildExpr
             ("Ring"SortExprAux(ees1:+:ees2)))rs")
       (string-append RingAdd" ("Ring"Eval("Ring"BuildExpr
             ("Ring"SortExprAux(ees1)))rs)
              ("Ring"Eval("Ring"BuildExpr
             ("Ring"SortExprAux(ees2)))rs)"))


  (sg "all rs,es ,e . "
      Ring"Eval("Ring"BuildExprAux(
	(SortListInsert "Ring"expr)"Ring"POExpr e es))rs
         = "Ring"Eval("Ring"BuildExprAux(e::es))rs")
  (assume "rs")
  (ind)
  ;(ng)
  (assume "e")
  (ng)
  (simp-with RingTimesComm
	     (pt (string-append Ring"Eval e rs"))
	     (pt Unum))
  (simp-with RingTimesNeutral
	     (pt (string-append Ring"Eval e rs")))
  (search)
  (assume "e" "es" "IH" "e2")
  (ng)
  (cases (pt (string-append Ring"POExpr e2 e")))
  (strip)
  ;(ng)
  (search)
  (strip)
  (ng)
  (simp "IH")
  (simp-with
   RingTimesAssoc
   (pt (string-append Ring"Eval e rs"))
   (pt (string-append Ring"Eval e2 rs"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux es)rs")))
  (simp-with RingTimesComm (pt (string-append Ring"Eval e rs"))
	     (pt (string-append Ring"Eval e2 rs")))
  (search)
  ; Proof finished.
  (arw (string-append Ring"Eval("Ring"BuildExprAux(
	(SortListInsert "Ring"expr)"Ring"POExpr e es))rs")
       (string-append Ring"Eval("Ring"BuildExprAux(e::es))rs"))


  (sg "all rs,es2,es1 . "
      Ring"Eval("Ring"BuildExprAux(
	(SortList "Ring"expr)"Ring"POExpr (es1:+:es2)))rs
         = "RingTimes" ("Ring"Eval("Ring"BuildExprAux((SortList "
	 Ring"expr)"Ring"POExpr (es1)))rs)
            ("Ring"Eval("Ring"BuildExprAux((SortList "
	    Ring"expr)"Ring"POExpr (es2)))rs)")
  (assume "rs" "es2")
  (ind)
  (ng)
  (simp-with
   RingTimesNeutral
   (pt (string-append Ring"Eval("Ring"BuildExprAux((SortList "
		      Ring"expr)"Ring"POExpr es2))rs")))
  (search)
  ;(ng)
  (assume "e" "es" "IH")
  (ng)
  (simp "IH")
  (simp-with
   RingTimesAssoc
   (pt (string-append Ring"Eval e rs"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux((SortList "
		      Ring"expr)"Ring"POExpr es))rs"))
   (pt (string-append Ring"Eval("Ring"BuildExprAux((SortList "
		      Ring"expr)"Ring"POExpr es2))rs")))
  (search)
  ; Proof finished.
  (arw (string-append Ring"Eval("Ring"BuildExprAux(
	(SortList "Ring"expr)"Ring"POExpr (es1:+:es2)))rs")
       (string-append RingTimes" ("Ring"Eval("
		      Ring"BuildExprAux((SortList "Ring"expr)"
		      Ring"POExpr (es1)))rs)
            ("Ring"Eval("Ring"BuildExprAux((SortList "
	    Ring"expr)"Ring"POExpr (es2)))rs)"))

  

  (sg "all rs,e. "
      Ring"Eval("Ring"BuildExprAux((SortList "
      Ring"expr)"Ring"POExpr("Ring"LinearExprAux e)))rs
             = "Ring"Eval(e)rs")
  (assume "rs")
  (ind)
  (search)
  ;(ng)
  (search)
  (search)
  (assume "e1" "e2" "IH1" "IH2")
  (ng)
  (simp "IH1")
  (simp "IH2")
  (search)
  ; Proof finished.
  (arw (string-append
	Ring"Eval("Ring"BuildExprAux((SortList "
	Ring"expr)"Ring"POExpr("Ring"LinearExprAux e)))rs")
       (string-append Ring"Eval(e)rs"))


  (sg "all rs,e. "
      Ring"Eval("Ring"BuildExpr("
      Ring"SortExprAux
            ("Ring"LinearExpr(e))))rs
            = "Ring"Eval(e)rs")
  (assume "rs")
  (ind)
  (search)
  (search)
  (assume "e1" "e2" "IH1" "IH2")
  (ng)
  (simp "IH1")
  (simp "IH2")
  (search)
  (search)
  ; Proof finished.
  (arw (string-append Ring"Eval("Ring"BuildExpr("
		      Ring"SortExprAux
            ("Ring"LinearExpr(e))))rs")
       (string-append Ring"Eval(e)rs"))


  ; Theorem EvalSortEqual
  (sg
   (string-append "all list "Ring","Ring"expr. 
           Equal("Ring"Eval("Ring"BuildExpr("
	   Ring"SimpConstTwo("Ring"SortExpr("
	   Ring"SimpConst("Ring"SortExprAux("
	   Ring"LinearExpr("Ring"Dist "Ring"expr("Ring"Ht "
	   Ring"expr))))))))list "Ring")("
	   Ring"Eval "Ring"expr list "Ring")"))
  (assume (string-append "list "Ring) (string-append Ring"expr"))
  (use-with "Eq-Refl" (py Ring)
	    (pt (string-append "("Ring"Eval "Ring"expr list "Ring")")))
  ;Proof finished.
  (save (string-append Ring"EvalSortEqual"))


)


(define (EvalSortEqual-proof ns expr Ring)
  (mk-proof-in-elim-form
   (make-proof-in-aconst-form 
    (theorem-name-to-aconst 
     (string-append Ring"EvalSortEqual")))
   ns expr))
  

; performs the translation of term of type ring
; into the algebra expr

(define (term-and-env-to-linarith-expr-and-env
	 term
	 env Ring
	 RingAdd RingTimes)
  (if (not (equal? (py Ring) (term-to-type term)))
      (myerror "term-and-env-to-linarith-expr-and-env"
	       "term of type "Ring" expected" term))
  (cond
   ((or (term-in-const-form? term)
	(is-numeric-term? term)
	(is-int-numeric-term? term)
	(is-pos-numeric-term? term)
	(is-numeric-term-in-nat? term))
    (list (mk-term-in-app-form
	   (pt (string-append Ring"Const")) term) env))
   ((and (term-in-app-form? term)
	 (term-in-const-form?
	  (term-in-app-form-to-final-op term))
	 (string=? RingAdd 
		   (const-to-name
		    (term-in-const-form-to-const
		     (term-in-app-form-to-final-op term))))
	 (= 2 (length (term-in-app-form-to-args term))))
    (let* ((args (term-in-app-form-to-args term))
	   (arg1 (car args))
	   (arg2 (cadr args))
	   (prev1 
	    (term-and-env-to-linarith-expr-and-env
	     arg1 env
	     Ring RingAdd RingTimes))
	   (expr1 (car prev1))
	   (env1 (cadr prev1))
	   (prev2 
	    (term-and-env-to-linarith-expr-and-env
	     arg2 env1
	     Ring RingAdd RingTimes))
	   (expr2 (car prev2))
	   (env2 (cadr prev2)))
      (list (mk-term-in-app-form
	     (pt (string-append Ring"Add"))
	     expr1 expr2) env2)))
   ((and (term-in-app-form? term)
	 (term-in-const-form?
	  (term-in-app-form-to-final-op term))
	 (string=?
	  RingTimes (const-to-name
		     (term-in-const-form-to-const
		      (term-in-app-form-to-final-op term))))
	 (= 2 (length (term-in-app-form-to-args term))))
    (let* ((args (term-in-app-form-to-args term))
	   (arg1 (car args))
	   (arg2 (cadr args))
	   (prev1 
	    (term-and-env-to-linarith-expr-and-env
	     arg1 env
	     Ring RingAdd RingTimes))
	   (expr1 (car prev1))
	   (env1 (cadr prev1))
	   (prev2
	    (term-and-env-to-linarith-expr-and-env
	     arg2 env1
	     Ring RingAdd RingTimes))
	   (expr2 (car prev2))
	   (env2 (cadr prev2)))
      (list (mk-term-in-app-form
	     (pt (string-append Ring"Mult"))
	     expr1 expr2) env2)))
   (else
    (let ((info (assoc-wrt term=? term env)))
      (if info
	  (list (make-term-in-app-form
		 (pt (string-append Ring"Var")) 
		 (make-numeric-term-in-nat (cadr info)))
		env)
	  (let* ((i (length env))
		 (var-expr
		  (make-term-in-app-form
		   (pt (string-append Ring"Var"))
		   (make-numeric-term-in-nat i))))
	    (list var-expr (append env
				   (list (list term i))))))))))

(define (term-to-linarith-expr-and-env
	 term Ring RingAdd RingTimes)
  (term-and-env-to-linarith-expr-and-env
   term '() Ring RingAdd RingTimes))

(define (terms-to-list-term Ring RingAdd RingTimes terms)
    (if (null? terms)
        (pt (string-append "(Nil "Ring")"))
        (mk-term-in-app-form
         (make-term-in-const-form
          (let* ((constr (constr-name-to-constr "Cons"))
                 (tvars (const-to-tvars constr))
                 (subst (make-substitution tvars 
					   (list (py Ring)))))
            (const-substitute constr subst #f)))
         (car terms)
         (terms-to-list-term 
	  Ring RingAdd RingTimes (cdr terms)))))

; (=-to-eq-proof term1 term2) returns a proof of
; term1=term2 -> term1≈term2

(define (=-to-eq-proof term1 term2)
  (mk-proof-in-elim-form
   (make-proof-in-aconst-form
    (finalg-to-=-to-eq-aconst (term-to-type term1)))
   term1 term2))

; (sort-term term) returns a term which has been sorted
; via the detour of the algebra expr

(define (sort-term term Ring RingAdd RingTimes)
  (if (not(term-in-app-form? term)) term
      (let* ((const-term (term-in-app-form-to-final-op term))
	     (args (term-in-app-form-to-args term))
	     (arg1 (car args))
	     (arg2 (cadr args))
	     (type1 (term-to-type arg1))
	     (type2 (term-to-type arg2)))
	(cond ((and  (equal? type1 (py "boole"))
		     (equal? type2 (py "boole")))
	       (mk-term-in-app-form
		const-term
		(sort-term arg1 Ring RingAdd RingTimes)
		(sort-term arg2 Ring RingAdd RingTimes)))
	      ((and (equal? type1 (py Ring))
		    (equal? type2 (py Ring)))
	       (let* ((e1-and-env1
		       (term-to-linarith-expr-and-env 
			arg1
			Ring RingAdd RingTimes))
		      (e2-and-env2
		       (term-and-env-to-linarith-expr-and-env
			arg2
			(cadr e1-and-env1)
			Ring RingAdd RingTimes))
		      (ns
                       (terms-to-list-term 
			Ring RingAdd RingTimes
                        (map car(cadr e2-and-env2))))
		      (vse1
		       (nt(mk-term-in-app-form
			   (pt (string-append Ring"Eval"))
			   (nt(make-term-in-app-form
			       (pt
				(string-append
				 Ring"NormalizeAndSortExpr"))
			       (car e1-and-env1)))
			   ns)))
		      (vse2
		       (nt(mk-term-in-app-form
			   (pt (string-append Ring"Eval"))
			   (nt(make-term-in-app-form
			       (pt
				(string-append
				 Ring"NormalizeAndSortExpr"))
			       (car e2-and-env2)))
			   ns))))
		 (mk-term-in-app-form const-term vse1 vse2)))
	      (else
	       (myerror "sort-term"
			"Other types not implemented !"))))))


(define (no-further-simp-possible
	 goalterm Ring RingAdd RingTimes)
  (let ((sorted-goalterm
	 (sort-term goalterm Ring RingAdd RingTimes)))
    (newline)
    (display-comment "I can not deal with the following:")
    (newline)(pp goalterm)
    (display-comment "which sorts to:")
    (newline)(pp sorted-goalterm)
    (display-comment "and then normalises to:")
    (newline)(pp(nt sorted-goalterm))
    (myerror "Try to prove this term
               by hand and add it as RW-rule.")))


;;    (reflection)

(begin

  (define (reflection Ring)
    (if (not (string? Ring))
	(myerror "reflection"
		 "string expected"))
    (if (not (assoc Ring INITIALISED-RINGS))
	(myerror "reflection"
		 "reflection for "Ring
		 "not initialised"))
    (let* ((info (cadr (assoc Ring INITIALISED-RINGS)))
	   (RingAdd (caddr info))
	   (RingTimes (cadddr info))
	   (goal-form (goal-to-formula(current-goal))))
      (if (not (atom-form? goal-form))
          (myerror "reflection"
		   "atomic goal-formula expected"))
      (let ((goal-term (atom-form-to-kernel goal-form)))
        (cond ((term=? goal-term (pt"False"))
               (myerror "reflection"
                        "Falsum is not provable !!!"))
              (else (reflection-intern
		     goal-term Ring RingAdd RingTimes))))))


  (define (reflection-intern goal-kernel
			     Ring RingAdd RingTimes)
    (let*
        ((num-goals (pproof-state-to-num-goals))
         (proof (pproof-state-to-proof))
         (maxgoal (pproof-state-to-maxgoal))
         (number (num-goal-to-number (car num-goals))))
      (set! PPROOF-STATE
            (apply
             use-intern
             (list num-goals proof maxgoal
                   (reflection-aux-proof 
		    goal-kernel
		    Ring RingAdd RingTimes))))
      (newline)
      (pproof-state-history-push PPROOF-STATE)
      (display-new-goals num-goals number)))


; (reflection-aux-proof gt) returns a proof of gt (hopefully).

  (define (reflection-aux-proof gt Ring RingAdd RingTimes)
    (display-comment "")
    (display-debug "reflection-aux-proof.
             gt: " (term-to-string gt))
    (let ((sgt (sort-term gt Ring RingAdd RingTimes)))
      (cond ((term=? gt (pt"True")) truth-proof)
;             ((term=? sgt gt)
;              (display-comment
;               "WARNING, reflection-aux-proof:
;                       All terms are sorted !")
;              (no-further-simp-possible
; 	      gt Ring RingAdd RingTimes))
; Goal-term is in application form.
            ((term-in-app-form? gt)
             (let* ((args (term-in-app-form-to-args gt))
                    (type1 (term-to-type(car args)))
                    (type2 (term-to-type(cadr args))))
               (cond
; If both arguments are of type nat,
; then use reflection-aux-ring.
                ((and (equal? type1 (py Ring))
                      (equal? type2 (py Ring)))
                 (display-debug
		  (string-append
		   "type1="Ring" and type2="Ring))
                 (reflection-aux-ring
		  gt sgt Ring RingAdd RingTimes))
; If both arguments are of type boole,
; then we decompose the goal-term.
                ((and (equal? type1(py "boole"))
                      (equal? type2(py "boole")))
                 (reflection-aux-boole
		  gt sgt Ring RingAdd RingTimes))
                (else (no-further-simp-possible
		       gt Ring RingAdd RingTimes)))))
            (else (no-further-simp-possible
		   gt Ring RingAdd RingTimes)))))



; (reflection-aux-ring gt sgt) returns proof of gt building a proof of
; (sgt->gt) whereas sgt will be shown by (reflection-aux-proof ).

  (define (reflection-aux-ring goalterm sortedgoalterm
			       Ring RingAdd RingTimes)
    (display-debug "reflection-aux-ring   "
                   "goalterm: " (term-to-string goalterm)
                   "  sortedgoalterm: "
		   (term-to-string sortedgoalterm))
    (let*
        ((const-term (term-in-app-form-to-final-op goalterm))
         (args (term-in-app-form-to-args goalterm))
         (arg1 (car args))
         (arg2 (cadr args))
         (sorted-args
	  (term-in-app-form-to-args sortedgoalterm))
         (vse1 (car  sorted-args))
         (vse2 (cadr sorted-args))
         (e1-and-env1
	  (term-to-linarith-expr-and-env
	   arg1 Ring RingAdd RingTimes))
         (e2-and-env2
          (term-and-env-to-linarith-expr-and-env
	   arg2 (cadr e1-and-env1) Ring RingAdd RingTimes))
         (ns (terms-to-list-term
	      Ring RingAdd RingTimes
	      (map car(cadr e2-and-env2)))))
      (mk-proof-in-elim-form
       (BinaryBooleCompat-proof vse1 arg1 vse2 arg2 const-term)
       (EvalSortEqual-proof ns (car e1-and-env1) Ring)
       (EvalSortEqual-proof ns (car e2-and-env2) Ring))))
       ;(reflection-aux-proof (nt sortedgoalterm)
       ; Ring RingAdd RingTimes))))



; (reflection-aux-boole ) takes care of the goal
; when its arguments are of type boole

  (define (reflection-aux-boole
	   goalterm sortedgoalterm Ring RingAdd RingTimes)
    (display-debug "reflection-aux-boole   "
                   "goalterm: " (term-to-string goalterm)
                   "  sortedgoalterm: "
		   (term-to-string sortedgoalterm))
    (let*
        ((const-term (term-in-app-form-to-final-op goalterm))
         (const-is-equal
          (string=?
           "=" (const-to-name
		(term-in-const-form-to-const const-term))))
         (args (term-in-app-form-to-args goalterm))
         (arg1 (car args))
         (arg2 (cadr args))
         (sorted-args (term-in-app-form-to-args sortedgoalterm))
         (vse1 (car  sorted-args))
         (vse2 (cadr sorted-args)))
      (cond
; Goal is of form True=boole :  Use BooleTrue 'left
       ((and (term=? arg1 (pt "True")) const-is-equal)
        (BooleTrue-proof
	 'left  arg2
	 (reflection-aux-proof arg2 Ring RingAdd RingTimes)))
; Goal is of form boole=True :  Use BooleTrue 'right
       ((and (term=? arg2 (pt "True"))const-is-equal)
        (BooleTrue-proof
	 'right arg1 
	 (reflection-aux-proof arg1 Ring RingAdd RingTimes)))
; The sorted lhs of goal normalises to True: We only work on the lhs.
       ((and (term=? (nt vse1) (pt"True"))
             (not(term=? (nt arg1) (pt"True"))))
        (reflection-aux-boole-true 
	 'left goalterm
	 Ring RingAdd RingTimes))
; The sorted rhs of goal normalises to True: We only work on the rhs.
       ((and (term=? (nt vse2) (pt"True"))
             (not(term=? (nt arg2) (pt"True"))))
        (reflection-aux-boole-true
	 'right goalterm Ring RingAdd RingTimes))
; The lhs of goal normalises to False
       ((and const-is-equal
             (term=? (nt arg1) (pt"False"))
             (term-in-app-form? arg2))
        (reflection-aux-boole-false
	 'left arg2 Ring RingAdd RingTimes))
; The rhs of goal normalises to False
       ((and const-is-equal
             (term=? (nt arg2) (pt"False"))
             (term-in-app-form? arg1))
        (reflection-aux-boole-false 
	 'right arg1 Ring RingAdd RingTimes))
; Goal is of form f(..)=g(..).
       ((and const-is-equal
             (term-in-app-form? arg1)
             (term-in-app-form? arg2))
        (reflection-aux-boolean-equality 
	 arg1 arg2 Ring RingAdd RingTimes))
; If goal is of form h(f(x,y),g(z,t)) where h is not equality.
       ((not const-is-equal)
        (reflection-aux-composed-boolean-term 
	 goalterm sortedgoalterm Ring RingAdd RingTimes))
       (else (no-further-simp-possible
	      goalterm Ring RingAdd RingTimes)))))



; If one side of the goal normalises to true, then we replace
; that side by true and return the result to (reflection-aux-proof)

  (define (reflection-aux-boole-true 
	   side term Ring RingAdd RingTimes)
    (display-debug "reflection-aux-boole-true   "
                   "  term: "(term-to-string term))
    (let* ((const-term
	    (term-in-app-form-to-final-op term))
           (args (term-in-app-form-to-args term))
           (arg1 (car  args))
           (arg2 (cadr args)))
      (if (equal? side 'left)
          (mk-proof-in-elim-form
           (BinaryBooleCompat-proof
            (pt "True") arg1 arg2 arg2 const-term)
           (mk-proof-in-elim-form
            (=-to-eq-proof (pt"True") arg1)  
            (reflection-aux-proof
	     (nt(make-=-term (pt"True") arg1))
	     Ring RingAdd RingTimes))
           (mk-proof-in-elim-form
	    (=-to-eq-proof arg2 arg2)truth-proof)
           (reflection-aux-proof
            (nt (mk-term-in-app-form
		 const-term (pt"True") arg2))
	    Ring RingAdd RingTimes))
          (mk-proof-in-elim-form
           (BinaryBooleCompat-proof
            arg1 arg1 (pt "True") arg2 const-term)
           (mk-proof-in-elim-form
	    (=-to-eq-proof arg1 arg1)truth-proof)
           (mk-proof-in-elim-form
            (=-to-eq-proof (pt"True") arg2)
            (reflection-aux-proof
	     (nt(make-=-term (pt"True") arg2))
	     Ring RingAdd RingTimes))
           (reflection-aux-proof
            (nt(mk-term-in-app-form
		const-term arg1 (pt"True"))) 
	    Ring RingAdd RingTimes)))))



; (reflection-aux-boole-false ) uses ¬(n<=k)=(k<n) and ¬(n<k)=(k<=n)

  (define (reflection-aux-boole-false 
	   side term Ring RingAdd RingTimes)
    (display-debug "reflection-aux-boole-false   "
                   "  term: "(term-to-string term))
    (let* ((const-string
            (term-to-string
	     (term-in-app-form-to-final-op term)))
           (args (term-in-app-form-to-args term))
           (arg1 (car  args))
           (arg2 (cadr args)))
      (cond ((string=? const-string "NatLt")
             (natNotLt-proof
              side arg1 arg2
              (reflection-aux-proof
               (nt(mk-term-in-app-form
		   (pt "NatLe") arg2 arg1))
	       Ring RingAdd RingTimes)))
            ((string=? const-string "NatLe")
             (natNotLe-proof
              side arg1 arg2
              (reflection-aux-proof
               (nt(mk-term-in-app-form
		   (pt "NatLt") arg2 arg1))
	       Ring RingAdd RingTimes)))
            (else no-further-simp-possible
		  goalterm Ring RingAdd RingTimes))))


; (reflection-aux-boolean-equality ) applies BinaryBooleFunctional
; if the lhs and rhs of goal have the same constant.

  (define (reflection-aux-boolean-equality
	   arg1 arg2 Ring RingAdd RingTimes)
    (display-debug "reflection-aux-boolean-equality   "
                   "  arg1: "(term-to-string arg1)
                   "  arg2: "(term-to-string arg2))
    (let ((const-term1 (term-in-app-form-to-final-op arg1))
          (const-term2 (term-in-app-form-to-final-op arg2)))
      (cond
; If f=g, then use BinaryBooleFunctional
       ((const=?
         (term-in-const-form-to-const const-term1)
         (term-in-const-form-to-const const-term2))
        (let* ((arg1s (term-in-app-form-to-args arg1))
               (arg2s (term-in-app-form-to-args arg2))
               (arg11 (car  arg1s))
               (arg12 (cadr arg1s))
               (arg21 (car  arg2s))
               (arg22 (cadr arg2s))
               (arg21=arg11-term (nt(make-=-term arg21 arg11)))
               (arg22=arg12-term (nt(make-=-term arg22 arg12)))
               (arg21-equal-arg11-proof
                (mk-proof-in-elim-form
                 (=-to-eq-proof arg21 arg11)
                 (reflection-aux-proof
		  arg21=arg11-term Ring RingAdd RingTimes)))
               (arg22-equal-arg12-proof
                (mk-proof-in-elim-form
                 (=-to-eq-proof arg22 arg12)
                 (reflection-aux-proof
		  arg22=arg12-term Ring RingAdd RingTimes))))
          (display-debug "BinaryBooleFunctional-proof")
          (mk-proof-in-elim-form
           (BinaryBooleFunctional-proof
            arg21 arg11 arg22 arg12 const-term1)
           arg21-equal-arg11-proof arg22-equal-arg12-proof)))
       (else
        (reflection-aux-composed-boolean-term 
         (nt(make-=-term arg1 arg2))
         (sort-term(nt(make-=-term arg1 arg2))
		   Ring RingAdd RingTimes)
	 Ring RingAdd RingTimes)
        ))))


; (reflection-aux-composed-boolean-term ) takse care of goal
; if it is not a boolean equality, i.e. h(x,y) with h ≠ =

  (define (reflection-aux-composed-boolean-term
	   goalterm sortedgoalterm Ring RingAdd RingTimes)
    (display-debug "reflection-aux-composed-boolean-term    "
                   "goalterm: " (term-to-string goalterm)
                   "  sortedgoalterm: " 
		   (term-to-string sortedgoalterm))
    (let* ((const-term (term-in-app-form-to-final-op goalterm))
           (args (term-in-app-form-to-args goalterm))
           (arg1 (car args))
           (arg2 (cadr args))
           (sorted-args
	    (term-in-app-form-to-args sortedgoalterm))
           (vse1 (car  sorted-args))
           (vse2 (cadr sorted-args))
           (vse1=arg1-term (nt(make-=-term vse1 arg1)))
           (vse2=arg2-term (nt(make-=-term vse2 arg2)))
           (vse1-equal-arg1-proof
            (mk-proof-in-elim-form
             (=-to-eq-proof vse1 arg1)
             (reflection-aux-proof
	      vse1=arg1-term Ring RingAdd RingTimes)))
           (vse2-equal-arg2-proof
            (mk-proof-in-elim-form
             (=-to-eq-proof vse2 arg2)
             (reflection-aux-proof
	      vse2=arg2-term Ring RingAdd RingTimes))))
      (mk-proof-in-elim-form
       (BinaryBooleCompat-proof vse1 arg1 vse2 arg2 const-term)
       vse1-equal-arg1-proof vse2-equal-arg2-proof
       (reflection-aux-proof
	(nt sortedgoalterm) Ring RingAdd RingTimes))))

) ; matches (begin


(set! COMMENT-FLAG #t)

; SOME EXAMPLES


#|

; NAT

(add-nat-tokens)

(begin
  (aga "NatPlusAssoc" 
       (pf "all nat1,nat2,nat3.(NatPlus nat1 (NatPlus nat2 nat3))
            = (NatPlus (NatPlus nat1 nat2) nat3)"))
  (aga "NatPlusNeutral"
       (pf "all nat.(NatPlus Zero nat) = nat"))
  (aga "NatPlusCommNew"
       (pf "all nat1,nat2.(NatPlus nat1 nat2) = (NatPlus nat2 nat1)"))
  (aga "NatTimesAssoc"
       (pf "all nat1,nat2,nat3.(NatTimes nat1 (NatTimes nat2 nat3))
            = (NatTimes (NatTimes nat1 nat2) nat3)"))
  (aga "NatTimesNeutral" 
       (pf "all nat.(NatTimes (Succ(Zero)) nat) = nat"))
  (aga "NatTimesCommNew" 
       (pf "all nat1,nat2.(NatTimes nat1 nat2) = (NatTimes nat2 nat1)"))
  (aga "NatDistr"  
       (pf "all nat1,nat2,nat3.(NatTimes nat1 (NatPlus nat2 nat3))
            = (NatPlus (NatTimes nat1 nat2) (NatTimes nat1 nat3))"))
  )

(prepare-reflection "nat" "Zero" "Succ(Zero)"
		    "NatPlus" "NatTimes" 
		    "NatPlusAssoc" "NatPlusNeutral" "NatPlusCommNew"
		    "NatTimesAssoc" "NatTimesNeutral" "NatTimesCommNew"
		    "NatDistr")

(sg "nat1 + nat2=nat2 + nat1")
(strip)
(reflection "nat")
(use "Truth-Axiom")
; Proof finished.


; ; INT


(set! COMMENT-FLAG #f)
(libload "numbers.scm")
(set! COMMENT-FLAG #t)

(begin
  (aga "IntPlusAssoc"    (pf "all i1,i2,i3.i1+(i2+i3) = (i1+i2)+i3"))
  (aga "IntPlusNeutral"  (pf "all i.IntZero+i = i"))
  (aga "IntPlusComm"     (pf "all i1,i2.i1+i2 = i2+i1"))  
  (aga "IntTimesAssoc"   (pf "all i1,i2,i3.i1*(i2*i3) = (i1*i2)*i3"))
  (aga "IntTimesNeutral" (pf "all i. (IntPos One)*i = i"))
  (aga "IntTimesComm"    (pf "all i1,i2.i1*i2 = i2*i1"))
  (aga "IntDistr"        (pf "all i1,i2,i3.i1*(i2+i3) = (i1*i2)+(i1*i3)"))
  )

(prepare-reflection "int" "IntZero" "IntPos One"
                    "IntPlus" "IntTimes" 
                    "IntPlusAssoc" "IntPlusNeutral" "IntPlusComm"
                    "IntTimesAssoc" "IntTimesNeutral" "IntTimesComm"
                    "IntDistr")


(sg "i1+i2 = i2+i1")
(strip)
(reflection "int")
(ng)
(use "Truth-Axiom")
; ; Proof finished.

(sg "2*i2+i1*3=3*i1+2*i2")
(strip)
(reflection "int")
(ng)
(use "Truth-Axiom")
; ; Proof finished

; ; with some constants
(sg "3+(181+i2)*i3+2+i1*i3*2+2*i2
     = 2*i2+i3*(171+i2+i1*2)+5+10*i3")
(strip)
(reflection "int")
; ; ok, ?_2 can be obtained from
; ; ?_3: 5+2*i2+181*i3+i2*i3+2*i3*i1=5+2*i2+181*i3+i2*i3+2*i3*i1 from
; ;   i2  i3  i1
(ng)
(use "Truth-Axiom")
; ; Proof finished.


(sg "3+i*4 = i+2+i*3+1")
(strip)
(reflection "int")
(ng)
(use "Truth-Axiom")
; ; Proof finished.


(sg "3+i<i+3+2")
(strip)
(ng)
(reflection "int")
; ; ok, ?_3 can be obtained from
; ; ?_4: 3+i<5+i from
; ;   i


; ; RING

(set! COMMENT-FLAG #f)
(exload "ordinals/ring.scm")
(set! COMMENT-FLAG #t)

(prepare-reflection "ring" "null" "unum" "RingAdd" "RingTimes" 
                    "RingAddAssoc"   "RingAddNeutral"   "RingAddComm"
                    "RingTimesAssoc" "RingTimesNeutral" "RingTimesComm"
                    "Distr1")

; ; RAT


(set! COMMENT-FLAG #f)
(libload "numbers.scm")
(set! COMMENT-FLAG #t)


(begin
  (aga "RatPlusAssoc"
       (pf "all rat1,rat2,rat3.rat1+(rat2+rat3) = (rat1+rat2)+rat3"))
  (aga "RatPlusNeutral"
       (pf "all rat.(IntZero#One)+rat = rat"))
  (aga "RatPlusComm"    
       (pf "all rat1,rat2.rat1+rat2 = rat2+rat1"))  
  (aga "RatTimesAssoc"  
       (pf "all rat1,rat2,rat3.rat1*(rat2*rat3) = (rat1*rat2)*rat3"))
  (aga "RatTimesNeutral"
       (pf "all rat.((IntPos One)#One)*rat = rat"))
  (aga "RatTimesComm"  
       (pf "all rat1,rat2.rat1*rat2 = rat2*rat1"))
  (aga "RatDistr"    
       (pf "all rat1,rat2,rat3.rat1*(rat2+rat3)=(rat1*rat2)+(rat1*rat3)"))
  )

(prepare-reflection
 "rat" "IntZero#One" "(IntPos One)#One"  "RatPlus" "RatTimes" 
 "RatPlusAssoc"   "RatPlusNeutral"  "RatPlusComm"
 "RatTimesAssoc"  "RatTimesNeutral" "RatTimesComm"
 "RatDistr")
|#

(display "End of reflection.scm
")