ghc/compiler/ndpFlatten/PArrAnal.hs

   1 --  $Id$
   2 --
   3 --  Copyright (c) 2002 Manuel M T Chakravarty & Gabriele Keller
   4 --
   5 --  Analysis phase for an optimised flattening transformation
   6 --
   7 --- DESCRIPTION ---------------------------------------------------------------
   8 --
   9 --  This module implements an analysis phase that identifies Core expressions
  10 --  that need not be transformed during flattening.  The expressions when
  11 --  executed in a parallel context are implemented as an iteration over the
  12 --  original scalar computation, instead of vectorising the computation.  This
  13 --  usually improves efficiency by increasing locality and also reduces code
  14 --  size.
  15 --
  16 --- DOCU ----------------------------------------------------------------------
  17 --
  18 --  Language: Haskell 98 with C preprocessor
  19 --
  20 -- Analyse the expression and annotate each simple subexpression accordingly.
  21 --
  22 --  The result of the analysis is stored in a new field in IdInfo (has yet to
  23 --  be extended)
  24 --
  25 --  A simple expression is any expression which is not a function, not of
  26 --  recursive type and does not contain a value of PArray type. Polymorphic
  27 --  variables are simple expressions even though they might be instantiated to
  28 --  a parray value or function.
  29 --
  30 --- TODO ----------------------------------------------------------------------
  31 --
  32
  33 module PArrAnal (
  34   markScalarExprs       -- :: [CoreBind] -> [CoreBind]
  35 ) where
  36
  37 import Panic   (panic)
  38 import Outputable (pprPanic, ppr)
  39 import CoreSyn (CoreBind)
  40
  41 import TypeRep      (Type(..))
  42 import Var (Var(..),Id)
  43 import Literal      (Literal)
  44 import CoreSyn (Expr(..),CoreExpr,Bind(..))
  45 --
  46
  47 data ArrayUsage = Prim | NonPrim | Array
  48                 | PolyExpr (Id -> Maybe (ArrayUsage -> ArrayUsage))
  49                 | PolyFun (ArrayUsage -> ArrayUsage)
  50
  51
  52 arrUsage:: CoreExpr -> ArrayUsage
  53 arrUsage (Var id)  = varArrayUsage id
  54 arrUsage (Lit lit) = litArrayUsage lit
  55 arrUsage (App expr1 expr2) =
  56   let
  57     arr1 = arrUsage expr1
  58     arr2 = arrUsage expr2
  59   in
  60   case (arr1, arr2) of
  61     (_,        Array)  -> Array
  62     (PolyFun f, _)     -> f arr2
  63     (_, _)             -> arr1
  64
  65 arrUsage (Lam b expr) =
  66   bindType (b, expr)
  67
  68 arrUsage (Let (NonRec b expr1) expr2) =
  69   arrUsage (App (Lam b expr2) expr1)
  70
  71 arrUsage (Let (Rec bnds) expr) =
  72   let
  73     t1 = foldr combineArrayUsage Prim (map bindType bnds)
  74     t2 = arrUsage expr
  75   in if isArrayUsage t1 then Array else t2
  76
  77 arrUsage (Case expr b alts) =
  78   let
  79     t1 = arrUsage expr
  80     t2 = scanType (map (arrUsage . (\ (_,_,x) -> x)) alts)
  81   in scanType [t1, t2]
  82
  83 arrUsage (Note n expr) =
  84   arrUsage expr
  85
  86 arrUsage (Type t) =
  87   typeArrayUsage  t
  88
  89 bindType (b, expr) =
  90   let
  91     bT    = varArrayUsage b
  92     exprT = arrUsage expr
  93   in case (bT, exprT) of
  94        (Array, _) -> Array
  95        _          -> exprT
  96
  97 scanType:: [ArrayUsage] -> ArrayUsage
  98 scanType [t]        = t
  99 scanType (Array:ts) = Array
 100 scanType (_:ts)     = scanType ts
 101
 102
 103
 104 -- the code expression represents a built-in function which generates
 105 -- an array
 106 isArrayGen:: CoreExpr -> Bool
 107 isArrayGen _ =
 108   panic "PArrAnal: isArrayGen: not yet implemented"
 109
 110 isArrayCon:: CoreExpr -> Bool
 111 isArrayCon _ =
 112   panic "PArrAnal: isArrayCon: not yet implemented"
 113
 114 markScalarExprs:: [CoreBind] -> [CoreBind]
 115 markScalarExprs _ =
 116   panic "PArrAnal.markScalarExprs: not implemented yet"
 117
 118
 119 varArrayUsage:: Id -> ArrayUsage
 120 varArrayUsage =
 121   panic "PArrAnal.varArrayUsage: not yet implented"
 122
 123 litArrayUsage:: Literal -> ArrayUsage
 124 litArrayUsage =
 125   panic "PArrAnal.litArrayUsage: not yet implented"
 126
 127
 128 typeArrayUsage:: Type -> ArrayUsage
 129 typeArrayUsage (TyVarTy tvar) =
 130   PolyExpr (tIdFun tvar)
 131 typeArrayUsage (AppTy _ _) =
 132    panic "PArrAnal.typeArrayUsage: AppTy case not yet implemented"
 133 typeArrayUsage (TyConApp tc tcargs) =
 134   let
 135     tcargsAU = map typeArrayUsage tcargs
 136     tcCombine  = foldr combineArrayUsage Prim tcargsAU
 137   in auCon tcCombine
 138 typeArrayUsage t@(SourceTy _) =
 139   pprPanic "PArrAnal.typeArrayUsage: encountered 'SourceType - shouldn't be here!"
 140            (ppr t)
 141
 142
 143 combineArrayUsage:: ArrayUsage -> ArrayUsage -> ArrayUsage
 144 combineArrayUsage Array _  = Array
 145 combineArrayUsage _ Array  = Array
 146 combineArrayUsage (PolyExpr f1) (PolyExpr f2) =
 147   PolyExpr f'
 148   where
 149     f' var =
 150       let
 151         f1lookup = f1 var
 152         f2lookup = f2 var
 153        in
 154        case (f1lookup, f2lookup) of
 155          (Nothing, _) -> f2lookup
 156          (_, Nothing) -> f1lookup
 157          (Just f1', Just f2') -> Just ( \e -> (combineArrayUsage (f1' e) (f2' e)))
 158 combineArrayUsage (PolyFun f) (PolyExpr g) =
 159         panic ("PArrAnal.typeArrayUsage: PolyFun as argument in data" ++
 160                " constructor - should not (?) happen\n")
 161 combineArrayUsage (PolyExpr g) (PolyFun f)  =
 162         panic ("PArrAnal.typeArrayUsage: PolyFun as argument in data" ++
 163                " constructor - should not (?) happen\n")
 164 combineArrayUsage NonPrim _ = NonPrim
 165 combineArrayUsage _ NonPrim = NonPrim
 166 combineArrayUsage Prim Prim = Prim
 167
 168
 169 isArrayUsage:: ArrayUsage -> Bool
 170 isArrayUsage Array = True
 171 isArrayUsage _     = False
 172
 173 --  Functions to serve as arguments for PolyExpr
 174 --  ---------------------------------------------
 175
 176 tIdFun:: Var -> Var -> Maybe (ArrayUsage -> ArrayUsage)
 177 tIdFun t tcomp =
 178   if t == tcomp then
 179      Just auId
 180   else
 181      Nothing
 182
 183 -- Functions to serve as argument for PolyFun
 184 -- -------------------------------------------
 185
 186 auId:: ArrayUsage -> ArrayUsage
 187 auId = id
 188
 189 auCon:: ArrayUsage -> ArrayUsage
 190 auCon Prim = NonPrim
 191 auCon (PolyExpr f) = PolyExpr f'
 192   where f' v  = case f v of
 193                    Nothing -> Nothing
 194                    Just g  -> Just  ( \e -> (auCon (g e)))
 195 auCon (PolyFun f)  = PolyFun (auCon . f)
 196 auCon _    = Array
 197
 198 -- traversal of Core expressions
 199 -- -----------------------------
 200
 201 -- FIXME: implement
 202