From 2511cf02bc67130abe360d39b59e40da3e4a741b Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Tue, 6 Nov 2012 17:20:07 -0500 Subject: [PATCH] Refactor and move a macro to a helper library --- .../base-env/base-special-env.rkt | 8 ------ collects/typed-racket/env/init-envs.rkt | 26 ++++++++++++++++++- 2 files changed, 25 insertions(+), 9 deletions(-) diff --git a/collects/typed-racket/base-env/base-special-env.rkt b/collects/typed-racket/base-env/base-special-env.rkt index ba31129b31..c521141bc5 100644 --- a/collects/typed-racket/base-env/base-special-env.rkt +++ b/collects/typed-racket/base-env/base-special-env.rkt @@ -14,14 +14,6 @@ (rename-in (types abbrev numeric-tower union) [make-arr* make-arr]) (for-syntax racket/base syntax/parse (only-in racket/syntax syntax-local-eval))) -(define-syntax (define-initial-env stx) - (syntax-parse stx - [(_ initialize-env [id-expr ty] ...) - #`(begin - (define initial-env (make-env [id-expr (λ () ty)] ... )) - (define (initialize-env) (initialize-type-env initial-env)) - (provide initialize-env))])) - (define (make-template-identifier what where) (let ([name (module-path-index-resolve (module-path-index-join where #f))]) (parameterize ([current-namespace (make-empty-namespace)]) diff --git a/collects/typed-racket/env/init-envs.rkt b/collects/typed-racket/env/init-envs.rkt index ced303158a..2156cefa3b 100644 --- a/collects/typed-racket/env/init-envs.rkt +++ b/collects/typed-racket/env/init-envs.rkt @@ -1,5 +1,7 @@ #lang racket/base -(provide (all-defined-out)) + +;; Support for defining the initial TR environment + (require "../utils/utils.rkt" "../utils/tc-utils.rkt" "global-env.rkt" @@ -10,10 +12,32 @@ (for-template (rep type-rep object-rep filter-rep) (types union abbrev) racket/shared racket/base) + (for-syntax syntax/parse racket/base) (types abbrev) racket/syntax racket/dict mzlib/pconvert racket/match) +(provide ;; convenience form for defining an initial environment + ;; used by "base-special-env.rkt" and "base-contracted.rkt" + define-initial-env + initialize-type-name-env + initialize-type-env + converter + bound-in-this-module + tname-env-init-code + tvariance-env-init-code + talias-env-init-code + env-init-code + mvar-env-init-code ) + +(define-syntax (define-initial-env stx) + (syntax-parse stx + [(_ initialize-env [id-expr ty] ...) + #`(begin + (define initial-env (make-env [id-expr (λ () ty)] ... )) + (define (initialize-env) (initialize-type-env initial-env)) + (provide initialize-env))])) + (define (initialize-type-name-env initial-type-names) (for-each (lambda (nm/ty) (register-resolved-type-alias (car nm/ty) (cadr nm/ty))) initial-type-names))