# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1484912972 0
# Node ID 63b7d69e7d8b3cb590266910b00f765af51d0266
# Parent  b9b6ba46e47b42a787b79b527bb8e3358104d1a3
Cleanup

diff -r b9b6ba46e47b -r 63b7d69e7d8b src/chancery.lisp
--- a/src/chancery.lisp	Fri Jan 20 01:08:00 2017 +0000
+++ b/src/chancery.lisp	Fri Jan 20 11:49:32 2017 +0000
@@ -97,37 +97,37 @@
         :when (< n weight) :do (return item)))
 
 
-;;;; Data ---------------------------------------------------------------------
-(defun data-special-form-p (form)
-  (ensure-boolean (and (consp form)
-                       (member (first form) '(quote eval)))))
+;;;; Core ---------------------------------------------------------------------
+(defun special-form-p (form)
+  (ensure-boolean
+    (and (consp form)
+         (member (first form) '(quote eval)))))
 
-(deftype data-special-form ()
-  '(satisfies data-special-form-p))
+(deftype special-form ()
+  '(satisfies special-form-p))
 
 
-(defun compile-sequence (seq)
-  (let ((contents (map 'list #'compile-expression seq)))
-    (etypecase seq
-      (list `(list ,@contents)))))
+(defun compile-list (contents)
+  `(list ,@(mapcar #'compile-expression contents)))
 
 (defun compile-symbol (symbol)
   `(,symbol))
 
-(defun compile-data-special-form (expr)
-  (destructuring-bind (symbol argument) expr
+(defun compile-special-form (expression)
+  (destructuring-bind (symbol argument) expression
     (ecase symbol
       (quote `(quote ,argument))
       (eval argument))))
 
-(defun compile-expression (expr)
-  (typecase expr
-    (null expr)
-    (non-keyword-symbol (compile-symbol expr))
-    (data-special-form (compile-data-special-form expr))
-    (string expr)
-    (sequence (compile-sequence expr))
-    (t expr)))
+(defun compile-expression (expression)
+  (typecase expression
+    (null expression)
+    (non-keyword-symbol (compile-symbol expression))
+    (special-form (compile-special-form expression))
+    (string expression)
+    (list (compile-list expression))
+    ; todo: vectors?
+    (t expression)))
 
 
 (defun build-weightlist-weighted (size weights)
@@ -173,6 +173,17 @@
            options)))
 
 
+(defun compile-rule-body (expression-compiler expressions distribution)
+  (if (= 1 (length expressions))
+    (funcall expression-compiler (first expressions))
+    (multiple-value-bind (selector expressions)
+        (compile-selector distribution expressions)
+      `(case ,selector
+         ,@(loop
+            :for i :from 0
+            :for expression :in expressions
+            :collect `(,i ,(funcall expression-compiler expression)))))))
+
 (defun compile-define-rule (expression-compiler name-and-options expressions)
   (destructuring-bind (name &key
                             documentation
@@ -181,15 +192,7 @@
       (ensure-list name-and-options)
     `(defun ,name ,arguments
        ,@(ensure-list documentation)
-       ,(if (= 1 (length expressions))
-         (funcall expression-compiler (first expressions))
-         (multiple-value-bind (selector expressions)
-             (compile-selector distribution expressions)
-           `(case ,selector
-              ,@(loop
-                 :for i :from 0
-                 :for expression :in expressions
-                 :collect `(,i ,(funcall expression-compiler expression)))))))))
+       ,(compile-rule-body expression-compiler expressions distribution))))
 
 
 (defmacro define-rule (name-and-options &rest expressions)
@@ -201,70 +204,29 @@
 
 
 ;;;; Strings ------------------------------------------------------------------
-(defun string-special-form-p (form)
-  (ensure-boolean (and (consp form)
-                       (member (first form) '(quote eval list vector)))))
-
-(deftype string-special-form ()
-  '(satisfies string-special-form-p))
-
-
 (defun compile-string-combination (list)
-  (let ((contents (-<> list
+  `(join-string ,@(-<> list
                     (separate-with-spaces <>)
                     (mapcar #'compile-string-expression <>))))
-    `(join-string ,@contents)))
 
 (defun compile-string-modifiers (vector)
-  (labels ((recur (modifiers)
-             (if (null modifiers)
-               (compile-expression (aref vector 0))
-               `(,(first modifiers)
-                 ,(recur (rest modifiers))))))
-    (recur (nreverse (coerce (subseq vector 1) 'list)))))
-
-(defun compile-string-sequence (sequence-type seq)
-  (let ((contents (map 'list #'compile-string-expression seq)))
-    (ecase sequence-type
-      (list `(list ,@contents)))))
-
-(defun compile-string-special-form (expr)
-  (destructuring-bind (symbol . body) expr
-    (ecase symbol
-      (quote `(quote ,(first body)))
-      (list (compile-string-sequence 'list body))
-      (vector (compile-string-sequence 'vector body))
-      (eval (first body)))))
-
+  ; #("foo" a b c) => (c (b (a "foo")))
+  (reduce (flip #'list) vector
+          :start 1
+          :initial-value (compile-expression (aref vector 0))))
 
 (defun compile-string-expression (expression)
   (typecase expression
     (string expression)
     (null "")
     (non-keyword-symbol (compile-symbol expression))
-    (string-special-form (compile-string-special-form expression))
+    (special-form (compile-special-form expression))
     (vector (compile-string-modifiers expression))
     (cons (compile-string-combination expression))
     (t expression)))
 
 
 (defmacro define-string (name-and-options &rest expressions)
-  "Define a Chancery string rule for the symbol `name`.
-
-  Each expression in `expressions` can be any valid Chancery expression.  When
-  the rule is invoked one will be chosen at random and evaluated.
-
-  Examples:
-
-    (define-rule name \"Alice\" \"Bob\" \"Carol\")
-    (define-rule place \"forest\" \"mountain\")
-    (define-rule emotion \"happy\" \"sad\")
-
-    (define-rule sentence
-      (name \"was\" emotion :. \".\")
-      (name \"went to the\" place :. \".\"))
-
-  "
   (compile-define-rule 'compile-string-expression name-and-options expressions))
 
 (defmacro gen-string (expression)