;; functions missing that are part of common lisp, and commonly used

;; push and pop treat variable v as a stack

(defmacro push (v l)
	`(setf ,l (cons ,v ,l)))

(defmacro pop (l)
	`(prog1 (first ,l) (setf ,l (rest ,l))))

;; pairlis does not check for lengths of keys and values being unequal

(defun pairlis (keys values list)
    (do ((remkeys keys (rest remkeys))
	 (remvals values (rest remvals))
	 (newalist list
		   (cons (cons (first remkeys) (first remvals)) newalist)))
	((null remkeys) newalist)
     ))


(defun copy-list (list) (append list 'nil))

(defun copy-alist (list)
    (if (null list)
        'NIL
        (cons (if (consp (car list))
		  (cons (caar list) (cdar list))
		  (car list))
	      (my-copy-alist (cdr list)))))

(defun copy-tree (list)
    (if (consp list)
        (cons (copy-tree (car list)) (copy-tree (cdr list)))
        list))

(defun list* (&rest list)
    (cond ((null list) 'nil)
	  ((null (cdr list)) (car list))
	  (t (do* ((head (cons (car list) 'nil))
		   (current head
			    (cdr (rplacd current (cons (car tail) 'nil))))
		   (tail (cdr list) (cdr tail)))
		  ((null (cdr tail)) (rplacd current (car tail)) head)
	      ))))

;; THE CAR OF A TCONC POINTS TO THE TCONC LIST,
;; THE TAIL POINTS TO LAST ELEMENT

(defun make-tconc nil
    (cons 'nil 'nil))

(defun tconc (tc new)
    (let ((newl (cons new 'nil)))
      (if (null (cdr tc))
	  (rplaca tc newl)
	  (rplacd (cdr tc) newl))
      (rplacd tc newl)
      tc))

(defun lconc (tc list)
    (cond ((not (null list))
	   (if (null (cdr tc))
	       (rplaca tc list)
	       (rplacd (cdr tc) list))
	   (rplacd tc (last list))))
    tc)

(defun remove-head (tc)
    (cond ((null (car tc)) 'nil)
	  ((null (cdar tc))
	   (let ((element (caar tc)))
	     (rplaca tc 'nil)
	     (rplacd tc 'nil)
	     element))
	  (t (let ((element (caar tc)))
	       (rplaca tc (cdar tc))
	       element))))