1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Compact
-- Copyright : (c) The University of Glasgow 2001-2009
-- (c) Giovanni Campagna <gcampagn@cs.stanford.edu> 2014
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : unstable
-- Portability : non-portable (GHC Extensions)
--
-- This module provides a data structure, called a Compact, for
-- holding fully evaluated data in a consecutive block of memory.
--
-- /Since: 1.0.0/
module Data.Compact (
Compact,
getCompact,
inCompact,
isCompact,
newCompact,
newCompactNoShare,
appendCompact,
appendCompactNoShare,
) where
-- Write down all GHC.Prim deps explicitly to keep them at minimum
import GHC.Prim (Compact#,
compactNew#,
State#,
RealWorld,
Int#,
)
-- We need to import Word from GHC.Types to see the representation
-- and to able to access the Word# to pass down the primops
import GHC.Types (IO(..), Word(..))
import Control.DeepSeq (NFData, force)
import Data.Compact.Internal(Compact(..),
isCompact,
inCompact,
compactAppendEvaledInternal)
-- |Retrieve the object that was stored in a Compact
getCompact :: Compact a -> a
getCompact (Compact _ obj) = obj
compactAppendInternal :: NFData a => Compact# -> a -> Int# ->
State# RealWorld -> (# State# RealWorld, Compact a #)
compactAppendInternal buffer root share s =
case force root of
!eval -> compactAppendEvaledInternal buffer eval share s
compactAppendInternalIO :: NFData a => Int# -> Compact b -> a -> IO (Compact a)
compactAppendInternalIO share (Compact buffer _) root =
IO (\s -> compactAppendInternal buffer root share s)
-- |Append a value to a 'Compact', and return a new 'Compact'
-- that shares the same buffer but a different root object.
appendCompact :: NFData a => Compact b -> a -> IO (Compact a)
appendCompact = compactAppendInternalIO 1#
-- |Append a value to a 'Compact'. This function differs from
-- 'appendCompact' in that it will not preserve internal sharing
-- in the passed in value (and it will diverge on cyclic structures).
appendCompactNoShare :: NFData a => Compact b -> a -> IO (Compact a)
appendCompactNoShare = compactAppendInternalIO 0#
compactNewInternal :: NFData a => Int# -> Word -> a -> IO (Compact a)
compactNewInternal share (W# size) root =
IO (\s -> case compactNew# size s of
(# s', buffer #) -> compactAppendInternal buffer root share s' )
-- |Create a new 'Compact', with the provided value as suggested block
-- size (which will be adjusted if unsuitable), and append the given
-- value to it, as if calling 'appendCompact'
newCompact :: NFData a => Word -> a -> IO (Compact a)
newCompact = compactNewInternal 1#
-- |Create a new 'Compact', but append the value using 'appendCompactNoShare'
newCompactNoShare :: NFData a => Word -> a -> IO (Compact a)
newCompactNoShare = compactNewInternal 0#
|
