srfi/34: work with else frmo racket or mzscheme

pkgs/srfi-pkgs/srfi-doc/srfi/scribblings/srfi.scrbl

@@ -707,6 +707,10 @@ This SRFI's syntax is part of Racket's default reader.
  (raise #f "raise")
 )]
 
+An @racket[else] is recognized as either the one from
+@racketmodname[racket/base] or as an identifier with the symbolic form
+@racket['else] and no binding.
+
 @; ----------------------------------------
 
 @srfi[35]{Conditions}

pkgs/srfi-pkgs/srfi-lib/srfi/34/exception.rkt

@@ -1,7 +1,10 @@
+#lang racket/base
+(require (for-syntax racket/base
+                     syntax/stx))
+
 ;; SRFI 34 for PLT Scheme
 ;; Zhu Chongkai, April 2005
 ;; <mrmathematica@yahoo.com>
-(module exception mzscheme
 
 (provide with-exception-handler
          guard
@@ -12,14 +15,18 @@
     ((_ handler thunk)
      (with-handlers (((lambda (exn) #t) handler)) (thunk)))))
 
-  (define-syntax guard
+(define-syntax (guard stx)
-    (syntax-rules (else)
+  (syntax-case stx ()
-      ((_ (var clause ... (else de ...)) e1 e2 ...)
+    ((_ (var clause ... (els de ...)) e1 e2 ...)
+     (and (identifier? #'els)
+          (module-or-top-identifier=? #'els #'else))
+     (syntax/loc stx
        (with-handlers (((lambda (exn) #t)
                         (lambda (var) (cond clause ...
                                             (else de ...)))))
-         e1 e2 ...))
+         e1 e2 ...)))
     ((_ (var clause ...) e1 e2 ...)
+     (syntax/loc stx
        (with-handlers (((lambda (exn) #t)
                         (lambda (var) (cond clause ...
                                             (else (raise var))))))

pkgs/srfi-pkgs/srfi-test/tests/srfi/34/else.rkt

@@ -0,0 +1,18 @@
+#lang racket/base
+(require srfi/34)
+
+(guard (condition
+         (else
+          (display "condition: ")
+          (write condition)
+          (newline)
+          'exception))
+  (+ 1 (raise 'an-error)))
+
+(guard (condition
+         (#t ; <- not an identifier
+          (display "condition: ")
+          (write condition)
+          (newline)
+          'exception))
+  (+ 1 (raise 'an-error)))

pkgs/srfi-pkgs/srfi-test/tests/srfi/34/mz-else.rkt

@@ -0,0 +1,10 @@
+#lang mzscheme
+(require srfi/34)
+
+(guard (condition
+         (else
+          (display "condition: ")
+          (write condition)
+          (newline)
+          'exception))
+  (+ 1 (raise 'an-error)))