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 import PprCore ( {- instances -} )
  46 --
  47
  48 data ArrayUsage = Prim | NonPrim | Array
  49                 | PolyExpr (Id -> Maybe (ArrayUsage -> ArrayUsage))
  50                 | PolyFun (ArrayUsage -> ArrayUsage)
  51
  52
  53 arrUsage:: CoreExpr -> ArrayUsage
  54 arrUsage (Var id)  = varArrayUsage id
  55 arrUsage (Lit lit) = litArrayUsage lit
  56 arrUsage (App expr1 expr2) =
  57   let
  58     arr1 = arrUsage expr1
  59     arr2 = arrUsage expr2
  60   in
  61   case (arr1, arr2) of
  62     (_,        Array)  -> Array
  63     (PolyFun f, _)     -> f arr2
  64     (_, _)             -> arr1
  65
  66 arrUsage (Lam b expr) =
  67   bindType (b, expr)
  68
  69 arrUsage (Let (NonRec b expr1) expr2) =
  70   arrUsage (App (Lam b expr2) expr1)
  71
  72 arrUsage (Let (Rec bnds) expr) =
  73   let
  74     t1 = foldr combineArrayUsage Prim (map bindType bnds)
  75     t2 = arrUsage expr
  76   in if isArrayUsage t1 then Array else t2
  77
  78 arrUsage (Case expr b _ alts) =
  79   let
  80     t1 = arrUsage expr
  81     t2 = scanType (map (arrUsage . (\ (_,_,x) -> x)) alts)
  82   in scanType [t1, t2]
  83
  84 arrUsage (Note n expr) =
  85   arrUsage expr
  86
  87 arrUsage (Type t) =
  88   typeArrayUsage  t
  89
  90 -- not quite sure this is right
  91 arrUsage (Cast expr co) =
  92   arrUsage expr
  93
  94 bindType (b, expr) =
  95   let
  96     bT    = varArrayUsage b
  97     exprT = arrUsage expr
  98   in case (bT, exprT) of
  99        (Array, _) -> Array
 100        _          -> exprT
 101
 102 scanType:: [ArrayUsage] -> ArrayUsage
 103 scanType [t]        = t
 104 scanType (Array:ts) = Array
 105 scanType (_:ts)     = scanType ts
 106
 107
 108
 109 -- the code expression represents a built-in function which generates
 110 -- an array
 111 isArrayGen:: CoreExpr -> Bool
 112 isArrayGen _ =
 113   panic "PArrAnal: isArrayGen: not yet implemented"
 114
 115 isArrayCon:: CoreExpr -> Bool
 116 isArrayCon _ =
 117   panic "PArrAnal: isArrayCon: not yet implemented"
 118
 119 markScalarExprs:: [CoreBind] -> [CoreBind]
 120 markScalarExprs _ =
 121   panic "PArrAnal.markScalarExprs: not implemented yet"
 122
 123
 124 varArrayUsage:: Id -> ArrayUsage
 125 varArrayUsage =
 126   panic "PArrAnal.varArrayUsage: not yet implented"
 127
 128 litArrayUsage:: Literal -> ArrayUsage
 129 litArrayUsage =
 130   panic "PArrAnal.litArrayUsage: not yet implented"
 131
 132
 133 typeArrayUsage:: Type -> ArrayUsage
 134 typeArrayUsage (TyVarTy tvar) =
 135   PolyExpr (tIdFun tvar)
 136 typeArrayUsage (AppTy _ _) =
 137    panic "PArrAnal.typeArrayUsage: AppTy case not yet implemented"
 138 typeArrayUsage (TyConApp tc tcargs) =
 139   let
 140     tcargsAU = map typeArrayUsage tcargs
 141     tcCombine  = foldr combineArrayUsage Prim tcargsAU
 142   in auCon tcCombine
 143 typeArrayUsage t@(PredTy _) =
 144   pprPanic "PArrAnal.typeArrayUsage: encountered 'PredType - shouldn't be here!"
 145            (ppr t)
 146
 147
 148 combineArrayUsage:: ArrayUsage -> ArrayUsage -> ArrayUsage
 149 combineArrayUsage Array _  = Array
 150 combineArrayUsage _ Array  = Array
 151 combineArrayUsage (PolyExpr f1) (PolyExpr f2) =
 152   PolyExpr f'
 153   where
 154     f' var =
 155       let
 156         f1lookup = f1 var
 157         f2lookup = f2 var
 158        in
 159        case (f1lookup, f2lookup) of
 160          (Nothing, _) -> f2lookup
 161          (_, Nothing) -> f1lookup
 162          (Just f1', Just f2') -> Just ( \e -> (combineArrayUsage (f1' e) (f2' e)))
 163 combineArrayUsage (PolyFun f) (PolyExpr g) =
 164         panic ("PArrAnal.typeArrayUsage: PolyFun as argument in data" ++
 165                " constructor - should not (?) happen\n")
 166 combineArrayUsage (PolyExpr g) (PolyFun f)  =
 167         panic ("PArrAnal.typeArrayUsage: PolyFun as argument in data" ++
 168                " constructor - should not (?) happen\n")
 169 combineArrayUsage NonPrim _ = NonPrim
 170 combineArrayUsage _ NonPrim = NonPrim
 171 combineArrayUsage Prim Prim = Prim
 172
 173
 174 isArrayUsage:: ArrayUsage -> Bool
 175 isArrayUsage Array = True
 176 isArrayUsage _     = False
 177
 178 --  Functions to serve as arguments for PolyExpr
 179 --  ---------------------------------------------
 180
 181 tIdFun:: Var -> Var -> Maybe (ArrayUsage -> ArrayUsage)
 182 tIdFun t tcomp =
 183   if t == tcomp then
 184      Just auId
 185   else
 186      Nothing
 187
 188 -- Functions to serve as argument for PolyFun
 189 -- -------------------------------------------
 190
 191 auId:: ArrayUsage -> ArrayUsage
 192 auId = id
 193
 194 auCon:: ArrayUsage -> ArrayUsage
 195 auCon Prim = NonPrim
 196 auCon (PolyExpr f) = PolyExpr f'
 197   where f' v  = case f v of
 198                    Nothing -> Nothing
 199                    Just g  -> Just  ( \e -> (auCon (g e)))
 200 auCon (PolyFun f)  = PolyFun (auCon . f)
 201 auCon _    = Array
 202
 203 -- traversal of Core expressions
 204 -- -----------------------------
 205
 206 -- FIXME: implement
 207