Add STREAM-LINE-COLUMN method on FORM-TRACKING-STREAM.

As requested by Fare on sbcl-devel.

NEWS

@@ -7,6 +7,8 @@ changes relative to sbcl-1.2.11:
   * bug fix: short form of DEFSETF no longer allows trailing junk.
   * bug fix: DEFINE-MODIFY-MACRO respects the provisions of CLHS 5.1.3
     regarding argument evaluation order. (lp#1452539)
+  * enhancement: The input stream for COMPILE-FILE implements
+    STREAM-LINE-COLUMN.
 
 changes in sbcl-1.2.11 relative to sbcl-1.2.10:
   * enhancement: SET-PPRINT-DISPATCH will warn when given an expression in

package-data-list.lisp-expr

@@ -1278,6 +1278,7 @@ possibly temporarily, because it might be used internally."
                "FORM-TRACKING-STREAM-P"
                "FORM-TRACKING-STREAM-FORM-START-BYTE-POS"
                "FORM-TRACKING-STREAM-FORM-START-CHAR-POS"
+               "LINE/COL-FROM-CHARPOS"
                "INTERN*"
                "WITH-FAST-READ-BYTE"
                "PREPARE-FOR-FAST-READ-CHAR"

src/code/early-extensions.lisp

@@ -1647,7 +1647,7 @@ to :INTERPRET, an interpreter will be used.")
 
 (defun stream-error-position-info (stream &optional position)
   (when (and (not position) (form-tracking-stream-p stream))
-    (let ((line/col (sb!c::line/col-from-charpos stream)))
+    (let ((line/col (line/col-from-charpos stream)))
       (return-from stream-error-position-info
         `((:line ,(car line/col))
           (:column ,(cdr line/col))

src/code/fd-stream.lisp

@@ -220,6 +220,21 @@
   ;; we can note the position at the first "good" character.
   (form-start-byte-pos)
   (form-start-char-pos))
+
+(defun line/col-from-charpos
+    (stream &optional (charpos (ansi-stream-input-char-pos stream)))
+  (let* ((newlines (form-tracking-stream-newlines stream))
+         (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))))
 
 ;;;; CORE OUTPUT FUNCTIONS
 

src/compiler/target-main.lisp

@@ -269,21 +269,6 @@ not STYLE-WARNINGs occur during compilation, and NIL otherwise.
             '(values 0 -1))
         charpos)))
 
-(defun line/col-from-charpos
-    (stream &optional (charpos (sb!impl::ansi-stream-input-char-pos stream)))
-  (let* ((newlines (sb!impl::form-tracking-stream-newlines stream))
-         (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))))
-
 ;; 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.

src/pcl/gray-streams.lisp

@@ -328,6 +328,8 @@
   defined for this function."))
 
 (defgeneric stream-line-column (stream)
+  (:method ((stream sb-int:form-tracking-stream))
+    (cdr (sb-int:line/col-from-charpos stream)))
   #+sb-doc
   (:documentation
    "Return the column number where the next character

tests/compiler-3.impure-cload.lisp

@@ -59,3 +59,17 @@
 (eval-when (:compile-toplevel)
   (let ((stream (sb-c::source-info-stream sb-c::*source-info*)))
     (assert (pathname stream))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (set-dispatch-macro-character
+   #\# #\@
+   (lambda (stream char arg)
+     (declare (ignore char arg) (optimize (speed 0)))
+     ;; return the column where the '#' was
+     `'(,(- (stream-line-column stream) 2)))))
+
+(defun foo-char-macro () (list #@
+                          #@))
+
+(with-test (:name :compile-file-stream-line-column)
+  (assert (equal (foo-char-macro) '((31) (26)))))