3 -- Copyright (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller
5 -- Auxiliary routines for NDP-related Core transformations.
7 --- DESCRIPTION ---------------------------------------------------------------
9 -- This module exports all functions to access and alter the `Type' data
10 -- structure from modules `Type' and `CoreExpr' from `CoreSyn'. As it is part
11 -- of the NDP flattening component, the functions provide access to all the
12 -- fields that are important for the flattening and lifting transformation.
14 --- DOCU ----------------------------------------------------------------------
16 -- Language: Haskell 98
18 --- TODO ----------------------------------------------------------------------
23 -- type inspection functions
25 tupleTyArgs, -- :: Type -> [Type]
26 funTyArgs, -- :: Type -> (Type, Type)
27 parrElemTy, -- :: Type -> Type
29 -- Core generation functions
31 mkTuple, -- :: [Type] -> [CoreExpr] -> CoreExpr
32 mkInt, -- :: CoreExpr -> CoreExpr
36 isDefault, -- :: CoreAlt -> Bool
37 isLit, -- :: [CoreAlt] -> Bool
38 isSimpleExpr, -- :: CoreExpr -> Bool
40 -- re-exported functions
42 mkPArrTy, -- :: Type -> Type
52 import Outputable (Outputable(ppr), pprPanic)
53 import BasicTypes (Boxity(..))
55 import Type (Type, splitTyConApp_maybe, splitFunTy)
56 import TyCon (TyCon(..), isTupleTyCon)
57 import PrelNames (parrTyConName)
58 import TysWiredIn (parrTyCon, unitDataConId, tupleCon, intDataCon, mkPArrTy,
60 import CoreSyn (CoreBndr, CoreExpr, CoreBind, CoreAlt, Expr(..), AltCon(..),
63 import VarEnv (IdEnv, delVarEnv, delVarEnvList, lookupVarEnv)
65 -- friends: don't import any to avoid cyclic imports
69 -- type inspection functions
70 -- -------------------------
72 -- determines the argument types of a tuple type (EXPORTED)
74 tupleTyArgs :: Type -> [Type]
76 case splitTyConApp_maybe ty of
77 Just (tyCon, argTys) | isTupleTyCon tyCon -> argTys
79 pprPanic "NDPCoreUtils.tupleTyArgs: wrong type: " (ppr ty)
81 -- determines the argument and result type of a function type (EXPORTED)
83 funTyArgs :: Type -> (Type, Type)
84 funTyArgs = splitFunTy
86 -- for a type of the form `[:t:]', yield `t' (EXPORTED)
88 -- * if the type has any other form, a fatal error occurs
90 parrElemTy :: Type -> Type
92 case splitTyConApp_maybe ty of
93 Just (tyCon, [argTy]) | tyConName tyCon == parrTyConName -> argTy
95 pprPanic "NDPCoreUtils.parrElemTy: wrong type: " (ppr ty)
98 -- Core generation functions
99 -- -------------------------
101 -- make a tuple construction expression from a list of argument types and
102 -- argument values (EXPORTED)
104 -- * the two lists need to be of the same length
106 mkTuple :: [Type] -> [CoreExpr] -> CoreExpr
107 mkTuple [] [] = Var unitDataConId
109 mkTuple ts es | length ts == length es =
110 mkConApp (tupleCon Boxed (length es)) (map Type ts ++ es)
112 panic "NDPCoreUtils.mkTuple: mismatch between number of types and exprs!"
114 -- make a boxed integer from an unboxed one (EXPORTED)
116 mkInt :: CoreExpr -> CoreExpr
117 mkInt e = mkConApp intDataCon [e]
123 -- checks whether a given case alternative is a default alternative (EXPORTED)
125 isDefault :: CoreAlt -> Bool
126 isDefault (DEFAULT, _, _) = True
129 -- check whether a list of case alternatives in belongs to a case over a
130 -- literal type (EXPORTED)
132 isLit :: [CoreAlt] -> Bool
133 isLit ((DEFAULT, _, _ ):alts) = isLit alts
134 isLit ((LitAlt _, _, _):_ ) = True
137 -- FIXME: this function should get a more expressive name and maybe also a
138 -- more detailed return type (depends on how the analysis goes)
139 isSimpleExpr:: CoreExpr -> Bool
148 substIdEnv:: IdEnv Id -> CoreExpr -> CoreExpr
149 substIdEnv env e@(Lit _) = e
150 substIdEnv env e@(Var id) =
151 case (lookupVarEnv env id) of
154 substIdEnv env (App e arg) =
155 App (substIdEnv env e) (substIdEnv env arg)
156 substIdEnv env (Lam b expr) =
157 Lam b (substIdEnv (delVarEnv env b) expr)
158 substIdEnv env (Let (NonRec b expr1) expr2) =
159 Let (NonRec b (substIdEnv env expr1))
160 (substIdEnv (delVarEnv env b) expr2)
161 substIdEnv env (Let (Rec bnds) expr) =
163 newEnv = delVarEnvList env (map fst bnds)
164 newExpr = substIdEnv newEnv expr
165 substBnd (b,e) = (b, substIdEnv newEnv e)
166 in Let (Rec (map substBnd bnds)) newExpr
167 substIdEnv env (Case expr b alts) =
168 Case (substIdEnv newEnv expr) b (map substAlt alts)
170 newEnv = delVarEnv env b
171 substAlt (c, bnds, expr) =
172 (c, bnds, substIdEnv (delVarEnvList env bnds) expr)
173 substIdEnv env (Note n expr) =
174 Note n (substIdEnv env expr)
175 substIdEnv env e@(Type t) = e