ghc/compiler/stgSyn/StgFuns.lhs

   1 x%
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1995
   3 %
   4 \section[StgFuns]{Utility functions for @STG@ programs}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module StgFuns (
  10         mapStgBindeesRhs
  11     ) where
  12
  13 import StgSyn
  14
  15 import UniqSet
  16 import Unique
  17
  18 import Util
  19 \end{code}
  20
  21 This utility function simply applies the given function to every
  22 bindee in the program.
  23
  24 \begin{code}
  25 mapStgBindeesBind :: (Id -> Id) -> PlainStgBinding -> PlainStgBinding
  26
  27 mapStgBindeesBind fn (StgNonRec b rhs) = StgNonRec b (mapStgBindeesRhs fn rhs)
  28 mapStgBindeesBind fn (StgRec pairs)    = StgRec [ (b, mapStgBindeesRhs fn r) | (b, r) <- pairs ]
  29
  30 ------------------
  31 mapStgBindeesRhs :: (Id -> Id) -> PlainStgRhs -> PlainStgRhs
  32
  33 mapStgBindeesRhs fn (StgRhsClosure cc bi fvs u args expr)
  34   = StgRhsClosure
  35         cc bi
  36         (map fn fvs)
  37         u
  38         (map fn args)
  39         (mapStgBindeesExpr fn expr)
  40
  41 mapStgBindeesRhs fn (StgRhsCon cc con atoms)
  42   = StgRhsCon cc con (map (mapStgBindeesAtom fn) atoms)
  43
  44 ------------------
  45 mapStgBindeesExpr :: (Id -> Id) -> PlainStgExpr -> PlainStgExpr
  46
  47 mapStgBindeesExpr fn (StgApp f args lvs)
  48   = StgApp (mapStgBindeesAtom fn f)
  49            (map (mapStgBindeesAtom fn) args)
  50            (mapUniqSet fn lvs)
  51
  52 mapStgBindeesExpr fn (StgConApp con atoms lvs)
  53   = StgConApp con (map (mapStgBindeesAtom fn) atoms) (mapUniqSet fn lvs)
  54
  55 mapStgBindeesExpr fn (StgPrimApp op atoms lvs)
  56   = StgPrimApp op (map (mapStgBindeesAtom fn) atoms) (mapUniqSet fn lvs)
  57
  58 mapStgBindeesExpr fn (StgLet bind expr)
  59   = StgLet (mapStgBindeesBind fn bind) (mapStgBindeesExpr fn expr)
  60
  61 mapStgBindeesExpr fn (StgLetNoEscape lvs rhss_lvs bind body)
  62   = StgLetNoEscape (mapUniqSet fn lvs) (mapUniqSet fn rhss_lvs)
  63                    (mapStgBindeesBind fn bind) (mapStgBindeesExpr fn body)
  64
  65 mapStgBindeesExpr fn (StgSCC ty label expr)
  66   = StgSCC ty label (mapStgBindeesExpr fn expr)
  67
  68 mapStgBindeesExpr fn (StgCase expr lvs1 lvs2 uniq alts)
  69   = StgCase (mapStgBindeesExpr fn expr)
  70             (mapUniqSet fn lvs1)
  71             (mapUniqSet fn lvs2)
  72             uniq
  73             (mapStgBindeesAlts alts)
  74   where
  75     mapStgBindeesAlts (StgAlgAlts ty alts deflt)
  76       = StgAlgAlts ty (map mapStgBindeesBoxed_alt alts) (mapStgBindeesDeflt deflt)
  77       where
  78         mapStgBindeesBoxed_alt (c,ps,use_mask,expr) = (c,ps,use_mask,mapStgBindeesExpr fn expr)
  79
  80     mapStgBindeesAlts (StgPrimAlts ty alts deflt)
  81       = StgPrimAlts ty (map mapStgBindeesunboxed_alt alts) (mapStgBindeesDeflt deflt)
  82       where
  83         mapStgBindeesunboxed_alt (l,expr) = (l,mapStgBindeesExpr fn expr)
  84
  85     mapStgBindeesDeflt StgNoDefault                 = StgNoDefault
  86     mapStgBindeesDeflt (StgBindDefault b used expr) = StgBindDefault b used (mapStgBindeesExpr fn expr)
  87
  88 ------------------
  89 mapStgBindeesAtom :: (Id -> Id) -> PlainStgAtom -> PlainStgAtom
  90
  91 mapStgBindeesAtom fn a@(StgLitAtom _)   = a
  92 mapStgBindeesAtom fn a@(StgVarAtom id)  = StgVarAtom (fn id)
  93 \end{code}