-import CoreUtils ( coreExprType, mkCoreIfThenElse )
-import PprStyle ( PprStyle(..) )
-import PrelVals ( iRREFUT_PAT_ERROR_ID )
-import Pretty ( ppShow )
-import Id ( idType, dataConArgTys, mkTupleCon,
- pprId{-ToDo:rm-},
- DataCon(..), DictVar(..), Id(..), GenId )
-import Literal ( Literal(..) )
-import TyCon ( mkTupleTyCon, isNewTyCon, tyConDataCons )
-import Type ( mkTyVarTys, mkRhoTy, mkForAllTys, mkFunTys,
- mkTheta, isUnboxedType, applyTyCon, getAppTyCon
- )
-import UniqSet ( mkUniqSet, minusUniqSet, uniqSetToList, UniqSet(..) )
-import Util ( panic, assertPanic, pprTrace{-ToDo:rm-} )
-import PprCore{-ToDo:rm-}
---import PprType--ToDo:rm
-import Pretty--ToDo:rm
-import TyVar--ToDo:rm
-import Unique--ToDo:rm
-import Usage--ToDo:rm
+import CoreUtils ( exprType, mkIfThenElse, mkCoerce, bindNonRec )
+import MkId ( iRREFUT_PAT_ERROR_ID, mkReboxingAlt, mkNewTypeBody )
+import Id ( idType, Id, mkWildId, mkTemplateLocals, mkSysLocal )
+import Var ( Var )
+import Name ( Name )
+import Literal ( Literal(..), mkStringLit, inIntRange, tARGET_MAX_INT )
+import TyCon ( isNewTyCon, tyConDataCons )
+import DataCon ( DataCon, dataConSourceArity, dataConTyCon, dataConTag )
+import Type ( mkFunTy, isUnLiftedType, Type, splitTyConApp, mkTyVarTy )
+import TcType ( tcEqType )
+import TysPrim ( intPrimTy )
+import TysWiredIn ( nilDataCon, consDataCon,
+ tupleCon, mkTupleTy,
+ unitDataConId, unitTy,
+ charTy, charDataCon,
+ intTy, intDataCon,
+ isPArrFakeCon )
+import BasicTypes ( Boxity(..) )
+import UniqSet ( mkUniqSet, minusUniqSet, isEmptyUniqSet )
+import UniqSupply ( splitUniqSupply, uniqFromSupply, uniqsFromSupply )
+import PrelNames ( unpackCStringName, unpackCStringUtf8Name,
+ plusIntegerName, timesIntegerName, smallIntegerDataConName,
+ lengthPName, indexPName )
+import Outputable
+import SrcLoc ( Located(..), unLoc )
+import Util ( isSingleton, notNull, zipEqual, sortWith )
+import ListSetOps ( assocDefault )
+import FastString
+
+import Data.Char ( ord )
+\end{code}
+
+
+
+%************************************************************************
+%* *
+ Rebindable syntax
+%* *
+%************************************************************************
+
+\begin{code}
+dsSyntaxTable :: SyntaxTable Id
+ -> DsM ([CoreBind], -- Auxiliary bindings
+ [(Name,Id)]) -- Maps the standard name to its value
+
+dsSyntaxTable rebound_ids
+ = mapAndUnzipDs mk_bind rebound_ids `thenDs` \ (binds_s, prs) ->
+ return (concat binds_s, prs)
+ where
+ -- The cheapo special case can happen when we
+ -- make an intermediate HsDo when desugaring a RecStmt
+ mk_bind (std_name, HsVar id) = return ([], (std_name, id))
+ mk_bind (std_name, expr)
+ = dsExpr expr `thenDs` \ rhs ->
+ newSysLocalDs (exprType rhs) `thenDs` \ id ->
+ return ([NonRec id rhs], (std_name, id))
+
+lookupEvidence :: [(Name, Id)] -> Name -> Id
+lookupEvidence prs std_name
+ = assocDefault (mk_panic std_name) prs std_name
+ where
+ mk_panic std_name = pprPanic "dsSyntaxTable" (ptext SLIT("Not found:") <+> ppr std_name)
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Building lets}
+%* *
+%************************************************************************
+
+Use case, not let for unlifted types. The simplifier will turn some
+back again.
+
+\begin{code}
+mkDsLet :: CoreBind -> CoreExpr -> CoreExpr
+mkDsLet (NonRec bndr rhs) body
+ | isUnLiftedType (idType bndr)
+ = Case rhs bndr (exprType body) [(DEFAULT,[],body)]
+mkDsLet bind body
+ = Let bind body
+
+mkDsLets :: [CoreBind] -> CoreExpr -> CoreExpr
+mkDsLets binds body = foldr mkDsLet body binds
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{ Selecting match variables}
+%* *
+%************************************************************************
+
+We're about to match against some patterns. We want to make some
+@Ids@ to use as match variables. If a pattern has an @Id@ readily at
+hand, which should indeed be bound to the pattern as a whole, then use it;
+otherwise, make one up.
+
+\begin{code}
+selectSimpleMatchVarL :: LPat Id -> DsM Id
+selectSimpleMatchVarL pat = selectMatchVar (unLoc pat) (hsPatType pat)
+
+-- (selectMatchVars ps tys) chooses variables of type tys
+-- to use for matching ps against. If the pattern is a variable,
+-- we try to use that, to save inventing lots of fresh variables.
+-- But even if it is a variable, its type might not match. Consider
+-- data T a where
+-- T1 :: Int -> T Int
+-- T2 :: a -> T a
+--
+-- f :: T a -> a -> Int
+-- f (T1 i) (x::Int) = x
+-- f (T2 i) (y::a) = 0
+-- Then we must not choose (x::Int) as the matching variable!
+
+selectMatchVars :: [Pat Id] -> [Type] -> DsM [Id]
+selectMatchVars [] [] = return []
+selectMatchVars (p:ps) (ty:tys) = do { v <- selectMatchVar p ty
+ ; vs <- selectMatchVars ps tys
+ ; return (v:vs) }
+
+selectMatchVar (LazyPat pat) pat_ty = selectMatchVar (unLoc pat) pat_ty
+selectMatchVar (VarPat var) pat_ty = try_for var pat_ty
+selectMatchVar (AsPat var pat) pat_ty = try_for (unLoc var) pat_ty
+selectMatchVar other_pat pat_ty = newSysLocalDs pat_ty -- OK, better make up one...
+
+try_for var pat_ty
+ | idType var `tcEqType` pat_ty = returnDs var
+ | otherwise = newSysLocalDs pat_ty