← Back to branch summary

~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to libguile/evalext.c

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Schepler
  • Date: 2006-11-09 03:11:16 UTC
  • Revision ID: james.westby@ubuntu.com-20061109031116-hu0q1jxqg12y6yeg
Tags: upstream-1.8.1+1
Import upstream version 1.8.1+1

Show diffs side-by-side

added added

removed removed

Lines of Context:
libguile/evalext.c
 
1
/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006 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
 
 
20
 
 
21
#include "libguile/_scm.h"
 
22
#include "libguile/eval.h"
 
23
#include "libguile/fluids.h"
 
24
#include "libguile/modules.h"
 
25
 
 
26
#include "libguile/validate.h"
 
27
#include "libguile/evalext.h"
 
28
 
 
29
SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0,
 
30
            (SCM sym, SCM env),
 
31
            "Return @code{#t} if @var{sym} is defined in the lexical "
 
32
            "environment @var{env}.  When @var{env} is not specified, "
 
33
            "look in the top-level environment as defined by the "
 
34
            "current module.")
 
35
#define FUNC_NAME s_scm_defined_p
 
36
{
 
37
  SCM var;
 
38
 
 
39
  SCM_VALIDATE_SYMBOL (1, sym);
 
40
 
 
41
  if (SCM_UNBNDP (env))
 
42
    var = scm_sym2var (sym, scm_current_module_lookup_closure (),
 
43
                         SCM_BOOL_F);
 
44
  else
 
45
    {
 
46
      SCM frames = env;
 
47
      register SCM b;
 
48
      for (; SCM_NIMP (frames); frames = SCM_CDR (frames))
 
49
        {
 
50
          SCM_ASSERT (scm_is_pair (frames), env, SCM_ARG2, FUNC_NAME);
 
51
          b = SCM_CAR (frames);
 
52
          if (scm_is_true (scm_procedure_p (b)))
 
53
            break;
 
54
          SCM_ASSERT (scm_is_pair (b), env, SCM_ARG2, FUNC_NAME);
 
55
          for (b = SCM_CAR (b); SCM_NIMP (b); b = SCM_CDR (b))
 
56
            {
 
57
              if (!scm_is_pair (b))
 
58
                {
 
59
                  if (scm_is_eq (b, sym))
 
60
                    return SCM_BOOL_T;
 
61
                  else
 
62
                    break;
 
63
                }
 
64
              if (scm_is_eq (SCM_CAR (b), sym))
 
65
                return SCM_BOOL_T;
 
66
            }
 
67
        }
 
68
      var = scm_sym2var (sym,
 
69
                         SCM_NIMP (frames) ? SCM_CAR (frames) : SCM_BOOL_F,
 
70
                         SCM_BOOL_F);
 
71
    }
 
72
              
 
73
  return (scm_is_false (var) || SCM_UNBNDP (SCM_VARIABLE_REF (var))
 
74
          ? SCM_BOOL_F
 
75
          : SCM_BOOL_T);
 
76
}
 
77
#undef FUNC_NAME
 
78
 
 
79
 
 
80
SCM_REGISTER_PROC (s_map_in_order, "map-in-order", 2, 0, 1, scm_map);
 
81
 
 
82
 
 
83
SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
 
84
            (SCM obj),
 
85
            "Return #t for objects which Guile considers self-evaluating")
 
86
#define FUNC_NAME s_scm_self_evaluating_p
 
87
{
 
88
  switch (SCM_ITAG3 (obj))
 
89
    {
 
90
    case scm_tc3_int_1:
 
91
    case scm_tc3_int_2:
 
92
      /* inum */
 
93
      return SCM_BOOL_T;
 
94
    case scm_tc3_imm24:
 
95
        /* characters, booleans, other immediates */
 
96
      return scm_from_bool (!scm_is_null (obj));
 
97
    case scm_tc3_cons:
 
98
      switch (SCM_TYP7 (obj))
 
99
        {
 
100
        case scm_tcs_closures:
 
101
        case scm_tc7_vector:
 
102
        case scm_tc7_wvect:
 
103
        case scm_tc7_number:
 
104
        case scm_tc7_string:
 
105
        case scm_tc7_smob:
 
106
        case scm_tc7_cclo:
 
107
        case scm_tc7_pws:
 
108
        case scm_tcs_subrs:
 
109
        case scm_tcs_struct:
 
110
          return SCM_BOOL_T;
 
111
        default:
 
112
          return SCM_BOOL_F;
 
113
        }
 
114
    }
 
115
  SCM_MISC_ERROR ("Internal error: Object ~S has unknown type",
 
116
                  scm_list_1 (obj));
 
117
  return SCM_UNSPECIFIED; /* never reached */
 
118
}
 
119
#undef FUNC_NAME
 
120
 
 
121
void 
 
122
scm_init_evalext ()
 
123
{
 
124
#include "libguile/evalext.x"
 
125
}
 
126
 
 
127
/*
 
128
  Local Variables:
 
129
  c-file-style: "gnu"
 
130
  End:
 
131
*/