1. monoid
  2. fucc

Commits

Ivan Boldyrev  committed e994b02

Use word 'terminal' for terminals and 'nterminal' for non-terminals
Keywords: generator, rename

  • Participants
  • Parent commits ad2f44d
  • Branches default

Comments (0)

Files changed (9)

File generator/fg-common.lisp

View file
  • Ignore whitespace
 (cl:in-package #:fucc-generator)
 
 (let ((processed-lrpoints (make-hash-table :test 'eql))
-      (processed-nterms (make-hash-table :test 'equal))
+      (processed-nterminals (make-hash-table :test 'equal))
       (new-unprocessed (make-hash-table :test 'equal)))
   (defun closure (set proceed expand ordering)
     (declare (type function proceed expand ordering))
     (let ((unprocessed 'nil))
-      ;; Initial set of non-kernel nterms
+      ;; Initial set of non-kernel nterminals
       (dolist (elt set)
         (dolist (new-elt (funcall proceed elt))
-          (unless (gethash new-elt processed-nterms)
+          (unless (gethash new-elt processed-nterminals)
             (push new-elt unprocessed))))
       (loop :while unprocessed :do
             (clrhash new-unprocessed)
             ;; Mark as processed _before_ processing
             (dolist (unpr unprocessed)
-              (setf (gethash unpr processed-nterms) t))
+              (setf (gethash unpr processed-nterminals) t))
             ;; Process
             (dolist (unpr unprocessed)
               (dolist (pt (funcall expand unpr))
                                    #'lrpoint=))
                   (dolist (candidate (funcall proceed pt))
                     (when (and candidate
-                               (not (gethash candidate processed-nterms)))
+                               (not (gethash candidate processed-nterminals)))
                       (iget candidate new-unprocessed #'sxhash #'equal))))))
             (setf unprocessed (itable-to-list new-unprocessed)))
       (prog1
                  set)
                 ordering)
         (clrhash processed-lrpoints)
-        (clrhash processed-nterms)
+        (clrhash processed-nterminals)
         (clrhash new-unprocessed)))))
 
 (let ((data (make-hash-table :test 'eql)))
-  (defun goto-nc (set nterm pred)
+  (defun goto-nc (set nterminal pred)
     (loop :for lrp :in set
           :for rule := (lrpoint-rule lrp)
           :for pos := (lrpoint-pos lrp)
           :when (and (< pos (rule-length rule))
-                     (funcall pred nterm rule pos))
+                     (funcall pred nterminal rule pos))
           :do  (iget (advance-lrpoint lrp) data #'lrpoint-hash #'lrpoint=))
     (prog1
         (sort (itable-to-list data) #'lrpoint<=)
           (let ((new-unprocessed nil))
             (dolist (item unprocessed)
               (iget item items #'item-hash #'item=))
-            (dolist (nterm (append (grammar-terms grammar)
-                                   (grammar-nterms grammar)))
+            (dolist (nterminal (append (grammar-terminals grammar)
+                                   (grammar-nterminals grammar)))
               (dolist (item unprocessed)
-                (let ((new-set (funcall goto-fun (item-set item) nterm)))
+                (let ((new-set (funcall goto-fun (item-set item) nterminal)))
                   (when new-set
                     (let* ((new-item (make-item :set new-set))
                            (member (iget new-item items
                       (when (eq new-item member)
                         ;; The item is new
                         (push member new-unprocessed))
-                      (push (cons nterm member)
+                      (push (cons nterminal member)
                             (item-moves item)))))))
             (setf unprocessed new-unprocessed)))
     (cons root-item
         :for num :from 0 :do
         (setf (item-index item) num))
   (let ((state-num (length items))
-        (terms-num (length (grammar-terms grammar)))
-        (nterms-num (length (grammar-nterms grammar))))
-    (let ((action-table (make-array (list state-num terms-num)
+        (terminals-num (length (grammar-terminals grammar)))
+        (nterminals-num (length (grammar-nterminals grammar))))
+    (let ((action-table (make-array (list state-num terminals-num)
                                     :initial-element nil))
-          (goto-table (make-array (1- nterms-num) :initial-element nil)))
+          (goto-table (make-array (1- nterminals-num) :initial-element nil)))
       ;; Shifts
       (dolist (item items)
         (loop :for (nterm . new-item) :in (item-moves item) :do
-              (if (term-p nterm)
+              (if (terminal-p nterm)
                   (pushnew (list* :shift nterm (item-index new-item))
                            (aref action-table
                                  (item-index item)
                                  (item-index new-item))
                            (aref goto-table
                                  (- (nterm-id nterm)
-                                    terms-num))
+                                    terminals-num))
                            :test #'equal))))
       ;; Reduce or accept
       (dolist (item items)
          (not (null (first left-side)))
          (null (rest left-side)))))
 
-(defun one-step-chain-rule-p (rule state term-id action-table goto-table)
+(defun one-step-chain-rule-p (rule state terminal-id action-table goto-table)
   (assert (chain-rule-p rule))
   (let* ((idx (nterm-id (first (rule-left rule))))
          (new-state (aref goto-table idx state))
-         (new-actions (aref action-table new-state term-id)))
+         (new-actions (aref action-table new-state terminal-id)))
     (find :action new-actions :key #'car)))
 
-(defun reduce-action (action state term action-table goto-table)
-  (declare (ignore action state term action-table goto-table))
+(defun reduce-action (action state terminal action-table goto-table)
+  (declare (ignore action state terminal action-table goto-table))
   (error "REDUCE-ACTION is unimplemented yet"))
 
 (defun remove-chain-rules (action-table goto-table)
           (let ((new-unprocessed nil))
             (setf repeat-flag nil)
             (loop :for unproc :in unprocessed :do
-                  (destructuring-bind (state term action action-tail) unproc
+                  (destructuring-bind (state terminal action action-tail) unproc
                     (if (one-step-chain-rule-p (cadr action)
                                                state
-                                               term
+                                               terminal
                                                action-table
                                                goto-table)
                         (setf (first action-tail)
                               (reduce-action action
                                              state
-                                             term
+                                             terminal
                                              action-table
                                              goto-table)
                               ;; Set repeat-flag

File generator/fg-decl.lisp

View file
  • Ignore whitespace
 (defmethod prec-priority ((number number))
   number)
 
+;; TODO: remove action :initform and prec-mixin: unsuitable for LL
 (defclass rule (properties prec-mixin)
-  ((left :accessor rule-left :initarg  :left)
-   (right :accessor rule-right :initarg :right)
-   (length :reader rule-length)
+  ((left :accessor rule-left
+         :accessor rule-nterminal
+         :initarg :left
+         :documentation "Left-hand size: non-terminal")
+   (right :accessor rule-right
+          :accessor rule-production
+          :initarg :right
+          :documentation "Right-hand side: list of terms")
+   (length :reader rule-length
+           :documentation "Cached length of right-hand side")
    (index :accessor rule-index :initarg :index)
    (action :accessor rule-action
+           :documentation "Action of the rule that creates rule's result"
            :initarg :action
            :initform (error "Action is not provided"))))
 
   ((name :accessor nterm-name :initarg :name)
    (rules :accessor nterm-rules :initarg :rules :initform nil)
    (id :accessor nterm-id :initarg :id)
-   (is-term :accessor term-p :initarg :is-term :initform nil)))
+   (is-terminal :accessor terminal-p :initarg :is-terminal :initform nil)))
 
 (defmethod nterm-name ((name null))
   nil)
 
-(defmethod term-p ((term null))
+(defmethod terminal-p ((term null))
   nil)
 
 (defun make-nterm (&rest args)
 (defvar *grammar-next-id*)
 
 (defclass grammar ()
-  ((nterms :accessor grammar-nterms :initarg :nterms)
-   (terms :accessor grammar-terms :initarg :terms)
+  ((nterminals :accessor grammar-nterminals :initarg :nterminals)
+   (terminals :accessor grammar-terminals :initarg :terminals)
    (rules :accessor grammar-rules :initarg :rules)
    (environment :accessor grammar-environment
                 :initarg :environment
                 :initform *grammar-environment*)
-   (first-nterm-id :accessor first-nterm-id
-                   :initarg :first-nterm-id
+   (first-nterminal-id :accessor first-nterminal-id
+                   :initarg :first-nterminal-id
                    :initform *grammar-next-id*)
    (prec-info :accessor grammar-prec-info
                :initarg :precedence
 
 (defmethod print-object ((nterm nterm) output)
   (format output "#<~A :NAME ~S :ID ~S>"
-          (if (term-p nterm)
+          (if (terminal-p nterm)
               "TERM"
               "NTERM")
           (nterm-name nterm)

File generator/fg-dump.lisp

View file
  • Ignore whitespace
         (j-var (gensym))
         (redux-var (gensym)))
     (dotimes (state (array-dimension action-table 0))
-      (dotimes (term (array-dimension action-table 1))
-        (let ((actions (aref action-table state term)))
+      (dotimes (terminal (array-dimension action-table 1))
+        (let ((actions (aref action-table state terminal)))
           (assert (null (rest actions)) nil
                   "Unresolved conflicts found at (~S ~S): ~S"
-                  term state actions)
-          (setf (aref array state term)
+                  terminal state actions)
+          (setf (aref array state terminal)
            (ecase (car (first actions))
              ((:shift)
               (list :shift :new-state (cddr (first actions))))
 (defun dump-goto-to-2d (goto-table)
   (let ((goto-tbl (make-array (array-dimensions goto-table)
                               :initial-element nil)))
-    (dotimes (nterm (array-dimension goto-table 0))
-      (loop :for (old-state . new-state) :in (aref goto-table nterm) :do
-            (setf (aref goto-tbl old-state nterm)
+    (dotimes (nterminal (array-dimension goto-table 0))
+      (loop :for (old-state . new-state) :in (aref goto-table nterminal) :do
+            (setf (aref goto-tbl old-state nterminal)
                   new-state)))
     goto-tbl))
 
   `(list ,(dump-action-to-2d action-table)
     ,(dump-goto-to-2d goto-table)))
 
-;;; Action table is 2d (state, term) , goto table is list of
-;;; (old-state . new-state) for given nterm
+;;; Action table is 2d (state, terminal) , goto table is list of
+;;; (old-state . new-state) for given nterminal
 (defun dump-to-2d-and-1d (action-table goto-table)
   `(list ,(dump-action-to-2d action-table)
     ,goto-table))
   (let* ((size (array-dimension action-table 0))
          (result (make-array size :initial-element nil)))
     (dotimes (state size)
-      (loop :for term-id :from 0 :below (array-dimension action-table 1)
-            :for term :in (grammar-terms grammar) :do
-            (let ((actions (aref action-table state term-id)))
+      (loop :for terminal-id :from 0 :below (array-dimension action-table 1)
+            :for terminal :in (grammar-terminals grammar) :do
+            (let ((actions (aref action-table state terminal-id)))
               (when actions
-                (push (nterm-name term) (aref result state)))))
+                (push (nterm-name terminal) (aref result state)))))
       ;; Just to preserve correct order of terminals for user
       ;; convenience
       (setf #1=(aref result state)

File generator/fg-grammar.lisp

View file
  • Ignore whitespace
                        terminals)))
     (values terms *grammar-next-id*)))
 
-(defun get-nterm (name &key is-term)
+(defun get-nterm (name &key is-terminal)
   "If NAME is NIL, return NIL.  Otherwise look for NAME in
 environment.  If found, return it; otherwise create new object."
   (if (null name)
             (setf (gethash name *grammar-environment*)
                   (make-nterm :name name
                               :id (incf *grammar-next-id*)
-                              :is-term is-term))))))
+                              :is-terminal is-terminal))))))
 
 (defun process-rule (s-rule)
   "Process given rule and return RULE object."
 
 (defun set-precedence-info (grammar)
   ;; Set terminals' precedence info
-  (loop :for (prec . terms) :in (grammar-prec-info grammar)
+  (loop :for (prec . terminals) :in (grammar-prec-info grammar)
         :for idx :from 0
-        :do (dolist (term terms)
-              (let ((nt (nterm-by-name term grammar)))
+        :do (dolist (terminal terminals)
+              (let ((nt (nterm-by-name terminal grammar)))
                 (setf (prec-assoc nt) prec)
                 (setf (prec-priority nt) idx))))
   ;; Set rules' precedence info
   (loop :for rule :in (grammar-rules grammar) :do
         (if (and (slot-boundp rule 'priority)
                  (symbolp (prec-priority rule)))
-            (let ((term (nterm-by-name (prec-priority rule) grammar)))
-              (setf (prec-assoc rule)    (prec-assoc term)
-                    (prec-priority rule) (prec-priority term)))
-            (let ((last-term (find-if #'term-p (rule-right rule)
+            (let ((terminal (nterm-by-name (prec-priority rule) grammar)))
+              (setf (prec-assoc rule)    (prec-assoc terminal)
+                    (prec-priority rule) (prec-priority terminal)))
+            (let ((last-terminal (find-if #'terminal-p (rule-right rule)
                                    :from-end t)))
-              (when last-term
-                (setf (prec-assoc    rule) (prec-assoc    last-term)
-                  (prec-priority rule) (prec-priority last-term)))))))
+              (when last-terminal
+                (setf (prec-assoc    rule) (prec-assoc    last-terminal)
+                  (prec-priority rule) (prec-priority last-terminal)))))))
 
 (defun generate-action--class (lhs class rule-info rhs)
   (let ((rev-arglist '())
                 (list (list +START+ '(:action (function identity))
                             initial))))
   (with-new-grammar-environment
-    (multiple-value-bind (terms first-nterm-id)  (init-env terminals)
+    (multiple-value-bind (terminals first-nterm-id)  (init-env terminals)
       (let* ((proc-rules (mapcar #'process-rule
                                  (expand-rules
                                   (mapcar #'generate-action rules))))
-             (nterms (sort (loop :for nterm
+             (nterminals (sort (loop :for nterm
                                  :being :each :hash-value :of *grammar-environment*
-                                 :when (not (term-p nterm))
+                                 :when (not (terminal-p nterm))
                                  :collect nterm)
                           #'<
                           :key #'nterm-id)))
         (let ((grammar (make-grammar :first-nterm-id first-nterm-id
                                      :rules proc-rules
-                                     :terms terms
-                                     :nterms nterms
+                                     :terminals terminals
+                                     :nterminals nterminals
                                      :precedence prec-info)))
           (set-precedence-info grammar)
           grammar)))))
          (nterm-id b)))))
 
 (defun nterm-by-name (name grammar)
-  "Return NTERM by NAME in given GRAMMAR"
+  "Find NTERM by NAME in given GRAMMAR"
   (gethash name (grammar-environment grammar)))
 
 (defun renumber-rules (grammar)
 
 (defun calculate-first (grammar)
   "Calculate FIRST for every nterm of grammar."
-  ;; Assign FIRST of terms to themselves
-  (dolist (term (grammar-terms grammar))
-    (setf (nterm-first term) (list term)))
-  ;; Set FIRST of nterms to NIL initially
-  (dolist (nterm (grammar-nterms grammar))
-    (setf (nterm-first nterm) nil))
-  ;; Calculate FIRST of nterms
+  ;; Assign FIRST of terminals to themselves
+  (dolist (terminal (grammar-terminals grammar))
+    (setf (nterm-first terminal) (list terminal)))
+  ;; Set FIRST of nterminals to NIL initially
+  (dolist (nterminal (grammar-nterminals grammar))
+    (setf (nterm-first nterminal) nil))
+  ;; Calculate FIRST of nterminals
   (let ((more-repeats t))
     (loop
      :while more-repeats :do
      (setf more-repeats nil)
-     (dolist (nterm (grammar-nterms grammar))
-       (let ((nt-first-orig (nterm-first nterm))
+     (dolist (nterminal (grammar-nterminals grammar))
+       (let ((nt-first-orig (nterm-first nterminal))
              (nt-first-more (reduce #'(lambda  (a b)
                                         (ounion a b :ordering #'nterm<=))
-                                    (nterm-rules nterm)
+                                    (nterm-rules nterminal)
                                     :initial-value nil
                                     :key #'(lambda (rule)
                                              (seq-first (rule-right rule))))))
          (let ((nt-first-new (ounion nt-first-orig nt-first-more
                                      :ordering #'nterm<=)))
            (when (not (equal nt-first-orig nt-first-new))
-             (setf (nterm-first nterm) nt-first-new)
+             (setf (nterm-first nterminal) nt-first-new)
              (setf more-repeats t))))))))
 
 (defun item-first (something)

File generator/fg-lalr.lisp

View file
  • Ignore whitespace
 (defparameter +wildcard+
   (make-nterm :name 'no-such-symbol
               :id -1
-              :is-term t)
+              :is-terminal t)
   "Special wildcard terminal for lookahead tracing.")
 
 (setf (nterm-first +wildcard+) (list +wildcard+))
 
 (define-property rm-info)
 
-(defun update-rm-info (target-nterm rule)
-  "Update RM-INFO for TARGET-NTERM with information from RULE."
-  (if (or (epsilon-rule-p rule) (term-p (first (rule-right rule))))
+(defun update-rm-info (target-nterminal rule)
+  "Update RM-INFO for TARGET-NTERMINAL with information from RULE."
+  (if (or (epsilon-rule-p rule) (terminal-p (first (rule-right rule))))
       nil
       (let ((source (first (rule-right rule)))
             (tail (rest (rule-right rule)))
             (updated-p nil))
         (let ((source-rm-info (rm-info source))
-              (target-rm-info (rm-info target-nterm))
+              (target-rm-info (rm-info target-nterminal))
               (first-set (seq-first tail)))
           (dotimes (i (array-dimension source-rm-info 0))
-            ;; Try uniting info about i-th nterm
+            ;; Try uniting info about i-th nterminal
             (when (aref source-rm-info i)
               (let ((new-value (ounion (aref target-rm-info i)
                                        (combine-first (aref source-rm-info i)
 
 (defun calculate-rm-info (grammar)
   "Info about rightmost derivations"
-  (let ((nterm-num (length (grammar-nterms grammar)))
-        (term-num (length (grammar-terms grammar))))
-    (dolist (nterm (grammar-nterms grammar))
-      (let ((array (make-array nterm-num :initial-element nil)))
-        (setf (aref array (- (nterm-id nterm) term-num))
+  (let ((nterminal-num (length (grammar-nterminals grammar)))
+        (terminal-num (length (grammar-terminals grammar))))
+    (dolist (nterminal (grammar-nterminals grammar))
+      (let ((array (make-array nterminal-num :initial-element nil)))
+        (setf (aref array (- (nterm-id nterminal) terminal-num))
               '(nil)) ; Or nil?
-        (setf (rm-info nterm) array)))
-    (let ((set (grammar-nterms grammar)))
+        (setf (rm-info nterminal) array)))
+    (let ((set (grammar-nterminals grammar)))
       (loop :while set
-            :for updated-nterms := nil :do
-            (dolist (nterm set)
+            :for updated-nterminals := nil :do
+            (dolist (nterminal set)
               (let ((updated nil))
-                (dolist (rule (nterm-rules nterm))
-                  (when (update-rm-info nterm rule)
+                (dolist (rule (nterm-rules nterminal))
+                  (when (update-rm-info nterminal rule)
                     (setf updated t)))
                 (when updated
-                  (pushnew nterm updated-nterms))))
-            (setf set updated-nterms)))))
+                  (pushnew nterminal updated-nterminals))))
+            (setf set updated-nterminals)))))
 
 ;;; TODO: try specialized version.  Necessary info can be generated
 ;;; during calculation of FIRST.
     (spread-laheads lr0-items)
     lr0-items))
 
-(defun nterm-epsilon-rules (nterm)
-  "List of epsilon rules of the nterm"
+(defun nterminal-epsilon-rules (nterminal)
+  "List of epsilon rules of the nterminal"
   (mapcan #'(lambda (rule)
               (if (epsilon-rule-p rule)
                   (list rule)
                   nil))
-          (nterm-rules nterm)))
+          (nterm-rules nterminal)))
 
 (defun get-epsilon-reductions (lrpoint lahead grammar)
   "Epsilon reductions that can happen for the LRPOINT and LAHEAD"
   (let ((nterm (nterm-at-pos lrpoint)))
-    (if (or (not nterm) (term-p nterm))
+    (if (or (not nterm) (terminal-p nterm))
         nil
         (let ((accumulator ())
               (rm-info (rm-info nterm)))
           (loop :for i :from 0 :below (array-dimension rm-info 0)
-                :for nterm :in (grammar-nterms grammar) :do
+                :for nterminal :in (grammar-nterminals grammar) :do
                 (let ((first-set (combine-first-sets
                                   (aref rm-info i)
                                   (seq-first
                                    (nthcdr (1+ (lrpoint-pos lrpoint))
                                            (rule-right (lrpoint-rule lrpoint))))
                                   lahead)))
-                  (loop :for rule :in (nterm-epsilon-rules nterm) :do
-                        (loop :for term :in first-set :do
-                              (push (cons rule (list term))
+                  (loop :for rule :in (nterminal-epsilon-rules nterm) :do
+                        (loop :for terminal :in first-set :do
+                              (push (cons rule (list terminal))
                                     accumulator)))))
           (nreverse accumulator)))))
 

File generator/fg-lr.lisp

View file
  • Ignore whitespace
                  (first-set (seq-first
                              (append (nthcdr (1+ pos) (rule-right rule))
                                      (lrpoint-lahead lrp)))))
-             (when (and nterm (not (term-p nterm)))
-               (dolist (term first-set)
-                 (when term
-                   (pushnew (list nterm term)
+             (when (and nterm (not (terminal-p nterm)))
+               (dolist (terminal first-set)
+                 (when terminal
+                   (pushnew (list nterm terminal)
                             result
                             :test #'equal))))))
          result))
    #'(lambda (cons)
-       (destructuring-bind (nterm . lahead) cons
+       (destructuring-bind (nterminal . lahead) cons
          (mapcar #'(lambda (rule)
                      (make-lrpoint :rule rule :pos 0 :lahead lahead))
-                 (nterm-rules nterm))))
+                 (nterm-rules nterminal))))
    #'lrpoint<=))
 
 (defun goto-lr1 (set nterm)

File generator/fg-lr0.lisp

View file
  • Ignore whitespace
                      (result nil))
                  (when (< lr-pos (rule-length lr-rule))
                    (let ((nterm (elt (rule-right lr-rule) lr-pos)))
-                     (when (and nterm (not (term-p nterm)))
+                     (when (and nterm (not (terminal-p nterm)))
                        (pushnew nterm result))))
                  result))
-           #'(lambda (nterm)
+           #'(lambda (nterminal)
                (mapcar #'(lambda (rule)
                            (make-lrpoint :rule rule :pos 0))
-                       (nterm-rules nterm)))
+                       (nterm-rules nterminal)))
            #'lrpoint<=))
 
-(defun goto-lr0 (set nterm)
+(defun goto-lr0 (set nterminal)
   (closure-lr0
    (goto-nc set
-            nterm
-            #'(lambda (nterm rule pos)
-                (eq nterm (elt (rule-right rule)
+            nterminal
+            #'(lambda (nterminal rule pos)
+                (eq nterminal (elt (rule-right rule)
                                pos))))))
 
 (defun items-lr0 (grammar)
   "Set rules that can be reduced in given item with LR0 aglorithm."
   (mapcan #'(lambda (lrpoint)
               (if (reduction-lrpoint-p lrpoint)
-                  (mapcar #'(lambda (term)
-                              (list (lrpoint-rule lrpoint) term))
-                          (grammar-terms grammar))
+                  (mapcar #'(lambda (terminal)
+                              (list (lrpoint-rule lrpoint) terminal))
+                          (grammar-terminals grammar))
                   nil))
           (item-set item)))
 
   (if (eql +START+ (nterm-name (rule-left (lrpoint-rule lrpoint))))
       (list (list (lrpoint-rule lrpoint)
                   (nterm-by-name +EOF+ grammar)))
-      (mapcar #'(lambda (term)
-                  (list (lrpoint-rule lrpoint) term))
+      (mapcar #'(lambda (terminal)
+                  (list (lrpoint-rule lrpoint) terminal))
               (nterm-follow (rule-left (lrpoint-rule lrpoint))))))
 
 (defun reduce-set-slr (item grammar)

File generator/fg-macro.lisp

View file
  • Ignore whitespace
         (%/value/-var (gensym))
         (mapping-var (gensym))
         (state-var (gensym))
-        (nterm-var (gensym))
-        (term-var (gensym))
+        (nterminal-var (gensym))
+        (terminal-var (gensym))
         (parser-var (gensym))
         (goto-table-var (gensym))
         (new-state-var (gensym))
       (when (or unproductive unused)
         ;; Recalculate grammar properties
         (loop :for idx :from 0
-              :for term :in (grammar-terms grammar) :do
-              (setf (nterm-id term) idx))
-        (loop :for idx :from (length (grammar-terms grammar))
-              :for nterm :in (grammar-nterms grammar) :do
-              (setf (nterm-id nterm) idx))
+              :for terminal :in (grammar-terminals grammar) :do
+              (setf (nterm-id terminal) idx))
+        (loop :for idx :from (length (grammar-terminals grammar))
+              :for nterminal :in (grammar-nterminals grammar) :do
+              (setf (nterm-id nterminal) idx))
         (renumber-rules grammar)
         (calculate-first grammar)
         (calculate-follow grammar)))
                  (,mapping-var (fucc::alist-to-hash-table
                            ',(list*
                               (cons nil 0)
-                              (mapcar #'(lambda (term)
-                                          (cons (nterm-name term)
-                                                (nterm-id term)))
-                                      (rest (grammar-terms grammar)))))))
+                              (mapcar #'(lambda (terminal)
+                                          (cons (nterm-name terminal)
+                                                (nterm-id terminal)))
+                                      (rest (grammar-terminals grammar)))))))
              (list
               0                      ; TODO: mechanism-dependent value
-              #'(lambda (,state-var ,term-var ,parser-var) ; TODO: ditto
-                  (setf ,term-var (or (gethash ,term-var ,mapping-var)
-                                      (and ,term-var
+              #'(lambda (,state-var ,terminal-var ,parser-var) ; TODO: ditto
+                  (setf ,terminal-var (or (gethash ,terminal-var ,mapping-var)
+                                      (and ,terminal-var
                                            ;; TODO: specific condition type
-                                           (error "Unknown terminal ~S" ,term-var))
+                                           (error "Unknown terminal ~S" ,terminal-var))
                                       0))
                   (aref (fourth ,parser-var)
-                        ,state-var ,term-var))
-              #'(lambda (,state-var ,nterm-var ,parser-var) ; TODO: ditto
+                        ,state-var ,terminal-var))
+              #'(lambda (,state-var ,nterminal-var ,parser-var) ; TODO: ditto
                   (let* ((,goto-table-var (fifth ,parser-var))
                          (,new-state-var
                           (cdr (assoc ,state-var
                                       (aref ,goto-table-var
-                                            (- ,nterm-var ,(length (grammar-terms grammar))))))))
+                                            (- ,nterminal-var ,(length (grammar-terminals grammar))))))))
                     (assert ,new-state-var)
                     ,new-state-var))
               (first ,%/value/-var)

File generator/fg-transform.lisp

View file
  • Ignore whitespace
   "Remove rules with unprductive nterms and nterms themself.
 Return list of unprductive nterms."
   (let ((unproductive ()))
-    ;; Terms are productive by definition
-    (dolist (term (grammar-terms grammar))
-      (setf (productive term) t))
-    (dolist (nterm (grammar-nterms grammar))
-      (unless (setf (productive nterm) (nterm-first nterm))
-        (push nterm unproductive)))
+    ;; Terminals are productive by definition
+    (dolist (terminal (grammar-terminals grammar))
+      (setf (productive terminal) t))
+    (dolist (nterminal (grammar-nterminals grammar))
+      (unless (setf (productive nterminal) (nterm-first nterminal))
+        (push nterminal unproductive)))
     (dolist (rule (grammar-rules grammar))
       (setf (productive rule)
             (and (productive (rule-left rule))
                  (every #'productive (rule-right rule)))))
-    ;; Prune grammar's nterm list and nterms' rules
-    (setf (grammar-nterms grammar)
-          (loop :for nterm :in (grammar-nterms grammar)
-                :when (productive nterm)
-                :collect nterm
-                :do (setf (nterm-rules nterm)
-                          (loop :for rule :in (nterm-rules nterm)
+    ;; Prune grammar's nterminal list and nterminals' rules
+    (setf (grammar-nterminals grammar)
+          (loop :for nterminal :in (grammar-nterminals grammar)
+                :when (productive nterminal)
+                :collect nterminal
+                :do (setf (nterm-rules nterminal)
+                          (loop :for rule :in (nterm-rules nterminal)
                                 :when (productive rule)
                                 :collect rule))))
     ;; Prune grammar's rule list
 (define-property nterm-used)
 
 (defun delete-unused-term-rules (grammar)
-  "Delete unused terms and nterms (i.e. they have no path from initial
-terminal).  Return list of unused terms/nterms."
+  "Delete unused terminals and nterminals (i.e. they have no path from initial
+terminal).  Return list of unused terminals/nterminals."
   (let ((unused ())
-        (start (first (last (grammar-nterms grammar)))))
+        (start (first (last (grammar-nterminals grammar)))))
     ;; Find unused rules and rules
     ;; TODO: reimplement with bit vectors as sets
     (setf (nterm-used start) t)
                 (setf (nterm-used nterm) t))
               (setf unprocessed new-unprocessed))))
     ;; Prune unused rules and rules
-    (setf (grammar-nterms grammar)
-          (loop :for nterm :in (grammar-nterms grammar)
-                :if (nterm-used nterm)
-                  :collect nterm
+    (setf (grammar-nterminals grammar)
+          (loop :for nterminal :in (grammar-nterminals grammar)
+                :if (nterm-used nterminal)
+                  :collect nterminal
                 :else
-                  :do (push nterm unused)))
-    ;; Update terms, preserving EOF term (which is always first)
-    (let ((eof-term (first (grammar-terms grammar))))
-      (setf (grammar-terms grammar)
-            (cons eof-term
-                  (loop :for term :in (rest (grammar-terms grammar))
-                        :if (nterm-used term)
-                          :collect term
+                  :do (push nterminal unused)))
+    ;; Update terminals, preserving EOF terminal (which is always first)
+    (let ((eof-terminal (first (grammar-terminals grammar))))
+      (setf (grammar-terminals grammar)
+            (cons eof-terminal
+                  (loop :for terminal :in (rest (grammar-terminals grammar))
+                        :if (nterm-used terminal)
+                          :collect terminal
                         :else
-                          :do (push term unused)))))
+                          :do (push terminal unused)))))
     (setf (grammar-rules grammar)
           (loop :for rule :in (grammar-rules grammar)
                 :when (nterm-used (rule-left rule))
 
 (defun remove-epsilon-rules (grammar)
   "Remove epsilon rules.  Actions are converted appropriately.
-Return alist NTERM -> EPSILON-ONLY-P where EPSILON-ONLY-P is true iff
-NTERM expands only to EPSILON or nothing.
+Return alist NTERMINAL -> EPSILON-ONLY-P where EPSILON-ONLY-P is true iff
+NTERMINAL expands only to EPSILON or nothing.
 
-This function may leave unused nterms.  Use DELETE-UNUSED-NTERM-RULES
+This function may leave unused nterminals.  Use DELETE-UNUSED-NTERM-RULES
 to remove them"
-  (let ((epsilon-terms (loop :for nterm :in (grammar-nterms grammar)
-                             :for first-set := (nterm-first nterm)
+  (let ((epsilon-terms (loop :for nterminal :in (grammar-nterminals grammar)
+                             :for first-set := (nterm-first nterminal)
                              :when (null (first first-set))
-                             :collect (cons nterm (null (rest first-set))))))
-    (dolist (nterm (grammar-nterms grammar))
-      (setf (nterm-rules nterm)
-            (loop :for rule :in (nterm-rules nterm)
+                             :collect (cons nterminal (null (rest first-set))))))
+    (dolist (nterminal (grammar-nterminals grammar))
+      (setf (nterm-rules nterminal)
+            (loop :for rule :in (nterm-rules nterminal)
                   :nconc (if (and (epsilon-rule-p rule)
                                   (not (eq +START+
                                            (nterm-name (rule-left rule)))))
     ;; TODO: do this optmization before +START+ is added.  Then order
     ;;       is not significant.
     (setf (grammar-rules grammar)
-          (loop :for nterm :in (grammar-nterms grammar)
-                :append (nterm-rules nterm)))
+          (loop :for nterminal :in (grammar-nterminals grammar)
+                :append (nterm-rules nterminal)))
     epsilon-terms))