# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1484410371 0
# Node ID 41f273df36731b9bb61237f12c626dd3adc39549
# Parent  5df9219aa0d33d51c4ca81bfccb87cd974c1060a
Try reintroducing data grammars

diff -r 5df9219aa0d3 -r 41f273df3673 examples/git-commands.lisp
--- a/examples/git-commands.lisp	Fri Jan 13 00:07:56 2017 +0000
+++ b/examples/git-commands.lisp	Sat Jan 14 16:12:51 2017 +0000
@@ -1,7 +1,7 @@
 (in-package :chancery)
 (named-readtables:in-readtable :chancery)
 
-(define-rule noun
+(define-string noun
   "binary blob"
   "packfile"
   "refspec"
@@ -21,11 +21,10 @@
   "repository"
   "symlink"
   "tag"
-  "tip"
-  )
+  "tip")
 
 
-(define-rule git-location%
+(define-string git-location%
   "repository"
   "index"
   "working tree"
@@ -39,7 +38,7 @@
   "upstream repository"
   "DAG")
 
-(define-rule git-folder%
+(define-string git-folder%
   ""
   "refs"
   "logs"
@@ -48,14 +47,14 @@
   "HEAD"
   "COMMIT_EDITMSG")
 
-(define-rule git-folder
+(define-string git-folder
   (".git/" :. git-folder%))
 
-(define-rule git-location
+(define-string git-location
   ("the" git-location%)
   git-folder)
 
-(define-rule external-location
+(define-string external-location
   "Hacker News"
   "Stack Overflow"
   "Twitter"
@@ -70,12 +69,12 @@
   "the git source code"
   "your home directory")
 
-(define-rule location
+(define-string location
   git-location
   external-location)
 
 
-(define-rule action
+(define-string action
   (list "bisect" "bisecting")
   (list "clone" "cloning")
   (list "commit" "committing")
@@ -99,23 +98,22 @@
   (list "sign" "signing")
   (list "simplify" "simplifying")
   (list "update" "updating")
-  (list "verify" "verifying")
-  )
+  (list "verify" "verifying"))
 
 (defun action-verb ()
   (first (action)))
 
 
-(define-rule refresh
+(define-string refresh
   "update"
   "reset")
 
-(define-rule refreshing
+(define-string refreshing
   "updating"
   "resetting")
 
 
-(define-rule extremum
+(define-string extremum
   "newest"
   "oldest"
   "largest"
@@ -127,7 +125,7 @@
   "simplest"
   "best")
 
-(define-rule adjective
+(define-string adjective
   "merged"
   "unmerged"
   "symbolic"
@@ -137,62 +135,61 @@
   "big-endian"
   "little-endian"
   "childless"
-  "binary"
-  )
+  "binary")
 
 
-(define-rule age
+(define-string age
   "newest"
   "oldest"
   "first"
   "last")
 
-(define-rule look-for
+(define-string look-for
   "search"
   "grep"
   "bisect"
   "filter")
 
-(define-rule temporal-adverb
+(define-string temporal-adverb
   "before"
   "after"
   "without")
 
 
 (defun letter ()
-  (random-elt "abcdefghijklmnopqrstuvwxyz"))
+  (random-elt "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"))
 
 (defun shellify (str)
   (string-downcase (substitute #\- #\space str)))
 
-(define-rule short-option%
+(define-string short-option%
   ("-" :. letter)
   ("-" :. letter [noun shellify string-upcase]))
 
 (defparameter *noun* nil)
 
-(define-rule long-option%
-  (eval (let ((*noun* (generate [noun shellify])))
-          (generate ("--" :. *noun* :. "=<" :. *noun* :. ">"))))
+(define-string long-option%
+  (eval (let ((*noun* (generate-string [noun shellify])))
+          (generate-string ("--" :. *noun* :. "=<" :. *noun* :. ">"))))
   ("--" :. action-verb)
   ("--" :. extremum)
   ("--only-" :. adjective)
   ("--only-" :. [noun shellify s])
   ("--" :. action-verb :. "=<" :. [noun shellify] :. ">"))
 
-(define-rule short-option
+(define-string short-option
   short-option%
   ("[" :. short-option% :. "]"))
 
-(define-rule long-option
+(define-string long-option
   long-option%
   ("[" :. long-option% :. "]"))
 
-(define-rule short-options
+(define-string short-options
   short-option
   (short-option short-option))
 
-(define-rule options
+(define-string options
   long-option
   short-options
   (short-options long-option)
@@ -202,7 +199,7 @@
 (defparameter *command* nil)
 (defparameter *commanding* nil)
 
-(define-rule description
+(define-string description
   (look-for location "for the" age noun "and" *command* "it")
   ("read" (eval (+ 2 (random 2000))) "bytes from" location "and" *command* "them")
   (*command* "the" extremum noun "in" git-location)
@@ -219,8 +216,8 @@
 
 (defun entry ()
   (destructuring-bind (*command* *commanding*) (action)
-    (generate
+    (generate-string
       ("git" *command* options #\newline :. [description cap]))))
 
 
-(dotimes (_ 20) (princ (entry)) (terpri) (terpri))
+; (dotimes (_ 20) (princ (entry)) (terpri) (terpri))
diff -r 5df9219aa0d3 -r 41f273df3673 src/chancery.lisp
--- a/src/chancery.lisp	Fri Jan 13 00:07:56 2017 +0000
+++ b/src/chancery.lisp	Sat Jan 14 16:12:51 2017 +0000
@@ -47,17 +47,21 @@
     (apply #'append <>)))
 
 
-;;;; Guts ---------------------------------------------------------------------
-(defun evaluate-combination (list)
-  (-<> list
-    (separate-with-spaces <>)
-    (mapcar #'evaluate-expression <>)
-    (apply #'cat (mapcar #'princ-to-string <>))))
+(deftype non-keyword-symbol ()
+  '(and symbol (not keyword)))
+
 
-(defun evaluate-modifiers (vector)
-  (reduce (flip #'funcall) vector
-          :start 1
-          :initial-value (evaluate-expression (aref vector 0))))
+;;;; Data ---------------------------------------------------------------------
+(defun data-special-form-p (form)
+  (ensure-boolean (and (consp form)
+                       (member (first form) '(quote eval)))))
+
+(deftype data-special-form ()
+  '(satisfies data-special-form-p))
+
+
+(defun evaluate-sequence (seq)
+  (map (type-of seq) #'evaluate-expression seq))
 
 (defun evaluate-symbol (symbol)
   (if (fboundp symbol)
@@ -67,25 +71,78 @@
 (defun evaluate-lisp (expr)
   (eval expr))
 
+(defun evaluate-data-special-form (expr)
+  (destructuring-bind (symbol argument) expr
+    (ecase symbol
+      (quote argument)
+      (eval (evaluate-lisp argument)))))
 
-(defun evaluate-list (list)
-  (mapcar #'evaluate-expression list))
 
 (defun evaluate-expression (expr)
   (typecase expr
-    ((or string keyword null) expr)
-    (symbol (evaluate-symbol expr))
-    (vector (evaluate-modifiers expr))
-    (cons (case (first expr)
-            (quote (second expr))
-            (eval (evaluate-lisp (second expr)))
-            (list (evaluate-list (rest expr)))
-            (t (evaluate-combination expr))))
+    (non-keyword-symbol (evaluate-symbol expr))
+    (data-special-form (evaluate-data-special-form expr))
+    (string expr)
+    (sequence (evaluate-sequence expr))
     (t expr)))
 
 
 (defmacro define-rule (name &rest expressions)
-  "Define a Chancery rule for the symbol `name`.
+  `(defun ,name ()
+     (evaluate-expression
+       (random-elt ,(coerce expressions 'vector)))))
+
+(defmacro generate (expression)
+  "Generate a single Chancery expression."
+  `(evaluate-expression ',expression))
+
+
+;;;; 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 evaluate-string-combination (list)
+  (-<> list
+    (separate-with-spaces <>)
+    (mapcar #'evaluate-string-expression <>)
+    (apply #'cat (mapcar #'princ-to-string <>))))
+
+(defun evaluate-string-modifiers (vector)
+  (reduce (flip #'funcall) vector
+          :start 1
+          :initial-value
+          (princ-to-string (evaluate-string-expression (aref vector 0)))))
+
+(defun evaluate-string-sequence (sequence-type seq)
+  (map sequence-type #'evaluate-string-expression seq))
+
+(defun evaluate-string-special-form (expr)
+  (destructuring-bind (symbol . body) expr
+    (ecase symbol
+      (quote (first body))
+      (list (evaluate-string-sequence 'list body))
+      (vector (evaluate-string-sequence 'vector body))
+      (eval (evaluate-lisp (first body))))))
+
+
+(defun evaluate-string-expression (expr)
+  (typecase expr
+    (string expr)
+    (null "")
+    (non-keyword-symbol (evaluate-symbol expr))
+    (string-special-form (evaluate-string-special-form expr))
+    (vector (evaluate-string-modifiers expr))
+    (cons (evaluate-string-combination expr))
+    (t expr)))
+
+
+(defmacro define-string (name &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.
@@ -102,12 +159,12 @@
 
   "
   `(defun ,name ()
-     (evaluate-expression
+     (evaluate-string-expression
        (random-elt ,(coerce expressions 'vector)))))
 
-(defmacro generate (expression)
-  "Generate a single Chancery expression."
-  `(evaluate-expression ',expression))
+(defmacro generate-string (expression)
+  "Generate a single Chancery string expression."
+  `(evaluate-string-expression ',expression))
 
 
 ;;;; Modifiers ----------------------------------------------------------------