Refactor and move a macro to a helper library
This commit is contained in:
parent
d6b0c71a91
commit
2511cf02bc
|
@ -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)])
|
||||||
|
|
26
collects/typed-racket/env/init-envs.rkt
vendored
26
collects/typed-racket/env/init-envs.rkt
vendored
|
@ -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))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user