diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog for the [`clash-ghc`](http://hackage.haskell.org/package/clash-ghc) package +## 0.5.8 *June 25th 2015* +* New features: + * Support for copying string literals from Haskell to generated code + * Support `clash-prelude-0.9` + * Size at below which functions are always inlined is configurable, run with `-clash-inline-below=N` to set the size limit to `N` + ## 0.5.7 *June 3rd 2015* * New features: * New Verilog backend, run `:verilog` in interactive mode, or `--verilog` for batch mode diff --git a/clash-ghc.cabal b/clash-ghc.cabal --- a/clash-ghc.cabal +++ b/clash-ghc.cabal @@ -1,5 +1,5 @@ Name: clash-ghc -Version: 0.5.7 +Version: 0.5.8 Synopsis: CAES Language for Synchronous Hardware Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that @@ -70,11 +70,11 @@ unbound-generics >= 0.1, unordered-containers >= 0.2.1.0, - clash-lib >= 0.5.6, - clash-systemverilog >= 0.5.5, - clash-vhdl >= 0.5.5, - clash-verilog >= 0.5.5, - clash-prelude >= 0.8, + clash-lib >= 0.5.7, + clash-systemverilog >= 0.5.6, + clash-vhdl >= 0.5.7, + clash-verilog >= 0.5.6, + clash-prelude >= 0.9, ghc-typelits-natnormalise >= 0.3 if os(windows) diff --git a/src-bin/Main.hs b/src-bin/Main.hs --- a/src-bin/Main.hs +++ b/src-bin/Main.hs @@ -126,6 +126,7 @@ r <- newIORef (CLaSHOpts { opt_dbgLevel = DebugNone , opt_inlineLimit = 20 , opt_specLimit = 20 + , opt_inlineBelow = 15 }) (argv3, clashFlagWarnings) <- parseCLaSHFlags r argv2 diff --git a/src-ghc/CLaSH/GHC/CLaSHFlags.hs b/src-ghc/CLaSH/GHC/CLaSHFlags.hs --- a/src-ghc/CLaSH/GHC/CLaSHFlags.hs +++ b/src-ghc/CLaSH/GHC/CLaSHFlags.hs @@ -31,6 +31,7 @@ flagsClash r = [ defFlag "clash-inline-limit" (IntSuffix (liftEwM . setInlineLimit r)) , defFlag "clash-spec-limit" (IntSuffix (liftEwM . setSpecLimit r)) + , defFlag "clash-inline-below" (IntSuffix (liftEwM . setInlineBelow r)) , defFlag "clash-debug" (SepArg (setDebugLevel r)) ] @@ -38,6 +39,11 @@ -> Int -> IO () setInlineLimit r n = modifyIORef r (\c -> c {opt_inlineLimit = n}) + +setInlineBelow :: IORef CLaSHOpts + -> Int + -> IO () +setInlineBelow r n = modifyIORef r (\c -> c {opt_inlineBelow = n}) setSpecLimit :: IORef CLaSHOpts -> Int diff --git a/src-ghc/CLaSH/GHC/GHC2Core.hs b/src-ghc/CLaSH/GHC/GHC2Core.hs --- a/src-ghc/CLaSH/GHC/GHC2Core.hs +++ b/src-ghc/CLaSH/GHC/GHC2Core.hs @@ -61,7 +61,12 @@ algTyConRhs, isAlgTyCon, isFamilyTyCon, isFunTyCon, isNewTyCon, isPrimTyCon, isTupleTyCon, - tcExpandTyCon_maybe, tyConArity, +#if __GLASGOW_HASKELL__ >= 711 + expandSynTyCon_maybe, +#else + tcExpandTyCon_maybe, +#endif + tyConArity, tyConDataCons, tyConKind, tyConName, tyConUnique) import Type (mkTopTvSubst, substTy, tcView) @@ -278,6 +283,7 @@ | f == pack "CLaSH.Signal.Internal.signal#" -> return (signalTerm xType) | f == pack "CLaSH.Signal.Internal.appSignal#" -> return (appSignalTerm xType) | f == pack "CLaSH.Signal.Internal.traverse#" -> return (traverseTerm xType) + | f == pack "CLaSH.Signal.Internal.joinSignal#" -> return (joinTerm xType) | f == pack "CLaSH.Signal.Bundle.vecBundle#" -> return (vecUnwrapTerm xType) | f == pack "GHC.Base.$" -> return (dollarTerm xType) | otherwise -> return (C.Prim xNameS xType) @@ -357,7 +363,11 @@ coreToType' (TyVarTy tv) = C.VarTy <$> coreToType (varType tv) <*> (coreToVar tv) coreToType' (TyConApp tc args) | isFunTyCon tc = foldl C.AppTy (C.ConstTy C.Arrow) <$> mapM coreToType args +#if __GLASGOW_HASKELL__ >= 711 + | otherwise = case expandSynTyCon_maybe tc args of +#else | otherwise = case tcExpandTyCon_maybe tc args of +#endif Just (substs,synTy,remArgs) -> do let substs' = mkTopTvSubst substs synTy' = substTy substs' synTy @@ -638,6 +648,18 @@ xId = C.Id xName (embed aTy) dollarTerm ty = error $ $(curLoc) ++ show ty + +-- | Given the type: +-- +-- @forall a. forall clk. Signal' clk (Signal' clk a) -> Signal' clk a@ +-- +-- Generate the term +-- +-- @/\(a:*)./\(clk:Clock).\(x:Signal' clk a).x@ +joinTerm :: C.Type + -> C.Term +joinTerm ty@(C.ForAllTy _) = signalTerm ty +joinTerm ty = error $ $(curLoc) ++ show ty isDataConWrapId :: Id -> Bool isDataConWrapId v = case idDetails v of diff --git a/src-ghc/CLaSH/GHC/LoadModules.hs b/src-ghc/CLaSH/GHC/LoadModules.hs --- a/src-ghc/CLaSH/GHC/LoadModules.hs +++ b/src-ghc/CLaSH/GHC/LoadModules.hs @@ -94,13 +94,18 @@ } return dfPlug - let dflags1 = dflags { DynFlags.ctxtStkDepth = 1000 - , DynFlags.optLevel = 2 - , DynFlags.ghcMode = GHC.CompManager - , DynFlags.ghcLink = GHC.LinkInMemory - , DynFlags.hscTarget = DynFlags.defaultObjectTarget - (DynFlags.targetPlatform dflags) - } + let dflags1 = dflags +#if __GLASGOW_HASKELL__ >= 711 + { DynFlags.reductionDepth = 1000 +#else + { DynFlags.ctxtStkDepth = 1000 +#endif + , DynFlags.optLevel = 2 + , DynFlags.ghcMode = GHC.CompManager + , DynFlags.ghcLink = GHC.LinkInMemory + , DynFlags.hscTarget = DynFlags.defaultObjectTarget + (DynFlags.targetPlatform dflags) + } let dflags2 = wantedOptimizationFlags dflags1 let ghcDynamic = case lookup "GHC Dynamic" (DynFlags.compilerInfo dflags) of Just "YES" -> True @@ -163,7 +168,13 @@ = ms {GHC.ms_hspp_opts = dflags} where dflags = wantedOptimizationFlags (ms_hspp_opts - {DynFlags.optLevel = 2, DynFlags.ctxtStkDepth = 1000}) + { DynFlags.optLevel = 2 +#if __GLASGOW_HASKELL__ >= 711 + , DynFlags.reductionDepth = 1000 +#else + , DynFlags.ctxtStkDepth = 1000 +#endif + }) wantedOptimizationFlags :: GHC.DynFlags -> GHC.DynFlags wantedOptimizationFlags df = foldl DynFlags.gopt_unset (foldl DynFlags.gopt_set df wanted) unwanted diff --git a/src-ghc/CLaSH/GHC/NetlistTypes.hs b/src-ghc/CLaSH/GHC/NetlistTypes.hs --- a/src-ghc/CLaSH/GHC/NetlistTypes.hs +++ b/src-ghc/CLaSH/GHC/NetlistTypes.hs @@ -52,6 +52,12 @@ sz <- tyNatSize m szTy elHWTy <- ExceptT $ return $ coreTypeToHWType ghcTypeToHWType m elTy return $ Vector sz elHWTy + + "String" -> return Void + "GHC.Types.[]" -> case tyView (head args) of + (TyConApp (name2String -> "GHC.Types.Char") []) -> return Void + _ -> fail $ "Can't translate type: " ++ showDoc ty + _ -> case m ! tc of -- TODO: Remove this conversion -- The current problem is that type-functions are not reduced by the GHC -> Core