clash-verilog 0.6.10 → 0.7
raw patch · 15 files changed
+266/−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 +4/−0
- LICENSE +2/−1
- clash-verilog.cabal +11/−8
- primitives/CLaSH.Class.BitPack.json +29/−0
- primitives/CLaSH.Prelude.BlockRam.File.json +6/−6
- primitives/CLaSH.Prelude.BlockRam.json +6/−6
- primitives/CLaSH.Prelude.RAM.json +6/−6
- primitives/CLaSH.Promoted.Nat.json +53/−24
- primitives/CLaSH.Sized.Internal.BitVector.json +7/−7
- primitives/CLaSH.Sized.Internal.Signed.json +6/−6
- primitives/CLaSH.Sized.Internal.Unsigned.json +8/−8
- primitives/CLaSH.Sized.RTree.json +25/−0
- primitives/GHC.CString.json +5/−0
- primitives/GHC.Integer.Logarithms.json +18/−0
- src/CLaSH/Backend/Verilog.hs +80/−11
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Changelog for the [`clash-systemverilog`](http://hackage.haskell.org/package/clash-systemverilog) package +## 0.7+* 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-verilog.cabal view
@@ -1,5 +1,5 @@ Name: clash-verilog-Version: 0.6.10+Version: 0.7 Synopsis: CAES Language for Synchronous Hardware - Verilog 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[6]) begin- ~SYM[0][~ARG[4]] <= ~ARG[7];+ if (~ARG[5]) begin+ ~SYM[0][~ARG[6]] <= ~ARG[7]; end- ~SYM[1] <= ~SYM[0][~ARG[5]];+ ~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" :@@ -24,10 +24,10 @@ end always @(posedge ~CLK[1]) begin : ~GENSYM[~COMPNAME_blockRam][4]- if (~ARG[5]) begin- ~SYM[0][~ARG[3]] <= ~ARG[6];+ if (~ARG[4]) begin+ ~SYM[0][~ARG[5]] <= ~ARG[6]; end- ~SYM[1] <= ~SYM[0][~ARG[4]];+ ~SYM[1] <= ~SYM[0][~ARG[3]]; end assign ~RESULT = ~SYM[1];
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 @@ reg ~TYPO ~GENSYM[RAM][0] [0:~LIT[2]-1]; always @(posedge ~CLK[0]) begin : ~GENSYM[~COMPNAME_Ram][1]- if (~ARG[5]) begin- ~SYM[0][~ARG[3]] <= ~ARG[6];+ if (~ARG[4]) begin+ ~SYM[0][~ARG[5]] <= ~ARG[6]; end end -assign ~RESULT = ~SYM[0][~ARG[4]];+assign ~RESULT = ~SYM[0][~ARG[3]]; // 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" : "~LIT[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
@@ -243,20 +243,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" :@@ -309,8 +309,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,25 @@+[ { "BlackBox" :+ { "name" : "CLaSH.Sized.RTree.treplicate"+ , "type" : "replicate :: SNat d -> a -> RTree d a"+ , "templateE" : "'{(2**~LIT[0]) {~ARG[1]}}"+ }+ }+, { "BlackBox" :+ { "name" : "CLaSH.Sized.RTree.textract"+ , "type" : "textract :: RTree 0 a -> a"+ , "templateD" :+"// textract begin+wire ~SIGD[~GENSYM[tree][0]][0];+assign ~SYM[0] = ~ARG[0];++assign ~RESULT = ~SYM[0][~SIZE[~TYP[0]]-1 -: ~SIZE[~TYPO]];+// textract end"+ }+ }+, { "BlackBox" :+ { "name" : "CLaSH.Sized.RTree.tsplit"+ , "type" : "tsplit:: RTree (d+1) a -> (RTree d a,RTree d a)"+ , "templateE" : "~ARG[0]"+ }+ }+]
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/Verilog.hs view
@@ -19,11 +19,13 @@ import qualified Control.Applicative as A import Control.Lens ((+=),(-=),(.=),(%=), makeLenses, use) import Control.Monad.State (State)+import Data.Hashable (Hashable (..)) import qualified Data.HashSet as HashSet import Data.Maybe (catMaybes,mapMaybe) import Data.Text.Lazy (pack, unpack) import qualified Data.Text.Lazy as Text import Prelude hiding ((<$>))+import Text.Printf import Text.PrettyPrint.Leijen.Text.Monadic import CLaSH.Backend@@ -47,6 +49,7 @@ { _genDepth :: Int -- ^ Depth of current generative block , _idSeen :: [Identifier] , _srcSpan :: SrcSpan+ , _includes :: [(String,Doc)] , _intWidth :: Int -- ^ Int/Word/Integer bit-width , _hdlsyn :: HdlSyn }@@ -54,7 +57,7 @@ makeLenses ''VerilogState instance Backend VerilogState where- initBackend = VerilogState 0 [] noSrcSpan+ initBackend = VerilogState 0 [] noSrcSpan [] #ifdef CABAL primDir = const (Paths_clash_verilog.getDataFileName "primitives") #else@@ -118,10 +121,12 @@ else s -- | Generate VHDL for a Netlist component-genVerilog :: SrcSpan -> Component -> VerilogM (String,Doc)+genVerilog :: SrcSpan -> Component -> VerilogM ((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 Verilog-2001" <$$>@@ -254,10 +259,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 `div` 4) ++ "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@@ -300,6 +317,19 @@ argSize = typeSize argTy start = typeSize ty - argSize - 1 +expr_ _ (Identifier id_ (Just (Indexed ((RTree 0 _),0,1)))) = text id_++expr_ _ (Identifier id_ (Just (Indexed (ty@(RTree _ _),1,1)))) =+ text id_ <> brackets (int start <> colon <> int end)+ where+ start = typeSize ty - 1+ end = typeSize ty `div` 2++expr_ _ (Identifier id_ (Just (Indexed (ty@(RTree _ _),1,2)))) =+ text id_ <> brackets (int start <> colon <> int 0)+ where+ start = (typeSize ty `div` 2) - 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@@ -310,6 +340,16 @@ start = typeSize ty - (fI * argSize) - 1 end = start - argSize + 1 +-- 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 (ty@(RTree _ argTy),10,fI)))) =+ text id_ <> brackets (int start <> colon <> int end)+ where+ argSize = typeSize argTy+ start = typeSize ty - (fI * argSize) - 1+ end = start - argSize + 1+ expr_ _ (Identifier id_ (Just (DC (ty@(SP _ _),_)))) = text id_ <> brackets (int start <> colon <> int end) where start = typeSize ty - 1@@ -319,8 +359,7 @@ expr_ b (DataCon _ (DC (Void, -1)) [e]) = expr_ b e -expr_ _ (DataCon (Vector 0 _) _ _) =- error $ $(curLoc) ++ "Verilog: Trying to create a Nil vector."+expr_ _ (DataCon ty@(Vector 0 _) _ _) = verilogTypeErrValue ty expr_ _ (DataCon (Vector 1 _) _ [e]) = expr_ False e expr_ _ e@(DataCon (Vector _ _) _ es@[_,_]) =@@ -328,6 +367,12 @@ Just es' -> listBraces (mapM (expr_ False) es') Nothing -> listBraces (mapM (expr_ False) es) +expr_ _ (DataCon (RTree 0 _) _ [e]) = expr_ False e+expr_ _ e@(DataCon (RTree _ _) _ es@[_,_]) =+ case rtreeChain e of+ Just es' -> listBraces (mapM (expr_ False) es')+ Nothing -> listBraces (mapM (expr_ False) es)+ expr_ _ (DataCon ty@(SP _ args) (DC (_,i)) es) = assignExpr where argTys = snd $ args !! i@@ -343,30 +388,42 @@ expr_ _ (DataCon (Product _ _) _ es) = listBraces (mapM (expr_ False) 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@@ -393,6 +450,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@@ -405,6 +469,11 @@ vectorChain (DataCon (Vector 1 _) _ [e]) = Just [e] 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]) = Just e1 <:> rtreeChain e2+rtreeChain _ = Nothing exprLit :: Maybe (HWType,Size) -> Literal -> VerilogM Doc exprLit Nothing (NumLit i) = integer i