compiler/ndpFlatten/PArrAnal.hs

   1 {-# OPTIONS -w #-}
   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/CodingStyle#Warnings
   6 -- for details
   7
   8 --  $Id$
   9 --
  10 --  Copyright (c) 2002 Manuel M T Chakravarty & Gabriele Keller
  11 --
  12 --  Analysis phase for an optimised flattening transformation
  13 --
  14 --- DESCRIPTION ---------------------------------------------------------------
  15 --
  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
  21 --  size.
  22 --
  23 --- DOCU ----------------------------------------------------------------------
  24 --
  25 --  Language: Haskell 98 with C preprocessor
  26 --
  27 -- Analyse the expression and annotate each simple subexpression accordingly.
  28 --
  29 --  The result of the analysis is stored in a new field in IdInfo (has yet to
  30 --  be extended)
  31 --
  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.
  36 --
  37 --- TODO ----------------------------------------------------------------------
  38 --
  39
  40 module PArrAnal (
  41   markScalarExprs       -- :: [CoreBind] -> [CoreBind]
  42 ) where
  43
  44 import Panic   (panic)
  45 import Outputable (pprPanic, ppr)
  46 import CoreSyn (CoreBind)
  47
  48 import TypeRep      (Type(..))
  49 import Var (Var(..),Id)
  50 import Literal      (Literal)
  51 import CoreSyn (Expr(..),CoreExpr,Bind(..))
  52 import PprCore ( {- instances -} )
  53 --
  54
  55 data ArrayUsage = Prim | NonPrim | Array
  56                 | PolyExpr (Id -> Maybe (ArrayUsage -> ArrayUsage))
  57                 | PolyFun (ArrayUsage -> ArrayUsage)
  58
  59
  60 arrUsage:: CoreExpr -> ArrayUsage
  61 arrUsage (Var id)  = varArrayUsage id
  62 arrUsage (Lit lit) = litArrayUsage lit
  63 arrUsage (App expr1 expr2) =
  64   let
  65     arr1 = arrUsage expr1
  66     arr2 = arrUsage expr2
  67   in
  68   case (arr1, arr2) of
  69     (_,        Array)  -> Array
  70     (PolyFun f, _)     -> f arr2
  71     (_, _)             -> arr1
  72
  73 arrUsage (Lam b expr) =
  74   bindType (b, expr)
  75
  76 arrUsage (Let (NonRec b expr1) expr2) =
  77   arrUsage (App (Lam b expr2) expr1)
  78
  79 arrUsage (Let (Rec bnds) expr) =
  80   let
  81     t1 = foldr combineArrayUsage Prim (map bindType bnds)
  82     t2 = arrUsage expr
  83   in if isArrayUsage t1 then Array else t2
  84
  85 arrUsage (Case expr b _ alts) =
  86   let
  87     t1 = arrUsage expr
  88     t2 = scanType (map (arrUsage . (\ (_,_,x) -> x)) alts)
  89   in scanType [t1, t2]
  90
  91 arrUsage (Note n expr) =
  92   arrUsage expr
  93
  94 arrUsage (Type t) =
  95   typeArrayUsage  t
  96
  97 -- not quite sure this is right
  98 arrUsage (Cast expr co) =
  99   arrUsage expr
 100
 101 bindType (b, expr) =
 102   let
 103     bT    = varArrayUsage b
 104     exprT = arrUsage expr
 105   in case (bT, exprT) of
 106        (Array, _) -> Array
 107        _          -> exprT
 108
 109 scanType:: [ArrayUsage] -> ArrayUsage
 110 scanType [t]        = t
 111 scanType (Array:ts) = Array
 112 scanType (_:ts)     = scanType ts
 113
 114
 115
 116 -- the code expression represents a built-in function which generates
 117 -- an array
 118 isArrayGen:: CoreExpr -> Bool
 119 isArrayGen _ =
 120   panic "PArrAnal: isArrayGen: not yet implemented"
 121
 122 isArrayCon:: CoreExpr -> Bool
 123 isArrayCon _ =
 124   panic "PArrAnal: isArrayCon: not yet implemented"
 125
 126 markScalarExprs:: [CoreBind] -> [CoreBind]
 127 markScalarExprs _ =
 128   panic "PArrAnal.markScalarExprs: not implemented yet"
 129
 130
 131 varArrayUsage:: Id -> ArrayUsage
 132 varArrayUsage =
 133   panic "PArrAnal.varArrayUsage: not yet implented"
 134
 135 litArrayUsage:: Literal -> ArrayUsage
 136 litArrayUsage =
 137   panic "PArrAnal.litArrayUsage: not yet implented"
 138
 139
 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) =
 146   let
 147     tcargsAU = map typeArrayUsage tcargs
 148     tcCombine  = foldr combineArrayUsage Prim tcargsAU
 149   in auCon tcCombine
 150 typeArrayUsage t@(PredTy _) =
 151   pprPanic "PArrAnal.typeArrayUsage: encountered 'PredType - shouldn't be here!"
 152            (ppr t)
 153
 154
 155 combineArrayUsage:: ArrayUsage -> ArrayUsage -> ArrayUsage
 156 combineArrayUsage Array _  = Array
 157 combineArrayUsage _ Array  = Array
 158 combineArrayUsage (PolyExpr f1) (PolyExpr f2) =
 159   PolyExpr f'
 160   where
 161     f' var =
 162       let
 163         f1lookup = f1 var
 164         f2lookup = f2 var
 165        in
 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
 179
 180
 181 isArrayUsage:: ArrayUsage -> Bool
 182 isArrayUsage Array = True
 183 isArrayUsage _     = False
 184
 185 --  Functions to serve as arguments for PolyExpr
 186 --  ---------------------------------------------
 187
 188 tIdFun:: Var -> Var -> Maybe (ArrayUsage -> ArrayUsage)
 189 tIdFun t tcomp =
 190   if t == tcomp then
 191      Just auId
 192   else
 193      Nothing
 194
 195 -- Functions to serve as argument for PolyFun
 196 -- -------------------------------------------
 197
 198 auId:: ArrayUsage -> ArrayUsage
 199 auId = id
 200
 201 auCon:: ArrayUsage -> ArrayUsage
 202 auCon Prim = NonPrim
 203 auCon (PolyExpr f) = PolyExpr f'
 204   where f' v  = case f v of
 205                    Nothing -> Nothing
 206                    Just g  -> Just  ( \e -> (auCon (g e)))
 207 auCon (PolyFun f)  = PolyFun (auCon . f)
 208 auCon _    = Array
 209
 210 -- traversal of Core expressions
 211 -- -----------------------------
 212
 213 -- FIXME: implement
 214