Merge branch 'master' into fix2001

.ci/bindist/README.md

@@ -28,7 +28,9 @@ triggered on any other branch a _beta_ release gets made.
 ## Releasing a new version major version (1.x)
 1. Change version numbers in:
   * `clash-prelude/clash-prelude.cabal`
+  * `clash-prelude-hedgehog/clash-prelude-hedgehog.cabal`
   * `clash-lib/clash-lib.cabal`
+  * `clash-lib-hedgehog/clash-lib-hedgehog.cabal`
   * `clash-ghc/clash-ghc.cabal`
   * `clash-ghc/clash-cores.cabal`
   * `.ci/bindist/linux/snap/snap/snapcraft.yaml`

.ci/docker/Dockerfile

@@ -107,7 +107,7 @@ RUN git clone https://github.com/verilator/verilator verilator \
 
 FROM builder AS build-ghc
 
-ARG ghcup_version="0.1.15.2"
+ARG ghcup_version="0.1.17.4"
 
 # Must be explicitly set
 ARG ghc_version

.ci/docker/build-and-publish-docker-image.sh

@@ -7,7 +7,7 @@ NAME="clash-ci-"
 DIR=$(dirname "$0")
 now=$(date +%F)
 
-GHC_VERSIONS=(  "9.0.1"   "8.10.2"  "8.8.4"   "8.6.5")
+GHC_VERSIONS=(  "9.0.2"   "8.10.2"  "8.8.4"   "8.6.5")
 CABAL_VERSIONS=("3.4.0.0" "3.2.0.0" "3.2.0.0" "3.0.0.0")
 
 # We want to use docker buildkit so that our layers are built in parallel. This

.ci/gitlab/benchmark.yml

@@ -1,5 +1,5 @@
 .benchmark:
-  image: ghcr.io/clash-lang/clash-ci-$GHC_VERSION:2022-01-25
+  image: ghcr.io/clash-lang/clash-ci-$GHC_VERSION:2022-02-02
   stage: test
   timeout: 2 hours
   variables:

.ci/gitlab/common.yml

@@ -1,5 +1,5 @@
 .common:
-  image: ghcr.io/clash-lang/clash-ci-$GHC_VERSION:2022-01-25
+  image: ghcr.io/clash-lang/clash-ci-$GHC_VERSION:2022-02-02
   timeout: 2 hours
   stage: build
   variables:

.github/workflows/ci.yml

@@ -28,13 +28,13 @@ jobs:
             ghc: 8.10.2
             multiple_hidden: yes
 
-          - name: GHC 9.0.1, Multiple Hidden
-            ghc: 9.0.1
+          - name: GHC 9.0.2, Multiple Hidden
+            ghc: 9.0.2
             multiple_hidden: yes
 
     # Run steps inside the clash CI docker image
     container:
-      image: ghcr.io/clash-lang/clash-ci-${{ matrix.ghc }}:2022-01-25
+      image: ghcr.io/clash-lang/clash-ci-${{ matrix.ghc }}:2022-02-02
 
       env:
         THREADS: 2

.gitlab-ci.yml

@@ -49,7 +49,7 @@ tests-8.10:
 tests-9.0:
   extends: .common-trigger
   variables:
-    GHC_VERSION: 9.0.1
+    GHC_VERSION: 9.0.2
 
 stack-build:
   extends: .common

benchmark/benchmark-normalization.hs

@@ -44,15 +44,16 @@ benchFile idirs src =
   env (setupEnv idirs src) $
     \ ~(clashEnv, clashDesign, supplyN) -> do
       bench ("normalization of " ++ src)
-            (nf (normalizeEntity
-                   clashEnv
-                   (designBindings clashDesign)
-                   (ghcTypeToHWType (opt_intWidth (envOpts clashEnv)))
-                   ghcEvaluator
-                   evaluator
-                   (fmap topId (designEntities clashDesign))
-                   supplyN)
-                   (topId (head (designEntities clashDesign))))
+            (nfIO
+              (normalizeEntity
+                 clashEnv
+                 (designBindings clashDesign)
+                 (ghcTypeToHWType (opt_intWidth (envOpts clashEnv)))
+                 ghcEvaluator
+                 evaluator
+                 (fmap topId (designEntities clashDesign))
+                 supplyN
+                 (topId (head (designEntities clashDesign)))))
 
 setupEnv
   :: [FilePath]

benchmark/common/BenchmarkCommon.hs

@@ -60,7 +60,7 @@ runNormalisationStage idirs src = do
   (env, design) <- runInputStage idirs src
   let topEntityNames = fmap topId (designEntities design)
   let topEntity = head topEntityNames
-  let transformedBindings =
+  transformedBindings <-
         normalizeEntity env (designBindings design)
           (ghcTypeToHWType (opt_intWidth (opts idirs)))
           ghcEvaluator

benchmark/profiling/run/profile-normalization-run.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE CPP #-}
 
 import           Clash.Driver
-import           Clash.Driver.Types
+import           Clash.Driver.Types           (ClashEnv(..), ClashOpts(opt_intWidth))
 
 import           Clash.GHC.PartialEval
 import           Clash.GHC.Evaluator
@@ -43,7 +43,7 @@ benchFile idirs src = do
                    , envCustomReprs = reprs
                    }
 
-      res = normalizeEntity clashEnv bindingsMap
+  res <- normalizeEntity clashEnv bindingsMap
                    (ghcTypeToHWType (opt_intWidth (envOpts clashEnv)))
                    ghcEvaluator
                    evaluator

changelog/2022-01-31T08_51_47+01_00_memblob

@@ -0,0 +1 @@
+ADDED: The `MemBlob` structure: efficient constants for initializing memories. Depending on how the content is constructed, a `Vec` for the initial memory content can turn out to be prohibitively slow. In these cases, `MemBlob` can store your content efficiently. [#2041](https://github.com/clash-lang/clash-compiler/pull/2041)

changelog/2022-01-31T12_23_39+01_00_spurious_integer_warnings.md

@@ -0,0 +1 @@
+CHANGED: toEnum/fromEnum on sized types is now less eager to report warnings about integer functions being used [#2046](https://github.com/clash-lang/clash-compiler/issues/2046).

changelog/2022-01-31T16_53_31+01_00_werror_clash.md

@@ -0,0 +1 @@
+CHANGED: Clash now respects the -Werror option from GHC

clash-ghc/src-bin-8.10/Clash/Main.hs

@@ -52,6 +52,7 @@ import Packages         ( pprPackages, pprPackagesSimple )
 import DriverPhases
 import BasicTypes       ( failed )
 import DynFlags hiding (WarnReason(..))
+import EnumSet as EnumSet
 import ErrUtils
 import FastString
 import Outputable
@@ -88,7 +89,7 @@ import Data.Maybe
 import           Paths_clash_ghc
 import           Clash.GHCi.UI (makeHDL)
 import           Exception (gcatch)
-import           Data.IORef (IORef, newIORef, readIORef)
+import           Data.IORef (IORef, newIORef, readIORef, modifyIORef')
 import qualified Data.Version (showVersion)
 
 import           Clash.Backend (Backend)
@@ -236,6 +237,10 @@ main' postLoadMode dflags0 args flagWarnings startAction clashOpts = do
   (dflags3, fileish_args, dynamicFlagWarnings) <-
       GHC.parseDynamicFlags dflags2 args
 
+  -- Propagate -Werror to Clash
+  liftIO . modifyIORef' clashOpts $ \opts ->
+    opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) }
+
   let dflags4 = case lang of
                 HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) ->
                     let platform = targetPlatform dflags3

clash-ghc/src-bin-861/Clash/Main.hs

@@ -53,6 +53,7 @@ import Packages         ( pprPackages, pprPackagesSimple )
 import DriverPhases
 import BasicTypes       ( failed )
 import DynFlags hiding (WarnReason(..))
+import EnumSet as EnumSet
 import ErrUtils
 import FastString
 import Outputable
@@ -86,7 +87,7 @@ import Data.Maybe
 import           Paths_clash_ghc
 import           Clash.GHCi.UI (makeHDL)
 import           Exception (gcatch)
-import           Data.IORef (IORef, newIORef, readIORef)
+import           Data.IORef (IORef, newIORef, readIORef, modifyIORef')
 import qualified Data.Version (showVersion)
 
 import           Clash.Backend (Backend)
@@ -235,6 +236,10 @@ main' postLoadMode dflags0 args flagWarnings startAction clashOpts = do
   (dflags3, fileish_args, dynamicFlagWarnings) <-
       GHC.parseDynamicFlags dflags2 args
 
+  -- Propagate -Werror to Clash
+  liftIO . modifyIORef' clashOpts $ \opts ->
+    opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) }
+
   let dflags4 = case lang of
                 HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) ->
                     let platform = targetPlatform dflags3

clash-ghc/src-bin-881/Clash/Main.hs

@@ -50,6 +50,7 @@ import Packages         ( pprPackages, pprPackagesSimple )
 import DriverPhases
 import BasicTypes       ( failed )
 import DynFlags hiding (WarnReason(..))
+import EnumSet as EnumSet
 import ErrUtils
 import FastString
 import Outputable
@@ -83,7 +84,7 @@ import Data.Maybe
 import           Paths_clash_ghc
 import           Clash.GHCi.UI (makeHDL)
 import           Exception (gcatch)
-import           Data.IORef (IORef, newIORef, readIORef)
+import           Data.IORef (IORef, newIORef, readIORef, modifyIORef')
 import qualified Data.Version (showVersion)
 
 import           Clash.Backend (Backend)
@@ -230,6 +231,10 @@ main' postLoadMode dflags0 args flagWarnings startAction clashOpts = do
   (dflags3, fileish_args, dynamicFlagWarnings) <-
       GHC.parseDynamicFlags dflags2 args
 
+  -- Propagate -Werror to Clash
+  liftIO . modifyIORef' clashOpts $ \opts ->
+    opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) }
+
   let dflags4 = case lang of
                 HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) ->
                     let platform = targetPlatform dflags3

clash-ghc/src-bin-9.0/Clash/Main.hs

@@ -54,6 +54,7 @@ import GHC.Driver.Phases
 import GHC.Types.Basic     ( failed )
 import GHC.Driver.Session as DynFlags hiding (WarnReason(..))
 import GHC.Utils.Error
+import GHC.Data.EnumSet as EnumSet
 import GHC.Data.FastString
 import GHC.Utils.Outputable as Outputable
 import GHC.SysTools.BaseDir
@@ -90,7 +91,7 @@ import Prelude
 import           Paths_clash_ghc
 import           Clash.GHCi.UI (makeHDL)
 import           Control.Monad.Catch (catch)
-import           Data.IORef (IORef, newIORef, readIORef)
+import           Data.IORef (IORef, newIORef, readIORef, modifyIORef')
 import qualified Data.Version (showVersion)
 
 import           Clash.Backend (Backend)
@@ -237,6 +238,10 @@ main' postLoadMode dflags0 args flagWarnings startAction clashOpts = do
   (dflags3, fileish_args, dynamicFlagWarnings) <-
       GHC.parseDynamicFlags dflags2 args
 
+  -- Propagate -Werror to Clash
+  liftIO . modifyIORef' clashOpts $ \opts ->
+    opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) }
+
   let dflags4 = case lang of
                 HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) ->
                     let platform = targetPlatform dflags3

clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs

@@ -2,7 +2,7 @@
   Copyright   :  (C) 2013-2016, University of Twente,
                      2016-2017, Myrtle Software Ltd,
                      2017     , QBayLogic, Google Inc.,
-                     2021     , QBayLogic B.V.
+                     2021-2022, QBayLogic B.V.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
 -}
@@ -1929,6 +1929,12 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
   "Clash.Sized.Internal.BitVector.le##" | [(0,i),(0,j)] <- bitLiterals args
     -> reduce (boolToBoolLiteral tcm ty (i <= j))
 
+-- Enum
+  "Clash.Sized.Internal.BitVector.toEnum##"
+    | [i] <- intLiterals' args
+    -> let Bit msk val = BitVector.toEnum## (fromInteger i)
+       in reduce (mkBitLit ty (toInteger msk) (toInteger val))
+
 -- Bits
   "Clash.Sized.Internal.BitVector.and##"
     | [i,j] <- bitLiterals args
@@ -2131,6 +2137,18 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
     , Just val <- reifyNat kn (liftBitVector2Bool BitVector.le# ty tcm args)
     -> reduce val
 
+-- Enum
+
+  "Clash.Sized.Internal.BitVector.toEnum#"
+    | let resTyInfo@(_,_,kn) = extractTySizeInfo tcm ty tys
+    , Just val <- reifyNat kn (liftInteger2BitVector (BitVector.toEnum# . fromInteger) resTyInfo args)
+    -> reduce val
+
+  "Clash.Sized.Internal.BitVector.fromEnum#"
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2Int (toInteger . BitVector.fromEnum#) args)
+    -> reduce val
+
 -- Bounded
   "Clash.Sized.Internal.BitVector.minBound#"
     | Just (nTy,len) <- extractKnownNat tcm tys
@@ -2303,6 +2321,16 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
     | Just (i,j) <- indexLiterals args
     -> reduce (boolToBoolLiteral tcm ty (i <= j))
 
+-- Enum
+  "Clash.Sized.Internal.Index.toEnum#"
+    | [i] <- intLiterals' args
+    , Just (nTy, mb) <- extractKnownNat tcm tys
+    -> reduce (mkIndexLit ty nTy mb i)
+
+  "Clash.Sized.Internal.Index.fromEnum#"
+    | [i] <- indexLiterals' args
+    -> reduce (integerToIntLiteral i)
+
 -- Bounded
   "Clash.Sized.Internal.Index.maxBound#"
     | Just (nTy,mb) <- extractKnownNat tcm tys
@@ -2409,6 +2437,16 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
   "Clash.Sized.Internal.Signed.le#" | Just (i,j) <- signedLiterals args
     -> reduce (boolToBoolLiteral tcm ty (i <= j))
 
+-- Enum
+  "Clash.Sized.Internal.Signed.toEnum#"
+    | [i] <- intLiterals' args
+    , Just (litTy, mb) <- extractKnownNat tcm tys
+    -> reduce (mkSignedLit ty litTy mb i)
+
+  "Clash.Sized.Internal.Signed.fromEnum#"
+    | [i] <- signedLiterals' args
+    -> reduce (integerToIntLiteral i)
+
 -- Bounded
   "Clash.Sized.Internal.Signed.minBound#"
     | Just (litTy,mb) <- extractKnownNat tcm tys
@@ -2616,6 +2654,16 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
   "Clash.Sized.Internal.Unsigned.le#" | Just (i,j) <- unsignedLiterals args
     -> reduce (boolToBoolLiteral tcm ty (i <= j))
 
+-- Enum
+  "Clash.Sized.Internal.Unsigned.toEnum#"
+    | [i] <- intLiterals' args
+    , Just (litTy, mb) <- extractKnownNat tcm tys
+    -> reduce (mkUnsignedLit ty litTy mb i)
+
+  "Clash.Sized.Internal.Unsigned.fromEnum#"
+    | [i] <- unsignedLiterals' args
+    -> reduce (integerToIntLiteral i)
+
 -- Bounded
   "Clash.Sized.Internal.Unsigned.minBound#"
     | Just (nTy,len) <- extractKnownNat tcm tys
@@ -4403,6 +4451,32 @@ liftBitVector2Bool  f ty tcm args _p
     in Just $ boolToBoolLiteral tcm ty val
   | otherwise = Nothing
 
+liftInteger2BitVector
+  :: KnownNat n
+  => (Integer -> BitVector n)
+  -> (Type, Type, Integer)
+  -> [Value]
+  -> (Proxy n -> Maybe Term)
+liftInteger2BitVector f resTyInfo args _p
+  | [i] <- intLiterals' args
+  = let BV msk val = f i
+     in Just (mkBitVectorLit' resTyInfo (toInteger msk) (toInteger val))
+
+  | otherwise
+  = Nothing
+
+liftBitVector2Int
+  :: KnownNat n
+  => (BitVector n -> Integer)
+  -> [Value]
+  -> (Proxy n -> Maybe Term)
+liftBitVector2Int f args _p
+  | [i] <- bitVectorLiterals' args
+  = let val = f (toBV i)
+     in Just $ integerToIntLiteral val
+  | otherwise
+  = Nothing
+
 liftSized2 :: (KnownNat n, Integral (sized n))
            => ([Value] -> [Integer])
               -- ^ literal argument extraction function

clash-ghc/src-ghc/Clash/GHC/NetlistTypes.hs

@@ -1,8 +1,9 @@
 {-|
   Copyright   :  (C) 2013-2016, University of Twente,
-                     2016-2017, Myrtle Software Ltd
+                     2016-2017, Myrtle Software Ltd,
+                     2021-2022, QBayLogic B.V.
   License     :  BSD2 (see the file LICENSE)
-  Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>
+  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
 -}
 
 {-# LANGUAGE CPP #-}
@@ -232,6 +233,12 @@ ghcTypeToHWType iw = go
           let filtered = [replicate sz1 (isVoid, fElHWTy)]
           return (FilteredHWType vecHWTy filtered)
 
+        "Clash.Explicit.BlockRam.Internal.MemBlob" -> do
+          let [nTy, mTy] = args
+          n0 <- liftE (tyNatSize m nTy)
+          m0 <- liftE (tyNatSize m mTy)
+          returnN (MemBlob (fromInteger n0) (fromInteger m0))
+
         "Clash.Sized.RTree.RTree" -> do
           let [szTy,elTy] = args
           sz0     <- liftE (tyNatSize m szTy)
@@ -252,6 +259,7 @@ ghcTypeToHWType iw = go
           return (FilteredHWType vecHWTy filtered)
 
         "String" -> returnN String
+        "GHC.Prim.Addr#" -> returnN String
         "GHC.Types.[]" -> case tyView (head args) of
           (TyConApp (nameOcc -> "GHC.Types.Char") []) -> returnN String
           _ -> throwE $ "Can't translate type: " ++ showPpr ty