{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
-- | promoted bit manipulation functions

module Predicate.Data.Bits (
    type (.&.)
  , type (.|.)
  , type (.^.)
  , BitShift
  , BitShiftL
  , BitShiftR
  , BitRotate
  , BitRotateL
  , BitRotateR
  , BitSet
  , BitComplement
  , BitClear

  , PopCount
  , TestBit
  , Bit
  , ZeroBits
 ) where
import Predicate.Core
import Predicate.Util
import Data.Proxy (Proxy(Proxy))
import qualified Data.Bits as Bits
import Data.Bits (Bits(..))
-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XOverloadedStrings

-- >>> import Predicate


-- | bitwise @and@ similar to 'Data.Bits..&.'

--

-- >>> pz @(344 .&. 123) ()

-- Val 88

--

data p .&. q deriving Int -> (p .&. q) -> ShowS
[p .&. q] -> ShowS
(p .&. q) -> String
(Int -> (p .&. q) -> ShowS)
-> ((p .&. q) -> String) -> ([p .&. q] -> ShowS) -> Show (p .&. q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p .&. q) -> ShowS
forall k (p :: k) k (q :: k). [p .&. q] -> ShowS
forall k (p :: k) k (q :: k). (p .&. q) -> String
showList :: [p .&. q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p .&. q] -> ShowS
show :: (p .&. q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p .&. q) -> String
showsPrec :: Int -> (p .&. q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p .&. q) -> ShowS
Show
infixl 7 .&.

instance ( P p a
         , P q a
         , Show (PP p a)
         , PP p a ~ PP q a
         , Bits (PP p a)
         ) => P (p .&. q) a where
  type PP (p .&. q) a = PP p a
  eval :: proxy (p .&. q) -> POpts -> a -> m (TT (PP (p .&. q) a))
eval proxy (p .&. q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"(.&.)"
    Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
    TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
      Left TT (PP q a)
e -> TT (PP q a)
e
      Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
        let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
            d :: PP q a
d = PP q a
p PP q a -> PP q a -> PP q a
forall a. Bits a => a -> a -> a
Bits..&. PP q a
q
        in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" .&. " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [Tree PE]
hhs


-- | bitwise @or@ similar to 'Data.Bits..|.'

--

-- >>> pz @(344 .|. 123) ()

-- Val 379

--

-- >>> pz @(Fst .|. Snd) (124,33)

-- Val 125

--

data p .|. q deriving Int -> (p .|. q) -> ShowS
[p .|. q] -> ShowS
(p .|. q) -> String
(Int -> (p .|. q) -> ShowS)
-> ((p .|. q) -> String) -> ([p .|. q] -> ShowS) -> Show (p .|. q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p .|. q) -> ShowS
forall k (p :: k) k (q :: k). [p .|. q] -> ShowS
forall k (p :: k) k (q :: k). (p .|. q) -> String
showList :: [p .|. q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p .|. q] -> ShowS
show :: (p .|. q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p .|. q) -> String
showsPrec :: Int -> (p .|. q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p .|. q) -> ShowS
Show
infixl 5 .|.

instance ( P p a
         , P q a
         , Show (PP p a)
         , PP p a ~ PP q a
         , Bits (PP p a)
         ) => P (p .|. q) a where
  type PP (p .|. q) a = PP p a
  eval :: proxy (p .|. q) -> POpts -> a -> m (TT (PP (p .|. q) a))
eval proxy (p .|. q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"(.|.)"
    Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
    TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
      Left TT (PP q a)
e -> TT (PP q a)
e
      Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
        let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
            d :: PP q a
d = PP q a
p PP q a -> PP q a -> PP q a
forall a. Bits a => a -> a -> a
Bits..|. PP q a
q
        in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" .|. " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [Tree PE]
hhs

-- | bitwise @xor@ similar to 'Data.Bits.xor'

--

-- >>> pz @(344 .^. 123) ()

-- Val 291

--

data p .^. q deriving Int -> (p .^. q) -> ShowS
[p .^. q] -> ShowS
(p .^. q) -> String
(Int -> (p .^. q) -> ShowS)
-> ((p .^. q) -> String) -> ([p .^. q] -> ShowS) -> Show (p .^. q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p .^. q) -> ShowS
forall k (p :: k) k (q :: k). [p .^. q] -> ShowS
forall k (p :: k) k (q :: k). (p .^. q) -> String
showList :: [p .^. q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p .^. q] -> ShowS
show :: (p .^. q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p .^. q) -> String
showsPrec :: Int -> (p .^. q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p .^. q) -> ShowS
Show
infixl 5 .^.

instance ( P p a
         , P q a
         , Show (PP p a)
         , PP p a ~ PP q a
         , Bits (PP p a)
         ) => P (p .^. q) a where
  type PP (p .^. q) a = PP p a
  eval :: proxy (p .^. q) -> POpts -> a -> m (TT (PP (p .^. q) a))
eval proxy (p .^. q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"(.^.)"
    Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
    TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
      Left TT (PP q a)
e -> TT (PP q a)
e
      Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
        let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
            d :: PP q a
d = PP q a
p PP q a -> PP q a -> PP q a
forall a. Bits a => a -> a -> a
`Bits.xor` PP q a
q
        in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" .^. " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [Tree PE]
hhs

data BitFunction =
     BFShift
   | BFShiftL
   | BFShiftR
   | BFRotate
   | BFRotateL
   | BFRotateR
   | BFSet
   | BFClear
   | BFComplement
   deriving (Int -> BitFunction -> ShowS
[BitFunction] -> ShowS
BitFunction -> String
(Int -> BitFunction -> ShowS)
-> (BitFunction -> String)
-> ([BitFunction] -> ShowS)
-> Show BitFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitFunction] -> ShowS
$cshowList :: [BitFunction] -> ShowS
show :: BitFunction -> String
$cshow :: BitFunction -> String
showsPrec :: Int -> BitFunction -> ShowS
$cshowsPrec :: Int -> BitFunction -> ShowS
Show,BitFunction -> BitFunction -> Bool
(BitFunction -> BitFunction -> Bool)
-> (BitFunction -> BitFunction -> Bool) -> Eq BitFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitFunction -> BitFunction -> Bool
$c/= :: BitFunction -> BitFunction -> Bool
== :: BitFunction -> BitFunction -> Bool
$c== :: BitFunction -> BitFunction -> Bool
Eq)

class BitFunctionC (fn :: BitFunction) where
  bitFunction :: Bits a => (String, a -> Int -> a)
instance BitFunctionC 'BFShift where
  bitFunction :: (String, a -> Int -> a)
bitFunction = (String
"shift", a -> Int -> a
forall a. Bits a => a -> Int -> a
Bits.shift)
instance BitFunctionC 'BFShiftL where
  bitFunction :: (String, a -> Int -> a)
bitFunction = (String
"shiftL", a -> Int -> a
forall a. Bits a => a -> Int -> a
Bits.shiftL)
instance BitFunctionC 'BFShiftR where
  bitFunction :: (String, a -> Int -> a)
bitFunction = (String
"shiftR", a -> Int -> a
forall a. Bits a => a -> Int -> a
Bits.shiftR)
instance BitFunctionC 'BFRotate where
  bitFunction :: (String, a -> Int -> a)
bitFunction = (String
"rotate", a -> Int -> a
forall a. Bits a => a -> Int -> a
Bits.rotate)
instance BitFunctionC 'BFRotateL where
  bitFunction :: (String, a -> Int -> a)
bitFunction = (String
"rotateL", a -> Int -> a
forall a. Bits a => a -> Int -> a
Bits.rotateL)
instance BitFunctionC 'BFRotateR where
  bitFunction :: (String, a -> Int -> a)
bitFunction = (String
"rotateR", a -> Int -> a
forall a. Bits a => a -> Int -> a
Bits.rotateR)
instance BitFunctionC 'BFSet where
  bitFunction :: (String, a -> Int -> a)
bitFunction = (String
"setBit", a -> Int -> a
forall a. Bits a => a -> Int -> a
Bits.setBit)
instance BitFunctionC 'BFClear where
  bitFunction :: (String, a -> Int -> a)
bitFunction = (String
"clearBit", a -> Int -> a
forall a. Bits a => a -> Int -> a
Bits.clearBit)
instance BitFunctionC 'BFComplement where
  bitFunction :: (String, a -> Int -> a)
bitFunction = (String
"complementBit", a -> Int -> a
forall a. Bits a => a -> Int -> a
Bits.complementBit)

-- flips the function where p is the integral

data BitImpl (fn :: BitFunction) p q deriving Int -> BitImpl fn p q -> ShowS
[BitImpl fn p q] -> ShowS
BitImpl fn p q -> String
(Int -> BitImpl fn p q -> ShowS)
-> (BitImpl fn p q -> String)
-> ([BitImpl fn p q] -> ShowS)
-> Show (BitImpl fn p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (fn :: BitFunction) k (p :: k) k (q :: k).
Int -> BitImpl fn p q -> ShowS
forall (fn :: BitFunction) k (p :: k) k (q :: k).
[BitImpl fn p q] -> ShowS
forall (fn :: BitFunction) k (p :: k) k (q :: k).
BitImpl fn p q -> String
showList :: [BitImpl fn p q] -> ShowS
$cshowList :: forall (fn :: BitFunction) k (p :: k) k (q :: k).
[BitImpl fn p q] -> ShowS
show :: BitImpl fn p q -> String
$cshow :: forall (fn :: BitFunction) k (p :: k) k (q :: k).
BitImpl fn p q -> String
showsPrec :: Int -> BitImpl fn p q -> ShowS
$cshowsPrec :: forall (fn :: BitFunction) k (p :: k) k (q :: k).
Int -> BitImpl fn p q -> ShowS
Show

instance ( P p a
         , P q a
         , Show (PP q a)
         , Bits (PP q a)
         , Integral (PP p a)
         , BitFunctionC fn
         ) => P (BitImpl fn p q) a where
  type PP (BitImpl fn p q) a = PP q a
  eval :: proxy (BitImpl fn p q)
-> POpts -> a -> m (TT (PP (BitImpl fn p q) a))
eval proxy (BitImpl fn p q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
ss
        (String
ss,PP q a -> Int -> PP q a
fn) = forall a. (BitFunctionC fn, Bits a) => (String, a -> Int -> a)
forall (fn :: BitFunction) a.
(BitFunctionC fn, Bits a) =>
(String, a -> Int -> a)
bitFunction @fn
    Either (TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
    TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a))
lr of
      Left TT (PP q a)
e -> TT (PP q a)
e
      Right (PP p a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
p,PP q a
q,TT (PP p a)
pp,TT (PP q a)
qq) ->
        let hhs :: [Tree PE]
hhs = [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
            d :: PP q a
d = PP q a -> Int -> PP q a
fn PP q a
q Int
p
        in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (String
ss String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [Tree PE]
hhs

-- | shift by @p@ using @q@: similar to flipped version of 'Data.Bits.shift'

--

-- >>> pz @(BitShift 1 7) ()

-- Val 14

--

-- >>> pz @(BitShift 1 Id) 123

-- Val 246

--

data BitShift p q deriving Int -> BitShift p q -> ShowS
[BitShift p q] -> ShowS
BitShift p q -> String
(Int -> BitShift p q -> ShowS)
-> (BitShift p q -> String)
-> ([BitShift p q] -> ShowS)
-> Show (BitShift p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> BitShift p q -> ShowS
forall k (p :: k) k (q :: k). [BitShift p q] -> ShowS
forall k (p :: k) k (q :: k). BitShift p q -> String
showList :: [BitShift p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [BitShift p q] -> ShowS
show :: BitShift p q -> String
$cshow :: forall k (p :: k) k (q :: k). BitShift p q -> String
showsPrec :: Int -> BitShift p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> BitShift p q -> ShowS
Show
type BitShiftT p q = BitImpl 'BFShift p q

instance P (BitShiftT p q) x => P (BitShift p q) x where
  type PP (BitShift p q) x = PP (BitShiftT p q) x
  eval :: proxy (BitShift p q) -> POpts -> x -> m (TT (PP (BitShift p q) x))
eval proxy (BitShift p q)
_ = Proxy (BitShiftT p q)
-> POpts -> x -> m (TT (PP (BitShiftT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (BitShiftT p q)
forall k (t :: k). Proxy t
Proxy @(BitShiftT p q))

-- | shift left by @p@ using @q@: similar to flipped version of 'Data.Bits.shiftL'

--

-- >>> pz @(BitShiftL 1 Id) 123

-- Val 246

--

data BitShiftL p q deriving Int -> BitShiftL p q -> ShowS
[BitShiftL p q] -> ShowS
BitShiftL p q -> String
(Int -> BitShiftL p q -> ShowS)
-> (BitShiftL p q -> String)
-> ([BitShiftL p q] -> ShowS)
-> Show (BitShiftL p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> BitShiftL p q -> ShowS
forall k (p :: k) k (q :: k). [BitShiftL p q] -> ShowS
forall k (p :: k) k (q :: k). BitShiftL p q -> String
showList :: [BitShiftL p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [BitShiftL p q] -> ShowS
show :: BitShiftL p q -> String
$cshow :: forall k (p :: k) k (q :: k). BitShiftL p q -> String
showsPrec :: Int -> BitShiftL p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> BitShiftL p q -> ShowS
Show
type BitShiftLT p q = BitImpl 'BFShiftL p q

instance P (BitShiftLT p q) x => P (BitShiftL p q) x where
  type PP (BitShiftL p q) x = PP (BitShiftLT p q) x
  eval :: proxy (BitShiftL p q)
-> POpts -> x -> m (TT (PP (BitShiftL p q) x))
eval proxy (BitShiftL p q)
_ = Proxy (BitShiftLT p q)
-> POpts -> x -> m (TT (PP (BitShiftLT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (BitShiftLT p q)
forall k (t :: k). Proxy t
Proxy @(BitShiftLT p q))

-- | shift right by @p@ using @q@: similar to flipped version of 'Data.Bits.shiftR'

--

-- >>> pz @(BitShiftR 1 Id) 123

-- Val 61

--

data BitShiftR p q deriving Int -> BitShiftR p q -> ShowS
[BitShiftR p q] -> ShowS
BitShiftR p q -> String
(Int -> BitShiftR p q -> ShowS)
-> (BitShiftR p q -> String)
-> ([BitShiftR p q] -> ShowS)
-> Show (BitShiftR p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> BitShiftR p q -> ShowS
forall k (p :: k) k (q :: k). [BitShiftR p q] -> ShowS
forall k (p :: k) k (q :: k). BitShiftR p q -> String
showList :: [BitShiftR p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [BitShiftR p q] -> ShowS
show :: BitShiftR p q -> String
$cshow :: forall k (p :: k) k (q :: k). BitShiftR p q -> String
showsPrec :: Int -> BitShiftR p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> BitShiftR p q -> ShowS
Show
type BitShiftRT p q = BitImpl 'BFShiftR p q

instance P (BitShiftRT p q) x => P (BitShiftR p q) x where
  type PP (BitShiftR p q) x = PP (BitShiftRT p q) x
  eval :: proxy (BitShiftR p q)
-> POpts -> x -> m (TT (PP (BitShiftR p q) x))
eval proxy (BitShiftR p q)
_ = Proxy (BitShiftRT p q)
-> POpts -> x -> m (TT (PP (BitShiftRT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (BitShiftRT p q)
forall k (t :: k). Proxy t
Proxy @(BitShiftRT p q))

-- | rotate by @p@ using @q@: similar to flipped version of 'Data.Bits.rotate'

--

-- >>> pz @(BitRotate 2 Id) 7

-- Val 28

--

data BitRotate p q deriving Int -> BitRotate p q -> ShowS
[BitRotate p q] -> ShowS
BitRotate p q -> String
(Int -> BitRotate p q -> ShowS)
-> (BitRotate p q -> String)
-> ([BitRotate p q] -> ShowS)
-> Show (BitRotate p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> BitRotate p q -> ShowS
forall k (p :: k) k (q :: k). [BitRotate p q] -> ShowS
forall k (p :: k) k (q :: k). BitRotate p q -> String
showList :: [BitRotate p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [BitRotate p q] -> ShowS
show :: BitRotate p q -> String
$cshow :: forall k (p :: k) k (q :: k). BitRotate p q -> String
showsPrec :: Int -> BitRotate p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> BitRotate p q -> ShowS
Show
type BitRotateT p q = BitImpl 'BFRotate p q

instance P (BitRotateT p q) x => P (BitRotate p q) x where
  type PP (BitRotate p q) x = PP (BitRotateT p q) x
  eval :: proxy (BitRotate p q)
-> POpts -> x -> m (TT (PP (BitRotate p q) x))
eval proxy (BitRotate p q)
_ = Proxy (BitRotateT p q)
-> POpts -> x -> m (TT (PP (BitRotateT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (BitRotateT p q)
forall k (t :: k). Proxy t
Proxy @(BitRotateT p q))

-- | rotate left by @p@ using @q@: similar to flipped version of 'Data.Bits.rotateL'

--

-- >>> pz @(BitRotateL 2 Id) 7

-- Val 28

--

data BitRotateL p q deriving Int -> BitRotateL p q -> ShowS
[BitRotateL p q] -> ShowS
BitRotateL p q -> String
(Int -> BitRotateL p q -> ShowS)
-> (BitRotateL p q -> String)
-> ([BitRotateL p q] -> ShowS)
-> Show (BitRotateL p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> BitRotateL p q -> ShowS
forall k (p :: k) k (q :: k). [BitRotateL p q] -> ShowS
forall k (p :: k) k (q :: k). BitRotateL p q -> String
showList :: [BitRotateL p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [BitRotateL p q] -> ShowS
show :: BitRotateL p q -> String
$cshow :: forall k (p :: k) k (q :: k). BitRotateL p q -> String
showsPrec :: Int -> BitRotateL p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> BitRotateL p q -> ShowS
Show
type BitRotateLT p q = BitImpl 'BFRotateL p q

instance P (BitRotateLT p q) x => P (BitRotateL p q) x where
  type PP (BitRotateL p q) x = PP (BitRotateLT p q) x
  eval :: proxy (BitRotateL p q)
-> POpts -> x -> m (TT (PP (BitRotateL p q) x))
eval proxy (BitRotateL p q)
_ = Proxy (BitRotateLT p q)
-> POpts -> x -> m (TT (PP (BitRotateLT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (BitRotateLT p q)
forall k (t :: k). Proxy t
Proxy @(BitRotateLT p q))

-- | rotate right by @p@ using @q@: similar to flipped version of 'Data.Bits.rotateR'

--

-- >>> pz @(BitRotateR 2 Id) 7

-- Val 1

--


data BitRotateR p q deriving Int -> BitRotateR p q -> ShowS
[BitRotateR p q] -> ShowS
BitRotateR p q -> String
(Int -> BitRotateR p q -> ShowS)
-> (BitRotateR p q -> String)
-> ([BitRotateR p q] -> ShowS)
-> Show (BitRotateR p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> BitRotateR p q -> ShowS
forall k (p :: k) k (q :: k). [BitRotateR p q] -> ShowS
forall k (p :: k) k (q :: k). BitRotateR p q -> String
showList :: [BitRotateR p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [BitRotateR p q] -> ShowS
show :: BitRotateR p q -> String
$cshow :: forall k (p :: k) k (q :: k). BitRotateR p q -> String
showsPrec :: Int -> BitRotateR p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> BitRotateR p q -> ShowS
Show
type BitRotateRT p q = BitImpl 'BFRotateR p q

instance P (BitRotateRT p q) x => P (BitRotateR p q) x where
  type PP (BitRotateR p q) x = PP (BitRotateRT p q) x
  eval :: proxy (BitRotateR p q)
-> POpts -> x -> m (TT (PP (BitRotateR p q) x))
eval proxy (BitRotateR p q)
_ = Proxy (BitRotateRT p q)
-> POpts -> x -> m (TT (PP (BitRotateRT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (BitRotateRT p q)
forall k (t :: k). Proxy t
Proxy @(BitRotateRT p q))

-- | set the bit at @p@ using @q@: similar to flipped version of 'Data.Bits.setBit'

--

-- >>> pz @(BitSet 0 Id) 8

-- Val 9

--

data BitSet p q deriving Int -> BitSet p q -> ShowS
[BitSet p q] -> ShowS
BitSet p q -> String
(Int -> BitSet p q -> ShowS)
-> (BitSet p q -> String)
-> ([BitSet p q] -> ShowS)
-> Show (BitSet p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> BitSet p q -> ShowS
forall k (p :: k) k (q :: k). [BitSet p q] -> ShowS
forall k (p :: k) k (q :: k). BitSet p q -> String
showList :: [BitSet p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [BitSet p q] -> ShowS
show :: BitSet p q -> String
$cshow :: forall k (p :: k) k (q :: k). BitSet p q -> String
showsPrec :: Int -> BitSet p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> BitSet p q -> ShowS
Show
type BitSetT p q = BitImpl 'BFSet p q

instance P (BitSetT p q) x => P (BitSet p q) x where
  type PP (BitSet p q) x = PP (BitSetT p q) x
  eval :: proxy (BitSet p q) -> POpts -> x -> m (TT (PP (BitSet p q) x))
eval proxy (BitSet p q)
_ = Proxy (BitSetT p q) -> POpts -> x -> m (TT (PP (BitSetT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (BitSetT p q)
forall k (t :: k). Proxy t
Proxy @(BitSetT p q))

-- | clear the bit at @p@ using @q@: similar to flipped version of 'Data.Bits.clearBit'

--

-- >>> pz @(BitClear 2 Id) 7

-- Val 3

--

data BitClear p q deriving Int -> BitClear p q -> ShowS
[BitClear p q] -> ShowS
BitClear p q -> String
(Int -> BitClear p q -> ShowS)
-> (BitClear p q -> String)
-> ([BitClear p q] -> ShowS)
-> Show (BitClear p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> BitClear p q -> ShowS
forall k (p :: k) k (q :: k). [BitClear p q] -> ShowS
forall k (p :: k) k (q :: k). BitClear p q -> String
showList :: [BitClear p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [BitClear p q] -> ShowS
show :: BitClear p q -> String
$cshow :: forall k (p :: k) k (q :: k). BitClear p q -> String
showsPrec :: Int -> BitClear p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> BitClear p q -> ShowS
Show
type BitClearT p q = BitImpl 'BFClear p q

instance P (BitClearT p q) x => P (BitClear p q) x where
  type PP (BitClear p q) x = PP (BitClearT p q) x
  eval :: proxy (BitClear p q) -> POpts -> x -> m (TT (PP (BitClear p q) x))
eval proxy (BitClear p q)
_ = Proxy (BitClearT p q)
-> POpts -> x -> m (TT (PP (BitClearT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (BitClearT p q)
forall k (t :: k). Proxy t
Proxy @(BitClearT p q))

-- | complement the bit at @p@ using @q@: similar to flipped version of 'Data.Bits.complementBit'

--

-- >>> pz @(BitComplement 1 Id) 7

-- Val 5

--

data BitComplement p q deriving Int -> BitComplement p q -> ShowS
[BitComplement p q] -> ShowS
BitComplement p q -> String
(Int -> BitComplement p q -> ShowS)
-> (BitComplement p q -> String)
-> ([BitComplement p q] -> ShowS)
-> Show (BitComplement p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> BitComplement p q -> ShowS
forall k (p :: k) k (q :: k). [BitComplement p q] -> ShowS
forall k (p :: k) k (q :: k). BitComplement p q -> String
showList :: [BitComplement p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [BitComplement p q] -> ShowS
show :: BitComplement p q -> String
$cshow :: forall k (p :: k) k (q :: k). BitComplement p q -> String
showsPrec :: Int -> BitComplement p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> BitComplement p q -> ShowS
Show
type BitComplementT p q = BitImpl 'BFComplement p q

instance P (BitComplementT p q) x => P (BitComplement p q) x where
  type PP (BitComplement p q) x = PP (BitComplementT p q) x
  eval :: proxy (BitComplement p q)
-> POpts -> x -> m (TT (PP (BitComplement p q) x))
eval proxy (BitComplement p q)
_ = Proxy (BitComplementT p q)
-> POpts -> x -> m (TT (PP (BitComplementT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (BitComplementT p q)
forall k (t :: k). Proxy t
Proxy @(BitComplementT p q))

-- | test the bit at @p@ using @q@: similar to flipped version of 'Data.Bits.testBit'

--

-- >>> pz @(TestBit 2 Id) 7

-- Val True

--

-- >>> pz @(TestBit 2 Id) 8

-- Val False

--

data TestBit p q deriving Int -> TestBit p q -> ShowS
[TestBit p q] -> ShowS
TestBit p q -> String
(Int -> TestBit p q -> ShowS)
-> (TestBit p q -> String)
-> ([TestBit p q] -> ShowS)
-> Show (TestBit p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> TestBit p q -> ShowS
forall k (p :: k) k (q :: k). [TestBit p q] -> ShowS
forall k (p :: k) k (q :: k). TestBit p q -> String
showList :: [TestBit p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [TestBit p q] -> ShowS
show :: TestBit p q -> String
$cshow :: forall k (p :: k) k (q :: k). TestBit p q -> String
showsPrec :: Int -> TestBit p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> TestBit p q -> ShowS
Show

instance ( P p a
         , P q a
         , Show (PP q a)
         , Bits (PP q a)
         , Integral (PP p a)
         ) => P (TestBit p q) a where
  type PP (TestBit p q) a = Bool
  eval :: proxy (TestBit p q) -> POpts -> a -> m (TT (PP (TestBit p q) a))
eval proxy (TestBit p q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"TestBit"
    Either (TT Bool) (PP p a, PP q a, TT (PP p a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT Bool) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
    TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case Either (TT Bool) (PP p a, PP q a, TT (PP p a), TT (PP q a))
lr of
      Left TT Bool
e -> TT Bool
e
      Right (PP p a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
p,PP q a
q,TT (PP p a)
pp,TT (PP q a)
qq) ->
        let hhs :: [Tree PE]
hhs = [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
            d :: Bool
d = PP q a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
Bits.testBit PP q a
q Int
p
        in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
d (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
d) [Tree PE]
hhs

-- | count number of bits at @p@: similar to 'Data.Bits.popCount'

--

-- >>> pz @(PopCount Id) 7

-- Val 3

--

-- >>> pz @(PopCount Id) 8

-- Val 1

--

-- >>> pz @(PopCount Id) (-7)

-- Val (-3)

--

data PopCount p deriving Int -> PopCount p -> ShowS
[PopCount p] -> ShowS
PopCount p -> String
(Int -> PopCount p -> ShowS)
-> (PopCount p -> String)
-> ([PopCount p] -> ShowS)
-> Show (PopCount p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> PopCount p -> ShowS
forall k (p :: k). [PopCount p] -> ShowS
forall k (p :: k). PopCount p -> String
showList :: [PopCount p] -> ShowS
$cshowList :: forall k (p :: k). [PopCount p] -> ShowS
show :: PopCount p -> String
$cshow :: forall k (p :: k). PopCount p -> String
showsPrec :: Int -> PopCount p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> PopCount p -> ShowS
Show

instance ( P p a
         , Show (PP p a)
         , Bits (PP p a)
         ) => P (PopCount p) a where
  type PP (PopCount p) a = Int
  eval :: proxy (PopCount p) -> POpts -> a -> m (TT (PP (PopCount p) a))
eval proxy (PopCount p)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"PopCount"
    TT (PP p a)
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
    TT Int -> m (TT Int)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Int -> m (TT Int)) -> TT Int -> m (TT Int)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT Int) (PP p a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p a)
pp [] of
      Left TT Int
e -> TT Int
e
      Right PP p a
p ->
        let d :: Int
d = PP p a -> Int
forall a. Bits a => a -> Int
Bits.popCount PP p a
p
        in POpts -> Val Int -> String -> [Tree PE] -> TT Int
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Int -> Val Int
forall a. a -> Val a
Val Int
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP p a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
d) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]

-- | create a 'Data.Bits.Bits' for type @t with the bit at @p@ and all the others set to zero: similar to 'Data.Bits.bit'

--

-- >>> pz @(Bit Int Id) 0

-- Val 1

--

-- >>> pz @(Bit Int Id) 3

-- Val 8

--

data Bit t p deriving Int -> Bit t p -> ShowS
[Bit t p] -> ShowS
Bit t p -> String
(Int -> Bit t p -> ShowS)
-> (Bit t p -> String) -> ([Bit t p] -> ShowS) -> Show (Bit t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> Bit t p -> ShowS
forall k (t :: k) k (p :: k). [Bit t p] -> ShowS
forall k (t :: k) k (p :: k). Bit t p -> String
showList :: [Bit t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [Bit t p] -> ShowS
show :: Bit t p -> String
$cshow :: forall k (t :: k) k (p :: k). Bit t p -> String
showsPrec :: Int -> Bit t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> Bit t p -> ShowS
Show

instance ( P p a
         , Show t
         , Bits t
         , Integral (PP p a)
         ) => P (Bit t p) a where
  type PP (Bit t p) a = t
  eval :: proxy (Bit t p) -> POpts -> a -> m (TT (PP (Bit t p) a))
eval proxy (Bit t p)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"Bit"
    TT (PP p a)
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
    TT t -> m (TT t)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT t -> m (TT t)) -> TT t -> m (TT t)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT t) (PP p a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p a)
pp [] of
      Left TT t
e -> TT t
e
      Right (PP p a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
p) ->
        let d :: t
d = Int -> t
forall a. Bits a => Int -> a
Bits.bit @t Int
p
        in POpts -> Val t -> String -> [Tree PE] -> TT t
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t -> Val t
forall a. a -> Val a
Val t
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> t -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts t
d) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]


-- | create a 'Data.Bits.Bits' for type @t with all bits set to zero: similar to 'Data.Bits.zeroBits'

--

-- >>> pz @(ZeroBits Int) ()

-- Val 0

--

data ZeroBits t deriving Int -> ZeroBits t -> ShowS
[ZeroBits t] -> ShowS
ZeroBits t -> String
(Int -> ZeroBits t -> ShowS)
-> (ZeroBits t -> String)
-> ([ZeroBits t] -> ShowS)
-> Show (ZeroBits t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k). Int -> ZeroBits t -> ShowS
forall k (t :: k). [ZeroBits t] -> ShowS
forall k (t :: k). ZeroBits t -> String
showList :: [ZeroBits t] -> ShowS
$cshowList :: forall k (t :: k). [ZeroBits t] -> ShowS
show :: ZeroBits t -> String
$cshow :: forall k (t :: k). ZeroBits t -> String
showsPrec :: Int -> ZeroBits t -> ShowS
$cshowsPrec :: forall k (t :: k). Int -> ZeroBits t -> ShowS
Show

instance ( Show t
         , Bits t
         ) => P (ZeroBits t) a where
  type PP (ZeroBits t) a = t
  eval :: proxy (ZeroBits t) -> POpts -> a -> m (TT (PP (ZeroBits t) a))
eval proxy (ZeroBits t)
_ POpts
opts a
_ = TT t -> m (TT t)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT t -> m (TT t)) -> TT t -> m (TT t)
forall a b. (a -> b) -> a -> b
$
    let msg0 :: String
msg0 = String
"ZeroBits"
        d :: t
d = Bits t => t
forall a. Bits a => a
Bits.zeroBits @t
    in POpts -> Val t -> String -> [Tree PE] -> TT t
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t -> Val t
forall a. a -> Val a
Val t
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> t -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts t
d) []