AnnCoreSyn.lhs 3.43 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
3 4 5 6 7 8 9 10 11 12 13 14 15
%
\section[AnnCoreSyntax]{Annotated core syntax}

For when you want @CoreSyntax@ trees annotated at every node.  Other
than that, just like @CoreSyntax@.  (Important to be sure that it {\em
really is} just like @CoreSyntax@.)

\begin{code}
#include "HsVersions.h"

module AnnCoreSyn (
	AnnCoreBinding(..), AnnCoreExpr(..),
	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
    ) where

21 22
import Ubiq{-uitous-}

23 24 25 26
import CoreSyn
\end{code}

\begin{code}
27 28 29
data AnnCoreBinding val_bdr val_occ tyvar uvar annot
  = AnnNonRec val_bdr (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
  | AnnRec    [(val_bdr, AnnCoreExpr val_bdr val_occ tyvar uvar annot)]
30 31 32
\end{code}

\begin{code}
33 34
type AnnCoreExpr val_bdr val_occ tyvar uvar annot
  = (annot, AnnCoreExpr' val_bdr val_occ tyvar uvar annot)
35

36 37 38
data AnnCoreExpr' val_bdr val_occ tyvar uvar annot
  = AnnVar	val_occ
  | AnnLit 	Literal
39

40 41
  | AnnCon	Id     [GenCoreArg val_occ tyvar uvar]
  | AnnPrim	PrimOp [GenCoreArg val_occ tyvar uvar]
42

43 44
  | AnnLam	(GenCoreBinder val_bdr tyvar uvar)
		(AnnCoreExpr val_bdr val_occ tyvar uvar annot)
45

46 47
  | AnnApp	(AnnCoreExpr val_bdr val_occ tyvar uvar annot)
		(GenCoreArg  val_occ tyvar uvar)
48

49 50
  | AnnCase	(AnnCoreExpr val_bdr val_occ tyvar uvar annot)
		(AnnCoreCaseAlts val_bdr val_occ tyvar uvar annot)
51

52 53
  | AnnLet	(AnnCoreBinding val_bdr val_occ tyvar uvar annot)
		(AnnCoreExpr val_bdr val_occ tyvar uvar annot)
54

55 56
  | AnnSCC	CostCentre
		(AnnCoreExpr val_bdr val_occ tyvar uvar annot)
57 58 59 60

  | AnnCoerce	Coercion
		(GenType tyvar uvar)
		(AnnCoreExpr val_bdr val_occ tyvar uvar annot)
61 62 63
\end{code}

\begin{code}
64 65 66 67 68 69 70 71 72 73 74 75 76
data AnnCoreCaseAlts val_bdr val_occ tyvar uvar annot
  = AnnAlgAlts	[(Id,
		  [val_bdr],
		  AnnCoreExpr val_bdr val_occ tyvar uvar annot)]
		(AnnCoreCaseDefault val_bdr val_occ tyvar uvar annot)
  | AnnPrimAlts	[(Literal,
		  AnnCoreExpr val_bdr val_occ tyvar uvar annot)]
		(AnnCoreCaseDefault val_bdr val_occ tyvar uvar annot)

data AnnCoreCaseDefault val_bdr val_occ tyvar uvar annot
  = AnnNoDefault
  | AnnBindDefault  val_bdr
		    (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
77 78 79
\end{code}

\begin{code}
80 81 82 83 84 85 86 87 88 89
deAnnotate :: AnnCoreExpr val_bdr val_occ tyvar uvar ann
	   -> GenCoreExpr val_bdr val_occ tyvar uvar

deAnnotate (_, AnnVar	v)          = Var v
deAnnotate (_, AnnLit	lit)	    = Lit lit
deAnnotate (_, AnnCon	con args)   = Con con args
deAnnotate (_, AnnPrim	op args)    = Prim op args
deAnnotate (_, AnnLam	binder body)= Lam binder (deAnnotate body)
deAnnotate (_, AnnApp	fun arg)    = App (deAnnotate fun) arg
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 96
    deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
    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 104
		 (deAnnDeflt deflt)

105
    deAnnAlts (AnnPrimAlts alts deflt)
106
      = PrimAlts [(lit,deAnnotate rhs) | (lit,rhs) <- alts]
107 108
		   (deAnnDeflt deflt)

109 110
    deAnnDeflt AnnNoDefault 	        = NoDefault
    deAnnDeflt (AnnBindDefault var rhs) = BindDefault var (deAnnotate rhs)
111
\end{code}