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

require-typed: more informative error when struct field is missing

Browse Source 
add a typed-field syntax class (`[id : expr]`) and use it to report errors + simplify other code
This commit is contained in:
Ben Greenman 2017-06-05 20:21:32 -04:00 committed by GitHub
parent dda8b1da20
commit 6e3c509a86
2 changed files with 25 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
typed-racket-lib/typed-racket/base-env/prims-contract.rkt
View File

@ -111,6 +111,10 @@
(pattern nm:id #:with parent #'#f)
(pattern (nm:id parent:id)))
(define-syntax-class typed-field
#:attributes (field type)
#:literals (:)
(pattern [field:id : type]))
(define-values (require/typed-legacy require/typed -unsafe-require/typed)
(let ()
@ -142,7 +146,7 @@
#:attributes (nm type (body 1) (constructor-parts 1) (tvar 1))
(pattern [(~or (~datum struct) #:struct)
(~optional (~seq (tvar ...)) #:defaults ([(tvar 1) '()]))
nm:opt-parent (body ...)
nm:opt-parent (body:typed-field ...)
(~var opts (struct-opts legacy #'nm.nm))]
#:with (constructor-parts ...) #'opts.ctor-value
#:attr type #'opts.type))
@ -150,7 +154,9 @@
(define-syntax-class signature-clause
#:literals (:)
#:attributes (sig-name [var 1] [type 1])
(pattern [#:signature sig-name:id ([var:id : type] ...)]))
(pattern [#:signature sig-name:id (body:typed-field ...)]
#:with (var ...) #'(body.field ...)
#:with (type ...) #'(body.type ...)))
(define-syntax-class opaque-clause
;#:literals (opaque)
@ -450,7 +456,7 @@
(syntax-parse stx #:literals (:)
[(_ name:opt-parent
(~optional (~seq (tvar:id ...)) #:defaults ([(tvar 1) '()]))
([fld : ty] ...)
(body:typed-field ...)
(~var input-maker (constructor-term legacy #'name.nm))
(~optional (~seq #:type-name type:id) #:defaults ([type #'name.nm]))
unsafe:unsafe-clause
@ -460,6 +466,8 @@
[hidden (generate-temporary #'name.nm)]
[orig-struct-info (generate-temporary #'nm)]
[spec (if (syntax-e #'name.parent) #'(nm parent) #'nm)]
[(fld ...) #'(body.field ...)]
[(ty ...) #'(body.type ...)]
[num-fields (syntax-length #'(fld ...))]
[(type-des _ pred sel ...)
(build-struct-names #'nm (syntax->list #'(fld ...)) #f #t)]
@ -540,7 +548,7 @@
(make-struct-info-self-ctor #'internal-maker si)
si))
(dtsi* (tvar ...) spec type ([fld : ty] ...) #:maker maker-name #:type-only)
(dtsi* (tvar ...) spec type (body ...) #:maker maker-name #:type-only)
#,(ignore #'(require/contract pred hidden (or/c struct-predicate-procedure?/c (c-> any-wrap/c boolean?)) lib))
#,(internal #'(require/typed-internal hidden (Any -> Boolean : type)))
(require/typed #:internal (maker-name real-maker) type lib

13
typed-racket-test/fail/require-typed-struct-missing-colon.rkt Normal file
View File

@ -0,0 +1,13 @@
#;
(exn-pred ".*while parsing typed-field.*")
#lang racket/base
(module server racket
(provide (struct-out posn))
(struct posn [x y]))
(module client typed/racket
(require/typed (submod ".." server)
(#:struct posn ((x Integer) (y Integer)))))
(require 'client)