summaryrefslogtreecommitdiff
path: root/libguile/read.c
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2008-09-10 22:50:04 +0200
committerLudovic Courtès <ludo@gnu.org>2008-09-10 22:50:04 +0200
commit6774820f1e83a388b3232cd61a66340886b395d8 (patch)
tree513cae9f2b9168aea1e4e20c3ce91cf89e0ce817 /libguile/read.c
parentb74e86cf5f50612742609210ad8e04d46069437f (diff)
parent29776e85da637ec4d44b2b2822d6934a50c0084b (diff)
downloadguile-6774820f1e83a388b3232cd61a66340886b395d8.tar.gz
Merge commit '29776e85da637ec4d44b2b2822d6934a50c0084b' into boehm-demers-weiser-gc
Conflicts: libguile/gc-card.c libguile/gc.c libguile/gc.h libguile/ports.c
Diffstat (limited to 'libguile/read.c')
-rw-r--r--libguile/read.c56
1 files changed, 30 insertions, 26 deletions
diff --git a/libguile/read.c b/libguile/read.c
index 52c4dc265..d1013c586 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -26,9 +26,6 @@
#include <stdio.h>
#include <ctype.h>
#include <string.h>
-#ifdef HAVE_STRINGS_H
-# include <strings.h>
-#endif
#include "libguile/_scm.h"
#include "libguile/chars.h"
@@ -182,29 +179,8 @@ static SCM *scm_read_hash_procedures;
(((_chr) <= UCHAR_MAX) ? tolower (_chr) : (_chr))
-#ifndef HAVE_STRNCASECMP
-/* XXX: Use Gnulib's `strncasecmp ()'. */
-
-static int
-strncasecmp (const char *s1, const char *s2, size_t len2)
-{
- while (*s1 && *s2 && len2 > 0)
- {
- int c1 = *s1, c2 = *s2;
-
- if (CHAR_DOWNCASE (c1) != CHAR_DOWNCASE (c2))
- return 0;
- else
- {
- ++s1;
- ++s2;
- --len2;
- }
- }
- return !(*s1 || *s2 || len2 > 0);
-}
-#endif
-
+/* Read an SCSH block comment. */
+static inline SCM scm_read_scsh_block_comment (int chr, SCM port);
/* Helper function similar to `scm_read_token ()'. Read from PORT until a
whitespace is read. Return zero if the whole token could fit in BUF,
@@ -272,6 +248,21 @@ flush_ws (SCM port, const char *eoferr)
}
break;
+ case '#':
+ switch (c = scm_getc (port))
+ {
+ case EOF:
+ eoferr = "read_sharp";
+ goto goteof;
+ case '!':
+ scm_read_scsh_block_comment (c, port);
+ break;
+ default:
+ scm_ungetc (c, port);
+ return '#';
+ }
+ break;
+
case SCM_LINE_INCREMENTORS:
case SCM_SINGLE_SPACES:
case '\t':
@@ -637,6 +628,8 @@ static SCM
scm_read_quote (int chr, SCM port)
{
SCM p;
+ long line = SCM_LINUM (port);
+ int column = SCM_COL (port) - 1;
switch (chr)
{
@@ -670,6 +663,17 @@ scm_read_quote (int chr, SCM port)
}
p = scm_cons2 (p, scm_read_expression (port), SCM_EOL);
+ if (SCM_RECORD_POSITIONS_P)
+ scm_whash_insert (scm_source_whash, p,
+ scm_make_srcprops (line, column,
+ SCM_FILENAME (port),
+ SCM_COPY_SOURCE_P
+ ? (scm_cons2 (SCM_CAR (p),
+ SCM_CAR (SCM_CDR (p)),
+ SCM_EOL))
+ : SCM_UNDEFINED,
+ SCM_EOL));
+
return p;
}