mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-22 19:44:10 +02:00
Code Activity

Add new lookup, lookup-bound intrinsics

Browse source 
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS):
* libguile/intrinsics.c (lookup, lookup_bound):
* libguile/intrinsics.c (scm_bootstrap_intrinsics): New intrinsics.
* module/language/cps/reify-primitives.scm (reify-primitives):
* module/language/cps/effects-analysis.scm (current-module):
* module/language/cps/compile-bytecode.scm (compile-function):
* module/system/vm/assembler.scm: Add compiler support.
This commit is contained in:
Andy Wingo 2020-05-11 10:00:30 +02:00
parent d6b6392cfb
commit 4274d615cc
6 changed files with 42 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

26
libguile/intrinsics.c
View file

@ -344,6 +344,30 @@ module_variable (SCM module, SCM name)
return scm_module_variable (module, name);
}
static SCM
lookup (SCM module, SCM name)
{
SCM var = module_variable (module, name);
if (!SCM_VARIABLEP (var))
scm_error (scm_from_latin1_symbol ("unbound-variable"), NULL,
"Unbound variable: ~S", scm_list_1 (name), SCM_BOOL_F);
return var;
}
static SCM
lookup_bound (SCM module, SCM name)
{
SCM var = lookup (module, name);
if (SCM_UNBNDP (SCM_VARIABLE_REF (var)))
scm_error (scm_from_latin1_symbol ("unbound-variable"), NULL,
"Unbound variable: ~S", scm_list_1 (name), SCM_BOOL_F);
return var;
}
static void throw_ (SCM key, SCM args) SCM_NORETURN;
static void throw_with_value (SCM val, SCM key_subr_and_message) SCM_NORETURN;
static void throw_with_value_and_data (SCM val, SCM key_subr_and_message) SCM_NORETURN;
@ -575,6 +599,8 @@ scm_bootstrap_intrinsics (void)
scm_vm_intrinsics.numerically_equal_p = numerically_equal_p;
scm_vm_intrinsics.resolve_module = resolve_module;
scm_vm_intrinsics.module_variable = module_variable;
scm_vm_intrinsics.lookup = lookup;
scm_vm_intrinsics.lookup_bound = lookup_bound;
scm_vm_intrinsics.define_x = scm_module_ensure_local_variable;
scm_vm_intrinsics.throw_ = throw_;
scm_vm_intrinsics.throw_with_value = throw_with_value;

2
libguile/intrinsics.h
View file

@ -212,6 +212,8 @@ typedef void (*scm_t_scm_uimm_scm_intrinsic) (SCM, uint8_t, SCM);
M(scm_scm_scm, struct_set_x, "$struct-set!", STRUCT_SET_X) \
M(scm_from_scm_uimm, struct_ref_immediate, "$struct-ref/immediate", STRUCT_REF_IMMEDIATE) \
M(scm_uimm_scm, struct_set_x_immediate, "$struct-set!/immediate", STRUCT_SET_X_IMMEDIATE) \
M(scm_from_scm_scm, lookup, "lookup", LOOKUP) \
M(scm_from_scm_scm, lookup_bound, "lookup-bound", LOOKUP_BOUND) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
/* Intrinsics prefixed with $ are meant to reduce bytecode size,