aherrmann · October 14, 2021 12:34 · Oct 14, 2021
diff --git a/Main.hs b/Main.hs
@@ -0,0 +1,86 @@
+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
+-}
diff --git a/Main2.hs b/Main2.hs
@@ -0,0 +1,94 @@
+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
+-}