libguile/procs.h

   1 /* classes: h_files */
   2
   3 #ifndef SCM_PROCS_H
   4 #define SCM_PROCS_H
   5
   6 /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
   7  *
   8  * This library is free software; you can redistribute it and/or
   9  * modify it under the terms of the GNU Lesser General Public License
  10  * as published by the Free Software Foundation; either version 3 of
  11  * the License, or (at your option) any later version.
  12  *
  13  * This library is distributed in the hope that it will be useful, but
  14  * WITHOUT ANY WARRANTY; without even the implied warranty of
  15  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16  * Lesser General Public License for more details.
  17  *
  18  * You should have received a copy of the GNU Lesser General Public
  19  * License along with this library; if not, write to the Free Software
  20  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  21  * 02110-1301 USA
  22  */
  23
  24 \f
  25
  26 #include "libguile/__scm.h"
  27
  28 \f
  29
  30
  31 /* Subrs
  32  */
  33
  34 #define SCM_SUBR_META_INFO(x)  ((SCM *) SCM_CELL_WORD_3 (x))
  35 #define SCM_SUBR_NAME(x) (SCM_SUBR_META_INFO (x) [0])
  36 #define SCM_SUBRF(x) ((SCM (*)()) SCM_CELL_WORD_1 (x))
  37 #define SCM_DSUBRF(x) ((double (*)()) SCM_CELL_WORD_1 (x))
  38 #define SCM_SUBR_PROPS(x) (SCM_SUBR_META_INFO (x) [1])
  39 #define SCM_SUBR_GENERIC(x) ((SCM *) SCM_CELL_WORD_2 (x))
  40 #define SCM_SET_SUBR_GENERIC(x, g) (*((SCM *) SCM_CELL_WORD_2 (x)) = (g))
  41 #define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SET_CELL_WORD_2 (x, (scm_t_bits) g))
  42
  43 /* Return the most suitable subr type for a subr with REQ required arguments,
  44    OPT optional arguments, and REST (0 or 1) arguments.  This has to be in
  45    sync with `create_gsubr ()'.  */
  46 #define SCM_SUBR_ARITY_TO_TYPE(req, opt, rest)                          \
  47   ((rest) == 0                                                          \
  48    ? ((opt) == 0                                                        \
  49       ? ((req) == 0                                                     \
  50          ? scm_tc7_subr_0                                               \
  51          : ((req) == 1                                                  \
  52             ? scm_tc7_subr_1                                            \
  53             : ((req) == 2                                               \
  54                ? scm_tc7_subr_2                                         \
  55                : ((req) == 3                                            \
  56                   ? scm_tc7_subr_3                                      \
  57                   : scm_tc7_gsubr                                       \
  58                     | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U)))))    \
  59       : ((opt) == 1                                                     \
  60          ? ((req) == 0                                                  \
  61             ? scm_tc7_subr_1o                                           \
  62             : ((req) == 1                                               \
  63                ? scm_tc7_subr_2o                                        \
  64                : scm_tc7_gsubr |                                        \
  65                  (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U)))           \
  66          : scm_tc7_gsubr |                                              \
  67            (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U)))                 \
  68    : ((rest) == 1                                                       \
  69       ? ((opt) == 0                                                     \
  70          ? ((req) == 0                                                  \
  71             ? scm_tc7_lsubr                                             \
  72             : ((req) == 2                                               \
  73                ? scm_tc7_lsubr_2                                        \
  74                : scm_tc7_gsubr                                          \
  75                  | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U)))         \
  76          : scm_tc7_gsubr                                                \
  77            | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U))                \
  78       : scm_tc7_gsubr                                                   \
  79         | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U)))
  80
  81
  82 \f
  83 /* Closures
  84  */
  85
  86 #define SCM_CLOSUREP(x) (!SCM_IMP(x) && (SCM_TYP3 (x) == scm_tc3_closure))
  87 #define SCM_CLOSCAR(x) SCM_PACK (SCM_CELL_WORD_0 (x) - scm_tc3_closure)
  88 #define SCM_CODE(x) SCM_CAR (SCM_CLOSCAR (x))
  89 #define SCM_CLOSURE_FORMALS(x) SCM_CAR (SCM_CODE (x))
  90 #define SCM_CLOSURE_BODY(x) SCM_CDR (SCM_CODE (x))
  91 #define SCM_PROCPROPS(x) SCM_CDR (SCM_CLOSCAR (x))
  92 #define SCM_SETPROCPROPS(x, p) SCM_SETCDR (SCM_CLOSCAR (x), p)
  93 #define SCM_ENV(x) SCM_CELL_OBJECT_1 (x)
  94 #define SCM_TOP_LEVEL(ENV)  (scm_is_null (ENV) || (scm_is_true (scm_procedure_p (SCM_CAR (ENV)))))
  95
  96 /* Procedure-with-setter
  97
  98    Four representations for procedure-with-setters were
  99    considered before selecting this one:
 100
 101    1. A closure where the CODE and ENV slots are used to represent
 102    the getter and a new SETTER slot is used for the setter.  The
 103    original getter is stored as a `getter' procedure property.  For
 104    closure getters, the CODE and ENV slots contains a copy of the
 105    getter's CODE and ENV slots.  For subr getters, the CODE contains
 106    a call to the subr.
 107
 108    2. A compiled closure with a call to the getter in the cclo
 109    procedure.  The getter and setter are stored in slots 1 and 2.
 110
 111    3. An entity (i.e. a struct with an associated procedure) with a
 112    call to the getter in the entity procedure and the setter stored
 113    in slot 0.  The original getter is stored in slot 1.
 114
 115    4. A new primitive procedure type supported in the evaluator.  The
 116    getter and setter are stored in a GETTER and SETTER slot.  A call
 117    to this procedure type results in a retrieval of the getter and a
 118    jump back to the correct eval dispatcher.
 119
 120    Representation 4 was selected because of efficiency and
 121    simplicity.
 122
 123    Rep 1 has the advantage that there is zero penalty for closure
 124    getters, but primitive getters will get considerable overhead
 125    because the procedure-with-getter will be a closure which calls
 126    the getter.
 127
 128    Rep 3 has the advantage that a GOOPS accessor can be a subclass of
 129    <procedure-with-setter>, but together with rep 2 it suffers from a
 130    three level dispatch for non-GOOPS getters:
 131
 132      cclo/struct --> dispatch proc --> getter
 133
 134    This is because the dispatch procedure must take an extra initial
 135    argument (cclo for rep 2, struct for rep 3).
 136
 137    Rep 4 has the single disadvantage that it uses up one tc7 type
 138    code, but the plan for uniform vectors will very likely free tc7
 139    codes, so this is probably no big problem.  Also note that the
 140    GETTER and SETTER slots can live directly on the heap, using the
 141    new four-word cells.  */
 142
 143 #define SCM_PROCEDURE_WITH_SETTER_P(obj) (!SCM_IMP(obj) && (SCM_TYP7 (obj) == scm_tc7_pws))
 144 #define SCM_PROCEDURE(obj) SCM_CELL_OBJECT_1 (obj)
 145 #define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj)
 146
 147
 148 \f
 149
 150 SCM_API SCM scm_c_make_subr (const char *name, long type, SCM (*fcn)());
 151 SCM_API SCM scm_c_make_subr_with_generic (const char *name, long type,
 152                                           SCM (*fcn)(), SCM *gf);
 153 SCM_API SCM scm_c_define_subr (const char *name, long type, SCM (*fcn)());
 154 SCM_API SCM scm_c_define_subr_with_generic (const char *name, long type,
 155                                             SCM (*fcn)(), SCM *gf);
 156 SCM_API SCM scm_procedure_p (SCM obj);
 157 SCM_API SCM scm_closure_p (SCM obj);
 158 SCM_API SCM scm_thunk_p (SCM obj);
 159 SCM_API int scm_subr_p (SCM obj);
 160 SCM_API SCM scm_procedure_documentation (SCM proc);
 161 SCM_API SCM scm_procedure_with_setter_p (SCM obj);
 162 SCM_API SCM scm_make_procedure_with_setter (SCM procedure, SCM setter);
 163 SCM_API SCM scm_procedure (SCM proc);
 164 SCM_API SCM scm_setter (SCM proc);
 165 SCM_INTERNAL void scm_init_procs (void);
 166
 167 #endif  /* SCM_PROCS_H */
 168
 169 /*
 170   Local Variables:
 171   c-file-style: "gnu"
 172   End:
 173 */