diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 88ea1946c..d5c8b3017 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -41,6 +41,9 @@ module Control.Abstract.Value , Numeric(..) , NumericC(..) , runNumeric +, Bitwise(..) +, BitwiseC(..) +, runBitwise ) where import Control.Abstract.Evaluator @@ -311,6 +314,29 @@ runNumeric :: Carrier (Numeric value :+: sig) (NumericC value (Eff m)) -> Evaluator term address value m a runNumeric = raiseHandler $ runNumericC . interpret + +data Bitwise value (m :: * -> *) k + = CastToInteger value (value -> k) + | LiftBitwise (forall a . Bits a => a -> a) value (value -> k) + | LiftBitwise2 (forall a . (Integral a, Bits a) => a -> a -> a) value value (value -> k) + | UnsignedRShift value value (value -> k) + deriving (Functor) + +instance HFunctor (Bitwise value) where + hmap _ = coerce + {-# INLINE hmap #-} + +instance Effect (Bitwise value) where + handle state handler = coerce . fmap (handler . (<$ state)) + +runBitwise :: Carrier (Bitwise value :+: sig) (BitwiseC value (Eff m)) + => Evaluator term address value (BitwiseC value (Eff m)) a + -> Evaluator term address value m a +runBitwise = raiseHandler $ runBitwiseC . interpret + +newtype BitwiseC value m a = BitwiseC { runBitwiseC :: m a } + + class Show value => AbstractIntro value where -- | Construct a key-value pair for use in a hash. kvPair :: value -> value -> value diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 616775b79..3b50acdda 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -21,7 +21,7 @@ import qualified Control.Abstract as Abstract import Control.Abstract.Context as X import Control.Abstract.Evaluator as X hiding (LoopControl(..), Return(..), catchLoopControl, runLoopControl, catchReturn, runReturn) import Control.Abstract.Modules as X (Modules, ModuleResult, ResolutionError(..), load, lookupModule, listModulesInDir, require, resolve, throwResolutionError) -import Control.Abstract.Value as X hiding (Boolean(..), Function(..), Numeric(..), String(..), Unit(..), While(..)) +import Control.Abstract.Value as X hiding (Bitwise(..), Boolean(..), Function(..), Numeric(..), String(..), Unit(..), While(..)) import Data.Abstract.BaseError as X import Data.Abstract.Declarations as X import Data.Abstract.FreeVariables as X diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index 1e119b80d..4fba1803d 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -9,7 +9,7 @@ import Data.Fixed import Data.List (intersperse) import Proto3.Suite.Class -import Control.Abstract hiding (Call, Member, Void) +import Control.Abstract hiding (Bitwise(..), Call, Member, Void) import Data.Abstract.Evaluatable as Abstract hiding (Member, Void) import Data.Abstract.Name as Name import Data.Abstract.Number (liftIntegralFrac, liftReal, liftedExponent, liftedFloorDiv)