diff options
-rw-r--r-- | src/VeriFuzz/Reduce.hs | 121 |
1 files changed, 73 insertions, 48 deletions
diff --git a/src/VeriFuzz/Reduce.hs b/src/VeriFuzz/Reduce.hs index 95c5bef..2a1b8b4 100644 --- a/src/VeriFuzz/Reduce.hs +++ b/src/VeriFuzz/Reduce.hs @@ -10,6 +10,8 @@ Portability : POSIX Test case reducer implementation. -} +{-# LANGUAGE RankNTypes #-} + module VeriFuzz.Reduce ( reduce ) @@ -42,12 +44,17 @@ instance Traversable Replacement where traverse f (Dual a b) = Dual <$> f a <*> f b -- | Split a list in two halves. -halve :: [a] -> ([a], [a]) -halve l = splitAt (length l `div` 2) l +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 -> a -> (b -> Replacement b) -> Replacement a +combine l i f = 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 +filterExpr _ e = e filterDecl :: [Identifier] -> ModItem -> Bool filterDecl ids (Decl Nothing (Port _ _ _ i)) = i `elem` ids @@ -65,59 +72,77 @@ cleanUndefined ids mis = . modContAssign . contAssignExpr %~ transform (filterExpr usedWires) - where usedWires = mis ^.. traverse . modContAssign . contAssignNetLVal <> ids + 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 -halveModAssign :: (([ModItem], [ModItem]) -> [ModItem]) -> ModDecl -> ModDecl -halveModAssign choose m = m & modItems %~ assigns +cleanMod :: ModDecl -> Replacement ModDecl -> Replacement ModDecl +cleanMod m newm = modify . change <$> newm where - assigns l = + mis = m ^. modItems + modify l = m & modItems .~ l + change l = cleanUndefined (m ^.. modInPorts . traverse . portName) - . combineAssigns (head $ m ^. modOutPorts) - . (filter (not . filterAssigns []) l <>) - . choose - . halve - . filter (filterAssigns $ m ^. modOutPorts) - $ l + . combineAssigns (head $ m ^. modOutPorts) + . (filter (not . filterAssigns []) mis <>) + $ l + ^. modItems -- | Split a module declaration in half by trying to remove assign statements. -halveAssigns :: VerilogSrc -> Replacement VerilogSrc -halveAssigns vsrc = - Dual (modified fst) (modified snd) - where - modified f = vsrc & getModule %~ halveModAssign f - ---halveExpr :: Expr -> Replacement Expr ---halveExpr (Concat (x:xs)) = Dual x $ Concat xs ---halveExpr (BinOp e1 _ e2) = Dual e1 e2 ---halveExpr (Cond _ e1 e2) = Dual e1 e2 ---halveExpr (UnOp _ e) = Single e ---halveExpr (Func _ e) = Single e ---halveExpr _ = None - --- | 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 srcInfo@(SourceInfo top src) = do +halveAssigns :: SourceInfo -> Replacement SourceInfo +halveAssigns vsrc = combine mainModule vsrc halveModAssign + +--halveIndExpr :: Expr -> Replacement Expr +--halveIndExpr (Concat (x : xs)) = Dual x $ Concat xs +--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 _ = None + +halveExpr :: SourceInfo -> Replacement SourceInfo +halveExpr _ = None + +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) -> - reduce eval $ srcTop s - (Dual _ l, Dual True False) -> - reduce eval $ srcTop l - (Dual r _, Dual False True) -> - reduce eval $ srcTop r + (Single s, Single False ) -> if s /= src then reduce eval s else return s + (Dual _ l, Dual True False ) -> reduce eval l + (Dual r _, Dual False True ) -> reduce eval r (Dual r l, Dual False False) -> do - lreduced <- reduce eval $ srcTop l - rreduced <- reduce eval $ srcTop r + lreduced <- reduce eval l + rreduced <- reduce eval r if runSource lreduced < runSource rreduced - then return lreduced - else return rreduced - _ -> return srcInfo + then return lreduced + else return rreduced + (None, None) -> return src + _ -> return src where - replacement = halveAssigns src - srcTop = SourceInfo top + replacement = repl src evalIfNotEmpty m = do - print $ GenVerilog <$> m ^.. getModule . modItems . traverse . modContAssign - eval $ srcTop m + 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 |