mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
add scm_c_public_ref et al
* libguile/modules.h: * libguile/modules.c (scm_public_lookup, scm_private_lookup) (scm_c_public_lookup, scm_c_private_lookup, scm_public_ref) (scm_private_ref, scm_c_public_ref, scm_c_private_ref) (scm_public_variable, scm_private_variable, scm_c_public_variable) (scm_c_private_variable): New helpers to get at variables and values in modules.
This commit is contained in:
parent
65ea26c582
commit
ef8e9356de
2 changed files with 138 additions and 1 deletions
|
@ -56,6 +56,9 @@ static SCM module_public_interface_var;
|
||||||
static SCM module_export_x_var;
|
static SCM module_export_x_var;
|
||||||
static SCM default_duplicate_binding_procedures_var;
|
static SCM default_duplicate_binding_procedures_var;
|
||||||
|
|
||||||
|
/* The #:ensure keyword. */
|
||||||
|
static SCM k_ensure;
|
||||||
|
|
||||||
|
|
||||||
static SCM unbound_variable (const char *func, SCM sym)
|
static SCM unbound_variable (const char *func, SCM sym)
|
||||||
{
|
{
|
||||||
|
@ -751,6 +754,124 @@ scm_lookup (SCM sym)
|
||||||
return var;
|
return var;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
scm_public_variable (SCM module_name, SCM name)
|
||||||
|
{
|
||||||
|
SCM mod, iface;
|
||||||
|
|
||||||
|
mod = scm_call_3 (scm_variable_ref (resolve_module_var), module_name,
|
||||||
|
k_ensure, SCM_BOOL_F);
|
||||||
|
|
||||||
|
if (scm_is_false (mod))
|
||||||
|
scm_misc_error ("public-lookup", "Module named ~s does not exist",
|
||||||
|
scm_list_1 (module_name));
|
||||||
|
|
||||||
|
iface = scm_module_public_interface (mod);
|
||||||
|
|
||||||
|
if (scm_is_false (iface))
|
||||||
|
scm_misc_error ("public-lookup", "Module ~s has no public interface",
|
||||||
|
scm_list_1 (mod));
|
||||||
|
|
||||||
|
return scm_module_variable (iface, name);
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
scm_private_variable (SCM module_name, SCM name)
|
||||||
|
{
|
||||||
|
SCM mod;
|
||||||
|
|
||||||
|
mod = scm_call_3 (scm_variable_ref (resolve_module_var), module_name,
|
||||||
|
k_ensure, SCM_BOOL_F);
|
||||||
|
|
||||||
|
if (scm_is_false (mod))
|
||||||
|
scm_misc_error ("private-lookup", "Module named ~s does not exist",
|
||||||
|
scm_list_1 (module_name));
|
||||||
|
|
||||||
|
return scm_module_variable (mod, name);
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
scm_c_public_variable (const char *module_name, const char *name)
|
||||||
|
{
|
||||||
|
return scm_public_variable (convert_module_name (module_name),
|
||||||
|
scm_from_locale_symbol (name));
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
scm_c_private_variable (const char *module_name, const char *name)
|
||||||
|
{
|
||||||
|
return scm_private_variable (convert_module_name (module_name),
|
||||||
|
scm_from_locale_symbol (name));
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
scm_public_lookup (SCM module_name, SCM name)
|
||||||
|
{
|
||||||
|
SCM var;
|
||||||
|
|
||||||
|
var = scm_public_variable (module_name, name);
|
||||||
|
|
||||||
|
if (scm_is_false (var))
|
||||||
|
scm_misc_error ("public-lookup", "No variable bound to ~s in module ~s",
|
||||||
|
scm_list_2 (name, module_name));
|
||||||
|
|
||||||
|
return var;
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
scm_private_lookup (SCM module_name, SCM name)
|
||||||
|
{
|
||||||
|
SCM var;
|
||||||
|
|
||||||
|
var = scm_private_variable (module_name, name);
|
||||||
|
|
||||||
|
if (scm_is_false (var))
|
||||||
|
scm_misc_error ("private-lookup", "No variable bound to ~s in module ~s",
|
||||||
|
scm_list_2 (name, module_name));
|
||||||
|
|
||||||
|
return var;
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
scm_c_public_lookup (const char *module_name, const char *name)
|
||||||
|
{
|
||||||
|
return scm_public_lookup (convert_module_name (module_name),
|
||||||
|
scm_from_locale_symbol (name));
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
scm_c_private_lookup (const char *module_name, const char *name)
|
||||||
|
{
|
||||||
|
return scm_private_lookup (convert_module_name (module_name),
|
||||||
|
scm_from_locale_symbol (name));
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
scm_public_ref (SCM module_name, SCM name)
|
||||||
|
{
|
||||||
|
return scm_variable_ref (scm_public_lookup (module_name, name));
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
scm_private_ref (SCM module_name, SCM name)
|
||||||
|
{
|
||||||
|
return scm_variable_ref (scm_private_lookup (module_name, name));
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
scm_c_public_ref (const char *module_name, const char *name)
|
||||||
|
{
|
||||||
|
return scm_public_ref (convert_module_name (module_name),
|
||||||
|
scm_from_locale_symbol (name));
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
scm_c_private_ref (const char *module_name, const char *name)
|
||||||
|
{
|
||||||
|
return scm_private_ref (convert_module_name (module_name),
|
||||||
|
scm_from_locale_symbol (name));
|
||||||
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_c_module_define (SCM module, const char *name, SCM value)
|
scm_c_module_define (SCM module, const char *name, SCM value)
|
||||||
{
|
{
|
||||||
|
@ -903,6 +1024,7 @@ scm_post_boot_init_modules ()
|
||||||
default_duplicate_binding_procedures_var =
|
default_duplicate_binding_procedures_var =
|
||||||
scm_c_lookup ("default-duplicate-binding-procedures");
|
scm_c_lookup ("default-duplicate-binding-procedures");
|
||||||
module_public_interface_var = scm_c_lookup ("module-public-interface");
|
module_public_interface_var = scm_c_lookup ("module-public-interface");
|
||||||
|
k_ensure = scm_from_locale_keyword ("ensure");
|
||||||
|
|
||||||
scm_module_system_booted_p = 1;
|
scm_module_system_booted_p = 1;
|
||||||
}
|
}
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
#ifndef SCM_MODULES_H
|
#ifndef SCM_MODULES_H
|
||||||
#define SCM_MODULES_H
|
#define SCM_MODULES_H
|
||||||
|
|
||||||
/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007, 2008 Free Software Foundation, Inc.
|
/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007, 2008, 2011 Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* modify it under the terms of the GNU Lesser General Public License
|
||||||
|
@ -93,6 +93,21 @@ SCM_API SCM scm_module_define (SCM module, SCM symbol, SCM val);
|
||||||
SCM_API SCM scm_module_export (SCM module, SCM symbol_list);
|
SCM_API SCM scm_module_export (SCM module, SCM symbol_list);
|
||||||
SCM_API SCM scm_module_reverse_lookup (SCM module, SCM variable);
|
SCM_API SCM scm_module_reverse_lookup (SCM module, SCM variable);
|
||||||
|
|
||||||
|
SCM_API SCM scm_public_variable (SCM module_name, SCM name);
|
||||||
|
SCM_API SCM scm_private_variable (SCM module_name, SCM name);
|
||||||
|
SCM_API SCM scm_c_public_variable (const char *module_name, const char *name);
|
||||||
|
SCM_API SCM scm_c_private_variable (const char *module_name, const char *name);
|
||||||
|
|
||||||
|
SCM_API SCM scm_public_lookup (SCM module_name, SCM name);
|
||||||
|
SCM_API SCM scm_private_lookup (SCM module_name, SCM name);
|
||||||
|
SCM_API SCM scm_c_public_lookup (const char *module_name, const char *name);
|
||||||
|
SCM_API SCM scm_c_private_lookup (const char *module_name, const char *name);
|
||||||
|
|
||||||
|
SCM_API SCM scm_public_ref (SCM module_name, SCM name);
|
||||||
|
SCM_API SCM scm_private_ref (SCM module_name, SCM name);
|
||||||
|
SCM_API SCM scm_c_public_ref (const char *module_name, const char *name);
|
||||||
|
SCM_API SCM scm_c_private_ref (const char *module_name, const char *name);
|
||||||
|
|
||||||
SCM_API SCM scm_c_resolve_module (const char *name);
|
SCM_API SCM scm_c_resolve_module (const char *name);
|
||||||
SCM_API SCM scm_resolve_module (SCM name);
|
SCM_API SCM scm_resolve_module (SCM name);
|
||||||
SCM_API SCM scm_c_define_module (const char *name,
|
SCM_API SCM scm_c_define_module (const char *name,
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue