X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/1bbd0b849f6b90f1ffe57e586e4ee5a884f84a11..6f29dc6d2f5837a612fe55afe995373d99c67d67:/libguile/read.c diff --git a/libguile/read.c b/libguile/read.c index 4b6a5806b..7af3b735d 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -47,7 +47,6 @@ #include #include "_scm.h" #include "chars.h" -#include "genio.h" #include "eval.h" #include "unif.h" #include "keywords.h" @@ -55,8 +54,12 @@ #include "srcprop.h" #include "hashtab.h" #include "hash.h" +#include "ports.h" +#include "root.h" +#include "strings.h" +#include "vectors.h" -#include "scm_validate.h" +#include "validate.h" #include "read.h" @@ -70,11 +73,11 @@ scm_option scm_read_opts[] = { "Record positions of source code expressions." }, { SCM_OPTION_BOOLEAN, "case-insensitive", 0, "Convert symbols to lower case."}, - { SCM_OPTION_SCM, "keywords", SCM_BOOL_F, + { SCM_OPTION_SCM, "keywords", SCM_UNPACK (SCM_BOOL_F), "Style of keyword recognition: #f or 'prefix"} }; -GUILE_PROC (scm_read_options, "read-options-interface", 0, 1, 0, +SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0, (SCM setting), "") #define FUNC_NAME s_scm_read_options @@ -92,7 +95,7 @@ GUILE_PROC (scm_read_options, "read-options-interface", 0, 1, 0, /* An association list mapping extra hash characters to procedures. */ static SCM *scm_read_hash_procedures; -GUILE_PROC (scm_read, "read", 0, 1, 0, +SCM_DEFINE (scm_read, "read", 0, 1, 0, (SCM port), "") #define FUNC_NAME s_scm_read @@ -102,7 +105,7 @@ GUILE_PROC (scm_read, "read", 0, 1, 0, if (SCM_UNBNDP (port)) port = scm_cur_inp; - SCM_VALIDATE_OPINPORT(1,port); + SCM_VALIDATE_OPINPORT (1,port); c = scm_flush_ws (port, (char *) NULL); if (EOF == c) @@ -117,8 +120,7 @@ GUILE_PROC (scm_read, "read", 0, 1, 0, char * -scm_grow_tok_buf (tok_buf) - SCM * tok_buf; +scm_grow_tok_buf (SCM *tok_buf) { scm_vector_set_length_x (*tok_buf, SCM_MAKINUM (2 * SCM_LENGTH (*tok_buf))); return SCM_CHARS (*tok_buf); @@ -127,9 +129,7 @@ scm_grow_tok_buf (tok_buf) int -scm_flush_ws (port, eoferr) - SCM port; - const char *eoferr; +scm_flush_ws (SCM port, const char *eoferr) { register int c; while (1) @@ -164,9 +164,7 @@ scm_flush_ws (port, eoferr) int -scm_casei_streq (s1, s2) - char * s1; - char * s2; +scm_casei_streq (char *s1, char *s2) { while (*s1 && *s2) if (scm_downcase((int)*s1) != scm_downcase((int)*s2)) @@ -202,7 +200,7 @@ recsexpr (SCM obj,int line,int column,SCM filename) { copy = scm_cons (recsexpr (SCM_CAR (obj), line, column, filename), SCM_UNDEFINED); - while (SCM_NIMP (tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp)) + while ((tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp)) { SCM_SETCDR (copy, scm_cons (recsexpr (SCM_CAR (tmp), line, @@ -216,7 +214,7 @@ recsexpr (SCM obj,int line,int column,SCM filename) else { recsexpr (SCM_CAR (obj), line, column, filename); - while (SCM_NIMP (tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp)) + while ((tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp)) recsexpr (SCM_CAR (tmp), line, column, filename); copy = SCM_UNDEFINED; } @@ -238,8 +236,7 @@ recsexpr (SCM obj,int line,int column,SCM filename) newline/exclamation-point/sharp-sign/newline sequence. */ static void -skip_scsh_block_comment (port) - SCM port; +skip_scsh_block_comment (SCM port) { /* Is this portable? Dear God, spare me from the non-eight-bit characters. But is it tasteful? */ @@ -377,17 +374,17 @@ tryagain_no_flush_ws: c = scm_getc (port); j = scm_read_token (c, tok_buf, port, 0); if (j == 1) - return SCM_MAKICHR (c); + return SCM_MAKE_CHAR (c); if (c >= '0' && c < '8') { p = scm_istr2int (SCM_CHARS (*tok_buf), (long) j, 8); if (SCM_NFALSEP (p)) - return SCM_MAKICHR (SCM_INUM (p)); + return SCM_MAKE_CHAR (SCM_INUM (p)); } for (c = 0; c < scm_n_charnames; c++) if (scm_charnames[c] && (scm_casei_streq (scm_charnames[c], SCM_CHARS (*tok_buf)))) - return SCM_MAKICHR (scm_charnums[c]); + return SCM_MAKE_CHAR (scm_charnums[c]); scm_wta (SCM_UNDEFINED, "unknown # object: #\\", SCM_CHARS (*tok_buf)); /* #:SYMBOL is a syntax for keywords supported in all contexts. */ @@ -408,7 +405,7 @@ tryagain_no_flush_ws: SCM got; got = scm_apply (sharp, - SCM_MAKICHR (c), + SCM_MAKE_CHAR (c), scm_acons (port, SCM_EOL, SCM_EOL)); if (SCM_UNSPECIFIED == got) goto unkshrp; @@ -420,8 +417,8 @@ tryagain_no_flush_ws: } } unkshrp: - scm_misc_error (s_scm_read, "Unknown # object: %S", - scm_listify (SCM_MAKICHR (c), SCM_UNDEFINED)); + scm_misc_error (s_scm_read, "Unknown # object: ~S", + scm_listify (SCM_MAKE_CHAR (c), SCM_UNDEFINED)); } case '"': @@ -495,7 +492,7 @@ tryagain_no_flush_ws: goto tok; case ':': - if (SCM_KEYWORD_STYLE == scm_keyword_prefix) + if (SCM_PACK (SCM_KEYWORD_STYLE) == scm_keyword_prefix) { j = scm_read_token ('-', tok_buf, port, 0); p = scm_intern (SCM_CHARS (*tok_buf), j); @@ -517,11 +514,7 @@ _Pragma ("noopt"); /* # pragma _CRI noopt */ #endif scm_sizet -scm_read_token (ic, tok_buf, port, weird) - int ic; - SCM *tok_buf; - SCM port; - int weird; +scm_read_token (int ic, SCM *tok_buf, SCM port, int weird) { register scm_sizet j; register int c; @@ -607,11 +600,7 @@ _Pragma ("opt"); /* # pragma _CRI opt */ #endif SCM -scm_lreadparen (tok_buf, port, name, copy) - SCM *tok_buf; - SCM port; - char *name; - SCM *copy; +scm_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy) { SCM tmp; SCM tl; @@ -647,11 +636,7 @@ scm_lreadparen (tok_buf, port, name, copy) SCM -scm_lreadrecparen (tok_buf, port, name, copy) - SCM *tok_buf; - SCM port; - char *name; - SCM *copy; +scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy) { register int c; register SCM tmp; @@ -675,7 +660,7 @@ scm_lreadrecparen (tok_buf, port, name, copy) /* Build the head of the list structure. */ ans = tl = scm_cons (tmp, SCM_EOL); if (SCM_COPY_SOURCE_P) - ans2 = tl2 = scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp) + ans2 = tl2 = scm_cons (SCM_CONSP (tmp) ? *copy : tmp, SCM_EOL); @@ -686,7 +671,7 @@ scm_lreadrecparen (tok_buf, port, name, copy) { SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, copy)); if (SCM_COPY_SOURCE_P) - SCM_SETCDR (tl2, scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp) + SCM_SETCDR (tl2, scm_cons (SCM_CONSP (tmp) ? *copy : tmp, SCM_EOL)); @@ -696,7 +681,7 @@ scm_lreadrecparen (tok_buf, port, name, copy) } tl = SCM_SETCDR (tl, scm_cons (tmp, SCM_EOL)); if (SCM_COPY_SOURCE_P) - tl2 = SCM_SETCDR (tl2, scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp) + tl2 = SCM_SETCDR (tl2, scm_cons (SCM_CONSP (tmp) ? *copy : tmp, SCM_EOL)); @@ -719,7 +704,7 @@ exit: /* Manipulate the read-hash-procedures alist. This could be written in Scheme, but maybe it will also be used by C code during initialisation. */ -GUILE_PROC (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, +SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, (SCM chr, SCM proc), "") #define FUNC_NAME s_scm_read_hash_extend @@ -727,7 +712,7 @@ GUILE_PROC (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, SCM this; SCM prev; - SCM_VALIDATE_CHAR(1,chr); + SCM_VALIDATE_CHAR (1,chr); SCM_ASSERT (SCM_FALSEP (proc) || SCM_NIMP(proc), proc, SCM_ARG2, FUNC_NAME); @@ -777,8 +762,7 @@ GUILE_PROC (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, /* Recover the read-hash procedure corresponding to char c. */ static SCM -scm_get_hash_procedure (c) - int c; +scm_get_hash_procedure (int c) { SCM rest = *scm_read_hash_procedures; @@ -787,7 +771,7 @@ scm_get_hash_procedure (c) if (SCM_NULLP (rest)) return SCM_BOOL_F; - if (SCM_ICHR (SCM_CAAR (rest)) == c) + if (SCM_CHAR (SCM_CAAR (rest)) == c) return SCM_CDAR (rest); rest = SCM_CDR (rest); @@ -803,3 +787,9 @@ scm_init_read () scm_init_opts (scm_read_options, scm_read_opts, SCM_N_READ_OPTIONS); #include "read.x" } + +/* + Local Variables: + c-file-style: "gnu" + End: +*/