-tidyEqnInfo v (EqnInfo (pat : pats) match_result)
- = tidy1 v pat match_result `thenDs` \ (pat', match_result') ->
- returnDs (EqnInfo (pat' : pats) match_result')
-
-tidy1 :: Id -- The Id being scrutinised
- -> TypecheckedPat -- The pattern against which it is to be matched
- -> MatchResult -- Current thing do do after matching
- -> DsM (TypecheckedPat, -- Equivalent pattern
- MatchResult) -- Augmented thing to do afterwards
- -- The augmentation usually takes the form
- -- of new bindings to be added to the front
-
-tidy1 v (VarPat var) match_result
- = returnDs (WildPat (idType var),
- mkCoLetsMatchResult extra_binds match_result)
- where
- extra_binds | v == var = []
- | otherwise = [NonRec var (Var v)]
+ --
+ -- POST CONDITION: head pattern in the EqnInfo is
+ -- WildPat
+ -- ConPat
+ -- NPat
+ -- LitPat
+ -- NPlusKPat
+ -- but no other
+
+tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_rhs = rhs })
+ = tidy1 v pat rhs `thenDs` \ (pat', rhs') ->
+ returnDs (eqn { eqn_pats = pat' : pats, eqn_rhs = rhs' })
+
+tidy1 :: Id -- The Id being scrutinised
+ -> Pat Id -- The pattern against which it is to be matched
+ -> MatchResult -- What to do afterwards
+ -> DsM (Pat Id, -- Equivalent pattern
+ MatchResult) -- Extra bindings around what to do afterwards
+
+-- The extra bindings etc are all wrapped around the RHS of the match
+-- so they are only available when matching is complete. But that's ok
+-- becuase, for example, in the pattern x@(...), the x can only be
+-- used in the RHS, not in the nested pattern, nor subsquent patterns
+--
+-- However this does have an awkward consequence. The bindings in
+-- a VarPatOut get wrapped around the result in right to left order,
+-- rather than left to right. This only matters if one set of
+-- bindings can mention things used in another, and that can happen
+-- if we allow equality dictionary bindings of form d1=d2.
+-- bindIInstsOfLocalFuns is now careful not to do this, but it's a wart.
+-- (Without this care in bindInstsOfLocalFuns, compiling
+-- Data.Generics.Schemes.hs fails in function everywhereBut.)
+
+-------------------------------------------------------
+-- (pat', mr') = tidy1 v pat mr
+-- tidies the *outer level only* of pat, giving pat'
+-- It eliminates many pattern forms (as-patterns, variable patterns,
+-- list patterns, etc) yielding one of:
+-- WildPat
+-- ConPatOut
+-- LitPat
+-- NPat
+-- NPlusKPat
+
+tidy1 v (ParPat pat) wrap = tidy1 v (unLoc pat) wrap
+tidy1 v (SigPatOut pat _) wrap = tidy1 v (unLoc pat) wrap
+tidy1 v (WildPat ty) wrap = returnDs (WildPat ty, wrap)
+
+ -- case v of { x -> mr[] }
+ -- = case v of { _ -> let x=v in mr[] }
+tidy1 v (VarPat var) rhs
+ = returnDs (WildPat (idType var), bindOneInMatchResult var v rhs)
+
+tidy1 v (VarPatOut var binds) rhs
+ = do { prs <- dsHsNestedBinds binds
+ ; return (WildPat (idType var),
+ bindOneInMatchResult var v $
+ mkCoLetMatchResult (Rec prs) rhs) }
+
+ -- case v of { x@p -> mr[] }
+ -- = case v of { p -> let x=v in mr[] }
+tidy1 v (AsPat (L _ var) pat) rhs
+ = tidy1 v (unLoc pat) (bindOneInMatchResult var v rhs)