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 *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 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-systemverilog.cabal b/clash-systemverilog.cabal --- a/clash-systemverilog.cabal +++ b/clash-systemverilog.cabal @@ -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 -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[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]; 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" : @@ -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" 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 @@ 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" } } 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" : "~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" } } ] 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 @@ -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" : 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,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" + } + } +] 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/SystemVerilog.hs b/src/CLaSH/Backend/SystemVerilog.hs --- a/src/CLaSH/Backend/SystemVerilog.hs +++ b/src/CLaSH/Backend/SystemVerilog.hs @@ -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_