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

use spaces instead of tabs to indent output

Browse Source 
svn: r15719
This commit is contained in:
Eli Barzilay 2009-08-12 21:37:33 +00:00
parent 829c8416b6
commit 95f4d1eefe
1 changed files with 30 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
collects/typed-scheme/typecheck/tc-app-helper.ss
View File

@ -19,31 +19,42 @@
(format "~a~a *~a" doms-string rst rng-string)]
[else (string-append (stringify (map make-printable dom)) rng-string)])))
(define (domain-mismatches ty doms rests drests rngs arg-tys tail-ty tail-bound #:expected [expected #f])
(define (domain-mismatches ty doms rests drests rngs arg-tys tail-ty tail-bound
#:expected [expected #f])
(define arguments-str
(stringify-domain arg-tys (if (not tail-bound) tail-ty #f) (if tail-bound (cons tail-ty tail-bound) #f)))
(stringify-domain arg-tys
(if (not tail-bound) tail-ty #f)
(if tail-bound (cons tail-ty tail-bound) #f)))
(cond
[(null? doms)
(int-err "How could doms be null: ~a ~a" ty)]
[(= 1 (length doms))
(format "Domain: ~a~nArguments: ~a~n~a"
(stringify-domain (car doms) (car rests) (car drests))
arguments-str
(if expected
(format "Result type: ~a~nExpected result: ~a~n"
(car rngs) (make-printable expected))
""))]
(string-append
"Domain: "
(stringify-domain (car doms) (car rests) (car drests))
"\nArguments: "
arguments-str
"\n"
(if expected
(format "Result type: ~a\nExpected result: ~a\n"
(car rngs) (make-printable expected))
""))]
[else
(format "~a: ~a~nArguments: ~a~n~a"
(if expected "Types" "Domains")
(stringify (if expected
(map stringify-domain (map make-printable doms) rests drests rngs)
(map stringify-domain (map make-printable doms) rests drests))
"~n\t")
arguments-str
(if expected
(format "Expected result: ~a~n" (make-printable expected))
""))]))
(let ([label (if expected "Types: " "Domains: ")]
[nl+spc (if expected "\n " "\n ")]
[pdoms (map make-printable doms)])
(string-append
label
(stringify (if expected
(map stringify-domain pdoms rests drests rngs)
(map stringify-domain pdoms rests drests))
nl+spc)
"\nArguments: "
arguments-str
"\n"
(if expected
(format "Expected result: ~a\n" (make-printable expected))
"")))]))
(define (poly-fail t argtypes #:name [name #f] #:expected [expected #f])
(match t