Refactor and move a macro to a helper library

This commit is contained in:
Asumu Takikawa 2012-11-06 17:20:07 -05:00
parent d6b0c71a91
commit 2511cf02bc
2 changed files with 25 additions and 9 deletions

View File

@ -14,14 +14,6 @@
(rename-in (types abbrev numeric-tower union) [make-arr* make-arr]) (rename-in (types abbrev numeric-tower union) [make-arr* make-arr])
(for-syntax racket/base syntax/parse (only-in racket/syntax syntax-local-eval))) (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) (define (make-template-identifier what where)
(let ([name (module-path-index-resolve (module-path-index-join where #f))]) (let ([name (module-path-index-resolve (module-path-index-join where #f))])
(parameterize ([current-namespace (make-empty-namespace)]) (parameterize ([current-namespace (make-empty-namespace)])

View File

@ -1,5 +1,7 @@
#lang racket/base #lang racket/base
(provide (all-defined-out))
;; Support for defining the initial TR environment
(require "../utils/utils.rkt" (require "../utils/utils.rkt"
"../utils/tc-utils.rkt" "../utils/tc-utils.rkt"
"global-env.rkt" "global-env.rkt"
@ -10,10 +12,32 @@
(for-template (rep type-rep object-rep filter-rep) (for-template (rep type-rep object-rep filter-rep)
(types union abbrev) (types union abbrev)
racket/shared racket/base) racket/shared racket/base)
(for-syntax syntax/parse racket/base)
(types abbrev) (types abbrev)
racket/syntax racket/dict racket/syntax racket/dict
mzlib/pconvert racket/match) 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) (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)) (for-each (lambda (nm/ty) (register-resolved-type-alias (car nm/ty) (cadr nm/ty))) initial-type-names))