#|$ACL2s-Preamble$;
; In this file I define some functions that I want the students to have defined
; before we discuss M5.

(defpkg  "M5"
  (set-difference-equal
   (add-to-set-eq 'print-base-p
                  (union-eq *common-lisp-symbols-from-main-lisp-package*
                            *acl2-exports*))
   '(STATE PC PROGRAM ID PUSH POP STEP COMPILE BOUNDP APPEND NTH LEN MEMBER GET GETF TYPE
           FIND REPLACE CLASS METHOD)))

(begin-book t :ttags :all);$ACL2s-Preamble$|#


(in-package "M5")

; Basic List Processing

(defun nth (n lst)
  (if (zp n)
      (car lst)
    (nth (- n 1) (cdr lst))))

(defun put-nth (n val lst)
  (if (zp n)
      (cons val (cdr lst))
    (cons (car lst) (put-nth (- n 1) val (cdr lst)))))

(defun repeat (th n)
     (if (zp n)
         nil
       (cons th (repeat th (- n 1)))))

(defun append (x y)
  (if (endp x)
      y
    (cons (car x)
          (append (cdr x) y))))

(defun rev (lst)
  (if (consp lst)
      (append (rev (cdr lst)) (list (car lst)))
    nil))

(defun len (x)
  (if (endp x)
      0
    (+ 1 (len (cdr x)))))

(defun member (e list)
  (if (endp list)
      nil
    (if (equal e (car list))
        t
      (member e (cdr list)))))

(defun index (e lst)
  (if (endp lst)
      0
    (if (equal e (car lst))
        0
      (+ 1 (index e (cdr lst))))))


; Stacks
(defun push (obj stk) (cons obj stk))
(defun top (stk) (car stk))
(defun pop (stk) (cdr stk))

(defun topn (n stk)
  (if (zp n)
      nil
    (cons (top stk)
          (topn (- n 1) (pop stk)))))

(defun popn (n stk)
  (if (zp n)
      stk
    (popn (- n 1) (pop stk))))

; Instructions

(defun op-code (inst) (car inst))

(defun arg1 (inst) (nth 1 inst))
(defun arg2 (inst) (nth 2 inst))
(defun arg3 (inst) (nth 3 inst))

; Binding Environments

(defun boundp (var alist)
  (if (endp alist)
      nil
    (if (equal var (car (car alist)))
        t
      (boundp var (cdr alist)))))

(defun binding (var alist)
  (if (endp alist)
      nil
    (if (equal var (car (car alist)))
        (car (cdr (car alist)))
      (binding var (cdr alist)))))

(defun bind (var val alist)
  (if (endp alist)
      (list (list var val))
    (if (equal var (car (car alist)))
        (cons (list var val) (cdr alist))
      (cons (car alist)
            (bind var val (cdr alist))))))

(defun bind-all (var-lst x)
  (if (endp var-lst)
      nil
    (cons (list (car var-lst)
                (if (consp x) (car x) x))
          (bind-all (cdr var-lst)
                    (if (consp x) (cdr x) x)))))#|ACL2s-ToDo-Line|#