author Ian Lynagh Sun, 6 Nov 2011 21:26:35 +0000 (21:26 +0000) committer Ian Lynagh Sun, 6 Nov 2011 21:26:35 +0000 (21:26 +0000)

index 01ceeb2..7853e4e 100644 (file)
@@ -5,13 +5,6 @@
% Author: Juan J. Quintela    <quintela@krilin.dc.fi.udc.es>

\begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
--- for details
-
{-# OPTIONS -fno-warn-incomplete-patterns #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
@@ -23,7 +16,7 @@ module Check ( check , ExhaustivePat ) where

#include "HsVersions.h"

-import HsSyn
+import HsSyn
import TcHsSyn
import DsUtils
import MatchLit
@@ -51,19 +44,19 @@ To discover that we go through the list of equations in a tree-like fashion.

If you like theory, a similar algorithm is described in:
\begin{quotation}
-       {\em Two Techniques for Compiling Lazy Pattern Matching},
-       Luc Maranguet,
-       INRIA Rocquencourt (RR-2385, 1994)
+        {\em Two Techniques for Compiling Lazy Pattern Matching},
+        Luc Maranguet,
+        INRIA Rocquencourt (RR-2385, 1994)
\end{quotation}
The algorithm is based on the first technique, but there are some differences:
\begin{itemize}
\item We don't generate code
-\item We have constructors and literals (not only literals as in the
-         article)
-\item We don't use directions, we must select the columns from
-         left-to-right
+\item We have constructors and literals (not only literals as in the
+          article)
+\item We don't use directions, we must select the columns from
+          left-to-right
\end{itemize}
-(By the way the second technique is really similar to the one used in
+(By the way the second technique is really similar to the one used in
@Match.lhs@ to generate code)

This function takes the equations of a pattern and returns:
@@ -71,7 +64,7 @@ This function takes the equations of a pattern and returns:
\item The patterns that are not recognized
\item The equations that are not overlapped
\end{itemize}
-It simplify the patterns and then call @check'@ (the same semantics), and it
+It simplify the patterns and then call @check'@ (the same semantics), and it
needs to reconstruct the patterns again ....

The problem appear with things like:
@@ -79,7 +72,7 @@ The problem appear with things like:
f [x,y]   = ....
f (x:xs)  = .....
\end{verbatim}
-We want to put the two patterns with the same syntax, (prefix form) and
+We want to put the two patterns with the same syntax, (prefix form) and
then all the constructors are equal:
\begin{verbatim}
f (: x (: y []))   = ....
@@ -87,15 +80,15 @@ then all the constructors are equal:
\end{verbatim}
(more about that in @tidy_eqns@)

-We would prefer to have a @WarningPat@ of type @String@, but Strings and the
+We would prefer to have a @WarningPat@ of type @String@, but Strings and the
Pretty Printer are not friends.

We use @InPat@ in @WarningPat@ instead of @OutPat@
-because we need to print the
-warning messages in the same way they are introduced, i.e. if the user
+because we need to print the
+warning messages in the same way they are introduced, i.e. if the user
wrote:
\begin{verbatim}
-       f [x,y] = ..
+        f [x,y] = ..
\end{verbatim}
He don't want a warning message written:
\begin{verbatim}
@@ -104,7 +97,7 @@ He don't want a warning message written:
Then we need to use InPats.
\begin{quotation}
Juan Quintela 5 JUL 1998\\
-         User-friendliness and compiler writers are no friends.
+          User-friendliness and compiler writers are no friends.
\end{quotation}

\begin{code}
@@ -120,16 +113,16 @@ check :: [EquationInfo] -> ([ExhaustivePat], [EquationInfo])
check qs = (untidy_warns, shadowed_eqns)
where
tidy_qs = map tidy_eqn qs
-       (warns, used_nos) = check' ([1..] zip tidy_qs)
-       untidy_warns = map untidy_exhaustive warns
-       shadowed_eqns = [eqn | (eqn,i) <- qs zip [1..],
-                               not (i elementOfUniqSet used_nos)]
+        (warns, used_nos) = check' ([1..] zip tidy_qs)
+        untidy_warns = map untidy_exhaustive warns
+        shadowed_eqns = [eqn | (eqn,i) <- qs zip [1..],
+                                not (i elementOfUniqSet used_nos)]

untidy_exhaustive :: ExhaustivePat -> ExhaustivePat
-untidy_exhaustive ([pat], messages) =
-                 ([untidy_no_pars pat], map untidy_message messages)
-untidy_exhaustive (pats, messages) =
-                 (map untidy_pars pats, map untidy_message messages)
+untidy_exhaustive ([pat], messages) =
+                  ([untidy_no_pars pat], map untidy_message messages)
+untidy_exhaustive (pats, messages) =
+                  (map untidy_pars pats, map untidy_message messages)

untidy_message :: (Name, [HsLit]) -> (Name, [HsLit])
untidy_message (string, lits) = (string, map untidy_lit lits)
@@ -139,7 +132,7 @@ The function @untidy@ does the reverse work of the @tidy_pat@ funcion.

\begin{code}

-type NeedPars = Bool
+type NeedPars = Bool

untidy_no_pars :: WarningPat -> WarningPat
untidy_no_pars p = untidy False p
@@ -157,15 +150,15 @@ untidy b (L loc p) = L loc (untidy' b p)
untidy' b (ConPatIn name ps)     = pars b (L loc (ConPatIn name (untidy_con ps)))
untidy' _ (ListPat pats ty)      = ListPat (map untidy_no_pars pats) ty
untidy' _ (TuplePat pats box ty) = TuplePat (map untidy_no_pars pats) box ty
-    untidy' _ (PArrPat _ _)         = panic "Check.untidy: Shouldn't get a parallel array here!"
-    untidy' _ (SigPatIn _ _)        = panic "Check.untidy: SigPat"
+    untidy' _ (PArrPat _ _)          = panic "Check.untidy: Shouldn't get a parallel array here!"
+    untidy' _ (SigPatIn _ _)         = panic "Check.untidy: SigPat"

untidy_con :: HsConPatDetails Name -> HsConPatDetails Name
-untidy_con (PrefixCon pats) = PrefixCon (map untidy_pars pats)
+untidy_con (PrefixCon pats) = PrefixCon (map untidy_pars pats)
untidy_con (InfixCon p1 p2) = InfixCon  (untidy_pars p1) (untidy_pars p2)
-untidy_con (RecCon (HsRecFields flds dd))
+untidy_con (RecCon (HsRecFields flds dd))
= RecCon (HsRecFields [ fld { hsRecFieldArg = untidy_pars (hsRecFieldArg fld) }
-                       | fld <- flds ] dd)
+                        | fld <- flds ] dd)

pars :: NeedPars -> WarningPat -> Pat Name
pars True p = ParPat p
@@ -173,7 +166,7 @@ pars _    p = unLoc p

untidy_lit :: HsLit -> HsLit
untidy_lit (HsCharPrim c) = HsChar c
-untidy_lit lit                   = lit
+untidy_lit lit            = lit
\end{code}

This equation is the same that check, the only difference is that the
@@ -183,20 +176,20 @@ the reason top have two functions, check is the external interface,

There are several cases:

-\begin{itemize}
-\item There are no equations: Everything is OK.
+\begin{itemize}
+\item There are no equations: Everything is OK.
\item There are only one equation, that can fail, and all the patterns are
-      variables. Then that equation is used and the same equation is
+      variables. Then that equation is used and the same equation is
non-exhaustive.
-\item All the patterns are variables, and the match can fail, there are
-      more equations then the results is the result of the rest of equations
+\item All the patterns are variables, and the match can fail, there are
+      more equations then the results is the result of the rest of equations
and this equation is used also.

-\item The general case, if all the patterns are variables (here the match
-      can't fail) then the result is that this equation is used and this
+\item The general case, if all the patterns are variables (here the match
+      can't fail) then the result is that this equation is used and this
equation doesn't generate non-exhaustive cases.

-\item In the general case, there can exist literals ,constructors or only
+\item In the general case, there can exist literals ,constructors or only
vars in the first column, we actuate in consequence.

\end{itemize}
@@ -204,20 +197,20 @@ There are several cases:

\begin{code}

-check' :: [(EqnNo, EquationInfo)]
-       -> ([ExhaustivePat],    -- Pattern scheme that might not be matched at all
-           EqnSet)             -- Eqns that are used (others are overlapped)
+check' :: [(EqnNo, EquationInfo)]
+        -> ([ExhaustivePat],    -- Pattern scheme that might not be matched at all
+            EqnSet)             -- Eqns that are used (others are overlapped)

check' [] = ([([],[])],emptyUniqSet)

-check' ((n, EqnInfo { eqn_pats = ps, eqn_rhs = MatchResult can_fail _ }) : rs)
+check' ((n, EqnInfo { eqn_pats = ps, eqn_rhs = MatchResult can_fail _ }) : rs)
| first_eqn_all_vars && case can_fail of { CantFail -> True; CanFail -> False }
-   = ([], unitUniqSet n)       -- One eqn, which can't fail
+   = ([], unitUniqSet n)        -- One eqn, which can't fail

-   | first_eqn_all_vars && null rs     -- One eqn, but it can fail
+   | first_eqn_all_vars && null rs      -- One eqn, but it can fail
= ([(takeList ps (repeat nlWildPat),[])], unitUniqSet n)

-   | first_eqn_all_vars                -- Several eqns, first can fail
+   | first_eqn_all_vars         -- Several eqns, first can fail
= (pats, addOneToUniqSet indexs n)
where
first_eqn_all_vars = all_vars ps
@@ -228,7 +221,7 @@ check' qs
| some_constructors = split_by_constructor qs
| only_vars         = first_column_only_vars qs
| otherwise = pprPanic "Check.check': Not implemented :-(" (ppr first_pats)
-                -- Shouldn't happen
+                 -- Shouldn't happen
where
-- Note: RecPats will have been simplified to ConPats
--       at this stage.
@@ -239,7 +232,7 @@ check' qs
\end{code}

Here begins the code to deal with literals, we need to split the matrix
-in different matrix beginning by each literal and a last matrix with the
+in different matrix beginning by each literal and a last matrix with the
rest of values.

\begin{code}
@@ -249,73 +242,73 @@ split_by_literals qs = process_literals used_lits qs
used_lits = get_used_lits qs
\end{code}

-@process_explicit_literals@ is a function that process each literal that appears
-in the column of the matrix.
+@process_explicit_literals@ is a function that process each literal that appears
+in the column of the matrix.

\begin{code}
process_explicit_literals :: [HsLit] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
process_explicit_literals lits qs = (concat pats, unionManyUniqSets indexs)
-    where
+    where
pats_indexs   = map (\x -> construct_literal_matrix x qs) lits
-      (pats,indexs) = unzip pats_indexs
+      (pats,indexs) = unzip pats_indexs
\end{code}

-@process_literals@ calls @process_explicit_literals@ to deal with the literals
-that appears in the matrix and deal also with the rest of the cases. It
+@process_literals@ calls @process_explicit_literals@ to deal with the literals
+that appears in the matrix and deal also with the rest of the cases. It
must be one Variable to be complete.

\begin{code}

process_literals :: [HsLit] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
-process_literals used_lits qs
+process_literals used_lits qs
| null default_eqns  = ASSERT( not (null qs) ) ([make_row_vars used_lits (head qs)] ++ pats,indexs)
| otherwise          = (pats_default,indexs_default)
where
(pats,indexs)   = process_explicit_literals used_lits qs
-       default_eqns    = ASSERT2( okGroup qs, pprGroup qs )
-                        [remove_var q | q <- qs, is_var (firstPatN q)]
-       (pats',indexs') = check' default_eqns
-       pats_default    = [(nlWildPat:ps,constraints) | (ps,constraints) <- (pats')] ++ pats
+       default_eqns    = ASSERT2( okGroup qs, pprGroup qs )
+                         [remove_var q | q <- qs, is_var (firstPatN q)]
+       (pats',indexs') = check' default_eqns
+       pats_default    = [(nlWildPat:ps,constraints) | (ps,constraints) <- (pats')] ++ pats
indexs_default  = unionUniqSets indexs' indexs
\end{code}

-Here we have selected the literal and we will select all the equations that
+Here we have selected the literal and we will select all the equations that
begins for that literal and create a new matrix.

\begin{code}
construct_literal_matrix :: HsLit -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
construct_literal_matrix lit qs =
-    (map (\ (xs,ys) -> (new_lit:xs,ys)) pats,indexs)
+    (map (\ (xs,ys) -> (new_lit:xs,ys)) pats,indexs)
where
-    (pats,indexs) = (check' (remove_first_column_lit lit qs))
+    (pats,indexs) = (check' (remove_first_column_lit lit qs))
new_lit = nlLitPat lit

remove_first_column_lit :: HsLit
-                        -> [(EqnNo, EquationInfo)]
+                        -> [(EqnNo, EquationInfo)]
-> [(EqnNo, EquationInfo)]
remove_first_column_lit lit qs
-  = ASSERT2( okGroup qs, pprGroup qs )
+  = ASSERT2( okGroup qs, pprGroup qs )
[(n, shift_pat eqn) | q@(n,eqn) <- qs, is_var_lit lit (firstPatN q)]
where
shift_pat eqn@(EqnInfo { eqn_pats = _:ps}) = eqn { eqn_pats = ps }
shift_pat _                                = panic "Check.shift_var: no patterns"
\end{code}

-This function splits the equations @qs@ in groups that deal with the
+This function splits the equations @qs@ in groups that deal with the
same constructor.

\begin{code}
split_by_constructor :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat], EqnSet)
-split_by_constructor qs
-  | notNull unused_cons = need_default_case used_cons unused_cons qs
-  | otherwise           = no_need_default_case used_cons qs
-                       where
-                          used_cons   = get_used_cons qs
-                          unused_cons = get_unused_cons used_cons
+split_by_constructor qs
+  | notNull unused_cons = need_default_case used_cons unused_cons qs
+  | otherwise           = no_need_default_case used_cons qs
+                       where
+                          used_cons   = get_used_cons qs
+                          unused_cons = get_unused_cons used_cons
\end{code}

-The first column of the patterns matrix only have vars, then there is
+The first column of the patterns matrix only have vars, then there is
nothing to do.

\begin{code}
@@ -325,31 +318,31 @@ first_column_only_vars qs = (map (\ (xs,ys) -> (nlWildPat:xs,ys)) pats,indexs)
(pats, indexs) = check' (map remove_var qs)
\end{code}

-This equation takes a matrix of patterns and split the equations by
-constructor, using all the constructors that appears in the first column
+This equation takes a matrix of patterns and split the equations by
+constructor, using all the constructors that appears in the first column
of the pattern matching.

-We can need a default clause or not ...., it depends if we used all the
+We can need a default clause or not ...., it depends if we used all the
constructors or not explicitly. The reasoning is similar to @process_literals@,
the difference is that here the default case is not always needed.

\begin{code}
no_need_default_case :: [Pat Id] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
no_need_default_case cons qs = (concat pats, unionManyUniqSets indexs)
-    where
+    where
pats_indexs   = map (\x -> construct_matrix x qs) cons
-      (pats,indexs) = unzip pats_indexs
+      (pats,indexs) = unzip pats_indexs

need_default_case :: [Pat Id] -> [DataCon] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
-need_default_case used_cons unused_cons qs
+need_default_case used_cons unused_cons qs
| null default_eqns  = (pats_default_no_eqns,indexs)
| otherwise          = (pats_default,indexs_default)
where
(pats,indexs)   = no_need_default_case used_cons qs
-       default_eqns    = ASSERT2( okGroup qs, pprGroup qs )
-                        [remove_var q | q <- qs, is_var (firstPatN q)]
-       (pats',indexs') = check' default_eqns
-       pats_default    = [(make_whole_con c:ps,constraints) |
+       default_eqns    = ASSERT2( okGroup qs, pprGroup qs )
+                         [remove_var q | q <- qs, is_var (firstPatN q)]
+       (pats',indexs') = check' default_eqns
+       pats_default    = [(make_whole_con c:ps,constraints) |
c <- unused_cons, (ps,constraints) <- pats'] ++ pats
new_wilds       = ASSERT( not (null qs) ) make_row_vars_for_constructor (head qs)
pats_default_no_eqns =  [(make_whole_con c:new_wilds,[]) | c <- unused_cons] ++ pats
@@ -357,12 +350,12 @@ need_default_case used_cons unused_cons qs

construct_matrix :: Pat Id -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
construct_matrix con qs =
-    (map (make_con con) pats,indexs)
+    (map (make_con con) pats,indexs)
where
-    (pats,indexs) = (check' (remove_first_column con qs))
+    (pats,indexs) = (check' (remove_first_column con qs))
\end{code}

-Here remove first column is more difficult that with literals due to the fact
+Here remove first column is more difficult that with literals due to the fact
that constructors can have arguments.

For instance, the matrix
@@ -377,37 +370,37 @@ is transformed in:
\end{verbatim}

\begin{code}
-remove_first_column :: Pat Id                -- Constructor
-                    -> [(EqnNo, EquationInfo)]
+remove_first_column :: Pat Id                -- Constructor
+                    -> [(EqnNo, EquationInfo)]
-> [(EqnNo, EquationInfo)]
remove_first_column (ConPatOut{ pat_con = L _ con, pat_args = PrefixCon con_pats }) qs
-  = ASSERT2( okGroup qs, pprGroup qs )
+  = ASSERT2( okGroup qs, pprGroup qs )
[(n, shift_var eqn) | q@(n, eqn) <- qs, is_var_con con (firstPatN q)]
where
new_wilds = [WildPat (hsLPatType arg_pat) | arg_pat <- con_pats]
-     shift_var eqn@(EqnInfo { eqn_pats = ConPatOut{ pat_args = PrefixCon ps' } : ps})
-       = eqn { eqn_pats = map unLoc ps' ++ ps }
+     shift_var eqn@(EqnInfo { eqn_pats = ConPatOut{ pat_args = PrefixCon ps' } : ps})
+        = eqn { eqn_pats = map unLoc ps' ++ ps }
shift_var eqn@(EqnInfo { eqn_pats = WildPat _ : ps })
-       = eqn { eqn_pats = new_wilds ++ ps }
+        = eqn { eqn_pats = new_wilds ++ ps }
shift_var _ = panic "Check.Shift_var:No done"

make_row_vars :: [HsLit] -> (EqnNo, EquationInfo) -> ExhaustivePat
make_row_vars used_lits (_, EqnInfo { eqn_pats = pats})
= (nlVarPat new_var:takeList (tail pats) (repeat nlWildPat),[(new_var,used_lits)])
-  where
+  where
new_var = hash_x

hash_x :: Name
hash_x = mkInternalName unboundKey {- doesn't matter much -}
-                    (mkVarOccFS (fsLit "#x"))
-                    noSrcSpan
+                     (mkVarOccFS (fsLit "#x"))
+                     noSrcSpan

make_row_vars_for_constructor :: (EqnNo, EquationInfo) -> [WarningPat]
-make_row_vars_for_constructor (_, EqnInfo { eqn_pats = pats})
+make_row_vars_for_constructor (_, EqnInfo { eqn_pats = pats})
= takeList (tail pats) (repeat nlWildPat)

compare_cons :: Pat Id -> Pat Id -> Bool
-compare_cons (ConPatOut{ pat_con = L _ id1 }) (ConPatOut { pat_con = L _ id2 }) = id1 == id2
+compare_cons (ConPatOut{ pat_con = L _ id1 }) (ConPatOut { pat_con = L _ id2 }) = id1 == id2

remove_dups :: [Pat Id] -> [Pat Id]
remove_dups []     = []
@@ -415,39 +408,39 @@ remove_dups (x:xs) | or (map (\y -> compare_cons x y) xs) = remove_dups  xs
| otherwise                            = x : remove_dups xs

get_used_cons :: [(EqnNo, EquationInfo)] -> [Pat Id]
-get_used_cons qs = remove_dups [pat | q <- qs, let pat = firstPatN q,
-                                     isConPatOut pat]
+get_used_cons qs = remove_dups [pat | q <- qs, let pat = firstPatN q,
+                                      isConPatOut pat]

isConPatOut :: Pat Id -> Bool
isConPatOut (ConPatOut {}) = True
isConPatOut _              = False

-remove_dups' :: [HsLit] -> [HsLit]
+remove_dups' :: [HsLit] -> [HsLit]
remove_dups' []                   = []
remove_dups' (x:xs) | x elem xs = remove_dups' xs
-                    | otherwise   = x : remove_dups' xs
+                    | otherwise   = x : remove_dups' xs

get_used_lits :: [(EqnNo, EquationInfo)] -> [HsLit]
get_used_lits qs = remove_dups' all_literals
-                where
-                  all_literals = get_used_lits' qs
+                 where
+                   all_literals = get_used_lits' qs

get_used_lits' :: [(EqnNo, EquationInfo)] -> [HsLit]
get_used_lits' [] = []
-get_used_lits' (q:qs)
+get_used_lits' (q:qs)
| Just lit <- get_lit (firstPatN q) = lit : get_used_lits' qs
-  | otherwise                        = get_used_lits qs
+  | otherwise                         = get_used_lits qs

-get_lit :: Pat id -> Maybe HsLit
+get_lit :: Pat id -> Maybe HsLit
-- Get a representative HsLit to stand for the OverLit
-- It doesn't matter which one, because they will only be compared
-- with other HsLits gotten in the same way
-get_lit (LitPat lit)                                     = Just lit
+get_lit (LitPat lit)                                      = Just lit
get_lit (NPat (OverLit { ol_val = HsIntegral i})    mb _) = Just (HsIntPrim   (mb_neg negate              mb i))
get_lit (NPat (OverLit { ol_val = HsFractional f }) mb _) = Just (HsFloatPrim (mb_neg negateFractionalLit mb f))
get_lit (NPat (OverLit { ol_val = HsIsString s })   _  _) = Just (HsStringPrim s)
-get_lit _                                                = Nothing
+get_lit _                                                 = Nothing

mb_neg :: (a -> a) -> Maybe b -> a -> a
mb_neg _      Nothing  v = v
@@ -462,7 +455,7 @@ get_unused_cons used_cons = ASSERT( not (null used_cons) ) unused_cons
Just (ty_con, inst_tys) = splitTyConApp_maybe ty
unused_cons = filterOut is_used (tyConDataCons ty_con)
is_used con = con elementOfUniqSet used_set
-                    || dataConCannotMatch inst_tys con
+                     || dataConCannotMatch inst_tys con

all_vars :: [Pat Id] -> Bool
all_vars []             = True
@@ -482,8 +475,8 @@ okGroup :: [(EqnNo, EquationInfo)] -> Bool
-- all have the same number of patterns
okGroup [] = True
okGroup (e:es) = n_pats > 0 && and [length (eqnPats e) == n_pats | e <- es]
-              where
-                n_pats = length (eqnPats e)
+               where
+                 n_pats = length (eqnPats e)

-- Half-baked print
pprGroup :: [(EqnNo, EquationInfo)] -> SDoc
@@ -515,9 +508,9 @@ is_var_con _   _                                           = False

is_var_lit :: HsLit -> Pat Id -> Bool
is_var_lit _   (WildPat _)   = True
-is_var_lit lit pat
+is_var_lit lit pat
| Just lit' <- get_lit pat = lit == lit'
-  | otherwise               = False
+  | otherwise                = False
\end{code}

The difference beteewn @make_con@ and @make_whole_con@ is that
@@ -548,7 +541,7 @@ In @reconstruct_pat@ we want to undo'' the work
that we have done in @tidy_pat@.
In particular:
\begin{tabular}{lll}
-       @((,) x y)@   & returns to be & @(x, y)@
+        @((,) x y)@   & returns to be & @(x, y)@
\\      @((:) x xs)@  & returns to be & @(x:xs)@
\\      @(x:(...:[])@ & returns to be & @[x,...]@
\end{tabular}
@@ -563,45 +556,45 @@ isInfixCon con = isDataSymOcc (getOccName con)

is_nil :: Pat Name -> Bool
is_nil (ConPatIn con (PrefixCon [])) = unLoc con == getName nilDataCon
-is_nil _                                    = False
+is_nil _                             = False

is_list :: Pat Name -> Bool
is_list (ListPat _ _) = True
is_list _             = False

return_list :: DataCon -> Pat Name -> Bool
-return_list id q = id == consDataCon && (is_nil q || is_list q)
+return_list id q = id == consDataCon && (is_nil q || is_list q)

make_list :: LPat Name -> Pat Name -> Pat Name
make_list p q | is_nil q    = ListPat [p] placeHolderType
make_list p (ListPat ps ty) = ListPat (p:ps) ty
make_list _ _               = panic "Check.make_list: Invalid argument"

-make_con :: Pat Id -> ExhaustivePat -> ExhaustivePat
-make_con (ConPatOut{ pat_con = L _ id }) (lp:lq:ps, constraints)
+make_con :: Pat Id -> ExhaustivePat -> ExhaustivePat
+make_con (ConPatOut{ pat_con = L _ id }) (lp:lq:ps, constraints)
| return_list id q = (noLoc (make_list lp q) : ps, constraints)
-     | isInfixCon id    = (nlInfixConPat (getName id) lp lq : ps, constraints)
-   where q  = unLoc lq
+     | isInfixCon id    = (nlInfixConPat (getName id) lp lq : ps, constraints)
+   where q  = unLoc lq

-make_con (ConPatOut{ pat_con = L _ id, pat_args = PrefixCon pats, pat_ty = ty }) (ps, constraints)
-      | isTupleTyCon tc  = (noLoc (TuplePat pats_con (tupleTyConBoxity tc) ty) : rest_pats, constraints)
-      | isPArrFakeCon id = (noLoc (PArrPat pats_con placeHolderType)           : rest_pats, constraints)
+make_con (ConPatOut{ pat_con = L _ id, pat_args = PrefixCon pats, pat_ty = ty }) (ps, constraints)
+      | isTupleTyCon tc  = (noLoc (TuplePat pats_con (tupleTyConBoxity tc) ty) : rest_pats, constraints)
+      | isPArrFakeCon id = (noLoc (PArrPat pats_con placeHolderType)           : rest_pats, constraints)
| otherwise        = (nlConPat name pats_con      : rest_pats, constraints)
-    where
-       name                  = getName id
-       (pats_con, rest_pats) = splitAtList pats ps
-       tc                    = dataConTyCon id
+    where
+        name                  = getName id
+        (pats_con, rest_pats) = splitAtList pats ps
+        tc                    = dataConTyCon id

-- reconstruct parallel array pattern
--
--  * don't check for the type only; we need to make sure that we are really
--   dealing with one of the fake constructors and not with the real
---   representation
+--   representation

make_whole_con :: DataCon -> WarningPat
make_whole_con con | isInfixCon con = nlInfixConPat name nlWildPat nlWildPat
| otherwise      = nlConPat name pats
-                where
+                where
name   = getName con
pats   = [nlWildPat | _ <- dataConOrigArgTys con]
\end{code}
@@ -613,40 +606,40 @@ make_whole_con con | isInfixCon con = nlInfixConPat name nlWildPat nlWildPat
tidy_eqn does more or less the same thing as @tidy@ in @Match.lhs@;
that is, it removes syntactic sugar, reducing the number of cases that
must be handled by the main checking algorithm.  One difference is
-that here we can do *all* the tidying at once (recursively), rather
+that here we can do *all* the tidying at once (recursively), rather
than doing it incrementally.

\begin{code}
tidy_eqn :: EquationInfo -> EquationInfo
-tidy_eqn eqn = eqn { eqn_pats = map tidy_pat (eqn_pats eqn),
-                    eqn_rhs  = tidy_rhs (eqn_rhs eqn) }
+tidy_eqn eqn = eqn { eqn_pats = map tidy_pat (eqn_pats eqn),
+                     eqn_rhs  = tidy_rhs (eqn_rhs eqn) }
where
-       -- Horrible hack.  The tidy_pat stuff converts "might-fail" patterns to
-        -- WildPats which of course loses the info that they can fail to match.
-       -- So we stick in a CanFail as if it were a guard.
+        -- Horrible hack.  The tidy_pat stuff converts "might-fail" patterns to
+        -- WildPats which of course loses the info that they can fail to match.
+        -- So we stick in a CanFail as if it were a guard.
tidy_rhs (MatchResult can_fail body)
-       | any might_fail_pat (eqn_pats eqn) = MatchResult CanFail body
-       | otherwise                         = MatchResult can_fail body
+        | any might_fail_pat (eqn_pats eqn) = MatchResult CanFail body
+        | otherwise                         = MatchResult can_fail body

--------------
might_fail_pat :: Pat Id -> Bool
--- Returns True of patterns that might fail (i.e. fall through) in a way
+-- Returns True of patterns that might fail (i.e. fall through) in a way
-- that is not covered by the checking algorithm.  Specifically:
---        NPlusKPat
---        ViewPat (if refutable)
+--         NPlusKPat
+--         ViewPat (if refutable)

-- First the two special cases
-might_fail_pat (NPlusKPat {})               = True
-might_fail_pat (ViewPat _ p _)                      = not (isIrrefutableHsPat p)
+might_fail_pat (NPlusKPat {})                = True
+might_fail_pat (ViewPat _ p _)               = not (isIrrefutableHsPat p)

-- Now the recursive stuff
-might_fail_pat (ParPat p)                   = might_fail_lpat p
-might_fail_pat (AsPat _ p)                  = might_fail_lpat p
-might_fail_pat (SigPatOut p _ )             = might_fail_lpat p
-might_fail_pat (ListPat ps _)                       = any might_fail_lpat ps
-might_fail_pat (TuplePat ps _ _)            = any might_fail_lpat ps
-might_fail_pat (PArrPat ps _)                       = any might_fail_lpat ps
-might_fail_pat (BangPat p)                          = might_fail_lpat p
+might_fail_pat (ParPat p)                    = might_fail_lpat p
+might_fail_pat (AsPat _ p)                   = might_fail_lpat p
+might_fail_pat (SigPatOut p _ )              = might_fail_lpat p
+might_fail_pat (ListPat ps _)                = any might_fail_lpat ps
+might_fail_pat (TuplePat ps _ _)             = any might_fail_lpat ps
+might_fail_pat (PArrPat ps _)                = any might_fail_lpat ps
+might_fail_pat (BangPat p)                   = might_fail_lpat p
might_fail_pat (ConPatOut { pat_args = ps }) = any might_fail_lpat (hsConPatArgs ps)

-- Finally the ones that are sure to succeed, or which are covered by the checking algorithm
@@ -658,16 +651,16 @@ might_fail_lpat :: LPat Id -> Bool
might_fail_lpat (L _ p) = might_fail_pat p

--------------
-tidy_lpat :: LPat Id -> LPat Id
+tidy_lpat :: LPat Id -> LPat Id
tidy_lpat p = fmap tidy_pat p

--------------
tidy_pat :: Pat Id -> Pat Id
tidy_pat pat@(WildPat _)  = pat
-tidy_pat (VarPat id)      = WildPat (idType id)
+tidy_pat (VarPat id)      = WildPat (idType id)
tidy_pat (ParPat p)       = tidy_pat (unLoc p)
-tidy_pat (LazyPat p)      = WildPat (hsLPatType p)     -- For overlap and exhaustiveness checking
-                                                       -- purposes, a ~pat is like a wildcard
+tidy_pat (LazyPat p)      = WildPat (hsLPatType p)      -- For overlap and exhaustiveness checking
+                                                        -- purposes, a ~pat is like a wildcard
tidy_pat (BangPat p)      = tidy_pat (unLoc p)
tidy_pat (AsPat _ p)      = tidy_pat (unLoc p)
tidy_pat (SigPatOut p _)  = tidy_pat (unLoc p)
@@ -682,10 +675,10 @@ tidy_pat (ViewPat _ _ ty)     = WildPat ty
tidy_pat pat@(ConPatOut { pat_con = L _ id, pat_args = ps })
= pat { pat_args = tidy_con id ps }

-tidy_pat (ListPat ps ty)
+tidy_pat (ListPat ps ty)
= unLoc $foldr (\ x y -> mkPrefixConPat consDataCon [x,y] list_ty) - (mkNilPat list_ty) - (map tidy_lpat ps) + (mkNilPat list_ty) + (map tidy_lpat ps) where list_ty = mkListTy ty -- introduce fake parallel array constructors to be able to handle parallel @@ -693,12 +686,12 @@ tidy_pat (ListPat ps ty) -- tidy_pat (PArrPat ps ty) = unLoc$ mkPrefixConPat (parrFakeCon (length ps))
-                          (map tidy_lpat ps)
-                          (mkPArrTy ty)
+                           (map tidy_lpat ps)
+                           (mkPArrTy ty)

tidy_pat (TuplePat ps boxity ty)
= unLoc $mkPrefixConPat (tupleCon (boxityNormalTupleSort boxity) arity) - (map tidy_lpat ps) ty + (map tidy_lpat ps) ty where arity = length ps @@ -706,29 +699,29 @@ tidy_pat (NPat lit mb_neg eq) = tidyNPat tidy_lit_pat lit mb_neg eq tidy_pat (LitPat lit) = tidy_lit_pat lit tidy_lit_pat :: HsLit -> Pat Id --- Unpack string patterns fully, so we can see when they +-- Unpack string patterns fully, so we can see when they -- overlap with each other, or even explicit lists of Chars. tidy_lit_pat lit | HsString s <- lit = unLoc$ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] stringTy)
-                 (mkPrefixConPat nilDataCon [] stringTy) (unpackFS s)
+                  (mkPrefixConPat nilDataCon [] stringTy) (unpackFS s)
| otherwise
-  = tidyLitPat lit
+  = tidyLitPat lit

-----------------
tidy_con :: DataCon -> HsConPatDetails Id -> HsConPatDetails Id
tidy_con _   (PrefixCon ps)   = PrefixCon (map tidy_lpat ps)
tidy_con _   (InfixCon p1 p2) = PrefixCon [tidy_lpat p1, tidy_lpat p2]
-tidy_con con (RecCon (HsRecFields fs _))
+tidy_con con (RecCon (HsRecFields fs _))
| null fs   = PrefixCon [nlWildPat | _ <- dataConOrigArgTys con]
-               -- Special case for null patterns; maybe not a record at all
+                -- Special case for null patterns; maybe not a record at all
| otherwise = PrefixCon (map (tidy_lpat.snd) all_pats)
where
-- pad out all the missing fields with WildPats.
field_pats = map (\ f -> (f, nlWildPat)) (dataConFieldLabels con)
all_pats = foldr (\(HsRecField id p _) acc -> insertNm (getName (unLoc id)) p acc)
-                    field_pats fs
-
+                     field_pats fs
+
insertNm nm p [] = [(nm,p)]
insertNm nm p (x@(n,_):xs)
| nm == n    = (nm,p):xs