Have `-Wformat' remain quiet for any procedure called `_' or `N_'.

[bpt/guile.git] / module / language / tree-il / analyze.scm

diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index 5f995b6..c3ff9e2 100644 (file)
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -1194,8 +1194,15 @@ accurate information is missing from a given `tree-il' element."
                              (false-if-exception
                               (module-ref env name))))
                       proc)))
-            (if (or (lambda? proc*) (procedure? proc*))
-                (validate-arity proc* application (lambda? proc*)))))
+            (cond ((lambda? proc*)
+                   (validate-arity proc* application #t))
+                  ((struct? proc*)
+                   ;; An applicable struct.
+                   (let ((p (struct-ref proc* 0)))
+                     (and (procedure? p)
+                          (validate-arity p application #f))))
+                  ((procedure? proc*)
+                   (validate-arity proc* application #f)))))
         toplevel-calls)))
 
    (make-arity-info vlist-null vlist-null vlist-null)))
@@ -1350,18 +1357,28 @@ accurate information is missing from a given `tree-il' element."
 (define (proc-ref? exp proc special-name env)
   "Return #t when EXP designates procedure PROC in ENV.  As a last
 resort, return #t when EXP refers to the global variable SPECIAL-NAME."
+
+  (define special?
+    (cut eq? <> special-name))
+
   (match exp
+    (($ <toplevel-ref> _ (? special?))
+     ;; Allow top-levels like: (define _ (cut gettext <> "my-domain")).
+     #t)
     (($ <toplevel-ref> _ name)
-     (let ((var (false-if-exception (module-variable env name))))
-       (if var
-           (eq? (false-if-exception (variable-ref var)) ; VAR may be unbound
-                proc)
-           (eq? name special-name))))      ; special hack to support local aliases
+     (let ((var (module-variable env name)))
+       (and var (variable-bound? var)
+            (eq? (variable-ref var) proc))))
+    (($ <module-ref> _ _ (? special?))
+     #t)
     (($ <module-ref> _ module name public?)
-     (let ((m (false-if-exception (if public?
-                                      (resolve-interface module)
-                                      (resolve-module module)))))
-       (and m (eq? (false-if-exception (module-ref module name)) proc))))
+     (let* ((mod (if public?
+                     (false-if-exception (resolve-interface module))
+                     (resolve-module module #:ensure #f)))
+            (var (and mod (module-variable mod name))))
+       (and var (variable-bound? var) (eq? (variable-ref var) proc))))
+    (($ <lexical-ref> _ (? special?))
+     #t)
     (_ #f)))
 
 (define gettext? (cut proc-ref? <> gettext '_ <>))