diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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 diff --git a/clash-verilog.cabal b/clash-verilog.cabal --- a/clash-verilog.cabal +++ b/clash-verilog.cabal @@ -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 -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, diff --git a/primitives/CLaSH.Class.BitPack.json b/primitives/CLaSH.Class.BitPack.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Class.BitPack.json @@ -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]" + } + } +] diff --git a/primitives/CLaSH.Prelude.BlockRam.File.json b/primitives/CLaSH.Prelude.BlockRam.File.json --- a/primitives/CLaSH.Prelude.BlockRam.File.json +++ b/primitives/CLaSH.Prelude.BlockRam.File.json @@ -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]; diff --git a/primitives/CLaSH.Prelude.BlockRam.json b/primitives/CLaSH.Prelude.BlockRam.json --- a/primitives/CLaSH.Prelude.BlockRam.json +++ b/primitives/CLaSH.Prelude.BlockRam.json @@ -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]; diff --git a/primitives/CLaSH.Prelude.RAM.json b/primitives/CLaSH.Prelude.RAM.json --- a/primitives/CLaSH.Prelude.RAM.json +++ b/primitives/CLaSH.Prelude.RAM.json @@ -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" } } diff --git a/primitives/CLaSH.Promoted.Nat.json b/primitives/CLaSH.Promoted.Nat.json --- a/primitives/CLaSH.Promoted.Nat.json +++ b/primitives/CLaSH.Promoted.Nat.json @@ -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" } } ] diff --git a/primitives/CLaSH.Sized.Internal.BitVector.json b/primitives/CLaSH.Sized.Internal.BitVector.json --- a/primitives/CLaSH.Sized.Internal.BitVector.json +++ b/primitives/CLaSH.Sized.Internal.BitVector.json @@ -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" : diff --git a/primitives/CLaSH.Sized.Internal.Signed.json b/primitives/CLaSH.Sized.Internal.Signed.json --- a/primitives/CLaSH.Sized.Internal.Signed.json +++ b/primitives/CLaSH.Sized.Internal.Signed.json @@ -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" : diff --git a/primitives/CLaSH.Sized.Internal.Unsigned.json b/primitives/CLaSH.Sized.Internal.Unsigned.json --- a/primitives/CLaSH.Sized.Internal.Unsigned.json +++ b/primitives/CLaSH.Sized.Internal.Unsigned.json @@ -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" : diff --git a/primitives/CLaSH.Sized.RTree.json b/primitives/CLaSH.Sized.RTree.json new file mode 100644 --- /dev/null +++ b/primitives/CLaSH.Sized.RTree.json @@ -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]" + } + } +] diff --git a/primitives/GHC.CString.json b/primitives/GHC.CString.json --- a/primitives/GHC.CString.json +++ b/primitives/GHC.CString.json @@ -3,6 +3,11 @@ , "templateE" : "~LIT[0]" } } +, { "BlackBox" : + { "name" : "GHC.CString.unpackFoldrCString#" + , "templateE" : "~LIT[0]" + } + } , { "Primitive" : { "name" : "GHC.CString.unpackCStringUtf8#" , "primType" : "Function" diff --git a/primitives/GHC.Integer.Logarithms.json b/primitives/GHC.Integer.Logarithms.json new file mode 100644 --- /dev/null +++ b/primitives/GHC.Integer.Logarithms.json @@ -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" + } + } +] diff --git a/src/CLaSH/Backend/Verilog.hs b/src/CLaSH/Backend/Verilog.hs --- a/src/CLaSH/Backend/Verilog.hs +++ b/src/CLaSH/Backend/Verilog.hs @@ -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