CMUCL commit: intl-branch src/compiler (13 files)
Raymond Toy
rtoy at common-lisp.net
Thu Feb 25 04:59:44 CET 2010
Date: Wednesday, February 24, 2010 @ 22:59:44
Author: rtoy
Path: /project/cmucl/cvsroot/src/compiler
Tag: intl-branch
Modified: array-tran.lisp checkgen.lisp float-tran.lisp gtn.lisp ir1tran.lisp
ir1util.lisp locall.lisp ltn.lisp proclaim.lisp represent.lisp
seqtran.lisp srctran.lisp typetran.lisp
o Make COMPILER-NOTE do the string lookup instead of at each call
site.
o Change all calls to COMPILER-NOTE to use _N" instead of _".
-----------------+
array-tran.lisp | 4 ++--
checkgen.lisp | 4 ++--
float-tran.lisp | 10 +++++-----
gtn.lisp | 6 +++---
ir1tran.lisp | 16 ++++++++--------
ir1util.lisp | 13 +++++++------
locall.lisp | 8 ++++----
ltn.lisp | 4 ++--
proclaim.lisp | 4 ++--
represent.lisp | 6 +++---
seqtran.lisp | 4 ++--
srctran.lisp | 4 ++--
typetran.lisp | 4 ++--
13 files changed, 44 insertions(+), 43 deletions(-)
Index: src/compiler/array-tran.lisp
diff -u src/compiler/array-tran.lisp:1.43.12.2 src/compiler/array-tran.lisp:1.43.12.3
--- src/compiler/array-tran.lisp:1.43.12.2 Wed Feb 10 12:38:34 2010
+++ src/compiler/array-tran.lisp Wed Feb 24 22:59:43 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/array-tran.lisp,v 1.43.12.2 2010-02-10 17:38:34 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/array-tran.lisp,v 1.43.12.3 2010-02-25 03:59:43 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -327,7 +327,7 @@
default-initial-element))))
(unless (csubtypep (ctype-of default-initial-element)
eltype-type)
- (compiler-note _"Default initial element ~s is not a ~s."
+ (compiler-note _N"Default initial element ~s is not a ~s."
default-initial-element eltype))
constructor)
(t
Index: src/compiler/checkgen.lisp
diff -u src/compiler/checkgen.lisp:1.34.32.2 src/compiler/checkgen.lisp:1.34.32.3
--- src/compiler/checkgen.lisp:1.34.32.2 Thu Feb 11 23:07:26 2010
+++ src/compiler/checkgen.lisp Wed Feb 24 22:59:43 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/checkgen.lisp,v 1.34.32.2 2010-02-12 04:07:26 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/checkgen.lisp,v 1.34.32.3 2010-02-25 03:59:43 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -622,7 +622,7 @@
(*compiler-error-context* context))
(when (policy context (>= safety brevity))
(compiler-note
- "Type assertion too complex to check:~% ~S."
+ _N"Type assertion too complex to check:~% ~S."
(type-specifier (continuation-asserted-type cont)))))
(setf (continuation-%type-check cont) :deleted))))))
Index: src/compiler/float-tran.lisp
diff -u src/compiler/float-tran.lisp:1.136.2.2 src/compiler/float-tran.lisp:1.136.2.3
--- src/compiler/float-tran.lisp:1.136.2.2 Wed Feb 10 19:04:41 2010
+++ src/compiler/float-tran.lisp Wed Feb 24 22:59:43 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/float-tran.lisp,v 1.136.2.2 2010-02-11 00:04:41 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/float-tran.lisp,v 1.136.2.3 2010-02-25 03:59:43 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -731,7 +731,7 @@
'single-float))
(t
(compiler-note
- _"Unable to avoid inline argument range check~@
+ _N"Unable to avoid inline argument range check~@
because the argument range (~s) was not within 2^~D"
(type-specifier (continuation-type x))
limit)
@@ -747,7 +747,7 @@
`(,prim-quick x))
(t
(compiler-note
- _"Unable to avoid inline argument range check~@
+ _N"Unable to avoid inline argument range check~@
because the argument range (~s) was not within 2^~D"
(type-specifier (continuation-type x))
limit)
@@ -873,11 +873,11 @@
;; Check that the ARG bounds are correctly canonicalised.
(when (and arg-lo (floatp arg-lo-val) (zerop arg-lo-val) (consp arg-lo)
(minusp (float-sign arg-lo-val)))
- (compiler-note _"Float zero bound ~s not correctly canonicalised?" arg-lo)
+ (compiler-note _N"Float zero bound ~s not correctly canonicalised?" arg-lo)
(setq arg-lo 0l0 arg-lo-val 0l0))
(when (and arg-hi (zerop arg-hi-val) (floatp arg-hi-val) (consp arg-hi)
(plusp (float-sign arg-hi-val)))
- (compiler-note _"Float zero bound ~s not correctly canonicalised?" arg-hi)
+ (compiler-note _N"Float zero bound ~s not correctly canonicalised?" arg-hi)
(setq arg-hi -0l0 arg-hi-val -0l0))
(flet ((fp-neg-zero-p (f) ; Is F -0.0?
(and (floatp f) (zerop f) (minusp (float-sign f))))
Index: src/compiler/gtn.lisp
diff -u src/compiler/gtn.lisp:1.17.54.2 src/compiler/gtn.lisp:1.17.54.3
--- src/compiler/gtn.lisp:1.17.54.2 Wed Feb 10 19:04:42 2010
+++ src/compiler/gtn.lisp Wed Feb 24 22:59:43 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/gtn.lisp,v 1.17.54.2 2010-02-11 00:04:42 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/gtn.lisp,v 1.17.54.3 2010-02-25 03:59:43 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -160,7 +160,7 @@
(dolist (fun funs
(let ((*compiler-error-context* (lambda-bind (first funs))))
(compiler-note
- _"Return value count mismatch prevents known return ~
+ _N"Return value count mismatch prevents known return ~
from these functions:~
~{~% ~A~}"
(remove nil (mapcar #'leaf-name funs)))))
@@ -173,7 +173,7 @@
(when (eq count :unknown)
(let ((*compiler-error-context* (lambda-bind fun)))
(compiler-note
- _"Return type not fixed values, so can't use known return ~
+ _N"Return type not fixed values, so can't use known return ~
convention:~% ~S"
(type-specifier rtype)))
(return)))))))))
Index: src/compiler/ir1tran.lisp
diff -u src/compiler/ir1tran.lisp:1.173.32.2 src/compiler/ir1tran.lisp:1.173.32.3
--- src/compiler/ir1tran.lisp:1.173.32.2 Wed Feb 10 20:33:01 2010
+++ src/compiler/ir1tran.lisp Wed Feb 24 22:59:43 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/ir1tran.lisp,v 1.173.32.2 2010-02-11 01:33:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/ir1tran.lisp,v 1.173.32.3 2010-02-25 03:59:43 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -815,7 +815,7 @@
(leaf
(when (lambda-var-p var)
(when (lambda-var-ignorep var)
- (compiler-note _"Reading an ignored variable: ~S." name))
+ (compiler-note _N"Reading an ignored variable: ~S." name))
;;
;; FIXME: There's a quirk somewhere when recording this
;; dependency, which I don't have to time to debug right now.
@@ -1205,7 +1205,7 @@
(compiler-error _"Declaring symbol-macro ~S special." name))
(lambda-var
(when (lambda-var-ignorep var)
- (compiler-note _"Ignored variable ~S is being declared special."
+ (compiler-note _N"Ignored variable ~S is being declared special."
name))
(setf (lambda-var-specvar var)
(specvar-for-binding name)))
@@ -1267,7 +1267,7 @@
(etypecase found
(functional
(when (policy nil (>= speed brevity))
- (compiler-note _"Ignoring ~A declaration not at ~
+ (compiler-note _N"Ignoring ~A declaration not at ~
definition of local function:~% ~S"
sense name)))
(global-var
@@ -1309,7 +1309,7 @@
((not var)
(if (or (lexenv-find name variables)
(lexenv-find-function name))
- (compiler-note _"Ignoring free ignore declaration for ~S." name)
+ (compiler-note _N"Ignoring free ignore declaration for ~S." name)
(compiler-warning _"Ignore declaration for unknown variable ~S."
name)))
((and (consp var)
@@ -1325,7 +1325,7 @@
((functional-p var)
(setf (leaf-ever-used var) t))
((lambda-var-specvar var)
- (compiler-note _"Declaring special variable ~S to be ignored." name))
+ (compiler-note _N"Declaring special variable ~S to be ignored." name))
((eq (first spec) 'ignorable)
(setf (leaf-ever-used var) t))
(t
@@ -1396,7 +1396,7 @@
(string= (symbol-name what) "CLASS"))) ; pcl hack
(or (info type kind what)
(and (consp what) (info type translator (car what)))))
- (compiler-note _"Abbreviated type declaration: ~S." spec)
+ (compiler-note _N"Abbreviated type declaration: ~S." spec)
(process-type-declaration spec res vars))
((info declaration recognized what)
res)
@@ -3368,7 +3368,7 @@
(compiler-error _"Attempt to set constant ~S." name))
(when (lambda-var-p leaf)
(when (lambda-var-ignorep leaf)
- (compiler-note _"Setting an ignored variable: ~S." name))
+ (compiler-note _N"Setting an ignored variable: ~S." name))
(note-dfo-dependency start leaf))
(set-variable start cont leaf (second things)))
(cons
Index: src/compiler/ir1util.lisp
diff -u src/compiler/ir1util.lisp:1.110.26.2 src/compiler/ir1util.lisp:1.110.26.3
--- src/compiler/ir1util.lisp:1.110.26.2 Wed Feb 10 20:33:01 2010
+++ src/compiler/ir1util.lisp Wed Feb 24 22:59:43 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/ir1util.lisp,v 1.110.26.2 2010-02-11 01:33:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/ir1util.lisp,v 1.110.26.3 2010-02-25 03:59:43 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -845,7 +845,7 @@
(mark-for-deletion (node-block ref)))
(unless (leaf-ever-used leaf)
(let ((*compiler-error-context* bind))
- (compiler-note _"Deleting unused function~:[.~;~:*~% ~S~]"
+ (compiler-note _N"Deleting unused function~:[.~;~:*~% ~S~]"
(leaf-name leaf))))
(unless (block-delete-p bind-block)
(unlink-blocks (component-head component) bind-block))
@@ -1199,7 +1199,7 @@
(unless (or (leaf-ever-used var)
(lambda-var-ignorep var))
(let ((*compiler-error-context* (lambda-bind fun)))
- (compiler-note _"Variable ~S defined but never used." (leaf-name var)))
+ (compiler-note _N"Variable ~S defined but never used." (leaf-name var)))
(setf (leaf-ever-used var) t)))
(undefined-value))
@@ -1274,7 +1274,7 @@
0)))
(unless (return-p node)
(let ((*compiler-error-context* node))
- (compiler-note _"Deleting unreachable code.")))
+ (compiler-note _N"Deleting unreachable code.")))
(return))))))
(undefined-value))
@@ -1634,7 +1634,7 @@
(cond ((> expanded *inline-expansion-limit*) nil)
((= expanded *inline-expansion-limit*)
(let ((*compiler-error-context* node))
- (compiler-note _"*Inline-Expansion-Limit* (~D) exceeded, ~
+ (compiler-note _N"*Inline-Expansion-Limit* (~D) exceeded, ~
probably trying to~% ~
inline a recursive function."
*inline-expansion-limit*))
@@ -2180,7 +2180,8 @@
(unless (if *compiler-error-context*
(policy *compiler-error-context* (= brevity 3))
(policy nil (= brevity 3)))
- (warn 'simple-style-warning :format-control format-string
+ (warn 'simple-style-warning
+ :format-control (intl::dgettext intl::*default-domain* format-string)
:format-arguments format-args))
(values))
Index: src/compiler/locall.lisp
diff -u src/compiler/locall.lisp:1.60.24.2 src/compiler/locall.lisp:1.60.24.3
--- src/compiler/locall.lisp:1.60.24.2 Wed Feb 10 20:33:01 2010
+++ src/compiler/locall.lisp Wed Feb 24 22:59:43 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/locall.lisp,v 1.60.24.2 2010-02-11 01:33:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/locall.lisp,v 1.60.24.3 2010-02-25 03:59:43 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -342,7 +342,7 @@
res)
(t
(let ((*compiler-error-context* call))
- (compiler-note _"Couldn't inline expand because expansion ~
+ (compiler-note _N"Couldn't inline expand because expansion ~
calls this let-converted local function:~
~% ~S"
(leaf-name res)))
@@ -590,7 +590,7 @@
(let ((cont (first key)))
(unless (constant-continuation-p cont)
(when flame
- (compiler-note _"Non-constant keyword in keyword call."))
+ (compiler-note _N"Non-constant keyword in keyword call."))
(setf (basic-combination-kind call) :error)
(return-from convert-more-call))
@@ -605,7 +605,7 @@
allowp (continuation-value val)))
(t
(when flame
- (compiler-note _"non-constant :ALLOW-OTHER-KEYS value"))
+ (compiler-note _N"non-constant :ALLOW-OTHER-KEYS value"))
(setf (basic-combination-kind call) :error)
(return-from convert-more-call)))))
(dolist (var (key-vars)
Index: src/compiler/ltn.lisp
diff -u src/compiler/ltn.lisp:1.43.36.2 src/compiler/ltn.lisp:1.43.36.3
--- src/compiler/ltn.lisp:1.43.36.2 Wed Feb 10 20:33:01 2010
+++ src/compiler/ltn.lisp Wed Feb 24 22:59:43 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/ltn.lisp,v 1.43.36.2 2010-02-11 01:33:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/ltn.lisp,v 1.43.36.3 2010-02-25 03:59:43 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -275,7 +275,7 @@
(*compiler-error-context* dest))
(when (and (policy-safe-p policy)
(policy dest (>= safety brevity)))
- (compiler-note _"Unable to check type assertion in unknown-values ~
+ (compiler-note _N"Unable to check type assertion in unknown-values ~
context:~% ~S"
(continuation-asserted-type cont))))
(setf (continuation-%type-check cont) :deleted))
Index: src/compiler/proclaim.lisp
diff -u src/compiler/proclaim.lisp:1.44.24.2 src/compiler/proclaim.lisp:1.44.24.3
--- src/compiler/proclaim.lisp:1.44.24.2 Wed Feb 10 21:19:58 2010
+++ src/compiler/proclaim.lisp Wed Feb 24 22:59:43 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/proclaim.lisp,v 1.44.24.2 2010-02-11 02:19:58 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/proclaim.lisp,v 1.44.24.3 2010-02-25 03:59:43 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -135,7 +135,7 @@
(char= (char name 0) #\&))))
(unless (member arg lambda-list-keywords)
(compiler-note
- _"~S uses lambda-list keyword naming convention, but is not a recognized lambda-list keyword."
+ _N"~S uses lambda-list keyword naming convention, but is not a recognized lambda-list keyword."
arg)))
(if (member arg lambda-list-keywords)
(ecase arg
Index: src/compiler/represent.lisp
diff -u src/compiler/represent.lisp:1.38.38.2 src/compiler/represent.lisp:1.38.38.3
--- src/compiler/represent.lisp:1.38.38.2 Wed Feb 10 21:45:32 2010
+++ src/compiler/represent.lisp Wed Feb 24 22:59:43 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/represent.lisp,v 1.38.38.2 2010-02-11 02:45:32 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/represent.lisp,v 1.38.38.3 2010-02-25 03:59:43 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -421,12 +421,12 @@
(vop-results op-vop)))
(error _"Couldn't fine op? Bug!")))))
(compiler-note
- _"Doing ~A (cost ~D)~:[~2*~; ~:[to~;from~] ~S~], for:~%~6T~
+ _N"Doing ~A (cost ~D)~:[~2*~; ~:[to~;from~] ~S~], for:~%~6T~
The ~:R ~:[result~;argument~] of ~A."
note cost name arg-p name
pos arg-p op-note)))
(t
- (compiler-note _"Doing ~A (cost ~D)~@[ from ~S~]~@[ to ~S~]."
+ (compiler-note _N"Doing ~A (cost ~D)~@[ from ~S~]~@[ to ~S~]."
note cost (get-operand-name op-tn t)
(get-operand-name dest-tn nil)))))
(undefined-value))
Index: src/compiler/seqtran.lisp
diff -u src/compiler/seqtran.lisp:1.33.10.2 src/compiler/seqtran.lisp:1.33.10.3
--- src/compiler/seqtran.lisp:1.33.10.2 Wed Feb 10 21:45:32 2010
+++ src/compiler/seqtran.lisp Wed Feb 24 22:59:43 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/seqtran.lisp,v 1.33.10.2 2010-02-11 02:45:32 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/seqtran.lisp,v 1.33.10.3 2010-02-25 03:59:43 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -455,7 +455,7 @@
(specifier-type 'function)))
(when (policy *compiler-error-context* (> speed brevity))
(compiler-note
- _"~S may not be a function, so must coerce at run-time."
+ _N"~S may not be a function, so must coerce at run-time."
n-fun))
(once-only ((n-fun `(if (functionp ,n-fun)
,n-fun
Index: src/compiler/srctran.lisp
diff -u src/compiler/srctran.lisp:1.170.12.2 src/compiler/srctran.lisp:1.170.12.3
--- src/compiler/srctran.lisp:1.170.12.2 Wed Feb 10 21:45:32 2010
+++ src/compiler/srctran.lisp Wed Feb 24 22:59:43 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/srctran.lisp,v 1.170.12.2 2010-02-11 02:45:32 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/srctran.lisp,v 1.170.12.3 2010-02-25 03:59:43 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -3735,7 +3735,7 @@
(compiler-warning _"~s: too few args (~d), need at least ~d"
context nargs min-args))
((> nargs max-args)
- (compiler-note _"~s: too many args (~d), wants at most ~d"
+ (compiler-note _N"~s: too many args (~d), wants at most ~d"
context nargs max-args))))))
(defun check-format-args-1 (string args context)
Index: src/compiler/typetran.lisp
diff -u src/compiler/typetran.lisp:1.45.38.2 src/compiler/typetran.lisp:1.45.38.3
--- src/compiler/typetran.lisp:1.45.38.2 Wed Feb 10 21:45:32 2010
+++ src/compiler/typetran.lisp Wed Feb 24 22:59:44 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/typetran.lisp,v 1.45.38.2 2010-02-11 02:45:32 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/typetran.lisp,v 1.45.38.3 2010-02-25 03:59:44 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -248,7 +248,7 @@
(let ((spec (hairy-type-specifier type)))
(cond ((unknown-type-p type)
(when (policy nil (> speed brevity))
- (compiler-note _"Can't open-code test of unknown type ~S."
+ (compiler-note _N"Can't open-code test of unknown type ~S."
(type-specifier type)))
`(%typep ,object ',spec))
(t
More information about the cmucl-commit
mailing list