# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1484219667 0
# Node ID bad26979f2d4a412de53c87f942fc9c2838cce07
# Parent  b646793b8d97552c6ad66acde68080b4fe4a70f9
Add destructuring

diff -r b646793b8d97 -r bad26979f2d4 .lispwords
--- a/.lispwords	Thu Jan 12 10:42:36 2017 +0000
+++ b/.lispwords	Thu Jan 12 11:14:27 2017 +0000
@@ -0,0 +1,1 @@
+(1 bind bind*)
diff -r b646793b8d97 -r bad26979f2d4 examples/story.lisp
--- a/examples/story.lisp	Thu Jan 12 10:42:36 2017 +0000
+++ b/examples/story.lisp	Thu Jan 12 11:14:27 2017 +0000
@@ -85,3 +85,42 @@
 
 ; (iterate (repeat 30) (pr (sentence)))
 
+
+;;;; Pronoun agreement through binding
+(defun pronoun (gender)
+  (case gender
+    (:female "she")
+    (:male "he")
+    (:neuter "it")
+    (t "they")))
+
+(defun posessive-pronoun (gender)
+  (case gender
+    (:female "her")
+    (:male "his")
+    (:neuter "its")
+    (t "their")))
+
+(define-rule hero
+  (list "freyja" :female)
+  (list "loki" :male)
+  (list "time" :neuter)
+  (list "frobboz" :frobbian))
+
+(define-rule weapon
+  "axe" "sword" "banana")
+
+(define-rule animal
+  "mouse" "squirrel" "beaver" "antelope" "rabbit" "elk")
+
+(define-rule story%
+  ([name cap] "took up" posessive "mighty" weapon "and went forth."
+   [pronoun cap] "slew the dragon and the people rejoiced.")
+  ("Once upon a time there was" [animal a] "named" [name cap] :. "."
+   [pronoun cap] "went to the village and was very happy."))
+
+(define-rule story
+  (bind* (((name gender) hero)
+          (pronoun [gender pronoun])
+          (posessive [gender posessive-pronoun]))
+    (story%)))
diff -r b646793b8d97 -r bad26979f2d4 src/chancery.lisp
--- a/src/chancery.lisp	Thu Jan 12 10:42:36 2017 +0000
+++ b/src/chancery.lisp	Thu Jan 12 11:14:27 2017 +0000
@@ -47,13 +47,22 @@
     (apply #'append <>)))
 
 
+(deftype non-keyword-symbol ()
+  '(and symbol (not keyword)))
+
+
 ;;;; Guts ---------------------------------------------------------------------
 (defparameter *bindings* nil)
 
 
 (defun create-binding (binding)
-  (destructuring-bind (symbol expr) binding
-    (list symbol (evaluate-expression expr))))
+  (destructuring-bind (target expr) binding
+    (let ((value (evaluate-expression expr)))
+      (etypecase target
+        (non-keyword-symbol (list target value))
+        (cons (loop :for symbol :in target
+                    :for val :in value
+                    :append (list symbol val)))))))
 
 (defun evaluate-bind (bindings expr)
   (let* ((new-bindings (mapcan (rcurry #'create-binding) bindings))
@@ -98,6 +107,10 @@
 (defun evaluate-lisp (expr)
   (eval expr))
 
+
+(defun evaluate-list (list)
+  (mapcar #'evaluate-expression list))
+
 (defun evaluate-expression (expr)
   (typecase expr
     ((or string keyword null) expr)
@@ -108,6 +121,7 @@
             (bind (evaluate-bind (second expr) (cddr expr)))
             (bind* (evaluate-bind* (second expr) (cddr expr)))
             (eval (evaluate-lisp (second expr)))
+            (list (evaluate-list (rest expr)))
             (t (evaluate-combination expr))))
     (t expr)))
 
@@ -176,3 +190,5 @@
          "'"
          "'s")))
 
+
+;;;; Scratch ------------------------------------------------------------------