aboutsummaryrefslogtreecommitdiffstats
path: root/src/VeriFuzz/Reduce.hs
blob: a074627da0ddd53f1fb1d867ac1633a3949b978e (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
{-|
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.
-}

module VeriFuzz.Reduce
    ( halveAssigns
    , reduce
    )
where

import           Control.Lens
import           VeriFuzz.AST

-- | Split a list in two halves.
halve :: [a] -> ([a], [a])
halve l = splitAt (length l `div` 2) l

-- | Split a module declaration in half by trying to remove assign statements.
halveAssigns :: VerilogSrc -> (VerilogSrc, VerilogSrc)
halveAssigns vsrc = (vsrc & vmod %~ fst . halve, vsrc & vmod %~ snd . halve)
    where
        vmod = getVerilogSrc . traverse . getDescription . modItems

-- | Reduce an input to a minimal representation.
reduce :: (VerilogSrc -> IO Bool) -- ^ Failed or not.
       -> VerilogSrc              -- ^ Input verilog source to be reduced.
       -> IO VerilogSrc           -- ^ Reduced output.
reduce eval src = do
    lresult <- eval l
    rresult <- eval r
    case (lresult, rresult) of
        (True, False) ->
            reduce eval l
        (False, True) ->
            reduce eval r
        (True, True) -> do
            lreduced <- reduce eval l
            rreduced <- reduce eval r
            if lreduced < rreduced
            then return lreduced
            else return rreduced
        _ ->
            return src
    where
        (l, r) = halveAssigns src