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

Raise errors when signatures are not in the signature environment while typechecking

Browse Source 
Closes #319
This commit is contained in:
Daniel Feltey 2016-03-12 16:39:39 -06:00
parent d23e05f2c3
commit 425ff47700
3 changed files with 37 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
typed-racket-lib/typed-racket/env/signature-env.rkt vendored
View File

@ -6,6 +6,7 @@
(provide register-signature!
finalize-signatures!
lookup-signature
lookup-signature/check
signature-env-map
with-signature-env/extend)
@ -66,5 +67,15 @@
(define (lookup-signature id)
(free-id-table-ref (signature-env) id #f))
;; lookup-signature/check : identifier? -> Signature?
;; lookup the identifier in the signature environment
;; errors if there is no such typed signature
(define (lookup-signature/check id)
(or (lookup-signature id)
(tc-error/fields "use of untyped signature in typed code"
#:more "consider using `require/typed' to import it"
"signature" (syntax-e id)
#:stx id)))
(define (signature-env-map f)
(sorted-dict-map (signature-env) f id<))

26
typed-racket-lib/typed-racket/typecheck/check-unit-unit.rkt
View File

@ -70,7 +70,7 @@
(private parse-type syntax-properties type-annotation)
(only-in (base-env base-special-env) make-template-identifier)
(env lexical-env tvar-env global-env
signature-env signature-helper)
signature-env)
(types utils abbrev union subtype resolve generalize signatures)
(typecheck check-below internal-forms)
(utils tc-utils)
@ -170,7 +170,7 @@
(values (for/list ([sig-id (in-list import-sigs)]
[sig-internal-ids (in-list import-internal-ids)])
(sig-info sig-id
(map car (Signature-mapping (lookup-signature sig-id)))
(map car (Signature-mapping (lookup-signature/check sig-id)))
sig-internal-ids))
;; export-temp-ids is a flat list which must be processed
;; sequentially to map them to the correct internal/external identifiers
@ -179,7 +179,7 @@
[sig-infos '()])
([sig (in-list export-sigs)])
(define external-ids
(map car (Signature-mapping (lookup-signature sig))))
(map car (Signature-mapping (lookup-signature/check sig))))
(define len (length external-ids))
(values (drop temp-ids len)
(cons (sig-info sig
@ -391,7 +391,7 @@
;; Returns a mapping of link-ids to sig-ids, a list of imported sig ids
;; a list of exported link-ids
(define (parse-compound-unit stx)
(define (list->sigs l) (map lookup-signature l))
(define (list->sigs l) (map lookup-signature/check l))
(syntax-parse stx
[cu:compound-unit-expansion
(define link-binding-info (tr:unit:compound-property stx))
@ -407,7 +407,7 @@
(let ()
(define link-syms (append cu-import-syms (flatten unit-export-syms)))
(define sig-ids (append compound-imports (flatten unit-exports)))
(map cons link-syms (map lookup-signature sig-ids))))
(map cons link-syms (map lookup-signature/check sig-ids))))
(define cu-exprs
(for/list ([unit-expr (in-list unit-exprs)]
[import-sigs (in-list unit-imports)]
@ -428,7 +428,7 @@
;; GIVEN: signature information
;; RETURNS: a mapping from internal names to types
(define (make-local-type-mapping si)
(define sig (lookup-signature (sig-info-name si)))
(define sig (lookup-signature/check (sig-info-name si)))
(define internal-names (sig-info-internals si))
(define sig-types
(map cdr (Signature-mapping sig)))
@ -475,7 +475,7 @@
(define (parse-and-check-unit-from-context form expected-type)
(syntax-parse form
[u:unit-expansion
(define export-sigs (map lookup-signature (attribute u.export-sigs)))
(define export-sigs (map lookup-signature/check (attribute u.export-sigs)))
(define body-stx (attribute u.body-stx))
(for ([sig (in-list export-sigs)])
(define ids (extract-definitions body-stx))
@ -558,8 +558,8 @@
(syntax-parse form
[cu:compound-unit-expansion
(define unit-exprs (attribute cu.unit-exprs))
(define compound-imports (map lookup-signature (attribute cu.compound-imports)))
(define compound-exports (map lookup-signature (attribute cu.compound-exports)))
(define compound-imports (map lookup-signature/check (attribute cu.compound-imports)))
(define compound-exports (map lookup-signature/check (attribute cu.compound-exports)))
(define import-vector (apply vector compound-imports))
(define import-length (vector-length import-vector))
(unless (and (list? init-depend-refs)
@ -579,7 +579,7 @@
[iu:invoke-unit-expansion
(define infer? (eq? 'infer (tr:unit:invoke-property form)))
(define invoked-unit (attribute iu.expr))
(define import-sigs (map lookup-signature (attribute iu.imports)))
(define import-sigs (map lookup-signature/check (attribute iu.imports)))
(define linking-units (attribute iu.units))
(define unit-expr-type (tc-expr/t invoked-unit))
;; TODO: Better error message/handling when the folling check-below "fails"
@ -630,9 +630,9 @@
init-depend-tags))
;; Get Signatures to build Unit type
(define import-signatures (map lookup-signature (map sig-info-name imports-info)))
(define export-signatures (map lookup-signature (map sig-info-name exports-info)))
(define init-depend-signatures (map lookup-signature init-depends))
(define import-signatures (map lookup-signature/check (map sig-info-name imports-info)))
(define export-signatures (map lookup-signature/check (map sig-info-name exports-info)))
(define init-depend-signatures (map lookup-signature/check init-depends))
(unless (distinct-signatures? import-signatures)
(tc-error/expr "unit expressions must import distinct signatures"))

13
typed-racket-test/fail/require-untyped-signature.rkt Normal file
View File

@ -0,0 +1,13 @@
#;
(exn-pred (regexp-quote "use of untyped signature in typed code"))
#lang racket
(module A racket
(provide a)
(define-signature a ()))
(module B typed/racket
(require (submod ".." A))
(define-unit u
(import a)
(export)))