From 57a55d2b9d97496ac4544d7c047e6f1d76d1f4a9 Mon Sep 17 00:00:00 2001 From: Jan Sucan Date: Tue, 30 Sep 2025 08:32:00 +0200 Subject: 24_a_2: Add solution --- ch24/Module_24_a_2.hs | 163 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 163 insertions(+) create mode 100644 ch24/Module_24_a_2.hs (limited to 'ch24/Module_24_a_2.hs') diff --git a/ch24/Module_24_a_2.hs b/ch24/Module_24_a_2.hs new file mode 100644 index 0000000..9797a3c --- /dev/null +++ b/ch24/Module_24_a_2.hs @@ -0,0 +1,163 @@ +-- Although we've already mentioned the existence of the strict-concurrency +-- package in the Hackage repository, try developing your own, as a wrapper +-- around the built-in MVar type. Following classic Haskell practice, make your +-- library type safe, so that users cannot accidentally mix uses of strict and +-- non-strict MVars. + + +-- The strict-concurrency package contains strict MVar and Chan. For simplicity, +-- I will +-- - implement only +-- - newEmptyMVar, newMVar, takeMVar, and putMVar +-- - newChan, writeChan, and readChan + +-- - not mimic the strict-concurrency functions completely, to avoid dealing +-- with the NFData typeclass and normal forms +-- +-- I assume that the classic Haskell practice means making sure that the users +-- cannot just simply change the import from the non-strict versions to strict +-- ones with the code still compiling. + + +module Module_24_a_2 + ( + StrictMVar + , Module_24_a_2.newStrictEmptyMVar + , Module_24_a_2.newStrictMVar + , Module_24_a_2.takeMVar + , Module_24_a_2.putMVar + , StrictChan + , Module_24_a_2.newStrictChan + , Module_24_a_2.writeChan + , Module_24_a_2.readChan + ) where + +import Control.Concurrent.MVar as NSM +import Control.Concurrent.Chan as NSC + + +newtype StrictMVar a = StrictM (MVar a) + +unwrapStrictMVar :: StrictMVar a -> MVar a +unwrapStrictMVar (StrictM m) = m + +newStrictEmptyMVar :: IO (StrictMVar a) +newStrictEmptyMVar = StrictM <$> NSM.newEmptyMVar + +newStrictMVar :: a -> IO (StrictMVar a) +newStrictMVar val = val `seq` StrictM <$> NSM.newMVar val + +takeMVar :: StrictMVar a -> IO a +takeMVar m = NSM.takeMVar $ unwrapStrictMVar m + +putMVar :: StrictMVar a -> a -> IO () +putMVar m val = val `seq` NSM.putMVar (unwrapStrictMVar m) val + + +newtype StrictChan a = StrictC (Chan a) + +unwrapStrictChan :: StrictChan a -> Chan a +unwrapStrictChan (StrictC c) = c + +newStrictChan :: IO (StrictChan a) +newStrictChan = StrictC <$> NSC.newChan + +writeChan :: StrictChan a -> a -> IO () +writeChan c val = val `seq` NSC.writeChan (unwrapStrictChan c) val + +readChan :: StrictChan a -> IO a +readChan c = NSC.readChan (unwrapStrictChan c) + + +-- To test this module better (information hiding offered by the export +-- functionality), it is imported in the test_24_a_2.hs instead of loaded into +-- ghci. The test source file contains commented-out sections of code I will +-- uncomment individually (with uncommenting the relevant import statement) when +-- performing the tests. + + + + +-- Tests with non-strict versions (the Control.Concurrent module) + +-- ghci> :l test_24_a_2.hs +-- [1 of 2] Compiling Main ( test_24_a_2.hs, interpreted ) +-- test_24_a_2.hs:26:8: error: [GHC-88464] +-- Variable not in scope: newStrictEmptyMVar :: IO (MVar a1) +-- | +-- 26 | x <- newStrictEmptyMVar +-- | ^^^^^^^^^^^^^^^^^^ +-- +-- test_24_a_2.hs:32:8: error: [GHC-88464] +-- Variable not in scope: newStrictChan :: IO (Chan a0) +-- | +-- 32 | x <- newStrictChan +-- | ^^^^^^^^^^^^^ +-- +-- Failed, unloaded all modules. + + +-- ghci> :l test_24_a_2.hs +-- [1 of 2] Compiling Main ( test_24_a_2.hs, interpreted ) +-- Ok, one module loaded. +-- ghci> m1NonStrict +-- ghci> m2NonStrict +-- ghci> cNonStrict + + + + +-- Tests with strict versions (this module) + +-- ghci> :l test_24_a_2.hs +-- [1 of 3] Compiling Module_24_a_2 ( Module_24_a_2.hs, interpreted ) +-- [2 of 3] Compiling Main ( test_24_a_2.hs, interpreted ) +-- Ok, two modules loaded. +-- ghci> mTypeConstructorAccessible +-- ghci> cTypeConstructorAccessible + + +-- ghci> :l test_24_a_2.hs +-- [1 of 3] Compiling Module_24_a_2 ( Module_24_a_2.hs, interpreted ) +-- [2 of 3] Compiling Main ( test_24_a_2.hs, interpreted ) +-- test_24_a_2.hs:16:9: error: [GHC-76037] +-- Not in scope: data constructor ‘StrictM’ +-- | +-- 16 | StrictM j -> undefined +-- | ^^^^^^^ +-- +-- test_24_a_2.hs:20:9: error: [GHC-76037] +-- Not in scope: data constructor ‘StrictC’ +-- | +-- 20 | StrictC j -> undefined +-- | ^^^^^^^ +-- +-- Failed, one module loaded. + + +-- ghci> :l test_24_a_2.hs +-- [1 of 3] Compiling Module_24_a_2 ( Module_24_a_2.hs, interpreted ) +-- [2 of 3] Compiling Main ( test_24_a_2.hs, interpreted ) +-- Ok, two modules loaded. +-- ghci> mStrict +-- 1 +-- ghci> cStrict +-- 2 + + +-- ghci> :l test_24_a_2.hs +-- [1 of 3] Compiling Module_24_a_2 ( Module_24_a_2.hs, interpreted ) +-- [2 of 3] Compiling Main ( test_24_a_2.hs, interpreted ) +-- Ok, two modules loaded. +-- ghci> m1Strict +-- *** Exception: Prelude.undefined +-- CallStack (from HasCallStack): +-- undefined, called at test_24_a_2.hs:59:14 in main:Main +-- ghci> m2Strict +-- *** Exception: Prelude.undefined +-- CallStack (from HasCallStack): +-- undefined, called at test_24_a_2.hs:63:23 in main:Main +-- ghci> cStrict +-- *** Exception: Prelude.undefined +-- CallStack (from HasCallStack): +-- undefined, called at test_24_a_2.hs:68:15 in main:Main -- cgit v1.2.3