From: Douglas K. <sn...@us...> - 2015-09-02 13:11:20
|
The branch "master" has been updated in SBCL: via f983299d27739025633c983dc008b909bea48637 (commit) from c58ebae96da2710a45b17ed407585f398df52077 (commit) - Log ----------------------------------------------------------------- commit f983299d27739025633c983dc008b909bea48637 Author: Douglas Katzman <do...@go...> Date: Wed Sep 2 08:55:12 2015 -0400 Really eliminate style warning about FORMAT-ERROR being unknown. Previous way didn't work when building the cross-compiler. --- build-order.lisp-expr | 7 ++++- src/code/condition-boot.lisp | 3 +- src/code/format-directive.lisp | 51 ++++++++++++++++++++++++++++++++++++++++ src/code/late-format.lisp | 41 -------------------------------- 4 files changed, 58 insertions(+), 44 deletions(-) diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 9865c2a..972208e 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -284,7 +284,6 @@ ("src/code/stream" :not-host) ("src/code/print" :not-host) ("src/code/early-format") - ("src/code/target-format" :not-host) ("src/code/defpackage" :not-host) ("src/code/error-error" :not-host) ; needs WITH-STANDARD-IO-SYNTAX macro @@ -372,6 +371,12 @@ ("src/code/early-condition") ("src/code/condition" :not-host) ("src/code/parse-defmacro-errors") + ("src/code/format-directive") + ;; Target-only stuff should usually be compiled late unless it has + ;; compile-time side-effects. This file could probably be later, + ;; but should certainly be no earlier than the definitions + ;; of FORMAT-ERROR and FORMAT-DIRECTIVE. + ("src/code/target-format" :not-host) ("src/compiler/generic/primtype") diff --git a/src/code/condition-boot.lisp b/src/code/condition-boot.lisp index 2c89dd7..a342774 100644 --- a/src/code/condition-boot.lisp +++ b/src/code/condition-boot.lisp @@ -48,5 +48,4 @@ (def sb!di:debug-condition (serious-condition) condition serious-condition) (def stream-error (error) condition serious-condition error) (def reference-condition (condition) condition) - (def sb!format:format-error (error reference-condition) - condition reference-condition serious-condition error)) + ) diff --git a/src/code/format-directive.lisp b/src/code/format-directive.lisp new file mode 100644 index 0000000..cddf71e --- /dev/null +++ b/src/code/format-directive.lisp @@ -0,0 +1,51 @@ +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(in-package "SB!FORMAT") + +(define-condition format-error (error reference-condition) + ((complaint :reader format-error-complaint :initarg :complaint) + (args :reader format-error-args :initarg :args :initform nil) + (control-string :reader format-error-control-string + :initarg :control-string + :initform *default-format-error-control-string*) + (offset :reader format-error-offset :initarg :offset + :initform *default-format-error-offset*) + (second-relative :reader format-error-second-relative + :initarg :second-relative :initform nil) + (print-banner :reader format-error-print-banner :initarg :print-banner + :initform t)) + (:report %print-format-error) + (:default-initargs :references nil)) + +(defun %print-format-error (condition stream) + (format stream + "~:[~*~;error in ~S: ~]~?~@[~% ~A~% ~V@T^~@[~V@T^~]~]" + (format-error-print-banner condition) + 'format + (format-error-complaint condition) + (format-error-args condition) + (format-error-control-string condition) + (format-error-offset condition) + (format-error-second-relative condition))) + +(defstruct format-directive + (string (missing-arg) :type simple-string) + (start (missing-arg) :type (and unsigned-byte fixnum)) + (end (missing-arg) :type (and unsigned-byte fixnum)) + (character (missing-arg) :type character) + (colonp nil :type (member t nil)) + (atsignp nil :type (member t nil)) + (params nil :type list)) +(defmethod print-object ((x format-directive) stream) + (print-unreadable-object (x stream) + (write-string (format-directive-string x) + stream + :start (format-directive-start x) + :end (format-directive-end x)))) diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp index 82b13f0..aa2c334 100644 --- a/src/code/late-format.lisp +++ b/src/code/late-format.lisp @@ -8,48 +8,7 @@ ;;;; files for more information. (in-package "SB!FORMAT") - -(define-condition format-error (error reference-condition) - ((complaint :reader format-error-complaint :initarg :complaint) - (args :reader format-error-args :initarg :args :initform nil) - (control-string :reader format-error-control-string - :initarg :control-string - :initform *default-format-error-control-string*) - (offset :reader format-error-offset :initarg :offset - :initform *default-format-error-offset*) - (second-relative :reader format-error-second-relative - :initarg :second-relative :initform nil) - (print-banner :reader format-error-print-banner :initarg :print-banner - :initform t)) - (:report %print-format-error) - (:default-initargs :references nil)) -(defun %print-format-error (condition stream) - (format stream - "~:[~*~;error in ~S: ~]~?~@[~% ~A~% ~V@T^~@[~V@T^~]~]" - (format-error-print-banner condition) - 'format - (format-error-complaint condition) - (format-error-args condition) - (format-error-control-string condition) - (format-error-offset condition) - (format-error-second-relative condition))) - -(def!struct format-directive - (string (missing-arg) :type simple-string) - (start (missing-arg) :type (and unsigned-byte fixnum)) - (end (missing-arg) :type (and unsigned-byte fixnum)) - (character (missing-arg) :type character) - (colonp nil :type (member t nil)) - (atsignp nil :type (member t nil)) - (params nil :type list)) -(def!method print-object ((x format-directive) stream) - (print-unreadable-object (x stream) - (write-string (format-directive-string x) - stream - :start (format-directive-start x) - :end (format-directive-end x)))) - ;;;; TOKENIZE-CONTROL-STRING (defun tokenize-control-string (string) ----------------------------------------------------------------------- hooks/post-receive -- SBCL |