123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149 |
- #ifdef HAVE_CONFIG_H
- # include <config.h>
- #endif
- #include "libguile/_scm.h"
- #include "libguile/eq.h"
- #include "libguile/ports.h"
- #include "libguile/root.h"
- #include "libguile/smob.h"
- #include "libguile/deprecation.h"
- #include "libguile/validate.h"
- #include "libguile/variable.h"
- void
- scm_i_variable_print (SCM exp, SCM port, scm_print_state *pstate)
- {
- scm_puts_unlocked ("#<variable ", port);
- scm_uintprint (SCM_UNPACK (exp), 16, port);
- scm_puts_unlocked (" value: ", port);
- scm_iprin1 (SCM_VARIABLE_REF (exp), port, pstate);
- scm_putc_unlocked('>', port);
- }
- static SCM
- make_variable (SCM init)
- {
- return scm_cell (scm_tc7_variable, SCM_UNPACK (init));
- }
- SCM_DEFINE (scm_make_variable, "make-variable", 1, 0, 0,
- (SCM init),
- "Return a variable initialized to value @var{init}.")
- #define FUNC_NAME s_scm_make_variable
- {
- return make_variable (init);
- }
- #undef FUNC_NAME
- SCM_DEFINE (scm_make_undefined_variable, "make-undefined-variable", 0, 0, 0,
- (),
- "Return a variable that is initially unbound.")
- #define FUNC_NAME s_scm_make_undefined_variable
- {
- return make_variable (SCM_UNDEFINED);
- }
- #undef FUNC_NAME
- SCM_DEFINE (scm_variable_p, "variable?", 1, 0, 0,
- (SCM obj),
- "Return @code{#t} iff @var{obj} is a variable object, else\n"
- "return @code{#f}.")
- #define FUNC_NAME s_scm_variable_p
- {
- return scm_from_bool (SCM_VARIABLEP (obj));
- }
- #undef FUNC_NAME
- SCM_DEFINE (scm_variable_ref, "variable-ref", 1, 0, 0,
- (SCM var),
- "Dereference @var{var} and return its value.\n"
- "@var{var} must be a variable object; see @code{make-variable}\n"
- "and @code{make-undefined-variable}.")
- #define FUNC_NAME s_scm_variable_ref
- {
- SCM val;
- SCM_VALIDATE_VARIABLE (1, var);
- val = SCM_VARIABLE_REF (var);
- if (scm_is_eq (val, SCM_UNDEFINED))
- SCM_MISC_ERROR ("variable is unbound: ~S", scm_list_1 (var));
- return val;
- }
- #undef FUNC_NAME
- SCM_DEFINE (scm_variable_set_x, "variable-set!", 2, 0, 0,
- (SCM var, SCM val),
- "Set the value of the variable @var{var} to @var{val}.\n"
- "@var{var} must be a variable object, @var{val} can be any\n"
- "value. Return an unspecified value.")
- #define FUNC_NAME s_scm_variable_set_x
- {
- SCM_VALIDATE_VARIABLE (1, var);
- SCM_VARIABLE_SET (var, val);
- return SCM_UNSPECIFIED;
- }
- #undef FUNC_NAME
- SCM_DEFINE (scm_variable_unset_x, "variable-unset!", 1, 0, 0,
- (SCM var),
- "Ensure that @var{var} is not bound to a value.\n"
- "@var{var} must be a variable object.")
- #define FUNC_NAME s_scm_variable_unset_x
- {
- SCM_VALIDATE_VARIABLE (1, var);
- SCM_VARIABLE_SET (var, SCM_UNDEFINED);
- return SCM_UNSPECIFIED;
- }
- #undef FUNC_NAME
- SCM_DEFINE (scm_variable_bound_p, "variable-bound?", 1, 0, 0,
- (SCM var),
- "Return @code{#t} iff @var{var} is bound to a value.\n"
- "Throws an error if @var{var} is not a variable object.")
- #define FUNC_NAME s_scm_variable_bound_p
- {
- SCM_VALIDATE_VARIABLE (1, var);
- return scm_from_bool (!scm_is_eq (SCM_VARIABLE_REF (var), SCM_UNDEFINED));
- }
- #undef FUNC_NAME
- void
- scm_init_variable ()
- {
- #include "libguile/variable.x"
- }
|