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

Add contracts and omit an unused definition

Browse Source
This commit is contained in:
Asumu Takikawa 2014-10-21 09:55:52 -04:00
parent dc578cdbc0
commit 200f1cdb45
1 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/name.rkt
View File

@ -17,10 +17,18 @@
syntax/id-table) syntax/id-table)
(provide with-new-name-tables (provide with-new-name-tables
get-all-name-defs (contract-out
lookup-name-sc [get-all-name-defs
lookup-name-defs (-> (listof (list/c (listof identifier?)
register-name-sc) static-contract?
static-contract?
static-contract?)))]
[lookup-name-sc (-> identifier? symbol? (or/c #f static-contract?))]
[register-name-sc (-> identifier?
(-> static-contract?)
(-> static-contract?)
(-> static-contract?)
any)]))
(define name-sc-table (make-parameter (make-free-id-table))) (define name-sc-table (make-parameter (make-free-id-table)))
(define name-defs-table (make-parameter (make-free-id-table))) (define name-defs-table (make-parameter (make-free-id-table)))
@ -45,9 +53,6 @@
[(typed) (cadr result)] [(typed) (cadr result)]
[(untyped) (caddr result)]))) [(untyped) (caddr result)])))
(define (lookup-name-defs name)
(free-id-table-ref (name-defs-table) name #f))
(define (register-name-sc name typed-thunk untyped-thunk both-thunk) (define (register-name-sc name typed-thunk untyped-thunk both-thunk)
(define-values (typed-name untyped-name both-name) (define-values (typed-name untyped-name both-name)
(values (generate-temporary) (values (generate-temporary)