Significantly reduce dependencies.

In conjunction with a small change to syntax/parse, this means
that `typed/racket/base` no longer depends on `racket/set`,
`racket/contract/base`, or `racket/generic`.

Timings on my machine go from ~200ms for `#lang typed/racket/base`
as the whole file, to ~100ms. For comparison, `racket/base` is 30ms
and `#lang racket` is 150ms. `#lang typed/racket` is ~200ms with
this change.

Changes include:
 - not using `in-syntax`
 - switching to `syntax/parse/pre`
 - avoiding `template` from `syntax/parse`
This commit is contained in:
Sam Tobin-Hochstadt 2015-04-03 12:01:26 -04:00
parent 7b5478e0bc
commit 583ca906b3
13 changed files with 47 additions and 49 deletions

View File

@ -1,7 +1,6 @@
#lang racket/base
(require syntax/parse/pre
syntax/parse/experimental/template
"../private/parse-classes.rkt"
"../private/syntax-properties.rkt"
(for-label "colon.rkt"))
@ -275,7 +274,9 @@
#:attr opt-property
(list (length (attribute mand)) (length (attribute opt)))
#:attr erased
(template ((?@ . mand.form) ... (?@ . opt.form) ... . rest.form))))
(with-syntax ([((mand-form ...) ...) #'(mand.form ...)]
[((opt-form ...) ...) #'(opt.form ...)])
(syntax (mand-form ... ... opt-form ... ... . rest.form)))))
(define-syntax-class curried-formals
#:attributes (erased fun-name)

View File

@ -18,16 +18,17 @@
syntax/stx
racket/list
racket/syntax
unstable/sequence
unstable/syntax
racket/struct-info
syntax/struct
"../typecheck/internal-forms.rkt"
"annotate-classes.rkt"
"../private/parse-classes.rkt"
"../private/syntax-properties.rkt"
"../typecheck/internal-forms.rkt"))
(begin-for-syntax
(lazy-require [syntax/struct (build-struct-names)]))
(provide define-typed-struct -struct define-typed-struct/exec define-type-alias dtsi* dtsi/exec*)
(define-for-syntax (with-type* expr ty)

View File

@ -120,15 +120,11 @@ the typed racket language.
(for-syntax
racket/lazy-require
syntax/parse/pre
syntax/parse/experimental/template
syntax/stx
racket/list
racket/syntax
unstable/sequence
unstable/syntax
racket/base
racket/struct-info
syntax/struct
(only-in "../typecheck/internal-forms.rkt" internal)
"annotate-classes.rkt"
"../utils/literal-syntax-class.rkt"
@ -251,11 +247,11 @@ the typed racket language.
. rest)
(define/with-syntax (bn* ...)
;; singleton names go to just the name
(for/list ([bn (in-syntax #'(bn ...))])
(for/list ([bn (in-list (syntax->list #'(bn ...)))])
(if (empty? (stx-cdr bn))
(stx-car bn)
bn)))
(template ((-lambda (?@ . vars) (bn* ...) . rest) e ...))]
(quasisyntax/loc stx ((-lambda #,@(syntax vars) (bn* ...) . rest) e ...))]
[(-let . rest)
(syntax/loc stx (-let-internal . rest))]))
@ -269,10 +265,10 @@ the typed racket language.
(syntax-parse stx
[(_ ([pred? action] ...) . body)
(with-syntax ([(pred?* ...)
(for/list ([(pred? idx) (in-indexed (in-syntax #'(pred? ...)))])
(for/list ([(pred? idx) (in-indexed (syntax->list #'(pred? ...)))])
(exn-predicate-property pred? idx))]
[(action* ...)
(for/list ([(action idx) (in-indexed (in-syntax #'(action ...)))])
(for/list ([(action idx) (in-indexed (syntax->list #'(action ...)))])
(exn-handler-property action idx))]
[body* (exn-body #'(let-values () . body))])
(exn-handlers (quasisyntax/loc stx
@ -744,7 +740,7 @@ the typed racket language.
(syntax-parse rhs
#:literals (-lambda)
[(-lambda formals . others)
(template/loc stx (-lambda (?@ . vars) formals . others))]
(quasisyntax/loc stx (-lambda #,@(syntax vars) formals . others))]
[_ rhs]))
(quasisyntax/loc stx (define #,defined-id #,rhs*))]))

View File

@ -1,6 +1,6 @@
#lang racket/base
(require (for-syntax racket/base racket/lazy-require syntax/parse))
(require (for-syntax racket/base racket/lazy-require))
(begin-for-syntax
(lazy-require [(submod "." implementation)
@ -13,8 +13,9 @@
:type :print-type :query-type/args :query-type/result)
(define-for-syntax (fail _ stx)
(syntax-parse stx
[_:id
(syntax-case stx ()
[_
(identifier? stx)
(raise-syntax-error #f "must be applied to arguments" stx)]
[_ (raise-syntax-error #f "only valid at the top-level of an interaction" stx)]))

View File

@ -1,6 +1,6 @@
#lang racket/base
(require (for-syntax racket/base syntax/parse syntax/stx))
(require (for-syntax racket/base syntax/parse/pre syntax/stx))
(define-syntax (#%module-begin stx)
(syntax-parse stx #:literals (require)

View File

@ -1,6 +1,6 @@
#lang racket/base
(require syntax/parse
(require syntax/parse/pre
"../utils/literal-syntax-class.rkt"
(for-label "../base-env/base-types-extra.rkt"))
(provide star ddd ddd/bound omit-parens)

View File

@ -1,7 +1,7 @@
#lang racket/base
(require
syntax/parse
(for-syntax racket/base syntax/parse racket/syntax))
syntax/parse/pre
(for-syntax racket/base syntax/parse/pre racket/syntax))
(define-syntax define-matcher
(syntax-parser

View File

@ -12,9 +12,8 @@
;; submodule is again to avoid dependency.
(require
syntax/parse
(for-syntax racket/base racket/syntax
syntax/parse syntax/parse/experimental/template)
syntax/parse/pre
(for-syntax racket/base racket/syntax syntax/parse/pre)
(for-label racket/base) ;; used for identifier comparison only
(for-template racket/base))
@ -42,7 +41,7 @@
(begin
(provide nms ...)
(module* literal-set #f
(require syntax/parse)
(require syntax/parse/pre)
(provide set-name)
(define-literal-set set-name (nms ...)))
(define-syntax (nms stx)
@ -111,17 +110,18 @@
(syntax-parse stx
[(_ :clause ...)
(template
(begin
(begin
(define-syntax-class name
#:auto-nested-attributes
#:literal-sets ((internal-literals #:at name))
(pattern i:internal^ #:with (lit . body) #'i.value))
(define pred
(syntax-parser
[(~var _ name) #t]
[_ #f]))) ...))]))
(syntax
(begin
(begin
(define-syntax-class name
#:auto-nested-attributes
#:literal-sets ((internal-literals #:at name))
(pattern i:internal^ #:with (lit . body) #'i.value))
(define pred
(syntax-parser
[(~var _ name) #t]
[_ #f])))
...))]))
(define-internal-classes

View File

@ -4,7 +4,7 @@
(for-syntax racket/base racket/lazy-require
"standard-inits.rkt")
;; these need to be available to the generated code
"typecheck/renamer.rkt"
"typecheck/renamer.rkt" syntax/location
(for-syntax (submod "base-env/prims-contract.rkt" self-ctor))
(for-syntax "utils/struct-extraction.rkt")
(for-syntax "typecheck/renamer.rkt")

View File

@ -1,14 +1,12 @@
#lang racket/base
(require
"../utils/utils.rkt"
syntax/parse
(utils tc-utils)
"../utils/utils.rkt" "../utils/disappeared-use.rkt"
syntax/parse/pre
(for-syntax
racket/base
racket/syntax
syntax/parse
unstable/sequence))
syntax/parse/pre))
(provide define-literal-syntax-class)
@ -29,7 +27,7 @@
(λ (sym) (introducer (datum->syntax #f sym)))))
(define/with-syntax literal-set (add-context 'lit-set))
(define/with-syntax (pattern-literals ...)
(for/list ([_ (in-syntax #'(literals ...))]
(for/list ([_ (in-list (syntax->list #'(literals ...)))]
[n (in-naturals)])
(add-context (string->symbol (format "pat~a" n)))))
#'(begin

View File

@ -1,6 +1,6 @@
#lang racket/base
(require syntax/modcollapse (for-template racket/base))
(require syntax/private/modcollapse-noctc (for-template racket/base))
(provide make-make-redirect-to-contract)
;; This is used to define identifiers that expand to a local-require

View File

@ -6,9 +6,10 @@ don't depend on any other portion of the system
|#
(require syntax/source-syntax "disappeared-use.rkt"
racket/promise racket/string
syntax/parse/pre (for-syntax racket/base syntax/parse/pre)
(only-in unstable/sequence in-slice))
racket/promise racket/string racket/lazy-require
syntax/parse/pre (for-syntax racket/base syntax/parse/pre))
(lazy-require [unstable/sequence (in-slice)])
(provide ;; parameters
current-orig-stx

View File

@ -5,7 +5,7 @@ This file is for utilities that are of general interest,
at least theoretically.
|#
(require (for-syntax racket/base syntax/parse racket/string unstable/sequence)
(require (for-syntax racket/base syntax/parse/pre racket/string)
racket/require-syntax racket/provide-syntax
racket/struct-info "timing.rkt")
@ -42,7 +42,7 @@ at least theoretically.
(syntax-parse stx
[(form id:identifier ...)
(with-syntax ([(id* ...)
(for/list ([id (in-syntax #'(id ...))])
(for/list ([id (syntax->list #'(id ...))])
(datum->syntax
id
`(lib
@ -62,7 +62,7 @@ at least theoretically.
(syntax-parse stx
[(_ id:identifier ...)
(with-syntax ([(id* ...)
(for/list ([id (in-syntax #'(id ...))])
(for/list ([id (syntax->list #'(id ...))])
(datum->syntax
id
`(lib