constant folding for shifts

This commit is contained in:
Zachary Snow 2020-06-06 22:45:08 -04:00
parent 2d7982f81e
commit 82703834ac
5 changed files with 53 additions and 7 deletions

View File

@ -81,7 +81,7 @@ convertExpr (orig @ (DimsFn FnDimensions (Left t))) =
convertExpr (DimFn f (Left t) (Number str)) = convertExpr (DimFn f (Left t) (Number str)) =
if dm == Nothing || isUnresolved t then if dm == Nothing || isUnresolved t then
DimFn f (Left t) (Number str) DimFn f (Left t) (Number str)
else if d <= 0 || d > length rs then else if d <= 0 || fromIntegral d > length rs then
Number "'x" Number "'x"
else case f of else case f of
FnLeft -> fst r FnLeft -> fst r
@ -97,7 +97,7 @@ convertExpr (DimFn f (Left t) (Number str)) =
_ -> snd $ typeRanges $ elaborateType t _ -> snd $ typeRanges $ elaborateType t
dm = readNumber str dm = readNumber str
Just d = dm Just d = dm
r = rs !! (d - 1) r = rs !! (fromIntegral $ d - 1)
isUnresolved :: Type -> Bool isUnresolved :: Type -> Bool
isUnresolved (Alias{}) = True isUnresolved (Alias{}) = True
isUnresolved (TypeOf{}) = True isUnresolved (TypeOf{}) = True

View File

@ -295,7 +295,7 @@ convertAsgn structs types (lhs, expr) =
convertExpr (Struct packing fields (_:rs)) (Bit e _) = convertExpr (Struct packing fields (_:rs)) (Bit e _) =
convertExpr (Struct packing fields rs) e convertExpr (Struct packing fields rs) e
convertExpr (Struct packing fields []) (Pattern [("", Repeat (Number nStr) exprs)]) = convertExpr (Struct packing fields []) (Pattern [("", Repeat (Number nStr) exprs)]) =
case readNumber nStr of case fmap fromIntegral (readNumber nStr) of
Just n -> convertExpr (Struct packing fields []) $ Pattern $ Just n -> convertExpr (Struct packing fields []) $ Pattern $
zip (repeat "") (concat $ take n $ repeat exprs) zip (repeat "") (concat $ take n $ repeat exprs)
Nothing -> Nothing ->

View File

@ -26,7 +26,10 @@ module Language.SystemVerilog.AST.Expr
, readNumber , readNumber
) where ) where
import Data.Bits (shiftL, shiftR)
import Data.Int (Int32)
import Data.List (intercalate) import Data.List (intercalate)
import Data.Word (Word32)
import Numeric (readHex) import Numeric (readHex)
import Text.Printf (printf) import Text.Printf (printf)
import Text.Read (readMaybe) import Text.Read (readMaybe)
@ -163,12 +166,12 @@ showExprOrRange :: ExprOrRange -> String
showExprOrRange (Left x) = show x showExprOrRange (Left x) = show x
showExprOrRange (Right x) = show x showExprOrRange (Right x) = show x
clog2Help :: Int -> Int -> Int clog2Help :: Int32 -> Int32 -> Int32
clog2Help p n = if p >= n then 0 else 1 + clog2Help (p*2) n clog2Help p n = if p >= n then 0 else 1 + clog2Help (p*2) n
clog2 :: Int -> Int clog2 :: Int32 -> Int32
clog2 n = if n < 2 then 0 else clog2Help 1 n clog2 n = if n < 2 then 0 else clog2Help 1 n
readNumber :: String -> Maybe Int readNumber :: String -> Maybe Int32
readNumber ('3' : '2' : '\'' : 'd' : rest) = readMaybe rest readNumber ('3' : '2' : '\'' : 'd' : rest) = readMaybe rest
readNumber ( '\'' : 'd' : rest) = readMaybe rest readNumber ( '\'' : 'd' : rest) = readMaybe rest
readNumber ('3' : '2' : '\'' : 'h' : rest) = readNumber ('3' : '2' : '\'' : 'h' : rest) =
@ -251,7 +254,7 @@ simplify (BinOp op e1 e2) =
(Add, BinOp Sub e (Number "1"), Number "1") -> e (Add, BinOp Sub e (Number "1"), Number "1") -> e
(Add, e, BinOp Sub (Number "0") (Number "1")) -> BinOp Sub e (Number "1") (Add, e, BinOp Sub (Number "0") (Number "1")) -> BinOp Sub e (Number "1")
(_ , Number a, Number b) -> (_ , Number a, Number b) ->
case (op, readNumber a :: Maybe Int, readNumber b :: Maybe Int) of case (op, readNumber a, readNumber b) of
(Add, Just x, Just y) -> Number $ show (x + y) (Add, Just x, Just y) -> Number $ show (x + y)
(Sub, Just x, Just y) -> Number $ show (x - y) (Sub, Just x, Just y) -> Number $ show (x - y)
(Mul, Just x, Just y) -> Number $ show (x * y) (Mul, Just x, Just y) -> Number $ show (x * y)
@ -265,7 +268,19 @@ simplify (BinOp op e1 e2) =
(Ge , Just x, Just y) -> bool $ x >= y (Ge , Just x, Just y) -> bool $ x >= y
(Lt , Just x, Just y) -> bool $ x < y (Lt , Just x, Just y) -> bool $ x < y
(Le , Just x, Just y) -> bool $ x <= y (Le , Just x, Just y) -> bool $ x <= y
(ShiftAL, Just x, Just y) -> Number $ show $ shiftL x (toInt y)
(ShiftAR, Just x, Just y) -> Number $ show $ shiftR x (toInt y)
(ShiftL , Just x, Just y) -> Number $ show $ shiftL x (toInt y)
(ShiftR , Just x, Just y) -> -- does not sign extend
Number $ show $ toInt32 $ shiftR (toWord32 x) (toInt y)
_ -> BinOp op e1' e2' _ -> BinOp op e1' e2'
where
toInt :: Int32 -> Int
toInt = fromIntegral
toWord32 :: Int32 -> Word32
toWord32 = fromIntegral
toInt32 :: Word32 -> Int32
toInt32 = fromIntegral
(Add, BinOp Add e (Number a), Number b) -> (Add, BinOp Add e (Number a), Number b) ->
case (readNumber a, readNumber b) of case (readNumber a, readNumber b) of
(Just x, Just y) -> BinOp Add e $ Number $ show (x + y) (Just x, Just y) -> BinOp Add e $ Number $ show (x + y)

30
test/basic/shift.sv Normal file
View File

@ -0,0 +1,30 @@
`define TEST_OP(op, a, b) $display(`"%0d op %0d = %0d`", a, b, a op b)
`define TEST(a, b) \
`TEST_OP(>> , a, b); \
`TEST_OP(<< , a, b); \
`TEST_OP(>>>, a, b); \
`TEST_OP(<<<, a, b)
module top;
initial begin
`TEST(-4, 0);
`TEST(-4, 1);
`TEST(-4, 2);
`TEST(-4, 3);
`TEST(-1, 0);
`TEST(-1, 1);
`TEST(-1, 2);
`TEST(-1, 3);
`TEST(1, 0);
`TEST(1, 1);
`TEST(1, 2);
`TEST(1, 3);
`TEST(2, 0);
`TEST(2, 1);
`TEST(2, 2);
`TEST(2, 3);
end
endmodule

1
test/basic/shift.v Normal file
View File

@ -0,0 +1 @@
`include "shift.sv"