rdelim.c 5.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218
  1. /* Copyright 1995-2001,2006,2011,2018
  2. Free Software Foundation, Inc.
  3. This file is part of Guile.
  4. Guile is free software: you can redistribute it and/or modify it
  5. under the terms of the GNU Lesser General Public License as published
  6. by the Free Software Foundation, either version 3 of the License, or
  7. (at your option) any later version.
  8. Guile is distributed in the hope that it will be useful, but WITHOUT
  9. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  10. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
  11. License for more details.
  12. You should have received a copy of the GNU Lesser General Public
  13. License along with Guile. If not, see
  14. <https://www.gnu.org/licenses/>. */
  15. #ifdef HAVE_CONFIG_H
  16. # include <config.h>
  17. #endif
  18. #include <stdio.h>
  19. #include <string.h>
  20. #include "boolean.h"
  21. #include "chars.h"
  22. #include "gsubr.h"
  23. #include "list.h"
  24. #include "modules.h"
  25. #include "numbers.h"
  26. #include "pairs.h"
  27. #include "ports.h"
  28. #include "srfi-13.h"
  29. #include "strings.h"
  30. #include "strports.h"
  31. #include "rdelim.h"
  32. SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
  33. (SCM delims, SCM str, SCM gobble, SCM port, SCM start, SCM end),
  34. "Read characters from @var{port} into @var{str} until one of the\n"
  35. "characters in the @var{delims} string is encountered. If\n"
  36. "@var{gobble} is true, discard the delimiter character;\n"
  37. "otherwise, leave it in the input stream for the next read. If\n"
  38. "@var{port} is not specified, use the value of\n"
  39. "@code{(current-input-port)}. If @var{start} or @var{end} are\n"
  40. "specified, store data only into the substring of @var{str}\n"
  41. "bounded by @var{start} and @var{end} (which default to the\n"
  42. "beginning and end of the string, respectively).\n"
  43. "\n"
  44. " Return a pair consisting of the delimiter that terminated the\n"
  45. "string and the number of characters read. If reading stopped\n"
  46. "at the end of file, the delimiter returned is the\n"
  47. "@var{eof-object}; if the string was filled without encountering\n"
  48. "a delimiter, this value is @code{#f}.")
  49. #define FUNC_NAME s_scm_read_delimited_x
  50. {
  51. size_t j;
  52. size_t cstart;
  53. size_t cend;
  54. scm_t_wchar c;
  55. size_t num_delims;
  56. SCM_VALIDATE_STRING (1, delims);
  57. num_delims = scm_i_string_length (delims);
  58. SCM_VALIDATE_STRING (2, str);
  59. scm_i_get_substring_spec (scm_i_string_length (str),
  60. start, &cstart, end, &cend);
  61. if (SCM_UNBNDP (port))
  62. port = scm_current_input_port ();
  63. else
  64. SCM_VALIDATE_OPINPORT (4, port);
  65. for (j = cstart; j < cend; j++)
  66. {
  67. size_t k;
  68. c = scm_getc (port);
  69. for (k = 0; k < num_delims; k++)
  70. {
  71. if (scm_i_string_ref (delims, k) == c)
  72. {
  73. if (scm_is_false (gobble))
  74. scm_ungetc (c, port);
  75. return scm_cons (SCM_MAKE_CHAR (c),
  76. scm_from_size_t (j - cstart));
  77. }
  78. }
  79. if (c == EOF)
  80. return scm_cons (SCM_EOF_VAL,
  81. scm_from_size_t (j - cstart));
  82. scm_c_string_set_x (str, j, SCM_MAKE_CHAR (c));
  83. }
  84. return scm_cons (SCM_BOOL_F, scm_from_size_t (j - cstart));
  85. }
  86. #undef FUNC_NAME
  87. /*
  88. * %read-line
  89. * truncates any terminating newline from its input, and returns
  90. * a cons of the string read and its terminating character. Doing
  91. * so makes it easy to implement the hairy `read-line' options
  92. * efficiently in Scheme.
  93. */
  94. SCM_DEFINE (scm_read_line, "%read-line", 0, 1, 0,
  95. (SCM port),
  96. "Read a newline-terminated line from @var{port}, allocating storage as\n"
  97. "necessary. The newline terminator (if any) is removed from the string,\n"
  98. "and a pair consisting of the line and its delimiter is returned. The\n"
  99. "delimiter may be either a newline or the @var{eof-object}; if\n"
  100. "@code{%read-line} is called at the end of file, it returns the pair\n"
  101. "@code{(#<eof> . #<eof>)}.")
  102. #define FUNC_NAME s_scm_read_line
  103. {
  104. /* Threshold under which the only allocation performed is that of the
  105. resulting string and pair. */
  106. #define LINE_BUFFER_SIZE 256
  107. SCM line, strings, result;
  108. scm_t_wchar buf[LINE_BUFFER_SIZE], delim;
  109. size_t index;
  110. if (SCM_UNBNDP (port))
  111. port = scm_current_input_port ();
  112. SCM_VALIDATE_OPINPORT (1,port);
  113. index = 0;
  114. delim = 0;
  115. strings = SCM_BOOL_F;
  116. do
  117. {
  118. if (SCM_UNLIKELY (index >= LINE_BUFFER_SIZE))
  119. {
  120. /* The line is getting longer than BUF so store its current
  121. contents in STRINGS. */
  122. strings = scm_cons (scm_from_utf32_stringn (buf, index),
  123. scm_is_false (strings) ? SCM_EOL : strings);
  124. index = 0;
  125. }
  126. else
  127. {
  128. buf[index] = scm_getc (port);
  129. switch (buf[index])
  130. {
  131. case EOF:
  132. case '\n':
  133. delim = buf[index];
  134. break;
  135. default:
  136. index++;
  137. }
  138. }
  139. }
  140. while (delim == 0);
  141. if (SCM_LIKELY (scm_is_false (strings)))
  142. /* The fast path. */
  143. line = scm_from_utf32_stringn (buf, index);
  144. else
  145. {
  146. /* Aggregate the intermediary results. */
  147. strings = scm_cons (scm_from_utf32_stringn (buf, index), strings);
  148. line = scm_string_concatenate (scm_reverse (strings));
  149. }
  150. if (delim == EOF && scm_i_string_length (line) == 0)
  151. result = scm_cons (SCM_EOF_VAL, SCM_EOF_VAL);
  152. else
  153. result = scm_cons (line,
  154. delim == EOF ? SCM_EOF_VAL : SCM_MAKE_CHAR (delim));
  155. return result;
  156. #undef LINE_BUFFER_SIZE
  157. }
  158. #undef FUNC_NAME
  159. SCM_DEFINE (scm_write_line, "write-line", 1, 1, 0,
  160. (SCM obj, SCM port),
  161. "Display @var{obj} and a newline character to @var{port}. If\n"
  162. "@var{port} is not specified, @code{(current-output-port)} is\n"
  163. "used. This procedure is equivalent to:\n"
  164. "@lisp\n"
  165. "(display obj [port])\n"
  166. "(newline [port])\n"
  167. "@end lisp")
  168. #define FUNC_NAME s_scm_write_line
  169. {
  170. scm_display (obj, port);
  171. return scm_newline (port);
  172. }
  173. #undef FUNC_NAME
  174. SCM
  175. scm_init_rdelim_builtins (void)
  176. {
  177. #include "rdelim.x"
  178. return SCM_UNSPECIFIED;
  179. }
  180. void
  181. scm_init_rdelim (void)
  182. {
  183. scm_c_define_gsubr ("%init-rdelim-builtins", 0, 0, 0,
  184. scm_init_rdelim_builtins);
  185. }