From b05cef80e35f972a251fc2d876c84ce9d43fdb96 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Sat, 12 Mar 2011 17:09:30 -0500
Subject: [PATCH] Use subtype test, just in case.

original commit: d06bf0de912355eb776f060c9d7a0a137f50a339
---
 .../typed-scheme/optimizer/float-complex.rkt  | 22 +++++++++----------
 .../typed-scheme/optimizer/unboxed-let.rkt    |  2 +-
 2 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/collects/typed-scheme/optimizer/float-complex.rkt b/collects/typed-scheme/optimizer/float-complex.rkt
index e974e6d6..534933a4 100644
--- a/collects/typed-scheme/optimizer/float-complex.rkt
+++ b/collects/typed-scheme/optimizer/float-complex.rkt
@@ -37,7 +37,7 @@
                         c1:unboxed-float-complex-opt-expr
                         c2:unboxed-float-complex-opt-expr
                         cs:unboxed-float-complex-opt-expr ...)
-           #:when (isoftype? this-syntax -FloatComplex)
+           #:when (subtypeof? this-syntax -FloatComplex)
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
@@ -62,7 +62,7 @@
                         c1:unboxed-float-complex-opt-expr
                         c2:unboxed-float-complex-opt-expr
                         cs:unboxed-float-complex-opt-expr ...)
-           #:when (isoftype? this-syntax -FloatComplex)
+           #:when (subtypeof? this-syntax -FloatComplex)
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
@@ -89,7 +89,7 @@
                         c1:unboxed-float-complex-opt-expr
                         c2:unboxed-float-complex-opt-expr
                         cs:unboxed-float-complex-opt-expr ...)
-           #:when (or (isoftype? this-syntax -FloatComplex) (isoftype? this-syntax -Number))
+           #:when (or (subtypeof? this-syntax -FloatComplex) (subtypeof? this-syntax -Number))
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
@@ -138,7 +138,7 @@
                         c1:unboxed-float-complex-opt-expr
                         c2:unboxed-float-complex-opt-expr
                         cs:unboxed-float-complex-opt-expr ...)
-           #:when (or (isoftype? this-syntax -FloatComplex) (isoftype? this-syntax -Number))
+           #:when (or (subtypeof? this-syntax -FloatComplex) (subtypeof? this-syntax -Number))
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with reals (syntax-map (lambda (x) (if (syntax->datum x) x #'0.0))
@@ -206,7 +206,7 @@
                                               res)]))))))))
 
   (pattern (#%plain-app (~and op (~literal conjugate)) c:unboxed-float-complex-opt-expr)
-           #:when (isoftype? this-syntax -FloatComplex)
+           #:when (subtypeof? this-syntax -FloatComplex)
            #:with real-binding #'c.real-binding
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
@@ -311,7 +311,7 @@
                                         (exact->inexact (syntax->datum #'n)))))))
   
   (pattern e:expr
-           #:when (isoftype? #'e -FloatComplex)
+           #:when (subtypeof? #'e -FloatComplex)
            #:with e* (unboxed-gensym)
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
@@ -321,7 +321,7 @@
                      ((real-binding) (unsafe-flreal-part e*))
                      ((imag-binding) (unsafe-flimag-part e*)))))
   (pattern e:expr
-           #:when (isoftype? #'e -Number) ; complex, maybe exact, maybe not
+           #:when (subtypeof? #'e -Number) ; complex, maybe exact, maybe not
            #:with e* (unboxed-gensym)
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
@@ -332,7 +332,7 @@
                      ((imag-binding) (exact->inexact (imag-part e*))))))
   (pattern e:expr
            #:with (bindings ...)
-           (error "non exhaustive pattern match")
+           (error (format "non exhaustive pattern match" #'e))
            #:with real-binding #f
            #:with imag-binding #f))
 
@@ -354,7 +354,7 @@
 (define-syntax-class float-complex-expr
   #:commit
   (pattern e:expr
-           #:when (isoftype? #'e -FloatComplex)
+           #:when (subtypeof? #'e -FloatComplex)
            #:with opt ((optimize) #'e)))
 
 (define-syntax-class float-complex-opt-expr
@@ -382,7 +382,7 @@
                   #'(op.unsafe n.opt)))
 
   (pattern (#%plain-app (~and op (~literal make-polar)) r theta)
-           #:when (isoftype? this-syntax -FloatComplex)
+           #:when (subtypeof? this-syntax -FloatComplex)
            #:with exp*:unboxed-float-complex-opt-expr this-syntax
            #:with opt
            (begin (log-optimization "make-polar" #'op)
@@ -420,7 +420,7 @@
                       real-binding)))
 
   (pattern (#%plain-app op:float-complex-op e:expr ...)
-           #:when (isoftype? this-syntax -FloatComplex)
+           #:when (subtypeof? this-syntax -FloatComplex)
            #:with exp*:unboxed-float-complex-opt-expr this-syntax
            #:with real-binding #'exp*.real-binding
            #:with imag-binding #'exp*.imag-binding
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index a3f7fa6d..4e6a2adf 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -59,7 +59,7 @@
                  ;; clauses of form ((v) rhs), currently only supports 1 lhs var
                  (partition
                   (lambda (p)
-                    (and (isoftype? (cadr p) -FloatComplex)
+                    (and (subtypeof? (cadr p) -FloatComplex)
                          (could-be-unboxed-in? (car (syntax-e (car p)))
                                                #'(begin body ...))))
                   (syntax-map syntax->list #'(clause ...))))