cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

minor improvements; util: start with functional tools: curry

Browse source
This commit is contained in:
Helmut Merz 2025-07-29 07:51:11 +02:00
parent dd1501636e
commit 6498068924
4 changed files with 14 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
lib/auth/web.lisp
View file

@ -21,7 +21,6 @@
(defun login-form (ctx msg-in) (defun login-form (ctx msg-in)
(let ((msg (message:create '(:auth :form :login) (let ((msg (message:create '(:auth :form :login)
:data (list :data (list
;:fields (:login :password)
:fields (login-fields) :fields (login-fields)
:button "Login")))) :button "Login"))))
(actor:send (actor:customer msg-in) msg) (actor:send (actor:customer msg-in) msg)

2
test/test-core.lisp
View file

@ -72,6 +72,8 @@
(t:show-result)))) (t:show-result))))
(deftest test-util () (deftest test-util ()
(let ((35+ (util:curry #'+ 35)))
(== (funcall 35+ 7) 42))
(let ((now (get-universal-time))) (let ((now (get-universal-time)))
(== (util:from-unix-time (util:to-unix-time now)) now)) (== (util:from-unix-time (util:to-unix-time now)) now))
(let* ((x (util:ptr)) (let* ((x (util:ptr))

9
util/async.lisp
View file

@ -17,14 +17,15 @@
(defun init () (defun init ()
(when (null lp:*kernel*) (when (null lp:*kernel*)
(format t "async:init ~a ~%" ;(format t "async:init ~a ~%"
(setf lp:*kernel* (lp:make-kernel (serapeum:count-cpus)))))) (setf lp:*kernel* (lp:make-kernel (serapeum:count-cpus)))
(util:lgi lp:*kernel*)))
(defun finish () (defun finish ()
(when lp:*kernel* (when lp:*kernel*
(lp:end-kernel))) (lp:end-kernel)))
;;;; simple task = mailbox with result channel ;;;; simple addressable task = mailbox with result channel
(defclass mailbox () (defclass mailbox ()
((queue :reader queue :initform (lpq:make-queue)) ((queue :reader queue :initform (lpq:make-queue))
@ -54,7 +55,7 @@
(defun try-receive-result (mb) (defun try-receive-result (mb)
(lp:try-receive-result (channel mb))) (lp:try-receive-result (channel mb)))
;;;; tasks - with behavior and thread-safe status ;;;; real (restartable) task - with behavior and thread-safe status
(defclass task (mailbox) (defclass task (mailbox)
((behavior :accessor behavior :initarg :behavior))) ((behavior :accessor behavior :initarg :behavior)))

8
util/util.lisp
View file

@ -4,7 +4,8 @@
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:b64 :qbase64)) (:local-nicknames (:b64 :qbase64))
#+sbcl (:import-from :sb-ext #:add-package-local-nickname) #+sbcl (:import-from :sb-ext #:add-package-local-nickname)
(:export #:make-vars-format #:lg #:lgd #:lgi #:lgw #:lgx (:export #:curry
#:make-vars-format #:lg #:lgd #:lgi #:lgw #:lgx
#:from-unix-time #:to-unix-time #:from-unix-time #:to-unix-time
#:ptr #:ptr
#:rfill #:rtrim #:rfill #:rtrim
@ -19,6 +20,11 @@
(in-package :scopes/util) (in-package :scopes/util)
;;;; functional tools
(defun curry (fn a)
(lambda (&rest args) (apply fn a args)))
;;;; formatting and logging shortcuts ;;;; formatting and logging shortcuts
(defun make-vars-format (vars &optional info) (defun make-vars-format (vars &optional info)