X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FndpFlatten%2FNDPCoreUtils.hs;fp=compiler%2FndpFlatten%2FNDPCoreUtils.hs;h=0000000000000000000000000000000000000000;hp=b3eee9afedfa2463336c3344cb26f0d624a4ae5b;hb=e415eeaf6c7771488af24758ca5b9c22c42be3a6;hpb=c0f21abc488d367252d8dd9287c3c84cf50b9125 diff --git a/compiler/ndpFlatten/NDPCoreUtils.hs b/compiler/ndpFlatten/NDPCoreUtils.hs deleted file mode 100644 index b3eee9a..0000000 --- a/compiler/ndpFlatten/NDPCoreUtils.hs +++ /dev/null @@ -1,182 +0,0 @@ -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - --- $Id$ --- --- Copyright (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller --- --- Auxiliary routines for NDP-related Core transformations. --- ---- DESCRIPTION --------------------------------------------------------------- --- --- This module exports all functions to access and alter the `Type' data --- structure from modules `Type' and `CoreExpr' from `CoreSyn'. As it is part --- of the NDP flattening component, the functions provide access to all the --- fields that are important for the flattening and lifting transformation. --- ---- DOCU ---------------------------------------------------------------------- --- --- Language: Haskell 98 --- ---- TODO ---------------------------------------------------------------------- --- - -module NDPCoreUtils ( - - -- type inspection functions - -- - tupleTyArgs, -- :: Type -> [Type] - funTyArgs, -- :: Type -> (Type, Type) - parrElemTy, -- :: Type -> Type - - -- Core generation functions - -- - mkTuple, -- :: [Type] -> [CoreExpr] -> CoreExpr - mkInt, -- :: CoreExpr -> CoreExpr - - -- query functions - -- - isDefault, -- :: CoreAlt -> Bool - isLit, -- :: [CoreAlt] -> Bool - isSimpleExpr, -- :: CoreExpr -> Bool - - -- re-exported functions - -- - mkPArrTy, -- :: Type -> Type - boolTy, -- :: Type - - -- substitution - -- - substIdEnv -) where - --- GHC -import Panic (panic) -import Outputable (Outputable(ppr), pprPanic) -import BasicTypes (Boxity(..)) -import Type (Type, splitTyConApp_maybe, splitFunTy) -import TyCon (isTupleTyCon) -import TysWiredIn (parrTyCon, unitDataConId, tupleCon, intDataCon, mkPArrTy, - boolTy) -import CoreSyn (CoreExpr, CoreAlt, Expr(..), AltCon(..), - Bind(..), mkConApp) -import PprCore ( {- instances -} ) -import Var (Id) -import VarEnv (IdEnv, delVarEnv, delVarEnvList, lookupVarEnv) - --- friends: don't import any to avoid cyclic imports --- - - --- type inspection functions --- ------------------------- - --- determines the argument types of a tuple type (EXPORTED) --- -tupleTyArgs :: Type -> [Type] -tupleTyArgs ty = - case splitTyConApp_maybe ty of - Just (tyCon, argTys) | isTupleTyCon tyCon -> argTys - _ -> - pprPanic "NDPCoreUtils.tupleTyArgs: wrong type: " (ppr ty) - --- determines the argument and result type of a function type (EXPORTED) --- -funTyArgs :: Type -> (Type, Type) -funTyArgs = splitFunTy - --- for a type of the form `[:t:]', yield `t' (EXPORTED) --- --- * if the type has any other form, a fatal error occurs --- -parrElemTy :: Type -> Type -parrElemTy ty = - case splitTyConApp_maybe ty of - Just (tyCon, [argTy]) | tyCon == parrTyCon -> argTy - _ -> - pprPanic "NDPCoreUtils.parrElemTy: wrong type: " (ppr ty) - - --- Core generation functions --- ------------------------- - --- make a tuple construction expression from a list of argument types and --- argument values (EXPORTED) --- --- * the two lists need to be of the same length --- -mkTuple :: [Type] -> [CoreExpr] -> CoreExpr -mkTuple [] [] = Var unitDataConId -mkTuple [_] [e] = e -mkTuple ts es | length ts == length es = - mkConApp (tupleCon Boxed (length es)) (map Type ts ++ es) -mkTuple _ _ = - panic "NDPCoreUtils.mkTuple: mismatch between number of types and exprs!" - --- make a boxed integer from an unboxed one (EXPORTED) --- -mkInt :: CoreExpr -> CoreExpr -mkInt e = mkConApp intDataCon [e] - - --- query functions --- --------------- - --- checks whether a given case alternative is a default alternative (EXPORTED) --- -isDefault :: CoreAlt -> Bool -isDefault (DEFAULT, _, _) = True -isDefault _ = False - --- check whether a list of case alternatives in belongs to a case over a --- literal type (EXPORTED) --- -isLit :: [CoreAlt] -> Bool -isLit ((DEFAULT, _, _ ):alts) = isLit alts -isLit ((LitAlt _, _, _):_ ) = True -isLit _ = False - --- FIXME: this function should get a more expressive name and maybe also a --- more detailed return type (depends on how the analysis goes) -isSimpleExpr:: CoreExpr -> Bool -isSimpleExpr _ = - -- FIXME - False - - --- Substitution --- ------------- - -substIdEnv:: IdEnv Id -> CoreExpr -> CoreExpr -substIdEnv env e@(Lit _) = e -substIdEnv env e@(Var id) = - case (lookupVarEnv env id) of - Just v -> (Var v) - _ -> e -substIdEnv env (App e arg) = - App (substIdEnv env e) (substIdEnv env arg) -substIdEnv env (Lam b expr) = - Lam b (substIdEnv (delVarEnv env b) expr) -substIdEnv env (Let (NonRec b expr1) expr2) = - Let (NonRec b (substIdEnv env expr1)) - (substIdEnv (delVarEnv env b) expr2) -substIdEnv env (Let (Rec bnds) expr) = - let - newEnv = delVarEnvList env (map fst bnds) - newExpr = substIdEnv newEnv expr - substBnd (b,e) = (b, substIdEnv newEnv e) - in Let (Rec (map substBnd bnds)) newExpr -substIdEnv env (Case expr b ty alts) = - Case (substIdEnv newEnv expr) b ty (map substAlt alts) - where - newEnv = delVarEnv env b - substAlt (c, bnds, expr) = - (c, bnds, substIdEnv (delVarEnvList env bnds) expr) -substIdEnv env (Note n expr) = - Note n (substIdEnv env expr) -substIdEnv env (Cast e co) = Cast (substIdEnv env e) co -substIdEnv env e@(Type t) = e