{-# LANGUAGE MagicHash, UnboxedTuples #-}

-- | Functions for working with GHC's compact regions.
--
-- This module is intended to be imported qualified as:
--
-- @
-- import Mikan.Utils.CompactRegion qualified as Compact
-- @
module Mikan.Utils.CompactRegion
  ( Compact
  , new
  , add
  , compact
  )
  where
import Control.DeepSeq

import GHC.Exts
import GHC.Types
import GHC.Word

import System.IO.Unsafe (unsafePerformIO)

-- | A handle to a compact region.
data Compact = Compact Compact#

instance NFData Compact where
  rnf :: Compact -> ()
rnf !Compact
x = ()

{-# INLINE new #-}
-- | Create a new compact region with given initial block size.
new :: Word -> IO Compact
new :: Word -> IO Compact
new (W# Word#
size) = (State# RealWorld -> (# State# RealWorld, Compact #)) -> IO Compact
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO \State# RealWorld
s -> case Word# -> State# RealWorld -> (# State# RealWorld, Compact# #)
compactNew# Word#
size State# RealWorld
s of
  (# State# RealWorld
s, Compact#
com #) -> (# State# RealWorld
s, Compact# -> Compact
Compact Compact#
com #)

{-# INLINE add #-}
-- | Deeply evaluate a value and add it to a compact region.
--
--
-- __Warning__: This function is NOT thread-safe.
-- Users are responsible for enforcing mutual exclusion.
add :: Compact -> a -> IO a
add :: forall a. Compact -> a -> IO a
add (Compact Compact#
com) a
a = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
forall a.
Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
compactAdd# Compact#
com a
a)

{-# NOINLINE compact #-}
-- | Deeply evaluate a value and place it in a fresh compact region with
-- a given initial block size.
--
-- If the structure contains any internal sharing, the shared data will
-- be duplicated during compaction. Moreover, 'compact' will not terminate
-- if the value contains any cycles.
--
-- The value must not contain any functions or data with mutable pointers; if
-- it does, 'compact' will raise an exception.
compact :: Word -> a -> a
compact :: forall a. Word -> a -> a
compact Word
size a
a =
  -- We cannot use 'unsafeDupablePerformIO' here, as 'add' is not
  -- thread safe.
  IO a -> a
forall a. IO a -> a
unsafePerformIO do
  !arena <- Word -> IO Compact
new Word
size
  add arena a