From 6247380066a1191aa6a730364ad933279d8ff722 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 31 Aug 2011 12:37:31 -0400 Subject: [PATCH] Reduce requires. original commit: 9a15a1febbdf81916a2638146499c872f35a6659 --- .../base-env/annotate-classes.rkt | 5 ++-- .../base-env/base-types-extra.rkt | 11 ++------ collects/typed-scheme/base-env/colon.rkt | 4 +-- .../typed-scheme/base-env/extra-procs.rkt | 2 +- collects/typed-scheme/base-env/prims.rkt | 16 ++++++----- .../typed-scheme/base-env/type-env-lang.rkt | 13 ++++----- collects/typed-scheme/env/init-envs.rkt | 7 ++--- collects/typed-scheme/minimal.rkt | 4 +-- collects/typed-scheme/rep/rep-utils.rkt | 20 ++++++------- collects/typed-scheme/typed-scheme.rkt | 13 +++++---- .../typed-scheme/types/numeric-predicates.rkt | 4 +-- collects/typed-scheme/types/printer.rkt | 7 ++--- collects/typed-scheme/types/type-table.rkt | 4 ++- collects/typed-scheme/types/union.rkt | 10 ++++--- .../typed-scheme/utils/require-contract.rkt | 6 ++-- collects/typed-scheme/utils/utils.rkt | 28 +++++++++++-------- 16 files changed, 77 insertions(+), 77 deletions(-) diff --git a/collects/typed-scheme/base-env/annotate-classes.rkt b/collects/typed-scheme/base-env/annotate-classes.rkt index 7ef0a813..515d23da 100644 --- a/collects/typed-scheme/base-env/annotate-classes.rkt +++ b/collects/typed-scheme/base-env/annotate-classes.rkt @@ -1,6 +1,7 @@ -#lang scheme/base +#lang racket/base -(require syntax/parse "colon.rkt" (for-template "colon.rkt") "../private/parse-type.rkt") +(require syntax/parse "../private/parse-classes.rkt" + (for-template "colon.rkt")) (provide (all-defined-out)) (define-splicing-syntax-class annotated-name diff --git a/collects/typed-scheme/base-env/base-types-extra.rkt b/collects/typed-scheme/base-env/base-types-extra.rkt index f3b412e3..f686e74b 100644 --- a/collects/typed-scheme/base-env/base-types-extra.rkt +++ b/collects/typed-scheme/base-env/base-types-extra.rkt @@ -1,6 +1,6 @@ -#lang scheme/base +#lang racket/base -(require (for-syntax scheme/base)) +(require (for-syntax racket/base)) (define-syntax (define-other-types stx) (syntax-case stx () @@ -12,15 +12,10 @@ ;; special type names that are not bound to particular types (define-other-types - #;-> case-> U Rec All Opaque Vector + -> case-> U Rec All Opaque Vector Parameterof List List* Class Values Instance Refinement pred) -(define-syntax -> - (lambda (stx) - (raise-syntax-error 'type-check "type name used out of context" stx))) -(provide ->) - (provide (rename-out [All ∀] [U Un] [-> →] diff --git a/collects/typed-scheme/base-env/colon.rkt b/collects/typed-scheme/base-env/colon.rkt index cef4b4eb..fb8bdaff 100644 --- a/collects/typed-scheme/base-env/colon.rkt +++ b/collects/typed-scheme/base-env/colon.rkt @@ -2,9 +2,7 @@ (require (for-syntax scheme/base syntax/parse "internal.rkt") "../typecheck/internal-forms.rkt" - (prefix-in t: "base-types-extra.rkt") - (for-template (prefix-in t: "base-types-extra.rkt")) - (for-syntax (prefix-in t: "base-types-extra.rkt"))) + (prefix-in t: "base-types-extra.rkt")) (provide :) diff --git a/collects/typed-scheme/base-env/extra-procs.rkt b/collects/typed-scheme/base-env/extra-procs.rkt index 09381252..c04ea1c3 100644 --- a/collects/typed-scheme/base-env/extra-procs.rkt +++ b/collects/typed-scheme/base-env/extra-procs.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (provide assert defined?) (define-syntax assert diff --git a/collects/typed-scheme/base-env/prims.rkt b/collects/typed-scheme/base-env/prims.rkt index e5762a38..a1088ef8 100644 --- a/collects/typed-scheme/base-env/prims.rkt +++ b/collects/typed-scheme/base-env/prims.rkt @@ -31,7 +31,7 @@ This file defines two sorts of primitives. All of them are provided into any mod (require "../utils/require-contract.rkt" "colon.rkt" "../typecheck/internal-forms.rkt" - (rename-in racket/contract [-> c->] [case-> c:case->]) + (rename-in racket/contract/base [-> c->] [case-> c:case->]) "base-types.rkt" "base-types-extra.rkt" racket/flonum ; for for/flvector and for*/flvector @@ -42,20 +42,22 @@ This file defines two sorts of primitives. All of them are provided into any mod racket/base racket/struct-info syntax/struct - "../rep/type-rep.rkt" - "../private/parse-type.rkt" + "../rep/type-rep.rkt" "annotate-classes.rkt" "internal.rkt" "../utils/tc-utils.rkt" - "../env/type-name-env.rkt" - "../private/type-contract.rkt" - "for-clauses.rkt" - "../types/utils.rkt") + "../env/type-name-env.rkt" + "for-clauses.rkt") "../types/numeric-predicates.rkt") (provide index?) ; useful for assert, and racket doesn't have it (define-for-syntax (ignore stx) (syntax-property stx 'typechecker:ignore #t)) +;; dynamically loaded b/c they're only used at the top-level, so we save a lot +;; of loading by not having them when we're in a module +(define-for-syntax (parse-type stx) ((dynamic-require 'typed-scheme/private/parse-type 'parse-type) stx)) +(define-for-syntax (type->contract stx) ((dynamic-require 'typed-scheme/private/type-contract 'type->contract) stx)) + (define-syntaxes (require/typed-legacy require/typed) (let () diff --git a/collects/typed-scheme/base-env/type-env-lang.rkt b/collects/typed-scheme/base-env/type-env-lang.rkt index 074080c1..45273846 100644 --- a/collects/typed-scheme/base-env/type-env-lang.rkt +++ b/collects/typed-scheme/base-env/type-env-lang.rkt @@ -1,9 +1,8 @@ -#lang scheme/base +#lang racket/base -(require "../utils/utils.rkt") - -(require (for-syntax (env init-envs) - scheme/base syntax/parse +(require "../utils/utils.rkt" + (for-syntax (env init-envs) + racket/base syntax/parse (except-in (rep filter-rep type-rep) make-arr) (rename-in (types union convenience) [make-arr* make-arr]))) @@ -24,8 +23,8 @@ (provide #%module-begin require - (all-from-out scheme/base) + (all-from-out racket/base) (for-syntax (types-out convenience union) (rep-out type-rep) - (all-from-out scheme/base))) + (all-from-out racket/base))) diff --git a/collects/typed-scheme/env/init-envs.rkt b/collects/typed-scheme/env/init-envs.rkt index ab2be099..0ccbb511 100644 --- a/collects/typed-scheme/env/init-envs.rkt +++ b/collects/typed-scheme/env/init-envs.rkt @@ -1,16 +1,15 @@ -#lang scheme/base +#lang racket/base (provide (all-defined-out)) (require "../utils/utils.rkt" "global-env.rkt" "type-name-env.rkt" "type-alias-env.rkt" - unstable/struct racket/dict (rep type-rep object-rep filter-rep rep-utils) (for-template (rep type-rep object-rep filter-rep) (types union) - mzlib/pconvert mzlib/shared scheme/base) + racket/shared racket/base) (types union convenience) - mzlib/pconvert racket/match mzlib/shared) + mzlib/pconvert racket/match) (define (initialize-type-name-env initial-type-names) (for-each (lambda (nm/ty) (register-resolved-type-alias (car nm/ty) (cadr nm/ty))) initial-type-names)) diff --git a/collects/typed-scheme/minimal.rkt b/collects/typed-scheme/minimal.rkt index b3a9ef68..837344a9 100644 --- a/collects/typed-scheme/minimal.rkt +++ b/collects/typed-scheme/minimal.rkt @@ -1,9 +1,9 @@ -#lang scheme/base +#lang racket/base (provide #%module-begin provide require rename-in rename-out prefix-in only-in all-from-out except-out except-in providing begin subtract-in) -(require (for-syntax scheme/base) scheme/require) +(require (for-syntax racket/base) racket/require) (define-for-syntax ts-mod 'typed-scheme/typed-scheme) diff --git a/collects/typed-scheme/rep/rep-utils.rkt b/collects/typed-scheme/rep/rep-utils.rkt index c23a3a07..70ab968d 100644 --- a/collects/typed-scheme/rep/rep-utils.rkt +++ b/collects/typed-scheme/rep/rep-utils.rkt @@ -1,23 +1,19 @@ -#lang scheme/base -(require "../utils/utils.rkt") - -(require mzlib/pconvert +#lang racket/base +(require "../utils/utils.rkt" + mzlib/pconvert racket/match "free-variance.rkt" "interning.rkt" unstable/match unstable/struct racket/stxparam - scheme/contract (for-syntax - scheme/list - (only-in racket/syntax generate-temporary) racket/match (except-in syntax/parse id identifier keyword) - scheme/base + racket/base syntax/struct - scheme/contract + racket/contract racket/syntax - (rename-in (except-in (utils utils stxclass-util) bytes byte-regexp regexp byte-pregexp pregexp) + (rename-in (except-in (utils stxclass-util) bytes byte-regexp regexp byte-pregexp pregexp) [id* id] [keyword* keyword]))) @@ -155,7 +151,7 @@ (with-syntax ;; makes as many underscores as default fields (+1 for key? if provided) ([(ign-pats ...) (let loop ([fs default-fields]) - (if (empty? fs) + (if (null? fs) (key->list key? #'_) (cons #'_ (loop (cdr fs)))))] ;; has to be down here to refer to #'contract @@ -239,7 +235,7 @@ #,(body-f)))])) (define (no-duplicates? lst) - (cond [(empty? lst) #t] + (cond [(null? lst) #t] [(member (car lst) (cdr lst)) #f] [else (no-duplicates? (cdr lst))])) diff --git a/collects/typed-scheme/typed-scheme.rkt b/collects/typed-scheme/typed-scheme.rkt index a60231ad..f0e8165d 100644 --- a/collects/typed-scheme/typed-scheme.rkt +++ b/collects/typed-scheme/typed-scheme.rkt @@ -1,10 +1,11 @@ #lang racket/base -(require (for-syntax racket/base - "utils/utils.rkt" ;; only for timing/debugging - ;; these requires are needed since their code - ;; appears in the residual program - "typecheck/renamer.rkt" "types/type-table.rkt")) +(require + (for-syntax racket/base "utils/utils.rkt") ;; only for timing/debugging + ;; the below requires are needed since they provide identifiers + ;; that may appear in the residual program + (for-syntax "typecheck/renamer.rkt" "types/type-table.rkt") + "utils/any-wrap.rkt" unstable/contract) (provide (rename-out [module-begin #%module-begin] [top-interaction #%top-interaction] @@ -26,7 +27,7 @@ (do-time "Finshed base-env") ((dynamic-require 'typed-scheme/base-env/base-env-numeric 'init)) (do-time "Finshed base-env-numeric") - ((dynamic-require 'typed-scheme/base-env/base-special-env 'initialize-special)) + ((dynamic-require 'typed-scheme/base-env/base-special-env 'initialize-special)) (do-time "Finished base-special-env") (set! initialized #t))) diff --git a/collects/typed-scheme/types/numeric-predicates.rkt b/collects/typed-scheme/types/numeric-predicates.rkt index 4224f3e3..5e38bded 100644 --- a/collects/typed-scheme/types/numeric-predicates.rkt +++ b/collects/typed-scheme/types/numeric-predicates.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require unstable/function racket/unsafe/ops) +(require racket/unsafe/ops) (provide index? exact-rational?) @@ -11,4 +11,4 @@ ;; we're safe from fixnum size issues on different platforms. (define (index? x) (and (fixnum? x) (unsafe-fx>= x 0) (fixnum? (* x 4)))) -(define exact-rational? (conjoin rational? exact?)) +(define (exact-rational? x) (and (rational? x) (exact? x))) diff --git a/collects/typed-scheme/types/printer.rkt b/collects/typed-scheme/types/printer.rkt index 0a525c6e..d05033c6 100644 --- a/collects/typed-scheme/types/printer.rkt +++ b/collects/typed-scheme/types/printer.rkt @@ -1,7 +1,6 @@ -#lang scheme/base +#lang racket/base -(require racket/require racket/match racket/list racket/string - unstable/sequence +(require racket/require racket/match unstable/sequence (prefix-in s: srfi/1) (path-up "rep/type-rep.rkt" "rep/filter-rep.rkt" "rep/object-rep.rkt" "rep/rep-utils.rkt" "types/abbrev.rkt" "types/subtype.rkt" @@ -173,7 +172,7 @@ [(list a b ...) (format "(case-lambda ~a~a)" (format-arr a) - (string-append* (map format-arr b)))]))])) + (apply string-append (map format-arr b)))]))])) ;; print out a type ;; print-type : Type Port Boolean -> Void diff --git a/collects/typed-scheme/types/type-table.rkt b/collects/typed-scheme/types/type-table.rkt index f1bbc576..5b19d7f8 100644 --- a/collects/typed-scheme/types/type-table.rkt +++ b/collects/typed-scheme/types/type-table.rkt @@ -1,12 +1,14 @@ #lang racket/base -(require racket/contract syntax/id-table racket/dict racket/match mzlib/pconvert +(require syntax/id-table racket/dict racket/match mzlib/pconvert "../utils/utils.rkt" + (contract-req) (rep type-rep object-rep) (only-in (types utils) tc-results?) (utils tc-utils) (env init-envs)) + (define table (make-hasheq)) (define (reset-type-table) (set! table (make-hasheq))) diff --git a/collects/typed-scheme/types/union.rkt b/collects/typed-scheme/types/union.rkt index e62fef13..8a47bf1b 100644 --- a/collects/typed-scheme/types/union.rkt +++ b/collects/typed-scheme/types/union.rkt @@ -1,12 +1,14 @@ -#lang scheme/base +#lang racket/base (require "../utils/utils.rkt" (rep type-rep rep-utils) - (utils tc-utils) - (prefix-in c: racket/contract) - (types utils subtype abbrev printer comparison) + (utils tc-utils) + (contract-req) + (types utils subtype abbrev printer comparison) racket/match) + + (provide/cond-contract [Un (() #:rest (c:listof Type/c) . c:->* . Type/c)]) diff --git a/collects/typed-scheme/utils/require-contract.rkt b/collects/typed-scheme/utils/require-contract.rkt index 4b0dec25..e39a261e 100644 --- a/collects/typed-scheme/utils/require-contract.rkt +++ b/collects/typed-scheme/utils/require-contract.rkt @@ -1,8 +1,8 @@ -#lang scheme/base +#lang racket/base -(require scheme/contract +(require racket/contract/region racket/contract/base syntax/location - (for-syntax scheme/base + (for-syntax racket/base syntax/parse (prefix-in tr: "../private/typed-renaming.rkt"))) diff --git a/collects/typed-scheme/utils/utils.rkt b/collects/typed-scheme/utils/utils.rkt index 5c3f2fc6..d1f078ad 100644 --- a/collects/typed-scheme/utils/utils.rkt +++ b/collects/typed-scheme/utils/utils.rkt @@ -6,9 +6,9 @@ at least theoretically. |# (require (for-syntax racket/base syntax/parse racket/string) - racket/contract/base racket/require-syntax - racket/provide-syntax racket/unit (prefix-in d: unstable/debug) - racket/struct-info racket/pretty mzlib/pconvert syntax/parse) + racket/require-syntax racket/unit + racket/provide-syntax (prefix-in d: unstable/debug) + racket/struct-info) ;; to move to unstable (provide reverse-begin list-update list-set debugf debugging? dprintf) @@ -27,6 +27,13 @@ at least theoretically. (define optimize? (make-parameter #t)) (define-for-syntax enable-contracts? #f) + +(define-syntax do-contract-req + (if enable-contracts? + (syntax-rules () [(_) (require racket/contract/base)]) + (syntax-rules () [(_) (begin)]))) +(do-contract-req) + (define show-input? (make-parameter #f)) ;; fancy require syntax @@ -152,13 +159,6 @@ at least theoretically. print-type* print-filter* print-latentfilter* print-object* print-latentobject* print-pathelem*) -(define (pseudo-printer s port mode) - (parameterize ([current-output-port port] - [show-sharing #f] - [booleans-as-true/false #f] - [constructor-style-printing #t]) - (pretty-print (print-convert s)))) - (define custom-printer (make-parameter #t)) (define-syntax (define-struct/printer stx) @@ -167,7 +167,13 @@ at least theoretically. #`(define-struct name (flds ...) #:property prop:custom-print-quotable 'never #:property prop:custom-write - (lambda (a b c) (if (custom-printer) (printer a b c) (pseudo-printer a b c))) + (lambda (a b c) (if (custom-printer) + (printer a b c) + ;; ok to make this case slow, it never runs in real code + ((if c + (dynamic-require 'racket/pretty 'pretty-write) + (dynamic-require 'racket/pretty 'pretty-print)) + a b))) #:transparent)]))