#|

Author: Pete Manolios
Date:   9/27/2022

Code used in lecture 6 of Computer-Aided Reasoning.

|#

(in-package "ACL2S")

"
START Automated Rev-Rev Demo
"

(set-gag-mode nil)

(definec ap (a :tl b :tl) :tl
  (if (endp a)
      b
    (cons (car a) 
          (ap (cdr a) b))))

(definec ap (a :tl b :tl) :tl
  (match a
    (nil nil)
    ((f . r) (cons f (ap r b)))))

(check= (ap '(1 2 3) '(4 5 6))
        '(1 2 3 4 5 6))

(definec rv (x :tl) :tl
  (if (endp x)
      nil
    (ap (rv (cdr x))
        (list (car x)))))

(definec rv (x :tl) :tl
  (match x
    (nil nil)
    ((f . r) (snoc (rv r) f))))

(rv '(1 2 3))

; Show  ld

; (ld "l6.lisp")

#|

This is a classic example that shows ACL2 going through all of the
proof procedures.

|#

(property rv-rv (x :all)
  (== (rv (rv x))
      x))

; Contract completion

(property rv-rv (x :tl)
  (== (rv (rv x))
      x))

"
END Automated Rev-Rev Demo
"

#|

 It is a good idea to not allow ACL2s to do nested inductions. There
 are several reasons for this.

 1. The theorems needed to avoid nested induction proofs are typically
 useful theorems to have around. You just discovered these interesting
 theorems, so by turning them into defthms, named properties, the
 theorem prover will be able to use them in subsequent proofs.

 2. It makes your proofs more robust. This is a big deal for proof
 engineering, where you don't have simple changes to your definitions/
 properties to require lots of proof re-engineering.

 First, we undo the previous theorem.

|#

:u

#|

 Next, we set the induction-depth-limit to 1, which means ACL2s can do
 proofs by induction, but cannot do nested inductions.

|#

(set-induction-depth-limit 1)


; Do the proof 

(property ap-associative (x :tl y :tl z :tl)
  (== (ap (ap x y) z)
      (ap x (ap y z))))

(property ap-x-nil (x :tl)
  (equal (ap x nil) x))

(property rv-ap (x :tl y :tl)
  (== (rv (ap x y))
      (ap (rv y) (rv x))))

(property rv-rv (x :tl)
  (== (rv (rv x))
      x))

:u

; How to tell ACL2s what induction scheme to use. Notice that the
; proof obligations are different than before.


(property rv-rv (x :tl)
  (== (rv (rv x))
      x)
  :hints (("goal" :induct (tlp x))))

; ACL2s uses previous theorems in subsequent proof attempts.

(property (x :tl)
  (== (rv (rv (rv x)))
      (rv x)))

(property (x :tl y :tl)
  (== (ap (rv (rv (rv x))) (ap x (ap y nil)))
      (ap (rv x) (ap x y))))