diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Changelog for the [`clash-ghc`](http://hackage.haskell.org/package/clash-ghc) package +## 0.4 *November 17th 2014* +* New features: + * Support for clash-prelude 0.6 + +* Fixes bugs: + * clash-ghc ignores "-package-db" flag [#35](https://github.com/christiaanb/clash2/issues/35) + ## 0.3.3 *August 12th 2014* * Fixes bugs: * Compile with GHC 7.8.3 [#31](https://github.com/christiaanb/clash2/issues/31) diff --git a/clash-ghc.cabal b/clash-ghc.cabal --- a/clash-ghc.cabal +++ b/clash-ghc.cabal @@ -1,5 +1,5 @@ Name: clash-ghc -Version: 0.3.3 +Version: 0.4 Synopsis: CAES Language for Synchronous Hardware Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that @@ -31,28 +31,30 @@ src-bin/HsVersions.h, src-bin/PosixSource.h -Data-files: primitives/clash.bit.json, - primitives/clash.ghc.ghc2core.json, - primitives/clash.prelude.json, - primitives/clash.prelude.explicit.json, - primitives/clash.promoted.nat.json, - primitives/clash.signal.explicit.json, - primitives/clash.signal.implicit.json, - primitives/clash.signal.types.json, - primitives/clash.sized.signed.json, - primitives/clash.sized.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 +Data-files: 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 @@ -83,8 +85,8 @@ base >= 4.3.1.0 && < 5, bifunctors >= 4.1.1, bytestring >= 0.9, - clash-lib >= 0.3.2, - clash-prelude >= 0.5.1, + clash-lib >= 0.4, + clash-prelude >= 0.6, containers >= 0.5.4.0, directory >= 1.2, filepath >= 1.3, 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.cblockRam" + , "comment" : + "cblockRam :: (KnownNat n, KnownNat m) -- (ARG[0],ARG[1]) + => SClock clk -- clk, ARG[2] + -> Vec n a -- init, ARG[3] + -> CSignal clk (Unsigned m) -- wr, ARG[4] + -> CSignal clk (Unsigned m) -- rd, ARG[5] + -> CSignal clk Bool -- wren, ARG[6] + -> CSignal clk a -- din, ARG[7] + -> CSignal 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,24 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Prelude.Testbench.csassert" + , "comment" : + "csassert :: (Eq a,Show a) -- (ARG[0],ARG[1]) + => CSignal t a -- ^ Checked value (ARG[2]) + -> CSignal t a -- ^ Expected value (ARG[3]) + -> CSignal t b -- ^ Return valued (ARG[4]) + -> CSignal t b" + , "templateD" : +"assert_~SYM[0] : block +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: \" & to_string (~ARG[3]) & \", actual: \" & to_string (~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,11 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Promoted.Nat.SNat" + , "templateE" : "~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Promoted.Nat.snatToInteger" + , "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,11 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Promoted.Symbol.SSymbol" + , "templateE" : "~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Promoted.Symbol.symbolToString" + , "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,6 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Signal.Explicit.veryUnsafeSynchronizer" + , "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#" + , "comment" : + "register# :: SClock clk -- ARG[0] + -> a -- ARG[1] + -> CSignal clk a -- ARG[2] + -> CSignal 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#" + , "comment" : + "regEn# :: SClock clk -- ARG[0] + -> a -- ARG[1] + -> CSignal clk Bool -- ARG[2] + -> CSignal clk a -- ARG[3] + -> CSignal 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,432 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.size#" + , "templateE" : "~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.maxIndex#" + , "templateE" : "~LIT[0] - 1" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.high" + , "templateE" : "\"1\"" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.low" + , "templateE" : "\"0\"" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.++#" + , "templateE" : "std_logic_vector'(~ARG[1]) & std_logic_vector'(~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.reduceAnd#" + , "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#" + , "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#" + , "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#" + , "comment" : + "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#" + , "comment" : + "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#" + , "comment" : + "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#" + , "comment" : + "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#" + , "comment" : + "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#" + , "comment" : + "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#" + , "comment" : + "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#" + , "templateE" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.neq#" + , "templateE" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.lt#" + , "templateE" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.ge#" + , "templateE" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.gt#" + , "templateE" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.le#" + , "templateE" : "~ARG[0] <= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.minBound#" + , "comment" : "Generates incorrect VDHL for n=0" + , "templateE" : "std_logic_vector'(~LIT[0]-1 downto 0 => '0');" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.maxBound#" + , "comment" : "Generates incorrect VDHL for n=0" + , "templateE" : "std_logic_vector'(~LIT[0]-1 downto 0 => '1');" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.+#" + , "templateE" : "std_logic_vector(unsigned(~ARG[1]) + unsigned(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.-#" + , "templateE" : "std_logic_vector(unsigned(~ARG[1]) - unsigned(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.*#" + , "templateE" : "std_logic_vector(resize(unsigned(~ARG[1]) * unsigned(~ARG[2]), ~LIT[0]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.negate#" + , "templateE" : "std_logic_vector(-(signed(~ARG[1])))" + } + } +, { "Primitive" : + { "name" : "CLaSH.Sized.Internal.BitVector.fromInteger#" + , "primType" : "Function" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.plus#" + , "templateE" : "std_logic_vector(resize(unsigned(~ARG[1]),~LIT[0]) + resize(unsigned(~ARG[2]),~LIT[0]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.minus#" + , "templateE" : "std_logic_vector(resize(unsigned(~ARG[1]),~LIT[0]) - resize(unsigned(~ARG[2]),~LIT[0]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.times#" + , "templateE" : "std_logic_vector(unsigned(~ARG[1]) * unsigned(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.quot#" + , "templateE" : "std_logic_vector(unsigned(~ARG[1]) / unsigned(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.rem#" + , "templateE" : "~ARG[1] rem ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.mod#" + , "templateE" : "~ARG[1] mod ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.toInteger#" + , "templateE" : "to_integer(unsigned(~ARG[0]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.and#" + , "templateE" : "~ARG[0] and ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.or#" + , "templateE" : "~ARG[0] or ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.xor#" + , "templateE" : "~ARG[0] xor ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.complement#" + , "templateE" : "not ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.shiftL#" + , "templateE" : "std_logic_vector(shift_left(unsigned(~ARG[1]),~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.shiftR#" + , "templateE" : "std_logic_vector(shift_right(unsigned(~ARG[1]),~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.rotateL#" + , "templateE" : "std_logic_vector(rotate_left(unsigned(~ARG[1]),~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.rotateR#" + , "templateE" : "std_logic_vector(rotate_right(unsigned(~ARG[1]),~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.BitVector.resize#" + , "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,76 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.eq#" + , "templateE" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.neq#" + , "templateE" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.lt#" + , "templateE" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.ge#" + , "templateE" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.gt#" + , "templateE" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.le#" + , "templateE" : "~ARG[0] <= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.maxBound#" + , "templateE" : "to_unsigned(max(0,~LIT[0]-1),~RESULT'length);" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.+#" + , "templateE" : "~ARG[1] + ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.-#" + , "templateE" : "~ARG[1] - ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.*#" + , "templateE" : "resize(~ARG[1] * ~ARG[2], ~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.fromInteger#" + , "templateE" : "to_unsigned(~ARG[1],integer(ceil(log2(real(max(2,~LIT[0]))))))" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.quot#" + , "templateE" : "~ARG[1] / ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.rem#" + , "templateE" : "~ARG[1] rem ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.mod#" + , "templateE" : "~ARG[1] mod ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Index.toInteger#" + , "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,186 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Internal.Signed.size#" + , "templateE" : "~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.pack#" + , "templateE" : "std_logic_vector(~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.unpack#" + , "templateE" : "signed(~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.eq#" + , "templateE" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.neq#" + , "templateE" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.lt#" + , "templateE" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.ge#" + , "templateE" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.gt#" + , "templateE" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.le#" + , "templateE" : "~ARG[0] <= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.minBound#" + , "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#" + , "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.+#" + , "templateE" : "~ARG[1] + ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.-#" + , "templateE" : "~ARG[1] - ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.*#" + , "templateE" : "resize(~ARG[1] * ~ARG[2], ~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.negate#" + , "templateE" : "-~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.abs#" + , "templateE" : "abs ~ARG[1]" + } + } +, { "Primitive" : + { "name" : "CLaSH.Sized.Internal.Signed.fromInteger#" + , "primType" : "Function" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.plus#" + , "templateE" : "resize(~ARG[1],~LIT[0]) + resize(~ARG[2],~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.minus#" + , "templateE" : "resize(~ARG[1],~LIT[0]) - resize(~ARG[2],~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.times#" + , "templateE" : "~ARG[1] * ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.quot#" + , "templateE" : "~ARG[1] / ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.rem#" + , "templateE" : "~ARG[1] rem ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.div#" + , "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#" + , "templateE" : "~ARG[1] mod ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.toInteger#" + , "templateE" : "to_integer(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.and#" + , "templateE" : "~ARG[1] and ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.or#" + , "templateE" : "~ARG[1] or ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.xor#" + , "templateE" : "~ARG[1] xor ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.complement#" + , "templateE" : "not ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.shiftL#" + , "templateE" : "shift_left(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.shiftR#" + , "templateE" : "shift_right(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.rotateL#" + , "templateE" : "rotate_left(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.rotateR#" + , "templateE" : "rotate_right(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Signed.resize#" + , "templateE" : "resize(~ARG[2],~LIT[1])" + } + } +] 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,163 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.size#" + , "templateE" : "~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.pack#" + , "templateE" : "std_logic_vector(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.unpack#" + , "templateE" : "unsigned(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.eq#" + , "templateE" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.neq#" + , "templateE" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.lt#" + , "templateE" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.ge#" + , "templateE" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.gt#" + , "templateE" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.le#" + , "templateE" : "~ARG[0] <= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.minBound#" + , "comment" : "Generates incorrect VDHL for n=0" + , "templateE" : "unsigned'(~LIT[0]-1 downto 0 => '0');" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.maxBound#" + , "comment" : "Generates incorrect VDHL for n=0" + , "templateE" : "unsigned'(~LIT[0]-1 downto 0 => '1');" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.+#" + , "templateE" : "~ARG[1] + ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.-#" + , "templateE" : "~ARG[1] - ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.*#" + , "templateE" : "resize(~ARG[1] * ~ARG[2], ~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.negate#" + , "templateE" : "unsigned(std_logic_vector(-(signed(std_logic_vector(~ARG[1])))))" + } + } +, { "Primitive" : + { "name" : "CLaSH.Sized.Internal.Unsigned.fromInteger#" + , "primType" : "Function" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.plus#" + , "templateE" : "resize(~ARG[1],~LIT[0]) + resize(~ARG[2],~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.minus#" + , "templateE" : "resize(~ARG[1],~LIT[0]) - resize(~ARG[2],~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.times#" + , "templateE" : "~ARG[1] * ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.quot#" + , "templateE" : "~ARG[1] / ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.rem#" + , "templateE" : "~ARG[1] rem ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.mod#" + , "templateE" : "~ARG[1] mod ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.toInteger#" + , "templateE" : "to_integer(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.and#" + , "templateE" : "~ARG[0] and ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.or#" + , "templateE" : "~ARG[0] or ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.xor#" + , "templateE" : "~ARG[0] xor ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.complement#" + , "templateE" : "not ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.shiftL#" + , "templateE" : "shift_left(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.shiftR#" + , "templateE" : "shift_right(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.rotateL#" + , "templateE" : "rotate_left(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.rotateR#" + , "templateE" : "rotate_right(~ARG[1],~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Internal.Unsigned.resize#" + , "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,365 @@ +[ { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.eq#" + , "templateE" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.neq#" + , "templateE" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.head" + , "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" + , "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" + , "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" + , "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" + , "comment" : + "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.++" + , "templateE" : "~TYPM[0]'(~ARG[0]) & ~TYPM[1]'(~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.concat" + , "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" + , "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" + , "comment" : + "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" + , "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" + , "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" + , "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_integer" + , "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_integer" + , "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" + , "templateE" : "~LIT[0] - 1" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.length" + , "templateE" : "~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.replicate" + , "templateE" : "~TYPMO'(0 to ~LIT[0]-1 => ~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.reverse" + , "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" + , "templateE" : "~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "CLaSH.Sized.Vector.concatBitVector#" + , "comment" : + "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#" + , "comment" : + "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,21 @@ +[ { "BlackBox" : + { "name" : "Control.Exception.Base.patError" + , "templateE" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.irrefutPatError" + , "templateE" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.recSelError" + , "templateE" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.absentError" + , "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,33 @@ +[ { "Primitive" : + { "name" : "GHC.Base.$" + , "primType" : "Function" + } + } +, { "BlackBox" : + { "name" : "GHC.Base.quotInt" + , "templateE" : "~ARG[0] div ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Base.remInt" + , "templateE" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Base.divInt" + , "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" + , "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,63 @@ +[ { "BlackBox" : + { "name" : "GHC.Classes.eqInt" + , "templateE" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.neInt" + , "templateE" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.gtInt" + , "templateE" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.geInt" + , "templateE" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.ltInt" + , "templateE" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.leInt" + , "templateE" : "~ARG[0] <= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.&&" + , "templateE" : "~ARG[0] and ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.||" + , "templateE" : "~ARG[0] or ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.not" + , "templateE" : "not ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.divInt#" + , "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#" + , "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,11 @@ +[ { "BlackBox" : + { "name" : "GHC.Err.error" + , "templateE" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "GHC.Err.undefined" + , "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,133 @@ +[ { "BlackBox" : + { "name" : "GHC.Integer.Type.smallInteger" + , "templateE" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.integerToInt" + , "templateE" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.plusInteger" + , "templateE" : "~ARG[0] + ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.minusInteger" + , "templateE" : "~ARG[0] - ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.timesInteger" + , "templateE" : "~ARG[0] * ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.negateInteger" + , "templateE" : "-~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.absInteger" + , "templateE" : "abs ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.divInteger" + , "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" + , "templateE" : "~ARG[0] mod ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.quotInteger" + , "templateE" : "~ARG[0] div ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.remInteger" + , "templateE" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.eqInteger" + , "templateE" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.neqInteger" + , "templateE" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.leInteger" + , "templateE" : "~ARG[0] <= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.gtInteger" + , "templateE" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.ltInteger" + , "templateE" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.geInteger" + , "templateE" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.eqInteger#" + , "templateE" : "1 when ~ARG[0] = ~ARG[1] else 0" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.neqInteger#" + , "templateE" : "1 when ~ARG[0] /= ~ARG[1] else 0" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.leInteger#" + , "templateE" : "1 when ~ARG[0] <= ~ARG[1] else 0" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.gtInteger#" + , "templateE" : "1 when ~ARG[0] > ~ARG[1] else 0" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.ltInteger#" + , "templateE" : "1 when ~ARG[0] < ~ARG[1] else 0" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.geInteger#" + , "templateE" : "1 when ~ARG[0] >= ~ARG[1] else 0" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.shiftRInteger" + , "templateE" : "~ARG[0] / (2**~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.shiftLInteger" + , "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,76 @@ +[ { "BlackBox" : + { "name" : "GHC.Prim.+#" + , "templateE" : "~ARG[0] + ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.-#" + , "templateE" : "~ARG[0] - ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.*#" + , "templateE" : "~ARG[0] * ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.quotInt#" + , "templateE" : "~ARG[0] div ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.remInt#" + , "templateE" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.negateInt#" + , "templateE" : "-~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.>#" + , "templateE" : "1 when ~ARG[0] > ~ARG[1] else 0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.>=#" + , "templateE" : "1 when ~ARG[0] >= ~ARG[1] else 0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.==#" + , "templateE" : "1 when ~ARG[0] = ~ARG[1] else 0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim./=#" + , "templateE" : "1 when ~ARG[0] /= ~ARG[1] else 0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.<#" + , "templateE" : "1 when ~ARG[0] < ~ARG[1] else 0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.<=#" + , "templateE" : "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#" + , "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,16 @@ +[ { "BlackBox" : + { "name" : "GHC.Real.divZeroError" + , "templateE" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "GHC.Real.ratioZeroDenominatorError" + , "templateE" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "GHC.Real.overflowError" + , "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,6 @@ +[ { "BlackBox" : + { "name" : "GHC.TypeLits.natVal" + , "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,6 @@ +[ { "BlackBox" : + { "name" : "Unsafe.Coerce.unsafeCoerce" + , "templateE" : "~ARG[0]" + } + } +] diff --git a/primitives/clash.bit.json b/primitives/clash.bit.json deleted file mode 100644 --- a/primitives/clash.bit.json +++ /dev/null @@ -1,26 +0,0 @@ -[ { "BlackBox" : - { "name" : "CLaSH.Bit.eqBit" - , "templateE" : "~ARG[0] = ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Bit.bAnd" - , "templateE" : "~ARG[0] and ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Bit.bOr" - , "templateE" : "~ARG[0] or ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Bit.bXor" - , "templateE" : "~ARG[0] xor ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Bit.bNot" - , "templateE" : "not ~ARG[0]" - } - } -] diff --git a/primitives/clash.ghc.ghc2core.json b/primitives/clash.ghc.ghc2core.json deleted file mode 100644 --- a/primitives/clash.ghc.ghc2core.json +++ /dev/null @@ -1,16 +0,0 @@ -[ { "BlackBox" : - { "name" : "EmptyCase" - , "templateE" : "~ERRORO" - } - } -, { "Primitive" : - { "name" : "_CO_" - , "primType" : "Constructor" - } - } -, { "Primitive" : - { "name" : "_TY_" - , "primType" : "Constructor" - } - } -] diff --git a/primitives/clash.prelude.explicit.json b/primitives/clash.prelude.explicit.json deleted file mode 100644 --- a/primitives/clash.prelude.explicit.json +++ /dev/null @@ -1,51 +0,0 @@ -[ { "BlackBox" : - { "name" : "CLaSH.Prelude.Explicit.cblockRam" - , "comment" : - "cblockRam :: (CPack a, KnownNat n, KnownNat m) -- (ARG[0],ARG[1],ARG[2]) - => Clock clk -- clk, ARG[3] - -> Vec n a -- init, ARG[4] - -> CSignal clk (Unsigned m) -- wr, ARG[5] - -> CSignal clk (Unsigned m) -- rd, ARG[6] - -> CSignal clk Bool -- wren, ARG[7] - -> CSignal clk a -- din, ARG[8] - -> CSignal clk a" - , "templateD" : -"~SYM[0]_block : block - signal ~SYM[1] : ~TYP[4] := ~LIT[4]; -- ram - signal ~SYM[2] : ~TYP[8]; -- inp - signal ~SYM[3] : ~TYP[8]; -- outp -begin - ~SYM[2] <= ~ARG[8]; - - process(~CLKO) - begin - if rising_edge(~CLKO) then - if ~ARG[7] then - ~SYM[1](to_integer(~ARG[5])) <= ~SYM[2]; - end if; - ~SYM[3] <= ~SYM[1](to_integer(~ARG[6])); - end if; - end process; - - ~RESULT <= ~SYM[3]; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Prelude.Explicit.csassert" - , "templateD" : -"~SYM[0]_block : block -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: \" & to_string (~ARG[3]) & \", actual: \" & to_string (~ARG[2])) severity error; - end if; - end process; - -- pragma translate_on - ~RESULT <= ~ARG[4]; -end block;" - } - } -] diff --git a/primitives/clash.prelude.json b/primitives/clash.prelude.json deleted file mode 100644 --- a/primitives/clash.prelude.json +++ /dev/null @@ -1,50 +0,0 @@ -[ { "BlackBox" : - { "name" : "CLaSH.Prelude.blockRam" - , "comment" : - "blockRam :: (Pack a, KnownNat n, KnownNat m) -- (ARG[0],ARG[1],ARG[2]) - => Vec n a -- init, ARG[3] - -> Signal (Unsigned m) -- write, ARG[4] - -> Signal (Unsigned m) -- read, ARG[5] - -> Signal Bool -- wen, ARG[6] - -> Signal a -- din, ARG[7] - -> Signal a" - , "templateD" : -"~SYM[0]_block : 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(~CLKO) - begin - if rising_edge(~CLKO) 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;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Prelude.sassert" - , "templateD" : -"~SYM[0]_block : block -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: \" & to_string (~ARG[3]) & \", actual: \" & to_string (~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 deleted file mode 100644 --- a/primitives/clash.promoted.nat.json +++ /dev/null @@ -1,11 +0,0 @@ -[ { "BlackBox" : - { "name" : "CLaSH.Promoted.Nat.SNat" - , "templateE" : "~LIT[0]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Promoted.Nat.fromSNat" - , "templateE" : "~LIT[0]" - } - } -] diff --git a/primitives/clash.signal.explicit.json b/primitives/clash.signal.explicit.json deleted file mode 100644 --- a/primitives/clash.signal.explicit.json +++ /dev/null @@ -1,38 +0,0 @@ -[ { "BlackBox" : - { "name" : "CLaSH.Signal.Explicit.cregister" - , "templateD" : -"~SYM[0]_block : block - signal ~SYM[1] : ~TYP[2]; - signal ~SYM[2] : ~TYP[1]; -begin - ~SYM[2] <= ~ARG[1]; - - process(~CLKO,~RSTO,~SYM[2]) - begin - if ~RSTO = '0' then - ~SYM[1] <= ~SYM[2]; - elsif rising_edge(~CLKO) then - ~SYM[1] <= ~ARG[2]; - end if; - end process; - - ~RESULT <= ~SYM[1]; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Signal.Explicit.veryUnsafeSynchronizer" - , "templateE" : "~ARG[2]" - } - } -, { "Primitive" : - { "name" : "CLaSH.Signal.Explicit.cpack" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "CLaSH.Signal.Explicit.cunpack" - , "primType" : "Function" - } - } -] diff --git a/primitives/clash.signal.implicit.json b/primitives/clash.signal.implicit.json deleted file mode 100644 --- a/primitives/clash.signal.implicit.json +++ /dev/null @@ -1,33 +0,0 @@ -[ { "BlackBox" : - { "name" : "CLaSH.Signal.Implicit.register" - , "templateD" : -"~SYM[0]_block : block - signal ~SYM[1] : ~TYP[1]; - signal ~SYM[2] : ~TYP[0]; -begin - ~SYM[2] <= ~ARG[0]; - - process(~CLKO,~RSTO,~SYM[2]) - begin - if ~RSTO = '0' then - ~SYM[1] <= ~SYM[2]; - elsif rising_edge(~CLKO) then - ~SYM[1] <= ~ARG[1]; - end if; - end process; - - ~RESULT <= ~SYM[1]; -end block;" - } - } -, { "Primitive" : - { "name" : "CLaSH.Signal.Implicit.pack" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "CLaSH.Signal.Implicit.unpack" - , "primType" : "Function" - } - } -] diff --git a/primitives/clash.signal.types.json b/primitives/clash.signal.types.json deleted file mode 100644 --- a/primitives/clash.signal.types.json +++ /dev/null @@ -1,16 +0,0 @@ -[ { "Primitive" : - { "name" : "CLaSH.Signal.Types.signal" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "CLaSH.Signal.Types.mapSignal" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "CLaSH.Signal.Types.appSignal" - , "primType" : "Function" - } - } -] diff --git a/primitives/clash.sized.signed.json b/primitives/clash.sized.signed.json deleted file mode 100644 --- a/primitives/clash.sized.signed.json +++ /dev/null @@ -1,227 +0,0 @@ -[ { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.eqS" - , "templateE" : "~ARG[0] = ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.gtS" - , "templateE" : "~ARG[0] > ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.ltS" - , "templateE" : "~ARG[0] < ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.geS" - , "templateE" : "~ARG[0] >= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.leS" - , "templateE" : "~ARG[0] <= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.minBoundS" - , "templateD" : "~RESULT <= ((~LIT[0]-1) => '1', (~LIT[0]-2) downto 0 => '0');" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.maxBoundS" - , "templateD" : "~RESULT <= ((~LIT[0]-1) => '0', (~LIT[0]-2) downto 0 => '1');" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.plusS" - , "templateE" : "~ARG[1] + ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.minS" - , "templateE" : "~ARG[1] - ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.timesS" - , "templateE" : "resize(~ARG[1] * ~ARG[2], ~LIT[0])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.negateS" - , "templateE" : "-~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.absS" - , "templateE" : "abs ~ARG[1]" - } - } -, { "Primitive" : - { "name" : "CLaSH.Sized.Signed.fromIntegerS" - , "primType" : "Function" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.quotS" - , "templateE" : "~ARG[1] / ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.remS" - , "templateE" : "~ARG[1] rem ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.divS" - , "templateD" : -"~SYM[0]_divS : 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.Signed.modS" - , "templateE" : "~ARG[1] mod ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.toIntegerS" - , "templateE" : "to_integer(~ARG[0])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.andS" - , "templateE" : "~ARG[1] and ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.orS" - , "templateE" : "~ARG[1] or ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.xorS" - , "templateE" : "~ARG[1] xor ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.complementS" - , "templateE" : "not ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.bitS" - , "templateD" : -"~SYM[0]_bitS : block - signal ~SYM[1] : ~TYP[1]; -begin - ~SYM[1] <= ~ARG[1]; - process(~SYM[1]) - variable ~SYM[2] : ~TYPO; - begin - ~SYM[2] := (others => '0'); - -- pragma translate_off - if ~SYM[1] < ~SYM[2]'low or ~SYM[1] > ~SYM[2]'high then - assert false report (\"Index: \" & integer'image(~SYM[1]) & \", is out of bounds: \" & integer'image(~SYM[2]'low) & \" downto \" & integer'image(~SYM[2]'high)) severity warning; - ~SYM[2] := ~ERRORO; - else - -- pragma translate_on - ~SYM[2](~SYM[1]) := '1'; - -- pragma translate_off - end if; - -- pragma translate_on; - ~RESULT <= ~SYM[2]; - end process; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.testBitS" - , "templateD" : -"~SYM[0]_testBitS : 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]) = '1'; - -- pragma translate_off - end if; - end process; - -- pragma translate_on -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.shiftLS" - , "templateE" : "shift_left(~ARG[1],~ARG[2])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.shiftRS" - , "templateE" : "shift_right(~ARG[1],~ARG[2])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.rotateLS" - , "templateE" : "rotate_left(~ARG[1],~ARG[2])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.rotateRS" - , "templateE" : "rotate_right(~ARG[1],~ARG[2])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.finiteBitSizeS" - , "templateE" : "~LIT[0]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.toBitVector" - , "templateE" : "std_logic_vector(~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.fromBitVector" - , "templateE" : "signed(~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.resizeS" - , "templateE" : "resize(~ARG[2],~LIT[1])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.plusS2" - , "templateE" : "~ARG[1] + ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.minusS2" - , "templateE" : "~ARG[1] - ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Signed.multS2" - , "templateE" : "~ARG[1] * ~ARG[2]" - } - } -] diff --git a/primitives/clash.sized.unsigned.json b/primitives/clash.sized.unsigned.json deleted file mode 100644 --- a/primitives/clash.sized.unsigned.json +++ /dev/null @@ -1,196 +0,0 @@ -[ { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.eqU" - , "templateE" : "~ARG[0] = ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.gtU" - , "templateE" : "~ARG[0] > ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.ltU" - , "templateE" : "~ARG[0] < ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.geU" - , "templateE" : "~ARG[0] >= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.leU" - , "templateE" : "~ARG[0] <= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.maxBoundU" - , "templateE" : "unsigned'((~LIT[0]-1) downto 0 => '1')" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.plusU" - , "templateE" : "~ARG[1] + ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.minU" - , "templateE" : "~ARG[1] - ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.timesU" - , "templateE" : "resize(~ARG[1] * ~ARG[2], ~LIT[0])" - } - } -, { "Primitive" : - { "name" : "CLaSH.Sized.Unsigned.fromIntegerU" - , "primType" : "Function" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.quotU" - , "templateE" : "~ARG[1] / ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.remU" - , "templateE" : "~ARG[1] rem ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.modU" - , "templateE" : "~ARG[1] mod ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.toIntegerU" - , "templateE" : "to_integer(~ARG[0])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.andU" - , "templateE" : "~ARG[1] and ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.orU" - , "templateE" : "~ARG[1] or ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.xorU" - , "templateE" : "~ARG[1] xor ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.complementU" - , "templateE" : "not ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.bitU" - , "templateD" : -"~SYM[0]_bitU : block - signal ~SYM[1] : ~TYP[1]; -begin - ~SYM[1] <= ~ARG[1]; - process(~SYM[1]) - variable ~SYM[2] : ~TYPO; - begin - ~SYM[2] := (others => '0'); - -- pragma translate_off - if ~SYM[1] < ~SYM[2]'low or ~SYM[1] > ~SYM[2]'high then - assert false report (\"Index: \" & integer'image(~SYM[1]) & \", is out of bounds: \" & integer'image(~SYM[2]'low) & \" downto \" & integer'image(~SYM[2]'high)) severity warning; - ~SYM[2] := ~ERRORO; - else - -- pragma translate_on - ~SYM[2](~SYM[1]) := '1'; - -- pragma translate_off - end if; - -- pragma translate_on; - ~RESULT <= ~SYM[2]; - end process; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.testBitU" - , "templateD" : -"~SYM[0]_testBitU : 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]) = '1'; - -- pragma translate_off - end if; - end process; - -- pragma translate_on -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.shiftLU" - , "templateE" : "shift_left(~ARG[1],~ARG[2])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.shiftRU" - , "templateE" : "shift_right(~ARG[1],~ARG[2])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.rotateLU" - , "templateE" : "rotate_left(~ARG[1],~ARG[2])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.rotateRU" - , "templateE" : "rotate_right(~ARG[1],~ARG[2])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.finiteBitSizeU" - , "templateE" : "~LIT[0]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.toBitVector" - , "templateE" : "std_logic_vector(~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.fromBitVector" - , "templateE" : "unsigned(~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.resizeU" - , "templateE" : "resize(~ARG[1],~LIT[0])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.plusU2" - , "templateE" : "~ARG[1] + ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.minusU2" - , "templateE" : "~ARG[1] - ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Unsigned.multU2" - , "templateE" : "~ARG[1] * ~ARG[2]" - } - } -] diff --git a/primitives/clash.sized.vector.json b/primitives/clash.sized.vector.json deleted file mode 100644 --- a/primitives/clash.sized.vector.json +++ /dev/null @@ -1,437 +0,0 @@ -[ { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vhead" - , "templateD" : -"~SYM[0]_vhead : block - signal ~SYM[1] : ~TYP[0]; -begin - ~SYM[1] <= ~ARG[0]; - ~RESULT <= ~SYM[1](~SYM[1]'high); -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vtail" - , "templateD" : -"~SYM[0]_vtail : block - signal ~SYM[1] : ~TYP[0]; -begin - ~SYM[1] <= ~ARG[0]; - ~RESULT <= ~SYM[1]((~SYM[1]'high)-1 downto 0); -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vlast" - , "templateD" : -"~SYM[0]_vlast : block - signal ~SYM[1] : ~TYP[0]; -begin - ~SYM[1] <= ~ARG[0]; - ~RESULT <= ~SYM[1](0); -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vinit" - , "templateD" : -"~SYM[0]_vinit : block - signal ~SYM[1] : ~TYP[0]; -begin - ~SYM[1] <= ~ARG[0]; - ~RESULT <= ~SYM[1](~SYM[1]'high downto 1); -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.shiftIntoL" - , "templateD" : -"~SYM[0]_shiftIntoL : block - signal ~SYM[1] : ~TYP[1]; -begin - ~SYM[1] <= ~ARG[1]; - ~RESULT <= ~TYPM[0]'(~ARG[0]) & ~SYM[1](~SYM[1]'high downto 1); -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.snoc" - , "templateE" : "~TYPM[1]'(~ARG[1]) & ~TYPM[0]'(~ARG[0])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.shiftIntoR" - , "templateD" : -"~SYM[0]_shiftIntoR : block - signal ~SYM[1] : ~TYP[1]; -begin - ~SYM[1] <= ~ARG[1]; - ~RESULT <= ~SYM[1]((~SYM[1]'high)-1 downto 0) & ~TYPM[0]'(~ARG[0]); -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vappend" - , "templateE" : "~TYPM[0]'(~ARG[0]) & ~TYPM[1]'(~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vsplit" - , "templateD" : -"~SYM[0]_vsplit : block - signal ~SYM[1] : ~TYP[1]; -begin - ~SYM[1] <= ~ARG[1]; - ~RESULT <= (~SYM[1](~SYM[1]'high downto (~SYM[1]'high - ~LIT[0] + 1)),~SYM[1]((~SYM[1]'high - ~LIT[0]) downto 0)); -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vconcat" - , "templateD" : -"~SYM[0]_vconcat : block - signal ~SYM[1] : ~TYP[0]; -begin - ~SYM[1] <= ~ARG[0]; - ~SYM[2]_vconcat : for ~SYM[3] in ~ARG[0]'high downto 0 generate - begin - ~RESULT(((~SYM[3] * ~SYM[1](0)'length) + ~SYM[1](0)'high) downto (~SYM[3] * ~SYM[1](0)'length)) <= ~SYM[1](~SYM[3]); - end generate; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vunconcat" - , "templateD" : -"~SYM[0]_vunconcat : block - signal ~SYM[1] : ~TYP[2]; -begin - ~SYM[1] <= ~ARG[2]; - ~SYM[2]_vunconcat : for ~SYM[3] in ~RESULT'high downto 0 generate - begin - ~RESULT(~SYM[3]) <= ~SYM[1](((~SYM[3] * ~RESULT(0)'length) + ~RESULT(0)'high) downto (~SYM[3] * ~RESULT(0)'length)); - end generate; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vmerge" - , "templateD" : -"~SYM[0]_vmerge : block - signal ~SYM[1] : ~TYP[0]; - signal ~SYM[2] : ~TYP[1]; -begin - ~SYM[1] <= ~ARG[0]; - ~SYM[2] <= ~ARG[1]; - - ~SYM[3]_vmerge : for ~SYM[4] in ~SYM[1]'high downto 0 generate - begin - ~RESULT(2*~SYM[4]+1) <= ~SYM[1](~SYM[4]); - ~RESULT(2*~SYM[4]) <= ~SYM[2](~SYM[4]); - end generate; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vreverse" - , "templateD" : -"~SYM[0]_vreverse : block - signal ~SYM[1] : ~TYP[0]; -begin - ~SYM[1] <= ~ARG[0]; - - process(~SYM[1]) - begin - for ~SYM[2] in ~SYM[1]'range loop - ~RESULT(~SYM[1]'high - ~SYM[2]) <= ~SYM[1](~SYM[2]); - end loop; - end process; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vmap" - , "templateD" : -"~SYM[0]_vmap : block - signal ~SYM[1] : ~TYP[1]; -begin - ~SYM[1] <= ~ARG[1]; - - ~SYM[2]_vmap : for ~SYM[3] in ~RESULT'high downto 0 generate - begin - ~INST 0 - ~OUTPUT <= ~RESULT(~SYM[3])~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[1](~SYM[3])~ ~TYPEL[~TYP[1]]~ - ~INST - end generate; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vzipWith" - , "templateD" : -"~SYM[0]_vzipWith : block - signal ~SYM[1] : ~TYP[1]; - signal ~SYM[2] : ~TYP[2]; -begin - ~SYM[1] <= ~ARG[1]; - ~SYM[2] <= ~ARG[2]; - - ~SYM[3]_generate : for ~SYM[4] in ~RESULT'high downto 0 generate - begin - ~INST 0 - ~OUTPUT <= ~RESULT(~SYM[4])~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[1](~SYM[4])~ ~TYPEL[~TYP[1]]~ - ~INPUT <= ~SYM[2](~SYM[4])~ ~TYPEL[~TYP[2]]~ - ~INST - end generate; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vfoldr" - , "templateD" : -"~SYM[0]_vfoldr : block - type ~SYM[7] is array (integer range <>) of ~TYP[1]; - signal ~SYM[6] : ~TYP[2]; - signal ~SYM[1] : ~SYM[7](~SYM[6]'high downto 0); -begin - ~SYM[1](0) <= ~ARG[1]; - ~SYM[6] <= ~ARG[2]; - - ~SYM[2]_generate : for ~SYM[3] in 0 to ~SYM[6]'high generate - begin - ~SYM[4]_generate : if ~SYM[3] /= (~SYM[6]'high) generate - ~INST 0 - ~OUTPUT <= ~SYM[1](~SYM[3]+1)~ ~TYP[1]~ - ~INPUT <= ~SYM[6](~SYM[3])~ ~TYPEL[~TYP[2]]~ - ~INPUT <= ~SYM[1](~SYM[3])~ ~TYP[1]~ - ~INST - end generate; - - ~SYM[5]_generate : if ~SYM[3] = (~SYM[6]'high) generate - ~INST 0 - ~OUTPUT <= ~RESULT~ ~TYPO~ - ~INPUT <= ~SYM[6](~SYM[3])~ ~TYPEL[~TYP[2]]~ - ~INPUT <= ~SYM[1](~SYM[3])~ ~TYP[1]~ - ~INST - end generate; - end generate; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vfoldl" - , "templateD" : -"~SYM[0]_vfoldl : block - type ~SYM[7] is array (integer range <>) of ~TYP[1]; - signal ~SYM[6] : ~TYP[2]; - signal ~SYM[1] : ~SYM[7](~SYM[6]'high downto 0); -begin - ~SYM[1](~SYM[1]'high) <= ~ARG[1]; - ~SYM[6] <= ~ARG[2]; - - ~SYM[2]_generate : for ~SYM[3] in ~SYM[6]'high downto 0 generate - begin - ~SYM[4]_generate : if ~SYM[3] /= 0 generate - ~INST 0 - ~OUTPUT <= ~SYM[1](~SYM[3]-1)~ ~TYP[1]~ - ~INPUT <= ~SYM[1](~SYM[3])~ ~TYP[1]~ - ~INPUT <= ~SYM[6](~SYM[3])~ ~TYPEL[~TYP[2]]~ - ~INST - end generate; - - ~SYM[5]_generate : if ~SYM[3] = 0 generate - ~INST 0 - ~OUTPUT <= ~RESULT~ ~TYPO~ - ~INPUT <= ~SYM[1](~SYM[3])~ ~TYP[1]~ - ~INPUT <= ~SYM[6](~SYM[3])~ ~TYPEL[~TYP[2]]~ - ~INST - end generate; - end generate; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vfoldr1" - , "templateD" : -"~SYM[0]_vfoldr1 : block - signal ~SYM[1] : ~TYP[1]; - signal ~SYM[2] : ~TYP[1]; -begin - ~SYM[1] <= ~ARG[1]; - ~SYM[2](0) <= SYM[1](0); - - ~SYM[3]_generate : for ~SYM[4] in 1 to ~SYM[2]'high generate - begin - ~INST 0 - ~OUTPUT <= ~SYM[2](~SYM[4])~ ~TYPEL[~TYP[1]]~ - ~INPUT <= ~SYM[1](~SYM[4])~ ~TYPEL[~TYP[1]]~ - ~INPUT <= ~SYM[2](~SYM[4]-1)~ ~TYPEL[~TYP[1]]~ - ~INST - end generate; - - ~RESULT <= ~SYM[2](~SYM[2]'high); -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vindex_integer" - , "templateD" : -"~SYM[0]_vindex_integer : 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]); - -- pragma translate_off - end if; - end process; - -- pragma translate_on -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.maxIndex" - , "templateD" : -"~SYM[0]_maxIndex : block - signal ~SYM[1] : ~TYP[1]; -begin - ~RESULT <= ~SYM[1]'high; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vreplace_integer" - , "templateD" : -"~SYM[0]_vreplace_integer : 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]) := ~SYM[3]; - -- pragma translate_off - end if; - -- pragma translate_on - ~RESULT <= ~SYM[4]; - end process; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vtake" - , "templateD" : -"~SYM[0]_vtake : block - signal ~SYM[1] : ~TYP[1]; -begin - ~SYM[1] <= ~ARG[1]; - ~RESULT <= ~SYM[1](~SYM[1]'high downto (~SYM[1]'length - ~LIT[0])); -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vdrop" - , "templateD" : -"~SYM[0]_vdrop : block - signal ~SYM[1] : ~TYP[1]; -begin - ~SYM[1] <= ~ARG[1]; - ~RESULT <= ~SYM[1]((~SYM[1]'high - ~LIT[0]) downto 0); -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vexact" - , "templateD" : -"~SYM[0]_vexact : block - signal ~SYM[1] : ~TYP[1]; -begin - ~SYM[1] <= ~ARG[1]; - ~RESULT <= ~SYM[1](~LIT[0]); -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vselect" - , "comment" : - "vselect :: ((f + (s * n) + 1) <= i) -- ARG[0] - => SNat f -- ARG[1] - -> SNat s -- ARG[2] - -> SNat (n + 1) -- ARG[3] - -> Vec i a -- ARG[4] - -> Vec (n + 1) a" - , "templateD" : -"~SYM[0]_vselect : block - signal ~SYM[1] : ~TYP[4]; -begin - ~SYM[1] <= ~ARG[4]; - ~SYM[2]_vselect : for ~SYM[3] in 0 to ~RESULT'high generate - begin - ~RESULT(~RESULT'high - ~SYM[3]) <= ~SYM[1](~SYM[1]'high - (~LIT[1]+(~LIT[2]*~SYM[3]))); - end generate; -end block;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vcopy" - , "templateE" : "~TYPMO'((~LIT[0] - 1) downto 0 => ~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.viterate" - , "templateD" : -"~SYM[0]_viterate : for ~SYM[1] in ~RESULT'high downto 0 generate -begin - ~SYM[2]_generate : if ~SYM[1] = (~RESULT'high) generate - begin - ~RESULT(~SYM[1]) <= ~ARG[2]; - end generate; - - ~SYM[3]_generate : if ~SYM[1] /= (~RESULT'high) generate - begin - ~INST 0 - ~OUTPUT <= ~RESULT(~SYM[1])~ ~TYPEL[~TYPO]~ - ~INPUT <= ~RESULT(~SYM[1]+1)~ ~TYPEL[~TYPO]~ - ~INST - end generate; -end generate;" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.lazyV" - , "templateE" : "~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "CLaSH.Sized.Vector.vhead'" - , "templateD" : -"~SYM[0]_vhead : block - signal ~SYM[1] : ~TYP[1]; -begin - ~SYM[1] <= ~ARG[1]; - ~RESULT <= ~SYM[1](~SYM[1]'high); -end block;" - } - } -] diff --git a/primitives/control.exception.base.json b/primitives/control.exception.base.json deleted file mode 100644 --- a/primitives/control.exception.base.json +++ /dev/null @@ -1,16 +0,0 @@ -[ { "BlackBox" : - { "name" : "Control.Exception.Base.patError" - , "templateE" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "Control.Exception.Base.irrefutPatError" - , "templateE" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "Control.Exception.Base.recSelError" - , "templateE" : "~ERRORO" - } - } -] diff --git a/primitives/ghc.base.json b/primitives/ghc.base.json deleted file mode 100644 --- a/primitives/ghc.base.json +++ /dev/null @@ -1,33 +0,0 @@ -[ { "Primitive" : - { "name" : "GHC.Base.$" - , "primType" : "Function" - } - } -, { "BlackBox" : - { "name" : "GHC.Base.quotInt" - , "templateE" : "~ARG[0] div ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Base.remInt" - , "templateE" : "~ARG[0] rem ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Base.divInt" - , "templateD" : -"~SYM[0]_block : 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" - , "templateE" : "~ARG[0] mod ~ARG[1]" - } - } -] diff --git a/primitives/ghc.classes.json b/primitives/ghc.classes.json deleted file mode 100644 --- a/primitives/ghc.classes.json +++ /dev/null @@ -1,63 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Classes.eqInt" - , "templateE" : "~ARG[0] = ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.neInt" - , "templateE" : "~ARG[0] /= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.gtInt" - , "templateE" : "~ARG[0] > ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.geInt" - , "templateE" : "~ARG[0] >= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.ltInt" - , "templateE" : "~ARG[0] < ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.leInt" - , "templateE" : "~ARG[0] <= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.&&" - , "templateE" : "~ARG[0] and ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.||" - , "templateE" : "~ARG[0] or ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.not" - , "templateE" : "not ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.divInt#" - , "templateD" : -"~SYM[0]_block : 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#" - , "templateE" : "~ARG[0] mod ~ARG[1]" - } - } -] diff --git a/primitives/ghc.cstring.json b/primitives/ghc.cstring.json deleted file mode 100644 --- a/primitives/ghc.cstring.json +++ /dev/null @@ -1,11 +0,0 @@ -[ { "Primitive" : - { "name" : "GHC.CString.unpackCString#" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "GHC.CString.unpackCStringUtf8#" - , "primType" : "Function" - } - } -] diff --git a/primitives/ghc.err.json b/primitives/ghc.err.json deleted file mode 100644 --- a/primitives/ghc.err.json +++ /dev/null @@ -1,11 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Err.error" - , "templateE" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "GHC.Err.undefined" - , "templateE" : "~ERRORO" - } - } -] diff --git a/primitives/ghc.integer.type.json b/primitives/ghc.integer.type.json deleted file mode 100644 --- a/primitives/ghc.integer.type.json +++ /dev/null @@ -1,123 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Integer.Type.smallInteger" - , "templateE" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.integerToInt" - , "templateE" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.plusInteger" - , "templateE" : "~ARG[0] + ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.minusInteger" - , "templateE" : "~ARG[0] - ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.timesInteger" - , "templateE" : "~ARG[0] * ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.negateInteger" - , "templateE" : "-~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.absInteger" - , "templateE" : "abs ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.divInteger" - , "templateD" : -"~SYM[0]_block : 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" - , "templateE" : "~ARG[0] mod ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.quotInteger" - , "templateE" : "~ARG[0] div ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.remInteger" - , "templateE" : "~ARG[0] rem ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.eqInteger" - , "templateE" : "~ARG[0] = ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.neqInteger" - , "templateE" : "~ARG[0] /= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.leInteger" - , "templateE" : "~ARG[0] <= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.gtInteger" - , "templateE" : "~ARG[0] > ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.ltInteger" - , "templateE" : "~ARG[0] < ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.geInteger" - , "templateE" : "~ARG[0] >= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.eqInteger#" - , "templateE" : "1 when ~ARG[0] = ~ARG[1] else 0" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.neqInteger#" - , "templateE" : "1 when ~ARG[0] /= ~ARG[1] else 0" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.leInteger#" - , "templateE" : "1 when ~ARG[0] <= ~ARG[1] else 0" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.gtInteger#" - , "templateE" : "1 when ~ARG[0] > ~ARG[1] else 0" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.ltInteger#" - , "templateE" : "1 when ~ARG[0] < ~ARG[1] else 0" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.geInteger#" - , "templateE" : "1 when ~ARG[0] >= ~ARG[1] else 0" - } - } -] diff --git a/primitives/ghc.prim.json b/primitives/ghc.prim.json deleted file mode 100644 --- a/primitives/ghc.prim.json +++ /dev/null @@ -1,76 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Prim.+#" - , "templateE" : "~ARG[0] + ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.-#" - , "templateE" : "~ARG[0] - ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.*#" - , "templateE" : "~ARG[0] * ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.quotInt#" - , "templateE" : "~ARG[0] div ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.remInt#" - , "templateE" : "~ARG[0] rem ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.negateInt#" - , "templateE" : "-~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.>#" - , "templateE" : "1 when ~ARG[0] > ~ARG[1] else 0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.>=#" - , "templateE" : "1 when ~ARG[0] >= ~ARG[1] else 0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.==#" - , "templateE" : "1 when ~ARG[0] = ~ARG[1] else 0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim./=#" - , "templateE" : "1 when ~ARG[0] /= ~ARG[1] else 0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.<#" - , "templateE" : "1 when ~ARG[0] < ~ARG[1] else 0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.<=#" - , "templateE" : "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#" - , "templateE" : "~ARG[0]" - } - } -] diff --git a/primitives/ghc.real.json b/primitives/ghc.real.json deleted file mode 100644 --- a/primitives/ghc.real.json +++ /dev/null @@ -1,16 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Real.divZeroError" - , "templateE" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "GHC.Real.ratioZeroDenominatorError" - , "templateE" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "GHC.Real.overflowError" - , "templateE" : "~ERRORO" - } - } -] diff --git a/primitives/ghc.typelits.json b/primitives/ghc.typelits.json deleted file mode 100644 --- a/primitives/ghc.typelits.json +++ /dev/null @@ -1,6 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.TypeLits.natVal" - , "templateE" : "~LIT[0]" - } - } -] diff --git a/primitives/ghc.types.json b/primitives/ghc.types.json deleted file mode 100644 --- a/primitives/ghc.types.json +++ /dev/null @@ -1,11 +0,0 @@ -[ { "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 deleted file mode 100644 --- a/primitives/unsafe.coerce.json +++ /dev/null @@ -1,6 +0,0 @@ -[ { "BlackBox" : - { "name" : "Unsafe.Coerce.unsafeCoerce" - , "templateE" : "~ARG[0]" - } - } -] diff --git a/src-bin/InteractiveUI.hs b/src-bin/InteractiveUI.hs --- a/src-bin/InteractiveUI.hs +++ b/src-bin/InteractiveUI.hs @@ -1496,21 +1496,24 @@ makeVHDL :: [FilePath] -> InputT GHCi () makeVHDL [] = do modGraph <- GHC.getModuleGraph + dflags <- getDynFlags let sortedGraph = GHC.topSortModuleGraph False modGraph Nothing case (reverse sortedGraph) of (AcyclicSCC top):_ -> do let loc = (GHC.ml_hs_file . GHC.ms_location) top maybe (return ()) (\src -> liftIO $ do primDir <- getDefPrimDir primMap <- CLaSH.Primitives.Util.generatePrimMap [primDir,"."] - (bindingsMap,tcm) <- generateBindings primMap src + (bindingsMap,tcm) <- generateBindings primMap src (Just dflags) CLaSH.Driver.generateVHDL bindingsMap primMap tcm ghcTypeToHWType reduceConstant DebugNone ) loc _ -> return () -makeVHDL srcs = liftIO $ do primDir <- getDefPrimDir - primMap <- CLaSH.Primitives.Util.generatePrimMap [primDir,"."] - mapM_ (\src -> do (bindingsMap,tcm) <- generateBindings primMap src - CLaSH.Driver.generateVHDL bindingsMap primMap tcm ghcTypeToHWType reduceConstant DebugNone - ) srcs +makeVHDL srcs = do + dflags <- getDynFlags + liftIO $ do primDir <- getDefPrimDir + primMap <- CLaSH.Primitives.Util.generatePrimMap [primDir,"."] + mapM_ (\src -> do (bindingsMap,tcm) <- generateBindings primMap src (Just dflags) + CLaSH.Driver.generateVHDL bindingsMap primMap tcm ghcTypeToHWType reduceConstant DebugNone + ) srcs ----------------------------------------------------------------------------- -- :type @@ -1890,10 +1893,9 @@ -- the actual exception thrown by checkAdd, using tryBool to -- turn it into a Bool. iidecls <- filterM (tryBool.checkAdd) (transient_ctx st ++ remembered_ctx st) - dflags <- GHC.getSessionDynFlags GHC.setContext $ - if xopt Opt_ImplicitPrelude dflags && not (any isPreludeImport iidecls) - then iidecls ++ [implicitPreludeImport,implicitCLaSHPreludeImport] + if not (any isPreludeImport iidecls) + then iidecls ++ [implicitPreludeImport] else iidecls -- XXX put prel at the end, so that guessCurrentModule doesn't pick it up. @@ -1915,17 +1917,11 @@ iiModuleName (IIDecl d) = unLoc (ideclName d) preludeModuleName :: ModuleName -preludeModuleName = GHC.mkModuleName "Prelude" - -clashPreludeModuleName :: ModuleName -clashPreludeModuleName = GHC.mkModuleName "CLaSH.Prelude" +preludeModuleName = GHC.mkModuleName "CLaSH.Prelude" implicitPreludeImport :: InteractiveImport implicitPreludeImport = IIDecl (simpleImportDecl preludeModuleName) -implicitCLaSHPreludeImport :: InteractiveImport -implicitCLaSHPreludeImport = IIDecl (simpleImportDecl clashPreludeModuleName) - isPreludeImport :: InteractiveImport -> Bool isPreludeImport (IIModule {}) = True isPreludeImport (IIDecl d) = unLoc (ideclName d) == preludeModuleName @@ -2283,8 +2279,7 @@ prel_imp | any isPreludeImport (rem_ctx ++ trans_ctx) = [] - | not (xopt Opt_ImplicitPrelude dflags) = [] - | otherwise = ["import Prelude -- implicit"] + | otherwise = ["import CLaSH.Prelude -- implicit"] trans_comment s = s ++ " -- added automatically" -- diff --git a/src-bin/Main.hs b/src-bin/Main.hs --- a/src-bin/Main.hs +++ b/src-bin/Main.hs @@ -175,6 +175,10 @@ , DynFlags.Opt_ConstraintKinds , DynFlags.Opt_TypeFamilies ] + dflagsExtra' = foldl DynFlags.xopt_unset dflagsExtra + [ DynFlags.Opt_ImplicitPrelude + , DynFlags.Opt_MonomorphismRestriction + ] case postStartupMode of Left preLoadMode -> @@ -185,7 +189,7 @@ ShowGhciUsage -> showGhciUsage dflags PrintWithDynFlags f -> putStrLn (f dflags) Right postLoadMode -> - main' postLoadMode dflagsExtra argv3 flagWarnings + main' postLoadMode dflagsExtra' argv3 flagWarnings main' :: PostLoadMode -> DynFlags -> [Located String] -> [Located String] -> Ghc () @@ -895,11 +899,13 @@ doVHDL :: [(String,Maybe Phase)] -> Ghc () doVHDL [] = throwGhcException (CmdLineError "No input files") -doVHDL srcs = liftIO $ do primDir <- getDefPrimDir - primMap <- CLaSH.Primitives.Util.generatePrimMap [primDir,"."] - mapM_ (\(src,_) -> do (bindingsMap,tcm) <- generateBindings primMap src - CLaSH.Driver.generateVHDL bindingsMap primMap tcm ghcTypeToHWType reduceConstant DebugNone - ) srcs +doVHDL srcs = do + dflags <- GHC.getSessionDynFlags + liftIO $ do primDir <- getDefPrimDir + primMap <- CLaSH.Primitives.Util.generatePrimMap [primDir,"."] + mapM_ (\(src,_) -> do (bindingsMap,tcm) <- generateBindings primMap src (Just dflags) + CLaSH.Driver.generateVHDL bindingsMap primMap tcm ghcTypeToHWType reduceConstant DebugNone + ) srcs -- ----------------------------------------------------------------------------- -- Util diff --git a/src-ghc/CLaSH/GHC/Evaluator.hs b/src-ghc/CLaSH/GHC/Evaluator.hs --- a/src-ghc/CLaSH/GHC/Evaluator.hs +++ b/src-ghc/CLaSH/GHC/Evaluator.hs @@ -1,37 +1,60 @@ {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE OverloadedStrings #-} module CLaSH.GHC.Evaluator where import qualified Data.Bifunctor as Bifunctor +import Data.Bits (shiftL,shiftR) import qualified Data.Either as Either import qualified Data.HashMap.Strict as HashMap import qualified Data.List as List -import qualified Data.Text as Text +import Unbound.LocallyNameless (bind, embed, string2Name) + import CLaSH.Core.DataCon (dcTag) import CLaSH.Core.Literal (Literal (..)) import CLaSH.Core.Term (Term (..)) -import CLaSH.Core.Type (Type (..), ConstTy (..)) +import CLaSH.Core.Type (Type (..), ConstTy (..), mkFunTy) import CLaSH.Core.TyCon (TyCon, TyConName, tyConDataCons) -import CLaSH.Core.Util (collectArgs) +import CLaSH.Core.TysPrim (typeNatKind) +import CLaSH.Core.Util (collectArgs, mkApps) +import CLaSH.Core.Var (Var (..)) reduceConstant :: HashMap.HashMap TyConName TyCon -> Term -> Term reduceConstant tcm e@(collectArgs -> (Prim nm _, args)) - | nm == Text.pack "GHC.Integer.Type.eqInteger#" + | nm == "GHC.Prim.==#" || nm == "GHC.Integer.Type.eqInteger#" = case (map (reduceConstant tcm) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] | i == j -> Literal (IntegerLiteral 1) | otherwise -> Literal (IntegerLiteral 0) _ -> e - | nm == Text.pack "GHC.Prim.<=#" || nm == Text.pack "GHC.Integer.Type.leInteger#" + | nm == "GHC.Integer.Type.gtInteger#" = case (map (reduceConstant tcm) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] + | i > j -> Literal (IntegerLiteral 1) + | otherwise -> Literal (IntegerLiteral 0) + _ -> e + | nm == "GHC.Integer.Type.ltInteger#" + = case (map (reduceConstant tcm) . Either.lefts) args of + [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] + | i < j -> Literal (IntegerLiteral 1) + | otherwise -> Literal (IntegerLiteral 0) + _ -> e + | nm == "GHC.Prim.<=#" || nm == "GHC.Integer.Type.leInteger#" + = case (map (reduceConstant tcm) . Either.lefts) args of + [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] | i <= j -> Literal (IntegerLiteral 1) | otherwise -> Literal (IntegerLiteral 0) _ -> e - | nm == Text.pack "GHC.Integer.Type.integerToInt" + | nm == "GHC.Prim.>=#" || nm == "GHC.Integer.Type.geInteger#" = case (map (reduceConstant tcm) . Either.lefts) args of + [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] + | i >= j -> Literal (IntegerLiteral 1) + | otherwise -> Literal (IntegerLiteral 0) + _ -> e + | nm == "GHC.Integer.Type.integerToInt" + = case (map (reduceConstant tcm) . Either.lefts) args of [Literal (IntegerLiteral i)] -> Literal (IntegerLiteral i) _ -> e - | nm == Text.pack "GHC.Prim.tagToEnum#" + | nm == "GHC.Prim.tagToEnum#" = case map (Bifunctor.bimap (reduceConstant tcm) id) args of [Right (ConstTy (TyCon tcN)), Left (Literal (IntegerLiteral i))] -> let dc = do { tc <- HashMap.lookup tcN tcm @@ -40,5 +63,81 @@ } in maybe e Data dc _ -> e + | nm == "GHC.Prim.*#" + = case (map (reduceConstant tcm) . Either.lefts) args of + [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] + -> Literal (IntegerLiteral (i * j)) + _ -> e + | nm == "GHC.Integer.Type.divInteger" + = case (map (reduceConstant tcm) . Either.lefts) args of + [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] + -> Literal (IntegerLiteral (i `div` j)) + _ -> e + | nm == "GHC.Integer.Type.shiftLInteger" + = case (map (reduceConstant tcm) . Either.lefts) args of + [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] + -> Literal (IntegerLiteral (i `shiftL` fromInteger j)) + _ -> e + | nm == "GHC.Integer.Type.shiftRInteger" + = case (map (reduceConstant tcm) . Either.lefts) args of + [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] + -> Literal (IntegerLiteral (i `shiftR` fromInteger j)) + _ -> e + | nm == "GHC.Prim.negateInt#" + = case (map (reduceConstant tcm) . Either.lefts) args of + [Literal (IntegerLiteral i)] -> Literal (IntegerLiteral (negate i)) + _ -> e + | nm == "CLaSH.Sized.Internal.Signed.minBound#" + = case args of + [litTy,Left (Literal (IntegerLiteral mb))] + -> let minB = negate (2 ^ (mb - 1)) + in mkApps signedConPrim [litTy,Left (Literal (IntegerLiteral minB))] + _ -> e + | nm == "CLaSH.Sized.Internal.Signed.maxBound#" + = case args of + [litTy,Left (Literal (IntegerLiteral mb))] + -> let maxB = (2 ^ (mb - 1)) - 1 + in mkApps signedConPrim [litTy,Left (Literal (IntegerLiteral maxB))] + _ -> e + | nm == "CLaSH.Sized.Internal.Unsigned.minBound#" + = case args of + [litTy] + -> mkApps unsignedConPrim [litTy,Left (Literal (IntegerLiteral 0))] + _ -> e + | nm == "CLaSH.Sized.Internal.Unsigned.maxBound#" + = case args of + [litTy,Left (Literal (IntegerLiteral mb))] + -> let maxB = 2 ^ mb + in mkApps unsignedConPrim [litTy,Left (Literal (IntegerLiteral maxB))] + _ -> e + | nm == "CLaSH.Sized.Internal.Signed.toInteger#" || nm == "CLaSH.Sized.Internal.Unsigned.toInteger#" + = case (map (reduceConstant tcm) . Either.lefts) args of + [App _ (Literal (IntegerLiteral i))] + -> Literal (IntegerLiteral i) + _ -> e + | nm == "GHC.TypeLits.natVal" + = case (map (reduceConstant tcm) . Either.lefts) args of + [Literal (IntegerLiteral i), _] -> Literal (IntegerLiteral i) + _ -> e reduceConstant _ e = e + +signedConPrim :: Term +signedConPrim = Prim "CLaSH.Sized.Internal.Signed.S" (ForAllTy (bind nTV funTy)) + where + funTy = mkFunTy intTy (AppTy signedTy nVar) + intTy = ConstTy (TyCon (string2Name "GHC.Integer.Type.Integer")) + signedTy = ConstTy (TyCon (string2Name "CLaSH.Sized.Internal.Signed.Signed")) + nName = string2Name "n" + nVar = VarTy typeNatKind nName + nTV = TyVar nName (embed typeNatKind) + +unsignedConPrim :: Term +unsignedConPrim = Prim "CLaSH.Sized.Internal.Unsigned.U" (ForAllTy (bind nTV funTy)) + where + funTy = mkFunTy intTy (AppTy unsignedTy nVar) + intTy = ConstTy (TyCon (string2Name "GHC.Integer.Type.Integer")) + unsignedTy = ConstTy (TyCon (string2Name "CLaSH.Sized.Internal.Unsigned.Unsigned")) + nName = string2Name "n" + nVar = VarTy typeNatKind nName + nTV = TyVar nName (embed typeNatKind) diff --git a/src-ghc/CLaSH/GHC/GHC2Core.hs b/src-ghc/CLaSH/GHC/GHC2Core.hs --- a/src-ghc/CLaSH/GHC/GHC2Core.hs +++ b/src-ghc/CLaSH/GHC/GHC2Core.hs @@ -275,15 +275,13 @@ Nothing -> C.Data <$> coreToDataCon (isDataConWrapId x && not (isNewTyCon (dataConTyCon dc))) dc Nothing -> case HashMap.lookup xNameS primMap of Just (Primitive f _) - | f == pack "CLaSH.Signal.Types.mapSignal" -> return (mapSyncTerm xType) - | f == pack "CLaSH.Signal.Types.appSignal" -> return (mapSyncTerm xType) - | f == pack "CLaSH.Signal.Types.signal" -> return (syncTerm xType) - | f == pack "CLaSH.Signal.Implicit.pack" -> return (splitCombineTerm False xType) - | f == pack "CLaSH.Signal.Implicit.unpack" -> return (splitCombineTerm True xType) - | f == pack "CLaSH.Signal.Explicit.cpack" -> return (cpackCUnpackTerm False xType) - | f == pack "CLaSH.Signal.Explicit.cunpack" -> return (cpackCUnpackTerm True xType) - | f == pack "GHC.Base.$" -> return (dollarAppTerm xType) - | otherwise -> return (C.Prim xNameS xType) + | f == pack "CLaSH.Signal.Internal.mapSignal#" -> return (mapSignalTerm xType) + | f == pack "CLaSH.Signal.Internal.signal#" -> return (signalTerm xType) + | f == pack "CLaSH.Signal.Internal.appSignal#" -> return (appSignalTerm xType) + | f == pack "CLaSH.Signal.Internal.traverse#" -> return (traverseTerm xType) + | f == pack "CLaSH.Signal.Bundle.vecBundle#" -> return (vecUnwrapTerm xType) + | f == pack "GHC.Base.$" -> return (dollarTerm xType) + | otherwise -> return (C.Prim xNameS xType) Just (BlackBox {}) -> return (C.Prim xNameS xType) Nothing @@ -420,84 +418,217 @@ let moduleNm = moduleName module_ return (moduleNameString moduleNm) -mapSyncTerm :: C.Type - -> C.Term -mapSyncTerm (C.ForAllTy tvATy) = - let (aTV,bTV,C.tyView -> C.FunTy _ (C.tyView -> C.FunTy aTy bTy)) = runFreshM $ do - { (aTV',C.ForAllTy tvBTy) <- unbind tvATy - ; (bTV',funTy) <- unbind tvBTy - ; return (aTV',bTV',funTy) } - fName = string2Name "f" - xName = string2Name "x" - fTy = C.mkFunTy aTy bTy - fId = C.Id fName (embed fTy) - xId = C.Id xName (embed aTy) - in C.TyLam $ bind aTV $ - C.TyLam $ bind bTV $ - C.Lam $ bind fId $ - C.Lam $ bind xId $ - C.App (C.Var fTy fName) (C.Var aTy xName) +-- | Given the type: +-- +-- @forall a. forall b. forall clk. (a -> b) -> CSignal clk a -> CSignal clk b@ +-- +-- Generate the term: +-- +-- @ +-- /\(a:*)./\(b:*)./\(clk:Clock).\(f : (CSignal clk a -> CSignal clk b)). +-- \(x : CSignal clk a).f x +-- @ +mapSignalTerm :: C.Type + -> C.Term +mapSignalTerm (C.ForAllTy tvATy) = + C.TyLam (bind aTV ( + C.TyLam (bind bTV ( + C.TyLam (bind clkTV ( + C.Lam (bind fId ( + C.Lam (bind xId ( + C.App (C.Var fTy fName) (C.Var aTy xName))))))))))) + where + (aTV,bTV,clkTV,funTy) = runFreshM $ do + { (aTV',C.ForAllTy tvBTy) <- unbind tvATy + ; (bTV',C.ForAllTy tvClkTy) <- unbind tvBTy + ; (clkTV',funTy') <- unbind tvClkTy + ; return (aTV',bTV',clkTV',funTy') + } + (C.FunTy _ funTy'') = C.tyView funTy + (C.FunTy aTy bTy) = C.tyView funTy'' + fName = string2Name "f" + xName = string2Name "x" + fTy = C.mkFunTy aTy bTy + fId = C.Id fName (embed fTy) + xId = C.Id xName (embed aTy) -mapSyncTerm ty = error $ $(curLoc) ++ show ty +mapSignalTerm ty = error $ $(curLoc) ++ show ty -syncTerm :: C.Type - -> C.Term -syncTerm (C.ForAllTy tvTy) = - let (aTV,C.tyView -> C.FunTy _ aTy) = runFreshM $ unbind tvTy - xName = string2Name "x" - xId = C.Id xName (embed aTy) - in C.TyLam $ bind aTV $ - C.Lam $ bind xId $ - C.Var aTy xName +-- | Given the type: +-- +-- @forall a. forall clk. a -> CSignal clk a@ +-- +-- Generate the term +-- +-- @/\(a:*)./\(clk:Clock).\(x:CSignal clk a).x@ +signalTerm :: C.Type + -> C.Term +signalTerm (C.ForAllTy tvATy) = + C.TyLam (bind aTV ( + C.TyLam (bind clkTV ( + C.Lam (bind xId ( + C.Var aTy xName)))))) + where + (aTV,clkTV,funTy) = runFreshM $ do + { (aTV', C.ForAllTy tvClkTy) <- unbind tvATy + ; (clkTV', funTy') <- unbind tvClkTy + ; return (aTV',clkTV',funTy') + } + (C.FunTy _ aTy) = C.tyView funTy + xName = string2Name "x" + xId = C.Id xName (embed aTy) -syncTerm ty = error $ $(curLoc) ++ show ty +signalTerm ty = error $ $(curLoc) ++ show ty -splitCombineTerm :: Bool - -> C.Type - -> C.Term -splitCombineTerm b (C.ForAllTy tvTy) = - let (aTV,C.tyView -> C.FunTy dictTy (C.tyView -> C.FunTy inpTy outpTy)) = runFreshM $ unbind tvTy - dictName = string2Name "splitCombineDict" - xName = string2Name "x" - nTy = if b then inpTy else outpTy - dId = C.Id dictName (embed dictTy) - xId = C.Id xName (embed nTy) - newExpr = C.TyLam $ bind aTV $ - C.Lam $ bind dId $ - C.Lam $ bind xId $ - C.Var nTy xName - in newExpr +-- | Given the type: +-- +-- @ +-- forall clk. forall a. forall b. CSignal clk (a -> b) -> CSignal clk a -> +-- CSignal clk b +-- @ +-- +-- Generate the term: +-- +-- @ +-- /\(clk:Clock)./\(a:*)./\(b:*).\(f : (CSignal clk a -> CSignal clk b)). +-- \(x : CSignal clk a).f x +-- @ +appSignalTerm :: C.Type + -> C.Term +appSignalTerm (C.ForAllTy tvClkTy) = + C.TyLam (bind clkTV ( + C.TyLam (bind aTV ( + C.TyLam (bind bTV ( + C.Lam (bind fId ( + C.Lam (bind xId ( + C.App (C.Var fTy fName) (C.Var aTy xName))))))))))) + where + (clkTV,aTV,bTV,funTy) = runFreshM $ do + { (clkTV',C.ForAllTy tvATy) <- unbind tvClkTy + ; (aTV',C.ForAllTy tvBTy) <- unbind tvATy + ; (bTV',funTy') <- unbind tvBTy + ; return (clkTV',aTV',bTV',funTy') + } + (C.FunTy _ funTy'') = C.tyView funTy + (C.FunTy aTy bTy) = C.tyView funTy'' + fName = string2Name "f" + xName = string2Name "x" + fTy = C.mkFunTy aTy bTy + fId = C.Id fName (embed fTy) + xId = C.Id xName (embed aTy) -splitCombineTerm _ ty = error $ $(curLoc) ++ show ty +appSignalTerm ty = error $ $(curLoc) ++ show ty -cpackCUnpackTerm :: Bool - -> C.Type - -> C.Term -cpackCUnpackTerm b (C.ForAllTy tvTy) = newExpr +-- | Given the type: +-- +-- @ +-- forall t.forall n.forall a.SClock t -> Vec n (CSignal t a) -> +-- CSignal t (Vec n a) +-- @ +-- +-- Generate the term: +-- +-- @ +-- /\(t:Clock)./\(n:Nat)./\(a:*).\(sclk:SClock t).\(vs:CSignal (Vec n a)).vs +-- @ +vecUnwrapTerm :: C.Type + -> C.Term +vecUnwrapTerm (C.ForAllTy tvTTy) = + C.TyLam (bind tTV ( + C.TyLam (bind nTV ( + C.TyLam (bind aTV ( + C.Lam (bind sclkId ( + C.Lam (bind vsId ( + C.Var vsTy vsName)))))))))) where - (aTV,packCDict,clkTV,clkTy,inpTy,outpTy) = runFreshM $ do - (aTV',C.tyView -> C.FunTy packCDict' (C.ForAllTy ty2)) <- unbind tvTy - (clkTV',C.tyView -> (C.FunTy clkTy' (C.tyView -> C.FunTy inpTy' outpTy'))) <- unbind ty2 - return (aTV',packCDict',clkTV',clkTy',inpTy',outpTy') - dictName = string2Name "cpackDict" - clkName = string2Name "clk" - sigName = string2Name "csig" - sigTy = if b then inpTy else outpTy - dictId = C.Id dictName (embed packCDict) - clkId = C.Id clkName (embed clkTy) - sigId = C.Id sigName (embed sigTy) - newExpr = C.TyLam $ bind aTV $ - C.Lam $ bind dictId $ - C.TyLam $ bind clkTV $ - C.Lam $ bind clkId $ - C.Lam $ bind sigId $ - C.Var sigTy sigName + (tTV,nTV,aTV,funTy) = runFreshM $ do + { (tTV',C.ForAllTy tvNTy) <- unbind tvTTy + ; (nTV',C.ForAllTy tvATy) <- unbind tvNTy + ; (aTV',funTy') <- unbind tvATy + ; return (tTV',nTV',aTV',funTy') + } + (C.FunTy sclkTy funTy'') = C.tyView funTy + (C.FunTy _ vsTy) = C.tyView funTy'' + sclkName = string2Name "sclk" + vsName = string2Name "vs" + sclkId = C.Id sclkName (embed sclkTy) + vsId = C.Id vsName (embed vsTy) -cpackCUnpackTerm _ ty = error $ $(curLoc) ++ show ty +vecUnwrapTerm ty = error $ $(curLoc) ++ show ty -dollarAppTerm :: C.Type - -> C.Term -dollarAppTerm = mapSyncTerm +-- | Given the type: +-- +-- @ +-- forall f.forall a.forall b.forall clk.Applicative f => (a -> f b) -> +-- CSignal clk a -> f (CSignal clk b) +-- @ +-- +-- Generate the term: +-- +-- @ +-- /\(f:* -> *)./\(a:*)./\(b:*)./\(clk:Clock).\(dict:Applicative f). +-- \(g:a -> f b).\(x:CSignal clk a).g x +-- @ +traverseTerm :: C.Type + -> C.Term +traverseTerm (C.ForAllTy tvFTy) = + C.TyLam (bind fTV ( + C.TyLam (bind aTV ( + C.TyLam (bind bTV ( + C.TyLam (bind clkTV ( + C.Lam (bind dictId ( + C.Lam (bind gId ( + C.Lam (bind xId ( + C.App (C.Var gTy gName) (C.Var xTy xName))))))))))))))) + where + (fTV,aTV,bTV,clkTV,funTy) = runFreshM $ do + { (fTV',C.ForAllTy tvATy) <- unbind tvFTy + ; (aTV',C.ForAllTy tvBTy) <- unbind tvATy + ; (bTV',C.ForAllTy tvClkTy) <- unbind tvBTy + ; (clkTV',funTy') <- unbind tvClkTy + ; return (fTV',aTV',bTV',clkTV',funTy') + } + (C.FunTy dictTy funTy1) = C.tyView funTy + (C.FunTy gTy funTy2) = C.tyView funTy1 + (C.FunTy xTy _) = C.tyView funTy2 + dictName = string2Name "dict" + gName = string2Name "g" + xName = string2Name "x" + dictId = C.Id dictName (embed dictTy) + gId = C.Id gName (embed gTy) + xId = C.Id xName (embed xTy) + +traverseTerm ty = error $ $(curLoc) ++ show ty + +-- | Given the type: +-- +-- @forall a. forall b. (a -> b) -> a -> b@ +-- +-- Generate the term: +-- +-- @/\(a:*)./\(b:*).\(f : (a -> b)).\(x : a).f x@ +dollarTerm :: C.Type + -> C.Term +dollarTerm (C.ForAllTy tvATy) = + C.TyLam (bind aTV ( + C.TyLam (bind bTV ( + C.Lam (bind fId ( + C.Lam (bind xId ( + C.App (C.Var fTy fName) (C.Var aTy xName))))))))) + where + (aTV,bTV,funTy) = runFreshM $ do + { (aTV',C.ForAllTy tvBTy) <- unbind tvATy + ; (bTV',funTy') <- unbind tvBTy + ; return (aTV',bTV',funTy') + } + (C.FunTy fTy funTy'') = C.tyView funTy + (C.FunTy aTy _) = C.tyView funTy'' + fName = string2Name "f" + xName = string2Name "x" + fId = C.Id fName (embed fTy) + xId = C.Id xName (embed aTy) + +dollarTerm ty = error $ $(curLoc) ++ show ty isDataConWrapId :: Id -> Bool isDataConWrapId v = case idDetails v of diff --git a/src-ghc/CLaSH/GHC/GenerateBindings.hs b/src-ghc/CLaSH/GHC/GenerateBindings.hs --- a/src-ghc/CLaSH/GHC/GenerateBindings.hs +++ b/src-ghc/CLaSH/GHC/GenerateBindings.hs @@ -12,6 +12,7 @@ import Unbound.LocallyNameless (name2String, runFreshM, unembed) import qualified CoreSyn as GHC +import qualified DynFlags as GHC import CLaSH.Core.FreeVars (termFreeIds) import CLaSH.Core.Term (Term (..), TmName) @@ -33,9 +34,10 @@ generateBindings :: PrimMap -> String + -> Maybe (GHC.DynFlags) -> IO (BindingMap,HashMap TyConName TyCon) -generateBindings primMap modName = do - (bindings,clsOps,unlocatable,fiEnvs) <- loadModules modName +generateBindings primMap modName dflagsM = do + (bindings,clsOps,unlocatable,fiEnvs) <- loadModules modName dflagsM let ((bindingsMap,clsVMap),tcMap) = State.runState (mkBindings primMap bindings clsOps unlocatable) emptyGHC2CoreState tcCache = makeAllTyCons tcMap fiEnvs allTcCache = tysPrimMap `HashMap.union` tcCache diff --git a/src-ghc/CLaSH/GHC/LoadModules.hs b/src-ghc/CLaSH/GHC/LoadModules.hs --- a/src-ghc/CLaSH/GHC/LoadModules.hs +++ b/src-ghc/CLaSH/GHC/LoadModules.hs @@ -18,19 +18,17 @@ #endif -- GHC API --- import qualified CorePrep import CLaSH.GHC.Compat.DynFlags (dopt_set, dopt_unset) import CLaSH.GHC.Compat.GHC (defaultErrorHandler) import qualified CoreSyn import DynFlags (GeneralFlag (..)) import qualified DynFlags import qualified GHC --- import qualified HscMain +import qualified HscMain import qualified HscTypes import qualified MonadUtils import qualified Panic import qualified TidyPgm --- import qualified TyCons import qualified TcRnMonad import qualified TcRnTypes @@ -66,35 +64,44 @@ loadModules :: String + -> Maybe (DynFlags.DynFlags) -> IO ( [(CoreSyn.CoreBndr, CoreSyn.CoreExpr)] -- Binders , [(CoreSyn.CoreBndr,Int)] -- Class operations , [CoreSyn.CoreBndr] -- Unlocatable Expressions , FamInstEnv.FamInstEnvs ) -loadModules modName = defaultErrorHandler $ do +loadModules modName dflagsM = defaultErrorHandler $ do libDir <- MonadUtils.liftIO ghcLibDir GHC.runGhc (Just libDir) $ do - dflags <- GHC.getSessionDynFlags + dflags <- case dflagsM of + Just df -> return df + Nothing -> do + df <- GHC.getSessionDynFlags + let dfEn = foldl DynFlags.xopt_set df + [ DynFlags.Opt_TemplateHaskell + , DynFlags.Opt_DataKinds + , DynFlags.Opt_TypeOperators + , DynFlags.Opt_FlexibleContexts + , DynFlags.Opt_ConstraintKinds + , DynFlags.Opt_TypeFamilies + ] + let dfDis = foldl DynFlags.xopt_unset dfEn + [ DynFlags.Opt_ImplicitPrelude + , DynFlags.Opt_MonomorphismRestriction + ] + return dfDis + let dflags1 = dflags { DynFlags.ctxtStkDepth = 1000 + , DynFlags.optLevel = 2 + , DynFlags.ghcMode = GHC.CompManager + , DynFlags.ghcLink = GHC.LinkInMemory + , DynFlags.hscTarget = DynFlags.defaultObjectTarget + (DynFlags.targetPlatform dflags) + } + let dflags2 = wantedOptimizationFlags dflags1 let ghcDynamic = case lookup "GHC Dynamic" (DynFlags.compilerInfo dflags) of Just "YES" -> True _ -> False - let dflags1 = foldl DynFlags.xopt_set - (dflags - { DynFlags.ctxtStkDepth = 1000 - , DynFlags.optLevel = 2 - , DynFlags.ghcMode = GHC.CompManager - , DynFlags.ghcLink = GHC.LinkInMemory - } ) - [ DynFlags.Opt_TemplateHaskell - , DynFlags.Opt_Arrows - , DynFlags.Opt_DataKinds - , DynFlags.Opt_TypeOperators - , DynFlags.Opt_FlexibleContexts - , DynFlags.Opt_ConstraintKinds - , DynFlags.Opt_TypeFamilies - ] - let dflags2 = wantedOptimizationFlags dflags1 let dflags3 = if ghcDynamic then DynFlags.gopt_set dflags2 DynFlags.Opt_BuildDynamicToo else dflags2 _ <- GHC.setSessionDynFlags dflags3 @@ -109,14 +116,9 @@ ; tcMod <- GHC.typecheckModule pMod ; dsMod <- fmap GHC.coreModule $ GHC.desugarModule tcMod ; hsc_env <- GHC.getSession - -- ; simpl_guts <- MonadUtils.liftIO $ HscMain.hscSimplify hsc_env dsMod - ; (tidy_guts,_) <- MonadUtils.liftIO $ TidyPgm.tidyProgram hsc_env dsMod - -- ; let tycons = HscTypes.cg_tycons tidy_guts + ; simpl_guts <- MonadUtils.liftIO $ HscMain.hscSimplify hsc_env dsMod + ; (tidy_guts,_) <- MonadUtils.liftIO $ TidyPgm.tidyProgram hsc_env simpl_guts ; let pgm = HscTypes.cg_binds tidy_guts - -- ; let pgm = HscTypes.mg_binds dsMod - -- ; let dataTyCons = filter TyCon.isDataTyCon tycons - -- ; dflags'' <- GHC.getSessionDynFlags - -- ; prepBinders <- MonadUtils.liftIO $ CorePrep.corePrepPgm dflags'' hsc_env pgm dataTyCons ; let modFamInstEnv = TcRnTypes.tcg_fam_inst_env $ fst $ GHC.tm_internals_ tcMod ; return (CoreSyn.flattenBinds pgm,modFamInstEnv) } @@ -153,27 +155,30 @@ wantedOptimizationFlags :: GHC.DynFlags -> GHC.DynFlags wantedOptimizationFlags df = foldl dopt_unset (foldl dopt_set df wanted) unwanted where - wanted = [ Opt_Strictness -- [Wanted?] don't care about strictness - , Opt_CSE -- CSE + wanted = [ Opt_CSE -- CSE , Opt_FullLaziness -- Floats let-bindings outside enclosing lambdas , Opt_Specialise -- Specialise on types, specialise type-class-overloaded function defined in this module for the types - , Opt_DoLambdaEtaExpansion -- We need eta-expansion anyway, so the more GHC does, the better + , Opt_DoLambdaEtaExpansion -- transform nested series of lambdas into one with multiple arguments, helps us achieve only top-level lambdas , Opt_CaseMerge -- We want fewer case-statements , Opt_DictsCheap -- Makes dictionaries seem cheap to optimizer: hopefully inline , Opt_SimpleListLiterals -- Avoids 'build' rule , Opt_ExposeAllUnfoldings -- We need all the unfoldings we can get , Opt_ForceRecomp -- Force recompilation: never bad + , Opt_EnableRewriteRules -- Reduce number of functions + , Opt_SimplPreInlining -- Inlines simple functions, we only care about the major first-order structure + , Opt_Strictness -- Strictness analysis helps with dead-code analysis + , Opt_StaticArgumentTransformation -- Turn on the static argument transformation, which turns a recursive function into a non-recursive one with a local recursive loop. + , Opt_FloatIn -- Moves let-bindings inwards, although it defeats the normal-form with a single top-level let-binding, it helps with other transformations + , Opt_DictsStrict -- Hopefully helps remove class method selectors + , Opt_DmdTxDictSel -- I think demand and strictness are related, strictness helps with dead-code, enable ] - unwanted = [ Opt_FloatIn -- Moves let-bindings inwards: defeats the normal-form with a single top-level let-binding - , Opt_StaticArgumentTransformation -- [Wanted?] Turn on the static argument transformation, which turns a recursive function into a non-recursive one with a local recursive loop. - , Opt_LiberateCase -- Perform unrolling of recursive RHS: avoid + unwanted = [ Opt_LiberateCase -- Perform unrolling of recursive RHS: avoid , Opt_SpecConstr -- Creates local-functions: avoid , Opt_IgnoreAsserts -- We don't care about assertions , Opt_DoEtaReduction -- We want eta-expansion , Opt_UnboxStrictFields -- Unboxed types are not handled properly: avoid , Opt_UnboxSmallStrictFields -- Unboxed types are not handled properly: avoid - , Opt_EnableRewriteRules -- Intermediate data-structures take up no space , Opt_Vectorise -- Don't care , Opt_VectorisationAvoidance -- Don't care , Opt_RegsGraph -- Don't care @@ -185,6 +190,6 @@ , Opt_OmitYields -- Don't care , Opt_IgnoreInterfacePragmas -- We need all the unfoldings we can get , Opt_OmitInterfacePragmas -- We need all the unfoldings we can get - , Opt_SimplPreInlining -- Does inlining, which destroys function hierarchy: avoid - , Opt_IrrefutableTuples -- Introduce irrefuntPatError: avoid + , Opt_IrrefutableTuples -- Introduce irrefutPatError: avoid + , Opt_Loopification -- STG pass, don't care ] diff --git a/src-ghc/CLaSH/GHC/NetlistTypes.hs b/src-ghc/CLaSH/GHC/NetlistTypes.hs --- a/src-ghc/CLaSH/GHC/NetlistTypes.hs +++ b/src-ghc/CLaSH/GHC/NetlistTypes.hs @@ -5,15 +5,13 @@ where import Data.HashMap.Strict (HashMap,(!)) -import Control.Monad (zipWithM) import Control.Monad.Trans.Error (ErrorT(..)) import Unbound.LocallyNameless (name2String) -import CLaSH.Core.Subst (substTys) import CLaSH.Core.Pretty (showDoc) import CLaSH.Core.TyCon (TyCon (..), TyConName) -import CLaSH.Core.Type (LitTy (..), Type (..), TyName, TypeView (..), - tyView) +import CLaSH.Core.Type (LitTy (..), Type (..), TypeView (..), + findFunSubst, tyView) import CLaSH.Netlist.Util (coreTypeToHWType) import CLaSH.Netlist.Types (HWType(..)) import CLaSH.Util @@ -27,24 +25,42 @@ "GHC.Integer.Type.Integer" -> return Integer "GHC.Prim.Int#" -> return Integer "GHC.Types.Int" -> return Integer - "GHC.Prim.ByteArray#" -> fail $ "Can't translate type: " ++ showDoc ty + "GHC.Prim.ByteArray#" -> + fail $ "Can't translate type: " ++ showDoc ty + "GHC.Types.Bool" -> return Bool - "GHC.Prim.~#" -> fail $ "Can't translate type: " ++ showDoc ty - "CLaSH.Bit.Bit" -> return Bit - "CLaSH.Signal.Implicit.Pack" -> fail $ "Can't translate type: " ++ showDoc ty - "CLaSH.Signal.Implicit.CPack" -> fail $ "Can't translate type: " ++ showDoc ty - "CLaSH.Signal.Types.Signal" -> ErrorT $ return $ coreTypeToHWType ghcTypeToHWType m (head args) - "CLaSH.Signal.Types.CSignal" -> ErrorT $ return $ coreTypeToHWType ghcTypeToHWType m (args !! 1) - "CLaSH.Signal.Implicit.SignalP" -> ErrorT $ return $ coreTypeToHWType ghcTypeToHWType m (head args) - "CLaSH.Signal.Explicit.CSignalP" -> ErrorT $ return $ coreTypeToHWType ghcTypeToHWType m (args !! 1) - "CLaSH.Sized.Signed.Signed" -> Signed <$> tyNatSize m (head args) - "CLaSH.Sized.Unsigned.Unsigned" -> Unsigned <$> tyNatSize m (head args) - "CLaSH.Sized.Vector.Vec" -> do + "GHC.Prim.~#" -> + fail $ "Can't translate type: " ++ showDoc ty + + "CLaSH.Signal.Internal.CSignal" -> + ErrorT $ return $ coreTypeToHWType ghcTypeToHWType m (args !! 1) + + "CLaSH.Sized.Internal.BitVector.BitVector" -> + BitVector <$> tyNatSize m (head args) + + "CLaSH.Sized.Internal.Index.Index" -> + Index <$> tyNatSize m (head args) + + "CLaSH.Sized.Internal.Signed.Signed" -> + Signed <$> tyNatSize m (head args) + + "CLaSH.Sized.Internal.Unsigned.Unsigned" -> + Unsigned <$> tyNatSize m (head args) + + "CLaSH.Sized.Vector.Vec" -> do let [szTy,elTy] = args sz <- tyNatSize m szTy elHWTy <- ErrorT $ return $ coreTypeToHWType ghcTypeToHWType m elTy return $ Vector sz elHWTy - _ -> ErrorT Nothing + _ -> case m ! tc of + -- TODO: Remove this conversion + -- The current problem is that type-functions are not reduced by the GHC -> Core + -- transformation process, and so end up here. Once a fix has been found for + -- this problem remove this dirty hack. + FunTyCon {tyConSubst = tcSubst} -> case findFunSubst tcSubst args of + Just ty' -> ErrorT $ return $ coreTypeToHWType ghcTypeToHWType m ty' + _ -> ErrorT Nothing + _ -> ErrorT Nothing ghcTypeToHWType _ _ = Nothing @@ -72,33 +88,3 @@ _ -> fail $ $(curLoc) ++ "Can't convert tyNat: " ++ show ty tyNatSize _ t = fail $ $(curLoc) ++ "Can't convert tyNat: " ++ show t - --- Given a set of type functions, and list of argument types, get the first --- type function that matches, and return its substituted RHS type. -findFunSubst :: [([Type],Type)] -> [Type] -> Maybe Type -findFunSubst [] _ = Nothing -findFunSubst (tcSubst:rest) args = case funSubsts tcSubst args of - Just ty -> Just ty - Nothing -> findFunSubst rest args - --- Given a ([LHS match type], RHS type) representing a type function, and --- a set of applied types. Match LHS with args, and when successful, return --- a substituted RHS -funSubsts :: ([Type],Type) -> [Type] -> Maybe Type -funSubsts (tcSubstLhs,tcSubstRhs) args = do - tySubts <- concat <$> zipWithM funSubst tcSubstLhs args - let tyRhs = substTys tySubts tcSubstRhs - return tyRhs - --- Given a LHS matching type, and a RHS to-match type, check if LHS and RHS --- are a match. If they do match, and the LHS is a variable, return a --- substitution -funSubst :: Type -> Type -> Maybe [(TyName,Type)] -funSubst (VarTy _ nmF) ty = Just [(nmF,ty)] -funSubst tyL@(LitTy _) tyR = if tyL == tyR then Just [] else Nothing -funSubst (tyView -> TyConApp tc argTys) (tyView -> TyConApp tc' argTys') - | tc == tc' - = do - tySubts <- zipWithM funSubst argTys argTys' - return (concat tySubts) -funSubst _ _ = Nothing