; ***********************************************************
; ; 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:
; (pload "./initiate.scm")
; (pload "./defsLamCalc.scm")
; (pload "./defsSubst.scm")
; (pload "./omega.scm")
; (pload "./defsNT.scm")
; (pload "./defsAxiomsSpecial.scm")
; (pload "./trivial.scm")
; (pload "./auxGlobal_SHORT.scm")
;
; NOTICE: Uncomment modules only when file is run on its own
; ***********************************************************


; ==================================
;  Section: Auxiliaries for Lemma 1
; ==================================
; contains all auxiliaries for Lemma 1

; Lemma: "Aux1Aux"
; ----------------
; auxiliary for "LemmaOneAux1"

(set-goal (pf "all rho,k,rhos.
 Lh rhos + Lh(ExtCtx rhos k rho) < Succ k -> F"))

(assume "rho")
(ind)
(cases)
(ng)
(prop)

(assume "sig" "rhos")
(ng)
(prop)

(assume "k" "IH")
(cases)
(ng)
(inst-with "IH" (pt "(Nil type)"))
(ng)
(prop)

(assume "sig" "rhos")
(inst-with "IH" (pt "rhos"))
(ng)
(prop)
(save "Aux1Aux")

; Lemma: "Aux1Aux2"
; -----------------
(set-goal 
  (pf "all rho,rhos, k. (k<Lh rhos -> F) -> 
       Typ(rhos:+:ExtCtx rhos k rho)(Var k)=rho"))

(assume "rho")
(ind)
(ind)
(assume 1)
(ng)
(prop)

(assume "k" "IH")
(assume 2)
(ng)
(inst-with "IH" 2)
(use 3)

(assume "sig" "rhos" "IH")
(cases)
(assume 2)
(ng)
(prop)

(assume "k" 1)
(ng)

(inst-with "IH" (pt "k") 2)
(use 3)
(save "Aux1Aux2")

; Lemma: "LemmaOneAux1"
; ---------------------
(set-goal
  (pf "all rhos,rho,sig,r,k.
        Fr rhos(rho to sig)r k -> 
        TypJ(rhos:+:(ExtCtx rhos k rho))(Var k)rho")) 

(assume "rhos" "rho" "sig" "r" "k" 1)
(ng)
(split)
(assert (pf "Lh rhos + Lh(ExtCtx rhos k rho) < Succ k -> F"))
(use "Aux1Aux")
(use "Trivial3")

(ng)
(assert (pf "k < Lh rhos -> F"))
(use "FrDef" (pt "(rho to sig)") (pt "r"))
(use 1)
(use "Aux1Aux2")
(save "LemmaOneAux1")

; Lemma: "Aux2Aux"
; ----------------
(set-goal
 (pf "all rhos,rho,sig,r,k.
      Fr rhos(rho to sig)r k -> 
      TypJ(rhos:+:(ExtCtx rhos k rho)) r (rho to sig)"))

(assume "rhos" "rho" "sig" "r" "k" 1)
(assert (pf "TypJ rhos r (rho to sig)"))
(use "FrDef" (pt "k"))
(use 1)
(assume 2)
(use "TypJExtCtx")
(use 2)
(save "Aux2Aux")

; Lemma: "LemmaOneAux2"
; ---------------------
(set-goal
 (pf "all rhos,rho,sig,r,k.
      Fr rhos(rho to sig)r k -> 
      TypJ(rhos:+:(ExtCtx rhos k rho))(r(Var k))sig"))

(assume "rhos" "rho" "sig" "r" "k" 1)
(use "TypJArrow" (pt "rho"))
(use "Aux2Aux")
(use 1)
(use "LemmaOneAux1" (pt "sig") (pt "r") )
(use 1)
(save "LemmaOneAux2")


; Lemma: "Aux3Aux"
; ----------------
(set-goal
 (pf "all rhos,rho,k.
      (k < Lh rhos -> F) ->
       Lh (rhos:+:(ExtCtx rhos k rho)) = (Succ k)"))

(ind)
(assume "rho")
(ind)
(assume 1)
(ng)
(prop)

(assume "k" "IH" 1)
(ng)
(inst-with "IH" 2)
(use 3)

(assume "rho" "rhos" "IH")
(assume "sig")
(cases)
(assume 1)
(ng)
(prop)

(assume "k")
(assume 3)
(ng)
(inst-with "IH" (pt "sig") (pt "k") 2)
(use 3)
(save "Aux3Aux")

; Lemma: "LemmaOneAux3"
; ---------------------
(set-goal
 (pf "all rhos,rho,sig,r,k.
        Fr rhos(rho to sig)r k -> 
        Fr(rhos:+:(ExtCtx rhos k rho))sig(r(Var k))(k+1)"))

(assume "rhos" "rho" "sig" "r" "k" 1)
(ng)
(use "FrDefRev")
(use "LemmaOneAux2")
(use 1)
(assert (pf "Lh (rhos:+:(ExtCtx rhos k rho)) = (Succ k)"))
(use "Aux3Aux")
(use "FrDef" (pt "(rho to sig)") (pt "r"))
(use 1)
(use "Trivial4")
(save "LemmaOneAux3")

; Lemma: "LemmaOneAux5"
; ---------------------
(set-goal
 (pf "all rhos,sigs,rho,sig,r,s,k.
      Fr(rhos:+:sigs)sig(r s)k -> TypJ(rhos:+:sigs)s rho ->
      Fr(rhos:+:sigs)rho s k"))

(assume "rhos" "sigs" "rho" "sig" "r" "s" "k")
(assume 1 2)
(use "FrDefRev")
(use 2)
(use "FrDef" (pt "sig") (pt "(r s)"))
(use 1)
(save "LemmaOneAux5")

; Lemma: "Aux7Aux"
; -----------------
(set-goal (pf "all rhos, sigs.
               Lh (rhos:+:sigs) < Lh rhos -> F"))

(assume "rhos")
(ind)
(ng)
(use "Trivial1")

(assume "sig" "sigs" "IH")
(assume 1)
(ng)
(use 1)
(assert (pf "Lh rhos+Lh sigs < Succ(Lh rhos+Lh sigs)"))
(prop)
(assume 3)
(assert (pf "Lh rhos+Lh sigs<Succ(Lh rhos+Lh sigs) &  
             Succ(Lh rhos+Lh sigs)<Lh rhos"))
(prop)
(use "Transitivity")
(save "Aux7Aux")

; Lemma: "LemmaOneAux7"
; ---------------------
(set-goal
 (pf "all rhos,sigs,rho,sig,r,s,k.
      Fr(rhos:+:sigs)sig(r s)k ->
      TypJ rhos r(rho to sig) ->
      Fr rhos(rho to sig)r k"))

(assume "rhos" "sigs" "rho" "sig" "r" "s" "k")
(assume 1 2)
(use "FrDefRev")
(use 2)
(assert (pf "k<Lh (rhos:+:sigs) -> F"))
(use "FrDef" (pt "sig") (pt "(r s)"))
(use 1)
(assert (pf "Lh (rhos:+:sigs) < Lh rhos -> F"))
(use "Aux7Aux")
(use "Transitivity 2")
(save "LemmaOneAux7")

; Lemma: "LemmaOneAux8"
; ---------------------
; an auxiliary for LemmaOne, which is used several times

(set-goal (pf "all rhos, sigs, rho, s.
               ex b^ (SCr (rhos:+:sigs) rho b^ s) ->
               TypJ (rhos:+:sigs) s rho"))

(assume "rhos" "sigs" "rho" "s" "[SC]")
(by-assume-with "[SC]" "b^" "[SC Body]")
(use "SCrUnfoldTwo" (pt "b^"))
(use "[SC Body]")
(save "LemmaOneAux8")
