Hack fix export-struct, remove useless documentation

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

@ -55,7 +55,6 @@
;(export? val-if-or) ;(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."
(let ((this (cadddr (read-from-string (file-get-contents input)))) (let ((this (cadddr (read-from-string (file-get-contents input))))
(sysdef `(asdf:defsystem ,name (sysdef `(asdf:defsystem ,name
:description ,description :description ,description
@ -73,37 +72,36 @@
(mapc #'(lambda (stmt) (write stmt :stream output-lisp :pretty nil)) this) (mapc #'(lambda (stmt) (write stmt :stream output-lisp :pretty nil)) 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) ) ;;; TODO: Make this work /for structs/ at all ;(defun utils->create-for (utils for &key (name 'flan-utils) ) ;;; TODO: Make this work /for structs/ at all
"Export `utils' functions used in file into own file" ; (let ((this (cadddr (read-from-string (file-get-contents utils))))
(let ((this (cadddr (read-from-string (file-get-contents utils)))) ; (for (read-from-string (file-get-contents for))))
(for (read-from-string (file-get-contents for)))) ; (labels ((sieve (li) ;; find all `,name:' functions in list
(labels ((sieve (li) ;; find all `,name:' functions in list ; (mapcan #'(lambda (part)
(mapcan #'(lambda (part) ; (if (atom part)
(if (atom part) ; (if (cl-ppcre:scan (concatenate 'string "^" (write-to-string name) ":")
(if (cl-ppcre:scan (concatenate 'string "^" (write-to-string name) ":") ; (write-to-string part))
(write-to-string part)) ; (list part)
(list part) ; nil)
nil) ; (sieve part)))
(sieve part))) ; li)))
li))) ; (let ((syms (sieve for))
(let ((syms (sieve for)) ; (allowed-definitions '(defun
(allowed-definitions '(defun ; defmacro
defmacro ; defparameter))) ;;;; STRUCT
defparameter))) ;;;; STRUCT ; (labels ((find-func (sym-name l) ;;; TODO: here
(labels ((find-func (sym-name l) ;;; TODO: here ; (mapcan #'(lambda (part)
(mapcan #'(lambda (part) ; (when (not (atom part))
(when (not (atom part)) ; (if (eql (cadr part) sym-name) ;; symbol found
(if (eql (cadr part) sym-name) ;; symbol found ; (list part)
(list part) ; (when (eql (car part) 'export*?) ;; export*?
(when (eql (car part) 'export*?) ;; export*? ; (find-func sym-name part)))))
(find-func sym-name part))))) ; l)))
l))) ; (let ((defs (mapcan #'(lambda (sym)
(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))
(find-func (read-from-string (cadr (cl-ppcre:split (concatenate 'string "^" (write-to-string name) ":") (write-to-string sym)))) this)) ; syms)))
syms))) ; (mapcan #'(lambda (def)
(mapcan #'(lambda (def) ; (when (member (car def) allowed-definitions)))
(when (member (car def) allowed-definitions))) ; defs)))))))
defs)))))))
(export*? (export*?
;;; --- actual (exported) code goes here -- ;;; --- actual (exported) code goes here --
@ -215,13 +213,13 @@
strs) strs)
0 -2)))) 0 -2))))
(defun export-struct (struct &optional (symbols nil)) ;;XXX: Export make-* (defun export-struct (struct &optional (symbols nil)) ;;XXX: Exporting make-* is a hack and you should fix it
(mapc #'export (symbol-match (strcat "^" (write-to-string struct) "-?") symbols))) (mapc #'export (symbol-match (strcat "^(MAKE-)?" (write-to-string struct) "-?") symbols)))
(defun -export*-struct (structs &optional (symbols nil)) ;;XXX: Export make-* (defun -export*-struct (structs &optional (symbols nil)) ;;XXX: Exporting make-* is a hack and you should fix it
(mapc #'export (symbol-match (mapc #'export (symbol-match
(strcat (strcat
"^(" "^(MAKE-)?("
(strjoin "|" (mapcar #'write-to-string structs)) (strjoin "|" (mapcar #'write-to-string structs))
")-?") ")-?")
symbols))) symbols)))

Loading…
Cancel
Save