1 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008, 2011 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 License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
7 *
8 * This library is distributed in the hope that it will be useful, but
9 * 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
16 * 02110-1301 USA
17 */
18
19
20
21 #ifdef HAVE_CONFIG_H
22 # include <config.h>
23 #endif
24
25 #include "libguile/_scm.h"
26 #include "libguile/eq.h"
27 #include "libguile/ports.h"
28 #include "libguile/smob.h"
29 #include "libguile/deprecation.h"
30
31 #include "libguile/validate.h"
32 #include "libguile/variable.h"
33
34
35 void
scm_i_variable_print(SCM exp,SCM port,scm_print_state * pstate)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
46
47 static SCM
make_variable(SCM init)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 (scm_is_eq (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_unset_x, "variable-unset!", 1, 0, 0,
114 (SCM var),
115 "Ensure that @var{var} is not bound to a value.\n"
116 "@var{var} must be a variable object.")
117 #define FUNC_NAME s_scm_variable_unset_x
118 {
119 SCM_VALIDATE_VARIABLE (1, var);
120 SCM_VARIABLE_SET (var, SCM_UNDEFINED);
121 return SCM_UNSPECIFIED;
122 }
123 #undef FUNC_NAME
124
125 SCM_DEFINE (scm_variable_bound_p, "variable-bound?", 1, 0, 0,
126 (SCM var),
127 "Return @code{#t} iff @var{var} is bound to a value.\n"
128 "Throws an error if @var{var} is not a variable object.")
129 #define FUNC_NAME s_scm_variable_bound_p
130 {
131 SCM_VALIDATE_VARIABLE (1, var);
132 return scm_from_bool (!scm_is_eq (SCM_VARIABLE_REF (var), SCM_UNDEFINED));
133 }
134 #undef FUNC_NAME
135
136
137 void
scm_init_variable()138 scm_init_variable ()
139 {
140 #include "libguile/variable.x"
141 }
142
143 /*
144 Local Variables:
145 c-file-style: "gnu"
146 End:
147 */
148