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

Replaced infer-dummy with lazy-require.

Browse Source
This commit is contained in:
Eric Dobson 2012-08-11 16:16:36 -07:00 committed by Sam Tobin-Hochstadt
parent 9ef80edfef
commit ac493a6f44
12 changed files with 20 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/tests/typed-racket/tr-random-testing.rkt
View File

@ -7,11 +7,10 @@
racket/sandbox racket/cmdline racket/sandbox racket/cmdline
"random-real.rkt") "random-real.rkt")
(require (except-in typed-racket/utils/utils infer) (require typed-racket/utils/utils
(typecheck typechecker) (typecheck typechecker)
(utils tc-utils) (utils tc-utils)
(types subtype utils) (types subtype utils))
typed-racket/infer/infer-dummy typed-racket/infer/infer)
(require (prefix-in b: (base-env base-env)) (require (prefix-in b: (base-env base-env))
(prefix-in n: (base-env base-env-numeric))) (prefix-in n: (base-env base-env-numeric)))
@ -105,7 +104,6 @@
(define (get-type e [typecheck (compose tc-expr expand)]) (define (get-type e [typecheck (compose tc-expr expand)])
(parameterize ([delay-errors? #f] (parameterize ([delay-errors? #f]
[current-namespace (namespace-anchor->namespace anch)] [current-namespace (namespace-anchor->namespace anch)]
[infer-param infer]
[orig-module-stx (quote-syntax e)]) [orig-module-stx (quote-syntax e)])
(typecheck (datum->syntax #'here e)))) (typecheck (datum->syntax #'here e))))

2
collects/tests/typed-racket/unit-tests/all-tests.rkt
View File

@ -15,13 +15,11 @@
"module-tests.rkt" ;; pass "module-tests.rkt" ;; pass
"contract-tests.rkt" "contract-tests.rkt"
(r:infer infer infer-dummy)
racket/runtime-path racket/runtime-path
rackunit rackunit/text-ui) rackunit rackunit/text-ui)
(provide unit-tests) (provide unit-tests)
(infer-param infer)
(define-runtime-path special "special-env-typecheck-tests.rkt") (define-runtime-path special "special-env-typecheck-tests.rkt")

3
collects/tests/typed-racket/unit-tests/remove-intersect-tests.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang scheme/base
(require "test-utils.rkt" (for-syntax scheme/base) (require "test-utils.rkt" (for-syntax scheme/base)
(rep type-rep) (rep type-rep)
(r:infer infer infer-dummy) (r:infer infer)
(types abbrev numeric-tower subtype union remove-intersect) (types abbrev numeric-tower subtype union remove-intersect)
rackunit) rackunit)
@ -21,7 +21,6 @@
#'(test-suite "Tests for intersect" #'(test-suite "Tests for intersect"
(test-check (format "Restrict test: ~a ~a" t1 t2) type-compare? (restrict t1 t2) res) ...)])) (test-check (format "Restrict test: ~a ~a" t1 t2) type-compare? (restrict t1 t2) res) ...)]))
(infer-param infer)
(define (restrict-tests) (define (restrict-tests)
(restr-tests (restr-tests

3
collects/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt
View File

@ -9,8 +9,7 @@
[true-lfilter -true-lfilter] [true-lfilter -true-lfilter]
[true-filter -true-filter] [true-filter -true-filter]
[-> t:->])) [-> t:->]))
(except-in (utils tc-utils utils) infer) (utils tc-utils utils)
typed-racket/infer/infer-dummy typed-racket/infer/infer
(utils mutated-vars) (utils mutated-vars)
rackunit rackunit/text-ui rackunit rackunit/text-ui

2
collects/tests/typed-racket/unit-tests/subtype-tests.rkt
View File

@ -4,7 +4,6 @@
(types subtype numeric-tower union utils abbrev) (types subtype numeric-tower union utils abbrev)
(rep type-rep) (rep type-rep)
(env init-envs type-env-structs) (env init-envs type-env-structs)
(r:infer infer infer-dummy)
rackunit rackunit
(for-syntax scheme/base)) (for-syntax scheme/base))
@ -22,7 +21,6 @@
(begin (test-suite "Tests for subtyping" (begin (test-suite "Tests for subtyping"
new-cl ...))))])) new-cl ...))))]))
(infer-param infer)
(define t1 (-mu T (-lst (Un (-v a) T)))) (define t1 (-mu T (-lst (Un (-v a) T))))

5
collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -19,8 +19,7 @@
[true-lfilter -true-lfilter] [true-lfilter -true-lfilter]
[true-filter -true-filter] [true-filter -true-filter]
[-> t:->]) [-> t:->])
(except-in (utils tc-utils utils) infer) (utils tc-utils utils)
typed-racket/infer/infer-dummy typed-racket/infer/infer
(utils mutated-vars) (utils mutated-vars)
(env type-name-env type-env-structs init-envs) (env type-name-env type-env-structs init-envs)
rackunit rackunit/text-ui rackunit rackunit/text-ui
@ -74,7 +73,6 @@
[(_ e) [(_ e)
#`(parameterize ([delay-errors? #f] #`(parameterize ([delay-errors? #f]
[current-namespace (namespace-anchor->namespace anch)] [current-namespace (namespace-anchor->namespace anch)]
[infer-param infer]
[orig-module-stx (quote-syntax e)]) [orig-module-stx (quote-syntax e)])
(let ([ex (expand 'e)]) (let ([ex (expand 'e)])
(parameterize ([mutated-vars (find-mutated-vars ex)]) (parameterize ([mutated-vars (find-mutated-vars ex)])
@ -85,7 +83,6 @@
[(_ e) [(_ e)
#`(parameterize ([delay-errors? #f] #`(parameterize ([delay-errors? #f]
[current-namespace (namespace-anchor->namespace anch)] [current-namespace (namespace-anchor->namespace anch)]
[infer-param infer]
[orig-module-stx (quote-syntax e)]) [orig-module-stx (quote-syntax e)])
(let ([ex (expand 'e)]) (let ([ex (expand 'e)])
(parameterize ([mutated-vars (find-mutated-vars ex)]) (parameterize ([mutated-vars (find-mutated-vars ex)])

6
collects/typed-racket/base-env/base-env-indexing.rkt
View File

@ -1,11 +1,11 @@
#lang racket/base #lang racket/base
(require (require
(rename-in "../utils/utils.rkt" [infer r:infer]) "../utils/utils.rkt"
(types numeric-tower) (env init-envs) (r:infer infer-dummy infer) (types numeric-tower) (env init-envs)
"base-env-indexing-abs.rkt") "base-env-indexing-abs.rkt")
(define e (parameterize ([infer-param infer]) (indexing -Integer))) (define e (indexing -Integer))
(define (initialize-indexing) (initialize-type-env e)) (define (initialize-indexing) (initialize-type-env e))
(provide initialize-indexing) (provide initialize-indexing)

7
collects/typed-racket/base-env/env-lang.rkt
View File

@ -1,12 +1,10 @@
#lang racket/base #lang racket/base
(require (rename-in "../utils/utils.rkt" [infer r:infer])) (require "../utils/utils.rkt")
(require (for-syntax racket/base syntax/parse) (require (for-syntax racket/base syntax/parse)
(utils tc-utils) (utils tc-utils)
(env init-envs) (env init-envs)
(r:infer infer)
(only-in (r:infer infer-dummy) infer-param)
(types abbrev numeric-tower union filter-ops) (types abbrev numeric-tower union filter-ops)
(rep object-rep filter-rep type-rep)) (rep object-rep filter-rep type-rep))
@ -21,8 +19,7 @@
(begin (begin
extra extra
(define e (define e
(parameterize ([infer-param infer]) (make-env [id (λ () ty)] ...))
(make-env [id (λ () ty)] ...)))
(define (init) (define (init)
(initialize-type-env e)) (initialize-type-env e))
(provide init)))] (provide init)))]

9
collects/typed-racket/infer/infer-dummy.rkt
View File

@ -1,9 +0,0 @@
#lang racket/base
(require "../utils/utils.rkt")
(require (rep type-rep) (utils tc-utils))
(define infer-param (make-parameter (lambda e (int-err "infer not initialized"))))
(define (unify X S T) ((infer-param) X null S T (make-Univ)))
;(trace unify)
(provide unify infer-param)

10
collects/typed-racket/private/with-types.rkt
View File

@ -11,17 +11,15 @@
unstable/sequence "../base-env/base-types-extra.rkt" unstable/sequence "../base-env/base-types-extra.rkt"
(path-up "env/type-name-env.rkt" (path-up "env/type-name-env.rkt"
"env/type-alias-env.rkt" "env/type-alias-env.rkt"
"infer/infer-dummy.rkt"
"private/parse-type.rkt" "private/parse-type.rkt"
"private/type-contract.rkt" "private/type-contract.rkt"
"typecheck/typechecker.rkt" "typecheck/typechecker.rkt"
"env/type-env-structs.rkt" "env/type-env-structs.rkt"
"env/global-env.rkt" "env/global-env.rkt"
"env/tvar-env.rkt" "env/tvar-env.rkt"
"infer/infer.rkt"
"utils/tc-utils.rkt" "utils/tc-utils.rkt"
"types/utils.rkt") "utils/utils.rkt"
(except-in (path-up "utils/utils.rkt") infer)) "types/utils.rkt"))
(provide wt-core) (provide wt-core)
@ -67,9 +65,7 @@
[(id ...) exids] [(id ...) exids]
[(ty ...) extys]) [(ty ...) extys])
(local-expand #'(let () (begin (: id ty) ... body ... (values id ...))) ctx null)))) (local-expand #'(let () (begin (: id ty) ... body ... (values id ...))) ctx null))))
(parameterize (;; a cheat to avoid units (parameterize (;; do we report multiple errors
[infer-param infer]
;; do we report multiple errors
[delay-errors? #t] [delay-errors? #t]
;; this parameter is just for printing types ;; this parameter is just for printing types
;; this is a parameter to avoid dependency issues ;; this is a parameter to avoid dependency issues

9
collects/typed-racket/tc-setup.rkt
View File

@ -1,17 +1,14 @@
#lang racket/base #lang racket/base
(require (rename-in "utils/utils.rkt" [infer r:infer]) (require "utils/utils.rkt"
(except-in syntax/parse id) (except-in syntax/parse id)
racket/pretty racket/promise racket/pretty racket/promise
(private type-contract) (private type-contract)
(types utils) (types utils)
(typecheck typechecker provide-handling tc-toplevel) (typecheck typechecker provide-handling tc-toplevel)
(env tvar-env type-name-env type-alias-env env-req) (env tvar-env type-name-env type-alias-env env-req)
(r:infer infer)
(utils tc-utils disarm mutated-vars debug) (utils tc-utils disarm mutated-vars debug)
(rep type-rep) (rep type-rep)
(except-in (utils utils) infer)
(only-in (r:infer infer-dummy) infer-param)
(for-syntax racket/base) (for-syntax racket/base)
(for-template racket/base)) (for-template racket/base))
@ -39,9 +36,7 @@
(with-handlers (with-handlers
(#;[(λ (e) (and (exn:fail? e) (not (exn:fail:syntax? e)) (not (exn:fail:filesystem? e)))) (#;[(λ (e) (and (exn:fail? e) (not (exn:fail:syntax? e)) (not (exn:fail:filesystem? e))))
(λ (e) (tc-error "Internal Typed Racket Error : ~a" e))]) (λ (e) (tc-error "Internal Typed Racket Error : ~a" e))])
(parameterize (;; a cheat to avoid units (parameterize (;; do we report multiple errors
[infer-param infer]
;; do we report multiple errors
[delay-errors? #t] [delay-errors? #t]
;; do we print the fully-expanded syntax? ;; do we print the fully-expanded syntax?
[print-syntax? #f] [print-syntax? #f]

9
collects/typed-racket/types/subtype.rkt
View File

@ -1,10 +1,9 @@
#lang racket/base #lang racket/base
(require "../utils/utils.rkt" (require (except-in "../utils/utils.rkt" infer)
(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 resolve base-abbrev numeric-tower substitute) (types utils resolve base-abbrev numeric-tower substitute)
(env type-name-env) (env type-name-env)
(only-in (infer infer-dummy) unify)
racket/match unstable/match racket/match unstable/match
racket/function racket/function
unstable/lazy-require unstable/lazy-require
@ -12,7 +11,9 @@
(for-syntax racket/base syntax/parse)) (for-syntax racket/base syntax/parse))
(lazy-require (lazy-require
("union.rkt" (Un))) ("union.rkt" (Un))
("../infer/infer.rkt" (infer)))
;; exn representing failure of subtyping ;; exn representing failure of subtyping
;; s,t both types ;; s,t both types
@ -344,7 +345,7 @@
;; use unification to see if we can use the polytype here ;; use unification to see if we can use the polytype here
[((Poly: vs b) s) [((Poly: vs b) s)
(=> unmatch) (=> unmatch)
(if (unify vs (list b) (list s)) A0 (unmatch))] (if (infer vs null (list b) (list s) (make-Univ)) A0 (unmatch))]
[(s (Poly: vs b)) [(s (Poly: vs b))
(=> unmatch) (=> unmatch)
(if (null? (fv b)) (subtype* A0 s b) (unmatch))] (if (null? (fv b)) (subtype* A0 s b) (unmatch))]