2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
10 -- Copyright (c) 2002 Manuel M T Chakravarty & Gabriele Keller
12 -- Analysis phase for an optimised flattening transformation
14 --- DESCRIPTION ---------------------------------------------------------------
16 -- This module implements an analysis phase that identifies Core expressions
17 -- that need not be transformed during flattening. The expressions when
18 -- executed in a parallel context are implemented as an iteration over the
19 -- original scalar computation, instead of vectorising the computation. This
20 -- usually improves efficiency by increasing locality and also reduces code
23 --- DOCU ----------------------------------------------------------------------
25 -- Language: Haskell 98 with C preprocessor
27 -- Analyse the expression and annotate each simple subexpression accordingly.
29 -- The result of the analysis is stored in a new field in IdInfo (has yet to
32 -- A simple expression is any expression which is not a function, not of
33 -- recursive type and does not contain a value of PArray type. Polymorphic
34 -- variables are simple expressions even though they might be instantiated to
35 -- a parray value or function.
37 --- TODO ----------------------------------------------------------------------
41 markScalarExprs -- :: [CoreBind] -> [CoreBind]
45 import Outputable (pprPanic, ppr)
46 import CoreSyn (CoreBind)
48 import TypeRep (Type(..))
49 import Var (Var(..),Id)
50 import Literal (Literal)
51 import CoreSyn (Expr(..),CoreExpr,Bind(..))
52 import PprCore ( {- instances -} )
55 data ArrayUsage = Prim | NonPrim | Array
56 | PolyExpr (Id -> Maybe (ArrayUsage -> ArrayUsage))
57 | PolyFun (ArrayUsage -> ArrayUsage)
60 arrUsage:: CoreExpr -> ArrayUsage
61 arrUsage (Var id) = varArrayUsage id
62 arrUsage (Lit lit) = litArrayUsage lit
63 arrUsage (App expr1 expr2) =
70 (PolyFun f, _) -> f arr2
73 arrUsage (Lam b expr) =
76 arrUsage (Let (NonRec b expr1) expr2) =
77 arrUsage (App (Lam b expr2) expr1)
79 arrUsage (Let (Rec bnds) expr) =
81 t1 = foldr combineArrayUsage Prim (map bindType bnds)
83 in if isArrayUsage t1 then Array else t2
85 arrUsage (Case expr b _ alts) =
88 t2 = scanType (map (arrUsage . (\ (_,_,x) -> x)) alts)
91 arrUsage (Note n expr) =
97 -- not quite sure this is right
98 arrUsage (Cast expr co) =
104 exprT = arrUsage expr
105 in case (bT, exprT) of
109 scanType:: [ArrayUsage] -> ArrayUsage
111 scanType (Array:ts) = Array
112 scanType (_:ts) = scanType ts
116 -- the code expression represents a built-in function which generates
118 isArrayGen:: CoreExpr -> Bool
120 panic "PArrAnal: isArrayGen: not yet implemented"
122 isArrayCon:: CoreExpr -> Bool
124 panic "PArrAnal: isArrayCon: not yet implemented"
126 markScalarExprs:: [CoreBind] -> [CoreBind]
128 panic "PArrAnal.markScalarExprs: not implemented yet"
131 varArrayUsage:: Id -> ArrayUsage
133 panic "PArrAnal.varArrayUsage: not yet implented"
135 litArrayUsage:: Literal -> ArrayUsage
137 panic "PArrAnal.litArrayUsage: not yet implented"
140 typeArrayUsage:: Type -> ArrayUsage
141 typeArrayUsage (TyVarTy tvar) =
142 PolyExpr (tIdFun tvar)
143 typeArrayUsage (AppTy _ _) =
144 panic "PArrAnal.typeArrayUsage: AppTy case not yet implemented"
145 typeArrayUsage (TyConApp tc tcargs) =
147 tcargsAU = map typeArrayUsage tcargs
148 tcCombine = foldr combineArrayUsage Prim tcargsAU
150 typeArrayUsage t@(PredTy _) =
151 pprPanic "PArrAnal.typeArrayUsage: encountered 'PredType - shouldn't be here!"
155 combineArrayUsage:: ArrayUsage -> ArrayUsage -> ArrayUsage
156 combineArrayUsage Array _ = Array
157 combineArrayUsage _ Array = Array
158 combineArrayUsage (PolyExpr f1) (PolyExpr f2) =
166 case (f1lookup, f2lookup) of
167 (Nothing, _) -> f2lookup
168 (_, Nothing) -> f1lookup
169 (Just f1', Just f2') -> Just ( \e -> (combineArrayUsage (f1' e) (f2' e)))
170 combineArrayUsage (PolyFun f) (PolyExpr g) =
171 panic ("PArrAnal.typeArrayUsage: PolyFun as argument in data" ++
172 " constructor - should not (?) happen\n")
173 combineArrayUsage (PolyExpr g) (PolyFun f) =
174 panic ("PArrAnal.typeArrayUsage: PolyFun as argument in data" ++
175 " constructor - should not (?) happen\n")
176 combineArrayUsage NonPrim _ = NonPrim
177 combineArrayUsage _ NonPrim = NonPrim
178 combineArrayUsage Prim Prim = Prim
181 isArrayUsage:: ArrayUsage -> Bool
182 isArrayUsage Array = True
183 isArrayUsage _ = False
185 -- Functions to serve as arguments for PolyExpr
186 -- ---------------------------------------------
188 tIdFun:: Var -> Var -> Maybe (ArrayUsage -> ArrayUsage)
195 -- Functions to serve as argument for PolyFun
196 -- -------------------------------------------
198 auId:: ArrayUsage -> ArrayUsage
201 auCon:: ArrayUsage -> ArrayUsage
203 auCon (PolyExpr f) = PolyExpr f'
204 where f' v = case f v of
206 Just g -> Just ( \e -> (auCon (g e)))
207 auCon (PolyFun f) = PolyFun (auCon . f)
210 -- traversal of Core expressions
211 -- -----------------------------