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

[Robert Strandh]

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

Modified Files:
	cl-syntax.lisp 
Log Message:
Decreased consing by a third, and improved performance at the same
time, by having a single mark and a size instead of two marks in a
stack entry.


Date: Sun Feb 27 07:16:52 2005
Author: rstrandh

Index: climacs/cl-syntax.lisp
diff -u climacs/cl-syntax.lisp:1.2 climacs/cl-syntax.lisp:1.3
--- climacs/cl-syntax.lisp:1.2	Fri Feb 25 08:11:24 2005
+++ climacs/cl-syntax.lisp	Sun Feb 27 07:16:48 2005
@@ -24,9 +24,15 @@
 
 (defclass stack-entry ()
   ((start-mark :initarg :start-mark :reader start-mark)
-   (end-mark :initarg :end-mark :reader end-mark))
+   (size :initarg :size))
   (:documentation "A stack entry corresponds to a syntactic category"))
 
+(defgeneric end-offset (stack-entry))
+
+(defmethod end-offset ((entry stack-entry))
+  (with-slots (start-mark size) entry
+     (+ (offset start-mark) size)))
+
 (defclass error-entry (stack-entry) ())
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -167,14 +173,15 @@
 		    :buffer buffer
 		    :offset 0)))
        (insert* elements 0 (make-instance 'start-entry
-			      :start-mark mark :end-mark mark)))))
+			      :start-mark mark :size 0)))))
 
 (defun next-entry (scan)
   (let ((start-mark (clone-mark scan)))
     (flet ((fo () (forward-object scan)))
       (macrolet ((make-entry (type)
 		   `(return-from next-entry
-		      (make-instance ,type :start-mark start-mark :end-mark (clone-mark scan)))))
+		      (make-instance ,type :start-mark start-mark
+				     :size (- (offset scan) (offset start-mark))))))
 	(loop with object = (object-after scan)
 	      until (end-of-buffer-p scan)
 	      do (case object
@@ -245,12 +252,12 @@
        (when (mark<= low-mark high-mark)
 	 ;; go back to a position before low-mark
 	 (loop until (or (= guess-pos 1)
-			 (mark< (end-mark (element* elements (1- guess-pos))) low-mark))
+			 (mark< (end-offset (element* elements (1- guess-pos))) low-mark))
 	       do (decf guess-pos))
 	 ;; go forward to the last position before low-mark
 	 (loop with nb-elements = (nb-elements elements)
 	       until (or (= guess-pos nb-elements)
-			 (mark>= (end-mark (element* elements guess-pos)) low-mark))
+			 (mark>= (end-offset (element* elements guess-pos)) low-mark))
 	       do (incf guess-pos))
 	 ;; delete entries that must be reparsed
 	 (loop until (or (= guess-pos (nb-elements elements))
@@ -260,7 +267,7 @@
 		       :buffer buffer
 		       :offset (if (zerop guess-pos)
 				   0
-				   (offset (end-mark (element* elements (1- guess-pos)))))))
+				   (end-offset (element* elements (1- guess-pos))))))
 	 ;; scan
 	 (unless (end-of-buffer-p scan)
 	   (loop with start-mark = nil