{-# LANGUAGE BlockArguments      #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE ViewPatterns        #-}

module Dovetail.Core.Data.Int.Bits where

import Data.Foldable (fold)
import Data.Bits
import Dovetail
import Dovetail.Evaluate (builtIn)

env :: forall ctx. Env ctx
env :: Env ctx
env = do
  let _ModuleName :: ModuleName
_ModuleName = Text -> ModuleName
ModuleName Text
"Data.Int.Bits"

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- and :: Int -> Int -> Int
      ModuleName
-> Text -> (Integer -> Integer -> Eval ctx Integer) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Eval ctx Integer)
        ModuleName
_ModuleName Text
"and"
        \Integer
a Integer
b ->
          Integer -> Eval ctx Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
b)
      -- or :: Int -> Int -> Int
    , ModuleName
-> Text -> (Integer -> Integer -> Eval ctx Integer) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Eval ctx Integer)
        ModuleName
_ModuleName Text
"or"
        \Integer
a Integer
b ->
          Integer -> Eval ctx Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
b)
      -- xor :: Int -> Int -> Int
    , ModuleName
-> Text -> (Integer -> Integer -> Eval ctx Integer) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Eval ctx Integer)
        ModuleName
_ModuleName Text
"xor"
        \Integer
a Integer
b ->
          Integer -> Eval ctx Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
b)
      -- shl :: Int -> Int -> Int
    , ModuleName
-> Text -> (Integer -> Integer -> Eval ctx Integer) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Eval ctx Integer)
        ModuleName
_ModuleName Text
"shl"
        \Integer
a Integer
b ->
          Integer -> Eval ctx Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b)
      -- shr :: Int -> Int -> Int
    , ModuleName
-> Text -> (Integer -> Integer -> Eval ctx Integer) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Eval ctx Integer)
        ModuleName
_ModuleName Text
"shr"
        \Integer
a Integer
b ->
          Integer -> Eval ctx Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b)
      -- zshr :: Int -> Int -> Int
    , ModuleName
-> Text -> (Integer -> Integer -> Eval ctx Integer) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Eval ctx Integer)
        ModuleName
_ModuleName Text
"zshr"
        \Integer
_ Integer
_ ->
          EvaluationErrorType ctx -> Eval ctx Integer
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError Text
"zshr is not implemented")
      -- complement :: Int -> Int
    , ModuleName -> Text -> (Integer -> Eval ctx Integer) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Eval ctx Integer)
        ModuleName
_ModuleName Text
"complement"
        \Integer
a ->
          Integer -> Eval ctx Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Integer
forall a. Bits a => a -> a
complement Integer
a)
    ]