;; Emulating n-ary congruences using rewriting contexts.

;; I really just don't like the idea of defining new equivalences for
;; each new context.  

;; To justify this dislike, I will point out that there is at least
;; one class of rewrite rules that are not (may not be) handled well
;; if we are forced to deal with congruences:

(equal (cp list (foo st1) st2)
       (cp list1 (foo1 st1)
	   (cp list2 (foo2 st1)
	       st2)))

;; Here might be the analogous rule using cp-equiv:

(iff (cp-equiv list (foo st1) st2)
     (and (cp-equiv list1 (foo1 st1) st2)
	  (cp-equiv list2 (foo2 st1) st2)))

;; However, this rule would require an "extensionality" type theorem
;; to expose the necessary (cp-equiv list (foo st1) st2) .. whereas
;; the (cp list (foo st1) st2) rule will normalize the expression in
;; place.

;; Perhaps the following rule is an analogous example rule for mod
;; (crt = chineese remainder theorem)

(equal (mod x (* a b))
       (crt a (mod x a)
	    b (mod x b)))



;; Substitution from the hypothesis works with equivalences, but
;; probably would not work for (fix ..).

(defun nequiv (x y) (equal (nfix x) (nfix y)))
(defequiv nequiv)

(defthm equal-into-equiv
  (iff (equal q (nfix x))
       (and (natp q)
	    (nequiv q x))))

;; One can, however, emulate such substitution using free-variables.
;; How expensive is this?  Would this be a long-term solution for
;; this kind of problem?  Note that this solution wouldn't support 
;; refinements, either.

(defthm free-variable-substitution
  (implies
   (and
    (equal (nfix x a) (nfix y a))
    (syntaxp (simpler y x)))
   (equal (nfix x a)
	  (nfix y a))))

;; There may be a number of things that the poor man's version
;; of context rewriting will not do (that an integrated solution
;; might be expected to do) due to the fact that the poor man's
;; version is rewriting in a backchaining context.  One example
;; is rewriting into an "if" :

(defthm fix-case-split
  (equal (mod x n) (if (test x n) (foo x) (goo n))))



(defaxiom pred-foo-z
  (pred (foo (z))))

(defthm substitution-of-equals
  (implies 
   (equal (z) (fix y))
   (pred (foo y))))

(iff (cp-equiv (append x y) st1 st2)
     (and (cp-equiv x st1 st2)
          (cp-equiv y st1 st2)))

(iff (cp-equiv list (foo st1) st2)
     (and (cp-equiv list1 (foo1 st1) st2)
	  (cp-equiv list2 (foo2 st1) st2)))

(defthm 
  (equal (mod (foo x) n)
	 (goo y)))
	 


;; Why not require the definition of nary-equivalences?
;;
;; I think we will find this technology very useful for
;; dependency analysis.

;; idempotent: (equal (nth (nth x n) n) (nth x n))

;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

;; Does a context have to be idempotent?
;;
;; - I think you want (need?) it to be.
;; - This would allow you to always rewrite a term using the context.

;; I think this would _greatly_ reduce the overall impact since there
;; would be no need to store (mod (foo x) n) rules with a trigger term
;; of (foo ..).

;; 1. Evaluate the term in the "mod-equiv" context until stable.
;; 2. create a new term by wrapping the current term in the current context.
;; 3. rewrite the new term in the current equiv context.
;; 4. if the new term changed, goto 1
;; 5. else return the stable term.

;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

;; The main question then becomes one of refinement.  Is there
;; a way to do refinement that makes sense?

;; I think that if the outermost rewrite succeeds, the new term
;; should, once again, be rewritten in the same context.  This,
;; I think, will give you the behavior that you want.

;; In the computation of (equal x (mod y n)), the context is (mod _
;; n).  Rewrite y using this context.  Then rewrite (mod y' n) in the
;; context of the simple binding.  This rewrites succeeds, producing
;; <term>, we need to simplify <term> in a (mod _ n) context.


;; - if rewriting succeeds wrap the term and evaluate in the equiv context.  If the rewrite succeeds, 
;; repeat the process.

(implies
  (hyps n) <- context satisfies this
  (equiv1 z (mod y n)))

(implies
  (hyps n)
  (equiv1 (mod (mod y n)) (mod y n)))

;; As an optimization, the context hypotesis (hyps n) should be cached.

;; (implies
;;  (equal y (cp listx x nil))
;;  (equal (foo x) (foo y)))

;; (equal (cp listx (goo x) y)
;;        (cp list1 (goo1 x)
;;            (cp list2 (goo2 x)
;;              y)))

;; (cp-equiv listx (goo x) y) => ??


;; (equiv fn n args)
;; equiv

;; - The equiv is the weakest (or just an) equivalence relation
;;   defined for the nth argument position of "fn".

;; - Rules are stored under 'equiv but are further restricted
;;   by a context pattern.

;; The theorem prover encounters a (mod x a) in the course of
;; simplification :
;;
;; - if the current context is stronger or unrelated to the (mod _ a)
;; context, the rewriter enters the (mod-equiv mod 1 (a)) context to
;; rewrite x.
;;
;;(mod (equiv <term> ..) a)
;;
;;(mod (equiv (mod <term> b) ..) a)
;;  -> (mod (equiv <term> ..) b)
;;  -> (mod (equiv <term> ..) a)
;;  -> (mod (equiv <term> ..) (fn a b))
;;
;; - if the current context is demonstrably weaker or equal to (mod _ a),
;;   keep the existing contex to rewrite <term>
;;
;; - if the the current context is not demonstrably weaker or equal,
;;   - assume the (mod _ a) context to rewrite term -> xterm
;;   - rewrite (mod xterm a) in the current context.
;;
;; When complete, it attempts to rewrite the (mod x a) term as it stands.
;; It is possible (even likely) that we will have rules of the form 
;;
;; (equal (mod (mod x a) b)
;;        (mod x b)
;;
;; So that, when we go to rewrite (mod x a), if we are in a "b" context,
;; we will rewrite (mod x a) into x.

;; A gernic context is defined as an equivalence relation (equiv), a function
;; symbol (fn), a position designator, and a list of terms.  The list of
;; terms, when augmented with the term being rewritten in in the position
;; identified by the position desingnator, can be viewed as the arguments of
;; fn.  A rewriting context can be thought of as a list of simple contexts.

;; The form (defcontext fn (x1..xk) n) attaches to the function symbol "fn" a
;; context descriptor indicating the nth argument position of "fn" should be
;; rewritten in a context defined by the other arguments to fn.  Now, every
;; time the rewriter encounters a term in which the leading symbol is (fn ..),
;; we first rewrite the "contextual" arguments and then use them to construct
;; a context in which we rewrite the designated argument.  Here is an example
;; of defcontext for the "mod" function:

(defcontext mod (x n) 1)

;; Multiple (defcontexts) may be defined for the same function symbol.  The
;; behavior of the system in such case may involve repeated application of the
;; above technique to each designated variable, in sequence, until the entire
;; term stabilizes.

#|

;; Umm .. I'm really not sure how refinement should work.  I have the feeling
;; that it will be easier to do it dynamicallly .. not only that, but the
;; current refinement stuff seems like sort of a "cheat" .. like we are
;; getting stuff for "free" .. that ACL2 is being _too_ nice to us.

;; As the rewriter prepares to enter a new context, that context is first
;; extended using context refinement.  Contextual refinement involves matching
;; each simple context against each enabled context refinement rule and then
;; adding the new context if all hypotheses are satisfied.  Note that caching
;; of rewrite results must use tags that indicate the full rewriting context.
;; A cached rewrite result can be used in a new context if the context tag for
;; that term is a contextual refinement of the current rewriting context.

;; static context refinement will take place only if the context refinement
;; rule is formulated such that the refined context can be computed and
;; justified using only the current context .. without reference to the term
;; being rewritten or free variables.
|#

(defthm static-context-refinement
  (implies
   (and
    (integerp p)
    (equiv2 (mod x1 (* p 2))
	    (mod x2 (* p 2))))
   (equiv1 (mod x1 p)
	   (mod x2 p)))
  :rule-classes ((:context-refinement (equiv2 (mod x (* p 2)) 1)
				      (equiv1 (mod x p) 1))))

;; When rewriting within a context, certain context congruence rules may be
;; activated.  Such rules pattern match on context elements as well as on the
;; term being rewritten.  If a match is found, a new context is created and
;; used to rewrite the term indicated in the conclusion.

(defthm context-congruence
  (implies
   (and
    (not (complexp x1))  ; <- these kind of hyps can be "expensive" causing
			 ; multiple rewrites of x1
    (not (complexp y))
    (equiv2 (mod x1 (* 2 n))
	    (mod x2 (* 2 n))))
   (equiv1 (mod (+ x1 y) n)
	   (mod (+ x2 y) n)))
  :rule-classes ((:context-congurence (equiv2 (mod x (* 2 n)) 1)
				      (equiv1 (mod (+ x1 y) n) 1 1))))

;; Simple rewrite rules are applied following a contextual rewriting of a
;; term.  Consider rewriting the form (mod term n).  We first rewrite "term"
;; in the context (equiv (mod . n) 1).  [Note that "equiv" in this context is
;; simply the weakest equiv relation that ACL2 knows about from any
;; :congruence theorems about mod].  Assuming that the rewriter returns (foo
;; x) as a result of rewriting "term" in this context, the rewriter then
;; reconstructs the term (mod (foo x) n) and searches for a rule that pattern
;; matches this new expression.  If it finds such a rule, it applies it and
;; simplifies the result.  [Note that kind of rewriting is _not_ done when
;; applying context congruence rules].

(defthm simple-rewrite
  (implies
   (hyps x)
   (equal (mod (foo x) 20)
	  (hoo x))))

;; While static context refinement allows us to create a static list of
;; contexts in which a term should be rewritten, it may not be desirable (or
;; possible) to to enumerate all possible contexts that we may wish to use
;; while rewriting a term. This becomes evident when we consider the fact
;; that, for (mod x n), every multiple of "n" defines a refining context for
;; (mod x n).  While simple rewrite rules can be used to detect this case, we
;; may have an instance where we have:

;; How do we apply this rule in our current context if our current context is
;; (mod x 2)?  The solution to this is to apply dynamic context refinement
;; rules.  Dynamic context refinement rules are context refinement rules with
;; free variables.

(defthm dynamic-context-refinement
  (implies
   (and
    (integerp n1)
    (integerp n2)
    (< n1 n2)
    (equal (gcd n1 n2) n1)
    (equal (mod x1 n2)
	   (mod x2 n2)))
   (equal (mod x1 n1)
	  (mod x2 n1)))
  :rule-classes ((:context-refinement (equal (mod x n2) 1)
				      (equal (mod x n1) 1))))

;; In order to apply dynamic context refinement, we must somehow instantiate
;; the dynamic context refinement rules.  We do this by appealing to the
;; context rewrite.  The context instance is used to instantiate any free
;; variables appearing in an applicable dynamic-context-refinement rule.

(defthm mod-foo-20
  (implies
   (hyps x)
   (equal (mod (foo x) 20)
	  (mod (hoo x) 20)))
  :rule-classes (:rewrite
		 (:context (equal (mod x 20) 1))))

(equal (gp-list (cons a list) (foo st))
       (cons (gp a (foo st))
	     (gp-list list (foo st))))

(defthm g-a-from-g-list
  (implies
   (and
    (hyps st1)
    (equal (g-list (foo-dia a st1) st1)
	   (g-list (foo-dia a st1) st2))
    )
   (equal (g a (foo st1))
	  (g a (foo st2)))))

(defthm g-list-from-g-list
  (implies
   (and
    (hyps st1)
    (equal (g-list (foo-dia* list st1) st1)
	   (g-list (foo-dia* list st1) st2)))
   (equal (g-list list (foo st1))
	  (g-list list (foo st2)))))



(defthm domain-context
  (implies
   (pred st)
   (equal (foo st)
	  (foo (cp list st nil)))))

(defthm mod-fix-point
  (implies
   (and
    (equal x (mod a n))
    (equal y (mod b n))
    (syntaxp (and (not (equal x a))
		  (not (equal y b)))))
   (equal (mod (+ a b) n)
	  (mod (+ x y) n))))

;; How do you keep from looping?? How do you remember that you have rewritten
;; a term such as that??

(equal (mod (+ a b) n)
       (mod (+ (mod a n) b) n))


(defthm domain-context
  (implies
   (and
    (pred st)
    (equiv st2
	   (cp list st1)))
   (equal (foo st1)
	  (foo st2))))
