{-# LANGUAGE PartialTypeSignatures , FlexibleContexts, DeriveGeneric, StandaloneDeriving, StrictData #-}


module OutputGeneration.Metrics (
  num_of_instructions,
  num_of_unres_inds_in_cfg,
  num_of_blocks,
  num_of_edges, 
  mk_metrics
 ) where

import Base

import Data.SValue
import Data.SymbolicExpression

import Analysis.Context
import Analysis.Pointers 
import Analysis.ControlFlow


import OutputGeneration.Retrieval

import Generic.HasSize 
import Generic.Binary
import Generic.SymbolicConstituents
import Generic.Instruction

import X86.Opcode


import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Set as S
import Data.Aeson
import Data.ByteString.Lazy.Char8 (unpack)

import Data.Maybe (fromJust,catMaybes,mapMaybe)
import Data.List 
import Data.Foldable
import Data.Word
import Data.Int (Int64)

import System.IO.Unsafe (unsafePerformIO)

import GHC.Generics


metrics :: Map [Char] [Char]
metrics = [([Char], [Char])] -> Map [Char] [Char]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
  ([Char]
"#instructions",          [Char]
"number of covered instructions"),
  ([Char]
"avgInstructionSize",     [Char]
"average instruction size"),
  ([Char]
"#expectedInstructions",  [Char]
"expected number of instructions"),
  ([Char]
"%instructionCoverage",   [Char]
"estimate of percentage of covered instructions"),
  ([Char]
"#memWrites",             [Char]
"total number of instructions writing to memory"),
  ([Char]
"pointerDesignations",    [Char]
"A, C, C+U, U"),
  ([Char]
"specifityMetric",        [Char]
"weighted mean of pointer designations"),

  ([Char]
"#functions",             [Char]
"total number of functions"),
  ([Char]
"#functions_verified",    [Char]
"total number of verified functions"),
  ([Char]
"#functions_unresolved",  [Char]
"total number of functions with unresolved indirections"),
  ([Char]
"#functions_verif_error", [Char]
"total number of functions with verification error"),

  ([Char]
"#resolved_jumps",        [Char]
"total number of resolved jumps"),
  ([Char]
"#resolved_calls",        [Char]
"total number of resolved calls"),
  ([Char]
"#unresolved_jumps",      [Char]
"total number of unresolved jumps"),
  ([Char]
"#unresolved_calls",      [Char]
"total number of unresolved calls"),

  ([Char]
"runningTime",            [Char]
"Running time in HH:MM:SS")
 ]


-- | Returns all generated metrics in JSON and pretty-printed
mk_metrics :: Context -> (String,String)
mk_metrics :: Context -> ([Char], [Char])
mk_metrics Context
ctxt =
  let instrs :: [Instruction]
instrs                          = Set Instruction -> [Instruction]
forall a. Set a -> [a]
S.toList (Set Instruction -> [Instruction])
-> Set Instruction -> [Instruction]
forall a b. (a -> b) -> a -> b
$ Context -> Set Instruction
ctxt_get_instructions Context
ctxt
      avg_size :: Double
avg_size                        = [Int] -> Double
forall a b. (Real a, Fractional b) => [a] -> b
average ([Int] -> Double) -> [Int] -> Double
forall a b. (a -> b) -> a -> b
$ (Instruction -> Int) -> [Instruction] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Instruction -> Int
forall a. HasSize a => a -> Int
sizeof [Instruction]
instrs
      text_section_size :: Int
text_section_size               = Binary -> Int
forall a. BinaryClass a => a -> Int
binary_text_section_size (Binary -> Int) -> Binary -> Int
forall a b. (a -> b) -> a -> b
$ Context -> Binary
ctxt_binary Context
ctxt
      num_expected_intrs :: Integer
num_expected_intrs              = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
text_section_size Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
avg_size)
      num_intrs :: Int
num_intrs                       = [Instruction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Instruction]
instrs
      instructionCoverage :: Double
instructionCoverage             = Double -> Double
round2dp (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
num_intrs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
num_expected_intrs Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100)
      mem_ops :: [(Word64, Word64, [Maybe SValue])]
mem_ops                         = Context -> [(Word64, Word64, [Maybe SValue])]
ctxt_resolve_mem_operands Context
ctxt
      pointerDesignations :: Map [Char] Int
pointerDesignations             = Context -> [(Word64, Word64, [Maybe SValue])] -> Map [Char] Int
mk_metric_pointerDesignations Context
ctxt [(Word64, Word64, [Maybe SValue])]
mem_ops 
      pointerDesignationsPercentages :: Map [Char] Double
pointerDesignationsPercentages  = Map [Char] Int -> Map [Char] Double
designations_to_percentages Map [Char] Int
pointerDesignations
      memWrites :: Int
memWrites                       = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Map [Char] Int -> [Int]
forall k a. Map k a -> [a]
M.elems Map [Char] Int
pointerDesignations
      specifityMetric :: Double
specifityMetric                 = Map [Char] Double -> Double
specifityMetricOf Map [Char] Double
pointerDesignationsPercentages

      num_functions :: Int
num_functions                   = IntMap VerificationResult -> Int
forall a. IntMap a -> Int
IM.size (IntMap VerificationResult -> Int)
-> IntMap VerificationResult -> Int
forall a b. (a -> b) -> a -> b
$ Context -> IntMap VerificationResult
ctxt_results Context
ctxt
      num_verif_success :: Int
num_verif_success               = Context -> Int
num_of_verif_success Context
ctxt
      num_verif_unresolved :: Int
num_verif_unresolved            = Context -> Int
num_of_verif_unresolved Context
ctxt
      num_verif_error :: Int
num_verif_error                 = Context -> Int
num_of_verif_error Context
ctxt

      resolved_jumps :: Int
resolved_jumps                  = Context -> Int
num_of_resolved_indirection_jumps Context
ctxt
      resolved_calls :: Int
resolved_calls                  = Context -> Int
num_of_resolved_indirection_calls Context
ctxt
      unresolved_jumps :: Int
unresolved_jumps                = Context -> (Opcode -> Bool) -> Int
num_of_unres_inds Context
ctxt Opcode -> Bool
isJump
      unresolved_calls :: Int
unresolved_calls                = Context -> (Opcode -> Bool) -> Int
num_of_unres_inds Context
ctxt Opcode -> Bool
isCall

      runningTimeRepr :: [Char]
runningTimeRepr                 = Int64 -> [Char]
show_runningtime (Int64 -> [Char]) -> Int64 -> [Char]
forall a b. (a -> b) -> a -> b
$ Context -> Int64
ctxt_runningtime Context
ctxt

      metrics :: [Metric]
metrics = (([Char], [Char]) -> Metric) -> [([Char], [Char])] -> [Metric]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> Metric
mk_metric [
                 ([Char]
"#instructions",            Int -> [Char]
forall a. Show a => a -> [Char]
show Int
num_intrs),
                 ([Char]
"avgInstructionSize",       Double -> [Char]
forall a. Show a => a -> [Char]
show Double
avg_size),
                 ([Char]
"#expectedInstructions",    Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
num_expected_intrs),
                 ([Char]
"%instructionCoverage",     Double -> [Char]
forall a. Show a => a -> [Char]
show Double
instructionCoverage),
                 ([Char]
"#memWrites",               Int -> [Char]
forall a. Show a => a -> [Char]
show Int
memWrites),
                 ([Char]
"pointerDesignations",      [([Char], Double)] -> [Char]
forall a. Show a => a -> [Char]
show ([([Char], Double)] -> [Char]) -> [([Char], Double)] -> [Char]
forall a b. (a -> b) -> a -> b
$ Map [Char] Double -> [([Char], Double)]
forall k a. Map k a -> [(k, a)]
M.toList Map [Char] Double
pointerDesignationsPercentages),
                 ([Char]
"specifityMetric",          Double -> [Char]
forall a. Show a => a -> [Char]
show Double
specifityMetric),
                 ([Char]
"#functions",               Int -> [Char]
forall a. Show a => a -> [Char]
show Int
num_functions),
                 ([Char]
"#functions_verified",      Int -> [Char]
forall a. Show a => a -> [Char]
show Int
num_verif_success),
                 ([Char]
"#functions_unresolved",    Int -> [Char]
forall a. Show a => a -> [Char]
show Int
num_verif_unresolved),
                 ([Char]
"#functions_verif_error",   Int -> [Char]
forall a. Show a => a -> [Char]
show Int
num_verif_error),
                 ([Char]
"#resolved_jumps",          Int -> [Char]
forall a. Show a => a -> [Char]
show Int
resolved_jumps),
                 ([Char]
"#resolved_calls",          Int -> [Char]
forall a. Show a => a -> [Char]
show Int
resolved_calls),
                 ([Char]
"#unresolved_jumps",        Int -> [Char]
forall a. Show a => a -> [Char]
show Int
unresolved_jumps),
                 ([Char]
"#unresolved_calls",        Int -> [Char]
forall a. Show a => a -> [Char]
show Int
unresolved_calls),
                 ([Char]
"runningTime",              [Char]
runningTimeRepr)
                ] in
  (ByteString -> [Char]
unpack (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ [Metric] -> ByteString
forall a. ToJSON a => a -> ByteString
encode [Metric]
metrics,[Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Metric -> [Char]) -> [Metric] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Metric -> [Char]
show_metric [Metric]
metrics)
 where
  mk_metric :: ([Char], [Char]) -> Metric
mk_metric ([Char]
name,[Char]
value) = [Char] -> [Char] -> [Char] -> Metric
Metric [Char]
name (Map [Char] [Char]
metrics Map [Char] [Char] -> [Char] -> [Char]
forall k a. Ord k => Map k a -> k -> a
M.! [Char]
name) [Char]
value


  show_metric :: Metric -> [Char]
show_metric (Metric [Char]
name [Char]
desc [Char]
value) =
    let str0 :: [Char]
str0 = [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
metrics_metric_size Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
name Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Char
' '
        str1 :: [Char]
str1 = [Char]
str0 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
desc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")" in
      [Char]
str1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
metrics_descr_size Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
desc) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
value

  designations_to_percentages :: M.Map String Int -> M.Map String Double
  designations_to_percentages :: Map [Char] Int -> Map [Char] Double
designations_to_percentages Map [Char] Int
m = (Int -> Double) -> Map [Char] Int -> Map [Char] Double
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\Int
v -> Int -> Int -> Double
forall a b. (Integral a, Integral b) => a -> b -> Double
mk_percentage Int
v (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Map [Char] Int -> [Int]
forall k a. Map k a -> [a]
M.elems Map [Char] Int
m) Map [Char] Int
m
  
  mk_percentage :: a -> b -> Double
mk_percentage a
x b
y = Double -> Double
round2dp (a
x a -> b -> Double
forall a b. (Integral a, Integral b) => a -> b -> Double
`intDiv` b
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100)


-- | Show time in HH:MM:SS
show_runningtime :: Int64 -> String
show_runningtime :: Int64 -> [Char]
show_runningtime Int64
secs = Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
hours [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
minutes [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
seconds
 where
  (Int64
hours,Int64
rem_hour)  = Int64
secs Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
3600
  (Int64
minutes,Int64
seconds) = Int64
rem_hour Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
60

-- | Number of functions successfully verified
num_of_verif_success :: Context -> Int
num_of_verif_success = IntMap VerificationResult -> Int
forall a. IntMap a -> Int
IM.size (IntMap VerificationResult -> Int)
-> (Context -> IntMap VerificationResult) -> Context -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VerificationResult -> Bool)
-> IntMap VerificationResult -> IntMap VerificationResult
forall a. (a -> Bool) -> IntMap a -> IntMap a
IM.filter VerificationResult -> Bool
isVerificationSuccess (IntMap VerificationResult -> IntMap VerificationResult)
-> (Context -> IntMap VerificationResult)
-> Context
-> IntMap VerificationResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> IntMap VerificationResult
ctxt_results
 where
  isVerificationSuccess :: VerificationResult -> Bool
isVerificationSuccess VerificationResult
VerificationSuccess               = Bool
True
  isVerificationSuccess VerificationResult
VerificationSuccesWithAssumptions = Bool
True
  isVerificationSuccess VerificationResult
_                                 = Bool
False

-- | Number of functions with unresolved indirections
num_of_verif_unresolved :: Context -> Int
num_of_verif_unresolved = IntMap VerificationResult -> Int
forall a. IntMap a -> Int
IM.size (IntMap VerificationResult -> Int)
-> (Context -> IntMap VerificationResult) -> Context -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VerificationResult -> Bool)
-> IntMap VerificationResult -> IntMap VerificationResult
forall a. (a -> Bool) -> IntMap a -> IntMap a
IM.filter (VerificationResult -> VerificationResult -> Bool
forall a. Eq a => a -> a -> Bool
(==) VerificationResult
VerificationUnresolvedIndirection) (IntMap VerificationResult -> IntMap VerificationResult)
-> (Context -> IntMap VerificationResult)
-> Context
-> IntMap VerificationResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> IntMap VerificationResult
ctxt_results

-- | Number of functions with a verification error
num_of_verif_error :: Context -> Int
num_of_verif_error = IntMap VerificationResult -> Int
forall a. IntMap a -> Int
IM.size (IntMap VerificationResult -> Int)
-> (Context -> IntMap VerificationResult) -> Context -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VerificationResult -> Bool)
-> IntMap VerificationResult -> IntMap VerificationResult
forall a. (a -> Bool) -> IntMap a -> IntMap a
IM.filter VerificationResult -> Bool
isVerificationError (IntMap VerificationResult -> IntMap VerificationResult)
-> (Context -> IntMap VerificationResult)
-> Context
-> IntMap VerificationResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> IntMap VerificationResult
ctxt_results
 where
  isVerificationError :: VerificationResult -> Bool
isVerificationError (VerificationError [Char]
_) = Bool
True
  isVerificationError VerificationResult
_                     = Bool
False

-- | Number of unresolved indirections
num_of_unres_inds :: Context -> (Opcode -> Bool) -> Int
num_of_unres_inds Context
ctxt Opcode -> Bool
chkKind = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((CFG -> Int) -> [CFG] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Context -> (Opcode -> Bool) -> CFG -> Int
num_of_unres_inds_in_cfg Context
ctxt Opcode -> Bool
chkKind) ([CFG] -> [Int]) -> [CFG] -> [Int]
forall a b. (a -> b) -> a -> b
$ IntMap CFG -> [CFG]
forall a. IntMap a -> [a]
IM.elems (IntMap CFG -> [CFG]) -> IntMap CFG -> [CFG]
forall a b. (a -> b) -> a -> b
$ Context -> IntMap CFG
ctxt_cfgs Context
ctxt)

-- | Number of unresolved indirections in the given CFG
num_of_unres_inds_in_cfg :: Context -> (Opcode -> Bool) -> CFG -> Int
num_of_unres_inds_in_cfg Context
ctxt Opcode -> Bool
chkKind CFG
g = 
  let blocks :: [Int]
blocks  = IntMap [Int] -> [Int]
forall a. IntMap a -> [Int]
IM.keys (IntMap [Int] -> [Int]) -> IntMap [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ CFG -> IntMap [Int]
cfg_blocks CFG
g in
    [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
b -> Context -> CFG -> Int -> NodeInfo
node_info_of Context
ctxt CFG
g Int
b NodeInfo -> NodeInfo -> Bool
forall a. Eq a => a -> a -> Bool
== NodeInfo
UnresolvedIndirection Bool -> Bool -> Bool
&& Int -> Bool
ends_in_kind Int
b) [Int]
blocks)
 where
  ends_in_kind :: Int -> Bool
ends_in_kind Int
b = Opcode -> Bool
chkKind (Opcode -> Bool) -> Opcode -> Bool
forall a b. (a -> b) -> a -> b
$ Instruction -> Opcode
forall label storage prefix opcode annotation.
GenericInstruction label storage prefix opcode annotation -> opcode
opcode (Instruction -> Opcode) -> Instruction -> Opcode
forall a b. (a -> b) -> a -> b
$ [Instruction] -> Instruction
forall a. [a] -> a
last (CFG -> Int -> [Instruction]
fetch_block CFG
g Int
b)

-- | Number of resolved indirections
num_of_resolved_indirection_calls :: Context -> Int
num_of_resolved_indirection_calls Context
ctxt = IntMap Indirection -> Int
forall a. IntMap a -> Int
IM.size (IntMap Indirection -> Int) -> IntMap Indirection -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Indirection -> Bool)
-> IntMap Indirection -> IntMap Indirection
forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
IM.filterWithKey (Context -> Int -> Indirection -> Bool
forall a p. Integral a => Context -> a -> p -> Bool
indirectionIsCall Context
ctxt) (IntMap Indirection -> IntMap Indirection)
-> IntMap Indirection -> IntMap Indirection
forall a b. (a -> b) -> a -> b
$ Context -> IntMap Indirection
ctxt_inds Context
ctxt
 where
  indirectionIsCall :: Context -> a -> p -> Bool
indirectionIsCall Context
ctxt a
a p
_ =
    case IO (Maybe Instruction) -> Maybe Instruction
forall a. IO a -> a
unsafePerformIO (IO (Maybe Instruction) -> Maybe Instruction)
-> IO (Maybe Instruction) -> Maybe Instruction
forall a b. (a -> b) -> a -> b
$ Context -> Word64 -> IO (Maybe Instruction)
fetch_instruction Context
ctxt (Word64 -> IO (Maybe Instruction))
-> Word64 -> IO (Maybe Instruction)
forall a b. (a -> b) -> a -> b
$ a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a of -- Should be safe as result is immutable.
      Maybe Instruction
Nothing -> Bool
False
      Just Instruction
i  -> Opcode -> Bool
isCall (Opcode -> Bool) -> Opcode -> Bool
forall a b. (a -> b) -> a -> b
$ Instruction -> Opcode
forall label storage prefix opcode annotation.
GenericInstruction label storage prefix opcode annotation -> opcode
opcode Instruction
i
num_of_resolved_indirection_jumps :: Context -> Int
num_of_resolved_indirection_jumps Context
ctxt = IntMap Indirection -> Int
forall a. IntMap a -> Int
IM.size (IntMap Indirection -> Int) -> IntMap Indirection -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Indirection -> Bool)
-> IntMap Indirection -> IntMap Indirection
forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
IM.filterWithKey (Context -> Int -> Indirection -> Bool
forall a p. Integral a => Context -> a -> p -> Bool
indirectionIsJump Context
ctxt) (IntMap Indirection -> IntMap Indirection)
-> IntMap Indirection -> IntMap Indirection
forall a b. (a -> b) -> a -> b
$ Context -> IntMap Indirection
ctxt_inds Context
ctxt
 where
  indirectionIsJump :: Context -> a -> p -> Bool
indirectionIsJump Context
ctxt a
a p
_ =
    case IO (Maybe Instruction) -> Maybe Instruction
forall a. IO a -> a
unsafePerformIO (IO (Maybe Instruction) -> Maybe Instruction)
-> IO (Maybe Instruction) -> Maybe Instruction
forall a b. (a -> b) -> a -> b
$ Context -> Word64 -> IO (Maybe Instruction)
fetch_instruction Context
ctxt (Word64 -> IO (Maybe Instruction))
-> Word64 -> IO (Maybe Instruction)
forall a b. (a -> b) -> a -> b
$ a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a of -- Should be safe as result is immutable.
      Maybe Instruction
Nothing -> Bool
False
      Just Instruction
i  -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Opcode -> Bool
isCall (Opcode -> Bool) -> Opcode -> Bool
forall a b. (a -> b) -> a -> b
$ Instruction -> Opcode
forall label storage prefix opcode annotation.
GenericInstruction label storage prefix opcode annotation -> opcode
opcode Instruction
i


-- | Number of instructions in CFG
num_of_instructions :: CFG -> Int
num_of_instructions CFG
g = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (([Int] -> Int) -> [[Int]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ IntMap [Int] -> [[Int]]
forall a. IntMap a -> [a]
IM.elems (IntMap [Int] -> [[Int]]) -> IntMap [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ CFG -> IntMap [Int]
cfg_blocks CFG
g)

-- | Number of basic blocks in CFG
num_of_blocks :: CFG -> Int
num_of_blocks CFG
g = IntMap [Int] -> Int
forall a. IntMap a -> Int
IM.size (IntMap [Int] -> Int) -> IntMap [Int] -> Int
forall a b. (a -> b) -> a -> b
$ CFG -> IntMap [Int]
cfg_blocks CFG
g

-- | Number of edges in CFG
num_of_edges :: CFG -> Int
num_of_edges CFG
g = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((IntSet -> Int) -> [IntSet] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map IntSet -> Int
IS.size ([IntSet] -> [Int]) -> [IntSet] -> [Int]
forall a b. (a -> b) -> a -> b
$ IntMap IntSet -> [IntSet]
forall a. IntMap a -> [a]
IM.elems (IntMap IntSet -> [IntSet]) -> IntMap IntSet -> [IntSet]
forall a b. (a -> b) -> a -> b
$ CFG -> IntMap IntSet
cfg_edges CFG
g)


mk_metric_pointerDesignations :: Context -> [(Word64,Word64, [Maybe SValue])] -> M.Map String Int
mk_metric_pointerDesignations :: Context -> [(Word64, Word64, [Maybe SValue])] -> Map [Char] Int
mk_metric_pointerDesignations Context
ctxt = ([Char] -> Map [Char] Int -> Map [Char] Int)
-> Map [Char] Int -> [[Char]] -> Map [Char] Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Int -> Int) -> [Char] -> Map [Char] Int -> Map [Char] Int
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
1)) Map [Char] Int
init_m ([[Char]] -> Map [Char] Int)
-> ([(Word64, Word64, [Maybe SValue])] -> [[Char]])
-> [(Word64, Word64, [Maybe SValue])]
-> Map [Char] Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, Word64, [Maybe SValue]) -> [[Char]])
-> [(Word64, Word64, [Maybe SValue])] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Word64, Word64, [Maybe SValue]) -> [[Char]]
forall a b. Integral a => (a, b, [Maybe SValue]) -> [[Char]]
get_specifity_per_instruction
 where
  init_m :: Map [Char] Int
init_m = [([Char], Int)] -> Map [Char] Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [([Char]
"U",Int
0), ([Char]
"C",Int
0), ([Char]
"C+U",Int
0), ([Char]
"A",Int
0)]

  get_specifity_per_instruction :: (a, b, [Maybe SValue]) -> [[Char]]
get_specifity_per_instruction (a
entry,b
a,[Maybe SValue]
es) = (Maybe SValue -> [Char]) -> [Maybe SValue] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Maybe SValue -> [Char]
forall a. Integral a => a -> Maybe SValue -> [Char]
get_domains a
entry) [Maybe SValue]
es

  get_domains :: a -> Maybe SValue -> [Char]
get_domains a
entry Maybe SValue
Nothing = [Char]
"Nothing"
  get_domains a
entry (Just SValue
e) = 
    let fctxt :: FContext
fctxt = Context -> Int -> FContext
mk_fcontext Context
ctxt (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
entry) in
       FContext -> SValue -> [Char]
forall p. p -> SValue -> [Char]
get_pointer_specifity_cpointer FContext
fctxt SValue
e



-- "C"     = Concrete
-- "C+U"   = Concrete plus unknown offset
-- "U"     = Unknown
-- "A"     = Addends
get_pointer_specifity_cpointer :: p -> SValue -> [Char]
get_pointer_specifity_cpointer p
fctxt SValue
Top = [Char]
"U"
get_pointer_specifity_cpointer p
fctxt (SAddends NESet (NESet SAddend)
es) = [Char]
"A"
get_pointer_specifity_cpointer p
fctxt (SConcrete NESet SimpleExpr
es)
  | (SimpleExpr -> Bool) -> NESet SimpleExpr -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any SimpleExpr -> Bool
contains_rock_bottom NESet SimpleExpr
es = [Char]
"C+U"
  | Bool
otherwise                   = [Char]
"C"
 where
  contains_rock_bottom :: SimpleExpr -> Bool
contains_rock_bottom SimpleExpr
e = SimpleExpr -> Bool
contains_bot SimpleExpr
e Bool -> Bool -> Bool
&& Bool -> Bool
not ((BotTyp -> Bool) -> SimpleExpr -> Bool
all_bot_satisfy (Bool -> Bool
not (Bool -> Bool) -> (BotTyp -> Bool) -> BotTyp -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotTyp -> Bool
is_rock_bottom) SimpleExpr
e)
  is_rock_bottom :: BotTyp -> Bool
is_rock_bottom (FromCall [Char]
"") = Bool
True
  is_rock_bottom BotTyp
_             = Bool
False

{-- TODO (SPointer vs)
  | any non_det vs = "PTR+UB" 
  | otherwise      = "PTR+B"
 where
  non_det (Base_Section _) = True
  non_det ptr              = has_unknown_offset ptr
get_pointer_specifity_cpointer fctxt (SConcrete es) = concrete es
 where
  concrete es
    | all (expr_is_highly_likely_local_pointer fctxt) es = "C+LGH"
    | all (expr_is_global_immediate $ f_ctxt fctxt) es   = "C+LGH"
    | all (expr_is_highly_likely_heap_pointer fctxt) es  = "C+LGH"
    | otherwise                                          = "C+O"
get_pointer_specifity_cpointer fctxt (SAddends adds) = "A"--}

specifityMetricOf :: M.Map String Double -> Double
specifityMetricOf :: Map [Char] Double -> Double
specifityMetricOf Map [Char] Double
m = Map [Char] Double
m Map [Char] Double -> [Char] -> Double
forall k a. Ord k => Map k a -> k -> a
M.! [Char]
"C" Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.8Double -> Double -> Double
forall a. Num a => a -> a -> a
*(Map [Char] Double
m Map [Char] Double -> [Char] -> Double
forall k a. Ord k => Map k a -> k -> a
M.! [Char]
"A") Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.6Double -> Double -> Double
forall a. Num a => a -> a -> a
*(Map [Char] Double
m Map [Char] Double -> [Char] -> Double
forall k a. Ord k => Map k a -> k -> a
M.! [Char]
"A")



metrics_metric_size :: Int
metrics_metric_size = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Char]] -> [Int]) -> [[Char]] -> [Int]
forall a b. (a -> b) -> a -> b
$ Map [Char] [Char] -> [[Char]]
forall k a. Map k a -> [k]
M.keys Map [Char] [Char]
metrics
metrics_descr_size :: Int
metrics_descr_size  = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Char]] -> [Int]) -> [[Char]] -> [Int]
forall a b. (a -> b) -> a -> b
$ Map [Char] [Char] -> [[Char]]
forall k a. Map k a -> [a]
M.elems Map [Char] [Char]
metrics


round2dp :: Double -> Double
round2dp :: Double -> Double
round2dp Double
x = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e2) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e2



intDiv :: (Integral a,Integral b) => a -> b -> Double
a
x intDiv :: a -> b -> Double
`intDiv` b
y = a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ b -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
y

data Metric = Metric {
  Metric -> [Char]
metrics_name  :: String, -- ^ Name of the metric
  Metric -> [Char]
metrics_desc  :: String, -- ^ Description of the metric
  Metric -> [Char]
metrics_value :: String  -- ^ Serialized value of the metric
 }
 deriving (forall x. Metric -> Rep Metric x)
-> (forall x. Rep Metric x -> Metric) -> Generic Metric
forall x. Rep Metric x -> Metric
forall x. Metric -> Rep Metric x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Metric x -> Metric
$cfrom :: forall x. Metric -> Rep Metric x
Generic

instance ToJSON Metric where
  toJSON :: Metric -> Value
toJSON = Options -> Metric -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
ObjectWithSingleField }