* ports.c (scm_char_ready_p): bug fix: in SCM_PROC char-ready's

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

diff --git a/libguile/read.c b/libguile/read.c
index 5831a95..dc04c34 100644 (file)
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -65,7 +65,7 @@
 scm_option scm_read_opts[] = {
   { SCM_OPTION_BOOLEAN, "copy", 0,
     "Copy source code expressions." },
-  { SCM_OPTION_BOOLEAN, "positions", 1,
+  { SCM_OPTION_BOOLEAN, "positions", 0,
     "Record positions of source code expressions." }
 };
 
@@ -213,12 +213,15 @@ 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))
-             copy = (SCM_CDR (copy) = scm_cons (recsexpr (SCM_CAR (tmp),
-                                                          line,
-                                                          column,
-                                                          filename),
-                                                SCM_UNDEFINED));
-           SCM_CDR (copy) = tmp;
+             {
+               SCM_SETCDR (copy, scm_cons (recsexpr (SCM_CAR (tmp),
+                                                     line,
+                                                     column,
+                                                     filename),
+                                           SCM_UNDEFINED));
+               copy = SCM_CDR (copy);
+             }
+           SCM_SETCDR (copy, tmp);
          }
        else
          {
@@ -239,6 +242,31 @@ recsexpr (obj, line, column, filename)
   }
 }
 
+
+/* 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 
@@ -255,6 +283,7 @@ scm_lreadr (tok_buf, port, case_i, sharp, copy)
 
 tryagain:
   c = scm_flush_ws (port, s_read);
+tryagain_no_flush_ws:
   switch (c)
     {
     case EOF:
@@ -331,6 +360,14 @@ tryagain:
          c = '#';
          goto num;
 
+       case '!':
+         /* start of a shell script.  Parse as a block comment,
+            terminated by !#, just like SCSH.  */
+         skip_scsh_block_comment (port);
+         /* EOF is not an error here */
+         c = scm_flush_ws (port, (char *)NULL);
+         goto tryagain_no_flush_ws;
+
        case '*':
          j = scm_read_token (c, tok_buf, port, case_i, 0);
          p = scm_istr2bve (SCM_CHARS (*tok_buf) + 1, (long) (j - 1));
@@ -382,7 +419,9 @@ tryagain:
              else
                return got;
            }
-       unkshrp:scm_wta ((SCM) SCM_MAKICHR (c), "unknown # object", "");
+       unkshrp:
+         scm_misc_error (s_read, "Unknown # object: %S",
+                         scm_listify (SCM_MAKICHR (c), SCM_UNDEFINED));
        }
 
     case '"':
@@ -641,10 +680,11 @@ scm_lreadparen (tok_buf, port, name, case_i, sharp, copy)
       scm_gen_ungetc (c, port);
       if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
        {
-         SCM_CDR (tl) = scm_lreadr (tok_buf, port, case_i, sharp, copy);
+         SCM_SETCDR (tl, scm_lreadr (tok_buf, port, case_i, sharp, copy));
          goto closeit;
        }
-      tl = (SCM_CDR (tl) = scm_cons (tmp, SCM_EOL));
+      SCM_SETCDR (tl, scm_cons (tmp, SCM_EOL));
+      tl = SCM_CDR (tl);
     }
   return ans;
 }
@@ -661,8 +701,8 @@ scm_lreadrecparen (tok_buf, port, name, case_i, sharp, copy)
 {
   register int c;
   register SCM tmp;
-  register SCM tl, tl2;
-  SCM ans, ans2;
+  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;