#|

Copyright © 2021 by Pete Manolios 

Author: Pete Manolios
Date:   9/13/2021

Code used in lecture 3 of Computer-Aided Reasoning.  

|#

(in-package "ACL2S")

"BEGIN DEMO 1

"

"Dotted pairs"
(cons 1 2)

"*, +, append are macros"

(+ 1 2 3 4)
(+)
(*)
(* 1 2 3)
(append '(1 2) '(3 4))
(append '(1 2) '(3 4) '(5 6))

(listp '(1 2))
(listp (cons 1 2))

(tlp '(1 2))
(tlp (cons 1 2))

(car '(1 . 2))
(cdr '(1 . 2))
(cadr '(1 2 . 3))
(cddr '(1 2 . 3))

(in-package "ACL2")
:pe +
:pe *
:pe append
:pe listp
:pe true-listp
:pe acl2s::tlp
:pe cadr
:trans1 (* 1 2 3)
:trans1 (*)
:trans1 (cadr '(1 2 . 3))
:trans1 (append '(1 2) '(3 4) '(5 6))
(in-package "ACL2S")

#|

Rotate buffer to the left begin.

An example of how contracts are used to help students learn how
to program and specify contracts.

|#


" Define a function that given a buffer, l, (a true list) and a
natural number, n, rotates the buffer to the left n times.

(Rotate-Left '(1 2 3 4 5) 2) = '(3 4 5 1 2)

"

(definec Rotate-Left (l :tl n :nat) :tl
  (cond ((= n 0) l)
        (t (Rotate-left (app (tail l) (head l))
                        (1- n)))))

(definec Rotate-Left (l :tl n :nat) :tl
  (cond ((= n 0) l)
        ((endp l) nil)
        (t (Rotate-Left (app (tail l) (head l))
                        (1- n)))))

(definec Rotate-Left (l :tl n :nat) :tl
  (cond ((= n 0) l)
        ((endp l) nil)
        (t (Rotate-Left (app (tail l) (list (head l)))
                               (1- n)))))
  
(check= (Rotate-Left '(1 2 3 4 5) 2) '(3 4 5 1 2))

(thm (=> (^ (tlp l) (natp n))
         (= (len (Rotate-Left l n))
            (len l))))

(definec RL (l :tl n :nat) :tl
  (cond ((= n 0) l)
        ((endp l) l)
        (t (RL (app (list (head l)) (tail l))
               (1- n)))))

(test? (=> (^ (tlp l)
              (natp n))
           (== (RL l n)
               (Rotate-Left l n))))

(definec drop-last (x :tl) :tl
  (cond ((endp x) nil)
        ((endp (rest x)) nil)
        (t (cons (first x) (drop-last (rest x))))))

(test? (=> (^ (tlp l)
              (consp l))
           (= (len (drop-last l))
              (1- (len l)))))

(definec prefixes (l :tl) :tl
  (cond ((endp l) '( () ))
        (t (cons l (prefixes (drop-last l))))))

"That went through automatically. Let's investigate.
But, it required an inductive proof that the 
size of (drop-last l) is less than the size of l.
"

(prefixes '(1 2 3))