{-# LANGUAGE DeriveGeneric, DefaultSignatures, Strict, StandaloneDeriving #-}

{-|
Module      : SValue
Description : 
-}

module Data.SValue2 where

import Data.SymbolicExpression

import Base

import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import Data.Word 
import Data.List
import GHC.Generics
import qualified Data.Serialize as Cereal
import Data.Bits (testBit)
import qualified Data.Set.NonEmpty as NES
import qualified Data.Foldable as F
import Control.DeepSeq


data PtrValue  =
    Base_StackPointer String
  | Base_Section Word64
  | Base_Malloc (Maybe Word64) (Maybe String)
  | Base_TLS
  | Base_StatePart StatePart
  deriving (PtrValue -> PtrValue -> Bool
(PtrValue -> PtrValue -> Bool)
-> (PtrValue -> PtrValue -> Bool) -> Eq PtrValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PtrValue -> PtrValue -> Bool
$c/= :: PtrValue -> PtrValue -> Bool
== :: PtrValue -> PtrValue -> Bool
$c== :: PtrValue -> PtrValue -> Bool
Eq,Eq PtrValue
Eq PtrValue
-> (PtrValue -> PtrValue -> Ordering)
-> (PtrValue -> PtrValue -> Bool)
-> (PtrValue -> PtrValue -> Bool)
-> (PtrValue -> PtrValue -> Bool)
-> (PtrValue -> PtrValue -> Bool)
-> (PtrValue -> PtrValue -> PtrValue)
-> (PtrValue -> PtrValue -> PtrValue)
-> Ord PtrValue
PtrValue -> PtrValue -> Bool
PtrValue -> PtrValue -> Ordering
PtrValue -> PtrValue -> PtrValue
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 :: PtrValue -> PtrValue -> PtrValue
$cmin :: PtrValue -> PtrValue -> PtrValue
max :: PtrValue -> PtrValue -> PtrValue
$cmax :: PtrValue -> PtrValue -> PtrValue
>= :: PtrValue -> PtrValue -> Bool
$c>= :: PtrValue -> PtrValue -> Bool
> :: PtrValue -> PtrValue -> Bool
$c> :: PtrValue -> PtrValue -> Bool
<= :: PtrValue -> PtrValue -> Bool
$c<= :: PtrValue -> PtrValue -> Bool
< :: PtrValue -> PtrValue -> Bool
$c< :: PtrValue -> PtrValue -> Bool
compare :: PtrValue -> PtrValue -> Ordering
$ccompare :: PtrValue -> PtrValue -> Ordering
$cp1Ord :: Eq PtrValue
Ord,(forall x. PtrValue -> Rep PtrValue x)
-> (forall x. Rep PtrValue x -> PtrValue) -> Generic PtrValue
forall x. Rep PtrValue x -> PtrValue
forall x. PtrValue -> Rep PtrValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PtrValue x -> PtrValue
$cfrom :: forall x. PtrValue -> Rep PtrValue x
Generic)

data SValue = SPointer (NES.NESet PtrValue) | SConcrete (NES.NESet SimpleExpr) | SAddends (NES.NESet StatePart) | Top
  deriving (SValue -> SValue -> Bool
(SValue -> SValue -> Bool)
-> (SValue -> SValue -> Bool) -> Eq SValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SValue -> SValue -> Bool
$c/= :: SValue -> SValue -> Bool
== :: SValue -> SValue -> Bool
$c== :: SValue -> SValue -> Bool
Eq,Eq SValue
Eq SValue
-> (SValue -> SValue -> Ordering)
-> (SValue -> SValue -> Bool)
-> (SValue -> SValue -> Bool)
-> (SValue -> SValue -> Bool)
-> (SValue -> SValue -> Bool)
-> (SValue -> SValue -> SValue)
-> (SValue -> SValue -> SValue)
-> Ord SValue
SValue -> SValue -> Bool
SValue -> SValue -> Ordering
SValue -> SValue -> SValue
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 :: SValue -> SValue -> SValue
$cmin :: SValue -> SValue -> SValue
max :: SValue -> SValue -> SValue
$cmax :: SValue -> SValue -> SValue
>= :: SValue -> SValue -> Bool
$c>= :: SValue -> SValue -> Bool
> :: SValue -> SValue -> Bool
$c> :: SValue -> SValue -> Bool
<= :: SValue -> SValue -> Bool
$c<= :: SValue -> SValue -> Bool
< :: SValue -> SValue -> Bool
$c< :: SValue -> SValue -> Bool
compare :: SValue -> SValue -> Ordering
$ccompare :: SValue -> SValue -> Ordering
$cp1Ord :: Eq SValue
Ord,(forall x. SValue -> Rep SValue x)
-> (forall x. Rep SValue x -> SValue) -> Generic SValue
forall x. Rep SValue x -> SValue
forall x. SValue -> Rep SValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SValue x -> SValue
$cfrom :: forall x. SValue -> Rep SValue x
Generic)

instance Cereal.Serialize PtrValue
instance NFData PtrValue
instance Cereal.Serialize SValue
instance NFData SValue

instance Show PtrValue where
  show :: PtrValue -> String
show (Base_StackPointer String
f) = String
"RSP_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" + ..."
  show (Base_Section Word64
i)      = String
"Section@0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
i
  show (Base_Malloc Maybe Word64
id Maybe String
h)    = (SimpleExpr -> String
forall a. Show a => a -> String
show (SimpleExpr -> String) -> SimpleExpr -> String
forall a b. (a -> b) -> a -> b
$ Maybe Word64 -> Maybe String -> SimpleExpr
SE_Malloc Maybe Word64
id Maybe String
h) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" + ..."
  show (Base_StatePart StatePart
sp)   = StatePart -> String
forall a. Show a => a -> String
show StatePart
sp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_0" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" + ..."
  show (PtrValue
Base_TLS)            = String
"&TLS" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" + ..."


instance Show SValue where
  show :: SValue -> String
show (SPointer NESet PtrValue
ptrs) = [String] -> String
show_set ((PtrValue -> String) -> [PtrValue] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PtrValue -> String
forall a. Show a => a -> String
show ([PtrValue] -> [String]) -> [PtrValue] -> [String]
forall a b. (a -> b) -> a -> b
$ NESet PtrValue -> [PtrValue]
forall a. NESet a -> [a]
neSetToList NESet PtrValue
ptrs)
  show (SConcrete NESet SimpleExpr
es)  = [String] -> String
show_set ((SimpleExpr -> String) -> [SimpleExpr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SimpleExpr -> String
forall a. Show a => a -> String
show ([SimpleExpr] -> [String]) -> [SimpleExpr] -> [String]
forall a b. (a -> b) -> a -> b
$ NESet SimpleExpr -> [SimpleExpr]
forall a. NESet a -> [a]
neSetToList NESet SimpleExpr
es)
  show (SAddends NESet StatePart
adds) = String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"+" ((StatePart -> String) -> [StatePart] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map StatePart -> String
forall a. Show a => a -> String
show([StatePart] -> [String]) -> [StatePart] -> [String]
forall a b. (a -> b) -> a -> b
$ NESet StatePart -> [StatePart]
forall a. NESet a -> [a]
neSetToList NESet StatePart
adds) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"+...}" 
  show SValue
Top             = String
"top"

show_set :: [String] -> String
show_set [String
str] = String
str
show_set [String]
strs  = String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
strs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"



isImmediate :: SValue -> Bool
isImmediate (SConcrete NESet SimpleExpr
es)  = (SimpleExpr -> Bool) -> NESet SimpleExpr -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SimpleExpr -> Bool
isImmediateExpr NESet SimpleExpr
es
isImmediate SValue
_ = Bool
False

isImmediateExpr :: SimpleExpr -> Bool
isImmediateExpr (SE_Immediate Word64
_) = Bool
True
isImmediateExpr SimpleExpr
_ = Bool
False


isConcrete :: SValue -> Bool
isConcrete (SConcrete NESet SimpleExpr
es) = Bool
True
isConcrete SValue
_ = Bool
False

isPointer :: SValue -> Bool
isPointer (SPointer NESet PtrValue
_) = Bool
True
isPointer SValue
_ = Bool
False

isSectionPtr :: PtrValue -> Bool
isSectionPtr (Base_Section Word64
a0) = Bool
True
isSectionPtr PtrValue
_ = Bool
False


isStackPointer :: PtrValue -> Bool
isStackPointer (Base_StackPointer String
f) = Bool
True
isStackPointer PtrValue
_ = Bool
False