diff --git a/make-asdf-system b/make-asdf-system index 0d990e3..faefb2a 100755 --- a/make-asdf-system +++ b/make-asdf-system @@ -1,4 +1,4 @@ #!/bin/bash -sbcl --eval "(progn (asdf:load-system :cl-ppcre) (load \"utils.lisp\") (print (utils->system \"utils.lisp\" \"utils/flan-utils\")) (quit))" +sbcl --eval "(progn (asdf:load-system :cl-ppcre) (asdf:load-system :bt-semaphore) (load \"utils.lisp\") (print (utils->system \"utils.lisp\" \"utils/flan-utils\")) (quit))" echo diff --git a/utils.lisp b/utils.lisp index e1d52ea..04cbaee 100644 --- a/utils.lisp +++ b/utils.lisp @@ -5,7 +5,7 @@ ;;; --- internally maintained config, don't put anything above these!! (defparameter *-utils-lisp* t) -(defparameter *-utils-depends* '(#:cl-ppcre)) +(defparameter *-utils-depends* '(#:cl-ppcre #:bt-semaphore)) (defparameter *-utils-version* "0.1.6") @@ -102,6 +102,9 @@ ; (mapcan #'(lambda (def) ; (when (member (car def) allowed-definitions))) ; defs))))))) + +(defparameter *old-readtables* nil) + (export*? ;;; --- actual (exported) code goes here -- @@ -356,7 +359,87 @@ (defun many-eql (&rest items) (many-equals items :test #'eql)) -;(defun map-parallel (func seq &key (map #'mapcar) (split 0.25) (debug nil)) ;;; TODO: make this work lol +(defmacro async (&rest form) + `(bt:make-thread + #'(lambda () + ,@form))) + +(defun wait (handle) + (bt:join-thread handle)) + + +(defun val (v) v) + +(defun sexpr-reader (stream char &key (func 'val)) + "Read next token only if S expression, else return as is" + (if (char= (peek-char t stream t nil t) #\() + (values (funcall func (read stream t nil t)) t) + (let ((*readtable* (copy-readtable))) + (set-macro-character char nil) + (values (read-from-string (strcat (string char) (write-to-string (read stream t nil t)))) nil)))) + +(defun bang-reader (stream char) + (declare (ignore char)) + (list (quote not) (read stream t nil t))) +; +;(defmacro enable-reader (char func &optional (keep t)) +; `(eval-when (:compile-toplevel :load-toplevel :execute) +; (when keep +; (push *readtable* *old-readtables*) +; (setq *readtable* (copy-readtable))) +; (set-macro-character ,char ,func))) +; +;(defun disable-reader (&optional (char nil)) +; (if (null char) +; '(eval-when (:compile-toplevel :load-toplevel :execute) +; (setq *readtable* (pop *old-readtables*))) +; `(set-macro-character ,char nil))) +; +(defun read-delimiter (stream char) + (declare (ignore stream char))) + +(defun read-next-until (stream char) + (if (char= (peek-char t stream t nil t) char) + (progn + (read-char stream t nil t) nil) + (read stream t nil t))) + +(defun export-reader (stream char) + (declare (ignore char)) + (loop for next = (read-next-until stream #\]) + while next + collect next into objects + finally (return `(export ,@objects)))) + +(defun top-level-reader (stream char) + (multiple-value-bind (thing okay) (sexpr-reader stream char) + (if okay + (append (list 'eval-when '(:compile-toplevel :load-toplevel :execute)) (list thing)) + thing))) + +(defun async-reader (stream char) + (multiple-value-bind (thing okay) (sexpr-reader stream char) + (if okay + (cons 'async (list thing)) + thing))) + +(defmacro enable-all-readers () + '(eval-when (:compile-toplevel :load-toplevel :execute) + (push *readtable* *old-readtables*) + (setq *readtable* (copy-readtable)) + + (set-macro-character #\¬ 'bang-reader) ;"Negates next statement" + (set-macro-character #\[ 'export-reader) ;"Exports all in brackets []" + (set-macro-character #\$ 'async-reader) ;"Run statement in seperate thread" + (set-macro-character #\~ 'top-level-reader))) ;"Run at compile,load and execute" + +(defmacro disable-all-readers() + '(eval-when (:compile-toplevel :load-toplevel :execute) + (setq *readtable* (pop *old-readtables*)))) + + + + ; ((defun map-parallel (func seq &key (map #'mapcar) (split 0.25) (debug nil)) ;;; TODO: make this work lol ; (flet ((dprint (x) (when debug (format t "~S~%" x)) x )) ; "Map over list in parallel" ; (let* ((step (floor (* split (list-length seq))))