haskell - 如何处理非详尽模式匹配的误报？

Question

假设您有一组精心设计的函数，并且了解您的设计，您可以知道函数和参数的某些组合永远不会发生。如果编译器愿意的话，这实际上是可以推断出来的。

为了清楚起见，请看这个例子(不要告诉我使用 map，这只是一个例子):

processAll :: [Int] -> [Int]
processAll [] = []
processAll a = let (x, xs) = processOne a in x:processAll xs
    where
        processOne (x:xs) = (x+1,xs)

在此示例中，很明显，永远不能使用空列表调用 processOne。使用 ghc 编译并添加 -Wall 会发出警告:

Pattern match(es) are non-exhaustive
In an equation for `processOne': Patterns not matched: []

当然，我通常不想禁用此类警告，因为我实际上可能在其他地方错过了模式匹配。但是，我希望 ghc 能够推断出该模式列表实际上在其领域中是详尽的。

禁用警告的替代解决方案是:

processAll :: [Int] -> [Int]
processAll [] = []
processAll a = let (x, xs) = processOne a in x:processAll xs
    where
        processOne (x:xs) = (x+1,xs)
        processOne _ = error "processor overheat - explosion imminent"

这既多余(因为processOne []无论如何都会导致错误)而且乏味。

一般应该如何处理这种情况？继续为每个不可能的情况添加错误消息吗？

<小时/>

在这个特定的例子中，我知道有更好的方法来处理这个问题，例如 having the caller match on the pattern 。因此，如果您想要的话，这里是另一个示例，它是我正在编写的词法分析器的非常简化的摘录，您也可以运行它:

import Data.Char (isNumber, isAlpha)
import Control.Monad

data TokenType = ParenOpen          -- (
                | ParenClose        -- )
                | Plus              -- +
                | Number String     -- A number
                | Variable String   -- Anything else
                | End               -- End of the stream
               deriving (Show, Eq)

-- content is the content of a file from a line and column on
type Content = (String, Int, Int)

-- a token is a token and its position as matched by the lexer
type Token = (TokenType, Int, Int)

lexer :: String -> [Token]
lexer = lexAll . (\s -> (s, 1, 1))
    where
        -- make a maybe value based on a Bool
        makeMaybe :: Bool -> a -> Maybe a
        makeMaybe p x = if p then return x else Nothing

        -- advance the content by one, taking care of line and column numbers
        advance :: Content -> Content
        advance (x:xs, l, c) = (xs, l', c')
                            where
                                l' = if x == '\n' then l + 1 else l
                                c' = if x == '\n' then 1 else c + 1

        -- advance the content by n
        advance' n content = iterate advance content !! n

        -- match a single character
        matchExact :: Char -> Content -> Maybe Content
        matchExact y content@(x:_, _, _) = makeMaybe (x == y) $ advance content

        -- match while pattern holds for characters
        matchPattern :: (Char -> Bool) -> Content -> Maybe (String, Content)
        matchPattern p content@(xs, _, _) = makeMaybe (len > 0) (pfx, advance' len content)
                                    where
                                        pfx = takeWhile p xs
                                        len = length pfx

        matchParenOpen = matchExact '(' >=> (\c -> return (ParenOpen, c))
        matchParenClose = matchExact ')' >=> (\c -> return (ParenClose, c))
        matchPlus = matchExact '+' >=> (\c -> return (Plus, c))
        matchNumber = matchPattern isNumber >=> (\(s, c) -> return (Number s, c))
        matchVariable = matchPattern isAlpha >=> (\(s, c) -> return (Variable s, c))

        lexOne :: Content -> (Token, Content)
        lexOne cur@([], l, c) = ((End, l, c), cur)
        lexOne cur@(_, l, c) = let tokenMatchers = [matchParenOpen,
                                                      matchParenClose,
                                                      matchPlus,
                                                      matchNumber,
                                                      matchVariable
                                                     ] in
                                case msum $ map ($ cur) tokenMatchers of
                                    -- if nothing could be matched, generate an error and skip the character
                                    Nothing -> lexOne $ advance cur
                                    -- otherwise, this is an interesting token
                                    Just (t, cnt) -> ((t, l, c), cnt)

        lexAll :: Content -> [Token]
        lexAll ([], _, _) = []
        lexAll content = token:lexAll rest
                    where
                        (token, rest) = lexOne content

main :: IO ()
main = getContents >>= putStrLn . unlines . map (\(t, l, c) -> show l ++ ":" ++ show c ++ ": " ++ show t) . lexer

在上面的示例中，lexOne 确保没有任何 match* 函数，因此 advance* 函数被赋予 Content 带有空字符串。 ghc 警告:

Pattern match(es) are non-exhaustive
In an equation for `advance': Patterns not matched: ([], _, _)

Pattern match(es) are non-exhaustive
In an equation for `matchExact': Patterns not matched: _ ([], _, _)

我可以肯定这永远不会发生。处理这个问题的正确方法是什么？

Answer 1

为什么不直接为 NonEmptyContent 添加类型？

module SO24967745 where
import Control.Monad
import Data.Char

data TokenType = ParenOpen          -- (
                | ParenClose        -- )
                | Plus              -- +
                | Number String     -- A number
                | Variable String   -- Anything else
                | End               -- End of the stream
               deriving (Show, Eq)

-- content is the content of a file from a line and column on
type Content = (String, Int, Int)
type NonEmptyContent = (Char, String, Int, Int)

-- a token is a token and its position as matched by the lexer
type Token = (TokenType, Int, Int)

lexer :: String -> [Token]
lexer = lexAll . (\s -> (s, 1, 1))
    where
        -- make a maybe value based on a Bool
        makeMaybe :: Bool -> a -> Maybe a
        makeMaybe p x = if p then return x else Nothing

        toNonEmptyContent :: Content -> Maybe NonEmptyContent
        toNonEmptyContent ([], _, _) = Nothing
        toNonEmptyContent (x:xs,l,c) = Just (x,xs,l,c)

        toContent :: NonEmptyContent -> Content
        toContent (x, xs, l, c) = (x:xs, l, c)

        -- advance the content by one, taking care of line and column numbers
        advance :: NonEmptyContent -> Content
        advance (x, xs, l, c) = (xs, l', c')
                            where
                                l' = if x == '\n' then l + 1 else l
                                c' = if x == '\n' then 1 else c + 1

        -- advance the content by n
        advance' :: Int -> NonEmptyContent -> Maybe Content
        advance' n = foldr (>=>) Just (replicate n (fmap advance . toNonEmptyContent)) . toContent

        -- match a single character
        matchExact :: Char -> NonEmptyContent -> Maybe Content
        matchExact y content@(x,_, _, _) = makeMaybe (x == y) $ advance content

        -- match while pattern holds for characters
        matchPattern :: (Char -> Bool) -> NonEmptyContent -> Maybe (String, Content)
        matchPattern p content@(x,xs, _, _) = do
          let pfx = takeWhile p (x:xs)
              len = length pfx
          guard (len > 0) 
          content' <- advance' len content
          return (pfx, content')

        matchParenOpen = matchExact '(' >=> (\c -> return (ParenOpen, c))
        matchParenClose = matchExact ')' >=> (\c -> return (ParenClose, c))
        matchPlus = matchExact '+' >=> (\c -> return (Plus, c))
        matchNumber = matchPattern isNumber >=> (\(s, c) -> return (Number s, c))
        matchVariable = matchPattern isAlpha >=> (\(s, c) -> return (Variable s, c))

        lexOne :: Content -> (Token, Content)
        lexOne cur@([], l, c) = ((End, l, c), cur)
        lexOne (x:xs, l, c)   = let cur = (x,xs,l,c)
                                    tokenMatchers = [matchParenOpen,
                                                      matchParenClose,
                                                      matchPlus,
                                                      matchNumber,
                                                      matchVariable
                                                     ] in
                                case msum $ map ($ cur) tokenMatchers of
                                    -- if nothing could be matched, generate an error and skip the character
                                    Nothing -> lexOne $ advance cur
                                    -- otherwise, this is an interesting token
                                    Just (t, cnt) -> ((t, l, c), cnt)

        lexAll :: Content -> [Token]
        lexAll ([], _, _) = []
        lexAll content = token:lexAll rest
                    where
                        (token, rest) = lexOne content

main :: IO ()
main = getContents >>= putStrLn . unlines . map (\(t, l, c) -> show l ++ ":" ++ show c ++ ": " ++ show t) . lexer