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

; =======================================
;  Section: Global Proofs for the Axioms
; =======================================
; contains global lemmas and definitions for
; the proofs of the axioms

; Subsection: "Miscellaneous"
; ==========================

; Definition: "Typs"
; ------------------
(add-program-constant "Typs" 
 (py "list type => list term => list type") 1)

(add-computation-rule (pt "Typs rhos (Nil term)")
                      (pt "(Nil type)"))
(add-computation-rule (pt "Typs rhos (r::rs)")
                      (pt "(Typ rhos r)::(Typs rhos rs)"))

; Lemma: "CorTypJ"
; ---------------
(set-goal
 (pf "all rhos, r.Cor rhos r -> TypJ rhos r (Typ rhos r)"))

(assume "rhos" "r" 1)
(ng)
(use 1)
(save "CorTypJ")

; Lemma: "TypJFoldHead"
; ---------------------
(add-global-assumption "TypJFoldHead"
 (pf "all rhos,rho,r,s,rs.
 TypJ rhos (FoldApp r rs) rho ->
 TypJ rhos s (Typ rhos r) ->
 TypJ rhos (FoldApp s rs) rho"))

; Lemma: "TypJFoldHeadCor"
; ------------------------
(add-global-assumption "TypJFoldHeadCor"
 (pf "all rhos,rho,sig,r,s,rs.
 TypJ rhos (FoldApp (Abs rho r s) rs) sig ->
 Cor rhos (Abs rho r s)"))


; Subsection: "SR"
; ================
; "SR" stands for "Subject Reduction";
; needed for Ax8, BNTypJ and Ax1

; Subsubsection: Auxiliaries for "SR"
; :::::::::::::::::::::::::::::::::::
; ...
; Subsubsection: Proof of "SR"
; ::::::::::::::::::::::::::::

; Lemma: "SR"
; -----------
(add-global-assumption "SR"
 (pf "all rhos,rho,sig,r,s.
 TypJ rhos ((Abs sig r) s) rho -> 
 TypJ rhos (Sub r (Wrap 0 (s:))) rho"))


; Subsection: "ExpTypJ"
; =====================

; Subsubsection: Auxiliaries for "ExpTypJ"
; ::::::::::::::::::::::::::::::::::::::::

; Definition: "OR"
; ----------------
(add-program-constant "OR" 
 (py "boole => boole => boole") 1)

(add-computation-rule (pt "OR F F ")
                      (pt "F"))
(add-computation-rule (pt "OR T F ")
                      (pt "T"))
(add-computation-rule (pt "OR F T ")
                      (pt "T"))
(add-computation-rule (pt "OR T T ")
                      (pt "T"))

; Definition: "Occurs"
; --------------------
(add-program-constant "Occurs" 
 (py "nat => term => boole") 1)

(add-computation-rule (pt "Occurs 0 (Var 0) ")
                      (pt "T"))
(add-computation-rule (pt "Occurs 0 (Var (Succ n)) ")
                      (pt "F"))
(add-computation-rule (pt "Occurs (Succ n) (Var 0) ")
                      (pt "F"))
(add-computation-rule (pt "Occurs n (r s) ")
 (pt "OR (Occurs n r) (Occurs n s)"))
(add-computation-rule (pt "Occurs n (Abs rho s) ")
                      (pt "Occurs (Succ n) s"))

; Definition: "Occurss"
; ---------------------
(add-program-constant "Occurss" 
 (py "nat => list term => boole") 1)

(add-computation-rule (pt "Occurss n (Nil term)")
                      (pt "F"))
(add-computation-rule (pt "Occurss n (r::rs)")
 (pt "OR (Occurs n r) (Occurss n rs)"))

; Subsubsection: Proof of "ExpTypJ"
; :::::::::::::::::::::::::::::::::
; contains "ExpTypJLeft" "ExpTypJRight" and
; "ExpTypJ"

; Lemma: "ExpTypJLeft"
; --------------------
(add-global-assumption "ExpTypJLeft"
 (pf "all rhos,rho,r,s.
 Exp rhos rho r s -> 
 TypJ rhos r rho"))

; Lemma: "ExpTypJRight"
; --------------------
(add-global-assumption "ExpTypJRight"
 (pf "all rhos,rho,r,s.
 Exp rhos rho r s -> 
 TypJ rhos s rho"))

; Lemma: "ExpTypJ"
; ----------------
(add-global-assumption "ExpTypJ"
 (pf "all rhos,rho,r,s.
 Exp rhos rho r s -> 
 TypJ rhos r rho & TypJ rhos s rho"))


; Subsection: "BNTypJ"
; ====================

; Subsubsection: Auxiliaries for "BNTypJ"
; :::::::::::::::::::::::::::::::::::::::

; Subsubsection: Proof of "BNTypJ"
; ::::::::::::::::::::::::::::::::

; Lemma: "BNTypJ"
; ---------------
(add-global-assumption "BNTypJ"
 (pf "all r,s.
 BN r s -> 
 all rhos,rho.TypJ rhos r rho ->
 TypJ rhos s rho"))


; Subsection: "NTypJ"
; ===================
; not used explicitly, but for "N" to be
; a proper definition the formula
; "TypJ rhos r rho -> N rhos rho r s -> TypJ rhos s rho"
; is implicitly required.
;
; Our Definition of "N" has the property
; that the type judgements follow directly from "N".
; Hence N rhos rho r s means exactly that 
; "s" is the long Normalform of "r" 
; in the given context with the given type

; Lemma: "NIndTypJ"
; -----------------
(add-global-assumption "NIndTypJ"
 (pf "all rhos,rho,r,s.
 TypJ rhos r rho ->
 NInd rhos rho r s -> 
 TypJ rhos s rho"))