; $Id: nat.scm 2361 2009-12-10 17:14:49Z schwicht $
(display "loading nat.scm ...") (newline)

; (load "~/minlog/init.scm")
; (set! DOT-NOTATION #f)


(add-alg "nat" '("Zero" "nat") '("Succ" "nat=>nat"))

(define (make-numeric-term-wrt-nat n)
  (if (= n 0)
      (pt "Zero")
      (make-term-in-app-form
       (pt "Succ")
       (make-numeric-term-wrt-nat (- n 1)))))

; The following is in term.scm, because it is used for term-to-expr
; (define (is-numeric-term-wrt-nat? term)
;   (or
;    (and (term-in-const-form? term)
; 	(string=? "Zero" (const-to-name (term-in-const-form-to-const term))))
;    (and (term-in-app-form? term)
; 	(let ((op (term-in-app-form-to-op term)))
; 	  (and (term-in-const-form? op)
; 	       (string=? "Succ" (const-to-name
; 				 (term-in-const-form-to-const op)))
; 	       (is-numeric-term-wrt-nat? (term-in-app-form-to-arg term)))))))

; (define (numeric-term-wrt-nat-to-number term)
;   (if (equal? term (pt "Zero"))
;       0
;       (+ 1 (numeric-term-wrt-nat-to-number (term-in-app-form-to-arg term)))))

; The functions make-numeric-term (used by the parser) and
; is-numeric-term?, numeric-term-to-number (used by term-to-expr and
; token-tree-to-string) take either pos or nat as default.

(define NAT-NUMBERS #t)

(define (make-numeric-term x)
  (if NAT-NUMBERS
      (make-numeric-term-wrt-nat x)
      (make-numeric-term-wrt-pos x)))

(define (is-numeric-term? x)
  (if NAT-NUMBERS
      (is-numeric-term-wrt-nat? x)
      (is-numeric-term-wrt-pos? x)))

(define (numeric-term-to-number x)
  (if NAT-NUMBERS
      (numeric-term-wrt-nat-to-number x)
      (numeric-term-wrt-pos-to-number x)))

; Program constants.

(add-program-constant "NatPlus" (py "nat=>nat=>nat") t-deg-zero)
(add-program-constant "NatTimes" (py "nat=>nat=>nat") t-deg-zero)
(add-program-constant "NatLt" (py "nat=>nat=>boole") t-deg-zero)
(add-program-constant "NatLe" (py "nat=>nat=>boole") t-deg-zero)
(add-program-constant "Pred" (py "nat=>nat") t-deg-zero)
(add-program-constant "NatMinus" (py "nat=>nat=>nat") t-deg-zero)
(add-program-constant "NatMax" (py "nat=>nat=>nat") t-deg-zero)
(add-program-constant "NatMin" (py "nat=>nat=>nat") t-deg-zero)
(add-program-constant "AllBNat" (py "nat=>(nat=>boole)=>boole") t-deg-zero)

; Tokens used by the parser.

(define (add-nat-tokens)
  (let* ((make-type-string
	  (lambda (type op-string type-strings)
	    (let* ((string (type-to-string type))
		   (l (string->list string)))
	      (if (member string type-strings)
		  (list->string (cons (char-upcase (car l)) (cdr l)))
		  (myerror op-string "unexpected type" type)))))
	 (tc ;term-creator
	  (lambda (op-string . type-strings)
	    (lambda (x y)
	      (let* ((type (term-to-type x))
		     (type-string
		      (make-type-string type op-string type-strings))
		     (internal-name (string-append type-string op-string)))
		(mk-term-in-app-form
		 (make-term-in-const-form
		  (pconst-name-to-pconst internal-name))
		 x y))))))
    (add-token "+" 'add-op (tc "Plus" "nat"))
    (add-token "*" 'mul-op (tc "Times" "nat"))
    (add-token "<" 'rel-op (tc "Lt" "nat"))
    (add-token "<=" 'rel-op (tc "Le" "nat"))
    (add-token "--" 'add-op (tc "Minus" "nat"))
    (add-token "max" 'mul-op (tc "Max" "nat"))
    (add-token "min" 'mul-op (tc "Min" "nat"))))

(add-nat-tokens)

; (add-nat-display) updates DISPLAY-FUNCTIONS, so that it uses the
; tokens introduced by (add-nat-tokens).

(define (add-nat-display)
  (let ((dc ;display-creator
	 (lambda (name display-string token-type)
	   (lambda (x)
	     (let ((op (term-in-app-form-to-final-op x))
		   (args (term-in-app-form-to-args x)))
	       (if (and (term-in-const-form? op)
			(string=? name (const-to-name
					(term-in-const-form-to-const op)))
			(= 2 (length args)))
		   (list token-type display-string
			 (term-to-token-tree (term-to-original (car args)))
			 (term-to-token-tree (term-to-original (cadr args))))
		   #f))))))
    (add-display (py "nat") (dc "NatPlus" "+" 'add-op))
    (add-display (py "nat") (dc "NatTimes" "*" 'mul-op))
    (add-display (py "boole") (dc "NatLt" "<" 'rel-op))
    (add-display (py "boole") (dc "NatLe" "<=" 'rel-op))
    (add-display (py "nat") (dc "NatMinus" "--" 'add-op))
    (add-display (py "nat") (dc "NatMax" "max" 'mul-op))
    (add-display (py "nat") (dc "NatMin" "min" 'mul-op))))

(add-nat-display)

; (remove-nat-tokens) removes all tokens and from DISPLAY-FUNCTIONS
; all items (nat proc).

(define (remove-nat-tokens)
  (remove-token "+")
  (remove-token "*")
  (remove-token "<")
  (remove-token "<=")
  (remove-token "--")
  (remove-token "max")
  (remove-token "min")
  (set! DISPLAY-FUNCTIONS
	(list-transform-positive DISPLAY-FUNCTIONS
	  (lambda (item)
	    (not (equal? (car item) (py "nat")))))))


; Computation rules for the program constants.

; For NatPlus
(add-computation-rules
 "nat+0" "nat"
 "nat1+Succ nat2" "Succ(nat1+nat2)")

; For NatTimes
(add-computation-rules
 "nat*0" "0"
 "nat1*Succ nat2" "(nat1*nat2)+nat1")

; For NatLt
(add-computation-rules
 "nat<0" "False"
 "0<Succ nat" "True"
 "Succ nat1<Succ nat2" "nat1<nat2")

; For NatLe
(add-computation-rules
 "0<=nat" "True"
 "Succ nat<=0" "False"
 "Succ nat1<=Succ nat2" "nat1<=nat2")

; For Pred
(add-computation-rules
 "Pred 0" "0"
 "Pred(Succ nat)" "nat")

; For NatMinus
(add-computation-rules
 "nat--0" "nat"
 "nat1--Succ nat2" "Pred(nat1--nat2)")

; For NatMax
(add-computation-rules
 "nat max 0" "nat"
 "0 max Succ nat" "Succ nat"
 "Succ nat1 max Succ nat2" "Succ(nat1 max nat2)")

; For NatMin
(add-computation-rules
 "nat min 0" "0"
 "0 min Succ nat" "0"
 "Succ nat1 min Succ nat2" "Succ(nat1 min nat2)")

; For AllBNat
(add-computation-rules
 "AllBNat 0 nat=>boole" "True"
 "AllBNat(Succ nat)nat=>boole" "AllBNat nat nat=>boole andb (nat=>boole)nat")


; We prove and add some properties of the program constants introduced,
; either as rewrite rules or as theorems

; Properties of NatPlus

; "NatPlusTotal"
(set-goal "Total NatPlus")
(use "Total")
(use "All-AllPartial")
(assume "nat1")
(use "Total" 'right)
(use "All-AllPartial")
(ind)
(use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
(use "Truth-Axiom")
(assume "nat2" "IH")
(use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
(ng)
(use (make-proof-in-aconst-form (finalg-to-total-to-e-aconst (py "nat"))))
(use "IH")
; Proof finished
(save "NatPlusTotal")


; (set-goal "all nat1,nat2 E(nat1+nat2)")
; (assume "nat1")
; (ind)
;   (use "Truth-Axiom")
; (assume "nat2" "IH")
; (use "IH")
; (add-theorem "NatPlusTotal")


(set-goal "all nat 0+nat=nat")
(ind)
  (use "Truth-Axiom")
(assume "nat" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "0+nat" "nat")


(set-goal "all nat1,nat2 Succ nat1+nat2=Succ(nat1+nat2)")
(assume "nat1")
(ind)
  (use "Truth-Axiom")
(assume "nat2" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "Succ nat1+nat2" "Succ(nat1+nat2)")


(set-goal "all nat1,nat2,nat3 nat1+(nat2+nat3)=nat1+nat2+nat3")
(assume "nat1" "nat2")
(ind)
  (use "Truth-Axiom")
(assume "nat3" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "nat1+(nat2+nat3)" "nat1+nat2+nat3")


; "NatPlusComm"
(set-goal "all nat1,nat2.nat1+nat2=nat2+nat1")
(assume "nat1")
(ind)
  (use "Truth-Axiom")
(assume "nat2" "IH")
(use "IH")
; Proof finished.
(save "NatPlusComm")


; Properties of NatTimes

; "NatTimesTotal"
(set-goal "Total NatTimes")
(use "Total")
(use "All-AllPartial")
(assume "nat1")
(use "Total" 'right)
(use "All-AllPartial")
(ind)
  (use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
  (use "Truth-Axiom")
(assume "nat2" "IH")
(use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
(ng)
(use (make-proof-in-aconst-form (finalg-to-total-to-e-aconst (py "nat"))))
(use "Total" 'left)
(use "Total" 'left)
(use "NatPlusTotal")
(use "IH")
(use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
(use "Truth-Axiom")
; Proof finished
(save "NatTimesTotal")

; (set-goal "all nat1,nat2 E(nat1*nat2)")
; (assume "nat1")
; (ind)
;   (use "Truth-Axiom")
; (assume "nat2" "IH")
; (use "Allpartial-All-nat")

; (use "NatPlusTotal")
; (use "IH")
; (add-theorem "NatTimesTotal")


(set-goal "all nat 0*nat=0")
(ind)
  (use "Truth-Axiom")
(assume "nat" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "0*nat" "0")


; "NatCompat"
(set-goal
 "all nat1,nat2(nat1=nat2 -> 
                all nat=>boole^.nat=>boole^nat1 -> nat=>boole^nat2)")
(ind)
  (cases)
    (assume "0=0" "nat=>boole^" "H1")
    (use "H1")
  (assume "nat" "Absurd" "nat=>boole^" "H1")
  (use "Efq")
  (use "Absurd")
(assume "nat1" "IH")
(cases)
  (assume "Absurd" "nat=>boole^" "H1")
  (use "Efq")
  (use "Absurd")
(assume "nat2" "nat1=nat2" "nat=>boole^")
(use-with "IH" (pt "nat2") "nat1=nat2" (pt "[nat]nat=>boole^(Succ nat)"))
; Proof finished.
(save "NatCompat")


; "Nat=Compat"
(set-goal
 "all nat1,nat2(nat1=nat2 -> all nat=>nat.nat=>nat nat1=nat=>nat nat2)")
(ind)
  (cases)
    (assume "Trivial" "nat=>nat")
    (use "Truth-Axiom")
  (assume "nat2" "Absurd" "nat=>nat")
  (use "Efq")
  (use "Absurd")
(assume "nat1" "IH")
(cases)
  (assume "Absurd" "nat=>nat")
  (use "Efq")
  (use "Absurd")
(assume "nat2" "nat1=nat2" "nat=>nat")
(use-with "IH" (pt "nat2") "nat1=nat2" (pt "[nat]nat=>nat(Succ nat)"))
; Proof finished.
(save "Nat=Compat")


; "Nat=Symm"
(set-goal "all nat1,nat2(nat1=nat2 -> nat2=nat1)")
(ind)
  (cases)
    (assume "H")
    (use "H")
  (assume "nat2" "Absurd")
  (use "Absurd")
(assume "nat1" "IH")
(cases)
  (assume "H")
  (use "H")
(use "IH")
; Proof finished.
(save "Nat=Symm")


; "Nat=Trans"
(set-goal "all nat1,nat2,nat3(nat1=nat2 -> nat2=nat3 -> nat1=nat3)")
(ind)
  (cases)
    (assume "nat3" "Trivial" "0=nat3")
    (use "0=nat3")
  (assume "nat2" "nat3" "Absurd" "H1")
  (use "Efq-Atom")
  (use "Absurd")
(assume "nat1" "IH")
(cases)
  (assume "nat3" "Absurd" "H1")
  (use "Efq-Atom")
  (use "Absurd")
(assume "nat2")
(cases)
  (assume "H1" "H2")
  (use "H2")
(use "IH")
; Proof finished.
(save "Nat=Trans")


(set-goal "all nat1,nat2 Succ nat1*nat2=(nat1*nat2)+nat2")
(assume "nat1")
(ind)
  (use "Truth-Axiom")
(assume "nat2" "IH")
(ng)
(use "Nat=Trans" (pt "nat1*nat2+nat2+nat1"))
(use-with "Nat=Compat" (pt "Succ nat1*nat2") (pt "nat1*nat2+nat2")
	  "IH" (pt "[nat]nat+nat1"))
(use-with "Nat=Compat" (pt "nat2+nat1") (pt "nat1+nat2") "?"
	  (pt "[nat]nat1*nat2+nat"))
(use "NatPlusComm")
; Proof finished.
(add-rewrite-rule "Succ nat1*nat2" "(nat1*nat2)+nat2")


(set-goal "all nat1,nat2,nat3 nat1*(nat2+nat3)=(nat1*nat2)+(nat1*nat3)")
(ind)
  (strip)
  (use "Truth-Axiom")
(assume "nat1" "IH1" "nat2" "nat3")
(ng)
(simp-with "IH1" (pt "nat2") (pt "nat3"))
(simp-with
 (pf "(((nat1*nat2)+nat2)+(nat1*nat3))=((nat1*nat2)+(nat1*nat3)+nat2)"))
(use "Truth-Axiom")
(simp-with (pf "(nat1*nat2+nat2+(nat1*nat3))=(nat1*nat2+(nat2+(nat1*nat3)))"))
(simp-with "NatPlusComm" (pt "nat2") (pt "nat1*nat3"))
(use "Truth-Axiom")
(use "Truth-Axiom")
; Proof finished.
(add-rewrite-rule "nat1*(nat2+nat3)" "nat1*nat2+nat1*nat3")


; "NatTimesComm"
(set-goal "all nat1,nat2 nat1*nat2=nat2*nat1")
(assume "nat1")
(ind)
  (use "Truth-Axiom")
(assume "nat2" "IH")
(ng)
(use "Nat=Trans" (pt "nat2*nat1+nat1"))
(use-with "Nat=Compat" (pt "nat1*nat2") (pt "nat2*nat1") "IH"
	  (pt "[nat]nat+nat1"))
(use "Truth-Axiom")
;Proof finished.
(save "NatTimesComm")


(set-goal "all nat1,nat2,nat3 (nat1+nat2)*nat3=(nat1*nat3)+(nat2*nat3)")
(assume "nat1" "nat2" "nat3")
(simp-with "NatTimesComm" (pt "nat1+nat2") (pt "nat3"))
(simp-with "NatTimesComm" (pt "nat1") (pt "nat3"))
(simp-with "NatTimesComm" (pt "nat2") (pt "nat3"))
(use-with "Truth-Axiom")
; Proof finished.
(add-rewrite-rule "(nat1+nat2)*nat3" "nat1*nat3+nat2*nat3")


(set-goal "all nat1,nat2,nat3 nat1*(nat2*nat3)=(nat1*nat2)*nat3")
(ind)
  (strip)
  (use "Truth-Axiom")
(assume "nat1" "IH1" "nat2" "nat3")
(ng)
(simp-with "IH1" (pt "nat2") (pt "nat3"))
(use "Truth-Axiom")
; Proof finished.
(add-rewrite-rule "nat1*(nat2*nat3)" "nat1*nat2*nat3")


; Properties of NatLt

; "NatLtTotal"
(set-goal "Total NatLt")
(assert (pf "all nat2,nat1 Total(nat1<nat2)"))
  (ind)
  (assume "nat1")
  (use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "boole"))))
  (use "Truth-Axiom")
  (assume "nat2" "IH")
  (cases)
  (use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "boole"))))
  (use "Truth-Axiom")
  (use "IH")
(assume "H")
(use "Total")
(use "All-AllPartial")
(assume "nat1")
(use "Total" 'right)
(use "All-AllPartial")
(assume "nat2")
(use "H")
; Proof finished.
(save "NatLtTotal")


(set-goal "all nat nat<Succ nat")
(ind)
  (use "Truth-Axiom")
(assume "nat" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "nat<Succ nat" "True")


(set-goal "all nat (nat<nat)=False")
(ind)
  (use "Truth-Axiom")
(assume "nat" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "nat<nat" "False")


(set-goal "all nat (Succ nat<nat)=False")
(ind)
  (use "Truth-Axiom")
(assume "nat" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "Succ nat<nat" "False")


; "NatLtTrans"
(set-goal "all nat1,nat2,nat3(nat1<nat2 -> nat2<nat3 -> nat1<nat3)")
(ind)
  (cases)
    (assume "nat3" "Absurd" "0<nat3")
    (use "0<nat3")
  (assume "nat2")
  (cases)
    (assume "Trivial" "Absurd")
    (use "Absurd")
  (assume "nat3" "Trivial" "H1")
  (use "Truth-Axiom")
(assume "nat1" "IH1")
(cases)
  (assume "nat3" "Absurd" "0<nat3")
  (use "Efq-Atom")
  (use "Absurd")
(assume "nat2")
(cases)
(assume "H1" "Absurd")
(use "Absurd")
(use "IH1")
; Proof finished
(save "NatLtTrans")


; "NatLtSuccCases"
(set-goal "all nat2,nat1(nat1<Succ nat2 -> (nat1<nat2 -> Pvar) -> 
                                           (nat1=nat2 -> Pvar) -> Pvar)")
(ind)
  (cases)
    (assume "H1" "H2" "H3")
    (use "H3")
  (use "Truth-Axiom")
  (assume "nat1" "Absurd" "H2" "H3")
  (use "Efq")
  (use "Absurd")
(assume "nat1" "IH")
(cases)
  (assume "H1" "H2" "H3")
  (use "H2")
  (use "Truth-Axiom")
(use "IH")
; Proof finished.
(save "NatLtSuccCases")


; Properties of NatLe

; "NatLeTotal"
(set-goal "Total NatLe")
(assert (pf "all nat1,nat2 Total(nat1<=nat2)"))
  (ind)
  (assume "nat2")
  (use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "boole"))))
  (use "Truth-Axiom")
  (assume "nat1" "IH")
  (cases)
  (use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "boole"))))
  (use "Truth-Axiom")
  (use "IH")
(assume "H")
(use "Total")
(use "All-AllPartial")
(assume "nat1")
(use "Total" 'right)
(use "All-AllPartial")
(assume "nat2")
(use "H")
; Proof finished.
(save "NatLeTotal")


(set-goal "all nat nat<=nat")
(ind)
  (use "Truth-Axiom")
(assume "nat" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "nat<=nat" "True")


(set-goal "all nat1,nat2 nat1<=nat1+nat2")
(ind)
  (assume "nat2")
  (use "Truth-Axiom")
(assume "nat" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "nat1<=nat1+nat2" "True")


(set-goal "all nat (Succ nat<=nat)=False")
(ind)
  (use "Truth-Axiom")
(assume "nat" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "Succ nat<=nat" "False")


(set-goal "all nat nat<=Succ nat")
(ind)
  (use "Truth-Axiom")
(assume "nat" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "nat<=Succ nat" "True")


; "NatLeTrans"
(set-goal "all nat1,nat2,nat3(nat1<=nat2 -> nat2<=nat3 -> nat1<=nat3)")
(ind)
  (strip)
  (use "Truth-Axiom")
(assume "nat1" "IH1")
(cases)
  (assume "nat3" "Absurd" "H1")
  (use "Efq-Atom")
  (use "Absurd")
(assume "nat2")
(cases)
  (assume "H1" "Absurd")
  (use "Absurd")
(use "IH1")
; Proof finished.
(save "NatLeTrans")


; "NatLtLeTrans"
(set-goal "all nat1,nat2,nat3(nat1<nat2 -> nat2<=nat3 -> nat1<nat3)")
(ind)
(cases)
  (assume "nat3" "Absurd" "H1")
  (use "Efq-Atom")
  (use "Absurd")
(assume "nat2")
(cases)
  (assume "H1" "Absurd")
  (use "Absurd")
(strip)
(use "Truth-Axiom")
(assume "nat1" "IH1")
(cases)
  (assume "nat3" "Absurd" "H1")
  (use "Efq-Atom")
  (use "Absurd")
(assume "nat2")
(cases)
  (assume "H1" "Absurd")
  (use "Absurd")
(use "IH1")
; Proof finished.
(save "NatLtLeTrans")


; "NatLeLtTrans"
(set-goal "all nat1,nat2,nat3(nat1<=nat2 -> nat2<nat3 -> nat1<nat3)")
(ind)
(cases)
  (assume "nat3" "Trivial" "0<nat3")
  (use "0<nat3")
(assume "nat2")
(cases)
  (prop)
(assume "nat3")
(prop)
(assume "nat1" "IH1")
(cases)
  (assume "nat3" "Absurd" "H1")
  (use "Efq-Atom")
  (use "Absurd")
(assume "nat2")
(cases)
  (assume "H1" "Absurd")
  (use "Absurd")
(use "IH1")
; Proof finished.
(save "NatLeLtTrans")


; "NatLtSuccToLe"
(set-goal "all nat1,nat2(nat1<Succ nat2 -> nat1<=nat2)")
(ind)
  (strip)
  (use "Truth-Axiom")
(assume "nat1" "IH1")
(cases)
  (assume "Absurd")
  (use "Absurd")
(use "IH1")
; Proof finished.
(save "NatLtSuccToLe")


; "NatLtLtSuccTrans"
(set-goal "all nat1,nat2,nat3(nat1<nat2 -> nat2<Succ nat3 -> nat1<nat3)")
(assume "nat1" "nat2" "nat3" "nat1<nat2" "nat2<Succ nat3")
(use "NatLtLeTrans" (pt "nat2"))
(use "nat1<nat2")
(use "NatLtSuccToLe")
(use "nat2<Succ nat3")
; Proof finished.
(save "NatLtLtSuccTrans")


; "NatLeToLtSucc"
(set-goal "all nat1,nat2(nat1<=nat2 -> nat1<Succ nat2)")
(ind)
  (strip)
  (use "Truth-Axiom")
(assume "nat1" "IH1")
(cases)
  (assume "Absurd")
  (use "Absurd")
(use "IH1")
; Proof finished.
(save "NatLeToLtSucc")


; "NatLtToSuccLe"
(set-goal (pf "all nat1,nat2(nat1<nat2 -> Succ nat1<=nat2)"))
(ind)
  (cases)
  (assume "Absurd")
  (use "Efq")
  (use "Absurd")
  (assume "nat2" "Trivial")
  (use "Truth-Axiom")
(assume "nat1" "IH1")
  (cases)
  (assume "Absurd")
  (use "Efq")
  (use "Absurd")
(use "IH1")
; Proof finished.
(save "NatLtToSuccLe")


; "NatSuccLeToLt"
(set-goal (pf "all nat1,nat2(Succ nat1<=nat2 -> nat1<nat2)"))
(ind)
  (cases)
  (assume "Absurd")
  (use "Efq")
  (use "Absurd")
  (assume "nat2" "Trivial")
  (use "Truth-Axiom")
(assume "nat1" "IH1")
  (cases)
  (assume "Absurd")
  (use "Efq")
  (use "Absurd")
(use "IH1")
; Proof finished.
(save "NatSuccLeToLt")


; "NatLeCases"
(set-goal "all nat2,nat1(nat1<=nat2 -> (nat1<nat2 -> Pvar) -> 
                        (nat1=nat2 -> Pvar) -> Pvar)")
(ind)
  (cases)
  (assume "H1" "H2" "H3")
  (use "H3")
  (use "Truth-Axiom")
(assume "nat1" "Absurd" "H2" "H3")
(use "H2")
(use "Absurd")
(assume "nat1" "IH")
(cases)
  (assume "H1" "H2" "H3")
  (use "H2")
  (use "Truth-Axiom")
(use "IH")
; Proof finished.
(save "NatLeCases")


; "NatLeLtCases"
(set-goal
 "all nat1,nat2((nat1<=nat2 -> Pvar) -> (nat2<nat1 -> Pvar) -> Pvar)")
(ind)
  (cases)
    (assume "H1" "H2")
    (use "H1")
    (use "Truth-Axiom")
  (assume "nat1" "H1" "H2")
  (use "H1")
  (use "Truth-Axiom")
(assume "nat1" "IH1")
(cases)
  (assume "H1" "H2")
  (use "H2")
  (use "Truth-Axiom")
(assume "nat2" "H1" "H2")
(use "IH1" (pt "nat2"))
(use "H1")
(use "H2")
; Proof finished.
(save "NatLeLtCases")


; "NatLeLin"
(set-goal
 "all nat1,nat2((nat1<=nat2 -> Pvar) -> (nat2<=nat1 -> Pvar) -> Pvar)")
(ind)
  (cases)
    (assume "H1" "H2")
    (use "H1")
    (use "Truth-Axiom")
  (assume "nat1" "H1" "H2")
  (use "H1")
  (use "Truth-Axiom")
(assume "nat1" "IH1")
(cases)
  (assume "H1" "H2")
  (use "H2")
  (use "Truth-Axiom")
(assume "nat2" "H1" "H2")
(use "IH1" (pt "nat2"))
(use "H1")
(use "H2")
; Proof finished.
(save "NatLeLin")


; Properties of NatMinus and Pred

; "PredTotal"
(set-goal (pf "Total Pred"))
(use "Total")
(use "All-AllPartial")
(cases)
(use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
(use "Truth-Axiom")
(assume "nat")
(use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
(use "Truth-Axiom")
; Proof finished.
(save "PredTotal")


; "NatMinusTotal"
(set-goal "Total NatMinus")
(use "Total")
(use "All-AllPartial")
(assume "nat1")
(use "Total" 'right)
(use "All-AllPartial")
(ind)
(use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
(use "Truth-Axiom")
(assume "nat2" "IH")
(use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
(ng)
(use (make-proof-in-aconst-form (finalg-to-total-to-e-aconst (py "nat"))))
(use "Total" 'left)
(use "PredTotal")
(use "IH")
; Proof finished
(save "NatMinusTotal")


(set-goal (pf "all nat1,nat2 Pred(Succ nat1--nat2)=nat1--nat2"))
(assume "nat1")
(ind)
  (use "Truth-Axiom")
(assume "nat2" "IH")
(ng)
(simp-with "IH")
(use "Truth-Axiom")
; Proof finished.
(add-rewrite-rule "Pred(Succ nat1--nat2)" "nat1--nat2")


(set-goal "all nat nat--nat=0")
(ind)
  (use "Truth-Axiom")
(assume "nat" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "nat--nat" "0")


(set-goal "all nat Succ nat--nat=1")
(ind)
  (use "Truth-Axiom")
(assume "nat" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "Succ nat--nat" "1")


; Properties of NatMax

; "NatMaxTotal"
(set-goal "Total NatMax")
(assert (pf "all nat2,nat1 Total(nat1 max nat2)"))
  (ind)
  (assume "nat1")
  (use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
  (use "Truth-Axiom")
  (assume "nat2" "IH")
  (cases)
  (use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
  (use "Truth-Axiom")
  (assume "nat1")
  (use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
  (ng)  
  (use (make-proof-in-aconst-form (finalg-to-total-to-e-aconst (py "nat"))))
  (use "IH")
(assume "H")
(use "Total")
(use "All-AllPartial")
(assume "nat1")
(use "Total" 'right)
(use "All-AllPartial")
(assume "nat2")
(use "H")
; Proof finished.
(save "NatMaxTotal")


(set-goal "all nat 0 max nat=nat")
(cases)
  (use "Truth-Axiom")
(strip)
(use "Truth-Axiom")
; Proof finished.
(add-rewrite-rule "0 max nat" "nat")


(set-goal "all nat nat max nat = nat")
(ind)
  (use "Truth-Axiom")
(assume "nat" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "nat max nat" "nat")


(set-goal "all nat1,nat2,nat3(
            nat1 max (nat2 max nat3)=nat1 max nat2 max nat3)")
(ind)
  (strip)
  (use "Truth-Axiom")
(assume "nat1" "IH1")
(cases)
  (strip)
  (use "Truth-Axiom")
(assume "nat2")
(cases)
  (use "Truth-Axiom")
(use "IH1")
; Proof finished.
(add-rewrite-rule
 "nat1 max (nat2 max nat3)" "nat1 max nat2 max nat3")


; "NatMaxComm"
(set-goal "all nat1,nat2 nat1 max nat2 = nat2 max nat1")
(ind)
  (strip)
  (use "Truth-Axiom")
(assume "nat1" "IH")
(cases)
  (use "Truth-Axiom")
(use "IH")
; Proof finished.
(save "NatMaxComm")


; "NatMaxUB1" 
(set-goal "all nat1,nat2 nat1<=nat1 max nat2")
(ind)
  (assume "nat2")
  (use "Truth-Axiom")
(assume "nat1" "IH1")
(cases)
  (use "Truth-Axiom")
(use "IH1")
; Proof finished.
(save "NatMaxUB1")


; "NatMaxUB2" 
(set-goal "all nat1,nat2 nat2<=nat1 max nat2")
(ind)
  (assume "nat2")
  (use "Truth-Axiom")
(assume "nat1" "IH1")
(cases)
  (use "Truth-Axiom")
(use "IH1")
; Proof finished.
(save "NatMaxUB2")


; Properties of NatMin

; "NatMinTotal"
(set-goal "Total NatMin")
(assert (pf "all nat2,nat1 Total(nat1 min nat2)"))
  (ind)
  (assume "nat1")
  (use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
  (use "Truth-Axiom")
  (assume "nat2" "IH")
  (cases)
  (use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
  (use "Truth-Axiom")
  (assume "nat1")
  (use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
  (ng)  
  (use (make-proof-in-aconst-form (finalg-to-total-to-e-aconst (py "nat"))))
  (use "IH")
(assume "H")
(use "Total")
(use "All-AllPartial")
(assume "nat1")
(use "Total" 'right)
(use "All-AllPartial")
(assume "nat2")
(use "H")
; Proof finished.
(save "NatMinTotal")


(set-goal "all nat 0 min nat=0")
(cases)
  (use "Truth-Axiom")
(strip)
(use "Truth-Axiom")
; Proof finished.
(add-rewrite-rule "0 min nat" "0")


(set-goal "all nat nat min nat = nat")
(ind)
  (use "Truth-Axiom")
(assume "nat" "IH")
(use "IH")
; Proof finished.
(add-rewrite-rule "nat min nat" "nat")


(set-goal "all nat1,nat2,nat3(
            nat1 min (nat2 min nat3)=nat1 min nat2 min nat3)")
(ind)
  (strip)
  (use "Truth-Axiom")
(assume "nat1" "IH1")
(cases)
  (strip)
  (use "Truth-Axiom")
(assume "nat2")
(cases)
  (use "Truth-Axiom")
(use "IH1")
; Proof finished.
(add-rewrite-rule "nat1 min (nat2 min nat3)" "nat1 min nat2 min nat3")


; "NatMinComm"
(set-goal "all nat1,nat2 nat1 min nat2 = nat2 min nat1")
(ind)
  (strip)
  (use "Truth-Axiom")
(assume "nat1" "IH")
(cases)
  (use "Truth-Axiom")
(use "IH")
; Proof finished.
(save "NatMinComm")


; "NatMinLB1" 
(set-goal "all nat1,nat2 nat1 min nat2<=nat1")
(ind)
  (assume "nat2")
  (use "Truth-Axiom")
(assume "nat1" "IH1")
(cases)
  (use "Truth-Axiom")
(use "IH1")
; Proof finished.
(save "NatMinLB1")


; "NatMinLB2" 
(set-goal "all nat1,nat2 nat1 min nat2<=nat2")
(ind)
  (assume "nat2")
  (use "Truth-Axiom")
(assume "nat1" "IH1")
(cases)
  (use "Truth-Axiom")
(use "IH1")
; Proof finished.
(save "NatMinLB2")


; Properties of AllBNat

; "AndConstTotal"
(set-goal "Total AndConst")
(use "Total")
(use "All-AllPartial")
(assume "boole1")
(use "Total" 'right)
(use "All-AllPartial")
(assume "boole2")
(use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "boole"))))
(use "Truth-Axiom")
; Proof finished
(save "AndConstTotal")


; "AllBNatTotal"
(set-goal (pf "Total AllBNat"))
(use "Total")
(use "All-AllPartial")
(ind)
; Base
(use "Total" 'right)
(use "All-AllPartial")
(assume "nat=>boole")
(use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "boole"))))
(use "Truth-Axiom")
; Step
(assume "nat" "IH")
(use "Total" 'right)
(assume "(nat=>boole)^" "Tf")
(ng)
(assert (pf "all boole^1(Total boole^1 -> all boole^2(Total boole^2 -> 
                         Total(boole^1 andb boole^2)))"))
  (assume "boole^1" "T1" "boole^2" "T2")
  (use "Total")
  (use "Total")
  (use "AndConstTotal")
  (use "T1")
  (use "T2")
(assume "TA")
(use "TA")
(use "Total")
(use "IH")
(use "Tf")
(use "Total")
(use "Tf")
(use (make-proof-in-aconst-form (finalg-to-e-to-total-aconst (py "nat"))))
(use "Truth-Axiom")
; Proof finished
(save "AllBNatTotal")


; "AllBNatIntro"
(set-goal "all (nat=>boole),nat2(
      all nat1(nat1<nat2 -> (nat=>boole)nat1) -> 
      AllBNat nat2([nat1](nat=>boole)nat1))")
(assume "(nat=>boole)")
(ind)
  (strip)
  (use "Truth-Axiom")
(assume "nat2" "IH" "H")
(ng)
(split)
  (use "IH")
  (assume "nat1" "nat1<nat2")
  (use "H")
  (use "NatLtTrans" (pt "nat2"))
  (use "nat1<nat2")
  (use "Truth-Axiom")
(use "H")
(use "Truth-Axiom")
; Proof finished.
(save "AllBNatIntro")


; "AllBNatElim"
(set-goal "all (nat=>boole),nat2(
      AllBNat nat2(nat=>boole) -> 
      all nat1(nat1<nat2 -> (nat=>boole)nat1))")
(assume "(nat=>boole)")
(ind)
  (assume "H1" "nat1" "Absurd")
  (use "Efq")
  (use "Absurd")
(assume "nat2" "IH")
(ng)
(assume "AllBHyp" "nat1" "nat1<Succ nat2")
(use "NatLtSuccCases" (pt "nat2") (pt "nat1"))
(use "nat1<Succ nat2")
(use "IH")
(use "AllBHyp")
(assume "nat1=nat2")
(simp "nat1=nat2")
(use "AllBHyp")
; Proof finished.
(save "AllBNatElim")

; For use with grec we add

(define natlt-obj (nbe-term-to-object (pt "NatLt") '()))

(av "n" "m" "k" (py "nat"))
