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

{-# 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
import Data.Vector.Unboxed.Base qualified as U
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 = coerce :: 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
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
showList :: [RawValue p] -> ShowS
$cshowList :: forall (p :: Pinning). [RawValue p] -> ShowS
show :: RawValue p -> String
$cshow :: forall (p :: Pinning). RawValue p -> String
showsPrec :: Int -> RawValue p -> ShowS
$cshowsPrec :: forall (p :: Pinning). Int -> RawValue p -> ShowS
Show, RawValue p -> ()
forall a. (a -> ()) -> NFData a
forall (p :: Pinning). RawValue p -> ()
rnf :: RawValue p -> ()
$crnf :: forall (p :: Pinning). RawValue p -> ()
NFData, 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
$cto :: forall (p :: Pinning) x. Rep (RawValue p) x -> RawValue p
$cfrom :: forall (p :: Pinning) x. RawValue p -> Rep (RawValue p) x
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
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 ()
poke :: Ptr (RawValue p) -> RawValue p -> IO ()
$cpoke :: forall (p :: Pinning). Ptr (RawValue p) -> RawValue p -> IO ()
peek :: Ptr (RawValue p) -> IO (RawValue p)
$cpeek :: forall (p :: Pinning). Ptr (RawValue p) -> IO (RawValue p)
pokeByteOff :: forall b. Ptr b -> Int -> RawValue p -> IO ()
$cpokeByteOff :: forall (p :: Pinning) b. Ptr b -> Int -> RawValue p -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (RawValue p)
$cpeekByteOff :: forall (p :: Pinning) b. Ptr b -> Int -> IO (RawValue p)
pokeElemOff :: Ptr (RawValue p) -> Int -> RawValue p -> IO ()
$cpokeElemOff :: forall (p :: Pinning).
Ptr (RawValue p) -> Int -> RawValue p -> IO ()
peekElemOff :: Ptr (RawValue p) -> Int -> IO (RawValue p)
$cpeekElemOff :: forall (p :: Pinning). Ptr (RawValue p) -> Int -> IO (RawValue p)
alignment :: RawValue p -> Int
$calignment :: forall (p :: Pinning). RawValue p -> Int
sizeOf :: RawValue p -> Int
$csizeOf :: forall (p :: Pinning). RawValue p -> Int
Storable, Addr# -> Int# -> RawValue p
ByteArray# -> Int# -> RawValue p
RawValue p -> Int#
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.
(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). 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
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> RawValue p -> State# s -> State# s
$csetOffAddr# :: forall (p :: Pinning) s.
Addr# -> Int# -> Int# -> RawValue p -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> RawValue p -> State# s -> State# s
$cwriteOffAddr# :: forall (p :: Pinning) s.
Addr# -> Int# -> RawValue p -> State# s -> State# s
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, RawValue p #)
$creadOffAddr# :: forall (p :: Pinning) s.
Addr# -> Int# -> State# s -> (# State# s, RawValue p #)
indexOffAddr# :: Addr# -> Int# -> RawValue p
$cindexOffAddr# :: forall (p :: Pinning). Addr# -> Int# -> RawValue p
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> RawValue p -> State# s -> State# s
$csetByteArray# :: forall (p :: Pinning) s.
MutableByteArray# s
-> Int# -> Int# -> RawValue p -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> RawValue p -> State# s -> State# s
$cwriteByteArray# :: forall (p :: Pinning) s.
MutableByteArray# s -> Int# -> RawValue p -> State# s -> State# s
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RawValue p #)
$creadByteArray# :: forall (p :: Pinning) s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RawValue p #)
indexByteArray# :: ByteArray# -> Int# -> RawValue p
$cindexByteArray# :: forall (p :: Pinning). ByteArray# -> Int# -> RawValue p
alignment# :: RawValue p -> Int#
$calignment# :: forall (p :: Pinning). RawValue p -> Int#
sizeOf# :: RawValue p -> Int#
$csizeOf# :: forall (p :: Pinning). RawValue p -> Int#
Prim)

instance Pretty (RawValue p) where
  pretty :: forall ann. RawValue p -> Doc ann
pretty = forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)