separate wrong-syntax/orig and wrong-syntax/syntax-spec

private/syntax/compile/binding-spec.rkt

@@ -224,7 +224,7 @@
     [(_ v:nonref-id (~and (~literal ...) ooo) ...+ rest ...+)
      (define depth (length (attribute ooo)))
      (when (> depth 1)
-       (wrong-syntax/orig this-syntax "nest cannot contain more than one ellipsis"))
+       (wrong-syntax/syntax-spec this-syntax "nest cannot contain more than one ellipsis"))
      (nest
       this-syntax
       depth
@@ -271,15 +271,15 @@
   (define binding (lookup v pvar-rep?))
   (when (not binding)
     (if (identifier? (current-syntax-context))
-        (wrong-syntax/orig v "binding spec expected a reference to a pattern variable")
+        (wrong-syntax/syntax-spec v "binding spec expected a reference to a pattern variable")
         (wrong-syntax v "expected a reference to a pattern variable")))
   (pvar-rep-var-info binding))
 
 (define (lookup-pvar-depth v)
   (define binding (lookup v pvar-rep?))
   (when (not binding)
     (if (identifier? (current-syntax-context))
-        (wrong-syntax/orig v "binding spec expected a reference to a pattern variable")
+        (wrong-syntax/syntax-spec v "binding spec expected a reference to a pattern variable")
         (wrong-syntax v "expected a reference to a pattern variable")))
   (pvar-rep-depth binding))
 
@@ -288,7 +288,7 @@
   (define maybe-dup (check-duplicates pvars free-identifier=?))
 
   (when maybe-dup
-    (wrong-syntax/orig maybe-dup "each pattern variable must occur in the binding spec at most once")))
+    (wrong-syntax/syntax-spec maybe-dup "each pattern variable must occur in the binding spec at most once")))
 
 (define (check-ellipsis-depth! bspec)
   (let loop ([bspec bspec] [depth 0])
@@ -328,9 +328,9 @@
   (define ss-depth (lookup-pvar-depth v))
   (cond
     [(< ss-depth bs-depth)
-     (wrong-syntax/orig v "too many ellipses for pattern variable in binding spec")]
+     (wrong-syntax/syntax-spec v "too many ellipses for pattern variable in binding spec")]
     [(< bs-depth ss-depth)
-     (wrong-syntax/orig v "missing ellipses with pattern variable in binding spec")]))
+     (wrong-syntax/syntax-spec v "missing ellipses with pattern variable in binding spec")]))
 
 ; makes sure you don't mix categories like refs+subexps and binds in the same ellipsis
 (define (check-ellipsis-homogeneity! bspec)
@@ -344,7 +344,7 @@
         (define export (find-export spec))
         (define representatives (filter values (list ref+subexp bind import export)))
         (when (< 1 (length representatives))
-            (wrong-syntax/orig stx "cannot mix imports or exports with other kinds of binding specs inside of ellipses"))
+            (wrong-syntax/syntax-spec stx "cannot mix imports or exports with other kinds of binding specs inside of ellipses"))
         bspec]
        [_ bspec]))
    bspec))
@@ -519,13 +519,13 @@
       (f (car specs) (cdr specs))))
 
 (define (binding-scope-error stx)
-  (wrong-syntax/orig stx "binding must occur within a scope"))
+  (wrong-syntax/syntax-spec stx "binding must occur within a scope"))
 
 (define (export-context-error stx)
-  (wrong-syntax/orig stx "exports may only occur at the top-level of an exporting binding spec"))
+  (wrong-syntax/syntax-spec stx "exports may only occur at the top-level of an exporting binding spec"))
 
 (define (re-export-context-error stx)
-  (wrong-syntax/orig stx "re-exports may only occur at the top-level of an exporting binding spec"))
+  (wrong-syntax/syntax-spec stx "re-exports may only occur at the top-level of an exporting binding spec"))
 
 ; spec -> (void) or raised syntax error
 ; enforces the above grammar for an unscoped expression
@@ -541,7 +541,7 @@
       [(or (and (s* import) (with-stx stx))
            (imports _ (cons (with-stx stx) _)))
        ; TODO use imports stx once it's sorce location is more refined.
-       (wrong-syntax/orig stx "import binding groups must occur within a scope")]
+       (wrong-syntax/syntax-spec stx "import binding groups must occur within a scope")]
       [(imports _ (list))
        ; impossible
        (void)]
@@ -585,14 +585,14 @@
        (refs+subexps group-spec (append group-specs specs))]
       [(group _ (list)) (check-sequence refs+subexps specs)]
       [(and (or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (with-stx stx))
-       (wrong-syntax/orig stx "bindings must appear first within a scope")]
+       (wrong-syntax/syntax-spec stx "bindings must appear first within a scope")]
       [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx))
        (export-context-error stx)]
       [(and (s* re-export) (with-stx stx))
        (re-export-context-error stx)]
       [(or (and (s* import) (with-stx stx))
            (imports _ (cons (with-stx stx) _)))
-       (wrong-syntax/orig stx "an import binding group must appear before references and subexpressions")]
+       (wrong-syntax/syntax-spec stx "an import binding group must appear before references and subexpressions")]
       [(imports _ (list))
        ; impossible
        (void)]
@@ -642,12 +642,12 @@
       [(and (or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (with-stx stx))
        (binding-scope-error stx)]
       [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx))
-       (wrong-syntax/orig stx "exports must appear first in a exporting spec")]
+       (wrong-syntax/syntax-spec stx "exports must appear first in a exporting spec")]
       [(and (s* re-export) (with-stx stx))
-       (wrong-syntax/orig stx "re-exports must occur before references and subexpressions")]
+       (wrong-syntax/syntax-spec stx "re-exports must occur before references and subexpressions")]
       [(or (and (s* import) (with-stx stx))
            (imports _ (cons (and (s* import) (with-stx stx)) _)))
-       (wrong-syntax/orig stx "import must occur within a scope")]
+       (wrong-syntax/syntax-spec stx "import must occur within a scope")]
       [(imports _ (list))
        ; impossible
        (void)]
@@ -677,9 +677,9 @@
        [(nested-binding)
         #`(nested)]
        [(nonterm-rep (nesting-nonterm-info _))
-        (wrong-syntax/orig v "nesting nonterminals must be used with `nest`")]
+        (wrong-syntax/syntax-spec v "nesting nonterminals must be used with `nest`")]
        [(nonterm-rep (exporting-nonterm-info _ _))
-        (wrong-syntax/orig v "exporting nonterminals must be used with `import` or `re-export`")]
+        (wrong-syntax/syntax-spec v "exporting nonterminals must be used with `import` or `re-export`")]
        [(or (? stxclass-rep?) (? special-syntax-class-binding?))
         #`(group (list))])]
     [(suspend _ (pvar v info))

private/syntax/compile/nonterminal-expander.rkt

@@ -117,7 +117,7 @@
         (syntax-parse (car prods)
           [(~or (p:form-production) (p:form-rewrite-production))
            (when (free-id-table-ref seen-forms #'p.form-name #f)
-             (wrong-syntax/orig #'p.form-name "all variants of the same-named form must occur together"))
+             (wrong-syntax/syntax-spec #'p.form-name "all variants of the same-named form must occur together"))
            (define-values (group remaining-prods) (gather-group prods))
            (loop remaining-prods (free-id-table-set seen-forms #'p.form-name #t) (cons group res))]
           [_ (loop (cdr prods) seen-forms (cons (car prods) res))]))))
@@ -214,7 +214,7 @@
 (define (generate-macro-clause extclass recur-id)
   (let ([ext-info (lookup extclass extclass-rep?)])
     (when (not ext-info)
-      (wrong-syntax/orig extclass "expected extension class name"))
+      (wrong-syntax/syntax-spec extclass "expected extension class name"))
 
     (with-syntax ([m-pred (extclass-rep-pred ext-info)]
                   [m-acc (extclass-rep-acc ext-info)]

private/syntax/compile/syntax-spec.rkt

@@ -72,7 +72,7 @@
        #:do [(define binding (lookup #'r.ref stxclass-rep?))]
        #:when binding
        #'(~var r.var r.ref)]
-      [_ (wrong-syntax/orig this-syntax "expected a syntax spec term")]))
+      [_ (wrong-syntax/syntax-spec this-syntax "expected a syntax spec term")]))
 
   (generate-pattern-form stx))
 
@@ -143,7 +143,7 @@
       [r:ref-id
        #:with c:special-syntax-class #'r.ref
        (when (member #'r.var res bound-identifier=?)
-         (wrong-syntax/orig #'r.var "duplicate pattern variable"))
+         (wrong-syntax/syntax-spec #'r.var "duplicate pattern variable"))
        (bind! #'r.var (pvar-rep (special-syntax-class-binding) depth))
        (set! res (cons #'r.var res))]
       [r:ref-id
@@ -154,9 +154,9 @@
                                      (nonterm-rep? v)
                                      (stxclass-rep? v)))))
        (when (not binding)
-         (wrong-syntax/orig #'r.ref "expected a reference to a binding class, extension class, syntax class, or nonterminal"))
+         (wrong-syntax/syntax-spec #'r.ref "expected a reference to a binding class, extension class, syntax class, or nonterminal"))
        (when (member #'r.var res bound-identifier=?)
-         (wrong-syntax/orig #'r.var "duplicate pattern variable"))
+         (wrong-syntax/syntax-spec #'r.var "duplicate pattern variable"))
        (bind! #'r.var (pvar-rep binding depth))
        (set! res (cons #'r.var res))]
       [_ (void)]))

private/syntax/interface.rkt

@@ -248,8 +248,7 @@
   (define-syntax generate-nonterminal-expander
     (syntax-parser
       [(_ orig-stx . decls)
-       (parameterize ([current-orig-stx (datum->syntax #'orig-stx 'syntax-spec)])
-         (compile-nonterminal-expander #'decls))]))  
+       (compile-nonterminal-expander #'decls)]))  
   )
 
 ;;

private/syntax/syntax-classes.rkt

@@ -3,6 +3,7 @@
 (provide
  current-orig-stx
  wrong-syntax/orig
+ wrong-syntax/syntax-spec
 
  maybe-description
  maybe-binding-space
@@ -71,6 +72,18 @@
 
 (define current-orig-stx (make-parameter #f))
 
+;; Used for meta-level errors where there is no good more-specific form
+;; to blame; that is, incorrect syntax-spec syntax, but on something like
+;; spec-var:[nt] where the error is not related to the immediately surrounding
+;; syntax. For errors where there is more appropriate immediately surrounding
+;; syntax, we use plain `wrong-syntax`.
+(define (wrong-syntax/syntax-spec
+         stx #:extra [extras null] format-string . args)
+  (parameterize ([current-syntax-context (datum->syntax #f 'syntax-spec)])
+    (apply wrong-syntax stx #:extra extras format-string args)))
+
+;; Used by DSL expanders to raise object-level errors; that is, a my-expression
+;; was expected by my-interface-macro.
 (define (wrong-syntax/orig stx #:extra [extras null] format-string . args)
   (parameterize ([current-syntax-context (current-orig-stx)])
     (apply wrong-syntax stx #:extra extras format-string args)))

tests/errors.rkt

@@ -73,6 +73,16 @@
    (nonterminal/nesting binding-group (nested)
      [])))
 
+(check-decl-error
+ #rx"syntax-spec: nesting nonterminals must be used with `nest`"
+ (syntax-spec
+   (nonterminal/nesting binding (nested)
+     ())
+   (host-interface/expression
+     (my-dsl b:binding)
+     #:binding b
+     #''todo)))
+
 (check-decl-error
  #rx"nest: expected pattern variable associated with a nesting nonterminal"
  (syntax-spec
@@ -394,7 +404,7 @@
  (expand-nonterminal/datum expr1 [x]))
 
 (check-decl-error
- #rx"host-interface/expression: missing compilation in host interface"
+ #rx"host-interface/expression: expected more terms starting with pattern directive or body"
  (syntax-spec
    (nonterminal/nesting binding (nested)
      ())
@@ -403,7 +413,7 @@
      #:binding (nest b []))))
 
 (check-decl-error
- #rx"host-interface/definitions: missing compilation in host interface"
+ #rx"host-interface/definitions: expected more terms starting with pattern directive or body"
  (syntax-spec
    (nonterminal/nesting binding (nested)
      ())