data-forced 0.2.0.0 → 0.3.0.0

raw patch · 3 files changed

+170/−215 lines, 3 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• data-forced.cabal +22/−22
• src/Data/Forced.hs +126/−156
• test/Main.hs +22/−37

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               data-forced-version:            0.2.0.0+version:            0.3.0.0 synopsis:           Specify that lifted values were forced to WHNF or NF. license:            MIT license-file:       LICENSE@@ -20,26 +20,26 @@   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-  >     -- 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+  > {-# Language QualifiedDo #-}+  > +  > import qualified Data.Forced as DF+  > import Data.Forced hiding (pure, fmap, (\<*\>), return, (>>=), (>>))+  > import Data.Map.Lazy qualified as ML+  > +  > noThunksForWHNF :: IO ()+  > noThunksForWHNF = do+  >   -- map0 actually evaluated on here.+  >   let map0 :: Demand (ML.Map Char (ForcedWHNF Int))+  >       map0 = DF.do+  >         v <- demandWHNF (const (2 + 2) 'a')+  >         DF.pure $ ML.insert 'a' v ML.empty+  > +  >   map1 <- extractDemand map0+  >   go (ML.lookup 'a' map1)+  > +  > -- pattern matching for de-structuring, no construction allowed.+  > go :: ForcedWHNF Int -> IO ()+  > go (ForcedWHNF i) =  print i -- extra-source-files:  source-repository head@@ -47,7 +47,7 @@   location: https://github.com/RubenAstudillo/data-forced  common warnings-    ghc-options: -Wall -Werror=unbanged-strict-patterns+    ghc-options: -Wall  library     import:           warnings

@@ -3,199 +3,131 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE UnliftedDatatypes #-} -module Data.Forced (-    -- * How to use this library--    -- ** 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+module Data.Forced+  ( -- * How to use this library+    -- | You should use the following imports+    --+    -- @+    --   import qualified Data.Forced as DF+    --   import Data.Forced hiding (pure, fmap, (<*>), return, (>>=), (>>))+    -- @ -    -- * Unlifted types+    -- ** Design the type of your long lived data structure+    -- $dataTypeUserDesign -    -- | We need these so whenever we bound a strict computation, all the-    -- lazy values will be forced as needed.-    Pairy (..),-    StrictValueExtractor,-    Strict,+    -- ** Construct values on the @Demand@ monad+    -- $useMonad -    -- * Newtypes that hold a evaluation invariant-    -- $invariantNewtypes-    ForcedWHNF,-    pattern ForcedWHNF,-    ForcedNF,-    pattern ForcedNF,+    -- * Newtypes to be used to specify how evaluated a type should be+    ForcedWHNF (ForcedWHNF)+  , ForcedNF (ForcedNF)+    -- * Monadic environment to execute the needed demands.+  , Demand+  , demandWHNF+  , demandNF+  , extractDemand -    -- * Call By Value functions-    strictlyWHNF,-    strictlyNF,-) where+    -- * Qualified Do support.+    -- | These are available to construct value by hand. But they clash with+    -- 'P.Functor', 'P.Applicative' and 'P.Monad' functions. We cannot+    -- provide instances to those classes as the 'Demand' monad is+    -- 'UnliftedType' kinded. But using @-XQualifiedDo@, GHC will pick up+    -- these names and use it on a @DF.do@ notation that does the right+    -- thing.+  , fmap+  , pure+  , (<*>)+  , return+  , (>>=)+  , (>>)+  ) where  import Control.DeepSeq (NFData (rnf)) import Data.Elevator (LiftedType, UnliftedType)+import Prelude ()+import qualified Prelude as P -{- $howToUse1-Add this to your .cabal file It will save us from a pitfall.+{- $dataTypeUserDesign+The main way this library helps you avoid leaks is by specifying the types+of your long lived data structures. They should contain new demands on the+type variables.  @-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))+-- On insertion of the lazy map, the keys and the values will evaluated.+type MyMap a = Map (ForcedWHNF Char) (ForcedNF (Maybe (Vector Int))) --- Prompt removal of deleted elements.-type MyMap2 a = ForcedWHNF (Map (ForcedWHNF Char) (ForcedNF (Maybe Vector)))+-- On top, prompt removal of deleted elements.+type MyMap2 a = ForcedWHNF (Map (ForcedWHNF Char) (ForcedNF (Maybe (Vector Int)))) @  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.+{- $useMonad+We use the 'Demand' monad to construct values with the correct strictness.+You either construct the values by hand, but it is better to use the+@-XQualifiedDo@ extension. +The main functions to keep in mind on this monad are: 'demandWHNF' and+'demandNF'.++Once you have the value specified, you need to extract it to the IO+environment. Hopefully this will be close to main where your long lived data+should be stored. We do this as is the obvious sequence point, so from the+PoV of the rest of the program, the action is visible on the default lifted+environment.+ The ideal code piece looks like this:  @-import Data.Map.Lazy+\{\-\# Language QualifiedDo \#\-\} -type MyMap a = Map Char (ForcedNF (Maybe Int))+import qualified Data.Forced as DF+import Data.Forced hiding (pure, fmap, (\<*\>), return, (>>=), (>>))+import Data.Map.Lazy qualified as ML  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)+    -- map0 actually evaluated on here.+    let map0 :: Demand (ML.Map Char (ForcedWHNF Int))+        map0 = DF.do+          v <- demandWHNF (const (2 + (2 :: Int)) \'a\')+          DF.pure $ ML.insert \'a\' v ML.empty -        -- Step 2. The extractor is inside the Pairy constructor of val0-        val1 = case val0 of { Pairy v ext -> ext v }+    map1 <- extractDemand map0+    go (ML.lookup \'a\' map1) -        -- Step 3. Store as a lazy thunk without the references.-        map1 = ML.insert 'a' val1 map0-    pure ()+-- pattern matching for de-structuring, no construction allowed.+go :: ForcedWHNF Int -> IO ()+go (ForcedWHNF i) =  print i @ -} -{- $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.+{- | A strict identity monad of 'UnliftedType' kind. To be used via+@-XQualifiedDo@. -}-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 :: LiftedType) :: UnliftedType where-    Strict :: !a -> Strict a+type Demand :: LiftedType -> UnliftedType+data Demand (a :: LiftedType) :: UnliftedType where+    Demand :: a -> Demand a -{- | We don't ship the constructor of 'Strict' as it could be used to bypass- our pushes to bind values to a name.+{- | We don't ship the constructor of 'Demand'. The only way to extract a+'Demand' is to sequence to a know point on 'P.IO'. From the PoV of the rest+of the program, the tagged values with t'ForcedWHNF' or t'ForcedNF'+will have been demanded. -}-extractStrict :: Strict a -> a-extractStrict (Strict a) = a+extractDemand :: Demand a -> P.IO a+extractDemand (Demand a) = P.pure 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.+functions of the 'Demand' type. Pattern matching is done via a+unidirectional pattern. -}  {- | Contains a value of type @a@ that has been forced to __W__eak __H__ead@@ -204,6 +136,9 @@ -} newtype ForcedWHNF a = ForcedOuter a +instance P.Show a => P.Show (ForcedWHNF a) where+  show (ForcedOuter a) = "ForcedWHNF " P.++ P.show a+ -- | The only way to extract the underlying value. pattern ForcedWHNF :: forall a. a -> ForcedWHNF a pattern ForcedWHNF a <- ForcedOuter a@@ -213,6 +148,9 @@ -} newtype ForcedNF a = ForcedFull a +instance P.Show a => P.Show (ForcedNF a) where+  show (ForcedFull a) = "ForcedNF " P.++ P.show a+ -- | The only way to extract the underlying value. pattern ForcedNF :: forall a. a -> ForcedNF a pattern ForcedNF a <- ForcedFull a@@ -220,9 +158,41 @@ {- | This is a CBV function. Evaluates the argument to WHNF before returning. -}-strictlyWHNF :: forall a. a -> StrictValueExtractor (ForcedWHNF a)-strictlyWHNF a = Pairy (Strict (ForcedOuter a)) extractStrict+demandWHNF :: forall a. a -> Demand (ForcedWHNF a)+demandWHNF a = a `P.seq` Demand (ForcedOuter 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+demandNF :: forall a. NFData a => a -> Demand (ForcedNF a)+demandNF a = rnf a `P.seq` Demand (ForcedFull a)++{- $qualifiedDoSupport++There are no 'P.Functor', 'P.Applicative' or 'P.Monad' classes for+'UnliftedType' types yet. This package is not the right place to define+them. We can get @do@ notation using @-XQualifiedDo@.+-}+-- | 'P.fmap' analogue for 'Demand's which are of the 'UnliftedType' kind.+fmap :: (a -> b) -> Demand a -> Demand b+fmap f (Demand a) = Demand (f a)++-- | Places __no__ demand on the value. 'P.pure' analogue for 'Demand's+-- which are of the 'UnliftedType' kind.+pure :: a -> Demand a+pure a = Demand a++-- | 'P.<*>' analogue for 'Demand's which are of the 'UnliftedType' kind.+(<*>) :: Demand (a -> b) -> Demand a -> Demand b+(<*>) (Demand fun) (Demand fa) = Demand (fun fa)++-- | 'P.return' analogue for 'Demand's which are of the 'UnliftedType' kind.+-- Same as 'pure'.+return :: a -> Demand a+return = pure++-- | 'P.>>=' analogue for 'Demand's which are of the 'UnliftedType' kind.+(>>=) :: Demand a -> (a -> Demand b) -> Demand b+(Demand ma) >>= f = f ma++-- | 'P.>>' analogue for 'Demand's which are of the 'UnliftedType' kind.+(>>) :: Demand a -> Demand b -> Demand b+(>>) fa fb = fa >>= (\_ -> fb)

@@ -1,9 +1,13 @@-{-# OPTIONS_GHC -Wno-unused-binds #-}+{-# Language QualifiedDo #-}+{-# OPTIONS_GHC -Wno-unused-matches #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Evaluate" #-}  module Main (main) where  import Control.Exception (ErrorCall (..), catch)-import Data.Forced+import qualified Data.Forced as DF+import Data.Forced hiding (pure, fmap, (<*>), return, (>>=), (>>)) import Data.Map.Lazy qualified as ML import Test.HUnit (Counts, Test (TestList), runTestTT, (~:)) @@ -24,47 +28,28 @@  noThunksForWHNF :: IO () noThunksForWHNF = do-    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+    let map0 :: Demand (ML.Map Char (ForcedWHNF Int))+        map0 = DF.do+          v <- demandWHNF (error "argument evaluated")+          DF.pure $ ML.insert 'a' v ML.empty+    map1 <- extractDemand map0     pure () +-- | Should not fail. thunksForWHNFMaybe :: IO () thunksForWHNFMaybe = do-    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+    let map0 :: Demand (ML.Map Char (ForcedWHNF (Maybe Int)))+        map0 = DF.do+          v <- demandWHNF (const (Just (error "argument evaluated")) 'a')+          DF.pure $ ML.insert 'a' v ML.empty+    map1 <- extractDemand map0     pure ()  noThunksForNFMaybe :: IO () noThunksForNFMaybe = do-    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+    let map0 :: Demand (ML.Map Char (ForcedNF (Maybe Int)))+        map0 = DF.do+          v <- demandNF (const (Just (error "argument evaluated")) 'a')+          DF.pure $ ML.insert 'a' v ML.empty+    map1 <- extractDemand map0     pure ()