clash-vhdl 0.7 → 0.7.1
raw patch · 9 files changed
+93/−47 lines, 9 files
Files
- CHANGELOG.md +4/−0
- clash-vhdl.cabal +3/−1
- primitives/CLaSH.Prelude.BlockRam.json +20/−21
- primitives/CLaSH.Sized.RTree.json +3/−2
- primitives/CLaSH.XException.json +7/−0
- primitives/GHC.IO.Exception.json +12/−0
- primitives/GHC.Integer.Type.json +13/−1
- primitives/GHC.Types.json +0/−5
- src/CLaSH/Backend/VHDL.hs +31/−17
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Changelog for the [`clash-vhdl`](http://hackage.haskell.org/package/clash-vhdl) package +## 0.7.1 *April 11th 2017*+* Fixes bugs:+ * resize `Integer` multiplication result+ ## 0.7 *January 16th 2017* * New features: * Support `clash-prelude` 0.11
clash-vhdl.cabal view
@@ -1,5 +1,5 @@ Name: clash-vhdl-Version: 0.7+Version: 0.7.1 Synopsis: CAES Language for Synchronous Hardware - VHDL backend Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -63,12 +63,14 @@ primitives/CLaSH.Sized.RTree.json primitives/CLaSH.Sized.Vector.json primitives/CLaSH.Transformations.json+ primitives/CLaSH.XException.json primitives/Control.Exception.Base.json primitives/Debug.Trace.json primitives/GHC.Base.json primitives/GHC.Classes.json primitives/GHC.CString.json primitives/GHC.Err.json+ primitives/GHC.IO.Exception.json primitives/GHC.Int.json primitives/GHC.Integer.Logarithms.json primitives/GHC.Integer.Type.json
primitives/CLaSH.Prelude.BlockRam.json view
@@ -1,41 +1,40 @@ [ { "BlackBox" : { "name" : "CLaSH.Prelude.BlockRam.blockRam#" , "type" :-"blockRam# :: KnownNat n -- ARG[0]- => SClock clk -- clk, ARG[1]- -> Vec n a -- init, ARG[2]- -> Signal' clk Int -- rd, ARG[3]- -> Signal' clk Bool -- wren, ARG[4]- -> Signal' clk Int -- wr, ARG[5]- -> Signal' clk a -- din, ARG[6]+"blockRam# :: SClock clk -- clk, ARG[0]+ -> Vec n a -- init, ARG[1]+ -> Signal' clk Int -- rd, ARG[2]+ -> Signal' clk Bool -- wren, ARG[3]+ -> Signal' clk Int -- wr, ARG[4]+ -> Signal' clk a -- din, ARG[5] -> Signal' clk a" , "templateD" : "-- blockRam begin ~GENSYM[~COMPNAME_blockRam][0] : block- signal ~GENSYM[RAM][1] : ~TYP[2] := ~LIT[2];~IF ~VIVADO ~THEN- signal ~GENSYM[dout][2] : std_logic_vector(~SIZE[~TYP[6]]-1 downto 0);~ELSE- signal ~SYM[2] : ~TYP[6];~FI- signal ~GENSYM[rd][3] : integer range 0 to ~LIT[0] - 1;- signal ~GENSYM[wr][4] : integer range 0 to ~LIT[0] - 1;+ signal ~GENSYM[RAM][1] : ~TYP[1] := ~LIT[1];~IF ~VIVADO ~THEN+ signal ~GENSYM[dout][2] : std_logic_vector(~SIZE[~TYP[5]]-1 downto 0);~ELSE+ signal ~SYM[2] : ~TYP[5];~FI+ signal ~GENSYM[rd][3] : integer range 0 to ~LENGTH[~TYP[1]] - 1;+ signal ~GENSYM[wr][4] : integer range 0 to ~LENGTH[~TYP[1]] - 1; begin- ~SYM[3] <= to_integer(~ARG[3])+ ~SYM[3] <= to_integer(~ARG[2]) -- pragma translate_off- mod ~LIT[0]+ mod ~LENGTH[~TYP[1]] -- pragma translate_on ; - ~SYM[4] <= to_integer(~ARG[5])+ ~SYM[4] <= to_integer(~ARG[4]) -- pragma translate_off- mod ~LIT[0]+ mod ~LENGTH[~TYP[1]] -- pragma translate_on ; - ~GENSYM[blockRam_sync][5] : process(~CLK[1])+ ~GENSYM[blockRam_sync][5] : process(~CLK[0]) begin- if rising_edge(~CLK[1]) then- if ~ARG[4] then~IF ~VIVADO ~THEN- ~SYM[1](~SYM[4]) <= ~TOBV[~ARG[6]][~TYP[6]];~ELSE- ~SYM[1](~SYM[4]) <= ~ARG[6];~FI+ if rising_edge(~CLK[0]) then+ if ~ARG[3] then~IF ~VIVADO ~THEN+ ~SYM[1](~SYM[4]) <= ~TOBV[~ARG[5]][~TYP[5]];~ELSE+ ~SYM[1](~SYM[4]) <= ~ARG[5];~FI end if; ~SYM[2] <= ~SYM[1](~SYM[3]); end if;
primitives/CLaSH.Sized.RTree.json view
@@ -12,8 +12,9 @@ textract_~SYM[0] : block signal ~SYM[1] : ~TYP[0]; begin- ~SYM[1] <= ~ARG[0];- ~RESULT <= ~SYM[1](0);+ ~SYM[1] <= ~ARG[0];~IF ~VIVADO ~THEN+ ~RESULT <= ~FROMBV[~SYM[1](0)][~TYPO];~ELSE+ ~RESULT <= ~SYM[1](0);~FI end block; -- textract end" }
+ primitives/CLaSH.XException.json view
@@ -0,0 +1,7 @@+[ { "BlackBox" :+ { "name" : "CLaSH.XException.seqX"+ , "type" : "seqX :: a -> b -> b"+ , "templateE" : "~ARG[1]"+ }+ }+]
+ primitives/GHC.IO.Exception.json view
@@ -0,0 +1,12 @@+[ { "BlackBox" :+ { "name" : "GHC.IO.Exception.assertError"+ , "type" : "assertError :: HasCallStack => Bool -> a -> a"+ , "comment" : "It would be nice if we could use a HDL assertion, however,+ because in HDL, case alternatives are evaluated+ concurrently, we would end up with the assertion being+ triggered, even when the result of that branch is not+ chosen in the multiplexer"+ , "templateE" : "~ARG[2]"+ }+ }+]
primitives/GHC.Integer.Type.json view
@@ -25,7 +25,7 @@ , { "BlackBox" : { "name" : "GHC.Integer.Type.timesInteger" , "type" : "timesInteger :: Integer -> Integer -> Integer"- , "templateE" : "~ARG[0] * ~ARG[1]"+ , "templateE" : "resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])" } } , { "BlackBox" :@@ -155,6 +155,18 @@ { "name" : "GHC.Integer.Type.shiftLInteger" , "type" : "shiftLInteger :: Integer -> Int# -> Integer" , "templateE" : "shift_left(~ARG[0],to_integer(~ARG[1]))"+ }+ }+, { "BlackBox" :+ { "name" : "GHC.Integer.Type.wordToInteger"+ , "type" : "wordToInteger :: Word# -> Integer"+ , "templateE" : "signed(std_logic_vector(~ARG[0]))"+ }+ }+, { "BlackBox" :+ { "name" : "GHC.Integer.Type.integerToWord"+ , "type" : "integerToWord :: Integer -> Word#"+ , "templateE" : "unsigned(std_logic_vector(~ARG[0]))" } } ]
primitives/GHC.Types.json view
@@ -1,9 +1,4 @@ [ { "Primitive" :- { "name" : "GHC.Types.Eq#"- , "primType" : "Constructor"- }- }-, { "Primitive" : { "name" : "GHC.Types.MkCoercible" , "primType" : "Constructor" }
src/CLaSH/Backend/VHDL.hs view
@@ -33,6 +33,7 @@ import Text.Printf import Text.PrettyPrint.Leijen.Text.Monadic +import CLaSH.Annotations.Primitive (HDL (..)) import CLaSH.Backend import CLaSH.Driver.Types (SrcSpan, noSrcSpan) import CLaSH.Netlist.BlackBox.Types (HdlSyn (..))@@ -67,6 +68,7 @@ instance Backend VHDLState where initBackend = VHDLState HashSet.empty [] HashMap.empty "" noSrcSpan [] [] []+ hdlKind = const VHDL #ifdef CABAL primDir = const (Paths_clash_vhdl.getDataFileName "primitives") #else@@ -647,7 +649,13 @@ _ -> text id_ <> parens (int 0) expr_ _ (Identifier id_ (Just (Indexed ((Vector n _),1,2)))) = text id_ <> parens (int 1 <+> "to" <+> int (n-1)) -expr_ _ (Identifier id_ (Just (Indexed ((RTree 0 _),0,1)))) = text id_ <> parens (int 0)+expr_ _ (Identifier id_ (Just (Indexed ((RTree 0 elTy),0,1)))) = do+ syn <- hdlSyn+ case syn of+ Vivado -> do+ id' <- fmap (displayT . renderOneLine) (text id_ <> parens (int 0))+ fromSLV elTy id' (typeSize elTy - 1) 0+ _ -> text id_ <> parens (int 0) expr_ _ (Identifier id_ (Just (Indexed ((RTree n _),1,1)))) = let z = 2^(n-1) in text id_ <> parens (int 0 <+> "to" <+> int (z-1))@@ -670,7 +678,13 @@ -- This is a HACK for CLaSH.Driver.TopWrapper.mkOutput -- RTree's don't have a 10'th constructor, this is just so that we can -- recognize the particular case-expr_ _ (Identifier id_ (Just (Indexed ((RTree _ _),10,fI)))) = text id_ <> parens (int fI)+expr_ _ (Identifier id_ (Just (Indexed ((RTree _ elTy),10,fI)))) = do+ syn <- hdlSyn+ case syn of+ Vivado -> do+ id' <- fmap (displayT . renderOneLine) (text id_ <> parens (int fI))+ fromSLV elTy id' (typeSize elTy - 1) 0+ _ -> text id_ <> parens (int fI) expr_ _ (Identifier id_ (Just (DC (ty@(SP _ _),_)))) = text id_ <> parens (int start <+> "downto" <+> int end) where@@ -710,17 +724,10 @@ case syn of Vivado -> vhdlTypeMark ty <> "'" <> parens (int 0 <+> rarrow <+> toSLV elTy e) _ -> vhdlTypeMark ty <> "'" <> parens (int 0 <+> rarrow <+> expr_ False e)-expr_ _ e@(DataCon ty@(RTree d elTy) _ [e1,e2]) = do- syn <- hdlSyn- case syn of- Vivado -> vhdlTypeMark ty <> "'" <> case rtreeChain e of- Just es -> tupled (mapM (toSLV elTy) es)- Nothing -> parens ("std_logic_vector'" <> parens (toSLV elTy e1) <+>- "&" <+> expr_ False e2)- _ -> vhdlTypeMark ty <> "'" <> case rtreeChain e of- Just es -> tupled (mapM (expr_ False) es)- Nothing -> parens (vhdlTypeMark (RTree (d-1) elTy) <> "'" <> parens (expr_ False e1) <+>- "&" <+> expr_ False e2)+expr_ _ e@(DataCon ty@(RTree d elTy) _ [e1,e2]) = vhdlTypeMark ty <> "'" <> case rtreeChain e of+ Just es -> tupled (mapM (expr_ False) es)+ Nothing -> parens (vhdlTypeMark (RTree (d-1) elTy) <> "'" <> parens (expr_ False e1) <+>+ "&" <+> expr_ False e2) expr_ _ (DataCon ty@(SP _ args) (DC (_,i)) es) = assignExpr where@@ -859,16 +866,23 @@ exprLit (Just (hty,sz)) (NumLit i) = case hty of Unsigned n | i < 2^(31 :: Integer) -> "to_unsigned" <> parens (integer i <> "," <> int n)- | otherwise -> "unsigned'" <> parens (if sz `mod` 4 == 0 then hlit else blit)+ | otherwise -> "unsigned'" <> parens lit Signed n | i < 2^(31 :: Integer) && i > (-2^(31 :: Integer)) -> "to_signed" <> parens (integer i <> "," <> int n)- | otherwise -> "signed'" <> parens (if sz `mod` 4 == 0 then hlit else blit)- BitVector _ -> "std_logic_vector'" <> parens (if sz `mod` 4 == 0 then hlit else blit)+ | otherwise -> "signed'" <> parens lit+ BitVector _ -> "std_logic_vector'" <> parens lit _ -> blit where+ validHexLit = sz `mod` 4 == 0 && sz /= 0+ lit = if validHexLit then hlit else blit blit = bits (toBits sz i)- hlit = (if i < 0 then "-" else empty) <> hex (toHex sz i)+ i' = case hty of+ Signed _ -> let mask = 2^(sz-1) in case divMod i mask of+ (s,i'') | even s -> i''+ | otherwise -> i'' - mask+ _ -> i `mod` 2^sz+ hlit = (if i' < 0 then "-" else empty) <> hex (toHex sz i') exprLit _ (BoolLit t) = if t then "true" else "false" exprLit _ (BitLit b) = squotes $ bit_char b exprLit _ (StringLit s) = text . T.pack $ show s