--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Makefile Sun Nov 20 17:35:34 2016 +0000
@@ -0,0 +1,8 @@
+.PHONY: vendor
+
+
+# Vendor ----------------------------------------------------------------------
+vendor/quickutils.lisp: vendor/make-quickutils.lisp
+ cd vendor && sbcl --noinform --load make-quickutils.lisp --eval '(quit)'
+
+vendor: vendor/quickutils.lisp
--- a/nrepl.asd Sun Nov 20 17:20:42 2016 +0000
+++ b/nrepl.asd Sun Nov 20 17:35:34 2016 +0000
@@ -21,19 +21,21 @@
)
:serial t
- :components
- ((:file "package")
- (:module "src" :serial t
- :components ((:file "utils")
- (:file "sockets")
- (:file "evaluation")
- (:module "middleware" :serial t
- :components ((:file "core")
- (:file "describe")
- (:file "documentation")
- (:file "macroexpand")
- (:file "eval")
- (:file "load-file")
- (:file "session")))
- (:file "server")))))
+ :components ((:module "vendor" :serial t
+ :components ((:file "quickutils-package")
+ (:file "quickutils")))
+ (:file "package")
+ (:module "src" :serial t
+ :components ((:file "utils")
+ (:file "sockets")
+ (:file "evaluation")
+ (:module "middleware" :serial t
+ :components ((:file "core")
+ (:file "describe")
+ (:file "documentation")
+ (:file "macroexpand")
+ (:file "eval")
+ (:file "load-file")
+ (:file "session")))
+ (:file "server")))))
--- a/package.lisp Sun Nov 20 17:20:42 2016 +0000
+++ b/package.lisp Sun Nov 20 17:35:34 2016 +0000
@@ -1,7 +1,8 @@
(defpackage :nrepl
(:use
:cl
- :split-sequence)
+ :split-sequence
+ :nrepl.quickutils)
(:export
:start-server
:stop-server))
--- a/src/middleware/core.lisp Sun Nov 20 17:20:42 2016 +0000
+++ b/src/middleware/core.lisp Sun Nov 20 17:35:34 2016 +0000
@@ -14,7 +14,7 @@
As the body is executing `message-binding` will be bound to the message map.
"
- (let ((fallback (gensym)))
+ (with-gensyms (fallback)
`(defun ,name (,fallback)
(lambda (,message-binding)
(handle-op ,message-binding ,op ,fallback
--- a/src/middleware/documentation.lisp Sun Nov 20 17:20:42 2016 +0000
+++ b/src/middleware/documentation.lisp Sun Nov 20 17:35:34 2016 +0000
@@ -22,7 +22,7 @@
(defun parse-symbol-designator-package (string in-package)
- (let ((parts (split-sequence-if (partial #'char= #\:)
+ (let ((parts (split-sequence-if (curry #'char= #\:)
(string-upcase string))))
(case (length parts)
(0 nil)
@@ -41,7 +41,7 @@
(t nil))))
(defun parse-symbol-designator-name (string)
- (let ((parts (split-sequence-if (partial #'char= #\:)
+ (let ((parts (split-sequence-if (curry #'char= #\:)
(string-upcase string))))
(case (length parts)
(0 nil)
@@ -87,7 +87,7 @@
"setf-docstring" (documentation symbol 'setf)
"function-docstring" (documentation symbol 'function)
"function-arglist"
- (when-found arglist (find-lambda-list symbol)
+ (when-found (arglist (find-lambda-list symbol))
(princ-to-string (cons symbol arglist)))))))
(define-middleware wrap-arglist "arglist" message
@@ -97,5 +97,5 @@
(with-when
(make-map "status" '("done"))
"function-arglist"
- (when-found arglist (find-lambda-list symbol)
+ (when-found (arglist (find-lambda-list symbol))
(lambda-list-to-string (cons symbol arglist)))))))
--- a/src/middleware/session.lisp Sun Nov 20 17:20:42 2016 +0000
+++ b/src/middleware/session.lisp Sun Nov 20 17:35:34 2016 +0000
@@ -20,7 +20,7 @@
(gethash id *sessions*))
(defun get-sessions ()
- (hash-keys *sessions*))
+ (hash-table-keys *sessions*))
(defun wrap-session (handler)
--- a/src/server.lisp Sun Nov 20 17:20:42 2016 +0000
+++ b/src/server.lisp Sun Nov 20 17:35:34 2016 +0000
@@ -52,7 +52,7 @@
(defun handle-message (socket-stream lock)
"Read and handle a single message from `socket-stream`."
(let ((message (fset:with (read-object socket-stream)
- "transport" (partial #'write-object socket-stream lock))))
+ "transport" (curry #'write-object socket-stream lock))))
(handle message)))
(defun handler (socket-stream lock)
--- a/src/utils.lisp Sun Nov 20 17:20:42 2016 +0000
+++ b/src/utils.lisp Sun Nov 20 17:35:34 2016 +0000
@@ -3,14 +3,9 @@
(defvar *log* *error-output*)
-(defun pairs (sequence)
- "Return a list of cons pairs of the items of the riffle `sequence`."
- (loop :for (a b) :on sequence :by #'cddr
- :collect (cons a b)))
-
(defun make-map (&rest keyvals)
"Create an fset map of the given riffle of keys and values."
- (fset:convert 'fset:map (pairs keyvals)))
+ (fset:convert 'fset:map (subdivide keyvals 2)))
(defun with-when (map &rest keyvals)
"Add the items in the `keyvals` riffle with non-nil values to `map`."
@@ -33,19 +28,10 @@
(read-next-from-string (subseq s pos) (cons i results))))))
(nreverse (read-next-from-string s ()))))
-(defun partial (fn &rest args)
- (lambda (&rest remaining-args)
- (apply fn (append args remaining-args))))
-
(defun random-uuid ()
"Return a random UUID as a string."
(format nil "~a" (uuid:make-v4-uuid)))
-(defun hash-keys (h)
- (loop :for key :being :the :hash-keys :of h
- :collect key))
-
-
(defun log-message (&rest args)
(apply #'format *log* args)
(force-output *log*))
@@ -69,8 +55,8 @@
(or (find-package (read-from-string in-package)) *package*)))
-(defmacro when-found (var lookup-expr &body body)
- "Perform `body` with `var` to the results of `lookup-expr`, when valid.
+(defmacro when-found ((var lookup-expr) &body body)
+ "Perform `body` with `var` bound to the results of `lookup-expr`, when valid.
`lookup-expr` should be an expression that returns two values, the first being
the result (which will be bound to `var`) and the second indicating whether
@@ -82,11 +68,11 @@
(when found
body))
- (when-found val (gethash :foo hash)
- body)
+ (when-found (val (gethash :foo hash))
+ body)
"
- (let ((found (gensym "found")))
+ (with-gensyms (found)
`(multiple-value-bind (,var ,found) ,lookup-expr
- (when ,found
- ,@body))))
+ (when ,found
+ ,@body))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/vendor/make-quickutils.lisp Sun Nov 20 17:35:34 2016 +0000
@@ -0,0 +1,14 @@
+(ql:quickload 'quickutil)
+
+(qtlc:save-utils-as
+ "quickutils.lisp"
+ :utilities '(
+
+ :curry
+ :hash-table-keys
+ :rcurry
+ :subdivide
+ :with-gensyms
+
+ )
+ :package "NREPL.QUICKUTILS")
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/vendor/quickutils-package.lisp Sun Nov 20 17:35:34 2016 +0000
@@ -0,0 +1,12 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (unless (find-package "NREPL.QUICKUTILS")
+ (defpackage "NREPL.QUICKUTILS"
+ (:documentation "Package that contains Quickutil utility functions.")
+ (:use :cl))))
+
+(in-package "NREPL.QUICKUTILS")
+
+;; need to define this here so sbcl will shut the hell up about it being
+;; undefined when compiling quickutils.lisp. computers are trash.
+(defparameter *utilities* nil)
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/vendor/quickutils.lisp Sun Nov 20 17:35:34 2016 +0000
@@ -0,0 +1,298 @@
+;;;; This file was automatically generated by Quickutil.
+;;;; See http://quickutil.org for details.
+
+;;;; To regenerate:
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :SUBDIVIDE :APPENDF :COMPOSE :DOHASH :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :HASH-TABLE-KEYS :MAPHASH-KEYS :MKSTR :ONCE-ONLY :RCURRY :REMOVEF :SYMB :WITH-GENSYMS) :ensure-package T :package "NREPL.QUICKUTILS")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (unless (find-package "NREPL.QUICKUTILS")
+ (defpackage "NREPL.QUICKUTILS"
+ (:documentation "Package that contains Quickutil utility functions.")
+ (:use #:cl))))
+
+(in-package "NREPL.QUICKUTILS")
+
+(when (boundp '*utilities*)
+ (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
+ :CURRY :SUBDIVIDE :APPENDF :COMPOSE
+ :DOHASH :ENSURE-BOOLEAN
+ :ENSURE-GETHASH :ENSURE-LIST
+ :MAPHASH-KEYS :HASH-TABLE-KEYS :MKSTR
+ :ONCE-ONLY :RCURRY :REMOVEF :SYMB
+ :STRING-DESIGNATOR :WITH-GENSYMS))))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun make-gensym-list (length &optional (x "G"))
+ "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
+using the second (optional, defaulting to `\"G\"`) argument."
+ (let ((g (if (typep x '(integer 0)) x (string x))))
+ (loop repeat length
+ collect (gensym g))))
+ ) ; eval-when
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ ;;; To propagate return type and allow the compiler to eliminate the IF when
+ ;;; it is known if the argument is function or not.
+ (declaim (inline ensure-function))
+
+ (declaim (ftype (function (t) (values function &optional))
+ ensure-function))
+ (defun ensure-function (function-designator)
+ "Returns the function designated by `function-designator`:
+if `function-designator` is a function, it is returned, otherwise
+it must be a function name and its `fdefinition` is returned."
+ (if (functionp function-designator)
+ function-designator
+ (fdefinition function-designator)))
+ ) ; eval-when
+
+ (defun curry (function &rest arguments)
+ "Returns a function that applies `arguments` and the arguments
+it is called with to `function`."
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (let ((fn (ensure-function function)))
+ (lambda (&rest more)
+ (declare (dynamic-extent more))
+ ;; Using M-V-C we don't need to append the arguments.
+ (multiple-value-call fn (values-list arguments) (values-list more)))))
+
+ (define-compiler-macro curry (function &rest arguments)
+ (let ((curries (make-gensym-list (length arguments) "CURRY"))
+ (fun (gensym "FUN")))
+ `(let ((,fun (ensure-function ,function))
+ ,@(mapcar #'list curries arguments))
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (lambda (&rest more)
+ (apply ,fun ,@curries more)))))
+
+
+ (defun subdivide (sequence chunk-size)
+ "Split `sequence` into subsequences of size `chunk-size`."
+ (check-type sequence sequence)
+ (check-type chunk-size (integer 1))
+
+ (etypecase sequence
+ ;; Since lists have O(N) access time, we iterate through manually,
+ ;; collecting each chunk as we pass through it. Using SUBSEQ would
+ ;; be O(N^2).
+ (list (loop :while sequence
+ :collect
+ (loop :repeat chunk-size
+ :while sequence
+ :collect (pop sequence))))
+
+ ;; For other sequences like strings or arrays, we can simply chunk
+ ;; by repeated SUBSEQs.
+ (sequence (loop :with len := (length sequence)
+ :for i :below len :by chunk-size
+ :collect (subseq sequence i (min len (+ chunk-size i)))))))
+
+
+ (define-modify-macro appendf (&rest lists) append
+ "Modify-macro for `append`. Appends `lists` to the place designated by the first
+argument.")
+
+
+ (defun compose (function &rest more-functions)
+ "Returns a function composed of `function` and `more-functions` that applies its ;
+arguments to to each in turn, starting from the rightmost of `more-functions`,
+and then calling the next one with the primary value of the last."
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (reduce (lambda (f g)
+ (let ((f (ensure-function f))
+ (g (ensure-function g)))
+ (lambda (&rest arguments)
+ (declare (dynamic-extent arguments))
+ (funcall f (apply g arguments)))))
+ more-functions
+ :initial-value function))
+
+ (define-compiler-macro compose (function &rest more-functions)
+ (labels ((compose-1 (funs)
+ (if (cdr funs)
+ `(funcall ,(car funs) ,(compose-1 (cdr funs)))
+ `(apply ,(car funs) arguments))))
+ (let* ((args (cons function more-functions))
+ (funs (make-gensym-list (length args) "COMPOSE")))
+ `(let ,(loop for f in funs for arg in args
+ collect `(,f (ensure-function ,arg)))
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (lambda (&rest arguments)
+ (declare (dynamic-extent arguments))
+ ,(compose-1 funs))))))
+
+
+ (defmacro dohash ((key value table &optional result) &body body)
+ "Iterate over the hash table `table`, executing `body`, with `key` and
+ `value` bound to the keys and values of the hash table
+ respectively. Return `result` from the iteration form."
+ `(progn
+ (maphash (lambda (,key ,value)
+ ,@body)
+ ,table)
+ ,result))
+
+
+ (defun ensure-boolean (x)
+ "Convert `x` into a Boolean value."
+ (and x t))
+
+
+ (defmacro ensure-gethash (key hash-table &optional default)
+ "Like `gethash`, but if `key` is not found in the `hash-table` saves the `default`
+under key before returning it. Secondary return value is true if key was
+already in the table."
+ `(multiple-value-bind (value ok) (gethash ,key ,hash-table)
+ (if ok
+ (values value ok)
+ (values (setf (gethash ,key ,hash-table) ,default) nil))))
+
+
+ (defun ensure-list (list)
+ "If `list` is a list, it is returned. Otherwise returns the list designated by `list`."
+ (if (listp list)
+ list
+ (list list)))
+
+
+ (declaim (inline maphash-keys))
+ (defun maphash-keys (function table)
+ "Like `maphash`, but calls `function` with each key in the hash table `table`."
+ (maphash (lambda (k v)
+ (declare (ignore v))
+ (funcall function k))
+ table))
+
+
+ (defun hash-table-keys (table)
+ "Returns a list containing the keys of hash table `table`."
+ (let ((keys nil))
+ (maphash-keys (lambda (k)
+ (push k keys))
+ table)
+ keys))
+
+
+ (defun mkstr (&rest args)
+ "Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
+
+Extracted from _On Lisp_, chapter 4."
+ (with-output-to-string (s)
+ (dolist (a args) (princ a s))))
+
+
+ (defmacro once-only (specs &body forms)
+ "Evaluates `forms` with symbols specified in `specs` rebound to temporary
+variables, ensuring that each initform is evaluated only once.
+
+Each of `specs` must either be a symbol naming the variable to be rebound, or of
+the form:
+
+ (symbol initform)
+
+Bare symbols in `specs` are equivalent to
+
+ (symbol symbol)
+
+Example:
+
+ (defmacro cons1 (x) (once-only (x) `(cons ,x ,x)))
+ (let ((y 0)) (cons1 (incf y))) => (1 . 1)"
+ (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY"))
+ (names-and-forms (mapcar (lambda (spec)
+ (etypecase spec
+ (list
+ (destructuring-bind (name form) spec
+ (cons name form)))
+ (symbol
+ (cons spec spec))))
+ specs)))
+ ;; bind in user-macro
+ `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string (car n)))))
+ gensyms names-and-forms)
+ ;; bind in final expansion
+ `(let (,,@(mapcar (lambda (g n)
+ ``(,,g ,,(cdr n)))
+ gensyms names-and-forms))
+ ;; bind in user-macro
+ ,(let ,(mapcar (lambda (n g) (list (car n) g))
+ names-and-forms gensyms)
+ ,@forms)))))
+
+
+ (defun rcurry (function &rest arguments)
+ "Returns a function that applies the arguments it is called
+with and `arguments` to `function`."
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (let ((fn (ensure-function function)))
+ (lambda (&rest more)
+ (declare (dynamic-extent more))
+ (multiple-value-call fn (values-list more) (values-list arguments)))))
+
+
+ (declaim (inline remove/swapped-arguments))
+ (defun remove/swapped-arguments (sequence item &rest keyword-arguments)
+ (apply #'remove item sequence keyword-arguments))
+
+ (define-modify-macro removef (item &rest remove-keywords)
+ remove/swapped-arguments
+ "Modify-macro for `remove`. Sets place designated by the first argument to
+the result of calling `remove` with `item`, place, and the `keyword-arguments`.")
+
+
+ (defun symb (&rest args)
+ "Receives any number of objects, concatenates all into one string with `#'mkstr` and converts them to symbol.
+
+Extracted from _On Lisp_, chapter 4.
+
+See also: `symbolicate`"
+ (values (intern (apply #'mkstr args))))
+
+
+ (deftype string-designator ()
+ "A string designator type. A string designator is either a string, a symbol,
+or a character."
+ `(or symbol string character))
+
+
+ (defmacro with-gensyms (names &body forms)
+ "Binds each variable named by a symbol in `names` to a unique symbol around
+`forms`. Each of `names` must either be either a symbol, or of the form:
+
+ (symbol string-designator)
+
+Bare symbols appearing in `names` are equivalent to:
+
+ (symbol symbol)
+
+The string-designator is used as the argument to `gensym` when constructing the
+unique symbol the named variable will be bound to."
+ `(let ,(mapcar (lambda (name)
+ (multiple-value-bind (symbol string)
+ (etypecase name
+ (symbol
+ (values name (symbol-name name)))
+ ((cons symbol (cons string-designator null))
+ (values (first name) (string (second name)))))
+ `(,symbol (gensym ,string))))
+ names)
+ ,@forms))
+
+ (defmacro with-unique-names (names &body forms)
+ "Binds each variable named by a symbol in `names` to a unique symbol around
+`forms`. Each of `names` must either be either a symbol, or of the form:
+
+ (symbol string-designator)
+
+Bare symbols appearing in `names` are equivalent to:
+
+ (symbol symbol)
+
+The string-designator is used as the argument to `gensym` when constructing the
+unique symbol the named variable will be bound to."
+ `(with-gensyms ,names ,@forms))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (export '(curry subdivide appendf compose dohash ensure-boolean
+ ensure-gethash ensure-list hash-table-keys maphash-keys mkstr
+ once-only rcurry removef symb with-gensyms with-unique-names)))
+
+;;;; END OF quickutils.lisp ;;;;