language-dickinson 1.3.0.1 → 1.3.0.2

raw patch · 7 files changed

+32/−23 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• examples/fortune.dck +0/−1
• language-dickinson.cabal +8/−4
• lib/noun.dck +1/−0
• man/emd.1 +6/−0
• src/Data/List/Ext.hs +2/−8
• src/Language/Dickinson/Pattern/Useless.hs +10/−10

@@ -1,5 +1,10 @@ # dickinson +## 1.3.0.2++  * Sanity checks in pattern match exhaustiveness checker+  * Mildly improved performance+ ## 1.3.0.1    * Make some stuff in the pattern match exhaustiveness checker strict for

@@ -43,7 +43,6 @@     (| "Did you remember to put apotheosis on your to-do list?")     (| "Cultivate weakness.")     (| "Beauty is a moral imperative.")-    (| "We are all united in being damned by our own personalities. That is beauty.")     (| "What do you know about dietetics?")     (| "Hobbies are sublunary")     (| "To err is immoral.")

@@ -1,6 +1,6 @@ cabal-version:      2.0 name:               language-dickinson-version:            1.3.0.1+version:            1.3.0.2 license:            BSD3 license-file:       LICENSE copyright:          Copyright: (c) 2020 Vanessa McHale@@ -125,7 +125,7 @@         FlexibleInstances GeneralizedNewtypeDeriving OverloadedStrings         StandaloneDeriving TupleSections DeriveDataTypeable -    ghc-options:      -Wall -O2+    ghc-options:      -Wall -O2 -fstatic-argument-transformation     build-depends:         base >=4.9 && <5,         array -any,@@ -178,7 +178,9 @@     autogen-modules:  Paths_language_dickinson     default-language: Haskell2010     other-extensions: FlexibleContexts OverloadedStrings TupleSections-    ghc-options:      -Wall -rtsopts -with-rtsopts=-A4M+    ghc-options:+        -Wall -rtsopts -with-rtsopts=-A4M -fstatic-argument-transformation+     build-depends:         base -any,         dickinson -any,@@ -265,7 +267,9 @@     main-is:          Bench.hs     hs-source-dirs:   bench     default-language: Haskell2010-    ghc-options:      -Wall -rtsopts -with-rtsopts=-A4M+    ghc-options:+        -Wall -rtsopts -with-rtsopts=-A4M -fstatic-argument-transformation+     build-depends:         base -any,         dickinson -any,

@@ -52,6 +52,7 @@       (| "gofer")       (| "chignon")       (| "henosis")+      (| "bindle")       (| "rhotacism")       (| "doyenne")       (| "theurgy")

@@ -86,6 +86,12 @@ .PP Put this in your \f[C]\[ti]/.bashrc\f[R] or \f[C]\[ti]/.bash_profile\f[R] to install them.+.PP+Shell completions are also available for fish and zsh; to get them:+.PP+\f[C]emd --fish-completion-script emd\f[R]+.PP+\f[C]emd --zsh-completion-script emd\f[R] .SH BUGS .PP Please report any bugs you may come across to

@@ -1,15 +1,9 @@-module Data.List.Ext ( anyA-                     , allA-                     , forAnyA+module Data.List.Ext ( forAnyA                      ) where --- TODO: does this short-circuit appropriately with state monad?+-- TODO: does this short-circuit appropriately with (strict) state monad? anyA :: (Traversable t, Applicative f) => (a -> f Bool) -> t a -> f Bool anyA p = fmap or . traverse p---- TODO: does this short-circuit appropriately with state monad?-allA :: (Traversable t, Applicative f) => (a -> f Bool) -> t a -> f Bool-allA p = fmap and . traverse p  forAnyA :: (Traversable t, Applicative f) => t a -> (a -> f Bool) -> f Bool forAnyA = flip anyA

@@ -59,9 +59,12 @@ assocUniques :: Name a -> PatternM IS.IntSet assocUniques (Name _ (Unique i) _) = {-# SCC "assocUniques" #-} do     st <- get-    let ty = findWithDefault undefined i (types st)-    pure $ findWithDefault undefined ty (allCons st)+    let ty = findWithDefault internalError i (types st)+    pure $ findWithDefault internalError ty (allCons st) +internalError :: a+internalError = error "Internal error: lookup in a PatternEnv failed"+ isExhaustive :: [Pattern a] -> PatternM Bool isExhaustive ps = {-# SCC "isExhaustive" #-} not <$> useful ps (Wildcard undefined) @@ -72,7 +75,7 @@     let ty = coerce (unique <$> ns)     pure $         if IS.null (allU IS.\\ IS.fromList ty)-            then Just ((\u -> (Name undefined (Unique u) ())) <$> IS.toList allU)+            then Just ((\u -> Name undefined (Unique u) ()) <$> IS.toList allU)             else Nothing  useful :: [Pattern a] -> Pattern a -> PatternM Bool@@ -127,11 +130,8 @@ fstComplete ps = {-# SCC "fstComplete" #-}     if maxTupleLength > 0         then pure $ CompleteTuple maxTupleLength-        else do-            res <- isCompleteSet (concatMap extrCons fstColumn)-            pure $ case res of-                Just ns -> CompleteTags ns-                Nothing -> NotComplete+        else maybe NotComplete CompleteTags+                <$> isCompleteSet (concatMap extrCons fstColumn)     where fstColumn = fmap head ps           tuple (PatternTuple _ ps') = length ps'           tuple (OrPattern _ ps')    = maximum (tuple <$> ps')@@ -145,12 +145,12 @@ 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:qs)                  = do -- pattern var or wildcard+usefulMaranget ps (q:qs)                  = do -- var or wildcard     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))+        CompleteTags ns -> or <$> forM ns (\n -> usefulMaranget (specializeTag n (forget ps)) (fmap void qs))  specializeTupleVector :: Int -> Pattern a -> [Pattern a] -> [Pattern a] specializeTupleVector n p ps = {-# SCC "specializeTupleVector" #-} replicate n p ++ ps