packages feed

clash-vhdl 0.6.16 → 0.7

raw patch · 15 files changed

+337/−117 lines, 15 filesdep +hashabledep ~clash-libdep ~clash-preludePVP ok

version bump matches the API change (PVP)

Dependencies added: hashable

Dependency ranges changed: clash-lib, clash-prelude

API changes (from Hackage documentation)

Files

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