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
|
import Control.Lens
import Control.Monad
import Criterion.Main
import Data.IORef
data RecC = RecC
{ _c0, _c1, _c2, _c3, _c4 :: !Int }
deriving (Show)
makeLenses ''RecC
data RecB = RecB
{ _b0, _b1, _b2, _b3, _b4 :: !RecC }
deriving (Show)
makeLenses ''RecB
data RecA = RecA
{ _a0, _a1, _a2, _a3, _a4 :: !RecB }
deriving (Show)
makeLenses ''RecA
data Tree a = Nil | Node !a !(Tree a) !(Tree a)
instance Show a => Show (Tree a) where
show Nil = "Nil"
show (Node x left right) = "Node " ++ show x ++ show left ++ " .."
inTree :: Int -> (a -> a) -> Tree a -> Tree a
inTree 0 f (Node x left right) = Node (f x) left right
inTree n f (Node x left right) = Node x (inTree (n1) f left) right
updateRec :: Int -> IORef (Tree RecA) -> IO ()
updateRec depth ref = replicateM_ 10000 $ do
modifyIORef' ref $ inTree depth updateRecord
return ()
where
updateRecord record =
record
& a0.b0.c0 +~ record^.a1.b2.c0
& a0.b0.c1 +~ record^.a1.b2.c1
& a0.b0.c2 +~ record^.a1.b2.c2
& a0.b0.c3 +~ record^.a1.b2.c3
& a0.b0.c4 +~ record^.a1.b2.c4
& a0.b0.c3 +~ 1
& a0.b1.c0 +~ 1
& a0.b1.c1 +~ 2
& a0.b1.c2 +~ 3
& a0.b1.c3 +~ 4
& a0.b1.c4 +~ 5
& a0.b1.c3 +~ 1
& a1.b2.c0 +~ 1
& a1.b2.c1 +~ 2
& a1.b2.c2 +~ 3
& a1.b2.c3 +~ 4
& a1.b2.c4 +~ 5
& a1.b2.c3 +~ 1
mkTree :: Int -> a -> Tree a
mkTree 0 x = Nil
mkTree n x = Node x (mkTree (n1) x) (mkTree (n1) x)
main :: IO ()
main = do
let c = RecC 0 1 2 3 4
b = RecB c c c c c
a = RecA b b b b b
depth = 15
ref <- newIORef $ mkTree (1+depth) a
defaultMain [
bench "Update fields" $ updateRec depth ref
]
readIORef ref >>= print
|