module Verismith.Verilog.Distance where
import Data.Functor.Foldable (cata)
import Data.Text (Text, unpack)
import Verismith.Verilog.AST
import Verismith.Verilog.Eval
data Pair a b = Pair a b
deriving (Int -> Pair a b -> ShowS
[Pair a b] -> ShowS
Pair a b -> String
(Int -> Pair a b -> ShowS)
-> (Pair a b -> String) -> ([Pair a b] -> ShowS) -> Show (Pair a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Pair a b -> ShowS
forall a b. (Show a, Show b) => [Pair a b] -> ShowS
forall a b. (Show a, Show b) => Pair a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Pair a b -> ShowS
showsPrec :: Int -> Pair a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => Pair a b -> String
show :: Pair a b -> String
$cshowList :: forall a b. (Show a, Show b) => [Pair a b] -> ShowS
showList :: [Pair a b] -> ShowS
Show)
instance (Eq b) => Eq (Pair a b) where
Pair a
_ b
a == :: Pair a b -> Pair a b -> Bool
== Pair a
_ b
b = b
a b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b
instance (Ord b) => Ord (Pair a b) where
Pair a
_ b
a <= :: Pair a b -> Pair a b -> Bool
<= Pair a
_ b
b = b
a b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
b
eqDistance :: (Eq a) => a -> a -> Int
eqDistance :: forall a. Eq a => a -> a -> Int
eqDistance a
a a
b = if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b then Int
0 else Int
1
{-# INLINE eqDistance #-}
emptyDistance :: a -> a -> Int
emptyDistance :: forall a. a -> a -> Int
emptyDistance a
_ a
_ = Int
0
{-# INLINE emptyDistance #-}
class Distance a where
distance :: a -> a -> Int
udistance :: a -> a -> Int
udistance = a -> a -> Int
forall a. Distance a => a -> a -> Int
distance
dempty :: a -> Int
dempty a
_ = Int
1
minimumloc :: (Distance a) => a -> [a] -> Pair Int Int
minimumloc :: forall a. Distance a => a -> [a] -> Pair Int Int
minimumloc a
ah [] = Int -> Int -> Pair Int Int
forall a b. a -> b -> Pair a b
Pair Int
0 (Int -> Pair Int Int) -> Int -> Pair Int Int
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Distance a => a -> Int
dempty a
ah
minimumloc a
ah [a]
b = [Pair Int Int] -> Pair Int Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Pair Int Int] -> Pair Int Int) -> [Pair Int Int] -> Pair Int Int
forall a b. (a -> b) -> a -> b
$ (\(Int
loc, a
el) -> Int -> Int -> Pair Int Int
forall a b. a -> b -> Pair a b
Pair Int
loc (a -> a -> Int
forall a. Distance a => a -> a -> Int
udistance a
ah a
el)) ((Int, a) -> Pair Int Int) -> [(Int, a)] -> [Pair Int Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [a]
b
removeAt :: Int -> [a] -> [a]
removeAt :: forall a. Int -> [a] -> [a]
removeAt Int
loc [a]
lst =
let ([a]
a, [a]
b) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
loc [a]
lst
in if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
b then [a]
a else [a]
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
b
remdist :: (Distance a) => [a] -> [a] -> Int
remdist :: forall a. Distance a => [a] -> [a] -> Int
remdist [] [a]
a = [a] -> [a] -> Int
forall a. Distance a => a -> a -> Int
distance [] [a]
a
remdist [a]
a [] = [a] -> [a] -> Int
forall a. Distance a => a -> a -> Int
distance [] [a]
a
remdist (a
x : [a]
xs) [a]
b
| Int
cost Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dx = [a] -> [a] -> Int
forall a. Distance a => a -> a -> Int
udistance [a]
xs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
removeAt Int
loc [a]
b) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cost
| Bool
otherwise = [a] -> [a] -> Int
forall a. Distance a => a -> a -> Int
udistance [a]
xs [a]
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dx
where
Pair Int
loc Int
cost = a -> [a] -> Pair Int Int
forall a. Distance a => a -> [a] -> Pair Int Int
minimumloc a
x [a]
b
dx :: Int
dx = a -> Int
forall a. Distance a => a -> Int
dempty a
x
instance (Distance a) => Distance [a] where
distance :: [a] -> [a] -> Int
distance [] [] = Int
0
distance [] [a]
l = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Distance a => a -> Int
dempty (a -> Int) -> [a] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
l
distance [a]
l [] = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Distance a => a -> Int
dempty (a -> Int) -> [a] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
l
distance a :: [a]
a@(a
ah : [a]
at) b :: [a]
b@(a
bh : [a]
bt) =
let cost :: Int
cost = a -> a -> Int
forall a. Distance a => a -> a -> Int
distance a
ah a
bh
in if Int
cost Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then [a] -> [a] -> Int
forall a. Distance a => a -> a -> Int
distance [a]
at [a]
bt
else
[Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum
[ [a] -> [a] -> Int
forall a. Distance a => a -> a -> Int
distance [a]
at [a]
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Distance a => a -> Int
dempty a
ah,
[a] -> [a] -> Int
forall a. Distance a => a -> a -> Int
distance [a]
bt [a]
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Distance a => a -> Int
dempty a
bh,
[a] -> [a] -> Int
forall a. Distance a => a -> a -> Int
distance [a]
at [a]
bt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cost
]
udistance :: [a] -> [a] -> Int
udistance [a]
a [a]
b =
[Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum
[ [a] -> [a] -> Int
forall a. Distance a => [a] -> [a] -> Int
remdist [a]
a [a]
b,
[a] -> [a] -> Int
forall a. Distance a => [a] -> [a] -> Int
remdist [a]
b [a]
a
]
dempty :: [a] -> Int
dempty [] = Int
0
dempty (a
a : [a]
b) = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a -> Int
forall a. Distance a => a -> Int
dempty a
a, [a] -> Int
forall a. Distance a => a -> Int
dempty [a]
b]
instance (Distance a) => Distance (Maybe a) where
distance :: Maybe a -> Maybe a -> Int
distance Maybe a
Nothing Maybe a
a = Maybe a -> Int
forall a. Distance a => a -> Int
dempty Maybe a
a
distance Maybe a
a Maybe a
Nothing = Maybe a -> Int
forall a. Distance a => a -> Int
dempty Maybe a
a
distance (Just a
a) (Just a
b) = a -> a -> Int
forall a. Distance a => a -> a -> Int
distance a
a a
b
udistance :: Maybe a -> Maybe a -> Int
udistance (Just a
a) (Just a
b) = a -> a -> Int
forall a. Distance a => a -> a -> Int
udistance a
a a
b
udistance Maybe a
a Maybe a
b = Maybe a -> Maybe a -> Int
forall a. Distance a => a -> a -> Int
distance Maybe a
a Maybe a
b
dempty :: Maybe a -> Int
dempty Maybe a
Nothing = Int
0
dempty (Just a
a) = a -> Int
forall a. Distance a => a -> Int
dempty a
a
instance Distance Char where
distance :: Char -> Char -> Int
distance = Char -> Char -> Int
forall a. Eq a => a -> a -> Int
eqDistance
instance Distance Bool where
distance :: Bool -> Bool -> Int
distance = Bool -> Bool -> Int
forall a. Eq a => a -> a -> Int
eqDistance
instance Distance Integer where
distance :: Integer -> Integer -> Int
distance = Integer -> Integer -> Int
forall a. Eq a => a -> a -> Int
eqDistance
instance Distance Text where
distance :: Text -> Text -> Int
distance Text
t1 Text
t2 = String -> String -> Int
forall a. Distance a => a -> a -> Int
distance (Text -> String
unpack Text
t1) (Text -> String
unpack Text
t2)
instance Distance Identifier where
distance :: Identifier -> Identifier -> Int
distance = Identifier -> Identifier -> Int
forall a. Eq a => a -> a -> Int
eqDistance
eval :: ConstExpr -> Integer
eval :: ConstExpr -> Integer
eval ConstExpr
c = BitVec -> Integer
forall a. Integral a => a -> Integer
toInteger ((Base ConstExpr BitVec -> BitVec) -> ConstExpr -> BitVec
forall t a. Recursive t => (Base t a -> a) -> t -> a
forall a. (Base ConstExpr a -> a) -> ConstExpr -> a
cata (Bindings -> ConstExprF BitVec -> BitVec
evaluateConst []) ConstExpr
c)
instance Distance ConstExpr where
distance :: ConstExpr -> ConstExpr -> Int
distance ConstExpr
c1 ConstExpr
c2 = Integer -> Integer -> Int
forall a. Distance a => a -> a -> Int
distance (ConstExpr -> Integer
eval ConstExpr
c1) (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ ConstExpr -> Integer
eval ConstExpr
c2
udistance :: ConstExpr -> ConstExpr -> Int
udistance ConstExpr
c1 ConstExpr
c2 = Integer -> Integer -> Int
forall a. Distance a => a -> a -> Int
udistance (ConstExpr -> Integer
eval ConstExpr
c1) (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ ConstExpr -> Integer
eval ConstExpr
c2
instance Distance Parameter where
distance :: Parameter -> Parameter -> Int
distance Parameter
_ Parameter
_ = Int
0
instance Distance PortType where
distance :: PortType -> PortType -> Int
distance = PortType -> PortType -> Int
forall a. Eq a => a -> a -> Int
eqDistance
instance Distance PortDir where
distance :: PortDir -> PortDir -> Int
distance = PortDir -> PortDir -> Int
forall a. Eq a => a -> a -> Int
eqDistance
instance Distance (Statement a) where
distance :: Statement a -> Statement a -> Int
distance (TimeCtrl Delay
_ Maybe (Statement a)
s1) (TimeCtrl Delay
_ Maybe (Statement a)
s2) = Maybe (Statement a) -> Maybe (Statement a) -> Int
forall a. Distance a => a -> a -> Int
distance Maybe (Statement a)
s1 Maybe (Statement a)
s2
distance (EventCtrl Event
_ Maybe (Statement a)
s1) (EventCtrl Event
_ Maybe (Statement a)
s2) = Maybe (Statement a) -> Maybe (Statement a) -> Int
forall a. Distance a => a -> a -> Int
distance Maybe (Statement a)
s1 Maybe (Statement a)
s2
distance (SeqBlock [Statement a]
s1) (SeqBlock [Statement a]
s2) = [Statement a] -> [Statement a] -> Int
forall a. Distance a => a -> a -> Int
distance [Statement a]
s1 [Statement a]
s2
distance (CondStmnt Expr
_ Maybe (Statement a)
st1 Maybe (Statement a)
sf1) (CondStmnt Expr
_ Maybe (Statement a)
st2 Maybe (Statement a)
sf2) = Maybe (Statement a) -> Maybe (Statement a) -> Int
forall a. Distance a => a -> a -> Int
distance Maybe (Statement a)
st1 Maybe (Statement a)
st2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Maybe (Statement a) -> Maybe (Statement a) -> Int
forall a. Distance a => a -> a -> Int
distance Maybe (Statement a)
sf1 Maybe (Statement a)
sf2
distance (ForLoop Assign
_ Expr
_ Assign
_ Statement a
s1) (ForLoop Assign
_ Expr
_ Assign
_ Statement a
s2) = Statement a -> Statement a -> Int
forall a. Distance a => a -> a -> Int
distance Statement a
s1 Statement a
s2
distance (StmntAnn a
_ Statement a
s1) Statement a
s2 = Statement a -> Statement a -> Int
forall a. Distance a => a -> a -> Int
distance Statement a
s1 Statement a
s2
distance (BlockAssign Assign
_) (BlockAssign Assign
_) = Int
0
distance (NonBlockAssign Assign
_) (NonBlockAssign Assign
_) = Int
0
distance (TaskEnable Task
_) (TaskEnable Task
_) = Int
0
distance (SysTaskEnable Task
_) (SysTaskEnable Task
_) = Int
0
distance (StmntCase CaseType
_ Expr
_ [CasePair a]
_ Maybe (Statement a)
_) (StmntCase CaseType
_ Expr
_ [CasePair a]
_ Maybe (Statement a)
_) = Int
0
distance Statement a
_ Statement a
_ = Int
1
instance Distance (ModItem a) where
distance :: ModItem a -> ModItem a -> Int
distance (ModCA ContAssign
_) (ModCA ContAssign
_) = Int
0
distance (ModInst Identifier
_ [ModConn]
_ Identifier
_ [ModConn]
_) (ModInst Identifier
_ [ModConn]
_ Identifier
_ [ModConn]
_) = Int
0
distance (Initial Statement a
_) (Initial Statement a
_) = Int
0
distance (Always Statement a
s1) (Always Statement a
s2) = Statement a -> Statement a -> Int
forall a. Distance a => a -> a -> Int
distance Statement a
s1 Statement a
s2
distance (Decl Maybe PortDir
_ Port
_ Maybe ConstExpr
_) (Decl Maybe PortDir
_ Port
_ Maybe ConstExpr
_) = Int
0
distance (ParamDecl NonEmpty Parameter
_) (ParamDecl NonEmpty Parameter
_) = Int
0
distance (LocalParamDecl NonEmpty LocalParam
_) (LocalParamDecl NonEmpty LocalParam
_) = Int
0
distance ModItem a
_ ModItem a
_ = Int
1
instance Distance Range where
distance :: Range -> Range -> Int
distance (Range ConstExpr
a1 ConstExpr
b1) (Range ConstExpr
a2 ConstExpr
b2) =
ConstExpr -> ConstExpr -> Int
forall a. Distance a => a -> a -> Int
distance ConstExpr
a1 ConstExpr
a2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ConstExpr -> ConstExpr -> Int
forall a. Distance a => a -> a -> Int
distance ConstExpr
b1 ConstExpr
b2
udistance :: Range -> Range -> Int
udistance (Range ConstExpr
a1 ConstExpr
b1) (Range ConstExpr
a2 ConstExpr
b2) =
ConstExpr -> ConstExpr -> Int
forall a. Distance a => a -> a -> Int
udistance ConstExpr
a1 ConstExpr
a2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ConstExpr -> ConstExpr -> Int
forall a. Distance a => a -> a -> Int
udistance ConstExpr
b1 ConstExpr
b2
instance Distance Port where
distance :: Port -> Port -> Int
distance (Port PortType
t1 Bool
s1 Range
r1 Identifier
_) (Port PortType
t2 Bool
s2 Range
r2 Identifier
_) =
PortType -> PortType -> Int
forall a. Distance a => a -> a -> Int
distance PortType
t1 PortType
t2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Bool -> Int
forall a. Distance a => a -> a -> Int
distance Bool
s1 Bool
s2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Range -> Range -> Int
forall a. Distance a => a -> a -> Int
distance Range
r1 Range
r2
udistance :: Port -> Port -> Int
udistance (Port PortType
t1 Bool
s1 Range
r1 Identifier
_) (Port PortType
t2 Bool
s2 Range
r2 Identifier
_) =
PortType -> PortType -> Int
forall a. Distance a => a -> a -> Int
udistance PortType
t1 PortType
t2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Bool -> Int
forall a. Distance a => a -> a -> Int
udistance Bool
s1 Bool
s2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Range -> Range -> Int
forall a. Distance a => a -> a -> Int
udistance Range
r1 Range
r2
dempty :: Port -> Int
dempty (Port PortType
t1 Bool
s1 Range
r1 Identifier
_) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PortType -> Int
forall a. Distance a => a -> Int
dempty PortType
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Int
forall a. Distance a => a -> Int
dempty Bool
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Range -> Int
forall a. Distance a => a -> Int
dempty Range
r1
instance Distance (ModDecl a) where
distance :: ModDecl a -> ModDecl a -> Int
distance (ModDecl Identifier
_ [Port]
min1 [Port]
mout1 [ModItem a]
mis1 Bindings
mp1) (ModDecl Identifier
_ [Port]
min2 [Port]
mout2 [ModItem a]
mis2 Bindings
mp2) =
[Port] -> [Port] -> Int
forall a. Distance a => a -> a -> Int
distance [Port]
min1 [Port]
min2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Port] -> [Port] -> Int
forall a. Distance a => a -> a -> Int
distance [Port]
mout1 [Port]
mout2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ModItem a] -> [ModItem a] -> Int
forall a. Distance a => a -> a -> Int
distance [ModItem a]
mis1 [ModItem a]
mis2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bindings -> Bindings -> Int
forall a. Distance a => a -> a -> Int
distance Bindings
mp1 Bindings
mp2
udistance :: ModDecl a -> ModDecl a -> Int
udistance (ModDecl Identifier
_ [Port]
min1 [Port]
mout1 [ModItem a]
mis1 Bindings
mp1) (ModDecl Identifier
_ [Port]
min2 [Port]
mout2 [ModItem a]
mis2 Bindings
mp2) =
[Port] -> [Port] -> Int
forall a. Distance a => a -> a -> Int
udistance [Port]
min1 [Port]
min2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Port] -> [Port] -> Int
forall a. Distance a => a -> a -> Int
udistance [Port]
mout1 [Port]
mout2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ModItem a] -> [ModItem a] -> Int
forall a. Distance a => a -> a -> Int
udistance [ModItem a]
mis1 [ModItem a]
mis2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bindings -> Bindings -> Int
forall a. Distance a => a -> a -> Int
udistance Bindings
mp1 Bindings
mp2
dempty :: ModDecl a -> Int
dempty (ModDecl Identifier
_ [Port]
min [Port]
mout [ModItem a]
mis Bindings
mp) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Port] -> Int
forall a. Distance a => a -> Int
dempty [Port]
min Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Port] -> Int
forall a. Distance a => a -> Int
dempty [Port]
mout Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ModItem a] -> Int
forall a. Distance a => a -> Int
dempty [ModItem a]
mis Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bindings -> Int
forall a. Distance a => a -> Int
dempty Bindings
mp
instance Distance (Verilog a) where
distance :: Verilog a -> Verilog a -> Int
distance (Verilog [ModDecl a]
m1) (Verilog [ModDecl a]
m2) = [ModDecl a] -> [ModDecl a] -> Int
forall a. Distance a => a -> a -> Int
distance [ModDecl a]
m1 [ModDecl a]
m2
udistance :: Verilog a -> Verilog a -> Int
udistance (Verilog [ModDecl a]
m1) (Verilog [ModDecl a]
m2) = [ModDecl a] -> [ModDecl a] -> Int
forall a. Distance a => a -> a -> Int
udistance [ModDecl a]
m1 [ModDecl a]
m2
dempty :: Verilog a -> Int
dempty (Verilog [ModDecl a]
m) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ModDecl a] -> Int
forall a. Distance a => a -> Int
dempty [ModDecl a]
m
instance Distance (SourceInfo a) where
distance :: SourceInfo a -> SourceInfo a -> Int
distance (SourceInfo Text
_ Verilog a
v1) (SourceInfo Text
_ Verilog a
v2) = Verilog a -> Verilog a -> Int
forall a. Distance a => a -> a -> Int
distance Verilog a
v1 Verilog a
v2
udistance :: SourceInfo a -> SourceInfo a -> Int
udistance (SourceInfo Text
_ Verilog a
v1) (SourceInfo Text
_ Verilog a
v2) = Verilog a -> Verilog a -> Int
forall a. Distance a => a -> a -> Int
udistance Verilog a
v1 Verilog a
v2
dempty :: SourceInfo a -> Int
dempty (SourceInfo Text
_ Verilog a
v) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Verilog a -> Int
forall a. Distance a => a -> Int
dempty Verilog a
v