; $Id: tutorial.scm,v 1.14 2008/01/25 13:30:16 logik Exp $

; This file contains the examples of the Tutorial for 
; Minlog version 4.0

; (load "~/minlog/init.scm")

; Distributivity

(add-predconst-name "A" "B" "C" (make-arity))
(define distr (pf "(A -> B -> C) -> (A -> B) -> A -> C"))
; distr
(set-goal distr)
; alternatively (set-goal (pf "(A -> B -> C) -> (A -> B) -> A -> C"))

(assume 1)
(assume 2)
(assume 3)
; alternatively: (assume 1 2 3)
(use 1)
(use 3)
(use 2)
(use 3)
; alternatively: (use-with 2 3)

(display-proof)
(display-pterm)
(display-proof-expr)

; Pierce law

(display-global-assumptions)
(display-global-assumptions "Efq")
(display-global-assumptions "Stab")

; (add-predconst-name "A" "B" (make-arity))
(define peirce-formula  (pf "((A -> B) -> A) -> A"))
(set-goal peirce-formula)

(assume 1)
(use "Stab")
(assume 2)
(use 2)
(use 1)
(assume 3)
(use "Efq")
(use 2)
(use 3)


; Conjunction

; (add-predconst-name "A" "B" (make-arity))
(set-goal (pf "(A & B) -> (B & A)"))

(assume 1)
(split)
(use 1)
(use 1)


; PREDICATE CALCULUS
; A first example with quantifiers:

(libload "nat.scm")
(add-predconst-name "R" (make-arity (py "nat") (py "nat")))

(define Symm (pf "all n,m. R n m  -> R m n"))
(define Tran (pf "all n,m,k. R n m -> R m k -> R n k"))

(set-goal (mk-imp Symm Tran (pf "all n,m. R n m -> R n n")))

(assume "Symm" "Tran" "n" "m" 3)
(use "Tran" (pt "m"))
(use 3)
(use "Symm")
(use 3)


; more elaborate - same example - `original goal'

; (libload "nat.scm")
; (add-predconst-name "R" (make-arity (py "nat") (py "nat")))

(set-goal (pf "(all n,m. R n m  -> R m n) 
		     & (all n,m,k. R n m & R m k -> R n k) 
		     -> all n. ex m R n m -> R n n"))
(assume 1)
(inst-with 1 'left)
(inst-with 1 'right)
(drop 1)
(name-hyp 2 "Symm")
(name-hyp 3 "Tran")
(assume "n" 4)
(ex-elim 4)
(assume "m" 5)
(cut (pf "R m n"))
(assume 6)
(use-with "Tran" (pt "n") (pt "m") (pt "n") "?")
(drop "Symm" "Tran" 4)
(split)
(use 5)
(use 6)
(use-with 2 (pt "n") (pt "m") 5)


; One more example with quantifiers (classical logic)

(add-pvar-name "Q" (make-arity (py "alpha")))
(add-var-name "x" "y" (py "alpha"))
(set-goal (pf "exca x. Q x -> all y Q y"))
; alternatively ;(set-goal (pf "(all x.(Q x -> all y Q y) -> bot) -> bot"))
(assume 1)
(use 1 (pt "x"))
(assume 2 "y")
(use "Stab") 
(assume 3)
(use 1 (pt "y"))
(assume 4)
(use "Efq")
(use-with 3 4)
(save "Drinker")
; (display-theorems)
 

; Natural Numbers

; (libload "nat.scm")
(set-goal (pf "all n,m.n + m = m + n"))
(assume "n")
(ind)
(normalize-goal)       ;abbreviation: ng
(use "Truth-Axiom")
(assume "m" "IH")
(ng)
(use "IH")

(display-proof)


; Another example 

; (libload "nat.scm")

(add-program-constant  "Odd" (mk-arrow (py "nat")(py "boole")) 1)
(add-program-constant  "Even" (mk-arrow (py "nat")(py "boole")) 1)
(add-computation-rule (pt "Odd 0")(pt "F")) 
(add-computation-rule (pt "Even 0")(pt "T")) 
;(add-computation-rule (pt "Odd (++ n)")(pt "Even n"))
;(add-computation-rule (pt "Even (++ n)")(pt "Odd n"))
(add-computation-rule (pt "Odd (Succ n)")(pt "Even n"))
(add-computation-rule (pt "Even (Succ n)")(pt "Odd n"))

(set-goal (pf "all n.Even (2*n)"))
(ind)
(ng)
(use "Truth-Axiom")
(ng)
(assume "n" 1)
(use 1)


; Lists over \alpha

; (libload "nat.scm")
(libload "list.scm")

(add-var-name "a" "b" (py "alpha"))
(add-var-name "u" "v" "w" "s" (py "list alpha"))

(add-program-constant "Rev"
		      (py "list alpha => list alpha") 1)
(add-computation-rule (pt "(Rev alpha) (Nil alpha)") (pt "(Nil alpha)"))
(add-computation-rule (pt "(Rev alpha) (a::w)") 
		      (pt "((Rev alpha) w) :+: (a:)"))

(add-global-assumption "Reff" (pf "all a,w,s. (Equal w s) 
				   -> Equal (a::w) (a::s)"))

(add-global-assumption "Eqrev" (pf "all w,s,u. Equal w s 
                                     -> Equal (w :+: u) (s :+: u)"))

(add-global-assumption "Asrev" (pf "all v,s,w,u. Equal v ((s :+: w) :+: u) 
                                     -> Equal v  (s :+: (w :+: u))"))

; Lemma
(set-goal (pf "all s. Equal s (s :+:(Nil alpha))"))
(ind)
(ng)
(use-with "Eq-Refl" (py "list alpha") (pt "(Nil alpha)"))
(assume "a" "w" 1)
(use "Reff")
(use 1)
(save "AppendEmpty")


; Main goal
(set-goal (pf "all w,s. (Equal ((Rev alpha)(w :+: s))
                        (((Rev alpha) s) :+: ((Rev alpha) w)))"))
(ind)
(ng)
(assume "s")
(use "AppendEmpty")
(assume "a" "w")
(ng)
(assume 1 "s")
(use-with "Asrev" (pt "((Rev alpha)(w :+: s) :+: a:)") 
	  (pt "((Rev alpha) s)") 
	  (pt "((Rev alpha) w)") (pt "a:") "?")
(use-with "Eqrev" (pt "((Rev alpha)(w :+: s))") 
	  (pt "((Rev alpha) s :+: (Rev alpha) w)") (pt "a:") "?")
(use 1)


;Proof of Eqrev

(set-goal (pf "all w,s,u. Equal w s 
                          -> Equal (w :+: u) (s :+: u)"))
(strip)
(simp-with 1)
(use-with "Eq-Refl" (py "list alpha") (pt "s:+:u"))



; An example with search

; (add-var-name "x" "y" (py "alpha"))
(add-tvar-name "beta")
(add-var-name "U" "V" "W" (py "beta"))
(add-predconst-name "in" (make-arity (py "alpha") (py "beta")))
(add-var-name "f" (py "alpha=>alpha"))

(set-goal
 (pf
  "all f.(all x,V. in (f x) V -> excl U. in x U 
                  & all y. in y U -> in (f y) V) -> 
          all x,W. in (f(f x)) W -> excl U. in x U 
                  & all y.in y U -> in (f(f y)) W"))
(search)
(dnp)











