From: Isaac Dupree <id@isaac.cedarswampstudios.org>
Date: Tue, 7 Aug 2007 00:12:48 +0000 (+0000)
Subject: more cmpFS refactoring
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=55551ce576db8530e305e552945a58cc070aa98c

more cmpFS refactoring
---

diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index 637ef0c..ffe10c3 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -129,15 +129,17 @@ instance Show FastString where
 cmpFS :: FastString -> FastString -> Ordering
 cmpFS (FastString u1 l1 _ buf1 _) (FastString u2 l2 _ buf2 _) =
   if u1 == u2 then EQ else
-  let l = if l1 <= l2 then l1 else l2 in
-  inlinePerformIO $
-    withForeignPtr buf1 $ \p1 ->
-    withForeignPtr buf2 $ \p2 -> do
-      res <- memcmp p1 p2 l
-      return $ case compare res 0 of
-                 LT -> LT
-                 EQ -> compare l1 l2
-                 GT -> GT
+  case unsafeMemcmp buf1 buf2 (min l1 l2) `compare` 0 of
+     LT -> LT
+     EQ -> compare l1 l2
+     GT -> GT
+
+unsafeMemcmp :: ForeignPtr a -> ForeignPtr b -> Int -> Int
+unsafeMemcmp buf1 buf2 l =
+      inlinePerformIO $
+        withForeignPtr buf1 $ \p1 ->
+        withForeignPtr buf2 $ \p2 ->
+          memcmp p1 p2 l
 
 #ifndef __HADDOCK__
 foreign import ccall unsafe "ghc_memcmp"