git.iko.soy/reflex
on develop help sign in
Make fast-weak optional
f0b5e75Ryan Trinkle
reflex.cabal+8
compare with develop
unifiedsplit
@@ -43,6 +43,11 @@ flag experimental-dependent-sum-instances
43 default: False
43 default: False
44 manual: True
44 manual: True
45
45
46+flag fast-weak
47+ description: Use the primitive implementation of FastWeak in GHCJS; note that this requires GHCJS to be built with FastWeak and FastWeakBag present in the RTS, which is not the default
48+ default: False
49+ manual: True
50+
46library
51library
47 hs-source-dirs: src
52 hs-source-dirs: src
48 build-depends:
53 build-depends:
@@ -142,6 +147,9 @@ library
142 if flag(experimental-dependent-sum-instances)
147 if flag(experimental-dependent-sum-instances)
143 ghc-options: -DEXPERIMENTAL_DEPENDENT_SUM_INSTANCES
148 ghc-options: -DEXPERIMENTAL_DEPENDENT_SUM_INSTANCES
144
149
150+ if flag(fast-weak) && impl(ghcjs)
151+ ghc-options: -DGHCJS_FAST_WEAK
152+
145 if impl(ghcjs)
153 if impl(ghcjs)
146 build-depends: ghcjs-base
154 build-depends: ghcjs-base
147
155
src/Data/FastWeakBag.hs+10−10
@@ -3,7 +3,7 @@
3#ifdef USE_REFLEX_OPTIMIZER
3#ifdef USE_REFLEX_OPTIMIZER
4{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
4{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
5#endif
5#endif
6−#ifdef ghcjs_HOST_OS
6+#ifdef GHCJS_FAST_WEAK
7{-# LANGUAGE ForeignFunctionInterface #-}
7{-# LANGUAGE ForeignFunctionInterface #-}
8{-# LANGUAGE JavaScriptFFI #-}
8{-# LANGUAGE JavaScriptFFI #-}
9#endif
9#endif
@@ -21,7 +21,7 @@ module Data.FastWeakBag
21 , remove
21 , remove
22 -- * Internal functions
22 -- * Internal functions
23 -- These will not always be available.
23 -- These will not always be available.
24−#ifndef ghcjs_HOST_OS
24+#ifndef GHCJS_FAST_WEAK
25 , _weakBag_children --TODO: Don't export this
25 , _weakBag_children --TODO: Don't export this
26#endif
26#endif
27 ) where
27 ) where
@@ -29,7 +29,7 @@ module Data.FastWeakBag
29import Control.Monad hiding (forM_, mapM_)
29import Control.Monad hiding (forM_, mapM_)
30import Control.Monad.IO.Class
30import Control.Monad.IO.Class
31
31
32−#ifdef ghcjs_HOST_OS
32+#ifdef GHCJS_FAST_WEAK
33import GHCJS.Types
33import GHCJS.Types
34import Reflex.FastWeak (unsafeFromRawJSVal, unsafeToRawJSVal, js_isNull)
34import Reflex.FastWeak (unsafeFromRawJSVal, unsafeToRawJSVal, js_isNull)
35#else
35#else
@@ -46,7 +46,7 @@ import Prelude hiding (mapM_, traverse)
46-- | A @FastWeakBag a@ holds a set of values of type @a@, but does not retain them -
46-- | A @FastWeakBag a@ holds a set of values of type @a@, but does not retain them -
47-- that is, they can still be garbage-collected. As long as the @a@s remain
47-- that is, they can still be garbage-collected. As long as the @a@s remain
48-- alive, the 'FastWeakBag' will continue to refer to them.
48-- alive, the 'FastWeakBag' will continue to refer to them.
49−#ifdef ghcjs_HOST_OS
49+#ifdef GHCJS_FAST_WEAK
50newtype FastWeakBag a = FastWeakBag JSVal
50newtype FastWeakBag a = FastWeakBag JSVal
51#else
51#else
52data FastWeakBag a = FastWeakBag
52data FastWeakBag a = FastWeakBag
@@ -59,7 +59,7 @@ data FastWeakBag a = FastWeakBag
59-- the caller retains the ticket, the item is guranteed to stay in memory (and
59-- the caller retains the ticket, the item is guranteed to stay in memory (and
60-- thus in the 'FastWeakBag'). The ticket can also be used to remove the item from
60-- thus in the 'FastWeakBag'). The ticket can also be used to remove the item from
61-- the 'FastWeakBag' prematurely (i.e. while it is still alive), using 'remove'.
61-- the 'FastWeakBag' prematurely (i.e. while it is still alive), using 'remove'.
62−#ifdef ghcjs_HOST_OS
62+#ifdef GHCJS_FAST_WEAK
63newtype FastWeakBagTicket a = FastWeakBagTicket JSVal
63newtype FastWeakBagTicket a = FastWeakBagTicket JSVal
64#else
64#else
65data FastWeakBagTicket a = FastWeakBagTicket
65data FastWeakBagTicket a = FastWeakBagTicket
@@ -74,7 +74,7 @@ insert :: a -- ^ The item
74 -> FastWeakBag a -- ^ The 'FastWeakBag' to insert into
74 -> FastWeakBag a -- ^ The 'FastWeakBag' to insert into
75 -> IO (FastWeakBagTicket a) -- ^ Returns a 'FastWeakBagTicket' that ensures the item
75 -> IO (FastWeakBagTicket a) -- ^ Returns a 'FastWeakBagTicket' that ensures the item
76 -- is retained and allows the item to be removed.
76 -- is retained and allows the item to be removed.
77−#ifdef ghcjs_HOST_OS
77+#ifdef GHCJS_FAST_WEAK
78insert a wb = js_insert (unsafeToRawJSVal a) wb
78insert a wb = js_insert (unsafeToRawJSVal a) wb
79foreign import javascript unsafe "$r = new h$FastWeakBagTicket($2, $1);" js_insert :: JSVal -> FastWeakBag a -> IO (FastWeakBagTicket a)
79foreign import javascript unsafe "$r = new h$FastWeakBagTicket($2, $1);" js_insert :: JSVal -> FastWeakBag a -> IO (FastWeakBagTicket a)
80#else
80#else
@@ -93,7 +93,7 @@ insert a (FastWeakBag nextId children) = {-# SCC "insert" #-} do
93-- | Create an empty 'FastWeakBag'.
93-- | Create an empty 'FastWeakBag'.
94{-# INLINE empty #-}
94{-# INLINE empty #-}
95empty :: IO (FastWeakBag a)
95empty :: IO (FastWeakBag a)
96−#ifdef ghcjs_HOST_OS
96+#ifdef GHCJS_FAST_WEAK
97empty = js_empty
97empty = js_empty
98foreign import javascript unsafe "$r = new h$FastWeakBag();" js_empty :: IO (FastWeakBag a)
98foreign import javascript unsafe "$r = new h$FastWeakBag();" js_empty :: IO (FastWeakBag a)
99#else
99#else
@@ -110,7 +110,7 @@ empty = {-# SCC "empty" #-} do
110-- | Check whether a 'FastWeakBag' is empty.
110-- | Check whether a 'FastWeakBag' is empty.
111{-# INLINE isEmpty #-}
111{-# INLINE isEmpty #-}
112isEmpty :: FastWeakBag a -> IO Bool
112isEmpty :: FastWeakBag a -> IO Bool
113−#ifdef ghcjs_HOST_OS
113+#ifdef GHCJS_FAST_WEAK
114isEmpty = js_isEmpty
114isEmpty = js_isEmpty
115foreign import javascript unsafe "(function(){ for(var i = 0; i < $1.tickets.length; i++) { if($1.tickets[i] !== null) { return false; } }; return true; })()" js_isEmpty :: FastWeakBag a -> IO Bool --TODO: Clean up as we go along so this isn't O(n) every time
115foreign import javascript unsafe "(function(){ for(var i = 0; i < $1.tickets.length; i++) { if($1.tickets[i] !== null) { return false; } }; return true; })()" js_isEmpty :: FastWeakBag a -> IO Bool --TODO: Clean up as we go along so this isn't O(n) every time
116#else
116#else
@@ -123,7 +123,7 @@ isEmpty bag = {-# SCC "isEmpty" #-} IntMap.null <$> readIORef (_weakBag_children
123-- when the traversal began will be visited exactly once; however, no guarantee
123-- when the traversal began will be visited exactly once; however, no guarantee
124-- is made about the order of the traversal.
124-- is made about the order of the traversal.
125traverse :: forall a m. MonadIO m => FastWeakBag a -> (a -> m ()) -> m ()
125traverse :: forall a m. MonadIO m => FastWeakBag a -> (a -> m ()) -> m ()
126−#ifdef ghcjs_HOST_OS
126+#ifdef GHCJS_FAST_WEAK
127traverse wb f = do
127traverse wb f = do
128 let go cursor = when (not $ js_isNull cursor) $ do
128 let go cursor = when (not $ js_isNull cursor) $ do
129 val <- liftIO $ js_getTicketValue cursor
129 val <- liftIO $ js_getTicketValue cursor
@@ -146,7 +146,7 @@ traverse (FastWeakBag _ children) f = {-# SCC "traverse" #-} do
146-- on the same 'FastWeakBagTicket'.
146-- on the same 'FastWeakBagTicket'.
147{-# INLINE remove #-}
147{-# INLINE remove #-}
148remove :: FastWeakBagTicket a -> IO ()
148remove :: FastWeakBagTicket a -> IO ()
149−#ifdef ghcjs_HOST_OS
149+#ifdef GHCJS_FAST_WEAK
150remove = js_remove
150remove = js_remove
151foreign import javascript unsafe "$1.bag.tickets[$1.pos] = null; $1.bag = new h$FastWeakBag(); $1.bag.tickets.push($1); $1.pos = 0;" js_remove :: FastWeakBagTicket a -> IO () --TODO: Don't bother with the new surrogate FastWeakBag; instead, make the GC check for bag === null, and then null it out here
151foreign import javascript unsafe "$1.bag.tickets[$1.pos] = null; $1.bag = new h$FastWeakBag(); $1.bag.tickets.push($1); $1.pos = 0;" js_remove :: FastWeakBagTicket a -> IO () --TODO: Don't bother with the new surrogate FastWeakBag; instead, make the GC check for bag === null, and then null it out here
152#else
152#else
src/Reflex/FastWeak.hs+10−10
@@ -1,7 +1,7 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE LambdaCase #-}
2{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4−#ifdef ghcjs_HOST_OS
4+#if GHCJS_FAST_WEAK
5{-# LANGUAGE ForeignFunctionInterface #-}
5{-# LANGUAGE ForeignFunctionInterface #-}
6{-# LANGUAGE JavaScriptFFI #-}
6{-# LANGUAGE JavaScriptFFI #-}
7#endif
7#endif
@@ -14,7 +14,7 @@ module Reflex.FastWeak
14 , getFastWeakValue
14 , getFastWeakValue
15 , getFastWeakTicket
15 , getFastWeakTicket
16 , emptyFastWeak
16 , emptyFastWeak
17−#ifdef ghcjs_HOST_OS
17+#ifdef GHCJS_FAST_WEAK
18 --TODO: Move these elsewhere
18 --TODO: Move these elsewhere
19 , unsafeFromRawJSVal
19 , unsafeFromRawJSVal
20 , unsafeToRawJSVal
20 , unsafeToRawJSVal
@@ -25,7 +25,7 @@ module Reflex.FastWeak
25import GHC.Exts (Any)
25import GHC.Exts (Any)
26import Unsafe.Coerce
26import Unsafe.Coerce
27
27
28−#ifdef ghcjs_HOST_OS
28+#ifdef GHCJS_FAST_WEAK
29import GHCJS.Types
29import GHCJS.Types
30#else
30#else
31import Control.Exception (evaluate)
31import Control.Exception (evaluate)
@@ -34,7 +34,7 @@ import System.Mem.Weak
34#endif
34#endif
35
35
36
36
37−#ifdef ghcjs_HOST_OS
37+#ifdef GHCJS_FAST_WEAK
38newtype FastWeakTicket a = FastWeakTicket JSVal
38newtype FastWeakTicket a = FastWeakTicket JSVal
39
39
40newtype FastWeak a = FastWeak JSVal
40newtype FastWeak a = FastWeak JSVal
@@ -59,7 +59,7 @@ type FastWeak a = Weak a
59
59
60-- This needs to be in IO so we know that we've relinquished the ticket
60-- This needs to be in IO so we know that we've relinquished the ticket
61getFastWeakTicketValue :: FastWeakTicket a -> IO a
61getFastWeakTicketValue :: FastWeakTicket a -> IO a
62−#ifdef ghcjs_HOST_OS
62+#ifdef GHCJS_FAST_WEAK
63getFastWeakTicketValue t = do
63getFastWeakTicketValue t = do
64 v <- js_ticketVal t
64 v <- js_ticketVal t
65 return $ unsafeFromRawJSVal v
65 return $ unsafeFromRawJSVal v
@@ -70,7 +70,7 @@ getFastWeakTicketValue = return . _fastWeakTicket_val
70#endif
70#endif
71
71
72getFastWeakValue :: FastWeak a -> IO (Maybe a)
72getFastWeakValue :: FastWeak a -> IO (Maybe a)
73−#ifdef ghcjs_HOST_OS
73+#ifdef GHCJS_FAST_WEAK
74getFastWeakValue w = do
74getFastWeakValue w = do
75 r <- js_weakVal w
75 r <- js_weakVal w
76 case js_isNull r of
76 case js_isNull r of
@@ -85,7 +85,7 @@ getFastWeakValue = deRefWeak
85#endif
85#endif
86
86
87getFastWeakTicket :: forall a. FastWeak a -> IO (Maybe (FastWeakTicket a))
87getFastWeakTicket :: forall a. FastWeak a -> IO (Maybe (FastWeakTicket a))
88−#ifdef ghcjs_HOST_OS
88+#ifdef GHCJS_FAST_WEAK
89getFastWeakTicket w = do
89getFastWeakTicket w = do
90 r <- js_weakTicket w
90 r <- js_weakTicket w
91 case js_isNull r of
91 case js_isNull r of
@@ -105,7 +105,7 @@ getFastWeakTicket w = do
105
105
106-- I think it's fine if this is lazy - it'll retain the 'a', but so would the output; we just need to make sure it's forced before we start relying on the associated FastWeak to actually be weak
106-- I think it's fine if this is lazy - it'll retain the 'a', but so would the output; we just need to make sure it's forced before we start relying on the associated FastWeak to actually be weak
107mkFastWeakTicket :: a -> IO (FastWeakTicket a)
107mkFastWeakTicket :: a -> IO (FastWeakTicket a)
108−#ifdef ghcjs_HOST_OS
108+#ifdef GHCJS_FAST_WEAK
109mkFastWeakTicket v = js_fastWeakTicket (unsafeToRawJSVal v)
109mkFastWeakTicket v = js_fastWeakTicket (unsafeToRawJSVal v)
110
110
111foreign import javascript unsafe "$r = new h$FastWeakTicket($1);" js_fastWeakTicket :: JSVal -> IO (FastWeakTicket a)
111foreign import javascript unsafe "$r = new h$FastWeakTicket($1);" js_fastWeakTicket :: JSVal -> IO (FastWeakTicket a)
@@ -120,7 +120,7 @@ mkFastWeakTicket v = do
120#endif
120#endif
121
121
122-- Needs IO so that it can force the value - otherwise, could end up with a reference to the Ticket, which would retain the value
122-- Needs IO so that it can force the value - otherwise, could end up with a reference to the Ticket, which would retain the value
123−#ifdef ghcjs_HOST_OS
123+#ifdef GHCJS_FAST_WEAK
124foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
124foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
125#else
125#else
126getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
126getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
@@ -131,7 +131,7 @@ getFastWeakTicketWeak = return . _fastWeakTicket_weak
131emptyFastWeak :: FastWeak a
131emptyFastWeak :: FastWeak a
132emptyFastWeak = unsafeCoerce w
132emptyFastWeak = unsafeCoerce w
133 where w :: FastWeak Any
133 where w :: FastWeak Any
134−#ifdef ghcjs_HOST_OS
134+#ifdef GHCJS_FAST_WEAK
135 w = js_emptyWeak
135 w = js_emptyWeak
136foreign import javascript unsafe "$r = new h$FastWeak(null);" js_emptyWeak :: FastWeak Any
136foreign import javascript unsafe "$r = new h$FastWeak(null);" js_emptyWeak :: FastWeak Any
137#else
137#else