Commit b0d573c5 by Zachary Snow

removed BitVec exprs to preserve number formatting

parent a3937a27
-- | Unsigned bit vectors.
module Data.BitVec
( BitVec
, bitVec
, select
, width
, value
) where
import Data.Bits
data BitVec = BitVec Int Integer deriving (Show, Eq)
instance Num BitVec where
BitVec w1 v1 + BitVec w2 v2 = bitVec (max w1 w2) (v1 + v2)
BitVec w1 v1 - BitVec w2 v2 = bitVec (max w1 w2) (v1 - v2)
BitVec w1 v1 * BitVec w2 v2 = bitVec (max w1 w2) (v1 * v2)
abs = id
signum (BitVec _ v) = if v == 0 then bitVec 1 0 else bitVec 1 1
fromInteger i = bitVec (wid i) i
where
wid :: Integer -> Int
wid a
| a == 0 = 0
| a == -1 = 1
| otherwise = 1 + wid (shiftR a 1)
instance Bits BitVec where
BitVec w1 v1 .&. BitVec w2 v2 = bitVec (max w1 w2) (v1 .&. v2)
BitVec w1 v1 .|. BitVec w2 v2 = bitVec (max w1 w2) (v1 .|. v2)
BitVec w1 v1 `xor` BitVec w2 v2 = bitVec (max w1 w2) (v1 `xor` v2)
complement (BitVec w v) = bitVec w $ complement v
shift (BitVec w v) i = bitVec w $ shift v i
rotate _ _ = undefined --XXX To lazy to implemented it now.
bit i = fromInteger $ bit i
testBit (BitVec _ v) i = testBit v i
bitSize (BitVec w _) = w
bitSizeMaybe (BitVec w _) = Just w
isSigned _ = False
popCount (BitVec _ v) = popCount v
instance Semigroup BitVec where
(<>) = mappend
instance Monoid BitVec where
mempty = BitVec 0 0
mappend (BitVec w1 v1) (BitVec w2 v2) = BitVec (w1 + w2) (shiftL v1 w2 .|. v2)
-- | BitVec construction, given width and value.
bitVec :: Int -> Integer -> BitVec
bitVec w v = BitVec w' $ v .&. ((2 ^ fromIntegral w') - 1)
where
w' = max w 0
-- | Bit seclection. LSB is 0.
select :: BitVec -> (BitVec, BitVec) -> BitVec
select (BitVec _ v) (msb, lsb) = bitVec (fromIntegral $ value $ msb - lsb + 1) $ shiftR v (fromIntegral $ value $ lsb)
-- | Width of a 'BitVec'.
width :: BitVec -> Int
width (BitVec w _) = w
-- | Value of a 'BitVec'.
value :: BitVec -> Integer
value (BitVec _ v) = v
......@@ -25,8 +25,6 @@ import Data.List
import Data.Maybe
import Text.Printf
import Data.BitVec
type Identifier = String
-- Note: Verilog allows modules to be declared with either a simple list of
......@@ -96,11 +94,11 @@ type PortBinding = (Identifier, Maybe Expr)
data Parameter = Parameter (Maybe Range) Identifier Expr deriving Eq
instance Show Parameter where
show (Parameter r n e) = printf "parameter %s%s = %s;" (showRange r) n (showExprConst e)
show (Parameter r n e) = printf "parameter %s%s = %s;" (showRange r) n (show e)
data Localparam = Localparam (Maybe Range) Identifier Expr deriving Eq
instance Show Localparam where
show (Localparam r n e) = printf "localparam %s%s = %s;" (showRange r) n (showExprConst e)
show (Localparam r n e) = printf "localparam %s%s = %s;" (showRange r) n (show e)
data IntegerV = IntegerV Identifier RangesOrAssignment deriving Eq
instance Show IntegerV where
......@@ -119,7 +117,7 @@ instance Show ModuleItem where
Assign a b -> printf "assign %s = %s;" (show a) (show b)
Instance m params i ports
| null params -> printf "%s %s %s;" m i (showPorts show ports)
| otherwise -> printf "%s #%s %s %s;" m (showPorts showExprConst params) i (showPorts show ports)
| otherwise -> printf "%s #%s %s %s;" m (showPorts show params) i (showPorts show ports)
Function t x i b -> printf "function %s%s;\n%s\n%s\nendfunction" (showFuncRet t) x (indent $ unlines' $ map showFunctionItem i) (indent $ show b)
where
showPorts :: (Expr -> String) -> [(Identifier, Maybe Expr)] -> String
......@@ -151,7 +149,7 @@ showRanges = concat . (map rangeToString)
showRange :: Maybe Range -> String
showRange Nothing = ""
showRange (Just (h, l)) = printf "[%s:%s] " (showExprConst h) (showExprConst l)
showRange (Just (h, l)) = printf "[%s:%s] " (show h) (show l)
indent :: String -> String
indent a = '\t' : f a
......@@ -166,7 +164,7 @@ unlines' = intercalate "\n"
data Expr
= String String
| Number BitVec
| Number String
| ConstBool Bool
| Ident Identifier
| IdentRange Identifier Range
......@@ -247,43 +245,21 @@ instance Show BinOp where
Gt -> ">"
Ge -> ">="
showBitVecDefault :: BitVec -> String
showBitVecDefault a = printf "%d'h%x" (width a) (value a)
showBitVecConst :: BitVec -> String
showBitVecConst a = show $ value a
instance Show Expr where show = showExpr showBitVecDefault
showExprConst :: Expr -> String
showExprConst = showExpr showBitVecConst
showExpr :: (BitVec -> String) -> Expr -> String
showExpr bv x = case x of
String a -> printf "\"%s\"" a
Number a -> bv a
ConstBool a -> printf "1'b%s" (if a then "1" else "0")
Ident a -> a
IdentBit a b -> printf "%s[%s]" a (showExprConst b)
IdentRange a (b, c) -> printf "%s[%s:%s]" a (showExprConst b) (showExprConst c)
Repeat a b -> printf "{%s {%s}}" (showExprConst a) (commas $ map s b)
Concat a -> printf "{%s}" (commas $ map show a)
ExprCall a -> show a
UniOp a b -> printf "(%s %s)" (show a) (s b)
BinOp a b c -> printf "(%s %s %s)" (s b) (show a) (s c)
Mux a b c -> printf "(%s ? %s : %s)" (s a) (s b) (s c)
Bit a b -> printf "(%s [%d])" (s a) b
where
s = showExpr bv
instance Num Expr where
(+) = BinOp Add
(-) = BinOp Sub
(*) = BinOp Mul
negate = UniOp USub
abs = undefined
signum = undefined
fromInteger = Number . fromInteger
instance Show Expr where
show x = case x of
String a -> printf "\"%s\"" a
Number a -> a
ConstBool a -> printf "1'b%s" (if a then "1" else "0")
Ident a -> a
IdentBit a b -> printf "%s[%s]" a (show b)
IdentRange a (b, c) -> printf "%s[%s:%s]" a (show b) (show c)
Repeat a b -> printf "{%s {%s}}" (show a) (commas $ map show b)
Concat a -> printf "{%s}" (commas $ map show a)
ExprCall a -> show a
UniOp a b -> printf "(%s %s)" (show a) (show b)
BinOp a b c -> printf "(%s %s %s)" (show b) (show a) (show c)
Mux a b c -> printf "(%s ? %s : %s)" (show a) (show b) (show c)
Bit a b -> printf "(%s [%d])" (show a) b
instance Bits Expr where
(.&.) = BinOp BWAnd
......@@ -299,14 +275,6 @@ instance Bits Expr where
bit = error "Not supported: bit"
popCount = error "Not supported: popCount"
instance Semigroup Expr where
(<>) = mappend
instance Monoid Expr where
mempty = 0
mappend a b = mconcat [a, b]
mconcat = Concat
data LHS
= LHS Identifier
| LHSBit Identifier Expr
......@@ -316,8 +284,8 @@ data LHS
instance Show LHS where
show (LHS a ) = a
show (LHSBit a b ) = printf "%s[%s]" a (showExprConst b)
show (LHSRange a (b, c)) = printf "%s[%s:%s]" a (showExprConst b) (showExprConst c)
show (LHSBit a b ) = printf "%s[%s]" a (show b)
show (LHSRange a (b, c)) = printf "%s[%s:%s]" a (show b) (show c)
show (LHSConcat a ) = printf "{%s}" (commas $ map show a)
data Stmt
......
......@@ -4,7 +4,6 @@ module Language.SystemVerilog.Parser.Parse (modules) where
import Data.Bits
import Data.List
import Data.BitVec
import Data.Maybe
import Language.SystemVerilog.AST
import Language.SystemVerilog.Parser.Tokens
......@@ -362,8 +361,8 @@ CaseDefault :: { Maybe Stmt }
: { Nothing }
| "default" ":" Stmt { Just $3 }
Number :: { BitVec }
: number { toNumber $1 }
Number :: { String }
: number { tokenString $1 }
String :: { String }
: string { toString $1 }
......@@ -435,25 +434,6 @@ parseError a = case a of
toString :: Token -> String
toString = tail . init . tokenString
toNumber :: Token -> BitVec
toNumber = number . tokenString
where
number :: String -> BitVec
number a
| all (flip elem ['0' .. '9']) a = fromInteger $ read a
| head a == '\'' = fromInteger $ f a
| isInfixOf "'" a = bitVec (read w) (f b)
| otherwise = error $ "Invalid number format: " ++ a
where
w = takeWhile (/= '\'') a
b = dropWhile (/= '\'') a
f a
| isPrefixOf "'d" a = read $ drop 2 a
| isPrefixOf "'h" a = read $ "0x" ++ drop 2 a
| isPrefixOf "'b" a = foldl (\ n b -> shiftL n 1 .|. (if b == '1' then 1 else 0)) 0 (drop 2 a)
| otherwise = error $ "Invalid number format: " ++ a
portDeclToModuleItems
:: Direction
-> (Maybe ((Maybe Range) -> Type))
......
......@@ -31,7 +31,6 @@ library
array >= 0.5.1.0 && < 0.6
exposed-modules:
Data.BitVec
Language.SystemVerilog
Language.SystemVerilog.AST
Language.SystemVerilog.Parser
......@@ -52,7 +51,6 @@ executable sv2v
array,
base
other-modules:
Data.BitVec
Language.SystemVerilog
Language.SystemVerilog.AST
Language.SystemVerilog.Parser
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment