packages feed

clash-systemverilog 0.6.10 → 0.7

raw patch · 15 files changed

+351/−83 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,5 +1,9 @@ # Changelog for the [`clash-systemverilog`](http://hackage.haskell.org/package/clash-systemverilog) package +## 0.7 *January 16th 2017*+* New features:+  * Support `clash-prelude` 0.11+ ## 0.6.10 *October 17th 20168 * Fixes bugs:   * CLaSH.Sized.Vector.imap primitive gets indices in reverse order
LICENSE view
@@ -1,4 +1,5 @@-Copyright (c) 2015, University of Twente+Copyright (c) 2015-2016, University of Twente,+              2017, QBayLogic All rights reserved.  Redistribution and use in source and binary forms, with or without
clash-systemverilog.cabal view
@@ -1,5 +1,5 @@ Name:                 clash-systemverilog-Version:              0.6.10+Version:              0.7 Synopsis:             CAES Language for Synchronous Hardware - SystemVerilog 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,9 +100,10 @@                       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.11     && < 0.12,                       fgl                     >= 5.4.2.4  && < 5.6,+                      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,
+ 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" :@@ -20,10 +20,10 @@ end  always @(posedge ~CLK[1]) begin : ~GENSYM[~COMPNAME_blockRamFile][2]-  if (~ARG[7]) begin-    ~SYM[0][~ARG[4]] <= ~ARG[7];+  if (~ARG[5]) begin+    ~SYM[0][~ARG[6]] <= ~ARG[7];   end-  ~SYM[1] <= ~SYM[0][~ARG[6]];+  ~SYM[1] <= ~SYM[0][~ARG[4]]; end  assign ~RESULT = ~SYM[1];
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" :@@ -17,10 +17,10 @@   ~SYM[0] = ~LIT[2]; end always @(posedge ~CLK[1]) begin : ~GENSYM[~COMPNAME_blockRam][2]-  if (~ARG[5]) begin-    ~SYM[0][~ARG[3]] <= ~TOBV[~ARG[6]][~TYP[6]];+  if (~ARG[4]) begin+    ~SYM[0][~ARG[5]] <= ~TOBV[~ARG[6]][~TYP[6]];   end-  ~SYM[1] <= ~SYM[0][~ARG[4]];+  ~SYM[1] <= ~SYM[0][~ARG[3]]; end assign ~RESULT = ~FROMBV[~SYM[1]][~TYP[6]]; // blockRam end"
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" :@@ -14,12 +14,12 @@ logic [~SIZE[~TYP[6]]-1:0] ~GENSYM[RAM][0] [0:~LIT[2]-1];  always @(posedge ~CLK[0]) begin : ~GENSYM[~COMPNAME_Ram][1]-  if (~ARG[5]) begin-    ~SYM[0][~ARG[3]] <= ~TOBV[~ARG[6]][~TYP[6]];+  if (~ARG[4]) begin+    ~SYM[0][~ARG[5]] <= ~TOBV[~ARG[6]][~TYP[6]];   end end -assign ~RESULT = ~FROMBV[~SYM[0][\\~ARG[4]\\]][~TYPO];+assign ~RESULT = ~FROMBV[~SYM[0][\\~ARG[3]\\]][~TYPO]; // asyncRam end"     }   }
primitives/CLaSH.Promoted.Nat.json view
@@ -1,37 +1,66 @@ [ { "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" : "~ARG[0]"-    }-  }-, { "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"+    , "templateD" :+"// flogBaseSNat begin+function integer ~GENSYM[flogBase][0];+  input integer base, value;+  begin+    for (~SYM[0] = 0; value >= base; ~SYM[0]=~SYM[0]+1)+      value = value / base;+  end+endfunction++assign ~RESULT = ~SYM[0](~LIT[2],~LIT[3]);+// flogBaseSNat end"     }   } , { "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"+    , "templateD" :+"// clogBaseSNat begin+function integer ~GENSYM[clogBase][0];+  input integer base, value;+  begin+    for (~SYM[0] = 0; base ** ~SYM[0] < value; ~SYM[0]=~SYM[0]+1);+  end+endfunction++assign ~RESULT = ~SYM[0](~LIT[2],~LIT[3]);+// clogBaseSNat end"     }   } , { "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)"+    , "templateD" :+"// logBaseSNat begin+function integer ~GENSYM[logBase][0];+  input integer base, value;+  begin+    for (~SYM[0] = 0; value >= base; ~SYM[0]=~SYM[0]+1)+      value = value / base;+  end+endfunction++assign ~RESULT = ~SYM[0](~LIT[1],~LIT[2]);+// logBaseSNat end"     }   } ]
primitives/CLaSH.Sized.Internal.BitVector.json view
@@ -246,20 +246,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" : "~ARG[1] + ~ARG[2]"+    , "type"      : "plus# :: BitVector m -> BitVector n -> BitVector (Max m n + 1)"+    , "templateE" : "~ARG[0] + ~ARG[1]"     }   } , { "BlackBox" :     { "name"      : "CLaSH.Sized.Internal.BitVector.minus#"-    , "type"      : "minus# :: KnownNat (Max m n + 1) => BitVector m -> BitVector n -> BitVector (Max m n + 1)"-    , "templateE" : "~ARG[1] - ~ARG[2]"+    , "type"      : "minus# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1)"+    , "templateE" : "~ARG[2] - ~ARG[3]"     }   } , { "BlackBox" :     { "name"      : "CLaSH.Sized.Internal.BitVector.times#"     , "type"      : "times# :: KnownNat (m + n) => BitVector m -> BitVector n -> BitVector (m + n)"-    , "templateE" : "~ARG[1] * ~ARG[2]"+    , "templateE" : "~ARG[0] * ~ARG[1]"     }   } , { "BlackBox" :@@ -312,8 +312,8 @@   } , { "BlackBox" :     { "name"      : "CLaSH.Sized.Internal.BitVector.shiftR#"-    , "type"      : "shiftR# :: KnownNat n => BitVector n -> Int -> BitVector n"-    , "templateE" : "~ARG[1] >> ~ARG[2]"+    , "type"      : "shiftR# :: BitVector n -> Int -> BitVector n"+    , "templateE" : "~ARG[0] >> ~ARG[1]"     }   } , { "BlackBox" :
primitives/CLaSH.Sized.Internal.Signed.json view
@@ -104,20 +104,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" : "~ARG[1] + ~ARG[2]"+    , "type"      : "plus# :: Signed m -> Signed n -> Signed (1 + Max m n)"+    , "templateE" : "~ARG[0] + ~ARG[1]"     }   } , { "BlackBox" :     { "name"      : "CLaSH.Sized.Internal.Signed.minus#"-    , "type"      : "minus# :: KnownNat (1 + Max m n) => Signed m -> Signed n -> Signed (1 + Max m n)"-    , "templateE" : "~ARG[1] - ~ARG[2]"+    , "type"      : "minus# :: Signed m -> Signed n -> Signed (1 + Max m n)"+    , "templateE" : "~ARG[0] - ~ARG[1]"     }   } , { "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
@@ -96,20 +96,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" : "~ARG[1] + ~ARG[2]"+    , "type"      : "plus# :: Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)"+    , "templateE" : "~ARG[0] + ~ARG[1]"     }   } , { "BlackBox" :     { "name"      : "CLaSH.Sized.Internal.Unsigned.minus#"-    , "type"      : "minus# :: KnownNat (1 + Max m n) => Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)"-    , "templateE" : "~ARG[1] - ~ARG[2]"+    , "type"      : "minus# :: (KnownNat m, KnownNat n) => Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)"+    , "templateE" : "~ARG[2] - ~ARG[3]"     }   } , { "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" :@@ -162,8 +162,8 @@   } , { "BlackBox" :     { "name"      : "CLaSH.Sized.Internal.Unsigned.shiftR#"-    , "type"      : "shiftR# :: KnownNat n => Unsigned n -> Int -> Unsigned n"-    , "templateE" : "~ARG[1] >> ~ARG[2]"+    , "type"      : "shiftR# :: Unsigned n -> Int -> Unsigned n"+    , "templateE" : "~ARG[0] >> ~ARG[1]"     }   } , { "BlackBox" :
+ primitives/CLaSH.Sized.RTree.json view
@@ -0,0 +1,31 @@+[ { "BlackBox" :+    { "name"      : "CLaSH.Sized.RTree.treplicate"+    , "type"      : "replicate :: SNat d -> a -> RTree d a"+    , "templateE" : "'{(2**~LIT[0]) {~TOBV[~ARG[1]][~TYP[1]]}}"+    }+  }+, { "BlackBox" :+    { "name"      : "CLaSH.Sized.RTree.textract"+    , "type"      : "textract :: RTree 0 a -> a"+    , "templateD" :+"// textract begin+~SIGD[~GENSYM[tree][0]][0];+assign ~SYM[0] = ~ARG[0];++assign ~RESULT = ~FROMBV[~SYM[0][\\0\\]][~TYPO];+// textract end"+    }+  }+, { "BlackBox" :+    { "name"      : "CLaSH.Sized.RTree.tsplit"+    , "type"      : "tsplit:: RTree (d+1) a -> (RTree d a,RTree d a)"+    , "templateD" :+"// tsplit begin+~SIGD[~GENSYM[tree][0]][0];+assign ~SYM[0] = ~ARG[0];++assign ~RESULT = ~TOBV[~SYM[0]][~TYP[0]];+// 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,18 @@+[ { "BlackBox" :+    { "name"      : "GHC.Integer.Logarithms.integerLogBase#"+    , "type"      : "integerLogBase# :: Integer -> Integer -> Int#"+    , "templateD" :+"// integerLogBase begin+function integer ~GENSYM[integerLogBase][0];+  input integer base, value;+  begin+    for (~SYM[0] = 0; value >= base; ~SYM[0]=~SYM[0]+1)+      value = value / base;+  end+endfunction++assign ~RESULT = ~SYM[0](~ARG[0],~ARG[1]);+// integerLogBase end"+    }+  }+]
src/CLaSH/Backend/SystemVerilog.hs view
@@ -21,6 +21,7 @@ import           Control.Monad                        (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)@@ -31,6 +32,7 @@ import qualified Data.Text.Lazy                       as Text import           Prelude                              hiding ((<$>)) import           Text.PrettyPrint.Leijen.Text.Monadic+import           Text.Printf  import           CLaSH.Backend import           CLaSH.Driver.Types                   (SrcSpan, noSrcSpan)@@ -58,6 +60,7 @@     , _idSeen    :: [Identifier]     , _oports    :: [Identifier]     , _srcSpan   :: SrcSpan+    , _includes  :: [(String,Doc)]     , _intWidth  :: Int -- ^ Int/Word/Integer bit-width     , _hdlsyn    :: HdlSyn     }@@ -65,7 +68,7 @@ makeLenses ''SystemVerilogState  instance Backend SystemVerilogState where-  initBackend     = SystemVerilogState HashSet.empty [] HashMap.empty 0 "" [] [] noSrcSpan+  initBackend     = SystemVerilogState HashSet.empty [] HashMap.empty 0 "" [] [] noSrcSpan [] #ifdef CABAL   primDir         = const (Paths_clash_systemverilog.getDataFileName "primitives") #else@@ -146,10 +149,12 @@   else s  -- | Generate VHDL for a Netlist component-genVerilog :: String -> SrcSpan -> Component -> SystemVerilogM (String,Doc)+genVerilog :: String -> SrcSpan -> Component -> SystemVerilogM ((String,Doc),[(String,Doc)]) genVerilog _ sp c = do     setSrcSpan sp-    (unpack cName,) A.<$> verilog+    v    <- verilog+    incs <- use includes+    return ((unpack cName,v),incs)   where     cName   = componentName c     verilog = "// Automatically generated SystemVerilog-2005" <$$>@@ -177,6 +182,9 @@     eqReprTy (Vector n ty1) (Vector m ty2)       | m == n    = eqReprTy ty1 ty2       | otherwise = False+    eqReprTy (RTree n ty1) (RTree m ty2)+      | m == n    = eqReprTy ty1 ty2+      | otherwise = False     eqReprTy ty1 ty2       | isUnsigned ty1 && isUnsigned ty2 = typeSize ty1 == typeSize ty2       | otherwise                        = ty1 == ty2@@ -193,6 +201,7 @@ mkUsedTys :: HWType         -> [HWType] mkUsedTys v@(Vector _ elTy)   = v : mkUsedTys elTy+mkUsedTys t@(RTree _ elTy)    = t : mkUsedTys elTy mkUsedTys p@(Product _ elTys) = p : concatMap mkUsedTys elTys mkUsedTys sp@(SP _ elTys)     = sp : concatMap mkUsedTys (concatMap snd elTys) mkUsedTys t                   = [t]@@ -209,6 +218,8 @@      edge t@(Vector _ elTy) = maybe [] ((:[]) . (HashMap.lookupDefault (error $ $(curLoc) ++ "Vector") t nodesI,,()))                                       (HashMap.lookup elTy nodesI)+    edge t@(RTree _ elTy)  = maybe [] ((:[]) . (HashMap.lookupDefault (error $ $(curLoc) ++ "RTree") t nodesI,,()))+                                      (HashMap.lookup elTy nodesI)     edge t@(Product _ tys) = let ti = HashMap.lookupDefault (error $ $(curLoc) ++ "Product") t nodesI                              in mapMaybe (\ty -> liftM (ti,,()) (HashMap.lookup ty nodesI)) tys     edge t@(SP _ ctys)     = let ti = HashMap.lookupDefault (error $ $(curLoc) ++ "SP") t nodesI@@ -226,6 +237,16 @@                 let ranges = hcat (mapM (\n' -> brackets (int 0 <> colon <> int (n'-1))) (tail ns))                 "typedef" <+> elTy' <+> ranges <+> tyName ty <+> brackets (int 0 <> colon <> int (head ns - 1)) <> semi               _ -> error $ $(curLoc) ++ "impossible"+tyDec ty@(RTree n elTy) = do+  syn <- hdlSyn+  case syn of+    Vivado -> "typedef" <+> "logic" <+> brackets (int (typeSize elTy - 1) <> colon <> int 0) <+>+              tyName ty <+> brackets (int 0 <> colon <> int (2^n-1)) <> semi+    _ -> do case splitVecTy ty of+              Just (ns,elTy') -> do+                let ranges = hcat (mapM (\n' -> brackets (int 0 <> colon <> int (n'-1))) (tail ns))+                "typedef" <+> elTy' <+> ranges <+> tyName ty <+> brackets (int 0 <> colon <> int (head ns - 1)) <> semi+              _ -> error $ $(curLoc) ++ "impossible" tyDec ty@(Product _ tys) = prodDec   where     prodDec = "typedef struct packed {" <$>@@ -252,6 +273,11 @@     go (Vector n elTy) = case go elTy of       Just (ns,elTy') -> Just (n:ns,elTy')       _               -> Just ([n],elTy)++    go (RTree n elTy) = let n' = 2^n in case go elTy of+      Just (ns,elTy') -> Just (n':ns,elTy')+      _               -> Just ([n'],elTy)+     go _ = Nothing  lvType :: HWType -> SystemVerilogM Doc@@ -264,6 +290,15 @@         let ranges = hcat (mapM (\n' -> brackets (int 0 <> colon <> int (n'-1))) ns)         elTy' <> ranges       _ -> error $ $(curLoc) ++ "impossible"+lvType ty@(RTree n elTy) = do+  syn <- hdlSyn+  case syn of+    Vivado -> "logic" <+> brackets (int 0 <> colon <> int (2^n-1)) <> brackets (int (typeSize elTy - 1) <> colon <> int 0)+    _ -> case splitVecTy ty of+      Just (ns,elTy') -> do+        let ranges = hcat (mapM (\n' -> brackets (int 0 <> colon <> int (n'-1))) ns)+        elTy' <> ranges+      _ -> error $ $(curLoc) ++ "impossible" lvType ty = verilogType ty  funDec :: HWType -> SystemVerilogM Doc@@ -299,6 +334,44 @@                     let ranges' = hcat (mapM (\n' -> brackets (int 0 <> colon <> int (n'-1))) (tail ns))                     elTy' <+> ranges' <+> d <+> brackets (int 0 <> colon <> int (head ns - 2))                   _ -> error $ $(curLoc) ++ "impossible"++funDec ty@(RTree n elTy) =+  "function" <+> "logic" <+> ranges <+> tName <> "_to_lv" <> parens (sigDecl "i" ty) <> semi <$>+  indent 2+    ("for" <+> parens ("int n = 0" <> semi <+> "n <" <+> int (2^n) <> semi <+> "n=n+1") <$>+      indent 2 (tName <> "_to_lv" <> brackets "n" <+> "=" <+> "i[n]" <> semi)) <$>+  "endfunction" <$>+  "function" <+> tName <+> tName <> "_from_lv" <> parens ("logic" <+> ranges <+> "i") <> semi <$>+  indent 2+    ("for" <+> parens ("int n = 0" <> semi <+> "n <" <+> int (2^n) <> semi <+> "n=n+1") <$>+      indent 2 (tName <> "_from_lv" <> brackets "n" <+> "=" <+> "i[n]" <> semi)) <$>+  "endfunction" <$>+  (if n > 0+      then+        "function" <+> tName <+> tName <> "_br" <> parens (treeSigDecl "l" <> comma <> treeSigDecl "r") <> semi <$>+        indent 2+          (tName <> "_br" <> brackets (int 0 <> colon <> int (2^(n-1)-1)) <+> "=" <+> "l" <> semi <$>+           tName <> "_br" <> brackets (int (2^(n-1)) <> colon <> int (2^n-1)) <+> "=" <+> "r" <> semi) <$>+        "endfunction"+      else+        empty)+  where+    treeSigDecl :: SystemVerilogM Doc -> SystemVerilogM Doc+    treeSigDecl d = do+      syn <- hdlSyn+      case syn of+        Vivado -> "logic" <+> brackets (int (typeSize elTy - 1) <> colon <> int 0) <+>+                  d <+> brackets (int 0 <> colon <> int (2^(n-1)-1))+        _ -> do case splitVecTy (RTree (n-1) elTy) of+                  Just (ns,elTy') -> do+                    let ranges' = hcat (mapM (\n' -> brackets (int 0 <> colon <> int (n'-1))) (tail ns))+                    elTy' <+> ranges' <+> d <+> brackets (int 0 <> colon <> int (head ns - 1))+                  _ -> error $ $(curLoc) ++ "impossible"++    tName  = tyName ty+    ranges = brackets (int 0 <> colon <> int (2^n-1)) <>+             brackets (int (typeSize elTy - 1) <> colon <> int 0)+ funDec _ = empty  module_ :: Component -> SystemVerilogM Doc@@ -363,6 +436,9 @@     Vector _ _ -> do       nm <- use modNm       text (pack nm) <> "_types::" <> tyName t+    RTree _ _ -> do+      nm <- use modNm+      text (pack nm) <> "_types::" <> tyName t     Signed n      -> "logic signed" <+> brackets (int (n-1) <> colon <> int 0)     Clock _ _     -> "logic"     Reset _ _     -> "logic"@@ -381,11 +457,13 @@   case t of     Product _ _ -> text (pack nm) <> "_types::" <> m     Vector _ _ -> text (pack nm) <> "_types::" <> m+    RTree _ _ -> text (pack nm) <> "_types::" <> m     _ -> empty  tyName :: HWType -> SystemVerilogM Doc tyName Bool              = "logic_vector_1" tyName (Vector n elTy)   = "array_of_" <> int n <> "_" <> tyName elTy+tyName (RTree n elTy)    = "tree_of_" <> int n <> "_" <> tyName elTy tyName (BitVector n)     = "logic_vector_" <> int n tyName t@(Index _)       = "logic_vector_" <> int (typeSize t) tyName (Signed n)        = "signed_" <> int n@@ -423,6 +501,11 @@   case syn of     Vivado -> braces (int n <+> braces (int (typeSize elTy) <+> braces "1'bx"))     _ -> braces (int n <+> braces (verilogTypeErrValue elTy))+verilogTypeErrValue (RTree n elTy) = do+  syn <- hdlSyn+  case syn of+    Vivado -> braces (int (2^n) <+> braces (int (typeSize elTy) <+> braces "1'bx"))+    _ -> braces (int (2^n) <+> braces (verilogTypeErrValue elTy)) verilogTypeErrValue String = "\"ERROR\"" verilogTypeErrValue ty  = braces (int (typeSize ty) <+> braces "1'bx") @@ -505,10 +588,22 @@   where     pms' = tupled $ sequence [dot <> text i <+> parens (expr_ False e) | (i,_,_,e) <- pms] -inst_ (BlackBoxD _ bs bbCtx) = do+inst_ (BlackBoxD _ _ _ Nothing bs bbCtx) = do   t <- renderBlackBox bs bbCtx   fmap Just (string t) +inst_ (BlackBoxD _ _ _ (Just (nm,inc)) bs bbCtx) = do+  inc' <- renderBlackBox inc bbCtx+  iw <- use intWidth+  let incHash = hash inc'+      nm'     = Text.concat [ Text.fromStrict nm+                            , Text.pack (printf ("%0" ++ show iw ++ "X") incHash)+                            ]+  t <- renderBlackBox bs (bbCtx {bbQsysIncName = Just nm'})+  inc'' <- text inc'+  includes %= ((unpack nm', inc''):)+  fmap Just (string t)+ inst_ (NetDecl _ _) = return Nothing  -- | Turn a Netlist expression into a SystemVerilog expression@@ -536,6 +631,19 @@  expr_ _ (Identifier id_ (Just (Indexed ((Vector n _),1,2)))) = text id_ <> brackets (int 1 <> colon <> int (n-1)) +expr_ _ (Identifier id_ (Just (Indexed ((RTree 0 elTy),0,1)))) = do+  id' <- fmap (displayT . renderOneLine) (text id_ <> brackets (int 0))+  simpleFromSLV elTy id'++expr_ _ (Identifier id_ (Just (Indexed ((RTree n _),1,1)))) =+  let z = 2^(n-1)+  in  text id_ <> brackets (int 0 <> colon <> int (z-1))++expr_ _ (Identifier id_ (Just (Indexed ((RTree n _),1,2)))) =+  let z  = 2^(n-1)+      z' = 2^n+  in text id_ <> brackets (int z <> colon <> 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@@ -543,6 +651,13 @@   id' <- fmap (displayT . renderOneLine) (text id_ <> brackets (int fI))   simpleFromSLV elTy id' +-- 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 _ elTy),10,fI)))) = do+  id' <- fmap (displayT . renderOneLine) (text id_ <> brackets (int fI))+  simpleFromSLV elTy id'+ expr_ _ (Identifier id_ (Just (DC (ty@(SP _ _),_)))) = text id_ <> brackets (int start <> colon <> int end)   where     start = typeSize ty - 1@@ -552,8 +667,7 @@  expr_ b (DataCon _ (DC (Void, -1)) [e]) =  expr_ b e -expr_ _ (DataCon (Vector 0 _) _ _) =-  error $ $(curLoc) ++ "SystemVerilog: Trying to create a Nil vector."+expr_ _ (DataCon ty@(Vector 0 _) _ _) = verilogTypeErrValue ty  expr_ _ (DataCon (Vector 1 elTy) _ [e]) = "'" <> braces (toSLV elTy e) @@ -561,6 +675,12 @@   Just es -> "'" <> listBraces (mapM (toSLV elTy) es)   Nothing -> verilogTypeMark ty <> "_cons" <> parens (expr_ False e1 <> comma <+> expr_ False e2) +expr_ _ (DataCon (RTree 0 elTy) _ [e]) = "'" <> braces (toSLV elTy e)++expr_ _ e@(DataCon ty@(RTree _ elTy) _ [e1,e2]) = case rtreeChain e of+  Just es -> "'" <> listBraces (mapM (toSLV elTy) es)+  Nothing -> verilogTypeMark ty <> "_br" <> parens (expr_ False e1 <> comma <+> expr_ False e2)+ expr_ _ (DataCon ty@(SP _ args) (DC (_,i)) es) = assignExpr   where     argTys     = snd $ args !! i@@ -575,30 +695,42 @@ expr_ _ (DataCon ty@(Sum _ _) (DC (_,i)) []) = int (typeSize ty) <> "'d" <> int i expr_ _ (DataCon (Product _ tys) _ es) = listBraces (zipWithM toSLV tys 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   = exprLit (Just (Index (fromInteger n),fromInteger n)) i -expr_ b (BlackBoxE _ bs bbCtx b') = do+expr_ b (BlackBoxE _ _ _ Nothing bs bbCtx b') = do   t <- renderBlackBox bs bbCtx   parenIf (b || b') $ string t +expr_ b (BlackBoxE _ _ _ (Just (nm,inc)) bs bbCtx b') = do+  inc' <- renderBlackBox inc bbCtx+  iw <- use intWidth+  let incHash = hash inc'+      nm'     = Text.concat [ Text.fromStrict nm+                            , Text.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_))          = text id_ <> brackets (int 0) expr_ _ (DataTag Bool (Right id_))         = do   iw <- use intWidth@@ -625,6 +757,13 @@   iw <- use intWidth   int iw <> "'sd1" +expr_ _ (DataTag (RTree 0 _) (Right _)) = do+  iw <- use intWidth+  int iw <> "'sd0"+expr_ _ (DataTag (RTree _ _) (Right _)) = do+  iw <- use intWidth+  int iw <> "'sd1"+ expr_ _ e = error $ $(curLoc) ++ (show e) -- empty  otherSize :: [HWType] -> Int -> Int@@ -638,6 +777,12 @@ vectorChain (DataCon (Vector _ _) _ [e1,e2]) = Just e1 <:> vectorChain e2 vectorChain _                                       = Nothing +rtreeChain :: Expr -> Maybe [Expr]+rtreeChain (DataCon (RTree 0 _) _ [e])     = Just [e]+rtreeChain (DataCon (RTree _ _) _ [e1,e2]) = A.liftA2 (++) (rtreeChain e1)+                                                           (rtreeChain e2)+rtreeChain _                               = Nothing+ exprLit :: Maybe (HWType,Size) -> Literal -> SystemVerilogM Doc exprLit Nothing (NumLit i) = integer i @@ -674,15 +819,18 @@ toSLV :: HWType -> Expr -> SystemVerilogM Doc toSLV t e = case t of   Vector _ _ -> verilogTypeMark t <> "_to_lv" <> parens (expr_ False e)+  RTree _ _ -> verilogTypeMark t <> "_to_lv" <> parens (expr_ False e)   _ -> expr_ False e  fromSLV :: HWType -> Identifier -> Int -> Int -> SystemVerilogM Doc fromSLV t@(Vector _ _) id_ start end = verilogTypeMark t <> "_from_lv" <> parens (text id_ <> brackets (int start <> colon <> int end))+fromSLV t@(RTree _ _) id_ start end = verilogTypeMark t <> "_from_lv" <> parens (text id_ <> brackets (int start <> colon <> int end)) fromSLV (Signed _) id_ start end = "$signed" <> parens (text id_ <> brackets (int start <> colon <> int end)) fromSLV _ id_ start end = text id_ <> brackets (int start <> colon <> int end)  simpleFromSLV :: HWType -> Identifier -> SystemVerilogM Doc simpleFromSLV t@(Vector _ _) id_ = verilogTypeMark t <> "_from_lv" <> parens (text id_)+simpleFromSLV t@(RTree _ _) id_ = verilogTypeMark t <> "_from_lv" <> parens (text id_) simpleFromSLV (Signed _) id_ = "$signed" <> parens (text id_) simpleFromSLV _ id_ = text id_