; $Id: tait.scm,v 1.3 2008/01/25 13:30:20 logik Exp $
; Based on examples/sn.scm, from 2005-01-08 to NTheorem

; ***************************************************************
; This is the central file, which loads all the other modules.
; Running this file requires the head information of all other 
; modules to be uncommented (see also the README file).
; ***************************************************************

; =======================
;  Section: Preparations
; =======================

; Subsection: Defining "pload"
; ============================
; 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))))


; Subsection: Initiation of Minlog
; ================================
(pload "./initiate.scm")


; Subsection: Lambda Calculus
; ===========================
; Subsubsection: Definitions for the Lambda-Calculus
; --------------------------------------------------
(pload "./defsLamCalc.scm")

; Subsubsection: Substitution
; ---------------------------
; Substitution in "de Bruijn"-style

; definitions for substitution
(pload "./defsSubst.scm")

; Joachimski-Section
(pload "./subst_Joachimski.scm")
;(pload "./subst_Joachimski_SHORT.scm")

; Subsubsection: Omega
; --------------------
(pload "./omega.scm")


; ================================
;  Section: Normalization Theorem
; ================================

; Subsection: Specific Definitions
; ================================
; specific definitions for the Normalization Theorem

; Subsubsection: General Definitions
; ----------------------------------
(pload "./defsNT.scm")
(pload "./defsAxiomsSpecial.scm")


; Subsection: Preceding Lemmas
; ============================
; Trivial Lemmas
; --------------
(pload "./trivial.scm")

; Global Auxiliaries
; ------------------
(pload "./auxGlobal.scm")
;(pload "./auxGlobal_SHORT.scm")


; Subsection: Axioms
; ===================
; Subsubsection: Proof of the Axioms
; ----------------------------------
; needs to be uncommented when Axioms 
; are used without proof (see below)
(pload "./defsPred.scm")
(pload "./proofAxiomsGlobal.scm")
;(pload "./proofAxiomsGlobal_SHORT.scm")
(pload "./proofAxiomsPart1.scm")
(pload "./proofAxiomsPart2.scm")

; Subsubsection: Definition of the Axioms
; ---------------------------------------
; needs to be uncommented 
; if proven Axioms are used (see above)
; (pload "./defsAxioms.scm")


; Subsection: Proof of original SC-Definition
; ===========================================
(pload "./auxSC.scm")


; Subsection: Lemma 1
; ===================
; Subsubsection: Auxiliaries for Lemma 1
; --------------------------------------
(pload "./auxLem1.scm")
;(pload "./auxLem1_SHORT.scm")

; Subsubsection: Lemma 1
; ----------------------
(pload "./Lem1.scm")


; Subsection: Lemma 2
; ===================
(pload "./Lem2.scm")


; Subsection: Lemma 3
; ===================
; Subsubsection: Auxiliaries for Lemma 3
; --------------------------------------
(pload "./auxLem3.scm")
;(pload "./auxLem3_SHORT.scm")

; Subsubsection: Lemma 3
; ----------------------
(pload "./Lem3.scm")


; Subsection: Normalization Theorem
; =================================
; Subsubsection: Auxiliaries for the Normalization Theorem
; --------------------------------------------------------
(pload "./auxNT.scm")
;(pload "./auxNT_SHORT.scm")

; Subsubsection: Normalization Theorem
; ------------------------------------
(pload "./NT.scm")


; =============================
;  Section: Program Extraction 
; =============================

; Subsection: Preparations
; ========================

(define SCLemmas
 '("LemmaSCIotaFold" "LemmaSCIotaUnfold" 
   "LemmaSCFold" "LemmaSCUnfold"))

(define AllLemmas (append SCLemmas 
 '("LemmaOne" "LemmaTwo" "LemmaThree")))

(define (theorem-name-to-expanded-proof name names)
  (expand-theorems (theorem-name-to-proof name)
                   (lambda (x) (member x names))))

(add-var-name "p" (py "(omega=>nat=>term)@@((nat=>term)=>omega)"))
(add-var-name "q" (py "list type=>list omega=>omega"))
(add-var-name "d" (py "list type=>list omega"))


; Subsection: Extraced Programs
; =============================
(set! pp-width 68)

; Subsubsection: Animating AC, ACL, IP, UNC
; -----------------------------------------
(animate "AC" (pt "[alpha1=>alpha2]alpha1=>alpha2"))
(animate "ACL" (pt "[g]g"))
(animate "IP" (pt "[alpha]alpha"))
(animate "UNC" (pt "[alpha2]alpha2"))

; Subsubsection: SCLemmas
; -----------------------
(pp (nt (proof-to-extracted-term 
 (theorem-name-to-proof "LemmaSCIotaFold"))))

; OmegaInIota

(pp (nt (proof-to-extracted-term 
 (theorem-name-to-proof "LemmaSCIotaUnfold"))))

; ModIota

(pp (nt (proof-to-extracted-term 
 (theorem-name-to-proof "LemmaSCFold"))))

; Hat

(pp (nt (proof-to-extracted-term 
 (theorem-name-to-proof "LemmaSCUnfold"))))

; Mod

; Subsubsection: LemmaOne
; -----------------------
(pp (nt (proof-to-extracted-term
	 (theorem-name-to-expanded-proof "LemmaOne" SCLemmas))))

; (Rec type=>(omega=>nat=>term)@@((nat=>term)=>omega))
; (ModIota@OmegaInIota)
; ([rho3,rho4,p5,p6]
;   ([a7,n8]
;     Abs rho3
;     (Sub(left p6(Mod a7(right p5([n9]Var n8)))(Succ n8))
;      (Wrap(Succ(Succ n8))((Var map Seq 1 n8):+:(Var 0):))))@
;   ([g7]Hat rho3 rho4([a8]right p6([n9]g7 n9(left p5 a8 n9)))))

; Subsubsection: LemmaTwo
; -----------------------
(pp (nt (proof-to-extracted-term 
 (theorem-name-to-proof "LemmaTwo"))))

; [a0]a0

; Subsubsection: LemmaThree
; -------------------------
(pp (nt (proof-to-extracted-term
	 (theorem-name-to-expanded-proof "LemmaThree" SCLemmas))))

; (Rec term=>list type=>list omega=>omega)
; ([n3,rhos4](ListRef omega)n3)
; ([r3,r4,q5,q6,rhos7,as8]Mod(q5 rhos7 as8)(q6 rhos7 as8))
; ([rho3,r4,q5,rhos6,as7]
;   Hat rho3(Typ(rho3::rhos6)r4)
;   ([a8]cLemmaTwo(q5(rho3::rhos6)(a8::as7))))

; Subsubsection: SCrsSeq
; ----------------------
(pp (nt (proof-to-extracted-term 
 (theorem-name-to-proof "SCrsSeq"))))

; (Rec list type=>list type=>list omega)([rhos2](Nil omega))
; ([rho2,rhos3,d4,rhos5]
;   right(cLemmaOne rho2)([n6]Var Lh rhos5)::d4(rhos5:+:rho2:))

; Subsubsection: NTheorem
; -----------------------
(pp (nt (proof-to-extracted-term 
 (theorem-name-to-proof "NTheorem"))))

; [rhos0,r1]
;  left(cLemmaOne(Typ rhos0 r1))
;  (cLemmaThree r1 rhos0(cSCrsSeq rhos0(Nil type)))
;  Lh rhos0


; Subsection: Animation of Lemmas
; ===============================
; Subsubsection: SC-Lemmas
; ------------------------
(animate "LemmaSCFold")
(animate "LemmaSCUnfold")
(animate "LemmaSCIotaFold")
(animate "LemmaSCIotaUnfold")

; Subsubsection: Main Lemmas
; --------------------------
(animate "LemmaOne")
(animate "LemmaTwo")
(animate "LemmaThree")
(animate "SCrsSeq")
(animate "NTheorem")


; Subsection: Examples
; ====================
; Subsubsection: Example 1 
; ------------------------
; Check Term in Context:
(pp (nt (pt "Cor ((Iota to Iota):) (Var 0) ")))

; Print long NF:
(pp (nt (pt "cNTheorem ((Iota to Iota):) (Var 0)" )))
;Abs Iota(Var 1(Var 0))

; Subsubsection: Example 2 
; ------------------------
; Check Term in Context:
(pp (nt (pt "Cor ((Iota to Iota to Iota):) (Var 0) ")))

; Print long NF:
(pp (nt (pt "cNTheorem ((Iota to Iota to Iota):) (Var 0)" )))
; Abs Iota(Abs Iota(Var 2(Var 1)(Var 0)))

; Subsubsection: Example 3 
; ------------------------
; Check Term in Context:
(pp (nt (pt "Cor (((Iota to Iota) to Iota):) (Var 0) ")))

; Print long NF:
(pp (nt (pt "cNTheorem (((Iota to Iota) to Iota):) (Var 0)" )))
; Abs(Iota to Iota)(Var 1(Abs Iota(Var 1(Var 0))))

; Subsubsection: Example 4
; ------------------------
; Check Term in Context:
(pp (nt (pt "Cor ((Iota to Iota):) 
 ((Abs (Iota to Iota) (Var 0)) (Var 0))")))

; Print long NF:
(pp (nt (pt "cNTheorem ((Iota to Iota):) 
 ((Abs (Iota to Iota) (Var 0)) (Var 0))" )))
; Abs Iota(Var 1(Var 0))

; Subsubsection: Example 5
; ------------------------
; Check Term in Context:
(pp (nt (pt "Cor 
 ((Iota to Iota) :: (((Iota to Iota) to Iota) :: (Iota to Iota):)) 
 ((Abs (Iota to Iota) (Var 2) (Var 0)) (Var 2))")))

; Print long NF:
(pp (nt (pt "cNTheorem 
 ((Iota to Iota) :: (((Iota to Iota) to Iota) :: (Iota to Iota):)) 
 ((Abs (Iota to Iota) (Var 2) (Var 0)) (Var 2))" )))
; Var 1(Abs Iota(Var 3(Var 0)))

; ***************************************************************
