better "expected more terms" messages in some cases

Still need docs, make constant stxclass descriptions available

racket/collects/syntax/parse/private/parse.rkt

@@ -461,11 +461,21 @@ Conventions:
                    [tx (cdr datum)]
                    [tpr (ps-add-cdr pr)])
                (parse:matrix ((hx hcx hpr es) (tx tcx tpr es) . ins) inner))
-             (let ([es* (if (and 'proper? (null? datum)) (es-add-proper-pair es) es)])
+             (let ([es* (if (and 'proper? (null? datum))
+                            (es-add-proper-pair (first-desc:matrix inner) es)
+                            es)])
                (fail (failure pr es*)))))]
     [(parse:pk (in1 . ins) #s(pk/and inner))
      #'(parse:matrix (in1 in1 . ins) inner)]))
 
+(define-syntax (first-desc:matrix stx)
+  (syntax-case stx ()
+    [(fdm (#s(pk (pat1 . pats) k)))
+     #'(first-desc:S pat1)]
+    [(fdm (pk ...))
+     ;; FIXME
+     #'#f]))
+
 ;; ----
 
 ;; (parse:S x cx S-pattern pr es k) : expr[Ans]
@@ -582,7 +592,7 @@ Conventions:
                       [tpr (ps-add-cdr pr)])
                   (parse:S hx hcx head hpr es
                            (parse:S tx cx tail tpr es k)))
-                (let ([es* (if (and 'proper? (null? datum)) (es-add-proper-pair es) es)])
+                (let ([es* (if (and 'proper? (null? datum)) (es-add-proper-pair (first-desc:S head) es) es)])
                   (fail (failure pr es*)))))]
        [#s(pat:vector _attrs subpattern)
         #`(let ([datum (if (syntax? x) (syntax-e x) x)])
@@ -639,6 +649,33 @@ Conventions:
                   (let ([es* (es-add-thing pr 'description #t role es)])
                     (fail (failure pr es*))))))])]))
 
+;; (first-desc:S S-pattern) : expr[FirstDesc]
+(define-syntax (first-desc:S stx)
+  (syntax-case stx ()
+    [(fds p)
+     (syntax-case #'p ()
+       [#s(pat:any _as)
+        #''(any)]
+       [#s(pat:var _as name #f _ () _ _ _)
+        #''(any)]
+       [#s(pat:var _ ...)
+        #'#f] ;; FIXME: need access to (constant) description as field
+       [#s(pat:datum _as d)
+        #''(datum d)]
+       [#s(pat:literal _as id _ip _lp)
+        #''(literal id)]
+       [#s(pat:describe _as _p description _t? _role)
+        #'description] ;; FIXME??? only constants?
+       [#s(pat:delimit _a pattern)
+        #'(first-desc:S pattern)]
+       [#s(pat:commit _a pattern)
+        #'(first-desc:S pattern)]
+       [#s(pat:post _a pattern)
+        #'(first-desc:S pattern)]
+       [#s(pat:integrated _as _name _pred description _role)
+        #''description]
+       [_ #'#f])]))
+
 ;; (disjunct ???-pattern success (pre:expr ...) (id:id ...)) : expr[Ans]
 (define-syntax (disjunct stx)
   (syntax-case stx ()

racket/collects/syntax/parse/private/runtime-progress.rkt

@@ -145,7 +145,7 @@ An ExpectStack (during parsing) is one of
   * (make-expect:message string ExpectStack)
   * (make-expect:atom atom ExpectStack)
   * (make-expect:literal identifier ExpectStack)
-  * (make-expect:proper-pair ExpectStack)
+  * (make-expect:proper-pair FirstDesc ExpectStack)
 
 The *-marked variants can only occur at the top of the stack.
 
@@ -159,7 +159,7 @@ An Expect is one of
   * (expect:message string _)
   * (expect:atom atom _)
   * (expect:literal identifier _)
-  * (expect:proper-pair _)
+  * (expect:proper-pair string/#f _)
   - (expect:disj (non-empty-listof Expect) _)
 
 That is, next link always ignored (replace with #f for sake of equal? cmp)
@@ -172,7 +172,7 @@ Goal during reporting is ease of manipulation.
 (struct expect:atom (atom next) #:prefab)
 (struct expect:literal (literal next) #:prefab)
 (struct expect:disj (expects next) #:prefab)
-(struct expect:proper-pair (next) #:prefab)
+(struct expect:proper-pair (first-desc next) #:prefab)
 
 (define (expect? x)
   (or (expect:thing? x)
@@ -198,5 +198,14 @@ Goal during reporting is ease of manipulation.
 (define (es-add-literal literal next)
   (expect:literal literal next))
 
-(define (es-add-proper-pair next)
-  (expect:proper-pair next))
+(define (es-add-proper-pair first-desc next)
+  (expect:proper-pair first-desc next))
+
+#|
+A FirstDesc is one of
+ - #f                   -- unknown, multiple possible, etc
+ - string               -- description
+ - (list 'any)
+ - (list 'literal symbol)
+ - (list 'datum datum)
+|#

racket/collects/syntax/parse/private/runtime-report.rkt

@@ -122,8 +122,15 @@ complicated.
      (format "expected the identifier `~s'" (syntax-e literal))]
     [(expect:message message _)
      (format "~a" message)]
-    [(expect:proper-pair _)
-     "expected more terms"]))
+    [(expect:proper-pair '#f _)
+     "expected more terms"]
+    [(expect:proper-pair first-desc _)
+     (format "expected more terms starting with ~a"
+             (match first-desc
+               [(? string?) first-desc]
+               [(list 'any) "any term"]
+               [(list 'literal id) (format "the literal symbol `~s'" id)]
+               [(list 'datum d) (format "the literal ~s" d)]))]))
 
 (define (context-prose-for-expect e)
   (match e
@@ -208,8 +215,8 @@ complicated.
          (cons (expect:atom atom #f) (loop rest-es))]
         [(expect:literal literal rest-es)
          (cons (expect:literal literal #f) (loop rest-es))]
-        [(expect:proper-pair rest-es)
-         (cons (expect:proper-pair #f) (loop rest-es))]))))
+        [(expect:proper-pair first-desc rest-es)
+         (cons (expect:proper-pair first-desc #f) (loop rest-es))]))))
 
 #|
 Simplification dilemma