[climacs-cvs] CVS update: climacs/syntax.lisp

[Robert Strandh]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv22978

Modified Files:
	syntax.lisp 
Log Message:
Avoid some more generic function dispatch by calling
potentially-handle-parse-tree directly when we know that it is a
complete item.  Also avoid creating the complete item, thus cutting
down on consing. 


Date: Fri Apr 15 07:22:59 2005
Author: rstrandh

Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.43 climacs/syntax.lisp:1.44
--- climacs/syntax.lisp:1.43	Fri Apr 15 07:02:53 2005
+++ climacs/syntax.lisp	Fri Apr 15 07:22:58 2005
@@ -305,9 +305,7 @@
 (defmethod print-object ((item complete-item) stream)
   (format stream "[~a]" (parse-tree item)))
 
-(defgeneric derive-item (prev-item parse-tree))
-
-(defmethod derive-item ((prev-item incomplete-item) parse-tree)
+(defun derive-item (prev-item parse-tree)
   (let ((remaining (funcall (suffix prev-item) parse-tree)))
     (cond ((null remaining)
 	   nil)
@@ -397,16 +395,15 @@
  	 (push item (gethash orig-state (incomplete-items to-state)))
 	 (dolist (rule (gethash (aref (symbols (rule item)) (dot-position item))
 				(hash (parser-grammar (parser to-state)))))
-	   (handle-item (if (functionp (right-hand-side rule))
-			    (make-instance 'incomplete-item
-					   :orig-state to-state
-					   :predicted-from item
-					   :rule rule
-					   :dot-position 0
-					   :suffix (right-hand-side rule))
-			    (make-instance 'complete-item
-					   :parse-tree (right-hand-side rule)))
-			to-state to-state))
+	   (if (functionp (right-hand-side rule))
+	       (handle-item (make-instance 'incomplete-item
+			       :orig-state to-state
+			       :predicted-from item
+			       :rule rule
+			       :dot-position 0
+			       :suffix (right-hand-side rule))
+			    to-state to-state)
+	       (potentially-handle-parse-tree (right-hand-side rule) to-state to-state)))
 	 (loop for parse-tree in (gethash to-state (parse-trees to-state))
  	       do (let ((new-item (derive-item item parse-tree)))
 		    (when new-item (handle-item new-item to-state to-state)))))))
@@ -423,16 +420,16 @@
 	   do (when (let ((sym (left-hand-side rule)))
 		      (or (subtypep (target parser) sym)
 			  (subtypep sym (target parser))))
-		(handle-item (if (functionp (right-hand-side rule))
-				 (make-instance 'incomplete-item
+		(if (functionp (right-hand-side rule))
+		    (handle-item (make-instance 'incomplete-item
 				    :orig-state initial-state
 				    :predicted-from nil
 				    :rule rule
 				    :dot-position 0
 				    :suffix (right-hand-side rule))
-				 (make-instance 'complete-item
-				    :parse-tree (right-hand-side rule)))
-			     initial-state initial-state)))))
+				 initial-state initial-state)
+		    (potentially-handle-parse-tree
+		     (right-hand-side rule) initial-state initial-state))))))
 
 (defun state-contains-target-p (state)
   (loop with target = (target (parser state))