By popular demand, rename COMPILE-FILE-POSITION to -LINE

and make COMPILE-FILE-POSITION return character position.

NEWS

@@ -9,10 +9,11 @@ changes relative to sbcl-1.2.10:
     under most circumstances, signal warnings similar to compiling such code.
     The usual caveat holds about not detecting calls through a computed name,
     as in (funcall (intern "DEPRECATED-FUN" "SB-EXT")).
-  * enhancement: (SB-EXT:COMPILE-FILE-POSITION) is a new macro that expands
+  * enhancement: (SB-EXT:COMPILE-FILE-LINE) is a new macro that expands
     to a constant (VALUES integer integer) indicating the source line/column
     from which it was read, intended for logging Lisp runtime errors in
     a style similar to that afforded by the C preprocessor __LINE__ macro.
+    Similarly (SB-EXT:COMPILE-FILE-POSITION) returns a position in characters.
   * enhancement: improved source locations for VOPs, alien types and
     declarations.
   * bug fix: functions in :FINAL deprecation have the correct docstring.

package-data-list.lisp-expr

@@ -652,6 +652,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
                ;; Customizing printing of compiler and debugger messages
                "*COMPILER-PRINT-VARIABLE-ALIST*"
                "*DEBUG-PRINT-VARIABLE-ALIST*"
+               "COMPILE-FILE-LINE"
                "COMPILE-FILE-POSITION"
 
                ;; Hooks into init & save sequences

src/compiler/target-main.lisp

@@ -207,12 +207,23 @@ not STYLE-WARNINGs occur during compilation, and NIL otherwise.
 ;; times as there are calls to the function - not very defensible
 ;; as a design choice, but just an accident of the particular implementation.
 ;;
-(let ()
-  (defmacro compile-file-position (&whole this-form)
-    #!+sb-doc
-    "Return line# and column# of this macro invocation as multiple values."
-    (let (file-info charpos)
-      (flet ((find-form-eq (form &optional fallback-path)
+(defmacro compile-file-position (&whole this-form)
+  #!+sb-doc
+  "Return character position of this macro invocation or NIL if unavailable."
+  ;; Counting characters is intuitive because the transfer element size is 1
+  ;; 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))
+
+(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))
+
+(defun compute-compile-file-position (this-form as-line/col-p)
+  (let (file-info 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))
@@ -227,7 +238,7 @@ not STYLE-WARNINGs occur during compilation, and NIL otherwise.
                                       (compile-file-position-helper
                                        file-info fallback-path))))
                          (setq charpos (svref vect (- i 2)))))))))
-        (cond
+      (cond
           ((and *source-info* (boundp '*current-path*) (not *current-path*))
            ;; probably a read-time eval
            (setq file-info (source-info-file-info *source-info*))
@@ -249,11 +260,13 @@ not STYLE-WARNINGs occur during compilation, and NIL otherwise.
                  ;; not producing a sexpr containing an invocation of C-F-P.
                  (when parent
                    (setq file-info (source-info-file-info parent))
-                   (find-form-eq this-form)))))))
+                   (find-form-eq this-form))))))))
+    (if as-line/col-p
         (if charpos
             (let ((line/col (line/col-from-charpos charpos file-info)))
               `(values ,(car line/col) ,(cdr line/col)))
-            '(values 0 -1))))))
+            '(values 0 -1))
+        charpos)))
 
 (defun line/col-from-charpos (charpos file-info)
   (let* ((newlines (file-info-newlines file-info))

tests/compiler-2.impure-cload.lisp

@@ -89,9 +89,9 @@
       (sb-int:info :variable :macro-expansion '%trash%)
     (assert (and (not val) (not foundp)))))
 
-;;; COMPILE-FILE-POSITION
+;;; COMPILE-FILE-LINE and COMPILE-FILE-POSITION
 
-(macrolet ((line () `(multiple-value-call 'cons (compile-file-position))))
+(macrolet ((line () `(multiple-value-call 'cons (compile-file-line))))
   (defun more-foo (x)
     (if x
         (format nil "Great! ~D" (line)) ; <-- this is line 97
@@ -100,7 +100,7 @@
 (declaim (inline thing))
 (defun thing ()
   (format nil "failed to frob a knob at line #~D"
-          (compile-file-position))) ; <-- this is line 103
+          (compile-file-line))) ; <-- this is line 103
 
 (defmacro more-randomness ()
   '(progn
@@ -117,16 +117,16 @@
             (progn (more-randomness))))))) ; <-- this is line 117
 
 (defun compile-file-pos-sharp-dot (x)
-  (list #.(format nil "Foo line ~D" (compile-file-position)) ; line #120
+  (list #.(format nil "Foo line ~D" (compile-file-line)) ; line #120
         x))
 
 (defun compile-file-pos-eval-in-macro ()
   (macrolet ((macro (x)
                (format nil "hi ~A at ~D" x
-                       (compile-file-position)))) ; line #126
+                       (compile-file-line)))) ; line #126
     (macro "there")))
 
-(with-test (:name :compile-file-position)
+(with-test (:name :compile-file-line)
   (assert (string= (more-foo t) "Great! (97 . 32)"))
   (assert (string= (more-foo nil) "Yikes (98 . 31)"))
   (assert (string= (bork t) "failed to frob a knob at line #103"))

tests/data/compile-file-pos.lisp

@@ -0,0 +1,6 @@
+;; This file is encoded in UTF8 xxx.
+;;
+(defun cfp-foolz1 ()
+  (values "Here is a string: םולש"
+          (format nil "Line ~D" (compile-file-line))
+          (format nil "Hey hey! ~D" (compile-file-position))))

tests/octets.pure.lisp

@@ -396,3 +396,31 @@
                              :external-format :utf-32be)))
     (let ((string (map 'string 'code-char '(#xd800 #xdc00 #xfffe #x10ffff))))
       (assert (equalp (enc string) #(0 0 0 63 0 0 0 63 0 0 0 63 0 0 0 63))))))
+
+(with-test (:name :compile-file-position-with-encodings
+            :skipped-on '(not :sb-unicode))
+  (with-open-file (f1 "data/compile-file-pos.lisp" :external-format :utf-8)
+    (with-open-file (f2 "data/compile-file-pos-utf16be.lisp"
+                        :external-format :utf-16be)
+      (dotimes (i 3) ; skip three lines
+        ;; because a comment line differs, and the function names differ
+        (read-line f1)
+        (read-line f2))
+      (dotimes (i 3) ; compare three lines
+        (assert (string= (read-line f1) (read-line f2))))))
+  (flet ((compile-and-load (file encoding main-fun)
+           (let ((fasl (compile-file file
+                                     :external-format encoding
+                                     :print nil :verbose nil)))
+             (load fasl)
+             (delete-file fasl)
+             (funcall main-fun))))
+    (multiple-value-bind (a1 b1 c1)
+        (compile-and-load "data/compile-file-pos.lisp" :utf-8 'cfp-foolz1)
+      (multiple-value-bind (a2 b2 c2)
+          (compile-and-load "data/compile-file-pos-utf16be.lisp" :utf-16be
+                            'cfp-foolz2)
+        (assert (string= a1 a2))
+        (assert (string= b1 b2))
+        ;; COMPILE-FILE-POSITION is insensitive to file encoding.
+        (assert (string= c1 c2))))))