clash-ghc 0.5.14 → 0.5.15
raw patch · 5 files changed
+77/−36 lines, 5 filesdep ~clash-libdep ~clash-preludedep ~clash-systemverilog
Dependency ranges changed: clash-lib, clash-prelude, clash-systemverilog, clash-verilog, clash-vhdl
Files
- CHANGELOG.md +8/−0
- clash-ghc.cabal +6/−6
- src-bin/Main.hs +11/−1
- src-ghc/CLaSH/GHC/Evaluator.hs +49/−28
- src-ghc/CLaSH/GHC/LoadModules.hs +3/−1
CHANGELOG.md view
@@ -1,5 +1,13 @@ # Changelog for the [`clash-ghc`](http://hackage.haskell.org/package/clash-ghc) package +## 0.5.15 *September 21st 2015*+* New features:+ * Report simulation time in (System)Verilog assert messages++* Fixes bugs:+ * Performance bug: top-level definitions of type "Signal" erroneously inlined.+ * Fix Index maxBound [#79](https://github.com/clash-lang/clash-compiler/pull/79)+ ## 0.5.14 *September 14th 2015* * New features: * Completely unroll "definitions" of some higher-order primitives with non-representable argument or result vectors:
clash-ghc.cabal view
@@ -1,5 +1,5 @@ Name: clash-ghc-Version: 0.5.14+Version: 0.5.15 Synopsis: CAES Language for Synchronous Hardware Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -94,11 +94,11 @@ unbound-generics >= 0.1 && < 0.3, unordered-containers >= 0.2.1.0, - clash-lib >= 0.5.12 && < 0.6,- clash-systemverilog >= 0.5.9,- clash-vhdl >= 0.5.11,- clash-verilog >= 0.5.9,- clash-prelude >= 0.9.2,+ clash-lib >= 0.5.13 && < 0.6,+ clash-systemverilog >= 0.5.10,+ clash-vhdl >= 0.5.12,+ clash-verilog >= 0.5.10,+ clash-prelude >= 0.9.3, ghc-typelits-natnormalise >= 0.3 if os(windows)
src-bin/Main.hs view
@@ -116,8 +116,18 @@ hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do- -- 1. extract the -B flag from the args++-- Disable CPR analysis in versions older than GHC 7.11 by always inserting the+-- -fcpr-off flag. From GHC 7.11 and up, CPR analysis, specifically the+-- worker/wrapper it creates, can be turned off with a DynFlag.+--+-- See [NOTE: CPR breaks CLaSH] why the worker/wrapper introduced by the CPR+-- analysis is bad for CLaSH+#if __GLASGOW_HASKELL__ >= 711 argv0 <- getArgs+#else+ argv0 <- fmap ("-fcpr-off":) getArgs+#endif libDir <- ghcLibDir let argv1 = map (mkGeneralLocated "on the commandline") argv0
src-ghc/CLaSH/GHC/Evaluator.hs view
@@ -14,14 +14,15 @@ import CLaSH.Core.Literal (Literal (..)) import CLaSH.Core.Term (Term (..)) import CLaSH.Core.Type (Type (..), ConstTy (..), LitTy (..),- TypeView (..), tyView, mkFunTy)+ TypeView (..), tyView, mkFunTy,+ mkTyConApp, splitFunForallTy) import CLaSH.Core.TyCon (TyCon, TyConName, tyConDataCons) import CLaSH.Core.TysPrim (typeNatKind) import CLaSH.Core.Util (collectArgs,mkApps,mkVec,termType) import CLaSH.Core.Var (Var (..)) reduceConstant :: HashMap.HashMap TyConName TyCon -> Bool -> Term -> Term-reduceConstant tcm isSubj e@(collectArgs -> (Prim nm _, args))+reduceConstant tcm isSubj e@(collectArgs -> (Prim nm ty, args)) | nm == "GHC.Prim.==#" || nm == "GHC.Integer.Type.eqInteger#" = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)]@@ -90,6 +91,16 @@ [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] -> Literal (IntegerLiteral (i `rem` j)) _ -> e+ | nm == "GHC.Prim.quotRemInt#"+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of+ [Literal (IntegerLiteral i), Literal (IntegerLiteral j)]+ -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty+ (Just tupTc) = HashMap.lookup tupTcNm tcm+ [tupDc] = tyConDataCons tupTc+ (q,r) = quotRem i j+ ret = mkApps (Data tupDc) (map Right tyArgs ++ [Left (Literal (IntegerLiteral q)), Left (Literal (IntegerLiteral r))])+ in ret+ _ -> e | nm == "GHC.Integer.Type.shiftLInteger" = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)]@@ -106,32 +117,42 @@ _ -> e | nm == "CLaSH.Sized.Internal.Signed.minBound#" = case args of- [litTy,Left (Literal (IntegerLiteral mb))]+ [litTy,kn@(Left (Literal (IntegerLiteral mb)))] -> let minB = negate (2 ^ (mb - 1))- in mkApps signedConPrim [litTy,Left (Literal (IntegerLiteral minB))]+ in mkApps signedConPrim [litTy,kn,Left (Literal (IntegerLiteral minB))] _ -> e | nm == "CLaSH.Sized.Internal.Signed.maxBound#" = case args of- [litTy,Left (Literal (IntegerLiteral mb))]+ [litTy,kn@(Left (Literal (IntegerLiteral mb)))] -> let maxB = (2 ^ (mb - 1)) - 1- in mkApps signedConPrim [litTy,Left (Literal (IntegerLiteral maxB))]+ in mkApps signedConPrim [litTy,kn,Left (Literal (IntegerLiteral maxB))] _ -> e | nm == "CLaSH.Sized.Internal.Unsigned.minBound#" = case args of- [litTy]- -> mkApps unsignedConPrim [litTy,Left (Literal (IntegerLiteral 0))]+ [litTy,kn@(Left (Literal (IntegerLiteral _)))]+ -> mkApps unsignedConPrim [litTy,kn,Left (Literal (IntegerLiteral 0))] _ -> e | nm == "CLaSH.Sized.Internal.Unsigned.maxBound#" = case args of- [litTy,Left (Literal (IntegerLiteral mb))]- -> let maxB = 2 ^ mb- in mkApps unsignedConPrim [litTy,Left (Literal (IntegerLiteral maxB))]+ [litTy,kn@(Left (Literal (IntegerLiteral mb)))]+ -> let maxB = (2 ^ mb) - 1+ in mkApps unsignedConPrim [litTy,kn,Left (Literal (IntegerLiteral maxB))] _ -> e | nm == "CLaSH.Sized.Internal.Signed.toInteger#" || nm == "CLaSH.Sized.Internal.Unsigned.toInteger#" = case (map (reduceConstant tcm isSubj) . Either.lefts) args of- [App _ (Literal (IntegerLiteral i))]- -> Literal (IntegerLiteral i)+ [collectArgs -> (Prim nm' _,[Right _, Left _, Left (Literal (IntegerLiteral i))])]+ | nm' == "CLaSH.Sized.Internal.Signed.fromInteger#" ||+ nm' == "CLaSH.Sized.Internal.Unsigned.fromInteger#" -> Literal (IntegerLiteral i) _ -> e+ | nm == "CLaSH.Sized.Internal.Signed.eq#" || nm == "CLaSH.Sized.Internal.Unsigned.eq#"+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of+ [collectArgs -> (Prim _ _,[Right _, Left _, Left (Literal (IntegerLiteral i))]) ,collectArgs -> (Prim _ _,[Right _, Left _, Left (Literal (IntegerLiteral j))])] ->+ let (_,tyView -> TyConApp boolTcNm []) = splitFunForallTy ty+ (Just boolTc) = HashMap.lookup boolTcNm tcm+ [falseDc,trueDc] = tyConDataCons boolTc+ retDc = if i == j then trueDc else falseDc+ in Data retDc+ _ -> e | nm == "GHC.TypeLits.natVal" = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), _] -> Literal (IntegerLiteral i)@@ -141,8 +162,8 @@ [(Literal (IntegerLiteral _),[]), (Data _,_)] -> mkApps snatCon args _ -> e | isSubj && nm == "CLaSH.Sized.Vector.replicate"- = let ty = runFreshM (termType tcm e)- in case tyView ty of+ = let ty' = runFreshM (termType tcm e)+ in case tyView ty' of (TyConApp vecTcNm [LitTy (NumTy len),argTy]) -> let (Just vecTc) = HashMap.lookup vecTcNm tcm [nilCon,consCon] = tyConDataCons vecTc@@ -152,24 +173,24 @@ reduceConstant _ _ e = e signedConPrim :: Term-signedConPrim = Prim "CLaSH.Sized.Internal.Signed.S" (ForAllTy (bind nTV funTy))- where- funTy = mkFunTy intTy (AppTy signedTy nVar)- intTy = ConstTy (TyCon (string2Name "GHC.Integer.Type.Integer"))- signedTy = ConstTy (TyCon (string2Name "CLaSH.Sized.Internal.Signed.Signed"))- nName = string2Name "n"- nVar = VarTy typeNatKind nName- nTV = TyVar nName (embed typeNatKind)--unsignedConPrim :: Term-unsignedConPrim = Prim "CLaSH.Sized.Internal.Unsigned.U" (ForAllTy (bind nTV funTy))+signedConPrim = Prim "CLaSH.Sized.Internal.Signed.fromInteger#" (ForAllTy (bind nTV funTy)) where- funTy = mkFunTy intTy (AppTy unsignedTy nVar)+ funTy = foldr1 mkFunTy [intTy,intTy,mkTyConApp signedTcNm [nVar]] intTy = ConstTy (TyCon (string2Name "GHC.Integer.Type.Integer"))- unsignedTy = ConstTy (TyCon (string2Name "CLaSH.Sized.Internal.Unsigned.Unsigned"))+ signedTcNm = string2Name "CLaSH.Sized.Internal.Signed.Signed" nName = string2Name "n" nVar = VarTy typeNatKind nName nTV = TyVar nName (embed typeNatKind)++unsignedConPrim :: Term+unsignedConPrim = Prim "CLaSH.Sized.Internal.Unsigned.fromInteger#" (ForAllTy (bind nTV funTy))+ where+ funTy = foldr1 mkFunTy [intTy,intTy,mkTyConApp unsignedTcNm [nVar]]+ intTy = ConstTy (TyCon (string2Name "GHC.Integer.Type.Integer"))+ unsignedTcNm = string2Name "CLaSH.Sized.Internal.Unsigned.Unsigned"+ nName = string2Name "n"+ nVar = VarTy typeNatKind nName+ nTV = TyVar nName (embed typeNatKind) snatCon :: Term snatCon = Data (MkData snanNm 1 snatTy [nName] [] argTys)
src-ghc/CLaSH/GHC/LoadModules.hs view
@@ -180,7 +180,6 @@ wantedOptimizationFlags df = foldl DynFlags.gopt_unset (foldl DynFlags.gopt_set df wanted) unwanted where wanted = [ Opt_CSE -- CSE- , Opt_FullLaziness -- Floats let-bindings outside enclosing lambdas , Opt_Specialise -- Specialise on types, specialise type-class-overloaded function defined in this module for the types , Opt_DoLambdaEtaExpansion -- transform nested series of lambdas into one with multiple arguments, helps us achieve only top-level lambdas , Opt_CaseMerge -- We want fewer case-statements@@ -216,6 +215,9 @@ , Opt_OmitInterfacePragmas -- We need all the unfoldings we can get , Opt_IrrefutableTuples -- Introduce irrefutPatError: avoid , 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]+#endif ] -- [NOTE: CPR breaks CLaSH]