1 /*=========================================================================== 2 * Filename : sigschemeinternal.h 3 * About : variable and function definitions for internal use 4 * 5 * Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp> 6 * Copyright (C) 2005-2006 Jun Inoue <jun.lambda AT gmail.com> 7 * Copyright (C) 2005-2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp> 8 * Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com> 9 * 10 * All rights reserved. 11 * 12 * Redistribution and use in source and binary forms, with or without 13 * modification, are permitted provided that the following conditions 14 * are met: 15 * 16 * 1. Redistributions of source code must retain the above copyright 17 * notice, this list of conditions and the following disclaimer. 18 * 2. Redistributions in binary form must reproduce the above copyright 19 * notice, this list of conditions and the following disclaimer in the 20 * documentation and/or other materials provided with the distribution. 21 * 3. Neither the name of authors nor the names of its contributors 22 * may be used to endorse or promote products derived from this software 23 * without specific prior written permission. 24 * 25 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS 26 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, 27 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 28 * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR 29 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 30 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 31 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; 32 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 33 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 34 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 35 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 36 ===========================================================================*/ 37 #ifndef __SIGSCHEMEINTERNAL_H 38 #define __SIGSCHEMEINTERNAL_H 39 40 #include <config.h> 41 42 #include <stddef.h> 43 #include <string.h> 44 45 #include "global.h" 46 #include "sigscheme.h" 47 #if SCM_USE_MULTIBYTE_CHAR 48 #include "encoding.h" 49 #else 50 #include "encoding-dummy.h" 51 #endif 52 #if SCM_USE_PORT 53 #include "scmport.h" 54 #endif 55 56 #ifdef __cplusplus 57 extern "C" { 58 #endif 59 60 /*======================================= 61 Prefix-less Abbreviation Names 62 =======================================*/ 63 /* TODO: generate these automatically and maybe put them in an optional public 64 * header file. */ 65 66 #define SYM_QUOTE SCM_SYM_QUOTE 67 #define SYM_QUASIQUOTE SCM_SYM_QUASIQUOTE 68 #define SYM_UNQUOTE SCM_SYM_UNQUOTE 69 #define SYM_UNQUOTE_SPLICING SCM_SYM_UNQUOTE_SPLICING 70 #define SYM_ELLIPSIS SCM_SYM_ELLIPSIS 71 72 #define EQ SCM_EQ 73 #define NULLP SCM_NULLP 74 #define FALSEP SCM_FALSEP 75 #define TRUEP SCM_TRUEP 76 #define EOFP SCM_EOFP 77 78 #define CAR SCM_CAR 79 #define CDR SCM_CDR 80 #define SET_CAR SCM_CONS_SET_CAR 81 #define SET_CDR SCM_CONS_SET_CDR 82 #define CAAR SCM_CAAR 83 #define CADR SCM_CADR 84 #define CDAR SCM_CDAR 85 #define CDDR SCM_CDDR 86 87 #define CONS SCM_CONS 88 #define IMMUTABLE_CONS SCM_IMMUTABLE_CONS 89 #define LIST_1 SCM_LIST_1 90 #define LIST_2 SCM_LIST_2 91 #define LIST_3 SCM_LIST_3 92 #define LIST_4 SCM_LIST_4 93 #define LIST_5 SCM_LIST_5 94 95 #define DEREF SCM_DEREF 96 #define SET SCM_SET 97 #define REF_CAR SCM_REF_CAR 98 #define REF_CDR SCM_REF_CDR 99 #define REF_OFF_HEAP SCM_REF_OFF_HEAP 100 101 #define EVAL SCM_EVAL 102 103 #define MAKE_BOOL SCM_MAKE_BOOL 104 #define MAKE_INT SCM_MAKE_INT 105 #define MAKE_CONS SCM_MAKE_CONS 106 #define MAKE_IMMUTABLE_CONS SCM_MAKE_IMMUTABLE_CONS 107 #define MAKE_SYMBOL SCM_MAKE_SYMBOL 108 #define MAKE_CHAR SCM_MAKE_CHAR 109 110 #define MAKE_STRING SCM_MAKE_STRING 111 #define MAKE_STRING_COPYING SCM_MAKE_STRING_COPYING 112 #define MAKE_IMMUTABLE_STRING SCM_MAKE_IMMUTABLE_STRING 113 #define MAKE_IMMUTABLE_STRING_COPYING SCM_MAKE_IMMUTABLE_STRING_COPYING 114 #define CONST_STRING SCM_CONST_STRING 115 #define STRLEN_UNKNOWN SCM_STRLEN_UNKNOWN 116 117 #define MAKE_FUNC SCM_MAKE_FUNC 118 #define MAKE_CLOSURE SCM_MAKE_CLOSURE 119 #define MAKE_VECTOR SCM_MAKE_VECTOR 120 #define MAKE_IMMUTABLE_VECTOR SCM_MAKE_IMMUTABLE_VECTOR 121 #define MAKE_PORT SCM_MAKE_PORT 122 #define MAKE_CONTINUATION SCM_MAKE_CONTINUATION 123 #define MAKE_C_POINTER SCM_MAKE_C_POINTER 124 #define MAKE_C_FUNCPOINTER SCM_MAKE_C_FUNCPOINTER 125 #define MAKE_VALUEPACKET SCM_MAKE_VALUEPACKET 126 127 #define MAKE_HMACRO SCM_MAKE_HMACRO 128 #define MAKE_FARSYMBOL SCM_MAKE_FARSYMBOL 129 #define MAKE_SUBPAT SCM_MAKE_SUBPAT 130 131 #define NUMBERP SCM_NUMBERP 132 #define INTP SCM_INTP 133 #define CONSP SCM_CONSP 134 #define SYMBOLP SCM_SYMBOLP 135 #define CHARP SCM_CHARP 136 #define STRINGP SCM_STRINGP 137 #define FUNCP SCM_FUNCP 138 #define SYNTAXP SCM_SYNTAXP 139 #define CLOSUREP SCM_CLOSUREP 140 #define SYNTACTIC_CLOSUREP SCM_SYNTACTIC_CLOSUREP 141 #define PROCEDUREP SCM_PROCEDUREP 142 #define SYNTACTIC_OBJECTP SCM_SYNTACTIC_OBJECTP 143 #define VECTORP SCM_VECTORP 144 #define PORTP SCM_PORTP 145 #define CONTINUATIONP SCM_CONTINUATIONP 146 #define NULLVALUESP SCM_NULLVALUESP 147 #define VALUEPACKETP SCM_VALUEPACKETP 148 #define HMACROP SCM_HMACROP 149 #define FARSYMBOLP SCM_FARSYMBOLP 150 #define SUBPATP SCM_SUBPATP 151 #define FREECELLP SCM_FREECELLP 152 #define C_POINTERP SCM_C_POINTERP 153 #define C_FUNCPOINTERP SCM_C_FUNCPOINTERP 154 #define ENVP SCM_ENVP 155 #define VALID_ENVP SCM_VALID_ENVP 156 #define ERROBJP SCM_ERROBJP 157 #define IDENTIFIERP SCM_IDENTIFIERP 158 159 #define LISTP SCM_LISTP 160 #define LIST_1_P SCM_LIST_1_P 161 #define LIST_2_P SCM_LIST_2_P 162 #define LIST_3_P SCM_LIST_3_P 163 #define LIST_4_P SCM_LIST_4_P 164 #define LIST_5_P SCM_LIST_5_P 165 #define PROPER_LISTP SCM_PROPER_LISTP 166 #define DOTTED_LISTP SCM_DOTTED_LISTP 167 #define CIRCULAR_LISTP SCM_CIRCULAR_LISTP 168 169 #define CDBG SCM_CDBG 170 #define DBG SCM_DBG 171 172 #define ENSURE_ALLOCATED SCM_ENSURE_ALLOCATED 173 #define ENSURE_PROPER_LIST_TERMINATION SCM_ENSURE_PROPER_LIST_TERMINATION 174 #define CHECK_PROPER_LIST_TERMINATION SCM_CHECK_PROPER_LIST_TERMINATION 175 176 177 /* 178 * Abbrev name for these constants are not provided since it involves some 179 * consistency problems and confusions. Use the canonical names always. 180 * 181 * SCM_NULL 182 * SCM_TRUE 183 * SCM_FALSE 184 * SCM_EOF 185 * SCM_UNBOUND 186 * SCM_UNDEF 187 */ 188 189 /*======================================= 190 Macro Definitions 191 =======================================*/ 192 #define SCM_ERR_HEADER "Error: " 193 194 #define ERRMSG_FIXNUM_OVERFLOW "fixnum overflow" 195 #define ERRMSG_UNHANDLED_EXCEPTION "unhandled exception" 196 #define SCM_ERRMSG_IMPROPER_ARGS \ 197 "proper list required for function call but got" 198 #define SCM_ERRMSG_NULL_IN_STRING \ 199 "null character in a middle of string is not enabled" 200 #define ERRMSG_UNSUPPORTED_ENCODING "unsupported encoding" 201 #define ERRMSG_CODEC_SW_NOT_SUPPORTED \ 202 "character encoding switching is not supported on this build" 203 204 #if SCM_STRICT_TOPLEVEL_DEFINITIONS 205 /* FIXME: temporary hack. SCM_EOF is only used as an unique ID. */ 206 #define SCM_INTERACTION_ENV_INDEFINABLE SCM_EOF 207 #endif 208 209 /* specifies whether the storage abstraction layer can only handle nested 210 * (stacked) continuation or R5RS-conformant full implementation. But current 211 * implementation only supports '1'. */ 212 #define SCM_NESTED_CONTINUATION_ONLY 1 213 #define INVALID_CONTINUATION_OPAQUE NULL 214 215 /* trace stack for debugging */ 216 #define MAKE_TRACE_FRAME(obj, env) CONS((obj), (env)) 217 #define TRACE_FRAME_OBJ CAR 218 #define TRACE_FRAME_ENV CDR 219 220 /* TODO: Remove valuecons to increase simiplicity. */ 221 /* Extraction of a valuepacket is granted only for SigScheme-internals */ 222 #define SCM_VALUEPACKET_VALUES(o) SCM_SAL_VALUEPACKET_VALUES(o) 223 #if SCM_USE_VALUECONS 224 #define SCM_NULLVALUESP(o) SCM_SAL_NULLVALUESP(o) 225 #define SCM_VALUECONS_CAR(o) SCM_SAL_VALUECONS_CAR(o) 226 #define SCM_VALUECONS_CDR(o) SCM_SAL_VALUECONS_CDR(o) 227 #else /* SCM_USE_VALUECONS */ 228 #define SCM_VALUEPACKET_SET_VALUES(o, vals) \ 229 SCM_SAL_VALUEPACKET_SET_VALUES((o), (vals)) 230 #endif /* SCM_USE_VALUECONS */ 231 232 /* TODO: Remove the concept 'freecell object' from SAL and replace with 233 * ordinary cons cells with freecell-marker in storage-{compact,fatty}. */ 234 #define SCM_AS_FREECELL(o) SCM_SAL_AS_FREECELL(o) 235 236 #define SCM_FREECELLP(o) SCM_SAL_FREECELLP(o) 237 #define SCM_FREECELL_NEXT(o) SCM_SAL_FREECELL_NEXT(o) 238 #define SCM_FREECELL_FREESLOT(o) SCM_SAL_FREECELL_FREESLOT(o) 239 #define SCM_FREECELL_SET_NEXT(o, next) SCM_SAL_FREECELL_SET_NEXT((o), (next)) 240 #define SCM_FREECELL_SET_FREESLOT(o, v) SCM_SAL_FREECELL_SET_FREESLOT((o), (v)) 241 #define SCM_FREECELL_CLEAR_FREESLOT(o) SCM_SAL_FREECELL_CLEAR_FREESLOT((o)) 242 243 #define EQVP(a, b) (SCM_EQVP((a), (b))) 244 #define EQUALP(a, b) (TRUEP(scm_p_equalp((a), (b)))) 245 #define STRING_EQUALP(str1, str2) \ 246 (EQ((str1), (str2)) \ 247 || (SCM_STRING_LEN(str1) == SCM_STRING_LEN(str2) /* rough rejection */ \ 248 && strcmp(SCM_STRING_STR(str1), SCM_STRING_STR(str2)) == 0)) 249 250 /* result encoders for scm_length() */ 251 /* Dotted list length (follows SRFI-1 definition) is encoded as 252 * (-length - 1) */ 253 #define SCM_LISTLEN_ENCODE_DOTTED(len) (~(len)) /* (-len - 1) */ 254 #define SCM_LISTLEN_ENCODE_CIRCULAR(len) (SCM_INT_T_MIN) 255 #define SCM_LISTLEN_ENCODE_ERROR SCM_LISTLEN_ENCODE_CIRCULAR 256 257 /*======================================= 258 Utils for Procedure Implementation 259 =======================================*/ 260 /* 261 * TODO: export these macros to sigscheme.h after: 262 * 263 * - Argument type information is encoded into ScmFuncTypeCode 264 * - Dynamically loadable binary module which allows user-written procedure is 265 * provided 266 */ 267 268 /* Obscures identifier ID. */ 269 #define SCM_MANGLE(id) scm_internal_##id 270 271 #define VALIDP(obj) (!EQ((obj), SCM_INVALID)) 272 273 /* Declares the current function name as seen by Scheme codes. TYPE 274 * is ignored, but we use it to implement a stub generator. This 275 * macro can be invoked only at the beginning of a function body, 276 * right after local variable declarations. */ 277 #define DECLARE_FUNCTION(func_name, type) \ 278 const char *SCM_MANGLE(name); \ 279 ScmObj SCM_MANGLE(tmp); \ 280 SCM_MANGLE(name) = func_name; \ 281 SCM_MANGLE(tmp) = SCM_INVALID /* No semicolon here. */ 282 283 /* DECLARE_FUNCTION without the functype. 284 * FIXME: is there a better name? */ 285 #define DECLARE_INTERNAL_FUNCTION(name) DECLARE_FUNCTION((name), ignored) 286 287 /* Signals an error without function name. The message is formatted by 288 * scm_vformat(). */ 289 #define PLAIN_ERR scm_plain_error 290 291 /* Signals an error. The current function name and the message are 292 sent to the error port. The message is formatted by scm_vformat(). */ 293 /* FIXME: check variadic macro availability with autoconf */ 294 #if HAVE_C99_VARIADIC_MACRO 295 #define ERR(fmt, ...) (scm_error(SCM_MANGLE(name), fmt, __VA_ARGS__)) 296 #elif HAVE_GNU_VARIADIC_MACRO 297 #define ERR(fmt, args...) (scm_error(SCM_MANGLE(name), fmt, args)) 298 #else 299 SCM_GLOBAL_VARS_BEGIN(error); 300 const char *scm_err_funcname; 301 SCM_GLOBAL_VARS_END(error); 302 #define scm_err_funcname SCM_GLOBAL_VAR(error, scm_err_funcname) 303 SCM_DECLARE_EXPORTED_VARS(error); 304 305 SCM_EXPORT void scm_error_with_implicit_func(const char *msg, ...) SCM_NORETURN; 306 #define ERR (scm_err_funcname = SCM_MANGLE(name)), scm_error_with_implicit_func 307 #endif 308 309 310 /* Signals an error that occured on an object. The current function 311 * name, the message, then the object, are written (with `write') to 312 * the error port. */ 313 #define ERR_OBJ(msg, obj) scm_error_obj(SCM_MANGLE(name), (msg), (obj)) 314 315 #define SCM_ENSURE_PROPER_LIST_TERMINATION(term, lst) \ 316 (NULLP(term) || (ERR_OBJ("proper list required but got", (lst)), 1)) 317 318 #if SCM_STRICT_ARGCHECK 319 #define SCM_CHECK_PROPER_LIST_TERMINATION SCM_ENSURE_PROPER_LIST_TERMINATION 320 #else 321 #define SCM_CHECK_PROPER_LIST_TERMINATION(term, lst) SCM_EMPTY_EXPR 322 #endif 323 324 /* ASSERT_NO_MORE_ARG() asserts that the variadic argument list has 325 * been exhausted. The assertion is implicit in NO_MORE_ARG(), so 326 * usually you don't have to call it explicitly. 327 * ASSERT_PROPER_ARG_LIST() should be used when scanning is ended 328 * prematurely, e.g. if an argument to "and" evaluates to #f. Both 329 * macros expand to no-ops #if !SCM_STRICT_ARGCHECK. 330 */ 331 #define ENSURE_NO_MORE_ARG(args) \ 332 (NO_MORE_ARG(args) || (ERR_OBJ("superfluous argument(s)", (args)), 1)) 333 #define ENSURE_PROPER_ARG_LIST(args) \ 334 (PROPER_LISTP(args) || (ERR_OBJ("bad argument list", (args)), 1)) 335 #if SCM_STRICT_ARGCHECK 336 #define NO_MORE_ARG(args) \ 337 (!CONSP(args) \ 338 && (NULLP(args) \ 339 || (ERR_OBJ("improper argument list terminator", (args)), 1))) 340 #define ASSERT_NO_MORE_ARG(args) ENSURE_NO_MORE_ARG(args) 341 #define ASSERT_PROPER_ARG_LIST(args) ENSURE_PROPER_ARG_LIST(args) 342 #else /* not SCM_STRICT_ARGCHECK */ 343 #define NO_MORE_ARG(args) (!CONSP(args)) 344 #define ASSERT_NO_MORE_ARG(args) SCM_EMPTY_EXPR 345 #define ASSERT_PROPER_ARG_LIST(args) SCM_EMPTY_EXPR 346 #endif /* not SCM_STRICT_ARGCHECK */ 347 348 /* Destructively retreives the first element of a list. */ 349 #define POP(_lst) \ 350 (SCM_MANGLE(tmp) = CAR(_lst), (_lst) = CDR(_lst), SCM_MANGLE(tmp)) 351 352 /* POP() with safety check. */ 353 #define SAFE_POP(_lst) \ 354 (CONSP((_lst)) ? POP((_lst)) : SCM_INVALID) 355 356 /* Like POP(), but signals an error if no argument is available. */ 357 #define MUST_POP_ARG(_lst) \ 358 (CONSP(_lst) ? POP(_lst) : (ERR("missing argument(s)"), SCM_NULL)) 359 360 #define FOR_EACH_WHILE(_kar, _lst, _cond) \ 361 while ((_cond) && ((_kar) = CAR((_lst)), (_lst) = CDR(_lst), 1)) 362 363 #define FOR_EACH(_kar, _lst) FOR_EACH_WHILE((_kar), (_lst), CONSP(_lst)) 364 365 #define FOR_EACH_PAIR(_subls, _lst) \ 366 for ((_subls) = (_lst); CONSP((_subls)); (_subls) = CDR(_subls)) 367 368 /* 369 * - expression part for the syntax is evaluated for each element except for 370 * the last one 371 * - _elm holds the last element after an overall iteration 372 * - _lst holds the terminal cdr after an overall iteration 373 */ 374 #define FOR_EACH_BUTLAST(_elm, _lst) \ 375 SCM_ASSERT(CONSP(_lst)); \ 376 while ((_elm) = POP(_lst), CONSP(_lst)) 377 378 #define ENSURE_TYPE(pred, _typename, obj) \ 379 (pred(obj) || (ERR_OBJ(_typename " required but got", (obj)), 1)) 380 381 #define ENSURE_INT(o) ENSURE_TYPE(INTP, "integer", (o)) 382 #define ENSURE_CONS(o) ENSURE_TYPE(CONSP, "pair", (o)) 383 #define ENSURE_SYMBOL(o) ENSURE_TYPE(SYMBOLP, "symbol", (o)) 384 #define ENSURE_CHAR(o) ENSURE_TYPE(CHARP, "character", (o)) 385 #define ENSURE_STRING(o) ENSURE_TYPE(STRINGP, "string", (o)) 386 #define ENSURE_FUNC(o) ENSURE_TYPE(FUNCP, "function", (o)) 387 #define ENSURE_CLOSURE(o) ENSURE_TYPE(CLOSUREP, "closure", (o)) 388 #define ENSURE_VECTOR(o) ENSURE_TYPE(VECTORP, "vector", (o)) 389 #define ENSURE_PORT(o) ENSURE_TYPE(PORTP, "port", (o)) 390 #define ENSURE_CONTINUATION(o) ENSURE_TYPE(CONTINUATIONP, "continuation", (o)) 391 #define ENSURE_PROCEDURE(o) ENSURE_TYPE(PROCEDUREP, "procedure", (o)) 392 #define ENSURE_ENV(o) ENSURE_TYPE(ENVP, "environment specifier", (o)) 393 #define ENSURE_VALID_ENV(o) \ 394 ENSURE_TYPE(VALID_ENVP, "valid environment specifier", (o)) 395 #define ENSURE_ERROBJ(o) ENSURE_TYPE(ERROBJP, "error object", (o)) 396 #define ENSURE_LIST(o) ENSURE_TYPE(LISTP, "list", (o)) 397 #define ENSURE_IDENTIFIER(o) ENSURE_TYPE(IDENTIFIERP, "identifier", (o)) 398 399 #if SCM_HAS_IMMUTABLE_CONS 400 #define ENSURE_MUTABLE_CONS(kons) \ 401 (SCM_CONS_MUTABLEP(kons) \ 402 || (ERR_OBJ("attempted to modify immutable pair", (kons)), 1)) 403 #else /* SCM_HAS_IMMUTABLE_CONS */ 404 #define ENSURE_MUTABLE_CONS(kons) SCM_EMPTY_EXPR 405 #endif /* SCM_HAS_IMMUTABLE_CONS */ 406 407 #if SCM_HAS_IMMUTABLE_STRING 408 #define ENSURE_MUTABLE_STRING(str) \ 409 (SCM_STRING_MUTABLEP(str) \ 410 || (ERR_OBJ("attempted to modify immutable string", (str)), 1)) 411 #else /* SCM_HAS_IMMUTABLE_STRING */ 412 #define ENSURE_MUTABLE_STRING(str) SCM_EMPTY_EXPR 413 #endif /* SCM_HAS_IMMUTABLE_STRING */ 414 415 #if SCM_HAS_IMMUTABLE_VECTOR 416 #define ENSURE_MUTABLE_VECTOR(vec) \ 417 (SCM_VECTOR_MUTABLEP(vec) \ 418 || (ERR_OBJ("attempted to modify immutable vector", (vec)), 1)) 419 #else /* SCM_HAS_IMMUTABLE_VECTOR */ 420 #define ENSURE_MUTABLE_VECTOR(vec) SCM_EMPTY_EXPR 421 #endif /* SCM_HAS_IMMUTABLE_VECTOR */ 422 423 #if SCM_USE_MULTIBYTE_CHAR 424 #define ENSURE_STATEFUL_CODEC(codec) \ 425 (SCM_CHARCODEC_STATEFULP(codec) \ 426 || (ERR("stateful character codec required but got: ~S", \ 427 SCM_CHARCODEC_ENCODING(codec)), 0)) 428 #define ENSURE_STATELESS_CODEC(codec) \ 429 (!SCM_CHARCODEC_STATEFULP(codec) \ 430 || (ERR("stateless character codec required but got: ~S", \ 431 SCM_CHARCODEC_ENCODING(codec)), 0)) 432 #endif /* SCM_USE_MULTIBYTE_CHAR */ 433 434 #if SCM_STRICT_ARGCHECK 435 #define CHECK_VALID_EVALED_VALUE(x) \ 436 do { \ 437 if (SYNTACTIC_OBJECTP(x)) \ 438 ERR_OBJ("syntactic keyword is evaluated as value", x); \ 439 if (VALUEPACKETP(x)) \ 440 ERR_OBJ("multiple values are not allowed here", x); \ 441 } while (/* CONSTCOND */ 0) 442 #else 443 #define CHECK_VALID_EVALED_VALUE(x) SCM_EMPTY_EXPR 444 #endif 445 446 /*======================================= 447 Numbers 448 =======================================*/ 449 #define INT_VALID_VALUEP(i) (SCM_INT_MIN <= (i) && (i) <= SCM_INT_MAX) 450 #define INT_OUT_OF_RANGEP(i) (!INT_VALID_VALUEP(i)) 451 452 /*======================================= 453 Characters 454 =======================================*/ 455 /* FIXME: support R6RS Unicode */ 456 457 /* accepts SCM_ICHAR_EOF */ 458 /* assumes ASCII */ 459 #define ICHAR_ASCIIP(c) (0 <= (c) && (c) <= 127) 460 #define ICHAR_SINGLEBYTEP(c) (0 <= (c) && (c) <= 255) 461 #define ICHAR_VALID_UNICODEP(c) ((0 <= (c) && (c) <= 0xd7ff) \ 462 || (0xe000 <= (c) && (c) <= 0x10ffff)) 463 464 #define ICHAR_CONTROLP(c) ((0 <= (c) && (c) <= 31) || (c) == 127) 465 /* 466 * SigScheme treats vertical tab (0x0b) as a white space charcter although 467 * R5RS char-whitespace? does not cover it. 468 * 469 * R5RS: 6.3.4 Characters 470 * The whitespace characters are space, tab, line feed, form feed, and 471 * carriage return. 472 * 473 * R6RS Standard Libraries: 1.1 Characters 474 * A character is whitespace if it is in one of the space, line, or 475 * paragraph separator categories (Zs, Zl or Zp), or if is U+0009 476 * (Horizontal tabulation), U+000A (Line feed), U+000B (Vertical 477 * tabulation), U+000C (Form feed), or U+000D (Carriage return). 478 */ 479 #define ICHAR_WHITESPACEP(c) ((c) == ' ' || ('\t' <= (c) && (c) <= '\r')) 480 #define ICHAR_NUMERICP(c) ('0' <= (c) && (c) <= '9') 481 #define ICHAR_HEXA_NUMERICP(c) (ICHAR_NUMERICP(c) \ 482 || ('a' <= (c) && (c) <= 'f') \ 483 || ('A' <= (c) && (c) <= 'F')) 484 #define ICHAR_ALPHABETICP(c) (ICHAR_LOWER_CASEP(c) || ICHAR_UPPER_CASEP(c)) 485 #define ICHAR_UPPER_CASEP(c) ('A' <= (c) && (c) <= 'Z') 486 #define ICHAR_LOWER_CASEP(c) ('a' <= (c) && (c) <= 'z') 487 488 /* 489 * SigScheme's case-insensitive character comparison conforms to the 490 * foldcase'ed comparison described in R6RS and SRFI-13, although R5RS does 491 * not define comparison between alphabetic and non-alphabetic char. 492 * 493 * This specification is needed to produce natural result on sort functions 494 * with these case-insensitive predicates as comparator. 495 * 496 * (a-sort '(#\a #\c #\B #\D #\1 #\[ #\$ #\_) char-ci<?) 497 * => (#\$ #\1 #\a #\B #\c #\D #\[ #\_) ;; the "natural result" 498 * 499 * => (#\$ #\1 #\B #\D #\[ #\_ #\a #\c) ;; "unnatural result" 500 * 501 * See also: 502 * 503 * - Description around 'char-foldcase' in R6RS (R5.92) Standard Libraries 504 * http://www.r6rs.org/document/lib-html/r6rs-lib-Z-H-3.html#node_sec_1.1 505 * - "Case mapping and case-folding" and "Comparison" section of SRFI-13 506 */ 507 #define ICHAR_DOWNCASE(c) (ICHAR_UPPER_CASEP(c) ? (c) + ('a' - 'A') : (c)) 508 #define ICHAR_UPCASE(c) (ICHAR_LOWER_CASEP(c) ? (c) - ('a' - 'A') : (c)) 509 /* foldcase for case-insensitive character comparison is done by downcase as 510 * described in R6RS libs. Although SRFI-13 expects (char-downcase (char-upcase 511 * c)), this implementation is sufficient for ASCII range. */ 512 #define ICHAR_FOLDCASE(c) (ICHAR_DOWNCASE(c)) 513 514 /*======================================= 515 Local Buffer Allocator 516 =======================================*/ 517 /* don't touch member variables directly */ 518 #define ScmLBuf(T) \ 519 struct ScmLBuf_##T##_ { \ 520 T *buf; \ 521 size_t size; \ 522 T *init_buf; \ 523 size_t init_size; \ 524 size_t extended_cnt; \ 525 } 526 527 ScmLBuf(void); 528 529 /* lvalue access is permitted */ 530 #define LBUF_BUF(lbuf) ((lbuf).buf) 531 532 /* lvalue access is not permitted */ 533 #define LBUF_END(lbuf) (&LBUF_BUF(lbuf)[LBUF_SIZE(lbuf)]) 534 #define LBUF_SIZE(lbuf) ((lbuf).size) 535 #define LBUF_INIT_SIZE(lbuf) ((lbuf).init_size) 536 #define LBUF_EXT_CNT(lbuf) ((lbuf).extended_cnt) 537 538 #define LBUF_INIT(lbuf, init_buf, init_size) \ 539 scm_lbuf_init((void *)&(lbuf), (init_buf), (init_size)) 540 541 #define LBUF_FREE(lbuf) \ 542 scm_lbuf_free((void *)&(lbuf)) 543 544 #define LBUF_ALLOC(lbuf, size) \ 545 scm_lbuf_alloc((void *)&(lbuf), (size)) 546 547 #define LBUF_REALLOC(lbuf, size) \ 548 scm_lbuf_realloc((void *)&(lbuf), (size)) 549 550 #define LBUF_EXTEND(lbuf, f, least_size) \ 551 scm_lbuf_extend((void *)&(lbuf), (f), (least_size)) 552 553 SCM_EXPORT void scm_lbuf_init(struct ScmLBuf_void_ *lbuf, 554 void *init_buf, size_t init_size); 555 SCM_EXPORT void scm_lbuf_free(struct ScmLBuf_void_ *lbuf); 556 SCM_EXPORT void scm_lbuf_alloc(struct ScmLBuf_void_ *lbuf, size_t size); 557 SCM_EXPORT void scm_lbuf_realloc(struct ScmLBuf_void_ *lbuf, size_t size); 558 SCM_EXPORT void scm_lbuf_extend(struct ScmLBuf_void_ *lbuf, 559 size_t (*f)(struct ScmLBuf_void_ *), 560 size_t least_size); 561 562 /* 563 * extended size functions: 564 * define your own one if more optimized version is needed 565 */ 566 SCM_EXPORT size_t scm_lbuf_f_linear(struct ScmLBuf_void_ *lbuf); 567 SCM_EXPORT size_t scm_lbuf_f_exponential(struct ScmLBuf_void_ *lbuf); 568 569 /*======================================= 570 Type Definitions 571 =======================================*/ 572 typedef struct ScmSpecialCharInfo_ ScmSpecialCharInfo; 573 struct ScmSpecialCharInfo_ { 574 scm_ichar_t code; /* character code as ASCII/Unicode */ 575 const char *esc_seq; /* escape sequence as string */ 576 const char *lex_rep; /* lexical representation as character object */ 577 }; 578 579 /*======================================= 580 Variable Declarations 581 =======================================*/ 582 /* procedure.c */ 583 SCM_GLOBAL_VARS_BEGIN(procedure); 584 ScmCharCodec *scm_identifier_codec; 585 ScmObj scm_values_applier; 586 SCM_GLOBAL_VARS_END(procedure); 587 #define scm_identifier_codec SCM_GLOBAL_VAR(procedure, scm_identifier_codec) 588 #define scm_values_applier SCM_GLOBAL_VAR(procedure, scm_values_applier) 589 SCM_DECLARE_EXPORTED_VARS(procedure); 590 591 /* port.c */ 592 SCM_GLOBAL_VARS_BEGIN(port); 593 ScmObj scm_in; /* current-input-port */ 594 ScmObj scm_out; /* current-output-port */ 595 ScmObj scm_err; /* current error port */ 596 SCM_GLOBAL_VARS_END(port); 597 #define scm_in SCM_GLOBAL_VAR(port, scm_in) 598 #define scm_out SCM_GLOBAL_VAR(port, scm_out) 599 #define scm_err SCM_GLOBAL_VAR(port, scm_err) 600 SCM_DECLARE_EXPORTED_VARS(port); 601 SCM_EXTERN(const ScmSpecialCharInfo scm_special_char_table[]); 602 603 /* write.c */ 604 SCM_GLOBAL_VARS_BEGIN(write); 605 void (*scm_write_ss_func)(ScmObj port, ScmObj obj); 606 SCM_GLOBAL_VARS_END(write); 607 #define scm_write_ss_func SCM_GLOBAL_VAR(write, scm_write_ss_func) 608 SCM_DECLARE_EXPORTED_VARS(write); 609 610 /* storage.c */ 611 #if SCM_USE_VALUECONS 612 SCM_GLOBAL_VARS_BEGIN(storage); 613 ScmObj scm_null_values; 614 SCM_GLOBAL_VARS_END(storage); 615 #define scm_null_values SCM_GLOBAL_VAR(storage, scm_null_values) 616 SCM_DECLARE_EXPORTED_VARS(storage); 617 #endif 618 619 /* symbol.c */ 620 /* Only permitted to storage-gc.c */ 621 SCM_GLOBAL_VARS_BEGIN(symbol); 622 ScmObj *scm_symbol_hash; 623 size_t scm_symbol_hash_size; 624 SCM_GLOBAL_VARS_END(symbol); 625 #define scm_symbol_hash SCM_GLOBAL_VAR(symbol, scm_symbol_hash) 626 #define scm_symbol_hash_size SCM_GLOBAL_VAR(symbol, scm_symbol_hash_size) 627 SCM_DECLARE_EXPORTED_VARS(symbol); 628 629 /*======================================= 630 Function Declarations 631 =======================================*/ 632 /* strcasecmp.c */ 633 #if !HAVE_STRCASECMP 634 #define strcasecmp scm_strcasecmp 635 SCM_EXPORT int scm_strcasecmp(const char *s1, const char *s2); 636 #endif /* !HAVE_STRCASECMP */ 637 638 /* storage.c */ 639 SCM_EXPORT void scm_init_storage(const ScmStorageConf *conf); 640 SCM_EXPORT void scm_fin_storage(void); 641 642 /* storage-gc.c */ 643 SCM_EXPORT void scm_init_gc(const ScmStorageConf *conf); 644 SCM_EXPORT void scm_fin_gc(void); 645 SCM_EXPORT ScmObj scm_alloc_cell(void); 646 SCM_EXPORT void scm_prealloc_heaps(size_t n); 647 648 /* continuation.c */ 649 #if SCM_USE_CONTINUATION 650 SCM_EXPORT void scm_init_continuation(void); 651 SCM_EXPORT void scm_fin_continuation(void); 652 SCM_EXPORT void scm_destruct_continuation(ScmObj cont); 653 SCM_EXPORT ScmObj scm_call_with_current_continuation(ScmObj proc, 654 ScmEvalState *eval_state); 655 SCM_EXPORT void scm_call_continuation(ScmObj cont, ScmObj ret) SCM_NORETURN; 656 SCM_EXPORT ScmObj scm_dynamic_wind(ScmObj before, ScmObj thunk, ScmObj after); 657 #if SCM_USE_BACKTRACE 658 SCM_EXPORT void scm_push_trace_frame(ScmObj obj, ScmObj env); 659 SCM_EXPORT void scm_pop_trace_frame(void); 660 #endif /* SCM_USE_BACKTRACE */ 661 SCM_EXPORT ScmObj scm_trace_stack(void); 662 #else /* SCM_USE_CONTINUATION */ 663 #define scm_trace_stack() SCM_NULL 664 #endif /* SCM_USE_CONTINUATION */ 665 666 /* symbol.c */ 667 SCM_EXPORT void scm_init_symbol(const ScmStorageConf *conf); 668 SCM_EXPORT void scm_fin_symbol(void); 669 670 /* env.c */ 671 SCM_EXPORT scm_bool scm_toplevel_environmentp(ScmObj env); 672 SCM_EXPORT ScmObj scm_extend_environment(ScmObj formals, ScmObj actuals, 673 ScmObj env); 674 SCM_EXPORT ScmObj scm_replace_environment(ScmObj formals, ScmObj actuals, 675 ScmObj env); 676 SCM_EXPORT ScmObj scm_update_environment(ScmObj actuals, ScmObj env); 677 SCM_EXPORT ScmObj scm_add_environment(ScmObj var, ScmObj val, ScmObj env); 678 SCM_EXPORT ScmRef scm_lookup_environment(ScmObj var, ScmObj env); 679 SCM_EXPORT ScmRef scm_lookup_frame(ScmObj var, ScmObj frame); 680 #if SCM_USE_HYGIENIC_MACRO 681 SCM_EXPORT ScmPackedEnv scm_pack_env(ScmObj env); 682 SCM_EXPORT ScmObj scm_unpack_env(ScmPackedEnv penv, ScmObj context); 683 SCM_EXPORT scm_bool scm_subenvp(ScmObj env, ScmPackedEnv sub); 684 SCM_EXPORT scm_bool scm_identifierequalp(ScmObj x, ScmPackedEnv xpenv, 685 ScmObj y, 686 ScmPackedEnv penv, ScmObj env); 687 SCM_EXPORT ScmObj scm_wrap_identifier(ScmObj id, ScmPackedEnv penv, 688 ScmObj env); 689 #endif 690 691 SCM_EXPORT scm_bool scm_valid_environmentp(ScmObj env); 692 SCM_EXPORT scm_bool scm_valid_environment_extensionp(ScmObj formals, 693 ScmObj actuals); 694 SCM_EXPORT scm_bool scm_valid_environment_extension_lengthp(scm_int_t formals_len, scm_int_t actuals_len); 695 SCM_EXPORT scm_int_t scm_validate_formals(ScmObj formals); 696 SCM_EXPORT scm_int_t scm_validate_actuals(ScmObj actuals); 697 698 /* syntax.c */ 699 SCM_EXPORT void scm_init_syntax(void); 700 #if SCM_USE_INTERNAL_DEFINITIONS 701 SCM_EXPORT ScmObj scm_s_body(ScmObj body, ScmEvalState *eval_state); 702 #else 703 #define scm_s_body scm_s_begin 704 #endif 705 SCM_EXPORT ScmObj scm_s_cond_internal(ScmObj clauses, 706 ScmEvalState *eval_state); 707 SCM_EXPORT ScmObj scm_s_let_internal(enum ScmObjType permitted, 708 ScmObj bindings, ScmObj body, 709 ScmEvalState *eval_state); 710 SCM_EXPORT ScmObj scm_s_letrec_internal(enum ScmObjType permitted, 711 ScmObj bindings, ScmObj body, 712 ScmEvalState *eval_state); 713 SCM_EXPORT void scm_s_define_internal(enum ScmObjType permitted, 714 ScmObj var, ScmObj exp, ScmObj env); 715 716 /* macro.c */ 717 #if SCM_USE_HYGIENIC_MACRO 718 SCM_EXPORT void scm_init_macro(void); 719 SCM_EXPORT ScmObj scm_expand_macro(ScmObj macro, ScmObj args, 720 ScmEvalState *eval_state); 721 SCM_EXPORT ScmObj scm_p_reversex(ScmObj in); /* To be relocated. */ 722 SCM_EXPORT void scm_macro_bad_scope(ScmObj sym); 723 #endif /* SCM_USE_HYGIENIC_MACRO */ 724 725 /* error.c */ 726 SCM_EXPORT void scm_init_error(void); 727 728 /* promise.c */ 729 SCM_EXPORT void scm_init_promise(void); 730 731 /* procedure.c */ 732 SCM_EXPORT ScmObj scm_map_single_arg(ScmObj proc, ScmObj lst); 733 SCM_EXPORT ScmObj scm_map_multiple_args(ScmObj proc, ScmObj lsts, 734 scm_bool allow_uneven_lists); 735 736 /* list.c */ 737 SCM_EXPORT scm_int_t scm_finite_length(ScmObj lst); 738 739 /* port.c */ 740 #if SCM_USE_PORT 741 SCM_EXPORT void scm_init_port(void); 742 SCM_EXPORT ScmObj scm_prepare_port(ScmObj args, ScmObj default_port); 743 SCM_EXPORT ScmCharPort *scm_make_char_port(ScmBytePort *bport); 744 #endif /* SCM_USE_PORT */ 745 746 /* write.c */ 747 #if SCM_USE_WRITER 748 SCM_EXPORT void scm_init_writer(void); 749 SCM_EXPORT void scm_display_errobj_ss(ScmObj port, ScmObj errobj); 750 #endif /* SCM_USE_WRITER */ 751 752 /* format.c */ 753 #if SCM_USE_FORMAT 754 SCM_EXPORT void scm_init_format(void); 755 #endif /* SCM_USE_FORMAT */ 756 757 /* load.c */ 758 #if SCM_USE_LOAD 759 SCM_EXPORT void scm_init_load(void); 760 SCM_EXPORT void scm_fin_load(void); 761 SCM_EXPORT void scm_load_system_file(const char *file); 762 #endif /* SCM_USE_LOAD */ 763 764 /* module.c */ 765 SCM_EXPORT void scm_init_module(void); 766 SCM_EXPORT void scm_fin_module(void); 767 768 /* sigscheme.c */ 769 SCM_EXPORT char **scm_interpret_argv(char **argv); 770 SCM_EXPORT void scm_free_argv(char **argv); 771 772 /* legacy-macro.c */ 773 #if SCM_USE_LEGACY_MACRO 774 SCM_EXPORT void scm_init_legacy_macro(void); 775 #endif 776 777 /* 778 * modules 779 */ 780 781 /* module-sscm-ext.c */ 782 #if SCM_USE_SSCM_EXTENSIONS 783 SCM_EXPORT void scm_initialize_sscm_extensions(void); 784 #endif 785 786 /* module-siod.c */ 787 #if SCM_COMPAT_SIOD 788 SCM_EXPORT void scm_initialize_siod(void); 789 #endif 790 791 /* module-srfi1.c */ 792 #if SCM_USE_SRFI1 793 SCM_EXPORT void scm_initialize_srfi1(void); 794 #endif 795 796 /* module-srfi2.c */ 797 #if SCM_USE_SRFI2 798 SCM_EXPORT void scm_initialize_srfi2(void); 799 #endif 800 801 /* module-srfi6.c */ 802 #if SCM_USE_SRFI6 803 SCM_EXPORT void scm_initialize_srfi6(void); 804 #endif 805 806 /* module-srfi8.c */ 807 #if SCM_USE_SRFI8 808 SCM_EXPORT void scm_initialize_srfi8(void); 809 #endif 810 811 /* module-srfi9.c */ 812 #if SCM_USE_SRFI9 813 SCM_EXPORT void scm_initialize_srfi9(void); 814 #endif 815 816 /* module-srfi23.c */ 817 #if SCM_USE_SRFI23 818 SCM_EXPORT void scm_initialize_srfi23(void); 819 #endif 820 821 /* module-srfi28.c */ 822 #if SCM_USE_SRFI28 823 SCM_EXPORT void scm_initialize_srfi28(void); 824 #endif 825 826 /* module-srfi34.c */ 827 #if SCM_USE_SRFI34 828 SCM_EXPORT void scm_initialize_srfi34(void); 829 #endif 830 831 /* module-srfi38.c */ 832 #if SCM_USE_SRFI38 833 SCM_EXPORT void scm_initialize_srfi38(void); 834 #endif 835 836 /* module-srfi43.c */ 837 #if SCM_USE_SRFI43 838 SCM_EXPORT void scm_initialize_srfi43(void); 839 #endif 840 841 /* module-srfi48.c */ 842 #if SCM_USE_SRFI48 843 SCM_EXPORT void scm_initialize_srfi48(void); 844 #endif 845 846 /* module-srfi55.c */ 847 #if SCM_USE_SRFI55 848 SCM_EXPORT void scm_initialize_srfi55(void); 849 #endif 850 851 /* module-srfi60.c */ 852 #if SCM_USE_SRFI60 853 SCM_EXPORT void scm_initialize_srfi60(void); 854 #endif 855 856 857 #ifdef __cplusplus 858 } 859 #endif 860 861 #endif /* __SIGSCHEMEINTERNAL_H */ 862