ghc/compiler/coreSyn/AnnCoreSyn.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
   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
  20         -- and to make the interface self-sufficient
  21     ) where
  22
  23 import PrelInfo         ( PrimOp(..), PrimRep
  24                           IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
  25                           IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
  26                         )
  27 import Literal          ( Literal )
  28 import CoreSyn
  29 import Outputable
  30 import CostCentre       ( CostCentre )
  31 #if USE_ATTACK_PRAGMAS
  32 import Util
  33 #endif
  34 \end{code}
  35
  36 \begin{code}
  37 data AnnCoreBinding binder bindee annot
  38   = AnnCoNonRec binder (AnnCoreExpr binder bindee annot)
  39   | AnnCoRec    [(binder, AnnCoreExpr binder bindee annot)]
  40 \end{code}
  41
  42 \begin{code}
  43 type AnnCoreExpr binder bindee annot = (annot, AnnCoreExpr' binder bindee annot)
  44
  45 data AnnCoreExpr' binder bindee annot
  46   = AnnCoVar     bindee
  47   | AnnCoLit Literal
  48
  49   | AnnCoCon     Id [Type] [GenCoreAtom bindee]
  50
  51   | AnnCoPrim    PrimOp [Type] [GenCoreAtom bindee]
  52
  53   | AnnCoLam     binder
  54                  (AnnCoreExpr binder bindee annot)
  55   | AnnCoTyLam   TyVar
  56                  (AnnCoreExpr binder bindee annot)
  57
  58   | AnnCoApp     (AnnCoreExpr binder bindee annot)
  59                  (GenCoreAtom    bindee)
  60   | AnnCoTyApp   (AnnCoreExpr binder bindee annot)
  61                  Type
  62
  63   | AnnCoCase    (AnnCoreExpr binder bindee annot)
  64                  (AnnCoreCaseAlts binder bindee annot)
  65
  66   | AnnCoLet     (AnnCoreBinding binder bindee annot)
  67                  (AnnCoreExpr binder bindee annot)
  68
  69   | AnnCoSCC     CostCentre
  70                  (AnnCoreExpr binder bindee annot)
  71 \end{code}
  72
  73 \begin{code}
  74 data AnnCoreCaseAlts binder bindee annot
  75   = AnnCoAlgAlts        [(Id,
  76                          [binder],
  77                          AnnCoreExpr binder bindee annot)]
  78                         (AnnCoreCaseDefault binder bindee annot)
  79   | AnnCoPrimAlts       [(Literal,
  80                           AnnCoreExpr binder bindee annot)]
  81                         (AnnCoreCaseDefault binder bindee annot)
  82
  83 data AnnCoreCaseDefault binder bindee annot
  84   = AnnCoNoDefault
  85   | AnnCoBindDefault    binder
  86                         (AnnCoreExpr binder bindee annot)
  87 \end{code}
  88
  89 \begin{code}
  90 deAnnotate :: AnnCoreExpr bndr bdee ann -> GenCoreExpr bndr bdee
  91
  92 deAnnotate (_, AnnCoVar v)            = Var v
  93 deAnnotate (_, AnnCoLit lit)      = Lit lit
  94 deAnnotate (_, AnnCoCon con tys args) = Con con tys args
  95 deAnnotate (_, AnnCoPrim op tys args) = Prim op tys args
  96 deAnnotate (_, AnnCoLam binder body)  = Lam binder (deAnnotate body)
  97 deAnnotate (_, AnnCoTyLam tyvar body) = CoTyLam tyvar (deAnnotate body)
  98 deAnnotate (_, AnnCoApp fun arg)      = App (deAnnotate fun) arg
  99 deAnnotate (_, AnnCoTyApp fun ty)     = CoTyApp (deAnnotate fun) ty
 100 deAnnotate (_, AnnCoSCC lbl body)     = SCC lbl (deAnnotate body)
 101
 102 deAnnotate (_, AnnCoLet bind body)
 103   = Let (deAnnBind bind) (deAnnotate body)
 104   where
 105     deAnnBind (AnnCoNonRec var rhs) = NonRec var (deAnnotate rhs)
 106     deAnnBind (AnnCoRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
 107
 108 deAnnotate (_, AnnCoCase scrut alts)
 109   = Case (deAnnotate scrut) (deAnnAlts alts)
 110   where
 111     deAnnAlts (AnnCoAlgAlts alts deflt)
 112       = AlgAlts [(con,args,deAnnotate rhs) | (con,args,rhs) <- alts]
 113                  (deAnnDeflt deflt)
 114
 115     deAnnAlts (AnnCoPrimAlts alts deflt)
 116       = PrimAlts [(lit,deAnnotate rhs) | (lit,rhs) <- alts]
 117                    (deAnnDeflt deflt)
 118
 119     deAnnDeflt AnnCoNoDefault         = NoDefault
 120     deAnnDeflt (AnnCoBindDefault var rhs) = BindDefault var (deAnnotate rhs)
 121 \end{code}