Merge pull request #3935 from hvr/pr/optimise-mkversion

Optimise Distribution.Version.mkVersion
haskell · Oct 4, 2016 · b858bed · b858bed
2 parents c6929fc + 883b3c3
commit b858bed
Showing 1 changed file with 48 additions and 17 deletions.
diff --git a/Cabal/Distribution/Version.hs b/Cabal/Distribution/Version.hs
@@ -168,24 +168,55 @@ instance Text Version where
 mkVersion :: [Int] -> Version
 -- TODO: add validity check; disallow 'mkVersion []' (we have
 -- 'nullVersion' for that)
-mkVersion ns = case ns of
-    [] -> nullVersion
-    [v1]          | v1 <= 0xfffe
-      -> PV0 (mkW64 (v1+1) 0 0 0)
-    [v1,v2]       | v1 <= 0xfffe, v2 <= 0xfffe
-      -> PV0 (mkW64 (v1+1) (v2+1) 0 0)
-    [v1,v2,v3]    | v1 <= 0xfffe, v2 <= 0xfffe, v3 <= 0xfffe
-      -> PV0 (mkW64 (v1+1) (v2+1) (v3+1)  0)
-    [v1,v2,v3,v4] | v1 <= 0xfffe, v2 <= 0xfffe, v3 <= 0xfffe, v4 <= 0xfffe
-      -> PV0 (mkW64 (v1+1) (v2+1) (v3+1) (v4+1))
-    v1:vs -> PV1 v1 vs
+mkVersion []                    = nullVersion
+mkVersion (v1:[])
+  | inWord16VerRep1 v1          = PV0 (mkWord64VerRep1 v1)
+  | otherwise                   = PV1 v1 []
   where
-    {-# INLINABLE mkW64 #-}
-    mkW64 :: Int -> Int -> Int -> Int -> Word64
-    mkW64 v1 v2 v3 v4 =     (fromIntegral v1 `shiftL` 48)
-                        .|. (fromIntegral v2 `shiftL` 32)
-                        .|. (fromIntegral v3 `shiftL` 16)
-                        .|.  fromIntegral v4
+    inWord16VerRep1 x1 = inWord16 (x1 .|. (x1+1))
+    mkWord64VerRep1 y1 = mkWord64VerRep (y1+1) 0 0 0
+
+mkVersion (v1:vs@(v2:[]))
+  | inWord16VerRep2 v1 v2       = PV0 (mkWord64VerRep2 v1 v2)
+  | otherwise                   = PV1 v1 vs
+  where
+    inWord16VerRep2 x1 x2 = inWord16 (x1 .|. (x1+1)
+                                  .|. x2 .|. (x2+1))
+    mkWord64VerRep2 y1 y2 = mkWord64VerRep (y1+1) (y2+1) 0 0
+
+mkVersion (v1:vs@(v2:v3:[]))
+  | inWord16VerRep3 v1 v2 v3    = PV0 (mkWord64VerRep3 v1 v2 v3)
+  | otherwise                   = PV1 v1 vs
+  where
+    inWord16VerRep3 x1 x2 x3 = inWord16 (x1 .|. (x1+1)
+                                     .|. x2 .|. (x2+1)
+                                     .|. x3 .|. (x3+1))
+    mkWord64VerRep3 y1 y2 y3 = mkWord64VerRep (y1+1) (y2+1) (y3+1) 0
+
+mkVersion (v1:vs@(v2:v3:v4:[]))
+  | inWord16VerRep4 v1 v2 v3 v4 = PV0 (mkWord64VerRep4 v1 v2 v3 v4)
+  | otherwise                   = PV1 v1 vs
+  where
+    inWord16VerRep4 x1 x2 x3 x4 = inWord16 (x1 .|. (x1+1)
+                                        .|. x2 .|. (x2+1)
+                                        .|. x3 .|. (x3+1)
+                                        .|. x4 .|. (x4+1))
+    mkWord64VerRep4 y1 y2 y3 y4 = mkWord64VerRep (y1+1) (y2+1) (y3+1) (y4+1)
+
+mkVersion (v1:vs)               = PV1 v1 vs
+
+
+{-# INLINE mkWord64VerRep #-}
+mkWord64VerRep :: Int -> Int -> Int -> Int -> Word64
+mkWord64VerRep v1 v2 v3 v4 =
+      (fromIntegral v1 `shiftL` 48)
+  .|. (fromIntegral v2 `shiftL` 32)
+  .|. (fromIntegral v3 `shiftL` 16)
+  .|.  fromIntegral v4
+
+{-# INLINE inWord16 #-}
+inWord16 :: Int -> Bool
+inWord16 x = (fromIntegral x :: Word) <= 0xffff
 
 -- | Variant of 'Version' which converts a "Data.Version" 'Version'
 -- into Cabal's 'Version' type.