language-dickinson 1.3.0.0 → 1.3.0.1
raw patch · 7 files changed
+27/−24 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−0
- language-dickinson.cabal +1/−1
- lib/noun.dck +1/−0
- src/Language/Dickinson/Check/Exhaustive.hs +0/−1
- src/Language/Dickinson/Check/Scope.hs +1/−1
- src/Language/Dickinson/Pattern.hs +2/−0
- src/Language/Dickinson/Pattern/Useless.hs +16/−21
CHANGELOG.md view
@@ -1,5 +1,11 @@ # dickinson +## 1.3.0.1++ * Make some stuff in the pattern match exhaustiveness checker strict for+ better performance+ * Use strict `State` monad in the scope checker for better performance+ ## 1.3.0.0 * Linter now reports inexhaustive pattern matches
language-dickinson.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: language-dickinson-version: 1.3.0.0+version: 1.3.0.1 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2020 Vanessa McHale
lib/noun.dck view
@@ -310,5 +310,6 @@ (| "apotheosis") (| "aphelion") (| "bevel")+ (| "thurible") (| "perihelion") (| "folderol"))))
src/Language/Dickinson/Check/Exhaustive.hs view
@@ -1,5 +1,4 @@ module Language.Dickinson.Check.Exhaustive ( checkExhaustive- , foliate ) where import Control.Applicative ((<|>))
src/Language/Dickinson/Check/Scope.hs view
@@ -7,7 +7,7 @@ import Control.Applicative ((<|>)) import Control.Monad.Except (MonadError)-import Control.Monad.State (State, evalState, get, modify)+import Control.Monad.State.Strict (State, evalState, get, modify) import Data.Foldable (traverse_) import qualified Data.IntSet as IS import Language.Dickinson.Check.Common
src/Language/Dickinson/Pattern.hs view
@@ -17,6 +17,8 @@ matches (OrPattern _ ps) e = any (`matches` e) ps matches _ _ = False +-- | Given an expression, find the first pattern it matches, failing if it+-- matches nothing. matchPattern :: MonadError (DickinsonError a) m => a -> Expression a -> [(Pattern a, Expression a)] -> m (Pattern a, Expression a) matchPattern l e (p:ps) | matches (fst p) e = pure p | otherwise = matchPattern l e ps
src/Language/Dickinson/Pattern/Useless.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} --- | This module is loosely based off _Warnings for pattern matching_ by Luc+-- | This module is loosely based off /Warnings for pattern matching/ by Luc -- Maranget module Language.Dickinson.Pattern.Useless ( PatternM , runPatternM@@ -12,20 +12,20 @@ , specializeTag ) where -import Control.Monad (forM, forM_)-import Control.Monad.State (State, evalState, get)-import Data.Coerce (coerce)-import Data.Foldable (toList, traverse_)-import Data.Functor (void)-import Data.IntMap (findWithDefault)-import qualified Data.IntMap as IM-import qualified Data.IntSet as IS+import Control.Monad (forM, forM_)+import Control.Monad.State.Strict (State, evalState, get)+import Data.Coerce (coerce)+import Data.Foldable (toList, traverse_)+import Data.Functor (void)+import Data.IntMap.Strict (findWithDefault)+import qualified Data.IntMap.Strict as IM+import qualified Data.IntSet as IS import Data.List.Ext import Language.Dickinson.Name import Language.Dickinson.Type import Language.Dickinson.Unique-import Lens.Micro (Lens')-import Lens.Micro.Mtl (modifying)+import Lens.Micro (Lens')+import Lens.Micro.Mtl (modifying) -- all constructors of a data PatternEnv = PatternEnv { allCons :: IM.IntMap IS.IntSet -- ^ all constructors indexed by type@@ -49,6 +49,7 @@ patternEnvDecls :: [Declaration a] -> PatternM () patternEnvDecls = traverse_ declAdd +-- TODO: just reader monad... writer at beginning? type PatternM = State PatternEnv runPatternM :: PatternM a -> a@@ -81,7 +82,7 @@ sanityFailed = error "Sanity check failed! Perhaps you ran the pattern match exhaustiveness checker on an ill-typed program?" specializeTag :: Name a -> [[Pattern a]] -> [[Pattern a]]-specializeTag c = {-# SCC "specializeTag" #-} concatMap withRow+specializeTag c = concatMap withRow where withRow (PatternCons _ c':ps) | c' == c = [ps] | otherwise = [] withRow (PatternTuple{}:_) = sanityFailed@@ -91,7 +92,7 @@ withRow [] = emptySpecialize specializeTuple :: Int -> [[Pattern a]] -> [[Pattern a]]-specializeTuple n = {-# SCC "specializeTuple" #-} concatMap withRow+specializeTuple n = concatMap withRow where withRow (PatternTuple _ ps:ps') = [toList ps ++ ps'] withRow (p@Wildcard{}:ps') = [replicate n p ++ ps'] withRow (p@PatternVar{}:ps') = [replicate n p ++ ps']@@ -104,7 +105,7 @@ -- | \\( \matcal(D) \\) in the Maranget paper defaultMatrix :: [[Pattern a]] -> [[Pattern a]]-defaultMatrix = {-# SCC "defaultMatrix" #-} concatMap withRow where+defaultMatrix = concatMap withRow where withRow [] = error "Internal error: tried to take default matrix of an empty row" withRow (PatternTuple{}:_) = error "Sanity check failed!" -- because a tuple would be complete by itself withRow (PatternCons{}:_) = []@@ -144,13 +145,7 @@ usefulMaranget ps (PatternCons _ c:qs) = usefulMaranget (specializeTag c ps) qs usefulMaranget ps (PatternTuple _ ps':qs) = usefulMaranget (specializeTuple (length ps') ps) (toList ps' ++ qs) usefulMaranget ps (OrPattern _ ps':qs) = forAnyA ps' $ \p -> usefulMaranget ps (p:qs)-usefulMaranget ps (q@Wildcard{}:qs) = do- cont <- fstComplete ps- case cont of- NotComplete -> usefulMaranget (defaultMatrix ps) qs- CompleteTuple n -> usefulMaranget (specializeTuple n ps) (specializeTupleVector n q qs)- CompleteTags ns -> or <$> (forM ns $ \n -> usefulMaranget (specializeTag n (forget ps)) (fmap void qs))-usefulMaranget ps (q@PatternVar{}:qs) = do+usefulMaranget ps (q:qs) = do -- pattern var or wildcard cont <- fstComplete ps case cont of NotComplete -> usefulMaranget (defaultMatrix ps) qs