Id typecheck/TcHsSyn
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module HsUtils where
#include "HsVersions.h"
import HsPat
import HsTypes
import HsLit
-import HsDecls
import RdrName
import Var
val_binds = ValBindsOut [(Recursive, binds)] []
mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id
--- Used for constructing dictinoary terms etc, so no locations
+-- Used for constructing dictionary terms etc, so no locations
mkHsConApp data_con tys args
= foldl mk_app (nlHsTyApp (dataConWrapId data_con) tys) args
where
%************************************************************************
\begin{code}
-collectLStmtsBinders :: [LStmt id] -> [Located id]
+collectLStmtsBinders :: OutputableBndr id => [LStmt id] -> [Located id]
collectLStmtsBinders = concatMap collectLStmtBinders
-collectStmtsBinders :: [Stmt id] -> [Located id]
+collectStmtsBinders :: OutputableBndr id => [Stmt id] -> [Located id]
collectStmtsBinders = concatMap collectStmtBinders
-collectLStmtBinders :: LStmt id -> [Located id]
+collectLStmtBinders :: OutputableBndr id => LStmt id -> [Located id]
collectLStmtBinders = collectStmtBinders . unLoc
-collectStmtBinders :: Stmt id -> [Located id]
+collectStmtBinders :: OutputableBndr id => Stmt id -> [Located id]
-- Id Binders for a Stmt... [but what about pattern-sig type vars]?
collectStmtBinders (BindStmt pat _ _ _) = collectLocatedPatBinders pat
collectStmtBinders (LetStmt binds) = collectLocalBinders binds
-collectStmtBinders (ExprStmt _ _ _) = []
-collectStmtBinders (RecStmt ss _ _ _ _) = collectLStmtsBinders ss
-collectStmtBinders other = panic "collectStmtBinders"
+collectStmtBinders (ExprStmt _ _ _) = []
+collectStmtBinders (ParStmt xs) = collectLStmtsBinders
+ $ concatMap fst xs
+collectStmtBinders (RecStmt ss _ _ _ _) = collectLStmtsBinders ss
+collectStmtBinders s = pprPanic "collectStmtBinders" (ppr s)
\end{code}
go (PArrPat pats _) = foldr collectl bndrs pats
go (TuplePat pats _ _) = foldr collectl bndrs pats
- go (ConPatIn c ps) = foldr collectl bndrs (hsConArgs ps)
- go (ConPatOut {pat_args=ps}) = foldr collectl bndrs (hsConArgs ps)
+ go (ConPatIn c ps) = foldr collectl bndrs (hsConPatArgs ps)
+ go (ConPatOut {pat_args=ps}) = foldr collectl bndrs (hsConPatArgs ps)
-- See Note [Dictionary binders in ConPatOut]
go (LitPat _) = bndrs
go (NPat _ _ _ _) = bndrs
go (SigPatIn pat _) = collectl pat bndrs
go (SigPatOut pat _) = collectl pat bndrs
go (TypePat ty) = bndrs
- go (DictPat ids1 ids2) = map noLoc ids1 ++ map noLoc ids2
- ++ bndrs
go (CoPat _ pat ty) = collectl (noLoc pat) bndrs
\end{code}
we want to generate bindings for x,y but not for dictionaries bound by
C. (The type checker ensures they would not be used.)
+Desugaring of arrow case expressions needs these bindings (see DsArrows
+and arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its
+own pat-binder-collector:
+
+Here's the problem. Consider
+
+data T a where
+ C :: Num a => a -> Int -> T a
+
+f ~(C (n+1) m) = (n,m)
+
+Here, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),
+and *also* uses that dictionary to match the (n+1) pattern. Yet, the
+variables bound by the lazy pattern are n,m, *not* the dictionary d.
+So in mkSelectorBinds in DsUtils, we want just m,n as the variables bound.
+
\begin{code}
collectSigTysFromPats :: [InPat name] -> [LHsType name]
collectSigTysFromPats pats = foldr collect_lpat [] pats
collect_pat (ListPat pats _) acc = foldr collect_lpat acc pats
collect_pat (PArrPat pats _) acc = foldr collect_lpat acc pats
collect_pat (TuplePat pats _ _) acc = foldr collect_lpat acc pats
-collect_pat (ConPatIn c ps) acc = foldr collect_lpat acc (hsConArgs ps)
+collect_pat (ConPatIn c ps) acc = foldr collect_lpat acc (hsConPatArgs ps)
collect_pat other acc = acc -- Literals, vars, wildcard
\end{code}