1 /* Copyright (C) 2001 Free Software Foundation, Inc.
3 * This program is free software; you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation; either version 2, or (at your option)
8 * This program 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
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this software; see the file COPYING. If not, write to
15 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
16 * Boston, MA 02111-1307 USA
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
21 * The exception is that, if you link the GUILE library with other files
22 * to produce an executable, this does not by itself cause the
23 * resulting executable to be covered by the GNU General Public License.
24 * Your use of that executable is in no way restricted on account of
25 * linking the GUILE library code into it.
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
30 * This exception applies only to the code released by the
31 * Free Software Foundation under the name GUILE. If you copy
32 * code from other Free Software Foundation releases into a copy of
33 * GUILE, as the General Public License permits, the exception does
34 * not apply to the code that you add in this way. To avoid misleading
35 * anyone as to the status of such modified files, you must delete
36 * this exception notice from them.
38 * If you write modifications of your own for GUILE, it is your choice
39 * whether to permit this exception to apply to your modifications.
40 * If you do not wish that, delete this exception notice. */
45 #define ENV_OBARRAY_SIZE 31
48 scm_t_bits scm_tc16_env
;
53 struct scm_env
*p
= scm_must_malloc (sizeof (struct scm_env
),
55 p
->identifier
= SCM_BOOL_F
;
56 p
->obarray
= scm_c_make_hash_table (ENV_OBARRAY_SIZE
);
57 SCM_RETURN_NEWSMOB (scm_tc16_env
, p
);
63 struct scm_env
*p
= SCM_ENV_DATA (obj
);
64 scm_gc_mark (p
->identifier
);
71 scm_must_free (SCM_ENV_DATA (obj
));
72 return sizeof (struct scm_env
);
84 scm_c_lookup_env (SCM identifier
)
86 /* Check if the env is already loaded */
87 SCM vcell
= scm_sym2ovcell_soft (identifier
, env_table
);
89 /* If not, load the env */
90 if (SCM_FALSEP (vcell
))
92 SCM env
= scm_apply (SCM_CDR (load_env
),
93 SCM_LIST1 (identifier
), SCM_EOL
);
95 scm_misc_error ("scm_c_lookup_env",
96 "Invalid env: ~S", SCM_LIST1 (env
));
97 scm_intern_symbol (env_table
, identifier
);
98 vcell
= scm_sym2ovcell_soft (identifier
, env_table
);
99 SCM_SETCDR (vcell
, env
);
102 return SCM_CDR (vcell
);
106 scm_c_env_vcell (SCM env
, SCM name
, int intern
)
108 SCM ob
= SCM_ENV_OBARRAY (env
);
110 scm_intern_symbol (ob
, name
);
111 return scm_sym2ovcell_soft (name
, ob
);
119 SCM_DEFINE (scm_make_env
, "make-env", 0, 0, 0,
122 #define FUNC_NAME s_scm_make_env
124 return scm_c_make_env ();
128 SCM_DEFINE (scm_env_p
, "env?", 1, 0, 0,
131 #define FUNC_NAME s_scm_env_p
133 return SCM_BOOL (SCM_ENV_P (x
));
137 SCM_DEFINE (scm_env_identifier
, "env-identifier", 1, 0, 0,
140 #define FUNC_NAME s_scm_env_identifier
142 SCM_VALIDATE_ENV (1, env
);
143 return SCM_ENV_IDENTIFIER (env
);
147 SCM_DEFINE (scm_set_env_identifier_x
, "set-env-identifier!", 2, 0, 0,
148 (SCM env
, SCM identifier
),
150 #define FUNC_NAME s_scm_set_env_identifier_x
152 SCM_VALIDATE_ENV (1, env
);
153 SCM_VALIDATE_SYMBOL (2, identifier
);
154 SCM_ENV_IDENTIFIER (env
) = identifier
;
155 return SCM_UNSPECIFIED
;
159 SCM_DEFINE (scm_env_bound_p
, "env-bound?", 2, 0, 0,
162 #define FUNC_NAME s_scm_env_bound_p
165 SCM_VALIDATE_ENV (1, env
);
166 SCM_VALIDATE_SYMBOL (2, name
);
167 vcell
= scm_sym2ovcell_soft (name
, SCM_ENV_OBARRAY (env
));
168 return SCM_BOOL (!SCM_FALSEP (vcell
) && !SCM_UNBNDP (SCM_CDR (vcell
)));
172 SCM_DEFINE (scm_env_ref
, "env-ref", 2, 0, 0,
175 #define FUNC_NAME s_scm_env_ref
178 SCM_VALIDATE_ENV (1, env
);
179 SCM_VALIDATE_SYMBOL (2, name
);
180 vcell
= scm_sym2ovcell_soft (name
, SCM_ENV_OBARRAY (env
));
181 if (SCM_FALSEP (vcell
) || SCM_UNBNDP (SCM_CDR (vcell
)))
182 SCM_MISC_ERROR ("Unbound variable in env: ~A, ~A",
183 SCM_LIST2 (env
, name
));
184 return SCM_CDR (vcell
);
188 SCM_DEFINE (scm_env_set_x
, "env-set!", 3, 0, 0,
189 (SCM env
, SCM name
, SCM val
),
191 #define FUNC_NAME s_scm_env_set_x
194 SCM_VALIDATE_ENV (1, env
);
195 SCM_VALIDATE_SYMBOL (2, name
);
196 vcell
= scm_sym2ovcell_soft (name
, SCM_ENV_OBARRAY (env
));
197 if (SCM_FALSEP (vcell
))
198 SCM_MISC_ERROR ("Unbound variable in env: ~A, ~A",
199 SCM_LIST2 (env
, name
));
200 SCM_SETCDR (vcell
, val
);
201 return SCM_UNSPECIFIED
;
205 SCM_DEFINE (scm_env_define
, "env-define", 3, 0, 0,
206 (SCM env
, SCM name
, SCM val
),
208 #define FUNC_NAME s_scm_env_define
211 SCM_VALIDATE_ENV (1, env
);
212 SCM_VALIDATE_SYMBOL (2, name
);
213 vcell
= scm_c_env_vcell (env
, name
, 1);
214 SCM_SETCDR (vcell
, val
);
215 return SCM_UNSPECIFIED
;
225 scm_tc16_env
= scm_make_smob_type ("env", 0);
226 scm_set_smob_mark (scm_tc16_env
, env_mark
);
227 scm_set_smob_free (scm_tc16_env
, env_free
);
229 env_table
= scm_permanent_object (scm_c_make_hash_table (51));
231 #ifndef SCM_MAGIC_SNARFER
235 mod
= scm_current_module ();
236 load_env
= scm_eval_closure_lookup (scm_standard_eval_closure (mod
),
237 scm_str2symbol ("load-env"),
239 load_env
= scm_variable_ref (load_env
);
240 /* Was: SCM_VARVCELL (load_env); */