Fix LLVM version check yet again

There were two problems with LLVM version checking:

- The parser would only parse x and x.y formatted versions. E.g. 1.2.3
  would be rejected.

- The version check was too strict and would reject x.y formatted
  versions. E.g. when we support version 7 it'd reject 7.0 ("LLVM
  version 7.0") and only accept 7 ("LLVM version 7").

We now parse versions with arbitrarily deep minor numbering (x.y.z.t...)
and accept versions as long as the major version matches the supported
version (e.g. 7.1, 7.1.2, 7.1.2.3 ...).

1 files changed, 28 insertions, 15 deletions

diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 7bed4c7b8d..e56be3ebb2 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -13,7 +13,8 @@ module LlvmCodeGen.Base (
         LiveGlobalRegs,
         LlvmUnresData, LlvmData, UnresLabel, UnresStatic,
 
-        LlvmVersion (..), supportedLlvmVersion, llvmVersionStr,
+        LlvmVersion, supportedLlvmVersion, llvmVersionSupported, parseLlvmVersion,
+        llvmVersionStr, llvmVersionList,
 
         LlvmM,
         runLlvm, liftStream, withClearVars, varLookup, varInsert,
@@ -60,6 +61,9 @@ import qualified Stream
 
 import Data.Maybe (fromJust)
 import Control.Monad (ap)
+import Data.Char (isDigit)
+import Data.List (intercalate)
+import qualified Data.List.NonEmpty as NE
 
 -- ----------------------------------------------------------------------------
 -- * Some Data Types
@@ -176,26 +180,35 @@ llvmPtrBits dflags = widthInBits $ typeWidth $ gcWord dflags
 -- * Llvm Version
 --
 
--- | LLVM Version Number
-data LlvmVersion
-    = LlvmVersion Int
-    | LlvmVersionOld Int Int
-    deriving Eq
+-- Newtype to avoid using the Eq instance!
+newtype LlvmVersion = LlvmVersion { llvmVersionNE :: NE.NonEmpty Int }
 
--- Custom show instance for backwards compatibility.
-instance Show LlvmVersion where
-  show (LlvmVersion maj) = show maj
-  show (LlvmVersionOld maj min) = show maj ++ "." ++ show min
+parseLlvmVersion :: String -> Maybe LlvmVersion
+parseLlvmVersion =
+    fmap LlvmVersion . NE.nonEmpty . go [] . dropWhile (not . isDigit)
+  where
+    go vs s
+      | null ver_str
+      = reverse vs
+      | '.' : rest' <- rest
+      = go (read ver_str : vs) rest'
+      | otherwise
+      = reverse (read ver_str : vs)
+      where
+        (ver_str, rest) = span isDigit s
 
 -- | The LLVM Version that is currently supported.
 supportedLlvmVersion :: LlvmVersion
-supportedLlvmVersion = LlvmVersion sUPPORTED_LLVM_VERSION
+supportedLlvmVersion = LlvmVersion (sUPPORTED_LLVM_VERSION NE.:| [])
+
+llvmVersionSupported :: LlvmVersion -> Bool
+llvmVersionSupported (LlvmVersion v) = NE.head v == sUPPORTED_LLVM_VERSION
 
 llvmVersionStr :: LlvmVersion -> String
-llvmVersionStr v =
-  case v of
-    LlvmVersion maj -> show maj
-    LlvmVersionOld maj min -> show maj ++ "." ++ show min
+llvmVersionStr = intercalate "." . map show . llvmVersionList
+
+llvmVersionList :: LlvmVersion -> [Int]
+llvmVersionList = NE.toList . llvmVersionNE
 
 -- ----------------------------------------------------------------------------
 -- * Environment Handling