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

,

Browse Source 
svn: r541
This commit is contained in:
Robby Findler 2005-08-03 14:11:51 +00:00
parent c95dd54291
commit a4be78133a
2 changed files with 15 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/lang/private/contracts/contracts-helpers.ss
View File

@ -115,12 +115,12 @@ flat-contract : contract
(let ([name (object-name function)])
(if (regexp-match #rx"[0-9]+:[0-9]+" (symbol->string name))
; cant infer a good name (higher order things)
(format "function defined on line ~e (called with: ~a) failed the assertion ~e"
(format "function defined on line ~e (called with: ~a) failed the assertion ~s"
name
(format-list-with-spaces values)
error)
; have func name
(format "function ~e (called with: ~a) failed the assertion ~e"
(format "function ~e (called with: ~a) failed the assertion ~s"
name
(format-list-with-spaces values)
error)))))]
@ -129,9 +129,9 @@ flat-contract : contract
(lambda (error)
(let ([name (object-name function)])
(if (regexp-match #rx"[0-9]+:[0-9]+" (symbol->string name))
(format "the arguments to the function defined on line ~e (~e) failed the assertion ~e"
(format "the arguments to the function defined on line ~e (~e) failed the assertion ~s"
name values error)
(format "function ~e's arguments ~a failed the assertion ~e"
(format "function ~e's arguments ~a failed the assertion ~s"
name
(format-list-with-spaces values)
error)))))])

20
collects/lang/private/contracts/hilighters.ss
View File

@ -2,6 +2,8 @@
(provide (all-defined))
(define identifying-mark 'xxx)
;; a path is a
;; list of symbols 'car 'cdr (or empty list)
;; or #f
@ -19,7 +21,7 @@
(lambda (p)
(cond
[(not p) `(add1 ,(type-hilighter #f))]
[(null? p) `(xxx (add1 ,(type-hilighter #f)))]
[(null? p) `(,identifying-mark (add1 ,(type-hilighter #f)))]
[(eq? (car p) 'car) `(add1 ,(type-hilighter (cdr p)))]
[else (path-error 'add1 p)])))
@ -29,7 +31,7 @@
(lambda (p)
(cond
[(not p) `(,thing ,(type-hilighter #f))]
[(null? p) `(xxx (,thing ,(type-hilighter #f)))]
[(null? p) `(,identifying-mark (,thing ,(type-hilighter #f)))]
[(eq? (car p) 'car) `(,thing ,(type-hilighter (cdr p)))]
[else (path-error thing p)])))
@ -51,7 +53,7 @@
(let ([list-hl (mk-list-hilighter cnt-hilighters)])
(cond
[(not p) name]
[(null? p) `(xxx ,name)]
[(null? p) `(,identifying-mark ,name)]
[(or (eq? (car p) 'car) (eq? (car p) 'cdr)) `(define-data ,name ,@(list-hl p))]
[else (path-error name p)]))))
@ -61,7 +63,7 @@
(let ([constructor (string->symbol (string-append "make-" (symbol->string name)))])
(cond
[(not p) `(,constructor ,@(map (lambda (f) (f #f)) field-hilighters))]
[(null? p) `(xxx (,constructor ,@(map (lambda (f) (f #f)) field-hilighters)))]
[(null? p) `(,identifying-mark (,constructor ,@(map (lambda (f) (f #f)) field-hilighters)))]
[(eq? (car p) 'car) `(,constructor ,((car field-hilighters) (cdr p)) ,@(map (lambda (f) (f #f)) (cdr field-hilighters)))]
[(eq? (car p) 'cdr) `(,constructor ,((car field-hilighters) #f) ,@((mk-list-hilighter (cdr field-hilighters)) (cdr p)))]
[else (path-error name p)]))))
@ -72,7 +74,7 @@
(lambda (p)
(cond
[(not p) `(cons ,(car-hilighter #f) ,(cdr-hilighter #f))]
[(null? p) `(xxx (cons ,(car-hilighter #f) ,(cdr-hilighter #f)))]
[(null? p) `(,identifying-mark (cons ,(car-hilighter #f) ,(cdr-hilighter #f)))]
[(eq? (car p) 'cdr) `(cons ,(car-hilighter #f) ,(cdr-hilighter (cdr p)))]
[(eq? (car p) 'car) `(cons ,(car-hilighter (cdr p)) ,(cdr-hilighter #f))]
[else (path-error 'cons p)])))
@ -83,7 +85,7 @@
(let ([list-hilighter (mk-list-hilighter domain-hilighter-list)])
(cond
[(not p) `( ,@(list-hilighter #f) -> ,(range-hilighter #f))]
[(null? p) `(xxx (,@(list-hilighter #f) -> ,(range-hilighter #f)))]
[(null? p) `(,identifying-mark (,@(list-hilighter #f) -> ,(range-hilighter #f)))]
[(eq? (car p) 'car) `( ,@(list-hilighter (cdr p)) -> , (range-hilighter #f))]
[(eq? (car p) 'cdr) `( ,@(list-hilighter #f) -> ,(range-hilighter (cdr p)))]
[else (path-error 'arrow p)]))))
@ -94,7 +96,7 @@
(let ([false-func (lambda (f) (f #f))])
(cond
[(not p) `( ,@(map false-func lhilighters))]
[(null? p) `(xxx ,@(map false-func lhilighters))]
[(null? p) `(,identifying-mark ,@(map false-func lhilighters))]
[(eq? (car p) 'car) `( ,@(cons ((car lhilighters) (cdr p)) (map false-func (cdr lhilighters))))]
[(eq? (car p) 'cdr) `( ,@(cons ((car lhilighters) #f) ((mk-list-hilighter (cdr lhilighters)) (cdr p))))]
[else (path-error 'list p)]))))
@ -104,5 +106,5 @@
(lambda (p)
(cond
[(not p) name]
[(or (null? p)(eq? (car p) 'car)) `(xxx ,name)]
[else (path-error 'flat p)]))))
[(or (null? p)(eq? (car p) 'car)) `(,identifying-mark ,name)]
[else (path-error 'flat p)]))))