-
-
Notifications
You must be signed in to change notification settings - Fork 104
/
signature-env.rkt
73 lines (61 loc) · 2.46 KB
/
signature-env.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
#lang racket/base
;; Environment for signature definitions
;; to track bindings and type definitions inside of signatures
(provide register-signature!
finalize-signatures!
lookup-signature
lookup-signature/check
signature-env-map
signature-env-for-each
with-signature-env/extend)
(require syntax/id-table
racket/match
racket/promise
(for-syntax syntax/parse racket/base)
"env-utils.rkt"
"../utils/utils.rkt"
(utils tc-utils)
(rep type-rep))
;; initial signature environment
(define signature-env (make-parameter (make-immutable-free-id-table)))
;; register-signature! : identifier? Signature? -> Void
;; adds a mapping from the given identifier to the given signature
;; in the signature environment
(define (register-signature! id sig)
(when (lookup-signature id)
(tc-error/fields "duplicate signature definition"
"identifier" (syntax-e id)))
(signature-env (free-id-table-set (signature-env) id sig)))
(define-syntax-rule (with-signature-env/extend ids sigs . b)
(let ([ids* ids]
[sigs* sigs])
(define new-env
(for/fold ([env (signature-env)])
([id (in-list ids*)]
[sig (in-list sigs*)])
(free-id-table-set env id sig)))
(parameterize ([signature-env new-env]) . b)))
;; Iterate over the signature environment forcing the types of bindings
;; in each signature
(define (finalize-signatures!)
(sorted-dict-for-each (signature-env) (λ (id sig) (force sig)) id<))
;; lookup-signature : identifier? -> (or/c #f Signature?)
;; look up the signature corresponding to the given identifier
;; in the signature environment
(define (lookup-signature id)
(cond
[(free-id-table-ref (signature-env) id #f) => force]
[else #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) (λ (id sig) (f id (force sig))) id<))
(define (signature-env-for-each f)
(sorted-dict-for-each (signature-env) (λ (id sig) (f id (force sig))) id<))