; $Id: surj.scm,v 1.3 2008/01/25 13:30:17 logik Exp $

; We show classically the existence of an n such that h(s(h n)) \ne n
; and extract a (somewhat unexpected) program from it (due to U.Berger)

; It suffices to prove 0=s(h(h 0)).  This is done as follows.
; Assume n=h(s(h n)) for all n.

; 0 = h(s(h 0))           by assumption for 0
;   = h(s(h(s(h(h 0)))))  by assumption for h 0 and compatibility
;   = s(h(h 0))           by assumption for s(h(h 0))

; To convert this into a proof in minimal logic of the classical
; existence formula, we have to double negate equations.

(libload "nat.scm")
(add-var-name "f" "h" "s" (py "nat=>nat"))

(add-pvar-name "P" (make-arity))

(set-goal (pf "(P1 -> P2) -> ((P1 -> bot) -> bot) -> (P2 -> bot) -> bot"))
(prop)
(save "D-Neg-Imp")

(set-goal (pf "(P1 -> P2 -> P3) ->
   ((P1 -> bot) -> bot) -> ((P2 -> bot) -> bot) -> (P3 -> bot) -> bot"))
(prop)
(save "D-Neg-Imp-2")

(add-global-assumption "Trans-=" (pf "all n,m,k.n=m -> m=k -> n=k"))
(add-global-assumption "Compat" (pf "all f,n,m.n=m -> f n=f m"))
(add-global-assumption "Comm" (pf "all n,m.n=m -> m=n"))

(set-goal (pf "all s,h.(all n.0=s n -> bot) -> excl n.n=h(s(h n)) -> bot"))
(assume "s" "h" "s-not-0" "neg-neg-n-is-hshn")
(inst-with-to "s-not-0" (pt "h(h 0)") "s-not-0-inst")
(drop "s-not-0")
(cut (pf "(0=s(h(h 0)) -> bot) -> bot"))
(prop)
(assume "neg-s-not-0-inst")
(drop "s-not-0-inst")
(use-with (theorem-name-to-proof "D-Neg-Imp-2")
	  (make-cterm (pf "0=h(s(h 0))"))
	  (make-cterm (pf "h(s(h 0))=s(h(h 0))"))
	  (make-cterm (pf "0=s(h(h 0))")) "?" "?" "?" "?")
(use "Trans-=")
(use "neg-neg-n-is-hshn")
(use-with (theorem-name-to-proof "D-Neg-Imp-2")
	  (make-cterm (pf "h(s(h 0))=h(s(h(s(h(h 0)))))"))
	  (make-cterm (pf "h(s(h(s(h(h 0)))))=s(h(h 0))")) 
	  (make-cterm (pf "h(s(h 0))=s(h(h 0))")) "?" "?" "?")
(use "Trans-=")
(use-with (theorem-name-to-proof "D-Neg-Imp")
	  (make-cterm (pf "s(h 0)=s(h(s(h(h 0))))"))
	  (make-cterm (pf "h(s(h 0))=h(s(h(s(h(h 0)))))")) "?" "?")
(use "Compat")
(use-with (theorem-name-to-proof "D-Neg-Imp")
	  (make-cterm (pf "h 0=h(s(h(h 0)))"))
	  (make-cterm (pf "s(h 0)=s(h(s(h(h 0))))")) "?" "?")
(use "Compat")
(use "neg-neg-n-is-hshn")
(use-with (theorem-name-to-proof "D-Neg-Imp")
	  (make-cterm (pf "s(h(h 0))=h(s(h(s(h(h 0)))))"))
	  (make-cterm (pf "h(s(h(s(h(h 0)))))=s(h(h 0))")) "?" "?")
(use "Comm")
(use "neg-neg-n-is-hshn")
(use "neg-s-not-0-inst")

(dnpe)
; (lambda (s)
;   (lambda (h)
;     (lambda (|99|)
;       (lambda (|100|)
;         ((|100| (s (h (h "0"))))
;          (lambda (|101|)
;            ((|100| (h "0"))
;             (lambda (|102|)
;               ((|100| "0")
;                (lambda (|103|)
;                  ((|99| (h (h "0")))
;                   (((((|Trans-=| "0") (h (s (h "0")))) (s (h (h "0"))))
;                     |103|)
;                    (((((|Trans-=| (h (s (h "0"))))
;                        (h (s (h (s (h (h "0")))))))
;                       (s (h (h "0"))))
;                      ((((|Compat| h) (s (h "0"))) (s (h (s (h (h "0"))))))
;                       ((((|Compat| s) (h "0")) (h (s (h (h "0")))))
;                        |102|)))
;                     (((|Comm| (s (h (h "0")))) (h (s (h (s (h (h "0")))))))
;                      |101|))))))))))))))

(define min-excl-proof (current-proof))
(formula-to-string (fold-formula (proof-to-formula min-excl-proof)))
; "all s,h.(all n.0=s n -> bot) -> excl n.n=h(s(h n)) -> bot"

(mload "../modules/atr.scm")

(define et (atr-min-excl-proof-to-structured-extracted-term min-excl-proof))
(term-to-string (nt et))

; With renaming (f0 -> s and f1 -> h) and indentation

; [s,h][if (s(h(h 0))=h(s(h(s(h(h 0))))))
; 	 [if (h 0=h(s(h(h 0))))
; 	     0
; 	     (h 0)]
; 	 (s(h(h 0)))]
