Added reader macros

master
Ringo Wantanabe 6 years ago
parent 7dea066a39
commit 0c47306d35
No known key found for this signature in database
GPG Key ID: DDDD9B6759158726

@ -1,4 +1,4 @@
#!/bin/bash #!/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 echo

@ -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))))

Loading…
Cancel
Save