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(..))
54 import Type (Type, splitTyConApp_maybe, splitFunTy)
55 import TyCon (isTupleTyCon)
56 import TysWiredIn (parrTyCon, unitDataConId, tupleCon, intDataCon, mkPArrTy,
58 import CoreSyn (CoreExpr, CoreAlt, Expr(..), AltCon(..),
60 import PprCore ( {- instances -} )
62 import VarEnv (IdEnv, delVarEnv, delVarEnvList, lookupVarEnv)
64 -- friends: don't import any to avoid cyclic imports
68 -- type inspection functions
69 -- -------------------------
71 -- determines the argument types of a tuple type (EXPORTED)
73 tupleTyArgs :: Type -> [Type]
75 case splitTyConApp_maybe ty of
76 Just (tyCon, argTys) | isTupleTyCon tyCon -> argTys
78 pprPanic "NDPCoreUtils.tupleTyArgs: wrong type: " (ppr ty)
80 -- determines the argument and result type of a function type (EXPORTED)
82 funTyArgs :: Type -> (Type, Type)
83 funTyArgs = splitFunTy
85 -- for a type of the form `[:t:]', yield `t' (EXPORTED)
87 -- * if the type has any other form, a fatal error occurs
89 parrElemTy :: Type -> Type
91 case splitTyConApp_maybe ty of
92 Just (tyCon, [argTy]) | tyCon == parrTyCon -> argTy
94 pprPanic "NDPCoreUtils.parrElemTy: wrong type: " (ppr ty)
97 -- Core generation functions
98 -- -------------------------
100 -- make a tuple construction expression from a list of argument types and
101 -- argument values (EXPORTED)
103 -- * the two lists need to be of the same length
105 mkTuple :: [Type] -> [CoreExpr] -> CoreExpr
106 mkTuple [] [] = Var unitDataConId
108 mkTuple ts es | length ts == length es =
109 mkConApp (tupleCon Boxed (length es)) (map Type ts ++ es)
111 panic "NDPCoreUtils.mkTuple: mismatch between number of types and exprs!"
113 -- make a boxed integer from an unboxed one (EXPORTED)
115 mkInt :: CoreExpr -> CoreExpr
116 mkInt e = mkConApp intDataCon [e]
122 -- checks whether a given case alternative is a default alternative (EXPORTED)
124 isDefault :: CoreAlt -> Bool
125 isDefault (DEFAULT, _, _) = True
128 -- check whether a list of case alternatives in belongs to a case over a
129 -- literal type (EXPORTED)
131 isLit :: [CoreAlt] -> Bool
132 isLit ((DEFAULT, _, _ ):alts) = isLit alts
133 isLit ((LitAlt _, _, _):_ ) = True
136 -- FIXME: this function should get a more expressive name and maybe also a
137 -- more detailed return type (depends on how the analysis goes)
138 isSimpleExpr:: CoreExpr -> Bool
147 substIdEnv:: IdEnv Id -> CoreExpr -> CoreExpr
148 substIdEnv env e@(Lit _) = e
149 substIdEnv env e@(Var id) =
150 case (lookupVarEnv env id) of
153 substIdEnv env (App e arg) =
154 App (substIdEnv env e) (substIdEnv env arg)
155 substIdEnv env (Lam b expr) =
156 Lam b (substIdEnv (delVarEnv env b) expr)
157 substIdEnv env (Let (NonRec b expr1) expr2) =
158 Let (NonRec b (substIdEnv env expr1))
159 (substIdEnv (delVarEnv env b) expr2)
160 substIdEnv env (Let (Rec bnds) expr) =
162 newEnv = delVarEnvList env (map fst bnds)
163 newExpr = substIdEnv newEnv expr
164 substBnd (b,e) = (b, substIdEnv newEnv e)
165 in Let (Rec (map substBnd bnds)) newExpr
166 substIdEnv env (Case expr b alts) =
167 Case (substIdEnv newEnv expr) b (map substAlt alts)
169 newEnv = delVarEnv env b
170 substAlt (c, bnds, expr) =
171 (c, bnds, substIdEnv (delVarEnvList env bnds) expr)
172 substIdEnv env (Note n expr) =
173 Note n (substIdEnv env expr)
174 substIdEnv env e@(Type t) = e