{-# LANGUAGE BangPatterns #-}
module Test.Mutagen.Lazy
(
__evaluated__
, Lazy (..)
, withLazy
, withLazyIO
)
where
import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Word (Word16, Word32, Word64, Word8)
import System.IO.Unsafe (unsafePerformIO)
import Test.Mutagen.Mutation (Pos)
__evaluated__ :: Pos -> a -> a
__evaluated__ :: forall a. Pos -> a -> a
__evaluated__ Pos
pos a
expr =
IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
Pos -> IO ()
addEvaluatedPos Pos
pos
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
expr
{-# INLINE __evaluated__ #-}
posRef :: IORef [Pos]
posRef :: IORef [Pos]
posRef = IO (IORef [Pos]) -> IORef [Pos]
forall a. IO a -> a
unsafePerformIO ([Pos] -> IO (IORef [Pos])
forall a. a -> IO (IORef a)
newIORef [])
{-# NOINLINE posRef #-}
addEvaluatedPos :: Pos -> IO ()
addEvaluatedPos :: Pos -> IO ()
addEvaluatedPos Pos
pos = IORef [Pos] -> ([Pos] -> [Pos]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [Pos]
posRef (Pos -> Pos
forall a. [a] -> [a]
reverse Pos
pos Pos -> [Pos] -> [Pos]
forall a. a -> [a] -> [a]
:)
resetPosRef :: IO ()
resetPosRef :: IO ()
resetPosRef = IORef [Pos] -> ([Pos] -> [Pos]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [Pos]
posRef ([Pos] -> [Pos] -> [Pos]
forall a b. a -> b -> a
const [])
readPosRef :: IO [Pos]
readPosRef :: IO [Pos]
readPosRef = [Pos] -> [Pos]
forall a. [a] -> [a]
reverse ([Pos] -> [Pos]) -> IO [Pos] -> IO [Pos]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef [Pos] -> IO [Pos]
forall a. IORef a -> IO a
readIORef IORef [Pos]
posRef
class Lazy a where
lazy :: a -> a
lazy = Pos -> a -> a
forall a. Lazy a => Pos -> a -> a
lazyNode []
lazyNode :: Pos -> a -> a
{-# MINIMAL lazyNode #-}
withLazy :: (Lazy a) => (a -> b) -> a -> IO ([Pos], b)
withLazy :: forall a b. Lazy a => (a -> b) -> a -> IO ([Pos], b)
withLazy a -> b
f a
a = do
IO ()
resetPosRef
let !b :: b
b = a -> b
f (a -> a
forall a. Lazy a => a -> a
lazy a
a)
ps <- IO [Pos]
readPosRef
return (ps, b)
withLazyIO :: (Lazy a) => (a -> IO b) -> a -> IO ([Pos], b)
withLazyIO :: forall a b. Lazy a => (a -> IO b) -> a -> IO ([Pos], b)
withLazyIO a -> IO b
f a
a = do
IO ()
resetPosRef
!b <- a -> IO b
f (a -> a
forall a. Lazy a => a -> a
lazy a
a)
ps <- readPosRef
return (ps, b)
instance Lazy () where
lazyNode :: Pos -> () -> ()
lazyNode = Pos -> () -> ()
forall a. Pos -> a -> a
__evaluated__
instance Lazy Int where
lazyNode :: Pos -> Int -> Int
lazyNode = Pos -> Int -> Int
forall a. Pos -> a -> a
__evaluated__
instance Lazy Double where
lazyNode :: Pos -> Double -> Double
lazyNode = Pos -> Double -> Double
forall a. Pos -> a -> a
__evaluated__
instance Lazy Float where
lazyNode :: Pos -> Float -> Float
lazyNode = Pos -> Float -> Float
forall a. Pos -> a -> a
__evaluated__
instance Lazy Word8 where
lazyNode :: Pos -> Word8 -> Word8
lazyNode = Pos -> Word8 -> Word8
forall a. Pos -> a -> a
__evaluated__
instance Lazy Word16 where
lazyNode :: Pos -> Word16 -> Word16
lazyNode = Pos -> Word16 -> Word16
forall a. Pos -> a -> a
__evaluated__
instance Lazy Word32 where
lazyNode :: Pos -> Word32 -> Word32
lazyNode = Pos -> Word32 -> Word32
forall a. Pos -> a -> a
__evaluated__
instance Lazy Word64 where
lazyNode :: Pos -> Word64 -> Word64
lazyNode = Pos -> Word64 -> Word64
forall a. Pos -> a -> a
__evaluated__
instance Lazy Char where
lazyNode :: Pos -> Char -> Char
lazyNode = Pos -> Char -> Char
forall a. Pos -> a -> a
__evaluated__
instance Lazy Bool where
lazyNode :: Pos -> Bool -> Bool
lazyNode = Pos -> Bool -> Bool
forall a. Pos -> a -> a
__evaluated__
instance (Lazy a) => Lazy (Maybe a) where
lazyNode :: Pos -> Maybe a -> Maybe a
lazyNode Pos
pre Maybe a
Nothing =
Pos -> Maybe a -> Maybe a
forall a. Pos -> a -> a
__evaluated__
Pos
pre
Maybe a
forall a. Maybe a
Nothing
lazyNode Pos
pre (Just a
a) =
Pos -> Maybe a -> Maybe a
forall a. Pos -> a -> a
__evaluated__ Pos
pre
(Maybe a -> Maybe a) -> Maybe a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (Pos -> a -> a
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
0 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) a
a)
instance (Lazy a, Lazy b) => Lazy (Either a b) where
lazyNode :: Pos -> Either a b -> Either a b
lazyNode Pos
pre (Left a
x) =
Pos -> Either a b -> Either a b
forall a. Pos -> a -> a
__evaluated__ Pos
pre
(Either a b -> Either a b) -> Either a b -> Either a b
forall a b. (a -> b) -> a -> b
$ a -> Either a b
forall a b. a -> Either a b
Left (Pos -> a -> a
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
0 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) a
x)
lazyNode Pos
pre (Right b
x) =
Pos -> Either a b -> Either a b
forall a. Pos -> a -> a
__evaluated__ Pos
pre
(Either a b -> Either a b) -> Either a b -> Either a b
forall a b. (a -> b) -> a -> b
$ b -> Either a b
forall a b. b -> Either a b
Right (Pos -> b -> b
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
0 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) b
x)
instance (Lazy a) => Lazy [a] where
lazyNode :: Pos -> [a] -> [a]
lazyNode Pos
pre [] =
Pos -> [a] -> [a]
forall a. Pos -> a -> a
__evaluated__
Pos
pre
[]
lazyNode Pos
pre (a
x : [a]
xs) =
Pos -> [a] -> [a]
forall a. Pos -> a -> a
__evaluated__
Pos
pre
(Pos -> a -> a
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
0 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Pos -> [a] -> [a]
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
1 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) [a]
xs)
instance (Lazy v) => Lazy (Map k v) where
lazyNode :: Pos -> Map k v -> Map k v
lazyNode Pos
pre Map k v
m =
(Int, Map k v) -> Map k v
forall a b. (a, b) -> b
snd ((Int -> v -> (Int, v)) -> Int -> Map k v -> (Int, Map k v)
forall a b c k. (a -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
Map.mapAccum Int -> v -> (Int, v)
forall {b}. Lazy b => Int -> b -> (Int, b)
f Int
0 Map k v
m)
where
f :: Int -> b -> (Int, b)
f Int
c b
v = (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Pos -> b -> b
forall a. Pos -> a -> a
__evaluated__ Pos
pre (Pos -> b -> b
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
c Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) b
v))
instance
(Lazy a, Lazy b)
=> Lazy (a, b)
where
lazyNode :: Pos -> (a, b) -> (a, b)
lazyNode Pos
pre (a
a, b
b) =
Pos -> (a, b) -> (a, b)
forall a. Pos -> a -> a
__evaluated__
Pos
pre
( Pos -> a -> a
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
0 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) a
a
, Pos -> b -> b
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
1 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) b
b
)
instance
(Lazy a, Lazy b, Lazy c)
=> Lazy (a, b, c)
where
lazyNode :: Pos -> (a, b, c) -> (a, b, c)
lazyNode Pos
pre (a
a, b
b, c
c) =
Pos -> (a, b, c) -> (a, b, c)
forall a. Pos -> a -> a
__evaluated__
Pos
pre
( Pos -> a -> a
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
0 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) a
a
, Pos -> b -> b
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
1 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) b
b
, Pos -> c -> c
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
2 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) c
c
)
instance
(Lazy a, Lazy b, Lazy c, Lazy d)
=> Lazy (a, b, c, d)
where
lazyNode :: Pos -> (a, b, c, d) -> (a, b, c, d)
lazyNode Pos
pre (a
a, b
b, c
c, d
d) =
Pos -> (a, b, c, d) -> (a, b, c, d)
forall a. Pos -> a -> a
__evaluated__
Pos
pre
( Pos -> a -> a
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
0 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) a
a
, Pos -> b -> b
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
1 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) b
b
, Pos -> c -> c
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
2 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) c
c
, Pos -> d -> d
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
3 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) d
d
)
instance
(Lazy a, Lazy b, Lazy c, Lazy d, Lazy e)
=> Lazy (a, b, c, d, e)
where
lazyNode :: Pos -> (a, b, c, d, e) -> (a, b, c, d, e)
lazyNode Pos
pre (a
a, b
b, c
c, d
d, e
e) =
Pos -> (a, b, c, d, e) -> (a, b, c, d, e)
forall a. Pos -> a -> a
__evaluated__
Pos
pre
( Pos -> a -> a
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
0 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) a
a
, Pos -> b -> b
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
1 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) b
b
, Pos -> c -> c
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
2 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) c
c
, Pos -> d -> d
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
3 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) d
d
, Pos -> e -> e
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
4 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) e
e
)
instance
(Lazy a, Lazy b, Lazy c, Lazy d, Lazy e, Lazy f)
=> Lazy (a, b, c, d, e, f)
where
lazyNode :: Pos -> (a, b, c, d, e, f) -> (a, b, c, d, e, f)
lazyNode Pos
pre (a
a, b
b, c
c, d
d, e
e, f
f) =
Pos -> (a, b, c, d, e, f) -> (a, b, c, d, e, f)
forall a. Pos -> a -> a
__evaluated__
Pos
pre
( Pos -> a -> a
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
0 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) a
a
, Pos -> b -> b
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
1 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) b
b
, Pos -> c -> c
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
2 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) c
c
, Pos -> d -> d
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
3 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) d
d
, Pos -> e -> e
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
4 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) e
e
, Pos -> f -> f
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
5 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) f
f
)
instance
(Lazy a, Lazy b, Lazy c, Lazy d, Lazy e, Lazy f, Lazy g)
=> Lazy (a, b, c, d, e, f, g)
where
lazyNode :: Pos -> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
lazyNode Pos
pre (a
a, b
b, c
c, d
d, e
e, f
f, g
g) =
Pos -> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
forall a. Pos -> a -> a
__evaluated__
Pos
pre
( Pos -> a -> a
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
0 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) a
a
, Pos -> b -> b
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
1 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) b
b
, Pos -> c -> c
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
2 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) c
c
, Pos -> d -> d
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
3 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) d
d
, Pos -> e -> e
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
4 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) e
e
, Pos -> f -> f
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
5 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) f
f
, Pos -> g -> g
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
6 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) g
g
)
instance
(Lazy a, Lazy b, Lazy c, Lazy d, Lazy e, Lazy f, Lazy g, Lazy h)
=> Lazy (a, b, c, d, e, f, g, h)
where
lazyNode :: Pos -> (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h)
lazyNode Pos
pre (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) =
Pos -> (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h)
forall a. Pos -> a -> a
__evaluated__
Pos
pre
( Pos -> a -> a
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
0 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) a
a
, Pos -> b -> b
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
1 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) b
b
, Pos -> c -> c
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
2 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) c
c
, Pos -> d -> d
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
3 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) d
d
, Pos -> e -> e
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
4 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) e
e
, Pos -> f -> f
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
5 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) f
f
, Pos -> g -> g
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
6 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) g
g
, Pos -> h -> h
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
7 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) h
h
)
instance
(Lazy a, Lazy b, Lazy c, Lazy d, Lazy e, Lazy f, Lazy g, Lazy h, Lazy i)
=> Lazy (a, b, c, d, e, f, g, h, i)
where
lazyNode :: Pos -> (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i)
lazyNode Pos
pre (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) =
Pos -> (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i)
forall a. Pos -> a -> a
__evaluated__
Pos
pre
( Pos -> a -> a
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
0 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) a
a
, Pos -> b -> b
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
1 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) b
b
, Pos -> c -> c
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
2 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) c
c
, Pos -> d -> d
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
3 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) d
d
, Pos -> e -> e
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
4 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) e
e
, Pos -> f -> f
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
5 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) f
f
, Pos -> g -> g
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
6 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) g
g
, Pos -> h -> h
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
7 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) h
h
, Pos -> i -> i
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
8 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) i
i
)
instance
(Lazy a, Lazy b, Lazy c, Lazy d, Lazy e, Lazy f, Lazy g, Lazy h, Lazy i, Lazy j)
=> Lazy (a, b, c, d, e, f, g, h, i, j)
where
lazyNode :: Pos
-> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j)
lazyNode Pos
pre (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) =
Pos
-> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j)
forall a. Pos -> a -> a
__evaluated__
Pos
pre
( Pos -> a -> a
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
0 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) a
a
, Pos -> b -> b
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
1 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) b
b
, Pos -> c -> c
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
2 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) c
c
, Pos -> d -> d
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
3 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) d
d
, Pos -> e -> e
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
4 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) e
e
, Pos -> f -> f
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
5 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) f
f
, Pos -> g -> g
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
6 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) g
g
, Pos -> h -> h
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
7 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) h
h
, Pos -> i -> i
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
8 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) i
i
, Pos -> j -> j
forall a. Lazy a => Pos -> a -> a
lazyNode (Int
9 Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
pre) j
j
)