|
|
|
@ -24,14 +24,19 @@
|
|
|
|
|
(defmacro export* (&rest syms)
|
|
|
|
|
`(mapc #'export '(,@syms)))
|
|
|
|
|
|
|
|
|
|
(defmacro eval-all (syms)
|
|
|
|
|
`(mapcar #'eval '(,@syms)))
|
|
|
|
|
(export? eval-all)
|
|
|
|
|
|
|
|
|
|
(defmacro export*! (&rest syms)
|
|
|
|
|
`(mapc #'export (list ,@syms)))
|
|
|
|
|
`(mapc #'export (eval-all ,syms)))
|
|
|
|
|
|
|
|
|
|
(export? export*)
|
|
|
|
|
(export? export*!)
|
|
|
|
|
|
|
|
|
|
(defmacro export*? (&rest val)
|
|
|
|
|
`(insystem? (export*! ,@val) (progn ,@val)))
|
|
|
|
|
`(insystem? (export*! ,@val)
|
|
|
|
|
(mapc #'eval '(,@val))))
|
|
|
|
|
|
|
|
|
|
(defun file-get-contents (filename)
|
|
|
|
|
(with-open-file (stream filename)
|
|
|
|
@ -40,6 +45,8 @@
|
|
|
|
|
contents)))
|
|
|
|
|
(export? file-get-contents)
|
|
|
|
|
|
|
|
|
|
;(export? val-if-or)
|
|
|
|
|
|
|
|
|
|
(defun utils->system (input output &key (name :flan-utils) (description "Some random utilities") (author "Ringo <flanchan@cumallover.me>") (license "None"))
|
|
|
|
|
"Write this file to an ASDF system."
|
|
|
|
|
(let ((this (cadddr (read-from-string (file-get-contents input))))
|
|
|
|
@ -59,10 +66,44 @@
|
|
|
|
|
(mapc #'(lambda (stmt) (write stmt :stream output-lisp)) this)
|
|
|
|
|
(write sysdef :stream output-asd :case :downcase )))))
|
|
|
|
|
|
|
|
|
|
(defun utils->create-for (utils for &key (name 'flan-utils) (package nil) ) ;;; TODO: Make this work for structs
|
|
|
|
|
"Export `utils' functions used in file into own file"
|
|
|
|
|
(let ((this (cadddr (read-from-string (file-get-contents utils))))
|
|
|
|
|
(for (read-from-string (file-get-contents for))))
|
|
|
|
|
(labels ((sieve (li) ;; find all `,name:' functions in list
|
|
|
|
|
(mapcan #'(lambda (part)
|
|
|
|
|
(if (atom part)
|
|
|
|
|
(if (cl-ppcre:scan (concatenate 'string "^" (write-to-string name) ":")
|
|
|
|
|
(write-to-string part))
|
|
|
|
|
(list part)
|
|
|
|
|
nil)
|
|
|
|
|
(sieve part)))
|
|
|
|
|
li)))
|
|
|
|
|
(let ((syms (sieve for))
|
|
|
|
|
(allowed-definitions '(defun
|
|
|
|
|
defmacro
|
|
|
|
|
defparameter))) ;;;; STRUCT
|
|
|
|
|
(labels ((find-func (sym-name l) ;;; TODO: here
|
|
|
|
|
(mapcan #'(lambda (part)
|
|
|
|
|
(when (not (atom part))
|
|
|
|
|
(if (eql (cadr part) sym-name) ;; symbol found
|
|
|
|
|
(list part)
|
|
|
|
|
(when (eql (car part) 'export*?) ;; export*?
|
|
|
|
|
(find-func sym-name part)))))
|
|
|
|
|
l)))
|
|
|
|
|
(let ((defs (mapcan #'(lambda (sym)
|
|
|
|
|
(find-func (read-from-string (cadr (cl-ppcre:split (concatenate 'string "^" (write-to-string name) ":") (write-to-string sym)))) this))
|
|
|
|
|
syms)))
|
|
|
|
|
(mapcan #'(lambda (def)
|
|
|
|
|
(when (member (car def) allowed-definitions)))
|
|
|
|
|
defs)))))))
|
|
|
|
|
(export*?
|
|
|
|
|
|
|
|
|
|
;;; --- actual (exported) code goes here ---
|
|
|
|
|
|
|
|
|
|
(defmacro val-if-or (val test or)
|
|
|
|
|
`(let ((vv ,val))
|
|
|
|
|
(if (funcall ,test vv) vv ,or)))
|
|
|
|
|
|
|
|
|
|
(defun where (expr items)
|
|
|
|
|
(mapcan #'(lambda (x)
|
|
|
|
@ -121,9 +162,6 @@
|
|
|
|
|
(with-output-to-string (stream)
|
|
|
|
|
(apply #'format `(,stream ,fmt . ,r))))
|
|
|
|
|
|
|
|
|
|
(defmacro val-if-or (val test or)
|
|
|
|
|
`(let ((vv ,val))
|
|
|
|
|
(if (funcall ,test vv) vv ,or)))
|
|
|
|
|
|
|
|
|
|
(defun get-all-symbols ()
|
|
|
|
|
(let ((lst '()))
|
|
|
|
@ -171,14 +209,14 @@
|
|
|
|
|
0 -2))))
|
|
|
|
|
|
|
|
|
|
(defun export-struct (struct &optional (symbols nil))
|
|
|
|
|
(mapc #'export (symbol-match (strcat "^" (write-to-string struct) "-") symbols)))
|
|
|
|
|
(mapc #'export (symbol-match (strcat "^" (write-to-string struct) "-?") symbols)))
|
|
|
|
|
|
|
|
|
|
(defun -export*-struct (structs &optional (symbols nil))
|
|
|
|
|
(mapc #'export (symbol-match
|
|
|
|
|
(strcat
|
|
|
|
|
"^("
|
|
|
|
|
(strjoin "|" (mapcar #'write-to-string structs))
|
|
|
|
|
")-")
|
|
|
|
|
")-?")
|
|
|
|
|
symbols)))
|
|
|
|
|
|
|
|
|
|
(defmacro export*-struct (&rest structs)
|
|
|
|
|