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

Make generated contracts for Floats include NaN.

Browse Source 
Closes PR13464.

original commit: e656bdb1c572c9e256901a89bfda985aa5700877
This commit is contained in:
Eric Dobson 2013-02-03 13:50:10 -08:00 committed by Vincent St-Amour
parent 7c8cb9a476
commit 3899a23a03
2 changed files with 81 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
collects/tests/typed-racket/succeed/pr13464.rkt Normal file
View File

@ -0,0 +1,65 @@
#lang racket
(module defs typed/racket
(provide (all-defined-out))
(: neg-flonum Negative-Flonum)
(: pos-flonum Positive-Flonum)
(: non-neg-flonum Nonnegative-Flonum)
(: non-pos-flonum Nonpositive-Flonum)
(: neg-single-flonum Negative-Single-Flonum)
(: pos-single-flonum Positive-Single-Flonum)
(: non-neg-single-flonum Nonnegative-Single-Flonum)
(: non-pos-single-flonum Nonpositive-Single-Flonum)
(: neg-ineact-real Negative-Inexact-Real)
(: pos-ineact-real Positive-Inexact-Real)
(: non-neg-ineact-real Nonnegative-Inexact-Real)
(: non-pos-ineact-real Nonpositive-Inexact-Real)
(: neg-real Negative-Real)
(: pos-real Positive-Real)
(: non-neg-real Nonnegative-Real)
(: non-pos-real Nonpositive-Real)
(define neg-flonum +nan.0)
(define pos-flonum +nan.0)
(define non-neg-flonum +nan.0)
(define non-pos-flonum +nan.0)
(define neg-single-flonum +nan.f)
(define pos-single-flonum +nan.f)
(define non-neg-single-flonum +nan.f)
(define non-pos-single-flonum +nan.f)
(define neg-ineact-real +nan.0)
(define pos-ineact-real +nan.0)
(define non-neg-ineact-real +nan.0)
(define non-pos-ineact-real +nan.0)
(define neg-real +nan.0)
(define pos-real +nan.0)
(define non-neg-real +nan.0)
(define non-pos-real +nan.0))
(require 'defs)
neg-flonum
pos-flonum
non-neg-flonum
non-pos-flonum
neg-single-flonum
pos-single-flonum
non-neg-single-flonum
non-pos-single-flonum
neg-ineact-real
pos-ineact-real
non-neg-ineact-real
non-pos-ineact-real
neg-real
pos-real
non-neg-real
non-pos-real

28
collects/typed-racket/private/type-contract.rkt
View File

@ -284,24 +284,28 @@
[(== t:-NonPosRat type-equal?) #'(flat-named-contract 'Nonpositive-Rational (and/c t:exact-rational? (lambda (x) (<= x 0))))]
[(== t:-Rat type-equal?) #'(flat-named-contract 'Rational t:exact-rational?)]
[(== t:-FlonumZero type-equal?) #'(flat-named-contract 'Float-Zero (and/c flonum? zero?))]
[(== t:-NonNegFlonum type-equal?) #'(flat-named-contract 'Nonnegative-Float (and/c flonum? (lambda (x) (>= x 0))))]
[(== t:-NonPosFlonum type-equal?) #'(flat-named-contract 'Nonpositive-Float (and/c flonum? (lambda (x) (<= x 0))))]
[(== t:-NonNegFlonum type-equal?) #'(flat-named-contract 'Nonnegative-Float (and/c flonum? (lambda (x) (not (< x 0)))))]
[(== t:-NonPosFlonum type-equal?) #'(flat-named-contract 'Nonpositive-Float (and/c flonum? (lambda (x) (not (> x 0)))))]
[(== t:-NegFlonum type-equal?) #'(flat-named-contract 'Negative-Float (and/c flonum? (lambda (x) (not (>= x 0)))))]
[(== t:-PosFlonum type-equal?) #'(flat-named-contract 'Positive-Float (and/c flonum? (lambda (x) (not (<= x 0)))))]
[(== t:-Flonum type-equal?) #'(flat-named-contract 'Float flonum?)]
[(== t:-SingleFlonumZero type-equal?) #'(flat-named-contract 'Single-Flonum-Zero (and/c single-flonum? zero?))]
[(== t:-InexactRealZero type-equal?) #'(flat-named-contract 'Inexact-Real-Zero (and/c inexact-real? zero?))]
[(== t:-PosInexactReal type-equal?) #'(flat-named-contract 'Positive-Inexact-Real (and/c inexact-real? positive?))]
[(== t:-NonNegSingleFlonum type-equal?) #'(flat-named-contract 'Nonnegative-Single-Flonum (and/c single-flonum? (lambda (x) (>= x 0))))]
[(== t:-NonNegInexactReal type-equal?) #'(flat-named-contract 'Nonnegative-Inexact-Real (and/c inexact-real? (lambda (x) (>= x 0))))]
[(== t:-NegInexactReal type-equal?) #'(flat-named-contract 'Negative-Inexact-Real (and/c inexact-real? negative?))]
[(== t:-NonPosSingleFlonum type-equal?) #'(flat-named-contract 'Nonpositive-Single-Flonum (and/c single-flonum? (lambda (x) (<= x 0))))]
[(== t:-NonPosInexactReal type-equal?) #'(flat-named-contract 'Nonpositive-Inexact-Real (and/c inexact-real? (lambda (x) (<= x 0))))]
[(== t:-PosSingleFlonum type-equal?) #'(flat-named-contract 'Positive-Single-Flonum (and/c single-flonum? (lambda (x) (not (<= x 0)))))]
[(== t:-PosInexactReal type-equal?) #'(flat-named-contract 'Positive-Inexact-Real (and/c inexact-real? (lambda (x) (not (<= x 0)))))]
[(== t:-NonNegSingleFlonum type-equal?) #'(flat-named-contract 'Nonnegative-Single-Flonum (and/c single-flonum? (lambda (x) (not (< x 0)))))]
[(== t:-NonNegInexactReal type-equal?) #'(flat-named-contract 'Nonnegative-Inexact-Real (and/c inexact-real? (lambda (x) (not (< x 0)))))]
[(== t:-NegSingleFlonum type-equal?) #'(flat-named-contract 'Negative-Single-Flonum (and/c single-flonum? (lambda (x) (not (>= x 0)))))]
[(== t:-NegInexactReal type-equal?) #'(flat-named-contract 'Negative-Inexact-Real (and/c inexact-real? (lambda (x) (not (>= x 0)))))]
[(== t:-NonPosSingleFlonum type-equal?) #'(flat-named-contract 'Nonpositive-Single-Flonum (and/c single-flonum? (lambda (x) (not (> x 0)))))]
[(== t:-NonPosInexactReal type-equal?) #'(flat-named-contract 'Nonpositive-Inexact-Real (and/c inexact-real? (lambda (x) (not (> x 0)))))]
[(== t:-SingleFlonum type-equal?) #'(flat-named-contract 'Single-Flonum single-flonum?)]
[(== t:-InexactReal type-equal?) #'(flat-named-contract 'Inexact-Real inexact-real?)]
[(== t:-RealZero type-equal?) #'(flat-named-contract 'Real-Zero (and/c real? zero?))]
[(== t:-PosReal type-equal?) #'(flat-named-contract 'Positive-Real (and/c real? positive?))]
[(== t:-NonNegReal type-equal?) #'(flat-named-contract 'Nonnegative-Real (and/c real? (lambda (x) (>= x 0))))]
[(== t:-NegReal type-equal?) #'(flat-named-contract 'Negative-Real (and/c real? negative?))]
[(== t:-NonPosReal type-equal?) #'(flat-named-contract 'Nonpositive-Real (and/c real? (lambda (x) (<= x 0))))]
[(== t:-PosReal type-equal?) #'(flat-named-contract 'Positive-Real (and/c real? (lambda (x) (not (<= x 0)))))]
[(== t:-NonNegReal type-equal?) #'(flat-named-contract 'Nonnegative-Real (and/c real? (lambda (x) (not (< x 0)))))]
[(== t:-NegReal type-equal?) #'(flat-named-contract 'Negative-Real (and/c real? (lambda (x) (not (>= x 0)))))]
[(== t:-NonPosReal type-equal?) #'(flat-named-contract 'Nonpositive-Real (and/c real? (lambda (x) (not (> x 0)))))]
[(== t:-Real type-equal?) #'(flat-named-contract 'Real real?)]
[(== t:-ExactNumber type-equal?) #'(flat-named-contract 'Exact-Number (and/c number? exact?))]
[(== t:-InexactComplex type-equal?)