diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/GHC/CmmToLlvm.hs similarity index 96% rename from compiler/llvmGen/LlvmCodeGen.hs rename to compiler/GHC/CmmToLlvm.hs index fb53f4caf80c9d6732bbbeebe88db193723f2161..f84c2901a590033f9b28419ee5e58451fb0eb91e 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/GHC/CmmToLlvm.hs @@ -3,19 +3,25 @@ -- ----------------------------------------------------------------------------- -- | This is the top-level module in the LLVM code generator. -- -module LlvmCodeGen ( LlvmVersion, llvmVersionList, llvmCodeGen, llvmFixupAsm ) where +module GHC.CmmToLlvm + ( LlvmVersion + , llvmVersionList + , llvmCodeGen + , llvmFixupAsm + ) +where #include "HsVersions.h" import GhcPrelude -import Llvm -import LlvmCodeGen.Base -import LlvmCodeGen.CodeGen -import LlvmCodeGen.Data -import LlvmCodeGen.Ppr -import LlvmCodeGen.Regs -import LlvmMangler +import GHC.Llvm +import GHC.CmmToLlvm.Base +import GHC.CmmToLlvm.CodeGen +import GHC.CmmToLlvm.Data +import GHC.CmmToLlvm.Ppr +import GHC.CmmToLlvm.Regs +import GHC.CmmToLlvm.Mangler import GHC.StgToCmm.CgUtils ( fixStgRegisters ) import GHC.Cmm diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs similarity index 99% rename from compiler/llvmGen/LlvmCodeGen/Base.hs rename to compiler/GHC/CmmToLlvm/Base.hs index 0da437ef184c63e42177098c4f3e1996586484fe..c0bd742840b95ab13f981cf89f26c10856cce014 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/GHC/CmmToLlvm/Base.hs @@ -9,7 +9,7 @@ -- Contains functions useful through out the code generator. -- -module LlvmCodeGen.Base ( +module GHC.CmmToLlvm.Base ( LlvmCmmDecl, LlvmBasicBlock, LiveGlobalRegs, @@ -43,8 +43,8 @@ module LlvmCodeGen.Base ( import GhcPrelude -import Llvm -import LlvmCodeGen.Regs +import GHC.Llvm +import GHC.CmmToLlvm.Regs import GHC.Cmm.CLabel import GHC.Platform.Regs ( activeStgRegs ) diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/GHC/CmmToLlvm/CodeGen.hs similarity index 99% rename from compiler/llvmGen/LlvmCodeGen/CodeGen.hs rename to compiler/GHC/CmmToLlvm/CodeGen.hs index e46e0f787f5c8e4633db619f0fa9a64e553780cd..33dd82c41857cf14ec740ee437e772cadc20679e 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/GHC/CmmToLlvm/CodeGen.hs @@ -4,15 +4,15 @@ -- ---------------------------------------------------------------------------- -- | Handle conversion of CmmProc to LLVM code. -- -module LlvmCodeGen.CodeGen ( genLlvmProc ) where +module GHC.CmmToLlvm.CodeGen ( genLlvmProc ) where #include "HsVersions.h" import GhcPrelude -import Llvm -import LlvmCodeGen.Base -import LlvmCodeGen.Regs +import GHC.Llvm +import GHC.CmmToLlvm.Base +import GHC.CmmToLlvm.Regs import GHC.Cmm.BlockId import GHC.Platform.Regs ( activeStgRegs ) @@ -422,8 +422,8 @@ genCall target res args = runStmtsDecls $ do _ -> CC_Ccc CCallConv -> CC_Ccc CApiConv -> CC_Ccc - PrimCallConv -> panic "LlvmCodeGen.CodeGen.genCall: PrimCallConv" - JavaScriptCallConv -> panic "LlvmCodeGen.CodeGen.genCall: JavaScriptCallConv" + PrimCallConv -> panic "GHC.CmmToLlvm.CodeGen.genCall: PrimCallConv" + JavaScriptCallConv -> panic "GHC.CmmToLlvm.CodeGen.genCall: JavaScriptCallConv" PrimTarget _ -> CC_Ccc @@ -1927,10 +1927,10 @@ toIWord dflags = mkIntLit (llvmWord dflags) -- | Error functions panic :: String -> a -panic s = Outputable.panic $ "LlvmCodeGen.CodeGen." ++ s +panic s = Outputable.panic $ "GHC.CmmToLlvm.CodeGen." ++ s pprPanic :: String -> SDoc -> a -pprPanic s d = Outputable.pprPanic ("LlvmCodeGen.CodeGen." ++ s) d +pprPanic s d = Outputable.pprPanic ("GHC.CmmToLlvm.CodeGen." ++ s) d -- | Returns TBAA meta data by unique diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/GHC/CmmToLlvm/Data.hs similarity index 98% rename from compiler/llvmGen/LlvmCodeGen/Data.hs rename to compiler/GHC/CmmToLlvm/Data.hs index d44ecaea209cb2d81b4ce9be6cfec5a3ffa4d4c8..b20c9bd3602904a7a6913e3f5681e16221cb7997 100644 --- a/compiler/llvmGen/LlvmCodeGen/Data.hs +++ b/compiler/GHC/CmmToLlvm/Data.hs @@ -3,7 +3,7 @@ -- | Handle conversion of CmmData to LLVM code. -- -module LlvmCodeGen.Data ( +module GHC.CmmToLlvm.Data ( genLlvmData, genData ) where @@ -11,8 +11,8 @@ module LlvmCodeGen.Data ( import GhcPrelude -import Llvm -import LlvmCodeGen.Base +import GHC.Llvm +import GHC.CmmToLlvm.Base import GHC.Cmm.BlockId import GHC.Cmm.CLabel diff --git a/compiler/llvmGen/LlvmMangler.hs b/compiler/GHC/CmmToLlvm/Mangler.hs similarity index 98% rename from compiler/llvmGen/LlvmMangler.hs rename to compiler/GHC/CmmToLlvm/Mangler.hs index 82157818605e378a27b12437dd2561d405daca13..1cdad2009f3a2ca7356f9877c17a02a850aa18ab 100644 --- a/compiler/llvmGen/LlvmMangler.hs +++ b/compiler/GHC/CmmToLlvm/Mangler.hs @@ -9,7 +9,7 @@ -- instructions require 32-byte alignment. -- -module LlvmMangler ( llvmFixupAsm ) where +module GHC.CmmToLlvm.Mangler ( llvmFixupAsm ) where import GhcPrelude diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/GHC/CmmToLlvm/Ppr.hs similarity index 97% rename from compiler/llvmGen/LlvmCodeGen/Ppr.hs rename to compiler/GHC/CmmToLlvm/Ppr.hs index 576e84dda4851b9480e1f72370f422e9170f8966..45a8285ec63114538518f9dc1fd01e46b8d09237 100644 --- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs +++ b/compiler/GHC/CmmToLlvm/Ppr.hs @@ -3,7 +3,7 @@ -- ---------------------------------------------------------------------------- -- | Pretty print helpers for the LLVM Code generator. -- -module LlvmCodeGen.Ppr ( +module GHC.CmmToLlvm.Ppr ( pprLlvmCmmDecl, pprLlvmData, infoSection ) where @@ -11,9 +11,9 @@ module LlvmCodeGen.Ppr ( import GhcPrelude -import Llvm -import LlvmCodeGen.Base -import LlvmCodeGen.Data +import GHC.Llvm +import GHC.CmmToLlvm.Base +import GHC.CmmToLlvm.Data import GHC.Cmm.CLabel import GHC.Cmm diff --git a/compiler/llvmGen/LlvmCodeGen/Regs.hs b/compiler/GHC/CmmToLlvm/Regs.hs similarity index 92% rename from compiler/llvmGen/LlvmCodeGen/Regs.hs rename to compiler/GHC/CmmToLlvm/Regs.hs index 4b1a15674ef2903178bbf927a78abf9776e09021..60c27c8f44dc7a014818d0ccc9380fdf746bb036 100644 --- a/compiler/llvmGen/LlvmCodeGen/Regs.hs +++ b/compiler/GHC/CmmToLlvm/Regs.hs @@ -4,7 +4,7 @@ -- | Deal with Cmm registers -- -module LlvmCodeGen.Regs ( +module GHC.CmmToLlvm.Regs ( lmGlobalRegArg, lmGlobalRegVar, alwaysLive, stgTBAA, baseN, stackN, heapN, rxN, topN, tbaa, getTBAA ) where @@ -13,7 +13,7 @@ module LlvmCodeGen.Regs ( import GhcPrelude -import Llvm +import GHC.Llvm import GHC.Cmm.Expr import DynFlags @@ -79,7 +79,7 @@ lmGlobalReg dflags suf reg ZmmReg 5 -> zmmGlobal $ "ZMM5" ++ suf ZmmReg 6 -> zmmGlobal $ "ZMM6" ++ suf MachSp -> wordGlobal $ "MachSp" ++ suf - _other -> panic $ "LlvmCodeGen.Reg: GlobalReg (" ++ (show reg) + _other -> panic $ "GHC.CmmToLlvm.Reg: GlobalReg (" ++ (show reg) ++ ") not supported!" -- LongReg, HpLim, CCSS, CurrentTSO, CurrentNusery, HpAlloc -- EagerBlackholeInfo, GCEnter1, GCFun, BaseReg, PicBaseReg @@ -116,12 +116,12 @@ stgTBAA -- hierarchy and as of LLVM 4.0 should *only* be referenced by other nodes. It -- should never occur in any LLVM instruction statement. rootN, topN, stackN, heapN, rxN, baseN :: Unique -rootN = getUnique (fsLit "LlvmCodeGen.Regs.rootN") -topN = getUnique (fsLit "LlvmCodeGen.Regs.topN") -stackN = getUnique (fsLit "LlvmCodeGen.Regs.stackN") -heapN = getUnique (fsLit "LlvmCodeGen.Regs.heapN") -rxN = getUnique (fsLit "LlvmCodeGen.Regs.rxN") -baseN = getUnique (fsLit "LlvmCodeGen.Regs.baseN") +rootN = getUnique (fsLit "GHC.CmmToLlvm.Regs.rootN") +topN = getUnique (fsLit "GHC.CmmToLlvm.Regs.topN") +stackN = getUnique (fsLit "GHC.CmmToLlvm.Regs.stackN") +heapN = getUnique (fsLit "GHC.CmmToLlvm.Regs.heapN") +rxN = getUnique (fsLit "GHC.CmmToLlvm.Regs.rxN") +baseN = getUnique (fsLit "GHC.CmmToLlvm.Regs.baseN") -- | The TBAA metadata identifier tbaa :: LMString diff --git a/compiler/llvmGen/Llvm.hs b/compiler/GHC/Llvm.hs similarity index 95% rename from compiler/llvmGen/Llvm.hs rename to compiler/GHC/Llvm.hs index 8104a3a61ee9fafe19d85df3e47d488bad02ac16..65389a7a5b6cce06410bbd6475e4ad10f340bd2e 100644 --- a/compiler/llvmGen/Llvm.hs +++ b/compiler/GHC/Llvm.hs @@ -9,7 +9,7 @@ -- (EHC) project (). -- -module Llvm ( +module GHC.Llvm ( -- * Modules, Functions and Blocks LlvmModule(..), @@ -57,8 +57,8 @@ module Llvm ( ) where -import Llvm.AbsSyn -import Llvm.MetaData -import Llvm.PpLlvm -import Llvm.Types +import GHC.Llvm.Syntax +import GHC.Llvm.MetaData +import GHC.Llvm.Ppr +import GHC.Llvm.Types diff --git a/compiler/llvmGen/Llvm/MetaData.hs b/compiler/GHC/Llvm/MetaData.hs similarity index 98% rename from compiler/llvmGen/Llvm/MetaData.hs rename to compiler/GHC/Llvm/MetaData.hs index 97e8086f42de8b6024f2cd6a9d09f744a1b73c7c..3e319c7036c6b6387d90c2c17db062208d1bce1c 100644 --- a/compiler/llvmGen/Llvm/MetaData.hs +++ b/compiler/GHC/Llvm/MetaData.hs @@ -1,10 +1,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Llvm.MetaData where +module GHC.Llvm.MetaData where import GhcPrelude -import Llvm.Types +import GHC.Llvm.Types import Outputable -- The LLVM Metadata System. diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/GHC/Llvm/Ppr.hs similarity index 99% rename from compiler/llvmGen/Llvm/PpLlvm.hs rename to compiler/GHC/Llvm/Ppr.hs index b534276f08ea2536284de87990385c1e120f92f5..0e8d279a504bebab89ae841900bfbc69f2a4ef88 100644 --- a/compiler/llvmGen/Llvm/PpLlvm.hs +++ b/compiler/GHC/Llvm/Ppr.hs @@ -4,7 +4,7 @@ -- | Pretty print LLVM IR Code. -- -module Llvm.PpLlvm ( +module GHC.Llvm.Ppr ( -- * Top level LLVM objects. ppLlvmModule, @@ -27,9 +27,9 @@ module Llvm.PpLlvm ( import GhcPrelude -import Llvm.AbsSyn -import Llvm.MetaData -import Llvm.Types +import GHC.Llvm.Syntax +import GHC.Llvm.MetaData +import GHC.Llvm.Types import Data.List ( intersperse ) import Outputable diff --git a/compiler/llvmGen/Llvm/AbsSyn.hs b/compiler/GHC/Llvm/Syntax.hs similarity index 99% rename from compiler/llvmGen/Llvm/AbsSyn.hs rename to compiler/GHC/Llvm/Syntax.hs index a89ee357062803df7156c88c0799d47c10a343a3..d048215a0baaac858becee1ee9fe6155f50cd94a 100644 --- a/compiler/llvmGen/Llvm/AbsSyn.hs +++ b/compiler/GHC/Llvm/Syntax.hs @@ -2,12 +2,12 @@ -- | The LLVM abstract syntax. -- -module Llvm.AbsSyn where +module GHC.Llvm.Syntax where import GhcPrelude -import Llvm.MetaData -import Llvm.Types +import GHC.Llvm.MetaData +import GHC.Llvm.Types import Unique diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/GHC/Llvm/Types.hs similarity index 99% rename from compiler/llvmGen/Llvm/Types.hs rename to compiler/GHC/Llvm/Types.hs index fee5af916095d3f440b5ab9ab858f8e75d18c777..f4fa9a9a5685c530ef5d16aab929a7dd6ff7a44f 100644 --- a/compiler/llvmGen/Llvm/Types.hs +++ b/compiler/GHC/Llvm/Types.hs @@ -4,7 +4,7 @@ -- | The LLVM Type System. -- -module Llvm.Types where +module GHC.Llvm.Types where #include "HsVersions.h" @@ -372,7 +372,7 @@ llvmWidthInBits _ (LMStructU _) = -- It's not trivial to calculate the bit width of the unpacked structs, -- since they will be aligned depending on the specified datalayout ( -- http://llvm.org/docs/LangRef.html#data-layout ). One way we could support - -- this could be to make the LlvmCodeGen.Ppr.moduleLayout be a data type + -- this could be to make the GHC.CmmToLlvm.Ppr.moduleLayout be a data type -- that exposes the alignment information. However, currently the only place -- we use unpacked structs is LLVM intrinsics that return them (e.g., -- llvm.sadd.with.overflow.*), so we don't actually need to compute their diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 2f27d7d1161de2798819a6d666cff99df7194d89..04dfa692f3af9c54c684510de1b2293f923df3d1 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -165,7 +165,6 @@ Library cmm coreSyn iface - llvmGen main nativeGen parser @@ -212,18 +211,18 @@ Library Predicate Lexeme Literal - Llvm - Llvm.AbsSyn - Llvm.MetaData - Llvm.PpLlvm - Llvm.Types - LlvmCodeGen - LlvmCodeGen.Base - LlvmCodeGen.CodeGen - LlvmCodeGen.Data - LlvmCodeGen.Ppr - LlvmCodeGen.Regs - LlvmMangler + GHC.Llvm + GHC.Llvm.Syntax + GHC.Llvm.MetaData + GHC.Llvm.Ppr + GHC.Llvm.Types + GHC.CmmToLlvm + GHC.CmmToLlvm.Base + GHC.CmmToLlvm.CodeGen + GHC.CmmToLlvm.Data + GHC.CmmToLlvm.Ppr + GHC.CmmToLlvm.Regs + GHC.CmmToLlvm.Mangler MkId Module Name diff --git a/compiler/main/CodeOutput.hs b/compiler/main/CodeOutput.hs index 6656a4f4d8ea40d9af8b17d34621aa880d7b9795..de5452740edf13f12b8564d3f13be6c4c02bd5d2 100644 --- a/compiler/main/CodeOutput.hs +++ b/compiler/main/CodeOutput.hs @@ -13,7 +13,7 @@ module CodeOutput( codeOutput, outputForeignStubs ) where import GhcPrelude import AsmCodeGen ( nativeCodeGen ) -import LlvmCodeGen ( llvmCodeGen ) +import GHC.CmmToLlvm ( llvmCodeGen ) import UniqSupply ( mkSplitUniqSupply ) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 6fbf019456abdf9694bea0824f1f1386c0c4389e..6fe8bc0d35d33af52838d4dc38691881561ed28d 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -57,7 +57,7 @@ import StringBuffer ( hGetStringBuffer, hPutStringBuffer ) import BasicTypes ( SuccessFlag(..) ) import Maybes ( expectJust ) import SrcLoc -import LlvmCodeGen ( llvmFixupAsm, llvmVersionList ) +import GHC.CmmToLlvm ( llvmFixupAsm, llvmVersionList ) import MonadUtils import GHC.Platform import TcRnTypes diff --git a/compiler/main/SysTools/Tasks.hs b/compiler/main/SysTools/Tasks.hs index ee6824327aa70d84380c625833ec8c0f85cf7744..d006a84b99c3aec5908df2f5ce7a8a25f57a0ecc 100644 --- a/compiler/main/SysTools/Tasks.hs +++ b/compiler/main/SysTools/Tasks.hs @@ -22,7 +22,7 @@ import System.IO import System.Process import GhcPrelude -import LlvmCodeGen.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, parseLlvmVersion) +import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, parseLlvmVersion) import SysTools.Process import SysTools.Info