ghc/compiler/coreSyn/AnnCoreSyn.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[AnnCoreSyntax]{Annotated core syntax}
   5
   6 For when you want @CoreSyntax@ trees annotated at every node.  Other
   7 than that, just like @CoreSyntax@.  (Important to be sure that it {\em
   8 really is} just like @CoreSyntax@.)
   9
  10 \begin{code}
  11 #include "HsVersions.h"
  12
  13 module AnnCoreSyn (
  14         AnnCoreBinding(..), AnnCoreExpr(..),
  15         AnnCoreExpr'(..),       -- v sad that this must be exported
  16         AnnCoreCaseAlts(..), AnnCoreCaseDefault(..),
  17
  18         deAnnotate -- we may eventually export some of the other deAnners
  19     ) where
  20
  21 import Ubiq{-uitous-}
  22
  23 import CoreSyn
  24 \end{code}
  25
  26 \begin{code}
  27 data AnnCoreBinding val_bdr val_occ tyvar uvar annot
  28   = AnnNonRec val_bdr (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
  29   | AnnRec    [(val_bdr, AnnCoreExpr val_bdr val_occ tyvar uvar annot)]
  30 \end{code}
  31
  32 \begin{code}
  33 type AnnCoreExpr val_bdr val_occ tyvar uvar annot
  34   = (annot, AnnCoreExpr' val_bdr val_occ tyvar uvar annot)
  35
  36 data AnnCoreExpr' val_bdr val_occ tyvar uvar annot
  37   = AnnVar      val_occ
  38   | AnnLit      Literal
  39
  40   | AnnCon      Id     [GenCoreArg val_occ tyvar uvar]
  41   | AnnPrim     PrimOp [GenCoreArg val_occ tyvar uvar]
  42
  43   | AnnLam      (GenCoreBinder val_bdr tyvar uvar)
  44                 (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
  45
  46   | AnnApp      (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
  47                 (GenCoreArg  val_occ tyvar uvar)
  48
  49   | AnnCase     (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
  50                 (AnnCoreCaseAlts val_bdr val_occ tyvar uvar annot)
  51
  52   | AnnLet      (AnnCoreBinding val_bdr val_occ tyvar uvar annot)
  53                 (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
  54
  55   | AnnSCC      CostCentre
  56                 (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
  57 \end{code}
  58
  59 \begin{code}
  60 data AnnCoreCaseAlts val_bdr val_occ tyvar uvar annot
  61   = AnnAlgAlts  [(Id,
  62                   [val_bdr],
  63                   AnnCoreExpr val_bdr val_occ tyvar uvar annot)]
  64                 (AnnCoreCaseDefault val_bdr val_occ tyvar uvar annot)
  65   | AnnPrimAlts [(Literal,
  66                   AnnCoreExpr val_bdr val_occ tyvar uvar annot)]
  67                 (AnnCoreCaseDefault val_bdr val_occ tyvar uvar annot)
  68
  69 data AnnCoreCaseDefault val_bdr val_occ tyvar uvar annot
  70   = AnnNoDefault
  71   | AnnBindDefault  val_bdr
  72                     (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
  73 \end{code}
  74
  75 \begin{code}
  76 deAnnotate :: AnnCoreExpr val_bdr val_occ tyvar uvar ann
  77            -> GenCoreExpr val_bdr val_occ tyvar uvar
  78
  79 deAnnotate (_, AnnVar   v)          = Var v
  80 deAnnotate (_, AnnLit   lit)        = Lit lit
  81 deAnnotate (_, AnnCon   con args)   = Con con args
  82 deAnnotate (_, AnnPrim  op args)    = Prim op args
  83 deAnnotate (_, AnnLam   binder body)= Lam binder (deAnnotate body)
  84 deAnnotate (_, AnnApp   fun arg)    = App (deAnnotate fun) arg
  85 deAnnotate (_, AnnSCC   lbl body)   = SCC lbl (deAnnotate body)
  86
  87 deAnnotate (_, AnnLet bind body)
  88   = Let (deAnnBind bind) (deAnnotate body)
  89   where
  90     deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
  91     deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
  92
  93 deAnnotate (_, AnnCase scrut alts)
  94   = Case (deAnnotate scrut) (deAnnAlts alts)
  95   where
  96     deAnnAlts (AnnAlgAlts alts deflt)
  97       = AlgAlts [(con,args,deAnnotate rhs) | (con,args,rhs) <- alts]
  98                  (deAnnDeflt deflt)
  99
 100     deAnnAlts (AnnPrimAlts alts deflt)
 101       = PrimAlts [(lit,deAnnotate rhs) | (lit,rhs) <- alts]
 102                    (deAnnDeflt deflt)
 103
 104     deAnnDeflt AnnNoDefault             = NoDefault
 105     deAnnDeflt (AnnBindDefault var rhs) = BindDefault var (deAnnotate rhs)
 106 \end{code}