--- src/code/cross-io.lisp +++ src/code/cross-io.lisp @@ -42,6 +42,6 @@ (def-stub sb!c::make-form-tracking-stream-observer) (def-stub form-tracking-stream-form-start-char-pos) (def-stub form-tracking-stream-form-start-byte-pos) - (def-stub line/col-from-charpos) + (def-stub form-tracking-stream-line-and-column) (def-stub (setf form-tracking-stream-form-start-char-pos)) (def-stub (setf form-tracking-stream-observer))) --- src/code/fd-stream.lisp +++ src/code/fd-stream.lisp @@ -223,8 +223,10 @@ (:copier nil)) ;; a function which is called for events on this stream. (observer (lambda (x y z) (declare (ignore x y z))) :type function) - ;; A vector of the character position of each #\Newline seen - (newlines (make-array 10 :fill-pointer 0 :adjustable t)) + ;; A vector of the character position of each #\Newline seen. + ;; There is a hypothetical newline at charpos = -1 for the line number = 0. + ;; That is why lines ("traditionally") start with the number 1. + (newlines (make-array 10 :initial-element -1 :fill-pointer 1 :adjustable t)) (last-newline -1 :type index-or-minus-1) ;; Better than reporting that a reader error occurred at a position ;; before any whitespace (or equivalently, a macro producing no value), @@ -232,20 +234,21 @@ (form-start-byte-pos) (form-start-char-pos)) -(defun line/col-from-charpos +(defun form-tracking-stream-line-and-column (stream &optional (charpos (ansi-stream-input-char-pos stream))) (let* ((newlines (form-tracking-stream-newlines stream)) - (index (position charpos newlines :test #'>= :from-end t))) + (index (position charpos newlines :test #'> :from-end t))) ;; Line numbers traditionally begin at 1, columns at 0. (if index - ;; INDEX is 1 less than the number of newlines seen - ;; up to and including this startpos. - ;; e.g. index=0 => 1 newline seen => line=2 - (cons (+ index 2) - ;; 1 char after the newline = column 0 - (- charpos (aref newlines index) 1)) - ;; zero newlines were seen - (cons 1 charpos)))) + ;; INDEX is the number of newlines seen up to this charpos. + ;; e.g. index = 1; 1 newline seen; line = 2. + ;; 1 char after the newline = column 0. + ;; The charpos for the newline character is therefore on + ;; the previous line with the column equal to line-length. + (values (1+ index) (- charpos (aref newlines index) 1)) + ;; Not found. + (values nil nil)))) + ;;;; CORE OUTPUT FUNCTIONS --- src/code/late-extensions.lisp +++ src/code/late-extensions.lisp @@ -316,10 +316,11 @@ (defun stream-error-position-info (stream &optional position) (when (and (not position) (form-tracking-stream-p stream)) - (let ((line/col (line/col-from-charpos stream))) + (multiple-value-bind (line column) + (form-tracking-stream-line-and-column stream) (return-from stream-error-position-info - `((:line ,(car line/col)) - (:column ,(cdr line/col)) + `((:line ,line) + (:column ,column) ,@(let ((position (file-position-or-nil-for-error stream))) ;; FIXME: 1- is technically broken for multi-byte external ;; encodings, albeit bug-compatible with the broken code in --- src/code/target-load.lisp +++ src/code/target-load.lisp @@ -49,13 +49,13 @@ (labels ((condition-herald (c) (declare (ignore c)) ; propagates up (when (form-tracking-stream-p stream) - (let* ((startpos - (form-tracking-stream-form-start-char-pos stream)) - (point (line/col-from-charpos stream startpos))) + (multiple-value-bind (line column) + (form-tracking-stream-line-and-column + stream + (form-tracking-stream-form-start-char-pos stream)) (format *error-output* "~&While evaluating the form ~ - starting at line ~D, column ~D~% of ~S:" - (car point) (cdr point) - (or pathname stream))))) + starting at line ~D, column ~D~% of ~S:" + line column (or pathname stream))))) (eval-form (form index) (with-simple-restart (continue "Ignore error and continue ~A file ~S." context native) --- src/compiler/main.lisp +++ src/compiler/main.lisp @@ -939,10 +939,10 @@ (form-tracking-stream-form-start-byte-pos stream)) pos) :line/col - (and (form-tracking-stream-p stream) - (line/col-from-charpos - stream - (form-tracking-stream-form-start-char-pos stream))) + (multiple-value-list + (and (form-tracking-stream-p stream) + (form-tracking-stream-line-and-column + stream (form-tracking-stream-form-start-char-pos stream)))) :stream stream))))) (unless (eq form stream) ; not EOF (funcall function form --- src/compiler/target-main.lisp +++ src/compiler/target-main.lisp @@ -219,67 +219,17 @@ ;; measurement unit. The standard allows counting in something other than ;; characters (namely bytes) for character streams, which is basically ;; irrelevant here, as we don't need random access to the file. - (compute-compile-file-position this-form nil)) + (values (compute-compile-file-position this-form))) (defmacro compile-file-line (&whole this-form) #!+sb-doc "Return line# and column# of this macro invocation as multiple values." - (compute-compile-file-position this-form t)) + (multiple-value-bind (line column) + (compute-compile-line-and-column this-form) + `(values ,(or line 0) ,(or column -1)))) ) -(defun compute-compile-file-position (this-form as-line/col-p) - (let (file-info stream charpos) - (flet ((find-form-eq (form &optional fallback-path) - (with-array-data ((vect (file-info-subforms file-info)) - (start) (end) :check-fill-pointer t) - (declare (ignore start)) - (do ((i (1- end) (- i 3))) - ((< i 0)) - (declare (index-or-minus-1 i)) - (when (eq form (svref vect i)) - (if charpos ; ambiguous - (return - (setq charpos - (and fallback-path - (compile-file-position-helper - file-info fallback-path)))) - (setq charpos (svref vect (- i 2))))))))) - (let ((source-info *source-info*)) - (when (and source-info (boundp '*current-path*)) - (setq file-info (source-info-file-info source-info) - stream (source-info-stream source-info)) - (cond - ((not *current-path*) - ;; probably a read-time eval - (find-form-eq this-form)) - ;; Hmm, would a &WHOLE argument would work better or worse in general? - (t - (let* ((original-source-path - (cddr (member 'original-source-start *current-path*))) - (path (reverse original-source-path))) - (when (file-info-subforms file-info) - (let ((form (elt (file-info-forms file-info) (car path)))) - (dolist (p (cdr path)) - (setq form (nth p form))) - (find-form-eq form (cdr path)))) - (unless charpos - (let ((parent (source-info-parent *source-info*))) - ;; probably in a local macro executing COMPILE-FILE-POSITION, - ;; not producing a sexpr containing an invocation of C-F-P. - (when parent - (setq file-info (source-info-file-info parent) - stream (source-info-stream parent)) - (find-form-eq this-form)))))))))) - (if as-line/col-p - (if (and charpos (form-tracking-stream-p stream)) - (let ((line/col (line/col-from-charpos stream charpos))) - `(values ,(car line/col) ,(cdr line/col))) - '(values 0 -1)) - charpos))) - -;; Find FORM's character position in FILE-INFO by looking for PATH-TO-FIND. -;; This is done by imparting tree structure to the annotations -;; more-or-less paralleling construction of the original sexpr. +;; Find FORM's character position in FILE-INFO by looking for SOURCE-PATH. ;; Unfortunately, though this was a nice idea, it is not terribly useful. ;; FIND-SOURCE-PATHS can not supply the correct path because it assumes ;; that a form determines a path, whereas the opposite is more accurate. @@ -298,49 +248,131 @@ ;; However, if you _could_ supply correct paths, this would compute correct ;; answers. (Modulo any bugs due to near-total lack of testing) -(defun compile-file-position-helper (file-info path-to-find) - (let (found-form start-char) - (labels - ((recurse (subpath upper-bound queue) - (let ((index -1)) - (declare (type index-or-minus-1 index)) - (loop - (let* ((item (car queue)) - (end (cdar item))) - (when (> end upper-bound) - (return)) - (pop queue) - (incf index) - (when (and (eql index (car subpath)) (not (cdr subpath))) - ;; This does not eagerly declare victory, because we want - ;; to find the rightmost match. In "#1=(FOO)" there are two - ;; different annotations pointing to (FOO). - (setq found-form (cdr item) - start-char (caar item))) - (unless queue (return)) - (let* ((next (car queue)) - (next-end (cdar next))) - (cond ((< next-end end) ; could descend - ;; only scan children if we're on the correct path - (if (eql index (car subpath)) - (setf queue (recurse (cdr subpath) end queue)) - ;; else skip quickly by finding the next sibling - (loop - (pop queue) - (when (or (endp queue) (>= (caaar queue) end)) - (return)))) - (unless queue (return))) - ((= next-end end) ; probably because of "#n=" - (decf (truly-the (integer 0) index)))))))) - queue)) - (let ((list - (with-array-data ((v (file-info-subforms file-info)) - (start) (end) :check-fill-pointer t) - (declare (ignore start)) - (sort (loop for i from 0 below end by 3 - collect (acons (aref v i) - (aref v (+ i 1)) - (aref v (+ i 2)))) - #'< :key 'caar)))) - (recurse path-to-find (cdaar list) (cdr list)))) - start-char)) +(defun find-form-character-position (file-info search-form + &optional tlf-number form-path) + ;; Look for the character position for the SEARCH-FORM using FILE-INFO. + ;; FORM-PATH is used to narrow the position for search. + ;; Returns the start and end position if found. + (unless (vectorp (file-info-subforms file-info)) + (return-from find-form-character-position (values nil nil))) + (with-array-data ((vect (file-info-subforms file-info)) + (vstart) (vend) :check-fill-pointer t) + (let (range-start range-end + start-pos end-pos + some-start-pos some-end-pos + parent-form) + ;; Determine the search- and the parent-form. + (when (and form-path tlf-number + (< tlf-number (length (file-info-forms file-info)))) + (setf parent-form (aref (file-info-forms file-info) tlf-number)) + (unless search-form + ;; If no search-form was supplied, derive it from the path. + (setf search-form parent-form) + (dolist (i form-path) + (unless (< i (length search-form)) (return)) + (setf search-form (nth i search-form))))) + ;; + ;; The subforms vector contains only file positions + ;; read for the current top-level form. + ;; The search would be more successful if we did not reset the + ;; subforms vector for each tlf. + ;; + ;; Seaching for the position of forms from another TLF inclusive + ;; from macros or macrogenerated forms in another file + ;; will give no correct result. + ;; + ;; In the subforms vector, a parent form is preceeded by all + ;; of the sub-forms read to make it. + ;; Thus searching for the search-form from the end of the vector, + ;; we encounter all the (grand-)parent forms of the search-form first. + ;; This allows us to derive the limit for the range start. + (do ((i (1- vend) (- i 3))) + ((<= i vstart) + ;; or best guess. + (values (or some-start-pos range-start) + (or some-end-pos range-end))) + (declare (index-or-minus-1 i)) + (let ((this-form (svref vect i)) + (info-start (svref vect (- i 2))) + (info-end (svref vect (- i 1)))) + (cond + ((eq this-form search-form) + ;; When the searched form is found and + ;; the form-path is NIL the from's position is returned. + ;; When the searched from is found and we reach + ;; the range-start, the position is also returned. + ;; If a position is not found above the range-start, + ;; the search continues below it. + (setf start-pos info-start + end-pos info-end) + (when (null form-path) + (return (values start-pos end-pos)))) + ((and form-path (eq this-form parent-form)) + ;; Each time the parent-form is found, + ;; it is used to narrow down the range. + ;; The form-path is used to descend on the parent-form + ;; If the searched form was found above, + ;; the previous search form's position is invalidated. + ;; If the search gets below range-start, + ;; the form-path is set to NIL and the parent-form is ignored. + (setf + range-start info-start + range-end info-end + ;; Descent in the form-path. + parent-form (and (< (car form-path) (length parent-form)) + (nth (car form-path) parent-form)) + form-path (and parent-form (cdr form-path)) + ;; Keep the last found position as a best guess. + some-start-pos (or start-pos some-start-pos) + some-end-pos (or end-pos some-end-pos) + ;; Invalidate previous find if any. + start-pos nil + end-pos nil))) + + (cond + ;; Are we still searching within the parent form range? + ((or (not range-start) (< range-start info-end))) + ;; If not and we have found the search-form, we are done. + (start-pos + (return (values start-pos end-pos))) + ;; We are out of range, the parent-form is of no use anymore. + (form-path + (setf form-path nil)))))))) + +(defun compute-compile-file-position (this-form) + (let* ((source-info *source-info*) + (source-path + (or + (and (boundp '*current-path*) *current-path*) + (and (boundp '*source-paths*) (get-source-path this-form)))) + (form-path + ;; The source-path contains + ;; `(original-source-start ,form-number ,@actual-source-path) + (reverse + (cddr (member 'original-source-start source-path)))) + (tlf-number (pop form-path)) + file-info stream start-pos end-pos) + (when (and source-info (boundp '*current-path*)) + (setq file-info (source-info-file-info source-info) + stream (source-info-stream source-info)) + (multiple-value-setq (start-pos end-pos) + (find-form-character-position + file-info this-form tlf-number form-path)) + + (unless start-pos + (let ((parent (source-info-parent *source-info*))) + (when parent + (setf stream (source-info-stream parent)) + (multiple-value-setq (start-pos end-pos) + (find-form-character-position + (source-info-file-info parent) this-form + tlf-number form-path)))))) + (values start-pos end-pos stream))) + +(defun compute-compile-line-and-column (&optional this-form) + (multiple-value-bind (start-pos end-pos stream) + (compute-compile-file-position this-form) + (declare (ignore end-pos)) + (if (and start-pos (form-tracking-stream-p stream)) + (form-tracking-stream-line-and-column stream start-pos) + (values nil nil)))) --- src/pcl/gray-streams.lisp +++ src/pcl/gray-streams.lisp @@ -307,7 +307,7 @@ (defgeneric stream-line-column (stream) (:method ((stream sb-int:form-tracking-stream)) - (cdr (sb-int:line/col-from-charpos stream))) + (nth-value 1 (sb-int:form-tracking-stream-line-and-column stream))) #+sb-doc (:documentation "Return the column number where the next character --- package-data-list.lisp-expr +++ package-data-list.lisp-expr @@ -1331,7 +1331,7 @@ "FORM-TRACKING-STREAM-P" "FORM-TRACKING-STREAM-FORM-START-BYTE-POS" "FORM-TRACKING-STREAM-FORM-START-CHAR-POS" - "LINE/COL-FROM-CHARPOS" + "FORM-TRACKING-STREAM-LINE-AND-COLUMN" "%INTERN" "WITH-FAST-READ-BYTE" "PREPARE-FOR-FAST-READ-CHAR"