blob: c0ce7216a2df7a4ca8223bd60198892dc1deec1a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
{-|
Module : VeriFuzz.Reduce
Description : Test case reducer implementation.
Copyright : (c) 2019, Yann Herklotz Grave
License : GPL-3
Maintainer : ymherklotz [at] gmail [dot] com
Stability : experimental
Portability : POSIX
Test case reducer implementation.
-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module VeriFuzz.Reduce
( reduce
)
where
import Control.Lens
import VeriFuzz.AST
import VeriFuzz.CodeGen
import VeriFuzz.Internal
import VeriFuzz.Mutate
data Replacement a = Dual a a
| Single a
| None
deriving (Eq, Show)
instance Functor Replacement where
fmap f (Dual a b) = Dual (f a) $ f b
fmap f (Single a) = Single $ f a
fmap _ None = None
instance Applicative Replacement where
pure a = Single a
(Dual a b) <*> (Dual c d) = Dual (a c) $ b d
(Dual a b) <*> (Single c) = Dual (a c) $ b c
(Single a) <*> (Dual b c) = Dual (a b) $ a c
(Single a) <*> (Single b) = Single $ a b
None <*> _ = None
_ <*> None = None
instance Foldable Replacement where
foldMap _ None = mempty
foldMap f (Single a) = f a
foldMap f (Dual a b) = f a <> f b
instance Traversable Replacement where
traverse _ None = pure None
traverse f (Single a) = Single <$> f a
traverse f (Dual a b) = Dual <$> f a <*> f b
-- | Split a list in two halves.
halve :: [a] -> Replacement [a]
halve [] = None
halve [a] = Single [a]
halve l = Dual a b where (a, b) = splitAt (length l `div` 2) l
combine :: Lens' a b -> (b -> Replacement b) -> a -> Replacement a
combine l f i = modify <$> f (i ^. l) where modify res = i & l .~ res
filterExpr :: [Identifier] -> Expr -> Expr
filterExpr ids (Id i) = if i `notElem` ids then Number 1 0 else Id i
filterExpr _ e = e
filterDecl :: [Identifier] -> ModItem -> Bool
filterDecl ids (Decl Nothing (Port _ _ _ i)) = i `elem` ids
filterDecl _ _ = True
filterAssigns :: [Port] -> ModItem -> Bool
filterAssigns out (ModCA (ContAssign i _)) =
notElem i $ out ^.. traverse . portName
filterAssigns _ _ = False
cleanUndefined :: [Identifier] -> [ModItem] -> [ModItem]
cleanUndefined ids mis =
filter (filterDecl usedWires) mis
& traverse
. modContAssign
. contAssignExpr
%~ transform (filterExpr usedWires)
where
usedWires = mis ^.. traverse . modContAssign . contAssignNetLVal <> ids
halveModAssign :: ModDecl -> Replacement ModDecl
halveModAssign m = cleanMod m $ modify <$> assigns (m ^. modItems)
where
assigns = halve . filter (filterAssigns $ m ^. modOutPorts)
modify l = m & modItems .~ l
cleanMod :: ModDecl -> Replacement ModDecl -> Replacement ModDecl
cleanMod m newm = modify . change <$> newm
where
mis = m ^. modItems
modify l = m & modItems .~ l
change l =
cleanUndefined (m ^.. modInPorts . traverse . portName)
. combineAssigns (head $ m ^. modOutPorts)
. (filter (not . filterAssigns []) mis <>)
$ l
^. modItems
-- | Split a module declaration in half by trying to remove assign statements.
halveAssigns :: SourceInfo -> Replacement SourceInfo
halveAssigns = combine mainModule halveModAssign
halveIndExpr :: Expr -> Replacement Expr
halveIndExpr (Concat l) = Concat <$> halve l
halveIndExpr (BinOp e1 _ e2 ) = Dual e1 e2
halveIndExpr (Cond _ e1 e2 ) = Dual e1 e2
halveIndExpr (UnOp _ e ) = Single e
halveIndExpr (Func _ e ) = Single e
halveIndExpr e = Single e
halveModExpr :: ModItem -> Replacement ModItem
halveModExpr (ModCA ca) = ModCA <$> combine contAssignExpr halveIndExpr ca
halveModExpr a = Single a
halveExpr :: SourceInfo -> Replacement SourceInfo
halveExpr = combine contexpr $ traverse halveModExpr
where
contexpr :: Lens' SourceInfo [ModItem]
contexpr = mainModule . modItems
reduce_
:: (SourceInfo -> Replacement SourceInfo)
-> (SourceInfo -> IO Bool)
-> SourceInfo
-> IO SourceInfo
reduce_ repl eval src = do
replAnswer <- sequenceA $ evalIfNotEmpty <$> replacement
case (replacement, replAnswer) of
(Single s, Single False) -> do
putStrLn "########## 1 ##########"
runIf s
(Dual _ l, Dual True False ) -> do
putStrLn "########## 2 ##########"
runIf l
(Dual r _, Dual False True ) -> do
putStrLn "########## 3 ##########"
runIf r
(Dual r l, Dual False False) -> do
putStrLn "########## 4 ##########"
lreduced <- runIf l
rreduced <- runIf r
if runSource lreduced < runSource rreduced
then return lreduced
else return rreduced
(None, None) -> do
putStrLn "########## 5 ##########"
return src
_ -> do
putStrLn "########## 6 ##########"
return src
where
replacement = repl src
runIf s = if s /= src then reduce eval s else return s
evalIfNotEmpty m = do
print
$ GenVerilog
<$> m
^.. mainModule
. modItems
. traverse
. modContAssign
eval m
-- | Reduce an input to a minimal representation.
reduce
:: (SourceInfo -> IO Bool) -- ^ Failed or not.
-> SourceInfo -- ^ Input verilog source to be reduced.
-> IO SourceInfo -- ^ Reduced output.
reduce eval src = reduce_ halveAssigns eval src >>= reduce_ halveExpr eval
|
