Commit fb6d198f authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Minor refactoring

MkCore.mkCoreTupTy moves to TysWiredIn, where it is called mkBoxedTupleTy
parent cf4d037c
......@@ -18,8 +18,7 @@ module MkCore (
mkChunkified,
-- * Constructing small tuples
mkCoreVarTup, mkCoreVarTupTy,
mkCoreTup, mkCoreTupTy,
mkCoreVarTup, mkCoreVarTupTy, mkCoreTup,
-- * Constructing big tuples
mkBigCoreVarTup, mkBigCoreVarTupTy,
......@@ -337,7 +336,7 @@ mkCoreVarTup ids = mkCoreTup (map Var ids)
-- | Bulid the type of a small tuple that holds the specified variables
mkCoreVarTupTy :: [Id] -> Type
mkCoreVarTupTy ids = mkCoreTupTy (map idType ids)
mkCoreVarTupTy ids = mkBoxedTupleTy (map idType ids)
-- | Build a small tuple holding the specified expressions
mkCoreTup :: [CoreExpr] -> CoreExpr
......@@ -346,10 +345,6 @@ mkCoreTup [c] = c
mkCoreTup cs = mkConApp (tupleCon Boxed (length cs))
(map (Type . exprType) cs ++ cs)
-- | Build the type of a small tuple that holds the specified type of thing
mkCoreTupTy :: [Type] -> Type
mkCoreTupTy tys = mkTupleTy Boxed tys
-- | Build a big tuple holding the specified variables
mkBigCoreVarTup :: [Id] -> CoreExpr
mkBigCoreVarTup ids = mkBigCoreTup (map Var ids)
......@@ -364,7 +359,7 @@ mkBigCoreTup = mkChunkified mkCoreTup
-- | Build the type of a big tuple that holds the specified type of thing
mkBigCoreTupTy :: [Type] -> Type
mkBigCoreTupTy = mkChunkified mkCoreTupTy
mkBigCoreTupTy = mkChunkified mkBoxedTupleTy
\end{code}
%************************************************************************
......@@ -408,7 +403,7 @@ mkTupleSelector vars the_var scrut_var scrut
mk_tup_sel vars_s the_var = mkSmallTupleSelector group the_var tpl_v $
mk_tup_sel (chunkify tpl_vs) tpl_v
where
tpl_tys = [mkCoreTupTy (map idType gp) | gp <- vars_s]
tpl_tys = [mkBoxedTupleTy (map idType gp) | gp <- vars_s]
tpl_vs = mkTemplateLocals tpl_tys
[(tpl_v, group)] = [(tpl,gp) | (tpl,gp) <- zipEqual "mkTupleSelector" tpl_vs vars_s,
the_var `elem` gp ]
......@@ -469,7 +464,7 @@ mkTupleCase uniqs vars body scrut_var scrut
one_tuple_case chunk_vars (us, vs, body)
= let (us1, us2) = splitUniqSupply us
scrut_var = mkSysLocal (fsLit "ds") (uniqFromSupply us1)
(mkCoreTupTy (map idType chunk_vars))
(mkBoxedTupleTy (map idType chunk_vars))
body' = mkSmallTupleCase chunk_vars body scrut_var (Var scrut_var)
in (us2, scrut_var:vs, body')
\end{code}
......
......@@ -142,7 +142,7 @@ coreCasePair scrut_var var1 var2 body
\begin{code}
mkCorePairTy :: Type -> Type -> Type
mkCorePairTy t1 t2 = mkCoreTupTy [t1, t2]
mkCorePairTy t1 t2 = mkBoxedTupleTy [t1, t2]
mkCorePairExpr :: CoreExpr -> CoreExpr -> CoreExpr
mkCorePairExpr e1 e2 = mkCoreTup [e1, e2]
......
......@@ -749,8 +749,7 @@ dsDo stmts body result_ty
body = noLoc $ HsDo DoExpr rec_stmts return_app body_ty
return_app = nlHsApp (noLoc return_op) (mkLHsTupleExpr rets)
body_ty = mkAppTy m_ty tup_ty
tup_ty = mkCoreTupTy (map idType tup_ids)
-- mkCoreTupTy deals with singleton case
tup_ty = mkBoxedTupleTy (map idType tup_ids) -- Deals with singleton case
-- In a do expression, pattern-match failure just calls
-- the monadic 'fail' rather than throwing an exception
......@@ -848,8 +847,7 @@ dsMDo tbl stmts body result_ty
mfix_pat = noLoc $ LazyPat $ mk_tup_pat rec_tup_pats
body = noLoc $ HsDo ctxt rec_stmts return_app body_ty
body_ty = mkAppTy m_ty tup_ty
tup_ty = mkCoreTupTy (map idType (later_ids' ++ rec_ids))
-- mkCoreTupTy deals with singleton case
tup_ty = mkBoxedTupleTy (map idType (later_ids' ++ rec_ids)) -- Deals with singleton case
return_app = nlHsApp (nlHsTyApp return_id [tup_ty])
(mkLHsTupleExpr rets)
......
......@@ -38,7 +38,7 @@ module TysWiredIn (
mkListTy,
-- * Tuples
mkTupleTy,
mkTupleTy, mkBoxedTupleTy,
tupleTyCon, tupleCon,
unitTyCon, unitDataCon, unitDataConId, pairTyCon,
unboxedSingletonTyCon, unboxedSingletonDataCon,
......@@ -539,6 +539,10 @@ mkTupleTy :: Boxity -> [Type] -> Type
mkTupleTy boxity [ty] | Boxed <- boxity = ty
mkTupleTy boxity tys = mkTyConApp (tupleTyCon boxity (length tys)) tys
-- | Build the type of a small tuple that holds the specified type of thing
mkBoxedTupleTy :: [Type] -> Type
mkBoxedTupleTy tys = mkTupleTy Boxed tys
unitTy :: Type
unitTy = mkTupleTy Boxed []
\end{code}
......
......@@ -25,7 +25,6 @@ import TcType
import TcBinds
import TcUnify
import TcSimplify
import MkCore
import Name
import TysWiredIn
import PrelNames
......@@ -524,7 +523,7 @@ tcDoStmt ctxt (RecStmt { recS_stmts = stmts, recS_later_ids = later_names
= do { let tup_names = rec_names ++ filterOut (`elem` rec_names) later_names
; tup_elt_tys <- newFlexiTyVarTys (length tup_names) liftedTypeKind
; let tup_ids = zipWith mkLocalId tup_names tup_elt_tys
tup_ty = mkCoreTupTy tup_elt_tys
tup_ty = mkBoxedTupleTy tup_elt_tys
; tcExtendIdEnv tup_ids $ do
{ ((stmts', (ret_op', tup_rets)), stmts_ty)
......
......@@ -25,7 +25,7 @@ module VectUtils (
import VectCore
import VectMonad
import MkCore ( mkCoreTup, mkCoreTupTy, mkWildCase )
import MkCore ( mkCoreTup, mkWildCase )
import CoreSyn
import CoreUtils
import CoreUnfold ( mkInlineRule )
......@@ -514,5 +514,5 @@ buildEnv vs
where
(vvs, lvs) = unzip vs
tys = map vVarType vs
ty = mkCoreTupTy tys
ty = mkBoxedTupleTy tys
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment