; $Id: fib.scm,v 1.13 2008/01/25 13:30:23 logik Exp $

; Extraction of the Fibonacci algorithm from a classical proof based
; on [BBS02]

; We need some arithmetic first.

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

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

(add-var-name "l" (py "nat"))
(add-var-name "f" (py "nat=>nat=>nat"))
(add-var-name "H" (py "(nat=>nat=>nat)=>nat"))

; The graph of the Fibonacci function:

(add-ids
 (list (list "G" (make-arity (py "nat") (py "nat"))))
 '("G 0 0" "InitGZero")
 '("G 1 1" "InitGOne")
 '("all n,k,l(G n k -> G(n+1)l -> G(n+2)(k+l))" "GenG"))

; (pp "InitGZero")
; (pp "InitGOne")
; (pp "GenG")

; "Fibonacci"
(set-goal (pf "all n excl k G n k"))
(cut (pf "all n excl k,l(G n k ! G(n+1)l)"))
(search)
(ind)
(search 1 '("InitGZero" 1) '("InitGOne" 1))
(search 1 '("GenG" 1))
; Proof finished.
(save "Fibonacci")

(proof-to-expr (np (theorem-name-to-proof "Fibonacci")))

#|
(lambda (n)
  (lambda (u499)
    ((((|Ind| n)
        (lambda (u500) ((((u500 0) 1) |Intro|) |Intro|)))
       (lambda (n618)
         (lambda (u501)
           (lambda (u502)
             (u501
               (lambda (k)
                 (lambda (l)
                   (lambda (u503)
                     (lambda (u504)
                       ((((u502 l) (+ k l)) u504)
                         (((((|Intro| n618) k) l) u503) u504)))))))))))
      (lambda (k)
        (lambda (l)
          (lambda (u505) (lambda (u506) ((u499 k) u505))))))))
|#

(define neterm
  (nt (atr-min-excl-proof-to-structured-extracted-term
       (np (theorem-name-to-proof "Fibonacci")))))

(pp neterm)

#|
[n0]
 (Rec nat=>(nat=>nat=>nat)=>nat)n0([f1]f1 0 1)
 ([n1,H2,f3]H2([n4,n5]f3 n5(n4+n5)))
 ([n1,n2]n1)
|#

(pp (nt (make-term-in-app-form neterm (pt "0")))) ;"0"
(pp (nt (make-term-in-app-form neterm (pt "1")))) ;"1"
(pp (nt (make-term-in-app-form neterm (pt "2")))) ;"1"
(pp (nt (make-term-in-app-form neterm (pt "3")))) ;"2"
(pp (nt (make-term-in-app-form neterm (pt "4")))) ;"3"
(pp (nt (make-term-in-app-form neterm (pt "8")))) ;"21"
(pp (nt (make-term-in-app-form neterm (pt "10")))) ;"55"
(pp (nt (make-term-in-app-form neterm (pt "12")))) ;"144"

(define (fibo n)
  (fibo1 n (lambda (k l) k)))

(define (fibo1 n1 f)
  (if (= n1 0)
      (f 1 1)
      (fibo1 (- n1 1) (lambda (k l) (f l (+ k l)))))) 

; (define test (fibo 80000))
