; $Id: dickson2gen.scm 2156 2008-01-25 13:25:12Z schimans $

;First step towards generalization. 
; Define f not from nat to nat, but from Q to nat, where

; Q is a set (unary predicate)
;  Q is a subset of nat
;  Q unbounded, i.e. all x ex y. Q(y) ! x<y

; Note: let Q be denoted by 'Set'

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

(set! COMMENT-FLAG #f)
(libload "nat.scm")
(set! COMMENT-FLAG #t)


;(libload "minpr_gen.scm")

(add-pvar-name "Set" (make-arity (py "nat")))
(make-pvar (make-arity "nat") -1 0 "Set")
(pvar-name? "Set")
(pvar-name-to-arity "Set")
(add-var-name "i" "j" "l" (py "nat"))
(add-var-name "f" "g" (py "nat=>nat"))
(add-rewrite-rule (pt "n<Succ n") (pt "True"))
(add-rewrite-rule (pt "Succ n<0") (pt "False"))

; Q unbounded:
(add-global-assumption "UnboundedQ" (pf "all i. Set(i) -> excl j. i<j ! Set(j)"))

; Q is not empty
(add-global-assumption "NonEmptyQ" (pf "excl i. Set(i)"))

; In the following, we require also that i and j are elements of Set 
; (since f,g have in fact to be defined from Set to nat
 
(set-goal (pf "all f,g excl i,j. Set i ! Set j ! i<j ! (f j<f i -> bot) ! (g j<g i -> bot)"))
(assume "f" "g")
(by-assume-minimal-wrt (pf "excl n Set n") "n" (pt "f") "MinH1" "min_P1")

; Generates two new goals: excl n Set n (assumed by default), 
; and the existence of the minimal element (a hypothesis) implies our goal
(use "NonEmptyQ")

(by-assume-minimal-wrt
 (pf "excl n. Set n ! (all m. Set m -> n<m+1 -> f m<f n -> bot)") 
 "i" (pt "g") "MinH2_1" "MinH2_2" "min_P2")
(exc-intro (pt "n"))
(use "min_P1")
(strip)
(use-with "MinH1" (pt "m") 5 3)

(by-assume-minimal-wrt
 (pf "excl l. i < l ! Set l")
 "j" (pt "f") "MinH3_1" "MinH3_2" "min_P3")
(use "UnboundedQ" (pt "i")) 
(use "MinH2_2")

; Now we have i and j as desired
(exc-intro (pt "i") (pt "j")) ;adds a new theorem, rerun the proof
(use "MinH2_2")
(use "min_P3")
(use "MinH3_2")
(use "min_P2")
(use "min_P3")
(aga "nat2" (pf "all n,m.n<m -> n<m+1"))
(use "nat2")
(use "MinH3_2")
(assume "H")
(use "MinH2_1" (pt "j"))
(use "H")
(use "min_P3")
(strip)
(use "MinH3_1" (pt "m"))
(use 12)
(aga "nat1" (pf "all n,m,k.n<m -> m<k+1 -> n<k"))
(use "nat1" (pt "j"))
(use "MinH3_2")
(use 11)
(use 10)
(save "DicksonTwoGen")

(set! UNFOLDING-FLAG #f)
(define dickson (np (expand-theorems (current-proof))))
(define reduced-dickson (np (reduce-efq-and-stab dickson)))


(mload "../modules/atr.scm")


(define program
  (atr-min-excl-proof-to-structured-extracted-term reduced-dickson))
; This is not yet working!:
; error!
; pconst-name-to-pconst
; pconst name expected
; cNon_emptyQ

(define nprogram (nt program))
(term-to-string nprogram)


; [f0,f1](Rec nat=>nat=>nat@@nat)
; ([n2]0@0)
; ([n2,(nat=>nat@@nat)_3,n4](Rec nat=>nat=>(nat=>nat@@nat)=>nat@@nat)
;  ([n5,(nat=>nat@@nat)_6]0@0)
;  ([n5,(nat=>(nat=>nat@@nat)=>nat@@nat)_6,n7,(nat=>nat@@nat)_8]
;   (Rec nat=>nat=>nat@@nat)
;   ([n9]0@0)
;   ([n9,(nat=>nat@@nat)_10,n11]
;    [if (f0 n11<f0 n7)
;        ((nat=>nat@@nat)_8 n11)
;        [if (f1 n11<f1 n7)
; 	   ((nat=>(nat=>nat@@nat)=>nat@@nat)_6 n11(nat=>nat@@nat)_10)
; 	   (n7@n11)]])
;   (Succ(f0(Succ n7)))(Succ n7))
;  (Succ(f1 n4))n4(nat=>nat@@nat)_3)
; (Succ(f0 0))0

(define constr-proof
  (atr-min-excl-proof-to-intuit-ex-proof reduced-dickson))
; (cdp constr-proof) ok

; Test of the extracted program

(set! UNFOLDING-FLAG #t)
(define f (pt "[n][if (n=0) 4 [if (n=1) 3 n]]"))
(define g (pt "[n][if (n<3) 1  0]"))
(term-to-string (nt (make-term-in-app-form
		     (make-term-in-app-form nprogram f) g)))

;  "3@4"

;End:
