github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-25 07:55:12 +03:00
Code Issues Projects Releases Wiki Activity

Ditto, but for bitwise functions.

Browse Source
This commit is contained in:
Patrick Thomson 2019-07-06 11:42:53 -04:00
parent 0329984dfa
commit d01ad24d83
3 changed files with 17 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Control/Abstract/Value.hs
View File

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

7
src/Control/Effect/Interpose.hs
View File

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

8
src/Data/Abstract/Value/Concrete.hs
View File

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