;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  M.-D. Hernest --- 071110  (i.e., 10 November 2007)
;;;  Extraction of the USUAL Fibonacci algorithm from a semi-classical proof
;;;  by means of the LIGHT functional DIALECTICA Interpretation. Based
;;;  on M.-D. Hernest --- "Light Functional Interpretation", CSL'2005 (Oxford)
;;;  Uses an adaptation of U. Berger's "uniform", non-computational-content
;;;  universal quantifier, denoted "allnc" below, corresponds to the *ncm*,
;;;  i.e., non-computational-meaning universal quantifier in the CSL paper.
;;;  THE EFFECT is that the D-Relevant CONTRACTION gets eliminated from
;;;  the raw extracted term => HEAVY decrease of the comput. complexity 
;;;  of the LDI-extracted program, also in its final, NbE-normalized form. 
;;;  ALSO followed by the original "pure" Goedel Dialectica extraction, for comparison 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(load "~/minlog/init.scm")
(set! COMMENT-FLAG #f)
(libload "nat.scm")
(add-var-name "l" (py "nat"))
(add-var-name "f" (py "nat=>nat=>nat"))
(add-var-name "H" (py "(nat=>nat=>nat)=>nat"))
(add-var-name "G" (py "nat=>nat=>boole"))

(set-goal (pf "allnc G. all n. G 0 0 -> G 1 1 -> 
                     (allnc n,k,l. G n k -> G (n+1) l -> G (n+2) (k+l)) -> 
                                        excl m. G n m "))
(assume "G" "n" "Init-Zero" "Init-One" "Step")
(cut (pf "all n. excl k. (all l. G n k -> G (n+1) l -> bot) -> bot"))
(search)
(ind)
(search)
(assume "n1" 4 5)
(search)
(define FibPrf (current-proof))

(mload "../modules/diatup.scm")
(set! COMMENT-FLAG #t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Extraction by Light Dialectica
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define vatmp (time (DIA-extract 'light FibPrf)))
(define FY-untup (tmpair-to-tuple (vatmpair-to-tmpair vatmp)))
(define FY-tmlst (tmtuple-to-tmlist FY-untup))
(length FY-tmlst)
(define tk (car FY-tmlst))
;;; (string-length (term-to-string tk))
;;; (pp tk)
(set! UNFOLDING-FLAG #t)
(define et (time (nt tk)))
(pp et)

(pp (time (nt (make-term-in-app-form et (pt "12"))))) ; "144" in 0. 06 sec
(pp (time (nt (make-term-in-app-form et (pt "15"))))) ; "610" in 0.2 sec
(pp (time (nt (make-term-in-app-form et (pt "20"))))) ; "6765" in 2 sec
(pp (time (nt (make-term-in-app-form et (pt "25"))))) ; "75025" in 17 sec
;; (pp (time (nt (make-term-in-app-form et (pt "30"))))) ; "832040" in 287 sec


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Extraction by Pure Dialectica
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define vatmp (time (DIA-extract 'pure FibPrf)))
(define FY-untup (tmpair-to-tuple (vatmpair-to-tmpair vatmp)))
(define FY-tmlst (tmtuple-to-tmlist FY-untup))
(length FY-tmlst)
(define tk (cadddr FY-tmlst))
;;; (string-length (term-to-string tk))
;;; (pp tk)
(set-flag 'UNFOLDING-FLAG #t)
(define et (time (nt tk)))
(pp et)

(pp (time (nt (mk-term-in-app-form et (pt "G") (pt "3")))))  ;; "2" - 00.20 sec.
(pp (time (nt (mk-term-in-app-form et (pt "G") (pt "4")))))  ;; "3" - 00.80 sec.
(pp (time (nt (mk-term-in-app-form et (pt "G") (pt "5")))))  ;; "5" - 06.00 sec.
;; (pp (time (nt (mk-term-in-app-form et (pt "G") (pt "6"))))) 


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Extraction by Monotone Dialectica
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define vatmp (time (DIA-extract 'monot FibPrf)))
(define FY-untup (tmpair-to-tuple (vatmpair-to-tmpair vatmp)))
(define FY-tmlst (tmtuple-to-tmlist FY-untup))
(length FY-tmlst)
(define tk (car FY-tmlst))
;;; (string-length (term-to-string tk))
;;; (pp tk)
(set-flag 'UNFOLDING-FLAG #t)
(define et (time (nt tk)))
(pp et)

(pp (time (nt (make-term-in-app-form et (pt "12"))))) ; "144" in 0. 06 sec
(pp (time (nt (make-term-in-app-form et (pt "15"))))) ; "610" in 0.2 sec
(pp (time (nt (make-term-in-app-form et (pt "20"))))) ; "6765" in 2 sec
(pp (time (nt (make-term-in-app-form et (pt "25"))))) ; "75025" in 17 sec
;; (pp (time (nt (make-term-in-app-form et (pt "30"))))) ; "832040" in 287 sec



