Skip to content

Commit 5e35dc5

Browse files
christiaanbchristiaanb
committed
Make Int/Word/Integer size configurable
* The default is the system's default word with * Integer is now treated as a Signed N-bit, instead of a HDL native integer This is a follow-up to the discussion in #108
1 parent 3a83f2f commit 5e35dc5

37 files changed

+268
-277
lines changed

‎CLaSH.hs

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,7 @@
1+
{-# LANGUAGE CPP #-}
2+
3+
#include "MachDeps.h"
4+
15
import CLaSH.Driver
26
import CLaSH.Driver.Types
37
import CLaSH.Rewrite.Types
@@ -12,15 +16,15 @@ import CLaSH.Backend.Verilog
1216

1317
genSystemVerilog :: String
1418
-> IO ()
15-
genSystemVerilog = doHDL (initBackend :: SystemVerilogState)
19+
genSystemVerilog = doHDL (initBackend WORD_SIZE_IN_BITS :: SystemVerilogState)
1620

1721
genVHDL :: String
1822
-> IO ()
19-
genVHDL = doHDL (initBackend :: VHDLState)
23+
genVHDL = doHDL (initBackend WORD_SIZE_IN_BITS :: VHDLState)
2024

2125
genVerilog :: String
2226
-> IO ()
23-
genVerilog = doHDL (initBackend :: VerilogState)
27+
genVerilog = doHDL (initBackend WORD_SIZE_IN_BITS :: VerilogState)
2428

2529
doHDL :: Backend s
2630
=> s
@@ -30,7 +34,7 @@ doHDL b src = do
3034
pd <- primDir b
3135
primMap <- generatePrimMap [pd,"."]
3236
(bindingsMap,tcm,tupTcm,topEnt,testInpM,expOutM) <- generateBindings primMap src Nothing
33-
generateHDL bindingsMap (Just b) primMap tcm tupTcm ghcTypeToHWType reduceConstant topEnt testInpM expOutM (CLaSHOpts 20 20 15 DebugFinal True)
37+
generateHDL bindingsMap (Just b) primMap tcm tupTcm (ghcTypeToHWType WORD_SIZE_IN_BITS) reduceConstant topEnt testInpM expOutM (CLaSHOpts 20 20 15 DebugFinal True WORD_SIZE_IN_BITS)
3438

3539
main :: IO ()
3640
main = genVHDL "./examples/FIR.hs"

‎clash-ghc/src-bin/InteractiveUI.hs

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -114,7 +114,7 @@ import CLaSH.Backend.SystemVerilog (SystemVerilogState)
114114
import CLaSH.Backend.VHDL (VHDLState)
115115
import CLaSH.Backend.Verilog (VerilogState)
116116
import qualified CLaSH.Driver
117-
import CLaSH.Driver.Types (CLaSHOpts)
117+
import CLaSH.Driver.Types (CLaSHOpts(..))
118118
import CLaSH.GHC.Evaluator
119119
import CLaSH.GHC.GenerateBindings
120120
import CLaSH.GHC.NetlistTypes
@@ -1559,7 +1559,7 @@ modulesLoadedMsg ok mods = do
15591559
liftIO $ putStrLn $ showSDocForUser dflags unqual msg
15601560

15611561
makeHDL' :: CLaSH.Backend.Backend backend
1562-
=> backend
1562+
=> (Int -> backend)
15631563
-> IORef CLaSHOpts
15641564
-> [FilePath]
15651565
-> InputT GHCi ()
@@ -1574,28 +1574,29 @@ makeHDL' backend opts lst = makeHDL backend opts =<< case lst of
15741574

15751575
makeHDL :: GHC.GhcMonad m
15761576
=> CLaSH.Backend.Backend backend
1577-
=> backend
1577+
=> (Int -> backend)
15781578
-> IORef CLaSHOpts
15791579
-> [FilePath]
15801580
-> m ()
15811581
makeHDL backend optsRef srcs = do
15821582
dflags <- GHC.getSessionDynFlags
15831583
liftIO $ do opts <- readIORef optsRef
1584-
primDir <- CLaSH.Backend.primDir backend
1584+
let iw = opt_intWidth opts
1585+
primDir <- CLaSH.Backend.primDir (backend iw)
15851586
primMap <- CLaSH.Primitives.Util.generatePrimMap [primDir,"."]
15861587
forM_ srcs $ \src -> do
15871588
(bindingsMap,tcm,tupTcm,topEnt,testInpM,expOutM) <- generateBindings primMap src (Just dflags)
1588-
CLaSH.Driver.generateHDL bindingsMap (Just backend) primMap tcm
1589-
tupTcm ghcTypeToHWType reduceConstant topEnt testInpM expOutM opts
1589+
CLaSH.Driver.generateHDL bindingsMap (Just (backend iw)) primMap tcm
1590+
tupTcm (ghcTypeToHWType iw) reduceConstant topEnt testInpM expOutM opts
15901591

15911592
makeVHDL :: IORef CLaSHOpts -> [FilePath] -> InputT GHCi ()
1592-
makeVHDL = makeHDL' (CLaSH.Backend.initBackend :: VHDLState)
1593+
makeVHDL = makeHDL' (CLaSH.Backend.initBackend :: Int -> VHDLState)
15931594

15941595
makeVerilog :: IORef CLaSHOpts -> [FilePath] -> InputT GHCi ()
1595-
makeVerilog = makeHDL' (CLaSH.Backend.initBackend :: VerilogState)
1596+
makeVerilog = makeHDL' (CLaSH.Backend.initBackend :: Int -> VerilogState)
15961597

15971598
makeSystemVerilog :: IORef CLaSHOpts -> [FilePath] -> InputT GHCi ()
1598-
makeSystemVerilog = makeHDL' (CLaSH.Backend.initBackend :: SystemVerilogState)
1599+
makeSystemVerilog = makeHDL' (CLaSH.Backend.initBackend :: Int -> SystemVerilogState)
15991600

16001601
-----------------------------------------------------------------------------
16011602
-- :type

‎clash-ghc/src-bin/Main.hs

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,8 @@
1111

1212
module Main (main) where
1313

14+
#include "MachDeps.h"
15+
1416
-- The official GHC API
1517
import qualified GHC
1618
import GHC ( -- DynFlags(..), HscTarget(..),
@@ -121,6 +123,7 @@ main = do
121123
, opt_specLimit = 20
122124
, opt_inlineBelow = 15
123125
, opt_cleanhdl = True
126+
, opt_intWidth = WORD_SIZE_IN_BITS
124127
})
125128
(argv3, clashFlagWarnings) <- parseCLaSHFlags r argv2
126129

@@ -941,18 +944,18 @@ abiHash strs = do
941944
-- -----------------------------------------------------------------------------
942945
-- VHDL Generation
943946

944-
makeHDL' :: CLaSH.Backend.Backend backend => backend -> IORef CLaSHOpts -> [(String,Maybe Phase)] -> Ghc ()
947+
makeHDL' :: CLaSH.Backend.Backend backend => (Int -> backend) -> IORef CLaSHOpts -> [(String,Maybe Phase)] -> Ghc ()
945948
makeHDL' _ _ [] = throwGhcException (CmdLineError "No input files")
946949
makeHDL' backend r srcs = makeHDL backend r $ fmap fst srcs
947950

948951
makeVHDL :: IORef CLaSHOpts -> [(String, Maybe Phase)] -> Ghc ()
949-
makeVHDL = makeHDL' (CLaSH.Backend.initBackend :: VHDLState)
952+
makeVHDL = makeHDL' (CLaSH.Backend.initBackend :: Int -> VHDLState)
950953

951954
makeVerilog :: IORef CLaSHOpts -> [(String, Maybe Phase)] -> Ghc ()
952-
makeVerilog = makeHDL' (CLaSH.Backend.initBackend :: VerilogState)
955+
makeVerilog = makeHDL' (CLaSH.Backend.initBackend :: Int -> VerilogState)
953956

954957
makeSystemVerilog :: IORef CLaSHOpts -> [(String, Maybe Phase)] -> Ghc ()
955-
makeSystemVerilog = makeHDL' (CLaSH.Backend.initBackend :: SystemVerilogState)
958+
makeSystemVerilog = makeHDL' (CLaSH.Backend.initBackend :: Int -> SystemVerilogState)
956959

957960
-- -----------------------------------------------------------------------------
958961
-- Util

‎clash-ghc/src-ghc/CLaSH/GHC/CLaSHFlags.hs

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,7 @@ flagsClash r = [
3434
, defFlag "clash-inline-below" (IntSuffix (liftEwM . setInlineBelow r))
3535
, defFlag "clash-debug" (SepArg (setDebugLevel r))
3636
, defFlag "clash-noclean" (NoArg (liftEwM (setNoClean r)))
37+
, defFlag "clash-intwidth" (IntSuffix (liftEwM . setIntWidth r))
3738
]
3839

3940
setInlineLimit :: IORef CLaSHOpts
@@ -60,3 +61,8 @@ setDebugLevel r s = case readMaybe s of
6061

6162
setNoClean :: IORef CLaSHOpts -> IO ()
6263
setNoClean r = modifyIORef r (\c -> c {opt_cleanhdl = False})
64+
65+
setIntWidth :: IORef CLaSHOpts
66+
-> Int
67+
-> IO ()
68+
setIntWidth r n = modifyIORef r (\c -> c {opt_intWidth = n})

‎clash-ghc/src-ghc/CLaSH/GHC/NetlistTypes.hs

Lines changed: 52 additions & 52 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,9 @@
1-
{-# LANGUAGE CPP #-}
21
{-# LANGUAGE TemplateHaskell #-}
32
{-# LANGUAGE ViewPatterns #-}
43
module CLaSH.GHC.NetlistTypes
54
(ghcTypeToHWType)
65
where
76

8-
#include "MachDeps.h"
9-
107
import Data.Coerce (coerce)
118
import Data.Functor.Identity (Identity (..))
129
import Data.HashMap.Strict (HashMap,(!))
@@ -21,64 +18,67 @@ import CLaSH.Core.Util (tyNatSize)
2118
import CLaSH.Netlist.Util (coreTypeToHWType)
2219
import CLaSH.Netlist.Types (HWType(..))
2320

24-
ghcTypeToHWType :: HashMap TyConName TyCon
21+
ghcTypeToHWType :: Int
22+
-> HashMap TyConName TyCon
2523
-> Type
2624
-> Maybe (Either String HWType)
27-
ghcTypeToHWType m ty@(tyView -> TyConApp tc args) = runExceptT $
28-
case name2String tc of
29-
"GHC.Int.Int8" -> return (Signed 8)
30-
"GHC.Int.Int16" -> return (Signed 16)
31-
"GHC.Int.Int32" -> return (Signed 32)
32-
"GHC.Int.Int64" -> return (Signed 64)
33-
"GHC.Word.Word8" -> return (Unsigned 8)
34-
"GHC.Word.Word16" -> return (Unsigned 16)
35-
"GHC.Word.Word32" -> return (Unsigned 32)
36-
"GHC.Word.Word64" -> return (Unsigned 64)
37-
"GHC.Integer.Type.Integer" -> return Integer
38-
"GHC.Prim.Char#" -> return (Unsigned 21)
39-
"GHC.Prim.Int#" -> return (Signed WORD_SIZE_IN_BITS)
40-
"GHC.Prim.Word#" -> return (Unsigned WORD_SIZE_IN_BITS)
41-
"GHC.Prim.ByteArray#" ->
42-
fail $ "Can't translate type: " ++ showDoc ty
25+
ghcTypeToHWType iw = go
26+
where
27+
go m ty@(tyView -> TyConApp tc args) = runExceptT $
28+
case name2String tc of
29+
"GHC.Int.Int8" -> return (Signed 8)
30+
"GHC.Int.Int16" -> return (Signed 16)
31+
"GHC.Int.Int32" -> return (Signed 32)
32+
"GHC.Int.Int64" -> return (Signed 64)
33+
"GHC.Word.Word8" -> return (Unsigned 8)
34+
"GHC.Word.Word16" -> return (Unsigned 16)
35+
"GHC.Word.Word32" -> return (Unsigned 32)
36+
"GHC.Word.Word64" -> return (Unsigned 64)
37+
"GHC.Integer.Type.Integer" -> return (Signed iw)
38+
"GHC.Prim.Char#" -> return (Unsigned 21)
39+
"GHC.Prim.Int#" -> return (Signed iw)
40+
"GHC.Prim.Word#" -> return (Unsigned iw)
41+
"GHC.Prim.ByteArray#" ->
42+
fail $ "Can't translate type: " ++ showDoc ty
4343

44-
"GHC.Types.Bool" -> return Bool
45-
"GHC.Prim.~#" ->
46-
fail $ "Can't translate type: " ++ showDoc ty
44+
"GHC.Types.Bool" -> return Bool
45+
"GHC.Prim.~#" ->
46+
fail $ "Can't translate type: " ++ showDoc ty
4747

48-
"CLaSH.Signal.Internal.Signal'" ->
49-
ExceptT $ return $ coreTypeToHWType ghcTypeToHWType m (args !! 1)
48+
"CLaSH.Signal.Internal.Signal'" ->
49+
ExceptT $ return $ coreTypeToHWType go m (args !! 1)
5050

51-
"CLaSH.Sized.Internal.BitVector.BitVector" ->
52-
BitVector <$> mapExceptT (Just . coerce) (tyNatSize m (head args))
51+
"CLaSH.Sized.Internal.BitVector.BitVector" ->
52+
BitVector <$> mapExceptT (Just . coerce) (tyNatSize m (head args))
5353

54-
"CLaSH.Sized.Internal.Index.Index" ->
55-
Index <$> mapExceptT (Just . coerce) (tyNatSize m (head args))
54+
"CLaSH.Sized.Internal.Index.Index" ->
55+
Index <$> mapExceptT (Just . coerce) (tyNatSize m (head args))
5656

57-
"CLaSH.Sized.Internal.Signed.Signed" ->
58-
Signed <$> mapExceptT (Just . coerce) (tyNatSize m (head args))
57+
"CLaSH.Sized.Internal.Signed.Signed" ->
58+
Signed <$> mapExceptT (Just . coerce) (tyNatSize m (head args))
5959

60-
"CLaSH.Sized.Internal.Unsigned.Unsigned" ->
61-
Unsigned <$> mapExceptT (Just . coerce) (tyNatSize m (head args))
60+
"CLaSH.Sized.Internal.Unsigned.Unsigned" ->
61+
Unsigned <$> mapExceptT (Just . coerce) (tyNatSize m (head args))
6262

63-
"CLaSH.Sized.Vector.Vec" -> do
64-
let [szTy,elTy] = args
65-
sz <- mapExceptT (Just . coerce) (tyNatSize m szTy)
66-
elHWTy <- ExceptT $ return $ coreTypeToHWType ghcTypeToHWType m elTy
67-
return $ Vector sz elHWTy
63+
"CLaSH.Sized.Vector.Vec" -> do
64+
let [szTy,elTy] = args
65+
sz <- mapExceptT (Just . coerce) (tyNatSize m szTy)
66+
elHWTy <- ExceptT $ return $ coreTypeToHWType go m elTy
67+
return $ Vector sz elHWTy
6868

69-
"String" -> return String
70-
"GHC.Types.[]" -> case tyView (head args) of
71-
(TyConApp (name2String -> "GHC.Types.Char") []) -> return String
72-
_ -> fail $ "Can't translate type: " ++ showDoc ty
69+
"String" -> return String
70+
"GHC.Types.[]" -> case tyView (head args) of
71+
(TyConApp (name2String -> "GHC.Types.Char") []) -> return String
72+
_ -> fail $ "Can't translate type: " ++ showDoc ty
7373

74-
_ -> case m ! tc of
75-
-- TODO: Remove this conversion
76-
-- The current problem is that type-functions are not reduced by the GHC -> Core
77-
-- transformation process, and so end up here. Once a fix has been found for
78-
-- this problem remove this dirty hack.
79-
FunTyCon {tyConSubst = tcSubst} -> case findFunSubst tcSubst args of
80-
Just ty' -> ExceptT $ return $ coreTypeToHWType ghcTypeToHWType m ty'
81-
_ -> ExceptT Nothing
82-
_ -> ExceptT Nothing
74+
_ -> case m ! tc of
75+
-- TODO: Remove this conversion
76+
-- The current problem is that type-functions are not reduced by the GHC -> Core
77+
-- transformation process, and so end up here. Once a fix has been found for
78+
-- this problem remove this dirty hack.
79+
FunTyCon {tyConSubst = tcSubst} -> case findFunSubst tcSubst args of
80+
Just ty' -> ExceptT $ return $ coreTypeToHWType go m ty'
81+
_ -> ExceptT Nothing
82+
_ -> ExceptT Nothing
8383

84-
ghcTypeToHWType _ _ = Nothing
84+
go _ _ = Nothing

‎clash-lib/src/CLaSH/Backend.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ import CLaSH.Netlist.Types
99

1010
class Backend state where
1111
-- | Initial state for state monad
12-
initBackend :: state
12+
initBackend :: Int -> state
1313

1414
-- | Location for the primitive definitions
1515
primDir :: state -> IO FilePath

‎clash-lib/src/CLaSH/Driver.hs

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -69,8 +69,9 @@ generateHDL bindingsMap hdlState primMap tcm tupTcm typeTrans eval (topEntity,an
6969
putStrLn $ "Normalisation took " ++ show prepNormDiff
7070

7171
let modName = takeWhile (/= '.') (name2String topEntity)
72+
iw = opt_intWidth opts
7273
(netlist,dfiles,cmpCnt) <- genNetlist Nothing transformedBindings primMap tcm
73-
typeTrans Nothing modName [] topEntity
74+
typeTrans Nothing modName [] iw topEntity
7475

7576
netlistTime <- netlist `deepseq` Clock.getCurrentTime
7677
let normNetDiff = Clock.diffUTCTime netlistTime normTime
@@ -95,8 +96,8 @@ generateHDL bindingsMap hdlState primMap tcm tupTcm typeTrans eval (topEntity,an
9596
let netTBDiff = Clock.diffUTCTime testBenchTime netlistTime
9697
putStrLn $ "Testbench generation took " ++ show netTBDiff
9798

98-
let hdlState' = fromMaybe (initBackend :: backend) hdlState
99-
topWrapper = mkTopWrapper primMap annM modName topComponent
99+
let hdlState' = fromMaybe (initBackend iw :: backend) hdlState
100+
topWrapper = mkTopWrapper primMap annM modName iw topComponent
100101
hdlDocs = createHDL hdlState' modName (topWrapper : netlist ++ testBench)
101102
dir = concat [ "./" ++ CLaSH.Backend.name hdlState' ++ "/"
102103
, takeWhile (/= '.') (name2String topEntity)

0 commit comments

Comments
 (0)