|
|
@ -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)))
|
|
|
|