blanks 0.4.0 → 0.4.1

raw patch · 10 files changed

+63/−38 lines, 10 filesdep +deepseqPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: deepseq

API changes (from Hackage documentation)

Files

• blanks.cabal +6/−4
• src/Blanks.hs +1/−17
• src/Blanks/LocScope.hs +5/−1
• src/Blanks/Located.hs +6/−2
• src/Blanks/Name.hs +9/−3
• src/Blanks/Scope.hs +5/−1
• src/Blanks/ScopeW.hs +4/−0
• src/Blanks/UnderScope.hs +12/−5
• test/Test/Blanks/LocScopeTest.hs +9/−4
• test/Test/Blanks/Parsing.hs +6/−1

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: dce6fa2995f08e5b1615eab81bbbbb7339ba49c1db0902125b8495fc24c84bd1+-- hash: f04965a3798127c433ad644602e9f2d305aadbcc482644902f31342e2390729c  name:           blanks-version:        0.4.0+version:        0.4.1 synopsis:       Fill-in-the-blanks - A library factoring out substitution from ASTs description:    Please see the README on GitHub at <https://github.com/ejconlon/blanks#readme> category:       Language@@ -42,12 +42,13 @@       Paths_blanks   hs-source-dirs:       src-  default-extensions: BangPatterns ConstraintKinds DeriveFunctor DeriveFoldable DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses PatternSynonyms Rank2Types TypeFamilies+  default-extensions: BangPatterns ConstraintKinds DeriveFunctor DeriveFoldable DeriveGeneric DeriveTraversable DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses PatternSynonyms Rank2Types TypeFamilies   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds   build-depends:       adjunctions >=4.4 && <5     , base >=4.12 && <5     , containers >=0.6 && <1+    , deepseq >=1.4 && <2     , distributive >=0.6 && <1     , mtl >=2.2 && <3   default-language: Haskell2010@@ -63,13 +64,14 @@       Paths_blanks   hs-source-dirs:       test-  default-extensions: BangPatterns ConstraintKinds DeriveFunctor DeriveFoldable DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses PatternSynonyms Rank2Types TypeFamilies+  default-extensions: BangPatterns ConstraintKinds DeriveFunctor DeriveFoldable DeriveGeneric DeriveTraversable DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses PatternSynonyms Rank2Types TypeFamilies   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds -threaded -rtsopts -with-rtsopts=-N   build-depends:       adjunctions >=4.4 && <5     , base >=4.12 && <5     , blanks     , containers >=0.6 && <1+    , deepseq >=1.4 && <2     , distributive >=0.6 && <1     , megaparsec     , mtl >=2.2 && <3

@@ -1,20 +1,4 @@--- | Fill-in-the-blanks - A library factoring out substitution from ASTs.------ It's a pain to track de Bruijn indices yourself to implement capture-avoiding subsititution,--- so this library provides some wrappers that help. One of the best libraries for this is--- <https://hackage.haskell.org/package/bound bound>, which uses a clever representation to make--- these operations safe and fast. The tradeoff is that you have to define a 'Monad' instance--- for your expression functor, which in practice can be tricky. (It's even trickier to derive--- 'Eq' and 'Show'!)------ This library takes the simpler, slower, and rather "succ-y" free-monad-ish approach,--- but with a twist. It expects you to rewrite all name-binding constructors in your expression--- as annotations on a single "binder" constructor. This allows you to use the provided 'Scope'--- type (or a variant) as a wrapper around your expression functor, which is only required to--- implement 'Functor'. This representation is less safe (since you can inspect and manipulate--- bound variables), but if you stick to the provided combinators, things will work out fine.------ You'll get most of what you want by just importing this module unqualified.+-- | You'll get most of what you want by just importing this module unqualified. -- See the 'Blanks' class definition and related methods to manipulate variables and abstractions. -- See 'Scope' for the basic wrapper and 'LocScope' for a wrapper with annotations you can use -- for source locations and the like. See the test suite for examples.

@@ -17,6 +17,7 @@ import Blanks.ScopeW (ScopeW (..)) import Blanks.UnderScope (pattern UnderScopeBinder, pattern UnderScopeBound, pattern UnderScopeEmbed,                           pattern UnderScopeFree)+import Control.DeepSeq (NFData (..)) import Control.Monad (ap) import Control.Monad.Identity (Identity (..)) import Control.Monad.Writer (MonadWriter (..))@@ -26,7 +27,7 @@ -- and inspection. newtype LocScope l n f a = LocScope   { unLocScope :: ScopeW (Located l) n f (LocScope l n f) a-  } deriving (Functor, Foldable, Traversable)+  } deriving stock (Functor, Foldable, Traversable)  type instance BlankLeft (LocScope l n f) = Located l type instance BlankRight (LocScope l n f) = Colocated l@@ -35,6 +36,9 @@  instance Functor f => Blank (LocScope l n f) instance NatNewtype (ScopeW (Located l) n f (LocScope l n f)) (LocScope l n f)++instance (NFData l, NFData n, NFData a, NFData (f (LocScope l n f a))) => NFData (LocScope l n f a) where+  rnf = rnf . unLocScope  pattern LocScopeBound :: l -> Int -> LocScope l n f a pattern LocScopeBound l b = LocScope (ScopeW (Located l (UnderScopeBound b)))

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE UndecidableInstances #-}  module Blanks.Located@@ -8,12 +9,14 @@   , runColocated   ) where +import Control.DeepSeq (NFData) import Control.Monad (ap) import Control.Monad.Reader (MonadReader, Reader, ReaderT (..), ask, reader, runReader) import Control.Monad.Writer (MonadWriter (..)) import Data.Distributive (Distributive (..)) import Data.Functor.Adjunction (Adjunction (..)) import Data.Functor.Rep (Representable)+import GHC.Generics (Generic)  -- | This is basically the 'Env' comonad, but with the env strict. -- It's also basically the 'Writer' monad in certain contexts.@@ -21,12 +24,13 @@ data Located l a = Located   { _locatedLoc :: !l   , _locatedVal :: a-  } deriving (Eq, Show, Functor, Foldable, Traversable)+  } deriving stock (Eq, Show, Functor, Foldable, Traversable, Generic)+    deriving anyclass (NFData)  -- | Because we defined a unique left adjoint, we have to define the unique right. newtype Colocated l a = Colocated   { unColocated :: Reader l a-  } deriving (Functor, Applicative, Monad, MonadReader l, Representable)+  } deriving newtype (Functor, Applicative, Monad, MonadReader l, Representable)  colocated :: (l -> a) -> Colocated l a colocated f = Colocated (reader f)

@@ -1,18 +1,24 @@+{-# LANGUAGE DeriveAnyClass #-}+ module Blanks.Name   ( Name (..)   , NameOnly   , pattern NameOnly   ) where +import Control.DeepSeq (NFData)+import GHC.Generics (Generic)+ -- | 'Name' is compared on value only, allowing you to define and use -- things like 'NameOnly' in your 'BlankInfo' values to make alpha-equivalent -- terms structurally ('Eq') equivalent. data Name n a =   Name-    { _nameKey :: n-    , _nameValue :: a+    { _nameKey :: !n+    , _nameValue :: !a     }-  deriving (Show, Functor, Foldable, Traversable)+  deriving stock (Show, Functor, Foldable, Traversable, Generic)+  deriving anyclass (NFData)  instance Eq a => Eq (Name n a) where   Name _ x == Name _ y = x == y

@@ -13,6 +13,7 @@ import Blanks.ScopeW (ScopeW (..)) import Blanks.UnderScope (pattern UnderScopeBinder, pattern UnderScopeBound, pattern UnderScopeEmbed,                           pattern UnderScopeFree)+import Control.DeepSeq (NFData (..)) import Control.Monad (ap) import Control.Monad.Identity (Identity (..)) @@ -21,7 +22,7 @@ -- and inspection. newtype Scope n f a = Scope   { unScope :: ScopeW Identity n f (Scope n f) a-  } deriving (Functor, Foldable, Traversable)+  } deriving stock (Functor, Foldable, Traversable)  type instance BlankLeft (Scope n f) = Identity type instance BlankRight (Scope n f) = Identity@@ -30,6 +31,9 @@  instance Functor f => Blank (Scope n f) instance NatNewtype (ScopeW Identity n f (Scope n f)) (Scope n f)++instance (NFData n, NFData a, NFData (f (Scope n f a))) => NFData (Scope n f a) where+  rnf = rnf . unScope  pattern ScopeBound :: Int -> Scope n f a pattern ScopeBound b = Scope (ScopeW (Identity (UnderScopeBound b)))

@@ -26,6 +26,7 @@ import Blanks.Sub (SubError (..)) import Blanks.UnderScope (UnderScope, pattern UnderScopeBinder, pattern UnderScopeBound, pattern UnderScopeEmbed,                           UnderScopeFold, pattern UnderScopeFree, underScopeFold, underScopeShift)+import Control.DeepSeq (NFData (..)) import Data.Bifoldable (bifoldr) import Data.Bifunctor (bimap, first) import Data.Bitraversable (bitraverse)@@ -39,6 +40,9 @@ newtype ScopeW t n f g a = ScopeW   { unScopeW :: t (UnderScope n f (g a) a)   }++instance NFData (t (UnderScope n f (g a) a) )=> NFData (ScopeW t n f g a) where+  rnf = rnf . unScopeW  instance Eq (t (UnderScope n f (g a) a)) => Eq (ScopeW t n f g a) where   ScopeW tu == ScopeW tv = tu == tv

@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveAnyClass #-}+ -- | Internals. You will probably never need these. module Blanks.UnderScope   ( BinderScope (..)@@ -14,21 +16,24 @@   , underScopeShift   ) where +import Control.DeepSeq (NFData) import Data.Bifoldable (Bifoldable (..)) import Data.Bifunctor (Bifunctor (..)) import Data.Bitraversable (Bitraversable (..))+import GHC.Generics (Generic)  newtype BoundScope =   BoundScope     { unBoundScope :: Int     }-  deriving (Eq, Show)+  deriving newtype (Eq, Show, NFData)  newtype FreeScope a =   FreeScope     { unFreeScope :: a     }-  deriving (Eq, Show, Functor, Foldable, Traversable)+  deriving stock (Eq, Show, Functor, Foldable, Traversable)+  deriving newtype (NFData)  data BinderScope n e =   BinderScope@@ -36,20 +41,22 @@     , binderScopeInfo :: !n     , binderScopeBody :: e     }-  deriving (Eq, Show, Functor, Foldable, Traversable)+  deriving stock (Eq, Show, Functor, Foldable, Traversable, Generic)+  deriving anyclass (NFData)  newtype EmbedScope f e =   EmbedScope     { unEmbedScope :: f e     }-  deriving (Eq, Show, Functor)+  deriving newtype (Eq, Show, Functor, NFData)  data UnderScope n f e a   = UnderBoundScope !BoundScope   | UnderFreeScope !(FreeScope a)   | UnderBinderScope !(BinderScope n e)   | UnderEmbedScope !(EmbedScope f e)-  deriving (Eq, Show, Functor)+  deriving stock (Eq, Show, Functor, Generic)+  deriving anyclass (NFData)  pattern UnderScopeBound :: Int -> UnderScope n f e a pattern UnderScopeBound i = UnderBoundScope (BoundScope i)

@@ -1,13 +1,16 @@+{-# LANGUAGE DeriveAnyClass #-}+ module Test.Blanks.LocScopeTest where  import Blanks-import Data.String (IsString)+import Control.DeepSeq (NFData, force)+import GHC.Generics (Generic) import Test.Blanks.Parsing import Test.Tasty import Test.Tasty.HUnit  -- A newtype indicating an identifier in our language-newtype Ident = Ident { unIdent :: String } deriving (Eq, Show, Ord, IsString)+newtype Ident = Ident { unIdent :: String } deriving newtype (Eq, Show, Ord, NFData)  -- The type of concrete expressions, labeled with source location data CExp l =@@ -45,7 +48,8 @@   | ExpAdd a a   | ExpIf a a a   | ExpIsZero a-  deriving (Eq, Show, Functor, Foldable, Traversable)+  deriving stock (Eq, Show, Functor, Foldable, Traversable, Generic)+  deriving anyclass (NFData)  -- A nameless equivalent to 'CExp' type ExpScope l = LocScope l (NameOnly Ident) Exp Ident@@ -125,7 +129,8 @@ testSingle :: TestName -> String -> ExpSimpleScope -> TestTree testSingle name input expected = testCase name $ do   namedExp <- runParserIO cexpParser input-  let namelessExp = nameless namedExp+  -- Force here just to test that we can+  let namelessExp = force (nameless namedExp)   cexpLoc namedExp @?= locScopeLocation namelessExp   let actual = locScopeForget namelessExp   expected @?= actual

@@ -1,8 +1,12 @@+{-# LANGUAGE DeriveAnyClass #-}+ module Test.Blanks.Parsing where  import Control.Applicative (Alternative (..))+import Control.DeepSeq (NFData) import Control.Exception (throwIO) import Data.Void (Void)+import GHC.Generics (Generic) import qualified Text.Megaparsec as MP import qualified Text.Megaparsec.Char as MPC import qualified Text.Megaparsec.Char.Lexer as MPCL@@ -23,7 +27,8 @@   , _ssStartColumn :: !MP.Pos   , _ssEndLine :: !MP.Pos   , _ssEndColumn :: !MP.Pos-  } deriving (Eq, Show, Ord)+  } deriving stock (Eq, Show, Ord, Generic)+    deriving anyclass (NFData)  mkSourceSpan :: MP.SourcePos -> MP.SourcePos -> SourceSpan mkSourceSpan (MP.SourcePos n sl sc) (MP.SourcePos _ el ec) = SourceSpan n sl sc el ec