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

recreate selector table automatically.

Browse Source 
original commit: a33f460b2547866d492bf01c81ded9b2a669ea26
This commit is contained in:
Sam Tobin-Hochstadt 2010-06-24 16:48:10 -04:00
parent bc193f512c
commit c898d882c6
3 changed files with 22 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/typed-scheme/rep/object-rep.rkt
View File

@ -6,6 +6,7 @@
(dpe CarPE () [#:fold-rhs #:base])
(dpe CdrPE () [#:fold-rhs #:base])
(dpe SyntaxPE () [#:fold-rhs #:base])
;; t is always a Name (can't put that into the contract b/c of circularity)
(dpe StructPE ([t Type?] [idx natural-number/c])
[#:frees (free-vars* t) (free-idxs* t)]
[#:fold-rhs (*StructPE (type-rec-id t) idx)])

9
collects/typed-scheme/typecheck/tc-toplevel.rkt
View File

@ -11,7 +11,7 @@
;; to appease syntax-parse
"internal-forms.rkt"
(rep type-rep)
(types utils convenience)
(types utils convenience type-table)
(private parse-type type-annotation type-contract)
(env global-env init-envs type-name-env type-alias-env lexical-env)
unstable/mutated-vars syntax/id-table
@ -19,7 +19,7 @@
"provide-handling.rkt"
"def-binding.rkt"
(prefix-in c: racket/contract)
racket/dict
racket/dict
(for-template
"internal-forms.rkt"
unstable/location
@ -306,10 +306,13 @@
[(new-provs ...)
(generate-prov def-tbl provide-tbl #'the-variable-reference)])
#`(begin
(define the-variable-reference (quote-module-path))
#,(if (null? (syntax-e #'(new-provs ...)))
#'(begin)
#'(define the-variable-reference (quote-module-path)))
#,(env-init-code syntax-provide? provide-tbl def-tbl)
#,(tname-env-init-code)
#,(talias-env-init-code)
(begin-for-syntax #,(make-struct-table-code))
(begin new-provs ...)))))
;; typecheck a whole module

17
collects/typed-scheme/types/type-table.rkt
View File

@ -1,7 +1,8 @@
#lang scheme/base
(require unstable/debug scheme/contract "../utils/utils.rkt" syntax/id-table racket/dict racket/match
(rep type-rep object-rep) (only-in (types abbrev utils) tc-results?) (utils tc-utils))
(rep type-rep object-rep) (only-in (types abbrev utils) tc-results?) (utils tc-utils)
(env init-envs) mzlib/pconvert)
(define table (make-hasheq))
@ -25,9 +26,21 @@
[else #f]))
(values (mk #f) (mk #t))))
(define (make-struct-table-code)
(parameterize ([current-print-convert-hook converter]
[show-sharing #f])
#`(begin #,@(for/list ([(k v) (in-dict struct-fn-table)]
#:when (bound-in-this-module k))
(match v
[(list pe mut?)
#`(add-struct-fn! (quote-syntax #,k)
#,(print-convert pe)
#,mut?)])))))
(p/c [add-typeof-expr (syntax? tc-results? . -> . any/c)]
[type-of (syntax? . -> . tc-results?)]
[reset-type-table (-> any/c)]
[add-struct-fn! (identifier? StructPE? boolean? . -> . any/c)]
[struct-accessor? (identifier? . -> . (or/c #f StructPE?))]
[struct-mutator? (identifier? . -> . (or/c #f StructPE?))])
[struct-mutator? (identifier? . -> . (or/c #f StructPE?))]
[make-struct-table-code (-> syntax?)])