From fbe7ae96e394e87e0dfa890e7419064ef3525cfc Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Wed, 19 Jul 2023 06:55:24 -0700
Subject: Change: rule results are bound to rule name for action

---
 argot.lisp | 39 ++++++++++++++++++++++-----------------
 1 file changed, 22 insertions(+), 17 deletions(-)

(limited to 'argot.lisp')

diff --git a/argot.lisp b/argot.lisp
index c434778..2d72866 100644
--- a/argot.lisp
+++ b/argot.lisp
@@ -70,23 +70,28 @@ and it returns VAR in that case."
 
 (defmacro defgrammar (name (&key (documentation "")) &body ruledefs)
   (let ((bindings-var (gensym "BINDINGS")))
-    `(progn
-       (defvar ,name nil ,documentation)
-       (setf ,name (make-hash-table :test #'eq))
-       ,@(loop :for ruledef :in ruledefs
-               :for (lhs pattern vars action) := (parse-rule-def ruledef)
-               :for bindings
-                 := (loop :for var :in vars
-                          :collect `(,var (cdr (assoc ',var ,bindings-var))))
-               :collect `(include-rule
-                          ,name
-                          (make-rule
-                           :lhs ',lhs
-                           :pattern ',pattern
-                           ,@(when action
-                               (list 
-                                :action `(lambda (,bindings-var) (let ,bindings ,action)))))))
-       ,name)))
+    (flet ((collect-let-bindings (lhs vars)
+             "Create let-bindings forms for the body of the :action.  "
+             (loop :for var :in vars
+                   :collect `(,var (cdr (assoc ',var ,bindings-var))) :into bs
+                   :finally (return (list* lhs `(cdr (assoc ',lhs ,bindings-var)) bs))))
+           (rule-includer (name lhs pattern &optional action bindings)
+             `(include-rule
+               ,name
+               (make-rule
+                :lhs ',lhs
+                :pattern ',pattern
+                ,@(when action
+                    (list 
+                     :action `(lambda (,bindings-var) (let ,bindings ,action)))))))) 
+      `(progn
+         (defvar ,name nil ,documentation)
+         (setf ,name (make-hash-table :test #'eq))
+         ,@(loop :for ruledef :in ruledefs
+                 :for (lhs pattern vars action) := (parse-rule-def ruledef)
+                 :for bindings := (collect-let-bindings lhs vars)
+                 :collect (rule-includer name lhs pattern action bindings))
+         ,name))))
 
 (defvar *position*)
 (defvar *grammar*)
-- 
cgit v1.2.3