diff --git a/utils.lisp b/utils.lisp index aad2f17..48b6de8 100644 --- a/utils.lisp +++ b/utils.lisp @@ -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 ") (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)