guile18/libguile/variable.c

   1 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16  */
  17
  18
  19 \f
  20 #ifdef HAVE_CONFIG_H
  21 # include <config.h>
  22 #endif
  23
  24 #include "libguile/_scm.h"
  25 #include "libguile/eq.h"
  26 #include "libguile/ports.h"
  27 #include "libguile/root.h"
  28 #include "libguile/smob.h"
  29 #include "libguile/deprecation.h"
  30
  31 #include "libguile/validate.h"
  32 #include "libguile/variable.h"
  33 \f
  34
  35 void
  36 scm_i_variable_print (SCM exp, SCM port, scm_print_state *pstate)
  37 {
  38   scm_puts ("#<variable ", port);
  39   scm_uintprint (SCM_UNPACK (exp), 16, port);
  40   scm_puts (" value: ", port);
  41   scm_iprin1 (SCM_VARIABLE_REF (exp), port, pstate);
  42   scm_putc('>', port);
  43 }
  44
  45 \f
  46
  47 static SCM
  48 make_variable (SCM init)
  49 {
  50   return scm_cell (scm_tc7_variable, SCM_UNPACK (init));
  51 }
  52
  53 SCM_DEFINE (scm_make_variable, "make-variable", 1, 0, 0,
  54             (SCM init),
  55             "Return a variable initialized to value @var{init}.")
  56 #define FUNC_NAME s_scm_make_variable
  57 {
  58   return make_variable (init);
  59 }
  60 #undef FUNC_NAME
  61
  62
  63 SCM_DEFINE (scm_make_undefined_variable, "make-undefined-variable", 0, 0, 0,
  64             (),
  65             "Return a variable that is initially unbound.")
  66 #define FUNC_NAME s_scm_make_undefined_variable
  67 {
  68   return make_variable (SCM_UNDEFINED);
  69 }
  70 #undef FUNC_NAME
  71
  72
  73 SCM_DEFINE (scm_variable_p, "variable?", 1, 0, 0,
  74             (SCM obj),
  75             "Return @code{#t} iff @var{obj} is a variable object, else\n"
  76             "return @code{#f}.")
  77 #define FUNC_NAME s_scm_variable_p
  78 {
  79   return scm_from_bool (SCM_VARIABLEP (obj));
  80 }
  81 #undef FUNC_NAME
  82
  83
  84 SCM_DEFINE (scm_variable_ref, "variable-ref", 1, 0, 0,
  85             (SCM var),
  86             "Dereference @var{var} and return its value.\n"
  87             "@var{var} must be a variable object; see @code{make-variable}\n"
  88             "and @code{make-undefined-variable}.")
  89 #define FUNC_NAME s_scm_variable_ref
  90 {
  91   SCM val;
  92   SCM_VALIDATE_VARIABLE (1, var);
  93   val = SCM_VARIABLE_REF (var);
  94   if (val == SCM_UNDEFINED)
  95     SCM_MISC_ERROR ("variable is unbound: ~S", scm_list_1 (var));
  96   return val;
  97 }
  98 #undef FUNC_NAME
  99
 100 SCM_DEFINE (scm_variable_set_x, "variable-set!", 2, 0, 0,
 101             (SCM var, SCM val),
 102             "Set the value of the variable @var{var} to @var{val}.\n"
 103             "@var{var} must be a variable object, @var{val} can be any\n"
 104             "value. Return an unspecified value.")
 105 #define FUNC_NAME s_scm_variable_set_x
 106 {
 107   SCM_VALIDATE_VARIABLE (1, var);
 108   SCM_VARIABLE_SET (var, val);
 109   return SCM_UNSPECIFIED;
 110 }
 111 #undef FUNC_NAME
 112
 113 SCM_DEFINE (scm_variable_bound_p, "variable-bound?", 1, 0, 0,
 114             (SCM var),
 115             "Return @code{#t} iff @var{var} is bound to a value.\n"
 116             "Throws an error if @var{var} is not a variable object.")
 117 #define FUNC_NAME s_scm_variable_bound_p
 118 {
 119   SCM_VALIDATE_VARIABLE (1, var);
 120   return scm_from_bool (SCM_VARIABLE_REF (var) != SCM_UNDEFINED);
 121 }
 122 #undef FUNC_NAME
 123
 124
 125 void
 126 scm_init_variable ()
 127 {
 128 #include "libguile/variable.x"
 129 }
 130
 131 /*
 132   Local Variables:
 133   c-file-style: "gnu"
 134   End:
 135 */