diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,4 @@ +# Changelog for the [`clash-vhdl`](http://hackage.haskell.org/package/clash-vhdl) package + +## 0.5 *March 11th 2015* +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +Copyright (c) 2015, University of Twente +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,5 @@ +# Support +For updates and questions join the mailing list clash-language+subscribe@googlegroups.com or read the [forum](https://groups.google.com/d/forum/clash-language) + +# `clash-vhdl` + * See the LICENSE file for license and copyright details diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/clash-vhdl.cabal b/clash-vhdl.cabal new file mode 100644 --- /dev/null +++ b/clash-vhdl.cabal @@ -0,0 +1,79 @@ +Name: clash-vhdl +Version: 0.5 +Synopsis: CAES Language for Synchronous Hardware - As a Library +Description: + CλaSH (pronounced ‘clash’) is a functional hardware description language that + borrows both its syntax and semantics from the functional programming language + Haskell. The merits of using a functional language to describe hardware comes + from the fact that combinational circuits can be directly modelled as + mathematical functions and that functional languages lend themselves very well + at describing and (de-)composing mathematical functions. + . + This package provides: + . + * VHDL Backend +Homepage: http://www.clash-lang.org/ +bug-reports: http://github.com/clash-lang/clash-compiler/issues +License: BSD2 +License-file: LICENSE +Author: Christiaan Baaij +Maintainer: Christiaan Baaij +Copyright: Copyright © 2015 University of Twente +Category: Hardware +Build-type: Simple + +Extra-source-files: README.md, + CHANGELOG.md + +Data-files: primitives/CLaSH.Driver.TestbenchGen.json + primitives/CLaSH.GHC.GHC2Core.json + primitives/CLaSH.Prelude.BlockRam.json + primitives/CLaSH.Prelude.Testbench.json + primitives/CLaSH.Promoted.Nat.json + primitives/CLaSH.Promoted.Symbol.json + primitives/CLaSH.Signal.Bundle.json + primitives/CLaSH.Signal.Explicit.json + primitives/CLaSH.Signal.Internal.json + primitives/CLaSH.Sized.Internal.BitVector.json + primitives/CLaSH.Sized.Internal.Index.json + primitives/CLaSH.Sized.Internal.Signed.json + primitives/CLaSH.Sized.Internal.Unsigned.json + primitives/CLaSH.Sized.Vector.json + primitives/Control.Exception.Base.json + primitives/GHC.Base.json + primitives/GHC.Classes.json + primitives/GHC.CString.json + primitives/GHC.Err.json + primitives/GHC.Integer.Type.json + primitives/GHC.Prim.json + primitives/GHC.Real.json + primitives/GHC.Typelits.json + primitives/GHC.Types.json + primitives/Unsafe.Coerce.json + +Cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/clash-lang/clash-compiler.git + +Library + HS-Source-Dirs: src + + default-language: Haskell2010 + ghc-options: -Wall -fwarn-tabs + CPP-Options: -DCABAL + + Build-depends: base >= 4.6.0.1 && < 5, + clash-lib >= 0.5, + clash-prelude >= 0.7, + fgl >= 5.4.2.4, + lens >= 3.9.2, + mtl >= 2.1.2, + text >= 0.11.3.1, + unordered-containers >= 0.2.3.3, + wl-pprint-text >= 1.1.0.0 + + Exposed-modules: CLaSH.Backend.VHDL + + Other-modules: Paths_clash_vhdl diff --git a/primitives/CLaSH.Driver.TestbenchGen.json b/primitives/CLaSH.Driver.TestbenchGen.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Driver.TestbenchGen.json @@ -0,0 +1,48 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Driver.TestbenchGen.clockGen" + , "templateD" : +"-- pragma translate_off +process is +begin + ~RESULT <= '0'; + wait for ~LIT[0] ns; + while (not finished) loop + ~RESULT <= not ~RESULT; + wait for ~LIT[1] ns; + ~RESULT <= not ~RESULT; + wait for ~LIT[2] ns; + end loop; + wait; +end process; +-- pragma translate_on" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Driver.TestbenchGen.resetGen" + , "templateD" : +"-- pragma translate_off +~RESULT <= '0', + '1' after ~LIT[0] ns; +-- pragma translate_on" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Driver.TestbenchGen.doneGen" + , "templateD" : "~RESULT <= ~ARG[0];" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Driver.TestbenchGen.finishedGen" + , "templateD" : +"~RESULT <= +-- pragma translate_off + false, +-- pragma translate_on + true +-- pragma translate_off + after ~LIT[0] ns +-- pragma translate_on + ;" + } + } +] diff --git a/primitives/CLaSH.GHC.GHC2Core.json b/primitives/CLaSH.GHC.GHC2Core.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.GHC.GHC2Core.json @@ -0,0 +1,16 @@ +[ { "BlackBox" : + { "name" : "EmptyCase" + , "templateE" : "~ERRORO" + } + } +, { "Primitive" : + { "name" : "_CO_" + , "primType" : "Constructor" + } + } +, { "Primitive" : + { "name" : "_TY_" + , "primType" : "Constructor" + } + } +] diff --git a/primitives/CLaSH.Prelude.BlockRam.json b/primitives/CLaSH.Prelude.BlockRam.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Prelude.BlockRam.json @@ -0,0 +1,34 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Prelude.BlockRam.blockRam'" + , "type" : +"blockRam' :: (KnownNat n, KnownNat m) -- (ARG[0],ARG[1]) + => SClock clk -- clk, ARG[2] + -> Vec n a -- init, ARG[3] + -> Signal' clk (Unsigned m) -- wr, ARG[4] + -> Signal' clk (Unsigned m) -- rd, ARG[5] + -> Signal' clk Bool -- wren, ARG[6] + -> Signal' clk a -- din, ARG[7] + -> Signal' clk a" + , "templateD" : +"blockram_~SYM[0] : block + signal ~SYM[1] : ~TYP[3] := ~LIT[3]; -- ram + signal ~SYM[2] : ~TYP[7]; -- inp + signal ~SYM[3] : ~TYP[7]; -- outp +begin + ~SYM[2] <= ~ARG[7]; + + process(~CLK[2]) + begin + if rising_edge(~CLK[2]) then + if ~ARG[6] then + ~SYM[1](to_integer(~ARG[4])) <= ~SYM[2]; + end if; + ~SYM[3] <= ~SYM[1](to_integer(~ARG[5])); + end if; + end process; + + ~RESULT <= ~SYM[3]; +end block;" + } + } +] diff --git a/primitives/CLaSH.Prelude.Testbench.json b/primitives/CLaSH.Prelude.Testbench.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Prelude.Testbench.json @@ -0,0 +1,37 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Prelude.Testbench.assert" + , "type" : +"assert :: (Eq a,Show a) -- (ARG[0],ARG[1]) + => Signal' t a -- ^ Checked value (ARG[2]) + -> Signal' t a -- ^ Expected value (ARG[3]) + -> Signal' t b -- ^ Return valued (ARG[4]) + -> Signal' t b" + , "templateD" : +"assert_~SYM[0] : block + -- pragma translate_off + function slv2string (slv : std_logic_vector) return STRING is + variable result : string (1 to slv'length); + variable r : integer; + begin + r := 1; + for i in slv'range loop + result(r) := std_logic'image(slv(i))(2); + r := r + 1; + end loop; + return result; + end; + -- pragma translate_on +begin + -- pragma translate_off + process(~CLK[2],~RST[2],~ARG[2],~ARG[3]) is + begin + if (rising_edge(~CLK[2]) or rising_edge(~RST[2])) then + assert (~ARG[2] = ~ARG[3]) report (\"expected: \" & slv2string(toSLV(~ARG[3])) & \", actual: \" & slv2string(toSLV(~ARG[2]))) severity error; + end if; + end process; + -- pragma translate_on + ~RESULT <= ~ARG[4]; +end block;" + } + } +] diff --git a/primitives/CLaSH.Promoted.Nat.json b/primitives/CLaSH.Promoted.Nat.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Promoted.Nat.json @@ -0,0 +1,13 @@ +[ { "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" : "~LIT[0]" + } + } +] diff --git a/primitives/CLaSH.Promoted.Symbol.json b/primitives/CLaSH.Promoted.Symbol.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Promoted.Symbol.json @@ -0,0 +1,13 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Promoted.Symbol.SSymbol" + , "type" : "SSymbol :: KnownNat n => Proxy n -> SSymbol n" + , "templateE" : "~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Promoted.Symbol.symbolToString" + , "type" : "symbolToString :: SSymbol n -> String" + , "templateE" : "~LIT[0]" + } + } +] diff --git a/primitives/CLaSH.Signal.Bundle.json b/primitives/CLaSH.Signal.Bundle.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Signal.Bundle.json @@ -0,0 +1,6 @@ +[ { "Primitive" : + { "name" : "CLaSH.Signal.Bundle.vecBundle#" + , "primType" : "Function" + } + } +] diff --git a/primitives/CLaSH.Signal.Explicit.json b/primitives/CLaSH.Signal.Explicit.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Signal.Explicit.json @@ -0,0 +1,11 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Signal.Explicit.unsafeSynchronizer" + , "type" : +"unsafeSynchronizer :: SClock clk1 + -> SClock clk2 + -> Signal' clk1 a -- ARG[2] + -> Signal' clk2 a" + , "templateE" : "~ARG[2]" + } + } +] diff --git a/primitives/CLaSH.Signal.Internal.json b/primitives/CLaSH.Signal.Internal.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Signal.Internal.json @@ -0,0 +1,86 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Signal.Internal.register#" + , "type" : +"register# :: SClock clk -- ARG[0] + -> a -- ARG[1] + -> Signal' clk a -- ARG[2] + -> Signal' clk a" + , "templateD" : +"register_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; + signal ~SYM[2] : ~TYP[2]; +begin + ~SYM[1] <= ~ARG[1]; + + process(~CLK[0],~RST[0],~SYM[1]) + begin + if ~RST[0] = '0' then + ~SYM[2] <= ~SYM[1]; + elsif rising_edge(~CLK[0]) then + ~SYM[2] <= ~ARG[2]; + end if; + end process; + + ~RESULT <= ~SYM[2]; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Signal.Internal.regEn#" + , "type" : +"regEn# :: SClock clk -- ARG[0] + -> a -- ARG[1] + -> Signal' clk Bool -- ARG[2] + -> Signal' clk a -- ARG[3] + -> Signal' clk a" + , "templateD" : +"regEn_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; + signal ~SYM[2] : ~TYP[2]; + signal ~SYM[3] : ~TYP[3]; +begin + ~SYM[1] <= ~ARG[1]; + ~SYM[2] <= ~ARG[2]; + + process(~CLK[0],~RST[0],~SYM[1],~SYM[2]) + begin + if ~RST[0] = '0' then + ~SYM[3] <= ~SYM[1]; + elsif rising_edge(~CLK[0]) then + if ~SYM[2] then + ~SYM[3] <= ~ARG[3]; + end if; + end if; + end process; + + ~RESULT <= ~SYM[3]; +end block;" + } + } + +, { "Primitive" : + { "name" : "CLaSH.Signal.Internal.signal#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "CLaSH.Signal.Internal.mapSignal#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "CLaSH.Signal.Internal.appSignal#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "CLaSH.Signal.Internal.foldr#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "CLaSH.Signal.Internal.traverse#" + , "primType" : "Function" + } + } +] diff --git a/primitives/CLaSH.Sized.Internal.BitVector.json b/primitives/CLaSH.Sized.Internal.BitVector.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Sized.Internal.BitVector.json @@ -0,0 +1,469 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.size#" + , "type" : "size# :: KnownNat n => BitVector n -> Int" + , "templateE" : "~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.maxIndex#" + , "type" : "maxIndex# :: KnownNat n => BitVector n -> Int" + , "templateE" : "~LIT[0] - 1" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.high" + , "type" : "high :: Bit" + , "templateE" : "\"1\"" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.low" + , "type" : "low :: Bit" + , "templateE" : "\"0\"" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.++#" + , "type" : "(++#) :: KnownNat m => BitVector n -> BitVector m -> BitVector (n + m)" + , "templateE" : "std_logic_vector'(~ARG[1]) & std_logic_vector'(~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.reduceAnd#" + , "type" : "reduceAnd# :: KnownNat n => BitVector n -> BitVector 1" + , "templateD" : +"reduceAnd_~SYM[0] : block + function and_reduce (arg : std_logic_vector) return std_logic is + variable upper, lower : std_logic; + variable half : integer; + variable argi : std_logic_vector (arg'length - 1 downto 0); + variable result : std_logic; + begin + if (arg'length < 1) then + result := '1'; + else + argi := arg; + if (argi'length = 1) then + result := argi(argi'left); + else + half := (argi'length + 1) / 2; -- lsb-biased tree + upper := and_reduce (argi (argi'left downto half)); + lower := and_reduce (argi (half - 1 downto argi'right)); + result := upper and lower; + end if; + end if; + return result; + end; +begin + ~RESULT <= (0 => and_reduce(~ARG[1])); +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.reduceOr#" + , "type" : "reduceOr# :: BitVector n -> BitVector 1" + , "templateD" : +"reduceOr_~SYM[0] : block + function or_reduce (arg : std_logic_vector) return std_logic is + variable upper, lower : std_logic; + variable half : integer; + variable argi : std_logic_vector (arg'length - 1 downto 0); + variable result : std_logic; + begin + if (arg'length < 1) then + result := '0'; + else + argi := arg; + if (argi'length = 1) then + result := argi(argi'left); + else + half := (argi'length + 1) / 2; -- lsb-biased tree + upper := or_reduce (argi (argi'left downto half)); + lower := or_reduce (argi (half - 1 downto argi'right)); + result := upper or lower; + end if; + end if; + return result; + end; +begin + ~RESULT <= (0 => or_reduce(~ARG[0])); +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.reduceXor#" + , "type" : "reduceXor# :: BitVector n -> BitVector 1" + , "templateD" : +"reduceXor_~SYM[0] : block + function xor_reduce (arg : std_logic_vector) return std_logic is + variable upper, lower : std_logic; + variable half : integer; + variable argi : std_logic_vector (arg'length - 1 downto 0); + variable result : std_logic; + begin + if (arg'length < 1) then + result := '0'; + else + argi := arg; + if (argi'length = 1) then + result := argi(argi'left); + else + half := (argi'length + 1) / 2; -- lsb-biased tree + upper := xor_reduce (argi (argi'left downto half)); + lower := xor_reduce (argi (half - 1 downto argi'right)); + result := upper xor lower; + end if; + end if; + return result; + end; +begin + ~RESULT <= (0 => xor_reduce(~ARG[0])); +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.index#" + , "type" : +"index# :: KnownNat n -- ARG[0] + => BitVector n -- ARG[1] + -> Int -- ARG[2] + -> Bit" + , "templateD" : +"indexBit_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; + signal ~SYM[2] : ~TYP[2]; +begin + ~SYM[1] <= ~ARG[1]; + ~SYM[2] <= ~ARG[2]; + -- pragma translate_off + process (~SYM[1],~SYM[2]) + begin + if ~SYM[2] < ~SYM[1]'low or ~SYM[2] > ~SYM[1]'high then + assert false report (\"Index: \" & integer'image(~SYM[2]) & \", is out of bounds: \" & integer'image(~SYM[1]'low) & \" downto \" & integer'image(~SYM[1]'high)) severity warning; + ~RESULT <= ~ERRORO; + else + -- pragma translate_on + ~RESULT <= ~SYM[1](~SYM[2] downto ~SYM[2]); + -- pragma translate_off + end if; + end process; + -- pragma translate_on +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.replaceBit#" + , "type" : +"replaceBit# :: KnownNat n -- ARG[0] + => BitVector n -- ARG[1] + -> Int -- ARG[2] + -> Bit -- ARG[3] + -> BitVector n" + , "templateD" : +"replaceBit_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; + signal ~SYM[2] : ~TYP[2]; + signal ~SYM[3] : ~TYP[3]; +begin + ~SYM[1] <= ~ARG[1]; + ~SYM[2] <= ~ARG[2]; + ~SYM[3] <= ~ARG[3]; + process(~SYM[1],~SYM[2],~SYM[3]) + variable ~SYM[4] : ~TYP[1]; + begin + ~SYM[4] := ~SYM[1]; + -- pragma translate_off + if ~SYM[2] < ~SYM[4]'low or ~SYM[2] > ~SYM[4]'high then + assert false report (\"Index: \" & integer'image(~SYM[2]) & \", is out of bounds: \" & integer'image(~SYM[1]'low) & \" downto \" & integer'image(~SYM[1]'high)) severity warning; + ~SYM[4] := ~ERROR[1]; + else + -- pragma translate_on + ~SYM[4](~SYM[2] downto ~SYM[2]) := ~SYM[3]; + -- pragma translate_off + end if; + -- pragma translate_on + ~RESULT <= ~SYM[4]; + end process; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.setSlice#" + , "type" : +"setSlice# :: BitVector (m + 1 + i) -- ARG[0] + -> SNat m -- ARG[1] + -> SNat n -- ARG[2] + -> BitVector (m + 1 - n) -- ARG[3] + -> BitVector (m + 1 + i)" + , "templateD" : +"setSlice_~SYM[0] : block + signal ~SYM[1] : ~TYP[0]; + signal ~SYM[2] : ~TYP[3]; +begin + ~SYM[1] <= ~ARG[0]; + ~SYM[2] <= ~ARG[3]; + process(~SYM[1],~SYM[2]) + variable ~SYM[3] : ~TYP[0]; + begin + ~SYM[3] := ~SYM[1]; + ~SYM[3](~LIT[1] downto ~LIT[2]) := ~SYM[2]; + ~RESULT <= ~SYM[3]; + end process; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.slice#" + , "type" : +"slice# :: BitVector (m + 1 + i) -- ARG[0] + -> SNat m -- ARG[1] + -> SNat n -- ARG[2] + -> BitVector (m + 1 - n)" + , "templateD" : +"slice_~SYM[0] : block + signal ~SYM[1] : ~TYP[0]; +begin + ~SYM[1] <= ~ARG[0]; + ~RESULT <= ~SYM[1](~LIT[1] downto ~LIT[2]); +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.split#" + , "type" : +"split# :: KnownNat n -- ARG[0] + => BitVector (m + n) -- ARG[1] + -> (BitVector m, BitVector n)" + , "templateD" : +"split_~SYM[0]: block + signal ~SYM[1] : ~TYP[1]; +begin + ~SYM[1] <= ~ARG[1]; + ~RESULT <= ( ~SYM[1](~RESULT.~TYPMO_sel0'left + ~RESULT.~TYPMO_sel1'length downto + ~RESULT.~TYPMO_sel0'right + ~RESULT.~TYPMO_sel1'length) + , ~SYM[1](~RESULT.~TYPMO_sel1'left downto ~RESULT.~TYPMO_sel1'right) + ); +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.msb#" + , "type" : +"msb# :: KnownNat n -- ARG[0] + => BitVector n -- ARG[1] + -> Bit" + , "templateD" : +"msb_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; +begin + ~SYM[2]_generate : if ~SYM[1]'length = 0 generate + begin + ~RESULT <= \"0\"; + end generate; + + ~SYM[3]_generate : if ~SYM[1]'length /= 0 generate + ~SYM[1] <= ~ARG[1]; + ~RESULT <= ~SYM[1](~SYM[1]'high downto ~SYM[1]'high); + end generate; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.lsb#" + , "type" : +"lsb# :: BitVector n -- ARG[0] + -> Bit" + , "templateD" : +"lsb_~SYM[0] : block + signal ~SYM[1] : ~TYP[0]; +begin + ~SYM[2]_generate : if ~SYM[1]'length = 0 generate + begin + ~RESULT <= \"0\"; + end generate; + + ~SYM[3]_generate : if ~SYM[1]'length /= 0 generate + begin + ~SYM[1] <= ~ARG[0]; + ~RESULT <= ~SYM[1](0 downto 0); + end generate; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.eq#" + , "type" : "eq# :: BitVector n -> BitVector n -> Bool" + , "templateE" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.neq#" + , "type" : "neq# :: BitVector n -> BitVector n -> Bool" + , "templateE" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.lt#" + , "type" : "lt# :: BitVector n -> BitVector n -> Bool" + , "templateE" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.ge#" + , "type" : "ge# :: BitVector n -> BitVector n -> Bool" + , "templateE" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.gt#" + , "type" : "gt# :: BitVector n -> BitVector n -> Bool" + , "templateE" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.le#" + , "type" : "le# :: BitVector n -> BitVector n -> Bool" + , "templateE" : "~ARG[0] <= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.minBound#" + , "type" : "minBound# :: KnownNat n => BitVector n" + , "comment" : "Generates incorrect VDHL for n=0" + , "templateE" : "std_logic_vector'(~LIT[0]-1 downto 0 => '0');" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.maxBound#" + , "type" : "maxBound# :: KnownNat n => BitVector n" + , "comment" : "Generates incorrect VDHL for n=0" + , "templateE" : "std_logic_vector'(~LIT[0]-1 downto 0 => '1');" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.+#" + , "type" : "(+#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "templateE" : "std_logic_vector(unsigned(~ARG[1]) + unsigned(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.-#" + , "type" : "(-#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "templateE" : "std_logic_vector(unsigned(~ARG[1]) - unsigned(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.*#" + , "type" : "(*#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "templateE" : "std_logic_vector(resize(unsigned(~ARG[1]) * unsigned(~ARG[2]), ~LIT[0]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.negate#" + , "type" : "negate# :: KnownNat n => BitVector n -> BitVector n" + , "templateE" : "std_logic_vector(-(signed(~ARG[1])))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.fromInteger#" + , "type" : "fromInteger# :: KnownNat n => Integer -> BitVector n" + , "templateE" : "std_logic_vector(to_unsigned(~ARG[1],~LIT[0]))" + } + } +, { "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]))" + } + } +, { "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]))" + } + } +, { "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]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.quot#" + , "type" : "quot# :: BitVector n -> BitVector n -> BitVector n" + , "templateE" : "std_logic_vector(unsigned(~ARG[1]) / unsigned(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.rem#" + , "type" : "rem# :: BitVector n -> BitVector n -> BitVector n" + , "templateE" : "~ARG[1] rem ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.mod#" + , "type" : "mod# :: BitVector n -> BitVector n -> BitVector n" + , "templateE" : "~ARG[1] mod ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.toInteger#" + , "type" : "toInteger# :: BitVector n -> Integer" + , "templateE" : "to_integer(unsigned(~ARG[0]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.and#" + , "type" : "and# :: BitVector n -> BitVector n -> BitVector n" + , "templateE" : "~ARG[0] and ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.or#" + , "type" : "or# :: BitVector n -> BitVector n -> BitVector n" + , "templateE" : "~ARG[0] or ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.xor#" + , "type" : "xor# :: BitVector n -> BitVector n -> BitVector n" + , "templateE" : "~ARG[0] xor ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.complement#" + , "type" : "complement# :: KnownNat n => BitVector n -> BitVector n" + , "templateE" : "not ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.shiftL#" + , "type" : "shiftL# :: KnownNat n => BitVector n -> Int -> BitVector n" + , "templateE" : "std_logic_vector(shift_left(unsigned(~ARG[1]),~ARG[2]))" + } + } +, { "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]),~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.rotateL#" + , "type" : "rotateL# :: KnownNat n => BitVector n -> Int -> BitVector n" + , "templateE" : "std_logic_vector(rotate_left(unsigned(~ARG[1]),~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.rotateR#" + , "type" : "rotateR# :: KnownNat n => BitVector n -> Int -> BitVector n" + , "templateE" : "std_logic_vector(rotate_right(unsigned(~ARG[1]),~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.resize#" + , "type" : "resize# :: KnownNat m => BitVector n -> BitVector m" + , "templateE" : "std_logic_vector(resize(unsigned(~ARG[1]),~LIT[0]))" + } + } +] diff --git a/primitives/CLaSH.Sized.Internal.Index.json b/primitives/CLaSH.Sized.Internal.Index.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Sized.Internal.Index.json @@ -0,0 +1,91 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.eq#" + , "type" : "eq# :: Index n -> Index n -> Bool" + , "templateE" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.neq#" + , "type" : "neq# :: Index n -> Index n -> Bool" + , "templateE" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.lt#" + , "type" : "lt# :: Index n -> Index n -> Bool" + , "templateE" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.ge#" + , "type" : "ge# :: Index n -> Index n -> Bool" + , "templateE" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.gt#" + , "type" : "gt# :: Index n -> Index n -> Bool" + , "templateE" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.le#" + , "type" : "le# :: Index n -> Index n -> Bool" + , "templateE" : "~ARG[0] <= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.maxBound#" + , "type" : "maxBound# :: KnownNat n => Index n" + , "templateE" : "to_unsigned(max(0,~LIT[0]-1),~RESULT'length);" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.+#" + , "type" : "(+#) :: KnownNat n => Index n -> Index n -> Index n" + , "templateE" : "~ARG[1] + ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.-#" + , "type" : "(-#) :: KnownNat n => Index n -> Index n -> Index n" + , "templateE" : "~ARG[1] - ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.*#" + , "type" : "(*#) :: KnownNat n => Index n -> Index n -> Index n" + , "templateE" : "resize(~ARG[1] * ~ARG[2], ~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.fromInteger#" + , "type" : "fromInteger# :: KnownNat n => Integer -> Index n" + , "templateE" : "to_unsigned(~ARG[1],integer(ceil(log2(real(max(2,~LIT[0]))))))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.quot#" + , "type" : "quot# :: KnownNat n => Index n -> Index n -> Index n" + , "templateE" : "~ARG[1] / ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.rem#" + , "type" : "rem# :: KnownNat n => Index n -> Index n -> Index n" + , "templateE" : "~ARG[1] rem ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.mod#" + , "type" : "mod# :: KnownNat n => Index n -> Index n -> Index n" + , "templateE" : "~ARG[1] mod ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.toInteger#" + , "type" : "toInteger# :: Index n -> Integer" + , "templateE" : "to_integer(~ARG[0])" + } + } +] diff --git a/primitives/CLaSH.Sized.Internal.Signed.json b/primitives/CLaSH.Sized.Internal.Signed.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Sized.Internal.Signed.json @@ -0,0 +1,232 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Internal.Signed.size#" + , "type" : "size# :: KnownNat n => Signed n -> Int" + , "templateE" : "~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.pack#" + , "type" : "pack# :: KnownNat n => Signed n -> BitVector n" + , "templateE" : "std_logic_vector(~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.unpack#" + , "type" : "unpack# :: KnownNat n => BitVector n -> Signed n" + , "templateE" : "signed(~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.eq#" + , "type" : "eq# :: Signed n -> Signed n -> Bool" + , "templateE" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.neq#" + , "type" : "neq# :: Signed n -> Signed n -> Bool" + , "templateE" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.lt#" + , "type" : "lt# :: Signed n -> Signed n -> Bool" + , "templateE" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.ge#" + , "type" : "ge# :: Signed n -> Signed n -> Bool" + , "templateE" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.gt#" + , "type" : "gt# :: Signed n -> Signed n -> Bool" + , "templateE" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.le#" + , "type" : "le# :: Signed n -> Signed n -> Bool" + , "templateE" : "~ARG[0] <= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.minBound#" + , "type" : "minBound# :: KnownNat n => Signed n" + , "comment" : "Generates incorrect VDHL for n=0" + , "comment2" : "the quantification with signed gives the array an ascending index" + , "templateE" : "signed'(0 => '1', 1 to ~LIT[0]-1 => '0')" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.maxBound#" + , "type" : "maxBound# :: KnownNat n => Signed n" + , "comment" : "Generates incorrect VDHL for n=0" + , "comment2" : "the quantification with signed gives the array an ascending index" + , "templateE" : "signed'(0 => '0', 1 to ~LIT[0]-1 => '1')" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.+#" + , "type" : "(+#) :: KnownNat n => Signed n -> Signed n -> Signed n" + , "templateE" : "~ARG[1] + ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.-#" + , "type" : "(-#) :: KnownNat n => Signed n -> Signed n -> Signed n" + , "templateE" : "~ARG[1] - ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.*#" + , "type" : "(*#) :: KnownNat n => Signed n -> Signed n -> Signed n" + , "templateE" : "resize(~ARG[1] * ~ARG[2], ~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.negate#" + , "type" : "negate# :: KnownNat n => Signed n -> Signed n" + , "templateE" : "-~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.abs#" + , "type" : "abs# :: KnownNat n => Signed n -> Signed n" + , "templateE" : "abs ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.fromInteger#" + , "type" : "fromInteger# :: KnownNat n => Integer -> Signed (n :: Nat)" + , "templateE" : "to_signed(~ARG[1],~LIT[0])" + } + } +, { "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])" + } + } +, { "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])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.times#" + , "type" : "times# :: KnownNat (m + n) => Signed m -> Signed n -> Signed (m + n)" + , "templateE" : "~ARG[1] * ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.quot#" + , "type" : "quot# :: KnownNat n => Signed n -> Signed n -> Signed n" + , "templateE" : "~ARG[1] / ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.rem#" + , "type" : "rem# :: KnownNat n => Signed n -> Signed n -> Signed n" + , "templateE" : "~ARG[1] rem ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.div#" + , "type" : "div# :: KnownNat n => Signed n -> Signed n -> Signed n" + , "templateD" : +"divSigned_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; + signal ~SYM[2] : ~TYP[2]; + signal ~SYM[3] : ~TYP[1]; +begin + ~SYM[1] <= ~ARG[1]; + ~SYM[2] <= ~ARG[2]; + ~SYM[3] <= ~SYM[1] / ~SYM[2]; + ~RESULT <= ~SYM[3] - to_signed(1,~LIT[0]) when ~SYM[1](~SYM[1]'high) = not (~SYM[2](~SYM[2]'high)) else + ~SYM[3]; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.mod#" + , "type" : "mod# :: KnownNat n => Signed n -> Signed n -> Signed n" + , "templateE" : "~ARG[1] mod ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.toInteger#" + , "type" : "toInteger# :: Signed n -> Integer" + , "templateE" : "to_integer(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.and#" + , "type" : "and# :: KnownNat n => Signed n -> Signed n -> Signed n" + , "templateE" : "~ARG[1] and ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.or#" + , "type" : "or# :: KnownNat n => Signed n -> Signed n -> Signed n" + , "templateE" : "~ARG[1] or ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.xor#" + , "type" : "xor# :: KnownNat n => Signed n -> Signed n -> Signed n" + , "templateE" : "~ARG[1] xor ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.complement#" + , "type" : "complement# :: KnownNat n => Signed n -> Signed n" + , "templateE" : "not ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.shiftL#" + , "type" : "shiftL# :: KnownNat n => Signed n -> Int -> Signed n" + , "templateE" : "shift_left(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.shiftR#" + , "type" : "shiftR# :: KnownNat n => Signed n -> Int -> Signed n" + , "templateE" : "shift_right(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.rotateL#" + , "type" : "rotateL# :: KnownNat n => Signed n -> Int -> Signed n" + , "templateE" : "rotate_left(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.rotateR#" + , "type" : "rotateR# :: KnownNat n => Signed n -> Int -> Signed n" + , "templateE" : "rotate_right(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.resize#" + , "type" : "resize# :: (KnownNat n, KnownNat m) => Signed n -> Signed m" + , "templateE" : "resize(~ARG[2],~LIT[1])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.truncateB#" + , "type" : "truncateB# :: KnownNat m => Signed (n + m) -> Signed m" + , "templateD" : +"truncateB_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; +begin + ~SYM[1] <= ~ARG[1]; + ~RESULT <= ~SYM[1](~LIT[0]-1 downto 0); +end block;" + } + } +] diff --git a/primitives/CLaSH.Sized.Internal.Unsigned.json b/primitives/CLaSH.Sized.Internal.Unsigned.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Sized.Internal.Unsigned.json @@ -0,0 +1,195 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.size#" + , "type" : "size# :: KnownNat n => Unsigned n -> Int" + , "templateE" : "~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.pack#" + , "type" : "pack# :: Unsigned n -> BitVector n" + , "templateE" : "std_logic_vector(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.unpack#" + , "type" : "unpack# :: BitVector n -> Unsigned n" + , "templateE" : "unsigned(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.eq#" + , "type" : "eq# :: Unsigned n -> Unsigned n -> Bool" + , "templateE" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.neq#" + , "type" : "neq# :: Unsigned n -> Unsigned n -> Bool" + , "templateE" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.lt#" + , "type" : "lt# :: Unsigned n -> Unsigned n -> Bool" + , "templateE" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.ge#" + , "type" : "ge# :: Unsigned n -> Unsigned n -> Bool" + , "templateE" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.gt#" + , "type" : "gt# :: Unsigned n -> Unsigned n -> Bool" + , "templateE" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.le#" + , "type" : "le# :: Unsigned n -> Unsigned n -> Bool" + , "templateE" : "~ARG[0] <= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.minBound#" + , "type" : "minBound# :: KnownNat n => Unsigned n" + , "comment" : "Generates incorrect VDHL for n=0" + , "templateE" : "unsigned'(~LIT[0]-1 downto 0 => '0');" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.maxBound#" + , "type" : "maxBound# :: KnownNat n => Unsigned n" + , "comment" : "Generates incorrect VDHL for n=0" + , "templateE" : "unsigned'(~LIT[0]-1 downto 0 => '1');" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.+#" + , "type" : "(+#) :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n" + , "templateE" : "~ARG[1] + ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.-#" + , "type" : "(-#) :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n" + , "templateE" : "~ARG[1] - ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.*#" + , "type" : "(*#) :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n" + , "templateE" : "resize(~ARG[1] * ~ARG[2], ~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.negate#" + , "type" : "negate# :: KnownNat n => Unsigned n -> Unsigned n" + , "templateE" : "unsigned(std_logic_vector(-(signed(std_logic_vector(~ARG[1])))))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.fromInteger#" + , "type" : "fromInteger# :: KnownNat n => Integer -> Unsigned n" + , "templateE" : "to_unsigned(~ARG[1],~LIT[0])" + } + } +, { "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])" + } + } +, { "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])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.times#" + , "type" : "times# :: KnownNat (m + n) => Unsigned m -> Unsigned n -> Unsigned (m + n)" + , "templateE" : "~ARG[1] * ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.quot#" + , "type" : "quot# :: Unsigned n -> Unsigned n -> Unsigned n" + , "templateE" : "~ARG[1] / ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.rem#" + , "type" : "rem# :: Unsigned n -> Unsigned n -> Unsigned n" + , "templateE" : "~ARG[1] rem ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.mod#" + , "type" : "mod# :: Unsigned n -> Unsigned n -> Unsigned n" + , "templateE" : "~ARG[1] mod ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.toInteger#" + , "type" : "toInteger# :: Unsigned n -> Integer" + , "templateE" : "to_integer(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.and#" + , "type" : "and# :: Unsigned n -> Unsigned n -> Unsigned n" + , "templateE" : "~ARG[0] and ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.or#" + , "type" : "or# :: Unsigned n -> Unsigned n -> Unsigned n" + , "templateE" : "~ARG[0] or ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.xor#" + , "type" : "xor# :: Unsigned n -> Unsigned n -> Unsigned n" + , "templateE" : "~ARG[0] xor ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.complement#" + , "type" : "complement# :: KnownNat n => Unsigned n -> Unsigned n" + , "templateE" : "not ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.shiftL#" + , "type" : "shiftL# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "templateE" : "shift_left(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.shiftR#" + , "type" : "shiftR# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "templateE" : "shift_right(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.rotateL#" + , "type" : "rotateL# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "templateE" : "rotate_left(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.rotateR#" + , "type" : "rotateR# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "templateE" : "rotate_right(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.resize#" + , "type" : "resize# :: KnownNat m => Unsigned n -> Unsigned m" + , "templateE" : "resize(~ARG[1],~LIT[0])" + } + } +] diff --git a/primitives/CLaSH.Sized.Vector.json b/primitives/CLaSH.Sized.Vector.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Sized.Vector.json @@ -0,0 +1,384 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.eq#" + , "type" : "eq# :: Eq a => Vec n a -> Vec n a -> Bool" + , "templateE" : "~ARG[1] = ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.neq#" + , "type" : "neq# :: Eq a => Vec n a -> Vec n a -> Bool" + , "templateE" : "~ARG[1] /= ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.head" + , "type" : "head :: Vec (n + 1) a -> a" + , "templateD" : +"head_~SYM[0] : block + signal ~SYM[1] : ~TYP[0]; +begin + ~SYM[1] <= ~ARG[0]; + ~RESULT <= ~SYM[1](0); +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.tail" + , "type" : "tail :: Vec (n + 1) a -> Vec n a" + , "templateD" : +"tail_~SYM[0] : block + signal ~SYM[1] : ~TYP[0]; +begin + ~SYM[1] <= ~ARG[0]; + ~RESULT <= ~SYM[1](1 to ~SYM[1]'high); +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.last" + , "type" : "Vec (n + 1) a -> a" + , "templateD" : +"last_~SYM[0] : block + signal ~SYM[1] : ~TYP[0]; +begin + ~SYM[1] <= ~ARG[0]; + ~RESULT <= ~SYM[1](~SYM[1]'high); +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.init" + , "type" : "Vec (n + 1) a -> Vec n a" + , "templateD" : +"init_~SYM[0] : block + signal ~SYM[1] : ~TYP[0]; +begin + ~SYM[1] <= ~ARG[0]; + ~RESULT <= ~SYM[1](0 to ~SYM[1]'high - 1); +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.select" + , "type" : +"select :: (CmpNat (i + s) (s * n) ~ GT) -- ARG[0] + => SNat f -- ARG[1] + -> SNat s -- ARG[2] + -> SNat n -- ARG[3] + -> Vec i a -- ARG[4] + -> Vec n a" + , "templateD" : +"select_~SYM[0] : block + signal ~SYM[1] : ~TYP[4]; +begin + ~SYM[1] <= ~ARG[4]; + + selectZ_~SYM[2] : if ~RESULT'length = 0 generate + ~RESULT <= ~ERRORO; + end generate; + + selectSN_~SYM[3] : if ~RESULT'length /= 0 generate + selectIter_~SYM[4] : for ~SYM[5] in ~RESULT'range generate + begin + ~RESULT(~SYM[5]) <= ~SYM[1](~LIT[1]+(~LIT[2]*~SYM[5])); + end generate; + end generate; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.++" + , "type" : "(++) :: Vec n a -> Vec m a -> Vec (n + m) a" + , "templateE" : "~TYPM[0]'(~ARG[0]) & ~TYPM[1]'(~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.concat" + , "type" : "concat :: Vec n (Vec m a) -> Vec (n * m) a" + , "templateD" : +"concat_~SYM[0] : block + signal ~SYM[1] : ~TYP[0]; +begin + ~SYM[1] <= ~ARG[0]; + + concatZ_~SYM[2] : if ~RESULT'length = 0 generate + ~RESULT <= ~ERRORO; + end generate; + + concatSN_~SYM[3] : if ~RESULT'length /= 0 generate + concatIter_~SYM[4] : for ~SYM[5] in ~SYM[1]'range generate + begin + ~RESULT((~SYM[5] * ~SYM[1](0)'length) to ((~SYM[5] * ~SYM[1](0)'length) + ~SYM[1](0)'high)) <= ~SYM[1](~SYM[5]); + end generate; + end generate; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.splitAt" + , "type" : "splitAt :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a)" + , "templateD" : +"splitAt_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; +begin + ~SYM[1] <= ~ARG[1]; + ~RESULT <= (~SYM[1](~RESULT.~TYPMO_sel0'left to ~RESULT.~TYPMO_sel0'right) + ,~SYM[1](~RESULT.~TYPMO_sel1'left + ~RESULT.~TYPMO_sel0'length to ~RESULT.~TYPMO_sel1'right + ~RESULT.~TYPMO_sel0'length)); +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.unconcat" + , "type" : +"unconcat :: KnownNat n -- ARG[0] + => SNat m -- ARG[1] + -> Vec (n * m) a -- ARG[2] + -> Vec n (Vec m a)" + , "templateD" : +"unconcat_~SYM[0] : block + signal ~SYM[1] : ~TYP[2]; +begin + ~SYM[1] <= ~ARG[2]; + + unconcatZ_~SYM[2] : if ~SYM[1]'length = 0 generate + ~RESULT <= ~ERRORO; + end generate; + + unconcatSN_~SYM[3] : if ~SYM[1]'length /= 0 generate + unconcatIter_~SYM[4] : for ~SYM[5] in ~RESULT'range generate + begin + ~RESULT(~SYM[5]) <= ~SYM[1]((~SYM[5] * ~LIT[1]) to ((~SYM[5] * ~LIT[1]) + ~LIT[1] - 1)); + end generate; + end generate; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.merge" + , "type" : "merge :: Vec n a -> Vec n a -> Vec (n + n) a" + , "templateD" : +"merge_~SYM[0] : block + signal ~SYM[1] : ~TYP[0]; + signal ~SYM[2] : ~TYP[1]; +begin + ~SYM[1] <= ~ARG[0]; + ~SYM[2] <= ~ARG[1]; + + mergeZ_~SYM[3] : if ~RESULT'length = 0 generate + ~RESULT <= ~ERRORO; + end generate; + + mergeSN_~SYM[4] : if ~RESULT'length /= 0 generate + mergeIter_~SYM[5] : for ~SYM[6] in ~SYM[1]'range generate + begin + ~RESULT(2*~SYM[6]) <= ~SYM[1](~SYM[6]); + ~RESULT(2*~SYM[6]+1) <= ~SYM[2](~SYM[6]); + end generate; + end generate; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.map" + , "type" : "map :: (a -> b) -> Vec n a -> Vec n b" + , "templateD" : +"map_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; +begin + ~SYM[1] <= ~ARG[1]; + + mapZ_~SYM[2] : if ~RESULT'length = 0 generate + ~RESULT <= ~ERRORO; + end generate; + + mapSN_~SYM[3] : if ~RESULT'length /= 0 generate + mapIter_~SYM[4] : for ~SYM[5] in ~RESULT'range generate + begin + ~INST 0 + ~OUTPUT <= ~RESULT(~SYM[5])~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[1](~SYM[5])~ ~TYPEL[~TYP[1]]~ + ~INST + end generate; + end generate; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.zipWith" + , "type" : "zipWith :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c" + , "templateD" : +"zipWith_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; + signal ~SYM[2] : ~TYP[2]; +begin + ~SYM[1] <= ~ARG[1]; + ~SYM[2] <= ~ARG[2]; + + zipWithZ_~SYM[3] : if ~RESULT'length = 0 generate + ~RESULT <= ~ERRORO; + end generate; + + zipWithSN_~SYM[4] : if ~RESULT'length /= 0 generate + zipWithIter_~SYM[5] : for ~SYM[6] in ~RESULT'range generate + begin + ~INST 0 + ~OUTPUT <= ~RESULT(~SYM[6])~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[1](~SYM[6])~ ~TYPEL[~TYP[1]]~ + ~INPUT <= ~SYM[2](~SYM[6])~ ~TYPEL[~TYP[2]]~ + ~INST + end generate; + end generate; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.index_int" + , "type" : "index_int :: KnownNat n => Vec n a -> Int -> a" + , "templateD" : +"indexVec_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; + signal ~SYM[2] : ~TYP[2]; +begin + ~SYM[1] <= ~ARG[1]; + ~SYM[2] <= ~ARG[2]; + -- pragma translate_off + process (~SYM[1],~SYM[2]) + begin + if ~SYM[2] < ~SYM[1]'low or ~SYM[2] > ~SYM[1]'high then + assert false report (\"Index: \" & integer'image(~SYM[2]) & \", is out of bounds: \" & integer'image(~SYM[1]'low) & \" to \" & integer'image(~SYM[1]'high)) severity warning; + ~RESULT <= ~ERRORO; + else + -- pragma translate_on + ~RESULT <= ~SYM[1](~SYM[2]); + -- pragma translate_off + end if; + end process; + -- pragma translate_on +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.replace_int" + , "type" : "replace_int :: KnownNat n => Vec n a -> Int -> a -> Vec n a" + , "templateD" : +"replaceVec_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; + signal ~SYM[2] : ~TYP[2]; + signal ~SYM[3] : ~TYP[3]; +begin + ~SYM[1] <= ~ARG[1]; + ~SYM[2] <= ~ARG[2]; + ~SYM[3] <= ~ARG[3]; + process(~SYM[1],~SYM[2],~SYM[3]) + variable ~SYM[4] : ~TYP[1]; + begin + ~SYM[4] := ~SYM[1]; + -- pragma translate_off + if ~SYM[2] < ~SYM[4]'low or ~SYM[2] > ~SYM[4]'high then + assert false report (\"Index: \" & integer'image(~SYM[2]) & \", is out of bounds: \" & integer'image(~SYM[1]'low) & \" to \" & integer'image(~SYM[1]'high)) severity warning; + ~SYM[4] := ~ERROR[1]; + else + -- pragma translate_on + ~SYM[4](~SYM[2]) := ~SYM[3]; + -- pragma translate_off + end if; + -- pragma translate_on + ~RESULT <= ~SYM[4]; + end process; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.maxIndex" + , "type" : "maxIndex :: KnownNat n => Vec n a -> Integer" + , "templateE" : "~LIT[0] - 1" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.length" + , "type" : "length :: KnownNat n => Vec n a -> Integer" + , "templateE" : "~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.replicate" + , "type" : "replicate :: SNat n -> a -> Vec n a" + , "templateE" : "~TYPMO'(0 to ~LIT[0]-1 => ~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.reverse" + , "type" : "reverse :: Vec n a -> Vec n a" + , "templateD" : +"reverse_~SYM[0] : block + signal ~SYM[1] : ~TYP[0]; +begin + ~SYM[1] <= ~ARG[0]; + + reverseZ_~SYM[2] : if ~RESULT'length = 0 generate + ~RESULT <= ~SYM[1]; + end generate; + + reverseSN_~SYM[3] : if ~RESULT'length /= 0 generate + reverseIter_~SYM[4] : for ~SYM[5] in ~SYM[1]'range generate + ~RESULT(~SYM[1]'high - ~SYM[5]) <= ~SYM[1](~SYM[5]); + end generate; + end generate; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.lazyV" + , "type" : "lazyV :: KnownNat n => Vec n a -> Vec n a" + , "templateE" : "~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.concatBitVector#" + , "type" : +"concatBitVector# :: KnownNat m -- ARG[0] + => Vec n (BitVector m) -- ARG[1] + -> BitVector (n * m)" + , "templateD" : +"concatBitVector_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; +begin + ~SYM[1] <= ~ARG[1]; + + concatBitVectorZ_~SYM[2] : if ~RESULT'length = 0 generate + ~RESULT <= ~ERRORO; + end generate; + + concatBitVectorSN_~SYM[3] : if ~RESULT'length /= 0 generate + concatBitVectorIter_~SYM[4] : for ~SYM[5] in ~SYM[1]'range generate + ~RESULT(((~SYM[5] * ~LIT[0]) + ~LIT[0] - 1) downto (~SYM[5] * ~LIT[0])) <= ~TYPMO(~SYM[1](~SYM[5])); + end generate; + end generate; +end block;" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.unconcatBitVector#" + , "type" : +"unconcatBitVector# :: (KnownNat n, KnownNat m) -- (ARG[0],ARG[1]) + => BitVector (n * m) -- ARG[2] + -> Vec n (BitVector m)" + , "templateD" : +"unconcatBitVector_~SYM[0] : block + signal ~SYM[1] : ~TYP[2]; +begin + ~SYM[1] <= ~ARG[2]; + + unconcatBitVectorZ_~SYM[2] : if ~SYM[1]'length = 0 generate + ~RESULT <= ~ERRORO; + end generate; + + unconcatBitVectorSN_~SYM[3] : if ~SYM[1]'length /= 0 generate + unconcatBitVectorIter_~SYM[4] : for ~SYM[5] in ~RESULT'range generate + ~RESULT(~SYM[5]) <= ~SYM[1](((~SYM[5] * ~LIT[1]) + ~LIT[1] - 1) downto (~SYM[5] * ~LIT[1])); + end generate; + end generate; +end block;" + } + } +] diff --git a/primitives/Control.Exception.Base.json b/primitives/Control.Exception.Base.json new file mode 100644 --- /dev/null +++ b/primitives/Control.Exception.Base.json @@ -0,0 +1,25 @@ +[ { "BlackBox" : + { "name" : "Control.Exception.Base.patError" + , "type" : "patError :: Addr# -> a" + , "templateE" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.irrefutPatError" + , "type" : "irrefutPatError :: Addr# -> a" + , "templateE" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.recSelError" + , "type" : "recSelError :: Addr# -> a" + , "templateE" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.absentError" + , "type" : "absentError :: Addr# -> a" + , "templateE" : "~ERRORO" + } + } +] diff --git a/primitives/GHC.Base.json b/primitives/GHC.Base.json new file mode 100644 --- /dev/null +++ b/primitives/GHC.Base.json @@ -0,0 +1,37 @@ +[ { "Primitive" : + { "name" : "GHC.Base.$" + , "primType" : "Function" + } + } +, { "BlackBox" : + { "name" : "GHC.Base.quotInt" + , "type" : "quotInt :: Int -> Int -> Int" + , "templateE" : "~ARG[0] / ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Base.remInt" + , "type" : "remInt :: Int -> Int -> Int" + , "templateE" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Base.divInt" + , "type" : "divInt :: Int -> Int -> Int" + , "templateD" : +"divInt_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; +begin + ~SYM[1] <= ~ARG[0] / ~ARG[1]; + ~RESULT <= ~SYM[1] - 1 when ((~ARG[0] = abs ~ARG[0]) /= (~ARG[1] = abs ~ARG[1])) else + ~SYM[1]; +end block;" + } + } +, { "BlackBox" : + { "name" : "GHC.Base.modInt" + , "type" : "modInt :: Int -> Int -> Int" + , "templateE" : "~ARG[0] mod ~ARG[1]" + } + } +] diff --git a/primitives/GHC.CString.json b/primitives/GHC.CString.json new file mode 100644 --- /dev/null +++ b/primitives/GHC.CString.json @@ -0,0 +1,11 @@ +[ { "Primitive" : + { "name" : "GHC.CString.unpackCString#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "GHC.CString.unpackCStringUtf8#" + , "primType" : "Function" + } + } +] diff --git a/primitives/GHC.Classes.json b/primitives/GHC.Classes.json new file mode 100644 --- /dev/null +++ b/primitives/GHC.Classes.json @@ -0,0 +1,74 @@ +[ { "BlackBox" : + { "name" : "GHC.Classes.eqInt" + , "type" : "eqInt :: Int -> Int -> Bool" + , "templateE" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.neInt" + , "type" : "neInt :: Int -> Int -> Bool" + , "templateE" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.gtInt" + , "type" : "gtInt :: Int -> Int -> Bool" + , "templateE" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.geInt" + , "type" : "geInt :: Int -> Int -> Bool" + , "templateE" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.ltInt" + , "type" : "ltInt :: Int -> Int -> Bool" + , "templateE" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.leInt" + , "type" : "leInt :: Int -> Int -> Bool" + , "templateE" : "~ARG[0] <= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.&&" + , "type" : "(&&) :: Bool -> Bool -> Bool" + , "templateE" : "~ARG[0] and ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.||" + , "type" : "(::) :: Bool -> Bool -> Bool" + , "templateE" : "~ARG[0] or ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.not" + , "type" : "not :: Bool -> Bool" + , "templateE" : "not ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.divInt#" + , "type" : "divInt# :: Int# -> Int# -> Int#" + , "templateD" : +"divInt_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; +begin + ~SYM[1] <= ~ARG[0] / ~ARG[1]; + ~RESULT <= ~SYM[1] - 1 when ((~ARG[0] = abs ~ARG[0]) /= (~ARG[1] = abs ~ARG[1])) else + ~SYM[1]; +end block;" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.modInt#" + , "type" : "modInt# :: Int# -> Int# -> Int#" + , "templateE" : "~ARG[0] mod ~ARG[1]" + } + } +] diff --git a/primitives/GHC.Err.json b/primitives/GHC.Err.json new file mode 100644 --- /dev/null +++ b/primitives/GHC.Err.json @@ -0,0 +1,13 @@ +[ { "BlackBox" : + { "name" : "GHC.Err.error" + , "type" : "error :: [Char] -> a" + , "templateE" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "GHC.Err.undefined" + , "type" : "undefined :: a" + , "templateE" : "~ERRORO" + } + } +] diff --git a/primitives/GHC.Integer.Type.json b/primitives/GHC.Integer.Type.json new file mode 100644 --- /dev/null +++ b/primitives/GHC.Integer.Type.json @@ -0,0 +1,158 @@ +[ { "BlackBox" : + { "name" : "GHC.Integer.Type.smallInteger" + , "type" : "smallInteger :: Int# -> Integer" + , "templateE" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.integerToInt" + , "type" : "integerToInt :: Integer -> Int#" + , "templateE" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.plusInteger" + , "type" : "plusInteger :: Integer -> Integer -> Integer" + , "templateE" : "~ARG[0] + ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.minusInteger" + , "type" : "minusInteger :: Integer -> Integer -> Integer" + , "templateE" : "~ARG[0] - ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.timesInteger" + , "type" : "timesInteger :: Integer -> Integer -> Integer" + , "templateE" : "~ARG[0] * ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.negateInteger" + , "type" : "negateInteger :: Integer -> Integer" + , "templateE" : "-~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.absInteger" + , "type" : "absInteger :: Integer -> Integer" + , "templateE" : "abs ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.divInteger" + , "type" : "divInteger :: Integer -> Integer -> Integer" + , "templateD" : +"divInteger_~SYM[0] : block + signal ~SYM[1] : ~TYP[1]; +begin + ~SYM[1] <= ~ARG[0] / ~ARG[1]; + ~RESULT <= ~SYM[1] - 1 when ((~ARG[0] = abs ~ARG[0]) /= (~ARG[1] = abs ~ARG[1])) else + ~SYM[1]; +end block;" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.modInteger" + , "type" : "modInteger :: Integer -> Integer -> Integer" + , "templateE" : "~ARG[0] mod ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.quotInteger" + , "type" : "quotInteger :: Integer -> Integer -> Integer" + , "templateE" : "~ARG[0] / ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.remInteger" + , "type" : "remInteger :: Integer -> Integer -> Integer" + , "templateE" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.eqInteger" + , "type" : "eqInteger :: Integer -> Integer -> Bool" + , "templateE" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.neqInteger" + , "type" : "neqInteger :: Integer -> Integer -> Bool" + , "templateE" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.leInteger" + , "type" : "leInteger :: Integer -> Integer -> Bool" + , "templateE" : "~ARG[0] <= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.gtInteger" + , "type" : "gtInteger :: Integer -> Integer -> Bool" + , "templateE" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.ltInteger" + , "type" : "ltInteger :: Integer -> Integer -> Bool" + , "templateE" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.geInteger" + , "type" : "geInteger :: Integer -> Integer -> Bool" + , "templateE" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.eqInteger#" + , "type" : "eqInteger# :: Integer -> Integer -> Int#" + , "templateD" : "~RESULT <= 1 when ~ARG[0] = ~ARG[1] else 0;" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.neqInteger#" + , "type" : "neqInteger# :: Integer -> Integer -> Int#" + , "templateD" : "~RESULT <= 1 when ~ARG[0] /= ~ARG[1] else 0;" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.leInteger#" + , "type" : "leInteger# :: Integer -> Integer -> Int#" + , "templateD" : "~RESULT <= 1 when ~ARG[0] <= ~ARG[1] else 0;" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.gtInteger#" + , "type" : "gtInteger# :: Integer -> Integer -> Int#" + , "templateD" : "~RESULT <= 1 when ~ARG[0] > ~ARG[1] else 0;" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.ltInteger#" + , "type" : "ltInteger# :: Integer -> Integer -> Int#" + , "templateD" : "~RESULT <= 1 when ~ARG[0] < ~ARG[1] else 0;" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.geInteger#" + , "type" : "geInteger# :: Integer -> Integer -> Int#" + , "templateD" : "~RESULT <= 1 when ~ARG[0] >= ~ARG[1] else 0;" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.shiftRInteger" + , "type" : "shiftRInteger :: Integer -> Int# -> Integer" + , "templateE" : "~ARG[0] / (2**~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.shiftLInteger" + , "type" : "shiftLInteger :: Integer -> Int# -> Integer" + , "templateE" : "~ARG[0] * (2**~ARG[1])" + } + } +] diff --git a/primitives/GHC.Prim.json b/primitives/GHC.Prim.json new file mode 100644 --- /dev/null +++ b/primitives/GHC.Prim.json @@ -0,0 +1,89 @@ +[ { "BlackBox" : + { "name" : "GHC.Prim.+#" + , "type" : "(+#) :: Int# -> Int# -> Int#" + , "templateE" : "~ARG[0] + ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.-#" + , "type" : "(-#) :: Int# -> Int# -> Int#" + , "templateE" : "~ARG[0] - ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.*#" + , "type" : "(*#) :: Int# -> Int# -> Int#" + , "templateE" : "~ARG[0] * ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.quotInt#" + , "type" : "quotInt# :: Int# -> Int# -> Int#" + , "templateE" : "~ARG[0] / ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.remInt#" + , "type" : "remInt# :: Int# -> Int# -> Int#" + , "templateE" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.negateInt#" + , "type" : "negateInt# :: Int# -> Int#" + , "templateE" : "-~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.>#" + , "type" : "(>#) :: Int# -> Int# -> Bool" + , "templateD" : "~RESULT <= 1 when ~ARG[0] > ~ARG[1] else 0;" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.>=#" + , "type" : "(>=#) :: Int# -> Int# -> Bool" + , "templateD" : "~RESULT <= 1 when ~ARG[0] >= ~ARG[1] else 0;" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.==#" + , "type" : "(==) :: Int# -> Int# -> Bool" + , "templateD" : "~RESULT <= 1 when ~ARG[0] = ~ARG[1] else 0;" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim./=#" + , "type" : "(/=#) :: Int# -> Int# -> Bool" + , "templateD" : "~RESULT <= 1 when ~ARG[0] /= ~ARG[1] else 0;" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.<#" + , "type" : "(<#) :: Int# -> Int# -> Bool" + , "templateD" : "~RESULT <= 1 when ~ARG[0] < ~ARG[1] else 0;" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.<=#" + , "type" : "(<=#) :: Int# -> Int# -> Bool" + , "templateD" : "~RESULT <= 1 when ~ARG[0] <= ~ARG[1] else 0;" + } + } +, { "Primitive" : + { "name" : "GHC.Prim.dataToTag#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "GHC.Prim.tagToEnum#" + , "primType" : "Function" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.unsafeCoerce#" + , "type" : "unsafeCoerce# :: a -> b" + , "templateE" : "~ARG[0]" + } + } +] diff --git a/primitives/GHC.Real.json b/primitives/GHC.Real.json new file mode 100644 --- /dev/null +++ b/primitives/GHC.Real.json @@ -0,0 +1,19 @@ +[ { "BlackBox" : + { "name" : "GHC.Real.divZeroError" + , "type" : "divZeroError :: a" + , "templateE" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "GHC.Real.ratioZeroDenominatorError" + , "type" : "ratioZeroDenominatorError :: a" + , "templateE" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "GHC.Real.overflowError" + , "type" : "overflowError :: a" + , "templateE" : "~ERRORO" + } + } +] diff --git a/primitives/GHC.Typelits.json b/primitives/GHC.Typelits.json new file mode 100644 --- /dev/null +++ b/primitives/GHC.Typelits.json @@ -0,0 +1,7 @@ +[ { "BlackBox" : + { "name" : "GHC.TypeLits.natVal" + , "type" : "natVal :: forall n proxy. KnownNat n => proxy n -> Integer" + , "templateE" : "~LIT[0]" + } + } +] diff --git a/primitives/GHC.Types.json b/primitives/GHC.Types.json new file mode 100644 --- /dev/null +++ b/primitives/GHC.Types.json @@ -0,0 +1,11 @@ +[ { "Primitive" : + { "name" : "GHC.Types.Eq#" + , "primType" : "Constructor" + } + } +, { "Primitive" : + { "name" : "GHC.Types.MkCoercible" + , "primType" : "Constructor" + } + } +] diff --git a/primitives/Unsafe.Coerce.json b/primitives/Unsafe.Coerce.json new file mode 100644 --- /dev/null +++ b/primitives/Unsafe.Coerce.json @@ -0,0 +1,7 @@ +[ { "BlackBox" : + { "name" : "Unsafe.Coerce.unsafeCoerce" + , "type" : "unsafeCoerce :: a -> b" + , "templateE" : "~ARG[0]" + } + } +] diff --git a/src/CLaSH/Backend/VHDL.hs b/src/CLaSH/Backend/VHDL.hs new file mode 100644 --- /dev/null +++ b/src/CLaSH/Backend/VHDL.hs @@ -0,0 +1,651 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecursiveDo #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} + +-- | Generate VHDL for assorted Netlist datatypes +module CLaSH.Backend.VHDL (VHDLState) where + +import qualified Control.Applicative as A +import Control.Lens hiding (Indexed) +import Control.Monad (forM,join,liftM,zipWithM) +import Control.Monad.State (State) +import Data.Graph.Inductive (Gr, mkGraph, topsort') +import Data.HashMap.Lazy (HashMap) +import qualified Data.HashMap.Lazy as HashMap +import Data.HashSet (HashSet) +import qualified Data.HashSet as HashSet +import Data.List (mapAccumL,nubBy) +import Data.Maybe (catMaybes,mapMaybe) +import Data.Text.Lazy (unpack) +import qualified Data.Text.Lazy as T +import Text.PrettyPrint.Leijen.Text.Monadic + +import CLaSH.Backend +import CLaSH.Netlist.BlackBox.Util (extractLiterals, renderBlackBox) +import CLaSH.Netlist.Types +import CLaSH.Netlist.Util +import CLaSH.Util (clog2, curLoc, makeCached, (<:>)) + +#ifdef CABAL +import qualified Paths_clash_vhdl +#else +import qualified System.FilePath +#endif + +-- | State for the 'CLaSH.Netlist.VHDL.VHDLM' monad: +data VHDLState = + VHDLState + { _tyCache :: (HashSet HWType) -- ^ Previously encountered HWTypes + , _tyCount :: Int -- ^ Product type counter + , _nameCache :: (HashMap HWType Doc) -- ^ Cache for previously generated product type names + } + +makeLenses ''VHDLState + +instance Backend VHDLState where + initBackend = VHDLState HashSet.empty 0 HashMap.empty +#ifdef CABAL + primDir = const (Paths_clash_vhdl.getDataFileName "primitives") +#else + primDir _ = return ("clash-vhdl" System.FilePath. "primitives") +#endif + extractTypes = _tyCache + name = const "vhdl" + extension = const ".vhdl" + + genHDL = genVHDL + mkTyPackage = mkTyPackage_ + hdlType = vhdlType + hdlTypeErrValue = vhdlTypeErrValue + hdlTypeMark = vhdlTypeMark + hdlSig t ty = sigDecl (text t) ty + inst = inst_ + expr = expr_ + +type VHDLM a = State VHDLState a + +-- | Generate VHDL for a Netlist component +genVHDL :: Component -> VHDLM (String,Doc) +genVHDL c = (unpack cName,) A.<$> vhdl + where + cName = componentName c + vhdl = "-- Automatically generated VHDL" <$$> + tyImports <$$> linebreak <> + entity c <$$> linebreak <> + architecture c + +-- | Generate a VHDL package containing type definitions for the given HWTypes +mkTyPackage_ :: [HWType] + -> VHDLM Doc +mkTyPackage_ hwtys = + "library IEEE;" <$> + "use IEEE.STD_LOGIC_1164.ALL;" <$> + "use IEEE.NUMERIC_STD.ALL;" <$$> linebreak <> + "package" <+> "types" <+> "is" <$> + indent 2 ( packageDec <$> + vcat (sequence funDecs) + ) <$> + "end" <> semi <> packageBodyDec + where + usedTys = concatMap mkUsedTys hwtys + needsDec = nubBy eqReprTy $ (hwtys ++ usedTys) + hwTysSorted = topSortHWTys needsDec + packageDec = vcat $ mapM tyDec hwTysSorted + (funDecs,funBodies) = unzip $ maxDec : (catMaybes $ map funDec (nubBy eqTypM needsDec)) + + packageBodyDec :: VHDLM Doc + packageBodyDec = case funBodies of + [] -> empty + _ -> linebreak <$> + "package" <+> "body" <+> "types" <+> "is" <$> + indent 2 (vcat (sequence funBodies)) <$> + "end" <> semi + + eqReprTy :: HWType -> HWType -> Bool + eqReprTy (Vector _ ty1) (Vector _ ty2) = eqReprTy ty1 ty2 + eqReprTy ty1 ty2 + | isUnsigned ty1 && isUnsigned ty2 || + isSLV ty1 && isSLV ty2 = typeSize ty1 == typeSize ty2 + | otherwise = ty1 == ty2 + + eqTypM (Vector _ ty1) (Vector _ ty2) = eqReprTy ty1 ty2 + eqTypM (Signed _) (Signed _) = True + eqTypM ty1 ty2 = isUnsigned ty1 && isUnsigned ty2 || + isSLV ty1 && isSLV ty2 || + ty1 == ty2 + + isUnsigned :: HWType -> Bool + isUnsigned (Unsigned _) = True + isUnsigned (Index _) = True + isUnsigned (Sum _ _) = True + isUnsigned _ = False + + isSLV :: HWType -> Bool + isSLV (BitVector _) = True + isSLV (SP _ _) = True + isSLV _ = False + +mkUsedTys :: HWType + -> [HWType] +mkUsedTys v@(Vector _ 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] + +topSortHWTys :: [HWType] + -> [HWType] +topSortHWTys hwtys = sorted + where + nodes = zip [0..] hwtys + nodesI = HashMap.fromList (zip hwtys [0..]) + edges = concatMap edge hwtys + graph = mkGraph nodes edges :: Gr HWType () + sorted = reverse $ topsort' graph + + edge t@(Vector _ elTy) = maybe [] ((:[]) . (HashMap.lookupDefault (error $ $(curLoc) ++ "Vector") 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 t@(SP _ ctys) = let ti = HashMap.lookupDefault (error $ $(curLoc) ++ "SP") t nodesI + in concatMap (\(_,tys) -> mapMaybe (\ty -> liftM (ti,,()) (HashMap.lookup (mkVecZ ty) nodesI)) tys) ctys + edge _ = [] + +mkVecZ :: HWType -> HWType +mkVecZ (Vector _ elTy) = Vector 0 elTy +mkVecZ t = t + +tyDec :: HWType -> VHDLM Doc +tyDec (Vector _ elTy) = "type" <+> "array_of_" <> tyName elTy <+> "is array (integer range <>) of" <+> vhdlType elTy <> semi + +tyDec ty@(Product _ tys) = prodDec + where + prodDec = "type" <+> tName <+> "is record" <$> + indent 2 (vcat $ zipWithM (\x y -> x <+> colon <+> y <> semi) selNames selTys) <$> + "end record" <> semi + + tName = tyName ty + selNames = map (\i -> tName <> "_sel" <> int i) [0..] + selTys = map vhdlType tys + +tyDec _ = empty + + +maxDec :: (VHDLM Doc, VHDLM Doc) +maxDec = + ( "function" <+> "max" <+> parens ("left, right: in integer") <+> "return integer" <> semi + , "function" <+> "max" <+> parens ("left, right: in integer") <+> "return integer" <+> "is" <$> + "begin" <$> + indent 2 (vcat $ sequence [ "if" <+> "left > right" <+> "then return left" <> semi + , "else return right" <> semi + , "end if" <> semi + ]) <$> + "end" <> semi + ) + +funDec :: HWType -> Maybe (VHDLM Doc,VHDLM Doc) +funDec Bool = Just + ( "function" <+> "toSLV" <+> parens ("b" <+> colon <+> "in" <+> "boolean") <+> "return" <+> "std_logic_vector" <> semi <$> + "function" <+> "fromSLV" <+> parens ("sl" <+> colon <+> "in" <+> "std_logic_vector") <+> "return" <+> "boolean" <> semi + , "function" <+> "toSLV" <+> parens ("b" <+> colon <+> "in" <+> "boolean") <+> "return" <+> "std_logic_vector" <+> "is" <$> + "begin" <$> + indent 2 (vcat $ sequence ["if" <+> "b" <+> "then" + , indent 2 ("return" <+> dquotes (int 1) <> semi) + ,"else" + , indent 2 ("return" <+> dquotes (int 0) <> semi) + ,"end" <+> "if" <> semi + ]) <$> + "end" <> semi <$> + "function" <+> "fromSLV" <+> parens ("sl" <+> colon <+> "in" <+> "std_logic_vector") <+> "return" <+> "boolean" <+> "is" <$> + "begin" <$> + indent 2 (vcat $ sequence ["if" <+> "sl" <+> "=" <+> dquotes (int 1) <+> "then" + , indent 2 ("return" <+> "true" <> semi) + ,"else" + , indent 2 ("return" <+> "false" <> semi) + ,"end" <+> "if" <> semi + ]) <$> + "end" <> semi + ) + +funDec Integer = Just + ( "function" <+> "to_integer" <+> parens ("i" <+> colon <+> "in" <+> "integer") <+> "return" <+> "integer" <> semi <$> + "function" <+> "toSLV" <+> parens ("i" <+> colon <+> "in" <+> "integer") <+> "return" <+> "std_logic_vector" <> semi + , "function" <+> "to_integer" <+> parens ("i" <+> colon <+> "in" <+> "integer") <+> "return" <+> "integer" <+> "is" <$> + "begin" <$> + indent 2 ("return" <+> "i" <> semi) <$> + "end" <> semi <$> + "function" <+> "toSLV" <+> parens ("i" <+> colon <+> "in" <+> "integer") <+> "return" <+> "std_logic_vector" <+> "is" <$> + "begin" <$> + indent 2 ("return" <+> "std_logic_vector" <> parens ("to_signed" <> parens ("i" <> comma <> int 32)) <> semi) <$> + "end" <> semi + ) + +funDec (Index _) = Just unsignedToSlvDec + +funDec (Signed _) = Just + ( "function" <+> "toSLV" <+> parens ("s" <+> colon <+> "in" <+> "signed") <+> "return" <+> "std_logic_vector" <> semi + , "function" <+> "toSLV" <+> parens ("s" <+> colon <+> "in" <+> "signed") <+> "return" <+> "std_logic_vector" <+> "is" <$> + "begin" <$> + indent 2 ("return" <+> "std_logic_vector" <> parens ("s") <> semi) <$> + "end" <> semi + ) + +funDec (Unsigned _) = Just unsignedToSlvDec + +funDec (Sum _ _) = Just unsignedToSlvDec + +funDec t@(Product _ elTys) = Just + ( "function" <+> "toSLV" <+> parens ("p :" <+> vhdlType t) <+> "return std_logic_vector" <> semi + , "function" <+> "toSLV" <+> parens ("p :" <+> vhdlType t) <+> "return std_logic_vector" <+> "is" <$> + "begin" <$> + indent 2 ("return" <+> parens (hcat (punctuate " & " elTyPrint)) <> semi) <$> + "end" <> semi + ) + where + elTyPrint = forM [0..(length elTys - 1)] + (\i -> "toSLV" <> + parens ("p." <> vhdlType t <> "_sel" <> int i)) + +funDec t@(Vector _ 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)) <+> + ":=" <+> "toSLV" <> parens ("ivalue" <> parens ("i")) <> semi + ) <$> + "end" <+> "loop" <> semi <$> + "return" <+> "result" <> semi + ) <$> + "end" <> semi + ) + +funDec (BitVector _) = Just slvToSlvDec +funDec (SP _ _) = Just slvToSlvDec + +funDec _ = Nothing + +unsignedToSlvDec :: (VHDLM Doc, VHDLM Doc) +unsignedToSlvDec = + ( "function" <+> "toSLV" <+> parens ("u" <+> colon <+> "in" <+> "unsigned") <+> "return" <+> "std_logic_vector" <> semi + , "function" <+> "toSLV" <+> parens ("u" <+> colon <+> "in" <+> "unsigned") <+> "return" <+> "std_logic_vector" <+> "is" <$> + "begin" <$> + indent 2 ("return" <+> "std_logic_vector" <> parens ("u") <> semi) <$> + "end" <> semi + ) + +slvToSlvDec :: (VHDLM Doc, VHDLM Doc) +slvToSlvDec = + ( "function" <+> "toSLV" <+> parens ("slv" <+> colon <+> "in" <+> "std_logic_vector") <+> "return" <+> "std_logic_vector" <> semi + , "function" <+> "toSLV" <+> parens ("slv" <+> colon <+> "in" <+> "std_logic_vector") <+> "return" <+> "std_logic_vector" <+> "is" <$> + "begin" <$> + indent 2 ("return" <+> "slv" <> semi) <$> + "end" <> semi + ) + +tyImports :: VHDLM Doc +tyImports = + punctuate' semi $ sequence + [ "library IEEE" + , "use IEEE.STD_LOGIC_1164.ALL" + , "use IEEE.NUMERIC_STD.ALL" + , "use IEEE.MATH_REAL.ALL" + , "use work.all" + , "use work.types.all" + ] + + +entity :: Component -> VHDLM Doc +entity c = do + rec (p,ls) <- fmap unzip (ports (maximum ls)) + "entity" <+> text (componentName c) <+> "is" <$> + (case p of + [] -> empty + _ -> indent 2 ("port" <> + parens (align $ vcat $ punctuate semi (A.pure p)) <> + semi) + ) <$> + "end" <> semi + where + ports l = sequence + $ [ (,fromIntegral $ T.length i) A.<$> (fill l (text i) <+> colon <+> "in" <+> vhdlType ty) + | (i,ty) <- inputs c ] ++ + [ (,fromIntegral $ T.length i) A.<$> (fill l (text i) <+> colon <+> "in" <+> vhdlType ty) + | (i,ty) <- hiddenPorts c ] ++ + [ (,fromIntegral $ T.length (fst $ output c)) A.<$> (fill l (text (fst $ output c)) <+> colon <+> "out" <+> vhdlType (snd $ output c)) + ] + +architecture :: Component -> VHDLM Doc +architecture c = + nest 2 + ("architecture structural of" <+> text (componentName c) <+> "is" <$$> + decls (declarations c)) <$$> + nest 2 + ("begin" <$$> + insts (declarations c)) <$$> + "end" <> semi + +-- | Convert a Netlist HWType to a VHDL type +vhdlType :: HWType -> VHDLM Doc +vhdlType hwty = do + tyCache %= HashSet.insert (mkVecZ hwty) + vhdlType' hwty + +vhdlType' :: HWType -> VHDLM Doc +vhdlType' Bool = "boolean" +vhdlType' (Clock _) = "std_logic" +vhdlType' (Reset _) = "std_logic" +vhdlType' Integer = "integer" +vhdlType' (BitVector n) = case n of + 0 -> "std_logic_vector (0 downto 1)" + _ -> "std_logic_vector" <> parens (int (n-1) <+> "downto 0") +vhdlType' (Index u) = "unsigned" <> parens (int (clog2 (max 2 u) - 1) <+> "downto 0") +vhdlType' (Signed n) = if n == 0 then "signed (0 downto 1)" + else "signed" <> parens (int (n-1) <+> "downto 0") +vhdlType' (Unsigned n) = if n == 0 then "unsigned (0 downto 1)" + else "unsigned" <> parens ( int (n-1) <+> "downto 0") +vhdlType' (Vector n elTy) = "array_of_" <> tyName elTy <> parens ("0 to " <> int (n-1)) +vhdlType' t@(SP _ _) = "std_logic_vector" <> parens (int (typeSize t - 1) <+> "downto 0") +vhdlType' t@(Sum _ _) = case typeSize t of + 0 -> "unsigned (0 downto 1)" + n -> "unsigned" <> parens (int (n -1) <+> "downto 0") +vhdlType' t@(Product _ _) = tyName t +vhdlType' Void = "std_logic_vector" <> parens (int (-1) <+> "downto 0") + +sigDecl :: VHDLM Doc -> HWType -> VHDLM Doc +sigDecl d t = d <+> colon <+> vhdlType t + +-- | Convert a Netlist HWType to the root of a VHDL type +vhdlTypeMark :: HWType -> VHDLM Doc +vhdlTypeMark hwty = do + tyCache %= HashSet.insert (mkVecZ hwty) + vhdlTypeMark' hwty + where + vhdlTypeMark' Bool = "boolean" + vhdlTypeMark' (Clock _) = "std_logic" + vhdlTypeMark' (Reset _) = "std_logic" + vhdlTypeMark' Integer = "integer" + vhdlTypeMark' (BitVector _) = "std_logic_vector" + vhdlTypeMark' (Index _) = "unsigned" + vhdlTypeMark' (Signed _) = "signed" + vhdlTypeMark' (Unsigned _) = "unsigned" + vhdlTypeMark' (Vector _ elTy) = "array_of_" <> tyName elTy + vhdlTypeMark' (SP _ _) = "std_logic_vector" + vhdlTypeMark' (Sum _ _) = "unsigned" + vhdlTypeMark' t@(Product _ _) = tyName t + vhdlTypeMark' t = error $ $(curLoc) ++ "vhdlTypeMark: " ++ show t + +tyName :: HWType -> VHDLM Doc +tyName Integer = "integer" +tyName Bool = "boolean" +tyName (Vector n elTy) = "array_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 +tyName (Unsigned n) = "unsigned_" <> int n +tyName t@(Sum _ _) = "unsigned_" <> int (typeSize t) +tyName t@(Product _ _) = makeCached t nameCache prodName + where + prodName = do i <- tyCount <<%= (+1) + "product" <> int i +tyName t@(SP _ _) = "std_logic_vector_" <> int (typeSize t) +tyName _ = empty + +-- | Convert a Netlist HWType to an error VHDL value for that type +vhdlTypeErrValue :: HWType -> VHDLM Doc +vhdlTypeErrValue Bool = "true" +vhdlTypeErrValue Integer = "integer'high" +vhdlTypeErrValue (BitVector _) = "(others => 'X')" +vhdlTypeErrValue (Index _) = "(others => 'X')" +vhdlTypeErrValue (Signed _) = "(others => 'X')" +vhdlTypeErrValue (Unsigned _) = "(others => 'X')" +vhdlTypeErrValue (Vector _ elTy) = parens ("others" <+> rarrow <+> vhdlTypeErrValue elTy) +vhdlTypeErrValue (SP _ _) = "(others => 'X')" +vhdlTypeErrValue (Sum _ _) = "(others => 'X')" +vhdlTypeErrValue (Product _ elTys) = tupled $ mapM vhdlTypeErrValue elTys +vhdlTypeErrValue (Reset _) = "'X'" +vhdlTypeErrValue (Clock _) = "'X'" +vhdlTypeErrValue Void = "(0 downto 1 => 'X')" + +decls :: [Declaration] -> VHDLM Doc +decls [] = empty +decls ds = do + rec (dsDoc,ls) <- fmap (unzip . catMaybes) $ mapM (decl (maximum ls)) ds + case dsDoc of + [] -> empty + _ -> punctuate' semi (A.pure dsDoc) + +decl :: Int -> Declaration -> VHDLM (Maybe (Doc,Int)) +decl l (NetDecl id_ ty) = Just A.<$> (,fromIntegral (T.length id_)) A.<$> + "signal" <+> fill l (text id_) <+> colon <+> vhdlType ty + +decl _ _ = return Nothing + +insts :: [Declaration] -> VHDLM Doc +insts [] = empty +insts is = vcat . punctuate linebreak . fmap catMaybes $ mapM inst_ is + +-- | Turn a Netlist Declaration to a VHDL concurrent block +inst_ :: Declaration -> VHDLM (Maybe Doc) +inst_ (Assignment id_ e) = fmap Just $ + text id_ <+> larrow <+> expr_ False e <> semi + +inst_ (CondAssignment id_ scrut es) = fmap Just $ + "with" <+> parens (expr_ True scrut) <+> "select" <$> + indent 2 (text id_ <+> larrow <+> align (vcat (punctuate comma (conds es)) <> semi)) + where + conds :: [(Maybe Expr,Expr)] -> VHDLM [Doc] + conds [] = return [] + conds [(_,e)] = expr_ False e <+> "when" <+> "others" <:> return [] + conds ((Nothing,e):_) = expr_ False e <+> "when" <+> "others" <:> return [] + conds ((Just c ,e):es') = expr_ False e <+> "when" <+> parens (expr_ True c) <:> conds es' + +inst_ (InstDecl nm lbl pms) = fmap Just $ + nest 2 $ text lbl <+> colon <+> "entity" + <+> text nm <$$> pms' <> semi + where + pms' = do + 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_ _ = return Nothing + +-- | Turn a Netlist expression into a VHDL expression +expr_ :: Bool -- ^ Enclose in parenthesis? + -> Expr -- ^ Expr to convert + -> VHDLM Doc +expr_ _ (Literal sizeM lit) = exprLit sizeM lit +expr_ _ (Identifier id_ Nothing) = text id_ +expr_ _ (Identifier id_ (Just (Indexed (ty@(SP _ args),dcI,fI)))) = fromSLV argTy id_ start end + where + argTys = snd $ args !! dcI + argTy = argTys !! fI + argSize = typeSize argTy + other = otherSize argTys (fI-1) + start = typeSize ty - 1 - conSize ty - other + end = start - argSize + 1 + +expr_ _ (Identifier id_ (Just (Indexed (ty@(Product _ _),_,fI)))) = text id_ <> dot <> tyName ty <> "_sel" <> int fI +expr_ _ (Identifier id_ (Just (DC (ty@(SP _ _),_)))) = text id_ <> parens (int start <+> "downto" <+> int end) + where + start = typeSize ty - 1 + end = typeSize ty - conSize ty + +expr_ _ (Identifier id_ (Just _)) = text id_ +expr_ _ (DataCon ty@(Vector 1 _) _ [e]) = vhdlTypeMark ty <> "'" <> parens (int 0 <+> rarrow <+> expr_ False e) +expr_ _ e@(DataCon ty@(Vector _ elTy) _ [e1,e2]) = 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@(SP _ args) (DC (_,i)) es) = assignExpr + where + argTys = snd $ args !! i + dcSize = conSize ty + sum (map typeSize argTys) + dcExpr = expr_ False (dcToExpr ty i) + argExprs = zipWith toSLV argTys es + extraArg = case typeSize ty - dcSize of + 0 -> [] + n -> [exprLit (Just (ty,n)) (NumLit 0)] + assignExpr = "std_logic_vector'" <> parens (hcat $ punctuate " & " $ sequence (dcExpr:argExprs ++ extraArg)) + +expr_ _ (DataCon ty@(Sum _ _) (DC (_,i)) []) = "to_unsigned" <> tupled (sequence [int i,int (typeSize ty)]) +expr_ _ (DataCon ty@(Product _ _) _ es) = tupled $ zipWithM (\i e -> tName <> "_sel" <> int i <+> rarrow <+> expr_ False e) [0..] es + where + tName = tyName ty + +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 _) + | 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 _) + | pNm == "CLaSH.Sized.Internal.BitVector.fromInteger#" + , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx + = exprLit (Just (BitVector (fromInteger n),fromInteger n)) i + +expr_ b (BlackBoxE _ bs bbCtx b') = do + t <- renderBlackBox bs bbCtx + parenIf (b || b') $ string t + +expr_ _ (DataTag Bool (Left id_)) = "false when" <+> text id_ <+> "= 0 else true" +expr_ _ (DataTag Bool (Right id_)) = "1 when" <+> text id_ <+> "else 0" +expr_ _ (DataTag hty@(Sum _ _) (Left id_)) = "to_unsigned" <> tupled (sequence [text id_,int (typeSize hty)]) +expr_ _ (DataTag (Sum _ _) (Right id_)) = "to_integer" <> parens (text id_) + +expr_ _ (DataTag (Product _ _) (Right _)) = int 0 +expr_ _ (DataTag hty@(SP _ _) (Right id_)) = "to_integer" <> parens + ("unsigned" <> parens + (text id_ <> parens + (int start <+> "downto" <+> int end))) + where + start = typeSize hty - 1 + end = typeSize hty - conSize hty + +expr_ _ (DataTag (Vector 0 _) (Right _)) = int 0 +expr_ _ (DataTag (Vector _ _) (Right _)) = int 1 + +expr_ _ e = error $ $(curLoc) ++ (show e) -- empty + +otherSize :: [HWType] -> Int -> Int +otherSize _ n | n < 0 = 0 +otherSize [] _ = 0 +otherSize (a:as) n = typeSize a + otherSize as (n-1) + +vectorChain :: Expr -> Maybe [Expr] +vectorChain (DataCon (Vector 0 _) _ _) = Just [] +vectorChain (DataCon (Vector 1 _) _ [e]) = Just [e] +vectorChain (DataCon (Vector _ _) _ [e1,e2]) = Just e1 <:> vectorChain e2 +vectorChain _ = Nothing + +exprLit :: Maybe (HWType,Size) -> Literal -> VHDLM Doc +exprLit Nothing (NumLit i) = integer i +exprLit (Just (hty,sz)) (NumLit i) = case hty of + Unsigned _ -> "unsigned'" <> parens blit + Signed _ -> "signed'" <> parens blit + BitVector _ -> "std_logic_vector'" <> parens blit + _ -> blit + + where + blit = bits (toBits sz i) +exprLit _ (BoolLit t) = if t then "true" else "false" +exprLit _ (BitLit b) = squotes $ bit_char b +exprLit _ l = error $ $(curLoc) ++ "exprLit: " ++ show l + +toBits :: Integral a => Int -> a -> [Bit] +toBits size val = map (\x -> if odd x then H else L) + $ reverse + $ take size + $ map (`mod` 2) + $ iterate (`div` 2) val + +bits :: [Bit] -> VHDLM Doc +bits = dquotes . hcat . mapM bit_char + +bit_char :: Bit -> VHDLM Doc +bit_char H = char '1' +bit_char L = char '0' +bit_char U = char 'U' +bit_char Z = char 'Z' + +toSLV :: HWType -> Expr -> VHDLM Doc +toSLV Bool e = "toSLV" <> parens (expr_ False e) +toSLV Integer e = "std_logic_vector" <> parens ("to_signed" <> tupled (sequence [expr_ False e,int 32])) +toSLV (BitVector _) e = expr_ False e +toSLV (Signed _) e = "std_logic_vector" <> parens (expr_ False e) +toSLV (Unsigned _) e = "std_logic_vector" <> parens (expr_ False e) +toSLV (Sum _ _) e = "std_logic_vector" <> parens (expr_ False e) +toSLV t@(Product _ tys) (Identifier id_ Nothing) = do + selIds' <- sequence selIds + encloseSep lparen rparen " & " (zipWithM toSLV tys selIds') + where + tName = tyName t + selNames = map (fmap (displayT . renderOneLine) ) [text id_ <> dot <> tName <> "_sel" <> int i | i <- [0..(length tys)-1]] + selIds = map (fmap (\n -> Identifier n Nothing)) selNames +toSLV (Product _ tys) (DataCon _ _ es) = encloseSep lparen rparen " & " (zipWithM toSLV tys es) +toSLV (SP _ _) e = expr_ False e +toSLV (Vector n elTy) (Identifier id_ Nothing) = do + selIds' <- sequence (reverse selIds) + parens (encloseSep lparen rparen " & " (mapM (toSLV elTy) selIds')) + where + selNames = map (fmap (displayT . renderOneLine) ) $ reverse [text id_ <> parens (int i) | i <- [0 .. (n-1)]] + selIds = map (fmap (`Identifier` Nothing)) selNames +toSLV (Vector n elTy) (DataCon _ _ es) = encloseSep lparen rparen " & " (zipWithM toSLV [elTy,Vector (n-1) elTy] es) +toSLV hty e = error $ $(curLoc) ++ "toSLV: ty:" ++ show hty ++ "\n expr: " ++ show e + +fromSLV :: HWType -> Identifier -> Int -> Int -> VHDLM Doc +fromSLV Bool id_ start _ = "fromSLV" <> parens (text id_ <> parens (int start)) +fromSLV Integer id_ start end = "to_integer" <> parens (fromSLV (Signed 32) id_ start end) +fromSLV (BitVector _) id_ start end = text id_ <> parens (int start <+> "downto" <+> int end) +fromSLV (Index _) id_ start end = "unsigned" <> parens (text id_ <> parens (int start <+> "downto" <+> int end)) +fromSLV (Signed _) id_ start end = "signed" <> parens (text id_ <> parens (int start <+> "downto" <+> int end)) +fromSLV (Unsigned _) id_ start end = "unsigned" <> parens (text id_ <> parens (int start <+> "downto" <+> int end)) +fromSLV (Sum _ _) id_ start end = "unsigned" <> parens (text id_ <> parens (int start <+> "downto" <+> int end)) +fromSLV t@(Product _ tys) id_ start _ = tupled $ zipWithM (\s e -> s <+> rarrow <+> e) selNames args + where + tName = tyName t + selNames = [tName <> "_sel" <> int i | i <- [0..]] + argLengths = map typeSize tys + starts = start : snd (mapAccumL ((join (,) .) . (-)) start argLengths) + ends = map (+1) (tail starts) + args = zipWith3 (`fromSLV` id_) tys starts ends + +fromSLV (SP _ _) id_ start end = text id_ <> parens (int start <+> "downto" <+> int end) +fromSLV (Vector n elTy) id_ start _ = tupled (fmap reverse args) + where + argLength = typeSize elTy + starts = take (n + 1) $ iterate (subtract argLength) start + ends = map (+1) (tail starts) + args = zipWithM (fromSLV elTy id_) starts ends +fromSLV hty _ _ _ = error $ $(curLoc) ++ "fromSLV: " ++ show hty + +dcToExpr :: HWType -> Int -> Expr +dcToExpr ty i = Literal (Just (ty,conSize ty)) (NumLit (toInteger i)) + +larrow :: VHDLM Doc +larrow = "<=" + +rarrow :: VHDLM Doc +rarrow = "=>" + +parenIf :: Monad m => Bool -> m Doc -> m Doc +parenIf True = parens +parenIf False = id + +punctuate' :: Monad m => m Doc -> m [Doc] -> m Doc +punctuate' s d = vcat (punctuate s d) <> s