CMUCL commit: intl-branch src/compiler (ltn.lisp meta-vmdef.lisp vop.lisp)

[Raymond Toy]

    Date: Friday, February 26, 2010 @ 16:34:58
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/compiler
     Tag: intl-branch

Modified: ltn.lisp meta-vmdef.lisp vop.lisp

Translate vop template efficiency notes.

vop.lisp:
o Add new slot to template structure to hold the text domain of the
  slot.  Needed for translating the template note.

meta-vmdef.lisp:
o Set the template-note-domain from the current default-domain.

ltn.lisp:
o When noting rejected templates, translate the template note in the
  appropriate text domain.


-----------------+
 ltn.lisp        |   23 ++++++++++++-----------
 meta-vmdef.lisp |    3 ++-
 vop.lisp        |    7 +++++--
 3 files changed, 19 insertions(+), 14 deletions(-)


Index: src/compiler/ltn.lisp
diff -u src/compiler/ltn.lisp:1.43.36.4 src/compiler/ltn.lisp:1.43.36.5
--- src/compiler/ltn.lisp:1.43.36.4	Wed Feb 24 23:35:40 2010
+++ src/compiler/ltn.lisp	Fri Feb 26 16:34:57 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.4 2010-02-25 04:35:40 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/compiler/ltn.lisp,v 1.43.36.5 2010-02-26 21:34:57 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -903,14 +903,15 @@
 	  (dolist (loser (losers))
 	    (when (and *efficiency-note-limit*
 		       (>= (count) *efficiency-note-limit*))
-	      (frob "etc.")
+	      (frob _"etc.")
 	      (return))
 	    (let* ((type (template-type loser))
 		   (valid (valid-function-use call type))
 		   (strict-valid (valid-function-use call type
 						     :strict-result t)))
 	      (frob _"Unable to do ~A (cost ~D) because:"
-		    (or (template-note loser) (template-name loser))
+		    (intl:dgettext (template-note-domain loser)
+				   (or (template-note loser) (template-name loser)))
 		    (template-cost loser))
 	      (cond
 	       ((and valid strict-valid)
@@ -928,14 +929,14 @@
 	(let ((*compiler-error-context* call))
 	  (efficiency-note "~{~?~^~&~6T~}"
 			   (if template
-			       `("Forced to do ~A (cost ~D)."
-				 (,(or (template-note template)
-				       (template-name template))
-				   ,(template-cost template))
-				 . ,(messages))
-			       `("Forced to do full call."
-				 nil
-				 . ,(messages))))))))
+			       (list* _"Forced to do ~A (cost ~D)."
+				      `(,(or (template-note template)
+					     (template-name template))
+					 ,(template-cost template))
+				      (messages))
+			       (list* _"Forced to do full call."
+				      nil
+				      (messages))))))))
   (undefined-value))
 
 
Index: src/compiler/meta-vmdef.lisp
diff -u src/compiler/meta-vmdef.lisp:1.9.48.2 src/compiler/meta-vmdef.lisp:1.9.48.3
--- src/compiler/meta-vmdef.lisp:1.9.48.2	Wed Feb 10 21:19:58 2010
+++ src/compiler/meta-vmdef.lisp	Fri Feb 26 16:34:58 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/meta-vmdef.lisp,v 1.9.48.2 2010-02-11 02:19:58 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/compiler/meta-vmdef.lisp,v 1.9.48.3 2010-02-26 21:34:58 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1599,6 +1599,7 @@
       :guard ,(when (vop-parse-guard parse)
 		`#'(lambda () ,(vop-parse-guard parse)))
       :note ',(vop-parse-note parse)
+      :note-domain ,intl::*default-domain*
       :info-arg-count ,(length (vop-parse-info-args parse))
       :policy ',(vop-parse-policy parse)
       :save-p ',(vop-parse-save-p parse)
Index: src/compiler/vop.lisp
diff -u src/compiler/vop.lisp:1.43.38.1 src/compiler/vop.lisp:1.43.38.2
--- src/compiler/vop.lisp:1.43.38.1	Mon Feb  8 12:15:51 2010
+++ src/compiler/vop.lisp	Fri Feb 26 16:34:58 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/vop.lisp,v 1.43.38.1 2010-02-08 17:15:51 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/compiler/vop.lisp,v 1.43.38.2 2010-02-26 21:34:58 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -727,7 +727,10 @@
   ;; Two values are returned: the first and last VOP emitted.  This vop
   ;; sequence must be linked into the VOP Next/Prev chain for the block.  At
   ;; least one VOP is always emitted.
-  (emit-function (required-argument) :type function))
+  (emit-function (required-argument) :type function)
+  ;;
+  ;; The text domain for the note.
+  (note-domain intl::*default-domain* :type (or string null)))
 
 (defprinter template
   name