diff --git a/collects/typed-scheme/main.ss b/collects/typed-scheme/main.ss index a31d5925a6..dde6b16ebc 100644 --- a/collects/typed-scheme/main.ss +++ b/collects/typed-scheme/main.ss @@ -1,9 +1,10 @@ #lang s-exp "minimal.ss" -(providing (libs (except scheme/base require #%module-begin #%top-interaction with-handlers lambda #%app)) +(providing (libs (except scheme/base #%module-begin #%top-interaction with-handlers lambda #%app) + (except "private/prims.ss")) (basics #%module-begin #%top-interaction - with-handlers lambda - #%app) - (from scheme require)) + #%app)) + +(provide (rename-out [with-handlers: with-handlers])) diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss index f818caf14a..a9ba1625cd 100644 --- a/collects/typed-scheme/private/base-env.ss +++ b/collects/typed-scheme/private/base-env.ss @@ -1,39 +1,20 @@ #lang scheme/base -(require (for-template (only-in (lib "list.ss") foldl) - scheme/base - '#%paramz - scheme/promise - string-constants/string-constant - #;'#%more-scheme - #;'#%qq-and-or - (only-in scheme/match/patterns match:error)) - ) - - +;; these are libraries providing functions we add types to that are not in scheme/base (require "extra-procs.ss" - scheme/promise - (except-in "type-rep.ss" make-arr) (only-in scheme/list cons? take drop add-between) '#%paramz - "type-effect-convenience.ss" - (only-in "type-effect-convenience.ss" [make-arr* make-arr]) - "union.ss" - string-constants/string-constant - (only-in scheme/match/patterns match:error) - "tc-structs.ss") + (only-in scheme/match/patterns match:error)) +;; these are all for constructing the types given to variables (require (for-syntax scheme/base "init-envs.ss" (except-in "type-rep.ss" make-arr) - (only-in (lib "list.ss") foldl) "type-effect-convenience.ss" (only-in "type-effect-convenience.ss" [make-arr* make-arr]) "union.ss" - string-constants/string-constant - (only-in scheme/match/patterns match:error) "tc-structs.ss")) (define-for-syntax (initialize-others) @@ -415,7 +396,7 @@ [copy-file (-> -Pathlike -Pathlike -Void)] [bytes->string/utf-8 (-> -Bytes -String)] ;; language - [(expand #'(this-language)) + [(expand '(this-language)) Sym string-constants/string-constant] ;; make-promise @@ -501,8 +482,10 @@ (-> (-Syntax Univ) Univ Univ)))] ))) -(begin-for-syntax (initialize-type-env initial-env) - (initialize-others)) +(begin-for-syntax + ;(printf "running base-env~n") + (initialize-type-env initial-env) + (initialize-others)) diff --git a/collects/typed-scheme/private/base-types.ss b/collects/typed-scheme/private/base-types.ss index 8ee28858ef..aca610a8c3 100644 --- a/collects/typed-scheme/private/base-types.ss +++ b/collects/typed-scheme/private/base-types.ss @@ -1,40 +1,12 @@ #lang scheme/base -(require (for-template (only-in (lib "list.ss") foldl) - scheme/base - '#%paramz - scheme/promise - string-constants/string-constant - #;'#%more-scheme - #;'#%qq-and-or - (only-in scheme/match/patterns match:error)) - ) - - -(require - "extra-procs.ss" - "init-envs.ss" - scheme/promise - (except-in "type-rep.ss" make-arr) - (only-in scheme/list cons?) - "type-effect-convenience.ss" - (only-in "type-effect-convenience.ss" [make-arr* make-arr]) - "union.ss" - string-constants/string-constant - (only-in scheme/match/patterns match:error) - "tc-structs.ss") - (require (for-syntax scheme/base "init-envs.ss" (except-in "type-rep.ss" make-arr) - (only-in (lib "list.ss") foldl) "type-effect-convenience.ss" (only-in "type-effect-convenience.ss" [make-arr* make-arr]) - "union.ss" - string-constants/string-constant - (only-in scheme/match/patterns match:error) - "tc-structs.ss")) + "union.ss")) ;; the initial type name environment - just the base types (define-syntax (define-tname-env stx) @@ -49,7 +21,7 @@ (initialize-type-name-env (list (list #'nm ty) ...))) (begin-for-syntax - ;(printf "phase is ~a~n" (syntax-local-phase-level)) + ;(printf "running base-types~n") (initer)))])) (define-syntax (define-other-types stx) diff --git a/collects/typed-scheme/private/prims.ss b/collects/typed-scheme/private/prims.ss index 57d8db02df..e5840ecfb8 100644 --- a/collects/typed-scheme/private/prims.ss +++ b/collects/typed-scheme/private/prims.ss @@ -35,19 +35,11 @@ This file defines two sorts of primitives. All of them are provided into any mod (require "require-contract.ss" "internal-forms.ss" - "planet-requires.ss" - (lib "etc.ss") (except-in (lib "contract.ss") ->) (only-in (lib "contract.ss") [-> c->]) (lib "struct.ss") "base-types.ss") - - - - - - (define-for-syntax (ignore stx) (syntax-property stx 'typechecker:ignore #t)) (define-for-syntax (internal stx) diff --git a/collects/typed-scheme/private/tc-toplevel.ss b/collects/typed-scheme/private/tc-toplevel.ss index 1909f9e7f1..20ae12e9df 100644 --- a/collects/typed-scheme/private/tc-toplevel.ss +++ b/collects/typed-scheme/private/tc-toplevel.ss @@ -21,9 +21,9 @@ "provide-handling.ss" "type-alias-env.ss" "type-contract.ss" - (only-in "prims.ss" :) + ;(only-in "prims.ss" :) (for-template - (only-in "prims.ss" :) + ;(only-in "prims.ss" :) "internal-forms.ss" "tc-utils.ss" (lib "contract.ss") diff --git a/collects/typed-scheme/typed-scheme.ss b/collects/typed-scheme/typed-scheme.ss index 5ae7954d08..77d688f763 100644 --- a/collects/typed-scheme/typed-scheme.ss +++ b/collects/typed-scheme/typed-scheme.ss @@ -1,45 +1,29 @@ #lang scheme/base -(require "private/prims.ss" - "private/init-envs.ss" - "private/extra-procs.ss" - "private/internal-forms.ss" - "private/base-env.ss" +(require "private/base-env.ss" "private/base-types.ss" (for-syntax scheme/base "private/type-utils.ss" - "private/typechecker.ss" + "private/typechecker.ss" "private/type-rep.ss" "private/provide-handling.ss" - "private/type-environments.ss" "private/tc-utils.ss" - "private/type-env.ss" "private/type-name-env.ss" + "private/type-environments.ss" + "private/tc-utils.ss" + "private/type-name-env.ss" "private/type-alias-env.ss" "private/utils.ss" - "private/internal-forms.ss" - "private/init-envs.ss" "private/type-effect-convenience.ss" - "private/effect-rep.ss" - "private/rep-utils.ss" "private/type-contract.ss" - ;(only-in "private/base-types.ss" init-tnames) scheme/nest syntax/kerncase scheme/match)) - -(provide - ;; provides syntax such as define: and define-typed-struct - (all-from-out "private/prims.ss") - ;; provides some pointless procedures - should be removed - (all-from-out "private/extra-procs.ss")) - (provide-tnames) (provide-extra-tnames) (provide (rename-out [module-begin #%module-begin] - [with-handlers: with-handlers] [top-interaction #%top-interaction] [#%plain-lambda lambda] [#%plain-app #%app] @@ -63,7 +47,7 @@ [with-handlers ([(lambda (e) (and catch-errors? (exn:fail? e) (not (exn:fail:syntax? e)))) (lambda (e) (tc-error "Internal error: ~a" e))])] - [parameterize ([delay-errors? #f] + [parameterize ([delay-errors? #t] ;; this parameter is for parsing types [current-tvars initial-tvar-env] ;; this parameter is just for printing types