Adding another exporting thing

master
Ringo Wantanabe 5 years ago
parent 1de7750917
commit 9b6da0e57c
No known key found for this signature in database
GPG Key ID: DDDD9B6759158726

@ -24,14 +24,19 @@
(defmacro export* (&rest syms) (defmacro export* (&rest syms)
`(mapc #'export '(,@syms))) `(mapc #'export '(,@syms)))
(defmacro eval-all (syms)
`(mapcar #'eval '(,@syms)))
(export? eval-all)
(defmacro export*! (&rest syms) (defmacro export*! (&rest syms)
`(mapc #'export (list ,@syms))) `(mapc #'export (eval-all ,syms)))
(export? export*) (export? export*)
(export? export*!) (export? export*!)
(defmacro export*? (&rest val) (defmacro export*? (&rest val)
`(insystem? (export*! ,@val) (progn ,@val))) `(insystem? (export*! ,@val)
(mapc #'eval '(,@val))))
(defun file-get-contents (filename) (defun file-get-contents (filename)
(with-open-file (stream filename) (with-open-file (stream filename)
@ -40,6 +45,8 @@
contents))) contents)))
(export? file-get-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")) (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." "Write this file to an ASDF system."
(let ((this (cadddr (read-from-string (file-get-contents input)))) (let ((this (cadddr (read-from-string (file-get-contents input))))
@ -59,10 +66,44 @@
(mapc #'(lambda (stmt) (write stmt :stream output-lisp)) this) (mapc #'(lambda (stmt) (write stmt :stream output-lisp)) this)
(write sysdef :stream output-asd :case :downcase ))))) (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*? (export*?
;;; --- actual (exported) code goes here --- ;;; --- 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) (defun where (expr items)
(mapcan #'(lambda (x) (mapcan #'(lambda (x)
@ -121,9 +162,6 @@
(with-output-to-string (stream) (with-output-to-string (stream)
(apply #'format `(,stream ,fmt . ,r)))) (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 () (defun get-all-symbols ()
(let ((lst '())) (let ((lst '()))
@ -171,14 +209,14 @@
0 -2)))) 0 -2))))
(defun export-struct (struct &optional (symbols nil)) (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)) (defun -export*-struct (structs &optional (symbols nil))
(mapc #'export (symbol-match (mapc #'export (symbol-match
(strcat (strcat
"^(" "^("
(strjoin "|" (mapcar #'write-to-string structs)) (strjoin "|" (mapcar #'write-to-string structs))
")-") ")-?")
symbols))) symbols)))
(defmacro export*-struct (&rest structs) (defmacro export*-struct (&rest structs)

Loading…
Cancel
Save