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

Lots more laziness, and useless require removal.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-09-08 19:27:07 -04:00
parent de0e8bc81c
commit b6b840076b
65 changed files with 204 additions and 223 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
View File

@ -3,9 +3,9 @@
(require "test-utils.ss" (require "test-utils.ss"
(for-syntax scheme/base) (for-syntax scheme/base)
(for-template scheme/base)) (for-template scheme/base))
(require (private base-env prims type-annotation (require (private #;base-env prims type-annotation
base-types-extra base-types-extra
base-env-numeric #;base-env-numeric
base-env-indexing base-env-indexing
parse-type) parse-type)
(typecheck typechecker) (typecheck typechecker)
@ -24,10 +24,10 @@
(for-syntax (utils tc-utils) (for-syntax (utils tc-utils)
(typecheck typechecker) (typecheck typechecker)
(env global-env) (env global-env)
(private base-env base-env-numeric (private #;base-env #;base-env-numeric
base-env-indexing)) base-env-indexing))
(for-template (private base-env base-types base-types-extra (for-template (private #;base-env base-types base-types-extra
base-env-numeric #;base-env-numeric
base-env-indexing)) base-env-indexing))
(for-syntax syntax/kerncase syntax/parse)) (for-syntax syntax/kerncase syntax/parse))

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

@ -10,7 +10,7 @@
(types union) (types union)
mzlib/pconvert mzlib/shared scheme/base) mzlib/pconvert mzlib/shared scheme/base)
(types union convenience) (types union convenience)
mzlib/pconvert scheme/match mzlib/shared) mzlib/pconvert racket/match mzlib/shared)
(define (initialize-type-name-env initial-type-names) (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)) (for-each (lambda (nm/ty) (register-resolved-type-alias (car nm/ty) (cadr nm/ty))) initial-type-names))

2
collects/typed-scheme/env/type-alias-env.rkt vendored
View File

@ -4,7 +4,7 @@
syntax/boundmap syntax/boundmap
(utils tc-utils) (utils tc-utils)
mzlib/trace mzlib/trace
scheme/match) racket/match)
(provide register-type-alias (provide register-type-alias
lookup-type-alias lookup-type-alias

2
collects/typed-scheme/env/type-env-structs.rkt vendored
View File

@ -2,7 +2,7 @@
(require scheme/contract unstable/sequence racket/dict syntax/id-table (require scheme/contract unstable/sequence racket/dict syntax/id-table
(prefix-in r: "../utils/utils.rkt") (prefix-in r: "../utils/utils.rkt")
scheme/match (r:rep filter-rep rep-utils type-rep) unstable/struct racket/match (r:rep filter-rep rep-utils type-rep) unstable/struct
(except-in (r:utils tc-utils) make-env)) (except-in (r:utils tc-utils) make-env))
(provide extend (provide extend

2
collects/typed-scheme/infer/constraint-structs.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base #lang scheme/base
(require "../utils/utils.rkt" (rep type-rep) scheme/contract scheme/match (for-syntax scheme/base syntax/parse)) (require "../utils/utils.rkt" (rep type-rep) scheme/contract racket/match (for-syntax scheme/base syntax/parse))
;; S, T types ;; S, T types
;; X a var ;; X a var

2
collects/typed-scheme/infer/constraints.rkt
View File

@ -6,7 +6,7 @@
(utils tc-utils) (utils tc-utils)
unstable/sequence unstable/hash unstable/sequence unstable/hash
"signatures.rkt" "constraint-structs.rkt" "signatures.rkt" "constraint-structs.rkt"
scheme/match) racket/match)
(import restrict^ dmap^) (import restrict^ dmap^)
(export constraints^) (export constraints^)

2
collects/typed-scheme/infer/dmap.rkt
View File

@ -3,7 +3,7 @@
(require "../utils/utils.rkt" (require "../utils/utils.rkt"
"signatures.rkt" "constraint-structs.rkt" "signatures.rkt" "constraint-structs.rkt"
(utils tc-utils) racket/contract (utils tc-utils) racket/contract
unstable/sequence unstable/hash scheme/match) unstable/sequence unstable/hash racket/match)
(import constraints^) (import constraints^)
(export dmap^) (export dmap^)

8
collects/typed-scheme/infer/infer-unit.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/unit #lang racket/unit
(require scheme/require (path-up "utils/utils.rkt") (require racket/require (path-up "utils/utils.rkt")
(except-in (except-in
(combine-in (combine-in
(utils tc-utils) (utils tc-utils)
@ -11,11 +11,11 @@
make-env -> ->* one-of/c) make-env -> ->* one-of/c)
"constraint-structs.rkt" "constraint-structs.rkt"
"signatures.rkt" "signatures.rkt"
scheme/match racket/match
mzlib/etc mzlib/etc
racket/trace racket/contract racket/trace racket/contract
unstable/sequence unstable/list unstable/debug unstable/hash unstable/sequence unstable/list unstable/debug unstable/hash
scheme/list) racket/list)
(import dmap^ constraints^ promote-demote^) (import dmap^ constraints^ promote-demote^)
(export infer^) (export infer^)

2
collects/typed-scheme/infer/promote-demote.rkt
View File

@ -4,7 +4,7 @@
(require (rep type-rep rep-utils) (require (rep type-rep rep-utils)
(types convenience union utils) (types convenience union utils)
"signatures.rkt" "signatures.rkt"
scheme/list scheme/match) scheme/list racket/match)
(import) (import)
(export promote-demote^) (export promote-demote^)

2
collects/typed-scheme/infer/restrict.rkt
View File

@ -4,7 +4,7 @@
(require (rep type-rep) (require (rep type-rep)
(types utils union subtype remove-intersect resolve substitute) (types utils union subtype remove-intersect resolve substitute)
"signatures.rkt" "signatures.rkt"
scheme/match mzlib/trace) racket/match mzlib/trace)
(import infer^) (import infer^)
(export restrict^) (export restrict^)

2
collects/typed-scheme/optimizer/apply.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang scheme/base
(require syntax/parse (require syntax/parse
syntax/id-table racket/dict syntax/id-table racket/dict
unstable/match scheme/match unstable/match racket/match
(for-template scheme/unsafe/ops racket/base (prefix-in k: '#%kernel)) (for-template scheme/unsafe/ops racket/base (prefix-in k: '#%kernel))
(for-syntax racket/base) (for-syntax racket/base)
"../utils/utils.rkt" "../utils/utils.rkt"

2
collects/typed-scheme/optimizer/box.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang scheme/base
(require syntax/parse (require syntax/parse
unstable/match scheme/match unstable/match racket/match
"../utils/utils.rkt" "../utils/utils.rkt"
(for-template scheme/base scheme/fixnum scheme/unsafe/ops) (for-template scheme/base scheme/fixnum scheme/unsafe/ops)
(rep type-rep) (rep type-rep)

4
collects/typed-scheme/optimizer/float.rkt
View File

@ -1,8 +1,8 @@
#lang scheme/base #lang scheme/base
(require syntax/parse (require syntax/parse
syntax/id-table racket/dict scheme/flonum syntax/id-table racket/dict racket/flonum
(for-template scheme/base scheme/flonum scheme/unsafe/ops) (for-template scheme/base racket/flonum scheme/unsafe/ops)
"../utils/utils.rkt" "../utils/utils.rkt"
(types abbrev type-table utils subtype) (types abbrev type-table utils subtype)
(optimizer utils fixnum)) (optimizer utils fixnum))

2
collects/typed-scheme/optimizer/inexact-complex.rkt
View File

@ -2,7 +2,7 @@
(require syntax/parse syntax/id-table scheme/dict (require syntax/parse syntax/id-table scheme/dict
"../utils/utils.rkt" racket/unsafe/ops "../utils/utils.rkt" racket/unsafe/ops
(for-template scheme/base scheme/math scheme/flonum scheme/unsafe/ops) (for-template scheme/base scheme/math racket/flonum scheme/unsafe/ops)
(types abbrev type-table utils subtype) (types abbrev type-table utils subtype)
(optimizer utils float fixnum)) (optimizer utils float fixnum))

2
collects/typed-scheme/optimizer/number.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang scheme/base
(require syntax/parse (require syntax/parse
(for-template scheme/base scheme/flonum scheme/unsafe/ops) (for-template scheme/base racket/flonum scheme/unsafe/ops)
"../utils/utils.rkt" "../utils/utils.rkt"
(optimizer utils)) (optimizer utils))

2
collects/typed-scheme/optimizer/optimizer.rkt
View File

@ -4,7 +4,7 @@
syntax/id-table racket/dict syntax/id-table racket/dict
racket/pretty racket/pretty
(for-template scheme/base (for-template scheme/base
scheme/flonum scheme/fixnum scheme/unsafe/ops racket/flonum scheme/fixnum scheme/unsafe/ops
racket/private/for) racket/private/for)
"../utils/utils.rkt" "../utils/utils.rkt"
(types abbrev type-table utils subtype) (types abbrev type-table utils subtype)

2
collects/typed-scheme/optimizer/pair.rkt
View File

@ -2,7 +2,7 @@
(require syntax/parse (require syntax/parse
syntax/id-table racket/dict syntax/id-table racket/dict
unstable/match scheme/match unstable/match racket/match
(for-template scheme/base scheme/unsafe/ops) (for-template scheme/base scheme/unsafe/ops)
"../utils/utils.rkt" "../utils/utils.rkt"
(rep type-rep) (rep type-rep)

2
collects/typed-scheme/optimizer/sequence.rkt
View File

@ -2,7 +2,7 @@
(require syntax/parse (require syntax/parse
syntax/id-table racket/dict syntax/id-table racket/dict
unstable/match scheme/match unstable/match racket/match
(for-template scheme/base scheme/unsafe/ops) (for-template scheme/base scheme/unsafe/ops)
"../utils/utils.rkt" "../utils/tc-utils.rkt" "../utils/utils.rkt" "../utils/tc-utils.rkt"
(rep type-rep) (rep type-rep)

2
collects/typed-scheme/optimizer/string.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang scheme/base
(require syntax/parse (require syntax/parse
(for-template scheme/base scheme/flonum scheme/unsafe/ops) (for-template scheme/base racket/flonum scheme/unsafe/ops)
"../utils/utils.rkt" "../utils/utils.rkt"
(types abbrev type-table utils subtype) (types abbrev type-table utils subtype)
(optimizer utils)) (optimizer utils))

2
collects/typed-scheme/optimizer/struct.rkt
View File

@ -2,7 +2,7 @@
(require syntax/parse (require syntax/parse
syntax/id-table racket/dict syntax/id-table racket/dict
unstable/match scheme/match unstable/match racket/match
(for-template scheme/base scheme/unsafe/ops) (for-template scheme/base scheme/unsafe/ops)
"../utils/utils.rkt" "../utils/utils.rkt"
(rep type-rep) (rep type-rep)

2
collects/typed-scheme/optimizer/unboxed-let.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang scheme/base
(require syntax/parse (require syntax/parse
scheme/list scheme/dict scheme/match scheme/list scheme/dict racket/match
"../utils/utils.rkt" "../utils/utils.rkt"
"../utils/tc-utils.rkt" "../utils/tc-utils.rkt"
(for-template scheme/base) (for-template scheme/base)

4
collects/typed-scheme/optimizer/utils.rkt
View File

@ -1,8 +1,8 @@
#lang scheme/base #lang scheme/base
(require unstable/match scheme/match (require unstable/match racket/match
racket/dict syntax/id-table unstable/syntax racket/dict syntax/id-table unstable/syntax
(for-template scheme/base scheme/flonum scheme/fixnum scheme/unsafe/ops) (for-template scheme/base racket/flonum scheme/fixnum scheme/unsafe/ops)
"../utils/utils.rkt" "../utils/utils.rkt"
(types abbrev type-table utils subtype) (types abbrev type-table utils subtype)
(rep type-rep)) (rep type-rep))

4
collects/typed-scheme/optimizer/vector.rkt
View File

@ -1,8 +1,8 @@
#lang scheme/base #lang scheme/base
(require syntax/parse (require syntax/parse
unstable/match scheme/match unstable/match racket/match
(for-template scheme/base scheme/flonum scheme/unsafe/ops) (for-template scheme/base racket/flonum scheme/unsafe/ops)
"../utils/utils.rkt" "../utils/utils.rkt"
(rep type-rep) (rep type-rep)
(types abbrev type-table utils subtype) (types abbrev type-table utils subtype)

25
collects/typed-scheme/private/base-env-indexing-abs.rkt
View File

@ -1,18 +1,19 @@
#lang racket #lang racket
(require (require
"../utils/utils.rkt" "../utils/utils.rkt"
racket/tcp (for-template '#%paramz racket/base racket/list
(only-in rnrs/lists-6 fold-left) racket/tcp
'#%paramz (only-in rnrs/lists-6 fold-left)
"extra-procs.rkt" '#%paramz
(utils tc-utils ) "extra-procs.rkt"
(types union convenience) (only-in '#%kernel [apply kernel:apply])
(only-in '#%kernel [apply kernel:apply]) racket/promise racket/system
racket/promise racket/system (only-in string-constants/private/only-once maybe-print-message)
(only-in string-constants/private/only-once maybe-print-message) (only-in racket/match/runtime match:error matchable? match-equality-test)
(only-in racket/match/runtime match:error matchable? match-equality-test) racket/unsafe/ops)
(for-template racket racket/unsafe/ops) (utils tc-utils)
(types union convenience)
(rename-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym])) (rename-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym]))
(provide indexing) (provide indexing)

73
collects/typed-scheme/private/base-env-numeric.rkt
View File

@ -2,24 +2,15 @@
(begin (begin
(require (require
scheme/tcp (for-template racket/flonum racket/fixnum racket/math racket/unsafe/ops racket/base)
scheme scheme/flonum scheme/fixnum (only-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym] [-Real R] [-ExactPositiveInteger -Pos]))
scheme/unsafe/ops
(only-in rnrs/lists-6 fold-left)
'#%paramz
"extra-procs.rkt"
(only-in '#%kernel [apply kernel:apply])
scheme/promise scheme/system
(only-in string-constants/private/only-once maybe-print-message)
(only-in racket/match/runtime match:error matchable? match-equality-test)
(for-syntax (only-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym] [-Real R] [-ExactPositiveInteger -Pos])))
(define-for-syntax all-num-types (list -Pos -Nat -Integer -ExactRational -Flonum -Real N)) (define all-num-types (list -Pos -Nat -Integer -ExactRational -Flonum -Real N))
(define-for-syntax binop (define binop
(lambda (t [r t]) (lambda (t [r t])
(t t . -> . r))) (t t . -> . r)))
(define-for-syntax rounder (define rounder
(cl->* (-> -PositiveFixnum -PositiveFixnum) (cl->* (-> -PositiveFixnum -PositiveFixnum)
(-> -NonnegativeFixnum -NonnegativeFixnum) (-> -NonnegativeFixnum -NonnegativeFixnum)
(-> -Fixnum -Fixnum) (-> -Fixnum -Fixnum)
@ -30,37 +21,37 @@
(-> -Flonum -Flonum) (-> -Flonum -Flonum)
(-> -Real -Real))) (-> -Real -Real)))
(define-for-syntax (unop t) (-> t t)) (define (unop t) (-> t t))
(define-for-syntax fl-comp (binop -Flonum B)) (define fl-comp (binop -Flonum B))
(define-for-syntax fl-op (binop -Flonum)) (define fl-op (binop -Flonum))
(define-for-syntax fl-unop (unop -Flonum)) (define fl-unop (unop -Flonum))
(define-for-syntax fl-rounder (define fl-rounder
(cl->* (-> -NonnegativeFlonum -NonnegativeFlonum) (cl->* (-> -NonnegativeFlonum -NonnegativeFlonum)
(-> -Flonum -Flonum))) (-> -Flonum -Flonum)))
(define-for-syntax int-op (binop -Integer)) (define int-op (binop -Integer))
(define-for-syntax nat-op (binop -Nat)) (define nat-op (binop -Nat))
(define-for-syntax fx-comp (binop -Integer B)) (define fx-comp (binop -Integer B))
(define-for-syntax fx-op (cl->* (-Pos -Pos . -> . -PositiveFixnum) (define fx-op (cl->* (-Pos -Pos . -> . -PositiveFixnum)
(-Nat -Nat . -> . -NonnegativeFixnum) (-Nat -Nat . -> . -NonnegativeFixnum)
(-Integer -Integer . -> . -Fixnum))) (-Integer -Integer . -> . -Fixnum)))
(define-for-syntax fx-natop (cl->* (-Nat -Nat . -> . -NonnegativeFixnum) (define fx-natop (cl->* (-Nat -Nat . -> . -NonnegativeFixnum)
(-Integer -Integer . -> . -Fixnum))) (-Integer -Integer . -> . -Fixnum)))
(define-for-syntax fx-unop (-Integer . -> . -Fixnum)) (define fx-unop (-Integer . -> . -Fixnum))
(define-for-syntax real-comp (->* (list R R) R B)) (define real-comp (->* (list R R) R B))
;; types for specific operations, to avoid repetition between safe and unsafe versions ;; types for specific operations, to avoid repetition between safe and unsafe versions
(define-for-syntax fx+-type (define fx+-type
(cl->* (-Pos -Nat . -> . -PositiveFixnum) (cl->* (-Pos -Nat . -> . -PositiveFixnum)
(-Nat -Pos . -> . -PositiveFixnum) (-Nat -Pos . -> . -PositiveFixnum)
(-Nat -Nat . -> . -NonnegativeFixnum) (-Nat -Nat . -> . -NonnegativeFixnum)
(-Integer -Integer . -> . -Fixnum))) (-Integer -Integer . -> . -Fixnum)))
(define-for-syntax fx--type (define fx--type
(-Integer -Integer . -> . -Fixnum)) (-Integer -Integer . -> . -Fixnum))
(define-for-syntax fx=-type (define fx=-type
(cl->* (cl->*
(-> -Integer (-val 0) B : (-FS (-filter (-val 0) 0) -top)) (-> -Integer (-val 0) B : (-FS (-filter (-val 0) 0) -top))
(-> (-val 0) -Integer B : (-FS (-filter (-val 0) 1) -top)) (-> (-val 0) -Integer B : (-FS (-filter (-val 0) 1) -top))
@ -71,40 +62,40 @@
(-> -Integer -NegativeFixnum B : (-FS (-filter -NegativeFixnum 0) -top)) (-> -Integer -NegativeFixnum B : (-FS (-filter -NegativeFixnum 0) -top))
(-> -NegativeFixnum -Integer B : (-FS (-filter -NegativeFixnum 1) -top)) (-> -NegativeFixnum -Integer B : (-FS (-filter -NegativeFixnum 1) -top))
fx-comp)) fx-comp))
(define-for-syntax fx<-type (define fx<-type
(cl->* (cl->*
(-> -Integer (-val 0) B : (-FS (-filter -NegativeFixnum 0) (-filter -NonnegativeFixnum 0))) (-> -Integer (-val 0) B : (-FS (-filter -NegativeFixnum 0) (-filter -NonnegativeFixnum 0)))
(-> -Integer -NegativeFixnum B : (-FS (-filter -NegativeFixnum 0) -top)) (-> -Integer -NegativeFixnum B : (-FS (-filter -NegativeFixnum 0) -top))
(-> -Nat -Integer B : (-FS (-filter -PositiveFixnum 1) -top)) (-> -Nat -Integer B : (-FS (-filter -PositiveFixnum 1) -top))
fx-comp)) fx-comp))
(define-for-syntax fx>-type (define fx>-type
(cl->* (cl->*
(-> -Integer (-val 0) B : (-FS (-filter -PositiveFixnum 0) -top)) (-> -Integer (-val 0) B : (-FS (-filter -PositiveFixnum 0) -top))
(-> -NegativeFixnum -Integer B : (-FS (-filter -NegativeFixnum 1) -top)) (-> -NegativeFixnum -Integer B : (-FS (-filter -NegativeFixnum 1) -top))
(-> -Integer -Nat B : (-FS (-filter -PositiveFixnum 0) -top)) (-> -Integer -Nat B : (-FS (-filter -PositiveFixnum 0) -top))
fx-comp)) fx-comp))
(define-for-syntax fx<=-type (define fx<=-type
(cl->* (cl->*
(-> -Integer (-val 0) B : (-FS -top (-filter -PositiveFixnum 0))) (-> -Integer (-val 0) B : (-FS -top (-filter -PositiveFixnum 0)))
(-> -Integer -NegativeFixnum B : (-FS (-filter -NegativeFixnum 0) -top)) (-> -Integer -NegativeFixnum B : (-FS (-filter -NegativeFixnum 0) -top))
(-> -Pos -Integer B : (-FS (-filter -Pos 1) -top)) (-> -Pos -Integer B : (-FS (-filter -Pos 1) -top))
(-> -Nat -Integer B : (-FS (-filter -Nat 1) -top)) (-> -Nat -Integer B : (-FS (-filter -Nat 1) -top))
fx-comp)) fx-comp))
(define-for-syntax fx>=-type (define fx>=-type
(cl->* (cl->*
(-> -Integer (-val 0) B : (-FS (-filter -NonnegativeFixnum 0) -top)) (-> -Integer (-val 0) B : (-FS (-filter -NonnegativeFixnum 0) -top))
(-> -NegativeFixnum -Integer B : (-FS (-filter -NegativeFixnum 1) -top)) (-> -NegativeFixnum -Integer B : (-FS (-filter -NegativeFixnum 1) -top))
(-> -Integer -Pos B : (-FS (-filter -Pos 0) -top)) (-> -Integer -Pos B : (-FS (-filter -Pos 0) -top))
(-> -Integer -Nat B : (-FS (-filter -Nat 0) -top)) (-> -Integer -Nat B : (-FS (-filter -Nat 0) -top))
fx-comp)) fx-comp))
(define-for-syntax fxmin-type (define fxmin-type
(cl->* (cl->*
(-> -NegativeFixnum -Integer -NegativeFixnum) (-> -NegativeFixnum -Integer -NegativeFixnum)
(-> -Integer -NegativeFixnum -NegativeFixnum) (-> -Integer -NegativeFixnum -NegativeFixnum)
(-> -Pos -Pos -PositiveFixnum) (-> -Pos -Pos -PositiveFixnum)
(-> -Nat -Nat -NonnegativeFixnum) (-> -Nat -Nat -NonnegativeFixnum)
(-> -Integer -Integer -Fixnum))) (-> -Integer -Integer -Fixnum)))
(define-for-syntax fxmax-type (define fxmax-type
(cl->* (cl->*
(-> -NegativeFixnum -NegativeFixnum -NegativeFixnum) (-> -NegativeFixnum -NegativeFixnum -NegativeFixnum)
(-> -Pos -Integer -PositiveFixnum) (-> -Pos -Integer -PositiveFixnum)
@ -113,26 +104,26 @@
(-> -Integer -Nat -NonnegativeFixnum) (-> -Integer -Nat -NonnegativeFixnum)
(-> -Integer -Integer -Fixnum))) (-> -Integer -Integer -Fixnum)))
(define-for-syntax fl+*-type (define fl+*-type
(cl->* (-NonnegativeFlonum -NonnegativeFlonum . -> . -NonnegativeFlonum) (cl->* (-NonnegativeFlonum -NonnegativeFlonum . -> . -NonnegativeFlonum)
(-Flonum -Flonum . -> . -Flonum))) (-Flonum -Flonum . -> . -Flonum)))
(define-for-syntax fl=-type (define fl=-type
(cl->* (cl->*
(-> -Flonum -NonnegativeFlonum B : (-FS (-filter -NonnegativeFlonum 0) -top)) (-> -Flonum -NonnegativeFlonum B : (-FS (-filter -NonnegativeFlonum 0) -top))
(-> -NonnegativeFlonum -Flonum B : (-FS (-filter -NonnegativeFlonum 1) -top)) (-> -NonnegativeFlonum -Flonum B : (-FS (-filter -NonnegativeFlonum 1) -top))
fl-comp)) fl-comp))
(define-for-syntax fl<-type (define fl<-type
(cl->* (cl->*
(-> -NonnegativeFlonum -Flonum B : (-FS (-filter -NonnegativeFlonum 1) -top)) (-> -NonnegativeFlonum -Flonum B : (-FS (-filter -NonnegativeFlonum 1) -top))
fl-comp)) fl-comp))
(define-for-syntax fl>-type (define fl>-type
(cl->* (cl->*
(-> -Flonum -NonnegativeFlonum B : (-FS (-filter -NonnegativeFlonum 0) -top)) (-> -Flonum -NonnegativeFlonum B : (-FS (-filter -NonnegativeFlonum 0) -top))
fl-comp)) fl-comp))
(define-for-syntax flmin-type (define flmin-type
(cl->* (-> -NonnegativeFlonum -NonnegativeFlonum -NonnegativeFlonum) (cl->* (-> -NonnegativeFlonum -NonnegativeFlonum -NonnegativeFlonum)
(-> -Flonum -Flonum -Flonum))) (-> -Flonum -Flonum -Flonum)))
(define-for-syntax flmax-type (define flmax-type
(cl->* (-> -NonnegativeFlonum -Flonum -NonnegativeFlonum) (cl->* (-> -NonnegativeFlonum -Flonum -NonnegativeFlonum)
(-> -Flonum -NonnegativeFlonum -NonnegativeFlonum) (-> -Flonum -NonnegativeFlonum -NonnegativeFlonum)
(-> -Flonum -Flonum -Flonum))) (-> -Flonum -Flonum -Flonum)))

43
collects/typed-scheme/private/base-env.rkt
View File

@ -1,26 +1,29 @@
#lang s-exp "env-lang.rkt" #lang s-exp "env-lang.rkt"
(require (require
racket/tcp
racket
racket/unsafe/ops (for-template
racket/fixnum (except-in racket -> ->* one-of/c)
racket/future racket/unsafe/ops
(only-in rnrs/lists-6 fold-left) racket/tcp
'#%paramz racket/fixnum
"extra-procs.rkt" racket/future
(only-in '#%kernel [apply kernel:apply]) (only-in rnrs/lists-6 fold-left)
(only-in racket/private/pre-base new-apply-proc) '#%paramz
(for-syntax (only-in racket/private/pre-base new-apply-proc)) "extra-procs.rkt"
scheme/promise scheme/system (only-in '#%kernel [apply kernel:apply])
racket/mpair (only-in racket/private/pre-base new-apply-proc)
(only-in string-constants/private/only-once maybe-print-message) scheme/promise scheme/system
(only-in mzscheme make-namespace) racket/mpair
(only-in racket/match/runtime match:error matchable? match-equality-test) racket/base
(for-syntax (only-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym]) (only-in string-constants/private/only-once maybe-print-message)
(only-in (rep type-rep) make-HashtableTop make-MPairTop (only-in mzscheme make-namespace)
make-BoxTop make-ChannelTop make-VectorTop (only-in racket/match/runtime match:error matchable? match-equality-test))
make-HeterogenousVector))) (only-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym])
(only-in (rep type-rep) make-HashtableTop make-MPairTop
make-BoxTop make-ChannelTop make-VectorTop
make-HeterogenousVector))
[raise (Univ . -> . (Un))] [raise (Univ . -> . (Un))]
[raise-syntax-error (cl->* [raise-syntax-error (cl->*

14
collects/typed-scheme/private/base-special-env.rkt
View File

@ -5,14 +5,12 @@
"../utils/utils.rkt" "../utils/utils.rkt"
racket/promise racket/promise
string-constants/string-constant string-constants/string-constant
(for-syntax (for-syntax racket/base syntax/parse (only-in unstable/syntax syntax-local-eval)
scheme/base syntax/parse (utils tc-utils)
(only-in unstable/syntax syntax-local-eval) (env init-envs)
(utils tc-utils) (except-in (rep filter-rep object-rep type-rep) make-arr)
(env init-envs) (types convenience union)
(except-in (rep filter-rep object-rep type-rep) make-arr) (only-in (types convenience) [make-arr* make-arr])))
(types convenience union)
(only-in (types convenience) [make-arr* make-arr])))
(define-syntax (define-initial-env stx) (define-syntax (define-initial-env stx)
(syntax-parse stx (syntax-parse stx

29
collects/typed-scheme/private/env-lang.rkt
View File

@ -2,14 +2,14 @@
(require (rename-in "../utils/utils.rkt" [infer r:infer])) (require (rename-in "../utils/utils.rkt" [infer r:infer]))
(require (for-syntax (utils tc-utils) (require (for-syntax scheme/base syntax/parse)
(env init-envs) (utils tc-utils)
scheme/base syntax/parse (env init-envs)
(r:infer infer) (r:infer infer)
(only-in (r:infer infer-dummy) infer-param) (only-in (r:infer infer-dummy) infer-param)
(except-in (rep object-rep filter-rep type-rep) make-arr) (except-in (rep object-rep filter-rep type-rep) make-arr)
(types convenience union) (types convenience union)
(only-in (types convenience) [make-arr* make-arr]))) (only-in (types convenience) [make-arr* make-arr]))
(define-syntax (-#%module-begin stx) (define-syntax (-#%module-begin stx)
(define-syntax-class clause (define-syntax-class clause
@ -21,18 +21,17 @@
#'(#%plain-module-begin #'(#%plain-module-begin
(begin (begin
extra extra
(define-for-syntax e (define e
(parameterize ([infer-param infer]) (parameterize ([infer-param infer])
(make-env [id ty] ...))) (make-env [id ty] ...)))
(begin-for-syntax (define (init)
(initialize-type-env e))))] (initialize-type-env e))
(provide init)))]
[(mb . rest) [(mb . rest)
#'(mb (begin) . rest)])) #'(mb (begin) . rest)]))
(provide (rename-out [-#%module-begin #%module-begin]) (provide (rename-out [-#%module-begin #%module-begin])
require require
(except-out (all-from-out scheme/base) #%module-begin) (except-out (all-from-out scheme/base) #%module-begin)
types rep private utils types rep private utils
(for-syntax (types-out convenience union))
(types-out convenience union)
(all-from-out scheme/base)))

2
collects/typed-scheme/private/parse-type.rkt
View File

@ -7,7 +7,7 @@
syntax/stx (prefix-in c: scheme/contract) syntax/stx (prefix-in c: scheme/contract)
syntax/parse syntax/parse
(env type-env-structs tvar-env type-name-env type-alias-env lexical-env index-env) (env type-env-structs tvar-env type-name-env type-alias-env lexical-env index-env)
scheme/match unstable/debug racket/match unstable/debug
(for-template scheme/base "colon.ss") (for-template scheme/base "colon.ss")
;; needed at this phase for tests ;; needed at this phase for tests
(combine-in (prefix-in t: "base-types-extra.ss") "colon.ss") (combine-in (prefix-in t: "base-types-extra.ss") "colon.ss")

21
collects/typed-scheme/private/prims.rkt
View File

@ -1,8 +1,8 @@
#lang scheme/base #lang racket/base
#| #|
This file defines two sorts of primitives. All of them are provided into any module using the typed scheme language. This file defines two sorts of primitives. All of them are provided into any module using the typed racket language.
1. macros for defining type annotated code. 1. macros for defining type annotated code.
this includes: lambda:, define:, etc this includes: lambda:, define:, etc
@ -27,29 +27,22 @@ This file defines two sorts of primitives. All of them are provided into any mod
[for/annotation for] [for/annotation for]
[for*/annotation for*])) [for*/annotation for*]))
(require "../utils/utils.rkt" (require "../utils/require-contract.rkt"
racket/base
mzlib/etc
"../utils/require-contract.rkt"
"colon.rkt" "colon.rkt"
"../typecheck/internal-forms.rkt" "../typecheck/internal-forms.rkt"
(rename-in racket/contract [-> c->]) (rename-in racket/contract [-> c->])
mzlib/struct
"base-types.rkt" "base-types.rkt"
"base-types-extra.rkt" "base-types-extra.rkt"
(for-syntax (for-syntax
syntax/parse syntax/parse
syntax/private/util syntax/private/util
scheme/base racket/base
mzlib/match racket/struct-info
scheme/struct-info
syntax/struct syntax/struct
syntax/stx
"../rep/type-rep.rkt" "../rep/type-rep.rkt"
"parse-type.rkt" "parse-type.rkt"
"annotate-classes.rkt" "annotate-classes.rkt"
"internal.rkt" "internal.rkt"
"../utils/utils.rkt"
"../utils/tc-utils.rkt" "../utils/tc-utils.rkt"
"../env/type-name-env.rkt" "../env/type-name-env.rkt"
"type-contract.rkt" "type-contract.rkt"
@ -277,8 +270,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
[(_ nm ((~describe "field specification" [fld:annotated-name]) ...) [proc : proc-ty]) [(_ nm ((~describe "field specification" [fld:annotated-name]) ...) [proc : proc-ty])
(with-syntax* (with-syntax*
([proc* (syntax-property #'(ann proc : proc-ty) 'typechecker:with-type #t)] ([proc* (syntax-property #'(ann proc : proc-ty) 'typechecker:with-type #t)]
[d-s (syntax-property (syntax/loc stx (define-struct/properties nm (fld.name ...) [d-s (syntax-property (syntax/loc stx (define-struct nm (fld.name ...)
([prop:procedure proc*]))) #:property prop:procedure proc*))
'typechecker:ignore-some #t)] 'typechecker:ignore-some #t)]
[dtsi (internal (syntax/loc stx (define-typed-struct/exec-internal nm (fld ...) proc-ty)))]) [dtsi (internal (syntax/loc stx (define-typed-struct/exec-internal nm (fld ...) proc-ty)))])
#'(begin d-s dtsi))])) #'(begin d-s dtsi))]))

2
collects/typed-scheme/private/type-annotation.rkt
View File

@ -7,7 +7,7 @@
(except-in (types subtype union convenience resolve utils) -> ->*) (except-in (types subtype union convenience resolve utils) -> ->*)
(private parse-type) (private parse-type)
(only-in scheme/contract listof ->) (only-in scheme/contract listof ->)
scheme/match mzlib/trace) racket/match mzlib/trace)
(provide type-annotation (provide type-annotation
get-type get-type
get-types get-types

2
collects/typed-scheme/private/type-contract.rkt
View File

@ -12,7 +12,7 @@
(types resolve utils) (types resolve utils)
(prefix-in t: (types convenience)) (prefix-in t: (types convenience))
(private parse-type) (private parse-type)
scheme/match syntax/struct syntax/stx mzlib/trace unstable/syntax scheme/list racket/match syntax/struct syntax/stx mzlib/trace unstable/syntax scheme/list
(only-in scheme/contract -> ->* case-> cons/c flat-rec-contract provide/contract any/c) (only-in scheme/contract -> ->* case-> cons/c flat-rec-contract provide/contract any/c)
(for-template scheme/base scheme/contract unstable/poly-c (utils any-wrap) (for-template scheme/base scheme/contract unstable/poly-c (utils any-wrap)
(only-in scheme/class object% is-a?/c subclass?/c object-contract class/c init object/c class?))) (only-in scheme/class object% is-a?/c subclass?/c object-contract class/c init object/c class?)))

3
collects/typed-scheme/private/with-types.rkt
View File

@ -5,8 +5,7 @@
(except-in racket/base for for*) (except-in racket/base for for*)
"prims.rkt" "prims.rkt"
(prefix-in c: (combine-in racket/contract/regions racket/contract/base))) (prefix-in c: (combine-in racket/contract/regions racket/contract/base)))
"base-env.rkt" "base-special-env.rkt" "base-env-numeric.rkt" "extra-procs.rkt" "prims.rkt"
"base-env-indexing.rkt" "extra-procs.rkt" "prims.rkt"
syntax/parse racket/block racket/match syntax/parse racket/block racket/match
unstable/sequence unstable/debug "base-types-extra.rkt" unstable/sequence unstable/debug "base-types-extra.rkt"
(except-in (path-up "env/type-name-env.rkt" (except-in (path-up "env/type-name-env.rkt"

2
collects/typed-scheme/rep/filter-rep.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base #lang scheme/base
(require scheme/match scheme/contract) (require racket/match scheme/contract)
(require "rep-utils.rkt" "free-variance.rkt") (require "rep-utils.rkt" "free-variance.rkt")
(define (Filter/c-predicate? e) (define (Filter/c-predicate? e)

2
collects/typed-scheme/rep/object-rep.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base #lang scheme/base
(require scheme/match scheme/contract "rep-utils.rkt" "free-variance.rkt" "filter-rep.rkt") (require racket/match scheme/contract "rep-utils.rkt" "free-variance.rkt" "filter-rep.rkt")
(provide object-equal?) (provide object-equal?)
(dpe CarPE () [#:fold-rhs #:base]) (dpe CarPE () [#:fold-rhs #:base])

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

@ -2,7 +2,7 @@
(require "../utils/utils.rkt") (require "../utils/utils.rkt")
(require mzlib/struct mzlib/pconvert (require mzlib/struct mzlib/pconvert
scheme/match racket/match
syntax/boundmap syntax/boundmap
"free-variance.rkt" "free-variance.rkt"
"interning.rkt" "interning.rkt"
@ -12,7 +12,7 @@
(for-syntax (for-syntax
scheme/list scheme/list
(only-in unstable/syntax generate-temporary) (only-in unstable/syntax generate-temporary)
scheme/match racket/match
(except-in syntax/parse id identifier keyword) (except-in syntax/parse id identifier keyword)
scheme/base scheme/base
syntax/struct syntax/struct

2
collects/typed-scheme/rep/type-rep.rkt
View File

@ -3,7 +3,7 @@
(require (utils tc-utils) (require (utils tc-utils)
"rep-utils.rkt" "object-rep.rkt" "filter-rep.rkt" "free-variance.rkt" "rep-utils.rkt" "object-rep.rkt" "filter-rep.rkt" "free-variance.rkt"
mzlib/trace scheme/match mzlib/etc mzlib/trace racket/match mzlib/etc
scheme/contract unstable/debug scheme/contract unstable/debug
(for-syntax scheme/base syntax/parse)) (for-syntax scheme/base syntax/parse))

2
collects/typed-scheme/typecheck/check-subforms-unit.rkt
View File

@ -3,7 +3,7 @@
(require "../utils/utils.rkt" (require "../utils/utils.rkt"
syntax/kerncase syntax/kerncase
syntax/parse syntax/parse
scheme/match unstable/debug racket/match unstable/debug
"signatures.rkt" "tc-metafunctions.rkt" "signatures.rkt" "tc-metafunctions.rkt"
(types utils convenience union subtype) (types utils convenience union subtype)
(utils tc-utils) (utils tc-utils)

2
collects/typed-scheme/typecheck/find-annotation.rkt
View File

@ -72,5 +72,5 @@
[e:core-expr [e:core-expr
(ormap find (syntax->list #'(e.expr ...)))])) (ormap find (syntax->list #'(e.expr ...)))]))
; (require scheme/trace) ; (require racket/trace)
; (trace find-annotation) ; (trace find-annotation)

2
collects/typed-scheme/typecheck/provide-handling.rkt
View File

@ -12,7 +12,7 @@
(for-syntax syntax/parse racket/base) (for-syntax syntax/parse racket/base)
racket/contract/private/provide unstable/list racket/contract/private/provide unstable/list
unstable/debug syntax/id-table racket/dict unstable/debug syntax/id-table racket/dict
unstable/syntax scheme/struct-info scheme/match unstable/syntax scheme/struct-info racket/match
"def-binding.rkt" syntax/parse "def-binding.rkt" syntax/parse
(for-template scheme/base "def-export.rkt" scheme/contract)) (for-template scheme/base "def-export.rkt" scheme/contract))

2
collects/typed-scheme/typecheck/tc-app-helper.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base #lang scheme/base
(require "../utils/utils.rkt" scheme/match unstable/list (require "../utils/utils.rkt" racket/match unstable/list
(utils tc-utils) (rep type-rep) (types utils union abbrev)) (utils tc-utils) (rep type-rep) (types utils union abbrev))
(provide (all-defined-out)) (provide (all-defined-out))

2
collects/typed-scheme/typecheck/tc-envops.rkt
View File

@ -11,7 +11,7 @@
(types resolve) (types resolve)
(only-in (env type-env-structs lexical-env) (only-in (env type-env-structs lexical-env)
env? update-type/lexical env-map env-props replace-props) env? update-type/lexical env-map env-props replace-props)
scheme/contract scheme/match scheme/contract racket/match
mzlib/trace unstable/debug unstable/struct mzlib/trace unstable/debug unstable/struct
(typecheck tc-metafunctions) (typecheck tc-metafunctions)
(for-syntax scheme/base)) (for-syntax scheme/base))

2
collects/typed-scheme/typecheck/tc-expr-unit.rkt
View File

@ -3,7 +3,7 @@
(require (rename-in "../utils/utils.rkt" [private private-in]) (require (rename-in "../utils/utils.rkt" [private private-in])
syntax/kerncase mzlib/trace syntax/kerncase mzlib/trace
scheme/match (prefix-in - scheme/contract) racket/match (prefix-in - scheme/contract)
"signatures.rkt" "tc-envops.rkt" "tc-metafunctions.rkt" "tc-subst.rkt" "signatures.rkt" "tc-envops.rkt" "tc-metafunctions.rkt" "tc-subst.rkt"
"check-below.rkt" "tc-funapp.rkt" "check-below.rkt" "tc-funapp.rkt"
(types utils convenience union subtype remove-intersect type-table filter-ops) (types utils convenience union subtype remove-intersect type-table filter-ops)

2
collects/typed-scheme/typecheck/tc-lambda-unit.rkt
View File

@ -16,7 +16,7 @@
(env type-env-structs lexical-env tvar-env index-env) (env type-env-structs lexical-env tvar-env index-env)
(utils tc-utils) (utils tc-utils)
unstable/debug unstable/debug
scheme/match) racket/match)
(require (for-template scheme/base "internal-forms.rkt")) (require (for-template scheme/base "internal-forms.rkt"))
(import tc-expr^) (import tc-expr^)

2
collects/typed-scheme/typecheck/tc-metafunctions.rkt
View File

@ -6,7 +6,7 @@
[->* -->*] [->* -->*]
[one-of/c -one-of/c]) [one-of/c -one-of/c])
(rep type-rep filter-rep rep-utils) scheme/list (rep type-rep filter-rep rep-utils) scheme/list
scheme/contract scheme/match unstable/match scheme/trace scheme/contract racket/match unstable/match racket/trace
unstable/debug unstable/debug
(for-syntax scheme/base)) (for-syntax scheme/base))

2
collects/typed-scheme/typecheck/tc-structs.rkt
View File

@ -12,7 +12,7 @@
mzlib/trace mzlib/trace
unstable/debug unstable/debug
racket/function racket/function
scheme/match racket/match
(only-in racket/contract (only-in racket/contract
listof any/c or/c listof any/c or/c
[->* c->*] [->* c->*]

2
collects/typed-scheme/typecheck/tc-subst.rkt
View File

@ -6,7 +6,7 @@
[->* -->*] [->* -->*]
[one-of/c -one-of/c]) [one-of/c -one-of/c])
(rep type-rep filter-rep rep-utils) scheme/list (rep type-rep filter-rep rep-utils) scheme/list
scheme/contract scheme/match unstable/match unstable/debug scheme/contract racket/match unstable/match unstable/debug
(for-syntax scheme/base) (for-syntax scheme/base)
"tc-metafunctions.rkt") "tc-metafunctions.rkt")

2
collects/typed-scheme/typecheck/tc-toplevel.rkt
View File

@ -4,7 +4,7 @@
syntax/kerncase syntax/kerncase
unstable/list unstable/syntax syntax/parse unstable/debug unstable/list unstable/syntax syntax/parse unstable/debug
mzlib/etc mzlib/etc
scheme/match racket/match
"signatures.rkt" "signatures.rkt"
"tc-structs.rkt" "tc-structs.rkt"
"typechecker.rkt" "typechecker.rkt"

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

@ -1,11 +1,9 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base "typecheck/renamer.rkt") (require (for-syntax racket/base "typecheck/renamer.rkt")
"private/base-special-env.rkt" "private/base-special-env.rkt")
"private/base-env.rkt"
"private/base-env-numeric.rkt")
(begin-for-syntax (initialize-special)) (begin-for-syntax )
(provide (rename-out [module-begin #%module-begin] (provide (rename-out [module-begin #%module-begin]
[top-interaction #%top-interaction] [top-interaction #%top-interaction]
@ -15,16 +13,27 @@
with-type) with-type)
(define-syntax (module-begin stx) (define-syntax (module-begin stx)
(initialize-special)
((dynamic-require 'typed-scheme/private/base-structs 'initialize-structs)) ((dynamic-require 'typed-scheme/private/base-structs 'initialize-structs))
((dynamic-require 'typed-scheme/private/base-env-indexing 'initialize-indexing)) ((dynamic-require 'typed-scheme/private/base-env-indexing 'initialize-indexing))
((dynamic-require 'typed-scheme/private/base-env 'init))
((dynamic-require 'typed-scheme/private/base-env-numeric 'init))
((dynamic-require 'typed-scheme/core 'mb-core) stx)) ((dynamic-require 'typed-scheme/core 'mb-core) stx))
(define-syntax (top-interaction stx) (define-syntax (top-interaction stx)
(initialize-special)
((dynamic-require 'typed-scheme/private/base-structs 'initialize-structs)) ((dynamic-require 'typed-scheme/private/base-structs 'initialize-structs))
((dynamic-require 'typed-scheme/private/base-env-indexing 'initialize-indexing))
((dynamic-require 'typed-scheme/private/base-env 'init))
((dynamic-require 'typed-scheme/private/base-env-numeric 'init))
((dynamic-require 'typed-scheme/core 'ti-core) stx)) ((dynamic-require 'typed-scheme/core 'ti-core) stx))
(define-syntax (with-type stx) (define-syntax (with-type stx)
(initialize-special)
((dynamic-require 'typed-scheme/private/base-structs 'initialize-structs)) ((dynamic-require 'typed-scheme/private/base-structs 'initialize-structs))
((dynamic-require 'typed-scheme/private/base-env-indexing 'initialize-indexing))
((dynamic-require 'typed-scheme/private/base-env 'init))
((dynamic-require 'typed-scheme/private/base-env-numeric 'init))
((dynamic-require 'typed-scheme/core 'wt-core) stx)) ((dynamic-require 'typed-scheme/core 'wt-core) stx))

18
collects/typed-scheme/types/abbrev.rkt
View File

@ -2,17 +2,15 @@
(require "../utils/utils.rkt") (require "../utils/utils.rkt")
(require (rep type-rep object-rep filter-rep rep-utils) (require (rep type-rep object-rep filter-rep)
#;"printer.rkt" "utils.rkt" "resolve.rkt" "resolve.rkt"
(utils tc-utils) (utils tc-utils)
scheme/list racket/list
scheme/match racket/match
scheme/promise (except-in racket/contract ->* ->)
scheme/flonum (except-in scheme/contract ->* ->) (prefix-in c: racket/contract)
unstable/syntax (for-syntax racket/base syntax/parse)
(prefix-in c: scheme/contract) (for-template racket/base racket/contract racket/promise racket/tcp racket/flonum))
(for-syntax scheme/base syntax/parse)
(for-template scheme/base scheme/contract scheme/promise scheme/tcp scheme/flonum))
(provide (all-defined-out) (provide (all-defined-out)
(rename-out [make-Listof -lst] (rename-out [make-Listof -lst]

4
collects/typed-scheme/types/convenience.rkt
View File

@ -4,10 +4,10 @@
(utils tc-utils) (utils tc-utils)
"abbrev.rkt" (only-in scheme/contract current-blame-format) "abbrev.rkt" (only-in scheme/contract current-blame-format)
(types comparison printer union subtype utils substitute) (types comparison printer union subtype utils substitute)
scheme/list scheme/match scheme/promise scheme/list racket/match scheme/promise
(for-syntax syntax/parse scheme/base) (for-syntax syntax/parse scheme/base)
unstable/debug syntax/id-table scheme/dict unstable/debug syntax/id-table scheme/dict
scheme/trace racket/trace
(for-template scheme/base)) (for-template scheme/base))
(provide (all-defined-out) (provide (all-defined-out)

4
collects/typed-scheme/types/filter-ops.rkt
View File

@ -5,10 +5,10 @@
(utils tc-utils) (only-in (infer infer) restrict) (utils tc-utils) (only-in (infer infer) restrict)
"abbrev.rkt" (only-in scheme/contract current-blame-format [-> -->] listof) "abbrev.rkt" (only-in scheme/contract current-blame-format [-> -->] listof)
(types comparison printer union subtype utils remove-intersect) (types comparison printer union subtype utils remove-intersect)
scheme/list scheme/match scheme/promise scheme/list racket/match scheme/promise
(for-syntax syntax/parse scheme/base) (for-syntax syntax/parse scheme/base)
unstable/debug syntax/id-table scheme/dict unstable/debug syntax/id-table scheme/dict
scheme/trace racket/trace
(for-template scheme/base)) (for-template scheme/base))
(provide (all-defined-out)) (provide (all-defined-out))

2
collects/typed-scheme/types/remove-intersect.rkt
View File

@ -3,7 +3,7 @@
(require "../utils/utils.rkt" (require "../utils/utils.rkt"
(rep type-rep rep-utils) (rep type-rep rep-utils)
(types union subtype resolve convenience utils) (types union subtype resolve convenience utils)
scheme/match mzlib/trace unstable/debug) racket/match mzlib/trace unstable/debug)
(provide (rename-out [*remove remove]) overlap) (provide (rename-out [*remove remove]) overlap)

2
collects/typed-scheme/types/resolve.rkt
View File

@ -5,7 +5,7 @@
(env type-name-env) (env type-name-env)
(utils tc-utils) (utils tc-utils)
(types utils) (types utils)
scheme/match racket/match
scheme/contract) scheme/contract)
(provide resolve-name resolve-app needs-resolving? resolve) (provide resolve-name resolve-app needs-resolving? resolve)

2
collects/typed-scheme/types/substitute.rkt
View File

@ -5,7 +5,7 @@
(utils tc-utils) (utils tc-utils)
(only-in (rep free-variance) combine-frees) (only-in (rep free-variance) combine-frees)
(env index-env tvar-env) (env index-env tvar-env)
scheme/match racket/match
scheme/contract) scheme/contract)
(provide subst-all substitute substitute-dots substitute-dotted subst (provide subst-all substitute substitute-dots substitute-dotted subst

11
collects/typed-scheme/types/subtype.rkt
View File

@ -1,15 +1,14 @@
#lang scheme/base #lang racket/base
(require "../utils/utils.rkt" (require "../utils/utils.rkt"
(rep type-rep filter-rep object-rep rep-utils) (rep type-rep filter-rep object-rep rep-utils)
(utils tc-utils) (utils tc-utils)
(types utils comparison resolve abbrev substitute) (types utils comparison resolve abbrev substitute)
(env type-name-env) (env type-name-env)
(only-in (infer infer-dummy) unify) (only-in (infer infer-dummy) unify)
scheme/match unstable/match racket/match unstable/match
mzlib/trace (rename-in scheme/contract (rename-in racket/contract
[-> c->] [-> c->] [->* c->*])
[->* c->*]) (for-syntax racket/base syntax/parse))
(for-syntax scheme/base syntax/parse))
;; exn representing failure of subtyping ;; exn representing failure of subtyping
;; s,t both types ;; s,t both types

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

@ -1,6 +1,6 @@
#lang scheme/base #lang racket/base
(require unstable/debug scheme/contract "../utils/utils.rkt" syntax/id-table racket/dict racket/match (require unstable/debug racket/contract "../utils/utils.rkt" syntax/id-table racket/dict racket/match
(rep type-rep object-rep) (only-in (types abbrev utils) tc-results?) (utils tc-utils) (rep type-rep object-rep) (only-in (types abbrev utils) tc-results?) (utils tc-utils)
(env init-envs) mzlib/pconvert) (env init-envs) mzlib/pconvert)

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

@ -1,11 +1,10 @@
#lang scheme/base #lang scheme/base
(require "../utils/utils.rkt") (require "../utils/utils.rkt"
(rep type-rep rep-utils)
(require (rep type-rep rep-utils)
(utils tc-utils) (utils tc-utils)
(types utils subtype abbrev printer comparison) (types utils subtype abbrev printer comparison)
scheme/match mzlib/trace) racket/match)
(provide Un) (provide Un)

16
collects/typed-scheme/types/utils.rkt
View File

@ -1,17 +1,15 @@
#lang scheme/base #lang racket/base
(require "../utils/utils.rkt") (require "../utils/utils.rkt"
(rep type-rep filter-rep object-rep rep-utils)
(require (rep type-rep filter-rep object-rep rep-utils)
(utils tc-utils) (utils tc-utils)
"substitute.rkt" "substitute.rkt"
(only-in (rep free-variance) combine-frees) (only-in (rep free-variance) combine-frees)
(env index-env tvar-env) (env index-env tvar-env)
scheme/match racket/match
scheme/list racket/list
mzlib/trace racket/contract
scheme/contract (for-syntax racket/base syntax/parse))
(for-syntax scheme/base syntax/parse))
(provide fv fv/list fi (provide fv fv/list fi
instantiate-poly instantiate-poly

2
collects/typed-scheme/utils/any-wrap.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base #lang scheme/base
(require scheme/match scheme/vector scheme/contract) (require racket/match scheme/vector scheme/contract)
(define-struct any-wrap (val) (define-struct any-wrap (val)
#:property prop:custom-write #:property prop:custom-write

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

@ -3,9 +3,7 @@
(require scheme/contract (require scheme/contract
unstable/location unstable/location
(for-syntax scheme/base (for-syntax scheme/base
syntax/kerncase
syntax/parse syntax/parse
"../utils/tc-utils.rkt"
(prefix-in tr: "../private/typed-renaming.rkt"))) (prefix-in tr: "../private/typed-renaming.rkt")))
(provide require/contract define-ignored) (provide require/contract define-ignored)

4
collects/typed-scheme/utils/syntax-traversal.rkt
View File

@ -1,6 +1,4 @@
#lang scheme/base #lang racket/base
(require mzlib/trace)
;; from Eli ;; from Eli

6
collects/typed-scheme/utils/tc-utils.rkt
View File

@ -7,7 +7,7 @@ don't depend on any other portion of the system
(provide (all-defined-out)) (provide (all-defined-out))
(require "syntax-traversal.rkt" racket/dict (require "syntax-traversal.rkt" racket/dict
syntax/parse (for-syntax scheme/base syntax/parse) scheme/match) syntax/parse (for-syntax scheme/base syntax/parse) racket/match)
;; a parameter representing the original location of the syntax being currently checked ;; a parameter representing the original location of the syntax being currently checked
(define current-orig-stx (make-parameter #'here)) (define current-orig-stx (make-parameter #'here))
@ -165,8 +165,8 @@ don't depend on any other portion of the system
#:transparent #:transparent
#:attributes (ty id) #:attributes (ty id)
(pattern [nm:identifier ~! ty] (pattern [nm:identifier ~! ty]
#:fail-unless (list? (identifier-template-binding #'nm)) "not a bound identifier" #:fail-unless (list? ((if (= 1 (syntax-local-phase-level)) identifier-template-binding identifier-template-binding) #'nm)) "not a bound identifier"
#:with id #'#'nm) #:with id #'(quote-syntax nm))
(pattern [e:expr ty] (pattern [e:expr ty]
#:with id #'e)) #:with id #'e))
(syntax-parse stx (syntax-parse stx

2
collects/typed-scheme/utils/unit-utils.rkt
View File

@ -1,6 +1,4 @@
#lang scheme/base #lang scheme/base
(require scheme/unit (for-syntax scheme/base))

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

@ -1,14 +1,14 @@
#lang scheme/base #lang racket/base
#| #|
This file is for utilities that are of general interest, This file is for utilities that are of general interest,
at least theoretically. at least theoretically.
|# |#
(require (for-syntax scheme/base syntax/parse scheme/string) (require (for-syntax racket/base syntax/parse racket/string)
scheme/contract scheme/match scheme/require-syntax racket/contract racket/require-syntax
scheme/provide-syntax mzlib/struct scheme/unit racket/provide-syntax racket/unit
scheme/pretty mzlib/pconvert syntax/parse) racket/pretty mzlib/pconvert syntax/parse)
;; to move to unstable ;; to move to unstable
(provide reverse-begin list-update list-set) (provide reverse-begin list-update list-set)