diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 99f5b4d9e..80cf1532e 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -51,6 +51,8 @@ module Control.Abstract.Value , runNumericFunction , runNumeric2Function , castToInteger +, runBitwiseFunction +, runBitwise2Function , liftBitwise , liftBitwise2 , unsignedRShift @@ -346,8 +348,15 @@ unsignedRShift :: (Member (Bitwise value) sig, Carrier sig m) unsignedRShift v1 v2 = send (UnsignedRShift v1 v2 pure) data BitwiseFunction = BitwiseFunction (forall a . Bits a => a -> a) + +runBitwiseFunction :: Bits a => BitwiseFunction -> a -> a +runBitwiseFunction (BitwiseFunction f) a = f a + data Bitwise2Function = Bitwise2Function (forall a . (Integral a, Bits a) => a -> a -> a) +runBitwise2Function :: (Integral a, Bits a) => Bitwise2Function -> a -> a -> a +runBitwise2Function (Bitwise2Function f) a b = f a b + data Bitwise value (m :: * -> *) k = CastToInteger value (value -> m k) | LiftBitwise BitwiseFunction value (value -> m k) diff --git a/src/Control/Effect/Interpose.hs b/src/Control/Effect/Interpose.hs index 757492c1d..dfaabb2e6 100644 --- a/src/Control/Effect/Interpose.hs +++ b/src/Control/Effect/Interpose.hs @@ -36,10 +36,11 @@ interpose m f = send (Interpose m f pure) runInterpose :: InterposeC eff m a -> m a runInterpose = runReader Nothing . runInterposeC -newtype InterposeC eff m a = InterposeC { runInterposeC :: ReaderC (Maybe (Listener eff (InterposeC eff m))) m a } - deriving (Alternative, Applicative, Functor, Monad) +newtype InterposeC (eff :: (* -> *) -> * -> *) m a = InterposeC + { runInterposeC :: ReaderC (Maybe (Listener eff (InterposeC eff m))) m a + } deriving (Alternative, Applicative, Functor, Monad) -newtype Listener eff m = Listener (forall n x . eff n x -> m x) +newtype Listener (eff :: (* -> *) -> * -> *) m = Listener (forall n x . eff n x -> m x) -- -- TODO: Document the implementation of this, as it is extremely subtle. diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs index 3b71b9021..d5e3d54e2 100644 --- a/src/Data/Abstract/Value/Concrete.hs +++ b/src/Data/Abstract/Value/Concrete.hs @@ -226,9 +226,9 @@ instance ( Member (Reader ModuleInfo) sig Abstract.Float t k -> k (Float (Number.Decimal t)) Abstract.Rational t k -> k (Rational (Number.Ratio t)) Abstract.LiftNumeric f arg k -> k =<< case arg of - Integer (Number.Integer i) -> pure $ Integer (Number.Integer (f i)) - Float (Number.Decimal d) -> pure $ Float (Number.Decimal (f d)) - Rational (Number.Ratio r) -> pure $ Rational (Number.Ratio (f r)) + Integer (Number.Integer i) -> pure $ Integer (Number.Integer (runNumericFunction f i)) + Float (Number.Decimal d) -> pure $ Float (Number.Decimal (runNumericFunction f d)) + Rational (Number.Ratio r) -> pure $ Rational (Number.Ratio (runNumericFunction f r)) other -> throwBaseError (NumericError other) Abstract.LiftNumeric2 f left right k -> k =<< case (left, right) of (Integer i, Integer j) -> attemptUnsafeArithmetic (runNumeric2Function f i j) & specialize @@ -268,7 +268,7 @@ instance ( Member (Reader ModuleInfo) sig CastToInteger (Integer (Number.Integer i)) k -> k (Integer (Number.Integer i)) CastToInteger (Float (Number.Decimal i)) k -> k (Integer (Number.Integer (coefficient (normalize i)))) CastToInteger i k -> throwBaseError (NumericError i) >>= k - LiftBitwise operator (Integer (Number.Integer i)) k -> k . Integer . Number.Integer . operator $ i + LiftBitwise operator (Integer (Number.Integer i)) k -> k . Integer . Number.Integer . runNumericFunction operator $ i LiftBitwise _ other k -> throwBaseError (BitwiseError other) >>= k LiftBitwise2 operator (Integer (Number.Integer i)) (Integer (Number.Integer j)) k -> k . Integer . Number.Integer $ operator i j LiftBitwise2 _ left right k -> throwBaseError (Bitwise2Error left right) >>= k