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

[Robert Strandh]

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

Modified Files:
	syntax.lisp 
Log Message:
More performance improvements.  The most common case of adding an item
to a parser state was during prediction when an item was derived from
a rule.  We now use a bitvector in each state that indicates what
rules have been used in prediction.  This avoids scanning the items in
the state for existing item-equal states. 


Date: Sat Apr 16 07:20:29 2005
Author: rstrandh

Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.46 climacs/syntax.lisp:1.47
--- climacs/syntax.lisp:1.46	Fri Apr 15 08:12:27 2005
+++ climacs/syntax.lisp	Sat Apr 16 07:20:29 2005
@@ -204,11 +204,13 @@
 (defclass rule ()
   ((left-hand-side :initarg :left-hand-side :reader left-hand-side)
    (right-hand-side :initarg :right-hand-side :reader right-hand-side)
-   (symbols :initarg :symbols :reader symbols)))
+   (symbols :initarg :symbols :reader symbols)
+   (number)))
 
 (defclass grammar ()
   ((rules :initform nil :accessor rules)
-   (hash :initform (make-hash-table) :accessor hash)))
+   (hash :initform (make-hash-table) :accessor hash)
+   (number-of-rules :initform 0)))
 
 (defmacro grammar-rule ((left-hand-side arrow arglist &body body))
   (declare (ignore arrow))
@@ -259,6 +261,8 @@
 
 (defmethod add-rule (rule (grammar grammar))
   (push rule (rules grammar))
+  (setf (slot-value rule 'number) (slot-value grammar 'number-of-rules))
+  (incf (slot-value grammar 'number-of-rules))
   (clrhash (hash grammar))
   (let (rhs-symbols)
     (dolist (rule (rules grammar))
@@ -348,7 +352,17 @@
 		     :reader incomplete-items)
    (parse-trees :initform (make-hash-table :test #'eq)
 		:reader parse-trees)
-   (last-nonempty-state :initarg :last-nonempty-state :accessor last-nonempty-state)))
+   (last-nonempty-state :initarg :last-nonempty-state :accessor last-nonempty-state)
+   (predicted-rules)))
+
+(defmethod initialize-instance :after ((state parser-state) &rest args)
+  (declare (ignore args))
+  (with-slots (predicted-rules) state
+     (setf predicted-rules
+	   (make-array (slot-value (parser-grammar (parser state))
+				   'number-of-rules)
+		       :element-type 'bit
+		       :initial-element 0))))
 
 (defun map-over-incomplete-items (state fun)
   (maphash (lambda (key incomplete-items)
@@ -385,13 +399,17 @@
 	 (dolist (rule (gethash (aref (symbols (rule item)) (dot-position item))
 				(hash (parser-grammar (parser to-state)))))
 	   (if (functionp (right-hand-side rule))
-	       (handle-incomplete-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)
+	       (let ((predicted-rules (slot-value to-state 'predicted-rules))
+		     (rule-number (slot-value rule 'number)))
+		 (when (zerop (aref predicted-rules rule-number))
+		   (setf (aref predicted-rules rule-number) 1)
+		   (handle-incomplete-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 (derive-and-handle-item item parse-tree to-state to-state)))))