Remade exporting structure

.gitignore

@@ -1 +1 @@
-utils/
+utils

Makefile

@@ -1,3 +0,0 @@
-
-flan-utils:
-	./make-asdf-system

flan-utils.asd

@@ -0,0 +1,15 @@
+(asdf/parse-defsystem:defsystem :flan-utils
+  :description
+  "Some random utilities"
+  :author
+  "Rin <flanchan@cumallover.me>"
+  :license
+  "None"
+  :version
+  "0.2.0"
+  :serial
+  t
+  :depends-on
+  (#:cl-ppcre #:bordeaux-threads)
+  :components
+  ((:file "flan-utils")))

flan-utils.lisp

@@ -1,115 +1,46 @@
 ;;;; utils.lisp -- some random utils I collect. might be useful, probably won't be.
 
-(if (boundp '*-utils-lisp*) "Already loaded" (progn
+(defpackage :flan-utils (:use :cl))
-
+(in-package :flan-utils)
-;;; --- internally maintained config, don't put anything above these!!
-
-(defparameter *-utils-lisp* t)
-(defparameter *-utils-depends* '(#:cl-ppcre #:bt-semaphore))
-
-(defparameter *-utils-version* "0.1.6")
-
-;;; -- Handle internal exporting --
-
-(defmacro insystem? (thing &optional (else nil))
-  `(if (boundp '*-utils-system*)
-     ,thing
-     ,else))
-
-(defmacro export? (val)
-  `(if (boundp '*-utils-system*)
-     (export ',val)
-     nil))
-
-;(defmacro export* (&rest syms) 
-;  `(mapc #'export '(,@syms)))
 
 (defmacro export* (&rest syms)
+  "Export all symbols"
   (cons 'progn (mapcan #'(lambda (x) `((export ',x))) syms)))
 
 (defmacro eval-all (syms)
+  "Eval all statements, return in list."
   `(mapcar #'eval '(,@syms)))
-(export? eval-all)
+(export 'eval-all)
 
 (defmacro export*! (&rest syms) 
+  "Eval all statements export return values"
   `(mapc #'export (eval-all ,syms)))
 
-(export? export*)
+(export 'export*)
-(export? export*!)
+(export 'export*!)
 
-(defmacro export*? (&rest val)
-  `(insystem? (export*! ,@val) 
-	      (mapc #'eval '(,@val))))
 
 (defmacro defexport (&rest val)
+  "Same as export*! for some reason"
   `(export*! ,@val))
-(export? defexport)
+(export 'defexport)
 
 (defun file-get-contents (filename)
+  "Read file into string"
   (with-open-file (stream filename)
     (let ((contents (make-string (file-length stream))))
       (read-sequence contents stream)
       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"))
-  (let ((this (cadddr (read-from-string (file-get-contents input))))
-	(sysdef `(asdf:defsystem ,name
-				 :description ,description
-				 :author ,author
-				 :license ,license
-				 :version ,*-utils-version*
-				 :serial t
-				 :depends-on ,*-utils-depends*
-				 :components ((:file ,(car (last (cl-ppcre:split "/" output))))))))
-    (rplaca this `(defpackage ,name (:use #:cl)))
-    (rplaca (cdr this) `(in-package ,name))
-    (rplaca (cddr this) '(defparameter *-utils-system* t))
-    (with-open-file (output-lisp (concatenate 'string output ".lisp") :direction :output :if-exists :supersede)
-      (with-open-file (output-asd (concatenate 'string output ".asd") :direction :output :if-exists :supersede)
-	(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
-;  (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)))))))
 
 (defparameter *old-readtables* nil)
 
-(export*?
+(defexport
 
 ;;; --- actual (exported) code goes here --
 
 (defmacro val-if-or (val test or)
+  "(if (test val) val or)"
   `(let ((vv ,val))
      (if (funcall ,test vv) vv ,or)))
 
@@ -122,9 +53,11 @@
   (not (null f)))
 
 (defun nop ()
+  "Do nothing"
   nil)
 
 (defun yep ()
+  "Do nothing"
   t)
 
 (defun mapline (input fi &key (read-line #'read-line))
@@ -133,6 +66,7 @@
 	while line do (funcall fi line)))
 
 (defun strcat (&rest str)
+  "Concat all strings, if item is not string it is written to one."
   (apply #'concatenate (cons 'string (mapcar #'(lambda (x) 
 						 (typecase x
 						   (string x)
@@ -141,21 +75,19 @@
 					     str))))
 
 (defmacro until (stmt)
+  "Repeat stmt until its return is not NIL, then return that value."
   `(let ((ret nil))
      (loop while (null (setf ret ,stmt)))
      ret))
 
-(defmacro until-trace (stmt)
-  `(let ((ret nil))
-     (loop while (null (setf ret ,stmt))
-	   collect ret)))
-
 (defmacro popor (li or)
+  "If li is list, pop it, else return or"
   `(if (atom ,li) ,or
      (pop ,li)))
 
 (defun rand-in (l &key (random #'random) )
   "Random member of, slide right if nil"
+  "Pretty sure this doesn't work"
   (let ((rng (funcall random (list-length l))))
     (let ((nl (nthcdr rng l)))
       (until (pop nl)))))
@@ -172,6 +104,7 @@
        (<= num s)))
 
 (defun format-string (fmt &rest r)
+  "Like sprintf I guess"
   (with-output-to-string (stream)
     (apply #'format `(,stream ,fmt . ,r))))
 
@@ -183,29 +116,33 @@
     lst))
 
 (defun symbol-match (scan &optional (symbols nil))
+  "Return all symbols whose names match regex `scan'. If symbols are not provided, get them all."
   (let ((symbols (val-if-or symbols #'true 
 			    (get-all-symbols))))
     (where #'(lambda (x) (cl-ppcre:scan scan (write-to-string x)))
 	   symbols)))
 
 (defun index (i max)
+  "Looping index"
   (if (< i 0)
     (index (+ max i) max)
     (mod i max)))
 
 (defun slice (seq start end)
-  "only works with lists i guess"
+  "Like JS slice()?"
   (let ((start (index start (length seq)))
 	(end   (index end (length seq))))
     (rplacd (nthcdr end seq) nil)
     (nthcdr start seq)))
 
 (defun flatten-top-level (li)
+  "'( (1 2) 3 4 (5 6 7) (8) ((9 10))) -> ( 1 2 3 4 5 6 7 8 (9 10))"
   (mapcan #'(lambda (x)
 	      (if (atom x) (list x) x))
 	  li))
 
 (defun flatten (li)
+  "'( (1 2) 3 4 (5 6 7) (8) ((9 10))) -> ( 1 2 3 4 5 6 7 8 9 10)"
   (mapcan #'(lambda (x)
 	      (if (atom x) 
 		(list x)
@@ -213,6 +150,7 @@
 	  li))
 
 (defun strjoin (delim &rest strs)
+  "Join strings with deliminator"
   (let ((strs (flatten-top-level strs)))
   (apply #'strcat
 	 (slice 
@@ -221,10 +159,11 @@
 		   strs)
 	   0 -2))))
 
-(defun export-struct (struct &optional (symbols nil)) ;;XXX: Exporting make-* is a hack and you should fix it
+(defun export-struct (struct &optional (symbols nil)) ;;XXX: Exporting make-* does not check for $
+  "Export all symbols relating to `struct'"
   (mapc #'export (symbol-match (strcat "^(MAKE-)?" (write-to-string struct) "-?") symbols)))
 
-(defun -export*-struct (structs &optional (symbols nil)) ;;XXX: Exporting make-* is a hack and you should fix it
+(defun -export*-struct (structs &optional (symbols nil)) ;;XXX
   (mapc #'export (symbol-match 
 		   (strcat
 		     "^(MAKE-)?("
@@ -233,6 +172,7 @@
 		   symbols)))
 
 (defmacro export*-struct (&rest structs)
+  "Export all symbols relating to multiple structs"
   `(-export*-struct '(,@structs)))
 
 
@@ -245,6 +185,7 @@
     ret))
 
 (defun cyclic (list)
+  "Simple circular list"
   (cdr (rplacd (last list) list)))
 
 (defun map1 (lam &rest lists)
@@ -279,7 +220,9 @@
 	 (mapcar lam (flatten-top-level args))))
 
 (defmacro lexical-boundp (lex)
+  "XXX: Use (declare (special ...)) instead"
   `(when (ignore-errors ,lex) t))
+
 ;; --- progressive evals
 
 (defmacro progen (&rest things)
@@ -307,6 +250,7 @@
      (apply #'values --yield-var)))
 
 (defmacro yield (value)
+  "Yield return value `value' if in yield-return(...) block."
   `(when (boundp '--yield-vars)
       (setf --yield-var (multiple-value-list ,value))
       (push (car --yield-var) --yield-vars)))
@@ -328,35 +272,43 @@
 ;; ---
 
 (defmacro push-unique (thing things &key (key nil) (test #'eql))
+  "Push if not member"
   `(let ((lex-thing ,thing))
      (if (member lex-thing ,things :key ,key :test ,test)
        (values ,things nil)
        (values (push lex-thing ,things) t))))
 
 (defmacro import* (&rest args)
+  "Import all symbols"
   (cons 'progn (mapcan #'(lambda (x) `((import ',x))) args)))
 
 (defmacro shadowing-import* (&rest args)
+  "Import all symbols (shadowing)"
   (cons 'progn (mapcan #'(lambda (x) `((shadowing-import ',x))) args)))
 
 (defmacro import*! (&rest args)
+  "Map eval then import all returns"
   `(mapc #'import (progel ,args)))
 
 (defmacro shadowing-import*! (&rest args)
+  "Map eval then import all returns (shadowing)"
   `(mapc #'shadowing-import (progel ,args)))
 
 (defmacro import*-from (package &rest args)
+  "Import all symbols from package. NOTE: You shouldn't prefix the symbols with the package name"
   (let ((ret (mapcar #'(lambda (x) (read-from-string (strcat (subseq (write-to-string package) 1) ":" (write-to-string x)))) args)))
     `(shadowing-import* @,ret)))
 
-(defun restrain-index (i max)
+;(defun restrain-index (i max)
-  (if nil
+;  
-  (if (>= i max) (1- max)
+;  (if nil
-    (if (< i 0) 0
+;  (if (>= i max) (1- max)
-      i))
+;    (if (< i 0) 0
-  i))
+;      i))
+;  i))
 
 (defun many-equals (items &key (test #'eql))
+  "For some reason equality comparers don't like more than 2 args"
   (let ((comp (car items)))
     (labels ((compare (x to)
 	       (when (null x) t)
@@ -367,18 +319,23 @@
 (defun many-eql (&rest items)
   (many-equals items :test #'eql))
 
+; --- async stuff
+
 (defstruct async-info 
   thread
   handlers
   lock)
 
 (defmacro push-handler (name lam)
+  "Push new handler to current async-info with name"
+  "NOTE: Should only be used inside an async() body."
   `(bt:with-lock-held
      ((async-info-lock current-async-info))
      (push (cons ,name ,lam)
 	   (async-info-handlers current-async-info))))
 
 (defmacro async (&rest form)
+  "Run form(s) async"
   `(let ((current-async-info (make-async-info)))
      (setf (async-info-handlers current-async-info) nil)
      (setf (async-info-lock current-async-info) (bt:make-lock))
@@ -389,22 +346,26 @@
      current-async-info))
 
 (defun async-info-handler (async name &key (test 'eql))
+  "Get handler from async-info of name"
   (bt:with-lock-held ((async-info-lock async))
 		     (let ((as (assoc name (async-info-handlers async) :test test )))
 		       (and as
 			    (cdr as)))))
 
 (defun wait (handle)
+  "Wait on async()"
   (if (async-info-p handle)
     (wait (async-info-thread handle))
     (bt:join-thread handle)))
 
 (defun async-kill (handle)
+  "Kill async()"
   (if (async-info-p handle)
     (async-kill (async-info-thread handle))
     (bt:destroy-thread handle)))
 
 (defun async-alive (handle)
+  "Is async() alive"
   (if (async-info-p handle)
     (async-alive (async-info-thread handle))
     (bt:thread-alive-p handle)))
@@ -412,6 +373,7 @@
 (defun val (v) v)
 
 (defun groupn (n list)
+  "Group list into sublists every `n' items."
   (let ((last nil)
 	(ret nil))
     (loop for x in list
@@ -424,6 +386,8 @@
 		 (setf last nil))))
     (reverse ret)))
 
+; --- reader macros
+
 (defun sexpr-reader (stream char &key (func 'val))
   "Read next token only if S expression, else return as is"
   (if (char= (peek-char t stream t nil t) #\()
@@ -435,20 +399,7 @@
 (defun bang-reader (stream char)
   (declare (ignore char))
   (list (quote not) (read stream t nil t)))
-;
+
-;(defmacro enable-reader (char func &optional (keep t))
-;  `(eval-when (:compile-toplevel :load-toplevel :execute)
-;     (when keep
-;       (push *readtable* *old-readtables*)
-;       (setq *readtable* (copy-readtable)))
-;    (set-macro-character ,char ,func)))
-;
-;(defun disable-reader (&optional (char nil))
-;  (if (null char)
-;    '(eval-when (:compile-toplevel :load-toplevel :execute)
-;       (setq *readtable* (pop *old-readtables*)))
-;    `(set-macro-character ,char nil)))
-;
 (defun read-delimiter (stream char)
   (declare (ignore stream char)))
 
@@ -539,6 +490,8 @@
 ;    (make-list length :initial-element 1)
 ;    :debug t))
 
+; --- others
+
 (defmacro popto (li val &key (test #'eql))
   "pop() list <li> until (car li) is equal to <val>, return elements pop()ed in new list"
   `(loop while (not (funcall ,test (car ,li) ,val))
@@ -584,6 +537,4 @@
 
 ) ;; -- end export
 
-(mapc #'fmakunbound '(insystem? export? export*?))
 
-)) ;; -- end guard

make-asdf-system

@@ -1,4 +0,0 @@
-#!/bin/bash
-
-sbcl --eval "(progn (asdf:load-system :cl-ppcre) (asdf:load-system :bt-semaphore)  (load \"utils.lisp\") (print (utils->system \"utils.lisp\" \"utils/flan-utils\")) (quit))"
-echo