1 /* Copyright (C) 1998,1999,2000,2001,2002, 2003 Free Software Foundation, Inc.
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.
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.
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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 #include "libguile/_scm.h"
22 #include "libguile/eval.h"
23 #include "libguile/macros.h"
24 #include "libguile/modules.h"
25 #include "libguile/fluids.h"
27 #include "libguile/validate.h"
28 #include "libguile/evalext.h"
30 SCM_SYMBOL (scm_sym_setter
, "setter");
33 scm_m_generalized_set_x (SCM xorig
, SCM env SCM_UNUSED
)
35 SCM x
= SCM_CDR (xorig
);
36 SCM_ASSYNT (2 == scm_ilength (x
), scm_s_expression
, scm_s_set_x
);
37 if (SCM_SYMBOLP (SCM_CAR (x
)))
38 return scm_cons (SCM_IM_SET_X
, x
);
39 else if (SCM_CONSP (SCM_CAR (x
)))
40 return scm_cons (scm_list_2 (scm_sym_setter
, SCM_CAAR (x
)),
41 scm_append (scm_list_2 (SCM_CDAR (x
), SCM_CDR (x
))));
43 scm_misc_error (scm_s_set_x
, scm_s_variable
, SCM_EOL
);
46 SCM_DEFINE (scm_defined_p
, "defined?", 1, 1, 0,
48 "Return @code{#t} if @var{sym} is defined in the lexical "
49 "environment @var{env}. When @var{env} is not specified, "
50 "look in the top-level environment as defined by the "
52 #define FUNC_NAME s_scm_defined_p
56 SCM_VALIDATE_SYMBOL (1, sym
);
59 var
= scm_sym2var (sym
, scm_current_module_lookup_closure (),
65 for (; SCM_NIMP (frames
); frames
= SCM_CDR (frames
))
67 SCM_ASSERT (SCM_CONSP (frames
), env
, SCM_ARG2
, FUNC_NAME
);
69 if (SCM_NFALSEP (scm_procedure_p (b
)))
71 SCM_ASSERT (SCM_CONSP (b
), env
, SCM_ARG2
, FUNC_NAME
);
72 for (b
= SCM_CAR (b
); SCM_NIMP (b
); b
= SCM_CDR (b
))
76 if (SCM_EQ_P (b
, sym
))
81 if (SCM_EQ_P (SCM_CAR (b
), sym
))
85 var
= scm_sym2var (sym
,
86 SCM_NIMP (frames
) ? SCM_CAR (frames
) : SCM_BOOL_F
,
90 return (SCM_FALSEP (var
) || SCM_UNBNDP (SCM_VARIABLE_REF (var
))
96 #if (SCM_ENABLE_DEPRECATED == 1)
98 SCM_SYNTAX (s_undefine
, "undefine", scm_makacro
, scm_m_undefine
);
101 scm_m_undefine (SCM x
, SCM env
)
105 SCM_ASSYNT (SCM_TOP_LEVEL (env
), "bad placement ", s_undefine
);
106 SCM_ASSYNT (SCM_CONSP (x
) && SCM_NULLP (SCM_CDR (x
)),
107 scm_s_expression
, s_undefine
);
109 SCM_ASSYNT (SCM_SYMBOLP (x
), scm_s_variable
, s_undefine
);
110 arg1
= scm_sym2var (x
, scm_env_top_level (env
), SCM_BOOL_F
);
111 SCM_ASSYNT (SCM_NFALSEP (arg1
) && !SCM_UNBNDP (SCM_VARIABLE_REF (arg1
)),
112 "variable already unbound ", s_undefine
);
113 SCM_VARIABLE_SET (arg1
, SCM_UNDEFINED
);
117 return SCM_UNSPECIFIED
;
123 SCM_REGISTER_PROC (s_map_in_order
, "map-in-order", 2, 0, 1, scm_map
);
125 SCM_DEFINE (scm_self_evaluating_p
, "self-evaluating?", 1, 0, 0,
127 "Return #t for objects which Guile considers self-evaluating")
128 #define FUNC_NAME s_scm_self_evaluating_p
130 switch (SCM_ITAG3 (obj
))
137 /* characters, booleans, other immediates */
138 return SCM_BOOL (!SCM_NULLP (obj
));
140 switch (SCM_TYP7 (obj
))
142 case scm_tcs_closures
:
154 #if SCM_SIZEOF_LONG_LONG != 0
169 SCM_MISC_ERROR ("Internal error: Object ~S has unknown type",
171 return SCM_UNSPECIFIED
; /* never reached */
178 scm_make_synt (scm_s_set_x
, scm_makmmacro
, scm_m_generalized_set_x
);
179 #include "libguile/evalext.x"