; ***********************************************************
; ; 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 "./defsAxioms.scm")
; (pload "./trivial.scm")
; (pload "./auxSC.scm")

; NOTICE: Uncomment modules only when file is run on its own
; ***********************************************************


; =============================
;  Section: Global Auxiliaries
; =============================
; contains global auxiliaries used in more than one module.

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

; Lemma: "SubVar"
; ---------------
(add-global-assumption "SubVar"
 (pf "all k,ss,m.
               k<Lh ss -> Sub(Var k) (Wrap m ss) = 
               (k thof ss)"))

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

; Lemma: "TypJTyp"
; ----------------
(add-global-assumption "TypJTyp"
 (pf "all rhos,rho,r.
      TypJ rhos r rho -> rho = Typ rhos r"))


; Subsection: SCrs
; ================

; Lemma: "SCrsSTotal"
; -------------------
(add-global-assumption "SCrsSTotal"
 (pf "all sigs,rhos,as^,ss.
      SCrs sigs rhos as^ ss -> STotal as^"))

; Lemma: "SCrsLh"
; ---------------
(add-global-assumption "SCrsLh"
 (pf "all sigs,rhos,as^,ss.SCrs sigs rhos as^ ss ->
 (Lh as^ =Lh rhos & Lh rhos=Lh ss)"))

; Lemma: "SCrsDefRev"
; -------------------
(add-global-assumption
 "SCrsDefRev"
 (pf "all sigs,rho,rhos,a^,as^,s,ss.
      SCrs sigs(rho::rhos)(a^ ::as^)(s::ss) ->
      (SCr sigs rho a^s & SCrs sigs rhos as^ss)"))
; proof by inversion


; Subsection TypJExtCtx
; =====================

; Lemma: "TypJExtCtx"
; -------------------
; auxiliary for "TypJAppIntro"

(add-global-assumption "TypJExtCtx"
 (pf "all r,rhos,rho,sigs.
      TypJ rhos r rho -> TypJ (rhos :+: sigs) r rho"))


; Subsection: "TypJAppIntro"
; ==========================

; Lemma: "TypJAppIntro"
; ---------------------
(add-global-assumption "TypJAppIntro"
 (pf "all rhos,sigs,rho,sig,r,s.
     TypJ rhos r(rho to sig) -> TypJ(rhos:+:sigs)s rho -> 
     TypJ(rhos:+:sigs)(r s)sig"))


; Subsection: "TypJSub"
; =====================
; used for "Subject Reduction" and
; for an auxiliary for Lemma 3

; Definition: "TypJsSublist"
; --------------------------
; TypJ for a Sublist 
; (easier proofs than with list of terms)

(add-program-constant "TypJsSublist" 
  (py "list type=> Sublist => list type=> boole") 1)

(add-computation-rule (pt "TypJsSublist sigs (Up n) (Nil type)")
		      (pt "T"))
(add-computation-rule (pt "TypJsSublist sigs (Up n) (rho::rhos)")
		      (pt "F"))
(add-computation-rule (pt "TypJsSublist sigs (Dot r theta) (Nil type)")
		      (pt "F"))

(add-computation-rule (pt "TypJsSublist sigs (Dot r theta) (rho::rhos)")
		      (pt "(TypJ sigs r rho) and (TypJsSublist sigs theta rhos)"))

; Definition: "TypJs"
; -------------------
; TypJ for a list of terms

(add-program-constant "TypJs" 
  (py "list type=> list term => list type=> boole") 1)

(add-computation-rule (pt "TypJs sigs ss rhos")
		      (pt "TypJsSublist sigs (Wrap 0 ss) rhos"))

; Lemma: "TypJSub"
; ----------------
(add-global-assumption "TypJSub"
 (pf "all r,rhos, theta, sigs,rho.TypJ rhos r rho ->
      TypJsSublist sigs theta rhos -> 
      TypJ sigs (Sub r theta) rho"))
