1. Phil Hargett
  2. HH-Parse

Commits

Phil Hargett  committed 39aadc5

Small refactorings of parser code in preparation for a possible tokenizer variation

  • Participants
  • Parent commits fb3b71e
  • Branches default

Comments (0)

Files changed (4)

File generics.lisp

View file
  • Ignore whitespace
 ;;
 ;; =====================================================================================================================
 
-(defgeneric parse-code (parser)
+(defgeneric parse-input (parser)
   )
 
 (defgeneric parse-result (parser)
   )
 
+(defgeneric parse-results-valid-p ( parser ) 
+  )
+
+(defgeneric parser-completed-p (parser)
+  (:documentation "Return true if parser has finished it's work (successfully or note).  This typically happens at end
+   of input, or if all of its threads have completed, but can vary by implementation")
+  )
+
 (defgeneric start-thread (parser node &optional base-thread)
   )
 
 (defgeneric return-from-node (parser thread value)
   )
 
+(defgeneric return-value-to-parser (parser thread value)
+  )
+
 (defgeneric abort-thread (parser thread)
   )
 

File parser.lisp

View file
  • Ignore whitespace
 	 (parser (make-instance 'parser :code code :stop stop) )
 	 )
     (start-thread parser top-node)
-    (parse-code parser)
+    (parse-input parser)
     )
   )
 
-(defmethod parse-code ( (parser parser) )
+(defmethod parse-input ( (parser parser) )
   (when (slot-boundp parser 'position)
     (setf (parse-position (code parser) ) (position-of parser) )
     )
-  (loop while (threads-of parser)
-     until (and (stop-position-of parser)
-		(positions-equal (parse-position (code parser) )
-				 (stop-position-of parser)
-				 )
-	       )
+  (loop until (parse-completed-p parser)
      do (trace-parser "P: ~s~%" parser)
      do (progn
 	  ;; get ready for character
 		  )
 	       )
 	  )
-     finally (return (values (parse-result parser) parser) )
+     finally (return (values (when (parse-results-valid-p parser) 
+			       (parse-result parser)
+			       )
+			     parser
+			     )
+		     )
        )
   )
 
+(defmethod parse-completed-p ( (parser parser) )
+  (or (null (threads-of parser))
+      (and (stop-position-of parser)
+	   (positions-equal (parse-position (code parser) )
+			    (stop-position-of parser)
+			    )
+	   )
+      )
+  )
+
 (defmethod parse-result ( (parser parser) )
-  (if (and (end-p parser) (results-of parser) (last-token-read-successfully parser) )
-      (let (
-	    (results (results-of parser))
-	    )
-	(if (> (length results) 1)
-	    results
-	    (car results)
-	    )
+  (let (
+	(results (results-of parser))
 	)
-      (progn
-	(trace-parser "Parser state: ~a~%" parser)
-	nil
+    (if (> (length results) 1)
+	results
+	(car results)
 	)
-      )
+    )
+  )
+
+(defmethod parse-results-valid-p ( (parser parser) )
+  (and (end-p parser) (results-of parser) (last-token-read-successfully parser) )
   )
 
 (defmethod start-thread (parser node &optional (base-thread nil) )
 	)
   (pop (stack-of thread) )
   (when (null (stack-of thread) )
-    ;; It's possible we do not want this check for empty value,
-    ;; because that implies that grammars that allow empty input
-    ;; should still succeed--but that seems like an uninteresting
-    ;; set to support
-    (if (and (end-p parser) value (not (empty-node-p value) ) )
-	;; succeeded
-	;; hmmm....note that an empty-node is a failure
-	(progn
-	  (setf (status-of thread) :succeeded)
-	  ;; several threads may result in the same solution; let's weed those out here
-	  (unless (member value (results-of parser) :test #'node-equal)
-	    (setf (results-of parser)
-		  (append (results-of parser)
-			  (list value)
-			  )
-		  )
-	    )
-	  )
-	;; failed
-	(setf (status-of thread) :failed)
-	)
+    (return-value-to-parser parser thread value)
     (setf (threads-of parser) (delete thread (threads-of parser)) )
     (trace-parser "#~a: thread exited with result ~a (~a threads remaining)~%" 
 		  (id-of thread)
     )
   )
 
+(defmethod return-value-to-parser (parser thread value)
+  ;; It's possible we do not want this check for empty value,
+  ;; because that implies that grammars that allow empty input
+  ;; should still succeed--but that seems like an uninteresting
+  ;; set to support
+  (if (and (end-p parser) value (not (empty-node-p value) ) )
+      ;; succeeded
+      ;; hmmm....note that an empty-node is a failure
+      (progn
+	(setf (status-of thread) :succeeded)
+	;; several threads may result in the same solution; let's weed those out here
+	(unless (member value (results-of parser) :test #'node-equal)
+	  (setf (results-of parser)
+		(append (results-of parser)
+			(list value)
+			)
+		)
+	  )
+	)
+      ;; failed
+      (setf (status-of thread) :failed)
+      )
+  )
+
 (defmethod abort-thread ( (parser parser) (thread parse-thread) )
   (setf (status-of thread) :failed)
   (setf (threads-of parser) (delete thread (threads-of parser)) )

File source.lisp

View file
  • Ignore whitespace
 					;; stop at beginning of next line
 					(make-instance 'source-code-position :line (+ 1 line) :column 0)
 					)
-				  (multiple-value-bind (results changed-parser) (parse-code new-parser)
+				  (multiple-value-bind (results changed-parser) (parse-input new-parser)
 				    (declare (ignorable results) )
 				    (setf (parser-of line) changed-parser)
 				    )

File tests.lisp

View file
  • Ignore whitespace
 	(setf (hh-parse::stop-position-of new-parser) nil)
 	(setf (hh-parse::code new-parser) is)
 	(assert-true (node-equal (lit "foobar")
-				 (hh-parse::parse-code new-parser)
+				 (hh-parse::parse-input new-parser)
 				 )
 		     )
 	(setf (hh-parse::stop-position-of parser) nil)
 	(assert-true (node-equal (lit "foobar")
-				 (hh-parse::parse-code parser)
+				 (hh-parse::parse-input parser)
 				 )
 		     )
 	)
 	(setf (hh-parse::stop-position-of new-parser) nil)
 	(setf (hh-parse::code new-parser) is)
 	(assert-true (node-equal (lit "foobar")
-				 (hh-parse::parse-code new-parser)
+				 (hh-parse::parse-input new-parser)
 				 )
 		     )
 	(setf (hh-parse::stop-position-of parser) nil)
 	(assert-true (node-equal (lit "foobar")
-				 (hh-parse::parse-code parser)
+				 (hh-parse::parse-input parser)
 				 )
 		     )
 	)
 	(setf (hh-parse::stop-position-of new-parser) nil)
 	(setf (hh-parse::code new-parser) is)
 	(assert-true (node-equal (lit "foobar")
-				 (hh-parse::parse-code new-parser)
+				 (hh-parse::parse-input new-parser)
 				 )
 		     )
 	(setf (hh-parse::stop-position-of parser) nil)
 	(assert-true (node-equal (lit "foobar")
-				 (hh-parse::parse-code parser)
+				 (hh-parse::parse-input parser)
 				 )
 		     )
 	)