diff --git a/code/buffer-stream.lisp b/code/buffer-stream.lisp index 3dbfe59..0d89d1a 100644 --- a/code/buffer-stream.lisp +++ b/code/buffer-stream.lisp @@ -1,5 +1,17 @@ (cl:in-package #:incrementalist) +(deftype stream-line-designator () + '(or null stream-line-number)) + +(deftype stream-line () + 'simple-string) + +(deftype stream-line-number () + 'alexandria:array-index) + +(deftype stream-item-number () + 'alexandria:array-index) + ;;; A class for presenting a snapshot of the contents of a Cluffer ;;; buffer as a (character input) stream. ;;; @@ -16,28 +28,31 @@ ((%lines :initarg :lines :reader lines) ;; Current position - (%line-number :type (or null alexandria:array-index) - :accessor line-number + (%line-number :type stream-line-designator + :reader line-number + :writer (setf %line-number) :initform nil) (%item-number :type alexandria:array-index :accessor item-number) ;; Cached line information (%line-count :accessor %line-count) - (%line :accessor %line) + (%line :type stream-line + :accessor %line) (%item-count :accessor %item-count)) (:default-initargs :lines (alexandria:required-argument :lines))) (declaim (inline update-lines-cache update-line-cache)) (defun update-lines-cache (stream lines) - (setf (line-number stream) nil ; forces update of `%line', `%item-count' - (%line-count stream) (flx:nb-elements lines))) + (setf (%line-number stream) nil + (%line-count stream) (flx:nb-elements lines))) -(defun update-line-cache (stream lines old-line-number new-line-number) - (unless (eql new-line-number old-line-number) - (let ((line (flx:element* lines new-line-number))) - (setf (%line stream) line - (%item-count stream) (length line))))) +(defun update-line-cache (stream line-number) + (let* ((lines (lines stream)) + (line (flx:element* lines line-number))) + (declare (type stream-line line)) + (setf (%line stream) line + (%item-count stream) (length line)))) (defmethod shared-initialize :after ((instance buffer-stream) (slot-names t) @@ -45,11 +60,13 @@ (when lines-supplied-p (update-lines-cache instance lines))) -(defmethod (setf line-number) :around ((new-value integer) - (object buffer-stream)) +(defmethod (setf line-number) ((new-value t) (object buffer-stream)) (let ((old-value (line-number object))) - (call-next-method) - (update-line-cache object (lines object) old-value new-value))) + (declare (type stream-line-designator old-value)) + (unless (eql new-value old-value) + (setf (%line-number object) new-value) + (update-line-cache object new-value))) + new-value) (defmethod print-object ((object buffer-stream) stream) (print-unreadable-object (object stream :type t :identity t) @@ -63,15 +80,15 @@ (defmethod stream:stream-peek-char ((stream buffer-stream)) (let* ((item-number (item-number stream)) - (end-of-line-p (= item-number (the alexandria:array-index + (end-of-line-p (= item-number (the stream-item-number (%item-count stream))))) - (declare (type alexandria:array-index item-number)) + (declare (type stream-item-number item-number)) (cond ((not end-of-line-p) (let ((line (%line stream))) - (declare (type simple-string line)) + (declare (type stream-line line)) (aref line item-number))) - ((= (the alexandria:array-index (line-number stream)) - (1- (the alexandria:array-index (%line-count stream)))) + ((= (the stream-line-number (line-number stream)) + (1- (the stream-line-number (%line-count stream)))) :eof) (t #\Newline)))) @@ -79,44 +96,53 @@ (defmethod stream:stream-read-char ((stream buffer-stream)) (let* (line-number (item-number (item-number stream)) - (end-of-line-p (= item-number (the alexandria:array-index + (end-of-line-p (= item-number (the stream-item-number (%item-count stream))))) - (declare (type alexandria:array-index item-number)) + (declare (type (or null stream-line-number) line-number) + (type stream-item-number item-number)) (cond ((not end-of-line-p) (prog1 (let ((line (%line stream))) - (declare (type simple-string line)) + (declare (type stream-line line)) (aref line item-number)) (setf (item-number stream) (1+ item-number)))) - ((= (setf line-number (the alexandria:array-index (line-number stream))) - (1- (the alexandria:array-index (%line-count stream)))) + ((= (setf line-number (line-number stream)) + (1- (the stream-line-number (%line-count stream)))) :eof) (t (prog1 #\Newline - (setf (line-number stream) (1+ line-number) ; updates cache - (item-number stream) 0)))))) + (let ((new-line-number (1+ line-number))) + (setf (%line-number stream) new-line-number) + (update-line-cache stream new-line-number) + (setf (item-number stream) 0))))))) (defmethod stream:stream-unread-char ((stream buffer-stream) (char t)) (let* (line-number (item-number (item-number stream)) (beginning-of-line-p (zerop item-number))) + (declare (type (or null stream-line-number) line-number) + (type stream-item-number item-number)) (cond ((not beginning-of-line-p) (setf (item-number stream) (1- item-number))) ((zerop (setf line-number (line-number stream))) (error "Attempt to unread a character at position 0")) (t - (setf (line-number stream) (1- line-number) ; updates cache - (item-number stream) (length (%line stream))))))) + (let ((new-line-number (1- line-number))) + (setf (%line-number stream) new-line-number) + (update-line-cache stream new-line-number) + (setf (item-number stream) (%item-count stream))))))) (defun compute-max-line-width (buffer-stream start-line end-line children) (let ((lines (lines buffer-stream))) (loop with rest = children - for line-number from start-line + for line-number of-type stream-line-number from start-line while (<= line-number end-line) - if (and (not (null rest)) (= line-number (start-line (first rest)))) - maximize (max-line-width (first rest)) + if (and (not (null rest)) (= line-number + (the stream-line-number + (start-line (first rest))))) + maximize (the alexandria:array-index (max-line-width (first rest))) and do (setf line-number (end-line (first rest))) (pop rest) else - maximize (length (flx:element* lines line-number))))) + maximize (length (the stream-line (flx:element* lines line-number))))))