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

Refactor base-special-env to run at phase 0.

Browse Source 
Unfortunately, it can no longer be required normally, and forces changes to test suites.

original commit: 8ecc2a4da4c995a83ddc630ab274859f47597fc6
This commit is contained in:
Sam Tobin-Hochstadt 2011-08-15 17:57:53 -04:00
parent ab46be4998
commit ec40b5be8f
2 changed files with 22 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/typed-scheme/base-env/base-special-env.rkt
View File

@ -5,27 +5,24 @@
"../utils/utils.rkt"
racket/promise
string-constants/string-constant
racket/private/kw racket/file racket/port
(for-syntax racket/base syntax/parse (only-in racket/syntax syntax-local-eval)
(utils tc-utils)
(env init-envs)
(except-in (rep filter-rep object-rep type-rep) make-arr)
(types convenience union)
(only-in (types convenience) [make-arr* make-arr])))
racket/private/kw racket/file racket/port syntax/parse
(for-template (only-in racket/private/kw kw-expander-proc kw-expander-impl)
racket/base racket/promise racket/file racket/port string-constants/string-constant)
(utils tc-utils)
(env init-envs)
(except-in (rep filter-rep object-rep type-rep) make-arr)
(types convenience union)
(only-in (types convenience) [make-arr* make-arr])
(for-template )
(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] ...)
(with-syntax ([(id ...)
(for/list ([expr (syntax->list #'(id-expr ...))])
(syntax-local-eval expr))])
#`(begin
(define-for-syntax initial-env
(make-env
[id ty] ...))
(define-for-syntax (initialize-env)
(initialize-type-env initial-env))
(provide (for-syntax initialize-env))))]))
#`(begin
(define initial-env (make-env [id-expr ty] ...))
(define (initialize-env) (initialize-type-env initial-env))
(provide initialize-env))]))
(define-initial-env initialize-special
;; make-promise
@ -33,6 +30,7 @@
#:context #'make-promise
[(_ mp . _) #'mp])
(-poly (a) (-> (-> a) (-Promise a)))]
;; language
[(syntax-parse (local-expand #'(this-language) 'expression null)
#:context #'language

15
collects/typed-scheme/typed-scheme.rkt
View File

@ -3,8 +3,7 @@
(require (for-syntax racket/base
;; these requires are needed since their code
;; appears in the residual program
"typecheck/renamer.rkt" "types/type-table.rkt" profile)
"base-env/base-special-env.rkt" )
"typecheck/renamer.rkt" "types/type-table.rkt"))
(provide (rename-out [module-begin #%module-begin]
[top-interaction #%top-interaction]
@ -17,12 +16,12 @@
(define-for-syntax initialized #f)
(define-for-syntax (do-standard-inits)
(unless initialized
(initialize-special)
((dynamic-require 'typed-scheme/base-env/base-structs 'initialize-structs))
((dynamic-require 'typed-scheme/base-env/base-env-indexing 'initialize-indexing))
((dynamic-require 'typed-scheme/base-env/base-env 'init))
((dynamic-require 'typed-scheme/base-env/base-env-numeric 'init))
(set! initialized #t)))
((dynamic-require 'typed-scheme/base-env/base-structs 'initialize-structs))
((dynamic-require 'typed-scheme/base-env/base-env-indexing 'initialize-indexing))
((dynamic-require 'typed-scheme/base-env/base-env 'init))
((dynamic-require 'typed-scheme/base-env/base-env-numeric 'init))
((dynamic-require 'typed-scheme/base-env/base-special-env 'initialize-special))
(set! initialized #t)))
(define-syntax-rule (drivers [name sym] ...)
(begin