mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

procedure-properties incorporates program-properties

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2010-04-17 14:45:32 +02:00
parent 689af21100
commit e1bdf9e2a5
1 changed files with 29 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

56
libguile/procprop.c
View file

@ -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"
}