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

Make numeric contracts in unions better.

Browse Source
This commit is contained in:
Eric Dobson 2014-01-14 22:52:18 -08:00
parent 4ad412d71c
commit 6d05e41a24
2 changed files with 16 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt
View File

@ -8,7 +8,8 @@
(rep type-rep filter-rep object-rep)
(utils tc-utils)
(env type-name-env)
(types resolve)
(rep rep-utils)
(types resolve union)
(prefix-in t: (types abbrev numeric-tower))
(private parse-type syntax-properties)
racket/match racket/syntax racket/list
@ -30,7 +31,7 @@
(#:typed-side boolean?) . c:->* . (c:or/c a static-contract?)))]))
(provide type->contract define/fixup-contract? change-contract-fixups
type->contract-fail)
type->contract-fail any-wrap/sc)
;; These check if either the define form or the body form has the syntax
;; property. Normally the define form will have the property but lifting an
@ -197,13 +198,16 @@
[(Univ:) (if (from-typed? typed-side) any-wrap/sc any/sc)]
[(Mu: var (Union: (list (Value: '()) (Pair: elem-ty (F: var)))))
(listof/sc (t->sc elem-ty))]
[t (=> fail) (or (numeric-type->static-contract t) (fail))]
[(Base: sym cnt _ _)
(flat/sc #`(flat-named-contract '#,sym (flat-contract-predicate #,cnt)) sym)]
[(Refinement: par p?)
(and/sc (t->sc par) (flat/sc p?))]
[(Union: elems)
(apply or/sc (map t->sc elems))]
(define-values (numeric non-numeric) (partition (λ (t) (equal? 'number (Type-key t))) elems ))
(define numeric-sc (numeric-type->static-contract (apply Un numeric)))
(if numeric-sc
(apply or/sc numeric-sc (map t->sc non-numeric))
(apply or/sc (map t->sc elems)))]
[(and t (Function: _)) (t->sc/fun t)]
[(Set: t) (set/sc (t->sc t))]
[(Sequence: ts) (apply sequence/sc (map t->sc ts))]

12
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/contract-tests.rkt
View File

@ -6,6 +6,7 @@
(private type-contract)
(rep type-rep)
(types abbrev numeric-tower union)
(static-contracts combinators optimize)
(submod typed-racket/private/type-contract numeric-contracts)
rackunit)
(provide tests)
@ -26,10 +27,11 @@
(let ([t e-t] [sc e-sc])
(with-check-info (['type t] ['expected sc])
(define actual
(type->static-contract
t
(λ (#:reason [reason #f])
(fail-check (or reason "Type could not be converted to contract")))))
(optimize
(type->static-contract
t
(λ (#:reason [reason #f])
(fail-check (or reason "Type could not be converted to contract"))))))
(with-check-info (['actual actual])
(unless (equal? actual sc)
(fail-check "Static contract didn't match expected")))))))
@ -122,5 +124,7 @@
(t-sc -Number number/sc)
(t-sc -Integer integer/sc)
(t-sc (-lst Univ) (listof/sc any-wrap/sc))
(t-sc (Un (-lst Univ) -Number) (or/sc number/sc (listof/sc any-wrap/sc)))
))