;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; index.scm
;;
;; A representation of natural numbers as indices
;;
;; Version $Id: index.scm 2156 2008-01-25 13:25:12Z schimans $
;;
;; Markus Sauermann
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(add-alg "index" '("Begin" "index") '("Next" "index=>index"))

(av "i" (py "index"))
(av "itob" (py "index=>boole"))
(add-pvar-name "Pindex" (make-arity (py "index")))


(set-goal (pf "all i1,i2. i1=i2 -> i2=i1"))
(assume "i1" "i2" 1)
(simp 1)
(use "Truth-Axiom")
(save "indexSymm")

(set-goal (pf "all i1,i2,i3. i1=i2 -> i2=i3 -> i1=i3"))
(assume "i1" "i2" "i3" 1 2)
(simp 1)
(use 2)
(save "indexTrans")

(set-goal (pf "all i. (Next i=i)=False"))
(ind)
(use "Truth-Axiom")
(assume "i" 1)
(ng)
(use 1)
(save "indexHelper9")



;; ADDITION

(add-program-constant
 "indexPlus" (py "index=>index=>index") 1 'const 2)

(add-token
 "$+"
 'add-op
 (lambda (x y)
   (mk-term-in-app-form
    (make-term-in-const-form (pconst-name-to-pconst "indexPlus")) x y)))

(add-display
 (py "index")
 (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=? "indexPlus"
			(const-to-name (term-in-const-form-to-const op)))
	      (= 2 (length args)))
	 (list 'add-op "$+"
	       (term-to-token-tree (car args))
	       (term-to-token-tree (cadr args)))
	 #f))))

(add-computation-rule (pt "i $+ Begin") (pt "i"))
(add-computation-rule (pt "i2 $+ Next i1") (pt "Next (i2 $+ i1)"))
;; (display-program-constants "indexPlus")

;; RELATIONS LESS, LESS OR EQUAL

(add-program-constant "indexLess" (py "index=>index=>boole") 1 'const 2)
(add-computation-rule (pt "indexLess i Begin") (pt "False"))
(add-computation-rule (pt "indexLess Begin (Next i)") (pt "True"))
(add-computation-rule (pt "indexLess (Next i1) (Next i2)") (pt "indexLess i1 i2"))

(add-program-constant "indexLeq" (py "index=>index=>boole") 1 'const 2)
(add-computation-rule (pt "indexLeq Begin i") (pt "True"))
(add-computation-rule (pt "indexLeq (Next i) Begin") (pt "False"))
(add-computation-rule (pt "indexLeq (Next i1) (Next i2)") (pt "indexLeq i1 i2"))

;;(remove-program-constant "indexLess")
(set-goal (pf "all i.indexLeq i i"))
(ind)
(use "Truth-Axiom")
(assume "i" 1)
(ng)
(use 1)
(save "indexHelper11")
(add-rewrite-rule (pt "indexLeq i i") (pt "True"))

(set-goal (pf "all i. indexLeq i (Next i)"))
(ind)
(use "Truth-Axiom")
(assume "i" 1)
(ng)
(use 1)
(save "indexHelper12")
(add-rewrite-rule (pt "indexLeq i (Next i)") (pt "True"))



(set-goal (pf "all i. Begin $+ i = i"))
(ind)
(auto)
(save "indexHelper1")
(add-rewrite-rule (pt "Begin $+ i") (pt "i"))

(set-goal (pf "all i1,i2. Next i1 $+ i2= Next (i1 $+ i2)"))
(assume "i1")
(ind)
(auto)
(save "indexHelper2")
(add-rewrite-rule (pt "Next i1 $+ i2") (pt "Next (i1 $+ i2)"))

(set-goal (pf "all i1,i2. i1$+i2 = i2$+i1"))
(assume "i1")
(ind)
(auto)
(save "indexPlusComm")


(set-goal (pf "all i1,i2,i3. i1$+(i2$+i3) = i1$+i2$+i3"))
(assume "i1" "i2")
(ind)
(auto)
(save "indexPlusAssoc")
(add-rewrite-rule (pt "i1 $+ (i2 $+ i3)") (pt "i1 $+ i2 $+ i3"))



;;(remove-computation-rules-for (pt "i1 $+ (i2 $+ i3)"))

(add-program-constant
 "indexPred" (py "index=>index") 1 'const 1)

(add-computation-rule (pt "indexPred Begin") (pt "Begin"))
(add-computation-rule (pt "indexPred (Next i)") (pt "i"))


;; SUBTRACTION

(add-program-constant
 "indexMinus" (py "index=>index=>index") 1 'const 2)

(add-token
 "$-"
 'add-op
 (lambda (x y)
   (mk-term-in-app-form
    (make-term-in-const-form (pconst-name-to-pconst "indexMinus")) x y)))

(add-display
 (py "index")
 (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=? "indexMinus"
			(const-to-name (term-in-const-form-to-const op)))
	      (= 2 (length args)))
	 (list 'add-op "$-"
	       (term-to-token-tree (car args))
	       (term-to-token-tree (cadr args)))
	 #f))))

(add-computation-rule (pt "i $- Begin") (pt "i"))
(add-computation-rule (pt "Begin $- Next i2") (pt "Begin"))
(add-computation-rule (pt "Next i1 $- Next i2") (pt "i1 $- i2"))

;; SHIFTS

(add-program-constant
 "indexSHLone" (py "index=>index") 1 'const 1)

(add-computation-rule (pt "indexSHLone Begin") (pt "Begin"))
(add-computation-rule (pt "indexSHLone (Next i)") (pt "Next (Next (indexSHLone i))"))






(set-goal (pf "all i. i $- i=Begin"))
(ind)
(use "Truth-Axiom")
(assume "i" 1)
(ng)
(use 1)
(save "indexHelper3")
(add-rewrite-rule (pt "i $- i") (pt "Begin"))

(set-goal (pf "all i. Begin $- i = Begin"))
(cases)
(use "Truth-Axiom")
(assume "i")
(use "Truth-Axiom")
(save "indexHelper4")
(add-rewrite-rule (pt "Begin $- i") (pt "Begin"))

(set-goal (pf "all i. Next i $- i = Next Begin"))
(ind)
(use "Truth-Axiom")
(assume "i" 1)
(use 1)
(save "indexHelper5")
(add-rewrite-rule (pt "Next i $- i") (pt "Next Begin"))

(set-goal (pf "all i. Next (Next i $- Next Begin) = Next i"))
(assume "i")
(use "Truth-Axiom")
(save "indexHelper6")

(set-goal (pf "all i. (i=Begin -> F) -> Next (i$-Next Begin) = i"))
(cases)
(assume 1)
(use 1)
(use "Truth-Axiom")
(assume "i" 1)
(use "indexHelper6")
(save "indexHelper7")

(set-goal (pf "all i1,i2. i2$-(i1$+(Next Begin)) = i2$-i1$-Next Begin"))
(ind)
(assume "i2")
(use "Truth-Axiom")
(assume "i1" 1)
(cases)
(use "Truth-Axiom")
(assume "i2")
(use 1)
(save "indexHelper8")

(set-goal (pf "all i1,i2. i2$+Next Begin$-Next i1=i2$-(Next i1$-Next Begin)"))
(assume "i1" "i2")
(use "Truth-Axiom")
(save "indexPlusOneShift1")

(set-goal (pf "all i1,i2. (i1 = Begin -> F) -> i2 $+ Next Begin $- i1=i2$-(i1$-Next Begin)"))
(cases)
(assume "i2" 1)
(ng)
(simp "indexHelper9")
(use 1)
(use "Truth-Axiom")
(assume "i1")
(assume "i2" 1)
(use "indexPlusOneShift1")
(save "indexPlusOneShift2")


(set-goal (pf "all i1,i2,i3. i3$-(i1$+i2) = i3$-i1$-i2"))
(ind)
;; i1 = 0
(assume "i2" "i3")
(use "Truth-Axiom")
;; i1 > 0
(assume "i1" 1)
(cases)
;;  i2 = 0
(assume "i3")
(use "Truth-Axiom")
;;  i2 > 0
(assume "i2")
(cases)
;;   i3 = 0
(use "Truth-Axiom")
;;   i3 > 0
(assume "i3")
(ng)
(simp (pf "Next(i1$+i2) = i1 $+ Next i2"))
(use 1)
(use "Truth-Axiom")
(save "indexTwoMinus")



(set-goal (pf "all i1,i2,i3. (indexLeq  i1 i2 -> indexLeq  i2 i3 -> indexLeq  i1 i3) &
                             (indexLess i1 i2 -> indexLess i2 i3 -> indexLess i1 i3) &
                             (indexLeq  i1 i2 -> indexLess i2 i3 -> indexLess i1 i3) &
                             (indexLess i1 i2 -> indexLeq  i2 i3 -> indexLess i1 i3)"))
(ind)
;; i1 = 1
(cases)
(cases)
(auto)
(assume "i2")
(cases)
(auto)
;; i1 > 1
(assume "i1" 1)
(cases)
;;  i2 = 0
(cases)
(auto)
(assume "i3")
(split)
(split)
(split)
(assume 2 3)
(use "Efq")
(use 2)
(assume 2 3)
(use "Efq")
(use 2)
(assume 2 3)
(use "Efq")
(use 2)
(assume 2 3)
(use "Efq")
(use 2)
;;  i2 > 0
(assume "i2")
(cases)
;;   i3 = 0
(split)
(split)
(split)
(assume 2 3)
(use "Efq")
(use 3)
(assume 2 3)
(use "Efq")
(use 3)
(assume 2 3)
(use "Efq")
(use 3)
(assume 2 3)
(use "Efq")
(use 3)
;;   i3 > 0
(assume "i3")
(use 1)
(save "indexLeqLessTrans")

(set-goal (pf "all i1,i2,i3. (indexLeq i1 i2 -> indexLeq i2 i3 -> indexLeq i1 i3)"))
(assume "i1" "i2" "i3")
(use "indexLeqLessTrans")
(save "indexLeqTrans")

(set-goal (pf "all i1,i2,i3. (indexLess i1 i2 -> indexLess i2 i3 -> indexLess i1 i3)"))
(assume "i1" "i2" "i3")
(use "indexLeqLessTrans")
(save "indexLessTrans")

(set-goal (pf "all i1,i2. indexLeq i1 (i1$+i2)"))
(ind)
(assume "i2")
(use "Truth-Axiom")
(assume "i1" 1)
(cases)
(use "Truth-Axiom")
(assume "i2")
(ng)
(use "indexLeqTrans" (pt "i1$+i2"))
(use 1)
(use "Truth-Axiom")
(save "indexHelper13")
(add-rewrite-rule (pt "indexLeq i1 (i1$+i2)") (pt "True"))


(set-goal (pf "all i1,i2. indexLeq i1 (i2$+i1)"))
(assume "i1" "i2")
(simp "indexPlusComm")
(use "Truth-Axiom")
(save "indexHelper14")
(add-rewrite-rule (pt "indexLeq i1 (i2$+i1)") (pt "True"))


(set-goal (pf "all i,i2. Next i $+ i2 $- Next Begin = Next i $- Next Begin $+ i2"))
(assume "i" "i2")
(use "Truth-Axiom")
(save "indexMinusOneShift1")

(set-goal (pf "all i1,i2. (i1 = Begin -> F) -> i1 $+ i2 $- Next Begin = i1 $- Next Begin $+ i2"))
(cases)
(assume "i2" 1)
(use "Efq")
(use 1)
(use "Truth-Axiom")
(assume "i1" "i2" 1)
(use "indexMinusOneShift1")
(save "indexMinusOneShift2")


(set-goal (pf "all i1,i2,i.(i1$+i=i2$+i)=(i1=i2)"))
(assume "i1" "i2")
(ind)
(use "Truth-Axiom")
(assume "i" 1)
(use 1)
(save "indexIdPred")

(set-goal (pf "all i1,i2,i. indexLess (i1$+i)(i2$+i)=indexLess i1 i2"))
(assume "i1" "i2")
(ind)
(use "Truth-Axiom")
(assume "i" 1)
(use 1)
(save "indexLessPred")

(set-goal (pf "all i1,i2,i. indexLeq (i1$+i)(i2$+i)=indexLeq i1 i2"))
(assume "i1" "i2")
(ind)
(use "Truth-Axiom")
(assume "i" 1)
(use 1)
(save "indexLeqPred")


(set-goal (pf "all i1,i. i1$+i$-i=i1"))
(assume "i1")
(ind)
(use "Truth-Axiom")
(assume "i" 1)
(use 1)
(save "indexPlusMinus")
(add-rewrite-rule (pt "i1$+i$-i") (pt "i1"))

(set-goal (pf "all i. indexLeq i Begin -> i = Begin"))
(cases)
(assume 1)
(use "Truth-Axiom")
(assume "i" 1)
(use 1)
(save "indexLeqBeginImpBegin")

(set-goal (pf "all i1,i. indexLeq i i1 -> i1$-i$+i=i1"))
(ind)
(use "indexLeqBeginImpBegin")
(assume "i1" 1)
(cases)
(assume 1)
(use "Truth-Axiom")
(assume "i" 2)
(use 1)
(use 2)
(save "indexMinusPlus")


(set-goal (pf "all i1,i2. indexSHLone (i1$+i2) = indexSHLone i1$+indexSHLone i2"))
(ind)
(assume "i2")
(use "Truth-Axiom")
(assume "i1" 1 "i2")
(use 1)
(save "indexShlPlusBij")

(set-goal (pf "all i1,i2. indexSHLone (i1$-i2) = indexSHLone i1$-indexSHLone i2"))
(ind)
(assume "i2")
(use "Truth-Axiom")
(assume "i1" 1)
(cases)
(use "Truth-Axiom")
(assume "i2")
(use 1)
(save "indexShlMinusBij")

(set-goal (pf "all i. indexSHLone i = i $+ i"))
(ind)
(use "Truth-Axiom")
(assume "i" 1)
(use 1)
(save "indexShlAdd")


(set-goal (pf "all i1,i2. (Next i2)$-i1=Begin -> i2 $- i1=Begin"))
(ind)
(cases)
(assume 1)
(use "Truth-Axiom")
(assume "i2" 1)
(use 1)
(assume "i1" 1)
(cases)
(assume 2)
(use "Truth-Axiom")
(assume "i2" 2)
(ng)
(use 1)
(use 2)
(save "indexDiffPlusOneImpDiffZero")


(set-goal (pf "all i1,i2. indexLeq i1 i2 -> i1 $- i2 = Begin"))
(ind)
(assume "i2" 1)
(use "Truth-Axiom")
(assume "i1" 1)
(cases)
(assume 2)
(use 2)
(assume "i2" 2)
(use 1)
(use 2)
(save "indexHelper10")


(set-goal (pf "all i1,i2. indexLeq  (Next i1) (Next i2) = indexLeq  i1 i2 &
                          indexLess (Next i1) (Next i2) = indexLess i1 i2 &
                          indexLess i1        (Next i2) = indexLeq  i1 i2 &
                          indexLeq  (Next i1) i2        = indexLess i1 i2"))
(ind)
(cases)
(auto)
(assume "i1" 1)
(cases)
(auto)
(save "indexLeqLessSimplifyer")

(set-goal (pf "all i1,i2. (indexLeq i1 i2) -> i2$+Next Begin $-i1=i2$-i1$+Next Begin"))
(ind)
(assume "i2" 1)
(use "Truth-Axiom")
(assume "i1" 1)
(cases)
(assume 2)
(use 2)
(assume "i2" 2)
(ng)
(use 1)
(use 2)
(save "indexPlusOneShiftExt")


(set-goal (pf "all i1,i2. i2 $+ Next Begin $- i1 $- Next Begin = i2 $- i1"))
(ind)
(assume "i2")
(use "Truth-Axiom")
(assume "i1" 1)
(cases)
(use "Truth-Axiom")
(assume "i2")
(use 1)
(save "indexHelper15")

(set-goal (pf "all i1,i2. indexLess (indexSHLone i1) (indexSHLone i2) = indexLess i1 i2 &
                          indexLeq  (indexSHLone i1) (indexSHLone i2) = indexLeq  i1 i2"))
(ind)
(cases)
(split)
(use "Truth-Axiom")
(use "Truth-Axiom")
(assume "i2")
(split)
(use "Truth-Axiom")
(use "Truth-Axiom")
(assume "i1" 1)
(cases)
(split)
(use "Truth-Axiom")
(use "Truth-Axiom")
(assume "i2")
(split)
(use 1)
(use 1)
(save "indexLessLeqShlBij")
(add-rewrite-rule (pt "indexLess (indexSHLone i1) (indexSHLone i2)") (pt "indexLess i1 i2"))
(add-rewrite-rule (pt "indexLeq  (indexSHLone i1) (indexSHLone i2)") (pt "indexLeq  i1 i2"))


(set-goal (pf "all i1,i2. (indexLeq i1 i2) = (i1$-i2=Begin)"))
(ind)
(assume "i2")
(use "Truth-Axiom")
(assume "i1" 1)
(cases)
(use "Truth-Axiom")
(assume "i2")
(use 1)
(save "indexLeqImpDiffZero")

(set-goal (pf "all i1,i2,i. i1=i2 -> i1 $- i = i2 $- i"))
(assume "i1" "i2" "i" 1)
(simp 1)
(use "Truth-Axiom")
(save "indexHelper16")

(set-goal (pf "all i2,i1. indexLess i1 (Next i2) -> (i1=i2 -> F) -> indexLess i1 i2"))
(ind)
(cases)
(assume  1 2)
(use 2)
(use "Truth-Axiom")
(assume "i1" 1 2)
(use 2)
(use 1)
(assume "i2" 1)
(cases)
(assume 2 3)
(use "Truth-Axiom")
(assume "i1" 2 3)
(use 1)
(use 2)
(use 3)
(save "indexHelper17")
