clash-lib 1.4.2 → 1.4.3

raw patch · 15 files changed

+224/−74 lines, 15 filesdep ~clash-preludePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: clash-prelude

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• clash-lib.cabal +2/−2
• prims/commonverilog/GHC_Num_Natural.primitives +8/−1
• prims/vhdl/Clash_Sized_Internal_BitVector.primitives +28/−8
• prims/vhdl/Clash_Sized_Internal_Signed.primitives +28/−8
• prims/vhdl/Clash_Sized_Internal_Unsigned.primitives +28/−8
• prims/vhdl/GHC_Integer_Type.primitives +14/−4
• prims/vhdl/GHC_Num_Integer.primitives +16/−6
• prims/vhdl/GHC_Num_Natural.primitives +20/−3
• prims/vhdl/GHC_Prim.primitives +28/−8
• src/Clash/Normalize/PrimitiveReductions.hs +1/−1
• src/Clash/Normalize/Transformations.hs +16/−9
• src/Clash/Primitives/Sized/Vector.hs +17/−10
• src/Clash/Primitives/Util.hs +11/−5
• src/Clash/Rewrite/Util.hs +1/−1

@@ -1,5 +1,11 @@ # Changelog for the Clash project +## 1.4.3 *Aug 8th 2021*+Fixed:++ * Clash no longer generates calls to `{shift,rotate}_{left,right}` in VHDL where the count is a negative number [#1810](https://github.com/clash-lang/clash-compiler/issues/1810).+ * Clash no longer incurs unnecessary compile-time complexity while compiling Vector indexing operator [#1557](https://github.com/clash-lang/clash-compiler/issues/1557)+ ## 1.4.2 *May 18th 2021* Fixed: 

@@ -1,6 +1,6 @@ Cabal-version:        2.2 Name:                 clash-lib-Version:              1.4.2+Version:              1.4.3 Synopsis:             Clash: a functional hardware description language - As a library Description:   Clash is a functional hardware description language that borrows both its@@ -144,7 +144,7 @@                       base16-bytestring       >= 0.1.1    && < 1.1,                       binary                  >= 0.8.5    && < 0.11,                       bytestring              >= 0.10.0.2 && < 0.12,-                      clash-prelude           == 1.4.2,+                      clash-prelude           == 1.4.3,                       concurrent-supply       >= 0.1.7    && < 0.2,                       containers              >= 0.5.0.0  && < 0.7,                       cryptohash-sha256       >= 0.11     && < 0.12,

@@ -92,8 +92,15 @@ , { "BlackBox" :   { "name"      : "GHC.Num.Natural.naturalShiftL#"   , "kind"      : "Expression"-  , "type"      : "naturalShiftL :: Natural -> Word# -> Natural"+  , "type"      : "naturalShiftL# :: Natural -> Word# -> Natural"   , "template"  : "~ARG[0] <<< ~ARG[1]"+  }+}+, { "BlackBox" :+  { "name"      : "GHC.Num.Natural.naturalShiftR#"+  , "kind"      : "Expression"+  , "type"      : "naturalShiftR# :: Natuarl -> Word# -> Natural"+  , "template"  : "~ARG[0] >>> ~ARG[1]"   } } , { "BlackBox" :

@@ -528,30 +528,50 @@   } , { "BlackBox" :     { "name"      : "Clash.Sized.Internal.BitVector.shiftL#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "shiftL# :: KnownNat n => BitVector n -> Int -> BitVector n"-    , "template"  : "std_logic_vector(shift_left(unsigned(~ARG[1]),to_integer(~ARG[2])))"+    , "template"  :+"~RESULT <= std_logic_vector(shift_left(unsigned(~ARG[1]), to_integer(~ARG[2])))+    -- pragma translate_off+    when (~ARG[2] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :     { "name"      : "Clash.Sized.Internal.BitVector.shiftR#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "shiftR# :: KnownNat n => BitVector n -> Int -> BitVector n"-    , "template"  : "std_logic_vector(shift_right(unsigned(~ARG[1]),to_integer(~ARG[2])))"+    , "template"  :+"~RESULT <= std_logic_vector(shift_right(unsigned(~ARG[1]),to_integer(~ARG[2])))+    -- pragma translate_off+    when (~ARG[2] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :     { "name"      : "Clash.Sized.Internal.BitVector.rotateL#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "rotateL# :: KnownNat n => BitVector n -> Int -> BitVector n"-    , "template"  : "std_logic_vector(rotate_left(unsigned(~ARG[1]),to_integer(~ARG[2])))"+    , "template"  :+"~RESULT <= std_logic_vector(rotate_left(unsigned(~ARG[1]),to_integer(~ARG[2])))+    -- pragma translate_off+    when (~ARG[2] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :     { "name"      : "Clash.Sized.Internal.BitVector.rotateR#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "rotateR# :: KnownNat n => BitVector n -> Int -> BitVector n"-    , "template"  : "std_logic_vector(rotate_right(unsigned(~ARG[1]),to_integer(~ARG[2])))"+    , "template"  :+"~RESULT <= std_logic_vector(rotate_right(unsigned(~ARG[1]),to_integer(~ARG[2])))+    -- pragma translate_off+    when (~ARG[2] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :

@@ -205,30 +205,50 @@   } , { "BlackBox" :     { "name"      : "Clash.Sized.Internal.Signed.shiftL#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "shiftL# :: KnownNat n => Signed n -> Int -> Signed n"-    , "template"  : "shift_left(~ARG[1],to_integer(~ARG[2]))"+    , "template"  :+"~RESULT <= shift_left(~ARG[1],to_integer(~ARG[2]))+    -- pragma translate_off+    when (~ARG[2] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :     { "name"      : "Clash.Sized.Internal.Signed.shiftR#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "shiftR# :: KnownNat n => Signed n -> Int -> Signed n"-    , "template"  : "shift_right(~ARG[1],to_integer(~ARG[2]))"+    , "template"  :+"~RESULT <= shift_right(~ARG[1],to_integer(~ARG[2]))+    -- pragma translate_off+    when (~ARG[2] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :     { "name"      : "Clash.Sized.Internal.Signed.rotateL#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "rotateL# :: KnownNat n => Signed n -> Int -> Signed n"-    , "template"  : "rotate_left(~ARG[1],to_integer(~ARG[2]))"+    , "template"  :+"~RESULT <= rotate_left(~ARG[1],to_integer(~ARG[2]))+    -- pragma translate_off+    when (~ARG[2] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :     { "name"      : "Clash.Sized.Internal.Signed.rotateR#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "rotateR# :: KnownNat n => Signed n -> Int -> Signed n"-    , "template"  : "rotate_right(~ARG[1],to_integer(~ARG[2]))"+    , "template"  :+"~RESULT <= rotate_right(~ARG[1],to_integer(~ARG[2]))+    -- pragma translate_off+    when (~ARG[2] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :

@@ -166,30 +166,50 @@   } , { "BlackBox" :     { "name"      : "Clash.Sized.Internal.Unsigned.shiftL#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "shiftL# :: KnownNat n => Unsigned n -> Int -> Unsigned n"-    , "template"  : "shift_left(~ARG[1],to_integer(~ARG[2]))"+    , "template"  :+"~RESULT <= shift_left(~ARG[1],to_integer(~ARG[2]))+    -- pragma translate_off+    when (~ARG[2] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :     { "name"      : "Clash.Sized.Internal.Unsigned.shiftR#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "shiftR# :: KnownNat n => Unsigned n -> Int -> Unsigned n"-    , "template"  : "shift_right(~ARG[1],to_integer(~ARG[2]))"+    , "template"  :+"~RESULT <= shift_right(~ARG[1],to_integer(~ARG[2]))+    -- pragma translate_off+    when (~ARG[2] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :     { "name"      : "Clash.Sized.Internal.Unsigned.rotateL#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "rotateL# :: KnownNat n => Unsigned n -> Int -> Unsigned n"-    , "template"  : "rotate_left(~ARG[1],to_integer(~ARG[2]))"+    , "template"  :+"~RESULT <= rotate_left(~ARG[1],to_integer(~ARG[2]))+    -- pragma translate_off+    when (~ARG[2] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :     { "name"      : "Clash.Sized.Internal.Unsigned.rotateR#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "rotateR# :: KnownNat n => Unsigned n -> Int -> Unsigned n"-    , "template"  : "rotate_right(~ARG[1],to_integer(~ARG[2]))"+    , "template"  :+"~RESULT <= rotate_right(~ARG[1],to_integer(~ARG[2]))+    -- pragma translate_off+    when (~ARG[2] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :

@@ -162,16 +162,26 @@   } , { "BlackBox" :     { "name"      : "GHC.Integer.Type.shiftRInteger"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "shiftRInteger :: Integer -> Int# -> Integer"-    , "template"  : "shift_right(~ARG[0],to_integer(~ARG[1]))"+    , "template"  :+"~RESULT <= shift_right(~ARG[0], to_integer(~ARG[1]))+    -- pragma translate_off+    when (~ARG[1] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :     { "name"      : "GHC.Integer.Type.shiftLInteger"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "shiftLInteger :: Integer -> Int# -> Integer"-    , "template"  : "shift_left(~ARG[0],to_integer(~ARG[1]))"+    , "template"  :+"~RESULT <= shift_left(~ARG[0], to_integer(~ARG[1]))+    -- pragma translate_off+    when (~ARG[1] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :

@@ -189,16 +189,26 @@   } , { "BlackBox" :     { "name"      : "GHC.Num.Integer.integerShiftR#"-    , "kind"      : "Expression"-    , "type"      : "integerShiftR :: Integer -> Word# -> Integer"-    , "template"  : "shift_right(~ARG[0],to_integer(~ARG[1]))"+    , "kind"      : "Declaration"+    , "type"      : "integerShiftR# :: Integer -> Word# -> Integer"+    , "template"  :+"~RESULT <= shift_right(~ARG[0], to_integer(~VAR[count][1](30 downto 0)))+    -- pragma translate_off+    when (~ARG[1] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :     { "name"      : "GHC.Num.Integer.integerShiftL#"-    , "kind"      : "Expression"-    , "type"      : "integerShiftR :: Integer -> Word# -> Integer"-    , "template"  : "shift_left(~ARG[0],to_integer(~ARG[1]))"+    , "kind"      : "Declaration"+    , "type"      : "integerShiftL# :: Integer -> Word# -> Integer"+    , "template"  :+"~RESULT <= shift_left(~ARG[0], to_integer(~VAR[count][1](30 downto 0)))+    -- pragma translate_off+    when (~ARG[1] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :

@@ -77,9 +77,26 @@ } , { "BlackBox" :   { "name"      : "GHC.Num.Natural.naturalShiftL#"-  , "kind"      : "Expression"-  , "type"      : "naturalShiftL :: Natural -> Word# -> Natural"-  , "template"  : "shift_left(~ARG[0],to_integer(~ARG[1]))"+  , "kind"      : "Declaration"+  , "type"      : "naturalShiftL# :: Natural -> Word# -> Natural"+  , "template"  :+"~RESULT <= shift_left(~ARG[0],to_integer(~VAR[count][1](30 downto 0)))+    -- pragma translate_off+    when (~ARG[1] >= to_unsigned(0, ~SIZE[~TYP[1]]-1)) else (others => 'X')+    -- pragma translate_on+    ;"+  }+}+, { "BlackBox" :+  { "name"      : "GHC.Num.Natural.naturalShiftR#"+  , "kind"      : "Declaration"+  , "type"      : "naturalShiftR# :: Natural -> Word# -> Natural"+  , "template"  :+"~RESULT <= shift_right(~ARG[0], to_integer(~VAR[count][1](30 downto 0)))+    -- pragma translate_off+    when (~ARG[1] >= to_unsigned(0, ~SIZE[~TYP[1]]-1)) else (others => 'X')+    -- pragma translate_on+    ;"   } } , { "BlackBox" :

@@ -163,16 +163,26 @@   } , { "BlackBox" :     { "name"      : "GHC.Prim.uncheckedIShiftL#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "uncheckedIShiftL# :: Int# -> Int# -> Int#"-    , "template"  : "shift_left(~ARG[0],to_integer(~ARG[1]))"+    , "template"  :+"~RESULT <= shift_left(~ARG[0],to_integer(~ARG[1]))+    -- pragma translate_off+    when (~ARG[1] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :     { "name"      : "GHC.Prim.uncheckedIShiftRA#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "uncheckedIShiftRA# :: Int# -> Int# -> Int#"-    , "template"  : "shift_right(~ARG[0],to_integer(~ARG[1]))"+    , "template"  :+"~RESULT <= shift_right(~ARG[0],to_integer(~ARG[1]))+    -- pragma translate_off+    when (~ARG[1] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :@@ -233,16 +243,26 @@   } , { "BlackBox" :     { "name"      : "GHC.Prim.uncheckedShiftL#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "uncheckedShiftL# :: Word# -> Int# -> Word#"-    , "template"  : "shift_left(~ARG[0],to_integer(~ARG[1]))"+    , "template"  :+"~RESULT <= shift_left(~ARG[0],to_integer(~ARG[1]))+    -- pragma translate_off+    when (~ARG[1] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :     { "name"      : "GHC.Prim.uncheckedShiftRL#"-    , "kind"      : "Expression"+    , "kind"      : "Declaration"     , "type"      : "uncheckedShiftR# :: Word# -> Int# -> Word#"-    , "template"  : "shift_right(~ARG[0],to_integer(~ARG[1]))"+    , "template"  :+"~RESULT <= shift_right(~ARG[0],to_integer(~ARG[1]))+    -- pragma translate_off+    when (~ARG[1] >= 0) else (others => 'X')+    -- pragma translate_on+    ;"     }   } , { "BlackBox" :

@@ -482,7 +482,7 @@   --   in   --     (a :> el1 :> el2 :> el3 :> ..)   ---  pure (Letrec (zip elementIds elems) vec)+  changed (Letrec (zip elementIds elems) vec)  -- | Replace an application of the @Clash.Sized.Vector.traverse#@ primitive on -- vectors of a known length @n@, by the fully unrolled recursive "definition"

@@ -1257,11 +1257,13 @@          else do            -- Parts of e2 are constant            let is1 = extendInScopeSetList is0 (fst <$> csrNewBindings specInfo)-           Letrec newBindings-            <$> specializeNorm-                  (TransformContext is1 tfCtx)-                  (App e1 (csrNewTerm specInfo))+           (body, isSpec) <- listen $ specializeNorm+             (TransformContext is1 tfCtx)+             (App e1 (csrNewTerm specInfo)) +           if Monoid.getAny isSpec+             then changed (Letrec newBindings body)+             else return e        else         -- e2 has no constant parts         return e@@ -2041,9 +2043,10 @@ -- On the two examples that were tested, Reducer and PipelinesViaFolds, this new -- version of CSE removed the same amount of let-binders. simpleCSE :: HasCallStack => NormRewrite-simpleCSE (TransformContext is0 _) (inverseTopSortLetBindings -> Letrec bndrs body) = do+simpleCSE (TransformContext is0 _) term@Letrec{} = do+  let Letrec bndrs body = inverseTopSortLetBindings term   let is1 = extendInScopeSetList is0 (map fst bndrs)-  (subst,bndrs1) <- reduceBinders (mkSubst is1) [] bndrs+  ((subst,bndrs1), change) <- listen $ reduceBinders (mkSubst is1) [] bndrs   -- TODO: check whether a substitution over the body is enough, the reason I'm   -- doing a substitution over the the binders as well is that I don't know in   -- what order a recursive group shows up in a inverse topological sort.@@ -2053,9 +2056,13 @@   -- NB: don't apply the substitution to the entire let-expression, and that   -- would rename the let-bindings because they've been added to the InScopeSet   -- of the substitution.-  let bndrs2 = map (second (substTm "simpleCSE.bndrs" subst)) bndrs1-      body1  = substTm "simpleCSE.body" subst body-  return (Letrec bndrs2 body1)+  if Monoid.getAny change+    then+      let bndrs2 = map (second (substTm "simpleCSE.bndrs" subst)) bndrs1+          body1  = substTm "simpleCSE.body" subst body+       in changed (Letrec bndrs2 body1)+    else+      return term  simpleCSE _ e = return e {-# SCC simpleCSE #-}

@@ -31,6 +31,7 @@  import           Clash.Backend   (Backend, hdlTypeErrValue, expr, blockDecl)+import           Clash.Core.TermInfo                (isVar) import           Clash.Core.Type   (Type(LitTy), LitTy(NumTy), coreView) import           Clash.Netlist.BlackBox             (isLiteral)@@ -240,21 +241,21 @@   error $ "Unexpected number of arguments: " ++ show (length (bbInputs args))  indexIntVerilog ::  BlackBoxFunction-indexIntVerilog _isD _primName args _ty = return ((meta,) <$> bb)+indexIntVerilog _isD _primName args _ty = return bb  where-  meta = emptyBlackBoxMeta{bbKind=bbKi}--  bbKi = case args of-    [_nTy,_aTy,_kn,_v,Left ix]-      | isLiteral ix -> TExpr-    _ -> TDecl+  meta bbKi = emptyBlackBoxMeta{bbKind=bbKi}    bb = case args of+    [_nTy,_aTy,_kn,Left v,Left ix] | isLiteral ix && isVar v ->+      Right (meta TExpr, BBFunction "Clash.Primitives.Sized.Vector.indexIntVerilogTF" 0 indexIntVerilogTF)     [_nTy,_aTy,_kn,_v,Left ix] | isLiteral ix ->-      Right (BBFunction "Clash.Primitives.Sized.Vector" 0 indexIntVerilogTF)+      case runParse (pack (I.unindent bbTextLitIx)) of+        Success t -> Right (meta TDecl, BBTemplate t)+        _         -> Left "internal error: parse fail"+     _ ->-      BBTemplate <$> case runParse (pack (I.unindent bbText)) of-        Success t -> Right t+      case runParse (pack (I.unindent bbText)) of+        Success t -> Right (meta TDecl, BBTemplate t)         _         -> Left "internal error: parse fail"    bbText = [I.i|@@ -268,6 +269,12 @@     ~ENDGENERATE     assign ~RESULT = ~SYM[0][~ARG[2]];~ELSEassign ~RESULT = ~ERRORO;~FI     // index end|]++  bbTextLitIx = [I.i|+    // index lit begin+    ~IF~SIZE[~TYP[1]]~THENassign ~RESULT = ~VAR[vec][1][~SIZE[~TYP[1]]-1-~LIT[2]*~SIZE[~TYPO] -: ~SIZE[~TYPO]];~ELSEassign ~RESULT = ~ERRORO;~FI+    // index lit end|]+  indexIntVerilogTF :: TemplateFunction indexIntVerilogTF = TemplateFunction used valid indexIntVerilogTemplate

@@ -2,8 +2,9 @@   Copyright  :  (C) 2012-2016, University of Twente,                     2017     , Myrtle Software Ltd                     2018     , Google Inc.+                    2021     , QBayLogic B.V.   License    :  BSD2 (see the file LICENSE)-  Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>+  Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>    Utility functions to generate Primitives -}@@ -195,7 +196,7 @@   getConstant _            = Nothing    -- Ensure that if the 'Integer' arguments are constants, that they are reduced-  -- to literals, so that the buildin rules can properly fire.+  -- to literals, so that the builtin rules can properly fire.   --   -- Only in the the case that 'Integer' arguments are truly variables should   -- the blackbox rules fire.@@ -205,8 +206,13 @@     | nm == "Clash.Sized.Internal.Index.fromInteger#"      = [1]     | nm == "Clash.Sized.Internal.Signed.fromInteger#"     = [1]     | nm == "Clash.Sized.Internal.Unsigned.fromInteger#"   = [1]++    | nm == "Clash.Sized.Vector.replace_int"               = [1,2]+    | otherwise = []+constantArgs nm (BlackBoxHaskell{}) = Set.fromList fromIntForce+ where     -- There is a special code-path for `index_int` in the Verilog backend in-    -- case the index is a variable. But this code path only works when the+    -- case the index is a constant. But this code path only works when the     -- vector is (a projection of) a variable. By forcing the arguments of     -- index_int we can be sure that arguments are either:     --@@ -216,8 +222,8 @@     --     -- As all other cases would be reduced by the evaluator, and even expensive     -- primitives under index_int are fully unrolled.-    | nm == "Clash.Sized.Vector.index_int"                 = [1,2]-    | nm == "Clash.Sized.Vector.replace_int"               = [1,2]+  fromIntForce+    | nm == "Clash.Sized.Vector.index_int"                 = [2]     | otherwise = [] constantArgs _ _ = Set.empty 

@@ -269,7 +269,7 @@                      ]             ) (return ()) -  Monad.when (lvl >= DebugApplied && not hasChanged && not (exprOld `aeqTerm` exprNew)) $+  Monad.when (lvl >= DebugSilent && not hasChanged && not (exprOld `aeqTerm` exprNew)) $     error $ $(curLoc) ++ "Expression changed without notice(" ++ name ++  "): before"                       ++ before ++ "\nafter:\n" ++ after