Initial import.

.gitignore

@@ -0,0 +1,2 @@
+*~
+*.fasl

LICENSE

@@ -0,0 +1,19 @@
+Copyright (c) 2015 Kyle Isom <kyle@metacircular.net>
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.

README.txt

@@ -0,0 +1 @@
+This is the stub README.txt for the "kutils" project.

kutils.asd

@@ -0,0 +1,12 @@
+;;;; kutils.asd
+
+(asdf:defsystem #:kutils
+  :description "Kyle's utility package"
+  :author "K. Isom <kyle@metacircular.net>"
+  :license "MIT License"
+  :serial t
+  :components ((:file "package")
+	       (:file "on")
+	       (:file "lol")
+               (:file "kutils")))
+

kutils.lisp

@@ -0,0 +1,70 @@
+;;;; kutils.lisp
+
+(in-package #:kutils)
+
+;;; "kutil" goes here. Hacks and glory await!
+
+(defun join (x sep)
+  (flatten
+   (mapcar (lambda (y)
+	     (list y sep))
+	   x)))
+
+
+;;; hash-table functions.
+
+(defun |#{-reader| (stream sub-char numarg)
+  (declare (ignore sub-char numarg))
+  (let ((m     (make-hash-table :test 'equal))
+	(k     nil)
+	(v     nil)
+	(key-p t))
+    (labels ((finalise-read (x)
+	       (reverse (concatenate 'string x)))
+	     (finalise-kv-pair ()
+	       (if key-p
+		   (progn
+		     (setq key-p nil
+			   k     (read-from-string (finalise-read k))))
+		   (progn
+		     (setq key-p t
+			   v     (read-from-string (finalise-read v)))
+		     (setf (gethash k m) v)
+		     (setq k nil v nil)))))
+      (do ((prev (read-char stream) curr)
+	   (curr (read-char stream) (read-char stream)))
+	  ((and (char= prev #\}) (char= curr #\#)))
+	(if (char= prev #\Space)
+	    (finalise-kv-pair)
+	    (if key-p
+		(push prev k)
+		(push prev v))))
+      (if key-p
+	  (error "Mismatched key value pairs.")
+	  (progn 
+	    (finalise-kv-pair)
+	    m)))))
+
+(set-dispatch-macro-character
+ #\# #\{ #'|#{-reader|)
+
+(defun sethash (k v m)
+  "Convenience notation for setting a value in a hash table."
+  (setf (gethash k m) v))
+
+(defun hashkeys (m)
+  "Returns a list of the keys in the hash table."
+  (let ((keys '()))
+    (maphash (lambda (k v)
+	       (declare (ignore v))
+	       (push k keys))
+	     m)
+    keys))
+
+(defun hashtable-to-alist (m)
+  (let ((alist '()))
+    (maphash (lambda (k v)
+	       (let ((elt (cons k v)))
+		 (setf alist (cons elt alist))))
+	     m)
+    alist))

lol.lisp

@@ -0,0 +1,51 @@
+(in-package #:kutils)
+
+;;;; Utilities from Let Over Lambda. This source code is provided
+;;;; under the following license:
+
+
+(defun g!-symbol-p (s)
+  (and (symbolp s)
+       (> (length (symbol-name s)) 2)
+       (string= (symbol-name s)
+		"G!"
+		:start1 0
+		:end1   2)))
+
+(defmacro defmacro/g! (name args &rest body)
+  "defmacro/g! provides automatic gensyms for all arguments starting
+with g!."
+  (let ((syms (remove-duplicates
+	       (remove-if-not #'g!-symbol-p
+			      (flatten body)))))
+    `(defmacro ,name ,args
+       (let ,(mapcar
+	      (lambda (s)
+		`(,s (gensym ,(subseq
+			       (symbol-name s)
+			       2))))
+	      syms)
+	 ,@body))))
+
+(defun o!-symbol-p (s)
+  (and (symbolp s)
+       (> (length (symbol-name s)) 2)
+       (string= (symbol-name s)
+		"O!"
+		:start1 0
+		:end1   2)))
+
+(defun o!-symbol-to-g!-symbol (s)
+  (symb "G!" (subseq (symbol-name s) 2)))
+
+(defmacro defmacro! (name args &rest body)
+  "defmacro! provides automatic gensyms and once-only
+evaluation. Arguments that begin with g! will be automatically
+gensym'd, and arguments that begin with o! will only be evaluated
+once. Inside the body, the o! arguments should be called as their
+equivalent g! argument: o!x should be called in the body as g!x."
+  (let* ((os (remove-if-not #'o!-symbol-p args))
+         (gs (mapcar #'o!-symbol-to-g!-symbol os)))
+    `(defmacro/g! ,name ,args
+       `(let ,(mapcar #'list (list ,@gs) (list ,@os))
+          ,(progn ,@body)))))

on.lisp

@@ -0,0 +1,55 @@
+(in-package #:kutils)
+
+;;;; The utilities in this file come from the book On Lisp by Paul
+;;;; Graham.
+
+(defun mkstr (&rest args)
+  "Concatenates its symbols and returns the printable representation
+of the result."
+  (with-output-to-string (s)
+    (dolist (a args) (princ a s))))
+
+(defun symb (&rest args)
+  "Passes its arguments to mkstr to produce a printable
+representation, and returns the symbol built from this result; if the
+symbol does not exist, it will be created."
+  (values (intern (apply #'mkstr args))))
+
+(defun group (source n)
+  "Group takes a list as input and produces a list of sublists of
+length n."
+  (when (zerop n) (error "zero length"))
+  (labels ((rec (source acc)
+	     (let ((rest (nthcdr n source)))
+	       (if (consp rest)
+		   (rec rest (cons
+			      (subseq source 0 n)
+			      acc))
+		   (nreverse (cons source acc))))))
+    (if source (rec source nil) nil)))
+
+(defun flatten (x)
+  "Returns a list of all atoms present in the provided list. Of
+historical note, this was originally provided in Interlisp."
+  (labels ((rec (x acc)
+	     (cond ((null x) acc)
+		   ((atom x) (cons x acc))
+		   (t (rec (car x)
+			   (rec (cdr x) acc))))))
+    (rec x nil)))
+
+;;; compose may have been one of the first functions that really made
+;;; me pay attention to Lisp. I'm not sure why, particularly, but it
+;;; helped spur further Lisp explorations.n
+
+(defun compose (&rest fns)
+  "Compose allows a number of functions with the same arity to be
+composed together in a chain."
+      (if fns
+          (let ((fn1 (car (last fns)))
+                (fns (butlast fns)))
+            #'(lambda (&rest args)
+                (reduce #'funcall fns
+                        :from-end t
+                        :initial-value (apply fn1 args))))
+          #'identity))

package.lisp

@@ -0,0 +1,14 @@
+;;;; package.lisp
+
+(defpackage #:kutils
+  (:use #:cl)
+  (:export #:mkstr     ; On Lisp utilities
+	   #:symbb
+	   #:group
+	   #:flatten
+	   #:compose
+	   #:defmacro! ; Let Over Lambda utilities
+	   #:join      ; My utilities
+	   #:sethash
+	   ))
+