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


; ===================================
;  Section: Definition of Predicates
; ===================================
; contains the definitions of N, A, H

; Subsection: Global Definitions
; ==============================

; Definition: "--->"
; ------------------
; folds a list of types with the last type

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

(add-computation-rule (pt " ---> (Nil type) rho") (pt "rho"))
(add-computation-rule (pt " ---> (sig::rhos) rho")
                      (pt "sig to (---> rhos rho)"))


; Subsection: Definition of N
; ===========================

; Subsubsection: BN
; :::::::::::::::::

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

(add-computation-rule (pt "FoldApp r (Nil term)")
                      (pt "r"))
(add-computation-rule (pt "FoldApp r (s::ss)")
                      (pt "FoldApp (r s) ss"))

(pp (nt (pt "FoldApp (r) (s::t:)")))
; => r s t

; Definition: "BN", "BNs"
; -----------------------
; simultaneous inductive definition of "BN" and "BNs"

(add-ids (list
 (list "BN" (make-arity (py "term") (py "term")) )
 (list "BNs" (make-arity (py "list term") (py "list term")) ))
  '("all n, rs, ss. BNs rs ss ->
     BN (FoldApp (Var n) rs) (FoldApp (Var n) ss)" "BNVar")
  '("all rho, r,s. BN r s -> BN (Abs rho r) (Abs rho s)" "BNAbs")
  '("all rho, r,s,t,rs. BN (FoldApp (Sub r (Wrap 0 (s:))) rs) t ->
     BN (FoldApp (Abs rho r) (s::rs)) t" "BNBeta")
  '("BNs (Nil term) (Nil term)" "BNsNil")
  '("all r,s,rs,ss. BN r s -> BNs rs ss -> BNs (r::rs) (s::ss)" 
    "BNsCons"))


; Subsubsection: Exp
; ::::::::::::::::::

; Definition: "Eta"
; -----------------
; recursive definition of Eta (=outside/brute force expansion)
; which is used for the definition of Exp

(add-program-constant "Eta" (py "type => term => term") 1)

(add-computation-rule (pt "Eta Iota r")
                      (pt "r"))
(add-computation-rule (pt "Eta (rho to sig) r")
 (pt "Abs rho (Eta sig ((Lift r 0 1) (Eta rho (Var 0))))"))

(pp (nt (pt "Eta ((Iota to Iota) to Iota) ((Var 3))")))

; Notice that the "1" (i.e., the totality) of Eta must be proved.
; This is easy, by induction on types.


; Definition: "Exp", "Exps"
; -------------------------
; "Exp" and "Exps" are defined simultaneously
; Exp t s means s is the eta-expanded form of t
; (since we only need t to be in beta-reduced form
; t is restricted to this form to keep proofs shorter)

(add-ids (list
          (list "Exp" (make-arity (py "list type") (py "type")
              (py "term") (py "term")) )
          (list "Exps" (make-arity (py "list type") (py "list type")
              (py "list term") (py "list term")) ))
  '("all rhos, sigs, rs, ss, k, t, rho.
     TypJ rhos (Var k) (---> sigs rho) ->
     Exps rhos sigs rs ss ->
     t = Eta rho (FoldApp (Var k) ss) ->
     Exp rhos rho (FoldApp (Var k) rs) t"
    "ExpVar")
  '("all rhos1,rhos2,sigs,taus,rho,sig,r,s,k.
     TypJ ((rhos1:+:rhos2):+:sigs) (Var k) rho ->
     Exp (rhos1:+:rhos2) sig r s ->
     TypJ rhos1 (ABS k rho r) (rho to sig) ->
     Exp (rhos1 :+: taus)(rho to sig)
      (ABS k rho r) (ABS k rho s)"  "ExpAbs")
  '("all rhos. Exps rhos (Nil type) (Nil term)
                         (Nil term)" "ExpsNil")
  '("all rhos,sigs,r,s,rs,ss. 
     Exp rhos rho r s -> Exps rhos sigs rs ss ->
     Exps rhos (rho::sigs) (r::rs) (s::ss)" "ExpsCons"))


; SubSubsection: Definition of NInd
; :::::::::::::::::::::::::::::::::
; N r s means s is the long normal form of r
; i.e. the beta-reduced and eta-expanded form of r

; Definition: NInd
; ----------------
(add-ids (list (list 
 "NInd" (make-arity (py "list type")(py "type")
                    (py "term") (py "term")) ))
 '("all rhos,rho,r,s,t.
    TypJ rhos r rho -> BN r t -> Exp rhos rho t s -> 
    NInd rhos rho r s" "NIntro"))

; Definition: "N"
; ---------------
(add-global-assumption "NDef" 
 (pf "all rhos,rho,r^,s^. N rhos rho r^ s^ -> 
      NInd rhos rho r^ s^"))

(add-global-assumption "NDefRev" 
 (pf "all rhos,rho,r^,s^.NInd rhos rho r^ s^ ->
      N rhos rho r^ s^ "))


; SubSubsection: Definition of Head
; :::::::::::::::::::::::::::::::::

; Definition: "HeadInd"
; ---------------------
(add-ids (list (list 
 "HeadInd" (make-arity (py "term") (py "term")) ))
 '("all rho,r,s,rs.HeadInd (FoldApp ((Abs rho r)s) rs)
  (FoldApp (Sub r(Dot s (Up 0))) rs)" "HeadCon"))

; Definition: "HeadDef" "HeadDefRev"
; ----------------------------------
(add-global-assumption "HeadDef" 
 (pf "all r,s. Head r s -> HeadInd r s"))

(add-global-assumption "HeadDefRev" 
 (pf "all r,s.HeadInd r s -> Head r s"))


; SubSubsection: Definition of A
; ::::::::::::::::::::::::::::::

; Definition: "AInd"
; ------------------
(add-ids (list (list "AInd" (make-arity (py "list type")(py "type")
 (py "term") (py "term")) ))
  '("all rhos,rho, k. TypJ rhos (Var k) rho -> 
     AInd rhos rho (Var k) (Var k)" "AIndVar")
  '("all rhos,rho,sig,r,s,r1,s1. 
     AInd rhos (rho to sig) r s ->
     TypJ rhos r1 rho -> NInd rhos rho r1 s1 ->
     AInd rhos sig (r r1) (s s1)" "AIndApp"))

; Definition: "A"
; ---------------
(add-global-assumption "ADef" 
 (pf "all rhos,rho,r,s. A rhos rho r s -> AInd rhos rho r s"))

(add-global-assumption "ADefRev" 
 (pf "all rhos,rho,r,s. AInd rhos rho r s -> A rhos rho r s"))
