diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,10 @@ # Changelog for the [`clash-vhdl`](http://hackage.haskell.org/package/clash-vhdl) package -## 0.6.16 +## 0.7 *January 16th 2017* +* New features: + * Support `clash-prelude` 0.11 + +## 0.6.16 *August 3rd 2016* * Fixes bugs: * Incorrect primitive for `Integer`s `ltInteger#` and `geInteger#` diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,5 @@ -Copyright (c) 2015, University of Twente +Copyright (c) 2015, University of Twente, + 2017, QBayLogic All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/clash-vhdl.cabal b/clash-vhdl.cabal --- a/clash-vhdl.cabal +++ b/clash-vhdl.cabal @@ -1,5 +1,5 @@ Name: clash-vhdl -Version: 0.6.16 +Version: 0.7 Synopsis: CAES Language for Synchronous Hardware - VHDL backend Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that @@ -9,9 +9,8 @@ . Features of CλaSH: . - * Strongly typed (like VHDL), yet with a very high degree of type inference, - enabling both safe and fast prototying using consise descriptions (like - Verilog). + * Strongly typed, but with a very high degree of type inference, enabling both + safe and fast prototyping using concise descriptions. . * Interactive REPL: load your designs in an interpreter and easily test all your component without needing to setup a test bench. @@ -34,14 +33,15 @@ License-file: LICENSE Author: Christiaan Baaij Maintainer: Christiaan Baaij -Copyright: Copyright © 2015-2016 University of Twente +Copyright: Copyright © 2015-2016, University of Twente, 2017, QBayLogic Category: Hardware Build-type: Simple Extra-source-files: README.md, CHANGELOG.md -Data-files: primitives/CLaSH.Driver.TestbenchGen.json +Data-files: primitives/CLaSH.Class.BitPack.json + primitives/CLaSH.Driver.TestbenchGen.json primitives/CLaSH.Driver.TopWrapper.json primitives/CLaSH.GHC.GHC2Core.json primitives/CLaSH.Prelude.BlockRam.json @@ -60,6 +60,7 @@ primitives/CLaSH.Sized.Internal.Index.json primitives/CLaSH.Sized.Internal.Signed.json primitives/CLaSH.Sized.Internal.Unsigned.json + primitives/CLaSH.Sized.RTree.json primitives/CLaSH.Sized.Vector.json primitives/CLaSH.Transformations.json primitives/Control.Exception.Base.json @@ -69,6 +70,7 @@ primitives/GHC.CString.json primitives/GHC.Err.json primitives/GHC.Int.json + primitives/GHC.Integer.Logarithms.json primitives/GHC.Integer.Type.json primitives/GHC.Prim.json primitives/GHC.Real.json @@ -98,10 +100,11 @@ ViewPatterns Build-depends: base >= 4.6.0.1 && < 5, - clash-lib >= 0.6.18 && < 0.7, - clash-prelude >= 0.10.1 && < 0.11, + clash-lib >= 0.7 && < 0.8, + clash-prelude >= 0.1 && < 0.12, fgl >= 5.4.2.4 && < 5.6, - lens >= 3.9.2 && < 4.15, + hashable >= 1.2.1.0 && < 1.3, + lens >= 3.9.2 && < 4.16, mtl >= 2.1.2 && < 2.3, text >= 0.11.3.1 && < 1.3, unordered-containers >= 0.2.3.3 && < 0.3, diff --git a/primitives/CLaSH.Class.BitPack.json b/primitives/CLaSH.Class.BitPack.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Class.BitPack.json @@ -0,0 +1,29 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Class.BitPack.packFloat#" + , "type" : +"packFloat# :: Float -> BitVector 32" + , "templateE" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Class.BitPack.unpackFloat#" + , "type" : +"packFloat# :: BitVector 32 -> Float" + , "templateE" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Class.BitPack.packDouble#" + , "type" : +"packFloat# :: Double -> BitVector 64" + , "templateE" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Class.BitPack.unpackDouble#" + , "type" : +"packFloat# :: BitVector 64 -> Double" + , "templateE" : "~ARG[0]" + } + } +] diff --git a/primitives/CLaSH.Prelude.BlockRam.File.json b/primitives/CLaSH.Prelude.BlockRam.File.json --- a/primitives/CLaSH.Prelude.BlockRam.File.json +++ b/primitives/CLaSH.Prelude.BlockRam.File.json @@ -5,9 +5,9 @@ => SClock clk -- clk, ARG[1] -> SNat n -- sz, ARG[2] -> FilePath -- file, ARG[3] - -> Signal' clk Int -- wr, ARG[4] - -> Signal' clk Int -- rd, ARG[5] - -> Signal' clk Bool -- wren, ARG[6] + -> Signal' clk Int -- rd, ARG[4] + -> Signal' clk Bool -- wren, ARG[5] + -> Signal' clk Int -- wr, ARG[6] -> Signal' clk (BitVector m) -- din, ARG[7] -> Signal' clk (BitVector m)" , "templateD" : @@ -29,8 +29,8 @@ signal ~GENSYM[RAM][2] : ~SYM[6](0 to ~LIT[2]-1) := ~SYM[1](~FILE[~LIT[3]]); signal ~GENSYM[dout][3] : ~TYP[7]; - signal ~GENSYM[wr][4] : integer range 0 to ~LIT[2]-1; - signal ~GENSYM[rd][5] : integer range 0 to ~LIT[2]-1; + signal ~GENSYM[rd][4] : integer range 0 to ~LIT[2]-1; + signal ~GENSYM[wr][5] : integer range 0 to ~LIT[2]-1; begin ~SYM[4] <= to_integer(~ARG[4]) -- pragma translate_off @@ -38,7 +38,7 @@ -- pragma translate_on ; - ~SYM[5] <= to_integer(~ARG[5]) + ~SYM[5] <= to_integer(~ARG[6]) -- pragma translate_off mod ~LIT[2] -- pragma translate_on @@ -47,10 +47,10 @@ ~GENSYM[blockRamFile_sync][7] : process(~CLK[1]) begin if (rising_edge(~CLK[1])) then - if ~ARG[6] then - ~SYM[2](~SYM[4]) <= to_bitvector(~ARG[7]); + if ~ARG[5] then + ~SYM[2](~SYM[5]) <= to_bitvector(~ARG[7]); end if; - ~SYM[3] <= to_stdlogicvector(~SYM[2](~SYM[5])); + ~SYM[3] <= to_stdlogicvector(~SYM[2](~SYM[4])); end if; end process; diff --git a/primitives/CLaSH.Prelude.BlockRam.json b/primitives/CLaSH.Prelude.BlockRam.json --- a/primitives/CLaSH.Prelude.BlockRam.json +++ b/primitives/CLaSH.Prelude.BlockRam.json @@ -4,9 +4,9 @@ "blockRam# :: KnownNat n -- ARG[0] => SClock clk -- clk, ARG[1] -> Vec n a -- init, ARG[2] - -> Signal' clk Int -- wr, ARG[3] - -> Signal' clk Int -- rd, ARG[4] - -> Signal' clk Bool -- wren, ARG[5] + -> Signal' clk Int -- rd, ARG[3] + -> Signal' clk Bool -- wren, ARG[4] + -> Signal' clk Int -- wr, ARG[5] -> Signal' clk a -- din, ARG[6] -> Signal' clk a" , "templateD" : @@ -15,8 +15,8 @@ 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[wr][3] : integer range 0 to ~LIT[0] - 1; - signal ~GENSYM[rd][4] : integer range 0 to ~LIT[0] - 1; + signal ~GENSYM[rd][3] : integer range 0 to ~LIT[0] - 1; + signal ~GENSYM[wr][4] : integer range 0 to ~LIT[0] - 1; begin ~SYM[3] <= to_integer(~ARG[3]) -- pragma translate_off @@ -24,7 +24,7 @@ -- pragma translate_on ; - ~SYM[4] <= to_integer(~ARG[4]) + ~SYM[4] <= to_integer(~ARG[5]) -- pragma translate_off mod ~LIT[0] -- pragma translate_on @@ -33,11 +33,11 @@ ~GENSYM[blockRam_sync][5] : process(~CLK[1]) begin if rising_edge(~CLK[1]) then - if ~ARG[5] then~IF ~VIVADO ~THEN - ~SYM[1](~SYM[3]) <= ~TOBV[~ARG[6]][~TYP[6]];~ELSE - ~SYM[1](~SYM[3]) <= ~ARG[6];~FI + if ~ARG[4] then~IF ~VIVADO ~THEN + ~SYM[1](~SYM[4]) <= ~TOBV[~ARG[6]][~TYP[6]];~ELSE + ~SYM[1](~SYM[4]) <= ~ARG[6];~FI end if; - ~SYM[2] <= ~SYM[1](~SYM[4]); + ~SYM[2] <= ~SYM[1](~SYM[3]); end if; end process;~IF ~VIVADO ~THEN ~RESULT <= ~FROMBV[~SYM[2]][~TYPO];~ELSE diff --git a/primitives/CLaSH.Prelude.RAM.json b/primitives/CLaSH.Prelude.RAM.json --- a/primitives/CLaSH.Prelude.RAM.json +++ b/primitives/CLaSH.Prelude.RAM.json @@ -4,9 +4,9 @@ "asyncRam# :: SClock wclk -- ^ wclk, ARG[0] -> SClock rclk -- ^ rclk, ARG[1] -> SNat n -- ^ sz, ARG[2] - -> Signal' wclk Int -- ^ wr, ARG[3] - -> Signal' rclk Int -- ^ rd, ARG[4] - -> Signal' wclk Bool -- ^ en, ARG[5] + -> Signal' rclk Int -- ^ rd, ARG[3] + -> Signal' wclk Bool -- ^ en, ARG[4] + -> Signal' wclk Int -- ^ wr, ARG[5] -> Signal' wclk a -- ^ din, ARG[6] -> Signal' rclk a" , "templateD" : @@ -15,8 +15,8 @@ type ~GENSYM[RamType][4] is array(natural range <>) of std_logic_vector(~SIZE[~TYP[6]]-1 downto 0);~ELSE type ~SYM[4] is array(natural range <>) of ~TYP[6];~FI signal ~GENSYM[RAM][1] : ~SYM[4](0 to ~LIT[2]-1); - signal ~GENSYM[wr][2] : integer range 0 to ~LIT[2] - 1; - signal ~GENSYM[rd][3] : integer range 0 to ~LIT[2] - 1; + signal ~GENSYM[rd][2] : integer range 0 to ~LIT[2] - 1; + signal ~GENSYM[wr][3] : integer range 0 to ~LIT[2] - 1; begin ~SYM[2] <= to_integer(~ARG[3]) -- pragma translate_off @@ -24,7 +24,7 @@ -- pragma translate_on ; - ~SYM[3] <= to_integer(~ARG[4]) + ~SYM[3] <= to_integer(~ARG[5]) -- pragma translate_off mod ~LIT[2] -- pragma translate_on @@ -33,14 +33,14 @@ ~GENSYM[asyncRam_sync][5] : process(~CLK[0]) begin if rising_edge(~CLK[0]) then - if ~ARG[5] then~IF ~VIVADO ~THEN - ~SYM[1](~SYM[2]) <= ~TOBV[~ARG[6]][~TYP[6]];~ELSE - ~SYM[1](~SYM[2]) <= ~ARG[6];~FI + if ~ARG[4] then~IF ~VIVADO ~THEN + ~SYM[1](~SYM[3]) <= ~TOBV[~ARG[6]][~TYP[6]];~ELSE + ~SYM[1](~SYM[3]) <= ~ARG[6];~FI end if; end if; end process;~IF ~VIVADO ~THEN - ~RESULT <= ~FROMBV[~SYM[1](~SYM[3])][~TYP[6]];~ELSE - ~RESULT <= ~SYM[1](~SYM[3]);~FI + ~RESULT <= ~FROMBV[~SYM[1](~SYM[2])][~TYP[6]];~ELSE + ~RESULT <= ~SYM[1](~SYM[2]);~FI end block; -- asyncRam end" } diff --git a/primitives/CLaSH.Promoted.Nat.json b/primitives/CLaSH.Promoted.Nat.json --- a/primitives/CLaSH.Promoted.Nat.json +++ b/primitives/CLaSH.Promoted.Nat.json @@ -1,37 +1,34 @@ [ { "BlackBox" : - { "name" : "CLaSH.Promoted.Nat.SNat" - , "type" : "SNat :: KnownNat n => Proxy n -> SNat n" - , "templateE" : "~LIT[0]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Promoted.Nat.snatToInteger" - , "type" : "snatToInteger :: SNat n -> Integer" - , "templateE" : "~IF ~IW64 ~THEN to_signed(~ARG[0],64) ~ELSE to_signed(~ARG[0],32) ~FI" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Promoted.Nat.addSNat" - , "type" : "CLaSH.Promoted.Nat.addSNat :: SNat a -> SNat b -> SNat (a + b)" - , "templateE" : "~LIT[0] + ~LIT[1]" + { "name" : "CLaSH.Promoted.Nat.powSNat" + , "type" : "CLaSH.Promoted.Nat.powSNat :: SNat a -> SNat b -> SNat (a^b)" + , "templateE" : "~LIT[0] ** ~LIT[1]" } } , { "BlackBox" : - { "name" : "CLaSH.Promoted.Nat.subSNat" - , "type" : "CLaSH.Promoted.Nat.subSNat :: SNat a -> SNat b -> SNat (a - b)" - , "templateE" : "~LIT[0] - ~LIT[1]" + { "name" : "CLaSH.Promoted.Nat.flogBaseSNat" + , "type" : "CLaSH.Promoted.Nat.flogBaseSNat :: (2 <= base, 1 <= x) + => SNat base -- ARG[2] + -> SNat x -- ARG[3] + -> SNat (FLog base x)" + , "templateE" : "integer(floor(log(real(~LIT[3]),real(~LIT[2]))))" } } , { "BlackBox" : - { "name" : "CLaSH.Promoted.Nat.mulSNat" - , "type" : "CLaSH.Promoted.Nat.mulSNat :: SNat a -> SNat b -> SNat (a * b)" - , "templateE" : "~LIT[0] * ~LIT[1]" + { "name" : "CLaSH.Promoted.Nat.clogBaseSNat" + , "type" : "CLaSH.Promoted.Nat.clogBaseSNat :: (2 <= base, 1 <= x) + => SNat base -- ARG[2] + -> SNat x -- ARG[3] + -> SNat (CLog base x)" + , "templateE" : "integer(ceiling(log(real(~LIT[3]),real(~LIT[2]))))" } } , { "BlackBox" : - { "name" : "CLaSH.Promoted.Nat.powSNat" - , "type" : "CLaSH.Promoted.Nat.powSNat :: SNat a -> SNat b -> SNat (a ^ b)" - , "templateE" : "~LIT[0] ** ~LIT[1]" + { "name" : "CLaSH.Promoted.Nat.logBaseSNat" + , "type" : "CLaSH.Promoted.Nat.logBaseSNat :: (FLog base x ~ CLog base x) + => SNat base -- ARG[1] + -> SNat x -- ARG[2] + -> SNat (Log base x)" + , "templateE" : "integer(ceiling(log(real(~LIT[2]),real(~LIT[1]))))" } } ] diff --git a/primitives/CLaSH.Sized.Internal.BitVector.json b/primitives/CLaSH.Sized.Internal.BitVector.json --- a/primitives/CLaSH.Sized.Internal.BitVector.json +++ b/primitives/CLaSH.Sized.Internal.BitVector.json @@ -404,20 +404,20 @@ } , { "BlackBox" : { "name" : "CLaSH.Sized.Internal.BitVector.plus#" - , "type" : "plus# :: KnownNat (Max m n + 1) => BitVector m -> BitVector n -> BitVector (Max m n + 1)" - , "templateE" : "std_logic_vector(resize(unsigned(~ARG[1]),~LIT[0]) + resize(unsigned(~ARG[2]),~LIT[0]))" + , "type" : "plus# :: BitVector m -> BitVector n -> BitVector (Max m n + 1)" + , "templateE" : "std_logic_vector(resize(unsigned(~ARG[0]),~SIZE[~TYPO]) + resize(unsigned(~ARG[1]),~SIZE[~TYPO]))" } } , { "BlackBox" : { "name" : "CLaSH.Sized.Internal.BitVector.minus#" - , "type" : "minus# :: KnownNat (Max m n + 1) => BitVector m -> BitVector n -> BitVector (Max m n + 1)" - , "templateE" : "std_logic_vector(resize(unsigned(~ARG[1]),~LIT[0]) - resize(unsigned(~ARG[2]),~LIT[0]))" + , "type" : "minus# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1)" + , "templateE" : "std_logic_vector(resize(unsigned(~ARG[2]),~SIZE[~TYPO]) - resize(unsigned(~ARG[3]),~SIZE[~TYPO]))" } } , { "BlackBox" : { "name" : "CLaSH.Sized.Internal.BitVector.times#" - , "type" : "times# :: KnownNat (m + n) => BitVector m -> BitVector n -> BitVector (m + n)" - , "templateE" : "std_logic_vector(unsigned(~ARG[1]) * unsigned(~ARG[2]))" + , "type" : "times# :: BitVector m -> BitVector n -> BitVector (m + n)" + , "templateE" : "std_logic_vector(unsigned(~ARG[0]) * unsigned(~ARG[1]))" } } , { "BlackBox" : @@ -470,8 +470,8 @@ } , { "BlackBox" : { "name" : "CLaSH.Sized.Internal.BitVector.shiftR#" - , "type" : "shiftR# :: KnownNat n => BitVector n -> Int -> BitVector n" - , "templateE" : "std_logic_vector(shift_right(unsigned(~ARG[1]),to_integer(~ARG[2])))" + , "type" : "shiftR# :: BitVector n -> Int -> BitVector n" + , "templateE" : "std_logic_vector(shift_right(unsigned(~ARG[0]),to_integer(~ARG[1])))" } } , { "BlackBox" : diff --git a/primitives/CLaSH.Sized.Internal.Signed.json b/primitives/CLaSH.Sized.Internal.Signed.json --- a/primitives/CLaSH.Sized.Internal.Signed.json +++ b/primitives/CLaSH.Sized.Internal.Signed.json @@ -106,20 +106,20 @@ } , { "BlackBox" : { "name" : "CLaSH.Sized.Internal.Signed.plus#" - , "type" : "plus# :: KnownNat (1 + Max m n) => Signed m -> Signed n -> Signed (1 + Max m n)" - , "templateE" : "resize(~ARG[1],~LIT[0]) + resize(~ARG[2],~LIT[0])" + , "type" : "plus# :: Signed m -> Signed n -> Signed (1 + Max m n)" + , "templateE" : "resize(~ARG[0],~SIZE[~TYPO]) + resize(~ARG[1],~SIZE[~TYPO])" } } , { "BlackBox" : { "name" : "CLaSH.Sized.Internal.Signed.minus#" - , "type" : "minus# :: KnownNat (1 + Max m n) => Signed m -> Signed n -> Signed (1 + Max m n)" - , "templateE" : "resize(~ARG[1],~LIT[0]) - resize(~ARG[2],~LIT[0])" + , "type" : "minus# :: Signed m -> Signed n -> Signed (1 + Max m n)" + , "templateE" : "resize(~ARG[0],~SIZE[~TYPO]) - resize(~ARG[1],~SIZE[~TYPO])" } } , { "BlackBox" : { "name" : "CLaSH.Sized.Internal.Signed.times#" - , "type" : "times# :: KnownNat (m + n) => Signed m -> Signed n -> Signed (m + n)" - , "templateE" : "~ARG[1] * ~ARG[2]" + , "type" : "times# :: Signed m -> Signed n -> Signed (m + n)" + , "templateE" : "~ARG[0] * ~ARG[1]" } } , { "BlackBox" : diff --git a/primitives/CLaSH.Sized.Internal.Unsigned.json b/primitives/CLaSH.Sized.Internal.Unsigned.json --- a/primitives/CLaSH.Sized.Internal.Unsigned.json +++ b/primitives/CLaSH.Sized.Internal.Unsigned.json @@ -98,20 +98,20 @@ } , { "BlackBox" : { "name" : "CLaSH.Sized.Internal.Unsigned.plus#" - , "type" : "plus# :: KnownNat (1 + Max m n) => Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)" - , "templateE" : "resize(~ARG[1],~LIT[0]) + resize(~ARG[2],~LIT[0])" + , "type" : "plus# :: Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)" + , "templateE" : "resize(~ARG[0],~SIZE[~TYPO]) + resize(~ARG[1],~SIZE[~TYPO])" } } , { "BlackBox" : { "name" : "CLaSH.Sized.Internal.Unsigned.minus#" - , "type" : "minus# :: KnownNat (1 + Max m n) => Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)" - , "templateE" : "resize(~ARG[1],~LIT[0]) - resize(~ARG[2],~LIT[0])" + , "type" : "minus# :: (KnownNat m,KnownNat n) => Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)" + , "templateE" : "resize(~ARG[2],~SIZE[~TYPO]) - resize(~ARG[3],~SIZE[~TYPO])" } } , { "BlackBox" : { "name" : "CLaSH.Sized.Internal.Unsigned.times#" - , "type" : "times# :: KnownNat (m + n) => Unsigned m -> Unsigned n -> Unsigned (m + n)" - , "templateE" : "~ARG[1] * ~ARG[2]" + , "type" : "times# :: Unsigned m -> Unsigned n -> Unsigned (m + n)" + , "templateE" : "~ARG[0] * ~ARG[1]" } } , { "BlackBox" : @@ -164,8 +164,8 @@ } , { "BlackBox" : { "name" : "CLaSH.Sized.Internal.Unsigned.shiftR#" - , "type" : "shiftR# :: KnownNat n => Unsigned n -> Int -> Unsigned n" - , "templateE" : "shift_right(~ARG[1],to_integer(~ARG[2]))" + , "type" : "shiftR# :: Unsigned n -> Int -> Unsigned n" + , "templateE" : "shift_right(~ARG[0],to_integer(~ARG[1]))" } } , { "BlackBox" : diff --git a/primitives/CLaSH.Sized.RTree.json b/primitives/CLaSH.Sized.RTree.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Sized.RTree.json @@ -0,0 +1,36 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Sized.RTree.treplicate" + , "type" : "replicate :: SNat n -> a -> RTree d a" + , "templateE" : "~TYPMO'(0 to (2**~LIT[0])-1 => ~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.RTree.textract" + , "type" : "textract :: RTree 0 a -> a" + , "templateD" : +"-- textract begin +textract_~SYM[0] : block + signal ~SYM[1] : ~TYP[0]; +begin + ~SYM[1] <= ~ARG[0]; + ~RESULT <= ~SYM[1](0); +end block; +-- textract end" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.RTree.tsplit" + , "type" : "tsplit:: RTree (d+1) a -> (RTree d a,RTree d a)" + , "templateD" : +"-- tsplit begin +textract_~SYM[0] : block + signal ~SYM[1] : ~TYP[0]; +begin + ~SYM[1] <= ~ARG[0]; + ~RESULT <= (~SYM[1](0 to (2**(~DEPTH[~TYP[0]]-1))-1) + ,~SYM[1](2**(~DEPTH[~TYP[0]]-1) to (2**~DEPTH[~TYP[0]])-1)); +end block; +-- tsplit end" + } + } +] diff --git a/primitives/GHC.CString.json b/primitives/GHC.CString.json --- a/primitives/GHC.CString.json +++ b/primitives/GHC.CString.json @@ -3,6 +3,11 @@ , "templateE" : "~LIT[0]" } } +, { "BlackBox" : + { "name" : "GHC.CString.unpackFoldrCString#" + , "templateE" : "~LIT[0]" + } + } , { "Primitive" : { "name" : "GHC.CString.unpackCStringUtf8#" , "primType" : "Function" diff --git a/primitives/GHC.Integer.Logarithms.json b/primitives/GHC.Integer.Logarithms.json new file mode 100644 --- /dev/null +++ b/primitives/GHC.Integer.Logarithms.json @@ -0,0 +1,7 @@ +[ { "BlackBox" : + { "name" : "GHC.Integer.Logarithms.integerLogBase#" + , "type" : "integerLogBase# :: Integer -> Integer -> Int#" + , "templateE" : "integer(floor(log(real(~ARG[1]),real(~ARG[0]))))" + } + } +] diff --git a/src/CLaSH/Backend/VHDL.hs b/src/CLaSH/Backend/VHDL.hs --- a/src/CLaSH/Backend/VHDL.hs +++ b/src/CLaSH/Backend/VHDL.hs @@ -20,6 +20,7 @@ import Control.Monad (forM,join,liftM,zipWithM) import Control.Monad.State (State) import Data.Graph.Inductive (Gr, mkGraph, topsort') +import Data.Hashable (Hashable (..)) import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as HashMap import Data.HashSet (HashSet) @@ -55,6 +56,9 @@ , _nameCache :: (HashMap HWType Doc) -- ^ Cache for previously generated product type names , _modNm :: String , _srcSpan :: SrcSpan + , _libraries :: [T.Text] + , _packages :: [T.Text] + , _includes :: [(String,Doc)] , _intWidth :: Int -- ^ Int/Word/Integer bit-width , _hdlsyn :: HdlSyn -- ^ For which HDL synthesis tool are we generating VHDL } @@ -62,7 +66,7 @@ makeLenses ''VHDLState instance Backend VHDLState where - initBackend = VHDLState HashSet.empty [] HashMap.empty "" noSrcSpan + initBackend = VHDLState HashSet.empty [] HashMap.empty "" noSrcSpan [] [] [] #ifdef CABAL primDir = const (Paths_clash_vhdl.getDataFileName "primitives") #else @@ -122,16 +126,22 @@ else s -- | Generate VHDL for a Netlist component -genVHDL :: String -> SrcSpan -> Component -> VHDLM (String,Doc) +genVHDL :: String -> SrcSpan -> Component -> VHDLM ((String,Doc),[(String,Doc)]) genVHDL nm sp c = do setSrcSpan sp - (unpack cName,) A.<$> vhdl + v <- vhdl + i <- use includes + return ((unpack cName,v),i) where cName = componentName c - vhdl = "-- Automatically generated VHDL-93" <$$> - tyImports nm <$$> linebreak <> - entity c <$$> linebreak <> - architecture c + vhdl = do + ent <- entity c + arch <- architecture c + imps <- tyImports nm + ("-- Automatically generated VHDL-93" <$$> + pure imps <$$> linebreak <> + pure ent <$$> linebreak <> + pure arch) -- | Generate a VHDL package containing type definitions for the given HWTypes mkTyPackage_ :: String @@ -177,6 +187,7 @@ mkUsedTys :: HWType -> [HWType] mkUsedTys v@(Vector _ elTy) = v : mkUsedTys elTy +mkUsedTys v@(RTree _ elTy) = v : mkUsedTys elTy mkUsedTys p@(Product _ elTys) = p : concatMap mkUsedTys elTys mkUsedTys sp@(SP _ elTys) = sp : concatMap mkUsedTys (concatMap snd elTys) mkUsedTys t = [t] @@ -193,12 +204,15 @@ edge t@(Vector _ elTy) = maybe [] ((:[]) . (HashMap.lookupDefault (error $ $(curLoc) ++ "Vector") t nodesI,,())) (HashMap.lookup (mkVecZ elTy) nodesI) + edge t@(RTree _ elTy) = maybe [] ((:[]) . (HashMap.lookupDefault (error $ $(curLoc) ++ "RTree") t nodesI,,())) + (HashMap.lookup (mkVecZ elTy) nodesI) edge t@(Product _ tys) = let ti = HashMap.lookupDefault (error $ $(curLoc) ++ "Product") t nodesI in mapMaybe (\ty -> liftM (ti,,()) (HashMap.lookup (mkVecZ ty) nodesI)) tys edge _ = [] normaliseType :: HWType -> HWType normaliseType (Vector n ty) = Vector n (normaliseType ty) +normaliseType (RTree d ty) = RTree d (normaliseType ty) normaliseType (Product nm tys) = Product nm (map normaliseType tys) normaliseType ty@(SP _ _) = BitVector (typeSize ty) normaliseType ty@(Index _) = Unsigned (typeSize ty) @@ -207,6 +221,7 @@ mkVecZ :: HWType -> HWType mkVecZ (Vector _ elTy) = Vector 0 elTy +mkVecZ (RTree _ elTy) = RTree 0 elTy mkVecZ t = t tyDec :: HWType -> VHDLM Doc @@ -218,6 +233,13 @@ _ -> "type" <+> "array_of_" <> tyName elTy <+> "is array (integer range <>) of" <+> vhdlType elTy <> semi +tyDec (RTree _ elTy) = do + syn <- hdlSyn + case syn of + Vivado -> "type" <+> "tree_of_" <> tyName elTy <+> "is array (integer range <>) of" + <+> "std_logic_vector" <> parens (int (typeSize elTy - 1) <+> "downto 0") <> semi + _ -> "type" <+> "tree_of_" <> tyName elTy <+> "is array (integer range <>) of" <+> vhdlType elTy <> semi + tyDec ty@(Product _ tys@(_:_:_)) = prodDec where prodDec = "type" <+> tName <+> "is record" <$> @@ -334,20 +356,46 @@ "end" <> semi ) +funDec syn t@(RTree _ elTy) = Just + ( "function" <+> "toSLV" <+> parens ("value : " <+> vhdlTypeMark t) <+> "return std_logic_vector" <> semi + , "function" <+> "toSLV" <+> parens ("value : " <+> vhdlTypeMark t) <+> "return std_logic_vector" <+> "is" <$> + indent 2 + ( "alias ivalue :" <+> vhdlTypeMark t <> "(1 to value'length) is value;" <$> + "variable result :" <+> "std_logic_vector" <> parens ("1 to value'length * " <> int (typeSize elTy)) <> semi + ) <$> + "begin" <$> + indent 2 + ("for i in ivalue'range loop" <$> + indent 2 + ( "result" <> parens (parens ("(i - 1) * " <> int (typeSize elTy)) <+> "+ 1" <+> + "to i*" <> int (typeSize elTy)) <+> + ":=" <+> (case syn of + Vivado -> "ivalue" <> parens ("i") + _ -> "toSLV" <> parens ("ivalue" <> parens ("i"))) <> semi + ) <$> + "end" <+> "loop" <> semi <$> + "return" <+> "result" <> semi + ) <$> + "end" <> semi + ) + funDec _ _ = Nothing tyImports :: String -> VHDLM Doc tyImports nm = do mkId <- mkBasicId + libs <- use libraries + packs <- use packages punctuate' semi $ sequence - [ "library IEEE" - , "use IEEE.STD_LOGIC_1164.ALL" - , "use IEEE.NUMERIC_STD.ALL" - , "use IEEE.MATH_REAL.ALL" - , "use std.textio.all" - , "use work.all" - , "use work." <> text (mkId (T.pack nm `T.append` "_types")) <> ".all" - ] + ([ "library IEEE" + , "use IEEE.STD_LOGIC_1164.ALL" + , "use IEEE.NUMERIC_STD.ALL" + , "use IEEE.MATH_REAL.ALL" + , "use std.textio.all" + , "use work.all" + , "use work." <> text (mkId (T.pack nm `T.append` "_types")) <> ".all" + ] ++ (map (("library" <+>) . text) (nub libs)) + ++ (map (("use" <+>) . text) (nub packs))) entity :: Component -> VHDLM Doc entity c = do @@ -402,6 +450,9 @@ go (Vector n elTy) = do nm <- use modNm text (T.toLower $ T.pack nm) <> "_types.array_of_" <> tyName elTy <> parens ("0 to " <> int (n-1)) + go (RTree d elTy) = do + nm <- use modNm + text (T.toLower $ T.pack nm) <> "_types.tree_of_" <> tyName elTy <> parens ("0 to " <> int ((2^d)-1)) go t@(Product _ _) = do nm <- use modNm text (T.toLower $ T.pack nm) <> "_types." <> tyName t @@ -428,6 +479,9 @@ go (Vector _ elTy) = do nm <- use modNm text (T.toLower $ T.pack nm) <> "_types.array_of_" <> tyName elTy + go (RTree _ elTy) = do + nm <- use modNm + text (T.toLower $ T.pack nm) <> "_types.tree_of_" <> tyName elTy go t@(Product _ _) = do nm <- use modNm text (T.toLower $ T.pack nm) <> "_types." <> tyName t @@ -438,6 +492,7 @@ tyName (Clock _ _) = "std_logic" tyName (Reset _ _) = "std_logic" tyName (Vector n elTy) = "array_of_" <> int n <> "_" <> tyName elTy +tyName (RTree n elTy) = "tree_of_" <> int n <> "_" <> tyName elTy tyName (BitVector n) = "std_logic_vector_" <> int n tyName t@(Index _) = "unsigned_" <> int (typeSize t) tyName (Signed n) = "signed_" <> int n @@ -476,6 +531,13 @@ "std_logic_vector'" <> parens (int 0 <+> "to" <+> int (typeSize elTy - 1) <+> rarrow <+> "'X'")) _ -> vhdlTypeMark t <> "'" <> parens (int 0 <+> "to" <+> int (n-1) <+> rarrow <+> vhdlTypeErrValue elTy) +vhdlTypeErrValue t@(RTree n elTy) = do + syn <-hdlSyn + case syn of + Vivado -> vhdlTypeMark t <> "'" <> parens (int 0 <+> "to" <+> int (2^n - 1) <+> rarrow <+> + "std_logic_vector'" <> parens (int 0 <+> "to" <+> int (typeSize elTy - 1) <+> + rarrow <+> "'X'")) + _ -> vhdlTypeMark t <> "'" <> parens (int 0 <+> "to" <+> int (2^n - 1) <+> rarrow <+> vhdlTypeErrValue elTy) vhdlTypeErrValue t@(Product _ elTys) = vhdlTypeMark t <> "'" <> tupled (mapM vhdlTypeErrValue elTys) vhdlTypeErrValue (Reset _ _) = "'X'" vhdlTypeErrValue (Clock _ _) = "'X'" @@ -536,9 +598,26 @@ rec (p,ls) <- fmap unzip $ sequence [ (,fromIntegral (T.length i)) A.<$> fill (maximum ls) (text i) <+> "=>" <+> expr_ False e | (i,_,_,e) <- pms] nest 2 $ "port map" <$$> tupled (A.pure p) -inst_ (BlackBoxD _ bs bbCtx) = do t <- renderBlackBox bs bbCtx - fmap Just (string t) +inst_ (BlackBoxD _ libs packs Nothing bs bbCtx) = do + libraries %= ((map T.fromStrict libs) ++) + packages %= ((map T.fromStrict packs) ++) + t <- renderBlackBox bs bbCtx + fmap Just (string t) +inst_ (BlackBoxD _ libs packs (Just (nm,inc)) bs bbCtx) = do + libraries %= ((map T.fromStrict libs) ++) + packages %= ((map T.fromStrict packs) ++) + inc' <- renderBlackBox inc bbCtx + iw <- use intWidth + let incHash = hash inc' + nm' = T.concat [ T.fromStrict nm + , T.pack (printf ("%0" ++ show (iw `div` 4) ++ "X") incHash) + ] + t <- renderBlackBox bs (bbCtx {bbQsysIncName = Just nm'}) + inc'' <- text inc' + includes %= ((unpack nm', inc''):) + fmap Just (string t) + inst_ _ = return Nothing -- | Turn a Netlist expression into a VHDL expression @@ -568,6 +647,15 @@ _ -> 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 n _),1,1)))) = + let z = 2^(n-1) + in text id_ <> parens (int 0 <+> "to" <+> int (z-1)) +expr_ _ (Identifier id_ (Just (Indexed ((RTree n _),1,2)))) = + let z = 2^(n-1) + z' = 2^n + in text id_ <> parens (int z <+> "to" <+> int (z'-1)) + -- This is a HACK for CLaSH.Driver.TopWrapper.mkOutput -- Vector's don't have a 10'th constructor, this is just so that we can -- recognize the particular case @@ -579,6 +667,11 @@ fromSLV elTy id' (typeSize elTy - 1) 0 _ -> text id_ <> parens (int fI) +-- 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 (DC (ty@(SP _ _),_)))) = text id_ <> parens (int start <+> "downto" <+> int end) where start = typeSize ty - 1 @@ -595,8 +688,7 @@ expr_ b (DataCon _ (DC (Void, -1)) [e]) = expr_ b e -expr_ _ (DataCon (Vector 0 _) _ _) = - error $ $(curLoc) ++ "VHDL: Trying to create a Nil vector." +expr_ _ (DataCon ty@(Vector 0 _) _ _) = vhdlTypeErrValue ty expr_ _ (DataCon ty@(Vector 1 elTy) _ [e]) = do syn <- hdlSyn @@ -612,6 +704,24 @@ _ -> vhdlTypeMark ty <> "'" <> case vectorChain e of Just es -> tupled (mapM (expr_ False) es) Nothing -> parens (vhdlTypeMark elTy <> "'" <> parens (expr_ False e1) <+> "&" <+> expr_ False e2) + +expr_ _ (DataCon ty@(RTree 0 elTy) _ [e]) = do + syn <- hdlSyn + 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_ _ (DataCon ty@(SP _ args) (DC (_,i)) es) = assignExpr where argTys = snd $ args !! i @@ -627,29 +737,29 @@ expr_ _ (DataCon ty@(Product _ _) _ es) = tupled $ zipWithM (\i e' -> tyName ty <> "_sel" <> int i <+> rarrow <+> expr_ False e') [0..] es -expr_ _ (BlackBoxE pNm _ bbCtx _) +expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _) | pNm == "CLaSH.Sized.Internal.Signed.fromInteger#" , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx = exprLit (Just (Signed (fromInteger n),fromInteger n)) i -expr_ _ (BlackBoxE pNm _ bbCtx _) +expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _) | pNm == "CLaSH.Sized.Internal.Unsigned.fromInteger#" , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx = exprLit (Just (Unsigned (fromInteger n),fromInteger n)) i -expr_ _ (BlackBoxE pNm _ bbCtx _) +expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _) | pNm == "CLaSH.Sized.Internal.BitVector.fromInteger#" , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx = exprLit (Just (BitVector (fromInteger n),fromInteger n)) i -expr_ _ (BlackBoxE pNm _ bbCtx _) +expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _) | pNm == "CLaSH.Sized.Internal.Index.fromInteger#" , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx , Just k <- clogBase 2 n , let k' = max 1 k = exprLit (Just (Unsigned k',k')) i -expr_ _ (BlackBoxE pNm _ bbCtx _) +expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _) | pNm == "CLaSH.Sized.Internal.Index.maxBound#" , [Literal _ (NumLit n)] <- extractLiterals bbCtx , n > 0 @@ -657,22 +767,38 @@ , let k' = max 1 k = exprLit (Just (Unsigned k',k')) (NumLit (n-1)) -expr_ _ (BlackBoxE pNm _ bbCtx _) +expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _) | pNm == "GHC.Types.I#" , [Literal _ (NumLit n)] <- extractLiterals bbCtx = do iw <- use intWidth exprLit (Just (Signed iw,iw)) (NumLit n) -expr_ _ (BlackBoxE pNm _ bbCtx _) +expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _) | pNm == "GHC.Types.W#" , [Literal _ (NumLit n)] <- extractLiterals bbCtx = do iw <- use intWidth exprLit (Just (Unsigned iw,iw)) (NumLit n) -expr_ b (BlackBoxE _ bs bbCtx b') = do +expr_ b (BlackBoxE _ libs packs Nothing bs bbCtx b') = do + libraries %= ((map T.fromStrict libs) ++) + packages %= ((map T.fromStrict packs) ++) t <- renderBlackBox bs bbCtx parenIf (b || b') $ string t +expr_ b (BlackBoxE _ libs packs (Just (nm,inc)) bs bbCtx b') = do + libraries %= ((map T.fromStrict libs) ++) + packages %= ((map T.fromStrict packs) ++) + inc' <- renderBlackBox inc bbCtx + iw <- use intWidth + let incHash = hash inc' + nm' = T.concat [ T.fromStrict nm + , T.pack (printf ("%0" ++ show (iw `div` 4) ++ "X") incHash) + ] + t <- renderBlackBox bs (bbCtx {bbQsysIncName = Just nm'}) + inc'' <- text inc' + includes %= ((unpack nm', inc''):) + parenIf (b || b') $ string t + expr_ _ (DataTag Bool (Left id_)) = "tagToEnum" <> parens (text id_) expr_ _ (DataTag Bool (Right id_)) = "dataToTag" <> parens (text id_) @@ -702,6 +828,13 @@ iw <- use intWidth "to_signed" <> parens (int 1 <> "," <> int iw) +expr_ _ (DataTag (RTree 0 _) (Right _)) = do + iw <- use intWidth + "to_signed" <> parens (int 0 <> "," <> int iw) +expr_ _ (DataTag (RTree _ _) (Right _)) = do + iw <- use intWidth + "to_signed" <> parens (int 1 <> "," <> int iw) + expr_ _ e = error $ $(curLoc) ++ (show e) -- empty otherSize :: [HWType] -> Int -> Int @@ -715,6 +848,11 @@ vectorChain (DataCon (Vector _ _) _ [e1,e2]) = Just e1 <:> vectorChain e2 vectorChain _ = Nothing +rtreeChain :: Expr -> Maybe [Expr] +rtreeChain (DataCon (RTree 1 _) _ [e]) = Just [e] +rtreeChain (DataCon (RTree _ _) _ [e1,e2]) = A.liftA2 (++) (rtreeChain e1) (rtreeChain e2) +rtreeChain _ = Nothing + exprLit :: Maybe (HWType,Size) -> Literal -> VHDLM Doc exprLit Nothing (NumLit i) = integer i @@ -724,13 +862,13 @@ | otherwise -> "unsigned'" <> parens (if sz `mod` 4 == 0 then hlit else blit) Signed n | i < 2^(31 :: Integer) && i > (-2^(31 :: Integer)) -> "to_signed" <> parens (integer i <> "," <> int n) - | otherwise -> "signed'" <> parens hlit + | 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) _ -> blit where blit = bits (toBits sz i) - hlit = hex (toHex sz i) + 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 @@ -761,7 +899,7 @@ toHex :: Int -> Integer -> String toHex sz i = let Just d = clogBase 16 (2^sz) - in printf ("%0" ++ show d ++ "X") i + in printf ("%0" ++ show d ++ "X") (abs i) hex :: String -> VHDLM Doc hex s = char 'x' <> dquotes (text (T.pack s))