Arborealis

;Main is the entire tree
;The tree is ordered like so: ((parent) (node-value) (left-child) (right-child))
;The parent of the root is nill - nothing.
(defparameter *main* (list (list ()) (list 0) (list ()) (list ())))
;Cnod is the current node
(defparameter *cnod* *main*)

#| S1
 | Following commands in this section (in order):
 | *Left and right child creation commands
 | *Movement commands
 | **Node value return function (debug use only)
 | **Node parent return function (debug use only)
 |#

(defun makel ()
  (setf (caaddr *cnod*) (list (copy-list *cnod*) (list 0) (list ()) (list ()))))
(defun maker ()
  (setf (car (cadddr *cnod*)) (list (copy-list *cnod*) (list 0) (list ()) (list ()))))
(defun nodv ()
  (caadr *cnod*))
(defun parn ()
  (car *cnod*))

#| S2
 | Following commands in this section (in order):
 | *Left and right movement commands
 | *Incrementing and decrementing commands
 | *Left and right paradox commands
 |#

(defun movel ()
  (setf *cnod* (caaddr *cnod*)))
(defun mover ()
  (setf *cnod* (car (cadddr *cnod*))))
(defun incnd ()
  (incf (caadr *cnod*)))
(defun decnd ()
  (decf (caadr *cnod*)))
(defun paral ()
  (setf (caaddr *cnod*) (copy-list (car *cnod*))))
(defun parar ()
  (setf (car (cadddr *cnod*)) (copy-list (car *cnod*))))

#| S3
 | Following commands in this section (in order):
 | *Left and right conditional movers
 | *Left and right binary tests
 | *Root return function
 |#

(defun corml ()
  (cond
    ((null (caaddr *cnod*)) (progn (makel) (movel)))
    ((= 0 (nodv)) (movel))
    ((null (car (cadddr *cnod*))) (progn (maker) (mover)))
    ((> 0 (nodv)) (mover))
    (t (print "How did you get here?"))))
(defun cormr ()
  (cond
    ((null (car (cadddr *cnod*))) (progn (maker) (mover)))
    ((= 0 (nodv)) (mover))
    ((null  (caaddr *cnod*)) (progn (makel) (movel)))
    ((> 0 (nodv)) (movel))
    (t (print "How did you get here?"))))
(defun leftp ()
  (if (null (caaddr *cnod*))
    (setf (caadr *cnod*) 0)
    (setf (caadr *cnod*) 1)))
(defun righp ()
  (if (null (car (cadddr *cnod*)))
    (setf (caadr *cnod*) 0)
    (setf (caadr *cnod*) 1)))
(defun root ()
  (defparameter *cnod* *main*))