1
1
mirror of https://github.com/github/semantic.git synced 2024-12-20 13:21:59 +03:00

add bitwise effect, carrier newtype and handler

This commit is contained in:
Ayman Nadeem 2018-12-14 15:14:02 -05:00
parent 6849fd8610
commit 99bbdfa9ae
3 changed files with 28 additions and 2 deletions

View File

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

View File

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

View File

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