suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

svn: r6875

Browse Source
This commit is contained in:
Kathy Gray 2007-07-09 11:01:32 +00:00
parent dd771d5883
commit 006ab0f79d
1 changed files with 28 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/combinator-parser/private-combinator/errors.scm
View File

@ -102,20 +102,30 @@
[top-names (map fail-type-name winners)] [top-names (map fail-type-name winners)]
[non-dup-tops (remove-dups top-names name)] [non-dup-tops (remove-dups top-names name)]
[top-name (car top-names)]) [top-name (car top-names)])
(cond
[(and (> (length winners) 1)
(> (length non-dup-tops) 1)
(> (length winners) max-choice-depth))
(combine-message
(msg (format "An error occurred in this ~a. Program resembles one of ~a.~n"
name (nice-list non-dup-tops)))
message-to-date)]
[(and (> (length winners) 1)
(<= (length winners) max-choice-depth))
(combine-message
(msg (format "An error occured in the ~a, program no longer matches expectation."
name))
message-to-date)]
[else
(fail-type->message (fail-type->message
(car winners) (car winners)
(add-to-message (add-to-message
(msg (msg
(cond
[(and (> (length winners) 1) (> (length non-dup-tops) 1))
(format "There is an error in this ~a. It is likely you intended one of ~a here.~n"
name (nice-list non-dup-tops))]
[else
(format "There is an error in this ~a~a.~n" (format "There is an error in this ~a~a.~n"
name name
(if (equal? top-name name) "" (if (equal? top-name name) ""
(format ", it is likely you intended ~a ~a here" (a/an top-name) top-name)))])) (format ", it is likely you intended ~a ~a here" (a/an top-name) top-name))))
name #f message-to-date)))] name #f message-to-date))]))]
[(choice-fail? fail-type) [(choice-fail? fail-type)
#;(printf "selecting for ~a~n message-to-date ~a~n" name message-to-date) #;(printf "selecting for ~a~n message-to-date ~a~n" name message-to-date)
(let* ([winners (select-errors (choice-fail-messages fail-type))] (let* ([winners (select-errors (choice-fail-messages fail-type))]
@ -135,16 +145,16 @@
(> (length no-dup-names) 1) (> (length no-dup-names) 1)
(> (length winners) 1)) (> (length winners) 1))
(combine-message (combine-message
(msg (format "An error occured in this ~a, one of ~a is expected here. Input is close to one of ~a.~n" (msg (format "An error occured in this ~a, one of ~a is expected here. Program resembles one of ~a.~n"
name (nice-list no-dup-names) (nice-list top-names))) name (nice-list no-dup-names) (nice-list top-names)))
message-to-date)] message-to-date)]
#;[(and (<= (choice-fail-options fail-type) max-choice-depth) [(and (> (length no-dup-names) max-choice-depth)
(> (length no-dup-names) 1)) (> (length winners) 1))
(combine-message (combine-message
(msg (format "An error occured in this ~a, one of ~a is expected here. Current input is close to ~a.~a~n" (msg (format "An error occured in this ~a. Possible options are ~a.~n"
name (nice-list no-dup-names) top-name name (nice-list
(if show-options " To see all options click here." ""))) (first-n max-choice-depth no-dup-names))))
message-to-date)] ;Add support for formatting and passing up all options message-to-date)]
[else [else
(fail-type->message (fail-type->message
(car winners) (car winners)