[Guile-commits] 02/02: Define top-level bindings for aux syntax: else, =>, _, ...

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 374c1e5807a35b16170ed7686abcd5c407554d78
Author: Andy Wingo <address@hidden>
Date:   Thu Sep 12 21:50:51 2019 +0200

    Define top-level bindings for aux syntax: else, =>, _, ...
    
    * module/ice-9/boot-9.scm (else, =>, ..., _): New definitions.  These
      are specified by the r6rs and the r7rs.
    * module/ice-9/sandbox.scm (core-bindings): Include the aux syntax
      definitions.
    * module/rnrs/base.scm:
    * module/rnrs.scm: Re-export aux syntax.
---
 module/ice-9/boot-9.scm  | 16 ++++++++++++++++
 module/ice-9/sandbox.scm |  1 +
 module/rnrs.scm          |  4 ++--
 module/rnrs/base.scm     |  4 ++--
 4 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 062ab68..f50448c 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -416,6 +416,22 @@ If returning early, return the return value of F."
 (define-syntax-rule (unless test stmt stmt* ...)
   (if (not test) (begin stmt stmt* ...)))
 
+(define-syntax else
+  (lambda (x)
+    (syntax-violation 'else "bad use of 'else' syntactic keyword" x x)))
+
+(define-syntax =>
+  (lambda (x)
+    (syntax-violation '=> "bad use of '=>' syntactic keyword" x x)))
+
+(define-syntax ...
+  (lambda (x)
+    (syntax-violation '... "bad use of '...' syntactic keyword" x x)))
+
+(define-syntax _
+  (lambda (x)
+    (syntax-violation '_ "bad use of '_' syntactic keyword" x x)))
+
 (define-syntax cond
   (lambda (whole-expr)
     (define (fold f seed xs)
diff --git a/module/ice-9/sandbox.scm b/module/ice-9/sandbox.scm
index bbb8119..3f9359d 100644
--- a/module/ice-9/sandbox.scm
+++ b/module/ice-9/sandbox.scm
@@ -314,6 +314,7 @@ allocation limit is exceeded, an exception will be thrown 
to the
 ;;
 (define core-bindings
   '(((guile)
+     else => _ ...
      and
      begin
      apply
diff --git a/module/rnrs.scm b/module/rnrs.scm
index d2b4cb3..f4ab970 100644
--- a/module/rnrs.scm
+++ b/module/rnrs.scm
@@ -1,6 +1,6 @@
 ;;; rnrs.scm --- The R6RS composite library
 
-;;      Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;      Copyright (C) 2010, 2011, 2019 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -73,7 +73,7 @@
          vector-map vector-for-each error assertion-violation assert
          call-with-current-continuation call/cc call-with-values dynamic-wind
          values apply quasiquote unquote unquote-splicing let-syntax 
-         letrec-syntax syntax-rules identifier-syntax
+         letrec-syntax syntax-rules identifier-syntax else => _ ...
 
          ;; (rnrs bytevectors)
          
diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm
index 9fedac0..9205016 100644
--- a/module/rnrs/base.scm
+++ b/module/rnrs/base.scm
@@ -1,6 +1,6 @@
 ;;; base.scm --- The R6RS base library
 
-;;      Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;      Copyright (C) 2010, 2011, 2019 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -23,7 +23,7 @@
          define define-syntax syntax-rules lambda let let* let-values 
          let*-values letrec letrec* begin 
 
-         quote lambda if set! cond case 
+         quote lambda if set! cond case else => _ ...
         
          or and not