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

reorg

Browse Source 
original commit: 5ac64589baffabf3e7045e5c0c877a1c484207ea
This commit is contained in:
Sam Tobin-Hochstadt 2008-09-09 17:40:26 -04:00
parent 53e3814a54
commit f54d163224
46 changed files with 234 additions and 200 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/typed-scheme/private/init-envs.ss → collects/typed-scheme/env/init-envs.ss vendored
View File

@ -1,11 +1,16 @@
#lang scheme/base
(provide (all-defined-out))
(require "../utils/utils.ss")
(require "type-env.ss" "type-rep.ss" "type-name-env.ss" "union.ss" "effect-rep.ss"
"type-effect-convenience.ss" "type-alias-env.ss"
"type-alias-env.ss")
(require mzlib/pconvert scheme/match mzlib/shared
(for-template mzlib/pconvert mzlib/shared scheme/base "type-rep.ss" "union.ss" "effect-rep.ss"))
(require "type-env.ss"
"type-name-env.ss"
(rep type-rep effect-rep)
(for-template (rep type-rep effect-rep)
(private union)
mzlib/pconvert mzlib/shared scheme/base)
(private type-effect-convenience union)
"type-alias-env.ss"
mzlib/pconvert scheme/match mzlib/shared)
(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))

8
collects/typed-scheme/private/lexical-env.ss → collects/typed-scheme/env/lexical-env.ss vendored
View File

@ -1,6 +1,12 @@
#lang scheme/base
(require "type-environments.ss" "tc-utils.ss" "type-env.ss" "mutated-vars.ss" "type-utils.ss" "type-effect-convenience.ss")
(require (except-in "../utils/utils.ss" extend))
(require "type-environments.ss"
(utils tc-utils)
"type-env.ss"
(private mutated-vars)
(private type-utils)
(private type-effect-convenience))
(provide (all-defined-out))

3
collects/typed-scheme/private/type-alias-env.ss → collects/typed-scheme/env/type-alias-env.ss vendored
View File

@ -1,7 +1,8 @@
#lang scheme/base
(require (except-in "../utils/utils.ss" extend))
(require syntax/boundmap
"tc-utils.ss"
(utils tc-utils)
mzlib/trace
scheme/match)

4
collects/typed-scheme/private/type-env.ss → collects/typed-scheme/env/type-env.ss vendored
View File

@ -1,7 +1,9 @@
#lang scheme/base
(require (except-in "../utils/utils.ss" extend))
(require syntax/boundmap
"tc-utils.ss" "type-utils.ss")
(utils tc-utils)
(private type-utils))
(provide register-type
finish-register-type

3
collects/typed-scheme/private/type-environments.ss → collects/typed-scheme/env/type-environments.ss vendored
View File

@ -10,8 +10,9 @@
initial-tvar-env
with-dotted-env/extend)
(require (prefix-in r: "../utils/utils.ss"))
(require scheme/match
"tc-utils.ss")
(r:utils tc-utils))
;; eq? has the type of equal?, and l is an alist (with conses!)
(define-struct env (eq? l))

5
collects/typed-scheme/private/type-name-env.ss → collects/typed-scheme/env/type-name-env.ss vendored
View File

@ -1,9 +1,10 @@
#lang scheme/base
(require "../utils/utils.ss")
(require syntax/boundmap
mzlib/trace
"tc-utils.ss"
"type-utils.ss")
(utils tc-utils)
(private type-utils))
(provide register-type-name
lookup-type-name

3
collects/typed-scheme/private/constraint-structs.ss → collects/typed-scheme/infer/constraint-structs.ss
View File

@ -1,6 +1,7 @@
#lang scheme/base
(require "type-rep.ss"
(require (except-in "../utils/utils.ss" extend))
(require (rep type-rep)
scheme/contract)
;; S, T types

7
collects/typed-scheme/private/constraints.ss → collects/typed-scheme/infer/constraints.ss
View File

@ -1,8 +1,9 @@
#lang scheme/unit
(require "type-effect-convenience.ss" "type-rep.ss"
"type-utils.ss" "union.ss" "tc-utils.ss"
"subtype.ss" "utils.ss"
(require (except-in "../utils/utils.ss" extend))
(require (private type-effect-convenience type-utils union subtype)
(rep type-rep)
(utils tc-utils)
"signatures.ss" "constraint-structs.ss"
scheme/match)

4
collects/typed-scheme/private/dmap.ss → collects/typed-scheme/infer/dmap.ss
View File

@ -1,6 +1,8 @@
#lang scheme/unit
(require "signatures.ss" "utils.ss" "tc-utils.ss" "constraint-structs.ss"
(require (except-in "../utils/utils.ss" extend))
(require "signatures.ss" "constraint-structs.ss"
(utils tc-utils)
scheme/match)
(import constraints^)

14
collects/typed-scheme/private/infer-unit.ss → collects/typed-scheme/infer/infer-unit.ss
View File

@ -1,12 +1,14 @@
#lang scheme/unit
(require "type-effect-convenience.ss" "type-rep.ss" "effect-rep.ss" "rep-utils.ss"
"free-variance.ss"
(except-in "type-utils.ss" Dotted)
"union.ss" "tc-utils.ss" "type-name-env.ss"
"subtype.ss" "remove-intersect.ss" "signatures.ss" "utils.ss"
(require (except-in "../utils/utils.ss"))
(require (rep free-variance type-rep effect-rep rep-utils)
(private type-effect-convenience union subtype remove-intersect)
(utils tc-utils)
(env type-name-env)
(except-in (private type-utils) Dotted)
"constraint-structs.ss"
(only-in "type-environments.ss" lookup current-tvars)
"signatures.ss"
(only-in (env type-environments) lookup current-tvars)
scheme/match
mzlib/etc
mzlib/trace

3
collects/typed-scheme/private/infer.ss → collects/typed-scheme/infer/infer.ss
View File

@ -1,9 +1,10 @@
#lang scheme/base
(require (except-in "../utils/utils.ss" infer))
(require "infer-unit.ss" "constraints.ss" "dmap.ss" "signatures.ss"
"restrict.ss" "promote-demote.ss"
(only-in scheme/unit provide-signature-elements)
"unit-utils.ss")
(utils unit-utils))
(provide-signature-elements restrict^ infer^)

7
collects/typed-scheme/private/promote-demote.ss → collects/typed-scheme/infer/promote-demote.ss
View File

@ -1,8 +1,9 @@
#lang scheme/unit
(require "type-effect-convenience.ss" "type-rep.ss"
"type-utils.ss" "union.ss"
"signatures.ss" "utils.ss"
(require "../utils/utils.ss")
(require (rep type-rep)
(private type-effect-convenience union type-utils)
"signatures.ss"
scheme/list)
(import)

6
collects/typed-scheme/private/restrict.ss → collects/typed-scheme/infer/restrict.ss
View File

@ -1,8 +1,8 @@
#lang scheme/unit
(require "type-rep.ss"
"type-utils.ss" "union.ss"
"subtype.ss" "remove-intersect.ss"
(require "../utils/utils.ss")
(require (rep type-rep)
(private type-utils union remove-intersect subtype)
"signatures.ss"
scheme/match)

29
collects/typed-scheme/infer/signatures.ss Normal file
View File

@ -0,0 +1,29 @@
#lang scheme/base
(require scheme/unit)
(provide (all-defined-out))
(define-signature dmap^
(dmap-meet))
(define-signature promote-demote^
(var-promote var-demote))
(define-signature constraints^
(exn:infer?
fail-sym
;; inference failure - masked before it gets to the user program
(define-syntaxes (fail!)
(syntax-rules ()
[(_ s t) (raise fail-sym)]))
cset-meet cset-meet*
no-constraint
empty-cset
insert
cset-combine
c-meet))
(define-signature restrict^
(restrict))
(define-signature infer^
(infer infer/vararg infer/dots))

8
collects/typed-scheme/private/base-env.ss
View File

@ -3,6 +3,7 @@
;; these are libraries providing functions we add types to that are not in scheme/base
(require
"extra-procs.ss"
"../utils/utils.ss"
(only-in scheme/list cons? take drop add-between last filter-map)
(only-in rnrs/lists-6 fold-left)
'#%paramz
@ -15,13 +16,12 @@
;; these are all for constructing the types given to variables
(require (for-syntax
scheme/base
"init-envs.ss"
"effect-rep.ss"
(except-in "type-rep.ss" make-arr)
(env init-envs)
(except-in (rep effect-rep type-rep) make-arr)
"type-effect-convenience.ss"
(only-in "type-effect-convenience.ss" [make-arr* make-arr])
"union.ss"
"tc-structs.ss"))
(typecheck tc-structs)))
(define-for-syntax (initialize-others)
(d-s date

5
collects/typed-scheme/private/base-types.ss
View File

@ -1,9 +1,10 @@
#lang scheme/base
(require (except-in "../utils/utils.ss" extend))
(require (for-syntax
scheme/base
"init-envs.ss"
(except-in "type-rep.ss" make-arr)
(env init-envs)
(except-in (rep type-rep) make-arr)
"type-effect-convenience.ss"
(only-in "type-effect-convenience.ss" [make-arr* make-arr])
"union.ss"))

11
collects/typed-scheme/private/parse-type.ss
View File

@ -2,16 +2,15 @@
(provide parse-type parse-type/id)
(require (except-in "type-rep.ss" make-arr)
(require (except-in "../utils/utils.ss" extend))
(require (except-in (rep type-rep) make-arr)
"type-effect-convenience.ss"
(only-in "type-effect-convenience.ss" [make-arr* make-arr])
"tc-utils.ss"
(utils tc-utils)
"union.ss"
syntax/stx
(except-in "type-environments.ss")
"type-name-env.ss"
"type-alias-env.ss"
"type-utils.ss"
(env type-environments type-name-env type-alias-env)
"type-utils.ss"
scheme/match)
(define enable-mu-parsing (make-parameter #t))

10
collects/typed-scheme/private/prims.ss
View File

@ -22,20 +22,20 @@ This file defines two sorts of primitives. All of them are provided into any mod
(provide (all-defined-out)
(rename-out [define-typed-struct define-struct:]))
(require (except-in "../utils/utils.ss" extend))
(require (for-syntax
scheme/base
"type-rep.ss"
(rep type-rep)
mzlib/match
"parse-type.ss"
syntax/struct
syntax/stx
"utils.ss"
"tc-utils.ss"
"type-name-env.ss"
(utils utils tc-utils)
(env type-name-env)
"type-contract.ss"))
(require "require-contract.ss"
"internal-forms.ss"
(typecheck internal-forms)
(except-in mzlib/contract ->)
(only-in mzlib/contract [-> c->])
mzlib/struct

5
collects/typed-scheme/private/remove-intersect.ss
View File

@ -1,7 +1,8 @@
#lang scheme/base
(require "type-rep.ss" "union.ss" "subtype.ss"
"type-utils.ss" "resolve-type.ss" "type-effect-convenience.ss"
(require (except-in "../utils/utils.ss" extend))
(require (rep type-rep)
(private union subtype resolve-type type-effect-convenience type-utils)
mzlib/plt-match mzlib/trace)
(provide (rename-out [*remove remove]) overlap)

3
collects/typed-scheme/private/resolve-type.ss
View File

@ -1,6 +1,7 @@
#lang scheme/base
(require "../utils/utils.ss")
(require "type-rep.ss" "type-name-env.ss" "tc-utils.ss"
(require (rep type-rep) (env type-name-env) (utils tc-utils)
"type-utils.ss"
mzlib/plt-match
mzlib/trace)

11
collects/typed-scheme/private/subtype.ss
View File

@ -1,12 +1,13 @@
#lang scheme/base
(require "../utils/utils.ss")
(require (except-in "type-rep.ss" sub-eff) "type-utils.ss"
"tc-utils.ss"
"effect-rep.ss"
(require (except-in (rep type-rep effect-rep) sub-eff)
(utils tc-utils)
"type-utils.ss"
"type-comparison.ss"
"resolve-type.ss"
"type-name-env.ss"
(only-in "infer-dummy.ss" unify)
(env type-name-env)
(only-in (infer infer-dummy) unify)
mzlib/plt-match
mzlib/trace)

8
collects/typed-scheme/private/type-annotation.ss
View File

@ -1,7 +1,11 @@
#lang scheme/base
(require "type-rep.ss" "parse-type.ss" "tc-utils.ss" "subtype.ss" "utils.ss"
"type-env.ss" "type-effect-convenience.ss" "resolve-type.ss" "union.ss"
(require (except-in "../utils/utils.ss" extend))
(require (rep type-rep)
(utils tc-utils)
(env type-env)
"parse-type.ss" "subtype.ss"
"type-effect-convenience.ss" "resolve-type.ss" "union.ss"
scheme/match mzlib/trace)
(provide type-annotation
get-type

7
collects/typed-scheme/private/type-effect-convenience.ss
View File

@ -1,13 +1,14 @@
#lang scheme/base
(require "type-rep.ss"
"effect-rep.ss"
(require "../utils/utils.ss")
(require (rep type-rep effect-rep)
(utils tc-utils)
scheme/match
"type-comparison.ss"
"type-effect-printer.ss"
"union.ss"
"subtype.ss"
"type-utils.ss"
"tc-utils.ss"
scheme/promise
(for-syntax macro-debugger/stxclass/stxclass)
(for-syntax scheme/base))

6
collects/typed-scheme/private/type-effect-printer.ss
View File

@ -1,5 +1,9 @@
#lang scheme/base
(require "type-rep.ss" "effect-rep.ss" "rep-utils.ss" "tc-utils.ss" "planet-requires.ss" scheme/match)
(require "../utils/utils.ss")
(require (rep type-rep effect-rep rep-utils)
(utils planet-requires tc-utils)
scheme/match)
;; do we attempt to find instantiations of polymorphic types to print?
;; FIXME - currently broken

10
collects/typed-scheme/private/type-utils.ss
View File

@ -1,10 +1,10 @@
#lang scheme/base
(require "type-rep.ss"
"effect-rep.ss"
"tc-utils.ss"
"rep-utils.ss"
(only-in "free-variance.ss" combine-frees)
(require "../utils/utils.ss")
(require (rep type-rep effect-rep rep-utils)
(utils tc-utils)
(only-in (rep free-variance) combine-frees)
mzlib/plt-match
scheme/list
mzlib/trace

8
collects/typed-scheme/private/union.ss
View File

@ -1,7 +1,11 @@
#lang scheme/base
(require "type-rep.ss" "subtype.ss" "tc-utils.ss"
"type-effect-printer.ss" "rep-utils.ss"
(require "../utils/utils.ss")
(require (rep type-rep rep-utils)
(utils tc-utils)
"subtype.ss"
"type-effect-printer.ss"
"type-comparison.ss"
scheme/match mzlib/trace)

0
collects/typed-scheme/private/effect-rep.ss → collects/typed-scheme/rep/effect-rep.ss
View File

3
collects/typed-scheme/private/free-variance.ss → collects/typed-scheme/rep/free-variance.ss
View File

@ -1,7 +1,8 @@
#lang scheme/base
(require "../utils/utils.ss")
(require (for-syntax scheme/base)
"tc-utils.ss"
(utils tc-utils)
mzlib/etc)
;; this file contains support for calculating the free variables/indexes of types

0
collects/typed-scheme/private/interning.ss → collects/typed-scheme/rep/interning.ss
View File

6
collects/typed-scheme/private/rep-utils.ss → collects/typed-scheme/rep/rep-utils.ss
View File

@ -1,18 +1,18 @@
#lang scheme/base
(require "../utils/utils.ss")
(require mzlib/struct
mzlib/plt-match
syntax/boundmap
"planet-requires.ss"
(utils planet-requires)
"free-variance.ss"
"utils.ss"
"interning.ss"
mzlib/etc
(for-syntax
scheme/base
syntax/struct
syntax/stx
"utils.ss"))
(utils utils)))
(provide == dt de print-type* print-effect* Type Type? Effect Effect? defintern hash-id Type-seq Effect-seq)

5
collects/typed-scheme/private/type-rep.ss → collects/typed-scheme/rep/type-rep.ss
View File

@ -1,7 +1,8 @@
#lang scheme/base
(require "../utils/utils.ss")
(require "planet-requires.ss" "rep-utils.ss" "effect-rep.ss" "tc-utils.ss"
"free-variance.ss"
(require (utils planet-requires tc-utils)
"rep-utils.ss" "effect-rep.ss" "free-variance.ss"
mzlib/trace scheme/match
(for-syntax scheme/base))

11
collects/typed-scheme/private/check-subforms-unit.ss → collects/typed-scheme/typecheck/check-subforms-unit.ss
View File

@ -1,15 +1,12 @@
#lang scheme/unit
(require (except-in "../utils/utils.ss" extend))
(require syntax/kerncase
scheme/match
"signatures.ss"
"type-utils.ss"
"type-rep.ss" ;; doesn't need tests
"type-effect-convenience.ss" ;; maybe needs tests
"union.ss"
"subtype.ss" ;; has tests
"tc-utils.ss" ;; doesn't need tests
)
(private type-utils type-effect-convenience union subtype)
(utils tc-utils)
(rep type-rep))
(import tc-if^ tc-lambda^ tc-app^ tc-let^ tc-expr^)
(export check-subforms^)

0
collects/typed-scheme/private/def-binding.ss → collects/typed-scheme/typecheck/def-binding.ss
View File

0
collects/typed-scheme/private/internal-forms.ss → collects/typed-scheme/typecheck/internal-forms.ss
View File

7
collects/typed-scheme/private/provide-handling.ss → collects/typed-scheme/typecheck/provide-handling.ss
View File

@ -1,11 +1,12 @@
#lang scheme/base
(require (except-in "../utils/utils.ss" extend))
(require (only-in srfi/1/list s:member)
syntax/kerncase
mzlib/trace
"type-contract.ss"
"type-rep.ss"
"tc-utils.ss"
(private type-contract)
(rep type-rep)
(utils tc-utils)
"def-binding.ss")
(require (for-template scheme/base

32
collects/typed-scheme/private/signatures.ss → collects/typed-scheme/typecheck/signatures.ss
View File

@ -2,41 +2,11 @@
(require scheme/unit)
(provide (all-defined-out))
(define-signature dmap^
(dmap-meet))
(define-signature promote-demote^
(var-promote var-demote))
(define-signature constraints^
(exn:infer?
fail-sym
;; inference failure - masked before it gets to the user program
(define-syntaxes (fail!)
(syntax-rules ()
[(_ s t) (raise fail-sym)]))
cset-meet cset-meet*
no-constraint
empty-cset
insert
cset-combine
c-meet))
(define-signature restrict^
(restrict))
(define-signature infer^
(infer infer/vararg infer/dots))
;; cycle 2
(define-signature typechecker^
(type-check tc-toplevel-form))
(define-signature tc-expr^
(tc-expr tc-expr/check tc-expr/check/t check-below tc-literal tc-exprs tc-exprs/check tc-expr/t #;check-expr))
(tc-expr tc-expr/check tc-expr/check/t check-below tc-exprs tc-exprs/check tc-expr/t))
(define-signature check-subforms^
(check-subforms/ignore check-subforms/with-handlers check-subforms/with-handlers/check))

22
collects/typed-scheme/private/tc-app-unit.ss → collects/typed-scheme/typecheck/tc-app-unit.ss
View File

@ -1,19 +1,13 @@
#lang scheme/unit
(require (only-in "../utils/utils.ss" debug in-syntax printf/log in-pairs rep utils private env [infer r:infer]))
(require "signatures.ss"
"type-rep.ss"
"effect-rep.ss"
"tc-utils.ss"
"subtype.ss"
"infer.ss"
(only-in "utils.ss" debug in-syntax printf/log in-pairs)
"union.ss"
"type-utils.ss"
"type-effect-convenience.ss"
"type-effect-printer.ss"
"type-annotation.ss"
"resolve-type.ss"
"type-environments.ss"
(rep type-rep effect-rep)
(utils tc-utils)
(private subtype type-utils union type-effect-convenience type-effect-printer resolve-type
type-annotation)
(r:infer infer)
(env type-environments)
(only-in srfi/1 alist-delete)
(only-in scheme/private/class-internal make-object do-make-object)
mzlib/trace mzlib/pretty syntax/kerncase scheme/match
@ -21,7 +15,7 @@
(for-template
"internal-forms.ss" scheme/base
(only-in scheme/private/class-internal make-object do-make-object)))
(require "constraint-structs.ss")
(require (r:infer constraint-structs))
(import tc-expr^ tc-lambda^ tc-dots^)
(export tc-app^)

18
collects/typed-scheme/private/tc-expr-unit.ss → collects/typed-scheme/typecheck/tc-expr-unit.ss
View File

@ -1,21 +1,15 @@
#lang scheme/unit
(require (rename-in "../utils/utils.ss" [private r:private]))
(require syntax/kerncase
scheme/match
"signatures.ss"
"type-utils.ss"
"utils.ss" ;; doesn't need tests
"type-rep.ss" ;; doesn't need tests
"type-effect-convenience.ss" ;; maybe needs tests
"union.ss"
"subtype.ss" ;; has tests
"parse-type.ss" ;; has tests
"tc-utils.ss" ;; doesn't need tests
"lexical-env.ss" ;; maybe needs tests
"type-annotation.ss" ;; has tests
"effect-rep.ss"
(only-in "type-environments.ss" lookup current-tvars extend-env)
(r:private type-utils type-effect-convenience union subtype parse-type type-annotation)
(rep type-rep effect-rep)
(utils tc-utils)
(env lexical-env)
(only-in (env type-environments) lookup current-tvars extend-env)
scheme/private/class-internal
(only-in srfi/1 split-at))

17
collects/typed-scheme/private/tc-lambda-unit.ss → collects/typed-scheme/typecheck/tc-lambda-unit.ss
View File

@ -1,20 +1,15 @@
#lang scheme/unit
(require (rename-in "../utils/utils.ss" [infer r:infer] [extend r:extend]))
(require "signatures.ss"
mzlib/trace
scheme/list
(except-in "type-rep.ss" make-arr) ;; doesn't need tests
"type-effect-convenience.ss" ;; maybe needs tests
"type-environments.ss" ;; doesn't need tests
"lexical-env.ss" ;; maybe needs tests
"type-annotation.ss" ;; has tests
(except-in "utils.ss" extend)
"type-utils.ss"
"effect-rep.ss"
"tc-utils.ss"
"union.ss"
(except-in (rep type-rep effect-rep) make-arr) ;; doesn't need tests
(private type-effect-convenience type-annotation union type-utils)
(env type-environments lexical-env)
(utils tc-utils)
mzlib/plt-match
(only-in "type-effect-convenience.ss" [make-arr* make-arr]))
(only-in (private type-effect-convenience) [make-arr* make-arr]))
(require (for-template scheme/base "internal-forms.ss"))
(import tc-expr^)

11
collects/typed-scheme/private/tc-let-unit.ss → collects/typed-scheme/typecheck/tc-let-unit.ss
View File

@ -1,14 +1,9 @@
#lang scheme/unit
(require (rename-in "../utils/utils.ss" [infer r:infer]))
(require "signatures.ss"
"type-effect-convenience.ss"
"lexical-env.ss"
"type-annotation.ss"
"type-alias-env.ss"
"type-env.ss"
"parse-type.ss"
"utils.ss"
"type-utils.ss"
(private type-effect-convenience type-annotation parse-type type-utils)
(env lexical-env type-alias-env type-env)
syntax/free-vars
mzlib/trace
scheme/match

17
collects/typed-scheme/private/tc-structs.ss → collects/typed-scheme/typecheck/tc-structs.ss
View File

@ -1,15 +1,12 @@
#lang scheme/base
(require "type-rep.ss" ;; doesn't need tests
"type-effect-convenience.ss" ;; maybe needs tests
"type-env.ss" ;; maybe needs tests
"type-utils.ss"
"parse-type.ss" ;; has tests
"type-environments.ss" ;; doesn't need tests
"type-name-env.ss" ;; maybe needs tests
"union.ss"
"tc-utils.ss"
"resolve-type.ss"
(require (except-in "../utils/utils.ss" extend))
(require (rep type-rep)
(private type-effect-convenience
type-utils parse-type
union resolve-type)
(env type-env type-environments type-name-env)
(utils tc-utils)
"def-binding.ss"
syntax/kerncase
syntax/struct

19
collects/typed-scheme/private/tc-toplevel.ss → collects/typed-scheme/typecheck/tc-toplevel.ss
View File

@ -1,26 +1,17 @@
#lang scheme/unit
(require (rename-in "../utils/utils.ss" [infer r:infer]))
(require syntax/kerncase
mzlib/etc
scheme/match
"signatures.ss"
"tc-structs.ss"
"type-utils.ss"
"utils.ss" ;; doesn't need tests
"type-effect-convenience.ss" ;; maybe needs tests
"internal-forms.ss" ;; doesn't need tests
"type-env.ss" ;; maybe needs tests
"parse-type.ss" ;; has tests
"tc-utils.ss" ;; doesn't need tests
"type-annotation.ss" ;; has tests
"type-name-env.ss" ;; maybe needs tests
"init-envs.ss"
"mutated-vars.ss"
(private type-utils type-effect-convenience parse-type type-annotation mutated-vars type-contract)
(env type-env init-envs type-name-env type-alias-env)
(utils tc-utils)
"provide-handling.ss"
"def-binding.ss"
"provide-handling.ss"
"type-alias-env.ss"
"type-contract.ss"
(for-template
"internal-forms.ss"
mzlib/contract

3
collects/typed-scheme/private/typechecker.ss → collects/typed-scheme/typecheck/typechecker.ss
View File

@ -1,6 +1,7 @@
#lang scheme/base
(require "unit-utils.ss"
(require "../utils/utils.ss")
(require (utils unit-utils)
mzlib/trace
(only-in scheme/unit provide-signature-elements)
"signatures.ss" "tc-toplevel.ss"

26
collects/typed-scheme/typed-scheme.ss
View File

@ -1,22 +1,18 @@
#lang scheme/base
(require "private/base-env.ss"
"private/base-types.ss"
(require (rename-in "utils/utils.ss" [infer r:infer]))
(require (private base-env base-types)
(for-syntax
scheme/base
"private/type-utils.ss"
"private/typechecker.ss"
"private/type-rep.ss"
"private/provide-handling.ss"
"private/type-environments.ss"
"private/tc-utils.ss"
"private/type-name-env.ss"
"private/type-alias-env.ss"
(except-in "private/utils.ss" extend)
(only-in "private/infer-dummy.ss" infer-param)
"private/infer.ss"
"private/type-effect-convenience.ss"
"private/type-contract.ss"
(private type-utils type-contract type-effect-convenience)
(typecheck typechecker provide-handling)
(env type-environments type-name-env type-alias-env)
(r:infer infer)
(utils tc-utils)
(rep type-rep)
(except-in (utils utils) infer extend)
(only-in (r:infer infer-dummy) infer-param)
scheme/nest
syntax/kerncase
scheme/match))

0
collects/typed-scheme/private/tc-utils.ss → collects/typed-scheme/utils/tc-utils.ss
View File

34
collects/typed-scheme/private/utils.ss → collects/typed-scheme/utils/utils.ss
View File

@ -2,6 +2,7 @@
(require (for-syntax scheme/base)
mzlib/plt-match
scheme/require-syntax
mzlib/struct)
(provide with-syntax* syntax-map start-timing do-time reverse-begin printf/log
@ -16,7 +17,38 @@
in-list-forever
extend
debug
in-syntax)
in-syntax
;; require macros
rep utils typecheck infer env private)
(define-syntax (define-requirer stx)
(syntax-case stx ()
[(_ nm)
#`(...
(define-require-syntax nm
(lambda (stx)
(syntax-case stx ()
[(_ id ...)
(andmap identifier? (syntax->list #'(id ...)))
(with-syntax ([(id* ...) (map (lambda (id) (datum->syntax
id
(string->symbol
(string-append
"typed-scheme/"
#,(symbol->string (syntax-e #'nm))
"/"
(symbol->string (syntax-e id))))
id id))
(syntax->list #'(id ...)))])
(syntax/loc stx (combine-in id* ...)))]))))]))
(define-requirer rep)
(define-requirer infer)
(define-requirer typecheck)
(define-requirer utils)
(define-requirer env)
(define-requirer private)
(define-sequence-syntax in-syntax
(lambda () #'syntax->list)