packages feed

clash-vhdl 0.5.12 → 0.6

raw patch · 15 files changed

+277/−239 lines, 15 filesdep ~clash-libdep ~clash-preludePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: clash-lib, clash-prelude

API changes (from Hackage documentation)

- CLaSH.Backend.VHDL: instance CLaSH.Backend.Backend CLaSH.Backend.VHDL.VHDLState
+ CLaSH.Backend.VHDL: instance Backend VHDLState

Files

CHANGELOG.md view
@@ -1,5 +1,9 @@ # Changelog for the [`clash-vhdl`](http://hackage.haskell.org/package/clash-vhdl) package +## 0.6 *October 3rd 2015*+* New features:+  * Support `clash-prelude-0.10`+ ## 0.5.12 *September 21st 2015* * Fixes bugs:   * Fix Index maxBound [#79](https://github.com/clash-lang/clash-compiler/pull/79)
README.md view
@@ -11,8 +11,8 @@ Features of CλaSH:    * Strongly typed (like VHDL), yet with a very high degree of type inference,-    which enables both safe and fast prototying using consise descriptions (like-    Verilog)+    enabling both safe and fast prototying using consise descriptions (like+    Verilog).    * Interactive REPL: load your designs in an interpreter and easily test all     your component without needing to setup a test bench.@@ -21,7 +21,7 @@     fully parametric by default.    * Synchronous sequential circuit design based on streams of values, called-    `Signal`s.+    `Signal`s, lead to natural descriptions of feedback loops.    * Support for multiple clock domains, with type safe clock domain crossing. 
clash-vhdl.cabal view
@@ -1,5 +1,5 @@ Name:                 clash-vhdl-Version:              0.5.12+Version:              0.6 Synopsis:             CAES Language for Synchronous Hardware - VHDL backend Description:   CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -10,8 +10,8 @@   Features of CλaSH:   .   * Strongly typed (like VHDL), yet with a very high degree of type inference,-    which enables both safe and fast prototying using consise descriptions (like-    Verilog)+    enabling both safe and fast prototying using consise descriptions (like+    Verilog).   .   * Interactive REPL: load your designs in an interpreter and easily test all     your component without needing to setup a test bench.@@ -20,7 +20,7 @@     fully parametric by default.   .   * Synchronous sequential circuit design based on streams of values, called-    @Signal@s.+    @Signal@s, lead to natural descriptions of feedback loops.   .   * Support for multiple clock domains, with type safe clock domain crossing.   .@@ -93,8 +93,8 @@                       ViewPatterns    Build-depends:      base                    >= 4.6.0.1 && < 5,-                      clash-lib               >= 0.5.12,-                      clash-prelude           >= 0.9,+                      clash-lib               >= 0.6,+                      clash-prelude           >= 0.10,                       fgl                     >= 5.4.2.4,                       lens                    >= 3.9.2,                       mtl                     >= 2.1.2,
primitives/CLaSH.Prelude.BlockRam.File.json view
@@ -27,33 +27,35 @@     return RAM;   end function; -  signal RAM  : RamType(0 to ~LIT[2]-1) := InitRamFromFile(~FILE[~LIT[3]]);-  signal dout : ~TYP[7];-  signal wr   : integer range 0 to ~LIT[2]-1;-  signal rd   : integer range 0 to ~LIT[2]-1;+  signal RAM_~SYM[1]  : RamType(0 to ~LIT[2]-1) := InitRamFromFile(~FILE[~LIT[3]]);+  signal dout_~SYM[2] : ~TYP[7];+  signal wr_~SYM[3]   : integer range 0 to ~LIT[2]-1;+  signal rd_~SYM[4]   : integer range 0 to ~LIT[2]-1; begin-  wr <= ~ARG[4]+  wr_~SYM[3] <= ~ARG[4]   -- pragma translate_off-        mod ~LIT[2]+                mod ~LIT[2]   -- pragma translate_on-        ;+                ; -  rd <= ~ARG[5]+  rd_~SYM[4] <= ~ARG[5]   -- pragma translate_off-        mod ~LIT[2]+                mod ~LIT[2]   -- pragma translate_on-        ;+                ; -  blockRamFile_~SYM[1] : process(~CLK[1])+  blockRamFile_sync : process(~CLK[1])   begin     if (rising_edge(~CLK[1])) then       if ~ARG[6] then-        RAM(to_integer(wr)) <= to_bitvector(~ARG[7]);+        RAM_~SYM[1](to_integer(wr_~SYM[3])) <= to_bitvector(~ARG[7]);       end if; -      ~RESULT <= to_stdlogicvector(RAM(rd));+      dout_~SYM[2] <= to_stdlogicvector(RAM_~SYM[1](rd_~SYM[4]));     end if;   end process;++  ~RESULT <= dout_~SYM[2]; end block; -- blockRamFile end"     }
primitives/CLaSH.Prelude.BlockRam.json view
@@ -12,34 +12,34 @@     , "templateD" : "-- blockRam begin blockRam_~COMPNAME_~SYM[0] : block-  signal RAM  : ~TYP[2] := ~LIT[2];-  signal dout : ~TYP[6];-  signal wr   : integer range 0 to ~LIT[0] - 1;-  signal rd   : integer range 0 to ~LIT[0] - 1;+  signal RAM_~SYM[1]  : ~TYP[2] := ~LIT[2];+  signal dout_~SYM[2] : ~TYP[6];+  signal wr_~SYM[3]   : integer range 0 to ~LIT[0] - 1;+  signal rd_~SYM[4]   : integer range 0 to ~LIT[0] - 1; begin-  wr <= ~ARG[3]+  wr_~SYM[3] <= ~ARG[3]   -- pragma translate_off-        mod ~LIT[0]+                mod ~LIT[0]   -- pragma translate_on-        ;+                ; -  rd <= ~ARG[4]+  rd_~SYM[4] <= ~ARG[4]   -- pragma translate_off-        mod ~LIT[0]+                mod ~LIT[0]   -- pragma translate_on-        ;+                ; -  blockRam_~SYM[1] : process(~CLK[1])+  blockRam_sync : process(~CLK[1])   begin     if rising_edge(~CLK[1]) then       if ~ARG[5] then-        RAM(wr) <= ~ARG[6];+        RAM_~SYM[1](wr_~SYM[3]) <= ~ARG[6];       end if;-      dout <= RAM(rd);+      dout_~SYM[2] <= RAM_~SYM[1](rd_~SYM[4]);     end if;   end process; -  ~RESULT <= dout;+  ~RESULT <= dout_~SYM[2]; end block; -- blockRam end"     }
primitives/CLaSH.Prelude.RAM.json view
@@ -13,32 +13,32 @@ "-- asyncRam begin asyncRam_~COMPNAME_~SYM[0] : block   type RamType is array(natural range <>) of ~TYP[6];-  signal RAM : RamType(0 to ~LIT[2]-1);-  signal wr  : integer range 0 to ~LIT[2] - 1;-  signal rd  : integer range 0 to ~LIT[2] - 1;+  signal RAM_~SYM[1] : RamType(0 to ~LIT[2]-1);+  signal wr_~SYM[2]  : integer range 0 to ~LIT[2] - 1;+  signal rd_~SYM[3]  : integer range 0 to ~LIT[2] - 1; begin-  wr <= ~ARG[3]+  wr_~SYM[2] <= ~ARG[3]   -- pragma translate_off-        mod ~LIT[2]+                mod ~LIT[2]   -- pragma translate_on-        ;+                ; -  rd <= ~ARG[4]+  rd_~SYM[3] <= ~ARG[4]   -- pragma translate_off-        mod ~LIT[2]+                mod ~LIT[2]   -- pragma translate_on-        ;+                ; -  asyncRam_~SYM[1] : process(~CLK[0])+  asyncRam_sync : process(~CLK[0])   begin     if rising_edge(~CLK[0]) then       if ~ARG[5] then-        RAM(wr) <= ~ARG[6];+        RAM_~SYM[1](wr_~SYM[2]) <= ~ARG[6];       end if;     end if;   end process; -  ~RESULT <= RAM(rd);+  ~RESULT <= RAM_~SYM[1](rd_~SYM[3]); end block; -- asyncRam end"     }
primitives/CLaSH.Prelude.ROM.File.json view
@@ -23,16 +23,16 @@     return ROM;   end function; -  signal ROM : RomType(0 to ~LIT[1]-1) := InitRomFromFile(~FILE[~LIT[2]]);-  signal rd  : integer range 0 to ~LIT[1]-1;+  signal ROM_~SYM[1] : RomType(0 to ~LIT[1]-1) := InitRomFromFile(~FILE[~LIT[2]]);+  signal rd_~SYM[2]  : integer range 0 to ~LIT[1]-1; begin-  rd <= ~ARG[3]+  rd_~SYM[2] <= ~ARG[3]   -- pragma translate_off-        mod ~LIT[1]+                mod ~LIT[1]   -- pragma translate_on-        ;+                ; -  ~RESULT <= to_stdlogicvector(ROM(rd));+  ~RESULT <= to_stdlogicvector(ROM_~SYM[1](rd_~SYM[2])); end block; -- asyncRomFile end"     }@@ -63,24 +63,24 @@     return ROM;   end function; -  signal ROM  : RomType(0 to ~LIT[2]-1) := InitRomFromFile(~FILE[~LIT[3]]);-  signal rd   : integer range 0 to ~LIT[2]-1;-  signal dout : ~TYPO;+  signal ROM_~SYM[1]  : RomType(0 to ~LIT[2]-1) := InitRomFromFile(~FILE[~LIT[3]]);+  signal rd_~SYM[2]   : integer range 0 to ~LIT[2]-1;+  signal dout_~SYM[3] : ~TYPO; begin-  rd <= ~ARG[4]+  rd_~SYM[2] <= ~ARG[4]   -- pragma translate_off-        mod ~LIT[2]+                mod ~LIT[2]   -- pragma translate_on-        ;+                ; -  romFile_~SYM[1] : process (~CLK[1])+  romFileSync : process (~CLK[1])   begin     if (rising_edge(~CLK[1])) then-      dout <= to_stdlogicvector(ROM(rd));+      dout_~SYM[3] <= to_stdlogicvector(ROM_~SYM[1](rd_~SYM[2]));     end if;   end process; -  ~RESULT <= dout;+  ~RESULT <= dout_~SYM[3]; end block; -- romFile end"     }
primitives/CLaSH.Prelude.ROM.json view
@@ -8,18 +8,18 @@     , "templateD" : "-- asyncRom begin asyncRom_~SYM[0] : block-  signal ROM       : ~TYP[1];-  signal rom_index : integer range 0 to ~LIT[0]-1;+  signal ROM_~SYM[1]       : ~TYP[1];+  signal rom_index_~SYM[2] : integer range 0 to ~LIT[0]-1; begin-  ROM <= ~ARG[1];+  ROM_~SYM[1] <= ~ARG[1]; -  rom_index <= ~ARG[2]+  rom_index~SYM[2] <= ~ARG[2]   -- pragma translate_off-               mod ~LIT[0]+                      mod ~LIT[0]   -- pragma translate_on-               ;+                      ; -  ~RESULT <= ROM(rom_index);+  ~RESULT <= ROM_~SYM[1](rom_index_~SYM[2]); end block; -- asyncRom end"     }@@ -35,26 +35,26 @@     , "templateD" : "-- rom begin rom_~COMPNAME_~SYM[0] : block-  signal ROM  : ~TYP[2];-  signal rd   : integer range 0 to ~LIT[0]-1;-  signal dout : ~TYPO;+  signal ROM_~SYM[1]  : ~TYP[2];+  signal rd_~SYM[2]   : integer range 0 to ~LIT[0]-1;+  signal dout_~SYM[3] : ~TYPO; begin-  ROM <= ~ARG[2];+  ROM_~SYM[1] <= ~ARG[2]; -  rd <= ~ARG[3]+  rd_~SYM[2] <= ~ARG[3]   -- pragma translate_off-        mod ~LIT[0]+                mod ~LIT[0]   -- pragma translate_on-        ;+                ;    romSync : process (~CLK[1])   begin     if (rising_edge(~CLK[1])) then-      dout <= ROM(rd);+      dout_~SYM[3] <= ROM_~SYM[1](rd_~SYM[2]);     end if;   end process; -  ~RESULT <= dout;+  ~RESULT <= dout_~SYM[3]; end block; -- rom end"     }
primitives/CLaSH.Prelude.Testbench.json view
@@ -25,17 +25,17 @@      end loop;      return result;   end;-  signal actual   : ~TYP[4];-  signal expected : ~TYP[5];+  signal actual_~SYM[1]   : ~TYP[4];+  signal expected_~SYM[2] : ~TYP[5];   -- pragma translate_on begin   -- pragma translate_off-  actual   <= ~ARG[4];-  expected <= ~ARG[5];+  actual_~SYM[1]   <= ~ARG[4];+  expected_~SYM[2] <= ~ARG[5];   process(~CLK[2],~RST[2]) is   begin     if (rising_edge(~CLK[2]) or rising_edge(~RST[2])) then-      assert (actual = expected) report (~LIT[3] & \", expected: \" & slv2string(toSLV(expected)) & \", actual: \" & slv2string(toSLV(actual))) severity error;+      assert (actual_~SYM[1] = expected_~SYM[2]) report (~LIT[3] & \", expected: \" & slv2string(toSLV(expected_~SYM[2])) & \", actual: \" & slv2string(toSLV(actual_~SYM[1]))) severity error;     end if;   end process;   -- pragma translate_on
primitives/CLaSH.Sized.Internal.BitVector.json view
@@ -259,21 +259,16 @@       => BitVector n -- ARG[1]       -> Bit"     , "templateD" :-"-- msb begin+"-- msb begin~IF ~LIT[0] ~THEN 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;+  ~SYM[1] <= ~ARG[1];+  ~RESULT <= ~SYM[1](~SYM[1]'high downto ~SYM[1]'high); end block;--- msb end"+~ELSE+~RESULT <= \"0\";+~FI-- msb end"     }   } , { "BlackBox" :@@ -282,22 +277,16 @@ "lsb# :: BitVector n -- ARG[0]       -> Bit"     , "templateD" :-"-- lsb begin+"-- lsb begin~IF ~SIZE[~TYP[0]] ~THEN 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;+  ~SYM[1] <= ~ARG[0];+  ~RESULT <= ~SYM[1](0 downto 0); end block;--- lsb end"+~ELSE+~RESULT <= \"0\";+~FI-- lsb end"     }   } , { "BlackBox" :@@ -338,9 +327,9 @@   } , { "BlackBox" :     { "name"      : "CLaSH.Sized.Internal.BitVector.minBound#"-    , "type"      : "minBound# :: KnownNat n => BitVector n"+    , "type"      : "minBound# :: BitVector n"     , "comment"   : "Generates incorrect VDHL for n=0"-    , "templateE" : "std_logic_vector'(~LIT[0]-1 downto 0 => '0')"+    , "templateE" : "std_logic_vector'(~SIZE[~TYPO]-1 downto 0 => '0')"     }   } , { "BlackBox" :
primitives/CLaSH.Sized.Internal.Index.json view
@@ -37,7 +37,7 @@ , { "BlackBox" :     { "name"      : "CLaSH.Sized.Internal.Index.maxBound#"     , "type"      : "maxBound# :: KnownNat n => Index n"-    , "templateE" : "to_unsigned(max(0,~LIT[0]-1),~SIZE[~TYPO])"+    , "templateE" : "to_unsigned(~LIT[0]-1,~SIZE[~TYPO])"     }   } , { "BlackBox" :
primitives/CLaSH.Sized.Internal.Signed.json view
@@ -136,18 +136,18 @@   } , { "BlackBox" :     { "name"      : "CLaSH.Sized.Internal.Signed.div#"-    , "type"      : "div# :: KnownNat n => Signed n -> Signed n -> Signed n"+    , "type"      : "div# :: Signed n -> Signed n -> Signed n"     , "templateD" : "-- divSigned begin divSigned_~SYM[0] : block-  signal ~SYM[1] : ~TYP[1];-  signal ~SYM[2] : ~TYP[2];-  signal ~SYM[3] : ~TYP[1];+  signal ~SYM[1] : ~TYP[0];+  signal ~SYM[2] : ~TYP[1];+  signal ~SYM[3] : ~TYP[0]; begin-  ~SYM[1] <= ~ARG[1];-  ~SYM[2] <= ~ARG[2];+  ~SYM[1] <= ~ARG[0];+  ~SYM[2] <= ~ARG[1];   ~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+  ~RESULT <= ~SYM[3] - to_signed(1,~SIZE[~TYPO]) when ~SYM[1](~SYM[1]'high) = not (~SYM[2](~SYM[2]'high)) else              ~SYM[3]; end block; -- divSigned end"@@ -155,8 +155,8 @@   } , { "BlackBox" :     { "name"      : "CLaSH.Sized.Internal.Signed.mod#"-    , "type"      : "mod# :: KnownNat n => Signed n -> Signed n -> Signed n"-    , "templateE" : "~ARG[1] mod ~ARG[2]"+    , "type"      : "mod# :: Signed n -> Signed n -> Signed n"+    , "templateE" : "~ARG[0] mod ~ARG[1]"     }   } , { "BlackBox" :
primitives/CLaSH.Sized.Internal.Unsigned.json view
@@ -54,9 +54,9 @@   } , { "BlackBox" :     { "name"      : "CLaSH.Sized.Internal.Unsigned.minBound#"-    , "type"      : "minBound# :: KnownNat n => Unsigned n"+    , "type"      : "minBound# :: Unsigned n"     , "comment"   : "Generates incorrect VDHL for n=0"-    , "templateE" : "unsigned'(~LIT[0]-1 downto 0 => '0')"+    , "templateE" : "unsigned'(~SIZE[~TYPO]-1 downto 0 => '0')"     }   } , { "BlackBox" :
primitives/CLaSH.Sized.Vector.json view
@@ -82,15 +82,9 @@ 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;+  select_loop : for ~SYM[2] in ~RESULT'range generate+  begin+      ~RESULT(~SYM[2]) <= ~SYM[1](~LIT[1]+(~LIT[2]*~SYM[2]));   end generate; end block; -- select end"@@ -112,15 +106,9 @@ 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;+  concat_loop : for ~SYM[2] in ~SYM[1]'range generate+  begin+    ~RESULT(~SYM[2] * ~LENGTH[~TYPEL[~TYP[0]]] to ((~SYM[2]+1) * ~LENGTH[~TYPEL[~TYP[0]]]) - 1) <= ~SYM[1](~SYM[2]);   end generate; end block; -- concat end"@@ -155,48 +143,15 @@ 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;+  unconcat_loop : for ~SYM[2] in ~RESULT'range generate+  begin+    ~RESULT(~SYM[2]) <= ~SYM[1]((~SYM[2] * ~LIT[1]) to ((~SYM[2] * ~LIT[1]) + ~LIT[1] - 1));   end generate; end block; -- unconcat end"     }   } , { "BlackBox" :-    { "name"      : "CLaSH.Sized.Vector.merge"-    , "type"      : "merge :: Vec n a -> Vec n a -> Vec (n + n) a"-    , "templateD" :-"-- merge begin-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;--- merge end"-    }-  }-, { "BlackBox" :     { "name"      : "CLaSH.Sized.Vector.map"     , "type"      : "map :: (a -> b) -> Vec n a -> Vec n b"     , "templateD" :@@ -206,21 +161,44 @@ begin   ~SYM[1] <= ~ARG[1]; -  mapZ_~SYM[2] : if ~RESULT'length = 0 generate-    ~RESULT <= ~ERRORO;+  map_loop : for ~SYM[2] in ~RESULT'range generate+  begin+    ~INST 0+      ~OUTPUT <= ~RESULT(~SYM[2])~ ~TYPEL[~TYPO]~+      ~INPUT  <= ~SYM[1](~SYM[2])~ ~TYPEL[~TYP[1]]~+    ~INST   end generate;+end block;+-- map end"+    }+  }+, { "BlackBox" :+    { "name"      : "CLaSH.Sized.Vector.imap"+    , "type"      : "imap :: KnownNat n => (Index n -> a -> b) -> Vec n a -> Vec n b"+    , "templateD" :+"-- imap begin+imap_~SYM[0] : block+  signal ~SYM[1] : ~TYP[2]; -  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;+  function max (l,r : in natural) return natural is+  begin+    if l > r then return l;+    else return r;+    end if;+  end function;+begin+  ~SYM[1] <= ~ARG[2];++  imap_loop : for ~SYM[2] in ~RESULT'range generate+  begin+    ~INST 1+      ~OUTPUT <= ~RESULT(~SYM[2])~ ~TYPEL[~TYPO]~+      ~INPUT  <= to_unsigned(~SYM[2],max(1,integer(ceil(log2(real(~LIT[0]))))))~ ~INDEXTYPE[~LIT[0]]~+      ~INPUT  <= ~SYM[1](~SYM[2])~ ~TYPEL[~TYP[2]]~+    ~INST   end generate; end block;--- map end"+-- imap end"     }   } , { "BlackBox" :@@ -235,22 +213,83 @@   ~SYM[1] <= ~ARG[1];   ~SYM[2] <= ~ARG[2]; -  zipWithZ_~SYM[3] : if ~RESULT'length = 0 generate-    ~RESULT <= ~ERRORO;+  zipWith_loop : for ~SYM[3] in ~RESULT'range generate+  begin+    ~INST 0+      ~OUTPUT <= ~RESULT(~SYM[3])~ ~TYPEL[~TYPO]~+      ~INPUT  <= ~SYM[1](~SYM[3])~ ~TYPEL[~TYP[1]]~+      ~INPUT  <= ~SYM[2](~SYM[3])~ ~TYPEL[~TYP[2]]~+    ~INST   end generate;+end block;+-- zipWith end"+    }+  }+, { "BlackBox" :+    { "name"      : "CLaSH.Sized.Vector.foldr"+    , "type"      : "foldr :: (a -> b -> b) -> b -> Vec n a -> b"+    , "templateD" :+"-- foldr begin~IF ~LENGTH[~TYP[2]] ~THEN+foldr_~SYM[0] : block+  type foldr_res_vec is array (natural range <>) of ~TYP[1];+  signal intermediate_~SYM[2] : foldr_res_vec (0 to ~LENGTH[~TYP[2]]);+  signal xs_~SYM[3] : ~TYP[2];+begin+  intermediate_~SYM[2](~LENGTH[~TYP[2]]) <= ~ARG[1];+  xs_~SYM[3] <= ~ARG[2]; -  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+  foldr_loop : for i_~SYM[4] in xs_~SYM[3]'range generate+    ~INST 0+      ~OUTPUT <= intermediate_~SYM[2](i_~SYM[4])~ ~TYP[1]~+      ~INPUT  <= xs_~SYM[3](i_~SYM[4])~ ~TYPEL[~TYP[2]]~+      ~INPUT  <= intermediate_~SYM[2](i_~SYM[4]+1)~ ~TYP[1]~+    ~INST+  end generate;++  ~RESULT <= intermediate_~SYM[2](0);+end block;+~ELSE+~RESULT <= ~ARG[1];+~FI-- foldr end"+    }+  }+, { "BlackBox" :+    { "name"      : "CLaSH.Sized.Vector.fold"+    , "type"      : "fold :: (a -> a -> a) -> Vec (n+1) a -> a"+    , "comment"   : "THIS ONLY WORKS FOR POWER OF TWO LENGTH VECTORS"+    , "templateD" :+"-- fold begin+fold_~SYM[0] : block+  -- given a level and a depth, calculate the corresponding index into the+  -- intermediate array+  function depth2Index (levels,depth : in natural) return natural is+  begin+    return (2 ** levels - 2 ** depth);+  end function;++  signal intermediate_~SYM[1] : ~TYPM[1](0 to (2*~LENGTH[~TYP[1]])-2);+  constant levels : natural := natural (ceil (log2 (real (~LENGTH[~TYP[1]]))));+begin+  -- put input array into the first half of the intermediate array+  intermediate_~SYM[1](0 to ~LENGTH[~TYP[1]]-1) <= ~ARG[1];++  -- Create the tree of instantiated components+  make_tree : if levels /= 0 generate+    tree_depth : for d in levels-1 downto 0 generate+      tree_depth_loop: for i in 0 to (natural(2**d) - 1) generate+        ~INST 0+          ~OUTPUT <= intermediate_~SYM[1](depth2Index(levels+1,d+1)+i)~ ~TYPO~+          ~INPUT  <= intermediate_~SYM[1](depth2Index(levels+1,d+2)+(2*i))~ ~TYPO~+          ~INPUT  <= intermediate_~SYM[1](depth2Index(levels+1,d+2)+(2*i)+1)~ ~TYPO~+        ~INST+      end generate;     end generate;   end generate;++  -- The last element of the intermediate array holds the result+  ~RESULT <= intermediate_~SYM[1]((2*~LENGTH[~TYP[1]])-2); end block;--- zipWith end"+-- fold end"     }   } , { "BlackBox" :@@ -323,6 +362,25 @@     }   } , { "BlackBox" :+    { "name"      : "CLaSH.Sized.Vector.transpose"+    , "type"      : "transpose :: KnownNat n => Vec m (Vec n a) -> Vec n (Vec m a)"+    , "templateD" :+"-- transpose begin+transpose_~SYM[0] : block+  signal ~SYM[1] : ~TYP[1];+begin+  ~SYM[1] <= ~ARG[1];++  transpose_outer : for row_index in ~SYM[1]'range generate+    transpose_inner : for col_index in ~RESULT'range generate+      ~RESULT(col_index)(row_index) <= ~SYM[1](row_index)(col_index);+    end generate;+  end generate;+end block;+-- transpose end"+    }+  }+, { "BlackBox" :     { "name"      : "CLaSH.Sized.Vector.reverse"     , "type"      : "reverse :: Vec n a -> Vec n a"     , "templateD" :@@ -332,14 +390,8 @@ 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;+  reverse_loop : for ~SYM[2] in ~SYM[1]'range generate+    ~RESULT(~SYM[1]'high - ~SYM[2]) <= ~SYM[1](~SYM[2]);   end generate; end block; -- reverse end"@@ -364,14 +416,8 @@ 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[1]'high - ~SYM[5]));-    end generate;+  concatBitVectorIter_loop : for ~SYM[2] in ~SYM[1]'range generate+    ~RESULT(((~SYM[2] * ~LIT[0]) + ~LIT[0] - 1) downto (~SYM[2] * ~LIT[0])) <= ~TYPMO(~SYM[1](~SYM[1]'high - ~SYM[2]));   end generate; end block; -- concatBitVector end"@@ -390,14 +436,8 @@ 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(~RESULT'high - ~SYM[5]) <= ~SYM[1](((~SYM[5] * ~LIT[1]) + ~LIT[1] - 1) downto (~SYM[5] * ~LIT[1]));-    end generate;+  unconcatBitVectorIter_loop : for ~SYM[2] in ~RESULT'range generate+    ~RESULT(~RESULT'high - ~SYM[2]) <= ~SYM[1](((~SYM[2] * ~LIT[1]) + ~LIT[1] - 1) downto (~SYM[2] * ~LIT[1]));   end generate; end block; -- unconcatBitVector end"
src/CLaSH/Backend/VHDL.hs view
@@ -98,7 +98,7 @@     needsDec    = nubBy eqReprTy . map mkVecZ $ (hwtys ++ usedTys)     hwTysSorted = topSortHWTys needsDec     packageDec  = vcat $ mapM tyDec hwTysSorted-    (funDecs,funBodies) = unzip $ maxDec : (catMaybes $ map funDec (nubBy eqTypM hwTysSorted))+    (funDecs,funBodies) = unzip . catMaybes $ map funDec (nubBy eqTypM hwTysSorted)      packageBodyDec :: VHDLM Doc     packageBodyDec = case funBodies of@@ -177,18 +177,6 @@ tyDec _ = empty  -maxDec :: (VHDLM Doc, VHDLM Doc)-maxDec =-  ( "function" <+> "max" <+> parens ("left, right: in integer") <+> "return integer" <> semi-  , "function" <+> "max" <+> parens ("left, right: in integer") <+> "return integer" <+> "is" <$>-    "begin" <$>-      indent 2 (vcat $ sequence [ "if" <+> "left > right" <+> "then return left" <> semi-                                , "else return right" <> semi-                                , "end if" <> semi-                                ]) <$>-    "end" <> semi-  )- funDec :: HWType -> Maybe (VHDLM Doc,VHDLM Doc) funDec Bool = Just   ( "function" <+> "toSLV" <+> parens ("b" <+> colon <+> "in" <+> "boolean") <+> "return" <+> "std_logic_vector" <> semi <$>@@ -500,10 +488,14 @@     end   = typeSize ty - conSize ty  expr_ _ (Identifier id_ (Just _)) = text id_-expr_ _ (DataCon ty@(Vector 1 _) _ [e])           = vhdlTypeMark ty <> "'" <> parens (int 0 <+> rarrow <+> expr_ False e)-expr_ _ e@(DataCon ty@(Vector _ elTy) _ [e1,e2])     = vhdlTypeMark ty <> "'" <> case vectorChain e of-                                                     Just es -> tupled (mapM (expr_ False) es)-                                                     Nothing -> parens (vhdlTypeMark elTy <> "'" <> parens (expr_ False e1) <+> "&" <+> expr_ False e2)++expr_ _ (DataCon (Vector 0 _) _ _) =+  error $ $(curLoc) ++ "VHDL: Trying to create a Nil vector."++expr_ _ (DataCon ty@(Vector 1 _) _ [e])          = vhdlTypeMark ty <> "'" <> parens (int 0 <+> rarrow <+> expr_ False e)+expr_ _ e@(DataCon ty@(Vector _ elTy) _ [e1,e2]) = vhdlTypeMark ty <> "'" <> case vectorChain e of+                                                    Just es -> tupled (mapM (expr_ False) es)+                                                    Nothing -> parens (vhdlTypeMark elTy <> "'" <> parens (expr_ False e1) <+> "&" <+> expr_ False e2) expr_ _ (DataCon ty@(SP _ args) (DC (_,i)) es) = assignExpr   where     argTys     = snd $ args !! i@@ -523,16 +515,19 @@ expr_ _ (BlackBoxE pNm _ bbCtx _)   | pNm == "CLaSH.Sized.Internal.Signed.fromInteger#"   , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx+  , n > 32   = exprLit (Just (Signed (fromInteger n),fromInteger n)) i  expr_ _ (BlackBoxE pNm _ bbCtx _)   | pNm == "CLaSH.Sized.Internal.Unsigned.fromInteger#"   , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx+  , n > 32   = exprLit (Just (Unsigned (fromInteger n),fromInteger n)) i  expr_ _ (BlackBoxE pNm _ bbCtx _)   | pNm == "CLaSH.Sized.Internal.BitVector.fromInteger#"   , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx+  , n > 32   = exprLit (Just (BitVector (fromInteger n),fromInteger n)) i  expr_ b (BlackBoxE _ bs bbCtx b') = do@@ -570,7 +565,15 @@ vectorChain _                                       = Nothing  exprLit :: Maybe (HWType,Size) -> Literal -> VHDLM Doc-exprLit Nothing       (NumLit i)   = integer i+exprLit Nothing (NumLit i) =+  let integerLow  = -2^(31 :: Integer) :: Integer+      integerHigh = 2^(31 :: Integer) - 1 :: Integer+      i' = if i < integerLow+              then integerLow+              else if i > integerHigh+                   then integerHigh+                   else i+  in  parenIf (i' < 0) (integer i') exprLit (Just (hty,sz)) (NumLit i) = case hty of                                        Unsigned _  -> "unsigned'" <> parens blit                                        Signed   _  -> "signed'" <> parens blit