From: Olof-Joachim Frahm Date: Thu, 11 Jul 2013 21:02:22 +0000 (+0200) Subject: Add initial support for SEQUENCE integration. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7f66452f5c49aef4ad5e38a61c887874f7668d4f;p=trees.git Add initial support for SEQUENCE integration. Also simplification of the existing MAKE-ITERATOR. --- diff --git a/iterator.lisp b/iterator.lisp index 3cdaa1c..e8c7ea9 100644 --- a/iterator.lisp +++ b/iterator.lisp @@ -1,7 +1,7 @@ (in-package :trees) -(defun extreme-node-with-path (root direction &optional path) - (do ((node root (funcall direction node)) +(defun extreme-node-with-path (root leftp &optional path) + (do ((node root (if leftp (left node) (right node))) (parent nil node)) ((null node) (values parent path)) (push node path))) @@ -12,28 +12,24 @@ (stack nil stackp)) (declare (type binary-tree tree)) (let ((modcount (modcount tree))) - (multiple-value-bind (extremum examine) - (if forwardp - (values #'left #'right) - (values #'right #'left)) - (multiple-value-bind (current stack) - (if (and currentp stackp) - (values current stack) - (extreme-node-with-path (root tree) extremum)) - #'(lambda () - (cond - ((/= modcount (modcount tree)) - (error "~A modified during iteration" tree)) - ((null current) - (values nil nil)) - (t - (let* ((next current) - (top (pop stack)) - (node (funcall examine top))) - (cond - ((null node) - (setf current (first stack))) - (t - (setf (values current stack) - (extreme-node-with-path node extremum stack)))) - (values next t))))))))) + (multiple-value-bind (current stack) + (if (and currentp stackp) + (values current stack) + (extreme-node-with-path (root tree) forwardp)) + (lambda () + (cond + ((/= modcount (modcount tree)) + (error "~A modified during iteration" tree)) + ((null current) + (values nil nil)) + (t + (let* ((next current) + (top (pop stack)) + (node (if forwardp (right top) (left top)))) + (cond + ((null node) + (setf current (first stack))) + (t + (setf (values current stack) + (extreme-node-with-path node forwardp stack)))) + (values next t)))))))) diff --git a/sequence.lisp b/sequence.lisp new file mode 100644 index 0000000..1d7b2db --- /dev/null +++ b/sequence.lisp @@ -0,0 +1,35 @@ +(in-package :trees) + +(defmethod sequence:length ((binary-tree binary-tree)) + (size binary-tree)) + +(defmethod sequence:make-simple-sequence-iterator ((binary-tree binary-tree) + &key from-end (start 0) end) + (when (or (not (zerop start)) end) + (error "~A and ~A are unsupported for ~A" 'start 'end 'binary-tree)) + (multiple-value-bind (current stack) + (extreme-node-with-path (root binary-tree) (not from-end)) + (declare (ignore current)) + (values stack NIL from-end))) + +(defmethod sequence:iterator-step ((binary-tree binary-tree) iterator from-end) + (let* ((current (car iterator)) + (stack (cdr iterator)) + (node (if from-end (left current) (right current)))) + (cond + ((null node) + stack) + (t + (multiple-value-bind (current stack) + (extreme-node-with-path node (not from-end) stack) + (declare (ignore current)) + stack))))) + +(defmethod sequence:iterator-endp ((binary-tree binary-tree) iterator limit from-end) + (declare (ignore limit from-end)) + (null iterator)) + +(defmethod sequence:iterator-element ((binary-tree binary-tree) iterator) + (datum (car iterator))) + +;; (defmethod sequence:iterator-index ((binary-tree binary-tree) iterator)) diff --git a/trees.asd b/trees.asd index b8b3a47..8f13810 100644 --- a/trees.asd +++ b/trees.asd @@ -19,6 +19,7 @@ (:file "avl-trees" :depends-on ("types" "binary-trees")) (:file "aa-trees" :depends-on ("types" "binary-trees")) (:file "iterator" :depends-on ("types" "binary-trees")) + (:file "sequence" :depends-on ("iterator")) (:file "utils" :depends-on ("binary-trees")) (:static-file "LICENSE") (:static-file "README") diff --git a/types.lisp b/types.lisp index d2235d1..83f9821 100644 --- a/types.lisp +++ b/types.lisp @@ -47,6 +47,52 @@ ;;; trees +#+sbcl +(defclass binary-tree (sequence standard-object) + ((test :initform #1=(error "missing arg") + :initarg :test + :type 'function + :reader test) + (key :initform #1# + :initarg :key + :type 'function + :reader key) + (pred :initform #1# + :initarg :pred + :type 'function + :reader pred) + (size :initform 0 + :initarg :size + :type 'fixnum + :accessor size) + (root :initform nil + :initarg :root + :type '(or null tree-node) + :accessor root) + (modcount :initform 0 + :initarg :modcount + :type 'fixnum + :accessor modcount) + (nodegen :initform #1# + :initarg :nodegen + :type 'function + :reader nodegen) + (rebalance/insert :initform nil + :initarg :rebalance/insert + :type '(or null function) + :reader rebalance/insert) + (rebalance/delete :initform nil + :initarg :rebalance/delete + :type '(or null function) + :reader rebalance/delete))) + +#+sbcl +(defun %make-binary-tree (pred key test nodegen rebalance/insert rebalance/delete) + (make-instance 'binary-tree :pred pred :key key :test test :nodegen nodegen + :rebalance/insert rebalance/insert + :rebalance/delete rebalance/delete)) + +#-sbcl (defstruct (binary-tree (:conc-name) (:constructor %make-binary-tree (pred key test