[Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. e3c5df539640a36eb1493f581087d54a4714f337

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=e3c5df539640a36eb1493f581087d54a4714f337

The branch, syncase-in-boot-9 has been updated
       via  e3c5df539640a36eb1493f581087d54a4714f337 (commit)
       via  6ed0c41a2d621c485a0b0e1b39535fd5a1e9bd20 (commit)
       via  34f3d47df9311852ba7eab6f8d1c36535c3774dd (commit)
      from  560b9c256d9cd5f80dead6ddb0d747a21c6c003a (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit e3c5df539640a36eb1493f581087d54a4714f337
Author: Andy Wingo <address@hidden>
Date:   Thu May 28 15:01:30 2009 +0200

    add tests for #' etc
    
    * test-suite/tests/reader.test ("#'"): Add tests for the hash-syntax
      reader macros.

commit 6ed0c41a2d621c485a0b0e1b39535fd5a1e9bd20
Author: Andy Wingo <address@hidden>
Date:   Thu May 28 14:59:47 2009 +0200

    add reader tests for #;
    
    * test-suite/tests/reader.test ("#;"): Add reader tests for #;.

commit 34f3d47df9311852ba7eab6f8d1c36535c3774dd
Author: Andy Wingo <address@hidden>
Date:   Thu May 28 14:49:33 2009 +0200

    add reader support for #; #` #' #, and #,@. fix bug in compile-and-load.
    
    * libguile/read.c (flush_ws, scm_read_commented_expression)
      (scm_read_sharp): Add support for commenting out expressions with #;.
      (scm_read_syntax, scm_read_sharp): Add support for #', #`, #, and #,@.
    
    * module/ice-9/boot-9.scm: Remove #' read-hash extension, which actually
      didn't do anything at all. It's been there since 1997, but no Guile
      code I've ever seen uses it, and it conflicts with #'x => (syntax x)
      from modern Scheme.
    
    * module/system/base/compile.scm (compile-and-load): Whoops, fix a number
      of bugs here.

-----------------------------------------------------------------------

Summary of changes:
 libguile/read.c                |   83 ++++++++++++++++++++++++++++++++++++++++
 module/ice-9/boot-9.scm        |    3 -
 module/system/base/compile.scm |    6 +-
 test-suite/tests/reader.test   |   35 +++++++++++++++++
 4 files changed, 121 insertions(+), 6 deletions(-)

diff --git a/libguile/read.c b/libguile/read.c
index 47b8004..a4db2ab 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -182,6 +182,7 @@ static SCM *scm_read_hash_procedures;
 
 /* Read an SCSH block comment.  */
 static inline SCM scm_read_scsh_block_comment (int chr, SCM port);
+static SCM scm_read_commented_expression (int chr, SCM port);
 
 /* Read from PORT until a delimiter (e.g., a whitespace) is read.  Return
    zero if the whole token fits in BUF, non-zero otherwise.  */
@@ -257,6 +258,9 @@ flush_ws (SCM port, const char *eoferr)
          case '!':
            scm_read_scsh_block_comment (c, port);
            break;
+         case ';':
+           scm_read_commented_expression (c, port);
+           break;
          default:
            scm_ungetc (c, port);
            return '#';
@@ -691,6 +695,65 @@ scm_read_quote (int chr, SCM port)
   return p;
 }
 
+SCM_SYMBOL (sym_syntax, "syntax");
+SCM_SYMBOL (sym_quasisyntax, "quasisyntax");
+SCM_SYMBOL (sym_unsyntax, "unsyntax");
+SCM_SYMBOL (sym_unsyntax_splicing, "unsyntax-splicing");
+
+static SCM
+scm_read_syntax (int chr, SCM port)
+{
+  SCM p;
+  long line = SCM_LINUM (port);
+  int column = SCM_COL (port) - 1;
+
+  switch (chr)
+    {
+    case '`':
+      p = sym_quasisyntax;
+      break;
+
+    case '\'':
+      p = sym_syntax;
+      break;
+
+    case ',':
+      {
+       int c;
+
+       c = scm_getc (port);
+       if ('@' == c)
+         p = sym_unsyntax_splicing;
+       else
+         {
+           scm_ungetc (c, port);
+           p = sym_unsyntax;
+         }
+       break;
+      }
+
+    default:
+      fprintf (stderr, "%s: unhandled syntax character (%i)\n",
+              "scm_read_syntax", chr);
+      abort ();
+    }
+
+  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;
+}
+
 static inline SCM
 scm_read_semicolon_comment (int chr, SCM port)
 {
@@ -854,6 +917,20 @@ scm_read_scsh_block_comment (int chr, SCM port)
 }
 
 static SCM
+scm_read_commented_expression (int chr, SCM port)
+{
+  int c;
+  
+  c = flush_ws (port, (char *) NULL);
+  if (EOF == c)
+    scm_i_input_error ("read_commented_expression", port,
+                       "no expression after #; comment", SCM_EOL);
+  scm_ungetc (c, port);
+  scm_read_expression (port);
+  return SCM_UNSPECIFIED;
+}
+
+static SCM
 scm_read_extended_symbol (int chr, SCM port)
 {
   /* Guile's extended symbol read syntax looks like this:
@@ -1014,6 +1091,12 @@ scm_read_sharp (int chr, SCM port)
       return (scm_read_extended_symbol (chr, port));
     case '!':
       return (scm_read_scsh_block_comment (chr, port));
+    case ';':
+      return (scm_read_commented_expression (chr, port));
+    case '`':
+    case '\'':
+    case ',':
+      return (scm_read_syntax (chr, port));
     default:
       result = scm_read_sharp_extension (chr, port);
       if (scm_is_eq (result, SCM_UNSPECIFIED))
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 26ce1a9..4406631 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -961,9 +961,6 @@
 ;;; Reader code for various "#c" forms.
 ;;;
 
-(read-hash-extend #\' (lambda (c port)
-                       (read port)))
-
 (define read-eval? (make-fluid))
 (fluid-set! read-eval? #f)
 (read-hash-extend #\.
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 74fb598..f6522f7 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -107,9 +107,9 @@
          port)))
     comp))
 
-(define* (compile-and-load file #:key (to 'value) (opts '()))
-  (read-and-compile (open-input-port file)
-                    #:from lang #:to to #:opts opts))
+(define* (compile-and-load file #:key (from 'scheme) (to 'value) (opts '()))
+  (read-and-compile (open-input-file file)
+                    #:from from #:to to #:opts opts))
 
 (define (compiled-file-name file)
   (let ((base (basename file))
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index b068c71..5e95a7a 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -35,6 +35,8 @@
   (cons 'read-error "end of file in string constant$"))
 (define exception:illegal-escape
   (cons 'read-error "illegal character in escape sequence: .*$"))
+(define exception:missing-expression
+  (cons 'read-error "no expression after #;"))
 
 
 (define (read-string s)
@@ -189,3 +191,36 @@
       (and (equal? (source-property sexp 'line) 0)
            (equal? (source-property sexp 'column) 0)))))
 
+(with-test-prefix "#;"
+  (for-each
+   (lambda (pair)
+     (pass-if (car pair)
+       (equal? (with-input-from-string (car pair) read) (cdr pair))))
+
+   '(("#;foo 10". 10)
+     ("#;(10 20 30) foo" . foo)
+     ("#;   (10 20 30) foo" . foo)
+     ("#;\n10\n20" . 20)))
+  
+  (pass-if "#;foo"
+    (eof-object? (with-input-from-string "#;foo" read)))
+  
+  (pass-if-exception "#;"
+    exception:missing-expression
+    (with-input-from-string "#;" read))
+  (pass-if-exception "#;("
+    exception:eof
+    (with-input-from-string "#;(" read)))
+
+(with-test-prefix "#'"
+  (for-each
+   (lambda (pair)
+     (pass-if (car pair)
+       (equal? (with-input-from-string (car pair) read) (cdr pair))))
+
+   '(("#'foo". (syntax foo))
+     ("#`foo" . (quasisyntax foo))
+     ("#,foo" . (unsyntax foo))
+     ("#,@foo" . (unsyntax-splicing foo)))))
+
+


hooks/post-receive
-- 
GNU Guile