guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-10-29-g3f


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-10-29-g3fc7e2c
Date: Sat, 17 Apr 2010 14:27:41 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=3fc7e2c12370f4c6386dafe127640f1ef1c6d76b

The branch, master has been updated
       via  3fc7e2c12370f4c6386dafe127640f1ef1c6d76b (commit)
       via  cb2ce548441824fe1284fc80a3a95394a9fc03d0 (commit)
       via  1e23b461ecd25c582dd0b10ebb1d7fd22f5e5ec4 (commit)
       via  07e424b753b31702bdee9a2f144af8dd407abfaf (commit)
       via  90fa152c1d2cf2e57050ac0f9da7eba1449bbc26 (commit)
       via  e1bdf9e2a5af4e08329509edb9d1617e7a385c03 (commit)
      from  689af21100ee511a3af8fe11e444a64d5242ad21 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 3fc7e2c12370f4c6386dafe127640f1ef1c6d76b
Author: Andy Wingo <address@hidden>
Date:   Sat Apr 17 16:28:52 2010 +0200

    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.

commit cb2ce548441824fe1284fc80a3a95394a9fc03d0
Author: Andy Wingo <address@hidden>
Date:   Sat Apr 17 16:03:51 2010 +0200

    add procedure_minimum_arity
    
    * libguile/procprop.h:
    * libguile/procprop.c (scm_procedure_minimum_arity): New public
      function, will replace (procedure-property foo 'arity).
    
    * libguile/programs.c (scm_i_program_arity): Rework to always provide
      the most permissive arity.

commit 1e23b461ecd25c582dd0b10ebb1d7fd22f5e5ec4
Author: Andy Wingo <address@hidden>
Date:   Sat Apr 17 15:17:24 2010 +0200

    remove program-name, program-documentation
    
    * libguile/programs.h:
    * libguile/programs.c (scm_program_name): Remove. procedure-name is
      sufficient.
    
    * module/system/vm/program.scm (program-name): Remove from exports list.
      (program-documentation): Remove; procedure-documentation is
      sufficient.
    
    * libguile/debug.c (scm_procedure_name): Remove special case for
      programs.
    
    * module/language/tree-il/analyze.scm (validate-arity): Use
      procedure-name.
    
    * module/ice-9/documentation.scm (object-documentation): Just use
      procedure-documentation, without special cases for programs.

commit 07e424b753b31702bdee9a2f144af8dd407abfaf
Author: Andy Wingo <address@hidden>
Date:   Sat Apr 17 15:02:56 2010 +0200

    scm_i_program_properties is internal; just use procedure-properties
    
    * libguile/programs.h:
    * libguile/programs.c (scm_i_program_properties): Make internal.
      (scm_program_name): Use scm_i_program_properties.
    
    * libguile/procprop.c (scm_procedure_properties): Use
      scm_i_program_properties, for programs.
    
    * libguile/procs.c (scm_procedure_documentation): Use procedure-property
      to get to 'documentation, not program-property.
    
    * module/system/vm/program.scm (program-properties, program-property):
      Remove from the exports list.
      (program-documentation): Use procedure-property.
    
    * module/texinfo/reflection.scm (macro-arguments)
      (macro-additional-stexi)
      (object-stexi-documentation): Use procedure-property, not
      program-property.

commit 90fa152c1d2cf2e57050ac0f9da7eba1449bbc26
Author: Andy Wingo <address@hidden>
Date:   Sat Apr 17 14:47:47 2010 +0200

    tweaks to procprop.c
    
    * libguile/procprop.c (scm_procedure_property)
      (scm_set_procedure_property_x): Fix up some variable naming.

commit e1bdf9e2a5af4e08329509edb9d1617e7a385c03
Author: Andy Wingo <address@hidden>
Date:   Sat Apr 17 14:45:32 2010 +0200

    procedure-properties incorporates program-properties
    
    * libguile/procprop.c (overrides, overrides_lock): Rename from props and
      props_lock.
      (scm_procedure_properties): If no overrides have been set, default to
      scm_program_properties (if it's a program).
      (scm_set_procedure_properties_x): Error if 'arity is in the alist.
      (scm_procedure_property): Just do a lookup in the
      scm_procedure_properties.
      (scm_set_procedure_properties_x): Init the overrides to
      scm_procedure_properties.

-----------------------------------------------------------------------

Summary of changes:
 emacs/guile-emacs.scm               |    7 +--
 libguile/debug.c                    |    7 +--
 libguile/procprop.c                 |  120 ++++++++++++++++++++++-------------
 libguile/procprop.h                 |    7 ++-
 libguile/procs.c                    |    7 +--
 libguile/programs.c                 |   69 +++++++++++---------
 libguile/programs.h                 |    3 +-
 module/ice-9/channel.scm            |    4 +-
 module/ice-9/documentation.scm      |   12 +---
 module/ice-9/session.scm            |    2 +-
 module/language/tree-il/analyze.scm |    4 +-
 module/system/vm/program.scm        |   10 +---
 module/texinfo/reflection.scm       |    9 +--
 13 files changed, 138 insertions(+), 123 deletions(-)

diff --git a/emacs/guile-emacs.scm b/emacs/guile-emacs.scm
index 4d99002..7691277 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 <address@hidden>
+;; Copyright (C) 2001, 2010 Keisuke Nishida <address@hidden>
 
 ;;;; 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/debug.c b/libguile/debug.c
index c8e908f..30332f4 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -137,15 +137,10 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
            "Return the name of the procedure @var{proc}")
 #define FUNC_NAME s_scm_procedure_name
 {
-  SCM name;
-
   SCM_VALIDATE_PROC (1, proc);
   while (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
     proc = SCM_STRUCT_PROCEDURE (proc);
-  name = scm_procedure_property (proc, scm_sym_name);
-  if (scm_is_false (name) && SCM_PROGRAM_P (proc))
-    name = scm_program_name (proc);
-  return name;
+  return scm_procedure_property (proc, scm_sym_name);
 }
 #undef FUNC_NAME
 
diff --git a/libguile/procprop.c b/libguile/procprop.c
index b3c6c86..2263d28 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,11 +43,13 @@
 
 
 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 props;
-static scm_i_pthread_mutex_t props_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+static SCM overrides;
+static scm_i_pthread_mutex_t overrides_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
 int
 scm_i_procedure_arity (SCM proc, int *req, int *opt, int *rest)
@@ -71,9 +77,30 @@ scm_i_procedure_arity (SCM proc, int *req, int *opt, int 
*rest)
   return scm_i_program_arity (proc, req, opt, rest);
 }
 
-/* FIXME: instead of the weak hash, perhaps for some kinds of procedures, use
-   other means; for example subrs have their own property slot, which is unused
-   at present. */
+SCM_DEFINE (scm_procedure_minimum_arity, "procedure-minimum-arity", 1, 0, 0, 
+           (SCM proc),
+           "Return the \"minimum arity\" of a procedure.\n\n"
+            "If the procedure has only one arity, that arity is returned\n"
+            "as a list of three values: the number of required arguments,\n"
+            "the number of optional arguments, and a boolean indicating\n"
+            "whether or not the procedure takes rest arguments.\n\n"
+            "For a case-lambda procedure, the arity returned is the one\n"
+            "with the lowest minimum number of arguments, and the highest\n"
+            "maximum number of arguments.\n\n"
+            "If it was not possible to determine the arity of the procedure,\n"
+            "@code{#f} is returned.")
+#define FUNC_NAME s_scm_procedure_minimum_arity
+{
+  int req, opt, rest;
+  
+  if (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_BOOL_F;
+}
+#undef FUNC_NAME
 
 SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0, 
            (SCM proc),
@@ -81,21 +108,26 @@ 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);
 
-  scm_i_pthread_mutex_lock (&props_lock);
-  ret = scm_hashq_ref (props, proc, SCM_EOL);
-  scm_i_pthread_mutex_unlock (&props_lock);
+  scm_i_pthread_mutex_lock (&overrides_lock);
+  ret = scm_hashq_ref (overrides, proc, SCM_BOOL_F);
+  scm_i_pthread_mutex_unlock (&overrides_lock);
 
-  scm_i_procedure_arity (proc, &req, &opt, &rest);
+  if (scm_is_false (ret))
+    {
+      if (SCM_PROGRAM_P (proc))
+        ret = scm_i_program_properties (proc);
+      else
+        ret = SCM_EOL;
+    }
+  
+#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
 
@@ -106,9 +138,14 @@ SCM_DEFINE (scm_set_procedure_properties_x, 
"set-procedure-properties!", 2, 0, 0
 {
   SCM_VALIDATE_PROC (1, proc);
 
-  scm_i_pthread_mutex_lock (&props_lock);
-  scm_hashq_set_x (props, proc, alist);
-  scm_i_pthread_mutex_unlock (&props_lock);
+#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);
+  scm_i_pthread_mutex_unlock (&overrides_lock);
 
   return SCM_UNSPECIFIED;
 }
@@ -121,25 +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
-    {
-      SCM ret;
-
-      scm_i_pthread_mutex_lock (&props_lock);
-      ret = scm_hashq_ref (props, proc, SCM_EOL);
-      scm_i_pthread_mutex_unlock (&props_lock);
+    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 (ret, key);
-    }
+  return scm_assq_ref (scm_procedure_properties (proc), key);
 }
 #undef FUNC_NAME
 
@@ -149,17 +175,25 @@ SCM_DEFINE (scm_set_procedure_property_x, 
"set-procedure-property!", 3, 0, 0,
            "@var{val}.")
 #define FUNC_NAME s_scm_set_procedure_property_x
 {
+  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 (&props_lock);
-  scm_hashq_set_x (props, proc,
-                   scm_assq_set_x (scm_hashq_ref (props, proc,
-                                                  SCM_EOL),
-                                   key, val));
-  scm_i_pthread_mutex_unlock (&props_lock);
+  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);
 
   return SCM_UNSPECIFIED;
 }
@@ -171,7 +205,7 @@ SCM_DEFINE (scm_set_procedure_property_x, 
"set-procedure-property!", 3, 0, 0,
 void
 scm_init_procprop ()
 {
-  props = scm_make_weak_key_hash_table (SCM_UNDEFINED);
+  overrides = scm_make_weak_key_hash_table (SCM_UNDEFINED);
 #include "libguile/procprop.x"
 }
 
diff --git a/libguile/procprop.h b/libguile/procprop.h
index 50f04b2..c8c156a 100644
--- a/libguile/procprop.h
+++ b/libguile/procprop.h
@@ -3,7 +3,7 @@
 #ifndef SCM_PROCPROP_H
 #define SCM_PROCPROP_H
 
-/* Copyright (C) 1995,1996,1998,2000, 2006, 2008, 2009 Free Software 
Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000, 2006, 2008, 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 License
@@ -28,12 +28,15 @@
 
 
 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;
 
 
 
 SCM_INTERNAL int scm_i_procedure_arity (SCM proc, int *req, int *opt, int 
*rest);
+SCM_API SCM scm_procedure_minimum_arity (SCM proc);
 SCM_API SCM scm_procedure_properties (SCM proc);
 SCM_API SCM scm_set_procedure_properties_x (SCM proc, SCM alist);
 SCM_API SCM scm_procedure_property (SCM proc, SCM key);
diff --git a/libguile/procs.c b/libguile/procs.c
index 10ae885..c6fab72 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2006, 2008, 2009 Free Software 
Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2006, 2008, 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 License
@@ -86,10 +86,7 @@ SCM_DEFINE (scm_procedure_documentation, 
"procedure-documentation", 1, 0, 0,
 #define FUNC_NAME s_scm_procedure_documentation
 {
   SCM_VALIDATE_PROC (SCM_ARG1, proc);
-  if (SCM_PROGRAM_P (proc))
-    return scm_assq_ref (scm_program_properties (proc), sym_documentation);
-  else
-    return SCM_BOOL_F;
+  return scm_procedure_property (proc, sym_documentation);
 }
 #undef FUNC_NAME
 
diff --git a/libguile/programs.c b/libguile/programs.c
index 79b1c32..12baf68 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -244,10 +244,9 @@ SCM_DEFINE (scm_program_arities, "program-arities", 1, 0, 
0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_program_properties, "program-properties", 1, 0, 0,
-           (SCM program),
-           "")
-#define FUNC_NAME s_scm_program_properties
+SCM
+scm_i_program_properties (SCM program)
+#define FUNC_NAME "%program-properties"
 {
   SCM meta;
   
@@ -261,16 +260,6 @@ SCM_DEFINE (scm_program_properties, "program-properties", 
1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_program_name, "program-name", 1, 0, 0,
-           (SCM program),
-           "")
-#define FUNC_NAME s_scm_program_name
-{
-  SCM_VALIDATE_PROGRAM (1, program);
-  return scm_assq_ref (scm_program_properties (program), scm_sym_name);
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_program_source, "program-source", 2, 0, 0,
            (SCM program, SCM ip),
            "")
@@ -345,21 +334,12 @@ SCM_DEFINE (scm_program_objcode, "program-objcode", 1, 0, 
0,
 }
 #undef FUNC_NAME
 
-/* This one is a shim to pre-case-lambda internal interfaces. Avoid it if you
-   can -- use program-arguments or the like. */
-static SCM sym_arglist;
-int
-scm_i_program_arity (SCM program, int *req, int *opt, int *rest)
+/* procedure-minimum-arity support. */
+static void
+parse_arity (SCM arity, int *req, int *opt, int *rest)
 {
-  SCM arities, x;
+  SCM x = scm_cddr (arity);
   
-  arities = scm_program_arities (program);
-  if (!scm_is_pair (arities))
-    return 0;
-  /* take the last arglist, it will be least specific */
-  while (scm_is_pair (scm_cdr (arities)))
-    arities = scm_cdr (arities);
-  x = scm_cddar (arities);
   if (scm_is_pair (x))
     {
       *req = scm_to_int (scm_car (x));
@@ -378,7 +358,37 @@ scm_i_program_arity (SCM program, int *req, int *opt, int 
*rest)
     }
   else
     *req = *opt = *rest = 0;
-          
+}
+  
+int
+scm_i_program_arity (SCM program, int *req, int *opt, int *rest)
+{
+  SCM arities;
+  
+  arities = scm_program_arities (program);
+  if (!scm_is_pair (arities))
+    return 0;
+
+  parse_arity (scm_car (arities), req, opt, rest);
+  arities = scm_cdr (arities);
+  
+  for (; scm_is_pair (arities); arities = scm_cdr (arities))
+    {
+      int thisreq, thisopt, thisrest;
+
+      parse_arity (scm_car (arities), &thisreq, &thisopt, &thisrest);
+
+      if (thisreq < *req
+          || (thisreq == *req
+              && ((thisrest && (!*rest || thisopt > *opt))
+                  || (!thisrest && !*rest && thisopt > *opt))))
+        {
+          *req = thisreq;
+          *opt = thisopt;
+          *rest = thisrest;
+        }
+    }
+
   return 1;
 }
 
@@ -387,9 +397,6 @@ scm_i_program_arity (SCM program, int *req, int *opt, int 
*rest)
 void
 scm_bootstrap_programs (void)
 {
-  /* arglist can't be snarfed, because snarfage is only loaded when (system vm
-     program) is loaded. perhaps static-alloc will fix this. */
-  sym_arglist = scm_from_locale_symbol ("arglist");
   scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
                             "scm_init_programs",
                             (scm_t_extension_init_func)scm_init_programs, 
NULL);
diff --git a/libguile/programs.h b/libguile/programs.h
index c8e3bf6..7f9b6f7 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -56,8 +56,6 @@ SCM_API SCM scm_program_bindings (SCM program);
 SCM_API SCM scm_program_sources (SCM program);
 SCM_API SCM scm_program_source (SCM program, SCM ip);
 SCM_API SCM scm_program_arities (SCM program);
-SCM_API SCM scm_program_properties (SCM program);
-SCM_API SCM scm_program_name (SCM program);
 SCM_API SCM scm_program_objects (SCM program);
 SCM_API SCM scm_program_module (SCM program);
 SCM_API SCM scm_program_num_free_variables (SCM program);
@@ -67,6 +65,7 @@ SCM_API SCM scm_program_objcode (SCM program);
 
 SCM_API SCM scm_c_program_source (SCM program, size_t ip);
 
+SCM_INTERNAL SCM scm_i_program_properties (SCM program);
 SCM_INTERNAL int scm_i_program_arity (SCM program, int *req, int *opt, int 
*rest);
 SCM_INTERNAL void scm_i_program_print (SCM program, SCM port,
                                        scm_print_state *pstate);
diff --git a/module/ice-9/channel.scm b/module/ice-9/channel.scm
index 01bff02..9c237f5 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/documentation.scm b/module/ice-9/documentation.scm
index 37c3bf7..9b0a121 100644
--- a/module/ice-9/documentation.scm
+++ b/module/ice-9/documentation.scm
@@ -1,4 +1,4 @@
-;;;;   Copyright (C) 2000,2001, 2002, 2003, 2006, 2009 Free Software 
Foundation, Inc.
+;;;;   Copyright (C) 2000,2001, 2002, 2003, 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
@@ -80,7 +80,6 @@
 
 (define-module (ice-9 documentation)
   :use-module (ice-9 rdelim)
-  :use-module ((system vm program) :select (program? program-documentation))
   :export (file-commentary
            documentation-files search-documentation-files
            object-documentation)
@@ -184,20 +183,13 @@
           (cond ((null? files) documentation-files)
                 (else files))))
 
-;; helper until the procedure documentation property is cleaned up
-(define (proc-doc proc)
-  (or (procedure-documentation proc)
-      (procedure-property proc 'documentation)))
-
 (define (object-documentation object)
   "Return the docstring for OBJECT.
 OBJECT can be a procedure, macro or any object that has its
 `documentation' property set."
   (or (and (procedure? object)
-          (proc-doc object))
+          (procedure-documentation object))
       (object-property object 'documentation)
-      (and (program? object)
-           (program-documentation object))
       (and (macro? object)
            (object-documentation (macro-transformer object)))
       (and (procedure? object)
diff --git a/module/ice-9/session.scm b/module/ice-9/session.scm
index e168d3e..f3c8f66 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 0c3cbf8..bc56a7d 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -996,14 +996,14 @@ accurate information is missing from a given `tree-il' 
element."
                (length x))
           0))
     (cond ((program? proc)
-           (values (program-name proc)
+           (values (procedure-name proc)
                    (map (lambda (a)
                           (list (arity:nreq a) (arity:nopt a) (arity:rest? a)
                                 (map car (arity:kw a))
                                 (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)))))
diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm
index 6c59566..f3892cb 100644
--- a/module/system/vm/program.scm
+++ b/module/system/vm/program.scm
@@ -28,8 +28,6 @@
 
             source:addr source:line source:column source:file
             program-sources program-source
-            program-properties program-property program-documentation
-            program-name
 
             program-bindings program-bindings-by-index program-bindings-for-ip
             program-arities program-arity arity:start arity:end
@@ -64,12 +62,6 @@
 (define (source:column source)
   (cdddr source))
 
-(define (program-property prog prop)
-  (assq-ref (program-properties prog) prop))
-
-(define (program-documentation prog)
-  (assq-ref (program-properties prog) 'documentation))
-
 (define (collapse-locals locs)
   (let lp ((ret '()) (locs locs))
     (if (null? locs)
@@ -200,7 +192,7 @@
 
 (define (write-program prog port)
   (format port "#<procedure ~a~a>"
-          (or (program-name prog)
+          (or (procedure-name prog)
               (and=> (program-source prog 0)
                      (lambda (s)
                        (format #f "~a at ~a:~a:~a"
diff --git a/module/texinfo/reflection.scm b/module/texinfo/reflection.scm
index 1e0d9bd..52b1ee9 100644
--- a/module/texinfo/reflection.scm
+++ b/module/texinfo/reflection.scm
@@ -37,7 +37,6 @@
   #:use-module (ice-9 session)
   #:use-module (ice-9 documentation)
   #:use-module (ice-9 optargs)
-  #:use-module (system vm program)
   #:use-module ((sxml transform) #:select (pre-post-order))
   #:export (module-stexi-documentation
             script-stexi-documentation
@@ -127,14 +126,14 @@
   (process-args
    (case type
      ((syntax-rules)
-      (let ((patterns (program-property transformer 'patterns)))
+      (let ((patterns (procedure-property transformer 'patterns)))
         (if (pair? patterns)
             (car patterns)
             '())))
      ((identifier-syntax)
       '())
      ((defmacro)
-      (or (program-property transformer 'defmacro-args)
+      (or (procedure-property transformer 'defmacro-args)
           '()))
      (else
       ;; a procedural (syntax-case) macro. how to document these?
@@ -143,7 +142,7 @@
 (define (macro-additional-stexi name type transformer)
   (case type
     ((syntax-rules)
-     (let ((patterns (program-property transformer 'patterns)))
+     (let ((patterns (procedure-property transformer 'patterns)))
        (if (pair? patterns)
            (map (lambda (x)
                   `(defspecx (% (name ,name)
@@ -228,7 +227,7 @@
                          (category "Class"))))
      ((is-a? object <macro>)
       (let* ((proc (macro-transformer object))
-             (type (and proc (program-property proc 'macro-type))))
+             (type (and proc (procedure-property proc 'macro-type))))
         `(defspec (% (name ,name)
                      (arguments ,@(macro-arguments name type proc)))
            ,@(macro-additional-stexi name type proc)


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]