{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 709
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
---------------------------------------------------------------
-- 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
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

-- 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

#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

-- | '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
showList :: [Mix] -> ShowS
$cshowList :: [Mix] -> ShowS
show :: Mix -> String
$cshow :: Mix -> String
showsPrec :: Int -> Mix -> ShowS
$cshowsPrec :: Int -> Mix -> ShowS
External instance of the constraint type Show HpcPos
Instance of class: Show of the constraint type Show BoxLabel
External instance of the constraint type Show HpcPos
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show Char
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show HpcPos
Instance of class: Show of the constraint type Show BoxLabel
External instance of the constraint type Show UTCTime
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
External instance of the constraint type Show Int
External instance of the constraint type Show Hash
Instance of class: Show of the constraint type Show BoxLabel
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
External instance of the constraint type Read HpcPos
Instance of class: Read of the constraint type Read BoxLabel
External instance of the constraint type Read HpcPos
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type Read Char
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type Read HpcPos
Instance of class: Read of the constraint type Read BoxLabel
External instance of the constraint type Read Int
External instance of the constraint type Read Hash
External instance of the constraint type Read UTCTime
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read BoxLabel
Instance of class: Read of the constraint type Read 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
External instance of the constraint type Eq HpcPos
Instance of class: Eq of the constraint type Eq BoxLabel
External instance of the constraint type Eq HpcPos
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
External instance of the constraint type Eq Char
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
External instance of the constraint type Eq HpcPos
Instance of class: Eq of the constraint type Eq BoxLabel
External instance of the constraint type Eq Int
External instance of the constraint type Eq UTCTime
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Hash
Instance of class: Eq of the constraint type Eq BoxLabel
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
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
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type Read Bool
External instance of the constraint type Read Bool
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read CondBox
Instance of class: Read of the constraint type Read 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
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type Show Bool
External instance of the constraint type Show Bool
External instance of the constraint type Ord Int
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show CondBox
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
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type Eq Bool
External instance of the constraint type Eq Bool
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
Instance of class: Eq of the constraint type Eq CondBox
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
External instance of the constraint type Ord Char
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
External instance of the constraint type Ord Bool
External instance of the constraint type Ord Bool
Instance of class: Eq of the constraint type Eq BoxLabel
Instance of class: Ord of the constraint type Ord CondBox
Instance of class: Eq of the constraint type Eq 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
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
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read 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
Instance of class: Eq of the constraint type Eq CondBox
Instance of class: Ord of the constraint type Ord CondBox
Instance of class: Eq of the constraint type Eq 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
External instance of the constraint type Num Hash
+ Bool -> Hash
forall a. HpcHash a => a -> Hash
External instance of the constraint type HpcHash Bool
toHash Bool
b
   toHash (TopLevelBox [String]
nm) = Hash
0x200 Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
External instance of the constraint type Num Hash
+ [String] -> Hash
forall a. HpcHash a => a -> Hash
External instance of the constraint type forall a. HpcHash a => HpcHash [a]
External instance of the constraint type forall a. HpcHash a => HpcHash [a]
External instance of the constraint type HpcHash Char
toHash [String]
nm
   toHash (LocalBox [String]
nm)    = Hash
0x300 Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
External instance of the constraint type Num Hash
+ [String] -> Hash
forall a. HpcHash a => a -> Hash
External instance of the constraint type forall a. HpcHash a => HpcHash [a]
External instance of the constraint type forall a. HpcHash a => HpcHash [a]
External instance of the constraint type HpcHash Char
toHash [String]
nm
   toHash (BinBox CondBox
cond Bool
b)  = Hash
0x400 Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
External instance of the constraint type Num Hash
+ (CondBox, Bool) -> Hash
forall a. HpcHash a => a -> Hash
External instance of the constraint type forall a b. (HpcHash a, HpcHash b) => HpcHash (a, b)
Instance of class: HpcHash of the constraint type HpcHash CondBox
External instance of the constraint type HpcHash Bool
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


-- | Create is mix file.
mixCreate :: String -- ^ Dir Name
          -> String -- ^ module Name
          -> Mix    -- ^ Mix DataStructure
          -> 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
Instance of class: Show of the constraint type Show Mix
show Mix
mix)

-- | Read a mix file.
readMix :: [String]                 -- ^ 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)
External instance of the constraint type Monad IO
External instance of the constraint type Traversable []
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
Instance of class: Read of the constraint type Read Mix
readMaybe
                         Mix
mix <- String -> Mix
parse (String -> Mix) -> IO String -> IO Mix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
`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
External instance of the constraint type Monad IO
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 (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type Monad IO
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
External instance of the constraint type Foldable []
any (Mix -> Mix -> Bool
forall a. Eq a => a -> a -> Bool
Instance of class: Eq of the constraint type Eq Mix
/= Mix
x) ([Mix] -> [Mix]
forall a. [a] -> [a]
tail [Mix]
xs) ->
              -- 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
External instance of the constraint type Show Int
show([Mix] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
External instance of the constraint type Foldable []
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
External instance of the constraint type Monad IO
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
External instance of the constraint type Eq Hash
== 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
External instance of the constraint type Show Hash
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
External instance of the constraint type Show Hash
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 :: MixEntryDom a -> Bool
isGoodNode (Node (HpcPos
pos,a
_) Forest (HpcPos, a)
sub_nodes) =
      [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
External instance of the constraint type Foldable []
and [ HpcPos
pos' HpcPos -> HpcPos -> Bool
`insideHpcPos` HpcPos
pos  | Node(HpcPos
pos',a
_)  Forest (HpcPos, a)
_ <- Forest (HpcPos, a)
sub_nodes ]
   Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
External instance of the constraint type Foldable []
and [ HpcPos
pos' HpcPos -> HpcPos -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq HpcPos
/= HpcPos
pos | Node(HpcPos
pos',a
_) Forest (HpcPos, a)
_ <- Forest (HpcPos, a)
sub_nodes ]
   Bool -> Bool -> Bool
&& Forest (HpcPos, a) -> Bool
forall a. [MixEntryDom a] -> Bool
isGoodForest Forest (HpcPos, a)
sub_nodes

-- all sub-trees are good trees, and no two HpcPos are inside each other.
isGoodForest :: [MixEntryDom a] -> Bool
isGoodForest :: [MixEntryDom a] -> Bool
isGoodForest [MixEntryDom a]
sub_nodes =
   (MixEntryDom a -> Bool) -> [MixEntryDom a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
External instance of the constraint type Foldable []
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
External instance of the constraint type Foldable []
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
External instance of the constraint type Eq Int
/= Int
n2 ]

addNodeToTree :: (Show a) => (HpcPos,a) -> MixEntryDom [a] -> MixEntryDom [a]
addNodeToTree :: (HpcPos, a) -> MixEntryDom [a] -> MixEntryDom [a]
addNodeToTree (HpcPos
new_pos,a
new_a) (Node (HpcPos
pos,[a]
a) Forest (HpcPos, [a])
children)
  | HpcPos
pos HpcPos -> HpcPos -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq HpcPos
== HpcPos
new_pos = (HpcPos, [a]) -> Forest (HpcPos, [a]) -> MixEntryDom [a]
forall a. a -> Forest a -> Tree a
Node (HpcPos
pos,a
new_a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
a) Forest (HpcPos, [a])
children
  | HpcPos
new_pos HpcPos -> HpcPos -> Bool
`insideHpcPos` HpcPos
pos =
       (HpcPos, [a]) -> Forest (HpcPos, [a]) -> MixEntryDom [a]
forall a. a -> Forest a -> Tree a
Node (HpcPos
pos,[a]
a) ((HpcPos, a) -> Forest (HpcPos, [a]) -> Forest (HpcPos, [a])
forall a.
Show a =>
(HpcPos, a) -> [MixEntryDom [a]] -> [MixEntryDom [a]]
Evidence bound by a type signature of the constraint type Show a
addNodeToList (HpcPos
new_pos,a
new_a) Forest (HpcPos, [a])
children)
  | HpcPos
pos HpcPos -> HpcPos -> Bool
`insideHpcPos` HpcPos
new_pos =
       String -> MixEntryDom [a]
forall a. HasCallStack => String -> a
error String
"precondition not met inside addNodeToNode"
  | Bool
otherwise = String -> MixEntryDom [a]
forall a. HasCallStack => String -> a
error String
"something impossible happened in addNodeToTree"

addNodeToList :: Show a => (HpcPos,a) -> [MixEntryDom [a]] -> [MixEntryDom [a]]
addNodeToList :: (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
External instance of the constraint type Foldable []
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
External instance of the constraint type Eq Int
== Int
0
     -- The case where we have a new HpcPos range
     then (HpcPos, [a]) -> [MixEntryDom [a]] -> MixEntryDom [a]
forall a. a -> Forest 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
External instance of the constraint type Foldable []
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
External instance of the constraint type Ord Int
> 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]
Evidence bound by a type signature of the constraint type Show 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 -> Forest 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 :: [(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
External instance of the constraint type Foldable []
foldr (HpcPos, a) -> [MixEntryDom [a]] -> [MixEntryDom [a]]
forall a.
Show a =>
(HpcPos, a) -> [MixEntryDom [a]] -> [MixEntryDom [a]]
Evidence bound by a type signature of the constraint type Show a
addNodeToList [] [(HpcPos, a)]
entries