mkSelectorBinds, mkTupleExpr, mkTupleSelector,
mkCoreTup, mkCoreSel, mkCoreTupTy,
+
+ dsReboundNames, lookupReboundName,
selectMatchVar
) where
#include "HsVersions.h"
-import {-# SOURCE #-} Match ( matchSimply )
+import {-# SOURCE #-} Match ( matchSimply )
+import {-# SOURCE #-} DsExpr( dsExpr )
import HsSyn
import TcHsSyn ( TypecheckedPat, hsPatType )
import CoreUtils ( exprType, mkIfThenElse, mkCoerce )
import MkId ( iRREFUT_PAT_ERROR_ID, mkReboxingAlt, mkNewTypeBody )
import Id ( idType, Id, mkWildId, mkTemplateLocals )
+import Name ( Name )
import Literal ( Literal(..), inIntRange, tARGET_MAX_INT )
import TyCon ( isNewTyCon, tyConDataCons )
import DataCon ( DataCon, dataConSourceArity )
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}
%* *
%************************************************************************
chunkify :: [a] -> [[a]]
-- The sub-lists of the result all have length <= mAX_TUPLE_SIZE
+-- But there may be more than mAX_TUPLE_SIZE sub-lists
chunkify xs
- | n_xs <= mAX_TUPLE_SIZE = [xs]
- | otherwise = split xs
+ | n_xs <= mAX_TUPLE_SIZE = {- pprTrace "Small" (ppr n_xs) -} [xs]
+ | otherwise = {- pprTrace "Big" (ppr n_xs) -} (split xs)
where
- -- n_chunks_m1 = numbe of chunks - 1
- n_xs = length xs
- n_chunks_m1 = n_xs `div` mAX_TUPLE_SIZE
- chunk_size = n_xs `div` n_chunks_m1
-
+ n_xs = length xs
split [] = []
- split xs = take chunk_size xs : split (drop chunk_size xs)
+ split xs = take mAX_TUPLE_SIZE xs : split (drop mAX_TUPLE_SIZE xs)
\end{code}