Merge branch 'master' of github.com:racket/typed-racket into fix-assoc-and-member-types
This commit is contained in:
Georges Dupéron
commit
6c12d93261
|
|
@ -489,7 +489,7 @@
|
|||
(fl-type-lambda
|
||||
(from-cases (-FlZero -Fl . -> . -FlZero)
|
||||
;; we don't have Pos Pos -> Pos, possible underflow
|
||||
(-NonNegFl -NonNegFl . -> . -NonNegFl)
|
||||
(-PosFl -PosFl . -> . -NonNegFl)
|
||||
(commutative-binop -PosFl -NegFl -NonPosFl)
|
||||
(-NegFl -NegFl . -> . -NonNegFl)
|
||||
(binop -Fl))))
|
||||
|
|
@ -1166,10 +1166,10 @@
|
|||
;; reals
|
||||
(varop-1+ -NonNegReal -NonNegReal)
|
||||
(-> -NonPosReal -NonPosReal)
|
||||
(-> -NonPosReal -NonPosReal -NonNegReal)
|
||||
(-> -NonPosReal -NonNegReal -NonPosReal)
|
||||
(-> -NonNegReal -NonPosReal -NonPosReal)
|
||||
(-> -NonPosReal -NonPosReal -NonPosReal -NonPosReal)
|
||||
(-> -NegReal -NegReal -NonNegReal) ; 0.0 is non-neg, but doesn't preserve sign
|
||||
(-> -NegReal -PosReal -NonPosReal) ; idem
|
||||
(-> -PosReal -NegReal -NonPosReal) ; idem
|
||||
(-> -NegReal -NegReal -NegReal -NonPosReal) ; idem
|
||||
(varop-1+ -Real)
|
||||
;; complexes
|
||||
(varop-1+ -FloatComplex)
|
||||
|
|
@ -1377,16 +1377,16 @@
|
|||
(-Int -Int . -> . -Int))]
|
||||
|
||||
[bitwise-and
|
||||
(let ([mix-with-int
|
||||
(let ([mix-with-nat
|
||||
(lambda (t)
|
||||
(list (->* (list t) t t) ; closed
|
||||
(->* (list -Int t) t t) ; brings result down
|
||||
(->* (list t -Int) t t)))])
|
||||
(->* (list -Nat t) t t) ; brings result down
|
||||
(->* (list t -Nat) t t)))])
|
||||
(from-cases (-> -NegFixnum) ; no args -> -1
|
||||
(map mix-with-int (list -Zero -Byte -Index -NonNegFixnum))
|
||||
(map mix-with-nat (list -Zero -Byte -Index -NonNegFixnum))
|
||||
;; closed on negatives, but not closed if we mix with positives
|
||||
(map varop-1+ (list -NegFixnum -NonPosFixnum))
|
||||
(map mix-with-int (list -Fixnum -Nat))
|
||||
(map varop-1+ (list -NegFixnum -NonPosFixnum -Fixnum))
|
||||
(map mix-with-nat (list -Nat))
|
||||
(map varop-1+ (list -NegInt -NonPosInt))
|
||||
(null -Int . ->* . -Int)))]
|
||||
[bitwise-ior
|
||||
|
|
@ -1621,8 +1621,12 @@
|
|||
(-InexactReal (Un -NegInt -PosInt) . -> . -InexactReal)
|
||||
(-InexactReal -InexactReal . -> . (Un -InexactReal -InexactComplex))
|
||||
(-Real -Int . -> . -Real)
|
||||
(-FloatComplex (Un -InexactComplex -InexactReal) . -> . -FloatComplex)
|
||||
(-SingleFlonumComplex (Un -SingleFlonum -SingleFlonumComplex) . -> . -SingleFlonumComplex)
|
||||
(-FloatComplex -FloatComplex . -> . -FloatComplex)
|
||||
(-FloatComplex -Flonum . -> . (Un -FloatComplex -Flonum))
|
||||
(-FloatComplex -InexactReal . -> . (Un -FloatComplex -InexactReal))
|
||||
(-FloatComplex -InexactComplex . -> . -FloatComplex)
|
||||
(-SingleFlonumComplex -SingleFlonumComplex . -> . -SingleFlonumComplex)
|
||||
(-SingleFlonumComplex -SingleFlonum . -> . (Un -SingleFlonumComplex -SingleFlonum))
|
||||
((Un -InexactReal -InexactComplex) -InexactComplex . -> . -InexactComplex)
|
||||
(-InexactComplex (Un -InexactReal -InexactComplex) . -> . -InexactComplex)
|
||||
(N N . -> . N))]
|
||||
|
|
|
|||
|
|
@ -83,11 +83,9 @@
|
|||
|
||||
;; Lazily loaded b/c they're only used sometimes, so we save a lot
|
||||
;; of loading by not having them when they are unneeded
|
||||
(lazy-require ["../rep/type-rep.rkt" (make-Opaque Error?)]
|
||||
(lazy-require ["../rep/type-rep.rkt" (Error?)]
|
||||
["../types/utils.rkt" (fv)]
|
||||
[syntax/define (normalize-definition)]
|
||||
[typed-racket/private/parse-type (parse-type)]
|
||||
[typed-racket/env/type-alias-env (register-resolved-type-alias)])
|
||||
[typed-racket/private/parse-type (parse-type)])
|
||||
|
||||
(define (with-type* expr ty)
|
||||
(with-type #`(ann #,expr #,ty)))
|
||||
|
|
@ -326,11 +324,6 @@
|
|||
(pattern #:name-exists))
|
||||
(syntax-parse stx
|
||||
[(_ ty:id pred:id lib (~optional ne:name-exists-kw) ...)
|
||||
;; This line appears redundant with the use of `define-type-alias` below, but
|
||||
;; it's actually necessary for top-level uses because this opaque type may appear
|
||||
;; in subsequent `require/typed` clauses, which needs to parse the types at
|
||||
;; expansion-time, not at typechecking time when aliases are installed.
|
||||
(register-resolved-type-alias #'ty (make-Opaque #'pred))
|
||||
(with-syntax ([hidden (generate-temporary #'pred)])
|
||||
(quasisyntax/loc stx
|
||||
(begin
|
||||
|
|
|
|||
|
|
@ -157,11 +157,7 @@ the typed racket language.
|
|||
;; Lazily loaded b/c they're only used sometimes, so we save a lot
|
||||
;; of loading by not having them when they are unneeded
|
||||
(begin-for-syntax
|
||||
(lazy-require ["../rep/type-rep.rkt" (make-Opaque Error?)]
|
||||
["../types/utils.rkt" (fv)]
|
||||
[syntax/define (normalize-definition)]
|
||||
[typed-racket/private/parse-type (parse-type)]
|
||||
[typed-racket/env/type-alias-env (register-resolved-type-alias)]))
|
||||
(lazy-require [syntax/define (normalize-definition)]))
|
||||
|
||||
(define-for-syntax (with-type* expr ty)
|
||||
(with-type #`(ann #,expr #,ty)))
|
||||
|
|
@ -812,7 +808,13 @@ the typed racket language.
|
|||
(define i 0)
|
||||
(for (clauses ...)
|
||||
(define v body-expr)
|
||||
(cond [(unsafe-fx= i 0) (define new-vs (ann (make-vector n v) T))
|
||||
;; can't use `unsafe-fx=` here
|
||||
;; if `n` is larger than a fixnum, this is unsafe, and we
|
||||
;; don't know whether that's the case until we try creating
|
||||
;; the vector
|
||||
;; other unsafe ops are after vector allocation, and so are
|
||||
;; fine
|
||||
(cond [(= i 0) (define new-vs (ann (make-vector n v) T))
|
||||
(set! vs new-vs)]
|
||||
[else (unsafe-vector-set! vs i v)])
|
||||
(set! i (unsafe-fx+ i 1))
|
||||
|
|
|
|||
|
|
@ -50,14 +50,14 @@
|
|||
"The optimizer could optimize it better if it had type Float-Complex.")
|
||||
this-syntax))
|
||||
|
||||
;; If a part is 0.0?
|
||||
(define (0.0? stx)
|
||||
(equal? (syntax->datum stx) 0.0))
|
||||
|
||||
|
||||
;; a+bi / c+di, names for real and imag parts of result -> one let-values binding clause
|
||||
(define (unbox-one-complex-/ a b c d res-real res-imag)
|
||||
(define both-real? (and (0.0? b) (0.0? d)))
|
||||
(define first-arg-real? (syntax-property b 'was-real?))
|
||||
(define second-arg-real? (syntax-property d 'was-real?))
|
||||
;; if both are real, we can short-circuit a lot
|
||||
(define both-real? (and first-arg-real? second-arg-real?))
|
||||
|
||||
;; we have the same cases as the Racket `/' primitive (except for the non-float ones)
|
||||
(define d=0-case
|
||||
#`(values (unsafe-fl+ (unsafe-fl/ #,a #,c)
|
||||
|
|
@ -85,10 +85,17 @@
|
|||
(unsafe-fl/ (unsafe-fl- (unsafe-fl* b r) a) den))])
|
||||
(values (unsafe-fl/ (unsafe-fl+ b (unsafe-fl* a r)) den)
|
||||
i)))
|
||||
|
||||
(cond [both-real?
|
||||
#`[(#,res-real #,res-imag)
|
||||
(values (unsafe-fl/ #,a #,c)
|
||||
0.0)]] ; currently not propagated
|
||||
[second-arg-real?
|
||||
#`[(#,res-real #,res-imag)
|
||||
(values (unsafe-fl/ #,a #,c)
|
||||
(unsafe-fl/ #,b #,c))]]
|
||||
[first-arg-real?
|
||||
(unbox-one-float-complex-/ a c d res-real res-imag)]
|
||||
[else
|
||||
#`[(#,res-real #,res-imag)
|
||||
(cond [(unsafe-fl= #,d 0.0) #,d=0-case]
|
||||
|
|
@ -112,7 +119,7 @@
|
|||
#`(let* ([cm (unsafe-flabs #,c)]
|
||||
[dm (unsafe-flabs #,d)]
|
||||
[swap? (unsafe-fl< cm dm)]
|
||||
[a #,a]
|
||||
[a #,a] ; don't swap with `b` (`0`) here, but handle below
|
||||
[c (if swap? #,d #,c)]
|
||||
[d (if swap? #,c #,d)]
|
||||
[r (unsafe-fl/ c d)]
|
||||
|
|
@ -198,27 +205,33 @@
|
|||
#'(cs.imag-binding ...))
|
||||
(list #'imag-binding))]
|
||||
[res '()])
|
||||
(if (null? e1)
|
||||
(reverse res)
|
||||
(loop (car rs) (car is) (cdr e1) (cdr e2) (cdr rs) (cdr is)
|
||||
;; complex multiplication, imag part, then real part (reverse)
|
||||
;; we eliminate operations on the imaginary parts of reals
|
||||
(let ((o-real? (0.0? o2))
|
||||
(e-real? (0.0? (car e2))))
|
||||
(list* #`((#,(car is))
|
||||
#,(cond ((and o-real? e-real?) #'0.0)
|
||||
(o-real? #`(unsafe-fl* #,o1 #,(car e2)))
|
||||
(e-real? #`(unsafe-fl* #,o2 #,(car e1)))
|
||||
(else
|
||||
#`(unsafe-fl+ (unsafe-fl* #,o2 #,(car e1))
|
||||
(unsafe-fl* #,o1 #,(car e2))))))
|
||||
#`((#,(car rs))
|
||||
#,(cond ((or o-real? e-real?)
|
||||
#`(unsafe-fl* #,o1 #,(car e1)))
|
||||
(else
|
||||
#`(unsafe-fl- (unsafe-fl* #,o1 #,(car e1))
|
||||
(unsafe-fl* #,o2 #,(car e2))))))
|
||||
res))))))))
|
||||
(cond
|
||||
[(null? e1)
|
||||
(reverse res)]
|
||||
[else
|
||||
(define o-real? (syntax-property o2 'was-real?))
|
||||
(define e-real? (syntax-property (car e2) 'was-real?))
|
||||
(define both-real? (and o-real? e-real?))
|
||||
(define new-imag-id (if both-real?
|
||||
(syntax-property (car is) 'was-real? #t)
|
||||
(car is)))
|
||||
(loop (car rs) new-imag-id (cdr e1) (cdr e2) (cdr rs) (cdr is)
|
||||
;; complex multiplication, imag part, then real part (reverse)
|
||||
;; we eliminate operations on the imaginary parts of reals
|
||||
(list* #`((#,new-imag-id)
|
||||
#,(cond ((and o-real? e-real?) #'0.0)
|
||||
(o-real? #`(unsafe-fl* #,o1 #,(car e2)))
|
||||
(e-real? #`(unsafe-fl* #,o2 #,(car e1)))
|
||||
(else
|
||||
#`(unsafe-fl+ (unsafe-fl* #,o2 #,(car e1))
|
||||
(unsafe-fl* #,o1 #,(car e2))))))
|
||||
#`((#,(car rs))
|
||||
#,(cond ((or o-real? e-real?)
|
||||
#`(unsafe-fl* #,o1 #,(car e1)))
|
||||
(else
|
||||
#`(unsafe-fl- (unsafe-fl* #,o1 #,(car e1))
|
||||
(unsafe-fl* #,o2 #,(car e2))))))
|
||||
res))])))))
|
||||
(pattern (#%plain-app op:*^ :unboxed-float-complex-opt-expr)
|
||||
#:when (subtypeof? this-syntax -FloatComplex)
|
||||
#:do [(log-unboxing-opt "unboxed unary float complex")])
|
||||
|
|
@ -332,10 +345,14 @@
|
|||
((real-binding) (unsafe-flreal-part e*))
|
||||
((imag-binding) (unsafe-flimag-part e*))))
|
||||
|
||||
;; The following optimization is incorrect and causes bugs because it turns exact numbers into inexact
|
||||
(pattern e:number-expr
|
||||
#:with e* (generate-temporary)
|
||||
#:with (real-binding imag-binding) (binding-names)
|
||||
#:with (real-binding imag-binding*) (binding-names)
|
||||
#:with imag-binding (if (subtypeof? #'e -Real)
|
||||
;; values that were originally reals may need to be
|
||||
;; handled specially
|
||||
(syntax-property #'imag-binding 'was-real? #t)
|
||||
#'imag-binding)
|
||||
#:do [(log-unboxing-opt
|
||||
(if (subtypeof? #'e -Flonum)
|
||||
"float in complex ops"
|
||||
|
|
|
|||
|
|
@ -138,7 +138,7 @@
|
|||
[res #'e.arg])
|
||||
([accessor (in-list (reverse (syntax->list #'e.alt)))])
|
||||
(cond
|
||||
[(subtype t (-pair Univ Univ)) ; safe to optimize this one layer
|
||||
[(and t (subtype t (-pair Univ Univ))) ; safe to optimize this one layer
|
||||
(syntax-parse accessor
|
||||
[op:pair-op
|
||||
(log-pair-opt)
|
||||
|
|
|
|||
|
|
@ -1,20 +1,22 @@
|
|||
#lang racket/base
|
||||
|
||||
;;TODO use contract-req
|
||||
(require "rep-utils.rkt" "free-variance.rkt" racket/contract/base
|
||||
racket/lazy-require)
|
||||
(require "../utils/utils.rkt" "rep-utils.rkt" "free-variance.rkt")
|
||||
|
||||
;; TODO use something other than lazy-require.
|
||||
(lazy-require ["type-rep.rkt" (Type/c Univ? Bottom?)]
|
||||
["object-rep.rkt" (Path?)])
|
||||
(provide hash-name filter-equal?)
|
||||
|
||||
(provide Filter/c FilterSet/c name-ref/c hash-name filter-equal?)
|
||||
(begin-for-cond-contract
|
||||
(require racket/contract/base racket/lazy-require)
|
||||
(lazy-require ["type-rep.rkt" (Type/c Univ? Bottom?)]
|
||||
["object-rep.rkt" (Path?)]))
|
||||
|
||||
(define (Filter/c-predicate? e)
|
||||
(provide-for-cond-contract Filter/c FilterSet/c name-ref/c)
|
||||
|
||||
(define-for-cond-contract (Filter/c-predicate? e)
|
||||
(and (Filter? e) (not (NoFilter? e)) (not (FilterSet? e))))
|
||||
(define Filter/c (flat-named-contract 'Filter Filter/c-predicate?))
|
||||
(define-for-cond-contract Filter/c
|
||||
(flat-named-contract 'Filter Filter/c-predicate?))
|
||||
|
||||
(define FilterSet/c
|
||||
(define-for-cond-contract FilterSet/c
|
||||
(flat-named-contract
|
||||
'FilterSet
|
||||
(λ (e) (or (FilterSet? e) (NoFilter? e)))))
|
||||
|
|
@ -22,10 +24,11 @@
|
|||
;; A Name-Ref is any value that represents an object.
|
||||
;; As an identifier, it represents a free variable in the environment
|
||||
;; As a list, it represents a De Bruijn indexed bound variable
|
||||
(define name-ref/c (or/c identifier? (list/c integer? integer?)))
|
||||
(define-for-cond-contract name-ref/c
|
||||
(or/c identifier? (list/c integer? integer?)))
|
||||
(define (hash-name v) (if (identifier? v) (hash-id v) (list v)))
|
||||
|
||||
(define ((length>=/c len) l)
|
||||
(define-for-cond-contract ((length>=/c len) l)
|
||||
(and (list? l)
|
||||
(>= (length l) len)))
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,6 @@
|
|||
"interning.rkt"
|
||||
racket/lazy-require
|
||||
racket/stxparam
|
||||
racket/unsafe/ops
|
||||
(for-syntax
|
||||
racket/match
|
||||
(except-in syntax/parse id identifier keyword)
|
||||
|
|
@ -33,9 +32,9 @@
|
|||
(define-struct Rep (seq free-vars free-idxs stx) #:transparent
|
||||
#:methods gen:equal+hash
|
||||
[(define (equal-proc x y recur)
|
||||
(eq? (unsafe-Rep-seq x) (unsafe-Rep-seq y)))
|
||||
(define (hash-proc x recur) (unsafe-Rep-seq x))
|
||||
(define (hash2-proc x recur) (unsafe-Rep-seq x))])
|
||||
(eq? (Rep-seq x) (Rep-seq y)))
|
||||
(define (hash-proc x recur) (Rep-seq x))
|
||||
(define (hash2-proc x recur) (Rep-seq x))])
|
||||
|
||||
;; evil tricks for hygienic yet unhygienic-looking reference
|
||||
;; in say def-type for type-ref-id
|
||||
|
|
@ -361,11 +360,6 @@
|
|||
[Object def-object #:Object object-case print-object object-name-ht object-rec-id]
|
||||
[PathElem def-pathelem #:PathElem pathelem-case print-pathelem pathelem-name-ht pathelem-rec-id])
|
||||
|
||||
;; NOTE: change these if the definitions above change, or everything will segfault
|
||||
(define-syntax-rule (unsafe-Rep-seq v) (unsafe-struct*-ref v 0))
|
||||
(define-syntax-rule (unsafe-Type-key v) (unsafe-struct*-ref v 4))
|
||||
(provide unsafe-Rep-seq unsafe-Type-key)
|
||||
|
||||
(define (Rep-values rep)
|
||||
(match rep
|
||||
[(? (lambda (e) (or (Filter? e)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang racket/base
|
||||
(require "../utils/utils.rkt" racket/unsafe/ops)
|
||||
(require "../utils/utils.rkt")
|
||||
(require (rep type-rep) (contract-req))
|
||||
|
||||
(provide (except-out (all-defined-out) current-seen-mark))
|
||||
|
|
@ -24,5 +24,5 @@
|
|||
A))
|
||||
(define (seen? ss st cs)
|
||||
(for/or ([i (in-list cs)])
|
||||
(and (eq? ss (unsafe-car i)) (eq? st (unsafe-cdr i)))))
|
||||
(and (eq? ss (car i)) (eq? st (cdr i)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -237,8 +237,8 @@
|
|||
;; is s a subtype of t, taking into account previously seen pairs A
|
||||
(define/cond-contract (subtype* A s t)
|
||||
(c:-> (c:listof (c:cons/c fixnum? fixnum?)) Type? Type? c:any/c)
|
||||
(define ss (unsafe-Rep-seq s))
|
||||
(define st (unsafe-Rep-seq t))
|
||||
(define ss (Rep-seq s))
|
||||
(define st (Rep-seq t))
|
||||
(early-return
|
||||
#:return-when (or (eq? ss st) (seen? ss st A)) A
|
||||
(define cr (let ([inner (hash-ref subtype-cache st #f)])
|
||||
|
|
@ -246,8 +246,8 @@
|
|||
(hash-ref inner ss 'missing)
|
||||
'missing)))
|
||||
#:return-when (boolean? cr) (and cr A)
|
||||
(define ks (unsafe-Type-key s))
|
||||
(define kt (unsafe-Type-key t))
|
||||
(define ks (Type-key s))
|
||||
(define kt (Type-key t))
|
||||
#:return-when (and (symbol? ks) (symbol? kt) (not (eq? ks kt))) #f
|
||||
#:return-when (and (symbol? ks) (pair? kt) (not (memq ks kt))) #f
|
||||
#:return-when
|
||||
|
|
|
|||
|
|
@ -100,7 +100,8 @@ at least theoretically.
|
|||
define/cond-contract/provide
|
||||
define-for-cond-contract
|
||||
provide-for-cond-contract
|
||||
require-for-cond-contract)
|
||||
require-for-cond-contract
|
||||
begin-for-cond-contract)
|
||||
|
||||
(define-require-syntax contract-req
|
||||
(if enable-contracts?
|
||||
|
|
@ -126,6 +127,12 @@ at least theoretically.
|
|||
(syntax-parser
|
||||
[(_ require-spec:expr ...) #'(begin)])))
|
||||
|
||||
(define-syntax begin-for-cond-contract
|
||||
(if enable-contracts?
|
||||
(make-rename-transformer #'begin)
|
||||
(syntax-parser
|
||||
[(_ e:expr ...) #'(begin)])))
|
||||
|
||||
|
||||
(define-syntax-rule (define/cond-contract/provide (name . args) c . body)
|
||||
(begin (define/cond-contract name c
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@
|
|||
require/typed-legacy
|
||||
require-typed-signature)
|
||||
typed-racket/base-env/base-types
|
||||
(except-in typed-racket/base-env/base-types-extra Distinction))
|
||||
(except-in typed-racket/base-env/base-types-extra Distinction Unit))
|
||||
(provide (rename-out [define-type-alias define-type])
|
||||
(all-from-out typed-racket/base-env/prims)
|
||||
(all-from-out typed-racket/base-env/base-types)
|
||||
|
|
|
|||
|
|
@ -15,9 +15,11 @@
|
|||
unit-from-context
|
||||
define-unit-from-context)
|
||||
typed-racket/base-env/unit-prims
|
||||
typed-racket/base-env/base-types-extra
|
||||
typed-racket/base-env/signature-prims)
|
||||
|
||||
(provide define-signature
|
||||
Unit
|
||||
unit
|
||||
invoke-unit
|
||||
invoke-unit/infer
|
||||
|
|
|
|||
24
typed-racket-test/fail/union-or-exclusive.rkt
Normal file
24
typed-racket-test/fail/union-or-exclusive.rkt
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
#;
|
||||
(exn-pred exn:fail:contract? "Real")
|
||||
#lang typed/racket #:no-optimize
|
||||
|
||||
|
||||
(module m1 racket
|
||||
(define (fix-vector-field-fun f)
|
||||
(cond [(procedure-arity-includes? f 2 #t)
|
||||
(λ (x y) (f x y))]
|
||||
[else
|
||||
(λ (x y) (f (vector x y)))]))
|
||||
(provide fix-vector-field-fun))
|
||||
|
||||
(require/typed
|
||||
(submod "." m1)
|
||||
[fix-vector-field-fun (-> (U (-> Real Real Any)
|
||||
(-> (Vector Real Real) Any))
|
||||
(-> Real Real Any))])
|
||||
|
||||
(: f : (Vector Real Real) -> (Listof Real))
|
||||
(define f (λ ([x : (Vector Real Real)] [ignored : Any #f])
|
||||
(list (vector-ref x 0) (vector-ref x 1))))
|
||||
|
||||
((fix-vector-field-fun f) 0.0 0.0)
|
||||
|
|
@ -57,30 +57,30 @@
|
|||
(test-suite "Known bugs"
|
||||
|
||||
;; Arguments are converted to inexact too early
|
||||
(bad-opt (* (make-rectangular -inf.0 1) (* 1 1)))
|
||||
(bad-opt (/ -inf.0-inf.0i 8))
|
||||
(good-opt (* (make-rectangular -inf.0 1) (* 1 1)))
|
||||
(good-opt (/ -inf.0-inf.0i 8))
|
||||
(good-opt (- (* -1 1 +nan.0) 1.0+1.0i))
|
||||
(good-opt (- (* (/ 6 11) (/ 1.2345678f0 123456.7f0)) (make-rectangular 0.0 0.3)))
|
||||
(bad-opt (/ 1.0 0.0+0.0i))
|
||||
(good-opt (/ 1.0 0.0+0.0i))
|
||||
(good-opt (+ 0.0+0.0i (* 1 1 +inf.0)))
|
||||
(bad-opt (* 1.0f-30 1.0f-30 1.0e60+1.0e60i))
|
||||
|
||||
;; Unary division has bad underflow
|
||||
(good-opt (/ (make-rectangular 1e+100 1e-300)))
|
||||
(good-opt (/ 0.5+1.7e+308i))
|
||||
(bad-opt (/ 1 (make-rectangular 1e+100 1e-300)))
|
||||
(bad-opt (/ 1 0.5+1.7e+308i))
|
||||
(good-opt (/ 1 (make-rectangular 1e+100 1e-300)))
|
||||
(good-opt (/ 1 0.5+1.7e+308i))
|
||||
|
||||
;; Division of complex 0 should only make part of the result nan
|
||||
(good-opt (/ 0.0+0.0i))
|
||||
(bad-opt (/ 1 0.0+0.0i))
|
||||
(bad-opt (/ 1.5 -3.0+9.8e-324i))
|
||||
(good-opt (/ 1 0.0+0.0i))
|
||||
(good-opt (/ 1.5 -3.0+9.8e-324i))
|
||||
|
||||
;; Division of complex infinity should only make part of the result nan
|
||||
(good-opt (/ (make-rectangular 1.0 +inf.0)))
|
||||
(good-opt (/ (make-rectangular +inf.0 1.0)))
|
||||
(bad-opt (/ 1 (make-rectangular 1.0 +inf.0)))
|
||||
(bad-opt (/ 1 (make-rectangular +inf.0 1.0)))
|
||||
(good-opt (/ 1 (make-rectangular 1.0 +inf.0)))
|
||||
(good-opt (/ 1 (make-rectangular +inf.0 1.0)))
|
||||
|
||||
;; Exp of large real should have 0 imaginary component
|
||||
(good-opt (+ (exp 1.7976931348623151e+308) 0.0+0.0i))
|
||||
|
|
|
|||
|
|
@ -16,12 +16,21 @@ TR opt: float-complex-float.rkt 5:0 (- 1.0+2.0i 2.0+4.0i 3.0) -- unboxed binary
|
|||
TR opt: float-complex-float.rkt 5:12 2.0+4.0i -- unboxed literal
|
||||
TR opt: float-complex-float.rkt 5:21 3.0 -- float in complex ops
|
||||
TR opt: float-complex-float.rkt 5:3 1.0+2.0i -- unboxed literal
|
||||
TR opt: float-complex-float.rkt 6:0 (/ 0.0 +inf.0-1.0i) -- unboxed binary float complex
|
||||
TR opt: float-complex-float.rkt 6:3 0.0 -- float in complex ops
|
||||
TR opt: float-complex-float.rkt 6:7 +inf.0-1.0i -- unboxed literal
|
||||
TR opt: float-complex-float.rkt 7:0 (* -0.9263371220283309 3/2 (make-rectangular +inf.f 0.7692234292042541)) -- unboxed binary float complex
|
||||
TR opt: float-complex-float.rkt 7:23 3/2 -- non float complex in complex ops
|
||||
TR opt: float-complex-float.rkt 7:27 (make-rectangular +inf.f 0.7692234292042541) -- make-rectangular elimination
|
||||
TR opt: float-complex-float.rkt 7:3 -0.9263371220283309 -- float in complex ops
|
||||
END
|
||||
#<<END
|
||||
6.0+8.0i
|
||||
-4.0-10.0i
|
||||
-4.0-4.0i
|
||||
-4.0-2.0i
|
||||
+nan.0+0.0i
|
||||
-inf.0-1.0688403264087485i
|
||||
|
||||
END
|
||||
#lang typed/scheme
|
||||
|
|
@ -32,3 +41,5 @@ END
|
|||
(- 1.0 2.0+4.0i 3.0+6.0i)
|
||||
(- 1.0+2.0i 2.0 3.0+6.0i)
|
||||
(- 1.0+2.0i 2.0+4.0i 3.0)
|
||||
(/ 0.0 +inf.0-1.0i)
|
||||
(* -0.9263371220283309 3/2 (make-rectangular +inf.f 0.7692234292042541))
|
||||
|
|
|
|||
7
typed-racket-test/succeed/match-or.rkt
Normal file
7
typed-racket-test/succeed/match-or.rkt
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
#lang typed/racket
|
||||
|
||||
(: f : (Listof Integer) (Listof Integer) → Integer)
|
||||
(define (f xs ys)
|
||||
(match* (xs ys)
|
||||
[((list a b) (or (list a b) (list b a))) (+ a b)]
|
||||
[(_ _) 42]))
|
||||
|
|
@ -41,7 +41,6 @@
|
|||
"filter-tests.rkt"
|
||||
"metafunction-tests.rkt"
|
||||
"generalize-tests.rkt"
|
||||
"rep-tests.rkt"
|
||||
"prims-tests.rkt"
|
||||
"tooltip-tests.rkt"
|
||||
"prefab-tests.rkt"
|
||||
|
|
|
|||
|
|
@ -1,23 +0,0 @@
|
|||
#lang racket/base
|
||||
|
||||
;; Tests for TR representation data structures such as types
|
||||
|
||||
(require "test-utils.rkt"
|
||||
rackunit
|
||||
typed-racket/rep/rep-utils
|
||||
typed-racket/rep/type-rep
|
||||
typed-racket/types/abbrev)
|
||||
|
||||
(provide tests)
|
||||
(gen-test-main)
|
||||
|
||||
(define tests
|
||||
(test-suite
|
||||
"Tests for TR IR data structures"
|
||||
|
||||
;; Make sure that unsafe operations return the same results as safe ones
|
||||
(check-equal? (Rep-seq -String) (unsafe-Rep-seq -String))
|
||||
(check-equal? (Rep-seq (-pair -String -String)) (unsafe-Rep-seq (-pair -String -String)))
|
||||
(check-equal? (Type-key -String) (unsafe-Type-key -String))
|
||||
(check-equal? (Type-key (-pair -String -String)) (unsafe-Type-key (-pair -String -String)))
|
||||
))
|
||||
|
|
@ -450,7 +450,11 @@
|
|||
(tc-e (min (ann 3 Fixnum) (ann 3 Fixnum)) -Fixnum)
|
||||
(tc-e (min (ann -2 Negative-Fixnum) (ann 3 Fixnum)) -NegFixnum)
|
||||
(tc-e (min (ann 3 Fixnum) (ann -2 Negative-Fixnum)) -NegFixnum)
|
||||
(tc-e (fl/ 1.7976931348623157e+308 -0.0e0) -Flonum)
|
||||
(tc-e (expt (make-rectangular 3 -1.7976931348623157e+308) (flacos (real->double-flonum 59.316513f0))) (t:Un -Flonum -FloatComplex))
|
||||
(tc-e (exact->inexact (ann 3 Number)) (t:Un -InexactReal -InexactComplex))
|
||||
(tc-e (/ (round (exact-round -2.7393196f0)) (real->double-flonum (inexact->exact (real->single-flonum -0.0)))) -Real)
|
||||
(tc-e (bitwise-and (exact-round 1.7976931348623157e+308) (exact-round -29)) -Int)
|
||||
(tc-e (exact->inexact 3) -PosFlonum)
|
||||
(tc-e (exact->inexact -3) -NegFlonum)
|
||||
(tc-e (real->double-flonum 0.0) -FlonumPosZero)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user