Anonymous avatar Anonymous committed 53c49bb

Refinements; need to remove :nil from grammars now

Comments (0)

Files changed (3)

 
 (defclass lr-parse-table ()
   ((number-of-states :initarg :states :accessor number-of-states)
-   (entries :initform (make-hash-table) :accessor entries))) 
+   (entries :initform (make-hash-table :test #'equal) :accessor entries))) 
 
 (defmethod print-object ((obj lr-parse-table) stream)
   (print-unreadable-object (obj stream :type t :identity t)
     (format stream "Max states=~a~%" (number-of-states obj))
     (format stream "Entries:~{~a:~a~%~}%"
 	    (loop for k being the hash-keys of (entries obj)
-		 collect (list k (gethash k (entries obj)))))))
+		 append (list k (gethash k (entries obj)))))))
 
 (defclass lalr1-grammar ()
   ((specification :initarg :specification :accessor specification)
     (labels ((shifting-p (item)
 	       (let* ((rhs (slot-value (slot-value item 'production) 'rhs))
 		     (length (length rhs)))
-		 (loop for position from (slot-value item 'position) upto length
-		    while (equal :nil (elt rhs position))
-		    finally (return ( < position length)))))
+		 (loop for position from (slot-value item 'position) below length
+		    for shifting = (not (equal :nil (elt rhs position)))
+		    until shifting
+		    finally (return shifting))))
 
 	     (index-of-goto (goto)
 	       (position goto states :test #'equal-items))
 
 	     (record-shift (statei next-symbol)
-	       (setf (gethash (list statei next-symbol) action-table)
-		     (list :shift (index-of-goto (lr1-goto-for-symbol specification states next-symbol)))))
+	       (setf (gethash (list statei next-symbol) (entries action-table))
+		     (list :shift (index-of-goto (lr1-goto-for-symbol specification (elt states statei) next-symbol)))))
 
 	     (record-reduce (statei next-symbol production)
-	       (setf (gethash (list statei next-symbol) action-table)
+	       (setf (gethash (list statei next-symbol) (entries action-table))
 		     ;; we need the production to 1) know what symbol to reduce to, and 2) to know
 		     ;; how many items on the stack to pop
 		     (list :reduce production )))
 
 	     (record-accept (statei next-symbol)
 	       ;; note we're assuming next-symbol will be :eof
-	       (setf (gethash (list statei next-symbol) action-table) :accept))
+	       (setf (gethash (list statei next-symbol) (entries action-table)) :accept))
 
 	     (record-goto (statei non-terminal)
-	       (let ((goto (index-of-goto (lr1-goto-for-symbol specification states non-terminal))))
+	       (let ((goto (index-of-goto (lr1-goto-for-symbol specification (elt states statei) non-terminal))))
 		 (when goto
-		   (setf (gethash (list statei non-terminal) goto-table) goto)))))
+		   (setf (gethash (list statei non-terminal) (entries goto-table)) goto)))))
 
-      (loop for i from 0 upto (length states)
+      (loop for i from 0 below (length states)
       	 for state = (elt states i)
       	 do (loop for item in state
       	       ;; action table
 	 while continue
 	 do (destructuring-bind (stack-state stack-token) (car (stack parser))
 	      (declare (ignorable stack-token))
-	      (let ((action (gethash (list stack-state token-symbol) (actions grammar))))
-		(destructuring-bind (op arg) action
+	      (let ((action (gethash (list stack-state token-symbol) (entries (actions grammar)))))
+		(if action
+		    (destructuring-bind (op arg) action
 
-		  (cond ((equal :shift op)
-			 (let ((next-state arg))
-			   (push (list next-state token) (stack parser))
-			   (setf continue nil)
-			   (setf result :continue)))
+		      (cond ((equal :shift op)
+			     (let ((next-state arg))
+			       (push (list next-state token) (stack parser))
+			       (setf continue nil)
+			       (setf result :continue)))
 
-			((equal :reduce op)
-			 ;; NOTE : if there is a semantic action, after the reduction is a good time to call it
-			 (let ((production arg))
-			   (loop for i from 1 to (length (slot-value production 'rhs))
-			      do (pop (stack parser)))
-			   (destructuring-bind (new-stack-state new-stack-token) (car (stack parser))
-			     (declare (ignorable new-stack-token))
-			     (push (list (gethash (list new-stack-state (slot-value production 'rule-name )) (gotos grammar)) 
-					 (slot-value production 'rule-name))
-				   (stack parser)))))
+			    ((equal :reduce op)
+			     ;; NOTE : if there is a semantic action, after the reduction is a good time to call it
+			     (let ((production arg))
+			       (loop for i from 1 to (length (slot-value production 'rhs))
+				  do (pop (stack parser)))
+			       (destructuring-bind (new-stack-state new-stack-token) (car (stack parser))
+				 (declare (ignorable new-stack-token))
+				 (push (list (gethash (list new-stack-state (slot-value production 'rule-name )) (entries (gotos grammar))) 
+					     (slot-value production 'rule-name))
+				       (stack parser)))))
 
-			((equal :accept op)
-			 (setf continue nil)
-			 (setf result :succeeded))
+			    ((equal :accept op)
+			     (setf continue nil)
+			     (setf result :succeeded))
 
-			(t (setf continue nil)
-			   (setf result :failed))))))))))
+			    (t (setf continue nil)
+			       (setf result :failed))))
+		    (progn
+		      (setf continue nil)
+		      (setf result :failed)))))
+	 finally (return result)))))
 
 (defun make-parser (lexer grammar)
-  (make-instance 'lalr1-parser :lexer lexer :grammar grammar))
+  (let ((parser (make-instance 'lalr1-parser :lexer lexer :grammar grammar)))
+    (push (list 0 'start) (stack parser))
+    parser))
 
 (defun get-parse-result (parser)
   (when (stack parser)
 (let ((html-grammar 
        (transform-extended-grammar-to-fundamental `(( tag-name  (identifier) )
 
-						    ( attribute-name  (identifier) )
+						    ( attribute-name  (identifier) )						  
 
 						    (integer (digit)
 							     (integer digit))
 						    (numeric-value ( (? (^ plus minus)) integer (? decimal integer)))
 						    (number (numeric-value))
 
+						    (es (? ws))
+
 						    ( quantity-value  (^ number
 									 ( number pct-symbol)
 									 ( number pct)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.