{-# LANGUAGE Safe #-}
---------------------------------------------------------------
-- Colin Runciman and Andy Gill, June 2006
---------------------------------------------------------------

-- | Datatypes and file-access routines for the per-module (@.mix@)
-- indexes used by Hpc.
module Trace.Hpc.Mix
        ( Mix(..)
        , MixEntry
        , BoxLabel(..)
        , CondBox(..)
        , mixCreate
        , readMix
        , createMixEntryDom
        , MixEntryDom
        )
  where

import Data.List (intercalate)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Time (UTCTime)
import Data.Tree
import Text.Read (readMaybe)

import System.FilePath

-- a module index records the attributes of each tick-box that has
-- been introduced in that module, accessed by tick-number position
-- in the list

import Trace.Hpc.Util (HpcPos, insideHpcPos, Hash, HpcHash(..), catchIO)
import Trace.Hpc.Tix

-- | 'Mix' is the information about a modules static properties, like
-- location of Tix's in a file.
--
-- Tab stops are the size of a tab in the provided /line:column/ values.
--
--  * In GHC, this is 1 (a tab is just a character)
--  * With @hpc-tracer@, this is 8 (a tab represents several spaces).
data Mix = Mix
             FilePath           -- location of original file
             UTCTime            -- time of original file's last update
             Hash               -- hash of mix entry + timestamp
             Int                -- tab stop value.
             [MixEntry]         -- entries
        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
$cshowsPrec :: Int -> Mix -> ShowS
showsPrec :: Int -> Mix -> ShowS
$cshow :: Mix -> String
show :: Mix -> String
$cshowList :: [Mix] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS Mix
readsPrec :: Int -> ReadS Mix
$creadList :: ReadS [Mix]
readList :: ReadS [Mix]
$creadPrec :: ReadPrec Mix
readPrec :: ReadPrec Mix
$creadListPrec :: ReadPrec [Mix]
readListPrec :: ReadPrec [Mix]
Read,Mix -> Mix -> Bool
(Mix -> Mix -> Bool) -> (Mix -> Mix -> Bool) -> Eq Mix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mix -> Mix -> Bool
== :: Mix -> Mix -> Bool
$c/= :: Mix -> Mix -> Bool
/= :: Mix -> Mix -> Bool
Eq)

type MixEntry = (HpcPos, BoxLabel)

data BoxLabel = ExpBox  Bool -- isAlt
              | 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
$creadsPrec :: Int -> ReadS BoxLabel
readsPrec :: Int -> ReadS BoxLabel
$creadList :: ReadS [BoxLabel]
readList :: ReadS [BoxLabel]
$creadPrec :: ReadPrec BoxLabel
readPrec :: ReadPrec BoxLabel
$creadListPrec :: ReadPrec [BoxLabel]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> BoxLabel -> ShowS
showsPrec :: Int -> BoxLabel -> ShowS
$cshow :: BoxLabel -> String
show :: BoxLabel -> String
$cshowList :: [BoxLabel] -> ShowS
showList :: [BoxLabel] -> ShowS
Show, BoxLabel -> BoxLabel -> Bool
(BoxLabel -> BoxLabel -> Bool)
-> (BoxLabel -> BoxLabel -> Bool) -> Eq BoxLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoxLabel -> BoxLabel -> Bool
== :: BoxLabel -> BoxLabel -> Bool
$c/= :: BoxLabel -> BoxLabel -> Bool
/= :: 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
$ccompare :: BoxLabel -> BoxLabel -> Ordering
compare :: BoxLabel -> BoxLabel -> Ordering
$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
>= :: BoxLabel -> BoxLabel -> Bool
$cmax :: BoxLabel -> BoxLabel -> BoxLabel
max :: BoxLabel -> BoxLabel -> BoxLabel
$cmin :: BoxLabel -> BoxLabel -> BoxLabel
min :: BoxLabel -> BoxLabel -> BoxLabel
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
$creadsPrec :: Int -> ReadS CondBox
readsPrec :: Int -> ReadS CondBox
$creadList :: ReadS [CondBox]
readList :: ReadS [CondBox]
$creadPrec :: ReadPrec CondBox
readPrec :: ReadPrec CondBox
$creadListPrec :: ReadPrec [CondBox]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> CondBox -> ShowS
showsPrec :: Int -> CondBox -> ShowS
$cshow :: CondBox -> String
show :: CondBox -> String
$cshowList :: [CondBox] -> ShowS
showList :: [CondBox] -> ShowS
Show, CondBox -> CondBox -> Bool
(CondBox -> CondBox -> Bool)
-> (CondBox -> CondBox -> Bool) -> Eq CondBox
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CondBox -> CondBox -> Bool
== :: CondBox -> CondBox -> Bool
$c/= :: CondBox -> CondBox -> Bool
/= :: 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
$ccompare :: CondBox -> CondBox -> Ordering
compare :: CondBox -> CondBox -> Ordering
$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
>= :: CondBox -> CondBox -> Bool
$cmax :: CondBox -> CondBox -> CondBox
max :: CondBox -> CondBox -> CondBox
$cmin :: CondBox -> CondBox -> CondBox
min :: CondBox -> CondBox -> CondBox
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


-- | Write a mix file to disk.
-- 
-- The following command creates the mix file under the location "\/home\/user\/main\/Main.mix"
--
-- > mixCreate "/home/user/main" "Main" mix

mixCreate :: FilePath -- ^ Name of the target directory.
          -> String -- ^ Name of the module for which the mix file is created.
          -> Mix    -- ^ The Mix data structure.
          -> 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)

-- | Read a mix file.
readMix :: [FilePath]                 -- ^ Dir Names
        -> Either String TixModule  -- ^ module wanted
        -> 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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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 a b. (a -> b) -> IO a -> IO b
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 a. a -> IO a
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 -- Bypass hash check
                            Right TixModule
tix -> Maybe Mix -> IO (Maybe Mix)
forall a. a -> IO a
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 a. a -> IO a
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 : tl :: [Mix]
tl@(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]
tl ->
              -- Only complain if multiple *different* `Mix` files with the
              -- same name are found (#9619).
              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 a. [a] -> 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 a. a -> IO a
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"

-- | Check that hash in .tix and .mix file match.
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)

-- A good tree has all its children fully inside its parents HpcPos.
-- No child should have the *same* HpcPos.
-- There is no ordering to the children

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

-- all sub-trees are good trees, and no two HpcPos are inside each other.
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 a. [a] -> 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
     -- The case where we have a new HpcPos range
     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 a. [a] -> 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
     -- The case where we are recursing into a tree
     -- Note we can recurse down many branches, in the case of
     -- overlapping ranges.
     -- Assumes we have captures the new HpcPos
     -- (or the above conditional would be true)
     then [ if Bool
i_am_inside  -- or the same as
            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
     -- The case of a super-range.
     ( (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 a b. (a -> b -> b) -> b -> [a] -> b
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