X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/3f2f0599c38e5319a8741a07e85b8417b402bcae..6f29dc6d2f5837a612fe55afe995373d99c67d67:/libguile/read.c diff --git a/libguile/read.c b/libguile/read.c index e6ff1361a..7af3b735d 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997, 1999 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -38,20 +38,28 @@ * If you write modifications of your own for GUILE, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ + +/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, + gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ + #include #include "_scm.h" #include "chars.h" -#include "genio.h" #include "eval.h" #include "unif.h" -#include "kw.h" +#include "keywords.h" #include "alist.h" #include "srcprop.h" #include "hashtab.h" #include "hash.h" +#include "ports.h" +#include "root.h" +#include "strings.h" +#include "vectors.h" +#include "validate.h" #include "read.h" @@ -65,44 +73,39 @@ 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"} }; -SCM_PROC (s_read_options, "read-options-interface", 0, 1, 0, scm_read_options); - -SCM -scm_read_options (setting) - SCM setting; +SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0, + (SCM setting), +"") +#define FUNC_NAME s_scm_read_options { SCM ans = scm_options (setting, scm_read_opts, SCM_N_READ_OPTIONS, - s_read_options); + FUNC_NAME); if (SCM_COPY_SOURCE_P) SCM_RECORD_POSITIONS_P = 1; return ans; } +#undef FUNC_NAME /* An association list mapping extra hash characters to procedures. */ static SCM *scm_read_hash_procedures; -SCM_PROC (s_read, "read", 0, 1, 0, scm_read); - -SCM -scm_read (port) - SCM port; +SCM_DEFINE (scm_read, "read", 0, 1, 0, + (SCM port), +"") +#define FUNC_NAME s_scm_read { int c; SCM tok_buf, copy; if (SCM_UNBNDP (port)) port = scm_cur_inp; - else - SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), - port, - SCM_ARG1, - s_read); + SCM_VALIDATE_OPINPORT (1,port); c = scm_flush_ws (port, (char *) NULL); if (EOF == c) @@ -112,12 +115,12 @@ scm_read (port) tok_buf = scm_makstr (30L, 0); return scm_lreadr (&tok_buf, port, ©); } +#undef FUNC_NAME 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); @@ -126,9 +129,7 @@ scm_grow_tok_buf (tok_buf) int -scm_flush_ws (port, eoferr) - SCM port; - char *eoferr; +scm_flush_ws (SCM port, const char *eoferr) { register int c; while (1) @@ -163,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)) @@ -185,14 +184,8 @@ scm_casei_streq (s1, s2) #ifndef DEBUG_EXTENSIONS #define recsexpr(obj, line, column, filename) (obj) #else -static SCM recsexpr SCM_P ((SCM obj, int line, int column, SCM filename)); - static SCM -recsexpr (obj, line, column, filename) - SCM obj; - int line; - int column; - SCM filename; +recsexpr (SCM obj,int line,int column,SCM filename) { if (SCM_IMP (obj) || SCM_NCONSP(obj)) return obj; @@ -207,7 +200,7 @@ recsexpr (obj, line, column, 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, @@ -221,7 +214,7 @@ recsexpr (obj, line, column, 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; } @@ -243,8 +236,7 @@ recsexpr (obj, line, column, 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? */ @@ -265,23 +257,19 @@ skip_scsh_block_comment (port) } } -static SCM -scm_get_hash_procedure SCM_P ((int c)); +static SCM scm_get_hash_procedure(int c); static char s_list[]="list"; SCM -scm_lreadr (tok_buf, port, copy) - SCM *tok_buf; - SCM port; - SCM *copy; +scm_lreadr (SCM *tok_buf,SCM port,SCM *copy) { int c; scm_sizet j; SCM p; tryagain: - c = scm_flush_ws (port, s_read); + c = scm_flush_ws (port, s_scm_read); tryagain_no_flush_ws: switch (c) { @@ -297,19 +285,19 @@ tryagain_no_flush_ws: goto tryagain; case '\'': - p = scm_i_quote; + p = scm_sym_quote; goto recquote; case '`': - p = scm_i_quasiquote; + p = scm_sym_quasiquote; goto recquote; case ',': c = scm_getc (port); if ('@' == c) - p = scm_i_uq_splicing; + p = scm_sym_uq_splicing; else { scm_ungetc (c, port); - p = scm_i_unquote; + p = scm_sym_unquote; } recquote: p = scm_cons2 (p, @@ -367,6 +355,7 @@ tryagain_no_flush_ws: c = scm_flush_ws (port, (char *)NULL); goto tryagain_no_flush_ws; +#ifdef HAVE_ARRAYS case '*': j = scm_read_token (c, tok_buf, port, 0); p = scm_istr2bve (SCM_CHARS (*tok_buf) + 1, (long) (j - 1)); @@ -374,6 +363,7 @@ tryagain_no_flush_ws: return p; else goto unkshrp; +#endif case '{': j = scm_read_token (c, tok_buf, port, 1); @@ -384,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. */ @@ -415,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; @@ -427,8 +417,8 @@ tryagain_no_flush_ws: } } unkshrp: - scm_misc_error (s_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 '"': @@ -502,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); @@ -524,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; @@ -614,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; @@ -629,7 +611,7 @@ scm_lreadparen (tok_buf, port, name, copy) if (')' == c) return SCM_EOL; scm_ungetc (c, port); - if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy))) + if (scm_sym_dot == (tmp = scm_lreadr (tok_buf, port, copy))) { ans = scm_lreadr (tok_buf, port, copy); closeit: @@ -641,7 +623,7 @@ scm_lreadparen (tok_buf, port, name, copy) while (')' != (c = scm_flush_ws (port, name))) { scm_ungetc (c, port); - if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy))) + if (scm_sym_dot == (tmp = scm_lreadr (tok_buf, port, copy))) { SCM_SETCDR (tl, scm_lreadr (tok_buf, port, copy)); goto closeit; @@ -654,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; @@ -672,7 +650,7 @@ scm_lreadrecparen (tok_buf, port, name, copy) if (')' == c) return SCM_EOL; scm_ungetc (c, port); - if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy))) + if (scm_sym_dot == (tmp = scm_lreadr (tok_buf, port, copy))) { ans = scm_lreadr (tok_buf, port, copy); if (')' != (c = scm_flush_ws (port, name))) @@ -682,18 +660,18 @@ 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); while (')' != (c = scm_flush_ws (port, name))) { scm_ungetc (c, port); - if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy))) + if (scm_sym_dot == (tmp = scm_lreadr (tok_buf, port, 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)); @@ -703,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)); @@ -726,18 +704,17 @@ 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. */ -SCM_PROC (s_read_hash_extend, "read-hash-extend", 2, 0, 0, scm_read_hash_extend); -SCM -scm_read_hash_extend (chr, proc) - SCM chr; - SCM proc; +SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, + (SCM chr, SCM proc), +"") +#define FUNC_NAME s_scm_read_hash_extend { SCM this; SCM prev; - SCM_ASSERT (SCM_ICHRP(chr), chr, SCM_ARG1, s_read_hash_extend); + SCM_VALIDATE_CHAR (1,chr); SCM_ASSERT (SCM_FALSEP (proc) || SCM_NIMP(proc), proc, SCM_ARG2, - s_read_hash_extend); + FUNC_NAME); /* Check if chr is already in the alist. */ this = *scm_read_hash_procedures; @@ -781,11 +758,11 @@ scm_read_hash_extend (chr, proc) return SCM_UNSPECIFIED; } +#undef FUNC_NAME /* 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; @@ -794,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); @@ -810,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: +*/