1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
-- $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
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
|
