The guard-like macro in the core language is now called protect.

This is the recommended syntax for error-handling in Chibi-specific
programs, since it's not possible to get stack traces when using
R[67]RS guard.  guard is defined separately and according to the
standard in (scheme base).

lib/chibi/doc.scm

@@ -216,10 +216,10 @@
        (div (^ (class . "result"))
             ,(call-with-output-string
                (lambda (out)
-                 (guard (exn (#t (print-exception exn out)))
+                 (protect (exn (#t (print-exception exn out)))
-                        (let ((res (eval expr example-env)))
+                   (let ((res (eval expr example-env)))
-                          (display "=> " out)
+                     (display "=> " out)
-                          (write res out))))))))))
+                     (write res out))))))))))
 
 (define (expand-example-import x env)
   (eval `(import ,@(cdr x))

lib/chibi/highlight.scm

@@ -27,7 +27,7 @@
 
 (define (highlight-detect-language str)
   (cond
-   ((guard (exn (else #f))
+   ((protect (exn (else #f))
       (call-with-input-string str
         (lambda (in) (do ((x #f (read in))) ((eof-object? x)))))
       #t)
@@ -163,7 +163,7 @@
              require-extension use use-modules import import-immutable
              define-module select-module provide autoload export
              only except rename prefix include include-shared
-             condition-case guard cond-expand for with to by
+             condition-case guard protect cond-expand for with to by
              in-list in-lists in-string in-string-reverse
              in-vector in-vector-reverse in-file listing appending
              summing multpliying up-from down-from else

lib/chibi/net/server.scm

@@ -27,19 +27,19 @@
     (define (run sock addr count)
       (log-debug "net-server: accepting request:" count)
       (let ((ports
-             (guard (exn
+             (protect (exn
-                     (else
+                       (else
-                      (log-error "net-server: couldn't create port:" sock)
+                        (log-error "net-server: couldn't create port:" sock)
-                      (close-file-descriptor sock)))
+                        (close-file-descriptor sock)))
                (cons (open-input-file-descriptor sock)
                      (open-output-file-descriptor sock)))))
-        (guard (exn
+        (protect (exn
-                (else (log-error "net-server: error in request:" count)
+                  (else (log-error "net-server: error in request:" count)
-                      (print-exception exn)
+                        (print-exception exn)
-                      (print-stack-trace exn)
+                        (print-stack-trace exn)
-                      (close-input-port (car ports))
+                        (close-input-port (car ports))
-                      (close-output-port (cdr ports))
+                        (close-output-port (cdr ports))
-                      (close-file-descriptor sock)))
+                        (close-file-descriptor sock)))
           (handler (car ports) (cdr ports) sock addr)
           (close-input-port (car ports))
           (close-output-port (cdr ports))

lib/chibi/reload.scm

@@ -22,20 +22,20 @@
   (let ((old-module (find-module module-name)))
     ;; Remove old entry in modules list.
     (delete-module! module-name)
-    (guard (exn (else (warn "Error loading module definition" module-name)
+    (protect (exn (else (warn "Error loading module definition" module-name)
-                      (print-exception exn)
+                        (print-exception exn)
-                      (print-stack-trace)
+                        (print-stack-trace)
-                      (add-module! module-name old-module)))
+                        (add-module! module-name old-module)))
       (load-module-definition module-name)
       (let ((module (find-module module-name)))
         (cond
          ((not module) (warn "Couldn't find module" module-name))
          (else
-          (guard (exn (else (warn "Error loading module" module-name)
+          (protect (exn (else (warn "Error loading module" module-name)
-                            (print-exception exn)
+                              (print-exception exn)
-                            (print-stack-trace)
+                              (print-stack-trace)
-                            (delete-module! module-name)
+                              (delete-module! module-name)
-                            (add-module! module-name old-module)))
+                              (add-module! module-name old-module)))
             (let ((env (eval-module module-name module)))
               (%import (module-env module) env (env-exports env) #f)))))))))
 

lib/chibi/repl.scm

@@ -41,7 +41,7 @@
         (if (equal? res "") line res))
        (else
         (let ((res (string-append res line "\n")))
-          (if (guard (exn (else #f)) (complete-sexp? res))
+          (if (protect (exn (else #f)) (complete-sexp? res))
               res
               (lp res))))))))
 
@@ -140,7 +140,7 @@
 ;;> @itemlist[
 ;;> @item{@scheme{in:} - the input port (default @scheme{(current-input-port)})}
 ;;> @item{@scheme{out:} - the output port (default @scheme{(current-output-port)})}
-;;> @item{@scheme{module:} - the initial module
+;;> @item{@scheme{module:} - the initial module}
 ;;> @item{@scheme{environment:} - the initial environment (default @scheme{(interaction-environment)})}
 ;;> @item{@scheme{escape:} - the command escape character (default @scheme|{#\@}|)}
 ;;> @item{@scheme{make-prompt:} - a procedure taking one argument (the current module name as a list) and returning a string to be used as the prompt}
@@ -185,7 +185,7 @@
          (mod+imps (eval `(resolve-import ',mod-name) (repl-meta-env rp))))
     (cond
      ((pair? mod+imps)
-      (guard
+      (protect
           (exn
            (else
             (print-exception exn (current-error-port))
@@ -250,7 +250,7 @@
       (display "Try @help <identifier> [<module>]\n" out))
      ((null? (cddr args))
       (let* ((failed (list 'failed))
-             (val (guard (exn (else (print-exception exn) failed))
+             (val (protect (exn (else (print-exception exn) failed))
                     (eval (second args) (repl-env rp))))
              (mod (and (procedure? val) (containing-module val))))
         (cond
@@ -260,7 +260,7 @@
          ((not (eq? val failed))
           (describe val out)))))
      (else
-      (guard (exn (else (print-exception exn (current-error-port))))
+      (protect (exn (else (print-exception exn (current-error-port))))
         (print-module-binding-docs (third args) (second args) out))))
     (continue rp)))
 
@@ -281,13 +281,13 @@
 
 (define (repl/eval rp expr-list)
   (let ((out (repl-out rp)))
-    (guard (exn (else (print-exception exn out)))
+    (protect (exn (else (print-exception exn out)))
       (let ((thread
              (make-thread
               (lambda ()
-                ;; The inner guard in the child thread catches errors
+                ;; The inner protect in the child thread catches errors
                 ;; from eval.
-                (guard (exn (else (print-exception exn out)))
+                (protect (exn (else (print-exception exn out)))
                   (for-each
                    (lambda (expr)
                      (call-with-values (lambda () (eval expr (repl-env rp)))
@@ -316,7 +316,7 @@
 (define (repl/eval-string rp str)
   (repl/eval
    rp
-   (guard (exn (else (print-exception exn (current-error-port))))
+   (protect (exn (else (print-exception exn (current-error-port))))
      ;; Ugly wrapper to account for the implicit state mutation
      ;; implied by the #!fold-case read syntax.
      (let ((in (repl-in rp))
@@ -357,7 +357,7 @@
          (history
           (cond ((memq 'history: o) => cadr)
                 (else
-                 (or (guard (exn (else #f))
+                 (or (protect (exn (else #f))
                        (list->history
                         (call-with-input-file history-file read)))
                      (make-history)))))

lib/chibi/term/edit-line.scm

@@ -613,10 +613,10 @@
   (buffer-insert! buf out ch))
 
 (define (command/enter ch buf out return)
-  (guard (exn (else
+  (protect (exn (else
-               (buffer-clear buf out)
+                 (buffer-clear buf out)
-               (print-exception exn out)
+                 (print-exception exn out)
-               (buffer-draw buf out)))
+                 (buffer-draw buf out)))
     (cond
      (((buffer-complete? buf) buf)
       (command/end-of-line ch buf out return)
@@ -771,10 +771,10 @@
                       ((keymap? x)
                        (lp x))
                       ((procedure? x)
-                       (guard (exn (else
+                       (protect (exn (else
-                                    (buffer-clear buf out)
+                                      (buffer-clear buf out)
-                                    (print-exception exn out)
+                                      (print-exception exn out)
-                                    (buffer-draw buf out)))
+                                      (buffer-draw buf out)))
                          (x ch buf out return))
                        (flush-output out)
                        (buffer-refresh buf out)

lib/chibi/test.sld

@@ -9,15 +9,17 @@
    current-test-applier current-test-handler current-test-skipper
    current-test-group-reporter test-failure-count
    current-test-epsilon current-test-comparator)
-  (import (scheme base)
+  (import (scheme write)
-          (scheme write)
           (scheme complex)
           (scheme process-context)
           (scheme time))
   (cond-expand
    (chibi
-    (import (only (chibi) pair-source print-exception)))
+    (import (except (scheme base) guard)
+            (rename (only (chibi) pair-source print-exception protect)
+                    (protect guard))))
    (else
+    (import (scheme base))
     (begin
       (define (pair-source x) #f)
       (define print-exception write))))

lib/init-7.scm

@@ -944,47 +944,39 @@
                          (error "exception handler returned"))))))))
     (%with-exception-handler self thunk)))
 
-(define-syntax guard
+(define-syntax protect
   (syntax-rules ()
-    ((guard (var clause ...) e1 e2 ...)
+    ((protect (var clause ...) e1 e2 ...)
      (let ((orig-handler (current-exception-handler)))
-       ((call-with-current-continuation
+       (call-with-current-continuation
-         (lambda (guard-k)
+        (lambda (protect-k)
-           (with-exception-handler
+          (with-exception-handler
-            (lambda (condition)
+           (lambda (condition)
-              ((call-with-current-continuation
+             (let ((var condition))  ; clauses may set! var
-                (lambda (handler-k)
+               (protect-k
-                  (let* ((var condition)            ; clauses may set! var
+                (protect-aux (raise-continuable condition) clause ...))))
-                         (res
+           (lambda () e1 e2 ...))))))))
-                          (guard-aux
-                           (handler-k (lambda ()
-                                        (raise-continuable condition)))
-                           clause ...)))
-                    (guard-k (lambda () res)))))))
-            (lambda ()
-              (let ((res (begin e1 e2 ...)))
-                (guard-k (lambda () res))))))))))))
 
-(define-syntax guard-aux
+(define-syntax protect-aux
   (syntax-rules (else =>)
-    ((guard-aux reraise (else result1 result2 ...))
+    ((protect-aux reraise (else result1 result2 ...))
      (begin result1 result2 ...))
-    ((guard-aux reraise (test => result))
+    ((protect-aux reraise (test => result))
      (let ((temp test))
        (if temp (result temp) reraise)))
-    ((guard-aux reraise (test => result) clause1 clause2 ...)
+    ((protect-aux reraise (test => result) clause1 clause2 ...)
      (let ((temp test))
-       (if temp (result temp) (guard-aux reraise clause1 clause2 ...))))
+       (if temp (result temp) (protect-aux reraise clause1 clause2 ...))))
-    ((guard-aux reraise (test))
+    ((protect-aux reraise (test))
      (or test reraise))
-    ((guard-aux reraise (test) clause1 clause2 ...)
+    ((protect-aux reraise (test) clause1 clause2 ...)
-     (or test (guard-aux reraise clause1 clause2 ...)))
+     (or test (protect-aux reraise clause1 clause2 ...)))
-    ((guard-aux reraise (test result1 result2 ...))
+    ((protect-aux reraise (test result1 result2 ...))
      (if test (begin result1 result2 ...) reraise))
-    ((guard-aux reraise (test result1 result2 ...) clause1 clause2 ...)
+    ((protect-aux reraise (test result1 result2 ...) clause1 clause2 ...)
      (if test
          (begin result1 result2 ...)
-         (guard-aux reraise clause1 clause2 ...)))))
+         (protect-aux reraise clause1 clause2 ...)))))
 
 (define (eval x . o)
   (let ((thunk (compile x (if (pair? o) (car o) (interaction-environment)))))

lib/meta.scm

@@ -167,7 +167,7 @@
                (%import env (module-env mod2) (cdr mod2-name+imports) #t)))
            (cdr x)))))
      meta)
-    (guard
+    (protect
         (exn (else
               (module-meta-data-set! mod meta)
               (if (not (any (lambda (x)

lib/scheme/misc-macros.scm

@@ -8,3 +8,43 @@
   (syntax-rules ()
     ((unless test . body)
      (when (not test) . body))))
+
+(define-syntax guard
+  (syntax-rules ()
+    ((guard (var clause ...) e1 e2 ...)
+     ((call-with-current-continuation
+       (lambda (guard-k)
+         (with-exception-handler
+          (lambda (condition)
+            ((call-with-current-continuation
+              (lambda (handler-k)
+                (guard-k
+                 (lambda ()
+                   (let ((var condition))      ; clauses may SET! var
+                     (guard-aux (handler-k (lambda ()
+                                             (raise-continuable condition)))
+                                clause ...))))))))
+          (lambda ()
+            (let ((res (begin e1 e2 ...)))
+              (guard-k (lambda () res)))))))))))
+
+(define-syntax guard-aux
+  (syntax-rules (else =>)
+    ((guard-aux reraise (else result1 result2 ...))
+     (begin result1 result2 ...))
+    ((guard-aux reraise (test => result))
+     (let ((temp test))
+       (if temp (result temp) reraise)))
+    ((guard-aux reraise (test => result) clause1 clause2 ...)
+     (let ((temp test))
+       (if temp (result temp) (guard-aux reraise clause1 clause2 ...))))
+    ((guard-aux reraise (test))
+     (or test reraise))
+    ((guard-aux reraise (test) clause1 clause2 ...)
+     (or test (guard-aux reraise clause1 clause2 ...)))
+    ((guard-aux reraise (test result1 result2 ...))
+     (if test (begin result1 result2 ...) reraise))
+    ((guard-aux reraise (test result1 result2 ...) clause1 clause2 ...)
+     (if test
+         (begin result1 result2 ...)
+         (guard-aux reraise clause1 clause2 ...)))))