Add a #lang for additional base type environments
These are for base type environments that get required rather than loaded with #lang typed/racket. original commit: 91a1ff262bc42cb3ca5ccfbcdc85c7a592a54bc7
This commit is contained in:
parent
f120a5c1fb
commit
a59ae821df
|
@ -0,0 +1,52 @@
|
|||
#lang racket/base
|
||||
|
||||
;; This module defines a #lang for use in defining extra base
|
||||
;; type environments that will only be included on a `require`
|
||||
;; (unlike the monolithic base type environment in base-env.rkt)
|
||||
;;
|
||||
;; Also see env-lang.rkt
|
||||
|
||||
(require "../utils/utils.rkt"
|
||||
(for-syntax (private parse-type))
|
||||
(for-syntax racket/base syntax/parse)
|
||||
(types abbrev numeric-tower union filter-ops)
|
||||
(for-syntax (types abbrev numeric-tower union filter-ops)))
|
||||
|
||||
(provide (rename-out [-#%module-begin #%module-begin])
|
||||
require
|
||||
(for-syntax parse-type) ; to allow resolution of Name types
|
||||
(except-out (all-from-out racket/base) #%module-begin)
|
||||
(for-syntax (except-out (all-from-out racket/base) #%module-begin))
|
||||
types rep private utils
|
||||
(for-syntax (types-out abbrev numeric-tower union filter-ops)))
|
||||
|
||||
(define-syntax (-#%module-begin stx)
|
||||
(define-syntax-class clause
|
||||
#:description "[id type]"
|
||||
(pattern [id:identifier ty]
|
||||
#:with register #'(register-type (quote-syntax id) ty)))
|
||||
(syntax-parse stx #:literals (require provide begin)
|
||||
[(mb (~optional
|
||||
(~and extra (~or (begin . _)
|
||||
(require . args)
|
||||
(provide . args)))
|
||||
#:defaults ([extra #'(void)]))
|
||||
~! binding:clause ...)
|
||||
#'(#%plain-module-begin
|
||||
extra
|
||||
(require (for-syntax typed-racket/env/env-req))
|
||||
(begin-for-syntax
|
||||
(module* #%type-decl #f
|
||||
(#%plain-module-begin ;; avoid top-level printing and config
|
||||
(require typed-racket/types/numeric-tower typed-racket/env/type-name-env
|
||||
typed-racket/env/global-env typed-racket/env/type-alias-env
|
||||
typed-racket/types/struct-table typed-racket/types/abbrev
|
||||
(rename-in racket/private/sort [sort raw-sort]))
|
||||
;; FIXME: add a switch to turn contracts on for testing
|
||||
binding.register ...)))
|
||||
(begin-for-syntax (add-mod! (variable-reference->module-path-index
|
||||
(#%variable-reference))))
|
||||
(provide binding.id ...))]
|
||||
[(mb . rest)
|
||||
#'(mb (begin) . rest)]))
|
||||
|
Loading…
Reference in New Issue
Block a user