; $Id: orevkov.scm,v 1.6 2008/01/25 13:30:24 logik Exp $

(add-var-name "x" "y" "z" "zero" (py "alpha"))
(add-var-name "S" (mk-arrow (py "alpha") (py "alpha")))
(add-predconst-name "Rpredconst"
		    (make-arity (py "alpha") (py "alpha") (py "alpha")))

(add-token
 "R"
 'predconst-name
 (string-and-arity-to-predconst-parse-function
  "Rpredconst" (make-arity (make-tvar -1 "alpha")
			   (make-tvar -1 "alpha")
			   (make-tvar -1 "alpha"))))

(add-predconst-display "Rpredconst" 'predconst-name "R")

(define hyp1-formula (pf "all y R y zero(S y)"))

(define hyp2-formula
  (pf "all y,x,z,z1.R y x z -> R z x z1 -> R y(S x)z1")) 

(define (a i)
  (if (zero? i)
      (pf "all y ex z R y x z")
      (let* ((xterm (pt "x"))
	     (xvar (term-in-var-form-to-var xterm))
	     (yterm (pt "y"))
	     (yvar (term-in-var-form-to-var yterm))
	     (zterm (pt "z"))
	     (zvar (term-in-var-form-to-var zterm)))
	(mk-all
	 yvar
	 (mk-imp (formula-subst (a (- i 1)) xvar yterm)
		 (mk-ex zvar
			(mk-and (formula-subst (a (- i 1)) xvar zterm)
				(pf "R y x z"))))))))

(formula-to-string (a 0)) ;"all y ex z R y x z"
(formula-to-string (a 1))
;"all y.all y2 ex z R y2 y z -> ex z.all y ex z3 R y z z3 & R y x z"

(define (a0 i)
  (formula-subst (a i) (pv "x") (pt "zero")))

(define (c k)
  (if (zero? k)
      (pf "ex z R zero x z")
      (let* ((xterm (pt "x"))
	     (xvar (term-in-var-form-to-var xterm))
	     (zterm (pt "z"))
	     (zvar (term-in-var-form-to-var zterm)))
      (mk-ex zvar (mk-and (pf "R zero x z")
			  (formula-subst (c (- k 1)) xvar zterm))))))

(define (c0 k)
  (formula-subst (c k) (pv "x") (pt "zero")))

(set-goal
 (mk-all (pv "zero") (pv "S") (mk-imp hyp1-formula hyp2-formula (a0 0))))
(assume "zero" "S" 1 2 "y")
(ex-intro (pt "S y"))
(use-with 1 (pt "y"))

(define a0-proof (pproof-state-to-proof))

(set-goal
 (mk-all (pv "zero") (pv "S") (mk-imp hyp1-formula hyp2-formula (a0 1))))
(assume "zero" "S" 1 2 "x" 3)
(ex-intro (pt "S x"))
(split)
(assume "y")
(ex-elim (pf "ex z R y x z"))
(use 3)

(assume "z" 4)
(ex-elim (pf "ex z1 R z x z1"))
(use 3)

(assume "z1" 5)
(ex-intro (pt "z1"))
(use 2 (pt "z"))
(use 4)
(use 5)

(use 1)

; (dnp)
; (dnpt)
; (dnpe)

(define a1-proof (pproof-state-to-proof))

(set-goal
 (mk-all (pv "zero") (pv "S") (mk-imp hyp1-formula hyp2-formula (a0 2))))
(assume "zero" "S" 1 2 "x" 3)
(ex-intro (pt "S x"))
(split)
(assume "y" 4)
(ex-elim (pf "ex z.all y ex z1 R y z z1 & R y x z"))
(use 3)
(use 4)
(assume "z" 5)
(ex-elim (pf "ex z1.all y ex z2 R y z1 z2 & R z x z1"))
(use 3)
(use 5)
(assume "z1" 6)
(ex-intro (pt "z1"))
(split)
(use 6)
(use 2 (pt "z"))
(use 5)
(use 6)

(use 1)

(define a2-proof (pproof-state-to-proof))

(set-goal
 (mk-all (pv "zero") (pv "S") (mk-imp hyp1-formula hyp2-formula (a0 3))))
(assume "zero" "S" 1 2 "x" 3)
(ex-intro (pt "S x"))
(split)
(assume "y" 4)
(ex-elim (mk-ex (pv "z") (mk-and (formula-subst (a 1) (pv "x") (pt "z"))
				 (pf "R y x z"))))
(use 3)
(use 4)
(assume "z" 5)
(ex-elim (mk-ex (pv "z1") (mk-and (formula-subst (a 1) (pv "x") (pt "z1"))
				  (pf "R z x z1"))))
(use 3)
(use 5)
(assume "z1" 6)
(ex-intro (pt "z1"))
(split)
(use 6)
(use 2 (pt "z"))
(use 5)
(use 6)

(use 1)

(define a3-proof (pproof-state-to-proof))

(set-goal
 (mk-all (pv "zero") (pv "S") (mk-imp hyp1-formula hyp2-formula (c0 0))))
(assume "zero" "S" 1 2)
(use-with a0-proof (pt "zero") (pt "S") 1 2 (pt "zero"))

(define c0-proof (pproof-state-to-proof))

(set-goal
 (mk-all (pv "zero") (pv "S") (mk-imp hyp1-formula hyp2-formula (c0 1))))
(assume "zero" "S" 1 2)
(ex-elim (mk-ex (pv "z1") (mk-and (formula-subst (a 0) (pv "x") (pt "z1"))
				  (pf "R zero zero z1"))))
(use-with a1-proof (pt "zero") (pt "S") 1 2 (pt "zero") DEFAULT-GOAL-NAME)
(use-with a0-proof (pt "zero") (pt "S") 1 2)
(assume "z1" 3)
(ex-intro (pt "z1"))
(split)
(use 3)
(use 3)

(define c1-proof (pproof-state-to-proof))

(set-goal
 (mk-all (pv "zero") (pv "S") (mk-imp hyp1-formula hyp2-formula (c0 2))))
(assume "zero" "S" 1 2)
(ex-elim (mk-ex (pv "z2") (mk-and (formula-subst (a 1) (pv "x") (pt "z2"))
				  (pf "R zero zero z2"))))
(use-with a2-proof (pt "zero") (pt "S") 1 2 (pt "zero") DEFAULT-GOAL-NAME)
(use-with a1-proof (pt "zero") (pt "S") 1 2)
(assume "z2" 3) ;Hyp_3: A1 z2 & R zero zero z2
(ex-intro (pt "z2"))
(split)
(use 3)
(ex-elim (mk-ex (pv "z1") (mk-and (formula-subst (a 0) (pv "x") (pt "z1"))
				  (pf "R zero z2 z1"))))
(use 3) 
(use-with a0-proof (pt "zero") (pt "S") 1 2)
(assume "z1" 4)
(ex-intro (pt "z1"))
(split)
(use 4)
(use 4)

(define c2-proof (pproof-state-to-proof))
; (dnp c2-proof)

(set-goal
 (mk-all (pv "zero") (pv "S") (mk-imp hyp1-formula hyp2-formula (c0 3))))
(assume "zero" "S" 1 2)
(ex-elim (mk-ex (pv "z3") (mk-and (formula-subst (a 2) (pv "x") (pt "z3"))
				  (pf "R zero zero z3"))))
(use-with a3-proof (pt "zero") (pt "S") 1 2 (pt "zero") DEFAULT-GOAL-NAME)
(use-with a2-proof (pt "zero") (pt "S") 1 2)
(assume "z3" 3) ;Hyp_3: A2 z3 & R zero zero z3
(ex-intro (pt "z3"))
(split)
(use 3)
(ex-elim (mk-ex (pv "z2") (mk-and (formula-subst (a 1) (pv "x") (pt "z2"))
				  (pf "R zero z3 z2"))))
(use 3)
(use-with a1-proof (pt "zero") (pt "S") 1 2)
(assume "z2" 4)
(ex-intro (pt "z2"))
(split)
(use 4)
(ex-elim (mk-ex (pv "z1") (mk-and (formula-subst (a 0) (pv "x") (pt "z1"))
				  (pf "R zero z2 z1"))))
(use 4)
(use-with a0-proof (pt "zero") (pt "S") 1 2)
(assume "z1" 5)
(ex-intro (pt "z1"))
(split)
(use 5)
(use 5)

(define c3-proof (pproof-state-to-proof))
; (dnp c3-proof)

;Local Variables:
;mode: scheme
;End:
