; $Id: bar.scm,v 1.7 2008/03/26 09:50:28 logik Exp $

; Based on Monika Seisenberger's Thesis "On the Constructive Content
; of Proofs", LMU 2003

; This file contains the definition of the inductive predicate Bar and
; examples for the use of the introduction and elimination axioms.

; We prove 
; - Bar [] implies that every infinite sequence has a good initial segment.
; - Bar ws*[].

; We will make use of these two Lemmas in higman-finite.scm.
; Therefore, we prove the statements for an alphabet consisting of
; natural numbers.

; 1. Definitions

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

; listrev.scm contains the type of reverse lists with the constructors
; Nil and Cons.  (Cons ws w) is displayed as ws::w.  The length of a
; list is denoted by Lh.

(define boole (py "boole"))
(define nat (py "nat"))
(define word (py "list nat"))
(define seq (py "list list nat"))

(remove-var-name "n" "k" "m")
(add-var-name "a" "b" "c" "i" "j" "k" "m" "n" nat)
(add-var-name "w" "u" "v" "x" "y" "z" "as" "bs" word)
(add-var-name "ws" "vs" "xs" "ys" "zs" seq)

(add-var-name "f" (make-arrow nat word))

; (add-program-constant "Init" (mk-arrow (mk-arrow nat word) nat seq) 1)
; (add-computation-rule (pt "Init f 0") (pt "(Nil list nat)"))
; (add-computation-rule (pt "Init f(Succ n)") (pt "Init f n::f n"))

; listrev.scm provides (f fbar n) for (Init f n)

; Emb, L, Good are inductive definitions without computational content.
; In the main text of the thesis, L vs v is Good(vs,v)

(add-ids (list (list "Emb" (make-arity word word)))
	 '("Emb(Nil nat)(Nil nat)" )
	 '("all v^,w^,a^(Emb v^ w^ -> Emb v^(w^ ::a^))")
         '("all v^,w^,a^(Emb v^ w^ -> Emb(v^ ::a^)(w^ ::a^))"))

(add-ids (list (list "L" (make-arity seq word)))
	 '("all vs^,v^,w^(Emb v^ w^ -> L(vs^ ::v^)w^)")
	 '("all vs^,v^,w^(L vs^ w^  -> L(vs^ ::v^)w^)"))

(add-ids (list (list "Good" (make-arity seq)))
	 '("all ws^,w^(L ws^ w^ -> Good(ws^ ::w^))")
	 '("all ws^,w^(Good ws^ -> Good(ws^ ::w^))"))

; Bar is an inductive predicate with computational content.  The
; `type' of Bar is algBar (or tree) with the constructors Leaf and
; Branch.

(add-ids (list (list "Bar" (make-arity seq) "algBar"))
	 '("allnc ws(Good ws -> Bar ws)" "Leaf")
	 '("allnc ws(all w Bar(ws ::w) -> Bar ws)" "Branch"))


; 2. The interactive proof

(set-goal
 (pf "allnc ws(Bar ws -> all f,n((f fbar n)=ws -> ex m Good(f fbar m)))"))
(assume "vs")

; Ind(Bar).
(elim)

; 1. Good ws
(assume "ws" "Good ws" "f" "n" "(f fbar n)=ws")
(ex-intro (pt "n"))
(simp "(f fbar n)=ws")
(use "Good ws")

; 2. all w Bar(ws ::w) 
(assume "ws" "all w Bar(ws ::w)" "IH" "f" "n" "(f fbar n)=ws")
(use-with "IH" (pt "f n") (pt "f") (pt "n+1") "?")

;f fbar(n+1)=(ws ::f n)
(ng)
(use "(f fbar n)=ws")
; Proof finished.
(save "BarThm")


; 3. The extracted program 

(add-var-name "ga" (py "list nat=>algBar"))
(add-var-name "gb" (py "list nat=>(nat=>list nat)=>nat=>nat"))

(pp (nt (proof-to-extracted-term (theorem-name-to-proof "BarThm"))))

; [algBar0]
;  (Rec algBar=>(nat=>list nat)=>nat=>nat)algBar0([f3,a4]a4)
;  ([ga3,gb4,f5,a6]gb4(f5 a6)f5(Succ a6))


; 4. We give a second example to demonstrate the use of the
; introduction axioms.

; Bar (ws*[])

(set-goal (pf "all w Emb(Nil nat)w"))
(ind)
(intro 0)
(assume "w" "a" "H1")
(intro 1)
(use "H1")
; Proof finished.
(save "EmbLemma")

(set-goal (pf "allnc ws Bar(ws ::(Nil nat))"))
(assume "ws")
(intro 1)
(assume "w")
(intro 0)    
(intro 0)       
(intro 0)      
(use "EmbLemma")
; Proof finished.
(save "Prop1")
                     
(pp (proof-to-extracted-term (theorem-name-to-proof "Prop1")))
; cBranch([w]cLeaf)

; A final comment: we could have reformulated our first statement:

;    allnc ws(Bar ws -> all f(Initial f ws -> ex m Good(f fbar m)))"))

; where  Initial f [] = True
;        Initial f (ws*w) = [if (f(Lh ws)=w) (Initial f ws) False]

; However, this would lead to problems concerning the CV-variables.
; since in case `Good ws',  we have to set m = Lh ws, but
; ws is a CV variable which must not be used in the interactive proof.

; In general, having a proof of Bar ws does not imply that we have given
; the object ws.
