Removed convenience.rkt from typed racket.
original commit: 9ed360bb5e3fd793ac4479507852aa282125fd61
This commit is contained in:
Eric Dobson
Sam Tobin-Hochstadt
parent
2009c1da8a
commit
3d2814de81
|
|
@ -4,9 +4,7 @@
|
|||
(for-syntax scheme/base)
|
||||
(for-template scheme/base)
|
||||
(private type-contract)
|
||||
(rep type-rep filter-rep object-rep)
|
||||
(types utils union convenience)
|
||||
(utils tc-utils)
|
||||
(types abbrev numeric-tower)
|
||||
rackunit)
|
||||
|
||||
(define-syntax-rule (t e)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
(require "test-utils.rkt" (for-syntax scheme/base))
|
||||
(require (rep type-rep)
|
||||
(r:infer infer)
|
||||
(types convenience union utils abbrev)
|
||||
(types numeric-tower union utils abbrev)
|
||||
rackunit)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
(utils tc-utils)
|
||||
(env type-alias-env type-env-structs tvar-env type-name-env init-envs)
|
||||
(rep type-rep)
|
||||
(rename-in (types subtype union utils convenience)
|
||||
(rename-in (types subtype union utils abbrev numeric-tower)
|
||||
[Un t:Un] [-> t:->] [->* t:->*])
|
||||
(base-env base-types base-types-extra colon)
|
||||
(for-template (base-env base-types base-types-extra base-env colon))
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
(require "test-utils.rkt" (for-syntax scheme/base)
|
||||
(rep type-rep)
|
||||
(r:infer infer infer-dummy)
|
||||
(types convenience subtype union remove-intersect)
|
||||
(types abbrev numeric-tower subtype union remove-intersect)
|
||||
rackunit)
|
||||
|
||||
(define-syntax (over-tests stx)
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
(for-syntax scheme/base)
|
||||
(for-template scheme/base)
|
||||
(rep type-rep filter-rep object-rep)
|
||||
(for-syntax (rename-in (types utils union convenience abbrev filter-ops)
|
||||
(for-syntax (rename-in (types utils union numeric-tower abbrev filter-ops)
|
||||
[Un t:Un]
|
||||
[true-lfilter -true-lfilter]
|
||||
[true-filter -true-filter]
|
||||
|
|
@ -12,12 +12,12 @@
|
|||
(except-in (utils tc-utils utils) infer)
|
||||
typed-racket/infer/infer-dummy typed-racket/infer/infer
|
||||
(utils mutated-vars)
|
||||
|
||||
|
||||
rackunit rackunit/text-ui
|
||||
syntax/parse
|
||||
syntax/parse
|
||||
racket/file racket/port
|
||||
(for-syntax syntax/kerncase syntax/parse racket/syntax
|
||||
(types abbrev convenience utils)
|
||||
(types abbrev numeric-tower utils)
|
||||
(utils mutated-vars)
|
||||
(utils tc-utils) (typecheck typechecker))
|
||||
typed-racket/base-env/prims
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require "test-utils.rkt"
|
||||
(types subtype convenience union utils abbrev)
|
||||
(types subtype numeric-tower union utils abbrev)
|
||||
(rep type-rep)
|
||||
(env init-envs type-env-structs)
|
||||
(r:infer infer infer-dummy)
|
||||
|
|
@ -18,9 +18,9 @@
|
|||
(syntax-case stx ()
|
||||
[(_ cl ...)
|
||||
(with-syntax ([(new-cl ...) (map single-test (syntax->list #'(cl ...)))])
|
||||
(syntax/loc stx
|
||||
(begin (test-suite "Tests for subtyping"
|
||||
new-cl ...))))]))
|
||||
(syntax/loc stx
|
||||
(begin (test-suite "Tests for subtyping"
|
||||
new-cl ...))))]))
|
||||
|
||||
(infer-param infer)
|
||||
|
||||
|
|
@ -112,9 +112,9 @@
|
|||
[(->* (list -Number -Number) -Boolean -Number) (->* (list -Number -Number -Boolean -Boolean) -Number)]
|
||||
|
||||
[(-poly (a) (cl-> [() a]
|
||||
[(-Number) a]))
|
||||
[(-Number) a]))
|
||||
(cl-> [() (-pair -Number (-v b))]
|
||||
[(-Number) (-pair -Number (-v b))])]
|
||||
[(-Number) (-pair -Number (-v b))])]
|
||||
|
||||
[(-values (list -Number)) (-values (list Univ))]
|
||||
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
define lambda λ)
|
||||
(typecheck typechecker)
|
||||
(rep type-rep filter-rep object-rep)
|
||||
(rename-in (types utils union convenience abbrev filter-ops)
|
||||
(rename-in (types utils union numeric-tower abbrev filter-ops)
|
||||
[Un t:Un]
|
||||
[true-lfilter -true-lfilter]
|
||||
[true-filter -true-filter]
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
"../utils/utils.rkt"
|
||||
(for-template racket/base racket/list racket/unsafe/ops racket/flonum)
|
||||
(utils tc-utils)
|
||||
(rename-in (types union convenience) [-Number N] [-Boolean B] [-Symbol Sym]))
|
||||
(rename-in (types union abbrev numeric-tower) [-Number N] [-Boolean B] [-Symbol Sym]))
|
||||
|
||||
(provide indexing)
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(require
|
||||
(rename-in "../utils/utils.rkt" [infer r:infer])
|
||||
(types convenience) (env init-envs) (r:infer infer-dummy infer)
|
||||
(types numeric-tower) (env init-envs) (r:infer infer-dummy infer)
|
||||
"base-env-indexing-abs.rkt")
|
||||
|
||||
(define e (parameterize ([infer-param infer]) (indexing -Integer)))
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
racket/list racket/math racket/flonum racket/unsafe/ops
|
||||
(for-template racket/flonum racket/fixnum racket/math racket/unsafe/ops racket/base
|
||||
(only-in "../types/numeric-predicates.rkt" index?))
|
||||
(only-in (types convenience) [-Number N] [-Boolean B] [-Symbol Sym] [-Real R] [-PosInt -Pos]))
|
||||
(only-in (types abbrev numeric-tower) [-Number N] [-Boolean B] [-Symbol Sym] [-Real R] [-PosInt -Pos]))
|
||||
|
||||
;; TODO having definitions only at the top is really inconvenient.
|
||||
|
||||
|
|
|
|||
|
|
@ -25,8 +25,11 @@
|
|||
(only-in racket/match/runtime match:error matchable? match-equality-test))
|
||||
racket/file
|
||||
(only-in racket/private/pre-base new-apply-proc)
|
||||
(only-in (types convenience) [-Number N] [-Boolean B] [-Symbol Sym])
|
||||
(only-in (types abbrev) [-Boolean B] [-Symbol Sym])
|
||||
(only-in (types numeric-tower) [-Number N])
|
||||
(only-in (rep type-rep)
|
||||
make-Name
|
||||
make-ValuesDots
|
||||
make-MPairTop
|
||||
make-BoxTop make-ChannelTop make-VectorTop
|
||||
make-ThreadCellTop
|
||||
|
|
@ -38,7 +41,7 @@
|
|||
;Section 9.2
|
||||
|
||||
[raise (cl->* (Univ . -> . (Un))
|
||||
(Univ Univ . -> . (Un)))]
|
||||
(Univ Univ . -> . (Un)))]
|
||||
|
||||
[error
|
||||
(cl->* (-> Sym (Un))
|
||||
|
|
@ -247,8 +250,8 @@
|
|||
|
||||
|
||||
[assert (-poly (a b) (cl->*
|
||||
(Univ (make-pred-ty (list a) Univ b) . -> . b)
|
||||
(-> (Un a (-val #f)) a)))]
|
||||
(Univ (make-pred-ty (list a) Univ b) . -> . b)
|
||||
(-> (Un a (-val #f)) a)))]
|
||||
[defined? (->* (list Univ) -Boolean : (-FS (-not-filter -Undefined 0 null) (-filter -Undefined 0 null)))]
|
||||
|
||||
|
||||
|
|
@ -389,12 +392,12 @@
|
|||
[list (-poly (a) (->* '() a (-lst a)))]
|
||||
[procedure? (make-pred-ty top-func)]
|
||||
[map (-polydots (c a b)
|
||||
(cl->*
|
||||
(-> (-> a c) (-pair a (-lst a)) (-pair c (-lst c)))
|
||||
((list
|
||||
((list a) (b b) . ->... . c)
|
||||
(-lst a))
|
||||
((-lst b) b) . ->... .(-lst c))))]
|
||||
(cl->*
|
||||
(-> (-> a c) (-pair a (-lst a)) (-pair c (-lst c)))
|
||||
((list
|
||||
((list a) (b b) . ->... . c)
|
||||
(-lst a))
|
||||
((-lst b) b) . ->... .(-lst c))))]
|
||||
[for-each (-polydots (c a b) ((list ((list a) (b b) . ->... . Univ) (-lst a))
|
||||
((-lst b) b) . ->... . -Void))]
|
||||
#;[fold-left (-polydots (c a b) ((list ((list c a) (b b) . ->... . c) c (-lst a))
|
||||
|
|
@ -1457,8 +1460,8 @@
|
|||
|
||||
[tcp-abandon-port (-Port . -> . -Void)]
|
||||
[tcp-addresses (cl->*
|
||||
(-Port [(-val #f)] . ->opt . (-values (list -String -String)))
|
||||
(-Port (-val #t) . -> . (-values (list -String -Index -String -Index))))]
|
||||
(-Port [(-val #f)] . ->opt . (-values (list -String -String)))
|
||||
(-Port (-val #t) . -> . (-values (list -String -Index -String -Index))))]
|
||||
|
||||
[tcp-port? (asym-pred Univ B (-FS (-filter (Un -Input-Port -Output-Port) 0) -top))]
|
||||
|
||||
|
|
@ -1750,8 +1753,8 @@
|
|||
|
||||
;; probably the most useful cases
|
||||
[curry (-poly (a b c)
|
||||
(cl->* ((a b . -> . c) a . -> . (b . -> . c))
|
||||
((a b . -> . c) . -> . (a . -> . (b . -> . c)))))]
|
||||
(cl->* ((a b . -> . c) a . -> . (b . -> . c))
|
||||
((a b . -> . c) . -> . (a . -> . (b . -> . c)))))]
|
||||
;; mutable pairs
|
||||
[mcons (-poly (a b) (-> a b (-mpair a b)))]
|
||||
[mcar (-poly (a b)
|
||||
|
|
|
|||
|
|
@ -11,8 +11,7 @@
|
|||
(utils tc-utils)
|
||||
(env init-envs)
|
||||
(except-in (rep filter-rep object-rep type-rep) make-arr)
|
||||
(types convenience union)
|
||||
(only-in (types convenience) [make-arr* make-arr])
|
||||
(rename-in (types abbrev numeric-tower union) [make-arr* make-arr])
|
||||
(for-syntax racket/base syntax/parse (only-in racket/syntax syntax-local-eval)))
|
||||
|
||||
(define-syntax (define-initial-env stx)
|
||||
|
|
|
|||
|
|
@ -5,8 +5,7 @@
|
|||
(utils tc-utils)
|
||||
(env init-envs)
|
||||
(except-in (rep filter-rep object-rep type-rep) make-arr)
|
||||
(types convenience union)
|
||||
(only-in (types convenience) [make-arr* make-arr])
|
||||
(rename-in (types abbrev numeric-tower union) [make-arr* make-arr])
|
||||
(typecheck tc-structs)
|
||||
;;For tests
|
||||
(prefix-in k: '#%kernel))
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
;; I don't understand this at all. :(
|
||||
;; -- STH, 6/26/12
|
||||
(require (for-syntax "../env/global-env.rkt"))
|
||||
(require "../types/convenience.rkt" "../rep/type-rep.rkt")
|
||||
(require "../types/abbrev.rkt" "../types/numeric-tower.rkt" "../rep/type-rep.rkt")
|
||||
|
||||
[Complex -Number]
|
||||
[Number -Number]
|
||||
|
|
|
|||
|
|
@ -7,9 +7,8 @@
|
|||
(env init-envs)
|
||||
(r:infer infer)
|
||||
(only-in (r:infer infer-dummy) infer-param)
|
||||
(except-in (rep object-rep filter-rep type-rep) make-arr)
|
||||
(types convenience union filter-ops)
|
||||
(only-in (types convenience) [make-arr* make-arr]))
|
||||
(types abbrev numeric-tower union filter-ops)
|
||||
(rep object-rep filter-rep type-rep))
|
||||
|
||||
(define-syntax (-#%module-begin stx)
|
||||
(define-syntax-class clause
|
||||
|
|
@ -17,15 +16,15 @@
|
|||
(pattern [id:identifier ty]))
|
||||
(syntax-parse stx #:literals (require begin)
|
||||
[(mb (~optional (~and extra (~or (begin . _) (require . args))))
|
||||
~! :clause ...)
|
||||
~! :clause ...)
|
||||
#'(#%plain-module-begin
|
||||
(begin
|
||||
extra
|
||||
(define e
|
||||
(parameterize ([infer-param infer])
|
||||
(make-env [id (λ () ty)] ...)))
|
||||
(define (init)
|
||||
(initialize-type-env e))
|
||||
(begin
|
||||
extra
|
||||
(define e
|
||||
(parameterize ([infer-param infer])
|
||||
(make-env [id (λ () ty)] ...)))
|
||||
(define (init)
|
||||
(initialize-type-env e))
|
||||
(provide init)))]
|
||||
[(mb . rest)
|
||||
#'(mb (begin) . rest)]))
|
||||
|
|
@ -34,4 +33,4 @@
|
|||
require
|
||||
(except-out (all-from-out racket/base) #%module-begin)
|
||||
types rep private utils
|
||||
(types-out convenience union filter-ops))
|
||||
(types-out abbrev numeric-tower union filter-ops))
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
(private with-types type-contract parse-type)
|
||||
(except-in syntax/parse id)
|
||||
racket/match racket/syntax unstable/match racket/list
|
||||
(types utils convenience generalize)
|
||||
(types utils abbrev generalize)
|
||||
(typecheck provide-handling tc-toplevel tc-app-helper)
|
||||
(rep type-rep)
|
||||
(env env-req)
|
||||
|
|
|
|||
4
collects/typed-racket/env/init-envs.rkt
vendored
4
collects/typed-racket/env/init-envs.rkt
vendored
|
|
@ -7,9 +7,9 @@
|
|||
"type-alias-env.rkt"
|
||||
(rep type-rep object-rep filter-rep rep-utils)
|
||||
(for-template (rep type-rep object-rep filter-rep)
|
||||
(types union convenience)
|
||||
(types union abbrev)
|
||||
racket/shared racket/base)
|
||||
(types union convenience)
|
||||
(types abbrev)
|
||||
racket/syntax
|
||||
mzlib/pconvert racket/match)
|
||||
|
||||
|
|
|
|||
6
collects/typed-racket/env/lexical-env.rkt
vendored
6
collects/typed-racket/env/lexical-env.rkt
vendored
|
|
@ -7,17 +7,17 @@
|
|||
;; but split here for performance
|
||||
|
||||
(require "../utils/utils.rkt"
|
||||
"type-env-structs.rkt"
|
||||
"type-env-structs.rkt"
|
||||
"global-env.rkt"
|
||||
"../types/kw-types.rkt"
|
||||
syntax/id-table
|
||||
syntax/id-table
|
||||
racket/keyword-transform racket/list
|
||||
(for-syntax syntax/parse syntax/parse/experimental/contract racket/base)
|
||||
(only-in racket/contract ->* -> or/c any/c listof cons/c)
|
||||
(utils tc-utils mutated-vars)
|
||||
(only-in (rep type-rep) Type/c)
|
||||
(typecheck tc-metafunctions)
|
||||
(except-in (types utils convenience) -> ->*))
|
||||
(except-in (types utils abbrev) -> ->*))
|
||||
|
||||
(provide lexical-env with-lexical-env with-lexical-env/extend
|
||||
with-lexical-env/extend/props update-type/lexical)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#lang racket/unit
|
||||
|
||||
(require "../utils/utils.rkt"
|
||||
(types convenience utils union subtype)
|
||||
(types abbrev utils union subtype)
|
||||
(rep type-rep)
|
||||
(utils tc-utils)
|
||||
unstable/sequence unstable/hash
|
||||
|
|
|
|||
|
|
@ -4,8 +4,8 @@
|
|||
(except-in
|
||||
(combine-in
|
||||
(utils tc-utils)
|
||||
(rep free-variance type-rep filter-rep rep-utils)
|
||||
(types utils convenience union subtype remove-intersect resolve
|
||||
(rep free-variance type-rep filter-rep object-rep rep-utils)
|
||||
(types utils abbrev numeric-tower union subtype remove-intersect resolve
|
||||
substitute generalize)
|
||||
(env type-name-env index-env tvar-env))
|
||||
make-env -> ->* one-of/c)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(require "../utils/utils.rkt")
|
||||
(require (rep type-rep rep-utils)
|
||||
(types convenience union utils)
|
||||
(types abbrev union utils)
|
||||
"signatures.rkt"
|
||||
racket/list racket/match)
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
"../utils/utils.rkt"
|
||||
(utils tc-utils)
|
||||
(rep type-rep)
|
||||
(types convenience utils type-table)
|
||||
(types abbrev utils type-table)
|
||||
(optimizer utils logging)
|
||||
(for-template racket/base racket/unsafe/ops))
|
||||
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
(for-template racket/base racket/unsafe/ops)
|
||||
"../utils/utils.rkt" "../utils/tc-utils.rkt"
|
||||
(rep type-rep)
|
||||
(types convenience type-table utils)
|
||||
(types abbrev type-table utils)
|
||||
(optimizer utils logging string
|
||||
float)) ; for int-expr
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
(for-template racket/base racket/unsafe/ops)
|
||||
"../utils/utils.rkt"
|
||||
(utils tc-utils)
|
||||
(types convenience)
|
||||
(types abbrev)
|
||||
(optimizer utils logging))
|
||||
|
||||
(provide string-opt-expr string-expr bytes-expr)
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
#lang racket/base
|
||||
|
||||
(require "../utils/utils.rkt"
|
||||
(except-in (rep type-rep) make-arr)
|
||||
(rename-in (types convenience union utils printer filter-ops resolve)
|
||||
(except-in (rep type-rep object-rep filter-rep) make-arr)
|
||||
(rename-in (types abbrev union utils printer filter-ops resolve)
|
||||
[make-arr* make-arr])
|
||||
(utils tc-utils stxclass-util)
|
||||
syntax/stx (prefix-in c: racket/contract)
|
||||
|
|
@ -40,10 +40,10 @@
|
|||
(parse-type #'ty)]
|
||||
[(x ...)
|
||||
#:fail-unless (= 1 (length
|
||||
(for/list ([i (syntax->list #'(x ...))]
|
||||
#:when (and (identifier? i)
|
||||
(free-identifier=? i #'t:->)))
|
||||
i)))
|
||||
(for/list ([i (syntax->list #'(x ...))]
|
||||
#:when (and (identifier? i)
|
||||
(free-identifier=? i #'t:->)))
|
||||
i)))
|
||||
#f
|
||||
(parse-type s)]))
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
(rep type-rep)
|
||||
(utils tc-utils)
|
||||
(env global-env)
|
||||
(except-in (types subtype union convenience resolve utils generalize) -> ->* one-of/c)
|
||||
(except-in (types subtype union resolve utils generalize))
|
||||
(private parse-type)
|
||||
(contract-req)
|
||||
racket/match)
|
||||
|
|
|
|||
|
|
@ -10,14 +10,14 @@
|
|||
(utils tc-utils require-contract)
|
||||
(env type-name-env)
|
||||
(types resolve utils)
|
||||
(prefix-in t: (types convenience))
|
||||
(prefix-in t: (types abbrev numeric-tower))
|
||||
(private parse-type)
|
||||
racket/match unstable/match syntax/struct syntax/stx racket/syntax racket/list
|
||||
(only-in racket/contract -> ->* case-> cons/c flat-rec-contract provide/contract any/c)
|
||||
(for-template racket/base racket/contract racket/set (utils any-wrap)
|
||||
(prefix-in t: (types numeric-predicates))
|
||||
(only-in unstable/contract sequence/c)
|
||||
(only-in racket/class object% is-a?/c subclass?/c object-contract class/c init object/c class?)))
|
||||
(only-in racket/class object% is-a?/c subclass?/c object-contract class/c init object/c class?)))
|
||||
|
||||
(define (define/fixup-contract? stx)
|
||||
(or (syntax-property stx 'typechecker:contract-def)
|
||||
|
|
@ -95,14 +95,14 @@
|
|||
[(list r) r]
|
||||
[_ #`(values #,@rngs*)])]
|
||||
[rst* rst])
|
||||
;; Garr, I hate case->!
|
||||
(if (and (pair? (syntax-e #'(opt-dom* ...))) case->)
|
||||
(exit (fail))
|
||||
(if (or rst (pair? (syntax-e #'(opt-dom* ...))))
|
||||
(if case->
|
||||
#'(dom* ... #:rest (listof rst*) . -> . rng*)
|
||||
#'((dom* ...) (opt-dom* ...) #:rest (listof rst*) . ->* . rng*))
|
||||
#'(dom* ... . -> . rng*)))))
|
||||
;; Garr, I hate case->!
|
||||
(if (and (pair? (syntax-e #'(opt-dom* ...))) case->)
|
||||
(exit (fail))
|
||||
(if (or rst (pair? (syntax-e #'(opt-dom* ...))))
|
||||
(if case->
|
||||
#'(dom* ... #:rest (listof rst*) . -> . rng*)
|
||||
#'((dom* ...) (opt-dom* ...) #:rest (listof rst*) . ->* . rng*))
|
||||
#'(dom* ... . -> . rng*)))))
|
||||
(unless (no-duplicates (for/list ([t arrs])
|
||||
(match t
|
||||
[(arr: dom _ _ _ _) (length dom)]
|
||||
|
|
@ -185,7 +185,7 @@
|
|||
([cnts (append (map t->c vars) (map t->c notvars))])
|
||||
#'(or/c . cnts)))]
|
||||
[(and t (Function: _)) (t->c/fun t)]
|
||||
[(Set: t) #`(set/c #,(t->c t))]
|
||||
[(Set: t) #`(set/c #,(t->c t))]
|
||||
[(Sequence: ts) #`(sequence/c #,@(map t->c ts))]
|
||||
[(Vector: t)
|
||||
(when flat? (exit (fail)))
|
||||
|
|
@ -202,7 +202,7 @@
|
|||
#`(flat-named-contract (quote #,(syntax-e p?)) #,(cert p?))]
|
||||
[(F: v) (cond [(assoc v (vars)) => second]
|
||||
[else (int-err "unknown var: ~a" v)])]
|
||||
[(Poly: vs b)
|
||||
[(Poly: vs b)
|
||||
(if from-typed?
|
||||
;; in positive position, no checking needed for the variables
|
||||
(parameterize ([vars (append (for/list ([v vs]) (list v #'any/c)) (vars))])
|
||||
|
|
@ -286,7 +286,7 @@
|
|||
[(Syntax: t) #`(syntax/c #,(t->c t))]
|
||||
[(Value: v) #`(flat-named-contract #,(format "~a" v) (lambda (x) (equal? x '#,v)))]
|
||||
[(Param: in out) #`(parameter/c #,(t->c out))]
|
||||
[(Hashtable: k v)
|
||||
[(Hashtable: k v)
|
||||
(when flat? (exit (fail)))
|
||||
#`(hash/c #,(t->c k) #,(t->c v) #:immutable 'dont-care)]
|
||||
[else
|
||||
|
|
|
|||
|
|
@ -9,20 +9,18 @@
|
|||
"../tc-setup.rkt"
|
||||
syntax/parse racket/match
|
||||
unstable/sequence "../base-env/base-types-extra.rkt"
|
||||
(except-in (path-up "env/type-name-env.rkt"
|
||||
"env/type-alias-env.rkt"
|
||||
"infer/infer-dummy.rkt"
|
||||
"private/parse-type.rkt"
|
||||
"private/type-contract.rkt"
|
||||
"typecheck/typechecker.rkt"
|
||||
"env/type-env-structs.rkt"
|
||||
"env/global-env.rkt"
|
||||
"env/tvar-env.rkt"
|
||||
"infer/infer.rkt"
|
||||
"utils/tc-utils.rkt"
|
||||
"types/utils.rkt"
|
||||
"types/convenience.rkt")
|
||||
->)
|
||||
(path-up "env/type-name-env.rkt"
|
||||
"env/type-alias-env.rkt"
|
||||
"infer/infer-dummy.rkt"
|
||||
"private/parse-type.rkt"
|
||||
"private/type-contract.rkt"
|
||||
"typecheck/typechecker.rkt"
|
||||
"env/type-env-structs.rkt"
|
||||
"env/global-env.rkt"
|
||||
"env/tvar-env.rkt"
|
||||
"infer/infer.rkt"
|
||||
"utils/tc-utils.rkt"
|
||||
"types/utils.rkt")
|
||||
(except-in (path-up "utils/utils.rkt") infer))
|
||||
|
||||
(provide wt-core)
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
(except-in syntax/parse id)
|
||||
racket/pretty racket/promise
|
||||
(private type-contract)
|
||||
(types utils convenience)
|
||||
(types utils)
|
||||
(typecheck typechecker provide-handling tc-toplevel)
|
||||
(env tvar-env type-name-env type-alias-env env-req)
|
||||
(r:infer infer)
|
||||
|
|
|
|||
|
|
@ -2,9 +2,9 @@
|
|||
|
||||
(require (rename-in "../utils/utils.rkt" [private private-in])
|
||||
racket/match (prefix-in - racket/contract)
|
||||
(types utils convenience union subtype remove-intersect type-table filter-ops)
|
||||
(types utils union subtype remove-intersect type-table filter-ops)
|
||||
(private-in parse-type type-annotation)
|
||||
(rep type-rep)
|
||||
(rep type-rep object-rep filter-rep)
|
||||
(only-in (infer infer) restrict)
|
||||
(except-in (utils tc-utils stxclass-util))
|
||||
(env lexical-env type-env-structs tvar-env index-env)
|
||||
|
|
|
|||
|
|
@ -1,14 +1,14 @@
|
|||
#lang racket/unit
|
||||
|
||||
(require "../utils/utils.rkt"
|
||||
syntax/kerncase
|
||||
syntax/parse
|
||||
syntax/kerncase
|
||||
syntax/parse
|
||||
racket/match
|
||||
"signatures.rkt" "tc-metafunctions.rkt"
|
||||
"tc-funapp.rkt" "tc-subst.rkt"
|
||||
(types utils convenience union subtype)
|
||||
(utils tc-utils)
|
||||
(rep type-rep))
|
||||
(types utils abbrev union subtype)
|
||||
(utils tc-utils)
|
||||
(rep type-rep))
|
||||
|
||||
(import tc-if^ tc-lambda^ tc-app^ tc-let^ tc-expr^)
|
||||
(export check-subforms^)
|
||||
|
|
@ -69,8 +69,8 @@
|
|||
(set! body-stx form)
|
||||
(set! body-ty (tc-expr form))]
|
||||
[(a . b)
|
||||
(loop #'a)
|
||||
(loop #'b)]
|
||||
(loop #'a)
|
||||
(loop #'b)]
|
||||
[_ (void)])))
|
||||
(apply combine-types body-ty handler-tys))
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
"check-below.rkt" "tc-subst.rkt"
|
||||
(utils tc-utils)
|
||||
(rep type-rep object-rep)
|
||||
(types utils union convenience subtype))
|
||||
(types utils union abbrev subtype))
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
|
|
@ -40,7 +40,7 @@
|
|||
ta))])
|
||||
(define-values (t-r f-r o-r)
|
||||
(for/lists (t-r f-r o-r)
|
||||
([r (in-list results)])
|
||||
([r (in-list results)])
|
||||
(open-Result r o-a t-a)))
|
||||
(ret t-r f-r o-r)))]
|
||||
[((arr: _ _ _ drest '()) _)
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
;; end fixme
|
||||
(for-syntax syntax/parse racket/base (utils tc-utils))
|
||||
(private type-annotation)
|
||||
(types utils union subtype resolve convenience
|
||||
(types utils union subtype resolve abbrev
|
||||
type-table substitute generalize)
|
||||
(utils tc-utils)
|
||||
(except-in (env type-env-structs tvar-env index-env) extend)
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
;; end fixme
|
||||
(for-syntax syntax/parse scheme/base (utils tc-utils))
|
||||
(private type-annotation)
|
||||
(types utils abbrev union subtype resolve convenience type-table substitute generalize)
|
||||
(types utils abbrev numeric-tower union subtype resolve type-table substitute generalize)
|
||||
(utils tc-utils)
|
||||
(only-in srfi/1 alist-delete)
|
||||
(except-in (env type-env-structs tvar-env index-env) extend)
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
racket/match racket/list
|
||||
(for-syntax (utils tc-utils))
|
||||
(private type-annotation)
|
||||
(types utils union subtype resolve convenience type-table substitute)
|
||||
(types utils union subtype resolve abbrev type-table substitute)
|
||||
(utils tc-utils)
|
||||
(only-in srfi/1 alist-delete)
|
||||
(except-in (env type-env-structs tvar-env index-env) extend)
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
#lang racket/base
|
||||
|
||||
(require (rename-in "../utils/utils.rkt" [infer infer-in]))
|
||||
(require (rename-in (types subtype convenience remove-intersect union)
|
||||
(require (rename-in (types subtype abbrev remove-intersect union)
|
||||
[-> -->]
|
||||
[->* -->*]
|
||||
[one-of/c -one-of/c])
|
||||
(infer-in infer)
|
||||
(rep type-rep object-rep)
|
||||
(rep type-rep filter-rep object-rep)
|
||||
(utils tc-utils)
|
||||
(types resolve)
|
||||
(only-in (env type-env-structs lexical-env)
|
||||
|
|
|
|||
|
|
@ -5,10 +5,10 @@
|
|||
racket/match (prefix-in - racket/contract)
|
||||
"signatures.rkt" "tc-envops.rkt" "tc-metafunctions.rkt" "tc-subst.rkt"
|
||||
"check-below.rkt" "tc-funapp.rkt" "tc-app-helper.rkt" "../types/kw-types.rkt"
|
||||
(types utils convenience union subtype remove-intersect
|
||||
(types utils abbrev numeric-tower union subtype remove-intersect
|
||||
type-table filter-ops generalize)
|
||||
(private-in parse-type type-annotation)
|
||||
(rep type-rep)
|
||||
(rep type-rep filter-rep object-rep)
|
||||
(only-in (infer infer) restrict)
|
||||
(except-in (utils tc-utils stxclass-util))
|
||||
(env lexical-env type-env-structs tvar-env index-env)
|
||||
|
|
@ -35,7 +35,7 @@
|
|||
[i:exp expected]
|
||||
[i:boolean (-val (syntax-e #'i))]
|
||||
[i:identifier (-val (syntax-e #'i))]
|
||||
|
||||
|
||||
;; Numbers
|
||||
[0 -Zero]
|
||||
[1 -One]
|
||||
|
|
|
|||
|
|
@ -13,8 +13,7 @@
|
|||
;; end fixme
|
||||
(for-syntax syntax/parse racket/base (utils tc-utils))
|
||||
(private type-annotation)
|
||||
(types utils union subtype resolve convenience type-table
|
||||
substitute)
|
||||
(types utils union subtype resolve abbrev type-table substitute)
|
||||
(utils tc-utils)
|
||||
(except-in (env type-env-structs tvar-env index-env) extend)
|
||||
(rep type-rep filter-rep rep-utils)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
(require (rename-in "../utils/utils.rkt" [infer r:infer])
|
||||
"signatures.rkt" "check-below.rkt"
|
||||
(rep type-rep filter-rep object-rep)
|
||||
(types convenience subtype union utils filter-ops)
|
||||
(types abbrev subtype union utils filter-ops)
|
||||
(env lexical-env type-env-structs)
|
||||
(r:infer infer)
|
||||
(utils tc-utils)
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@
|
|||
racket/syntax unstable/struct syntax/stx
|
||||
(rename-in racket/contract [-> -->] [->* -->*] [one-of/c -one-of/c])
|
||||
(except-in (rep type-rep) make-arr)
|
||||
(rename-in (types convenience utils union)
|
||||
(rename-in (types abbrev utils union)
|
||||
[make-arr* make-arr])
|
||||
(private type-annotation)
|
||||
(env type-env-structs lexical-env tvar-env index-env)
|
||||
|
|
|
|||
|
|
@ -3,10 +3,10 @@
|
|||
(require (rename-in "../utils/utils.rkt" [infer r:infer])
|
||||
"signatures.rkt" "tc-metafunctions.rkt" "tc-subst.rkt"
|
||||
"check-below.rkt"
|
||||
(types utils convenience)
|
||||
(types utils abbrev)
|
||||
(private type-annotation parse-type)
|
||||
(env lexical-env type-alias-env global-env type-env-structs)
|
||||
(rep type-rep)
|
||||
(env lexical-env type-alias-env global-env type-env-structs)
|
||||
(rep type-rep filter-rep object-rep)
|
||||
syntax/free-vars
|
||||
racket/match (prefix-in c: racket/contract)
|
||||
(except-in racket/contract -> ->* one-of/c)
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
#lang racket/base
|
||||
|
||||
(require "../utils/utils.rkt"
|
||||
(rename-in (types subtype convenience remove-intersect union utils filter-ops)
|
||||
(rename-in (types subtype abbrev remove-intersect union utils filter-ops)
|
||||
[-> -->]
|
||||
[->* -->*]
|
||||
[one-of/c -one-of/c])
|
||||
(rep type-rep filter-rep rep-utils) racket/list
|
||||
(rep type-rep filter-rep object-rep rep-utils) racket/list
|
||||
racket/contract racket/match unstable/match
|
||||
(for-syntax racket/base))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
#lang racket/base
|
||||
|
||||
(require "../utils/utils.rkt"
|
||||
(except-in (rep type-rep free-variance) Dotted)
|
||||
(rep type-rep object-rep free-variance)
|
||||
(private parse-type)
|
||||
(types convenience utils union resolve substitute type-table)
|
||||
(types abbrev utils union resolve substitute type-table)
|
||||
(env global-env type-env-structs type-name-env tvar-env)
|
||||
(utils tc-utils)
|
||||
"def-binding.rkt"
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
#lang racket/base
|
||||
|
||||
(require "../utils/utils.rkt")
|
||||
(require (rename-in (types subtype convenience remove-intersect union utils filter-ops)
|
||||
(require (rename-in (types subtype abbrev remove-intersect union utils filter-ops)
|
||||
[-> -->]
|
||||
[->* -->*]
|
||||
[one-of/c -one-of/c])
|
||||
(rep type-rep filter-rep rep-utils) racket/list
|
||||
(rep type-rep object-rep filter-rep rep-utils) racket/list
|
||||
racket/contract racket/match unstable/match
|
||||
(for-syntax racket/base)
|
||||
"tc-metafunctions.rkt")
|
||||
|
|
@ -42,9 +42,9 @@
|
|||
(define (st t) (subst-type t k o polarity))
|
||||
(define/cond-contract (sf fs) (FilterSet? . -> . FilterSet?) (subst-filter-set fs k o polarity))
|
||||
(type-case (#:Type st
|
||||
#:Filter sf
|
||||
#:Object (lambda (f) (subst-object f k o polarity)))
|
||||
t
|
||||
#:Filter sf
|
||||
#:Object (lambda (f) (subst-object f k o polarity)))
|
||||
t
|
||||
[#:arr dom rng rest drest kws
|
||||
;; here we have to increment the count for the domain, where the new bindings are in scope
|
||||
(let* ([arg-count (+ (length dom) (if rest 1 0) (if drest 1 0) (length kws))]
|
||||
|
|
@ -64,12 +64,12 @@
|
|||
[(Empty:) t]
|
||||
[(Path: p i)
|
||||
(if (name-ref=? i k)
|
||||
(match o
|
||||
[(Empty:) (make-Empty)]
|
||||
;; the result is not from an annotation, so it isn't a NoObject
|
||||
[(NoObject:) (make-Empty)]
|
||||
[(Path: p* i*) (make-Path (append p p*) i*)])
|
||||
t)]))
|
||||
(match o
|
||||
[(Empty:) (make-Empty)]
|
||||
;; the result is not from an annotation, so it isn't a NoObject
|
||||
[(NoObject:) (make-Empty)]
|
||||
[(Path: p* i*) (make-Path (append p p*) i*)])
|
||||
t)]))
|
||||
|
||||
;; this is the substitution metafunction
|
||||
(define/cond-contract (subst-filter f k o polarity)
|
||||
|
|
@ -79,17 +79,17 @@
|
|||
(match o
|
||||
[(or (Empty:) (NoObject:))
|
||||
(cond [(name-ref=? i k)
|
||||
(if polarity -top -bot)]
|
||||
[(index-free-in? k t) (if polarity -top -bot)]
|
||||
(if polarity -top -bot)]
|
||||
[(index-free-in? k t) (if polarity -top -bot)]
|
||||
[else f])]
|
||||
[(Path: p* i*)
|
||||
(cond [(name-ref=? i k)
|
||||
(maker
|
||||
(subst-type t k o polarity)
|
||||
i*
|
||||
(maker
|
||||
(subst-type t k o polarity)
|
||||
i*
|
||||
(append p p*))]
|
||||
[(index-free-in? k t) (if polarity -top -bot)]
|
||||
[else f])]))
|
||||
[(index-free-in? k t) (if polarity -top -bot)]
|
||||
[else f])]))
|
||||
(match f
|
||||
[(ImpFilter: ant consq)
|
||||
(make-ImpFilter (subst-filter ant k o (not polarity)) (ap consq))]
|
||||
|
|
@ -107,28 +107,28 @@
|
|||
return
|
||||
(define (for-object o)
|
||||
(object-case (#:Type for-type)
|
||||
o
|
||||
[#:Path p i
|
||||
(if (name-ref=? i k)
|
||||
(return #t)
|
||||
o)]))
|
||||
o
|
||||
[#:Path p i
|
||||
(if (name-ref=? i k)
|
||||
(return #t)
|
||||
o)]))
|
||||
(define (for-filter o)
|
||||
(filter-case (#:Type for-type
|
||||
#:Filter for-filter)
|
||||
o
|
||||
[#:NotTypeFilter t p i
|
||||
(if (name-ref=? i k)
|
||||
(return #t)
|
||||
o)]
|
||||
[#:TypeFilter t p i
|
||||
(if (name-ref=? i k)
|
||||
(return #t)
|
||||
o)]))
|
||||
#:Filter for-filter)
|
||||
o
|
||||
[#:NotTypeFilter t p i
|
||||
(if (name-ref=? i k)
|
||||
(return #t)
|
||||
o)]
|
||||
[#:TypeFilter t p i
|
||||
(if (name-ref=? i k)
|
||||
(return #t)
|
||||
o)]))
|
||||
(define (for-type t)
|
||||
(type-case (#:Type for-type
|
||||
#:Filter for-filter
|
||||
#:Object for-object)
|
||||
t
|
||||
#:Filter for-filter
|
||||
#:Object for-object)
|
||||
t
|
||||
[#:arr dom rng rest drest kws
|
||||
;; here we have to increment the count for the domain, where the new bindings are in scope
|
||||
(let* ([arg-count (+ (length dom) (if rest 1 0) (if drest 1 0) (length kws))]
|
||||
|
|
|
|||
|
|
@ -11,10 +11,10 @@
|
|||
;; to appease syntax-parse
|
||||
"internal-forms.rkt"
|
||||
(rep type-rep)
|
||||
(types utils convenience type-table)
|
||||
(types utils abbrev type-table)
|
||||
(private parse-type type-annotation type-contract)
|
||||
(env global-env init-envs type-name-env type-alias-env lexical-env env-req)
|
||||
syntax/id-table
|
||||
syntax/id-table
|
||||
(utils tc-utils mutated-vars)
|
||||
"provide-handling.rkt"
|
||||
"def-binding.rkt"
|
||||
|
|
@ -50,9 +50,9 @@
|
|||
(parameterize ([current-orig-stx form])
|
||||
(syntax-parse form
|
||||
#:literals (values define-type-alias-internal define-typed-struct-internal define-type-internal
|
||||
define-typed-struct/exec-internal :-internal assert-predicate-internal
|
||||
require/typed-internal declare-refinement-internal
|
||||
define-values quote-syntax #%plain-app begin define-syntaxes)
|
||||
define-typed-struct/exec-internal :-internal assert-predicate-internal
|
||||
require/typed-internal declare-refinement-internal
|
||||
define-values quote-syntax #%plain-app begin define-syntaxes)
|
||||
;#:literal-sets (kernel-literals)
|
||||
|
||||
;; forms that are handled in other ways
|
||||
|
|
@ -60,7 +60,7 @@
|
|||
#:when (or (syntax-property form 'typechecker:ignore)
|
||||
(syntax-property form 'typechecker:ignore-some))
|
||||
(list)]
|
||||
|
||||
|
||||
[((~literal module) n:id spec ((~literal #%plain-module-begin) body ...))
|
||||
(list)]
|
||||
;; module* is not expanded, so it doesn't have a `#%plain-module-begin`
|
||||
|
|
@ -153,10 +153,10 @@
|
|||
[else
|
||||
(match (get-type/infer vars #'expr tc-expr tc-expr/check)
|
||||
[(tc-results: ts)
|
||||
(for/list ([i (in-list vars)] [t (in-list ts)])
|
||||
(register-type i t)
|
||||
(free-id-table-set! unann-defs i #t)
|
||||
(make-def-binding i t))])]))]
|
||||
(for/list ([i (in-list vars)] [t (in-list ts)])
|
||||
(register-type i t)
|
||||
(free-id-table-set! unann-defs i #t)
|
||||
(make-def-binding i t))])]))]
|
||||
|
||||
;; to handle the top-level, we have to recur into begins
|
||||
[(begin . rest)
|
||||
|
|
@ -205,8 +205,8 @@
|
|||
(void)]
|
||||
[(define-values () (begin (quote-syntax (define-typed-struct-internal . rest)) (#%plain-app values)))
|
||||
(void)]
|
||||
|
||||
;; submodules take care of themselves:
|
||||
|
||||
;; submodules take care of themselves:
|
||||
[(module n spec (#%plain-module-begin body ...))
|
||||
(void)]
|
||||
;; module* is not expanded, so it doesn't have a `#%plain-module-begin`
|
||||
|
|
@ -343,12 +343,12 @@
|
|||
(values
|
||||
#`(begin
|
||||
(begin-for-syntax
|
||||
(module* #%type-decl #f
|
||||
(module* #%type-decl #f
|
||||
(require typed-racket/types/numeric-tower typed-racket/env/type-name-env
|
||||
typed-racket/env/global-env typed-racket/env/type-alias-env
|
||||
typed-racket/types/type-table)
|
||||
#,(env-init-code syntax-provide? provide-tbl def-tbl)
|
||||
#,(talias-env-init-code)
|
||||
#,(env-init-code syntax-provide? provide-tbl def-tbl)
|
||||
#,(talias-env-init-code)
|
||||
#,(tname-env-init-code)
|
||||
#,(make-struct-table-code)
|
||||
#,@(for/list ([a (in-list aliases)])
|
||||
|
|
|
|||
|
|
@ -25,6 +25,9 @@
|
|||
|
||||
|
||||
(provide (except-out (all-defined-out) make-Base)
|
||||
(all-from-out "base-abbrev.rkt")
|
||||
;; TODO change the uses of this export to Un
|
||||
(rename-out (Un *Un))
|
||||
(rename-out [make-Listof -lst]
|
||||
[make-MListof -mlst]))
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
(rep type-rep filter-rep object-rep rep-utils)
|
||||
(utils tc-utils) (only-in (infer infer) restrict)
|
||||
(only-in racket/contract [-> -->] listof)
|
||||
(types union subtype utils remove-intersect convenience)
|
||||
(types union subtype utils remove-intersect abbrev)
|
||||
racket/list racket/match
|
||||
(for-syntax syntax/parse racket/base)
|
||||
syntax/id-table racket/dict
|
||||
|
|
|
|||
|
|
@ -3,7 +3,8 @@
|
|||
(require "../utils/utils.rkt"
|
||||
(rep type-rep filter-rep object-rep rep-utils)
|
||||
(utils tc-utils)
|
||||
"convenience.rkt" "subtype.rkt" "substitute.rkt" "union.rkt"
|
||||
"abbrev.rkt" "subtype.rkt" "substitute.rkt" "union.rkt"
|
||||
"numeric-tower.rkt"
|
||||
racket/match
|
||||
(for-syntax syntax/parse racket/base)
|
||||
syntax/id-table racket/dict)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#lang racket/base
|
||||
|
||||
(require "convenience.rkt" "../rep/type-rep.rkt"
|
||||
(require "abbrev.rkt" "../rep/type-rep.rkt"
|
||||
"union.rkt" "../utils/tc-utils.rkt"
|
||||
racket/list racket/dict racket/match)
|
||||
|
||||
|
|
|
|||
|
|
@ -3,10 +3,12 @@
|
|||
(require racket/require racket/match unstable/sequence racket/string racket/promise
|
||||
(prefix-in s: srfi/1)
|
||||
(path-up "rep/type-rep.rkt" "rep/filter-rep.rkt" "rep/object-rep.rkt"
|
||||
"rep/rep-utils.rkt" "types/convenience.rkt" "types/subtype.rkt"
|
||||
"rep/rep-utils.rkt" "types/abbrev.rkt" "types/subtype.rkt"
|
||||
"utils/utils.rkt"
|
||||
"utils/tc-utils.rkt"))
|
||||
|
||||
;;TODO try to remove requirement on abbrev once promise is fixed
|
||||
|
||||
;; do we attempt to find instantiations of polymorphic types to print?
|
||||
;; FIXME - currently broken
|
||||
(define print-poly-types? #t)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(require "../utils/utils.rkt"
|
||||
(rep type-rep rep-utils)
|
||||
(types union subtype resolve convenience utils)
|
||||
(types abbrev union subtype resolve utils)
|
||||
racket/match)
|
||||
|
||||
(provide (rename-out [*remove remove]) overlap)
|
||||
|
|
|
|||
|
|
@ -7,9 +7,13 @@
|
|||
(only-in (infer infer-dummy) unify)
|
||||
racket/match unstable/match
|
||||
racket/function
|
||||
unstable/lazy-require
|
||||
(prefix-in c: racket/contract)
|
||||
(for-syntax racket/base syntax/parse))
|
||||
|
||||
(lazy-require
|
||||
("union.rkt" (Un)))
|
||||
|
||||
;; exn representing failure of subtyping
|
||||
;; s,t both types
|
||||
|
||||
|
|
@ -193,7 +197,7 @@
|
|||
[(not (apply = (length dom1) (map length dom))) #f]
|
||||
[(not (for/and ([rng2 (in-list rng)]) (type-equal? rng1 rng2)))
|
||||
#f]
|
||||
[else (make-arr (apply map *Un (cons dom1 dom)) rng1 #f #f '())])]
|
||||
[else (make-arr (apply map Un (cons dom1 dom)) rng1 #f #f '())])]
|
||||
[_ #f]))
|
||||
|
||||
(define-match-expander NameStruct:
|
||||
|
|
|
|||
|
|
@ -7,8 +7,7 @@
|
|||
(utils tc-utils)
|
||||
(env init-envs)
|
||||
(except-in (rep filter-rep object-rep type-rep) make-arr)
|
||||
(types convenience union)
|
||||
(only-in (types convenience) [make-arr* make-arr])))
|
||||
(rename-in (types abbrev union) [make-arr* make-arr])))
|
||||
|
||||
(define-for-syntax unit-env
|
||||
(make-env
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user