Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ;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*))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement