{-# LANGUAGE DeriveGeneric, DefaultSignatures, Strict, StandaloneDeriving, BangPatterns #-}
module Data.SPointer where
import Data.SymbolicExpression
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 SPointer =
Concrete (NES.NESet SimpleExpr)
| Bases (NES.NESet PointerBase)
| Sources (NES.NESet BotSrc)
| Top
deriving (SPointer -> SPointer -> Bool
(SPointer -> SPointer -> Bool)
-> (SPointer -> SPointer -> Bool) -> Eq SPointer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SPointer -> SPointer -> Bool
$c/= :: SPointer -> SPointer -> Bool
== :: SPointer -> SPointer -> Bool
$c== :: SPointer -> SPointer -> Bool
Eq,Eq SPointer
Eq SPointer
-> (SPointer -> SPointer -> Ordering)
-> (SPointer -> SPointer -> Bool)
-> (SPointer -> SPointer -> Bool)
-> (SPointer -> SPointer -> Bool)
-> (SPointer -> SPointer -> Bool)
-> (SPointer -> SPointer -> SPointer)
-> (SPointer -> SPointer -> SPointer)
-> Ord SPointer
SPointer -> SPointer -> Bool
SPointer -> SPointer -> Ordering
SPointer -> SPointer -> SPointer
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 :: SPointer -> SPointer -> SPointer
$cmin :: SPointer -> SPointer -> SPointer
max :: SPointer -> SPointer -> SPointer
$cmax :: SPointer -> SPointer -> SPointer
>= :: SPointer -> SPointer -> Bool
$c>= :: SPointer -> SPointer -> Bool
> :: SPointer -> SPointer -> Bool
$c> :: SPointer -> SPointer -> Bool
<= :: SPointer -> SPointer -> Bool
$c<= :: SPointer -> SPointer -> Bool
< :: SPointer -> SPointer -> Bool
$c< :: SPointer -> SPointer -> Bool
compare :: SPointer -> SPointer -> Ordering
$ccompare :: SPointer -> SPointer -> Ordering
$cp1Ord :: Eq SPointer
Ord,(forall x. SPointer -> Rep SPointer x)
-> (forall x. Rep SPointer x -> SPointer) -> Generic SPointer
forall x. Rep SPointer x -> SPointer
forall x. SPointer -> Rep SPointer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SPointer x -> SPointer
$cfrom :: forall x. SPointer -> Rep SPointer x
Generic)
show_set :: (Foldable t,Show a) => t a -> String
show_set :: t a -> String
show_set t a
as = String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((a -> String) -> [a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> String
forall a. Show a => a -> String
show ([a] -> [String]) -> [a] -> [String]
forall a b. (a -> b) -> a -> b
$ t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t a
as) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
instance Show SPointer where
show :: SPointer -> String
show (Concrete NESet SimpleExpr
es)
| NESet SimpleExpr -> Int
forall a. NESet a -> Int
NES.size NESet SimpleExpr
es Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = 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
NES.findMin NESet SimpleExpr
es
| Bool
otherwise = NESet SimpleExpr -> String
forall (t :: * -> *) a. (Foldable t, Show a) => t a -> String
show_set NESet SimpleExpr
es String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"C"
show (Bases NESet PointerBase
bs) = NESet PointerBase -> String
forall (t :: * -> *) a. (Foldable t, Show a) => t a -> String
show_set NESet PointerBase
bs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"B"
show (Sources NESet BotSrc
srcs) = NESet BotSrc -> String
forall (t :: * -> *) a. (Foldable t, Show a) => t a -> String
show_set NESet BotSrc
srcs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"S"
show SPointer
Top = String
"top"
isConcrete :: SPointer -> Bool
isConcrete (Concrete NESet SimpleExpr
_) = Bool
True
isConcrete SPointer
_ = Bool
False
instance Cereal.Serialize SPointer
instance NFData SPointer