----------------------------------------------------------------------------
-- |
-- Module      :  Data.Emacs.Module.Raw.Value.Internal
-- Copyright   :  (c) Sergey Vinokurov 2022
-- License     :  Apache-2.0 (see LICENSE)
-- Maintainer  :  serg.foo@gmail.com
----------------------------------------------------------------------------

{-# LANGUAGE CPP          #-}
{-# LANGUAGE DataKinds    #-}
{-# LANGUAGE DerivingVia  #-}
{-# LANGUAGE TypeFamilies #-}

{-# LANGUAGE UnboxedTuples #-}

module Data.Emacs.Module.Raw.Value.Internal
  ( RawValue(..)
  , Pinning(..)
  , toUnknown
  ) where

import Control.DeepSeq
import Data.Coerce
import Data.Primitive.Types
import Data.Vector.Generic qualified as G
import Data.Vector.Generic.Mutable qualified as GM
import Data.Vector.Primitive qualified as P
import Data.Vector.Unboxed qualified as U
#if !MIN_VERSION_vector(0, 13, 1)
import Data.Vector.Unboxed.Base qualified as U
#endif
import Foreign
import GHC.Generics (Generic)
import Prettyprinter (Pretty(..))

data Pinning
  -- | Tag for global values are independent of environment ('Env') that produced it.
  --
  -- Can be used to e.g. cache values that are expensive to compute from scratch.
  = Pinned

  -- | Tag denoting regular Emacs values. Will go away after control
  -- returns to Emacs.
  | Regular

  -- | Tag denoting either global or regular emacs values. Cannot tell
  -- them apart, just pass to Emacs.
  | Unknown

toUnknown :: RawValue p -> RawValue 'Unknown
toUnknown :: forall (p :: Pinning). RawValue p -> RawValue 'Unknown
toUnknown = RawValue p -> RawValue 'Unknown
forall a b. Coercible a b => a -> b
coerce

-- | Basic handle on an Emacs value.
newtype RawValue (p :: Pinning) = RawValue { forall (p :: Pinning). RawValue p -> Ptr (RawValue p)
unRawValue :: Ptr (RawValue p) }
  deriving (Int -> RawValue p -> ShowS
[RawValue p] -> ShowS
RawValue p -> String
(Int -> RawValue p -> ShowS)
-> (RawValue p -> String)
-> ([RawValue p] -> ShowS)
-> Show (RawValue p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (p :: Pinning). Int -> RawValue p -> ShowS
forall (p :: Pinning). [RawValue p] -> ShowS
forall (p :: Pinning). RawValue p -> String
$cshowsPrec :: forall (p :: Pinning). Int -> RawValue p -> ShowS
showsPrec :: Int -> RawValue p -> ShowS
$cshow :: forall (p :: Pinning). RawValue p -> String
show :: RawValue p -> String
$cshowList :: forall (p :: Pinning). [RawValue p] -> ShowS
showList :: [RawValue p] -> ShowS
Show, RawValue p -> ()
(RawValue p -> ()) -> NFData (RawValue p)
forall a. (a -> ()) -> NFData a
forall (p :: Pinning). RawValue p -> ()
$crnf :: forall (p :: Pinning). RawValue p -> ()
rnf :: RawValue p -> ()
NFData, (forall x. RawValue p -> Rep (RawValue p) x)
-> (forall x. Rep (RawValue p) x -> RawValue p)
-> Generic (RawValue p)
forall x. Rep (RawValue p) x -> RawValue p
forall x. RawValue p -> Rep (RawValue p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (p :: Pinning) x. Rep (RawValue p) x -> RawValue p
forall (p :: Pinning) x. RawValue p -> Rep (RawValue p) x
$cfrom :: forall (p :: Pinning) x. RawValue p -> Rep (RawValue p) x
from :: forall x. RawValue p -> Rep (RawValue p) x
$cto :: forall (p :: Pinning) x. Rep (RawValue p) x -> RawValue p
to :: forall x. Rep (RawValue p) x -> RawValue p
Generic, Ptr (RawValue p) -> IO (RawValue p)
Ptr (RawValue p) -> Int -> IO (RawValue p)
Ptr (RawValue p) -> Int -> RawValue p -> IO ()
Ptr (RawValue p) -> RawValue p -> IO ()
RawValue p -> Int
(RawValue p -> Int)
-> (RawValue p -> Int)
-> (Ptr (RawValue p) -> Int -> IO (RawValue p))
-> (Ptr (RawValue p) -> Int -> RawValue p -> IO ())
-> (forall b. Ptr b -> Int -> IO (RawValue p))
-> (forall b. Ptr b -> Int -> RawValue p -> IO ())
-> (Ptr (RawValue p) -> IO (RawValue p))
-> (Ptr (RawValue p) -> RawValue p -> IO ())
-> Storable (RawValue p)
forall b. Ptr b -> Int -> IO (RawValue p)
forall b. Ptr b -> Int -> RawValue p -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall (p :: Pinning). Ptr (RawValue p) -> IO (RawValue p)
forall (p :: Pinning). Ptr (RawValue p) -> Int -> IO (RawValue p)
forall (p :: Pinning).
Ptr (RawValue p) -> Int -> RawValue p -> IO ()
forall (p :: Pinning). Ptr (RawValue p) -> RawValue p -> IO ()
forall (p :: Pinning). RawValue p -> Int
forall (p :: Pinning) b. Ptr b -> Int -> IO (RawValue p)
forall (p :: Pinning) b. Ptr b -> Int -> RawValue p -> IO ()
$csizeOf :: forall (p :: Pinning). RawValue p -> Int
sizeOf :: RawValue p -> Int
$calignment :: forall (p :: Pinning). RawValue p -> Int
alignment :: RawValue p -> Int
$cpeekElemOff :: forall (p :: Pinning). Ptr (RawValue p) -> Int -> IO (RawValue p)
peekElemOff :: Ptr (RawValue p) -> Int -> IO (RawValue p)
$cpokeElemOff :: forall (p :: Pinning).
Ptr (RawValue p) -> Int -> RawValue p -> IO ()
pokeElemOff :: Ptr (RawValue p) -> Int -> RawValue p -> IO ()
$cpeekByteOff :: forall (p :: Pinning) b. Ptr b -> Int -> IO (RawValue p)
peekByteOff :: forall b. Ptr b -> Int -> IO (RawValue p)
$cpokeByteOff :: forall (p :: Pinning) b. Ptr b -> Int -> RawValue p -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> RawValue p -> IO ()
$cpeek :: forall (p :: Pinning). Ptr (RawValue p) -> IO (RawValue p)
peek :: Ptr (RawValue p) -> IO (RawValue p)
$cpoke :: forall (p :: Pinning). Ptr (RawValue p) -> RawValue p -> IO ()
poke :: Ptr (RawValue p) -> RawValue p -> IO ()
Storable, Addr# -> Int# -> RawValue p
ByteArray# -> Int# -> RawValue p
Proxy (RawValue p) -> Int#
RawValue p -> Int#
(Proxy (RawValue p) -> Int#)
-> (RawValue p -> Int#)
-> (Proxy (RawValue p) -> Int#)
-> (RawValue p -> Int#)
-> (ByteArray# -> Int# -> RawValue p)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, RawValue p #))
-> (forall s.
    MutableByteArray# s -> Int# -> RawValue p -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> RawValue p -> State# s -> State# s)
-> (Addr# -> Int# -> RawValue p)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, RawValue p #))
-> (forall s. Addr# -> Int# -> RawValue p -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> RawValue p -> State# s -> State# s)
-> Prim (RawValue p)
forall s.
Addr# -> Int# -> Int# -> RawValue p -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, RawValue p #)
forall s. Addr# -> Int# -> RawValue p -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> RawValue p -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RawValue p #)
forall s.
MutableByteArray# s -> Int# -> RawValue p -> State# s -> State# s
forall a.
(Proxy a -> Int#)
-> (a -> Int#)
-> (Proxy a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
forall (p :: Pinning). Addr# -> Int# -> RawValue p
forall (p :: Pinning). ByteArray# -> Int# -> RawValue p
forall (p :: Pinning). Proxy (RawValue p) -> Int#
forall (p :: Pinning). RawValue p -> Int#
forall (p :: Pinning) s.
Addr# -> Int# -> Int# -> RawValue p -> State# s -> State# s
forall (p :: Pinning) s.
Addr# -> Int# -> State# s -> (# State# s, RawValue p #)
forall (p :: Pinning) s.
Addr# -> Int# -> RawValue p -> State# s -> State# s
forall (p :: Pinning) s.
MutableByteArray# s
-> Int# -> Int# -> RawValue p -> State# s -> State# s
forall (p :: Pinning) s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RawValue p #)
forall (p :: Pinning) s.
MutableByteArray# s -> Int# -> RawValue p -> State# s -> State# s
$csizeOfType# :: forall (p :: Pinning). Proxy (RawValue p) -> Int#
sizeOfType# :: Proxy (RawValue p) -> Int#
$csizeOf# :: forall (p :: Pinning). RawValue p -> Int#
sizeOf# :: RawValue p -> Int#
$calignmentOfType# :: forall (p :: Pinning). Proxy (RawValue p) -> Int#
alignmentOfType# :: Proxy (RawValue p) -> Int#
$calignment# :: forall (p :: Pinning). RawValue p -> Int#
alignment# :: RawValue p -> Int#
$cindexByteArray# :: forall (p :: Pinning). ByteArray# -> Int# -> RawValue p
indexByteArray# :: ByteArray# -> Int# -> RawValue p
$creadByteArray# :: forall (p :: Pinning) s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RawValue p #)
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RawValue p #)
$cwriteByteArray# :: forall (p :: Pinning) s.
MutableByteArray# s -> Int# -> RawValue p -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> RawValue p -> State# s -> State# s
$csetByteArray# :: forall (p :: Pinning) s.
MutableByteArray# s
-> Int# -> Int# -> RawValue p -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> RawValue p -> State# s -> State# s
$cindexOffAddr# :: forall (p :: Pinning). Addr# -> Int# -> RawValue p
indexOffAddr# :: Addr# -> Int# -> RawValue p
$creadOffAddr# :: forall (p :: Pinning) s.
Addr# -> Int# -> State# s -> (# State# s, RawValue p #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, RawValue p #)
$cwriteOffAddr# :: forall (p :: Pinning) s.
Addr# -> Int# -> RawValue p -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> RawValue p -> State# s -> State# s
$csetOffAddr# :: forall (p :: Pinning) s.
Addr# -> Int# -> Int# -> RawValue p -> State# s -> State# s
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> RawValue p -> State# s -> State# s
Prim)

instance Pretty (RawValue p) where
  pretty :: forall ann. RawValue p -> Doc ann
pretty = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann)
-> (RawValue p -> String) -> RawValue p -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (RawValue p) -> String
forall a. Show a => a -> String
show (Ptr (RawValue p) -> String)
-> (RawValue p -> Ptr (RawValue p)) -> RawValue p -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawValue p -> Ptr (RawValue p)
forall (p :: Pinning). RawValue p -> Ptr (RawValue p)
unRawValue

newtype instance U.MVector s (RawValue p) = MV_RawValue (P.MVector s (RawValue p))
newtype instance U.Vector    (RawValue p) = V_RawValue  (P.Vector    (RawValue p))

deriving via (U.UnboxViaPrim (RawValue p)) instance GM.MVector U.MVector (RawValue p)
deriving via (U.UnboxViaPrim (RawValue p)) instance G.Vector   U.Vector  (RawValue p)

instance U.Unbox (RawValue p)