ghc/compiler/stgSyn/StgUtils.lhs

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