From 4e944f73abc138b7d283020bf5c577fe6ecf6e95 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 19 Jul 2010 17:58:38 -0400
Subject: [PATCH] Added optimization for string-length and bytes-length.

---
 .../optimizer/generic/string-length.rkt       |  6 ++++
 .../hand-optimized/string-length.rkt          |  6 ++++
 .../optimizer/non-optimized/string-length.rkt |  6 ++++
 collects/typed-scheme/optimizer/optimizer.rkt |  8 ++++--
 collects/typed-scheme/optimizer/sequence.rkt  | 11 +-------
 collects/typed-scheme/optimizer/string.rkt    | 28 +++++++++++++++++++
 6 files changed, 53 insertions(+), 12 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/string-length.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/string-length.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/non-optimized/string-length.rkt
 create mode 100644 collects/typed-scheme/optimizer/string.rkt

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 0000000000..302101007e
--- /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/hand-optimized/string-length.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/string-length.rkt
new file mode 100644
index 0000000000..8291883467
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/hand-optimized/string-length.rkt
@@ -0,0 +1,6 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(unsafe-string-length "eh")
+(unsafe-bytes-length #"eh")
diff --git a/collects/tests/typed-scheme/optimizer/non-optimized/string-length.rkt b/collects/tests/typed-scheme/optimizer/non-optimized/string-length.rkt
new file mode 100644
index 0000000000..6ab3f44658
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/non-optimized/string-length.rkt
@@ -0,0 +1,6 @@
+#lang typed/scheme
+
+(require racket/unsafe/ops)
+
+(string-length "eh")
+(bytes-length #"eh")
diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index d9ad4ab6cc..eae6d01e92 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 box struct dead-code))
+         (optimizer utils fixnum float inexact-complex vector string
+                    pair sequence box struct dead-code))
 
 (provide optimize-top)
 
@@ -22,6 +25,7 @@
   (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)
diff --git a/collects/typed-scheme/optimizer/sequence.rkt b/collects/typed-scheme/optimizer/sequence.rkt
index c17130998c..3821e88665 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 0000000000..8f9f019e0f
--- /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))))