evalext.c 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115
  1. /* Copyright 1998-2003,2006,2008-2013,2015,2018
  2. Free Software Foundation, Inc.
  3. This file is part of Guile.
  4. Guile is free software: you can redistribute it and/or modify it
  5. under the terms of the GNU Lesser General Public License as published
  6. by the Free Software Foundation, either version 3 of the License, or
  7. (at your option) any later version.
  8. Guile is distributed in the hope that it will be useful, but WITHOUT
  9. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  10. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
  11. License for more details.
  12. You should have received a copy of the GNU Lesser General Public
  13. License along with Guile. If not, see
  14. <https://www.gnu.org/licenses/>. */
  15. #ifdef HAVE_CONFIG_H
  16. # include <config.h>
  17. #endif
  18. #include "gsubr.h"
  19. #include "eval.h"
  20. #include "list.h"
  21. #include "fluids.h"
  22. #include "modules.h"
  23. #include "pairs.h"
  24. #include "symbols.h"
  25. #include "variable.h"
  26. #include "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_syntax:
  74. case scm_tc7_vm_cont:
  75. case scm_tc7_number:
  76. case scm_tc7_string:
  77. case scm_tc7_smob:
  78. case scm_tc7_program:
  79. case scm_tc7_bytevector:
  80. case scm_tc7_array:
  81. case scm_tc7_bitvector:
  82. case scm_tcs_struct:
  83. return SCM_BOOL_T;
  84. default:
  85. return SCM_BOOL_F;
  86. }
  87. }
  88. SCM_MISC_ERROR ("Internal error: Object ~S has unknown type",
  89. scm_list_1 (obj));
  90. return SCM_UNSPECIFIED; /* never reached */
  91. }
  92. #undef FUNC_NAME
  93. void
  94. scm_init_evalext ()
  95. {
  96. #include "evalext.x"
  97. }