-import CoreUtils ( coreExprType, mkCoreIfThenElse )
-import PprStyle ( PprStyle(..) )
-import PrelInfo ( stringTy, iRREFUT_PAT_ERROR_ID )
-import Pretty ( ppShow )
-import Id ( idType, dataConArgTys, mkTupleCon,
- DataCon(..), DictVar(..), Id(..), GenId )
-import Literal ( Literal(..) )
-import TyCon ( mkTupleTyCon )
-import Type ( mkTyVarTys, mkRhoTy, mkForAllTys, mkFunTys,
- isUnboxedType, applyTyCon, getAppDataTyCon
- )
-import UniqSet ( mkUniqSet, minusUniqSet, uniqSetToList, UniqSet(..) )
-import Util ( panic, assertPanic )
-
-splitDictType = panic "DsUtils.splitDictType"
+import CoreUtils ( exprType, mkIfThenElse, mkCoerce, bindNonRec )
+import MkId ( iRREFUT_PAT_ERROR_ID, mkReboxingAlt, mkNewTypeBody )
+import Id ( idType, Id, mkWildId, mkTemplateLocals, mkSysLocal )
+import Name ( Name )
+import Literal ( Literal(..), inIntRange, tARGET_MAX_INT )
+import TyCon ( isNewTyCon, tyConDataCons )
+import DataCon ( DataCon, dataConSourceArity )
+import Type ( mkFunTy, isUnLiftedType, Type, splitTyConApp )
+import TcType ( tcTyConAppTyCon, isIntTy, isFloatTy, isDoubleTy )
+import TysPrim ( intPrimTy )
+import TysWiredIn ( nilDataCon, consDataCon,
+ tupleCon, mkTupleTy,
+ unitDataConId, unitTy,
+ charTy, charDataCon,
+ intTy, intDataCon,
+ floatDataCon,
+ doubleDataCon,
+ stringTy, isPArrFakeCon )
+import BasicTypes ( Boxity(..) )
+import UniqSet ( mkUniqSet, minusUniqSet, isEmptyUniqSet, UniqSet )
+import UniqSupply ( splitUniqSupply, uniqFromSupply, uniqsFromSupply )
+import PrelNames ( unpackCStringName, unpackCStringUtf8Name,
+ plusIntegerName, timesIntegerName, smallIntegerDataConName,
+ lengthPName, indexPName )
+import Outputable
+import UnicodeUtil ( intsToUtf8, stringToUtf8 )
+import Util ( isSingleton, notNull, zipEqual )
+import ListSetOps ( assocDefault )
+import FastString
+\end{code}
+
+
+
+%************************************************************************
+%* *
+ Rebindable syntax
+%* *
+%************************************************************************
+
+\begin{code}
+dsReboundNames :: ReboundNames Id
+ -> DsM ([CoreBind], -- Auxiliary bindings
+ [(Name,Id)]) -- Maps the standard name to its value
+
+dsReboundNames 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))
+
+lookupReboundName :: [(Name,Id)] -> Name -> CoreExpr
+lookupReboundName prs std_name
+ = Var (assocDefault (mk_panic std_name) prs std_name)
+ where
+ mk_panic std_name = pprPanic "dsReboundNames" (ptext SLIT("Not found:") <+> ppr std_name)
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Tidying lit pats}
+%* *
+%************************************************************************
+
+\begin{code}
+tidyLitPat :: HsLit -> TypecheckedPat -> TypecheckedPat
+tidyLitPat (HsChar c) pat = mkCharLitPat c
+tidyLitPat lit pat = pat
+
+tidyNPat :: HsLit -> Type -> TypecheckedPat -> TypecheckedPat
+tidyNPat (HsString s) _ pat
+ | lengthFS s <= 1 -- Short string literals only
+ = foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c,pat] stringTy)
+ (mkNilPat stringTy) (unpackIntFS s)
+ -- The stringTy is the type of the whole pattern, not
+ -- the type to instantiate (:) or [] with!
+ where
+
+tidyNPat lit lit_ty default_pat
+ | isIntTy lit_ty = mkPrefixConPat intDataCon [LitPat (mk_int lit)] lit_ty
+ | isFloatTy lit_ty = mkPrefixConPat floatDataCon [LitPat (mk_float lit)] lit_ty
+ | isDoubleTy lit_ty = mkPrefixConPat doubleDataCon [LitPat (mk_double lit)] lit_ty
+ | otherwise = default_pat
+
+ where
+ mk_int (HsInteger i _) = HsIntPrim i
+
+ mk_float (HsInteger i _) = HsFloatPrim (fromInteger i)
+ mk_float (HsRat f _) = HsFloatPrim f
+
+ mk_double (HsInteger i _) = HsDoublePrim (fromInteger i)
+ mk_double (HsRat f _) = HsDoublePrim f
+\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 [(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}
+selectMatchVar :: TypecheckedPat -> DsM Id
+selectMatchVar (VarPat var) = returnDs var
+selectMatchVar (AsPat var pat) = returnDs var
+selectMatchVar (LazyPat pat) = selectMatchVar pat
+selectMatchVar other_pat = newSysLocalDs (hsPatType other_pat) -- OK, better make up one...