clash-ghc 0.6.23 → 0.6.24
raw patch · 6 files changed
+99/−72 lines, 6 filesdep ~clash-systemverilogdep ~clash-verilogdep ~lens
Dependency ranges changed: clash-systemverilog, clash-verilog, lens
Files
- CHANGELOG.md +7/−0
- clash-ghc.cabal +4/−4
- src-bin/InteractiveUI.hs +1/−3
- src-bin/Main.hs +1/−1
- src-ghc/CLaSH/GHC/GenerateBindings.hs +8/−4
- src-ghc/CLaSH/GHC/LoadModules.hs +78/−60
CHANGELOG.md view
@@ -1,5 +1,12 @@ # Changelog for the [`clash-ghc`](http://hackage.haskell.org/package/clash-ghc) package +## 0.6.24 *October 17th 20168+* Call generatePrimMap after loadModules [#175](https://github.com/clash-lang/clash-compiler/pull/175)+* Fixes bugs:+ * (System)Verilog: CLaSH.Sized.Vector.imap primitive gets indices in reverse order+ * Template Haskell splices are run twice+ * CLaSH errors out when observing the constructor for `Signal` [#174](https://github.com/clash-lang/clash-compiler/issues/174)+ ## 0.6.23 *August 18th 2015* * Fixes bugs: * Type families are not being reduced correctly [#167](https://github.com/clash-lang/clash-compiler/issues/167)
clash-ghc.cabal view
@@ -1,5 +1,5 @@ Name: clash-ghc-Version: 0.6.23+Version: 0.6.24 Synopsis: CAES Language for Synchronous Hardware Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -87,7 +87,7 @@ process >= 1.2 && < 1.5, hashable >= 1.1.2.3 && < 1.3, haskeline >= 0.7.0.3 && < 0.8,- lens >= 4.0.5 && < 4.15,+ lens >= 4.0.5 && < 4.16, mtl >= 2.1.1 && < 2.3, text >= 0.11.3.1 && < 1.3, transformers >= 0.4.2 && < 0.6,@@ -95,9 +95,9 @@ unordered-containers >= 0.2.1.0 && < 0.3, clash-lib >= 0.6.21 && < 0.7,- clash-systemverilog >= 0.6.9 && < 0.7,+ clash-systemverilog >= 0.6.10 && < 0.7, clash-vhdl >= 0.6.16 && < 0.7,- clash-verilog >= 0.6.9 && < 0.7,+ clash-verilog >= 0.6.10 && < 0.7, clash-prelude >= 0.10.13 && < 0.11, ghc-typelits-extra >= 0.1.3 && < 0.2, ghc-typelits-natnormalise >= 0.4.3 && < 0.6,
src-bin/InteractiveUI.hs view
@@ -115,7 +115,6 @@ import CLaSH.GHC.GenerateBindings import CLaSH.GHC.NetlistTypes import CLaSH.Netlist.BlackBox.Types (HdlSyn)-import qualified CLaSH.Primitives.Util import CLaSH.Util (clashLibVersion) import Control.DeepSeq import qualified Data.Time.Clock as Clock@@ -1593,9 +1592,8 @@ else Nothing opts' = opts {opt_hdlDir = maybe outputDir Just (opt_hdlDir opts)} primDir <- CLaSH.Backend.primDir (backend iw syn)- primMap <- CLaSH.Primitives.Util.generatePrimMap [primDir,"."] forM_ srcs $ \src -> do- (bindingsMap,tcm,tupTcm,topEnt,testInpM,expOutM) <- generateBindings primMap src (Just dflags)+ (bindingsMap,tcm,tupTcm,topEnt,testInpM,expOutM,primMap) <- generateBindings primDir src (Just dflags) prepTime <- startTime `deepseq` bindingsMap `deepseq` tcm `deepseq` Clock.getCurrentTime let prepStartDiff = Clock.diffUTCTime prepTime startTime putStrLn $ "Loading dependencies took " ++ show prepStartDiff
src-bin/Main.hs view
@@ -149,7 +149,7 @@ do case preStartupMode of ShowSupportedExtensions -> showSupportedExtensions ShowVersion -> showVersion- ShowNumVersion -> putStrLn (Data.Version.showVersion Paths_clash_ghc.version)+ ShowNumVersion -> putStrLn cProjectVersion ShowOptions isInteractive -> showOptions isInteractive Right postStartupMode -> -- start our GHC session
src-ghc/CLaSH/GHC/GenerateBindings.hs view
@@ -16,6 +16,7 @@ import qualified Data.HashMap.Strict as HashMap import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as IM+import Data.Text.Lazy (Text) import qualified Data.Set as Set import qualified Data.Set.Lens as Lens import Unbound.Generics.LocallyNameless (runFreshM, unembed)@@ -44,19 +45,22 @@ import CLaSH.GHC.LoadModules (loadModules) import CLaSH.Normalize.Util import CLaSH.Primitives.Types (PrimMap)+import CLaSH.Primitives.Util (generatePrimMap) import CLaSH.Rewrite.Util (mkInternalVar, mkSelectorCase) import CLaSH.Util ((***),first) generateBindings ::- PrimMap a+ FilePath -> String -> Maybe (GHC.DynFlags) -> IO (BindingMap,HashMap TyConName TyCon,IntMap TyConName ,(TmName, Maybe TopEntity) -- topEntity bndr + (maybe) TopEntity annotation ,Maybe TmName -- testInput bndr- ,Maybe TmName) -- expectedOutput bndr-generateBindings primMap modName dflagsM = do+ ,Maybe TmName -- expectedOutput bndr+ ,PrimMap Text) -- The primitives found in '.' and 'primDir'+generateBindings primDir modName dflagsM = do (bindings,clsOps,unlocatable,fiEnvs,(topEnt,topEntAnn),testInpM,expOutM) <- loadModules modName dflagsM+ primMap <- generatePrimMap [primDir,"."] let ((bindingsMap,clsVMap),tcMap) = State.runState (mkBindings primMap bindings clsOps unlocatable) emptyGHC2CoreState (tcMap',tupTcCache) = mkTupTyCons tcMap tcCache = makeAllTyCons tcMap' fiEnvs@@ -70,7 +74,7 @@ return (topEnt'',testInpM'',expOutM'') droppedAndRetypedBindings = dropAndRetypeBindings allTcCache allBindings topEnt' testInpM' expOutM' - return (droppedAndRetypedBindings,allTcCache,tupTcCache,(topEnt',topEntAnn),testInpM',expOutM')+ return (droppedAndRetypedBindings,allTcCache,tupTcCache,(topEnt',topEntAnn),testInpM',expOutM',primMap) dropAndRetypeBindings :: HashMap TyConName TyCon -> BindingMap
src-ghc/CLaSH/GHC/LoadModules.hs view
@@ -146,72 +146,82 @@ _ <- GHC.setSessionDynFlags dflags3 target <- GHC.guessTarget modName Nothing GHC.setTargets [target]- ldRes <- GHC.load GHC.LoadAllTargets- case ldRes of- GHC.Succeeded -> do- modGraph <- GHC.getModuleGraph- let modGraph' = map disableOptimizationsFlags modGraph- tidiedMods <- mapM (\m -> do { pMod <- parseModule m- ; tcMod <- GHC.typecheckModule pMod- ; dsMod <- fmap GHC.coreModule $ GHC.desugarModule tcMod- ; hsc_env <- GHC.getSession- ; simpl_guts <- MonadUtils.liftIO $ HscMain.hscSimplify hsc_env dsMod- ; (tidy_guts,_) <- MonadUtils.liftIO $ TidyPgm.tidyProgram hsc_env simpl_guts- ; let pgm = HscTypes.cg_binds tidy_guts- ; let modFamInstEnv = TcRnTypes.tcg_fam_inst_env $ fst $ GHC.tm_internals_ tcMod- ; return (CoreSyn.flattenBinds pgm,modFamInstEnv)- }- ) modGraph'-- let (binders,modFamInstEnvs) = first concat $ unzip tidiedMods- modFamInstEnvs' = foldr UniqFM.plusUFM UniqFM.emptyUFM modFamInstEnvs+ modGraph <- GHC.depanal [] False+ let modGraph' = map disableOptimizationsFlags modGraph+ modGraph2 = Digraph.flattenSCCs (GHC.topSortModuleGraph True modGraph' Nothing)+ tidiedMods <- mapM (\m -> do { pMod <- parseModule m+ ; tcMod <- GHC.typecheckModule pMod+ -- The purpose of the home package table (HPT) is to track+ -- the already compiled modules, so subsequent modules can+ -- rely/use those compilation results+ --+ -- We need to update the home package table (HPT) ourselves+ -- as we can no longer depend on 'GHC.load' to create a+ -- proper HPT.+ --+ -- The reason we have to cannot rely on 'GHC.load' is that+ -- it runs the rename/type-checker, which we also run in+ -- the code above. This would mean that the renamer/type-checker+ -- is run twice, which in turn means that template haskell+ -- splices are run twice.+ --+ -- Given that TH splices can do non-trivial computation and I/O,+ -- running TH twice must be avoid.+ ; tcMod' <- GHC.loadModule tcMod+ ; dsMod <- fmap GHC.coreModule $ GHC.desugarModule tcMod'+ ; hsc_env <- GHC.getSession+ ; simpl_guts <- MonadUtils.liftIO $ HscMain.hscSimplify hsc_env dsMod+ ; (tidy_guts,_) <- MonadUtils.liftIO $ TidyPgm.tidyProgram hsc_env simpl_guts+ ; let pgm = HscTypes.cg_binds tidy_guts+ ; let modFamInstEnv = TcRnTypes.tcg_fam_inst_env $ fst $ GHC.tm_internals_ tcMod+ ; return (CoreSyn.flattenBinds pgm,modFamInstEnv)+ }+ ) modGraph2 - (externalBndrs,clsOps,unlocatable) <- loadExternalExprs- (map snd binders)- (map fst binders)+ let (binders,modFamInstEnvs) = first concat $ unzip tidiedMods+ modFamInstEnvs' = foldr UniqFM.plusUFM UniqFM.emptyUFM modFamInstEnvs - hscEnv <- GHC.getSession- famInstEnvs <- TcRnMonad.liftIO $ TcRnMonad.initTcForLookup hscEnv FamInst.tcGetFamInstEnvs+ (externalBndrs,clsOps,unlocatable) <- loadExternalExprs+ (map snd binders)+ (map fst binders) - let rootModule = GHC.ms_mod_name . last- . Digraph.flattenSCC- . last- $ GHC.topSortModuleGraph True modGraph Nothing+ hscEnv <- GHC.getSession+ famInstEnvs <- TcRnMonad.liftIO $ TcRnMonad.initTcForLookup hscEnv FamInst.tcGetFamInstEnvs - rootBndrs = filter (maybe False- ((== rootModule)- . Module.moduleName)- . Name.nameModule_maybe- . Var.varName)- (map fst binders)+ let rootModule = GHC.ms_mod_name . last $ modGraph2+ rootBndrs = filter (maybe False+ ((== rootModule)+ . Module.moduleName)+ . Name.nameModule_maybe+ . Var.varName)+ (map fst binders) - topEntM <- findCLaSHAnnotations rootBndrs- let varNameString = OccName.occNameString . Name.nameOccName . Var.varName- topEntities = filter ((== "topEntity") . varNameString) rootBndrs- testInputs = filter ((== "testInput") . varNameString) rootBndrs- expectedOutputs = filter ((== "expectedOutput") . varNameString) rootBndrs- topEntity <- case topEntities of- [] -> case topEntM of- Just (l,r) -> return (l,Just r)- _ -> Panic.pgmError $ "No 'topEntity', nor function with a 'TopEntity' annotation found in root module: " ++- (Outputable.showSDocUnsafe (ppr rootModule))- [x] -> case topEntM of- Just (l,r) | l == x -> return (l,Just r)- | otherwise -> Panic.pgmError $ "'TopEntity' annotation applied to a function that is not named 'topEntity' while a 'topEntity' function is present: " ++- (Outputable.showSDocUnsafe (ppr rootModule <> dot <> ppr l))- Nothing -> return (x,Nothing)- _ -> Panic.pgmError $ $(curLoc) ++ "Multiple 'topEntities' found."- testInput <- case testInputs of- [] -> return Nothing- [x] -> return (Just x)- _ -> Panic.pgmError $ $(curLoc) ++ "Multiple 'testInput's found."- expectedOutput <- case expectedOutputs of- [] -> return Nothing- [x] -> return (Just x)- _ -> Panic.pgmError $ $(curLoc) ++ "Multiple 'testInput's found."+ topEntM <- findCLaSHAnnotations rootBndrs+ let varNameString = OccName.occNameString . Name.nameOccName . Var.varName+ topEntities = filter ((== "topEntity") . varNameString) rootBndrs+ testInputs = filter ((== "testInput") . varNameString) rootBndrs+ expectedOutputs = filter ((== "expectedOutput") . varNameString) rootBndrs+ topEntity <- case topEntities of+ [] -> case topEntM of+ Just (l,r) -> return (l,Just r)+ _ -> Panic.pgmError $ "No 'topEntity', nor function with a 'TopEntity' annotation found in root module: " +++ (Outputable.showSDocUnsafe (ppr rootModule))+ [x] -> case topEntM of+ Just (l,r) | l == x -> return (l,Just r)+ | otherwise -> Panic.pgmError $ "'TopEntity' annotation applied to a function that is not named 'topEntity' while a 'topEntity' function is present: " +++ (Outputable.showSDocUnsafe (ppr rootModule <> dot <> ppr l))+ Nothing -> return (x,Nothing)+ _ -> Panic.pgmError $ $(curLoc) ++ "Multiple 'topEntities' found."+ testInput <- case testInputs of+ [] -> return Nothing+ [x] -> return (Just x)+ _ -> Panic.pgmError $ $(curLoc) ++ "Multiple 'testInput's found."+ expectedOutput <- case expectedOutputs of+ [] -> return Nothing+ [x] -> return (Just x)+ _ -> Panic.pgmError $ $(curLoc) ++ "Multiple 'testInput's found." - return (binders ++ externalBndrs,clsOps,unlocatable,(fst famInstEnvs,modFamInstEnvs'),topEntity,testInput,expectedOutput)- GHC.Failed -> Panic.pgmError $ $(curLoc) ++ "failed to load module: " ++ modName+ return (binders ++ externalBndrs,clsOps,unlocatable,(fst famInstEnvs,modFamInstEnvs'),topEntity,testInput,expectedOutput) findCLaSHAnnotations :: GHC.GhcMonad m => [CoreSyn.CoreBndr]@@ -266,7 +276,9 @@ , Opt_FloatIn -- Moves let-bindings inwards, although it defeats the normal-form with a single top-level let-binding, it helps with other transformations , Opt_DictsStrict -- Hopefully helps remove class method selectors , Opt_DmdTxDictSel -- I think demand and strictness are related, strictness helps with dead-code, enable+#if __GLASGOW_HASKELL__ >= 711 , Opt_Strictness -- Strictness analysis helps with dead-code analysis. However, see [NOTE: CPR breaks CLaSH]+#endif ] unwanted = [ Opt_LiberateCase -- Perform unrolling of recursive RHS: avoid@@ -290,6 +302,12 @@ , Opt_Loopification -- STG pass, don't care #if __GLASGOW_HASKELL__ >= 711 , Opt_CprAnal -- The worker/wrapper introduced by CPR breaks CLaSH, see [NOTE: CPR breaks CLaSH]+#else+ , Opt_Strictness -- Strictness analysis helps with dead-code analysis. However, see [NOTE: CPR breaks CLaSH]+ -- So, strictness analysis must be disabled completely on GHC versions below 8.0,+ -- because strictness analysis implies demand analysis, which implies CPR analysis,+ -- which cannot be completely disabled due to https://ghc.haskell.org/trac/ghc/ticket/10696.+ -- This bug shows itself as: https://github.com/clash-lang/clash-compiler/issues/174 #endif ]