; ***********************************************************
; ; 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")
;
; NOTICE: Uncomment modules only when file is run on its own
; ***********************************************************


; ==============================
;  Section: Substitution Lemmas
; ==============================
; Substitution in Joachimski style

; Definition: "Subcompose"
; ------------------------
; Composition on substitutions

(add-program-constant "Subcompose" (py "Sublist=>Sublist=>Sublist") 1 'const 2)

; ________________________ INTERNAL ________________________
; Allows the infix notation with "circ" instead of "Subcompose"

(add-token
 "circ"
 'mul-op
 (lambda (x y)
   (let* ((type1 (term-to-type x))
	  (type2 (term-to-type y))
	  (type (types-lub type1 type2)))
     (mk-term-in-app-form
      (make-term-in-const-form (pconst-name-to-pconst "Subcompose"))
      x y))))

(add-display
 (py "Sublist")
 (lambda (x)
   (let ((op (term-in-app-form-to-final-op x))
	 (args (term-in-app-form-to-args x)))
     (if (and (term-in-const-form? op)
	      (string=? "Subcompose"
			(const-to-name (term-in-const-form-to-const op)))
	      (= 2 (length args)))
	 (list 'mul-op "circ"
	       (term-to-token-tree (car args))
	       (term-to-token-tree (cadr args)))
	 #f))))
; _________________________________________________________


(add-computation-rule (pt "Up 0 circ theta") (pt "theta"))
(add-computation-rule (pt "Up(Succ n) circ Dot r theta")
		      (pt "Up n circ theta"))
(add-computation-rule (pt "Up(Succ n)circ Up m") (pt "Up(Succ n+m)"))
(add-computation-rule (pt "Dot r theta circ theta1")
		      (pt "Dot(Sub r theta1)(theta circ theta1)"))

; Lemma: "LiftId"
; --------------
; lifting with value 0 is identity

(add-rewrite-rule (pt "Lift r k 0") (pt "r"))

; Lemma: "LiftTwiceMod"
; ---------------------
; lifting with k and then with k1 is the same as lifting
; with (k+k1) at one step

(add-rewrite-rule (pt "Lift(Lift r l k)l k1") (pt "Lift r l(k+k1)"))

; Lemma: "SubliftId"
; ------------------
; lifting of a substitutionlist with value 0 is identity

(add-rewrite-rule (pt "Sublift theta 0") (pt "theta"))

; Definition: Spare
; -----------------
; adds 0 1 ... (m-1) to a substitution list

(add-program-constant "Spare" (py "nat=>Sublist=>Sublist") 1 'const 2)

(add-computation-rule (pt "Spare 0 theta") (pt "theta"))
(add-computation-rule (pt "Spare(Succ m)theta")
		      (pt "Spare m(Dot(Var m)theta)"))

; Lemma: "SubVarSpare"
; --------------------
(add-global-assumption "SubVarSpare"
 (pf "all m,k,theta.Sub(Var(k+m))(Spare m theta)=Sub(Var k)theta"))

; Lemma: "SubVarSpareLt"
; ----------------------
(add-global-assumption "SubVarSpareLt"
 (pf "all m,k,theta.k<m -> Sub(Var k)(Spare m theta)=Var k"))

; Lemma: "DotVarSubliftSpare"
; ----------------------------
(add-global-assumption "DotVarSubliftSpare"
 (pf "all m,theta.Dot(Var 0)(Sublift(Spare m theta)1)=
                  Spare(Succ m)(Sublift theta 1)"))

; Lemma: "CircUpUp"
; -----------------

(add-rewrite-rule (pt "Up m circ Up n") (pt "Up(m+n)"))

; Lemma: "CircUp"
; ---------------
; Joachimski's (3)

(add-rewrite-rule (pt "theta circ Up n") (pt "Sublift theta n"))

; Definition: "Pushlist"
; ---------------------
; adds the elements of a list to a substitution list

(add-program-constant "Pushlist" (py "list term=>Sublist=>Sublist") 1 'const 2)

(add-var-name "rs" "ss" (py "list term"))

(add-computation-rule (pt "Pushlist(Nil term)theta") (pt "theta"))
(add-computation-rule (pt "Pushlist(r::rs)theta")
		      (pt "Dot r(Pushlist rs theta)"))

; Lemma: "PushlistEq"
; ------------------
(add-rewrite-rule (pt "Sub(Var(k+Lh rs))(Pushlist rs theta)")
		  (pt "Sub(Var k)theta"))

; Lemma: "SubLiftSpare"
; ---------------------
; Joachimski's (6)

(add-global-assumption "SubLiftSpare"
 (pf "all r,m,rs,theta.
  Sub(Lift r m Lh rs)(Spare m(Pushlist rs theta))=Sub r(Spare m theta)"))

; Theorem: "SubSub"
; -----------------
; Joachimski's (7)
(add-global-assumption "SubSub"
 (pf "all r,theta,theta1.
  Sub(Sub r theta)theta1=Sub r(theta circ theta1)"))

