{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 709
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
module Trace.Hpc.Mix
( Mix(..)
, MixEntry
, BoxLabel(..)
, CondBox(..)
, mixCreate
, readMix
, createMixEntryDom
, MixEntryDom
)
where
import Data.List
import Data.Maybe (catMaybes, fromMaybe)
import Data.Time (UTCTime)
import Data.Tree
#if MIN_VERSION_base(4,6,0)
import Text.Read (readMaybe)
#else
import Data.Char (isSpace)
#endif
import System.FilePath
import Trace.Hpc.Util (HpcPos, insideHpcPos, Hash, HpcHash(..), catchIO)
import Trace.Hpc.Tix
#if !MIN_VERSION_base(4,6,0)
readMaybe :: Read a => String -> Maybe a
readMaybe s = case reads s of
[(x, s')] | all isSpace s' -> Just x
_ -> Nothing
#endif
data Mix = Mix
FilePath
UTCTime
Hash
Int
[MixEntry]
deriving (Int -> Mix -> ShowS
[Mix] -> ShowS
Mix -> String
(Int -> Mix -> ShowS)
-> (Mix -> String) -> ([Mix] -> ShowS) -> Show Mix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mix] -> ShowS
$cshowList :: [Mix] -> ShowS
show :: Mix -> String
$cshow :: Mix -> String
showsPrec :: Int -> Mix -> ShowS
$cshowsPrec :: Int -> Mix -> ShowS
Show,ReadPrec [Mix]
ReadPrec Mix
Int -> ReadS Mix
ReadS [Mix]
(Int -> ReadS Mix)
-> ReadS [Mix] -> ReadPrec Mix -> ReadPrec [Mix] -> Read Mix
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Mix]
$creadListPrec :: ReadPrec [Mix]
readPrec :: ReadPrec Mix
$creadPrec :: ReadPrec Mix
readList :: ReadS [Mix]
$creadList :: ReadS [Mix]
readsPrec :: Int -> ReadS Mix
$creadsPrec :: Int -> ReadS Mix
Read,Mix -> Mix -> Bool
(Mix -> Mix -> Bool) -> (Mix -> Mix -> Bool) -> Eq Mix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mix -> Mix -> Bool
$c/= :: Mix -> Mix -> Bool
== :: Mix -> Mix -> Bool
$c== :: Mix -> Mix -> Bool
Eq)
type MixEntry = (HpcPos, BoxLabel)
data BoxLabel = ExpBox Bool
| TopLevelBox [String]
| LocalBox [String]
| BinBox CondBox Bool
deriving (ReadPrec [BoxLabel]
ReadPrec BoxLabel
Int -> ReadS BoxLabel
ReadS [BoxLabel]
(Int -> ReadS BoxLabel)
-> ReadS [BoxLabel]
-> ReadPrec BoxLabel
-> ReadPrec [BoxLabel]
-> Read BoxLabel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BoxLabel]
$creadListPrec :: ReadPrec [BoxLabel]
readPrec :: ReadPrec BoxLabel
$creadPrec :: ReadPrec BoxLabel
readList :: ReadS [BoxLabel]
$creadList :: ReadS [BoxLabel]
readsPrec :: Int -> ReadS BoxLabel
$creadsPrec :: Int -> ReadS BoxLabel
Read, Int -> BoxLabel -> ShowS
[BoxLabel] -> ShowS
BoxLabel -> String
(Int -> BoxLabel -> ShowS)
-> (BoxLabel -> String) -> ([BoxLabel] -> ShowS) -> Show BoxLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoxLabel] -> ShowS
$cshowList :: [BoxLabel] -> ShowS
show :: BoxLabel -> String
$cshow :: BoxLabel -> String
showsPrec :: Int -> BoxLabel -> ShowS
$cshowsPrec :: Int -> BoxLabel -> ShowS
Show, BoxLabel -> BoxLabel -> Bool
(BoxLabel -> BoxLabel -> Bool)
-> (BoxLabel -> BoxLabel -> Bool) -> Eq BoxLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoxLabel -> BoxLabel -> Bool
$c/= :: BoxLabel -> BoxLabel -> Bool
== :: BoxLabel -> BoxLabel -> Bool
$c== :: BoxLabel -> BoxLabel -> Bool
Eq, Eq BoxLabel
Eq BoxLabel
-> (BoxLabel -> BoxLabel -> Ordering)
-> (BoxLabel -> BoxLabel -> Bool)
-> (BoxLabel -> BoxLabel -> Bool)
-> (BoxLabel -> BoxLabel -> Bool)
-> (BoxLabel -> BoxLabel -> Bool)
-> (BoxLabel -> BoxLabel -> BoxLabel)
-> (BoxLabel -> BoxLabel -> BoxLabel)
-> Ord BoxLabel
BoxLabel -> BoxLabel -> Bool
BoxLabel -> BoxLabel -> Ordering
BoxLabel -> BoxLabel -> BoxLabel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BoxLabel -> BoxLabel -> BoxLabel
$cmin :: BoxLabel -> BoxLabel -> BoxLabel
max :: BoxLabel -> BoxLabel -> BoxLabel
$cmax :: BoxLabel -> BoxLabel -> BoxLabel
>= :: BoxLabel -> BoxLabel -> Bool
$c>= :: BoxLabel -> BoxLabel -> Bool
> :: BoxLabel -> BoxLabel -> Bool
$c> :: BoxLabel -> BoxLabel -> Bool
<= :: BoxLabel -> BoxLabel -> Bool
$c<= :: BoxLabel -> BoxLabel -> Bool
< :: BoxLabel -> BoxLabel -> Bool
$c< :: BoxLabel -> BoxLabel -> Bool
compare :: BoxLabel -> BoxLabel -> Ordering
$ccompare :: BoxLabel -> BoxLabel -> Ordering
Ord)
data CondBox = GuardBinBox
| CondBinBox
| QualBinBox
deriving (ReadPrec [CondBox]
ReadPrec CondBox
Int -> ReadS CondBox
ReadS [CondBox]
(Int -> ReadS CondBox)
-> ReadS [CondBox]
-> ReadPrec CondBox
-> ReadPrec [CondBox]
-> Read CondBox
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CondBox]
$creadListPrec :: ReadPrec [CondBox]
readPrec :: ReadPrec CondBox
$creadPrec :: ReadPrec CondBox
readList :: ReadS [CondBox]
$creadList :: ReadS [CondBox]
readsPrec :: Int -> ReadS CondBox
$creadsPrec :: Int -> ReadS CondBox
Read, Int -> CondBox -> ShowS
[CondBox] -> ShowS
CondBox -> String
(Int -> CondBox -> ShowS)
-> (CondBox -> String) -> ([CondBox] -> ShowS) -> Show CondBox
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CondBox] -> ShowS
$cshowList :: [CondBox] -> ShowS
show :: CondBox -> String
$cshow :: CondBox -> String
showsPrec :: Int -> CondBox -> ShowS
$cshowsPrec :: Int -> CondBox -> ShowS
Show, CondBox -> CondBox -> Bool
(CondBox -> CondBox -> Bool)
-> (CondBox -> CondBox -> Bool) -> Eq CondBox
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CondBox -> CondBox -> Bool
$c/= :: CondBox -> CondBox -> Bool
== :: CondBox -> CondBox -> Bool
$c== :: CondBox -> CondBox -> Bool
Eq, Eq CondBox
Eq CondBox
-> (CondBox -> CondBox -> Ordering)
-> (CondBox -> CondBox -> Bool)
-> (CondBox -> CondBox -> Bool)
-> (CondBox -> CondBox -> Bool)
-> (CondBox -> CondBox -> Bool)
-> (CondBox -> CondBox -> CondBox)
-> (CondBox -> CondBox -> CondBox)
-> Ord CondBox
CondBox -> CondBox -> Bool
CondBox -> CondBox -> Ordering
CondBox -> CondBox -> CondBox
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CondBox -> CondBox -> CondBox
$cmin :: CondBox -> CondBox -> CondBox
max :: CondBox -> CondBox -> CondBox
$cmax :: CondBox -> CondBox -> CondBox
>= :: CondBox -> CondBox -> Bool
$c>= :: CondBox -> CondBox -> Bool
> :: CondBox -> CondBox -> Bool
$c> :: CondBox -> CondBox -> Bool
<= :: CondBox -> CondBox -> Bool
$c<= :: CondBox -> CondBox -> Bool
< :: CondBox -> CondBox -> Bool
$c< :: CondBox -> CondBox -> Bool
compare :: CondBox -> CondBox -> Ordering
$ccompare :: CondBox -> CondBox -> Ordering
Ord)
instance HpcHash BoxLabel where
toHash :: BoxLabel -> Hash
toHash (ExpBox Bool
b) = Hash
0x100 Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
+ Bool -> Hash
forall a. HpcHash a => a -> Hash
toHash Bool
b
toHash (TopLevelBox [String]
nm) = Hash
0x200 Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
+ [String] -> Hash
forall a. HpcHash a => a -> Hash
toHash [String]
nm
toHash (LocalBox [String]
nm) = Hash
0x300 Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
+ [String] -> Hash
forall a. HpcHash a => a -> Hash
toHash [String]
nm
toHash (BinBox CondBox
cond Bool
b) = Hash
0x400 Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
+ (CondBox, Bool) -> Hash
forall a. HpcHash a => a -> Hash
toHash (CondBox
cond,Bool
b)
instance HpcHash CondBox where
toHash :: CondBox -> Hash
toHash CondBox
GuardBinBox = Hash
0x10
toHash CondBox
CondBinBox = Hash
0x20
toHash CondBox
QualBinBox = Hash
0x30
mixCreate :: String
-> String
-> Mix
-> IO ()
mixCreate :: String -> String -> Mix -> IO ()
mixCreate String
dirName String
modName Mix
mix =
String -> String -> IO ()
writeFile (String -> ShowS
mixName String
dirName String
modName) (Mix -> String
forall a. Show a => a -> String
show Mix
mix)
readMix :: [String]
-> Either String TixModule
-> IO Mix
readMix :: [String] -> Either String TixModule -> IO Mix
readMix [String]
dirNames Either String TixModule
mod' = do
let modName :: String
modName = ShowS -> (TixModule -> String) -> Either String TixModule -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ShowS
forall a. a -> a
id TixModule -> String
tixModuleName Either String TixModule
mod'
[Maybe Mix]
res <- [IO (Maybe Mix)] -> IO [Maybe Mix]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ (do let mixPath :: String
mixPath = String -> ShowS
mixName String
dirName String
modName
parseError :: a
parseError = String -> a
forall a. HasCallStack => String -> a
error (String
"can not parse " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mixPath)
parse :: String -> Mix
parse = Mix -> Maybe Mix -> Mix
forall a. a -> Maybe a -> a
fromMaybe Mix
forall {a}. a
parseError (Maybe Mix -> Mix) -> (String -> Maybe Mix) -> String -> Mix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Mix
forall a. Read a => String -> Maybe a
readMaybe
Mix
mix <- String -> Mix
parse (String -> Mix) -> IO String -> IO Mix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO String
readFile String
mixPath
case Either String TixModule
mod' of
Left String
_ -> Maybe Mix -> IO (Maybe Mix)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Mix -> IO (Maybe Mix)) -> Maybe Mix -> IO (Maybe Mix)
forall a b. (a -> b) -> a -> b
$ Mix -> Maybe Mix
forall a. a -> Maybe a
Just Mix
mix
Right TixModule
tix -> Maybe Mix -> IO (Maybe Mix)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Mix -> IO (Maybe Mix)) -> Maybe Mix -> IO (Maybe Mix)
forall a b. (a -> b) -> a -> b
$ TixModule -> Mix -> String -> Maybe Mix
checkHash TixModule
tix Mix
mix String
mixPath)
IO (Maybe Mix) -> (IOException -> IO (Maybe Mix)) -> IO (Maybe Mix)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\ IOException
_ -> Maybe Mix -> IO (Maybe Mix)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Mix -> IO (Maybe Mix)) -> Maybe Mix -> IO (Maybe Mix)
forall a b. (a -> b) -> a -> b
$ Maybe Mix
forall a. Maybe a
Nothing)
| String
dirName <- [String]
dirNames
]
case [Maybe Mix] -> [Mix]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Mix]
res of
xs :: [Mix]
xs@(Mix
x:Mix
_:[Mix]
_) | (Mix -> Bool) -> [Mix] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Mix -> Mix -> Bool
forall a. Eq a => a -> a -> Bool
/= Mix
x) ([Mix] -> [Mix]
forall a. [a] -> [a]
tail [Mix]
xs) ->
String -> IO Mix
forall a. HasCallStack => String -> a
error (String -> IO Mix) -> String -> IO Mix
forall a b. (a -> b) -> a -> b
$ String
"found " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show([Mix] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mix]
xs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" different instances of "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
modName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
dirNames
(Mix
x:[Mix]
_) -> Mix -> IO Mix
forall (m :: * -> *) a. Monad m => a -> m a
return Mix
x
[Mix]
_ -> String -> IO Mix
forall a. HasCallStack => String -> a
error (String -> IO Mix) -> String -> IO Mix
forall a b. (a -> b) -> a -> b
$ String
"can not find "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
modName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
dirNames
mixName :: FilePath -> String -> String
mixName :: String -> ShowS
mixName String
dirName String
name = String
dirName String -> ShowS
</> String
name String -> ShowS
<.> String
"mix"
checkHash :: TixModule -> Mix -> FilePath -> Maybe Mix
checkHash :: TixModule -> Mix -> String -> Maybe Mix
checkHash TixModule
tix mix :: Mix
mix@(Mix String
_ UTCTime
_ Hash
mixHash Int
_ [MixEntry]
_) String
mixPath
| Hash
modHash Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
mixHash = Mix -> Maybe Mix
forall a. a -> Maybe a
Just Mix
mix
| Bool
otherwise = String -> Maybe Mix
forall a. HasCallStack => String -> a
error (String -> Maybe Mix) -> String -> Maybe Mix
forall a b. (a -> b) -> a -> b
$
String
"hash in tix file for module " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
modName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Hash -> String
forall a. Show a => a -> String
show Hash
modHash String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"does not match hash in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mixPath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Hash -> String
forall a. Show a => a -> String
show Hash
mixHash String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
where
modName :: String
modName = TixModule -> String
tixModuleName TixModule
tix
modHash :: Hash
modHash = TixModule -> Hash
tixModuleHash TixModule
tix
type MixEntryDom a = Tree (HpcPos,a)
isGoodNode :: MixEntryDom a -> Bool
isGoodNode :: forall a. MixEntryDom a -> Bool
isGoodNode (Node (HpcPos
pos,a
_) [Tree (HpcPos, a)]
sub_nodes) =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ HpcPos
pos' HpcPos -> HpcPos -> Bool
`insideHpcPos` HpcPos
pos | Node(HpcPos
pos',a
_) [Tree (HpcPos, a)]
_ <- [Tree (HpcPos, a)]
sub_nodes ]
Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ HpcPos
pos' HpcPos -> HpcPos -> Bool
forall a. Eq a => a -> a -> Bool
/= HpcPos
pos | Node(HpcPos
pos',a
_) [Tree (HpcPos, a)]
_ <- [Tree (HpcPos, a)]
sub_nodes ]
Bool -> Bool -> Bool
&& [Tree (HpcPos, a)] -> Bool
forall a. [MixEntryDom a] -> Bool
isGoodForest [Tree (HpcPos, a)]
sub_nodes
isGoodForest :: [MixEntryDom a] -> Bool
isGoodForest :: forall a. [MixEntryDom a] -> Bool
isGoodForest [MixEntryDom a]
sub_nodes =
(MixEntryDom a -> Bool) -> [MixEntryDom a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all MixEntryDom a -> Bool
forall a. MixEntryDom a -> Bool
isGoodNode [MixEntryDom a]
sub_nodes
Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not (HpcPos
pos1 HpcPos -> HpcPos -> Bool
`insideHpcPos` HpcPos
pos2 Bool -> Bool -> Bool
||
HpcPos
pos2 HpcPos -> HpcPos -> Bool
`insideHpcPos` HpcPos
pos1)
| (Node (HpcPos
pos1,a
_) [MixEntryDom a]
_,Int
n1) <- [MixEntryDom a] -> [Int] -> [(MixEntryDom a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [MixEntryDom a]
sub_nodes [Int
0..]
, (Node (HpcPos
pos2,a
_) [MixEntryDom a]
_,Int
n2) <- [MixEntryDom a] -> [Int] -> [(MixEntryDom a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [MixEntryDom a]
sub_nodes [Int
0..]
, (Int
n1 :: Int) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n2 ]
addNodeToTree :: (Show a) => (HpcPos,a) -> MixEntryDom [a] -> MixEntryDom [a]
addNodeToTree :: forall a.
Show a =>
(HpcPos, a) -> MixEntryDom [a] -> MixEntryDom [a]
addNodeToTree (HpcPos
new_pos,a
new_a) (Node (HpcPos
pos,[a]
a) [Tree (HpcPos, [a])]
children)
| HpcPos
pos HpcPos -> HpcPos -> Bool
forall a. Eq a => a -> a -> Bool
== HpcPos
new_pos = (HpcPos, [a]) -> [Tree (HpcPos, [a])] -> Tree (HpcPos, [a])
forall a. a -> [Tree a] -> Tree a
Node (HpcPos
pos,a
new_a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
a) [Tree (HpcPos, [a])]
children
| HpcPos
new_pos HpcPos -> HpcPos -> Bool
`insideHpcPos` HpcPos
pos =
(HpcPos, [a]) -> [Tree (HpcPos, [a])] -> Tree (HpcPos, [a])
forall a. a -> [Tree a] -> Tree a
Node (HpcPos
pos,[a]
a) ((HpcPos, a) -> [Tree (HpcPos, [a])] -> [Tree (HpcPos, [a])]
forall a.
Show a =>
(HpcPos, a) -> [MixEntryDom [a]] -> [MixEntryDom [a]]
addNodeToList (HpcPos
new_pos,a
new_a) [Tree (HpcPos, [a])]
children)
| HpcPos
pos HpcPos -> HpcPos -> Bool
`insideHpcPos` HpcPos
new_pos =
String -> Tree (HpcPos, [a])
forall a. HasCallStack => String -> a
error String
"precondition not met inside addNodeToNode"
| Bool
otherwise = String -> Tree (HpcPos, [a])
forall a. HasCallStack => String -> a
error String
"something impossible happened in addNodeToTree"
addNodeToList :: Show a => (HpcPos,a) -> [MixEntryDom [a]] -> [MixEntryDom [a]]
addNodeToList :: forall a.
Show a =>
(HpcPos, a) -> [MixEntryDom [a]] -> [MixEntryDom [a]]
addNodeToList (HpcPos
new_pos,a
new_a) [MixEntryDom [a]]
entries
| Bool
otherwise =
if [()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ ()
| (Bool
am_inside,Bool
am_outside,MixEntryDom [a]
_) <- [(Bool, Bool, MixEntryDom [a])]
entries'
, Bool
am_inside Bool -> Bool -> Bool
|| Bool
am_outside
] Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then (HpcPos, [a]) -> [MixEntryDom [a]] -> MixEntryDom [a]
forall a. a -> [Tree a] -> Tree a
Node (HpcPos
new_pos,[a
new_a]) [] MixEntryDom [a] -> [MixEntryDom [a]] -> [MixEntryDom [a]]
forall a. a -> [a] -> [a]
: [MixEntryDom [a]]
entries else
if [()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ ()
| (Bool
am_inside,Bool
_,MixEntryDom [a]
_) <- [(Bool, Bool, MixEntryDom [a])]
entries'
, Bool
am_inside
] Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then [ if Bool
i_am_inside
then (HpcPos, a) -> MixEntryDom [a] -> MixEntryDom [a]
forall a.
Show a =>
(HpcPos, a) -> MixEntryDom [a] -> MixEntryDom [a]
addNodeToTree (HpcPos
new_pos,a
new_a) MixEntryDom [a]
node
else MixEntryDom [a]
node
| (Bool
i_am_inside,Bool
_,MixEntryDom [a]
node) <- [(Bool, Bool, MixEntryDom [a])]
entries'
] else
( (HpcPos, [a]) -> [MixEntryDom [a]] -> MixEntryDom [a]
forall a. a -> [Tree a] -> Tree a
Node (HpcPos
new_pos,[a
new_a])
[ MixEntryDom [a]
node | (Bool
_,Bool
True,MixEntryDom [a]
node) <- [(Bool, Bool, MixEntryDom [a])]
entries' ] MixEntryDom [a] -> [MixEntryDom [a]] -> [MixEntryDom [a]]
forall a. a -> [a] -> [a]
:
[ MixEntryDom [a]
node | (Bool
_,Bool
False,MixEntryDom [a]
node) <- [(Bool, Bool, MixEntryDom [a])]
entries' ]
)
where
entries' :: [(Bool, Bool, MixEntryDom [a])]
entries' = [ ( HpcPos
new_pos HpcPos -> HpcPos -> Bool
`insideHpcPos` HpcPos
pos
, HpcPos
pos HpcPos -> HpcPos -> Bool
`insideHpcPos` HpcPos
new_pos
, MixEntryDom [a]
node)
| node :: MixEntryDom [a]
node@(Node (HpcPos
pos,[a]
_) [MixEntryDom [a]]
_) <- [MixEntryDom [a]]
entries
]
createMixEntryDom :: (Show a) => [(HpcPos,a)] -> [MixEntryDom [a]]
createMixEntryDom :: forall a. Show a => [(HpcPos, a)] -> [MixEntryDom [a]]
createMixEntryDom [(HpcPos, a)]
entries
| [MixEntryDom [a]] -> Bool
forall a. [MixEntryDom a] -> Bool
isGoodForest [MixEntryDom [a]]
forest = [MixEntryDom [a]]
forest
| Bool
otherwise = String -> [MixEntryDom [a]]
forall a. HasCallStack => String -> a
error String
"createMixEntryDom: bad forest"
where forest :: [MixEntryDom [a]]
forest = ((HpcPos, a) -> [MixEntryDom [a]] -> [MixEntryDom [a]])
-> [MixEntryDom [a]] -> [(HpcPos, a)] -> [MixEntryDom [a]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (HpcPos, a) -> [MixEntryDom [a]] -> [MixEntryDom [a]]
forall a.
Show a =>
(HpcPos, a) -> [MixEntryDom [a]] -> [MixEntryDom [a]]
addNodeToList [] [(HpcPos, a)]
entries