From fafa83a8a087bea1e456bc907da987dfaa6dc62d Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Mon, 28 Mar 2016 15:20:17 -0400
Subject: [PATCH] syntax/parse: reorder and compress error messages
Collect common types of frame (eg message, literal, etc) and
report together. For literals, symbols, and other atoms, compress
multiple entries to list. For example:
before: "expected the identifier `X' or expected the identifier `Y'"
now: "expected one of these identifiers: `X' or `Y'"
---
.../syntax/parse/private/runtime-report.rkt | 42 +++++++++++++++----
1 file changed, 33 insertions(+), 9 deletions(-)
diff --git a/racket/collects/syntax/parse/private/runtime-report.rkt b/racket/collects/syntax/parse/private/runtime-report.rkt
index 07c4abff54..536dc86e4e 100644
--- a/racket/collects/syntax/parse/private/runtime-report.rkt
+++ b/racket/collects/syntax/parse/private/runtime-report.rkt
@@ -552,16 +552,40 @@ This suggests the following new algorithm based on (s):
context frame-stx within-stx)])]))
;; prose-for-expects : (listof Expect) -> string
-;; FIXME: partition by role first?
(define (prose-for-expects expects)
- (join-sep (append (for/list ([expect expects]
- #:when (not (expect:proper-pair? expect)))
- (prose-for-expect expect))
- (let ([proper-pair-expects (filter expect:proper-pair? expects)])
- (if (pair? proper-pair-expects)
- (list (prose-for-proper-pair-expects proper-pair-expects))
- null)))
- ";" "or"))
+ (define msgs (filter expect:message? expects))
+ (define things (filter expect:thing? expects))
+ (define literal (filter expect:literal? expects))
+ (define atom/symbol
+ (filter (lambda (e) (and (expect:atom? e) (symbol? (expect:atom-atom e)))) expects))
+ (define atom/nonsym
+ (filter (lambda (e) (and (expect:atom? e) (not (symbol? (expect:atom-atom e))))) expects))
+ (define proper-pairs (filter expect:proper-pair? expects))
+ (join-sep
+ (append (map prose-for-expect (append msgs things))
+ (prose-for-expects/literals literal "identifiers")
+ (prose-for-expects/literals atom/symbol "literal symbols")
+ (prose-for-expects/literals atom/nonsym "literals")
+ (prose-for-expects/pairs proper-pairs))
+ ";" "or"))
+
+(define (prose-for-expects/literals expects whats)
+ (cond [(null? expects) null]
+ [(singleton? expects) (map prose-for-expect expects)]
+ [else
+ (define (prose e)
+ (match e
+ [(expect:atom (? symbol? atom) _)
+ (format "`~s'" atom)]
+ [(expect:atom atom _)
+ (format "~s" atom)]
+ [(expect:literal literal _)
+ (format "`~s'" (syntax-e literal))]))
+ (list (string-append "expected one of these " whats ": "
+ (join-sep (map prose expects) "," "or")))]))
+
+(define (prose-for-expects/pairs expects)
+ (if (pair? expects) (list (prose-for-proper-pair-expects expects)) null))
;; prose-for-expect : Expect -> string
(define (prose-for-expect e)