diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,3 +3,21 @@ ## 0.1.0.0 -- YYYY-mm-dd * First version. Released on an unsuspecting world. + +## 0.2.0.0 -- 2023-04-14 + +* Use a StrictValueExtractor instead of a raw Strict. + +This avoid a common pitfall where let bound destructuring will fallback to +lazy semantics. This way we force the use to bound the two values with +names. Any inconsistency will be reported by +-Werror=unbanged-strict-patterns . + +* Use a strict tuple type called Pairy + +We have more oportunities to trigger evaluation like that. + +* Give a good tutorial + +I am pretty proud of it. + diff --git a/data-forced.cabal b/data-forced.cabal --- a/data-forced.cabal +++ b/data-forced.cabal @@ -1,11 +1,13 @@ cabal-version: 3.0 name: data-forced -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Specify that lifted values were forced to WHNF or NF. license: MIT license-file: LICENSE author: Ruben Astudillo maintainer: ruben.astud@gmail.com +homepage: https://github.com/RubenAstudillo/data-forced +bug-reports: https://github.com/RubenAstudillo/data-forced/issues copyright: 2023 category: Data build-type: Simple @@ -13,24 +15,39 @@ description: Alternative to bang patterns using CBV functions and unlifted data types. Tag your values to maintain the invariant that they were forced. Avoid - liveness leaks on long running data structures. + liveness leaks on long lived data structures. + Main tutorial on the only module. Here is a taste of how it will look + like. + > import Data.Map.Lazy as ML -- Spine strict - > + > > -- No references on added leafs even though it is a lazy map. > basicEvent :: ML.Map Char (ForcedWHNF Int) -> IO (ML.Map Char (ForcedWHNF Int)) > basicEvent map0 = do - > let val0 :: Strict (ForcedWHNF Int) - > -- val0 = strictlyWHNF (error "argument evaluated") -- would fail - > val0 = strictlyWHNF (2 + 2) - > -- CBV function, 2 + 2 reduced before val0 is bound. - > Strict val1 = val0 -- De-structure - > map1 = ML.insert 'a' val1 map0 + > let + > -- Step1: bind the strict value with a strict let. (2 + 2) reduced + > -- before val0 is bound. + > val0 :: StrictValueExtractor (ForcedWHNF Int) + > val0 = strictlyWHNF (2 + 2) + > -- val0 = strictlyWHNF (error "argument evaluated") -- would fail + > + > -- Step2: extract the strict value to be use on lazy setting. A + > -- neccesary idiom to avoid a pitfall. + > val1 = case val0 of { Pairy val0' ext -> ext val0' } + > + > -- Step3: Store the value free of references. Even though map1 is a lazy + > -- map, the references to evaluate val1 were already freed. + > map1 = ML.insert 'a' val1 map0 > pure map1 -- extra-source-files: +source-repository head + type: git + location: https://github.com/RubenAstudillo/data-forced + common warnings - ghc-options: -Wall + ghc-options: -Wall -Werror=unbanged-strict-patterns library import: warnings diff --git a/src/Data/Forced.hs b/src/Data/Forced.hs --- a/src/Data/Forced.hs +++ b/src/Data/Forced.hs @@ -1,43 +1,228 @@ -{-# Language ExplicitForAll, UnliftedDatatypes, PatternSynonyms, GADTSyntax #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE GADTSyntax #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE UnliftedDatatypes #-} -module Data.Forced - ( Strict(..) - , ForcedWHNF - , pattern ForcedWHNF - , ForcedNF - , pattern ForcedNF - , strictlyWHNF - , strictlyNF - ) where +module Data.Forced ( + -- * How to use this library -import Data.Elevator ( UnliftedType, LiftedType ) -import Control.DeepSeq + -- ** Add a new flag on ghc-options + -- $howToUse1 + -- ** Put ForcedWHNF or ForcedNF types on fields that need to have __no__ references when hold on a long lived data structure. + -- $howToUse2 + + -- ** Use this common idiom whenever you need to obtain a forced value + -- $howToUse3 + + -- * The 'UnliftedType' calling convention (or how to avoid pitfalls) + -- $unliftedCallingConvetion + + -- * Unlifted types + + -- | We need these so whenever we bound a strict computation, all the + -- lazy values will be forced as needed. + Pairy (..), + StrictValueExtractor, + Strict, + + -- * Newtypes that hold a evaluation invariant + -- $invariantNewtypes + ForcedWHNF, + pattern ForcedWHNF, + ForcedNF, + pattern ForcedNF, + + -- * Call By Value functions + strictlyWHNF, + strictlyNF, +) where + +import Control.DeepSeq (NFData (rnf)) +import Data.Elevator (LiftedType, UnliftedType) + +{- $howToUse1 +Add this to your .cabal file It will save us from a pitfall. + +@ +common warnings + ghc-options: -Werror=unbanged-strict-patterns + +library + import: warnings + ... + +executable myAwesomeProgram + import: warnings +@ +-} + +{- $howToUse2 +@ +import Data.Map.Lazy -- it is fine, really. +import Data.Vector + +type MyMap a = Map (ForcedWHNF Char) (ForcedNF (Maybe Vector)) + +-- Prompt removal of deleted elements. +type MyMap2 a = ForcedWHNF (Map (ForcedWHNF Char) (ForcedNF (Maybe Vector))) +@ + +This way it will be a type error to store a thunk that is keeping references +alive. +-} + +{- $howToUse3 + 1. Strictly @let@ bound on your current context the result of a call to + 'strictlyWHNF' or 'strictlyNF'. __This is the most important part.__ + 2. Use a lazy let to extract the underlying @ForcedWHNF a@ or @ForcedNF a@ + with the paired extractor. + 3. Store the previous result on the long lived data structure. + +The ideal code piece looks like this: + +@ +import Data.Map.Lazy + +type MyMap a = Map Char (ForcedNF (Maybe Int)) + +noThunksForWHNF :: IO () +noThunksForWHNF = do + let map0 :: ML.Map Char (ForcedWHNF Int) + map0 = ML.empty + + -- Step 1. Strict let bound is done given the kind of + -- StrictValueExtractor + val0 :: StrictValueExtractor (ForcedWHNF Int) + val0 = strictlyWHNF (const (2 + 2) map0) + + -- Step 2. The extractor is inside the Pairy constructor of val0 + val1 = case val0 of { Pairy v ext -> ext v } + + -- Step 3. Store as a lazy thunk without the references. + map1 = ML.insert 'a' val1 map0 + pure () +@ +-} + +{- $unliftedCallingConvetion + +Types that have kind 'UnliftedType' have an different calling convention +than normal values. To achieve the correct evaluation level: + + 1. We __should__ bound with a name (@let@) computations that return a type + with 'UnliftedType' kind to the top level of our current context. + 2. We __must not__ inline computation with kind 'UnliftedType' at use + sites. Specially if the use site is inside of a lazy function. + +The first kind of mistake is hard to trigger if we follow the first section +rules. The library also steers you in the right direction by recommending +the following stanza. + +@ +common warnings + ghc-options: -Wall -Werror=unbanged-strict-patterns +@ + +on the cabal file of your project. It will protect your against this common +error + +@ +noThunksForWHNF :: IO (ML.Map Char (Forced Int)) +noThunksForWHNF = do + let map0 :: ML.Map Char (ForcedWHNF Int) + map0 = ML.empty + + -- Step 1 & 2 merged + val0 :: StrictValueExtractor (ForcedWHNF Int) + val0@(Pairy v ext) = strictlyWHNF (const (2 + 2) map0) + + -- Step 3. Store as a lazy thunk without the references. + map1 = ML.insert 'a' val1 map0 + pure map1 +@ + +Now @val0@ merged steps 1 and 2. __But in doing so it turned a strict let__ +__into a lazy let__. The @-Werror=unbanged-strict-patterns@ will highlight +this at compile time and require you to put a @BangPattern@ on @val0@. + +The problem about inlining is hiding a strict computation inside of a lazy +computation. So in the previous example + +@ +noThunksForWHNF :: IO (ML.Map Char (Forced Int)) +noThunksForWHNF = do + let map0 :: ML.Map Char (ForcedWHNF Int) + map0 = ML.empty + + -- Step 1 & 2 merged + val1= case strictlyWHNF (const (2 + 2) map0) of + Pairy v ext -> ext + + -- Step 3. Store as a lazy thunk without the references. + map1 = ML.insert 'a' val1 map0 + pure map1 +@ + +val1 __has been bound by a lazy let__. Top level bound plus explicit types +in @let@ bindings will help us to avoid this. +-} + +{- | Unlifted pair type. When a value of this type is bound, it will have + already evaluated @u@. +-} +type Pairy :: UnliftedType -> LiftedType -> UnliftedType +data Pairy (u :: UnliftedType) (l :: LiftedType) :: UnliftedType where + Pairy :: u -> l -> Pairy u l + +{- | A type synonym for the unlifted pair type synonym. It contains a strict + value and a way to extract it to a lazy/normal context. +-} +type StrictValueExtractor a = Pairy (Strict a) (Strict a -> a) + +-- | A wrapper for a lifted type that makes sure to have it evaluated. type Strict :: LiftedType -> UnliftedType -data Strict a where - Strict :: !a -> Strict a +data Strict (a :: LiftedType) :: UnliftedType where + Strict :: !a -> Strict a -{- The invariants of @ForcedWHNF@ and @ForcedNF@ depends on the constructors +{- | We don't ship the constructor of 'Strict' as it could be used to bypass + our pushes to bind values to a name. +-} +extractStrict :: Strict a -> a +extractStrict (Strict a) = a + +{- $invariantNewtypes + +The invariants of @ForcedWHNF@ and @ForcedNF@ depends on the constructors not being exported. The only way to construct these value is through the CBV functions. Pattern matching is done via a unidirectional pattern. -} + +{- | Contains a value of type @a@ that has been forced to __W__eak __H__ead + __N__ormal __F__orm. Constructor not exported (so no + 'Data.Coercible.coerce'). +-} newtype ForcedWHNF a = ForcedOuter a +-- | The only way to extract the underlying value. pattern ForcedWHNF :: forall a. a -> ForcedWHNF a pattern ForcedWHNF a <- ForcedOuter a +{- | Contains a value of type @a@ that has been forced to __N__ormal + __F__orm. Constructor not exported (so no 'Data.Coercible.coerce'). +-} newtype ForcedNF a = ForcedFull a +-- | The only way to extract the underlying value. pattern ForcedNF :: forall a. a -> ForcedNF a pattern ForcedNF a <- ForcedFull a {- | This is a CBV function. Evaluates the argument to WHNF before returning. -} -strictlyWHNF :: forall a. a -> Strict (ForcedWHNF a) -strictlyWHNF a = Strict (ForcedOuter a) +strictlyWHNF :: forall a. a -> StrictValueExtractor (ForcedWHNF a) +strictlyWHNF a = Pairy (Strict (ForcedOuter a)) extractStrict -{- | This is a CBV function. Evaluates the argument to NF before returning. --} -strictlyNF :: forall a. NFData a => a -> Strict (ForcedNF a) -strictlyNF a = Strict (ForcedFull (rnf a `seq` a)) +-- | This is a CBV function. Evaluates the argument to NF before returning. +strictlyNF :: forall a. NFData a => a -> StrictValueExtractor (ForcedNF a) +strictlyNF a = Pairy (Strict (ForcedFull (rnf a `seq` a))) extractStrict diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,51 +1,70 @@ -{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-unused-binds #-} +{-# OPTIONS_GHC -Wno-unused-binds #-} + module Main (main) where -import qualified Data.Map.Lazy as ML +import Control.Exception (ErrorCall (..), catch) import Data.Forced -import Test.HUnit ( (~:), runTestTT, Counts, Test(TestList) ) -import Control.Exception (catch, ErrorCall (..)) +import Data.Map.Lazy qualified as ML +import Test.HUnit (Counts, Test (TestList), runTestTT, (~:)) main :: IO Counts main = runTestTT tests tests :: Test -tests = TestList - [ "test1" ~: "noThunksForWHNF" ~: errorCalledWithMsg "argument evaluated" noThunksForWHNF - , "test2" ~: "thunksForWHNFMaybe" ~: thunksForWHNFMaybe - , "test3" ~: "noThunksForNFMaybe" ~: errorCalledWithMsg "argument evaluated" noThunksForNFMaybe - ] +tests = + TestList + [ "test1" ~: "noThunksForWHNF" ~: errorCalledWithMsg "argument evaluated" noThunksForWHNF + , "test2" ~: "thunksForWHNFMaybe" ~: thunksForWHNFMaybe + , "test3" ~: "noThunksForNFMaybe" ~: errorCalledWithMsg "argument evaluated" noThunksForNFMaybe + ] errorCalledWithMsg :: String -> IO a -> IO Bool errorCalledWithMsg msg io = - catch (False <$ io) (\(ErrorCall msg1) -> pure (msg == msg1)) + catch (False <$ io) (\(ErrorCall msg1) -> pure (msg == msg1)) noThunksForWHNF :: IO () noThunksForWHNF = do - let map0 :: ML.Map Char (ForcedWHNF Int) - map0 = ML.empty - val0 :: Strict (ForcedWHNF Int) - val0 = strictlyWHNF (error "argument evaluated") - Strict val1 = val0 - map1 = ML.insert 'a' val1 map0 - pure () + let map0 :: ML.Map Char (ForcedWHNF Int) + map0 = ML.empty + val0 :: StrictValueExtractor (ForcedWHNF Int) + !val0@(Pairy val1 ext) = strictlyWHNF (error "argument evaluated") + map1 = ML.insert 'a' (ext val1) map0 + pure () +noThunksForWHNF1 :: IO () +noThunksForWHNF1 = do + let map0 :: ML.Map Char (ForcedWHNF Int) + map0 = ML.empty + val0 :: StrictValueExtractor (ForcedWHNF Int) + val0 = strictlyWHNF (error "argument evaluated") + val1 = case val0 of Pairy v ext -> ext v + map1 = ML.insert 'a' val1 map0 + pure () + +noThunksForWHNF2 :: IO () +noThunksForWHNF2 = do + let map0 :: ML.Map Char (ForcedWHNF Int) + map0 = ML.empty + val1 = case strictlyWHNF (error "argument evaluated") of Pairy v ext -> ext v + map1 = ML.insert 'a' val1 map0 + pure () + thunksForWHNFMaybe :: IO () thunksForWHNFMaybe = do - let map0 :: ML.Map Char (ForcedWHNF (Maybe Int)) - map0 = ML.empty - val0 :: Strict (ForcedWHNF (Maybe Int)) - val0 = strictlyWHNF (const (Just (error "argument evaluated")) 'a') - Strict val1 = val0 - map1 = ML.insert 'a' val1 map0 - pure () + let map0 :: ML.Map Char (ForcedWHNF (Maybe Int)) + map0 = ML.empty + val0 :: StrictValueExtractor (ForcedWHNF (Maybe Int)) + val0 = strictlyWHNF (const (Just (error "argument evaluated")) 'a') + val1 = case val0 of Pairy v ext -> ext v + map1 = ML.insert 'a' val1 map0 + pure () noThunksForNFMaybe :: IO () noThunksForNFMaybe = do - let map0 :: ML.Map Char (ForcedNF (Maybe Int)) - map0 = ML.empty - val0 :: Strict (ForcedNF (Maybe Int)) - val0 = strictlyNF ((+1) <$> Just (error "argument evaluated" :: Int)) - Strict val = val0 - map1 = ML.insert 'a' val map0 - pure () + let map0 :: ML.Map Char (ForcedNF (Maybe Int)) + map0 = ML.empty + val0 :: StrictValueExtractor (ForcedNF (Maybe Int)) + val0 = strictlyNF ((+ 1) <$> Just (error "argument evaluated" :: Int)) + val = case val0 of Pairy st ext -> ext st + map1 = ML.insert 'a' val map0 + pure ()