packages feed

data-forced 0.1.0.0 → 0.2.0.0

raw patch · 4 files changed

+301/−62 lines, 4 files

Files

CHANGELOG.md view
@@ -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.+
data-forced.cabal view
@@ -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
src/Data/Forced.hs view
@@ -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
test/Main.hs view
@@ -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 ()