Initial commit

.gitignore

@@ -0,0 +1 @@
+utils/

.utils.lisp

@@ -0,0 +1,109 @@
+(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))
+
+;;; -- 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) 
+  `(mapc #'export (list ,@syms)))
+
+(export? export*)
+(export? export*!)
+
+(defmacro export*? (&rest val)
+  `(insystem? (export*! ,@val) (progn ,@val)))
+
+(defun file-get-contents (filename)
+  (with-open-file (stream filename)
+    (let ((contents (make-string (file-length stream))))
+      (read-sequence contents stream)
+      contents)))
+(export? file-get-contents)
+
+(defun utils->system (input output &key (name :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
+				 :author ,author
+				 :license ,license
+				 :version "0.0.2" 
+				 :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)) this)
+	(write sysdef :stream output-asd)))))
+
+(export*?
+
+;;; --- actual (exported) code goes here ---
+
+(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))
+	 collect (pop ,li)))
+
+(defmacro popn (li n)
+  "pop() list <li> <n> times, return elements pop()ed in a new list."
+  (if (numberp n)
+    (list 'let '((tmp 'nil))
+	  (apply #'list 'progn
+		 (loop for x from 1 to n
+		       collect `(setf tmp (cons (pop ,li) tmp))))
+	  '(reverse tmp))
+    `(loop for x from 1 to ,n collect (pop ,li))))
+
+(defun make-paged-vector (blocksize &key (element-type 'integer))
+  "Vector that increases size in blocks"
+  (list (make-array blocksize :element-type element-type :fill-pointer 0 :adjustable t) blocksize 0 1))
+
+(defun paged-vector<-size (vec) (caddr vec))
+(defun paged-vector<-blocksize (vec) (cadr vec))
+(defun paged-vector<-blocks (vec) (cadddr vec))
+
+(defmacro paged-vector->push (vec elem)
+  "add <elem> to end, extending if needed"
+  `(if (>= (1+ (mod (paged-vector<-size ,vec) (paged-vector<-blocksize ,vec))) (paged-vector<-blocksize ,vec))
+     (progn 
+       (adjust-array (car ,vec)
+		  (* (1+ (paged-vector<-blocks ,vec))
+		     (paged-vector<-blocksize ,vec)))
+       (incf (cadddr ,vec))
+       (incf (caddr ,vec))
+       (vector-push ,elem (car ,vec))
+       ,vec)
+     (progn (incf (caddr ,vec)) (vector-push ,elem (car ,vec)) ,vec)))
+
+(defun make-paged-vector-s (elements blocksize)
+  "make-paged-vector with default elements"
+  (let ((out (make-paged-vector blocksize)))
+    (mapc #'(lambda (x) (paged-vector->push out x)) elements) out))
+
+(defmacro paged-vector<- (vec) `(car ,vec))
+
+) ;; -- end export
+
+(mapc #'fmakunbound '(insystem? export? export*?))
+
+)) ;; -- end guard

make-asdf-system

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

utils.lisp

@@ -0,0 +1,113 @@
+;;;; 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))
+
+(defparameter *-utils-version* "0.0.2")
+
+;;; -- 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) 
+  `(mapc #'export (list ,@syms)))
+
+(export? export*)
+(export? export*!)
+
+(defmacro export*? (&rest val)
+  `(insystem? (export*! ,@val) (progn ,@val)))
+
+(defun file-get-contents (filename)
+  (with-open-file (stream filename)
+    (let ((contents (make-string (file-length stream))))
+      (read-sequence contents stream)
+      contents)))
+(export? file-get-contents)
+
+(defun utils->system (input output &key (name :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
+				 :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)) this)
+	(write sysdef :stream output-asd :case :downcase )))))
+
+(export*?
+
+;;; --- actual (exported) code goes here ---
+
+(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))
+	 collect (pop ,li)))
+
+(defmacro popn (li n)
+  "pop() list <li> <n> times, return elements pop()ed in a new list."
+  (if (numberp n)
+    (list 'let '((tmp 'nil))
+	  (apply #'list 'progn
+		 (loop for x from 1 to n
+		       collect `(setf tmp (cons (pop ,li) tmp))))
+	  '(reverse tmp))
+    `(loop for x from 1 to ,n collect (pop ,li))))
+
+(defun make-paged-vector (blocksize &key (element-type 'integer))
+  "Vector that increases size in blocks"
+  (list (make-array blocksize :element-type element-type :fill-pointer 0 :adjustable t) blocksize 0 1))
+
+(defun paged-vector<-size (vec) (caddr vec))
+(defun paged-vector<-blocksize (vec) (cadr vec))
+(defun paged-vector<-blocks (vec) (cadddr vec))
+
+(defmacro paged-vector->push (vec elem)
+  "add <elem> to end, extending if needed"
+  `(if (>= (1+ (mod (paged-vector<-size ,vec) (paged-vector<-blocksize ,vec))) (paged-vector<-blocksize ,vec))
+     (progn 
+       (adjust-array (car ,vec)
+		  (* (1+ (paged-vector<-blocks ,vec))
+		     (paged-vector<-blocksize ,vec)))
+       (incf (cadddr ,vec))
+       (incf (caddr ,vec))
+       (vector-push ,elem (car ,vec))
+       ,vec)
+     (progn (incf (caddr ,vec)) (vector-push ,elem (car ,vec)) ,vec)))
+
+(defun make-paged-vector-s (elements blocksize)
+  "make-paged-vector with default elements"
+  (let ((out (make-paged-vector blocksize)))
+    (mapc #'(lambda (x) (paged-vector->push out x)) elements) out))
+
+(defmacro paged-vector<- (vec) `(car ,vec))
+
+) ;; -- end export
+
+(mapc #'fmakunbound '(insystem? export? export*?))
+
+)) ;; -- end guard