evalext.c 2.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116
  1. /* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2015 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. #ifdef HAVE_CONFIG_H
  19. # include <config.h>
  20. #endif
  21. #include "libguile/_scm.h"
  22. #include "libguile/eval.h"
  23. #include "libguile/fluids.h"
  24. #include "libguile/modules.h"
  25. #include "libguile/validate.h"
  26. #include "libguile/evalext.h"
  27. SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0,
  28. (SCM sym, SCM module),
  29. "Return @code{#t} if @var{sym} is defined in the module "
  30. "@var{module} or the current module when @var{module} is not"
  31. "specified.")
  32. #define FUNC_NAME s_scm_defined_p
  33. {
  34. SCM var;
  35. SCM_VALIDATE_SYMBOL (1, sym);
  36. if (SCM_UNBNDP (module))
  37. module = scm_current_module ();
  38. else
  39. SCM_VALIDATE_MODULE (2, module);
  40. var = scm_module_variable (module, sym);
  41. return (scm_is_false (var) || SCM_UNBNDP (SCM_VARIABLE_REF (var))
  42. ? SCM_BOOL_F
  43. : SCM_BOOL_T);
  44. }
  45. #undef FUNC_NAME
  46. SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
  47. (SCM obj),
  48. "Return #t for objects which Guile considers self-evaluating")
  49. #define FUNC_NAME s_scm_self_evaluating_p
  50. {
  51. switch (SCM_ITAG3 (obj))
  52. {
  53. case scm_tc3_int_1:
  54. case scm_tc3_int_2:
  55. /* inum */
  56. return SCM_BOOL_T;
  57. case scm_tc3_imm24:
  58. /* characters, booleans, other immediates */
  59. return scm_from_bool (!scm_is_null_and_not_nil (obj));
  60. case scm_tc3_cons:
  61. switch (SCM_TYP7 (obj))
  62. {
  63. case scm_tc7_vector:
  64. case scm_tc7_wvect:
  65. case scm_tc7_pointer:
  66. case scm_tc7_hashtable:
  67. case scm_tc7_weak_set:
  68. case scm_tc7_weak_table:
  69. case scm_tc7_fluid:
  70. case scm_tc7_dynamic_state:
  71. case scm_tc7_frame:
  72. case scm_tc7_keyword:
  73. case scm_tc7_vm_cont:
  74. case scm_tc7_number:
  75. case scm_tc7_string:
  76. case scm_tc7_smob:
  77. case scm_tc7_program:
  78. case scm_tc7_bytevector:
  79. case scm_tc7_array:
  80. case scm_tc7_bitvector:
  81. case scm_tcs_struct:
  82. return SCM_BOOL_T;
  83. default:
  84. return SCM_BOOL_F;
  85. }
  86. }
  87. SCM_MISC_ERROR ("Internal error: Object ~S has unknown type",
  88. scm_list_1 (obj));
  89. return SCM_UNSPECIFIED; /* never reached */
  90. }
  91. #undef FUNC_NAME
  92. void
  93. scm_init_evalext ()
  94. {
  95. #include "libguile/evalext.x"
  96. }
  97. /*
  98. Local Variables:
  99. c-file-style: "gnu"
  100. End:
  101. */