GHC in-place updates

Main.hs

module Main where

import Control.Monad.State.Strict
import Control.Monad.ST
import Debug.Trace (trace)

data S = S { property :: String }

main :: IO ()
main = flip evalStateT S { property = trace "read 0" "state 0" } $ do
  liftIO $ putStrLn "1"
  p0 <- gets property
  let msg0 = trace "msg 0" $ "p0: " ++ p0
  liftIO $ putStrLn "2"
  modify' $ \s -> s { property = trace "read 1" "state 1" }
  liftIO $ putStrLn "3"
  p1 <- gets property
  let msg1 = trace "msg 1" $ "p1: " ++ p1
  liftIO $ putStrLn "4"
  modify' $ \s -> s { property = trace "read 2" "state 2" }
  liftIO $ putStrLn "5"
  p2 <- gets property
  let msg2 = trace "msg 2" $ "p2: " ++ p2
  liftIO $ putStrLn "6"
  liftIO $ putStrLn $ "msg1: " ++ msg1 ++ "\nmsg2: " ++ msg2 ++ "\nmsg0: " ++ msg0
  liftIO $ putStrLn "7"

{-
$ nix-shell -p "haskell.packages.ghc8104.ghcWithPackages (ps: [ ps.vector ])"

$ ghc Main -package base -package mtl && ./Main
1
2
3
4
5
6
msg 1
read 1
msg1: p1: state 1
msg 2
read 2
msg2: p2: state 2
msg 0
read 0
msg0: p0: state 0
7


$ ghc Main -XStrictData -package base -package mtl && ./Main
1
2
read 0
read 1
3
4
read 2
5
6
msg 1
msg1: p1: state 1
msg 2
msg2: p2: state 2
msg 0
msg0: p0: state 0
7


$ ghc Main -XStrict -package base -package mtl && ./Main
1
read 0
msg 0
2
read 1
3
msg 1
4
read 2
5
msg 2
6
msg1: p1: state 1
msg2: p2: state 2
msg0: p0: state 0
7
-}

Main2.hs

module Main where

import Control.Monad.State.Strict
import Control.Monad.ST
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import Debug.Trace (trace)

unsafeInplaceWrite :: Int -> a -> V.Vector a -> V.Vector a
unsafeInplaceWrite ix x v = runST $ do
  mv <- V.unsafeThaw v
  MV.write mv ix x
  V.unsafeFreeze mv

data S = S { property :: V.Vector Int }

main :: IO ()
main = flip evalStateT S { property = trace "read 0" $ V.fromList [0, 0, 0] } $ do
  liftIO $ putStrLn "1"
  p0 <- gets property
  let msg0 = trace "msg 0" $ "p0: " ++ show p0
  liftIO $ putStrLn "2"
  modify' $ \s -> s { property = trace "read 1" $ unsafeInplaceWrite 1 1 (property s) }
  liftIO $ putStrLn "3"
  p1 <- gets property
  let msg1 = trace "msg 1" $ "p1: " ++ show p1
  liftIO $ putStrLn "4"
  modify' $ \s -> s { property = trace "read 2" $ unsafeInplaceWrite 2 2 (property s) }
  liftIO $ putStrLn "5"
  p2 <- gets property
  let msg2 = trace "msg 2" $ "p2: " ++ show p2
  liftIO $ putStrLn "6"
  liftIO $ putStrLn $ "msg1: " ++ msg1 ++ "\nmsg2: " ++ msg2 ++ "\nmsg0: " ++ msg0
  liftIO $ putStrLn "7"
  
{-
$ nix-shell -p "haskell.packages.ghc8104.ghcWithPackages (ps: [ ps.vector ])"

$ ghc Main2 -package base -package mtl && ./Main2
1
2
3
4
5
6
msg 1
read 1
read 0
msg1: p1: [0,1,0]
msg 2
read 2
msg2: p2: [0,1,2]
msg 0
msg0: p0: [0,1,2]
7


$ ghc Main2 -XStrictData -package base -package mtl && ./Main2
1
2
read 0
read 1
3
4
read 2
5
6
msg 1
msg1: p1: [0,1,2]
msg 2
msg2: p2: [0,1,2]
msg 0
msg0: p0: [0,1,2]
7


$ ghc Main2 -XStrict -package base -package mtl && ./Main2
1
read 0
msg 0
2
read 1
3
msg 1
4
read 2
5
msg 2
6
msg1: p1: [0,1,2]
msg2: p2: [0,1,2]
msg0: p0: [0,1,2]
7
-}