9a223fdf9928

Remove possibly-unneeded binding bullshit
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Fri, 13 Jan 2017 00:00:05 +0000
parents 37d2a6b3aaf0
children 5df9219aa0d3
branches/tags (none)
files docs/02-usage.markdown examples/git-commands.lisp examples/story.lisp src/chancery.lisp vendor/make-quickutils.lisp vendor/quickutils.lisp

Changes

--- a/docs/02-usage.markdown	Thu Jan 12 22:39:04 2017 +0000
+++ b/docs/02-usage.markdown	Fri Jan 13 00:00:05 2017 +0000
@@ -19,5 +19,3 @@
 Evaluation
 ----------
 
-Binding
--------
--- a/examples/git-commands.lisp	Thu Jan 12 22:39:04 2017 +0000
+++ b/examples/git-commands.lisp	Fri Jan 13 00:00:05 2017 +0000
@@ -169,9 +169,11 @@
   ("-" :. letter)
   ("-" :. letter [noun shellify string-upcase]))
 
+(defparameter *noun* nil)
+
 (define-rule long-option%
-  (bind ((noun [noun shellify]))
-    ("--" :. noun :. "=<" :. noun :. ">"))
+  (eval (let ((*noun* (generate [noun shellify])))
+          (generate ("--" :. *noun* :. "=<" :. *noun* :. ">"))))
   ("--" :. action-verb)
   ("--" :. extremum)
   ("--only-" :. adjective)
@@ -197,24 +199,28 @@
   (long-option short-options))
 
 
+(defparameter *command* nil)
+(defparameter *commanding* nil)
+
 (define-rule 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)
-  (command [noun a] temporal-adverb refreshing git-location)
-  (command "and push all" adjective [noun s] "to" location)
-  (command "all" adjective [noun s] "in" git-location)
-  (command "the" extremum "and merge it into" git-location)
-  (command "some" [noun s] "from a remote")
-  (command "two or more" [noun s] "and save them to" location)
-  ("move or" command [noun a] "in" git-location)
-  ("rebase" [noun a] "onto" location "after" commanding "it")
-  (command "and" refresh git-location)
-  ("list," command :. ", or delete" [noun s]))
+  (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)
+  (*command* [noun a] temporal-adverb refreshing git-location)
+  (*command* "and push all" adjective [noun s] "to" location)
+  (*command* "all" adjective [noun s] "in" git-location)
+  (*command* "the" extremum "and merge it into" git-location)
+  (*command* "some" [noun s] "from a remote")
+  (*command* "two or more" [noun s] "and save them to" location)
+  ("move or" *command* [noun a] "in" git-location)
+  ("rebase" [noun a] "onto" location "after" *commanding* "it")
+  (*command* "and" refresh git-location)
+  ("list," *command* :. ", or delete" [noun s]))
+
+(defun entry ()
+  (destructuring-bind (*command* *commanding*) (action)
+    (generate
+      ("git" *command* options #\newline :. [description cap]))))
 
 
-(define-rule entry
-  (bind (((command commanding) action))
-    ("git" command options #\newline :. [description cap])))
-
-
+(dotimes (_ 20) (princ (entry)) (terpri) (terpri))
--- a/examples/story.lisp	Thu Jan 12 22:39:04 2017 +0000
+++ b/examples/story.lisp	Fri Jan 13 00:00:05 2017 +0000
@@ -1,92 +1,6 @@
 (in-package :chancery)
 (named-readtables:in-readtable :chancery)
 
-(define-rule name
-  "arjun"
-  "yuuma"
-  "jess"
-  "bob smith")
-
-(define-rule nature-noun
-  "ocean"
-  "mountain"
-  "forest"
-  "cloud"
-  "river"
-  "tree"
-  "sky"
-  "sea"
-  "desert")
-
-(define-rule animal
-  "unicorn"
-  "raven"
-  "turkey"
-  "wallaby"
-  "sparrow"
-  "scorpion"
-  "coyote"
-  "eagle"
-  "owl"
-  "lizard"
-  "zebra"
-  "duck"
-  "kitten")
-
-(define-rule color
-  "orange"
-  "blue"
-  "white"
-  "black"
-  "grey"
-  "purple"
-  "indigo"
-  "turquoise")
-
-(define-rule activity
-  "running"
-  "jumping"
-  "flying"
-  "carousing")
-
-(define-rule sentence
-  ("The" color animal "of the" nature-noun "is called" [name cap-all q] :. ".")
-  ("The" animal "was" activity "in the" [nature-noun s] :. ".")
-  ([name cap-all pos] "favorite color is" color :. ".")
-  ([nature-noun cap] "air is fresh.")
-  ("The" [animal s] "were" activity "in the" nature-noun :. "."))
-
-
-(define-rule pronoun
-  "he" "she")
-
-(define-rule posessive-pronoun
-  "his" "her")
-
-(define-rule omen
-  "good omen"
-  "bad omen")
-
-
-(define-rule story%
-  ("There once was" [color a] animal "named"  hero :. "."
-   cap-pro "journeyed to a distant" nature-noun "to find" [animal a] :. "."
-   "On the way" pronoun "saw" (eval (+ 10 (random 10))) [animal s] activity :. "."
-   hero "considered this to be a" omen :. ".")
-  (bind ((victim animal))
-    (hero "came upon a sick" victim :. "."
-     cap-pro "touched the" victim "and" posessive-pronoun "wounds were healed.")))
-
-(define-rule story
-  (bind* ((hero [name cap-all])
-          (pronoun pronoun)
-          (cap-pro [pronoun cap]))
-    (story%)))
-
-; (iterate (repeat 30) (pr (sentence)))
-
-
-;;;; Pronoun agreement through binding
 (defun pronoun (gender)
   (case gender
     (:female "she")
@@ -101,6 +15,11 @@
     (:neuter "its")
     (t "their")))
 
+
+(defparameter *name* nil)
+(defparameter *pronoun* nil)
+(defparameter *possessive* nil)
+
 (define-rule hero
   (list "freyja" :female)
   (list "loki" :male)
@@ -113,14 +32,18 @@
 (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 monster
+  "dragon" "kraken" "chimera")
 
-(define-rule story
-  (bind* (((name gender) hero)
-          (pronoun [gender pronoun])
-          (posessive [gender posessive-pronoun]))
-    (story%)))
+(define-rule story%
+  ([*name* cap] "took up" *possessive* "mighty" weapon "and went forth."
+   [*pronoun* cap] "slew the" monster "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."))
+
+(defun story ()
+  (destructuring-bind (name gender) (hero)
+    (let ((*name* name)
+          (*pronoun* (pronoun gender))
+          (*possessive* (posessive-pronoun gender)))
+      (story%))))
--- a/src/chancery.lisp	Thu Jan 12 22:39:04 2017 +0000
+++ b/src/chancery.lisp	Fri Jan 13 00:00:05 2017 +0000
@@ -52,39 +52,6 @@
 
 
 ;;;; Guts ---------------------------------------------------------------------
-(defparameter *bindings* nil)
-
-
-(defun create-binding (binding)
-  (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))
-         (*bindings* (cons new-bindings *bindings*)))
-    (evaluate-expression expr)))
-
-(defun evaluate-bind* (bindings expr)
-  (destructuring-bind (binding . remaining-bindings) bindings
-    (let ((*bindings* (cons (create-binding binding)
-                            *bindings*)))
-      (if remaining-bindings
-        (evaluate-bind* remaining-bindings expr)
-        (evaluate-expression expr)))))
-
-(defun lookup-binding (symbol)
-  (loop :for frame :in *bindings*
-        :for value = (getf frame symbol 'not-found)
-        :do (unless (eq value 'not-found)
-              (return-from lookup-binding (values value t))))
-  (values nil nil))
-
-
 (defun evaluate-combination (list)
   (-<> list
     (separate-with-spaces <>)
@@ -97,12 +64,9 @@
           :initial-value (evaluate-expression (aref vector 0))))
 
 (defun evaluate-symbol (symbol)
-  (multiple-value-bind (value found) (lookup-binding symbol)
-    (if found
-      value
-      (if (fboundp symbol)
-        (funcall symbol)
-        (symbol-value symbol)))))
+  (if (fboundp symbol)
+    (funcall symbol)
+    (symbol-value symbol)))
 
 (defun evaluate-lisp (expr)
   (eval expr))
@@ -118,8 +82,6 @@
     (vector (evaluate-modifiers expr))
     (cons (case (first expr)
             (quote (second expr))
-            (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))))
@@ -147,6 +109,9 @@
      (evaluate-expression
        (random-elt ,(coerce expressions 'vector)))))
 
+(defmacro generate (expression)
+  `(evaluate-expression ',expression))
+
 
 ;;;; Modifiers ----------------------------------------------------------------
 (defun cap (string)
--- a/vendor/make-quickutils.lisp	Thu Jan 12 22:39:04 2017 +0000
+++ b/vendor/make-quickutils.lisp	Fri Jan 13 00:00:05 2017 +0000
@@ -4,6 +4,7 @@
   "quickutils.lisp"
   :utilities '(
 
+               :compose
                :curry
                :ensure-boolean
                :ensure-gethash
--- a/vendor/quickutils.lisp	Thu Jan 12 22:39:04 2017 +0000
+++ b/vendor/quickutils.lisp	Fri Jan 13 00:00:05 2017 +0000
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :FLIP :MKSTR :ONCE-ONLY :RCURRY :RIFFLE :SPLIT-SEQUENCE :SYMB :WITH-GENSYMS) :ensure-package T :package "CHANCERY.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :FLIP :MKSTR :ONCE-ONLY :RCURRY :RIFFLE :SPLIT-SEQUENCE :SYMB :WITH-GENSYMS) :ensure-package T :package "CHANCERY.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "CHANCERY.QUICKUTILS")
@@ -14,9 +14,10 @@
 
 (when (boundp '*utilities*)
   (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
-                                         :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH
-                                         :ENSURE-LIST :FLIP :MKSTR :ONCE-ONLY
-                                         :RCURRY :RIFFLE :SPLIT-SEQUENCE :SYMB
+                                         :COMPOSE :CURRY :ENSURE-BOOLEAN
+                                         :ENSURE-GETHASH :ENSURE-LIST :FLIP
+                                         :MKSTR :ONCE-ONLY :RCURRY :RIFFLE
+                                         :SPLIT-SEQUENCE :SYMB
                                          :STRING-DESIGNATOR :WITH-GENSYMS))))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun make-gensym-list (length &optional (x "G"))
@@ -42,6 +43,35 @@
         (fdefinition function-designator)))
   )                                        ; eval-when
 
+  (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))))))
+  
+
   (defun curry (function &rest arguments)
     "Returns a function that applies `arguments` and the arguments
 it is called with to `function`."
@@ -328,7 +358,7 @@
     `(with-gensyms ,names ,@forms))
   
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(curry ensure-boolean ensure-gethash ensure-list flip mkstr
+  (export '(compose curry ensure-boolean ensure-gethash ensure-list flip mkstr
             once-only rcurry riffle split-sequence split-sequence-if
             split-sequence-if-not symb with-gensyms with-unique-names)))