suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Reduce requires.

Browse Source 
original commit: 9a15a1febbdf81916a2638146499c872f35a6659
This commit is contained in:
Sam Tobin-Hochstadt 2011-08-31 12:37:31 -04:00
parent a328126da4
commit 6247380066
16 changed files with 77 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/typed-scheme/base-env/annotate-classes.rkt
View File

@ -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

11
collects/typed-scheme/base-env/base-types-extra.rkt
View File

@ -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]
[-> →]

4
collects/typed-scheme/base-env/colon.rkt
View File

@ -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 :)

2
collects/typed-scheme/base-env/extra-procs.rkt
View File

@ -1,4 +1,4 @@
#lang scheme/base
#lang racket/base
(provide assert defined?)
(define-syntax assert

16
collects/typed-scheme/base-env/prims.rkt
View File

@ -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 ()

13
collects/typed-scheme/base-env/type-env-lang.rkt
View File

@ -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)))

7
collects/typed-scheme/env/init-envs.rkt vendored
View File

@ -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))

4
collects/typed-scheme/minimal.rkt
View File

@ -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)

20
collects/typed-scheme/rep/rep-utils.rkt
View File

@ -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))]))

13
collects/typed-scheme/typed-scheme.rkt
View File

@ -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)))

4
collects/typed-scheme/types/numeric-predicates.rkt
View File

@ -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)))

7
collects/typed-scheme/types/printer.rkt
View File

@ -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

4
collects/typed-scheme/types/type-table.rkt
View File

@ -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)))

10
collects/typed-scheme/types/union.rkt
View File

@ -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)])

6
collects/typed-scheme/utils/require-contract.rkt
View File

@ -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")))

28
collects/typed-scheme/utils/utils.rkt
View File

@ -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)]))