async: provide lparallel wrappers => no other package uses lparallel directly

core/actor.lisp

@@ -3,8 +3,6 @@
 (defpackage :scopes/core/actor
   (:use :common-lisp)
   (:local-nicknames (:async :scopes/util/async) 
-                    (:lp :lparallel) 
-                    (:lpq :lparallel.queue)
                     (:shape :scopes/shape)
                     (:util :scopes/util))
   (:export #:start #:stop #:become #:create #:send
@@ -39,15 +37,15 @@
 (defun start (mb bhv &key foreground)
   (if foreground
     (ac-loop mb bhv)
-    (let ((ch (lp:make-channel)))
+    (let ((ch (async:make-ch)))
-      (lp:submit-task ch (lambda () (ac-loop mb bhv)))
+      (async:submit-task ch (lambda () (ac-loop mb bhv)))
       ch)))
 
 (defun stop (mb)
   (send mb (message +quit-message+)))
 
 (defun ac-loop (mb bhv)
-  (let ((msg (lpq:pop-queue mb)))
+  (let ((msg (async:rcv mb)))
     (unless (eq (content msg) +quit-message+)
       (ac-loop mb (or (funcall bhv msg) bhv)))))
 
@@ -55,12 +53,12 @@
 ;;;  there is no `become` operation: the behavior just returns the new behavior
 
 (defun create (bhv)
-  (let ((mb (lpq:make-queue))) 
+  (let ((mb (async:make-mb))) 
     (values mb (start mb bhv))))
 
 (defun send (mb msg)
   ;(util:lgi msg)
-  (lpq:push-queue msg mb))
+  (async:snd mb msg))
 
 ;;;; predefined behaviors
 

core/core.lisp

@@ -8,9 +8,7 @@
                     (:message :scopes/core/message)
                     (:shape :scopes/shape)
                     (:util :scopes/util)
-                    (:alx :alexandria)
+                    (:alx :alexandria))
-                    (:lp :lparallel) 
-                    (:lpq :lparallel.queue))
   (:export #:action-spec #:define-actions
            #:*root* #:make-setup #:actions 
            #:find-service #:run-services #:setup-services #:shutdown
@@ -84,7 +82,7 @@
 (defun setup-services (&optional (cfg config:*root*))
   (async:init)
   (let* ((ctx (make-instance 'context :config cfg))) 
-    (setf (mailbox ctx) (lpq:make-queue))
+    (setf (mailbox ctx) (async:make-mb))
     (setf *root* ctx))
   (dolist (c (reverse (config:children cfg)))
     (add-service *root* c)))

util/async.lisp

@@ -5,9 +5,8 @@
   (:local-nicknames (:util :scopes/util)
                     (:lp :lparallel)
                     (:lpq :lparallel.queue))
-  (:export #:init #:finish #:make-mb #:receive #:submit-task
+  (:export #:init #:finish #:make-ch #:make-mb #:rcv #:snd #:submit-task
-           #:fg-task #:task 
+           #:fg-task #:task #:make-task #:start #:stop #:status #:data #:send))
-           #:make-task #:start #:stop #:status #:data #:send))
 
 (in-package :scopes/util/async)
 
@@ -16,24 +15,32 @@
 (defun init ()
   (when (null lp:*kernel*)
     (format t "async:init ~a ~%" 
-             (setf lp:*kernel* (lp:make-kernel (serapeum:count-cpus))))
+             (setf lp:*kernel* (lp:make-kernel (serapeum:count-cpus))))))
-    ))
 
 (defun finish ()
   (when lp:*kernel*
-    (lp:end-kernel)
+    (lp:end-kernel)))
-    ;(setf lp:*kernel* nil)
+
-))
+(defun make-ch ()
+  (lp:make-channel))
 
 (defun make-mb ()
   (lpq:make-queue))
 
-(defun receive (mb)
+(defun rcv (mb)
   (lpq:pop-queue mb))
 
+(defun snd (mb msg)
+  (lpq:push-queue msg mb))
+
 (defun submit-task (ch job)
   (lp:submit-task ch job))
 
+;;;; not used at the moment
+
+(defun receive-result 
+  (lp:receive-result ch))
+
 ;;;; job - probably obsolete
 
 (eval-when (:compile-toplevel :load-toplevel :execute)

web/response.lisp

@@ -2,11 +2,11 @@
 
 (defpackage :scopes/web/response
   (:use :common-lisp)
-  (:local-nicknames (:actor :scopes/core/actor)
+  (:local-nicknames (:async :scopes/util/async)
+                    (:actor :scopes/core/actor)
                     (:cookie :scopes/web/cookie)
                     (:core :scopes/core)
                     (:dom :scopes/web/dom)
-                    (:lpq :lparallel.queue)
                     (:message :scopes/core/message)
                     (:shape :scopes/shape)
                     (:util :scopes/util))
@@ -74,7 +74,7 @@
   (let* ((headers (getf env :headers))
          (resp-class (select-response-class (gethash "accept" headers) html-responder))
          (resp (make-instance resp-class :context ctx :env env)))
-    (setf (core:mailbox resp) (lpq:make-queue))
+    (setf (core:mailbox resp) (async:make-mb))
     resp))
     ;(actor:make-actor #'core:handle-message resp-class :context ctx :env env)))