From a38640a581cdca68b4b319649e04c66d856abcb3 Mon Sep 17 00:00:00 2001 From: Ringo Wantanabe Date: Sun, 17 Feb 2019 15:41:17 +0000 Subject: [PATCH] Remade exporting structure --- .gitignore | 2 +- Makefile | 3 - flan-utils.asd | 15 +++ utils.lisp => flan-utils.lisp | 177 ++++++++++++---------------------- make-asdf-system | 4 - 5 files changed, 80 insertions(+), 121 deletions(-) delete mode 100644 Makefile create mode 100644 flan-utils.asd rename utils.lisp => flan-utils.lisp (77%) delete mode 100755 make-asdf-system diff --git a/.gitignore b/.gitignore index ff4c290..9487075 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1 @@ -utils/ +utils diff --git a/Makefile b/Makefile deleted file mode 100644 index e22d132..0000000 --- a/Makefile +++ /dev/null @@ -1,3 +0,0 @@ - -flan-utils: - ./make-asdf-system diff --git a/flan-utils.asd b/flan-utils.asd new file mode 100644 index 0000000..320071f --- /dev/null +++ b/flan-utils.asd @@ -0,0 +1,15 @@ +(asdf/parse-defsystem:defsystem :flan-utils + :description + "Some random utilities" + :author + "Rin " + :license + "None" + :version + "0.2.0" + :serial + t + :depends-on + (#:cl-ppcre #:bordeaux-threads) + :components + ((:file "flan-utils"))) diff --git a/utils.lisp b/flan-utils.lisp similarity index 77% rename from utils.lisp rename to flan-utils.lisp index e3a9a74..b677a8f 100644 --- a/utils.lisp +++ b/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 - -;;; --- 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))) +(defpackage :flan-utils (:use :cl)) +(in-package :flan-utils) (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? val-if-or) - -(defun utils->system (input output &key (name :flan-utils) (description "Some random utilities") (author "Ringo ") (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))))))) +(export 'file-get-contents) (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) - (if nil - (if (>= i max) (1- max) - (if (< i 0) 0 - i)) - i)) +;(defun restrain-index (i max) +; +; (if nil +; (if (>= i max) (1- max) +; (if (< i 0) 0 +; 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
  • until (car li) is equal to , 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 diff --git a/make-asdf-system b/make-asdf-system deleted file mode 100755 index faefb2a..0000000 --- a/make-asdf-system +++ /dev/null @@ -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