; $Id: exc.scm,v 1.3 2008/01/25 13:30:21 logik Exp $

(define (formula-of-exc-intro-at l-or-a-string n m)
  (let* ((fixed-vars
	  (do ((i (- n 1) (- i 1))
	       (res (list (make-var (make-tvar n DEFAULT-TVAR-NAME) n 1 ""))
		    (cons (make-var (make-tvar i DEFAULT-TVAR-NAME) i 1 "")
			  res)))
	      ((zero? i) res)))
	 (fixed-tvars (map var-to-type fixed-vars))
	 (fixed-arity (apply make-arity fixed-tvars))
	 (fixed-pvars (do ((j (- m 1) (- j 1))
			   (res (list (make-pvar fixed-arity m 0 ""))
				(cons (make-pvar fixed-arity j 0 "") res)))
			  ((zero? j) res)))
	 (fixed-varterms (map make-term-in-var-form fixed-vars))
	 (fixed-formulas (map (lambda (x)
				(apply make-predicate-formula
				       (cons x fixed-varterms)))
			      fixed-pvars))
	 (fixed-exc-kernel (apply mk-tensor fixed-formulas))
	 (fixed-exc-formula
	  (cond
	   ((string=? "l" l-or-a-string)
	    (apply mk-excl (append fixed-vars (list fixed-exc-kernel))))
	   ((string=? "a" l-or-a-string)
	    (apply mk-exca (append fixed-vars (list fixed-exc-kernel))))
	   (else (myerror "formula-of-exc-intro-at: string l or a expected"
			  l-or-a-string)))))
    (apply mk-all
	   (append fixed-vars
		   (list (apply mk-imp (append fixed-formulas
					       (list fixed-exc-formula))))))))

(formula-to-string (formula-of-exc-intro-at "l" 2 2))
(formula-to-string (formula-of-exc-intro-at "a" 2 2))
(formula-to-string (fold-formula
		    (unfold-formula (formula-of-exc-intro-at "l" 1 2))))

(set-goal (formula-of-exc-intro-at "l" 2 2))
(search)
(save "Excl-Intro-2-2")

; Now Exc-Elim

(add-var-name "x" (make-tvar -1 DEFAULT-TVAR-NAME))

(set-goal (pf "excl x (Pvar alpha) x -> 
               (all x.(Pvar alpha) x -> Pvar) -> Pvar"))
(search 1 (list "Stab-Log" 1))
(save "Excl-Elim-1-1")
