Commits

Phil Hargett  committed 03bc1e0

Removed unused LR0 constructs

  • Participants
  • Parent commits e0ac2c0
  • Branches parsing

Comments (0)

Files changed (1)

     (with-slots (rule-name rhs) obj
       (format stream "Rule=~s RHS=~s" rule-name rhs))))
 
-(defclass lr0-item ()
-  ((position :initarg :position)
-   (production :initarg :production)))
-
-(defmethod print-object ((obj lr0-item) stream)
-  (print-unreadable-object (obj stream :type t :identity t)
-    (with-slots (position production) obj
-      (format stream "Position=~a Production=~s" position production))))
-
 (defclass lr1-item ()
   ((position :initarg :position)
    (lookahead :initarg :lookahead)
       (with-slots ((right-rule-name rule-name) (right-rhs rhs)) right
 	(and (equal left-rule-name right-rule-name)
 	     (equal left-rhs right-rhs)))))
-  (:method ((left lr0-item) (right lr0-item))
-    (with-slots ((left-position position) (left-production production)) left
-      (with-slots ((right-position position) (right-production production)) right
-	(and (= left-position right-position)
-	     (equal-items left-production right-production)))))
   (:method ((left lr1-item) (right lr1-item))
     (with-slots ((left-position position) (left-lookahead lookahead) (left-production production)) left
       (with-slots ((right-position position) (right-lookahead lookahead) (right-production production)) right
   (loop for rule in specification
        collect (car rule)))
 
-(defun initial-lr0-item-for-production (production)
-  (make-instance 'lr0-item :position 0 :production production))
-
-(defun initial-lr0-items-for-grammar (specification start-rule-name)
-  "Start rule should have  single production of the form: rule-name (:bof some-other-rule-name :eof);
-  an item's position is an index into the production's rhs of the *next* unread term."
-  (loop for rule in specification
-     if (eql (car rule) start-rule-name)
-     return (loop for production in (rule-productions rule)
-	       collect (initial-lr0-item-for-production production))))
-
 (defun initial-lr1-item-for-production (production lookahead)
   (make-instance 'lr1-item :position 0 :production production :lookahead lookahead))
 
 		      (elt rhs lookahead-position)
 		      default-lookahead)))))))
 
-(defun increment-lr0-item-position (item)
-  (with-slots (position production) item
-    (make-instance 'lr0-item :position (1+ position) :production production)))
-
 (defun increment-lr1-item-position (item)
   (with-slots (position lookahead production) item
     (make-instance 'lr1-item :position (1+ position) :lookahead lookahead :production production)))
 	;; terminal -- no productions
 	(list symbol))))
 
-(defun closure-of-lr0-items (specification items)
-  (let ((closure items))
-    (loop for done = t
-       do (loop for item in closure
-	     for productions = (rule-productions-in-grammar specification (next-term-for-item item))
-	     when productions
-	     do (loop for production in productions
-		   do (let ((initial-item (initial-lr0-item-for-production production)))
-			(unless (member initial-item closure :test #'equal-items)
-			  (setf done nil)
-			  (push initial-item closure)))))
-       until done
-       ;; note: we sort here, to ensure that we can use #'equal-items as a canonical
-       ;; test of uniqueness (and set membership, too)
-       finally (return (sort closure #'item<)))))
-
 (defun closure-of-lr1-items (specification items)
   (let ((closure items))
     (loop for done = t
   (:method ((left t) (right t))
     (equal left right)))
 
-(defun lr0-goto-for-symbol (specification items symbol)
-  (closure-of-lr0-items specification 
-		    (loop for item in items
-		       if (equal symbol (next-term-for-item item))
-		       unless (item-finished-p item)
-		       collect (increment-lr0-item-position item))))
-
 (defun lr1-goto-for-symbol (specification items symbol)
   (closure-of-lr1-items specification 
 		    (loop for item in items
   (let ((goto (lr1-goto-for-symbol specification states symbol)))
     (position goto states :test #'equal-items)))
 
-(defun lr0-items-for-grammar (specification start-rule-name)
-  (let ((states (list (closure-of-lr0-items specification (initial-lr0-items-for-grammar specification start-rule-name))))
-	(symbols (symbols-in-grammar specification)))
-    (loop for done = t
-       do (loop for state in states
-	     ;; do (format *standard-output* "State: ~a~%" state)
-	     do (loop for symbol in symbols
-		   do (let ((goto (lr0-goto-for-symbol specification state symbol)))
-			(when (and goto (not (member goto states :test #'equal-items)))
-			  (setf done nil)
-			  (push goto states)))))
-       until done
-       finally (return (reverse states)))))
-
 (defun lr1-items-for-grammar (specification start-rule-name)
   (let ((states (list (closure-of-lr1-items specification (initial-lr1-items-for-grammar specification start-rule-name))))
 	(symbols (symbols-in-grammar specification)))
 (defun parse-result (parser)
   (when (stack parser)
     (destructuring-bind (stack-state stack-token) (car (stack parser))
+      (declare (ignore stack-state))
       stack-token)))
 
 (defun parse-input (parser input)