From ebf87fd795689f6243312ca391e006474dc325dc Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 22 Apr 2014 18:09:44 -0400
Subject: [PATCH] Basic optimizations for extflonums.

original commit: 171d874757ffd111aa3bd5c4d17ca01251144c68
---
 .../typed-racket/optimizer/extflonum.rkt      | 48 +++++++++++++++++++
 .../typed-racket/optimizer/float.rkt          |  2 +-
 .../typed-racket/optimizer/optimizer.rkt      |  7 +--
 3 files changed, 53 insertions(+), 4 deletions(-)
 create mode 100644 pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/extflonum.rkt

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/extflonum.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/extflonum.rkt
new file mode 100644
index 00000000..6ab60fe2
--- /dev/null
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/extflonum.rkt
@@ -0,0 +1,48 @@
+#lang racket/base
+
+(require syntax/parse racket/extflonum
+         syntax/parse/experimental/specialize
+         (for-template racket/base racket/extflonum racket/unsafe/ops)
+         "../utils/utils.rkt"
+         (optimizer utils numeric-utils logging float))
+
+(provide extflonum-opt-expr)
+
+
+(define (mk-extflonum-tbl generic) ; all operations are prefixed
+  (mk-unsafe-tbl generic "~a" "unsafe-~a"))
+
+(define binary-extflonum-ops
+  ;; comparisons are good too, because we don't have to do n-ary->binary
+  ;; (all ops are binary only)
+  (mk-extflonum-tbl (list #'extfl+ #'extfl- #'extfl* #'extfl/
+                          #'extfl= #'extfl< #'extfl> #'extfl<= #'extfl>=
+                          #'extflmin #'extflmax #'extflexpt)))
+
+(define unary-extflonum-ops
+  (mk-extflonum-tbl (list #'extflabs #'extflround #'extflfloor #'extflceiling #'extfltruncate
+                          #'extflsin #'extflcos #'extfltan #'extflasin #'extflacos #'extflatan
+                          #'extfllog #'extflexp #'extflsqrt)))
+
+(define-syntax-class/specialize unary-extflonum-op (float-op unary-extflonum-ops))
+(define-syntax-class/specialize binary-extflonum-op (float-op binary-extflonum-ops))
+
+
+;; TODO do conversions (unsafe-fx->extfl, unsafe-extfl->fx)
+;; TODO do extflvector ops
+
+(define-syntax-rule (log-extfl-opt opt-label)
+  (log-opt opt-label "Extflonum arithmetic specialization."))
+
+;; Those are easy. Because extflonums are disjoint from the rest of the numeric
+;; tower, if the operations type check at all, they have the right types for
+;; optimization. Ops are all fixed arity, too.
+(define-syntax-class extflonum-opt-expr
+  #:commit
+  #:literal-sets (kernel-literals)
+  (pattern (#%plain-app op:unary-extflonum-op t:opt-expr)
+    #:do [(log-extfl-opt "unary extflonum")]
+    #:with opt #'(op.unsafe t.opt))
+  (pattern (#%plain-app op:binary-extflonum-op t1:opt-expr t2:opt-expr)
+    #:do [(log-extfl-opt "binary extflonum")]
+    #:with opt #'(op.unsafe t1.opt t2.opt)))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float.rkt
index 968b0e1f..83003aeb 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float.rkt
@@ -8,7 +8,7 @@
          (types numeric-tower union abbrev)
          (optimizer utils numeric-utils logging fixnum))
 
-(provide float-opt-expr float-arg-expr int-expr)
+(provide float-opt-expr float-arg-expr int-expr float-op)
 
 
 (define (mk-float-tbl generic)
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/optimizer.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/optimizer.rkt
index ce0c1932..7df9d75c 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/optimizer.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/optimizer.rkt
@@ -5,8 +5,9 @@
          (private syntax-properties)
          (types type-table)
          (optimizer utils
-                    number fixnum float float-complex vector string list pair
-                    sequence box struct dead-code apply unboxed-let
+                    number fixnum float extflonum float-complex
+                    vector string list pair sequence
+                    box struct dead-code apply unboxed-let
                     hidden-costs))
 
 
@@ -38,7 +39,7 @@
   (pattern :number-opt-expr)
   (pattern :fixnum-opt-expr)
   (pattern :float-opt-expr)
-  ;; TODO add optimizations for extflonums. should be easy (like structs), if it typechecks, it's the right type
+  (pattern :extflonum-opt-expr)
   (pattern :float-complex-opt-expr)
   (pattern :vector-opt-expr)
   (pattern :string-opt-expr)