2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[AnnCoreSyntax]{Annotated core syntax}
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@.)
11 #include "HsVersions.h"
14 AnnCoreBinding(..), AnnCoreExpr(..),
15 AnnCoreExpr'(..), -- v sad that this must be exported
16 AnnCoreCaseAlts(..), AnnCoreCaseDefault(..),
18 deAnnotate -- we may eventually export some of the other deAnners
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)]
33 type AnnCoreExpr val_bdr val_occ tyvar uvar annot
34 = (annot, AnnCoreExpr' val_bdr val_occ tyvar uvar annot)
36 data AnnCoreExpr' val_bdr val_occ tyvar uvar annot
40 | AnnCon Id [GenCoreArg val_occ tyvar uvar]
41 | AnnPrim PrimOp [GenCoreArg val_occ tyvar uvar]
43 | AnnLam (GenCoreBinder val_bdr tyvar uvar)
44 (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
46 | AnnApp (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
47 (GenCoreArg val_occ tyvar uvar)
49 | AnnCase (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
50 (AnnCoreCaseAlts val_bdr val_occ tyvar uvar annot)
52 | AnnLet (AnnCoreBinding val_bdr val_occ tyvar uvar annot)
53 (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
56 (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
60 data AnnCoreCaseAlts val_bdr val_occ tyvar uvar annot
63 AnnCoreExpr val_bdr val_occ tyvar uvar annot)]
64 (AnnCoreCaseDefault val_bdr val_occ tyvar uvar annot)
65 | AnnPrimAlts [(Literal,
66 AnnCoreExpr val_bdr val_occ tyvar uvar annot)]
67 (AnnCoreCaseDefault val_bdr val_occ tyvar uvar annot)
69 data AnnCoreCaseDefault val_bdr val_occ tyvar uvar annot
71 | AnnBindDefault val_bdr
72 (AnnCoreExpr val_bdr val_occ tyvar uvar annot)
76 deAnnotate :: AnnCoreExpr val_bdr val_occ tyvar uvar ann
77 -> GenCoreExpr val_bdr val_occ tyvar uvar
79 deAnnotate (_, AnnVar v) = Var v
80 deAnnotate (_, AnnLit lit) = Lit lit
81 deAnnotate (_, AnnCon con args) = Con con args
82 deAnnotate (_, AnnPrim op args) = Prim op args
83 deAnnotate (_, AnnLam binder body)= Lam binder (deAnnotate body)
84 deAnnotate (_, AnnApp fun arg) = App (deAnnotate fun) arg
85 deAnnotate (_, AnnSCC lbl body) = SCC lbl (deAnnotate body)
87 deAnnotate (_, AnnLet bind body)
88 = Let (deAnnBind bind) (deAnnotate body)
90 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
91 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
93 deAnnotate (_, AnnCase scrut alts)
94 = Case (deAnnotate scrut) (deAnnAlts alts)
96 deAnnAlts (AnnAlgAlts alts deflt)
97 = AlgAlts [(con,args,deAnnotate rhs) | (con,args,rhs) <- alts]
100 deAnnAlts (AnnPrimAlts alts deflt)
101 = PrimAlts [(lit,deAnnotate rhs) | (lit,rhs) <- alts]
104 deAnnDeflt AnnNoDefault = NoDefault
105 deAnnDeflt (AnnBindDefault var rhs) = BindDefault var (deAnnotate rhs)