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 IMP_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
  58   | AnnCoerce   Coercion
  59                 (GenType tyvar uvar)
  60                 (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
  61 \end{code}
  62
  63 \begin{code}
  64 data AnnCoreCaseAlts val_bdr val_occ tyvar uvar annot
  65   = AnnAlgAlts  [(Id,
  66                   [val_bdr],
  67                   AnnCoreExpr val_bdr val_occ tyvar uvar annot)]
  68                 (AnnCoreCaseDefault val_bdr val_occ tyvar uvar annot)
  69   | AnnPrimAlts [(Literal,
  70                   AnnCoreExpr val_bdr val_occ tyvar uvar annot)]
  71                 (AnnCoreCaseDefault val_bdr val_occ tyvar uvar annot)
  72
  73 data AnnCoreCaseDefault val_bdr val_occ tyvar uvar annot
  74   = AnnNoDefault
  75   | AnnBindDefault  val_bdr
  76                     (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
  77 \end{code}
  78
  79 \begin{code}
  80 deAnnotate :: AnnCoreExpr val_bdr val_occ tyvar uvar ann
  81            -> GenCoreExpr val_bdr val_occ tyvar uvar
  82
  83 deAnnotate (_, AnnVar   v)          = Var v
  84 deAnnotate (_, AnnLit   lit)        = Lit lit
  85 deAnnotate (_, AnnCon   con args)   = Con con args
  86 deAnnotate (_, AnnPrim  op args)    = Prim op args
  87 deAnnotate (_, AnnLam   binder body)= Lam binder (deAnnotate body)
  88 deAnnotate (_, AnnApp   fun arg)    = App (deAnnotate fun) arg
  89 deAnnotate (_, AnnSCC   lbl body)   = SCC lbl (deAnnotate body)
  90 deAnnotate (_, AnnCoerce c ty body) = Coerce c ty (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}