{-# LANGUAGE OverloadedStrings #-}

-- | Checking for missing cases in a match expression.  Based on
-- "Warnings for pattern matching" by Luc Maranget.  We only detect
-- inexhaustiveness here - ideally, we would also like to check for
-- redundant cases.
module Language.Futhark.TypeChecker.Match
  ( unmatched,
    Match,
  )
where

import qualified Data.Map.Strict as M
import Data.Maybe
import Futhark.Util (maybeHead, nubOrd)
import Futhark.Util.Pretty hiding (bool, group, space)
import Language.Futhark hiding (ExpBase (Constr), unscopeType)

data Constr
  = Constr Name
  | ConstrTuple
  | ConstrRecord [Name]
  | -- | Treated as 0-ary.
    ConstrLit PatLit
  deriving (Constr -> Constr -> Bool
(Constr -> Constr -> Bool)
-> (Constr -> Constr -> Bool) -> Eq Constr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constr -> Constr -> Bool
$c/= :: Constr -> Constr -> Bool
== :: Constr -> Constr -> Bool
$c== :: Constr -> Constr -> Bool
Eq, Eq Constr
Eq Constr
-> (Constr -> Constr -> Ordering)
-> (Constr -> Constr -> Bool)
-> (Constr -> Constr -> Bool)
-> (Constr -> Constr -> Bool)
-> (Constr -> Constr -> Bool)
-> (Constr -> Constr -> Constr)
-> (Constr -> Constr -> Constr)
-> Ord Constr
Constr -> Constr -> Bool
Constr -> Constr -> Ordering
Constr -> Constr -> Constr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Constr -> Constr -> Constr
$cmin :: Constr -> Constr -> Constr
max :: Constr -> Constr -> Constr
$cmax :: Constr -> Constr -> Constr
>= :: Constr -> Constr -> Bool
$c>= :: Constr -> Constr -> Bool
> :: Constr -> Constr -> Bool
$c> :: Constr -> Constr -> Bool
<= :: Constr -> Constr -> Bool
$c<= :: Constr -> Constr -> Bool
< :: Constr -> Constr -> Bool
$c< :: Constr -> Constr -> Bool
compare :: Constr -> Constr -> Ordering
$ccompare :: Constr -> Constr -> Ordering
Ord, Int -> Constr -> ShowS
[Constr] -> ShowS
Constr -> String
(Int -> Constr -> ShowS)
-> (Constr -> String) -> ([Constr] -> ShowS) -> Show Constr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constr] -> ShowS
$cshowList :: [Constr] -> ShowS
show :: Constr -> String
$cshow :: Constr -> String
showsPrec :: Int -> Constr -> ShowS
$cshowsPrec :: Int -> Constr -> ShowS
Show)

-- | A representation of the essentials of a pattern.
data Match
  = MatchWild StructType
  | MatchConstr Constr [Match] StructType
  deriving (Match -> Match -> Bool
(Match -> Match -> Bool) -> (Match -> Match -> Bool) -> Eq Match
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Match -> Match -> Bool
$c/= :: Match -> Match -> Bool
== :: Match -> Match -> Bool
$c== :: Match -> Match -> Bool
Eq, Eq Match
Eq Match
-> (Match -> Match -> Ordering)
-> (Match -> Match -> Bool)
-> (Match -> Match -> Bool)
-> (Match -> Match -> Bool)
-> (Match -> Match -> Bool)
-> (Match -> Match -> Match)
-> (Match -> Match -> Match)
-> Ord Match
Match -> Match -> Bool
Match -> Match -> Ordering
Match -> Match -> Match
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Match -> Match -> Match
$cmin :: Match -> Match -> Match
max :: Match -> Match -> Match
$cmax :: Match -> Match -> Match
>= :: Match -> Match -> Bool
$c>= :: Match -> Match -> Bool
> :: Match -> Match -> Bool
$c> :: Match -> Match -> Bool
<= :: Match -> Match -> Bool
$c<= :: Match -> Match -> Bool
< :: Match -> Match -> Bool
$c< :: Match -> Match -> Bool
compare :: Match -> Match -> Ordering
$ccompare :: Match -> Match -> Ordering
Ord, Int -> Match -> ShowS
[Match] -> ShowS
Match -> String
(Int -> Match -> ShowS)
-> (Match -> String) -> ([Match] -> ShowS) -> Show Match
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Match] -> ShowS
$cshowList :: [Match] -> ShowS
show :: Match -> String
$cshow :: Match -> String
showsPrec :: Int -> Match -> ShowS
$cshowsPrec :: Int -> Match -> ShowS
Show)

matchType :: Match -> StructType
matchType :: Match -> StructType
matchType (MatchWild StructType
t) = StructType
t
matchType (MatchConstr Constr
_ [Match]
_ StructType
t) = StructType
t

pprMatch :: Int -> Match -> Doc
pprMatch :: Int -> Match -> Doc
pprMatch Int
_ MatchWild {} = Doc
"_"
pprMatch Int
_ (MatchConstr (ConstrLit PatLit
l) [Match]
_ StructType
_) = PatLit -> Doc
forall a. Pretty a => a -> Doc
ppr PatLit
l
pprMatch Int
p (MatchConstr (Constr Name
c) [Match]
ps StructType
_) =
  Bool -> Doc -> Doc
parensIf (Bool -> Bool
not ([Match] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Match]
ps) Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    Doc
"#" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Name -> Doc
forall a. Pretty a => a -> Doc
ppr Name
c Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ((Match -> Doc) -> [Match] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc
" " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>) (Doc -> Doc) -> (Match -> Doc) -> Match -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Match -> Doc
pprMatch Int
10) [Match]
ps)
pprMatch Int
_ (MatchConstr Constr
ConstrTuple [Match]
ps StructType
_) =
  Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Match -> Doc) -> [Match] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Match -> Doc
pprMatch (-Int
1)) [Match]
ps
pprMatch Int
_ (MatchConstr (ConstrRecord [Name]
fs) [Match]
ps StructType
_) =
  Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Name -> Match -> Doc) -> [Name] -> [Match] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Name -> Match -> Doc
ppField [Name]
fs [Match]
ps
  where
    ppField :: Name -> Match -> Doc
ppField Name
name Match
t = String -> Doc
text (Name -> String
nameToString Name
name) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
equals Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Match -> Doc
pprMatch (-Int
1) Match
t

instance Pretty Match where
  ppr :: Match -> Doc
ppr = Int -> Match -> Doc
pprMatch (-Int
1)

patternToMatch :: Pattern -> Match
patternToMatch :: Pattern -> Match
patternToMatch (Id VName
_ (Info PatternType
t) SrcLoc
_) = StructType -> Match
MatchWild (StructType -> Match) -> StructType -> Match
forall a b. (a -> b) -> a -> b
$ PatternType -> StructType
forall dim as. TypeBase dim as -> TypeBase dim ()
toStruct PatternType
t
patternToMatch (Wildcard (Info PatternType
t) SrcLoc
_) = StructType -> Match
MatchWild (StructType -> Match) -> StructType -> Match
forall a b. (a -> b) -> a -> b
$ PatternType -> StructType
forall dim as. TypeBase dim as -> TypeBase dim ()
toStruct PatternType
t
patternToMatch (PatternParens Pattern
p SrcLoc
_) = Pattern -> Match
patternToMatch Pattern
p
patternToMatch (PatternAscription Pattern
p TypeDeclBase Info VName
_ SrcLoc
_) = Pattern -> Match
patternToMatch Pattern
p
patternToMatch (PatternLit PatLit
l (Info PatternType
t) SrcLoc
_) =
  Constr -> [Match] -> StructType -> Match
MatchConstr (PatLit -> Constr
ConstrLit PatLit
l) [] (StructType -> Match) -> StructType -> Match
forall a b. (a -> b) -> a -> b
$ PatternType -> StructType
forall dim as. TypeBase dim as -> TypeBase dim ()
toStruct PatternType
t
patternToMatch p :: Pattern
p@(TuplePattern [Pattern]
ps SrcLoc
_) =
  Constr -> [Match] -> StructType -> Match
MatchConstr Constr
ConstrTuple ((Pattern -> Match) -> [Pattern] -> [Match]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Match
patternToMatch [Pattern]
ps) (StructType -> Match) -> StructType -> Match
forall a b. (a -> b) -> a -> b
$
    Pattern -> StructType
patternStructType Pattern
p
patternToMatch p :: Pattern
p@(RecordPattern [(Name, Pattern)]
fs SrcLoc
_) =
  Constr -> [Match] -> StructType -> Match
MatchConstr ([Name] -> Constr
ConstrRecord [Name]
fnames) ((Pattern -> Match) -> [Pattern] -> [Match]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Match
patternToMatch [Pattern]
ps) (StructType -> Match) -> StructType -> Match
forall a b. (a -> b) -> a -> b
$
    Pattern -> StructType
patternStructType Pattern
p
  where
    ([Name]
fnames, [Pattern]
ps) = [(Name, Pattern)] -> ([Name], [Pattern])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Name, Pattern)] -> ([Name], [Pattern]))
-> [(Name, Pattern)] -> ([Name], [Pattern])
forall a b. (a -> b) -> a -> b
$ Map Name Pattern -> [(Name, Pattern)]
forall a. Map Name a -> [(Name, a)]
sortFields (Map Name Pattern -> [(Name, Pattern)])
-> Map Name Pattern -> [(Name, Pattern)]
forall a b. (a -> b) -> a -> b
$ [(Name, Pattern)] -> Map Name Pattern
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Name, Pattern)]
fs
patternToMatch (PatternConstr Name
c (Info PatternType
t) [Pattern]
args SrcLoc
_) =
  Constr -> [Match] -> StructType -> Match
MatchConstr (Name -> Constr
Constr Name
c) ((Pattern -> Match) -> [Pattern] -> [Match]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Match
patternToMatch [Pattern]
args) (StructType -> Match) -> StructType -> Match
forall a b. (a -> b) -> a -> b
$ PatternType -> StructType
forall dim as. TypeBase dim as -> TypeBase dim ()
toStruct PatternType
t

isConstr :: Match -> Maybe Name
isConstr :: Match -> Maybe Name
isConstr (MatchConstr (Constr Name
c) [Match]
_ StructType
_) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
c
isConstr Match
_ = Maybe Name
forall a. Maybe a
Nothing

complete :: [Match] -> Bool
complete :: [Match] -> Bool
complete [Match]
xs
  | Just Match
x <- [Match] -> Maybe Match
forall a. [a] -> Maybe a
maybeHead [Match]
xs,
    Scalar (Sum Map Name [StructType]
all_cs) <- Match -> StructType
matchType Match
x,
    Just [Name]
xs_cs <- (Match -> Maybe Name) -> [Match] -> Maybe [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Match -> Maybe Name
isConstr [Match]
xs =
    (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
xs_cs) (Map Name [StructType] -> [Name]
forall k a. Map k a -> [k]
M.keys Map Name [StructType]
all_cs)
  | Bool
otherwise =
    ((Match -> Bool) -> [Match] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Match -> Bool
isBool Bool
True) [Match]
xs Bool -> Bool -> Bool
&& (Match -> Bool) -> [Match] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Match -> Bool
isBool Bool
False) [Match]
xs)
      Bool -> Bool -> Bool
|| (Match -> Bool) -> [Match] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Match -> Bool
isRecord [Match]
xs
      Bool -> Bool -> Bool
|| (Match -> Bool) -> [Match] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Match -> Bool
isTuple [Match]
xs
  where
    isBool :: Bool -> Match -> Bool
isBool Bool
b1 (MatchConstr (ConstrLit (PatLitPrim (BoolValue Bool
b2))) [Match]
_ StructType
_) = Bool
b1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b2
    isBool Bool
_ Match
_ = Bool
False
    isRecord :: Match -> Bool
isRecord (MatchConstr ConstrRecord {} [Match]
_ StructType
_) = Bool
True
    isRecord Match
_ = Bool
False
    isTuple :: Match -> Bool
isTuple (MatchConstr Constr
ConstrTuple [Match]
_ StructType
_) = Bool
True
    isTuple Match
_ = Bool
False

specialise :: [StructType] -> Match -> [[Match]] -> [[Match]]
specialise :: [StructType] -> Match -> [[Match]] -> [[Match]]
specialise [StructType]
ats Match
c1 = [[Match]] -> [[Match]]
go
  where
    go :: [[Match]] -> [[Match]]
go ((Match
c2 : [Match]
row) : [[Match]]
ps)
      | Just [Match]
args <- Match -> Match -> Maybe [Match]
match Match
c1 Match
c2 =
        ([Match]
args [Match] -> [Match] -> [Match]
forall a. [a] -> [a] -> [a]
++ [Match]
row) [Match] -> [[Match]] -> [[Match]]
forall a. a -> [a] -> [a]
: [[Match]] -> [[Match]]
go [[Match]]
ps
      | Bool
otherwise =
        [[Match]] -> [[Match]]
go [[Match]]
ps
    go [[Match]]
_ = []

    match :: Match -> Match -> Maybe [Match]
match (MatchConstr Constr
c1' [Match]
_ StructType
_) (MatchConstr Constr
c2' [Match]
args StructType
_)
      | Constr
c1' Constr -> Constr -> Bool
forall a. Eq a => a -> a -> Bool
== Constr
c2' =
        [Match] -> Maybe [Match]
forall a. a -> Maybe a
Just [Match]
args
      | Bool
otherwise =
        Maybe [Match]
forall a. Maybe a
Nothing
    match Match
_ MatchWild {} =
      [Match] -> Maybe [Match]
forall a. a -> Maybe a
Just ([Match] -> Maybe [Match]) -> [Match] -> Maybe [Match]
forall a b. (a -> b) -> a -> b
$ (StructType -> Match) -> [StructType] -> [Match]
forall a b. (a -> b) -> [a] -> [b]
map StructType -> Match
MatchWild [StructType]
ats
    match Match
_ Match
_ =
      Maybe [Match]
forall a. Maybe a
Nothing

defaultMat :: [[Match]] -> [[Match]]
defaultMat :: [[Match]] -> [[Match]]
defaultMat = ([Match] -> Maybe [Match]) -> [[Match]] -> [[Match]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Match] -> Maybe [Match]
onRow
  where
    onRow :: [Match] -> Maybe [Match]
onRow (MatchConstr {} : [Match]
_) = Maybe [Match]
forall a. Maybe a
Nothing
    onRow (MatchWild {} : [Match]
ps) = [Match] -> Maybe [Match]
forall a. a -> Maybe a
Just [Match]
ps
    onRow [] = Maybe [Match]
forall a. Maybe a
Nothing -- Should not happen.

findUnmatched :: [[Match]] -> Int -> [[Match]]
findUnmatched :: [[Match]] -> Int -> [[Match]]
findUnmatched [[Match]]
pmat Int
n
  | ((Match
p : [Match]
_) : [[Match]]
_) <- [[Match]]
pmat,
    Just [Match]
heads <- ([Match] -> Maybe Match) -> [[Match]] -> Maybe [Match]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Match] -> Maybe Match
forall a. [a] -> Maybe a
maybeHead [[Match]]
pmat =
    if [Match] -> Bool
complete [Match]
heads
      then [Match] -> [[Match]]
completeCase [Match]
heads
      else StructType -> [Match] -> [[Match]]
incompleteCase (Match -> StructType
matchType Match
p) [Match]
heads
  where
    completeCase :: [Match] -> [[Match]]
completeCase [Match]
cs = do
      Match
c <- [Match]
cs
      let ats :: [StructType]
ats = case Match
c of
            MatchConstr Constr
_ [Match]
args StructType
_ -> (Match -> StructType) -> [Match] -> [StructType]
forall a b. (a -> b) -> [a] -> [b]
map Match -> StructType
matchType [Match]
args
            MatchWild StructType
_ -> []
          a_k :: Int
a_k = [StructType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StructType]
ats
          pmat' :: [[Match]]
pmat' = [StructType] -> Match -> [[Match]] -> [[Match]]
specialise [StructType]
ats Match
c [[Match]]
pmat
      [Match]
u <- [[Match]] -> Int -> [[Match]]
findUnmatched [[Match]]
pmat' (Int
a_k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      [Match] -> [[Match]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Match] -> [[Match]]) -> [Match] -> [[Match]]
forall a b. (a -> b) -> a -> b
$ case Match
c of
        MatchConstr Constr
c' [Match]
_ StructType
t ->
          let ([Match]
r, [Match]
p) = Int -> [Match] -> ([Match], [Match])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
a_k [Match]
u
           in Constr -> [Match] -> StructType -> Match
MatchConstr Constr
c' [Match]
r StructType
t Match -> [Match] -> [Match]
forall a. a -> [a] -> [a]
: [Match]
p
        MatchWild StructType
t ->
          StructType -> Match
MatchWild StructType
t Match -> [Match] -> [Match]
forall a. a -> [a] -> [a]
: [Match]
u

    incompleteCase :: StructType -> [Match] -> [[Match]]
incompleteCase StructType
pt [Match]
cs = do
      [Match]
u <- [[Match]] -> Int -> [[Match]]
findUnmatched ([[Match]] -> [[Match]]
defaultMat [[Match]]
pmat) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      if [Match] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Match]
cs
        then [Match] -> [[Match]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Match] -> [[Match]]) -> [Match] -> [[Match]]
forall a b. (a -> b) -> a -> b
$ StructType -> Match
MatchWild StructType
pt Match -> [Match] -> [Match]
forall a. a -> [a] -> [a]
: [Match]
u
        else case StructType
pt of
          Scalar (Sum Map Name [StructType]
all_cs) -> do
            -- Figure out which constructors are missing.
            let sigma :: [Name]
sigma = (Match -> Maybe Name) -> [Match] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Match -> Maybe Name
isConstr [Match]
cs
                notCovered :: (Name, b) -> Bool
notCovered (Name
k, b
_) = Name
k Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
sigma
            (Name
cname, [StructType]
ts) <- ((Name, [StructType]) -> Bool)
-> [(Name, [StructType])] -> [(Name, [StructType])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name, [StructType]) -> Bool
forall {b}. (Name, b) -> Bool
notCovered ([(Name, [StructType])] -> [(Name, [StructType])])
-> [(Name, [StructType])] -> [(Name, [StructType])]
forall a b. (a -> b) -> a -> b
$ Map Name [StructType] -> [(Name, [StructType])]
forall k a. Map k a -> [(k, a)]
M.toList Map Name [StructType]
all_cs
            [Match] -> [[Match]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Match] -> [[Match]]) -> [Match] -> [[Match]]
forall a b. (a -> b) -> a -> b
$ Constr -> [Match] -> StructType -> Match
MatchConstr (Name -> Constr
Constr Name
cname) ((StructType -> Match) -> [StructType] -> [Match]
forall a b. (a -> b) -> [a] -> [b]
map StructType -> Match
MatchWild [StructType]
ts) StructType
pt Match -> [Match] -> [Match]
forall a. a -> [a] -> [a]
: [Match]
u
          StructType
_ ->
            -- This is where we could have enumerated missing match
            -- values (e.g. for booleans), rather than just emitting a
            -- wildcard.
            [Match] -> [[Match]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Match] -> [[Match]]) -> [Match] -> [[Match]]
forall a b. (a -> b) -> a -> b
$ StructType -> Match
MatchWild StructType
pt Match -> [Match] -> [Match]
forall a. a -> [a] -> [a]
: [Match]
u

-- If we get here, then the number of columns must be zero.
findUnmatched [] Int
_ = [[]]
findUnmatched [[Match]]
_ Int
_ = []

{-# NOINLINE unmatched #-}

-- | Find the unmatched cases.
unmatched :: [Pattern] -> [Match]
unmatched :: [Pattern] -> [Match]
unmatched [Pattern]
orig_ps =
  -- The algorithm may find duplicate example, which we filter away
  -- here.
  [Match] -> [Match]
forall a. Ord a => [a] -> [a]
nubOrd ([Match] -> [Match]) -> [Match] -> [Match]
forall a b. (a -> b) -> a -> b
$
    ([Match] -> Maybe Match) -> [[Match]] -> [Match]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Match] -> Maybe Match
forall a. [a] -> Maybe a
maybeHead ([[Match]] -> [Match]) -> [[Match]] -> [Match]
forall a b. (a -> b) -> a -> b
$
      [[Match]] -> Int -> [[Match]]
findUnmatched ((Pattern -> [Match]) -> [Pattern] -> [[Match]]
forall a b. (a -> b) -> [a] -> [b]
map ((Match -> [Match] -> [Match]
forall a. a -> [a] -> [a]
: []) (Match -> [Match]) -> (Pattern -> Match) -> Pattern -> [Match]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> Match
patternToMatch) [Pattern]
orig_ps) Int
1