6bf141513f
Each typed module now defines a submodule named `type-decl`. This module performs the type environment initialization (along with other environment updates) when invoked. Additionall, every typed module, when invoked, performs a for-syntax addition to a list specifying the submodules that need invocation. This invocation is then performed by the `#%module-begin` from Typed Racket. The `type-decl` module always goes at the beginning of the expanded module, so that it's available at syntax-time for all the other submodules. This involved adding pre- and post- syntaxes for the results of typechecking. This allows significant runtime dependency reduction from the main `typed/racket` and `typed/racket/base` languages (not yet complete).
78 lines
3.4 KiB
Racket
78 lines
3.4 KiB
Racket
#lang racket/base
|
|
|
|
(require (rename-in "utils/utils.rkt" [infer r:infer])
|
|
(except-in syntax/parse id)
|
|
racket/pretty
|
|
(private type-contract)
|
|
(types utils convenience)
|
|
(typecheck typechecker provide-handling tc-toplevel)
|
|
(env tvar-env type-name-env type-alias-env env-req)
|
|
(r:infer infer)
|
|
(utils tc-utils disarm mutated-vars debug)
|
|
(rep type-rep)
|
|
(except-in (utils utils) infer)
|
|
(only-in (r:infer infer-dummy) infer-param)
|
|
(for-syntax racket/base)
|
|
(for-template racket/base))
|
|
|
|
(provide tc-setup invis-kw maybe-optimize)
|
|
|
|
(define-syntax-class invis-kw
|
|
#:literals (define-values define-syntaxes #%require #%provide begin)
|
|
(pattern (~or define-values define-syntaxes #%require #%provide begin)))
|
|
|
|
(define (maybe-optimize body)
|
|
;; do we optimize?
|
|
(if (optimize?)
|
|
(let ([optimize-top
|
|
(begin0 (dynamic-require 'typed-racket/optimizer/optimizer
|
|
'optimize-top)
|
|
(do-time "Loading optimizer"))])
|
|
(begin0 (map optimize-top (syntax->list body))
|
|
(do-time "Optimized")))
|
|
body))
|
|
|
|
(define-syntax-rule (tc-setup orig-stx stx expand-ctxt fully-expanded-stx init checker pre-result post-result . body)
|
|
(let ()
|
|
(set-box! typed-context? #t)
|
|
;(start-timing (syntax-property stx 'enclosing-module-name))
|
|
(with-handlers
|
|
(#;[(λ (e) (and (exn:fail? e) (not (exn:fail:syntax? e)) (not (exn:fail:filesystem? e))))
|
|
(λ (e) (tc-error "Internal Typed Racket Error : ~a" e))])
|
|
(parameterize (;; enable fancy printing?
|
|
[custom-printer #t]
|
|
;; a cheat to avoid units
|
|
[infer-param infer]
|
|
;; do we report multiple errors
|
|
[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
|
|
(lambda ()
|
|
(append
|
|
(type-name-env-map (lambda (id ty)
|
|
(cons (syntax-e id) ty)))
|
|
(type-alias-env-map (lambda (id ty)
|
|
(cons (syntax-e id) ty)))))]
|
|
;; reinitialize disappeared uses
|
|
[disappeared-use-todo null]
|
|
[disappeared-bindings-todo null])
|
|
(define fully-expanded-stx (disarm* (local-expand stx expand-ctxt (list #'module*))))
|
|
(when (show-input?)
|
|
(pretty-print (syntax->datum fully-expanded-stx)))
|
|
(do-time "Local Expand Done")
|
|
(init)
|
|
(do-time "Initialized Envs")
|
|
(parameterize ([mutated-vars (find-mutated-vars fully-expanded-stx)]
|
|
[orig-module-stx (or (orig-module-stx) orig-stx)]
|
|
[expanded-module-stx fully-expanded-stx]
|
|
[debugging? #f])
|
|
(do-time "Starting `checker'")
|
|
(define-values (pre-result post-result) (checker fully-expanded-stx))
|
|
(do-time "Typechecking Done")
|
|
(let () . body))))))
|