# HG changeset patch # User Steve Losh # Date 1484139193 0 # Node ID 678e161802f57f8a28f182f5e8a3ce9b704c56c8 Initial commit diff -r 000000000000 -r 678e161802f5 .hgignore --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.hgignore Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,5 @@ +syntax: glob + +scratch.lisp +*.png +docs/build diff -r 000000000000 -r 678e161802f5 .lispwords diff -r 000000000000 -r 678e161802f5 Makefile --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Makefile Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,27 @@ +.PHONY: vendor pubdocs + +sourcefiles = $(shell ffind --full-path --literal .lisp) +docfiles = $(shell ls docs/*.markdown) +apidocs = $(shell ls docs/*reference*.markdown) + +# Vendor ---------------------------------------------------------------------- +vendor/quickutils.lisp: vendor/make-quickutils.lisp + cd vendor && sbcl --noinform --load make-quickutils.lisp --eval '(quit)' + +vendor: vendor/quickutils.lisp + + +# Documentation --------------------------------------------------------------- +$(apidocs): $(sourcefiles) + sbcl --noinform --load docs/api.lisp --eval '(quit)' + +docs/build/index.html: $(docfiles) $(apidocs) docs/title + cd docs && ~/.virtualenvs/d/bin/d + +docs: docs/build/index.html + +pubdocs: docs + hg -R ~/src/sjl.bitbucket.org pull -u + rsync --delete -a ./docs/build/ ~/src/sjl.bitbucket.org/chancery + hg -R ~/src/sjl.bitbucket.org commit -Am 'chancery: Update site.' + hg -R ~/src/sjl.bitbucket.org push diff -r 000000000000 -r 678e161802f5 README.markdown --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/README.markdown Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,25 @@ +``` + ,- _~. ,, + (' /| || _ +(( || ||/\\ < \, \\/\\ _-_ _-_ ,._-_ '\\/\\ +(( || || || /-|| || || || || \\ || || ;' + ( / | || || (( || || || || ||/ || ||/ + -____- \\ |/ \/\\ \\ \\ \\,/ \\,/ \\, |/ + _/ ( + -_- +``` + +Chancery is a library for procedurally generating data in Common Lisp. It has +some extra support for strings, and is heavily inspired by [Tracery][]. + +[Tracery]: http://tracery.io/ + +* **License:** MIT/X11 +* **Documentation:** +* **Mercurial:** +* **Git:** + +Chancery focuses on simplicity, correctness, and usability. Performance is not +*terrible*, but is not a high priority. + +It is currently not thread-safe, but this may happen in the future. diff -r 000000000000 -r 678e161802f5 chancery.asd --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/chancery.asd Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,17 @@ +(asdf:defsystem :chancery + :description "A library for procedurally generating data, inspired by Tracery." + + :author "Steve Losh " + + :license "MIT/X11" + :version "1.0.0" + + :depends-on () + + :serial t + :components ((:module "vendor" :serial t + :components ((:file "quickutils-package") + (:file "quickutils"))) + (:file "package") + (:module "src" :serial t + :components ((:file "chancery"))))) diff -r 000000000000 -r 678e161802f5 docs/01-installation.markdown --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/docs/01-installation.markdown Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,8 @@ +Installation +============ + +Chancery is compatible with Quicklisp, but not *in* Quicklisp (yet?). You can +clone the repository into your [Quicklisp local-projects][local] directory for +now. + +[local]: https://www.quicklisp.org/beta/faq.html#local-project diff -r 000000000000 -r 678e161802f5 docs/02-usage.markdown --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/docs/02-usage.markdown Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,7 @@ +Usage +===== + +Chancery is ... + +[TOC] + diff -r 000000000000 -r 678e161802f5 docs/03-reference.markdown diff -r 000000000000 -r 678e161802f5 docs/04-changelog.markdown --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/docs/04-changelog.markdown Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,11 @@ +Changelog +========= + +Here's the list of changes in each released version. + +[TOC] + +v1.0.0 +------ + +Initial version. diff -r 000000000000 -r 678e161802f5 docs/api.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/docs/api.lisp Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,20 @@ +(ql:quickload "cl-d-api") + +(defparameter *header* + "The following is a list of all user-facing parts of Chancery. + +If there are backwards-incompatible changes to anything listed here, they will +be noted in the changelog and the author will feel bad. + +Anything not listed here is subject to change at any time with no warning, so +don't touch it. + +") + +(d-api:generate-documentation + :chancery + #p"docs/03-reference.markdown" + (list "CHANCERY") + *header* + :title "API Reference") + diff -r 000000000000 -r 678e161802f5 docs/footer.markdown --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/docs/footer.markdown Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,14 @@ +Made with Lisp and love by [Steve Losh][] in Reykjavík, Iceland. + +[Steve Losh]: http://stevelosh.com/ + + diff -r 000000000000 -r 678e161802f5 docs/index.markdown --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/docs/index.markdown Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,14 @@ +Chancery is a library for procedurally generating data in Common Lisp. It has +some extra support for strings, and is heavily inspired by [Tracery][]. + +[Tracery]: http://tracery.io/ + +* **License:** MIT/X11 +* **Documentation:** +* **Mercurial:** +* **Git:** + +Chancery focuses on simplicity, correctness, and usability. Performance is not +*terrible*, but is not a high priority. + +It is currently not thread-safe, but this may happen in the future. diff -r 000000000000 -r 678e161802f5 docs/title --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/docs/title Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,1 @@ +Chancery diff -r 000000000000 -r 678e161802f5 package.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/package.lisp Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,4 @@ +(defpackage :chancery + (:use :cl :chancery.quickutils) + (:export + )) diff -r 000000000000 -r 678e161802f5 src/chancery.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/chancery.lisp Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,1 @@ +(in-package :chancery) diff -r 000000000000 -r 678e161802f5 vendor/make-quickutils.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/vendor/make-quickutils.lisp Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,18 @@ +(ql:quickload 'quickutil) + +(qtlc:save-utils-as + "quickutils.lisp" + :utilities '( + + :curry + :ensure-boolean + :ensure-gethash + :ensure-list + :mkstr + :once-only + :rcurry + :symb + :with-gensyms + + ) + :package "CHANCERY.QUICKUTILS") diff -r 000000000000 -r 678e161802f5 vendor/quickutils-package.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/vendor/quickutils-package.lisp Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,12 @@ +(eval-when (:compile-toplevel :load-toplevel :execute) + (unless (find-package "CHANCERY.QUICKUTILS") + (defpackage "CHANCERY.QUICKUTILS" + (:documentation "Package that contains Quickutil utility functions.") + (:use :cl)))) + +(in-package "CHANCERY.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) + diff -r 000000000000 -r 678e161802f5 vendor/quickutils.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/vendor/quickutils.lisp Wed Jan 11 12:53:13 2017 +0000 @@ -0,0 +1,199 @@ +;;;; This file was automatically generated by Quickutil. +;;;; See http://quickutil.org for details. + +;;;; To regenerate: +;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :MKSTR :ONCE-ONLY :RCURRY :SYMB :WITH-GENSYMS) :ensure-package T :package "CHANCERY.QUICKUTILS") + +(eval-when (:compile-toplevel :load-toplevel :execute) + (unless (find-package "CHANCERY.QUICKUTILS") + (defpackage "CHANCERY.QUICKUTILS" + (:documentation "Package that contains Quickutil utility functions.") + (:use #:cl)))) + +(in-package "CHANCERY.QUICKUTILS") + +(when (boundp '*utilities*) + (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION + :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH + :ENSURE-LIST :MKSTR :ONCE-ONLY :RCURRY + :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 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))) + + + (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))))) + + + (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 ensure-boolean ensure-gethash ensure-list mkstr once-only + rcurry symb with-gensyms with-unique-names))) + +;;;; END OF quickutils.lisp ;;;;