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

adjust struct/dc so error say "struct/dc" not "-struct/dc"

Browse Source
This commit is contained in:
Robby Findler 2012-08-23 18:58:48 -05:00
parent 66b78bf488
commit 4a0506a24f
1 changed files with 15 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/racket/contract/private/struct-dc.rkt
View File

@ -469,7 +469,7 @@
(define-for-syntax (get-struct-info id stx) (define-for-syntax (get-struct-info id stx)
(unless (identifier? id) (unless (identifier? id)
(raise-syntax-error #f "expected a struct name" stx id)) (raise-syntax-error 'struct/dc "expected a struct name" stx id))
(define inf (syntax-local-value id (λ () #f))) (define inf (syntax-local-value id (λ () #f)))
(unless (struct-info? inf) (unless (struct-info? inf)
(raise-syntax-error 'struct/dc "expected a struct" stx id)) (raise-syntax-error 'struct/dc "expected a struct" stx id))
@ -495,14 +495,14 @@
(define selector-candidate (name->sel-id #'id sel-name)) (define selector-candidate (name->sel-id #'id sel-name))
(unless (for/or ([selector (in-list (list-ref info 3))]) (unless (for/or ([selector (in-list (list-ref info 3))])
(and selector (free-identifier=? selector-candidate selector))) (and selector (free-identifier=? selector-candidate selector)))
(raise-syntax-error #f (raise-syntax-error 'struct/dc
"expected an identifier that names a field or a sequence with a field name, the #:parent keyword, and the parent struct" "expected an identifier that names a field or a sequence with a field name, the #:parent keyword, and the parent struct"
stx stx
sel-name))) sel-name)))
(define (check-not-both this that) (define (check-not-both this that)
(when (and this that) (when (and this that)
(raise-syntax-error #f (raise-syntax-error 'struct/dc
(format "found both ~a and ~a on the same field" (format "found both ~a and ~a on the same field"
(syntax-e this) (syntax-e this)
(syntax-e that)) (syntax-e that))
@ -530,10 +530,10 @@
(sel-name? #'sel-name) (sel-name? #'sel-name)
(let () (let ()
(unless (sel-name? #'sel-name) (unless (sel-name? #'sel-name)
(raise-syntax-error #f not-field-name-str stx #'sel-name)) (raise-syntax-error 'struct/dc not-field-name-str stx #'sel-name))
(for ([name (in-list (syntax->list #'(dep-name ...)))]) (for ([name (in-list (syntax->list #'(dep-name ...)))])
(unless (sel-name? name) (unless (sel-name? name)
(raise-syntax-error #f not-field-name-str stx name))) (raise-syntax-error 'struct/dc not-field-name-str stx name)))
(ensure-valid-field #'sel-name) (ensure-valid-field #'sel-name)
(define-values (ctc-exp lazy? type depends-on-state?) (define-values (ctc-exp lazy? type depends-on-state?)
(let loop ([stuff #'(stuff1 . stuff)] (let loop ([stuff #'(stuff1 . stuff)]
@ -549,7 +549,7 @@
(loop #'more-stuff lazy? (stx-car stuff) depends-on-state?))] (loop #'more-stuff lazy? (stx-car stuff) depends-on-state?))]
[(#:depends-on-state . more-stuff) (loop #'more-stuff lazy? type #t)] [(#:depends-on-state . more-stuff) (loop #'more-stuff lazy? type #t)]
[(#:lazy . more-stuff) (loop #'more-stuff #t type depends-on-state?)] [(#:lazy . more-stuff) (loop #'more-stuff #t type depends-on-state?)]
[_ (raise-syntax-error #f "could not parse clause" stx clause)]))) [_ (raise-syntax-error 'struct/dc "could not parse clause" stx clause)])))
(dep-clause ctc-exp lazy? (dep-clause ctc-exp lazy?
#'sel-name (name->sel-id #'id #'sel-name) #'sel-name (name->sel-id #'id #'sel-name)
(if type (syntax-e type) '#:chaperone) (if type (syntax-e type) '#:chaperone)
@ -560,15 +560,15 @@
[(sel-name . rest) [(sel-name . rest)
(let () (let ()
(unless (sel-name? #'sel-name) (unless (sel-name? #'sel-name)
(raise-syntax-error #f not-field-name-str stx #'sel-name)) (raise-syntax-error 'struct/dc not-field-name-str stx #'sel-name))
(ensure-valid-field #'sel-name) (ensure-valid-field #'sel-name)
(define-values (lazy? exp) (define-values (lazy? exp)
(syntax-case #'rest () (syntax-case #'rest ()
[(#:lazy exp) (values #t #'exp)] [(#:lazy exp) (values #t #'exp)]
[(exp) (values #f #'exp)] [(exp) (values #f #'exp)]
[else (raise-syntax-error #f "could not parse clause" stx clause)])) [else (raise-syntax-error 'struct/dc "could not parse clause" stx clause)]))
(indep-clause exp lazy? #'sel-name (name->sel-id #'id #'sel-name)))] (indep-clause exp lazy? #'sel-name (name->sel-id #'id #'sel-name)))]
[_ (raise-syntax-error #f "could not parse clause" stx #'clause)]))) [_ (raise-syntax-error 'struct/dc "could not parse clause" stx #'clause)])))
(let () (let ()
@ -607,7 +607,7 @@
(free-identifier-mapping-get (free-identifier-mapping-get
lazy-mapping lazy-mapping
id id
(λ () (raise-syntax-error #f (λ () (raise-syntax-error 'struct/dc
(format "the field: ~s is depended on (by the contract on the field: ~s), but it has no contract" (format "the field: ~s is depended on (by the contract on the field: ~s), but it has no contract"
(syntax->datum dep-name) (syntax->datum dep-name)
(syntax->datum (clause-sel-name clause))) (syntax->datum (clause-sel-name clause)))
@ -618,7 +618,7 @@
(when (and (dep-clause? clause) (when (and (dep-clause? clause)
(eq? (dep-clause-type clause) '#:impersonator)) (eq? (dep-clause-type clause) '#:impersonator))
(unless mut (unless mut
(raise-syntax-error #f (raise-syntax-error 'struct/dc
(format "the ~a field is immutable, so the contract cannot be an impersonator contract" (format "the ~a field is immutable, so the contract cannot be an impersonator contract"
(syntax-e (clause-sel-name clause))) (syntax-e (clause-sel-name clause)))
stx stx
@ -626,7 +626,7 @@
;; check that mutable fields aren't lazy ;; check that mutable fields aren't lazy
(when (and (clause-lazy? clause) mut) (when (and (clause-lazy? clause) mut)
(raise-syntax-error #f (raise-syntax-error 'struct/dc
(format "the ~s field is mutable, so the contract cannot be lazy" (format "the ~s field is mutable, so the contract cannot be lazy"
(syntax->datum (clause-sel-name clause))) (syntax->datum (clause-sel-name clause)))
stx stx
@ -666,12 +666,13 @@
(for/list ([id (in-list (dep-clause-dep-ids x))]) (for/list ([id (in-list (dep-clause-dep-ids x))])
(free-identifier-mapping-get id->children id (free-identifier-mapping-get id->children id
(λ () (λ ()
(raise-syntax-error #f "unknown clause" stx id))))] (raise-syntax-error 'struct/dc "unknown clause" stx id))))]
[else '()])) [else '()]))
(top-sort clauses neighbors (top-sort clauses neighbors
(λ (leftovers) (λ (leftovers)
(raise-syntax-error #f "found cyclic dependencies" (raise-syntax-error 'struct/dc
"found cyclic dependencies"
stx)))) stx))))
(define-for-syntax (do-struct/dc struct/c? stx) (define-for-syntax (do-struct/dc struct/c? stx)