|
|
@ -5,7 +5,7 @@
|
|
|
|
;;; --- internally maintained config, don't put anything above these!!
|
|
|
|
;;; --- internally maintained config, don't put anything above these!!
|
|
|
|
|
|
|
|
|
|
|
|
(defparameter *-utils-lisp* t)
|
|
|
|
(defparameter *-utils-lisp* t)
|
|
|
|
(defparameter *-utils-depends* '(#:cl-ppcre))
|
|
|
|
(defparameter *-utils-depends* '(#:cl-ppcre #:bt-semaphore))
|
|
|
|
|
|
|
|
|
|
|
|
(defparameter *-utils-version* "0.1.6")
|
|
|
|
(defparameter *-utils-version* "0.1.6")
|
|
|
|
|
|
|
|
|
|
|
@ -102,6 +102,9 @@
|
|
|
|
; (mapcan #'(lambda (def)
|
|
|
|
; (mapcan #'(lambda (def)
|
|
|
|
; (when (member (car def) allowed-definitions)))
|
|
|
|
; (when (member (car def) allowed-definitions)))
|
|
|
|
; defs)))))))
|
|
|
|
; defs)))))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defparameter *old-readtables* nil)
|
|
|
|
|
|
|
|
|
|
|
|
(export*?
|
|
|
|
(export*?
|
|
|
|
|
|
|
|
|
|
|
|
;;; --- actual (exported) code goes here --
|
|
|
|
;;; --- actual (exported) code goes here --
|
|
|
@ -356,7 +359,87 @@
|
|
|
|
(defun many-eql (&rest items)
|
|
|
|
(defun many-eql (&rest items)
|
|
|
|
(many-equals items :test #'eql))
|
|
|
|
(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 ))
|
|
|
|
; (flet ((dprint (x) (when debug (format t "~S~%" x)) x ))
|
|
|
|
; "Map over list in parallel"
|
|
|
|
; "Map over list in parallel"
|
|
|
|
; (let* ((step (floor (* split (list-length seq))))
|
|
|
|
; (let* ((step (floor (* split (list-length seq))))
|
|
|
|