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

Move struct table code gen to init-envs.rkt

Browse Source 
This keeps all the code generation in one place.
This commit is contained in:
Asumu Takikawa 2016-06-21 17:55:03 -04:00
parent ee02c26020
commit 11439eb653
2 changed files with 18 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
typed-racket-lib/typed-racket/env/init-envs.rkt vendored
View File

@ -12,7 +12,7 @@
(rename-in racket/private/sort [sort raw-sort])
(rep type-rep object-rep prop-rep rep-utils free-variance)
(for-syntax syntax/parse racket/base)
(types abbrev union utils)
(types abbrev struct-table union utils)
data/queue
racket/dict racket/list racket/set racket/promise
racket/match)
@ -24,14 +24,14 @@
initialize-type-env
get-extra-type-definitions ; for tc-toplevel.rkt
type->sexp ; for types/printer.rkt
path-elem->sexp ; for types/struct-table.rkt
bound-in-this-module
tname-env-init-code
tvariance-env-init-code
talias-env-init-code
env-init-code
mvar-env-init-code
signature-env-init-code)
signature-env-init-code
make-struct-table-code)
(define-syntax (define-initial-env stx)
(syntax-parse stx
@ -415,3 +415,12 @@
(make-init-code
signature-env-map
(lambda (id sig) #`(register-signature! #'#,id #,(quote-type sig)))))
(define (make-struct-table-code)
(make-init-code
struct-fn-table-map
(λ (id v)
(match-define (list pe mut?) v)
#`(add-struct-fn! (quote-syntax #,id)
#,(path-elem->sexp pe)
#,mut?))))

18
typed-racket-lib/typed-racket/types/struct-table.rkt
View File

@ -6,7 +6,7 @@
(prefix-in c: (contract-req))
(rep type-rep prop-rep object-rep)
(utils tc-utils)
(env init-envs env-utils)
(env env-utils)
(types abbrev))
(define struct-fn-table (make-free-id-table))
@ -26,20 +26,14 @@
[(list (StructPE: _ idx) _) idx]
[_ (int-err (format "no struct fn table entry for ~a" (syntax->datum id)))]))
(define (make-struct-table-code)
(define/with-syntax (adds ...)
(for/list ([(k v) (in-sorted-dict struct-fn-table id<)]
#:when (bound-in-this-module k))
(match v
[(list pe mut?)
#`(add-struct-fn! (quote-syntax #,k)
#,(path-elem->sexp pe)
#,mut?)])))
#'(begin adds ...))
(define (struct-fn-table-map f)
(for/list ([(k v) (in-sorted-dict struct-fn-table id<)])
(f k v)))
(provide/cond-contract
[add-struct-fn! (identifier? StructPE? boolean? . c:-> . c:any/c)]
[struct-accessor? (identifier? . c:-> . (c:or/c #f StructPE?))]
[struct-mutator? (identifier? . c:-> . (c:or/c #f StructPE?))]
[struct-fn-idx (identifier? . c:-> . exact-integer?)]
[make-struct-table-code (c:-> syntax?)])
[struct-fn-table-map (c:-> (c:-> identifier? (c:list/c StructPE? boolean?) c:any/c)
(c:listof/c c:any/c))])