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   | AnnNote     (CoreNote flexi)
  61                 (AnnCoreExpr val_bdr val_occ flexi annot)
  62 \end{code}
  63
  64 \begin{code}
  65 data AnnCoreCaseAlts val_bdr val_occ flexi annot
  66   = AnnAlgAlts  [(Id,
  67                   [val_bdr],
  68                   AnnCoreExpr val_bdr val_occ flexi annot)]
  69                 (AnnCoreCaseDefault val_bdr val_occ flexi annot)
  70   | AnnPrimAlts [(Literal,
  71                   AnnCoreExpr val_bdr val_occ flexi annot)]
  72                 (AnnCoreCaseDefault val_bdr val_occ flexi annot)
  73
  74 data AnnCoreCaseDefault val_bdr val_occ flexi annot
  75   = AnnNoDefault
  76   | AnnBindDefault  val_bdr
  77                     (AnnCoreExpr val_bdr val_occ flexi annot)
  78 \end{code}
  79
  80 \begin{code}
  81 deAnnotate :: AnnCoreExpr val_bdr val_occ flexi ann
  82            -> GenCoreExpr val_bdr val_occ flexi
  83
  84 deAnnotate (_, AnnVar   v)          = Var v
  85 deAnnotate (_, AnnLit   lit)        = Lit lit
  86 deAnnotate (_, AnnCon   con args)   = Con con args
  87 deAnnotate (_, AnnPrim  op args)    = Prim op args
  88 deAnnotate (_, AnnLam   binder body)= Lam binder (deAnnotate body)
  89 deAnnotate (_, AnnApp   fun arg)    = App (deAnnotate fun) arg
  90 deAnnotate (_, AnnNote  note body)  = Note note (deAnnotate body)
  91
  92 deAnnotate (_, AnnLet bind body)
  93   = Let (deAnnBind bind) (deAnnotate body)
  94   where
  95     deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
  96     deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
  97
  98 deAnnotate (_, AnnCase scrut alts)
  99   = Case (deAnnotate scrut) (deAnnAlts alts)
 100   where
 101     deAnnAlts (AnnAlgAlts alts deflt)
 102       = AlgAlts [(con,args,deAnnotate rhs) | (con,args,rhs) <- alts]
 103                  (deAnnDeflt deflt)
 104
 105     deAnnAlts (AnnPrimAlts alts deflt)
 106       = PrimAlts [(lit,deAnnotate rhs) | (lit,rhs) <- alts]
 107                    (deAnnDeflt deflt)
 108
 109     deAnnDeflt AnnNoDefault             = NoDefault
 110     deAnnDeflt (AnnBindDefault var rhs) = BindDefault var (deAnnotate rhs)
 111 \end{code}