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)
(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))))
(sysdef `(asdf:defsystem ,name
:description ,description
@ -73,37 +72,36 @@
(mapc #'(lambda (stmt) (write stmt :stream output-lisp :pretty nil)) this)
(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
"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)))))))
;(defun utils->create-for (utils for &key (name 'flan-utils) ) ;;; TODO: Make this work /for structs/ at all
; (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 --
@ -215,13 +213,13 @@
strs)
0 -2))))
(defun export-struct (struct &optional (symbols nil)) ;;XXX: Export make-*
(mapc #'export (symbol-match (strcat "^" (write-to-string struct) "-?") symbols)))
(defun export-struct (struct &optional (symbols nil)) ;;XXX: Exporting make-* is a hack and you should fix it
(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
(strcat
"^("
"^(MAKE-)?("
(strjoin "|" (mapcar #'write-to-string structs))
")-?")
symbols)))

Loading…
Cancel
Save