[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Source locate `(... . ,_code_)
From:       stassats via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2022-11-28 22:37:05
Message-ID: 1669675025.196149.17498 () sfp-scm-7 ! v30 ! lw ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  4acecfbea9f122a7af62667b5cd96bdf14ad3a70 (commit)
      from  515a9a6119b7f6e2533e9c44a15038994d10b41a (commit)

- Log -----------------------------------------------------------------
commit 4acecfbea9f122a7af62667b5cd96bdf14ad3a70
Author: Stas Boukarev <stassats@gmail.com>
Date:   Mon Nov 28 02:04:01 2022 +0300

    Source locate `(... . ,_code_)
---
 src/code/list.lisp                  | 10 ----------
 src/code/primordial-extensions.lisp | 10 ++++++++++
 src/compiler/ir1report.lisp         |  5 ++++-
 src/compiler/ir1tran.lisp           |  7 ++++++-
 4 files changed, 20 insertions(+), 12 deletions(-)

diff --git a/src/code/list.lisp b/src/code/list.lisp
index a2813fb87..01264ce89 100644
--- a/src/code/list.lisp
+++ b/src/code/list.lisp
@@ -262,16 +262,6 @@
               (fast-nthcdr (mod n i) r-i))
            (declare (type fixnum i))))))))
 
-;;; For [n]butlast
-(defun dotted-nthcdr (n list)
-  (declare (fixnum n))
-  (do ((i n (1- i))
-       (result list (cdr result)))
-      ((not (plusp i)) result)
-    (declare (type fixnum i))
-    (when (atom result)
-      (return))))
-
 ;;; LAST
 ;;;
 ;;; Transforms in src/compiler/srctran.lisp pick the most specific
diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index f08148384..df45fe1bd 100644
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -314,3 +314,13 @@
 (defmacro defconstant-eqx (symbol expr eqx &optional doc)
   `(defconstant ,symbol (%defconstant-eqx-value ',symbol ,expr ,eqx)
      ,@(when doc (list doc))))
+
+;;; For [n]butlast
+(defun dotted-nthcdr (n list)
+  (declare (fixnum n))
+  (do ((i n (1- i))
+       (result list (cdr result)))
+      ((not (plusp i)) result)
+    (declare (type fixnum i))
+    (when (atom result)
+      (return))))
diff --git a/src/compiler/ir1report.lisp b/src/compiler/ir1report.lisp
index 432cbd6aa..eecea1b00 100644
--- a/src/compiler/ir1report.lisp
+++ b/src/compiler/ir1report.lisp
@@ -217,7 +217,10 @@
                 (when (and (>= (length name) 3) (string= name "DEF" :end1 3))
                   (context (source-form-context form))))))
           (when (null current) (return))
-          (setq form (nth (pop current) form)))
+         (let ((cons (sb-impl::dotted-nthcdr (pop current) form)))
+           (setq form (if (comma-p cons)
+                          (comma-expr cons)
+                          (car cons)))))
 
         (cond ((context)
                (values form (context)))
diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 89c83cf93..3bae1b6f5 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -543,7 +543,10 @@
       (declare (fixnum pos))
       (macrolet ((frob ()
                    `(progn
-                      (when (atom subform) (return))
+                      (when (comma-p subform)
+                        (setf subform (comma-expr subform)))
+                      (when (atom subform)
+                        (return))
                       (let ((fm (car subform)))
                         (when (comma-p fm)
                           (setf fm (comma-expr fm)))
@@ -567,6 +570,8 @@
         (loop
          (frob)
          (frob)
+         (when (comma-p trail)
+           (return))
          (setq trail (cdr trail)))))))
 
 

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL


_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]