summaryrefslogtreecommitdiff
path: root/libguile/procprop.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-04-17 14:45:32 +0200
committerAndy Wingo <wingo@pobox.com>2010-04-17 15:20:03 +0200
commite1bdf9e2a5af4e08329509edb9d1617e7a385c03 (patch)
tree91e59bb4612232cbe2298ed486f5684bf851aa08 /libguile/procprop.c
parent689af21100ee511a3af8fe11e444a64d5242ad21 (diff)
downloadguile-e1bdf9e2a5af4e08329509edb9d1617e7a385c03.tar.gz
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.
Diffstat (limited to 'libguile/procprop.c')
-rw-r--r--libguile/procprop.c56
1 files changed, 29 insertions, 27 deletions
diff --git a/libguile/procprop.c b/libguile/procprop.c
index b3c6c864c..84f1bc54d 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -42,8 +42,8 @@ SCM_GLOBAL_SYMBOL (scm_sym_system_procedure, "system-procedure");
SCM_GLOBAL_SYMBOL (scm_sym_arity, "arity");
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,10 +71,6 @@ 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_properties, "procedure-properties", 1, 0, 0,
(SCM proc),
"Return @var{obj}'s property list.")
@@ -85,10 +81,18 @@ SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0,
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);
+ if (scm_is_false (ret))
+ {
+ if (SCM_PROGRAM_P (proc))
+ ret = scm_program_properties (proc);
+ else
+ ret = SCM_EOL;
+ }
+
scm_i_procedure_arity (proc, &req, &opt, &rest);
return scm_acons (scm_sym_arity,
@@ -106,9 +110,12 @@ 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_assq (alist, scm_sym_arity))
+ SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL);
+
+ scm_i_pthread_mutex_lock (&overrides_lock);
+ scm_hashq_set_x (overrides, proc, alist);
+ scm_i_pthread_mutex_unlock (&overrides_lock);
return SCM_UNSPECIFIED;
}
@@ -132,13 +139,9 @@ SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0,
}
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);
-
- return scm_assq_ref (ret, key);
+ SCM alist;
+ alist = scm_procedure_properties (proc);
+ return scm_assq_ref (alist, key);
}
}
#undef FUNC_NAME
@@ -149,17 +152,16 @@ 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_VALIDATE_PROC (1, proc);
+ SCM alist;
+ SCM_VALIDATE_PROC (1, proc);
if (scm_is_eq (key, scm_sym_arity))
SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL);
- 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);
+ alist = scm_procedure_properties (proc);
+ scm_i_pthread_mutex_lock (&overrides_lock);
+ scm_hashq_set_x (overrides, proc, scm_assq_set_x (alist, key, val));
+ scm_i_pthread_mutex_unlock (&overrides_lock);
return SCM_UNSPECIFIED;
}
@@ -171,7 +173,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"
}