From 1f7d88e1148f14ceac89cc156f3daec08da5c3d0 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Thu, 12 Jul 2012 11:19:58 -0400 Subject: [PATCH] Reduce some dependencies of Typed Racket prims. original commit: 396b04eb8689ed918f675cbed290c0a1bfa71c78 --- collects/typed-racket/base-env/prims.rkt | 8 +++----- collects/typed-racket/env/env-req.rkt | 14 ++------------ collects/typed-racket/tc-setup.rkt | 2 -- .../typed-racket/typecheck/tc-toplevel.rkt | 3 ++- collects/typed-racket/typed-racket.rkt | 1 + collects/typed-racket/types/type-table.rkt | 19 ++++++++----------- 6 files changed, 16 insertions(+), 31 deletions(-) diff --git a/collects/typed-racket/base-env/prims.rkt b/collects/typed-racket/base-env/prims.rkt index 4ddcd292..9024157d 100644 --- a/collects/typed-racket/base-env/prims.rkt +++ b/collects/typed-racket/base-env/prims.rkt @@ -40,16 +40,13 @@ This file defines two sorts of primitives. All of them are provided into any mod "base-types.rkt" "base-types-extra.rkt" racket/flonum ; for for/flvector and for*/flvector - mzlib/etc (for-syntax unstable/lazy-require syntax/parse racket/syntax racket/base - syntax/define racket/struct-info syntax/struct - ;"../rep/type-rep.rkt" "annotate-classes.rkt" "internal.rkt" "../utils/tc-utils.rkt" @@ -58,7 +55,8 @@ This file defines two sorts of primitives. All of them are provided into any mod (provide index?) ; useful for assert, and racket doesn't have it (begin-for-syntax - (lazy-require ["../rep/type-rep.rkt" (make-Opaque)])) + (lazy-require ["../rep/type-rep.rkt" (make-Opaque)] + [syntax/define (normalize-definition)])) (define-for-syntax (ignore stx) (syntax-property stx 'typechecker:ignore #t)) @@ -304,7 +302,7 @@ This file defines two sorts of primitives. All of them are provided into any mod (define-syntax (opt-lambda: stx) (syntax-parse stx [(opt-lambda: formals:opt-lambda-annotated-formals . body) - (syntax/loc stx (opt-lambda formals.ann-formals . body))])) + (syntax/loc stx (-lambda formals.ann-formals . body))])) (define-syntaxes (let-internal: let*: letrec:) (let ([mk (lambda (form) diff --git a/collects/typed-racket/env/env-req.rkt b/collects/typed-racket/env/env-req.rkt index 363fefd2..cc70acb5 100644 --- a/collects/typed-racket/env/env-req.rkt +++ b/collects/typed-racket/env/env-req.rkt @@ -1,23 +1,13 @@ #lang racket/base -(require racket/match) - -(define module-name (make-parameter #f)) (define to-require null) (define (add-mod! m) - ;(printf ">> adding module ~v\n" m) (set! to-require (cons m to-require))) -(define (fix m) - (match m - [`(file ,(? bytes? b)) - `(file ,(bytes->string/utf-8 b))] - [_ m])) (define (do-requires [ns (current-namespace)]) (parameterize ([current-namespace ns]) (for ([m (in-list to-require)] #:when m) - ;(printf ">> loading ~a\n" m) - (dynamic-require `(submod ,(fix m) #%type-decl) #f)))) + (dynamic-require `(submod ,m #%type-decl) #f)))) -(provide add-mod! do-requires module-name) \ No newline at end of file +(provide add-mod! do-requires) \ No newline at end of file diff --git a/collects/typed-racket/tc-setup.rkt b/collects/typed-racket/tc-setup.rkt index 8ddca303..4214d9cf 100644 --- a/collects/typed-racket/tc-setup.rkt +++ b/collects/typed-racket/tc-setup.rkt @@ -47,8 +47,6 @@ [delay-errors? #t] ;; do we print the fully-expanded syntax? [print-syntax? #f] - ;; the name of this module: - [module-name (syntax-property orig-stx 'enclosing-module-name)] ;; this parameter is just for printing types ;; this is a parameter to avoid dependency issues [current-type-names diff --git a/collects/typed-racket/typecheck/tc-toplevel.rkt b/collects/typed-racket/typecheck/tc-toplevel.rkt index 947bdcb8..15a5bf1b 100644 --- a/collects/typed-racket/typecheck/tc-toplevel.rkt +++ b/collects/typed-racket/typecheck/tc-toplevel.rkt @@ -344,7 +344,8 @@ (begin-for-syntax (module* #%type-decl #f (require typed-racket/types/numeric-tower typed-racket/env/type-name-env - typed-racket/env/global-env typed-racket/env/type-alias-env) + typed-racket/env/global-env typed-racket/env/type-alias-env + typed-racket/types/type-table) #,(env-init-code syntax-provide? provide-tbl def-tbl) #,(talias-env-init-code) #,(tname-env-init-code) diff --git a/collects/typed-racket/typed-racket.rkt b/collects/typed-racket/typed-racket.rkt index ea621c15..2112c4e8 100644 --- a/collects/typed-racket/typed-racket.rkt +++ b/collects/typed-racket/typed-racket.rkt @@ -5,6 +5,7 @@ (for-syntax "utils/timing.rkt") ;; only for timing/debugging ;; the below requires are needed since they provide identifiers ;; that may appear in the residual program + "utils/utils.rkt" "utils/any-wrap.rkt" unstable/contract) (provide (rename-out [module-begin #%module-begin] diff --git a/collects/typed-racket/types/type-table.rkt b/collects/typed-racket/types/type-table.rkt index 5b9fa674..a0b9bf25 100644 --- a/collects/typed-racket/types/type-table.rkt +++ b/collects/typed-racket/types/type-table.rkt @@ -1,7 +1,7 @@ #lang racket/base (require syntax/id-table racket/dict racket/match mzlib/pconvert - "../utils/utils.rkt" + "../utils/utils.rkt" racket/syntax "../utils/tc-utils.rkt" (contract-req) (rep type-rep object-rep) @@ -69,16 +69,13 @@ (define (make-struct-table-code) (parameterize ([current-print-convert-hook converter] [show-sharing #f]) - #`(when (unbox typed-context?) - (define add! (dynamic-require 'typed-racket/types/type-table 'add-struct-fn!)) - #,@(for/list ([(k v) (in-dict struct-fn-table)] - #:when (bound-in-this-module k)) - (match v - [(list pe mut?) - #`(add! (quote-syntax #,k) - #,(print-convert pe) - #,mut?)])) - (void)))) + (define/with-syntax (adds ...) + (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?)]))) + #'(begin adds ...))) ;; keeps track of expressions that always evaluate to true or always evaluate