1. Phil Hargett
  2. HH-Parse


Phil Hargett  committed b90ebfa

Although unwieldy, the html grammar is sort of working--can parse first token successfully

  • Participants
  • Parent commits 7910e94
  • Branches parsing

Comments (0)

Files changed (2)

File grammar.lisp

View file
  • Ignore whitespace
 			     collect (transform-term term))))))
     (if (listp new-rhs) new-rhs (list new-rhs)))) ;; make sure it's always a list
-(defun transform-for-nil (grammar)
+(defun transform-for-nil (start-rule-name grammar)
   "Transform the grammar as needed to remove all occurrences of nil"
   (let ((nilable ())
 	(transforming nil)
 					  collect term)
-	     (remove-unused-rules (grammar)
+	     (remove-unused-rules (start-rule-name grammar)
 	       "After all of the :nil substitutions have been made, it is reasonable that some rules
                 may no longer be used anywhere; let's just drop them, to simplify table development"
+	       ;; TODO gotta pass in the start rule, otherwise it gets removed also!
 	       (loop for rule in grammar
-		    if (loop for any-rule in grammar
+		  if (or (equal (car rule) start-rule-name)
+			 (loop for any-rule in grammar
 			    with used = nil
 			    do (loop for any-rhs in (cdr any-rule)
-				    if (member (car rule) any-rhs :test #'equal)
-				    do (setf used t))
+				  if (member (car rule) any-rhs :test #'equal)
+				  do (setf used t))
 			    until used
-			    finally (return used))
-		    collect rule)))
+			    finally (return used)))
+		  collect rule)))
       (loop ;; for i from 1 to 10
       	 do (setf transforming nil)
       	 do (progn
 	      (compute-nilable-terms new-grammar))
       	 while transforming)
-      (setf new-grammar (remove-unused-rules new-grammar))
+      (setf new-grammar (remove-unused-rules start-rule-name new-grammar))
-(defun transform-extended-grammar-to-fundamental (grammar) 
-  (transform-for-nil
-   (let ((*new-rules* nil))
-     (append (for-each-rhs grammar
-			   #'(lambda (rhs)		      
-			       (transform-rhs (if (listp rhs) rhs (list rhs)))))
-	     *new-rules*))))
+(defun transform-extended-grammar-to-fundamental (start-rule-name grammar ) 
+  (transform-for-nil start-rule-name
+		     (let ((*new-rules* nil))
+		       (append (for-each-rhs grammar
+					     #'(lambda (rhs)		      
+						 (transform-rhs (if (listp rhs) rhs (list rhs)))))
+			       *new-rules*))))
 ;; ---------------------------------------------------------------------------------------------------------------------
 ;; LALR(1) grammar construction
     (labels ((shifting-p (item)
 	       (let* ((rhs (slot-value (slot-value item 'production) 'rhs))
 		     (length (length rhs)))
-		 (loop for position from (slot-value item 'position) below length
-		    for shifting = (not (equal :nil (elt rhs position)))
-		    until shifting
-		    finally (return shifting))))
+		 (< (slot-value item 'position) length)))
 	     (index-of-goto (goto)
 	       (position goto states :test #'equal-items))

File samples.lisp

View file
  • Ignore whitespace
 ;; ---------------------------------------------------------------------------------------------------------------------
 ;; Sample grammars
-(let ((grammar-419 (transform-extended-grammar-to-fundamental `((S (^ (:i E :t S SP) :a))
+(let ((grammar-419 (transform-extended-grammar-to-fundamental 'S
+							      `((S (^ (:i E :t S SP) :a))
 								(SP (:e (? S)))
 								(E (:b))))))
   (defun grammar-419 ()
-(let ((grammar-420 (transform-extended-grammar-to-fundamental `(
+(let ((grammar-420 (transform-extended-grammar-to-fundamental 'start
+							      `(
 								(start (s))
 								(s (l eq r)
   (defun grammar-420 ()
-(let ((numbers-grammar (transform-extended-grammar-to-fundamental `(
+(let ((numbers-grammar (transform-extended-grammar-to-fundamental 'number 
+								  `(
 								    ;; literals are digits, decimal, plus, minus
 								    (integer (digit)
 									     (integer digit))
 (let ((html-grammar 
-       (transform-extended-grammar-to-fundamental `(( tag-name  (identifier) )
+       (transform-extended-grammar-to-fundamental 'document 
+						  `(( tag-name  (identifier) )
 						    ( attribute-name  (identifier) )						  
 						    (integer (digit)
 							       (* (^ tag html-text))
-						    (document (tag))))))
+						    (document (tag :eof))))))
   (defun html-grammar ()