Update libraries

contrib/clim-test/src/misc.lisp

@@ -2,7 +2,7 @@
   (:use :cl))
 
 (defvar *job-handler* nil)
-(defvar *job-handler-queue* (dhs-sequences:make-blocking-queue :name "Job handler queue"))
+(defvar *job-handler-queue* (receptacle:make-blocking-queue :name "Job handler queue"))
 
 (defclass channel ()
   ((id      :type string
@@ -52,7 +52,7 @@
 
 (defun job-handler-loop ()
   (loop
-    for job = (dhs-sequences:queue-pop-wait *job-handler-queue*)
+    for job = (receptacle:queue-pop-wait *job-handler-queue*)
     do (restart-case
             (funcall (job/callback job))
          (skip-current-job ()
@@ -67,7 +67,7 @@
 
 (defun submit-new-job (callback)
   (let ((job (make-instance 'job :callback callback)))
-    (dhs-sequences:queue-push *job-handler-queue* job)))
+    (receptacle:queue-push *job-handler-queue* job)))
 
 (defmacro with-submitted-job ((conn) &body body)
   (let ((conn-sym (gensym "CONN-")))

potato-index.asd

@@ -6,7 +6,7 @@
   :depends-on (:potato-common
                :alexandria
                :cl-solr
-               :containers
+               :receptacle
                :cl-markup
                :string-case)
   :components ((:module "src/index"

potato.asd

@@ -16,7 +16,7 @@
                  :cl-memcached
                  :iolib
                  :trivial-gray-streams
-                 :containers
+                 :receptacle
                  :secure-random
                  :cl-who
                  :log4cl

src/common/fset-map.lisp

@@ -3,22 +3,22 @@
 (declaim #.*compile-decl*)
 
 (defun make-fsmap ()
-  (dhs-sequences:make-cas-wrapper (fset:empty-map)))
+  (receptacle:make-cas-wrapper (fset:empty-map)))
 
 (defun fsmap-value (map key)
-  (fset:lookup (dhs-sequences:cas-wrapper/value map) key))
+  (fset:lookup (receptacle:cas-wrapper/value map) key))
 
 (defun fsmap-set (map key value &key no-replace)
   (loop
-     for old-map = (dhs-sequences:cas-wrapper/value map)
+     for old-map = (receptacle:cas-wrapper/value map)
      do (progn
           (when no-replace
             (multiple-value-bind (old-value set-p)
                 (fset:lookup old-map key)
               (when set-p
                 (return old-value))))
           (let* ((new-map (fset:with old-map key value))
-                 (result (dhs-sequences:cas map old-map new-map)))
+                 (result (receptacle:cas map old-map new-map)))
             (when (eq old-map result)
               (return value))))))
 

src/common/msgl-queue.lisp

@@ -6,8 +6,8 @@
   ())
 
 (defclass msgl ()
-  ((messages     :type dhs-sequences:queue
-                 :initform (dhs-sequences:make-queue)
+  ((messages     :type receptacle:queue
+                 :initform (receptacle:make-queue)
                  :reader msgl/messages)
    (processing-p :type t
                  :initform nil
@@ -26,7 +26,7 @@
   (when (bordeaux-threads:with-lock-held ((msgl/lock queue))
           (when (msgl/stopped queue)
             (error "Queue is stopped: ~s" queue))
-          (dhs-sequences:queue-push (msgl/messages queue) fn)
+          (receptacle:queue-push (msgl/messages queue) fn)
           (if (msgl/processing-p queue)
               nil
               (progn
@@ -36,12 +36,12 @@
       (block msgl-finish
         (let ((will-exit nil))
           (labels ((stop ()
-                     (dhs-sequences:delete-all (msgl/messages queue))
+                     (receptacle:delete-all (msgl/messages queue))
                      (setf (msgl/stopped queue) nil)))
             (unwind-protect
                  (loop
                     for obj = (bordeaux-threads:with-lock-held ((msgl/lock queue))
-                                (let ((result (dhs-sequences:queue-pop (msgl/messages queue)
+                                (let ((result (receptacle:queue-pop (msgl/messages queue)
                                                                        :if-empty nil)))
                                   (unless result
                                     (setf (msgl/processing-p queue) nil)

src/common/package.lisp

@@ -109,7 +109,7 @@
            #:sorted-list-first-item
            #:plain-sorted-list
            #:cl-containers-sorted-list
-           #:dhs-sequences-sorted-list
+           #:receptacle-sorted-list
            #:*state-server-reader-expire-time*
            #:*state-server-reader-high-prio*
            #:*state-server-reader-low-prio*

src/common/sorted-list.lisp

@@ -107,37 +107,37 @@ removed, or NIL if the element could not be found."
   (cl-containers:first-item (cl-containers-sorted-list/content list)))
 
 ;;;
-;;;  dhs-sequences.red-black-tree version
+;;;  receptacle.red-black-tree version
 ;;;
 
-(defclass dhs-sequences-sorted-list (sorted-list-mixin)
-  ((content :type dhs-sequences.red-black-tree:red-black-tree
-            :reader dhs-sequences-sorted-list/content)))
+(defclass receptacle-sorted-list (sorted-list-mixin)
+  ((content :type receptacle.red-black-tree:red-black-tree
+            :reader receptacle-sorted-list/content)))
 
-(defmethod initialize-instance :after ((obj dhs-sequences-sorted-list) &key)
+(defmethod initialize-instance :after ((obj receptacle-sorted-list) &key)
   (setf (slot-value obj 'content)
-        (make-instance 'dhs-sequences.red-black-tree:red-black-tree
+        (make-instance 'receptacle.red-black-tree:red-black-tree
                        :test (sorted-list/test-fn obj)
                        :test-equal (sorted-list/test-equal-fn obj)
                        :key (sorted-list/key-fn obj))))
 
-(defmethod sorted-list-insert ((list dhs-sequences-sorted-list) element)
-  (dhs-sequences:tree-insert (dhs-sequences-sorted-list/content list) element))
+(defmethod sorted-list-insert ((list receptacle-sorted-list) element)
+  (receptacle:tree-insert (dhs-sequences-sorted-list/content list) element))
 
-(defmethod sorted-list-remove ((list dhs-sequences-sorted-list) element)
-  (let* ((tree (dhs-sequences-sorted-list/content list))
-         (node (dhs-sequences:tree-find-node tree element)))
+(defmethod sorted-list-remove ((list receptacle-sorted-list) element)
+  (let* ((tree (receptacle-sorted-list/content list))
+         (node (receptacle:tree-find-node tree element)))
     (if node
         (progn
-          (dhs-sequences:tree-delete-node tree node)
-          (dhs-sequences:node-element node))
+          (receptacle:tree-delete-node tree node)
+          (receptacle:node-element node))
         (progn
           (log:warn "Attempt to remove node ~s which was not in the tree" element)
           nil))))
 
-(defmethod sorted-list-first-item ((list dhs-sequences-sorted-list))
-  (let ((tree (dhs-sequences-sorted-list/content list)))
-    (dhs-sequences:tree-first-element tree)))
+(defmethod sorted-list-first-item ((list receptacle-sorted-list))
+  (let ((tree (receptacle-sorted-list/content list)))
+    (receptacle:tree-first-element tree)))
 
 ;;;
 ;;;  logged-sorted-list
@@ -186,5 +186,5 @@ removed, or NIL if the element could not be found."
 
 (defclass logged-cl-containers-sorted-list (locked-sorted-list-mixin logged-sorted-list-mixin cl-containers-sorted-list)
   ())
-(defclass logged-dhs-sequences-sorted-list (logged-sorted-list-mixin dhs-sequences-sorted-list)
+(defclass logged-receptacle-sorted-list (logged-sorted-list-mixin dhs-sequences-sorted-list)
   ())

src/common/timer.lisp

@@ -4,15 +4,15 @@
 
 (deftype timer-trigger () '(and real (satisfies plusp)))
 
-(defclass checked-dhs-sequences-sorted-list (potato.common:dhs-sequences-sorted-list)
+(defclass checked-receptacle-sorted-list (potato.common:dhs-sequences-sorted-list)
   ()
-  (:documentation "Special version of dhs-sequences-sorted-list which
+  (:documentation "Special version of receptacle-sorted-list which
 verifies that removed objects actually exists in the list, and throws
 an error if not. This is purely to be used for testing, since its use
 in the timer queue has a race condition when a timer expires at the
 same time an object is being removed from the list."))
 
-(defmethod potato.common:sorted-list-remove :around ((list checked-dhs-sequences-sorted-list) element)
+(defmethod potato.common:sorted-list-remove :around ((list checked-receptacle-sorted-list) element)
   (let ((element (call-next-method)))
     (unless element
       (error "Illegal state in timer queue detected. Unable to find object in list: ~s" element))))
@@ -28,26 +28,26 @@ same time an object is being removed from the list."))
                  :initarg :callback
                  :initform (error "required value ~s missing" :callback)
                  :reader timer/callback)
-   (cancelled    :type dhs-sequences:cas-wrapper
-                 :initform (dhs-sequences:make-cas-wrapper nil)
+   (cancelled    :type receptacle:cas-wrapper
+                 :initform (receptacle:make-cas-wrapper nil)
                  :accessor timer/cancelled)))
 
 (defmethod print-object ((obj timer) stream)
   (print-unreadable-safely (index trigger-time cancelled) obj stream
-    (format stream "INDEX ~s TRIGGER-TIME ~s CANCELLED ~s" index trigger-time (dhs-sequences:cas-wrapper/value cancelled))))
+    (format stream "INDEX ~s TRIGGER-TIME ~s CANCELLED ~s" index trigger-time (receptacle:cas-wrapper/value cancelled))))
 
 (defclass timer-queue ()
   ((name          :type string
                   :initarg :name
                   :initform (error "required value missing")
                   :reader timer-queue/name)
-   (request-queue :type dhs-sequences:blocking-queue
-                  :initform (dhs-sequences:make-blocking-queue)
+   (request-queue :type receptacle:blocking-queue
+                  :initform (receptacle:make-blocking-queue)
                   :reader timer-queue/request-queue)
    (timers        :type t
                   :reader timer-queue/timers)
-   (index         :type dhs-sequences:cas-wrapper
-                  :initform (dhs-sequences:make-cas-wrapper 0)
+   (index         :type receptacle:cas-wrapper
+                  :initform (receptacle:make-cas-wrapper 0)
                   :accessor timer-queue/index)
    (thread        :type t
                   :initform nil
@@ -68,11 +68,11 @@ same time an object is being removed from the list."))
         ;; Fallback that can be used if a bug is found in the red-black implementation
         #+nil(make-instance 'potato.common:plain-sorted-list :test #'timer< :test-equal #'eq :key #'identity)
         ;; Standard sorted list to use in production deployments
-        (make-instance 'potato.common:dhs-sequences-sorted-list :test #'timer< :test-equal #'eq :key #'identity)
+        (make-instance 'potato.common:receptacle-sorted-list :test #'timer< :test-equal #'eq :key #'identity)
         ;; Don't use the checked sorted list in production. See the note about the race condition in the class documentation
-        #+nil(make-instance 'checked-dhs-sequences-sorted-list :test #'timer< :test-equal #'eq :key #'identity)
+        #+nil(make-instance 'checked-receptacle-sorted-list :test #'timer< :test-equal #'eq :key #'identity)
         ;; Used to debug possible errors in the red-black implementation
-        #+nil(make-instance 'potato.common::logged-dhs-sequences-sorted-list
+        #+nil(make-instance 'potato.common::logged-receptacle-sorted-list
                        :test #'timer< :test-equal #'eq :key #'identity
                        :name (timer-queue/name obj)
                        :value-formatter (lambda (v)
@@ -96,10 +96,10 @@ same time an object is being removed from the list."))
      if (and next-expired (<= (timer/trigger-time next-expired) now))
      do (progn
           (sorted-list-remove timers next-expired)
-          (when (null (dhs-sequences:cas (timer/cancelled next-expired) nil t))
+          (when (null (receptacle:cas (timer/cancelled next-expired) nil t))
             (funcall (timer/callback next-expired))))
      else
-     do (let ((task (dhs-sequences:queue-pop-wait request-queue
+     do (let ((task (receptacle:queue-pop-wait request-queue
                                                   :timeout (if next-expired
                                                                (- (timer/trigger-time next-expired) now)
                                                                ;; ELSE: No timers, wait indefinitely
@@ -111,11 +111,11 @@ same time an object is being removed from the list."))
                       (:stop (return-from timer-thread-loop nil))))))))
 
 (defun increment-index (mgr)
-  (dhs-sequences:with-cas-update (v (timer-queue/index mgr))
+  (receptacle:with-cas-update (v (timer-queue/index mgr))
     (1+ v)))
 
 (defun push-request-to-request-queue (mgr fn)
-  (dhs-sequences:queue-push (timer-queue/request-queue mgr) fn))
+  (receptacle:queue-push (timer-queue/request-queue mgr) fn))
 
 (defun schedule-timer (mgr time callback)
   (check-type mgr timer-queue)
@@ -150,7 +150,7 @@ same time an object is being removed from the list."))
 (defun unschedule-timer (mgr timer)
   (check-type mgr timer-queue)
   (check-type timer timer)
-  (when (null (dhs-sequences:cas (timer/cancelled timer) nil t))
+  (when (null (receptacle:cas (timer/cancelled timer) nil t))
     (push-request-to-request-queue mgr
                                    (lambda ()
                                      (let ((timers (timer-queue/timers mgr)))

src/index/potato-index.lisp

@@ -2,7 +2,7 @@
 
 (declaim #.potato.common::*compile-decl*)
 
-(defvar *channel-group-cache* (dhs-sequences:make-blocking-hash-map :name "Map from channel to group" :test #'equal))
+(defvar *channel-group-cache* (receptacle:make-blocking-hash-map :name "Map from channel to group" :test #'equal))
 (defvar *main-seq-field-name* "couchdb_seq")
 (defvar *main-seq* nil)
 
@@ -33,7 +33,7 @@
         db-seq)))
 
 (defun find-cached-channel (channel-id)
-  (dhs-sequences:hash-get-or-update *channel-group-cache* channel-id
+  (receptacle:hash-get-or-update *channel-group-cache* channel-id
                                     #'(lambda ()
                                         (let* ((channel-result (clouchdb:get-document channel-id))
                                                (group-id (getfield :|group| channel-result)))

src/potato/commands.lisp

@@ -69,7 +69,7 @@
                         (error "Unable to parse args: ~a" s)))
                  (return (reverse result))))))
 
-(defvar *command-map* (dhs-sequences:make-hash-map :test 'equal))
+(defvar *command-map* (receptacle:make-hash-map :test 'equal))
 
 (defmacro define-command (name command required-params optional-params description long-description &body body)
   (let ((args-sym (gensym "ARGS"))
@@ -90,7 +90,7 @@
                       for index from (length required-params)
                       collect `(,(car sym) (nth ,index ,args-sym))))
              ,@body)))
-       (setf (dhs-sequences:hash-get *command-map* ,command)
+       (setf (receptacle:hash-get *command-map* ,command)
              (list ',name ,command ',required-params ',optional-params ,description ,long-description)))))
 
 (defun arg-is-active (arg &optional default-active-p)
@@ -104,15 +104,15 @@
          (error "Illegal boolean parameter: ~s" arg))))
 
 (defun show-commands-list ()
-  (let ((commands (sort (dhs-sequences:hash-keys *command-map*) #'string<)))
+  (let ((commands (sort (receptacle:hash-keys *command-map*) #'string<)))
     (dolist (command commands)
       (destructuring-bind (name command-string requred-params optional-params description long-description)
-          (dhs-sequences:hash-get *command-map* command)
+          (receptacle:hash-get *command-map* command)
         (declare (ignore name requred-params optional-params long-description))
         (format t "~a - ~a~%" command-string description)))))
 
 (defun show-command-help (cmd)
-  (let ((command (dhs-sequences:hash-get *command-map* cmd)))
+  (let ((command (receptacle:hash-get *command-map* cmd)))
     (unless command
       (error "No such command: ~s" cmd))
     (destructuring-bind (name command-string requred-params optional-params description long-description)
@@ -417,7 +417,7 @@ Valid values for role is: user, admin"
                  (show-command-help (car args)))
                 (t
                  (error "Usage: help [command]")))
-          (let ((command (dhs-sequences:hash-get *command-map* name)))
+          (let ((command (receptacle:hash-get *command-map* name)))
             (unless command
               (error "No such command: ~s" name))
             (funcall (car command) args))))))