mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 17:50:29 +02:00
Code Activity

Add intrinsics for module operations

Browse source 
* libguile/intrinsics.c (scm_bootstrap_intrinsics):
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS):
* module/system/vm/assembler.scm (resolve-module, lookup): New intrinsics.
* module/language/cps/compile-bytecode: Add cases for primcalls
  corresponding to new intrinsics.
This commit is contained in:
Andy Wingo 2018-05-13 10:23:28 +02:00
parent 16a996f052
commit fb344a25d5
4 changed files with 51 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

38
libguile/intrinsics.c
View file

@ -220,6 +220,42 @@ numerically_equal_p (SCM a, SCM b)
return scm_is_true (scm_num_eq_p (a, b));
}
static SCM
resolve_module (SCM name, scm_t_uint8 public_p)
{
SCM mod;
if (!scm_module_system_booted_p)
return SCM_BOOL_F;
mod = scm_maybe_resolve_module (name);
if (scm_is_false (mod))
scm_misc_error (NULL, "Module named ~s does not exist",
scm_list_1 (name));
if (public_p)
{
mod = scm_module_public_interface (mod);
if (scm_is_false (mod))
scm_misc_error (NULL, "Module named ~s has no public interface",
scm_list_1 (name));
}
return mod;
}
static SCM
lookup (SCM module, SCM name)
{
/* If MODULE was captured before modules were booted, use the root
module. Not so nice, but hey... */
if (scm_is_false (module))
module = scm_the_root_module ();
return scm_module_variable (module, name);
}
void
scm_bootstrap_intrinsics (void)
{
@ -262,6 +298,8 @@ scm_bootstrap_intrinsics (void)
scm_vm_intrinsics.heap_numbers_equal_p = scm_i_heap_numbers_equal_p;
scm_vm_intrinsics.less_p = less_p;
scm_vm_intrinsics.numerically_equal_p = numerically_equal_p;
scm_vm_intrinsics.resolve_module = resolve_module;
scm_vm_intrinsics.lookup = lookup;
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_intrinsics",

2
libguile/intrinsics.h
View file

@ -82,6 +82,8 @@ typedef enum scm_compare (*scm_t_compare_from_scm_scm_intrinsic) (SCM, SCM);
M(bool_from_scm_scm, heap_numbers_equal_p, "heap-numbers-equal?", HEAP_NUMBERS_EQUAL_P) \
M(compare_from_scm_scm, less_p, "<?", LESS_P) \
M(bool_from_scm_scm, numerically_equal_p, "=?", NUMERICALLY_EQUAL_P) \
M(scm_from_scm_uimm, resolve_module, "resolve-module", RESOLVE_MODULE) \
M(scm_from_scm_scm, lookup, "lookup", LOOKUP) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic