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 module AnnCoreSyn (
  12         AnnCoreBinding(..), AnnCoreExpr,
  13         AnnCoreExpr'(..),       -- v sad that this must be exported
  14         AnnCoreCaseAlts(..), AnnCoreCaseDefault(..),
  15
  16         deAnnotate -- we may eventually export some of the other deAnners
  17     ) where
  18
  19 #include "HsVersions.h"
  20
  21 import CoreSyn
  22
  23 import Id         ( Id )
  24 import Literal    ( Literal )
  25 import PrimOp     ( PrimOp )
  26 import CostCentre ( CostCentre )
  27 import Type       ( GenType )
  28
  29 \end{code}
  30
  31 \begin{code}
  32 data AnnCoreBinding val_bdr val_occ flexi annot
  33   = AnnNonRec val_bdr (AnnCoreExpr val_bdr val_occ flexi annot)
  34   | AnnRec    [(val_bdr, AnnCoreExpr val_bdr val_occ flexi annot)]
  35 \end{code}
  36
  37 \begin{code}
  38 type AnnCoreExpr val_bdr val_occ flexi annot
  39   = (annot, AnnCoreExpr' val_bdr val_occ flexi annot)
  40
  41 data AnnCoreExpr' val_bdr val_occ flexi annot
  42   = AnnVar      val_occ
  43   | AnnLit      Literal
  44
  45   | AnnCon      Id     [GenCoreArg val_occ flexi]
  46   | AnnPrim     PrimOp [GenCoreArg val_occ flexi]
  47
  48   | AnnLam      (GenCoreBinder val_bdr flexi)
  49                 (AnnCoreExpr val_bdr val_occ flexi annot)
  50
  51   | AnnApp      (AnnCoreExpr val_bdr val_occ flexi annot)
  52                 (GenCoreArg  val_occ flexi)
  53
  54   | AnnCase     (AnnCoreExpr val_bdr val_occ flexi annot)
  55                 (AnnCoreCaseAlts val_bdr val_occ flexi annot)
  56
  57   | AnnLet      (AnnCoreBinding val_bdr val_occ flexi annot)
  58                 (AnnCoreExpr val_bdr val_occ flexi annot)
  59
  60   | AnnSCC      CostCentre
  61                 (AnnCoreExpr val_bdr val_occ flexi annot)
  62
  63   | AnnCoerce   Coercion
  64                 (GenType flexi)
  65                 (AnnCoreExpr val_bdr val_occ flexi annot)
  66 \end{code}
  67
  68 \begin{code}
  69 data AnnCoreCaseAlts val_bdr val_occ flexi annot
  70   = AnnAlgAlts  [(Id,
  71                   [val_bdr],
  72                   AnnCoreExpr val_bdr val_occ flexi annot)]
  73                 (AnnCoreCaseDefault val_bdr val_occ flexi annot)
  74   | AnnPrimAlts [(Literal,
  75                   AnnCoreExpr val_bdr val_occ flexi annot)]
  76                 (AnnCoreCaseDefault val_bdr val_occ flexi annot)
  77
  78 data AnnCoreCaseDefault val_bdr val_occ flexi annot
  79   = AnnNoDefault
  80   | AnnBindDefault  val_bdr
  81                     (AnnCoreExpr val_bdr val_occ flexi annot)
  82 \end{code}
  83
  84 \begin{code}
  85 deAnnotate :: AnnCoreExpr val_bdr val_occ flexi ann
  86            -> GenCoreExpr val_bdr val_occ flexi
  87
  88 deAnnotate (_, AnnVar   v)          = Var v
  89 deAnnotate (_, AnnLit   lit)        = Lit lit
  90 deAnnotate (_, AnnCon   con args)   = Con con args
  91 deAnnotate (_, AnnPrim  op args)    = Prim op args
  92 deAnnotate (_, AnnLam   binder body)= Lam binder (deAnnotate body)
  93 deAnnotate (_, AnnApp   fun arg)    = App (deAnnotate fun) arg
  94 deAnnotate (_, AnnSCC   lbl body)   = SCC lbl (deAnnotate body)
  95 deAnnotate (_, AnnCoerce c ty body) = Coerce c ty (deAnnotate body)
  96
  97 deAnnotate (_, AnnLet bind body)
  98   = Let (deAnnBind bind) (deAnnotate body)
  99   where
 100     deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
 101     deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
 102
 103 deAnnotate (_, AnnCase scrut alts)
 104   = Case (deAnnotate scrut) (deAnnAlts alts)
 105   where
 106     deAnnAlts (AnnAlgAlts alts deflt)
 107       = AlgAlts [(con,args,deAnnotate rhs) | (con,args,rhs) <- alts]
 108                  (deAnnDeflt deflt)
 109
 110     deAnnAlts (AnnPrimAlts alts deflt)
 111       = PrimAlts [(lit,deAnnotate rhs) | (lit,rhs) <- alts]
 112                    (deAnnDeflt deflt)
 113
 114     deAnnDeflt AnnNoDefault             = NoDefault
 115     deAnnDeflt (AnnBindDefault var rhs) = BindDefault var (deAnnotate rhs)
 116 \end{code}