From: Roman Leshchinskiy Date: Sun, 9 Mar 2008 22:59:14 +0000 (+0000) Subject: Remove ndpFlatten X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=e415eeaf6c7771488af24758ca5b9c22c42be3a6 Remove ndpFlatten This patch removes the ndpFlatten directory and the -fflatten static flag. This code has never worked and has now been superceded by vectorisation. --- diff --git a/compiler/Makefile b/compiler/Makefile index c7d4169..7cd21c6 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -433,7 +433,7 @@ SRC_HC_OPTS += -Istage$(stage) ALL_DIRS = \ utils basicTypes types hsSyn prelude rename typecheck deSugar coreSyn \ vectorise specialise simplCore stranal stgSyn simplStg codeGen main \ - profiling parser cprAnalysis ndpFlatten iface cmm + profiling parser cprAnalysis iface cmm # Make sure we include Config.hs even if it doesn't exist yet... ALL_SRCS += $(CONFIG_HS) diff --git a/compiler/basicTypes/Unique.lhs b/compiler/basicTypes/Unique.lhs index 4028786..5190702 100644 --- a/compiler/basicTypes/Unique.lhs +++ b/compiler/basicTypes/Unique.lhs @@ -286,7 +286,6 @@ Allocation of unique supply characters: d desugarer f AbsC flattener g SimplStg - l ndpFlatten n Native codegen r Hsc name cache s simplifier diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index 1b7df1b..93ce6ad 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -40,7 +40,6 @@ import ByteCodeGen ( byteCodeGen, coreExprToBCOs ) import Linker ( HValue, linkExpr ) import CoreTidy ( tidyExpr ) import CorePrep ( corePrepExpr ) -import Flattening ( flattenExpr ) import Desugar ( deSugarExpr ) import SimplCore ( simplifyExpr ) import TcRnDriver ( tcRnStmt, tcRnExpr, tcRnType ) @@ -961,11 +960,8 @@ compileExpr hsc_env srcspan ds_expr = do { let { dflags = hsc_dflags hsc_env ; lint_on = dopt Opt_DoCoreLinting dflags } - -- Flatten it - ; flat_expr <- flattenExpr hsc_env ds_expr - -- Simplify it - ; simpl_expr <- simplifyExpr dflags flat_expr + ; simpl_expr <- simplifyExpr dflags ds_expr -- Tidy it (temporary, until coreSat does cloning) ; let tidy_expr = tidyExpr emptyTidyEnv simpl_expr diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 043df54..bf0e822 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -44,7 +44,6 @@ module StaticFlags ( opt_IrrefutableTuples, opt_Parallel, opt_RuntimeTypes, - opt_Flatten, -- optimisation opts opt_NoMethodSharing, @@ -301,7 +300,6 @@ opt_Hpc = lookUp FSLIT("-fhpc") opt_DictsStrict = lookUp FSLIT("-fdicts-strict") opt_IrrefutableTuples = lookUp FSLIT("-firrefutable-tuples") opt_Parallel = lookUp FSLIT("-fparallel") -opt_Flatten = lookUp FSLIT("-fflatten") -- optimisation opts opt_SpecInlineJoinPoints = lookUp FSLIT("-fspec-inline-join-points") @@ -367,7 +365,6 @@ isStaticFlag f = "fspec-inline-join-points", "firrefutable-tuples", "fparallel", - "fflatten", "fgransim", "fno-hi-version-check", "dno-black-holing", @@ -604,7 +601,7 @@ way_details = (WayNDP, Way "ndp" False "Nested data parallelism" [ "-fparr" - , "-fflatten"]), + , "-fvectorise"]), (WayUser_a, Way "a" False "User way 'a'" ["$WAY_a_REAL_OPTS"]), (WayUser_b, Way "b" False "User way 'b'" ["$WAY_b_REAL_OPTS"]), diff --git a/compiler/ndpFlatten/FlattenInfo.hs b/compiler/ndpFlatten/FlattenInfo.hs deleted file mode 100644 index 928b5df..0000000 --- a/compiler/ndpFlatten/FlattenInfo.hs +++ /dev/null @@ -1,42 +0,0 @@ --- $Id$ --- --- Copyright (c) 2002 Manuel M T Chakravarty & Gabriele Keller --- --- Information for modules outside of the flattening module collection. --- ---- DESCRIPTION --------------------------------------------------------------- --- --- This module contains information that is needed, and thus imported, by --- modules that are otherwise independent of flattening and may in fact be --- directly or indirectly imported by some of the flattening-related --- modules. This is to avoid cyclic module dependencies. --- ---- DOCU ---------------------------------------------------------------------- --- --- Language: Haskell 98 --- ---- TODO ---------------------------------------------------------------------- --- -module FlattenInfo ( - namesNeededForFlattening -) where - -import StaticFlags (opt_Flatten) -import NameSet (FreeVars, emptyFVs, mkFVs) -import PrelNames (fstName, andName, orName, lengthPName, replicatePName, - mapPName, bpermutePName, bpermuteDftPName, indexOfPName) - - --- this is a list of names that need to be available if flattening is --- performed (EXPORTED) --- --- * needs to be kept in sync with the names used in Core generation in --- `FlattenMonad' and `NDPCoreUtils' --- -namesNeededForFlattening :: FreeVars -namesNeededForFlattening - | not opt_Flatten = emptyFVs -- none without -fflatten - | otherwise - = mkFVs [fstName, andName, orName, lengthPName, replicatePName, mapPName, - bpermutePName, bpermuteDftPName, indexOfPName] - -- stuff from PrelGHC doesn't have to go here diff --git a/compiler/ndpFlatten/FlattenMonad.hs b/compiler/ndpFlatten/FlattenMonad.hs deleted file mode 100644 index 245e88d..0000000 --- a/compiler/ndpFlatten/FlattenMonad.hs +++ /dev/null @@ -1,461 +0,0 @@ --- $Id$ --- --- Copyright (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller --- --- Monad maintaining parallel contexts and substitutions for flattening. --- ---- DESCRIPTION --------------------------------------------------------------- --- --- The flattening transformation needs to perform a fair amount of plumbing. --- It needs to mainatin a set of variables, called the parallel context for --- lifting, variable substitutions in case alternatives, and so on. --- Moreover, we need to manage uniques to create new variables. The monad --- defined in this module takes care of maintaining this state. --- ---- DOCU ---------------------------------------------------------------------- --- --- Language: Haskell 98 --- --- * a parallel context is a set of variables that get vectorised during a --- lifting transformations (ie, their type changes from `t' to `[:t:]') --- --- * all vectorised variables in a parallel context have the same size; we --- call this also the size of the parallel context --- --- * we represent contexts by maps that give the lifted version of a variable --- (remember that in GHC, variables contain type information that changes --- during lifting) --- ---- TODO ---------------------------------------------------------------------- --- --- * Assumptions currently made that should (if they turn out to be true) be --- documented in The Commentary: --- --- - Local bindings can be copied without any need to alpha-rename bound --- variables (or their uniques). Such renaming is only necessary when --- bindings in a recursive group are replicated; implying that this is --- required in the case of top-level bindings). (Note: The CoreTidy path --- generates global uniques before code generation.) --- --- * One FIXME left to resolve. --- - -{-# 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 - -module FlattenMonad ( - - -- monad definition - -- - Flatten, runFlatten, - - -- variable generation - -- - newVar, mkBind, - - -- context management & query operations - -- - extendContext, packContext, liftVar, liftConst, intersectWithContext, - - -- construction of prelude functions - -- - mk'fst, mk'eq, mk'neq, mk'and, mk'or, mk'lengthP, mk'replicateP, mk'mapP, - mk'bpermuteP, mk'bpermuteDftP, mk'indexOfP -) where - --- standard -import Monad (mplus) - --- GHC -import Panic (panic) -import Outputable (Outputable(ppr), pprPanic) -import UniqSupply (UniqSupply, splitUniqSupply, uniqFromSupply) -import Var (Var, idType) -import Id (Id, mkSysLocal) -import Name (Name) -import VarSet (VarSet, emptyVarSet, extendVarSet, varSetElems ) -import VarEnv (VarEnv, emptyVarEnv, zipVarEnv, plusVarEnv, - elemVarEnv, lookupVarEnv, lookupVarEnv_NF, delVarEnvList) -import Type (Type, tyConAppTyCon) -import HscTypes (HomePackageTable, - ExternalPackageState(eps_PTE), HscEnv(..), - TyThing(..), lookupType) -import PrelNames ( fstName, andName, orName, - lengthPName, replicatePName, mapPName, bpermutePName, - bpermuteDftPName, indexOfPName) -import TysPrim ( charPrimTyCon, intPrimTyCon, floatPrimTyCon, doublePrimTyCon ) -import PrimOp ( PrimOp(..) ) -import PrelInfo ( primOpId ) -import DynFlags (DynFlags) -import CoreSyn (Expr(..), Bind(..), CoreBndr, CoreExpr, CoreBind, mkApps) -import CoreUtils (exprType) -import FastString (FastString) - --- friends -import NDPCoreUtils (parrElemTy) - - --- definition of the monad --- ----------------------- - --- state maintained by the flattening monad --- -data FlattenState = FlattenState { - - -- our source for uniques - -- - us :: UniqSupply, - - -- environment containing all known names (including all - -- Prelude functions) - -- - env :: Name -> Id, - - -- this variable determines the parallel context; if - -- `Nothing', we are in pure vectorisation mode, no - -- lifting going on - -- - ctxtVar :: Maybe Var, - - -- environment that maps each variable that is - -- vectorised in the current parallel context to the - -- vectorised version of that variable - -- - ctxtEnv :: VarEnv Var, - - -- those variables from the *domain* of `ctxtEnv' that - -- have been used since the last context restriction (cf. - -- `restrictContext') - -- - usedVars :: VarSet - } - --- initial value of the flattening state --- -initialFlattenState :: DynFlags - -> ExternalPackageState - -> HomePackageTable - -> UniqSupply - -> FlattenState -initialFlattenState dflags eps hpt us = - FlattenState { - us = us, - env = lookup, - ctxtVar = Nothing, - ctxtEnv = emptyVarEnv, - usedVars = emptyVarSet - } - where - lookup n = - case lookupType dflags hpt (eps_PTE eps) n of - Just (AnId v) -> v - _ -> pprPanic "FlattenMonad: unknown name:" (ppr n) - --- the monad representation (EXPORTED ABSTRACTLY) --- -newtype Flatten a = Flatten { - unFlatten :: (FlattenState -> (a, FlattenState)) - } - -instance Monad Flatten where - return x = Flatten $ \s -> (x, s) - m >>= n = Flatten $ \s -> let - (r, s') = unFlatten m s - in - unFlatten (n r) s' - --- execute the given flattening computation (EXPORTED) --- -runFlatten :: HscEnv - -> ExternalPackageState - -> UniqSupply - -> Flatten a - -> a -runFlatten hsc_env eps us m - = fst $ unFlatten m (initialFlattenState (hsc_dflags hsc_env) - eps (hsc_HPT hsc_env) us) - - --- variable generation --- ------------------- - --- generate a new local variable whose name is based on the given lexeme and --- whose type is as specified in the second argument (EXPORTED) --- -newVar :: FastString -> Type -> Flatten Var -newVar lexeme ty = Flatten $ \state -> - let - (us1, us2) = splitUniqSupply (us state) - state' = state {us = us2} - in - (mkSysLocal lexeme (uniqFromSupply us1) ty, state') - --- generate a non-recursive binding using a new binder whose name is derived --- from the given lexeme (EXPORTED) --- -mkBind :: FastString -> CoreExpr -> Flatten (CoreBndr, CoreBind) -mkBind lexeme e = - do - v <- newVar lexeme (exprType e) - return (v, NonRec v e) - - --- context management --- ------------------ - --- extend the parallel context by the given set of variables (EXPORTED) --- --- * if there is no parallel context at the moment, the first element of the --- variable list will be used to determine the new parallel context --- --- * the second argument is executed in the current context extended with the --- given variables --- --- * the variables must already have been lifted by transforming their type, --- but they *must* have retained their original name (or, at least, their --- unique); this is needed so that they match the original variable in --- variable environments --- --- * any trace of the given set of variables has to be removed from the state --- at the end of this operation --- -extendContext :: [Var] -> Flatten a -> Flatten a -extendContext [] m = m -extendContext vs m = Flatten $ \state -> - let - extState = state { - ctxtVar = ctxtVar state `mplus` Just (head vs), - ctxtEnv = ctxtEnv state `plusVarEnv` zipVarEnv vs vs - } - (r, extState') = unFlatten m extState - resState = extState' { -- remove `vs' from the result state - ctxtVar = ctxtVar state, - ctxtEnv = ctxtEnv state, - usedVars = usedVars extState' `delVarEnvList` vs - } - in - (r, resState) - --- execute the second argument in a restricted context (EXPORTED) --- --- * all variables in the current parallel context are packed according to --- the permutation vector associated with the variable passed as the first --- argument (ie, all elements of vectorised context variables that are --- invalid in the restricted context are dropped) --- --- * the returned list of core binders contains the operations that perform --- the restriction on all variables in the parallel context that *do* occur --- during the execution of the second argument (ie, `liftVar' is executed at --- least once on any such variable) --- -packContext :: Var -> Flatten a -> Flatten (a, [CoreBind]) -packContext perm m = Flatten $ \state -> - let - -- FIXME: To set the packed environment to the unpacked on is a hack of - -- which I am not sure yet (a) whether it works and (b) whether it's - -- really worth it. The one advantages is that, we can use a var set, - -- after all, instead of a var environment. - -- - -- The idea is the following: If we have to pack a variable `x', we - -- generate `let{-NonRec-} x = bpermuteP perm x in ...'. As this is a - -- non-recursive binding, the lhs `x' overshadows the rhs `x' in the - -- body of the let. - -- - -- NB: If we leave it like this, `mkCoreBind' can be simplified. - packedCtxtEnv = ctxtEnv state - packedState = state { - ctxtVar = fmap - (lookupVarEnv_NF packedCtxtEnv) - (ctxtVar state), - ctxtEnv = packedCtxtEnv, - usedVars = emptyVarSet - } - (r, packedState') = unFlatten m packedState - resState = state { -- revert to the unpacked context - ctxtVar = ctxtVar state, - ctxtEnv = ctxtEnv state - } - bndrs = map mkCoreBind . varSetElems . usedVars $ packedState' - - -- generate a binding for the packed variant of a context variable - -- - mkCoreBind var = let - rhs = fst $ unFlatten (mk'bpermuteP (idType var) - (Var perm) - (Var var) - ) state - in - NonRec (lookupVarEnv_NF packedCtxtEnv var) $ rhs - - in - ((r, bndrs), resState) - --- lift a single variable in the current context (EXPORTED) --- --- * if the variable does not occur in the context, it's value is vectorised to --- match the size of the current context --- --- * otherwise, the variable is replaced by whatever the context environment --- maps it to (this may either be simply the lifted version of the original --- variable or a packed variant of that variable) --- --- * the monad keeps track of all lifted variables that occur in the parallel --- context, so that `packContext' can determine the correct set of core --- bindings --- -liftVar :: Var -> Flatten CoreExpr -liftVar var = Flatten $ \s -> - let - v = ctxtVarErr s - v'elemType = parrElemTy . idType $ v - len = fst $ unFlatten (mk'lengthP v'elemType (Var v)) s - replicated = fst $ unFlatten (mk'replicateP (idType var) len (Var var)) s - in case lookupVarEnv (ctxtEnv s) var of - Just liftedVar -> (Var liftedVar, - s {usedVars = usedVars s `extendVarSet` var}) - Nothing -> (replicated, s) - --- lift a constant expression in the current context (EXPORTED) --- --- * the value of the constant expression is vectorised to match the current --- parallel context --- -liftConst :: CoreExpr -> Flatten CoreExpr -liftConst e = Flatten $ \s -> - let - v = ctxtVarErr s - v'elemType = parrElemTy . idType $ v - len = fst $ unFlatten (mk'lengthP v'elemType (Var v)) s - in - (fst $ unFlatten (mk'replicateP (exprType e) len e ) s, s) - --- pick those variables of the given set that occur (if albeit in lifted form) --- in the current parallel context (EXPORTED) --- --- * the variables returned are from the given set and *not* the corresponding --- context variables --- -intersectWithContext :: VarSet -> Flatten [Var] -intersectWithContext vs = Flatten $ \s -> - let - vs' = filter (`elemVarEnv` ctxtEnv s) (varSetElems vs) - in - (vs', s) - - --- construct applications of prelude functions --- ------------------------------------------- - --- NB: keep all the used names listed in `FlattenInfo.namesNeededForFlattening' - --- generate an application of `fst' (EXPORTED) --- -mk'fst :: Type -> Type -> CoreExpr -> Flatten CoreExpr -mk'fst ty1 ty2 a = mkFunApp fstName [Type ty1, Type ty2, a] - --- generate an application of `&&' (EXPORTED) --- -mk'and :: CoreExpr -> CoreExpr -> Flatten CoreExpr -mk'and a1 a2 = mkFunApp andName [a1, a2] - --- generate an application of `||' (EXPORTED) --- -mk'or :: CoreExpr -> CoreExpr -> Flatten CoreExpr -mk'or a1 a2 = mkFunApp orName [a1, a2] - --- generate an application of `==' where the arguments may only be literals --- that may occur in a Core case expression (i.e., `Char', `Int', `Float', and --- `Double') (EXPORTED) --- -mk'eq :: Type -> CoreExpr -> CoreExpr -> Flatten CoreExpr -mk'eq ty a1 a2 = return (mkApps (Var eqName) [a1, a2]) - where - tc = tyConAppTyCon ty - -- - eqName | tc == charPrimTyCon = primOpId CharEqOp - | tc == intPrimTyCon = primOpId IntEqOp - | tc == floatPrimTyCon = primOpId FloatEqOp - | tc == doublePrimTyCon = primOpId DoubleEqOp - | otherwise = - pprPanic "FlattenMonad.mk'eq: " (ppr ty) - --- generate an application of `==' where the arguments may only be literals --- that may occur in a Core case expression (i.e., `Char', `Int', `Float', and --- `Double') (EXPORTED) --- -mk'neq :: Type -> CoreExpr -> CoreExpr -> Flatten CoreExpr -mk'neq ty a1 a2 = return (mkApps (Var neqName) [a1, a2]) - where - tc = tyConAppTyCon ty - -- - neqName {- | name == charPrimTyConName = neqCharName -} - | tc == intPrimTyCon = primOpId IntNeOp - {- | name == floatPrimTyConName = neqFloatName -} - {- | name == doublePrimTyConName = neqDoubleName -} - | otherwise = - pprPanic "FlattenMonad.mk'neq: " (ppr ty) - --- generate an application of `lengthP' (EXPORTED) --- -mk'lengthP :: Type -> CoreExpr -> Flatten CoreExpr -mk'lengthP ty a = mkFunApp lengthPName [Type ty, a] - --- generate an application of `replicateP' (EXPORTED) --- -mk'replicateP :: Type -> CoreExpr -> CoreExpr -> Flatten CoreExpr -mk'replicateP ty a1 a2 = mkFunApp replicatePName [Type ty, a1, a2] - --- generate an application of `replicateP' (EXPORTED) --- -mk'mapP :: Type -> Type -> CoreExpr -> CoreExpr -> Flatten CoreExpr -mk'mapP ty1 ty2 a1 a2 = mkFunApp mapPName [Type ty1, Type ty2, a1, a2] - --- generate an application of `bpermuteP' (EXPORTED) --- -mk'bpermuteP :: Type -> CoreExpr -> CoreExpr -> Flatten CoreExpr -mk'bpermuteP ty a1 a2 = mkFunApp bpermutePName [Type ty, a1, a2] - --- generate an application of `bpermuteDftP' (EXPORTED) --- -mk'bpermuteDftP :: Type -> CoreExpr -> CoreExpr -> CoreExpr -> Flatten CoreExpr -mk'bpermuteDftP ty a1 a2 a3 = mkFunApp bpermuteDftPName [Type ty, a1, a2, a3] - --- generate an application of `indexOfP' (EXPORTED) --- -mk'indexOfP :: Type -> CoreExpr -> CoreExpr -> Flatten CoreExpr -mk'indexOfP ty a1 a2 = mkFunApp indexOfPName [Type ty, a1, a2] - - --- auxilliary functions --- -------------------- - --- obtain the context variable, aborting if it is not available (as this --- signals an internal error in the usage of the `Flatten' monad) --- -ctxtVarErr :: FlattenState -> Var -ctxtVarErr s = case ctxtVar s of - Nothing -> panic "FlattenMonad.ctxtVarErr: No context variable available!" - Just v -> v - --- given the name of a known function and a set of arguments (needs to include --- all needed type arguments), build a Core expression that applies the named --- function to those arguments --- -mkFunApp :: Name -> [CoreExpr] -> Flatten CoreExpr -mkFunApp name args = - do - fun <- lookupName name - return $ mkApps (Var fun) args - --- get the `Id' of a known `Name' --- --- * this can be the `Name' of any function that's visible on the toplevel of --- the current compilation unit --- -lookupName :: Name -> Flatten Id -lookupName name = Flatten $ \s -> - (env s name, s) diff --git a/compiler/ndpFlatten/Flattening.hs b/compiler/ndpFlatten/Flattening.hs deleted file mode 100644 index 220c571..0000000 --- a/compiler/ndpFlatten/Flattening.hs +++ /dev/null @@ -1,812 +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 --- --- Vectorisation and lifting --- ---- DESCRIPTION --------------------------------------------------------------- --- --- This module implements the vectorisation and function lifting --- transformations of the flattening transformation. --- ---- DOCU ---------------------------------------------------------------------- --- --- Language: Haskell 98 with C preprocessor --- --- Types: --- the transformation on types has five purposes: --- --- 1) for each type definition, derive the lifted version of this type --- liftTypeef --- 2) change the type annotations of functions & variables acc. to rep. --- flattenType --- 3) derive the type of a lifted function --- liftType --- 4) sumtypes: --- this is the most fuzzy and complicated part. For each lifted --- sumtype we need to generate function to access and combine the --- component arrays --- --- NOTE: the type information of variables and data constructors is *not* --- changed to reflect it's representation. This has to be solved --- somehow (???, FIXME) using type indexed types --- --- Vectorisation: --- is very naive at the moment. One of the most striking inefficiencies is --- application vect (app e1 e2) -> app (fst (vect e1) (vect e2)) if e1 is a --- lambda abstraction. The vectorisation produces a pair consisting of the --- original and the lifted function, but the lifted version is discarded. --- I'm also not sure how much of this would be thrown out by the simplifier --- eventually --- --- *) vectorise --- --- Conventions: --- ---- TODO ---------------------------------------------------------------------- --- --- * look closer into the definition of type definition (TypeThing or so) --- - -module Flattening ( - flatten, flattenExpr, -) where - -#include "HsVersions.h" - --- friends -import NDPCoreUtils (tupleTyArgs, funTyArgs, isDefault, - isLit, mkPArrTy, mkTuple, isSimpleExpr, substIdEnv) -import FlattenMonad (Flatten, runFlatten, mkBind, extendContext, packContext, - liftVar, liftConst, intersectWithContext, mk'fst, - mk'mapP, mk'bpermuteDftP, mk'indexOfP,mk'eq,mk'neq) - --- GHC -import TcType ( tcIsForAllTy, tcView ) -import TypeRep ( Type(..) ) -import Coercion ( coercionKind ) -import StaticFlags (opt_Flatten) -import Panic (panic) -import ErrUtils (dumpIfSet_dyn) -import UniqSupply (mkSplitUniqSupply) -import DynFlags (DynFlag(..)) -import Literal (Literal, literalType) -import Var (Var(..), idType, isTyVar) -import Id (setIdType) -import DataCon (DataCon, dataConTag) -import HscTypes ( ModGuts(..), HscEnv(..), hscEPS ) -import CoreFVs (exprFreeVars) -import CoreSyn (Expr(..), Bind(..), Alt, AltCon(..), - CoreBndr, CoreExpr, CoreBind, mkLams, mkLets, - mkApps, mkIntLitInt) -import PprCore (pprCoreExpr) -import CoreLint (showPass, endPass) - -import CoreUtils (exprType, applyTypeToArg, mkPiType) -import VarEnv (zipVarEnv) -import TysWiredIn (mkTupleTy) -import BasicTypes (Boxity(..)) -import Outputable -import FastString - --- standard -import Monad (liftM, foldM) - --- toplevel transformation --- ----------------------- - --- entry point to the flattening transformation for the compiler driver when --- compiling a complete module (EXPORTED) --- -flatten :: HscEnv - -> ModGuts - -> IO ModGuts -flatten hsc_env mod_impl@(ModGuts {mg_binds = binds}) - | not opt_Flatten = return mod_impl -- skip without -fflatten - | otherwise = - do - let dflags = hsc_dflags hsc_env - - eps <- hscEPS hsc_env - us <- mkSplitUniqSupply 'l' -- 'l' as in fLattening - -- - -- announce vectorisation - -- - showPass dflags "Flattening [first phase: vectorisation]" - -- - -- vectorise all toplevel bindings - -- - let binds' = runFlatten hsc_env eps us $ vectoriseTopLevelBinds binds - -- - -- and dump the result if requested - -- - endPass dflags "Flattening [first phase: vectorisation]" - Opt_D_dump_vect binds' - return $ mod_impl {mg_binds = binds'} - --- entry point to the flattening transformation for the compiler driver when --- compiling a single expression in interactive mode (EXPORTED) --- -flattenExpr :: HscEnv - -> CoreExpr -- the expression to be flattened - -> IO CoreExpr -flattenExpr hsc_env expr - | not opt_Flatten = return expr -- skip without -fflatten - | otherwise = - do - let dflags = hsc_dflags hsc_env - eps <- hscEPS hsc_env - - us <- mkSplitUniqSupply 'l' -- 'l' as in fLattening - -- - -- announce vectorisation - -- - showPass dflags "Flattening [first phase: vectorisation]" - -- - -- vectorise the expression - -- - let expr' = fst . runFlatten hsc_env eps us $ vectorise expr - -- - -- and dump the result if requested - -- - dumpIfSet_dyn dflags Opt_D_dump_vect "Vectorised expression" - (pprCoreExpr expr') - return expr' - - --- vectorisation of bindings and expressions --- ----------------------------------------- - - -vectoriseTopLevelBinds:: [CoreBind] -> Flatten [CoreBind] -vectoriseTopLevelBinds binds = - do - vbinds <- mapM vectoriseBind binds - return (adjustTypeBinds vbinds) - -adjustTypeBinds:: [CoreBind] -> [CoreBind] -adjustTypeBinds vbinds = - let - ids = concat (map extIds vbinds) - idEnv = zipVarEnv ids ids - in map (substIdEnvBind idEnv) vbinds - where - -- FIXME replace by 'bindersOf' - extIds (NonRec b expr) = [b] - extIds (Rec bnds) = map fst bnds - substIdEnvBind idEnv (NonRec b expr) = NonRec b (substIdEnv idEnv expr) - substIdEnvBind idEnv (Rec bnds) - = Rec (map (\ (b,e) -> (b, (substIdEnv idEnv e))) bnds) - --- vectorise a single core binder --- -vectoriseBind :: CoreBind -> Flatten CoreBind -vectoriseBind (NonRec b expr) = - liftM (NonRec b) $ liftM fst $ vectorise expr -vectoriseBind (Rec bindings) = - liftM Rec $ mapM vectoriseOne bindings - where - vectoriseOne (b, expr) = - do - (vexpr, ty) <- vectorise expr - return (setIdType b ty, vexpr) - - --- Searches for function definitions and creates a lifted version for --- each function. --- We have only two interesting cases: --- 1) function application (ex1) (ex2) --- vectorise both subexpressions. The function will end up becoming a --- pair (orig. fun, lifted fun), choose first component (in many cases, --- this is pretty inefficient, since the lifted version is generated --- although it is clear that it won't be used --- --- 2) lambda abstraction --- any function has to exist in two forms: it's original form and it's --- lifted form. Therefore, every lambda abstraction is transformed into --- a pair of functions: the original function and its lifted variant --- --- --- FIXME: currently, I use 'exprType' all over the place - this is terribly --- inefficient. It should be suffiecient to change 'vectorise' and 'lift' to --- return the type of the result expression as well. --- -vectorise:: CoreExpr -> Flatten (CoreExpr, Type) -vectorise (Var id) = - do - let varTy = idType id - let vecTy = vectoriseTy varTy - return (Var (setIdType id vecTy), vecTy) - -vectorise (Lit lit) = - return ((Lit lit), literalType lit) - - -vectorise e@(App expr t@(Type _)) = - do - (vexpr, vexprTy) <- vectorise expr - return ((App vexpr t), applyTypeToArg vexprTy t) - -vectorise (App (Lam b expr) arg) = - do - (varg, argTy) <- vectorise arg - (vexpr, vexprTy) <- vectorise expr - let vb = setIdType b argTy - return ((App (Lam vb vexpr) varg), - applyTypeToArg (mkPiType vb vexprTy) varg) - --- if vexpr expects a type as first argument --- application stays just as it is --- -vectorise (App expr arg) = - do - (vexpr, vexprTy) <- vectorise expr - (varg, vargTy) <- vectorise arg - - if (tcIsForAllTy vexprTy) - then do - let resTy = applyTypeToArg vexprTy varg - return (App vexpr varg, resTy) - else do - let [t1, t2] = tupleTyArgs vexprTy - vexpr' <- mk'fst t1 t2 vexpr - let resTy = applyTypeToArg t1 varg - return ((App vexpr' varg), resTy) -- apply the first component of - -- the vectorized function - -vectorise e@(Lam b expr) - | isTyVar b - = do - (vexpr, vexprTy) <- vectorise expr -- don't vectorise 'b'! - return ((Lam b vexpr), mkPiType b vexprTy) - | otherwise = - do - (vexpr, vexprTy) <- vectorise expr - let vb = setIdType b (vectoriseTy (idType b)) - let ve = Lam vb vexpr - (lexpr, lexprTy) <- lift e - let veTy = mkPiType vb vexprTy - return $ (mkTuple [veTy, lexprTy] [ve, lexpr], - mkTupleTy Boxed 2 [veTy, lexprTy]) - -vectorise (Let bind body) = - do - vbind <- vectoriseBind bind - (vbody, vbodyTy) <- vectorise body - return ((Let vbind vbody), vbodyTy) - -vectorise (Case expr b ty alts) = - do - (vexpr, vexprTy) <- vectorise expr - valts <- mapM vectorise' alts - let res_ty = snd (head valts) - return (Case vexpr (setIdType b vexprTy) res_ty (map fst valts), res_ty) - where vectorise' (con, bs, expr) = - do - (vexpr, vexprTy) <- vectorise expr - return ((con, bs, vexpr), vexprTy) -- FIXME: change type of con - -- and bs - - - -vectorise (Note note expr) = - do - (vexpr, vexprTy) <- vectorise expr -- FIXME: is this ok or does it - return ((Note note vexpr), vexprTy) -- change the validity of note? - -vectorise e@(Type t) = - return (e, t) -- FIXME: panic instead of 't'??? - - -{- -myShowTy (TyVarTy _) = "TyVar " -myShowTy (AppTy t1 t2) = - "AppTy (" ++ (myShowTy t1) ++ ", " ++ (myShowTy t2) ++ ")" -myShowTy (TyConApp _ t) = - "TyConApp TC (" ++ (myShowTy t) ++ ")" --} - -vectoriseTy :: Type -> Type -vectoriseTy ty | Just ty' <- tcView ty = vectoriseTy ty' - -- Look through notes and synonyms - -- NB: This will discard notes and synonyms, of course - -- ToDo: retain somehow? -vectoriseTy t@(TyVarTy v) = t -vectoriseTy t@(AppTy t1 t2) = - AppTy (vectoriseTy t1) (vectoriseTy t2) -vectoriseTy t@(TyConApp tc ts) = - TyConApp tc (map vectoriseTy ts) -vectoriseTy t@(FunTy t1 t2) = - mkTupleTy Boxed 2 [(FunTy (vectoriseTy t1) (vectoriseTy t2)), - (liftTy t)] -vectoriseTy t@(ForAllTy v ty) = - ForAllTy v (vectoriseTy ty) -vectoriseTy t = t - - --- liftTy: wrap the type in an array but be careful with function types --- on the *top level* (is this sufficient???) - -liftTy:: Type -> Type -liftTy ty | Just ty' <- tcView ty = liftTy ty' -liftTy (FunTy t1 t2) = FunTy (liftTy t1) (liftTy t2) -liftTy (ForAllTy tv t) = ForAllTy tv (liftTy t) -liftTy t = mkPArrTy t - - --- lifting: --- ---------- --- * liftType --- * lift - - --- liftBinderType: Converts a type 'a' stored in the binder to the --- representation of '[:a:]' will therefore call liftType --- --- lift type, don't change name (incl unique) nor IdInfo. IdInfo looks ok, --- but I'm not entirely sure about some fields (e.g., strictness info) -liftBinderType:: CoreBndr -> Flatten CoreBndr -liftBinderType bndr = return $ setIdType bndr (liftTy (idType bndr)) - --- lift: lifts an expression (a -> [:a:]) --- If the expression is a simple expression, it is treated like a constant --- expression. --- If the body of a lambda expression is a simple expression, it is --- transformed into a mapP -lift:: CoreExpr -> Flatten (CoreExpr, Type) -lift cExpr@(Var id) = - do - lVar@(Var lId) <- liftVar id - return (lVar, idType lId) - -lift cExpr@(Lit lit) = - do - lLit <- liftConst cExpr - return (lLit, exprType lLit) - - -lift (Lam b expr) - | isSimpleExpr expr = liftSimpleFun b expr - | isTyVar b = - do - (lexpr, lexprTy) <- lift expr -- don't lift b! - return (Lam b lexpr, mkPiType b lexprTy) - | otherwise = - do - lb <- liftBinderType b - (lexpr, lexprTy) <- extendContext [lb] (lift expr) - return ((Lam lb lexpr) , mkPiType lb lexprTy) - -lift (App expr1 expr2) = - do - (lexpr1, lexpr1Ty) <- lift expr1 - (lexpr2, _) <- lift expr2 - return ((App lexpr1 lexpr2), applyTypeToArg lexpr1Ty lexpr2) - - -lift (Let (NonRec b expr1) expr2) - |isSimpleExpr expr2 = - do - (lexpr1, _) <- lift expr1 - (lexpr2, lexpr2Ty) <- liftSimpleFun b expr2 - let (t1, t2) = funTyArgs lexpr2Ty - liftM (\x -> (x, liftTy t2)) $ mk'mapP t1 t2 lexpr2 lexpr1 - - | otherwise = - do - (lexpr1, _) <- lift expr1 - lb <- liftBinderType b - (lexpr2, lexpr2Ty) <- extendContext [lb] (lift expr1) - return ((Let (NonRec lb lexpr1) lexpr2), lexpr2Ty) - -lift (Let (Rec binds) expr2) = - do - let (bndVars, exprs) = unzip binds - lBndVars <- mapM liftBinderType bndVars - lexprs <- extendContext bndVars (mapM lift exprs) - (lexpr2, lexpr2Ty) <- extendContext bndVars (lift expr2) - return ((Let (Rec (zip lBndVars (map fst lexprs))) lexpr2), lexpr2Ty) - --- FIXME: --- Assumption: alternatives can either be literals or data construtors. --- Due to type restrictions, I don't think it is possible --- that they are mixed. --- The handling of literals and data constructors is completely --- different --- --- --- let b = expr in alts --- --- I think I read somewhere that the default case (if present) is stored --- in the head of the list. Assume for now this is true, have to check --- --- (1) literals --- (2) data constructors --- --- FIXME: optimisation: first, filter out all simple expression and --- loop (mapP & filter) over all the corresponding values in a single --- traversal: - --- (1) splitAlts:: [Alt CoreBndr] -> ([Alt CoreBndr],[Alt CoreBndr]) --- simple alts reg alts --- (2) if simpleAlts = [] then (just as before) --- if regAlts = [] then (the whole thing is just a loop) --- otherwise (a) compute index vector for simpleAlts (for def permute --- later on --- (b) --- gaw 2004 FIX? -lift cExpr@(Case expr b _ alts) = - do - (lExpr, _) <- lift expr - lb <- liftBinderType b -- lift alt-expression - lalts <- if isLit alts - then extendContext [lb] (liftCaseLit b alts) - else extendContext [lb] (liftCaseDataCon b alts) - letWrapper lExpr b lalts - -lift (Cast expr co) = - do - (lexpr, t) <- lift expr - let lco = liftTy co - let (t1, t2) = coercionKind lco - return ((Cast expr lco), t2) - -lift (Note note expr) = - do - (lexpr, t) <- lift expr - return ((Note note lexpr), t) - -lift e@(Type t) = return (e, t) - - --- auxilliary functions for lifting of case statements --- - -liftCaseDataCon:: CoreBndr -> [Alt CoreBndr] -> - Flatten (([CoreBind], [CoreBind], [CoreBind])) -liftCaseDataCon b [] = - return ([], [], []) -liftCaseDataCon b alls@(alt:alts) - | isDefault alt = - do - (i, e, defAltBndrs) <- liftCaseDataConDefault b alt alts - (is, es, altBndrs) <- liftCaseDataCon' b alts - return (i:is, e:es, defAltBndrs ++ altBndrs) - | otherwise = - liftCaseDataCon' b alls - -liftCaseDataCon':: CoreBndr -> [Alt CoreBndr] -> - Flatten ([CoreBind], [CoreBind], [CoreBind]) -liftCaseDataCon' _ [] = - do - return ([], [], []) - - -liftCaseDataCon' b ((DataAlt dcon, bnds, expr): alts) = - do - (permBnd, exprBnd, packBnd) <- liftSingleDataCon b dcon bnds expr - (permBnds, exprBnds, packBnds) <- liftCaseDataCon' b alts - return (permBnd:permBnds, exprBnd:exprBnds, packBnd ++ packBnds) - - --- FIXME: is is really necessary to return the binding to the permutation --- array in the data constructor case, as the representation already --- contains the extended flag vector -liftSingleDataCon:: CoreBndr -> DataCon -> [CoreBndr] -> CoreExpr -> - Flatten (CoreBind, CoreBind, [CoreBind]) -liftSingleDataCon b dcon bnds expr = - do - let dconId = dataConTag dcon - indexExpr <- mkIndexOfExprDCon (idType b) b dconId - (bb, bbind) <- mkBind FSLIT("is") indexExpr - lbnds <- mapM liftBinderType bnds - ((lExpr, _), bnds') <- packContext bb (extendContext lbnds (lift expr)) - (_, vbind) <- mkBind FSLIT("r") lExpr - return (bbind, vbind, bnds') - --- FIXME: clean this up. the datacon and the literal case are so --- similar that it would be easy to use the same function here --- instead of duplicating all the code. --- -liftCaseDataConDefault:: CoreBndr -> (Alt CoreBndr) -> [Alt CoreBndr] - -> Flatten (CoreBind, CoreBind, [CoreBind]) -liftCaseDataConDefault b (_, _, def) alts = - do - let dconIds = map (\(DataAlt d, _, _) -> dataConTag d) alts - indexExpr <- mkIndexOfExprDConDft (idType b) b dconIds - (bb, bbind) <- mkBind FSLIT("is") indexExpr - ((lDef, _), bnds) <- packContext bb (lift def) - (_, vbind) <- mkBind FSLIT("r") lDef - return (bbind, vbind, bnds) - --- liftCaseLit: checks if we have a default case and handles it --- if necessary -liftCaseLit:: CoreBndr -> [Alt CoreBndr] -> - Flatten ([CoreBind], [CoreBind], [CoreBind]) -liftCaseLit b [] = - return ([], [], []) --FIXME: a case with no cases at all??? -liftCaseLit b alls@(alt:alts) - | isDefault alt = - do - (i, e, defAltBndrs) <- liftCaseLitDefault b alt alts - (is, es, altBndrs) <- liftCaseLit' b alts - return (i:is, e:es, defAltBndrs ++ altBndrs) - | otherwise = - do - liftCaseLit' b alls - --- liftCaseLitDefault: looks at all the other alternatives which --- contain a literal and filters all those elements from the --- array which do not match any of the literals in the other --- alternatives. -liftCaseLitDefault:: CoreBndr -> (Alt CoreBndr) -> [Alt CoreBndr] - -> Flatten (CoreBind, CoreBind, [CoreBind]) -liftCaseLitDefault b (_, _, def) alts = - do - let lits = map (\(LitAlt l, _, _) -> l) alts - indexExpr <- mkIndexOfExprDft (idType b) b lits - (bb, bbind) <- mkBind FSLIT("is") indexExpr - ((lDef, _), bnds) <- packContext bb (lift def) - (_, vbind) <- mkBind FSLIT("r") lDef - return (bbind, vbind, bnds) - --- FIXME: --- Assumption: in case of Lit, the list of binders of the alt is empty. --- --- returns --- a list of all vars bound to the expr in the body of the alternative --- a list of (var, expr) pairs, where var has to be bound to expr --- by letWrapper -liftCaseLit':: CoreBndr -> [Alt CoreBndr] -> - Flatten ([CoreBind], [CoreBind], [CoreBind]) -liftCaseLit' _ [] = - do - return ([], [], []) -liftCaseLit' b ((LitAlt lit, [], expr):alts) = - do - (permBnd, exprBnd, packBnd) <- liftSingleCaseLit b lit expr - (permBnds, exprBnds, packBnds) <- liftCaseLit' b alts - return (permBnd:permBnds, exprBnd:exprBnds, packBnd ++ packBnds) - --- lift a single alternative of the form: case b of lit -> expr. --- --- It returns the bindings: --- (a) let b' = indexOfP (mapP (\x -> x == lit) b) --- --- (b) lift expr in the packed context. Returns lexpr and the --- list of binds (bnds) that describe the packed arrays --- --- (c) create new var v' to bind lexpr to --- --- (d) return (b' = indexOf...., v' = lexpr, bnds) -liftSingleCaseLit:: CoreBndr -> Literal -> CoreExpr -> - Flatten (CoreBind, CoreBind, [CoreBind]) -liftSingleCaseLit b lit expr = - do - indexExpr <- mkIndexOfExpr (idType b) b lit -- (a) - (bb, bbind) <- mkBind FSLIT("is") indexExpr - ((lExpr, t), bnds) <- packContext bb (lift expr) -- (b) - (_, vbind) <- mkBind FSLIT("r") lExpr - return (bbind, vbind, bnds) - --- letWrapper lExpr b ([indexbnd_i], [exprbnd_i], [pckbnd_ij]) --- --- let b = lExpr in --- let index_bnd_1 in --- let packbnd_11 in --- ... packbnd_1m in --- let exprbnd_1 in .... --- ... --- let nvar = replicate dummy (length ) --- nvar1 = bpermuteDftP index_bnd_1 ... --- --- in bpermuteDftP index_bnd_n nvar_(n-1) --- -letWrapper:: CoreExpr -> CoreBndr ->([CoreBind], [CoreBind], [CoreBind]) -> - Flatten (CoreExpr, Type) -letWrapper lExpr b (indBnds, exprBnds, pckBnds) = - do - (defBpBnds, ty) <- dftbpBinders indBnds exprBnds - let resExpr = getExprOfBind (head defBpBnds) - return ((mkLets (indBnds ++ pckBnds ++ exprBnds ++ defBpBnds) resExpr), ty) - --- dftbpBinders: return the list of binders necessary to construct the overall --- result from the subresults computed in the different branches of the case --- statement. The binding which contains the final result is in the *head* --- of the result list. --- --- dftbpBinders [ind_i = ...] [expr_i = ...] = [dn = ..., d_n-1 = .., d1 = ...] --- --- let def = replicate (length of context) undefined --- d1 = bpermuteDftP dft e1 i1 --- ..... --- -dftbpBinders:: [CoreBind] -> [CoreBind] -> Flatten ([CoreBind], Type) -dftbpBinders indexBnds exprBnds = - do - let expr = getExprOfBind (head exprBnds) - defVecExpr <- createDftArrayBind expr - ((b, bnds), t) <- dftbpBinders' indexBnds exprBnds defVecExpr - return ((b:bnds),t) - where - dftbpBinders' :: [CoreBind] - -> [CoreBind] - -> CoreBind - -> Flatten ((CoreBind, [CoreBind]), Type) - dftbpBinders' [] [] cBnd = - return ((cBnd, []), panic "dftbpBinders: undefined type") - dftbpBinders' (i:is) (e:es) cBind = - do - let iVar = getVarOfBind i - let eVar = getVarOfBind e - let cVar = getVarOfBind cBind - let ty = idType eVar - newBnd <- mkDftBackpermute ty iVar eVar cVar - ((fBnd, restBnds), _) <- dftbpBinders' is es newBnd - return ((fBnd, (newBnd:restBnds)), liftTy ty) - - dftbpBinders' _ _ _ = - panic "Flattening.dftbpBinders: index and expression binder lists have different length!" - -getExprOfBind:: CoreBind -> CoreExpr -getExprOfBind (NonRec _ expr) = expr - -getVarOfBind:: CoreBind -> Var -getVarOfBind (NonRec b _) = b - - - --- Optimised Transformation --- ========================= --- - --- liftSimpleFun --- if variables x_1 to x_i occur in the context *and* free in expr --- then --- (liftSimpleExpression expr) => mapP (\ (x1,..xn) -> expr) (x1,..xn) --- -liftSimpleFun:: CoreBndr -> CoreExpr -> Flatten (CoreExpr, Type) -liftSimpleFun b expr = - do - bndVars <- collectBoundVars expr - let bndVars' = b:bndVars - bndVarsTuple = mkTuple (map idType bndVars') (map Var bndVars') - lamExpr = mkLams (b:bndVars) expr -- FIXME: should be tuple - -- here - let (t1, t2) = funTyArgs . exprType $ lamExpr - mapExpr <- mk'mapP t1 t2 lamExpr bndVarsTuple - let lexpr = mkApps mapExpr [bndVarsTuple] - return (lexpr, undefined) -- FIXME!!!!! - - -collectBoundVars:: CoreExpr -> Flatten [CoreBndr] -collectBoundVars expr = - intersectWithContext (exprFreeVars expr) - - --- auxilliary routines --- ------------------- - --- mkIndexOfExpr b lit -> --- indexOf (mapP (\x -> x == lit) b) b --- -mkIndexOfExpr:: Type -> CoreBndr -> Literal -> Flatten CoreExpr -mkIndexOfExpr idType b lit = - do - eqExpr <- mk'eq idType (Var b) (Lit lit) - let lambdaExpr = (Lam b eqExpr) - mk'indexOfP idType lambdaExpr (Var b) - --- there is FlattenMonad.mk'indexOfP as well as --- CoreSyn.mkApps and CoreSyn.mkLam, all of which should help here - --- for case-distinction over data constructors: --- let b = expr in --- case b of --- dcon args -> .... --- dconId = dataConTag dcon --- the call "mkIndexOfExprDCon b dconId" computes the core expression for --- indexOfP (\x -> x == dconId) b) --- -mkIndexOfExprDCon::Type -> CoreBndr -> Int -> Flatten CoreExpr -mkIndexOfExprDCon idType b dId = - do - let intExpr = mkIntLitInt dId - eqExpr <- mk'eq idType (Var b) intExpr - let lambdaExpr = (Lam b intExpr) - mk'indexOfP idType lambdaExpr (Var b) - - - --- there is FlattenMonad.mk'indexOfP as well as --- CoreSyn.mkApps and CoreSyn.mkLam, all of which should help here - --- mk'IndexOfExprDConDft b dconIds : Generates the index expression for the --- default case. "dconIds" is a list of all the data constructor idents which --- are covered by the other cases. --- indexOfP (\x -> x != dconId_1 && ....) b) --- -mkIndexOfExprDConDft:: Type -> CoreBndr -> [Int] -> Flatten CoreExpr -mkIndexOfExprDConDft idType b dId = - do - let intExprs = map mkIntLitInt dId - bExpr <- foldM (mk'neq idType) (head intExprs) (tail intExprs) - let lambdaExpr = (Lam b bExpr) - mk'indexOfP idType (Var b) bExpr - - --- mkIndexOfExprDef b [lit1, lit2,...] -> --- indexOf (\x -> not (x == lit1 || x == lit2 ....) b -mkIndexOfExprDft:: Type -> CoreBndr -> [Literal] -> Flatten CoreExpr -mkIndexOfExprDft idType b lits = - do - let litExprs = map (\l-> Lit l) lits - bExpr <- foldM (mk'neq idType) (head litExprs) (tail litExprs) - let lambdaExpr = (Lam b bExpr) - mk'indexOfP idType bExpr (Var b) - - --- create a back-permute binder --- --- * `mkDftBackpermute ty indexArrayVar srcArrayVar dftArrayVar' creates a --- Core binding of the form --- --- x = bpermuteDftP indexArrayVar srcArrayVar dftArrayVar --- --- where `x' is a new local variable --- -mkDftBackpermute :: Type -> Var -> Var -> Var -> Flatten CoreBind -mkDftBackpermute ty idx src dft = - do - rhs <- mk'bpermuteDftP ty (Var idx) (Var src) (Var dft) - liftM snd $ mkBind FSLIT("dbp") rhs - --- create a dummy array with elements of the given type, which can be used as --- default array for the combination of the subresults of the lifted case --- expression --- -createDftArrayBind :: CoreExpr -> Flatten CoreBind -createDftArrayBind e = - panic "Flattening.createDftArrayBind: not implemented yet" -{- - do - let ty = parrElemTy . exprType $ expr - len <- mk'lengthP e - rhs <- mk'replicateP ty len err?? - lift snd $ mkBind FSLIT("dft") rhs -FIXME: nicht so einfach; man kann kein "error"-Wert nehmen, denn der w"urde - beim bpermuteDftP sofort evaluiert, aber es ist auch schwer m"oglich einen - generischen Wert f"ur jeden beliebigen Typ zu erfinden. --} - - - - --- show functions (the pretty print functions sometimes don't --- show it the way I want.... - --- shows just the structure -showCoreExpr (Var _ ) = "Var " -showCoreExpr (Lit _) = "Lit " -showCoreExpr (App e1 e2) = - "(App \n " ++ (showCoreExpr e1) ++ "\n " ++ (showCoreExpr e2) ++ ") " -showCoreExpr (Lam b e) = - "Lam b " ++ (showCoreExpr e) -showCoreExpr (Let bnds expr) = - "Let \n" ++ (showBinds bnds) ++ "in " ++ (showCoreExpr expr) - where showBinds (NonRec b e) = showBind (b,e) - showBinds (Rec bnds) = concat (map showBind bnds) - showBind (b,e) = " b = " ++ (showCoreExpr e)++ "\n" --- gaw 2004 FIX? -showCoreExpr (Case ex b ty alts) = - "Case b = " ++ (showCoreExpr ex) ++ " of \n" ++ (showAlts alts) - where showAlts _ = "" -showCoreExpr (Note _ ex) = "Note n " ++ (showCoreExpr ex) -showCoreExpr (Type t) = "Type" 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 diff --git a/compiler/ndpFlatten/PArrAnal.hs b/compiler/ndpFlatten/PArrAnal.hs deleted file mode 100644 index e4c0dc7..0000000 --- a/compiler/ndpFlatten/PArrAnal.hs +++ /dev/null @@ -1,214 +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) 2002 Manuel M T Chakravarty & Gabriele Keller --- --- Analysis phase for an optimised flattening transformation --- ---- DESCRIPTION --------------------------------------------------------------- --- --- This module implements an analysis phase that identifies Core expressions --- that need not be transformed during flattening. The expressions when --- executed in a parallel context are implemented as an iteration over the --- original scalar computation, instead of vectorising the computation. This --- usually improves efficiency by increasing locality and also reduces code --- size. --- ---- DOCU ---------------------------------------------------------------------- --- --- Language: Haskell 98 with C preprocessor --- --- Analyse the expression and annotate each simple subexpression accordingly. --- --- The result of the analysis is stored in a new field in IdInfo (has yet to --- be extended) --- --- A simple expression is any expression which is not a function, not of --- recursive type and does not contain a value of PArray type. Polymorphic --- variables are simple expressions even though they might be instantiated to --- a parray value or function. --- ---- TODO ---------------------------------------------------------------------- --- - -module PArrAnal ( - markScalarExprs -- :: [CoreBind] -> [CoreBind] -) where - -import Panic (panic) -import Outputable (pprPanic, ppr) -import CoreSyn (CoreBind) - -import TypeRep (Type(..)) -import Var (Var(..),Id) -import Literal (Literal) -import CoreSyn (Expr(..),CoreExpr,Bind(..)) -import PprCore ( {- instances -} ) --- - -data ArrayUsage = Prim | NonPrim | Array - | PolyExpr (Id -> Maybe (ArrayUsage -> ArrayUsage)) - | PolyFun (ArrayUsage -> ArrayUsage) - - -arrUsage:: CoreExpr -> ArrayUsage -arrUsage (Var id) = varArrayUsage id -arrUsage (Lit lit) = litArrayUsage lit -arrUsage (App expr1 expr2) = - let - arr1 = arrUsage expr1 - arr2 = arrUsage expr2 - in - case (arr1, arr2) of - (_, Array) -> Array - (PolyFun f, _) -> f arr2 - (_, _) -> arr1 - -arrUsage (Lam b expr) = - bindType (b, expr) - -arrUsage (Let (NonRec b expr1) expr2) = - arrUsage (App (Lam b expr2) expr1) - -arrUsage (Let (Rec bnds) expr) = - let - t1 = foldr combineArrayUsage Prim (map bindType bnds) - t2 = arrUsage expr - in if isArrayUsage t1 then Array else t2 - -arrUsage (Case expr b _ alts) = - let - t1 = arrUsage expr - t2 = scanType (map (arrUsage . (\ (_,_,x) -> x)) alts) - in scanType [t1, t2] - -arrUsage (Note n expr) = - arrUsage expr - -arrUsage (Type t) = - typeArrayUsage t - --- not quite sure this is right -arrUsage (Cast expr co) = - arrUsage expr - -bindType (b, expr) = - let - bT = varArrayUsage b - exprT = arrUsage expr - in case (bT, exprT) of - (Array, _) -> Array - _ -> exprT - -scanType:: [ArrayUsage] -> ArrayUsage -scanType [t] = t -scanType (Array:ts) = Array -scanType (_:ts) = scanType ts - - - --- the code expression represents a built-in function which generates --- an array -isArrayGen:: CoreExpr -> Bool -isArrayGen _ = - panic "PArrAnal: isArrayGen: not yet implemented" - -isArrayCon:: CoreExpr -> Bool -isArrayCon _ = - panic "PArrAnal: isArrayCon: not yet implemented" - -markScalarExprs:: [CoreBind] -> [CoreBind] -markScalarExprs _ = - panic "PArrAnal.markScalarExprs: not implemented yet" - - -varArrayUsage:: Id -> ArrayUsage -varArrayUsage = - panic "PArrAnal.varArrayUsage: not yet implented" - -litArrayUsage:: Literal -> ArrayUsage -litArrayUsage = - panic "PArrAnal.litArrayUsage: not yet implented" - - -typeArrayUsage:: Type -> ArrayUsage -typeArrayUsage (TyVarTy tvar) = - PolyExpr (tIdFun tvar) -typeArrayUsage (AppTy _ _) = - panic "PArrAnal.typeArrayUsage: AppTy case not yet implemented" -typeArrayUsage (TyConApp tc tcargs) = - let - tcargsAU = map typeArrayUsage tcargs - tcCombine = foldr combineArrayUsage Prim tcargsAU - in auCon tcCombine -typeArrayUsage t@(PredTy _) = - pprPanic "PArrAnal.typeArrayUsage: encountered 'PredType - shouldn't be here!" - (ppr t) - - -combineArrayUsage:: ArrayUsage -> ArrayUsage -> ArrayUsage -combineArrayUsage Array _ = Array -combineArrayUsage _ Array = Array -combineArrayUsage (PolyExpr f1) (PolyExpr f2) = - PolyExpr f' - where - f' var = - let - f1lookup = f1 var - f2lookup = f2 var - in - case (f1lookup, f2lookup) of - (Nothing, _) -> f2lookup - (_, Nothing) -> f1lookup - (Just f1', Just f2') -> Just ( \e -> (combineArrayUsage (f1' e) (f2' e))) -combineArrayUsage (PolyFun f) (PolyExpr g) = - panic ("PArrAnal.typeArrayUsage: PolyFun as argument in data" ++ - " constructor - should not (?) happen\n") -combineArrayUsage (PolyExpr g) (PolyFun f) = - panic ("PArrAnal.typeArrayUsage: PolyFun as argument in data" ++ - " constructor - should not (?) happen\n") -combineArrayUsage NonPrim _ = NonPrim -combineArrayUsage _ NonPrim = NonPrim -combineArrayUsage Prim Prim = Prim - - -isArrayUsage:: ArrayUsage -> Bool -isArrayUsage Array = True -isArrayUsage _ = False - --- Functions to serve as arguments for PolyExpr --- --------------------------------------------- - -tIdFun:: Var -> Var -> Maybe (ArrayUsage -> ArrayUsage) -tIdFun t tcomp = - if t == tcomp then - Just auId - else - Nothing - --- Functions to serve as argument for PolyFun --- ------------------------------------------- - -auId:: ArrayUsage -> ArrayUsage -auId = id - -auCon:: ArrayUsage -> ArrayUsage -auCon Prim = NonPrim -auCon (PolyExpr f) = PolyExpr f' - where f' v = case f v of - Nothing -> Nothing - Just g -> Just ( \e -> (auCon (g e))) -auCon (PolyFun f) = PolyFun (auCon . f) -auCon _ = Array - --- traversal of Core expressions --- ----------------------------- - --- FIXME: implement - diff --git a/compiler/ndpFlatten/TODO b/compiler/ndpFlatten/TODO deleted file mode 100644 index e596609..0000000 --- a/compiler/ndpFlatten/TODO +++ /dev/null @@ -1,202 +0,0 @@ - TODO List for Flattening Support in GHC -*-text-*- - ======================================= - -Middle-End Related -~~~~~~~~~~~~~~~~~~ - -Flattening Transformation -~~~~~~~~~~~~~~~~~~~~~~~~~ - -* Complete and test - -* Complete the analysis - -* Type transformation: The idea solution would probably be if we can add some - generic machinery, so that we can define all the rules for handling the type - and value transformations in a library. (The PrelPArr for WayNDP.) - - -Library Related -~~~~~~~~~~~~~~~ - -* Problem with re-exporting PrelPArr from Prelude is that it would also be - visible when -pparr is not given. There should be a mechanism to implicitly - import more than one module (like PERVASIVE modules in M3) - -* We need a PrelPArr-like library for when flattening is used, too. In fact, - we need some library routines that are on the level of merely vectorised - code (eg, for the dummy default vectors), and then, all the `PArrays' stuff - implementing fast unboxed arrays and fusion. - -* Enum is a problem. Ideally, we would like `enumFromToP' and - `enumFromThenToP' to be members of `Enum'. On the other hand, we really do - not want to change `Enum'. The solution for the moment is to define - - enumFromTo x y = mapP toEnum [:fromEnum x .. fromEnum y:] - enumFromThenTo x y z = mapP toEnum [:fromEnum x, fromEnum y .. fromEnum z:] - - like the Haskell Report does for the list versions. This is hopefully - efficient enough as array fusion should fold the two traversals into one. - [DONE] - - -DOCU that should go into the Commentary -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The type constructor [::] -------------------------- - -The array type constructor [::] is quite similar to [] (list constructor) in -that GHC has to know about it (in TysWiredIn); however, there are some -differences: - -* [::] is an abstract type, whereas [] is not - -* if flattening is switched on, all occurences of the type are actually - removed by appropriate program transformations. - -The module PrelPArr that actually implements nested parallel arrays. [::] is -eliminated only if in addition to array support, flattening is activated. It -is just an option rather than the only method to implement those arrays. - - Flags: -fparr -- syntactic support for parallel arrays (via `PrelPArr') - * Dynamic hsc option; can be reversed with -fno-parr - -fflatten -- flattening transformation - * Static hsc option - -ndp -- this a way option, which implies -fparr and -fflatten - (way options are handled by the driver and are not - directly seen by hsc) - -ddump-vect -- dump Core after vectorisation - * Dynamic hsc option - -* PrelPArr implements array variants of the Prelude list functions plus some - extra functions (also, some list functions (eg, those generating infinite - lists) have been left out. - -* prelude/PrelNames has been extended with all the names from PrelPArr that - need to be known inside the compiler - -* The variable GhcSupportsPArr, which can be set in build.mk decides whether - `PrelPArr' is to be compiled or not. (We probably need to supress compiling - PrelPArr in WayNDP, or rather replace it with a different PrelPArr.) - -* Say something about `TysWiredIn.parrTyCon' as soon as we know how it - actually works... - -Parser and AST Notes: -- Parser and AST is quite straight forward. Essentially, the list cases - duplicated with a name containing `PArr' or `parr' and modified to fit the - slightly different semantics (ie, finite length, strict). -- The value and pattern `[::]' is an empty explicit parallel array (ie, - something of the form `ExplicitPArr ty []' in the AST). This is in contrast - to lists, which use the nil-constructor instead. In the case of parallel - arrays, using a constructor would be rather awkward, as it is not a - constructor-based type. -- Thus, array patterns have the general form `[:p1, p2, ..., pn:]', where n >= - 0. Thus, two array patterns overlap iff they have the same length. -- The type constructor for parallel is internally represented as a - `TyCon.AlgTyCon' with a wired in definition in `TysWiredIn'. - -Desugarer Notes: -- Desugaring of patterns involving parallel arrays: - * In Match.tidy1, we use fake array constructors; ie, any pattern `[:p1, ..., - pn:]' is replaces by the expression `MkPArr p1 ... pn', where - `MkPArr' is the n-ary array constructor. These constructors are fake, - because they are never used to actually represent array values; in fact, - they are removed again before pattern compilation is finished. However, - the use of these fake constructors implies that we need not modify large - parts of the machinery of the pattern matching compiler, as array patterns - are handled like any other constructor pattern. - * Check.simplify_pat introduces the same fake constructors as Match.tidy1 - and removed again by Check.make_con. - * In DsUtils.mkCoAlgCaseMatchResult, we catch the case of array patterns and - generate code as the following example illustrates, where the LHS is the - code that would be produced if array construtors would really exist: - - case v of pa { - MkPArr1 x1 -> e1 - MkPArr2 x2 x3 x4 -> e2 - DFT -> e3 - } - - => - - case lengthP v of - Int# i# -> - case i# of l { - 1 -> let x1 = v!:0 in e1 - 3 -> let x2 = v!:0; x2 = v!:1; x3 = v!:2 in e2 - DFT -> e3 - } - * The desugaring of array comprehensions is in `DsListComp', but follows - rules that are different from that for translating list comprehensions. - Denotationally, it boils down to the same, but the operational - requirements for an efficient implementation of array comprehensions are - rather different. - - [:e | qss:] = <<[:e | qss:]>> () [:():] - - <<[:e' | :]>> pa ea = mapP (\pa -> e') ea - <<[:e' | b , qs:]>> pa ea = <<[:e' | qs:]>> pa (filterP (\pa -> b) ea) - <<[:e' | p <- e, qs:]>> pa ea = - let ef = filterP (\x -> case x of {p -> True; _ -> False}) e - in - <<[:e' | qs:]>> (pa, p) (crossP ea ef) - <<[:e' | let ds, qs:]>> pa ea = - <<[:e' | qs:]>> (pa, (x_1, ..., x_n)) - (mapP (\v@pa -> (v, let ds in (x_1, ..., x_n))) ea) - where - {x_1, ..., x_n} = DV (ds) -- Defined Variables - <<[:e' | qs | qss:]>> pa ea = - <<[:e' | qss:]>> (pa, (x_1, ..., x_n)) - (zipP ea <<[:(x_1, ..., x_n) | qs:]>>) - where - {x_1, ..., x_n} = DV (qs) - - Moreover, we have - - crossP :: [:a:] -> [:b:] -> [:(a, b):] - crossP a1 a2 = let - len1 = lengthP a1 - len2 = lengthP a2 - x1 = concatP $ mapP (replicateP len2) a1 - x2 = concatP $ replicateP len1 a2 - in - zipP x1 x2 - - For a more efficient implementation of `crossP', see `PrelPArr'. - - Optimisations: - - In the `p <- e' rule, if `pa = ()', drop it and simplify the `crossP ea - e' to `e'. - - We assume that fusion will optimise sequences of array processing - combinators. - - Do we want to have the following function? - - mapFilterP :: (a -> Maybe b) -> [:a:] -> [:b:] - - Even with fusion `(mapP (\p -> e) . filterP (\p -> b))' may still result - in redundant pattern matching operations. (Let's wait with this until - we have seen what the Simplifier does to the generated code.) - -Flattening Notes: -* The story about getting access to all the names like "fst" etc that we need - to generate during flattening is quite involved. To have a reasonable - chance to get at the stuff, we need to put flattening inbetween the - desugarer and the simplifier as an extra pass in HscMain.hscMain. After - that point, the persistent compiler state is zapped (for heap space - reduction reasons, I guess) and nothing remains of the imported interfaces - in one shot mode. - - Moreover, to get the Ids that we need into the type environment, we need to - force the renamer to include them. This is done in - RnEnv.getImplicitModuleFVs, which computes all implicitly imported names. - We let it add the names from FlattenInfo.namesNeededForFlattening. - - Given all these arrangements, FlattenMonad can obtain the needed Ids from - the persistent compiler state without much further hassle. - - [It might be worthwhile to document in the non-Flattening part of the - Commentary that the persistent compiler state is zapped after desugaring and - how the free variables determined by the renamer imply which names are - imported.] diff --git a/compiler/package.conf.in b/compiler/package.conf.in index 2342e14..e4cbaec 100644 --- a/compiler/package.conf.in +++ b/compiler/package.conf.in @@ -94,9 +94,6 @@ exposed-modules: FieldLabel Finder FiniteMap - FlattenInfo - FlattenMonad - Flattening FloatIn FloatOut ForeignCall @@ -150,7 +147,6 @@ exposed-modules: MkIface Module NCGMonad - NDPCoreUtils Name NameEnv NameSet @@ -294,7 +290,6 @@ import-dirs: FPTOOLS_TOP_ABS"/compiler/stage"STAGE"/utils", FPTOOLS_TOP_ABS"/compiler/stage"STAGE"/profiling", FPTOOLS_TOP_ABS"/compiler/stage"STAGE"/parser", FPTOOLS_TOP_ABS"/compiler/stage"STAGE"/cprAnalysis", - FPTOOLS_TOP_ABS"/compiler/stage"STAGE"/ndpFlatten", FPTOOLS_TOP_ABS"/compiler/stage"STAGE"/iface", FPTOOLS_TOP_ABS"/compiler/stage"STAGE"/cmm", FPTOOLS_TOP_ABS"/compiler/stage"STAGE"/nativeGen"