diff options
| -rw-r--r-- | argot.lisp | 39 |
1 files changed, 22 insertions, 17 deletions
@@ -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*) |