; $Id: auxNT.scm,v 1.3 2008/01/25 13:30:20 logik Exp $
; ***********************************************************
; ; Adapt path if necessary:
; (define path "~/minlog/examples/tait/diplomarbeit_schlenker/")

; ; Defines the function "pload" to load files 
; ; from the path defined above
; (define pload (lambda (x) (load (string-append path x))))

; ; Used Modules:
; (load "./initiate.scm")
; (load "./defsLamCalc.scm")
; (load "./defsSubst.scm")
; (load "./omega.scm")
; (load "./defsNT.scm")
; (load "./defsAxiomsSpecial.scm")
; (load "./defsAxioms.scm")
; (load "./trivial.scm")
; (load "./auxSC.scm")
; (load "./auxGlobal_SHORT.scm")
; (load "./auxLem1_SHORT.scm")
; (load "./Lem1.scm")
;
; NOTICE: Uncomment modules only when file is run on its own
; ***********************************************************


; ====================================================
;  Section: Auxiliaries for the Normalization Theorem
; ====================================================
; contains all auxiliaries for the Normalization Theorem

; Subsection: "SCrsSeq"
; =====================

; Lemma: "TypJVar"
; ----------------
(set-goal (pf "all sigs,rhos,rho 
 TypJ(sigs:+: (rho::rhos))(Var Lh sigs)rho"))

(ind)
; Base Case: (Nil type)
(assume "rhos" "rho")
(ng)
(use "Truth-Axiom")
; Step Case: (sig :: sigs)
(assume "sig" "sigs" "IH")
(assume "rhos" "rho")
(ng)
(use "IH")
(save "TypJVar")

; Lemma: "SCrsSeq"
; ----------------
; Note: Lemma has computational content

(set-goal
 (pf "all rhos,sigs ex as^.
 SCrs(sigs:+:rhos)rhos as^ (Var map(Seq(Lh sigs)(Lh rhos)))"))

(ind)
; Base Case: (Nil type)
(assume "sigs")
(ex-intro (pt "(Nil omega)"))
(simp "ListAppendNil")
(use "SCrsDefNil")

; Step Case: r :: rhos
(assume "rho" "rhos" "[IH]" "sigs")
(inst-with-to "[IH]" (pt "sigs:+:rho:") "[IH 2]")
(by-assume-with "[IH 2]" "as^" "[IHInst]")
(assert (pf "ex a^ SCr(sigs:+: (rho::rhos)) rho a^(Var(Lh sigs))"))
(use "LemmaOne")
(use "TypJVar")
(assume "k" 4)
(ex-intro (pt "Var Lh sigs"))
(use "Ax3")
(use "TypJVar")
(assume "[SC]")
(by-assume-with "[SC]" "a^" "[SC Body]")
(ex-intro (pt "a^ ::as^"))
(ng #t)
(use "SCrsDef")
(use "SCrsSTotal" (pt "(sigs:+:rho: :+:rhos)") 
 (pt "rhos")(pt "(Var map Seq Lh(sigs:+:rho:)Lh rhos)"))
(prop)
(use "[SC Body]")
(simp (pf "(sigs:+:(rho::rhos))=(sigs:+:rho: :+:rhos)"))
(use "[IHInst]")
(simp "ListAppendAssoc")
(use "Truth-Axiom")
(save "SCrsSeq")


; Subsection: "SubIds"
; ====================

; Lemma: "LhSeq"
; --------------
(set-goal (pf "all l,n Lh(Seq n l)=l"))

(ind)
(assume "n")
(use "Truth-Axiom")
(assume "l" "[IH]")
(assume "n")
(ng)
(use "[IH]")
(save "LhSeq")

; Lemma: "ListRefMap"
; -------------------
(set-goal (pf "all alpha1=>alpha2,(list alpha1),nat.nat<Lh(list alpha1) ->
               Equal(nat thof(alpha1=>alpha2 map(list alpha1)))
                    (alpha1=>alpha2(nat thof(list alpha1)))"))
(assume "alpha1=>alpha2")
(ind)
(assume "nat" "Absurd")
(use "Efq")
(use "Absurd")
(assume "alpha1" "list alpha1" "IH")
(cases)
(assume "Trivial")
(ng)
(use "Eq-Refl")
(assume "nat" "nat<Lh List alpha1")
(ng)
(use "IH")
(use "nat<Lh List alpha1")
(save "ListRefMap")

; Lemma: "ListRefSeq"
; -------------------
; k-th element of Seq

(set-goal (pf "all l,k,n.k<l -> (k thof Seq n l)=k+n"))

(ind)
(assume "n" "k" "[Absurd]")
(use "Efq")
(use "[Absurd]")
(assume "l" "[IH]")
(cases)
(assume "k" "[Trivial]")
(use "Truth-Axiom")
(assume "k" "n" "[k<l]")
(ng)
(use-with "[IH]" (pt "k") (pt "Succ n") "[k<l]")
(save "ListRefSeq")

; Lemma: "AuxSubIds"
; ------------------
; an auxiliary for "SubIds" (used as a rewrite-rule).

(set-goal (pf "all m,n,l.Wrap (Succ n) (Var map Seq (Succ l) m) =
Sublift (Wrap n(Var map Seq l m)) 1"))

(ind)
(auto)
(save "AuxSubIds")

(add-rewrite-rule (pt "Wrap (Succ n) (Var map Seq (Succ l) m)")
              (pt "Sublift (Wrap n(Var map Seq l m)) 1"))

; Lemma: "SubIds"
; ---------------
(set-goal (pf "all r,rhos, n.Cor rhos r -> 
 Sub r (Wrap n (Var map(Seq 0(Lh rhos))))=r"))

(ind)
(assume "k" "rhos" "n" "[Cor]")
(simp "SubVar")
(simp "ListRefMap")
(simp "ListRefSeq")
(auto)
(simp "LhSeq")
(auto)
(simp "LhMap")
(simp "LhSeq")
(auto)

; App
(assume "r" "s" "[IHr]" "[IHs]" "rhos" "n" "[Cor]")
(ng)
(split)
(use "[IHr]")
(use-with "[Cor]" 'left 'left)
(use "[IHs]")
(use-with "[Cor]" 'left 'right)

; Abs
(assume "rho" "r" "[IHr]" "rhos" "n" "[Cor]")
(ng)
(assert 
 (pf "Sub r (Wrap (Succ n) (Var map Seq 0 Lh(rho::rhos)))=r"))
(use "[IHr]")
(use "[Cor]")
(assume "[EqHyp]")
(ng)
(auto)
(save "SubIds")


; Subsection: "FrIntro1"
; ======================

; Lemma: "FrIntro1"
; -----------------
(set-goal (pf "all rhos,r,rho.
 TypJ rhos r rho -> Fr rhos rho r(Lh rhos)"))

(assume "rhos" "r" "rho" 1)
(use "FrDefRev")
(use 1)
(use "Trivial1")
(save "FrIntro1")
