Distinguish occurences of "Bad syntax" (#1036)

doc/reference/std/sugar.md

@@ -99,6 +99,27 @@ closed
 ```
 :::
 
+## ignore-errors
+```scheme
+(ignore-errors body ...)
+```
+
+Evaluates body with an exception catcher that returns `#f` if an exception happened.
+This is useful when attempting recovery side-effects on a “best effort” basis,
+when trying out some user-specified computation that ought to return
+something other than `#f` (or for which `#f` is otherwise a useful way to flag error), etc.
+
+::: tip Examples:
+```scheme
+> (ignore-errors 1 2 3)
+3
+> (ignore-errors 1 (error "foo") 3)
+#f
+> (ignore-errors 1 2 #f)
+#f
+```
+:::
+
 ## defmethod/alias
 ```scheme
 (defmethod/alias {method (alias ...) type}

src/gerbil/expander/common.ss

@@ -26,7 +26,7 @@ namespace: gx
          (generate1 hd #'pat #t #'body E))
         ((pat fender body)
          (generate1 hd #'pat #'fender #'body E))
-        (_ (raise-syntax-error #f "Bad syntax" stx hd))))
+        (_ (raise-syntax-error #f "Bad syntax; invalid syntax-case pattern" stx hd))))
 
     (def (generate1 where hd fender body E)
       (def (recur hd tgt K)
@@ -79,7 +79,7 @@ namespace: gx
                  [#'if #'(eql (stx-e target) 'datum)
                    K E]))
               (else
-               (raise-syntax-error #f "Bad syntax" stx where hd))))))
+               (raise-syntax-error #f "Bad syntax; invalid syntax-case head" stx where hd))))))
 
       (recur hd tgt [#'if fender body E]))
 
@@ -95,7 +95,7 @@ namespace: gx
                             #'(lambda () (begin . body))
                             (stx-source #'hd))]
                         r)
-                  (raise-syntax-error #f "Bad syntax" stx #'hd))
+                  (raise-syntax-error #f "Bad syntax; invalid else body" stx #'hd))
                 (raise-syntax-error #f "Bad syntax; misplaced else"
                                     stx #'hd)))
              (_ (with-syntax* (($E (genident 'E))
@@ -108,7 +108,7 @@ namespace: gx
                   (lp #'rest #'$E (cons [E #'try] r))))))
           (_ (with-syntax ((target tgt))
                (cons [E (stx-wrap-source
-                         #'(lambda () (raise-syntax-error #f "Bad syntax" target))
+                         #'(lambda () (raise-syntax-error #f "Bad syntax; invalid syntax-case clause" target))
                          (stx-source stx))]
                      r))))))
 

src/gerbil/expander/core.ss

@@ -251,7 +251,7 @@ namespace: gx
         (core-apply-expander (&syntax-binding-e bind) stx))
        ((not bind) stx)
        (else
-        (raise-syntax-error #f "Bad syntax" stx)))))
+        (raise-syntax-error #f "Bad syntax; no binding for head" stx)))))
 
   (core-syntax-case stx ()
     ((hd . _)
@@ -283,7 +283,7 @@ namespace: gx
   (def (expand-splice hd body rest r)
     (if (stx-list? body)
       (K (stx-foldr cons rest body) r)
-      (raise-syntax-error #f "Bad syntax" stx hd)))
+      (raise-syntax-error #f "Bad syntax; splice body isn't a list" stx hd)))
 
   (def (expand-cond-expand hd rest r)
     (K (cons (core-expand-cond-expand% hd) rest) r))
@@ -370,7 +370,7 @@ namespace: gx
          ((or)      (stx-ormap satisfied? body))
          ((defined) (stx-andmap core-resolve-identifier body))
          (else
-          (raise-syntax-error #f "Bad syntax" stx combinator))))))
+          (raise-syntax-error #f "Bad syntax; bad cond-expannd combinator" stx combinator))))))
 
   (def (loop rest)
     (core-syntax-case rest ()
@@ -380,7 +380,7 @@ namespace: gx
           (cond
            ((stx-eq? condition 'else)
             (if (stx-null? rest) body
-                (raise-syntax-error #f "Bad syntax" stx hd)))
+                (raise-syntax-error #f "Bad syntax; clauses after else" stx hd)))
            ((satisfied? condition)
             body)
            (else
@@ -419,11 +419,11 @@ namespace: gx
      (else (K stx))))
    ((bound-method-ref K method) => (cut core-apply-expander <> stx method))
    (else
-    (raise-syntax-error #f "Bad syntax" stx method))))
+    (raise-syntax-error #f "Bad syntax; no expander method" stx method))))
 
 (defmethod {apply-macro-expander expander}
   (lambda (self stx)
-    (raise-syntax-error #f "Bad syntax" stx)))
+    (raise-syntax-error #f "Bad syntax; bottom method for apply-macro-expander" stx)))
 
 (defmethod {apply-macro-expander macro-expander}
   (lambda (self stx)

src/gerbil/expander/stxcase.ss

@@ -206,7 +206,7 @@ namespace: gx
       (generate (parse form))
       (stx-source stx)))
     (else
-     (raise-syntax-error #f "Bad syntax" stx))))
+     (raise-syntax-error #f "Bad syntax; expand-syntax expects a single argument" stx))))
 
 ;;; syntax-case
 (def (macro-expand-syntax-case stx
@@ -488,7 +488,7 @@ namespace: gx
       ((not (identifier-list? ids))
        (raise-syntax-error #f "Bad template identifier list" stx ids))
       ((not (stx-list? clauses))
-       (raise-syntax-error #f "Bad syntax" stx))
+       (raise-syntax-error #f "Bad syntax; clauses expected" stx))
       (else
        (let* ((ids (syntax->list ids))
               (clauses (syntax->list clauses))
@@ -502,7 +502,7 @@ namespace: gx
              (core-list 'let-values
                [[[E] (core-list 'lambda%
                        [target] (core-list 'raise-syntax-error
-                                  #f "Bad syntax" target))]]
+                                  #f "Bad syntax; invalid match target" target))]]
                (generate-body
                 (generate-bindings target ids clauses clause-ids E)
                 [first expr]))

src/gerbil/expander/top.ss

@@ -155,7 +155,7 @@ namespace: gx
         (else
          (let* ((body
                  (match body
-                   ([] (raise-syntax-error #f "Bad syntax" stx))
+                   ([] (raise-syntax-error #f "Bad syntax; empty body" stx))
                    ([expr] expr)
                    (else
                     (core-quote-syntax
@@ -210,7 +210,7 @@ namespace: gx
            (core-cons '%#extern (reverse r))
            (stx-source stx)))
          (else
-          (raise-syntax-error #f "Bad syntax" stx)))))))
+          (raise-syntax-error #f "Bad syntax; %#extern expects list of (internal external) identifier lists" stx)))))))
 
 ;; (%#define-values hd expr)
 (def (core-expand-define-values% stx)
@@ -453,7 +453,7 @@ namespace: gx
                    ((or (stx-string? ns) (stx-false? ns))
                     (stx-e ns))
                    (else
-                    (raise-syntax-error #f "Bad syntax" stx ns))))
+                    (raise-syntax-error #f "Bad syntax; extern expects namespace identifier" stx ns))))
            (lp rest ns r)))
         ((hd . rest)
          (if (identifier? hd)

src/gerbil/prelude/core.ss

@@ -1568,7 +1568,7 @@ package: gerbil
                     (values (foldl cons tail hd)
                             (foldl cons (list tail) body)
                             #t))
-                  (raise-syntax-error #f "Bad syntax" stx #'e)))
+                  (raise-syntax-error #f "Bad syntax; cut ellipsis <...> not in tail position" stx #'e)))
                (_ (lp #'rest hd (cons #'e body)))))
             (_ (values (reverse hd) (reverse body) #f)))))
 
@@ -2077,7 +2077,7 @@ package: gerbil
            (generate-typedef stx #'id #'super fields body #t))
           (_ (if (identifier? hd)
                (generate-typedef stx hd #f fields body #t)
-               (raise-syntax-error #f "Bad syntax" stx hd)))))
+               (raise-syntax-error #f "Bad syntax; struct name not an identifier" stx hd)))))
 
       (syntax-case stx ()
         ((_ hd fields . rest)
@@ -2096,7 +2096,7 @@ package: gerbil
            (generate-typedef stx #'id (syntax->list #'super) slots body #f))
           (_ (if (identifier? hd)
                (generate-typedef stx hd [] slots body #f)
-               (raise-syntax-error #f "Bad syntax" stx hd)))))
+               (raise-syntax-error #f "Bad syntax; class name should be an identifier" stx hd)))))
 
       (syntax-case stx ()
         ((_ hd slots . rest)
@@ -2972,7 +2972,7 @@ package: gerbil
     ((recur id match-e)
      (recur id match-e
             (lambda ($stx)
-              (raise-syntax-error #f "Bad syntax" $stx)))))
+              (raise-syntax-error #f "Bad syntax; no macro definition for defsyntax-for-match" $stx)))))
 
   (defrules defrules-for-match ()
     ((_ id . body)
@@ -3064,11 +3064,11 @@ package: gerbil
       (lambda () postlude rest ...))))
 
   (defsyntax (@bytes stx)
-  (syntax-case stx ()
-    ((_ str)
-     (stx-string? #'str)
-     (with-syntax ((e (string->bytes (stx-e #'str))))
-       #'(quote e)))))
+    (syntax-case stx ()
+      ((_ str)
+       (stx-string? #'str)
+       (with-syntax ((e (string->bytes (stx-e #'str))))
+         #'(quote e)))))
 
   ;; ...
   )

src/gerbil/runtime/eval.ss

@@ -128,7 +128,7 @@ namespace: #f
        => (lambda (bind)
             ((__syntax-e bind) stx)))
       (else
-       (__raise-syntax-error #f "Bad syntax" stx form))))))
+       (__raise-syntax-error #f "Bad syntax; cannot resolve form" stx form))))))
 
 (def (__compile-error stx (detail #f))
   (__raise-syntax-error 'compile "Bad syntax; cannot compile" stx detail))

src/gerbil/runtime/syntax.ss

@@ -63,7 +63,7 @@ namespace: #f
                              (generate1 #'pat #'tgt #'(if fender expr E) #'E #'kws)))))
             #'(let ($E (lambda () continue))
                 body)))
-         ([] #'(__raise-syntax-error #f "Bad syntax" tgt)))))))
+         ([] #'(__raise-syntax-error #f "Bad syntax; malformed ast clause" tgt)))))))
 
 
 ;; we really don't want stack traces in syntax error, they are worse than useless.

src/std/net/httpd/server.ss

@@ -1,5 +1,5 @@
 ;;; -*- Gerbil -*-
-;;; ̧© vyzo
+;;; © vyzo
 ;;; embedded HTTP/1.1 server
 
 (import :std/sugar

src/std/stxparam.ss

@@ -45,12 +45,12 @@
                 => values)
                (else
                 (raise-syntax-error #f errmsg stx)))
-              (raise-syntax-error #f "Bad syntax" stx))))))
+              (raise-syntax-error #f "Bad syntax; defsyntax-parameter* expects a macro definition" stx))))))
 
   (syntax-case stx ()
     ((_ macro param)
      (identifier-list? #'(macro param))
-     (defparam #'macro #'param "Bad syntax"))
+     (defparam #'macro #'param "Bad syntax; syntax parameter* unbound"))
     ((_ macro param errmsg)
      (identifier-list? #'(macro param))
      (defparam #'macro #'param #'errmsg))))

src/std/sugar-test.ss

@@ -57,6 +57,11 @@
       (check-exception (in-ctx (lambda () (check depth => 1) (error "foo"))) true)
       (check depth => 0))
 
+    (test-case "ignore-errors"
+      (check (ignore-errors 1 2 3) => 3)
+      (check (ignore-errors 1 (error "foo") 3) => #f)
+      (check (ignore-errors 1 2 #f) => #f))
+
     (test-case "with-destroy"
       (check (let (a (A)) [(with-destroy a (A-a a)) (A-a a)]) => '(open closed))
       (def b (A))

src/std/sugar.ss

@@ -8,6 +8,7 @@
   catch
   finally
   try
+  ignore-errors
   with-destroy
   defmethod/alias
   using-method
@@ -107,6 +108,8 @@
          (() ; no clauses, just a begin
           (cons 'begin (reverse body))))))))
 
+(defrule (ignore-errors form ...) (with-catch false (lambda () form ...)))
+
 (defrule (with-destroy obj body ...)
   (let ($obj obj)
     (try body ... (finally {destroy $obj}))))

src/std/values.ss

@@ -15,24 +15,24 @@
 (def (first-value x . _) x)
 (defrules first-value% ()
   ((_ form) (with ((values x . _) form) x))
-  ((_ form forms ...) (syntax-error "Bad syntax"))
+  ((_ . _) (syntax-error "Bad syntax; first-value expects single argument"))
   (_ first-value))
 
 (def (second-value _ x . _) x)
 (defrules second-value% ()
   ((_ form) (with ((values _ x . _) form) x))
-  ((_ form forms ...) (syntax-error "Bad syntax"))
+  ((_ . _) (syntax-error "Bad syntax; second-value expects single argument"))
   (_ second-value))
 
 (defrules nth-value% ()
   ((_ n form) (with ((values . x) form) (list-ref x n)))
-  ((_ form forms ...) (syntax-error "Bad syntax"))
+  ((_ . _) (syntax-error "Bad syntax; nth-value expects two arguments"))
   (_ nth-value_))
 (def (nth-value n vals) (nth-value% n vals))
 
 (defrules values->vector% ()
   ((_ form) (list->vector (values->list form)))
-  ((_ . _) (syntax-error "Bad syntax"))
+  ((_ . _) (syntax-error "Bad syntax; values->vector expects one argument"))
   (_ values->vector))
 (def (values->vector vals) (values->vector% vals))
 
@@ -42,7 +42,7 @@
 
 (defrules values->cons% ()
   ((_ form) (with ((values a b) form) (cons a b)))
-  ((_ . _) (syntax-error "Bad syntax"))
+  ((_ . _) (syntax-error "Bad syntax; values->cons expects one argument"))
   (_ values->cons))
 (def (values->cons vals) (values->cons% vals))