[bpt/guile.git] / libguile / read.c

/*	Copyright (C) 1995,1996 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
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 *
 * As a special exception, the Free Software Foundation gives permission
 * for additional uses of the text contained in its release of GUILE.
 *
 * The exception is that, if you link the GUILE library with other files
 * to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the GUILE library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the
 * Free Software Foundation under the name GUILE.  If you copy
 * code from other Free Software Foundation releases into a copy of
 * GUILE, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * 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.  
 */
\f

#include "extchrs.h"
#include <stdio.h>
#include "_scm.h"
#include "chars.h"
#include "genio.h"
#include "eval.h"
#include "unif.h"
#include "mbstrings.h"
#include "kw.h"
#include "alist.h"
#include "srcprop.h"
#include "hashtab.h"
#include "hash.h"

#include "read.h"

\f

#define default_case_i 0

\f

scm_option scm_read_opts[] = {
  { SCM_OPTION_BOOLEAN, "copy", 0,
    "Copy source code expressions." },
  { SCM_OPTION_BOOLEAN, "positions", 0,
    "Record positions of source code expressions." }
};

SCM_PROC (s_read_options, "read-options-interface", 0, 1, 0, scm_read_options);

SCM
scm_read_options (setting)
     SCM setting;
{
  SCM ans = scm_options (setting,
			 scm_read_opts,
			 SCM_N_READ_OPTIONS,
			 s_read_options);
  if (SCM_COPY_SOURCE_P)
    SCM_RECORD_POSITIONS_P = 1;
  return ans;
}

SCM_PROC (s_read, "read", 0, 3, 0, scm_read);

SCM 
scm_read (port, case_insensitive_p, sharp)
     SCM port;
     SCM case_insensitive_p;
     SCM sharp;
{
  int c;
  SCM tok_buf, copy;
  int case_i;

  if (SCM_UNBNDP (port))
    port = scm_cur_inp;
  else
    SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port),
		port,
		SCM_ARG1,
		s_read);

  case_i = (SCM_UNBNDP (case_insensitive_p)
	    ? default_case_i
	    : (case_insensitive_p == SCM_BOOL_F));
  
  if (SCM_UNBNDP (sharp))
    sharp = SCM_BOOL_F;

  c = scm_flush_ws (port, (char *) NULL);
  if (EOF == c)
    return SCM_EOF_VAL;
  scm_gen_ungetc (c, port);

  tok_buf = scm_makstr (30L, 0);
  return scm_lreadr (&tok_buf, port, case_i, sharp, &copy);
}


char *
scm_grow_tok_buf (tok_buf)
     SCM * tok_buf;
{
  scm_vector_set_length_x (*tok_buf, SCM_MAKINUM (2 * SCM_LENGTH (*tok_buf)));
  return SCM_CHARS (*tok_buf);
}


int 
scm_flush_ws (port, eoferr)
     SCM port;
     char *eoferr;
{
  register int c;
  while (1)
    switch (c = scm_gen_getc (port))
      {
      case EOF:
      goteof:
	if (eoferr)
	  scm_wta (SCM_UNDEFINED, "end of file in ", eoferr);
	return c;
      case ';':
      lp:
	switch (c = scm_gen_getc (port))
	  {
	  case EOF:
	    goto goteof;
	  default:
	    goto lp;
	  case SCM_LINE_INCREMENTORS:
	    break;
	  }
	break;
      case SCM_LINE_INCREMENTORS:
      case SCM_SINGLE_SPACES:
      case '\t':
	break;
      default:
	return c;
      }
}


int
scm_casei_streq (s1, s2)
     char * s1;
     char * s2;
{
  while (*s1 && *s2)
    if (scm_downcase((int)*s1) != scm_downcase((int)*s2))
      return 0;
    else
      {
	++s1;
	++s2;
      }
  return !(*s1 || *s2);
}


/* recsexpr is used when recording expressions
 * constructed by read:sharp.
 */

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;
{
  if (SCM_IMP (obj) || SCM_NCONSP(obj))
    return obj;
  {
    SCM tmp = obj, copy;
    /* If this sexpr is visible in the read:sharp source, we want to
       keep that information, so only record non-constant cons cells
       which haven't previously been read by the reader. */
    if (SCM_FALSEP (scm_whash_lookup (scm_source_whash, obj)))
      {
	if (SCM_COPY_SOURCE_P)
	  {
	    copy = scm_cons (recsexpr (SCM_CAR (obj), line, column, filename),
			     SCM_UNDEFINED);
	    while (SCM_NIMP (tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp))
	      {
		SCM_SETCDR (copy, scm_cons (recsexpr (SCM_CAR (tmp),
						      line,
						      column,
						      filename),
					    SCM_UNDEFINED));
		copy = SCM_CDR (copy);
	      }
	    SCM_SETCDR (copy, tmp);
	  }
	else
	  {
	    recsexpr (SCM_CAR (obj), line, column, filename);
	    while (SCM_NIMP (tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp))
	      recsexpr (SCM_CAR (tmp), line, column, filename);
	    copy = SCM_UNDEFINED;
	  }
	scm_whash_insert (scm_source_whash,
			  obj,
			  scm_make_srcprops (line,
					     column,
					     filename,
					     copy,
					     SCM_EOL));
      }
    return obj;
  }
}


/* Consume an SCSH-style block comment.  Assume that we've already
   read the initial `#!', and eat characters until the matching `!#'.  */

static void
skip_scsh_block_comment (port)
     SCM port;
{
  char last_c = '\0';

  for (;;)
    {
      int c = scm_gen_getc (port);

      if (c == EOF)
	scm_wta (SCM_UNDEFINED,
		 "unterminated `#! ... !#' comment", "read");
      else if (c == '#' && last_c == '!')
	return;

      last_c = c;
    }
}


static char s_list[]="list";

SCM 
scm_lreadr (tok_buf, port, case_i, sharp, copy)
     SCM *tok_buf;
     SCM port;
     int case_i;
     SCM sharp;
     SCM *copy;
{
  int c;
  scm_sizet j;
  SCM p;

tryagain:
  c = scm_flush_ws (port, s_read);
  switch (c)
    {
    case EOF:
      return SCM_EOF_VAL;

    case '(':
      return SCM_RECORD_POSITIONS_P
	     ? scm_lreadrecparen (tok_buf, port, s_list, case_i, sharp, copy)
	     : scm_lreadparen (tok_buf, port, s_list, case_i, sharp, copy);
    case ')':
      scm_wta (SCM_UNDEFINED, "unexpected \")\"", "read");
      goto tryagain;
    
    case '\'':
      p = scm_i_quote;
      goto recquote;
    case '`':
      p = scm_i_quasiquote;
      goto recquote;
    case ',':
      c = scm_gen_getc (port);
      if ('@' == c)
	p = scm_i_uq_splicing;
      else
	{
	  scm_gen_ungetc (c, port);
	  p = scm_i_unquote;
	}
    recquote:
      p = scm_cons2 (p,
		     scm_lreadr (tok_buf, port, case_i, sharp, copy),
		     SCM_EOL);
      if (SCM_RECORD_POSITIONS_P)
	scm_whash_insert (scm_source_whash,
			  p,
			  scm_make_srcprops (SCM_LINUM (port),
					     SCM_COL (port) - 1,
					     SCM_FILENAME (port),
					     SCM_COPY_SOURCE_P
					     ? (*copy = scm_cons2 (SCM_CAR (p),
								   SCM_CAR (SCM_CDR (p)),
								   SCM_EOL))
					     : SCM_UNDEFINED,
					     SCM_EOL));
      return p;
    case '#':
      c = scm_gen_getc (port);
      switch (c)
	{
	case '(':
	  p = scm_lreadparen (tok_buf, port, "vector", case_i, sharp, copy);
	  return SCM_NULLP (p) ? scm_nullvect : scm_vector (p);

	case 't':
	case 'T':
	  return SCM_BOOL_T;
	case 'f':
	case 'F':
	  return SCM_BOOL_F;

	case 'b':
	case 'B':
	case 'o':
	case 'O':
	case 'd':
	case 'D':
	case 'x':
	case 'X':
	case 'i':
	case 'I':
	case 'e':
	case 'E':
	  scm_gen_ungetc (c, port);
	  c = '#';
	  goto num;

	case '!':
	  /* start of a shell script.  Parse as a block comment,
	     terminated by !#, just like SCSH.  */
	  skip_scsh_block_comment (port);
	  goto tryagain;

	case '*':
	  j = scm_read_token (c, tok_buf, port, case_i, 0);
	  p = scm_istr2bve (SCM_CHARS (*tok_buf) + 1, (long) (j - 1));
	  if (SCM_NFALSEP (p))
	    return p;
	  else
	    goto unkshrp;

	case '{':
	  j = scm_read_token (c, tok_buf, port, case_i, 1);
	  p = scm_intern (SCM_CHARS (*tok_buf), j);
	  if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
	    scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
	  return SCM_CAR (p);

	case '\\':
	  c = scm_gen_getc (port);
	  j = scm_read_token (c, tok_buf, port, case_i, 0);
	  if (j == 1)
	    return SCM_MAKICHR (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));
	    }
	  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]);
	  scm_wta (SCM_UNDEFINED, "unknown # object: #\\", SCM_CHARS (*tok_buf));


	default:
	callshrp:
	  if (SCM_NIMP (sharp))
	    {
	      int line = SCM_LINUM (port);
	      int column = SCM_COL (port) - 2;
	      SCM got;
	      got = scm_apply (sharp,
			       SCM_MAKICHR (c),
			       scm_acons (port, SCM_EOL, SCM_EOL));
	      if (SCM_UNSPECIFIED == got)
		goto unkshrp;
	      if (SCM_RECORD_POSITIONS_P)
		return *copy = recsexpr (got, line, column,
					 SCM_FILENAME (port));
	      else
		return got;
	    }
	unkshrp:scm_wta ((SCM) SCM_MAKICHR (c), "unknown # object", "");
	}

    case '"':
      j = 0;
      while ('"' != (c = scm_gen_getc (port)))
	{
	  SCM_ASSERT (EOF != c, SCM_UNDEFINED, "end of file in ", "string");

	  while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf))
	    scm_grow_tok_buf (tok_buf);

	  if (c == '\\')
	    switch (c = scm_gen_getc (port))
	      {
	      case '\n':
		continue;
	      case '0':
		c = '\0';
		break;
	      case 'f':
		c = '\f';
		break;
	      case 'n':
		c = '\n';
		break;
	      case 'r':
		c = '\r';
		break;
	      case 't':
		c = '\t';
		break;
	      case 'a':
		c = '\007';
		break;
	      case 'v':
		c = '\v';
		break;
	      }
	  if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
	    {
	      SCM_CHARS (*tok_buf)[j] = c;
	      ++j;
	    }
	  else
	    {
	      int len;
	      len = xwctomb (SCM_CHARS (*tok_buf) + j, c);
	      if (len == 0)
		len = 1;
	      SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read");
	      j += len;
	    }
	}
      if (j == 0)
	return scm_nullstr;
      SCM_CHARS (*tok_buf)[j] = 0;
      {
	SCM str;
	str = scm_makfromstr (SCM_CHARS (*tok_buf), j, 0);
	if (SCM_PORT_REPRESENTATION(port) != scm_regular_port)
	  {
	    SCM_SETLENGTH (str, SCM_LENGTH (str), scm_tc7_mb_string);
	  }
	return str;
      }

    case'0':case '1':case '2':case '3':case '4':
    case '5':case '6':case '7':case '8':case '9':
    case '.':
    case '-':
    case '+':
    num:
      j = scm_read_token (c, tok_buf, port, case_i, 0);
      p = scm_istring2number (SCM_CHARS (*tok_buf), (long) j, 10L);
      if (SCM_NFALSEP (p))
	return p;
      if (c == '#')
	{
	  if ((j == 2) && (scm_gen_getc (port) == '('))
	    {
	      scm_gen_ungetc ('(', port);
	      c = SCM_CHARS (*tok_buf)[1];
	      goto callshrp;
	    }
	  scm_wta (SCM_UNDEFINED, "unknown # object", SCM_CHARS (*tok_buf));
	}
      goto tok;

    case ':':
      j = scm_read_token ('-', tok_buf, port, case_i, 0);
      p = scm_intern (SCM_CHARS (*tok_buf), j);
      if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
	scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
      return scm_make_keyword_from_dash_symbol (SCM_CAR (p));

    default:
      j = scm_read_token (c, tok_buf, port, case_i, 0);
      /* fallthrough */

    tok:
      p = scm_intern (SCM_CHARS (*tok_buf), j);
      if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
	scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
      return SCM_CAR (p);
    }
}

#ifdef _UNICOS
_Pragma ("noopt");		/* # pragma _CRI noopt */
#endif

scm_sizet 
scm_read_token (ic, tok_buf, port, case_i, weird)
     int ic;
     SCM *tok_buf;
     SCM port;
     int case_i;
     int weird;
{
  register scm_sizet j;
  register int c;
  register char *p;

  c = ic;
  p = SCM_CHARS (*tok_buf);

  if (weird)
    j = 0;
  else
    {
      j = 0;
      while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf))
	p = scm_grow_tok_buf (tok_buf);
      if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
	{
	  p[j] = c;
	  ++j;
	}
      else
	{
	  int len;
	  len = xwctomb (p + j, c);
	  if (len == 0)
	    len = 1;
	  SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read");
	  j += len;
	}
    }

  while (1)
    {
      while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf))
	p = scm_grow_tok_buf (tok_buf);
      c = scm_gen_getc (port);
      switch (c)
	{
	case '(':
	case ')':
	case '"':
	case ';':
	case SCM_WHITE_SPACES:
	case SCM_LINE_INCREMENTORS:
	  if (weird)
	    goto default_case;

	  scm_gen_ungetc (c, port);
	case EOF:
	eof_case:
	  p[j] = 0;
	  return j;
	case '\\':
	  if (!weird)
	    goto default_case;
	  else
	    {
	      c = scm_gen_getc (port);
	      if (c == EOF)
		goto eof_case;
	      else
		goto default_case;
	    }
	case '}':
	  if (!weird)
	    goto default_case;

	  c = scm_gen_getc (port);
	  if (c == '#')
	    {
	      p[j] = 0;
	      return j;
	    }
	  else
	    {
	      scm_gen_ungetc (c, port);
	      c = '}';
	      goto default_case;
	    }

	default:
	default_case:
	  {
	    c = (case_i ? scm_downcase(c) : c);
	    if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
	      {
		p[j] = c;
		++j;
	      }
	    else
	      {
		int len;
		len = xwctomb (p + j, c);
		if (len == 0)
		  len = 1;
		SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read");
		j += len;
	      }
	  }

	}
    }
}

#ifdef _UNICOS
_Pragma ("opt");		/* # pragma _CRI opt */
#endif

SCM 
scm_lreadparen (tok_buf, port, name, case_i, sharp, copy)
     SCM *tok_buf;
     SCM port;
     char *name;
     int case_i;
     SCM sharp;
     SCM *copy;
{
  SCM tmp;
  SCM tl;
  SCM ans;
  int c;

  c = scm_flush_ws (port, name);
  if (')' == c)
    return SCM_EOL;
  scm_gen_ungetc (c, port);
  if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
    {
      ans = scm_lreadr (tok_buf, port, case_i, sharp, copy);
    closeit:
      if (')' != (c = scm_flush_ws (port, name)))
	scm_wta (SCM_UNDEFINED, "missing close paren", "");
      return ans;
    }
  ans = tl = scm_cons (tmp, SCM_EOL);
  while (')' != (c = scm_flush_ws (port, name)))
    {
      scm_gen_ungetc (c, port);
      if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
	{
	  SCM_SETCDR (tl, scm_lreadr (tok_buf, port, case_i, sharp, copy));
	  goto closeit;
	}
      SCM_SETCDR (tl, scm_cons (tmp, SCM_EOL));
      tl = SCM_CDR (tl);
    }
  return ans;
}


SCM 
scm_lreadrecparen (tok_buf, port, name, case_i, sharp, copy)
     SCM *tok_buf;
     SCM port;
     char *name;
     int case_i;
     SCM sharp;
     SCM *copy;
{
  register int c;
  register SCM tmp;
  register SCM tl, tl2 = SCM_EOL;
  SCM ans, ans2 = SCM_EOL;
  /* Need to capture line and column numbers here. */
  int line = SCM_LINUM (port);
  int column = SCM_COL (port) - 1;

  c = scm_flush_ws (port, name);
  if (')' == c)
    return SCM_EOL;
  scm_gen_ungetc (c, port);
  if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
    {
      ans = scm_lreadr (tok_buf, port, case_i, sharp, copy);
      if (')' != (c = scm_flush_ws (port, name)))
	scm_wta (SCM_UNDEFINED, "missing close paren", "");
      return ans;
    }
  /* 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)
			   ? *copy
			   : tmp,
			   SCM_EOL);
  while (')' != (c = scm_flush_ws (port, name)))
    {
      scm_gen_ungetc (c, port);
      if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
	{
	  SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy));
	  if (SCM_COPY_SOURCE_P)
	    SCM_SETCDR (tl2, scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp)
				       ? *copy
				       : tmp,
				       SCM_EOL));
	  if (')' != (c = scm_flush_ws (port, name)))
	    scm_wta (SCM_UNDEFINED, "missing close paren", "");
	  goto exit;
	}
      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)
					 ? *copy
					 : tmp,
					 SCM_EOL));
    }
exit:
  scm_whash_insert (scm_source_whash,
		    ans,
		    scm_make_srcprops (line,
				       column,
				       SCM_FILENAME (port),
				       SCM_COPY_SOURCE_P
				       ? *copy = ans2
				       : SCM_UNDEFINED,
				       SCM_EOL));
  return ans;
}


\f


void
scm_init_read ()
{
  scm_init_opts (scm_read_options, scm_read_opts, SCM_N_READ_OPTIONS);
#include "read.x"
}
Commit	Line	Data
0f2d19dd JB	1	/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
	2	*
	3	* This program is free software; you can redistribute it and/or modify
	4	* it under the terms of the GNU General Public License as published by
	5	* the Free Software Foundation; either version 2, or (at your option)
	6	* any later version.
	7	*
	8	* This program is distributed in the hope that it will be useful,
	9	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	10	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	11	* GNU General Public License for more details.
	12	*
	13	* You should have received a copy of the GNU General Public License
	14	* along with this software; see the file COPYING. If not, write to
	15	* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
	16	*
	17	* As a special exception, the Free Software Foundation gives permission
	18	* for additional uses of the text contained in its release of GUILE.
	19	*
	20	* The exception is that, if you link the GUILE library with other files
	21	* to produce an executable, this does not by itself cause the
	22	* resulting executable to be covered by the GNU General Public License.
	23	* Your use of that executable is in no way restricted on account of
	24	* linking the GUILE library code into it.
	25	*
	26	* This exception does not however invalidate any other reasons why
	27	* the executable file might be covered by the GNU General Public License.
	28	*
	29	* This exception applies only to the code released by the
	30	* Free Software Foundation under the name GUILE. If you copy
	31	* code from other Free Software Foundation releases into a copy of
	32	* GUILE, as the General Public License permits, the exception does
	33	* not apply to the code that you add in this way. To avoid misleading
	34	* anyone as to the status of such modified files, you must delete
	35	* this exception notice from them.
	36	*
	37	* If you write modifications of your own for GUILE, it is your choice
	38	* whether to permit this exception to apply to your modifications.
	39	* If you do not wish that, delete this exception notice.
	40	*/
	41	\f
	42
	43	#include "extchrs.h"
	44	#include <stdio.h>
	45	#include "_scm.h"
20e6290e JB	46	#include "chars.h"
	47	#include "genio.h"
	48	#include "eval.h"
	49	#include "unif.h"
	50	#include "mbstrings.h"
	51	#include "kw.h"
	52	#include "alist.h"
09a4f039 MD	53	#include "srcprop.h"
	54	#include "hashtab.h"
	55	#include "hash.h"
20e6290e	56
0f2d19dd JB	57	#include "read.h"
	58
	59	\f
	60
	61	#define default_case_i 0
	62
	63	\f
	64
a16f6fe7	65	scm_option scm_read_opts[] = {
b7ff98dd MD	66	{ SCM_OPTION_BOOLEAN, "copy", 0,
b7ff98dd MD	67	"Copy source code expressions." },
ac74fc22	68	{ SCM_OPTION_BOOLEAN, "positions", 0,
b7ff98dd	69	"Record positions of source code expressions." }
a16f6fe7 MD	70	};
a16f6fe7 MD	71
b7ff98dd	72	SCM_PROC (s_read_options, "read-options-interface", 0, 1, 0, scm_read_options);
1cc91f1b	73
a16f6fe7	74	SCM
b7ff98dd MD	75	scm_read_options (setting)
b7ff98dd MD	76	SCM setting;
a16f6fe7	77	{
b7ff98dd MD	78	SCM ans = scm_options (setting,
	79	scm_read_opts,
	80	SCM_N_READ_OPTIONS,
	81	s_read_options);
	82	if (SCM_COPY_SOURCE_P)
	83	SCM_RECORD_POSITIONS_P = 1;
a16f6fe7 MD	84	return ans;
a16f6fe7 MD	85	}
a16f6fe7	86
0f2d19dd	87	SCM_PROC (s_read, "read", 0, 3, 0, scm_read);
1cc91f1b	88
0f2d19dd	89	SCM
95b88819	90	scm_read (port, case_insensitive_p, sharp)
0f2d19dd	91	SCM port;
95b88819	92	SCM case_insensitive_p;
0f2d19dd	93	SCM sharp;
0f2d19dd JB	94	{
0f2d19dd JB	95	int c;
09a4f039	96	SCM tok_buf, copy;
0f2d19dd JB	97	int case_i;
	98
	99	if (SCM_UNBNDP (port))
	100	port = scm_cur_inp;
	101	else
09a4f039 MD	102	SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port),
	103	port,
	104	SCM_ARG1,
	105	s_read);
0f2d19dd	106
95b88819	107	case_i = (SCM_UNBNDP (case_insensitive_p)
0f2d19dd	108	? default_case_i
95b88819	109	: (case_insensitive_p == SCM_BOOL_F));
0f2d19dd JB	110
	111	if (SCM_UNBNDP (sharp))
	112	sharp = SCM_BOOL_F;
	113
	114	c = scm_flush_ws (port, (char *) NULL);
	115	if (EOF == c)
	116	return SCM_EOF_VAL;
	117	scm_gen_ungetc (c, port);
	118
	119	tok_buf = scm_makstr (30L, 0);
09a4f039	120	return scm_lreadr (&tok_buf, port, case_i, sharp, &copy);
0f2d19dd JB	121	}
	122
	123
1cc91f1b	124
0f2d19dd JB	125	char *
	126	scm_grow_tok_buf (tok_buf)
	127	SCM * tok_buf;
0f2d19dd	128	{
85ab9947	129	scm_vector_set_length_x (tok_buf, SCM_MAKINUM (2 SCM_LENGTH (*tok_buf)));
0f2d19dd JB	130	return SCM_CHARS (*tok_buf);
	131	}
	132
	133
1cc91f1b	134
0f2d19dd JB	135	int
	136	scm_flush_ws (port, eoferr)
	137	SCM port;
	138	char *eoferr;
0f2d19dd JB	139	{
	140	register int c;
	141	while (1)
	142	switch (c = scm_gen_getc (port))
	143	{
	144	case EOF:
	145	goteof:
	146	if (eoferr)
	147	scm_wta (SCM_UNDEFINED, "end of file in ", eoferr);
	148	return c;
	149	case ';':
	150	lp:
	151	switch (c = scm_gen_getc (port))
	152	{
	153	case EOF:
	154	goto goteof;
	155	default:
	156	goto lp;
	157	case SCM_LINE_INCREMENTORS:
	158	break;
	159	}
	160	break;
	161	case SCM_LINE_INCREMENTORS:
0f2d19dd	162	case SCM_SINGLE_SPACES:
0f2d19dd	163	case '\t':
0f2d19dd JB	164	break;
	165	default:
	166	return c;
	167	}
	168	}
	169
	170
1cc91f1b	171
0f2d19dd JB	172	int
	173	scm_casei_streq (s1, s2)
	174	char * s1;
	175	char * s2;
0f2d19dd JB	176	{
	177	while (s1 && s2)
	178	if (scm_downcase((int)s1) != scm_downcase((int)s2))
	179	return 0;
	180	else
	181	{
	182	++s1;
	183	++s2;
	184	}
	185	return !(s1 \|\| s2);
	186	}
	187
	188
09a4f039 MD	189	/* recsexpr is used when recording expressions
	190	* constructed by read:sharp.
	191	*/
1cc91f1b JB	192
	193	static SCM recsexpr SCM_P ((SCM obj, int line, int column, SCM filename));
	194
09a4f039 MD	195	static SCM
	196	recsexpr (obj, line, column, filename)
	197	SCM obj;
	198	int line;
	199	int column;
	200	SCM filename;
09a4f039 MD	201	{
	202	if (SCM_IMP (obj) \|\| SCM_NCONSP(obj))
	203	return obj;
	204	{
	205	SCM tmp = obj, copy;
	206	/* If this sexpr is visible in the read:sharp source, we want to
	207	keep that information, so only record non-constant cons cells
	208	which haven't previously been read by the reader. */
	209	if (SCM_FALSEP (scm_whash_lookup (scm_source_whash, obj)))
	210	{
	211	if (SCM_COPY_SOURCE_P)
	212	{
	213	copy = scm_cons (recsexpr (SCM_CAR (obj), line, column, filename),
	214	SCM_UNDEFINED);
	215	while (SCM_NIMP (tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp))
a6c64c3c MD	216	{
	217	SCM_SETCDR (copy, scm_cons (recsexpr (SCM_CAR (tmp),
	218	line,
	219	column,
	220	filename),
	221	SCM_UNDEFINED));
	222	copy = SCM_CDR (copy);
	223	}
	224	SCM_SETCDR (copy, tmp);
09a4f039 MD	225	}
	226	else
	227	{
	228	recsexpr (SCM_CAR (obj), line, column, filename);
	229	while (SCM_NIMP (tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp))
	230	recsexpr (SCM_CAR (tmp), line, column, filename);
	231	copy = SCM_UNDEFINED;
	232	}
	233	scm_whash_insert (scm_source_whash,
	234	obj,
	235	scm_make_srcprops (line,
	236	column,
	237	filename,
	238	copy,
	239	SCM_EOL));
	240	}
	241	return obj;
	242	}
	243	}
	244
f9c68a47 JB	245
	246	/* Consume an SCSH-style block comment. Assume that we've already
	247	read the initial `#!', and eat characters until the matching `!#'. */
	248
	249	static void
	250	skip_scsh_block_comment (port)
	251	SCM port;
	252	{
	253	char last_c = '\0';
	254
	255	for (;;)
	256	{
	257	int c = scm_gen_getc (port);
	258
	259	if (c == EOF)
	260	scm_wta (SCM_UNDEFINED,
	261	"unterminated `#! ... !#' comment", "read");
	262	else if (c == '#' && last_c == '!')
	263	return;
	264
	265	last_c = c;
	266	}
	267	}
	268
	269
09a4f039	270	static char s_list[]="list";
1cc91f1b	271
0f2d19dd	272	SCM
09a4f039 MD	273	scm_lreadr (tok_buf, port, case_i, sharp, copy)
09a4f039 MD	274	SCM *tok_buf;
0f2d19dd JB	275	SCM port;
	276	int case_i;
	277	SCM sharp;
09a4f039	278	SCM *copy;
0f2d19dd JB	279	{
	280	int c;
	281	scm_sizet j;
	282	SCM p;
	283
	284	tryagain:
	285	c = scm_flush_ws (port, s_read);
	286	switch (c)
	287	{
	288	case EOF:
	289	return SCM_EOF_VAL;
	290
	291	case '(':
09a4f039 MD	292	return SCM_RECORD_POSITIONS_P
	293	? scm_lreadrecparen (tok_buf, port, s_list, case_i, sharp, copy)
	294	: scm_lreadparen (tok_buf, port, s_list, case_i, sharp, copy);
0f2d19dd JB	295	case ')':
	296	scm_wta (SCM_UNDEFINED, "unexpected \")\"", "read");
	297	goto tryagain;
	298
	299	case '\'':
09a4f039 MD	300	p = scm_i_quote;
09a4f039 MD	301	goto recquote;
0f2d19dd	302	case '`':
09a4f039 MD	303	p = scm_i_quasiquote;
09a4f039 MD	304	goto recquote;
0f2d19dd JB	305	case ',':
	306	c = scm_gen_getc (port);
	307	if ('@' == c)
	308	p = scm_i_uq_splicing;
	309	else
	310	{
	311	scm_gen_ungetc (c, port);
	312	p = scm_i_unquote;
	313	}
09a4f039 MD	314	recquote:
	315	p = scm_cons2 (p,
	316	scm_lreadr (tok_buf, port, case_i, sharp, copy),
	317	SCM_EOL);
	318	if (SCM_RECORD_POSITIONS_P)
	319	scm_whash_insert (scm_source_whash,
	320	p,
	321	scm_make_srcprops (SCM_LINUM (port),
	322	SCM_COL (port) - 1,
	323	SCM_FILENAME (port),
	324	SCM_COPY_SOURCE_P
	325	? (*copy = scm_cons2 (SCM_CAR (p),
	326	SCM_CAR (SCM_CDR (p)),
	327	SCM_EOL))
	328	: SCM_UNDEFINED,
	329	SCM_EOL));
	330	return p;
0f2d19dd JB	331	case '#':
	332	c = scm_gen_getc (port);
	333	switch (c)
	334	{
	335	case '(':
09a4f039	336	p = scm_lreadparen (tok_buf, port, "vector", case_i, sharp, copy);
0f2d19dd JB	337	return SCM_NULLP (p) ? scm_nullvect : scm_vector (p);
	338
	339	case 't':
	340	case 'T':
	341	return SCM_BOOL_T;
	342	case 'f':
	343	case 'F':
	344	return SCM_BOOL_F;
	345
	346	case 'b':
	347	case 'B':
	348	case 'o':
	349	case 'O':
	350	case 'd':
	351	case 'D':
	352	case 'x':
	353	case 'X':
	354	case 'i':
	355	case 'I':
	356	case 'e':
	357	case 'E':
	358	scm_gen_ungetc (c, port);
	359	c = '#';
	360	goto num;
	361
f9c68a47 JB	362	case '!':
	363	/* start of a shell script. Parse as a block comment,
	364	terminated by !#, just like SCSH. */
	365	skip_scsh_block_comment (port);
	366	goto tryagain;
	367
0f2d19dd JB	368	case '*':
	369	j = scm_read_token (c, tok_buf, port, case_i, 0);
	370	p = scm_istr2bve (SCM_CHARS (*tok_buf) + 1, (long) (j - 1));
	371	if (SCM_NFALSEP (p))
	372	return p;
	373	else
	374	goto unkshrp;
	375
	376	case '{':
	377	j = scm_read_token (c, tok_buf, port, case_i, 1);
	378	p = scm_intern (SCM_CHARS (*tok_buf), j);
	379	if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
	380	scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
	381	return SCM_CAR (p);
	382
	383	case '\\':
	384	c = scm_gen_getc (port);
	385	j = scm_read_token (c, tok_buf, port, case_i, 0);
	386	if (j == 1)
	387	return SCM_MAKICHR (c);
	388	if (c >= '0' && c < '8')
	389	{
	390	p = scm_istr2int (SCM_CHARS (*tok_buf), (long) j, 8);
	391	if (SCM_NFALSEP (p))
	392	return SCM_MAKICHR (SCM_INUM (p));
	393	}
	394	for (c = 0; c < scm_n_charnames; c++)
	395	if (scm_charnames[c]
	396	&& (scm_casei_streq (scm_charnames[c], SCM_CHARS (*tok_buf))))
	397	return SCM_MAKICHR (scm_charnums[c]);
	398	scm_wta (SCM_UNDEFINED, "unknown # object: #\\", SCM_CHARS (*tok_buf));
	399
	400
	401	default:
	402	callshrp:
	403	if (SCM_NIMP (sharp))
	404	{
09a4f039 MD	405	int line = SCM_LINUM (port);
09a4f039 MD	406	int column = SCM_COL (port) - 2;
0f2d19dd	407	SCM got;
09a4f039 MD	408	got = scm_apply (sharp,
	409	SCM_MAKICHR (c),
	410	scm_acons (port, SCM_EOL, SCM_EOL));
0f2d19dd JB	411	if (SCM_UNSPECIFIED == got)
0f2d19dd JB	412	goto unkshrp;
09a4f039 MD	413	if (SCM_RECORD_POSITIONS_P)
	414	return *copy = recsexpr (got, line, column,
	415	SCM_FILENAME (port));
	416	else
	417	return got;
0f2d19dd JB	418	}
	419	unkshrp:scm_wta ((SCM) SCM_MAKICHR (c), "unknown # object", "");
	420	}
	421
	422	case '"':
	423	j = 0;
	424	while ('"' != (c = scm_gen_getc (port)))
	425	{
	426	SCM_ASSERT (EOF != c, SCM_UNDEFINED, "end of file in ", "string");
	427
	428	while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf))
	429	scm_grow_tok_buf (tok_buf);
	430
	431	if (c == '\\')
	432	switch (c = scm_gen_getc (port))
	433	{
	434	case '\n':
	435	continue;
	436	case '0':
	437	c = '\0';
	438	break;
	439	case 'f':
	440	c = '\f';
	441	break;
	442	case 'n':
	443	c = '\n';
	444	break;
	445	case 'r':
	446	c = '\r';
	447	break;
	448	case 't':
	449	c = '\t';
	450	break;
	451	case 'a':
	452	c = '\007';
	453	break;
	454	case 'v':
	455	c = '\v';
	456	break;
	457	}
	458	if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
	459	{
	460	SCM_CHARS (*tok_buf)[j] = c;
	461	++j;
	462	}
	463	else
	464	{
	465	int len;
	466	len = xwctomb (SCM_CHARS (*tok_buf) + j, c);
	467	if (len == 0)
	468	len = 1;
	469	SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read");
	470	j += len;
	471	}
	472	}
	473	if (j == 0)
	474	return scm_nullstr;
	475	SCM_CHARS (*tok_buf)[j] = 0;
	476	{
	477	SCM str;
	478	str = scm_makfromstr (SCM_CHARS (*tok_buf), j, 0);
	479	if (SCM_PORT_REPRESENTATION(port) != scm_regular_port)
	480	{
	481	SCM_SETLENGTH (str, SCM_LENGTH (str), scm_tc7_mb_string);
482	}
483	return str;
484	}
485
486	case'0':case '1':case '2':case '3':case '4':
487	case '5':case '6':case '7':case '8':case '9':
488	case '.':
489	case '-':
490	case '+':
491	num:
492	j = scm_read_token (c, tok_buf, port, case_i, 0);
493	p = scm_istring2number (SCM_CHARS (*tok_buf), (long) j, 10L);
494	if (SCM_NFALSEP (p))
495	return p;
496	if (c == '#')
497	{
498	if ((j == 2) && (scm_gen_getc (port) == '('))
499	{
500	scm_gen_ungetc ('(', port);
501	c = SCM_CHARS (*tok_buf)[1];
502	goto callshrp;
503	}
504	scm_wta (SCM_UNDEFINED, "unknown # object", SCM_CHARS (*tok_buf));
505	}
506	goto tok;
507
508	case ':':
509	j = scm_read_token ('-', tok_buf, port, case_i, 0);
510	p = scm_intern (SCM_CHARS (*tok_buf), j);
511	if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
512	scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
513	return scm_make_keyword_from_dash_symbol (SCM_CAR (p));
514
515	default:
516	j = scm_read_token (c, tok_buf, port, case_i, 0);
517	/* fallthrough */
518
519	tok:
520	p = scm_intern (SCM_CHARS (*tok_buf), j);
521	if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
522	scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
523	return SCM_CAR (p);
524	}
525	}
526
527	#ifdef _UNICOS
528	_Pragma ("noopt"); /* # pragma _CRI noopt */
529	#endif
1cc91f1b	530
0f2d19dd	531	scm_sizet
1cc91f1b	532	scm_read_token (ic, tok_buf, port, case_i, weird)
0f2d19dd JB	533	int ic;
	534	SCM *tok_buf;
	535	SCM port;
	536	int case_i;
	537	int weird;
0f2d19dd JB	538	{
	539	register scm_sizet j;
	540	register int c;
	541	register char *p;
	542
	543	c = ic;
	544	p = SCM_CHARS (*tok_buf);
	545
	546	if (weird)
	547	j = 0;
	548	else
	549	{
	550	j = 0;
	551	while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf))
	552	p = scm_grow_tok_buf (tok_buf);
	553	if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
	554	{
	555	p[j] = c;
	556	++j;
	557	}
	558	else
	559	{
	560	int len;
	561	len = xwctomb (p + j, c);
	562	if (len == 0)
	563	len = 1;
	564	SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read");
	565	j += len;
	566	}
	567	}
	568
	569	while (1)
	570	{
	571	while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf))
	572	p = scm_grow_tok_buf (tok_buf);
	573	c = scm_gen_getc (port);
	574	switch (c)
	575	{
	576	case '(':
	577	case ')':
	578	case '"':
	579	case ';':
	580	case SCM_WHITE_SPACES:
	581	case SCM_LINE_INCREMENTORS:
	582	if (weird)
	583	goto default_case;
	584
	585	scm_gen_ungetc (c, port);
	586	case EOF:
	587	eof_case:
	588	p[j] = 0;
	589	return j;
	590	case '\\':
	591	if (!weird)
	592	goto default_case;
	593	else
	594	{
	595	c = scm_gen_getc (port);
	596	if (c == EOF)
	597	goto eof_case;
	598	else
	599	goto default_case;
	600	}
	601	case '}':
602	if (!weird)
603	goto default_case;
604
605	c = scm_gen_getc (port);
606	if (c == '#')
607	{
608	p[j] = 0;
609	return j;
610	}
611	else
612	{
613	scm_gen_ungetc (c, port);
614	c = '}';
615	goto default_case;
616	}
617
618	default:
619	default_case:
620	{
621	c = (case_i ? scm_downcase(c) : c);
622	if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
623	{
624	p[j] = c;
625	++j;
626	}
627	else
628	{
629	int len;
630	len = xwctomb (p + j, c);
631	if (len == 0)
632	len = 1;
633	SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read");
634	j += len;
635	}
636	}
637
638	}
639	}
640	}
1cc91f1b	641
0f2d19dd JB	642	#ifdef _UNICOS
	643	_Pragma ("opt"); /* # pragma _CRI opt */
	644	#endif
	645
0f2d19dd	646	SCM
1cc91f1b	647	scm_lreadparen (tok_buf, port, name, case_i, sharp, copy)
0f2d19dd JB	648	SCM *tok_buf;
	649	SCM port;
	650	char *name;
	651	int case_i;
	652	SCM sharp;
1cc91f1b	653	SCM *copy;
0f2d19dd JB	654	{
	655	SCM tmp;
	656	SCM tl;
	657	SCM ans;
	658	int c;
	659
	660	c = scm_flush_ws (port, name);
	661	if (')' == c)
	662	return SCM_EOL;
	663	scm_gen_ungetc (c, port);
09a4f039	664	if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
0f2d19dd	665	{
09a4f039	666	ans = scm_lreadr (tok_buf, port, case_i, sharp, copy);
0f2d19dd JB	667	closeit:
	668	if (')' != (c = scm_flush_ws (port, name)))
	669	scm_wta (SCM_UNDEFINED, "missing close paren", "");
	670	return ans;
	671	}
	672	ans = tl = scm_cons (tmp, SCM_EOL);
	673	while (')' != (c = scm_flush_ws (port, name)))
	674	{
	675	scm_gen_ungetc (c, port);
09a4f039	676	if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
0f2d19dd	677	{
a6c64c3c	678	SCM_SETCDR (tl, scm_lreadr (tok_buf, port, case_i, sharp, copy));
0f2d19dd JB	679	goto closeit;
0f2d19dd JB	680	}
a6c64c3c MD	681	SCM_SETCDR (tl, scm_cons (tmp, SCM_EOL));
a6c64c3c MD	682	tl = SCM_CDR (tl);
0f2d19dd JB	683	}
	684	return ans;
	685	}
	686
1cc91f1b	687
09a4f039 MD	688	SCM
	689	scm_lreadrecparen (tok_buf, port, name, case_i, sharp, copy)
	690	SCM *tok_buf;
	691	SCM port;
	692	char *name;
	693	int case_i;
	694	SCM sharp;
	695	SCM *copy;
09a4f039 MD	696	{
	697	register int c;
	698	register SCM tmp;
4dc2435a JB	699	register SCM tl, tl2 = SCM_EOL;
4dc2435a JB	700	SCM ans, ans2 = SCM_EOL;
09a4f039 MD	701	/* Need to capture line and column numbers here. */
	702	int line = SCM_LINUM (port);
	703	int column = SCM_COL (port) - 1;
	704
	705	c = scm_flush_ws (port, name);
	706	if (')' == c)
	707	return SCM_EOL;
	708	scm_gen_ungetc (c, port);
	709	if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
	710	{
	711	ans = scm_lreadr (tok_buf, port, case_i, sharp, copy);
	712	if (')' != (c = scm_flush_ws (port, name)))
	713	scm_wta (SCM_UNDEFINED, "missing close paren", "");
	714	return ans;
	715	}
	716	/* Build the head of the list structure. */
	717	ans = tl = scm_cons (tmp, SCM_EOL);
	718	if (SCM_COPY_SOURCE_P)
	719	ans2 = tl2 = scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp)
	720	? *copy
	721	: tmp,
	722	SCM_EOL);
	723	while (')' != (c = scm_flush_ws (port, name)))
	724	{
	725	scm_gen_ungetc (c, port);
	726	if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
	727	{
	728	SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy));
	729	if (SCM_COPY_SOURCE_P)
	730	SCM_SETCDR (tl2, scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp)
	731	? *copy
	732	: tmp,
	733	SCM_EOL));
	734	if (')' != (c = scm_flush_ws (port, name)))
	735	scm_wta (SCM_UNDEFINED, "missing close paren", "");
	736	goto exit;
	737	}
	738	tl = SCM_SETCDR (tl, scm_cons (tmp, SCM_EOL));
	739	if (SCM_COPY_SOURCE_P)
	740	tl2 = SCM_SETCDR (tl2, scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp)
	741	? *copy
	742	: tmp,
	743	SCM_EOL));
	744	}
	745	exit:
	746	scm_whash_insert (scm_source_whash,
	747	ans,
	748	scm_make_srcprops (line,
	749	column,
	750	SCM_FILENAME (port),
	751	SCM_COPY_SOURCE_P
	752	? *copy = ans2
	753	: SCM_UNDEFINED,
	754	SCM_EOL));
	755	return ans;
	756	}
	757
0f2d19dd JB	758
	759	\f
	760
	761
1cc91f1b	762
0f2d19dd JB	763	void
0f2d19dd JB	764	scm_init_read ()
0f2d19dd	765	{
b7ff98dd	766	scm_init_opts (scm_read_options, scm_read_opts, SCM_N_READ_OPTIONS);
0f2d19dd JB	767	#include "read.x"
0f2d19dd JB	768	}