Add a graph utility class

Remove tree functionality from utils.lisp and generalize it as graph

core/all.lisp

@@ -7,6 +7,7 @@
     (:nicknames :core)
   (:use-reexport
    :stoe/core/utils
+   :stoe/core/graph
    :stoe/core/time
    :stoe/core/thread
    :stoe/core/containers

core/graph.lisp

@@ -0,0 +1,68 @@
+#|
+  This file is a part of stoe project.
+  Copyright (c) 2014 Renaud Casenave-Péré (renaud@casenave-pere.fr)
+|#
+
+(uiop:define-package :stoe/core/graph
+    (:use :cl :stoe/core/utils)
+  (:export #:graph-node #:prior-nodes #:next-nodes
+           #:attach-node #:detach-node #:insert-node
+           #:cyclic-graph-p #:make-graph-node))
+(in-package :stoe/core/graph)
+
+(defclass graph-node ()
+  ((prior-nodes :initform nil :accessor prior-nodes)
+   (next-nodes :initform nil :accessor next-nodes)))
+
+(defgeneric attach-node (node &key prior next))
+(defmethod attach-node ((node graph-node) &key prior next)
+  (let ((prior-list (safe-list prior))
+        (next-list (safe-list next)))
+    (with-slots (prior-nodes next-nodes) node
+      (setf prior-nodes (append prior-nodes prior-list))
+      (setf next-nodes (append next-nodes next-list)))
+    (mapc (lambda (pnode)
+            (with-slots (next-nodes) pnode
+              (setf next-nodes (append next-nodes (list node)))))
+          prior-list)
+    (mapc (lambda (nnode)
+            (with-slots (prior-nodes) nnode
+              (setf prior-nodes (append prior-nodes (list node)))))
+          next-list))
+  node)
+
+(defgeneric detach-node (node &key prior next))
+(defmethod detach-node ((node graph-node) &key prior next)
+  (let ((prior-list (if (eq prior t) (prior-nodes node) (safe-list prior)))
+        (next-list (if (eq next t) (next-nodes node) (safe-list next))))
+    (mapc (lambda (pnode)
+            (with-slots (next-nodes) pnode
+              (setf next-nodes (remove node next-nodes))))
+          prior-list)
+    (mapc (lambda (nnode)
+            (with-slots (prior-nodes) nnode
+              (setf prior-nodes (remove node prior-nodes))))
+          next-list))
+  (values))
+
+(defgeneric insert-node (node prior next))
+(defmethod insert-node ((node graph-node) prior next)
+  (detach-node prior :next next)
+  (attach-node node :prior prior :next next))
+
+(defun cyclic-graph-p (node)
+  (let ((visited-nodes (list node))
+        (visit-stack (next-nodes node)))
+    (loop for node = (pop visit-stack)
+          do (cond
+               ((null node) (return nil))
+               ((member node visited-nodes) (return t))
+               (t
+                (push node visited-nodes)
+                (setf visit-stack (append (next-nodes node) visit-stack)))))))
+
+(defun make-graph-node (&key prior next)
+  (let ((node (make-instance 'graph-node)))
+    (when (or prior next)
+      (attach-node node :prior prior :next next))
+    node))

core/utils.lisp

@@ -10,7 +10,6 @@
            #:progress-step
            #:loop-with-progress
            #:add-hook #:remove-hook #:run-hook
-           #:node #:parent #:children #:attach-node #:detach-node #:root
            #:shared-object #:refcount #:inc-ref #:dec-ref
            #:extend-array #:shrink-array
            #:error-implementation-unsupported
@@ -85,36 +84,6 @@
           hook)
     result))
 
-(defclass node ()
-  ((parent :initform nil :accessor parent)
-   (children :initform nil :accessor children)))
-
-(defgeneric attach-node (node parent))
-(defmethod attach-node ((node node) parent)
-  (with-slots ((node-parent parent)) node
-    (when parent
-      (with-slots (children) parent
-        (setf children (append children (list node)))))
-    (setf node-parent parent))
-  node)
-
-(defgeneric detach-node (node))
-(defmethod detach-node ((node node))
-  (with-slots (parent) node
-    (when parent
-      (with-slots (children) parent
-        (setf children (delete node children)))))
-  node)
-
-(defgeneric root (node))
-(defmethod root ((node node))
-  (if (parent node)
-      (root (parent node))
-      node))
-
-(defmethod initialize-instance :after ((node node) &key parent)
-  (attach-node node parent))
-
 (defclass shared-object ()
   ((refcount :initform 0 :reader refcount)))
 
@@ -170,8 +139,6 @@
   (:documentation "Return the name of an object."))
 (defgeneric id (obj)
   (:documentation "Return the id of an object."))
-(defgeneric parent (obj)
-  (:documentation "Return the parent of an object."))
 (defgeneric size (obj)
   (:documentation "Return the size of an object."))
 (defgeneric raw-data (obj)