;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; MDH 071118 - Binary Tape Example - here with bools 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(load "~/minlog/init.scm")
(set! COMMENT-FLAG #f)
(libload "nat.scm")

(add-var-name "a" (py "boole"))
(add-var-name "b" (py "boole"))
(add-var-name "c" (py "boole"))
(add-var-name "f" (py "nat=>boole"))
(add-var-name "p" (py "nat"))

(aga "Assum1" (pf "all a. (a = False -> F) -> (a = True)" ))
(aga "Assum2" (pf "all n,m. m<Succ(m+n)"))
(aga "Assum3" (pf "all n,m. n<Succ(m+n)"))
(aga "Bool-Eq-Trans" (pf "all a,c,b. a=b -> c=b -> a=c"))

(set-goal (pf "all f. exca b. all n. exca p (n<p ! f(p)=b)"))
(assume "f" "Ass01")
(use "Ass01" (pt "True"))
(assume "n" "Ass02")
(use "Ass01" (pt "False"))
(assume "m" "Ass03")
(use "Ass02" (pt "n+m+1"))
(use "Assum2")
(use "Assum1")
(use "Ass03")
(use "Assum3")
(save "Lemma")

(set-goal (pf "all f. exca m. exca n. m<n ! f(m)=f(n)"))
(strip)
(inst-with "Lemma" (pt "f"))
(use 2)
(strip)
(inst-with 3 (pt "0"))
(use 4)
(strip)
(use 1 (pt "p"))
(strip)
(use 3 (pt "p"))
(assume "m" "Hyp0" "Hyp1")
(use 7 (pt "m"))
(use "Hyp0")
(inst-with "Bool-Eq-Trans" (pt "f p") (pt "f m") (pt "b"))
(use 10)
(use 6) 
(use "Hyp1")
(define CP  (current-proof))
; (cdp CP)
; (define NCP (np CP))

(mload "../modules/diatup.scm")
(define vatmp (DIA-extr-vatmpair 'light CP))
(contraction-count)
(IndRule-count)
(define tmp (vatmpair-to-tmpair vatmp))
(define tuple (tmpair-to-tuple tmp))
(define tmlst (tmtuple-to-tmlist tuple))
(length tmlst)
(set! UNFOLDING-FLAG #t)
(define t1 (time (nt (car tmlst))))
(define t2 (time (nt (cadr tmlst))))
;;; (pp t1)
;;; (pp t2)

(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 (Succ n)")(pt "Even n"))
(add-computation-rule (pt "Even (Succ n)")(pt "Odd n"))
(add-computation-rule (pt "Odd 0")(pt "False"))
(add-computation-rule (pt "Even 0")(pt "True"))

(define f (pt "[n] Odd (n+n+n)"))

(define t3 (nt (mk-term-in-app-form t1 f)))
(define t4 (nt (mk-term-in-app-form  t2 f)))
(set! COMMENT-FLAG #t)
(pp t3)
(pp t4)



