Reduce some dependencies of Typed Racket prims.
This commit is contained in:
parent
5ab3827b48
commit
396b04eb86
|
@ -40,16 +40,13 @@ This file defines two sorts of primitives. All of them are provided into any mod
|
||||||
"base-types.rkt"
|
"base-types.rkt"
|
||||||
"base-types-extra.rkt"
|
"base-types-extra.rkt"
|
||||||
racket/flonum ; for for/flvector and for*/flvector
|
racket/flonum ; for for/flvector and for*/flvector
|
||||||
mzlib/etc
|
|
||||||
(for-syntax
|
(for-syntax
|
||||||
unstable/lazy-require
|
unstable/lazy-require
|
||||||
syntax/parse
|
syntax/parse
|
||||||
racket/syntax
|
racket/syntax
|
||||||
racket/base
|
racket/base
|
||||||
syntax/define
|
|
||||||
racket/struct-info
|
racket/struct-info
|
||||||
syntax/struct
|
syntax/struct
|
||||||
;"../rep/type-rep.rkt"
|
|
||||||
"annotate-classes.rkt"
|
"annotate-classes.rkt"
|
||||||
"internal.rkt"
|
"internal.rkt"
|
||||||
"../utils/tc-utils.rkt"
|
"../utils/tc-utils.rkt"
|
||||||
|
@ -58,7 +55,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
|
||||||
(provide index?) ; useful for assert, and racket doesn't have it
|
(provide index?) ; useful for assert, and racket doesn't have it
|
||||||
|
|
||||||
(begin-for-syntax
|
(begin-for-syntax
|
||||||
(lazy-require ["../rep/type-rep.rkt" (make-Opaque)]))
|
(lazy-require ["../rep/type-rep.rkt" (make-Opaque)]
|
||||||
|
[syntax/define (normalize-definition)]))
|
||||||
|
|
||||||
(define-for-syntax (ignore stx) (syntax-property stx 'typechecker:ignore #t))
|
(define-for-syntax (ignore stx) (syntax-property stx 'typechecker:ignore #t))
|
||||||
|
|
||||||
|
@ -304,7 +302,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
|
||||||
(define-syntax (opt-lambda: stx)
|
(define-syntax (opt-lambda: stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(opt-lambda: formals:opt-lambda-annotated-formals . body)
|
[(opt-lambda: formals:opt-lambda-annotated-formals . body)
|
||||||
(syntax/loc stx (opt-lambda formals.ann-formals . body))]))
|
(syntax/loc stx (-lambda formals.ann-formals . body))]))
|
||||||
|
|
||||||
(define-syntaxes (let-internal: let*: letrec:)
|
(define-syntaxes (let-internal: let*: letrec:)
|
||||||
(let ([mk (lambda (form)
|
(let ([mk (lambda (form)
|
||||||
|
|
14
collects/typed-racket/env/env-req.rkt
vendored
14
collects/typed-racket/env/env-req.rkt
vendored
|
@ -1,23 +1,13 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(require racket/match)
|
|
||||||
|
|
||||||
(define module-name (make-parameter #f))
|
|
||||||
(define to-require null)
|
(define to-require null)
|
||||||
(define (add-mod! m)
|
(define (add-mod! m)
|
||||||
;(printf ">> adding module ~v\n" m)
|
|
||||||
(set! to-require (cons m to-require)))
|
(set! to-require (cons m to-require)))
|
||||||
|
|
||||||
(define (fix m)
|
|
||||||
(match m
|
|
||||||
[`(file ,(? bytes? b))
|
|
||||||
`(file ,(bytes->string/utf-8 b))]
|
|
||||||
[_ m]))
|
|
||||||
(define (do-requires [ns (current-namespace)])
|
(define (do-requires [ns (current-namespace)])
|
||||||
(parameterize ([current-namespace ns])
|
(parameterize ([current-namespace ns])
|
||||||
(for ([m (in-list to-require)]
|
(for ([m (in-list to-require)]
|
||||||
#:when m)
|
#:when m)
|
||||||
;(printf ">> loading ~a\n" m)
|
(dynamic-require `(submod ,m #%type-decl) #f))))
|
||||||
(dynamic-require `(submod ,(fix m) #%type-decl) #f))))
|
|
||||||
|
|
||||||
(provide add-mod! do-requires module-name)
|
(provide add-mod! do-requires)
|
|
@ -47,8 +47,6 @@
|
||||||
[delay-errors? #t]
|
[delay-errors? #t]
|
||||||
;; do we print the fully-expanded syntax?
|
;; do we print the fully-expanded syntax?
|
||||||
[print-syntax? #f]
|
[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 parameter is just for printing types
|
||||||
;; this is a parameter to avoid dependency issues
|
;; this is a parameter to avoid dependency issues
|
||||||
[current-type-names
|
[current-type-names
|
||||||
|
|
|
@ -344,7 +344,8 @@
|
||||||
(begin-for-syntax
|
(begin-for-syntax
|
||||||
(module* #%type-decl #f
|
(module* #%type-decl #f
|
||||||
(require typed-racket/types/numeric-tower typed-racket/env/type-name-env
|
(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/env/global-env typed-racket/env/type-alias-env
|
||||||
|
typed-racket/types/type-table)
|
||||||
#,(env-init-code syntax-provide? provide-tbl def-tbl)
|
#,(env-init-code syntax-provide? provide-tbl def-tbl)
|
||||||
#,(talias-env-init-code)
|
#,(talias-env-init-code)
|
||||||
#,(tname-env-init-code)
|
#,(tname-env-init-code)
|
||||||
|
|
|
@ -5,6 +5,7 @@
|
||||||
(for-syntax "utils/timing.rkt") ;; only for timing/debugging
|
(for-syntax "utils/timing.rkt") ;; only for timing/debugging
|
||||||
;; the below requires are needed since they provide identifiers
|
;; the below requires are needed since they provide identifiers
|
||||||
;; that may appear in the residual program
|
;; that may appear in the residual program
|
||||||
|
"utils/utils.rkt"
|
||||||
"utils/any-wrap.rkt" unstable/contract)
|
"utils/any-wrap.rkt" unstable/contract)
|
||||||
|
|
||||||
(provide (rename-out [module-begin #%module-begin]
|
(provide (rename-out [module-begin #%module-begin]
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(require syntax/id-table racket/dict racket/match mzlib/pconvert
|
(require syntax/id-table racket/dict racket/match mzlib/pconvert
|
||||||
"../utils/utils.rkt"
|
"../utils/utils.rkt" racket/syntax
|
||||||
"../utils/tc-utils.rkt"
|
"../utils/tc-utils.rkt"
|
||||||
(contract-req)
|
(contract-req)
|
||||||
(rep type-rep object-rep)
|
(rep type-rep object-rep)
|
||||||
|
@ -69,16 +69,13 @@
|
||||||
(define (make-struct-table-code)
|
(define (make-struct-table-code)
|
||||||
(parameterize ([current-print-convert-hook converter]
|
(parameterize ([current-print-convert-hook converter]
|
||||||
[show-sharing #f])
|
[show-sharing #f])
|
||||||
#`(when (unbox typed-context?)
|
(define/with-syntax (adds ...)
|
||||||
(define add! (dynamic-require 'typed-racket/types/type-table 'add-struct-fn!))
|
(for/list ([(k v) (in-dict struct-fn-table)]
|
||||||
#,@(for/list ([(k v) (in-dict struct-fn-table)]
|
#:when (bound-in-this-module k))
|
||||||
#:when (bound-in-this-module k))
|
(match v
|
||||||
(match v
|
[(list pe mut?)
|
||||||
[(list pe mut?)
|
#`(add-struct-fn! (quote-syntax #,k) #,(print-convert pe) #,mut?)])))
|
||||||
#`(add! (quote-syntax #,k)
|
#'(begin adds ...)))
|
||||||
#,(print-convert pe)
|
|
||||||
#,mut?)]))
|
|
||||||
(void))))
|
|
||||||
|
|
||||||
|
|
||||||
;; keeps track of expressions that always evaluate to true or always evaluate
|
;; keeps track of expressions that always evaluate to true or always evaluate
|
||||||
|
|
Loading…
Reference in New Issue
Block a user