deprecate arity access via (procedure-properties proc 'arity)

* libguile/procprop.h (scm_sym_arity): Deprecate. I didn't move it to
  deprecated.h though, because that might have some boot implications --
  though I didn't check.

* libguile/procprop.c (scm_procedure_properties)
  (scm_set_procedure_properties_x, scm_procedure_property)
  (scm_set_procedure_property_x): Deprecate access to a procedure's
  arity via procedure-properties. Users should use
  procedure-minimum-arity.

* module/ice-9/channel.scm (eval):
* module/ice-9/session.scm (arity):
* module/language/tree-il/analyze.scm (validate-arity): Fix up instances
  of (procedure-property x 'arity) to use procedure-minimum-arity.

6 files changed, 38 insertions, 28 deletions

diff --git a/emacs/guile-emacs.scm b/emacs/guile-emacs.scm
index 4d99002b6..769127709 100644
--- a/emacs/guile-emacs.scm
+++ b/emacs/guile-emacs.scm
@@ -1,6 +1,6 @@
 ;;; guile-emacs.scm --- Guile Emacs interface
 
-;; Copyright (C) 2001 Keisuke Nishida <kxn30@po.cwru.edu>
+;; Copyright (C) 2001, 2010 Keisuke Nishida <kxn30@po.cwru.edu>
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -59,9 +59,6 @@
 ;;;
 
 (define (guile-emacs-export-procedure name proc docs)
-  (define (procedure-arity proc)
-    (assq-ref (procedure-properties proc) 'arity))
-
   (define (procedure-args proc)
     (let ((source (procedure-source proc)))
       (if source
@@ -72,7 +69,7 @@
 	    ((symbol? formals) `(&rest ,formals))
 	    (else (cons (car formals) (loop (cdr formals))))))
 	;; arity -> emacs args
-	(let* ((arity (procedure-arity proc))
+	(let* ((arity (procedure-minimum-arity proc))
 	       (nreqs (car arity))
 	       (nopts (cadr arity))
 	       (restp (caddr arity)))
diff --git a/libguile/procprop.c b/libguile/procprop.c
index b7575d199..2263d283a 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -22,9 +22,13 @@
 # include <config.h>
 #endif
 
+#define SCM_BUILDING_DEPRECATED_CODE
+
 #include "libguile/_scm.h"
 
 #include "libguile/alist.h"
+#include "libguile/deprecation.h"
+#include "libguile/deprecated.h"
 #include "libguile/eval.h"
 #include "libguile/procs.h"
 #include "libguile/gsubr.h"
@@ -39,7 +43,9 @@
 
 
 SCM_GLOBAL_SYMBOL (scm_sym_system_procedure, "system-procedure");
+#if (SCM_ENABLE_DEPRECATED == 1)
 SCM_GLOBAL_SYMBOL (scm_sym_arity, "arity");
+#endif
 SCM_GLOBAL_SYMBOL (scm_sym_name, "name");
 
 static SCM overrides;
@@ -102,7 +108,6 @@ SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0,
 #define FUNC_NAME s_scm_procedure_properties
 {
   SCM ret;
-  int req, opt, rest;
   
   SCM_VALIDATE_PROC (1, proc);
 
@@ -118,13 +123,11 @@ SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0,
         ret = SCM_EOL;
     }
   
-  scm_i_procedure_arity (proc, &req, &opt, &rest);
+#if (SCM_ENABLE_DEPRECATED == 1)
+  ret = scm_acons (scm_sym_arity, scm_procedure_minimum_arity (proc), ret);
+#endif
 
-  return scm_acons (scm_sym_arity,
-                    scm_list_3 (scm_from_int (req),
-                                scm_from_int (opt),
-                                scm_from_bool (rest)),
-                    ret);
+  return ret;
 }
 #undef FUNC_NAME
 
@@ -135,8 +138,10 @@ SCM_DEFINE (scm_set_procedure_properties_x, "set-procedure-properties!", 2, 0, 0
 {
   SCM_VALIDATE_PROC (1, proc);
 
+#if (SCM_ENABLE_DEPRECATED == 1)
   if (scm_assq (alist, scm_sym_arity))
     SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL);
+#endif
 
   scm_i_pthread_mutex_lock (&overrides_lock);
   scm_hashq_set_x (overrides, proc, alist);
@@ -153,17 +158,14 @@ SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0,
 {
   SCM_VALIDATE_PROC (1, proc);
 
+#if (SCM_ENABLE_DEPRECATED == 1)
   if (scm_is_eq (key, scm_sym_arity))
-    /* avoid a cons in this case */
-    {
-      int req, opt, rest;
-      scm_i_procedure_arity (proc, &req, &opt, &rest);
-      return scm_list_3 (scm_from_int (req),
-                         scm_from_int (opt),
-                         scm_from_bool (rest));
-    }
-  else
-    return scm_assq_ref (scm_procedure_properties (proc), key);
+    scm_c_issue_deprecation_warning
+      ("Accessing a procedure's arity via `procedure-property' is deprecated.\n"
+       "Use `procedure-minimum-arity instead.");
+#endif
+
+  return scm_assq_ref (scm_procedure_properties (proc), key);
 }
 #undef FUNC_NAME
 
@@ -176,10 +178,19 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0,
   SCM props;
 
   SCM_VALIDATE_PROC (1, proc);
+
+#if (SCM_ENABLE_DEPRECATED == 1)
   if (scm_is_eq (key, scm_sym_arity))
-    SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL);
+    SCM_MISC_ERROR ("arity is a deprecated read-only property", SCM_EOL);
+#endif
 
   props = scm_procedure_properties (proc);
+
+#if (SCM_ENABLE_DEPRECATED == 1)
+  /* cdr past the consed-on arity. */
+  props = scm_cdr (props);
+#endif
+
   scm_i_pthread_mutex_lock (&overrides_lock);
   scm_hashq_set_x (overrides, proc, scm_assq_set_x (props, key, val));
   scm_i_pthread_mutex_unlock (&overrides_lock);
diff --git a/libguile/procprop.h b/libguile/procprop.h
index 0f1fd8e36..c8c156a25 100644
--- a/libguile/procprop.h
+++ b/libguile/procprop.h
@@ -28,7 +28,9 @@
 
 
 SCM_API SCM scm_sym_name;
-SCM_API SCM scm_sym_arity;
+#if (SCM_ENABLE_DEPRECATED == 1)
+SCM_DEPRECATED SCM scm_sym_arity;
+#endif
 SCM_API SCM scm_sym_system_procedure;
 
 
diff --git a/module/ice-9/channel.scm b/module/ice-9/channel.scm
index 01bff02c5..9c237f5b0 100644
--- a/module/ice-9/channel.scm
+++ b/module/ice-9/channel.scm
@@ -1,6 +1,6 @@
 ;;; Guile object channel
 
-;; Copyright (C) 2001, 2006, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2006, 2009, 2010 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -158,7 +158,7 @@
 
 (define guile:eval eval)
 (define eval
-  (if (= (car (procedure-property guile:eval 'arity)) 1)
+  (if (= (car (procedure-minimum-arity guile:eval)) 1)
     (lambda (x e) (guile:eval x e))
     guile:eval))
 
diff --git a/module/ice-9/session.scm b/module/ice-9/session.scm
index e168d3e5b..f3c8f6625 100644
--- a/module/ice-9/session.scm
+++ b/module/ice-9/session.scm
@@ -484,7 +484,7 @@ It is an image under the mapping EXTRACT."
 		  (display rest-arg)
 		  (display "'"))))))
    (else
-    (let ((arity (procedure-property obj 'arity)))
+    (let ((arity (procedure-minimum-arity obj)))
       (display (car arity))
       (cond ((caddr arity)
 	     (display " or more"))
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index f9fb573e8..bc56a7d77 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -1003,7 +1003,7 @@ accurate information is missing from a given `tree-il' element."
                                 (arity:allow-other-keys? a)))
                         (program-arities proc))))
           ((procedure? proc)
-           (let ((arity (procedure-property proc 'arity)))
+           (let ((arity (procedure-minimum-arity proc)))
              (values (procedure-name proc)
                      (list (list (car arity) (cadr arity) (caddr arity)
                                  #f #f)))))