close Warning: Can't synchronize with repository "(default)" ("(default)" is not readable or not a Git repository.). Look in the Trac log for more information.

Ticket #104: 0001-Record-source-location-for-define-condition.patch

File 0001-Record-source-location-for-define-condition.patch, 3.2 KB (added by Helmut Eller, 10 years ago)

  • new file src/bootfiles/20e/boot-2014-08-class-srcloc.lisp 

    From 5b837ff599b3760ee5f17b9fcf4622b7cb84c682 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Thu, 31 Jul 2014 16:43:45 +0200
Subject: [PATCH] Record source location for define-condition.

* compiler/globaldb.lisp: New info-type source-location/class.  As
class names can theoretically also be variable names it seemed
reasonable to introduce this instead of using the existing
source-location/defvar.

* code/error.lisp (%compiler-define-condition): Take
source-location as argument and store it in the infodb.
(define-condition): Pass source-location along.

* bootfiles/20e/boot-2014-08-class-srcloc.lisp: New bootfile needed
because error.lisp is compiled before globaldb.lisp.
---
 src/bootfiles/20e/boot-2014-08-class-srcloc.lisp |    4 ++++
 src/code/error.lisp                              |    9 ++++++---
 src/compiler/globaldb.lisp                       |    4 ++++
 3 files changed, 14 insertions(+), 3 deletions(-)
 create mode 100644 src/bootfiles/20e/boot-2014-08-class-srcloc.lisp

diff --git src/bootfiles/20e/boot-2014-08-class-srcloc.lisp src/bootfiles/20e/boot-2014-08-class-srcloc.lisp
new file mode 100644
index 0000000..8b1dca5
    - +  
     1;; Define source-location/class info type so that code/error.lisp can
     2;; be compiled.
     3(in-package c)
     4(define-info-type source-location class (or form-numbers null) nil)

  • src/code/error.lisp 

    diff --git src/code/error.lisp src/code/error.lisp
index 3fc7f81..ee44212 100644
     
    597597;;;; DEFINE-CONDITION
    598598
    599599(eval-when (compile load eval)
    600 (defun %compiler-define-condition (name direct-supers layout)
     600(defun %compiler-define-condition (name direct-supers layout source-location)
    601601  (multiple-value-bind (class old-layout)
    602602                       (insured-find-class name #'condition-class-p
    603603                                           #'make-condition-class)
    … …  
    625625    ;; Initialize CPL slot.
    626626    (setf (condition-class-cpl class)
    627627          (remove-if-not #'condition-class-p
    628                          (std-compute-class-precedence-list class))))
     628                         (std-compute-class-precedence-list class)))
     629
     630    (setf (info :source-location :class name) source-location))
    629631  (undefined-value))
    630632
    631633); eval-when (compile load eval)
    … …  
    872874
    873875      `(progn
    874876         (eval-when (compile load eval)
    875            (%compiler-define-condition ',name ',parent-types ',layout))
     877           (%compiler-define-condition ',name ',parent-types ',layout
     878                                       (c::source-location)))
    876879
    877880         (declaim (ftype (function (t) t) ,@(all-readers)))
    878881         (declaim (ftype (function (t t) t) ,@(all-writers)))

  • src/compiler/globaldb.lisp 

    diff --git src/compiler/globaldb.lisp src/compiler/globaldb.lisp
index ae7b565..8d182c8 100644
     
    11741174;;; location for defstruct and deftype.
    11751175(define-info-class source-location)
    11761176(define-info-type source-location defvar (or form-numbers null) nil)
     1177;; This is used for define-condition.  It could also be used for
     1178;; defclass but PCL classes already have a "definition-source" slot and we
     1179;; store it there.
     1180(define-info-type source-location class (or form-numbers null) nil)
    11771181
    11781182;; The textdomain for the documentation
    11791183(define-info-type function textdomain (or string null) nil)