libguile/gscm.h

   1 /* classes: h_files */
   2
   3 #ifndef GSCMH
   4 #define GSCMH
   5
   6 /*      Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
   7  *
   8  * This program is free software; you can redistribute it and/or modify
   9  * it under the terms of the GNU General Public License as published by
  10  * the Free Software Foundation; either version 2, or (at your option)
  11  * any later version.
  12  *
  13  * This program is distributed in the hope that it will be useful,
  14  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  15  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16  * GNU General Public License for more details.
  17  *
  18  * You should have received a copy of the GNU General Public License
  19  * along with this software; see the file COPYING.  If not, write to
  20  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21  *
  22  * As a special exception, the Free Software Foundation gives permission
  23  * for additional uses of the text contained in its release of GUILE.
  24  *
  25  * The exception is that, if you link the GUILE library with other files
  26  * to produce an executable, this does not by itself cause the
  27  * resulting executable to be covered by the GNU General Public License.
  28  * Your use of that executable is in no way restricted on account of
  29  * linking the GUILE library code into it.
  30  *
  31  * This exception does not however invalidate any other reasons why
  32  * the executable file might be covered by the GNU General Public License.
  33  *
  34  * This exception applies only to the code released by the
  35  * Free Software Foundation under the name GUILE.  If you copy
  36  * code from other Free Software Foundation releases into a copy of
  37  * GUILE, as the General Public License permits, the exception does
  38  * not apply to the code that you add in this way.  To avoid misleading
  39  * anyone as to the status of such modified files, you must delete
  40  * this exception notice from them.
  41  *
  42  * If you write modifications of your own for GUILE, it is your choice
  43  * whether to permit this exception to apply to your modifications.
  44  * If you do not wish that, delete this exception notice.
  45  */
  46 \f
  47
  48 #include "libguile.h"
  49
  50 \f
  51 /* {Locking Out Async Execution (including async GC) and Non-Local Exits}
  52  */
  53
  54 #define GSCM_DEFER_INTS                 SCM_DEFER_INTS
  55 #define GSCM_ALLOW_INTS                 SCM_ALLOW_INTS
  56
  57 \f
  58 /* {Common Constants}
  59  */
  60
  61 #define GSCM_EOL                        SCM_EOL
  62 #define GSCM_FALSE                      SCM_BOOL_F
  63 #define GSCM_TRUE                       SCM_BOOL_T
  64
  65 #define GSCM_EOL_MARKER                 SCM_UNDEFINED
  66 #define GSCM_NOT_PASSED                 SCM_UNDEFINED
  67 #define GSCM_UNSPECIFIED                SCM_UNSPECIFIED
  68
  69 \f
  70 /* {Booleans}
  71  */
  72
  73 #define gscm_bool(CBOOL)        ((CBOOL) ? SCM_BOOL_T : SCM_BOOL_F)
  74 #define gscm_2_bool(BOOL)       (((BOOL) == SCM_BOOL_F) ? 0 : 1)
  75
  76 \f
  77 /* {Numbers}
  78  */
  79
  80 #define gscm_ulong              scm_ulong2num
  81 #define gscm_long               scm_long2num
  82 #define gscm_double(X)          scm_makdbl ((X), 0.0)
  83
  84 #define gscm_2_ulong(OBJ)       scm_num2ulong((OBJ), (char *)SCM_ARG1, "gscm_2_ulong")
  85 #define gscm_2_long(OBJ)        scm_num2long((OBJ), (char *)SCM_ARG1, "gscm_2_long")
  86 #define gscm_2_double(OBJ)      scm_num2dbl((OBJ), "gscm_2_double")
  87
  88 \f
  89 /* {Characters}
  90  */
  91
  92 #define gscm_char(C)            SCM_MAKICHR(C)
  93 /* extern int gscm_2_char               P((SCM)); */
  94
  95 \f
  96 /* {Strings}
  97  */
  98
  99 #define gscm_str(SRC, LEN)      scm_makfromstr (SRC, LEN, 0)
 100 #define gscm_str0               scm_makfrom0str
 101
 102 \f
 103
 104 /* {Pairs and Lists}
 105  */
 106
 107 #define gscm_cons                       scm_cons
 108 #define gscm_list                       scm_listify
 109 #define gscm_ilength                    scm_ilength
 110
 111
 112 #define gscm_set_car(OBJ, VAL) \
 113    ((SCM_NIMP(OBJ) && SCM_CONSP(OBJ)) \
 114                    ? (SCM_CAR(OBJ) = VAL) \
 115                    : scm_wta ((OBJ), (char *)SCM_ARG1, "set-car!"))
 116
 117 #define gscm_set_cdr(OBJ, VAL) \
 118    ((SCM_NIMP(OBJ) && SCM_CONSP(OBJ)) \
 119                    ? (SCM_CDR(OBJ) = VAL) \
 120                    : scm_wta ((OBJ), (char *)SCM_ARG1, "set-cdr!"))
 121
 122
 123 #define GSCM_SAFE_CAR(X)   ((SCM_NIMP(X) && SCM_CONSP(X)) \
 124                    ? SCM_CAR(X) \
 125                    : scm_wta ((X), (char *)SCM_ARG1, "car"))
 126
 127 #define GSCM_SAFE_CDR(X)   ((SCM_NIMP(X) && SCM_CONSP(X)) \
 128                    ? SCM_CDR(X) \
 129                    : scm_wta ((X), (char *)SCM_ARG1, "cdr"))
 130
 131 #define gscm_car(OBJ)           GSCM_SAFE_CAR (OBJ)
 132 #define gscm_cdr(OBJ)           GSCM_SAFE_CDR (OBJ)
 133
 134 #define gscm_caar(OBJ)          GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))
 135 #define gscm_cdar(OBJ)          GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))
 136 #define gscm_cadr(OBJ)          GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))
 137 #define gscm_cddr(OBJ)          GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))
 138
 139 #define gscm_caaar(OBJ)         GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ)))
 140 #define gscm_cdaar(OBJ)         GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ)))
 141 #define gscm_cadar(OBJ)         GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ)))
 142 #define gscm_cddar(OBJ)         GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ)))
 143 #define gscm_caadr(OBJ)         GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ)))
 144 #define gscm_cdadr(OBJ)         GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ)))
 145 #define gscm_caddr(OBJ)         GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ)))
 146 #define gscm_cdddr(OBJ)         GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ)))
 147
 148 #define gscm_caaaar(OBJ)        GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
 149 #define gscm_cdaaar(OBJ)        GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
 150 #define gscm_cadaar(OBJ)        GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
 151 #define gscm_cddaar(OBJ)        GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
 152 #define gscm_caadar(OBJ)        GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
 153 #define gscm_cdadar(OBJ)        GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
 154 #define gscm_caddar(OBJ)        GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
 155 #define gscm_cdddar(OBJ)        GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
 156 #define gscm_caaadr(OBJ)        GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
 157 #define gscm_cdaadr(OBJ)        GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
 158 #define gscm_cadadr(OBJ)        GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
 159 #define gscm_cddadr(OBJ)        GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
 160 #define gscm_caaddr(OBJ)        GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
 161 #define gscm_cdaddr(OBJ)        GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
 162 #define gscm_cadddr(OBJ)        GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
 163 #define gscm_cddddr(OBJ)        GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
 164
 165 \f
 166 /* {Symbols}
 167  */
 168
 169 #define gscm_symbol(STR, LEN)           SCM_CAR(scm_intern (STR, LEN))
 170 #define gscm_tmp_symbol(STR, LEN)       SCM_CAR(scm_intern_obarray (STR, LEN, SCM_BOOL_F))
 171
 172 \f
 173 /* {Vectors}
 174  */
 175
 176 #define gscm_vector(N, FILL)            scm_make_vector (SCM_MAKINUM(N), (FILL), SCM_UNDEFINED)
 177 #define gscm_vref(V, I)                 scm_vector_ref ((V), SCM_MAKINUM(I))
 178 #define gscm_vset(V, I, VAL)            scm_vector_set_x ((V), SCM_MAKINUM(I), (VAL))
 179
 180 \f
 181 /* {Procedures}
 182  */
 183
 184 /* extern SCM gscm_make_subr P((SCM (*fn)(), int req, int opt, int varp, char * doc)); */
 185 /* extern SCM gscm_curry P((SCM procedure, SCM first_arg)); */
 186
 187 #define gscm_apply(PROC, ARGS)          scm_apply ((PROC), (ARGS), SCM_EOL)
 188
 189
 190 \f
 191 /* {Non-local Exits}
 192  */
 193
 194
 195 #define gscm_catch(T, TH, H)            scm_catch ((T), (TH), (H))
 196 #define gscm_throw(T, V)                scm_throw ((T), (V))
 197 #define gscm_dynamic_wind(E, T, L)      scm_dynwind ((E), (T), (L))
 198 /* extern void gscm_error P((char * message, SCM args)); */
 199
 200 \f
 201 /* {I/O}
 202  */
 203
 204 #define gscm_print_obj                  scm_iprin1
 205 #define gscm_putc                       scm_putc
 206 #define gscm_puts                       scm_puts
 207 #define gscm_fwrite                     scm_fwrite
 208 #define gscm_flush                      scm_flush
 209
 210 extern char * gscm_last_attempted_init_file;
 211 \f
 212 /* {Equivalence}
 213  */
 214
 215
 216 #define gscm_is_eq(OBJ)         (SCM_BOOL_F != scm_eq (OBJ))
 217 #define gscm_is_eqv(OBJ)        (SCM_BOOL_F != scm_eqv (OBJ))
 218 #define gscm_is_equal(OBJ)      (SCM_BOOL_F != scm_equal_p (OBJ))
 219
 220 \f
 221 /* {Procedure Properties}
 222  */
 223
 224 #define gscm_procedure_properties               scm_procedure_properties
 225 #define gscm_set_procedure_properties_x         scm_set_procedure_properties_x
 226 #define gscm_procedure_property                 scm_procedure_property
 227 #define gscm_set_procedure_property_x           scm_set_procedure_property_x
 228
 229 \f
 230 /* {Generic Length Procedure}
 231  */
 232
 233 #define gscm_obj_length                         scm_obj_length
 234
 235 \f
 236 /* {Proc Declaration Macro}
 237  */
 238 #ifndef GSCM_MAGIC_SNARFER
 239 #define GSCM_PROC(RANAME, CFN, STR, REQ, OPT, VAR)  \
 240         static char RANAME[]=STR;
 241 #else
 242 #define GSCM_PROC(RANAME, CFN, STR, REQ, OPT, VAR)  \
 243 %%% gscm_define_procedure (RANAME, CFN, REQ, OPT, VAR, "")
 244 #endif
 245
 246 #define gscm_define_procedure(NAME, FN, REQ, OPT, VARP, DOC)    scm_make_gsubr(name, req, opt, varp, fn)
 247 #define gscm_curry                                              scm_curry
 248 #define gscm_define                                             scm_sysintern
 249 \f
 250
 251 typedef int GSCM_top_level;
 252
 253 \f
 254 /* {Error Returns}
 255  */
 256
 257 typedef int GSCM_status;
 258
 259 #define GSCM_OK                         0
 260 #define GSCM_ERROR                      1
 261 #define GSCM_ILLEGALLY_REENTERED        2
 262 #define GSCM_OUT_OF_MEM                 3
 263 #define GSCM_ERROR_OPENING_FILE         4
 264 #define GSCM_ERROR_OPENING_INIT_FILE    5
 265
 266 \f
 267
 268 #ifdef __STDC__
 269 extern GSCM_status gscm_seval_str (SCM *answer, GSCM_top_level toplvl, char * str);
 270 extern GSCM_status gscm_seval_file (SCM *answer, GSCM_top_level toplvl, char * file_name);
 271 extern GSCM_status gscm_eval_str (char ** answer, GSCM_top_level toplvl, char * str);
 272 extern GSCM_status gscm_eval_file (char ** answer, GSCM_top_level toplvl, char * file_name);
 273 extern GSCM_status gscm_run_scm (int argc, char ** argv, FILE * in, FILE * out, FILE * err, GSCM_status (*initfn)(), char * initfile, char * initcmd);
 274 extern char * gscm_error_msg (int n);
 275 extern SCM gscm_make_subr (SCM (*fn)(), int req, int opt, int varp, char * doc);
 276 extern int gscm_2_char (SCM c);
 277 extern void gscm_2_str (char ** out, int * len_out, SCM * objp);
 278 extern void gscm_error (char * message, SCM args);
 279 extern void scm_init_guile (void);
 280
 281 #else /* STDC */
 282 extern GSCM_status gscm_seval_str ();
 283 extern void format_load_command ();
 284 extern GSCM_status gscm_seval_file ();
 285 extern GSCM_status gscm_eval_str ();
 286 extern GSCM_status gscm_eval_file ();
 287 extern char * gscm_error_msg ();
 288 extern SCM gscm_make_subr ();
 289 extern int gscm_2_char ();
 290 extern void gscm_2_str ();
 291 extern void gscm_error ();
 292 extern GSCM_status gscm_run_scm ();
 293 extern void scm_init_guile ();
 294
 295 #endif /* STDC */
 296 #endif  /* GSCMH */
 297