cs: fix value formatting in car, etc., exceptions

This commit is contained in:
Matthew Flatt 2019-10-12 15:33:55 -06:00
parent 77cdfde679
commit a85a915f88

View File

@ -67,14 +67,17 @@
(equal? irritants '(0)))
(values "division by zero" null)]
[(equal? str "~s is not a pair")
(values "contract violation\n expected: pair?\n given: ~s"
(format-error-values "contract violation\n expected: pair?\n given: ~s"
irritants)]
[(and (equal? str "incorrect list structure ~s")
(cxr->contract who))
=> (lambda (ctc)
(values (string-append "contract violation\n expected: " ctc "\n given: ~s")
(format-error-values (string-append "contract violation\n expected: " ctc "\n given: ~s")
irritants))]
[else
(format-error-values str irritants)]))
(define (format-error-values str irritants)
(let ([str (string-copy str)]
[len (string-length str)])
(let loop ([i 0] [accum-irritants '()] [irritants irritants])
@ -96,7 +99,7 @@
(cons (car irritants)
accum-irritants)
(cdr irritants))])]
[else (loop (fx+ i 1) accum-irritants irritants)])))]))
[else (loop (fx+ i 1) accum-irritants irritants)]))))
(define (string-prefix? p str)
(and (>= (string-length str) (string-length p))