diff --git a/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt b/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt new file mode 100644 index 00000000..800f688e --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt @@ -0,0 +1,4 @@ +#lang typed/racket #:optimize +(require racket/unsafe/ops) +(apply + (map add1 (list 1 2 3))) +(apply * (map add1 (list 1 2 3))) diff --git a/collects/tests/typed-scheme/optimizer/generic/box.rkt b/collects/tests/typed-scheme/optimizer/generic/box.rkt new file mode 100644 index 00000000..aa6695de --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/box.rkt @@ -0,0 +1,9 @@ +#lang typed/scheme #:optimize + +(require racket/unsafe/ops) + +(: x (Boxof Integer)) +(define x (box 1)) +(unbox x) +(set-box! x 2) +(unbox x) diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let.rkt new file mode 100644 index 00000000..4039f652 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let.rkt @@ -0,0 +1,12 @@ +#lang typed/scheme #:optimize + +(require racket/unsafe/ops) + +(let ((t1 (+ 1.0+2.0i 2.0+4.0i)) ; can be unboxed + (t2 (+ 3.0+6.0i 4.0+8.0i)) ; can't be unboxed + (t3 1.0+2.0i) ; can't be unboxed + (t4 1)) + (display (+ t1 t1)) + (display t2) + (display t3) + (display t4)) diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let2.rkt new file mode 100644 index 00000000..f41ef094 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let2.rkt @@ -0,0 +1,7 @@ +#lang typed/scheme #:optimize + +(require racket/unsafe/ops) + +;; unboxing of let bindings does not currently work with multiple values +(let-values (((t1 t2) (values (+ 1.0+2.0i 2.0+4.0i) (+ 3.0+6.0i 4.0+8.0i)))) + (+ t1 t2)) diff --git a/collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt b/collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt new file mode 100644 index 00000000..e9f58d5d --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt @@ -0,0 +1,6 @@ +#lang typed/scheme #:optimize + +(require racket/unsafe/ops) + +(let ((x (+ 1.0 2.0))) + x) diff --git a/collects/tests/typed-scheme/optimizer/generic/one-arg-arith.rkt b/collects/tests/typed-scheme/optimizer/generic/one-arg-arith.rkt new file mode 100644 index 00000000..990036e4 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/one-arg-arith.rkt @@ -0,0 +1,20 @@ +#lang typed/scheme #:optimize + +(require racket/unsafe/ops) + +(- 12) +(- 12.0) +(/ 4.2) + +(+ 1) +(+ 1.0) +(+ (expt 2 100)) +(* 1) +(* 1.0) +(* (expt 2 100)) +(min 1) +(min 1.0) +(min (expt 2 100)) +(max 1) +(max 1.0) +(max (expt 2 100)) diff --git a/collects/tests/typed-scheme/optimizer/generic/string-length.rkt b/collects/tests/typed-scheme/optimizer/generic/string-length.rkt new file mode 100644 index 00000000..30210100 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/string-length.rkt @@ -0,0 +1,6 @@ +#lang typed/scheme #:optimize + +(require racket/unsafe/ops) + +(string-length "eh") +(bytes-length #"eh") diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt new file mode 100644 index 00000000..bfa8fff1 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt @@ -0,0 +1,8 @@ +#lang typed/scheme #:optimize + +(require racket/unsafe/ops) + +(let* ((t1 (+ 1.0+2.0i 2.0+4.0i)) + (t2 (- t1 3.0+6.0i)) + (t3 4.0+8.0i)) + (+ t2 t3)) diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let2.rkt new file mode 100644 index 00000000..f5f8c2a5 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let2.rkt @@ -0,0 +1,7 @@ +#lang typed/scheme #:optimize + +(require racket/unsafe/ops) + +(let ((t1 (+ 1.0+2.0i 2.0+4.0i)) + (t2 (+ 3.0+6.0i 4.0+8.0i))) + (+ t1 t2)) diff --git a/collects/tests/typed-scheme/optimizer/generic/zero.rkt b/collects/tests/typed-scheme/optimizer/generic/zero.rkt new file mode 100644 index 00000000..dc78943c --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/zero.rkt @@ -0,0 +1,4 @@ +#lang typed/scheme #:optimize +(require racket/unsafe/ops) +(zero? 1) +(zero? (sqrt 3.0)) diff --git a/collects/tests/typed-scheme/run.rkt b/collects/tests/typed-scheme/run.rkt index 7f40679c..b848d7ae 100644 --- a/collects/tests/typed-scheme/run.rkt +++ b/collects/tests/typed-scheme/run.rkt @@ -4,30 +4,39 @@ (require "main.ss") (define exec (make-parameter go/text)) -(define the-tests (make-parameter tests)) -(define skip-all? #f) +(define the-tests (make-parameter #f)) (define nightly? (make-parameter #f)) +(define unit? (make-parameter #f)) +(define int? (make-parameter #f)) (define opt? (make-parameter #f)) (define bench? (make-parameter #f)) (current-namespace (make-base-namespace)) (command-line #:once-each - ["--unit" "run just the unit tests" (the-tests unit-tests)] - ["--int" "run just the integration tests" (the-tests int-tests)] - ["--nightly" "for the nightly builds" (nightly? #t)] + ["--unit" "run the unit tests" (unit? #t)] + ["--int" "run the integration tests" (int? #t)] + ["--nightly" "for the nightly builds" (begin (nightly? #t) (unit? #t) (int? #t))] ["--just" path "run only this test" (the-tests (just-one path))] ["--opt" "run the optimizer tests" (opt? #t)] ["--benchmarks" "compile the typed benchmarks" (bench? #t)] + ["--all" "run all tests" (begin (unit? #t) (int? #t) (opt? #t) (bench? #t))] ["--gui" "run using the gui" (if (gui-available?) (begin (exec go)) (error "GUI not available"))] ) +(the-tests + (cond [(and (unit?) (int?)) tests] + [(unit?) unit-tests] + [(int?) int-tests] + [else #f])) + (cond [(and (nightly?) (eq? 'cgc (system-type 'gc))) (printf "Skipping Typed Racket tests.\n")] - [(unless (= 0 ((exec) (the-tests))) - (eprintf "Typed Racket Tests did not pass.")) + [(when (the-tests) + (unless (= 0 ((exec) (the-tests))) + (eprintf "Typed Racket Tests did not pass."))) (when (opt?) (parameterize ([current-command-line-arguments #()]) (dynamic-require '(file "optimizer/run.rkt") #f)) diff --git a/collects/typed-scheme/optimizer/apply.rkt b/collects/typed-scheme/optimizer/apply.rkt new file mode 100644 index 00000000..4fa67d97 --- /dev/null +++ b/collects/typed-scheme/optimizer/apply.rkt @@ -0,0 +1,32 @@ +#lang scheme/base +(require syntax/parse + syntax/id-table racket/dict + unstable/match scheme/match + (for-template scheme/unsafe/ops racket/base (prefix-in k: '#%kernel)) + (for-syntax racket/base) + "../utils/utils.rkt" + (rep type-rep) + (types abbrev type-table utils subtype) + (optimizer utils)) + +(provide apply-opt-expr) + +(define-syntax-class apply-op + #:literals (+ *) + (pattern + #:with identity #'0) + (pattern * #:with identity #'1)) + +(define-syntax-class apply-opt-expr + #:literals (k:apply map #%plain-app #%app) + (pattern (#%plain-app k:apply op:apply-op (#%plain-app map f l)) + #:with opt + (begin (reset-unboxed-gensym) + (with-syntax ([(f* lp v lst) (map unboxed-gensym '(f* loop v lst))] + [l ((optimize) #'l)] + [f ((optimize) #'f)]) + (log-optimization "apply-map" #'op) + #'(let ([f* f]) + (let lp ([v op.identity] [lst l]) + (if (null? lst) + v + (lp (op v (f* (unsafe-car lst))) (unsafe-cdr lst))))))))) diff --git a/collects/typed-scheme/optimizer/box.rkt b/collects/typed-scheme/optimizer/box.rkt new file mode 100644 index 00000000..99efba91 --- /dev/null +++ b/collects/typed-scheme/optimizer/box.rkt @@ -0,0 +1,29 @@ +#lang scheme/base + +(require syntax/parse + unstable/match scheme/match + "../utils/utils.rkt" + (for-template scheme/base scheme/fixnum scheme/unsafe/ops) + (rep type-rep) + (types abbrev type-table utils subtype) + (optimizer utils)) + +(provide box-opt-expr) + +(define-syntax-class box-expr + (pattern e:expr + #:when (match (type-of #'e) + [(tc-result1: (Box: _)) #t] + [_ #f]) + #:with opt ((optimize) #'e))) + +(define-syntax-class box-op + ;; we need the * versions of these unsafe operations to be chaperone-safe + (pattern (~literal unbox) #:with unsafe #'unsafe-unbox*) + (pattern (~literal set-box!) #:with unsafe #'unsafe-set-box*!)) + +(define-syntax-class box-opt-expr + (pattern (#%plain-app op:box-op b:box-expr new:expr ...) + #:with opt + (begin (log-optimization "box" #'op) + #`(op.unsafe b.opt #,@(map (optimize) (syntax->list #'(new ...))))))) diff --git a/collects/typed-scheme/optimizer/fixnum.rkt b/collects/typed-scheme/optimizer/fixnum.rkt index 8959261e..fbe684c1 100644 --- a/collects/typed-scheme/optimizer/fixnum.rkt +++ b/collects/typed-scheme/optimizer/fixnum.rkt @@ -71,7 +71,18 @@ #:with opt (begin (log-optimization "binary nonzero fixnum" #'op) #'(op.unsafe n1.opt n2.opt))) + + (pattern (#%plain-app (~and op (~literal -)) f:fixnum-expr) + #:with opt + (begin (log-optimization "unary fixnum" #'op) + #'(unsafe-fx- 0 f.opt))) + (pattern (#%plain-app (~and op (~literal exact->inexact)) n:fixnum-expr) #:with opt (begin (log-optimization "fixnum to float" #'op) - #'(unsafe-fx->fl n.opt)))) + #'(unsafe-fx->fl n.opt))) + + (pattern (#%plain-app (~and op (~literal zero?)) n:fixnum-expr) + #:with opt + (begin (log-optimization "fixnum zero?" #'op) + #'(unsafe-fx= n.opt 0)))) diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt index 549cc493..b7970212 100644 --- a/collects/typed-scheme/optimizer/float.rkt +++ b/collects/typed-scheme/optimizer/float.rkt @@ -68,13 +68,22 @@ #:with opt (begin (log-optimization "binary float" #'op) (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...)))) - (pattern (~and res (#%plain-app (~var op (float-op binary-float-comps)) - f1:float-expr - f2:float-expr - fs:float-expr ...)) + (pattern (#%plain-app (~var op (float-op binary-float-comps)) + f1:float-expr + f2:float-expr + fs:float-expr ...) #:with opt (begin (log-optimization "binary float comp" #'op) (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...)))) + + (pattern (#%plain-app (~and op (~literal -)) f:float-expr) + #:with opt + (begin (log-optimization "unary float" #'op) + #'(unsafe-fl- 0.0 f.opt))) + (pattern (#%plain-app (~and op (~literal /)) f:float-expr) + #:with opt + (begin (log-optimization "unary float" #'op) + #'(unsafe-fl/ 1.0 f.opt))) ;; we can optimize exact->inexact if we know we're giving it an Integer (pattern (#%plain-app (~and op (~literal exact->inexact)) n:int-expr) @@ -85,4 +94,9 @@ (pattern (#%plain-app (~and op (~literal exact->inexact)) f:float-expr) #:with opt (begin (log-optimization "float to float" #'op) - #'f.opt))) + #'f.opt)) + + (pattern (#%plain-app (~and op (~literal zero?)) f:float-expr) + #:with opt + (begin (log-optimization "float zero?" #'op) + #'(unsafe-fl= f.opt 0.0)))) diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt index 99ec1c38..3eeaa32b 100644 --- a/collects/typed-scheme/optimizer/inexact-complex.rkt +++ b/collects/typed-scheme/optimizer/inexact-complex.rkt @@ -1,90 +1,101 @@ #lang scheme/base -(require syntax/parse +(require syntax/parse syntax/id-table scheme/dict "../utils/utils.rkt" (for-template scheme/base scheme/math scheme/flonum scheme/unsafe/ops) (types abbrev type-table utils subtype) (optimizer utils float fixnum)) -(provide inexact-complex-opt-expr) +(provide inexact-complex-opt-expr inexact-complex-arith-opt-expr + unboxed-inexact-complex-opt-expr unboxed-vars-table) +;; contains the bindings which actually exist as separate bindings for each component +;; associates identifiers to lists (real-binding imag-binding) +(define unboxed-vars-table (make-free-id-table)) + ;; it's faster to take apart a complex number and use unsafe operations on ;; its parts than it is to use generic operations ;; we keep the real and imaginary parts unboxed as long as we stay within ;; complex operations (define-syntax-class unboxed-inexact-complex-opt-expr + (pattern (#%plain-app (~and op (~literal +)) c1:unboxed-inexact-complex-opt-expr c2:unboxed-inexact-complex-opt-expr cs:unboxed-inexact-complex-opt-expr ...) - #:with real-part (unboxed-gensym) - #:with imag-part (unboxed-gensym) + #:with real-binding (unboxed-gensym) + #:with imag-binding (unboxed-gensym) #:with (bindings ...) (begin (log-optimization "unboxed binary inexact complex" #'op) #`(#,@(append (syntax->list #'(c1.bindings ... c2.bindings ... cs.bindings ... ...)) - (list #`(real-part #,(for/fold ((o #'c1.real-part)) - ((e (syntax->list #'(c2.real-part cs.real-part ...)))) - #`(unsafe-fl+ #,o #,e))) - ;; we can skip the imaginary parts of reals (#f) - #`(imag-part - #,(let ((l (filter syntax->datum - (syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...))))) - (case (length l) - ((0) #'0.0) - ((1) (car l)) - (else - (for/fold ((o (car l))) - ((e (cdr l))) - #`(unsafe-fl+ #,o #,e))))))))))) + (let () + ;; we can skip the real parts of imaginaries (#f) and vice versa + (define (skip-0s l) + (let ((l (filter syntax->datum (syntax->list l)))) + (case (length l) + ((0) #'0.0) + ((1) (car l)) + (else + (for/fold ((o (car l))) + ((e (cdr l))) + #`(unsafe-fl+ #,o #,e)))))) + (list + #`(real-binding #,(skip-0s #'(c1.real-binding c2.real-binding cs.real-binding ...))) + #`(imag-binding #,(skip-0s #'(c1.imag-binding c2.imag-binding cs.imag-binding ...))))))))) + (pattern (#%plain-app (~and op (~literal -)) c1:unboxed-inexact-complex-opt-expr c2:unboxed-inexact-complex-opt-expr cs:unboxed-inexact-complex-opt-expr ...) - #:with real-part (unboxed-gensym) - #:with imag-part (unboxed-gensym) + #:with real-binding (unboxed-gensym) + #:with imag-binding (unboxed-gensym) #:with (bindings ...) (begin (log-optimization "unboxed binary inexact complex" #'op) #`(#,@(append (syntax->list #'(c1.bindings ... c2.bindings ... cs.bindings ... ...)) - (list #`(real-part #,(for/fold ((o #'c1.real-part)) - ((e (syntax->list #'(c2.real-part cs.real-part ...)))) - #`(unsafe-fl- #,o #,e))) - ;; unlike addition, we simply can't skip imaginary parts of reals - #`(imag-part - #,(let* ((l1 (map (lambda (x) (if (syntax->datum x) x #'0.0)) - (syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...)))) - ;; but we can skip all but the first 0 - (l2 (filter (lambda (x) (not (equal? (syntax->datum x) 0.0))) - (cdr l1)))) - (case (length l2) - ((0) (car l1)) - (else - (for/fold ((o (car l1))) - ((e l2)) - #`(unsafe-fl- #,o #,e))))))))))) + (let () + ;; unlike addition, we simply can't skip real parts of imaginaries + (define (skip-0s l) + (let* ((l1 (map (lambda (x) (if (syntax->datum x) x #'0.0)) + (syntax->list l))) + ;; but we can skip all but the first 0 + (l2 (filter (lambda (x) (not (equal? (syntax->datum x) 0.0))) + (cdr l1)))) + (case (length l2) + ((0) (car l1)) + (else + (for/fold ((o (car l1))) + ((e l2)) + #`(unsafe-fl- #,o #,e)))))) + (list + #`(real-binding #,(skip-0s #'(c1.real-binding c2.real-binding cs.real-binding ...))) + #`(imag-binding #,(skip-0s #'(c1.imag-binding c2.imag-binding cs.imag-binding ...))))))))) + (pattern (#%plain-app (~and op (~literal *)) c1:unboxed-inexact-complex-opt-expr c2:unboxed-inexact-complex-opt-expr cs:unboxed-inexact-complex-opt-expr ...) - #:with real-part (unboxed-gensym) - #:with imag-part (unboxed-gensym) + #:with real-binding (unboxed-gensym) + #:with imag-binding (unboxed-gensym) #:with (bindings ...) (begin (log-optimization "unboxed binary inexact complex" #'op) #`(c1.bindings ... c2.bindings ... cs.bindings ... ... ;; we want to bind the intermediate results to reuse them - ;; the final results are bound to real-part and imag-part - #,@(let ((l (map (lambda (x) (if (syntax->datum x) x #'0.0)) - (syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...))))) - (let loop ([o1 #'c1.real-part] - [o2 (car l)] - [e1 (syntax->list #'(c2.real-part cs.real-part ...))] - [e2 (cdr l)] + ;; the final results are bound to real-binding and imag-binding + #,@(let ((lr (map (lambda (x) (if (syntax->datum x) x #'0.0)) + (syntax->list #'(c1.real-binding c2.real-binding cs.real-binding ...)))) + (li (map (lambda (x) (if (syntax->datum x) x #'0.0)) + (syntax->list #'(c1.imag-binding c2.imag-binding cs.imag-binding ...))))) + (let loop ([o1 (car lr)] + [o2 (car li)] + [e1 (cdr lr)] + [e2 (cdr li)] [rs (append (map (lambda (x) (unboxed-gensym)) - (syntax->list #'(cs.real-part ...))) - (list #'real-part))] + (syntax->list #'(cs.real-binding ...))) + (list #'real-binding))] [is (append (map (lambda (x) (unboxed-gensym)) - (syntax->list #'(cs.imag-part ...))) - (list #'imag-part))] + (syntax->list #'(cs.imag-binding ...))) + (list #'imag-binding))] [res '()]) (if (null? e1) (reverse res) @@ -107,32 +118,34 @@ #`(unsafe-fl- (unsafe-fl* #,o1 #,(car e1)) (unsafe-fl* #,o2 #,(car e2)))))) res))))))))) + (pattern (#%plain-app (~and op (~literal /)) c1:unboxed-inexact-complex-opt-expr c2:unboxed-inexact-complex-opt-expr cs:unboxed-inexact-complex-opt-expr ...) - #:with real-part (unboxed-gensym) - #:with imag-part (unboxed-gensym) - #:with reals (syntax->list #'(c1.real-part c2.real-part cs.real-part ...)) + #:with real-binding (unboxed-gensym) + #:with imag-binding (unboxed-gensym) + #:with reals (map (lambda (x) (if (syntax->datum x) x #'0.0)) + (syntax->list #'(c1.real-binding c2.real-binding cs.real-binding ...))) #:with imags (map (lambda (x) (if (syntax->datum x) x #'0.0)) - (syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...))) + (syntax->list #'(c1.imag-binding c2.imag-binding cs.imag-binding ...))) #:with (bindings ...) (begin (log-optimization "unboxed binary inexact complex" #'op) #`(c1.bindings ... c2.bindings ... cs.bindings ... ... ;; we want to bind the intermediate results to reuse them - ;; the final results are bound to real-part and imag-part + ;; the final results are bound to real-binding and imag-binding #,@(let loop ([o1 (car (syntax->list #'reals))] [o2 (car (syntax->list #'imags))] [e1 (cdr (syntax->list #'reals))] [e2 (cdr (syntax->list #'imags))] [rs (append (map (lambda (x) (unboxed-gensym)) - (syntax->list #'(cs.real-part ...))) - (list #'real-part))] + (syntax->list #'(cs.real-binding ...))) + (list #'real-binding))] [is (append (map (lambda (x) (unboxed-gensym)) - (syntax->list #'(cs.imag-part ...))) - (list #'imag-part))] + (syntax->list #'(cs.imag-binding ...))) + (list #'imag-binding))] [ds (map (lambda (x) (unboxed-gensym)) - (syntax->list #'(c2.real-part cs.real-part ...)))] + (syntax->list #'(c2.real-binding cs.real-binding ...)))] [res '()]) (if (null? e1) (reverse res) @@ -175,55 +188,88 @@ (unsafe-fl+ (unsafe-fl* #,(car e1) #,(car e1)) (unsafe-fl* #,(car e2) #,(car e2)))) res)])))))))) + (pattern (#%plain-app (~and op (~literal conjugate)) c:unboxed-inexact-complex-opt-expr) - #:with real-part #'c.real-part - #:with imag-part (unboxed-gensym) + #:with real-binding #'c.real-binding + #:with imag-binding (unboxed-gensym) #:with (bindings ...) (begin (log-optimization "unboxed unary inexact complex" #'op) #`(#,@(append (syntax->list #'(c.bindings ...)) - (list #'(imag-part (unsafe-fl- 0.0 c.imag-part))))))) + (list #'(imag-binding (unsafe-fl- 0.0 c.imag-binding))))))) + + (pattern (#%plain-app (~and op (~or (~literal real-part) (~literal unsafe-flreal-part))) + c:unboxed-inexact-complex-opt-expr) + #:with real-binding #'c.real-binding + #:with imag-binding #f + #:with (bindings ...) + (begin (log-optimization "unboxed unary inexact complex" #'op) + #'(c.bindings ...))) + (pattern (#%plain-app (~and op (~or (~literal imag-part) (~literal unsafe-flimag-part))) + c:unboxed-inexact-complex-opt-expr) + #:with real-binding #'c.imag-binding + #:with imag-binding #f + #:with (bindings ...) + (begin (log-optimization "unboxed unary inexact complex" #'op) + #'(c.bindings ...))) + + ;; if we see a variable that's already unboxed, use the unboxed bindings + (pattern v:id + #:with unboxed-info (dict-ref unboxed-vars-table #'v #f) + #:when (syntax->datum #'unboxed-info) + #:with real-binding (car (syntax->list #'unboxed-info)) + #:with imag-binding (cadr (syntax->list #'unboxed-info)) + #:with (bindings ...) #'()) + + ;; else, do the unboxing here (pattern e:expr #:when (isoftype? #'e -InexactComplex) #:with e* (unboxed-gensym) - #:with real-part (unboxed-gensym) - #:with imag-part (unboxed-gensym) + #:with real-binding (unboxed-gensym) + #:with imag-binding (unboxed-gensym) #:with (bindings ...) #`((e* #,((optimize) #'e)) - (real-part (unsafe-flreal-part e*)) - (imag-part (unsafe-flimag-part e*)))) + (real-binding (unsafe-flreal-part e*)) + (imag-binding (unsafe-flimag-part e*)))) ;; special handling of reals (pattern e:float-expr - #:with real-part (unboxed-gensym) - #:with imag-part #f + #:with real-binding (unboxed-gensym) + #:with imag-binding #f #:with (bindings ...) - #`((real-part #,((optimize) #'e)))) + #`((real-binding #,((optimize) #'e)))) (pattern e:fixnum-expr - #:with real-part (unboxed-gensym) - #:with imag-part #f + #:with real-binding (unboxed-gensym) + #:with imag-binding #f #:with (bindings ...) - #`((real-part (unsafe-fx->fl #,((optimize) #'e))))) + #`((real-binding (unsafe-fx->fl #,((optimize) #'e))))) (pattern e:int-expr - #:with real-part (unboxed-gensym) - #:with imag-part #f + #:with real-binding (unboxed-gensym) + #:with imag-binding #f #:with (bindings ...) - #`((real-part (->fl #,((optimize) #'e))))) + #`((real-binding (->fl #,((optimize) #'e))))) (pattern e:expr #:when (isoftype? #'e -Real) - #:with real-part (unboxed-gensym) - #:with imag-part #f + #:with real-binding (unboxed-gensym) + #:with imag-binding #f #:with (bindings ...) - #`((real-part (exact->inexact #,((optimize) #'e))))) + #`((real-binding (exact->inexact #,((optimize) #'e))))) + (pattern e:expr + #:when (isoftype? #'e -Number) ; complex, maybe exact, maybe not + #:with real-binding (unboxed-gensym) + #:with imag-binding (unboxed-gensym) + #:with (bindings ...) + #`((real-binding (real-part #,((optimize) #'e))) + (imag-binding (imag-part #,((optimize) #'e))))) (pattern e:expr #:with (bindings ...) (error "non exhaustive pattern match") - #:with real-part #f - #:with imag-part #f)) + #:with real-binding #f + #:with imag-binding #f)) (define-syntax-class inexact-complex-unary-op (pattern (~or (~literal real-part) (~literal flreal-part)) #:with unsafe #'unsafe-flreal-part) (pattern (~or (~literal imag-part) (~literal flimag-part)) #:with unsafe #'unsafe-flimag-part)) -(define-syntax-class inexact-complex-binary-op +(define-syntax-class inexact-complex-op (pattern (~or (~literal +) (~literal -) (~literal *) (~literal /) (~literal conjugate)))) (define-syntax-class inexact-complex-expr @@ -232,15 +278,39 @@ #:with opt ((optimize) #'e))) (define-syntax-class inexact-complex-opt-expr + + ;; we can optimize taking the real of imag part of an unboxed complex + ;; hopefully, the compiler can eliminate unused bindings for the other part if it's not used + (pattern (#%plain-app (~and op (~or (~literal real-part) (~literal unsafe-flreal-part) + (~literal imag-part) (~literal unsafe-flimag-part))) + c:inexact-complex-expr) + #:with c*:inexact-complex-arith-opt-expr #'c + #:with opt + (begin (log-optimization "unboxed inexact complex" #'op) + (reset-unboxed-gensym) + #`(let* (c*.bindings ...) + #,(if (or (free-identifier=? #'op #'real-part) + (free-identifier=? #'op #'unsafe-flreal-part)) + #'c*.real-binding + #'c*.imag-binding)))) + (pattern (#%plain-app op:inexact-complex-unary-op n:inexact-complex-expr) #:with opt (begin (log-optimization "unary inexact complex" #'op) #'(op.unsafe n.opt))) - (pattern (~and exp (#%plain-app op:inexact-complex-binary-op e:expr ...)) + (pattern e:inexact-complex-arith-opt-expr + #:with opt + #'e.opt)) + +(define-syntax-class inexact-complex-arith-opt-expr + (pattern (~and exp (#%plain-app op:inexact-complex-op e:expr ...)) #:when (isoftype? #'exp -InexactComplex) #:with exp*:unboxed-inexact-complex-opt-expr #'exp + #:with real-binding #'exp*.real-binding + #:with imag-binding #'exp*.imag-binding + #:with (bindings ...) #'(exp*.bindings ...) #:with opt (begin (log-optimization "unboxed inexact complex" #'exp) (reset-unboxed-gensym) #'(let* (exp*.bindings ...) - (unsafe-make-flrectangular exp*.real-part exp*.imag-part))))) + (unsafe-make-flrectangular exp*.real-binding exp*.imag-binding))))) diff --git a/collects/typed-scheme/optimizer/number.rkt b/collects/typed-scheme/optimizer/number.rkt new file mode 100644 index 00000000..81acd094 --- /dev/null +++ b/collects/typed-scheme/optimizer/number.rkt @@ -0,0 +1,16 @@ +#lang scheme/base + +(require syntax/parse + (for-template scheme/base scheme/flonum scheme/unsafe/ops) + "../utils/utils.rkt" + (optimizer utils)) + +(provide number-opt-expr) + +(define-syntax-class number-opt-expr + ;; these cases are all identity + (pattern (#%plain-app (~and op (~or (~literal +) (~literal *) (~literal min) (~literal max))) + f:expr) + #:with opt + (begin (log-optimization "unary number" #'op) + ((optimize) #'f)))) diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt index 730d6680..eb07adcd 100644 --- a/collects/typed-scheme/optimizer/optimizer.rkt +++ b/collects/typed-scheme/optimizer/optimizer.rkt @@ -2,10 +2,13 @@ (require syntax/parse syntax/id-table racket/dict - (for-template scheme/base scheme/flonum scheme/fixnum scheme/unsafe/ops racket/private/for) + (for-template scheme/base + scheme/flonum scheme/fixnum scheme/unsafe/ops + racket/private/for) "../utils/utils.rkt" (types abbrev type-table utils subtype) - (optimizer utils fixnum float inexact-complex vector pair sequence struct dead-code)) + (optimizer utils number fixnum float inexact-complex vector string + pair sequence box struct dead-code apply unboxed-let)) (provide optimize-top) @@ -18,35 +21,58 @@ #:literal-sets (kernel-literals) ;; interesting cases, where something is optimized + (pattern e:apply-opt-expr #:with opt #'e.opt) + (pattern e:number-opt-expr #:with opt #'e.opt) (pattern e:fixnum-opt-expr #:with opt #'e.opt) (pattern e:float-opt-expr #:with opt #'e.opt) (pattern e:inexact-complex-opt-expr #:with opt #'e.opt) (pattern e:vector-opt-expr #:with opt #'e.opt) + (pattern e:string-opt-expr #:with opt #'e.opt) (pattern e:pair-opt-expr #:with opt #'e.opt) (pattern e:sequence-opt-expr #:with opt #'e.opt) + (pattern e:box-opt-expr #:with opt #'e.opt) (pattern e:struct-opt-expr #:with opt #'e.opt) (pattern e:dead-code-opt-expr #:with opt #'e.opt) + (pattern e:unboxed-let-opt-expr #:with opt #'e.opt) ;; boring cases, just recur down - (pattern (#%plain-lambda formals e:opt-expr ...) - #:with opt #'(#%plain-lambda formals e.opt ...)) - (pattern (define-values formals e:opt-expr ...) - #:with opt #'(define-values formals e.opt ...)) - (pattern (case-lambda [formals e:opt-expr ...] ...) - #:with opt #'(case-lambda [formals e.opt ...] ...)) - (pattern (let-values ([ids e-rhs:opt-expr] ...) e-body:opt-expr ...) - #:with opt #'(let-values ([ids e-rhs.opt] ...) e-body.opt ...)) - (pattern (letrec-values ([ids e-rhs:opt-expr] ...) e-body:opt-expr ...) - #:with opt #'(letrec-values ([ids e-rhs.opt] ...) e-body.opt ...)) - (pattern (letrec-syntaxes+values stx-bindings ([(ids ...) e-rhs:opt-expr] ...) e-body:opt-expr ...) - #:with opt #'(letrec-syntaxes+values stx-bindings ([(ids ...) e-rhs.opt] ...) e-body.opt ...)) + (pattern ((~and op (~or (~literal #%plain-lambda) (~literal define-values))) + formals e:expr ...) + #:with opt #`(op formals #,@(map (optimize) (syntax->list #'(e ...))))) + (pattern (case-lambda [formals e:expr ...] ...) + ;; optimize all the bodies + #:with (opt-parts ...) + (map (lambda (part) + (let ((l (syntax->list part))) + (cons (car l) + (map (optimize) (cdr l))))) + (syntax->list #'([formals e ...] ...))) + #:with opt #'(case-lambda opt-parts ...)) + (pattern ((~and op (~or (~literal let-values) (~literal letrec-values))) + ([ids e-rhs:expr] ...) e-body:expr ...) + #:with (opt-rhs ...) (map (optimize) (syntax->list #'(e-rhs ...))) + #:with opt #`(op ([ids opt-rhs] ...) + #,@(map (optimize) (syntax->list #'(e-body ...))))) + (pattern (letrec-syntaxes+values stx-bindings + ([(ids ...) e-rhs:expr] ...) + e-body:expr ...) + ;; optimize all the rhss + #:with (opt-clauses ...) + (map (lambda (clause) + (let ((l (syntax->list clause))) + (list (car l) ((optimize) (cadr l))))) + (syntax->list #'([(ids ...) e-rhs] ...))) + #:with opt #`(letrec-syntaxes+values + stx-bindings + (opt-clauses ...) + #,@(map (optimize) (syntax->list #'(e-body ...))))) (pattern (kw:identifier expr ...) - #:when (ormap (lambda (k) (free-identifier=? k #'kw)) - (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression - #'#%variable-reference #'with-continuation-mark)) + #:when + (for/or ([k (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression + #'#%variable-reference #'with-continuation-mark)]) + (free-identifier=? k #'kw)) ;; we don't want to optimize in the cases that don't match the #:when clause - #:with (expr*:opt-expr ...) #'(expr ...) - #:with opt #'(kw expr*.opt ...)) + #:with opt #`(kw #,@(map (optimize) (syntax->list #'(expr ...))))) (pattern other:expr #:with opt #'other)) @@ -58,12 +84,14 @@ (current-output-port)))) (begin0 (parameterize ([current-output-port port] - [optimize (lambda (stx) - (syntax-parse stx #:literal-sets (kernel-literals) - [e:opt-expr - (syntax/loc stx e.opt)]))]) + [optimize (syntax-parser + [e:expr + #:when (and (not (syntax-property #'e 'typechecker:ignore)) + (not (syntax-property #'e 'typechecker:with-handlers))) + #:with e*:opt-expr #'e + #'e*.opt] + [e:expr #'e])]) ((optimize) stx)) - (if (and *log-optimizations?* - *log-optimizatons-to-log-file?*) - (close-output-port port) - #t)))) + (when (and *log-optimizations?* + *log-optimizatons-to-log-file?*) + (close-output-port port))))) diff --git a/collects/typed-scheme/optimizer/sequence.rkt b/collects/typed-scheme/optimizer/sequence.rkt index c1713099..3821e886 100644 --- a/collects/typed-scheme/optimizer/sequence.rkt +++ b/collects/typed-scheme/optimizer/sequence.rkt @@ -7,7 +7,7 @@ "../utils/utils.rkt" "../utils/tc-utils.rkt" (rep type-rep) (types abbrev type-table utils subtype) - (optimizer utils)) + (optimizer utils string)) (provide sequence-opt-expr) @@ -29,15 +29,6 @@ [_ #f]) #:with opt ((optimize) #'e))) -(define-syntax-class string-expr - (pattern e:expr - #:when (isoftype? #'e -String) - #:with opt ((optimize) #'e))) -(define-syntax-class bytes-expr - (pattern e:expr - #:when (isoftype? #'e -Bytes) - #:with opt ((optimize) #'e))) - (define-syntax-class sequence-opt-expr ;; if we're iterating (with the for macros) over something we know is a list, ;; we can generate code that would be similar to if in-list had been used diff --git a/collects/typed-scheme/optimizer/string.rkt b/collects/typed-scheme/optimizer/string.rkt new file mode 100644 index 00000000..8f9f019e --- /dev/null +++ b/collects/typed-scheme/optimizer/string.rkt @@ -0,0 +1,28 @@ +#lang scheme/base + +(require syntax/parse + (for-template scheme/base scheme/flonum scheme/unsafe/ops) + "../utils/utils.rkt" + (types abbrev type-table utils subtype) + (optimizer utils)) + +(provide string-opt-expr string-expr bytes-expr) + +(define-syntax-class string-expr + (pattern e:expr + #:when (isoftype? #'e -String) + #:with opt ((optimize) #'e))) +(define-syntax-class bytes-expr + (pattern e:expr + #:when (isoftype? #'e -Bytes) + #:with opt ((optimize) #'e))) + +(define-syntax-class string-opt-expr + (pattern (#%plain-app (~literal string-length) s:string-expr) + #:with opt + (begin (log-optimization "string" #'op) + #'(unsafe-string-length s.opt))) + (pattern (#%plain-app (~literal bytes-length) s:bytes-expr) + #:with opt + (begin (log-optimization "bytes" #'op) + #'(unsafe-bytes-length s.opt)))) diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt new file mode 100644 index 00000000..1f28db63 --- /dev/null +++ b/collects/typed-scheme/optimizer/unboxed-let.rkt @@ -0,0 +1,100 @@ +#lang scheme/base + +(require syntax/parse + scheme/list scheme/dict + "../utils/utils.rkt" + "../utils/tc-utils.rkt" + (for-template scheme/base) + (types abbrev) + (optimizer utils inexact-complex)) + +(provide unboxed-let-opt-expr) + +;; possibly replace bindings of complex numbers by bindings of their 2 components +;; useful for intermediate results used more than once and for loop variables + +(define-syntax-class unboxed-let-opt-expr + #:literal-sets (kernel-literals) + (pattern (~and exp (let-values (clause:expr ...) body:expr ...)) + ;; we look for bindings of complexes that are not mutated and only + ;; used in positions where we would unbox them + ;; these are candidates for unboxing + #:with ((candidates ...) (others ...)) + (let-values + (((candidates others) + ;; clauses of form ((v) rhs), currently only supports 1 lhs var + (partition (lambda (p) + (and (isoftype? (cadr p) -InexactComplex) + (let ((v (car (syntax-e (car p))))) + (not (is-var-mutated? v)) + (could-be-unboxed-in? v #'(begin body ...))))) + (map syntax->list (syntax->list #'(clause ...)))))) + (list candidates others)) + #:with (opt-candidates:unboxed-let-clause ...) #'(candidates ...) + #:with (opt-others:let-clause ...) #'(others ...) + #:with opt + (begin (log-optimization "unboxed let bindings" #'exp) + ;; add the unboxed bindings to the table, for them to be used by + ;; further optimizations + (for ((v (in-list (syntax->list #'(opt-candidates.id ...)))) + (r (in-list (syntax->list #'(opt-candidates.real-binding ...)))) + (i (in-list (syntax->list #'(opt-candidates.imag-binding ...))))) + (dict-set! unboxed-vars-table v (list r i))) + #`(let* (opt-candidates.bindings ... ... opt-others.res ...) + #,@(map (optimize) (syntax->list #'(body ...))))))) + +;; if a variable is only used in complex arithmetic operations, it's safe +;; to unbox it +(define (could-be-unboxed-in? v exp) + + (define (direct-child-of? exp) + (ormap (lambda (x) (and (identifier? x) (free-identifier=? x v))) + (syntax->list exp))) + + ;; if v is a direct child of exp, that means it's used in a boxed + ;; fashion, and is not safe to unboxed + ;; if not, recur on the subforms + (define (look-at exp) + (and (not (direct-child-of? exp)) + (andmap rec (syntax->list exp)))) + + (define (rec exp) + (syntax-parse exp + #:literal-sets (kernel-literals) + + ;; can be used in a complex arithmetic expr, can be a direct child + [exp:inexact-complex-arith-opt-expr + (andmap rec (syntax->list #'exp))] + + ;; recur down + [((~and op (~or (~literal #%plain-lambda) (~literal define-values))) + formals e:expr ...) + (look-at #'(e ...))] + [(case-lambda [formals e:expr ...] ...) + (look-at #'(e ... ...))] + [((~or (~literal let-values) (~literal letrec-values)) + ([ids e-rhs:expr] ...) e-body:expr ...) + (look-at #'(e-rhs ... e-body ...))] + [(letrec-syntaxes+values stx-bindings + ([(ids ...) e-rhs:expr] ...) + e-body:expr ...) + (look-at #'(e-rhs ... e-body ...))] + [(kw:identifier expr ...) + #:when (ormap (lambda (k) (free-identifier=? k #'kw)) + (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression + #'#%variable-reference #'with-continuation-mark)) + (look-at #'(expr ...))] + + ;; not used, safe to unbox + [_ #t])) + (rec exp)) + +(define-syntax-class unboxed-let-clause + (pattern ((v:id) rhs:unboxed-inexact-complex-opt-expr) + #:with id #'v + #:with real-binding #'rhs.real-binding + #:with imag-binding #'rhs.imag-binding + #:with (bindings ...) #'(rhs.bindings ...))) +(define-syntax-class let-clause ; to turn let-values clauses into let clauses + (pattern ((v:id) rhs:expr) + #:with res #`(v #,((optimize) #'rhs)))) diff --git a/collects/typed-scheme/optimizer/utils.rkt b/collects/typed-scheme/optimizer/utils.rkt index 912b0184..088f0fd0 100644 --- a/collects/typed-scheme/optimizer/utils.rkt +++ b/collects/typed-scheme/optimizer/utils.rkt @@ -52,9 +52,9 @@ ;; necessary to have predictable symbols to add in the hand-optimized versions ;; of the optimizer tests (which check for equality of expanded code) (define *unboxed-gensym-counter* 0) -(define (unboxed-gensym) +(define (unboxed-gensym [name 'unboxed-gensym-]) (set! *unboxed-gensym-counter* (add1 *unboxed-gensym-counter*)) - (format-unique-id #'here "unboxed-gensym-~a" *unboxed-gensym-counter*)) + (format-unique-id #'here "~a~a" name *unboxed-gensym-counter*)) (define (reset-unboxed-gensym) (set! *unboxed-gensym-counter* 0)) diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt index b709fbb7..7805bd08 100644 --- a/collects/typed-scheme/private/base-env-numeric.rkt +++ b/collects/typed-scheme/private/base-env-numeric.rkt @@ -235,27 +235,24 @@ [* (apply cl->* (append (for/list ([t (list -Pos -Nat -Integer -ExactRational -NonnegativeFlonum -Flonum)]) (->* (list) t t)) - (list (->* (list -Pos) -NonnegativeFlonum -NonnegativeFlonum)) - (list (->* (list -NonnegativeFlonum) -Pos -NonnegativeFlonum)) - (list (->* (list -Pos) -Flonum -Flonum)) - (list (->* (list -Flonum) -Pos -Flonum)) + (list (->* (list) (Un -Pos -NonnegativeFlonum) -NonnegativeFlonum)) + (list (->* (list) (Un -Pos -Flonum) -Flonum)) (list (->* (list) -Real -Real)) - (list (->* (list) -InexactComplex -InexactComplex)) + (list (->* (list) (Un -InexactComplex -Flonum) -InexactComplex)) (list (->* (list) N N))))] [+ (apply cl->* (append (list (->* (list -Pos) -Nat -Pos)) - (list (->* (list -Nat) -Pos -Pos)) + (list (->* (list -Nat -Pos) -Nat -Pos)) (for/list ([t (list -Nat -Integer -ExactRational -NonnegativeFlonum -Flonum)]) (->* (list) t t)) - (list (->* (list -Nat) -NonnegativeFlonum -NonnegativeFlonum)) - (list (->* (list -NonnegativeFlonum) -Nat -NonnegativeFlonum)) ;; special cases for promotion to inexact, not exhaustive ;; valid for + and -, but not for * and /, since (* 0) is exact 0 (i.e. not a float) + (list (->* (list) (Un -Nat -NonnegativeFlonum) -NonnegativeFlonum)) (list (->* (list -Flonum) -Real -Flonum)) (list (->* (list -Real -Flonum) -Real -Flonum)) (list (->* (list) -Real -Real)) - (list (->* (list -Real) -InexactComplex -InexactComplex)) - (list (->* (list -InexactComplex) -Real -InexactComplex)) - (list (->* (list) -InexactComplex -InexactComplex)) + (list (->* (list) (Un -Real -InexactComplex) -InexactComplex)) + (list (->* (list -InexactComplex) N -InexactComplex)) + (list (->* (list N -InexactComplex) N -InexactComplex)) (list (->* (list) N N))))] [- (apply cl->* @@ -264,9 +261,9 @@ (list (->* (list -Flonum) -Real -Flonum)) (list (->* (list -Real -Flonum) -Real -Flonum)) (list (->* (list -Real) -Real -Real)) - (list (->* (list -Real) -InexactComplex -InexactComplex)) - (list (->* (list -InexactComplex) -Real -InexactComplex)) - (list (->* (list -InexactComplex) -InexactComplex -InexactComplex)) + (list (->* (list) (Un -Real -InexactComplex) -InexactComplex)) + (list (->* (list -InexactComplex) N -InexactComplex)) + (list (->* (list N -InexactComplex) N -InexactComplex)) (list (->* (list N) N N))))] [/ (apply cl->* (append (list (->* (list -Integer) -Integer -ExactRational)) @@ -275,6 +272,7 @@ ;; only exact 0 as first argument can cause the result of a division involving inexacts to be exact (list (->* (list -Flonum) -Real -Flonum)) (list (->* (list -Real) -Real -Real)) + (list (->* (list (Un -Flonum -InexactComplex)) (Un -Real -InexactComplex) -InexactComplex)) (list (->* (list -InexactComplex) -InexactComplex -InexactComplex)) (list (->* (list N) N N))))] @@ -340,7 +338,9 @@ (-Nat -Nat . -> . -Nat) (-Integer -Integer . -> . -Integer))] [bitwise-and (cl->* (null -NonnegativeFixnum . ->* . -NonnegativeFixnum) + ((list -Integer) -NonnegativeFixnum . ->* . -NonnegativeFixnum) (null -Fixnum . ->* . -Fixnum) + ((list -Integer) -Fixnum . ->* . -Fixnum) (null -Nat . ->* . -Nat) (null -Integer . ->* . -Integer))] [bitwise-ior (cl->* (null -NonnegativeFixnum . ->* . -NonnegativeFixnum) diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt index 7f865c7a..0ce98a90 100644 --- a/collects/typed-scheme/private/base-env.rkt +++ b/collects/typed-scheme/private/base-env.rkt @@ -200,10 +200,18 @@ [newline (->opt [-Output-Port] -Void)] [not (-> Univ B)] [box (-poly (a) (a . -> . (-box a)))] -[unbox (-poly (a) (cl->* +[unbox (-poly (a) (cl->* ((-box a) . -> . a) ((make-BoxTop) . -> . Univ)))] [set-box! (-poly (a) ((-box a) a . -> . -Void))] +[unsafe-unbox (-poly (a) (cl->* + ((-box a) . -> . a) + ((make-BoxTop) . -> . Univ)))] +[unsafe-set-box! (-poly (a) ((-box a) a . -> . -Void))] +[unsafe-unbox* (-poly (a) (cl->* + ((-box a) . -> . a) + ((make-BoxTop) . -> . Univ)))] +[unsafe-set-box*! (-poly (a) ((-box a) a . -> . -Void))] [box? (make-pred-ty (make-BoxTop))] [cons? (make-pred-ty (-pair Univ Univ))] [pair? (make-pred-ty (-pair Univ Univ))] diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt index a8203f4e..5ce0ce8a 100644 --- a/collects/typed-scheme/types/abbrev.rkt +++ b/collects/typed-scheme/types/abbrev.rkt @@ -176,7 +176,7 @@ (define -ExactNonnegativeInteger (*Un -ExactPositiveInteger -Zero)) (define -Nat -ExactNonnegativeInteger) -(define -Byte -Integer) +(define -Byte -NonnegativeFixnum)