1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
/* Copyright (C) 1998,1999,2000,2001,2002,2003 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#include "libguile/_scm.h"
#include "libguile/eval.h"
#include "libguile/fluids.h"
#include "libguile/modules.h"
#include "libguile/validate.h"
#include "libguile/evalext.h"
SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0,
(SCM sym, SCM env),
"Return @code{#t} if @var{sym} is defined in the lexical "
"environment @var{env}. When @var{env} is not specified, "
"look in the top-level environment as defined by the "
"current module.")
#define FUNC_NAME s_scm_defined_p
{
SCM var;
SCM_VALIDATE_SYMBOL (1, sym);
if (SCM_UNBNDP (env))
var = scm_sym2var (sym, scm_current_module_lookup_closure (),
SCM_BOOL_F);
else
{
SCM frames = env;
register SCM b;
for (; SCM_NIMP (frames); frames = SCM_CDR (frames))
{
SCM_ASSERT (SCM_CONSP (frames), env, SCM_ARG2, FUNC_NAME);
b = SCM_CAR (frames);
if (scm_is_true (scm_procedure_p (b)))
break;
SCM_ASSERT (SCM_CONSP (b), env, SCM_ARG2, FUNC_NAME);
for (b = SCM_CAR (b); SCM_NIMP (b); b = SCM_CDR (b))
{
if (!SCM_CONSP (b))
{
if (scm_is_eq (b, sym))
return SCM_BOOL_T;
else
break;
}
if (scm_is_eq (SCM_CAR (b), sym))
return SCM_BOOL_T;
}
}
var = scm_sym2var (sym,
SCM_NIMP (frames) ? SCM_CAR (frames) : SCM_BOOL_F,
SCM_BOOL_F);
}
return (scm_is_false (var) || SCM_UNBNDP (SCM_VARIABLE_REF (var))
? SCM_BOOL_F
: SCM_BOOL_T);
}
#undef FUNC_NAME
SCM_REGISTER_PROC (s_map_in_order, "map-in-order", 2, 0, 1, scm_map);
SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
(SCM obj),
"Return #t for objects which Guile considers self-evaluating")
#define FUNC_NAME s_scm_self_evaluating_p
{
switch (SCM_ITAG3 (obj))
{
case scm_tc3_int_1:
case scm_tc3_int_2:
/* inum */
return SCM_BOOL_T;
case scm_tc3_imm24:
/* characters, booleans, other immediates */
return scm_from_bool (!SCM_NULLP (obj));
case scm_tc3_cons:
switch (SCM_TYP7 (obj))
{
case scm_tcs_closures:
case scm_tc7_vector:
case scm_tc7_wvect:
#if SCM_HAVE_ARRAYS
case scm_tc7_bvect:
case scm_tc7_byvect:
case scm_tc7_svect:
case scm_tc7_ivect:
case scm_tc7_uvect:
case scm_tc7_fvect:
case scm_tc7_dvect:
case scm_tc7_cvect:
#if SCM_SIZEOF_LONG_LONG != 0
case scm_tc7_llvect:
#endif
#endif
case scm_tc7_number:
case scm_tc7_string:
case scm_tc7_smob:
case scm_tc7_cclo:
case scm_tc7_pws:
case scm_tcs_subrs:
case scm_tcs_struct:
return SCM_BOOL_T;
default:
return SCM_BOOL_F;
}
}
SCM_MISC_ERROR ("Internal error: Object ~S has unknown type",
scm_list_1 (obj));
return SCM_UNSPECIFIED; /* never reached */
}
#undef FUNC_NAME
void
scm_init_evalext ()
{
#include "libguile/evalext.x"
}
/*
Local Variables:
c-file-style: "gnu"
End:
*/
|
