diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index a24a416256e6c9326e6c25f2406355c3aa5ecc2a..88901be4d6ab7cb5c938604f37cfbf6a52dde5ee 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -3,7 +3,7 @@
 -- -----------------------------------------------------------------------------
 -- | This is the top-level module in the LLVM code generator.
 --
-module LlvmCodeGen ( llvmCodeGen, llvmFixupAsm ) where
+module LlvmCodeGen ( LlvmVersion (..), llvmCodeGen, llvmFixupAsm ) where
 
 #include "HsVersions.h"
 
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index b47bf6aff6859bebb3965d4c09b7110ac9584136..81f3b9f84ce2f2d9889cc718346a9d5de07c38dc 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -13,7 +13,7 @@ module LlvmCodeGen.Base (
         LiveGlobalRegs,
         LlvmUnresData, LlvmData, UnresLabel, UnresStatic,
 
-        LlvmVersion, supportedLlvmVersion, llvmVersionStr,
+        LlvmVersion (..), supportedLlvmVersion, llvmVersionStr,
 
         LlvmM,
         runLlvm, liftStream, withClearVars, varLookup, varInsert,
@@ -177,14 +177,25 @@ llvmPtrBits dflags = widthInBits $ typeWidth $ gcWord dflags
 --
 
 -- | LLVM Version Number
-type LlvmVersion = (Int, Int)
+data LlvmVersion
+    = LlvmVersion Int
+    | LlvmVersionOld Int Int
+    deriving Eq
+
+-- Custom show instance for backwards compatibility.
+instance Show LlvmVersion where
+  show (LlvmVersion maj) = show maj
+  show (LlvmVersionOld maj min) = show maj ++ "." ++ show min
 
 -- | The LLVM Version that is currently supported.
 supportedLlvmVersion :: LlvmVersion
-supportedLlvmVersion = sUPPORTED_LLVM_VERSION
+supportedLlvmVersion = LlvmVersion sUPPORTED_LLVM_VERSION
 
 llvmVersionStr :: LlvmVersion -> String
-llvmVersionStr (major, minor) = show major ++ "." ++ show minor
+llvmVersionStr v =
+  case v of
+    LlvmVersion maj -> show maj
+    LlvmVersionOld maj min -> show maj ++ "." ++ show min
 
 -- ----------------------------------------------------------------------------
 -- * Environment Handling
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index f77927f8e5626d08623651341d68cafc50b74c67..74bc64ede3706b77f75b34f61aa4cebe5936c0aa 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -56,7 +56,7 @@ import StringBuffer     ( hGetStringBuffer, hPutStringBuffer )
 import BasicTypes       ( SuccessFlag(..) )
 import Maybes           ( expectJust )
 import SrcLoc
-import LlvmCodeGen      ( llvmFixupAsm )
+import LlvmCodeGen      ( LlvmVersion (..), llvmFixupAsm )
 import MonadUtils
 import GHC.Platform
 import TcRnTypes
@@ -2038,7 +2038,8 @@ getBackendDefs :: DynFlags -> IO [String]
 getBackendDefs dflags | hscTarget dflags == HscLlvm = do
     llvmVer <- figureLlvmVersion dflags
     return $ case llvmVer of
-               Just n -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format n ]
+               Just (LlvmVersion n) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (n,0) ]
+               Just (LlvmVersionOld m n) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,n) ]
                _      -> []
   where
     format (major, minor)
diff --git a/compiler/main/SysTools/Tasks.hs b/compiler/main/SysTools/Tasks.hs
index 10e1102304cf433f6a7ad6f588548333ae2832f3..0310bd8eb258e6f8b5c17efd503cd30c0e3c1d2c 100644
--- a/compiler/main/SysTools/Tasks.hs
+++ b/compiler/main/SysTools/Tasks.hs
@@ -23,7 +23,7 @@ import System.IO
 import System.Process
 import GhcPrelude
 
-import LlvmCodeGen.Base (llvmVersionStr, supportedLlvmVersion)
+import LlvmCodeGen.Base (LlvmVersion (..), llvmVersionStr, supportedLlvmVersion)
 
 import SysTools.Process
 import SysTools.Info
@@ -200,7 +200,7 @@ runClang dflags args = do
     )
 
 -- | Figure out which version of LLVM we are running this session
-figureLlvmVersion :: DynFlags -> IO (Maybe (Int, Int))
+figureLlvmVersion :: DynFlags -> IO (Maybe LlvmVersion)
 figureLlvmVersion dflags = do
   let (pgm,opts) = pgm_lc dflags
       args = filter notNull (map showOpt opts)
@@ -222,8 +222,10 @@ figureLlvmVersion dflags = do
               vline <- dropWhile (not . isDigit) `fmap` hGetLine pout
               v     <- case span (/= '.') vline of
                         ("",_)  -> fail "no digits!"
-                        (x,y) -> return (read x
-                                        , read $ takeWhile isDigit $ drop 1 y)
+                        (x,"") -> return $ LlvmVersion (read x)
+                        (x,y) -> return $ LlvmVersionOld
+                                            (read x)
+                                            (read $ takeWhile isDigit $ drop 1 y)
 
               hClose pin
               hClose pout
diff --git a/configure.ac b/configure.ac
index e1b2342d75e0f077d22e8324052cabdad517929b..751b059f2bf0db0336992649f657161d431d78c2 100644
--- a/configure.ac
+++ b/configure.ac
@@ -628,7 +628,7 @@ AC_SUBST([LibtoolCmd])
 # tools we are looking for. In the past, GHC supported a number of
 # versions of LLVM simultaneously, but that stopped working around
 # 3.5/3.6 release of LLVM.
-LlvmVersion=7.0
+LlvmVersion=7
 AC_SUBST([LlvmVersion])
 sUPPORTED_LLVM_VERSION=$(echo \($LlvmVersion\) | sed 's/\./,/')
 AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION], ${sUPPORTED_LLVM_VERSION}, [The supported LLVM version number])