[project @ 2003-01-09 11:39:20 by simonmar]
[ghc-hetmet.git] / ghc / compiler / coreSyn / CoreSyn.lhs
index f941deb..12f750f 100644 (file)
@@ -7,7 +7,7 @@
 module CoreSyn (
        Expr(..), Alt, Bind(..), AltCon(..), Arg, Note(..),
        CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
-       TaggedExpr, TaggedAlt, TaggedBind, TaggedArg,
+       TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),
 
        mkLets, mkLams, 
        mkApps, mkTyApps, mkValApps, mkVarApps,
@@ -54,9 +54,10 @@ import CostCentre    ( CostCentre, noCostCentre )
 import Var             ( Var, Id, TyVar, isTyVar, isId )
 import Type            ( Type, mkTyVarTy, seqType )
 import Literal         ( Literal, mkMachInt )
-import DataCon         ( DataCon, dataConId )
+import DataCon         ( DataCon, dataConWorkId )
 import BasicTypes      ( Activation )
 import VarSet
+import FastString
 import Outputable
 \end{code}
 
@@ -165,7 +166,7 @@ rulesRules (Rules rules _) = rules
 \end{code}
 
 \begin{code}
-type RuleName = FAST_STRING
+type RuleName = FastString
 type IdCoreRule = (Id,CoreRule)                -- Rules don't have their leading Id inside them
 
 data CoreRule
@@ -342,12 +343,18 @@ type CoreAlt  = Alt  CoreBndr
 Binders are ``tagged'' with a \tr{t}:
 
 \begin{code}
-type Tagged t = (CoreBndr, t)
+data TaggedBndr t = TB CoreBndr t      -- TB for "tagged binder"
 
-type TaggedBind t = Bind (Tagged t)
-type TaggedExpr t = Expr (Tagged t)
-type TaggedArg  t = Arg  (Tagged t)
-type TaggedAlt  t = Alt  (Tagged t)
+type TaggedBind t = Bind (TaggedBndr t)
+type TaggedExpr t = Expr (TaggedBndr t)
+type TaggedArg  t = Arg  (TaggedBndr t)
+type TaggedAlt  t = Alt  (TaggedBndr t)
+
+instance Outputable b => Outputable (TaggedBndr b) where
+  ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
+
+instance Outputable b => OutputableBndr (TaggedBndr b) where
+  pprBndr _ b = ppr b  -- Simple
 \end{code}
 
 
@@ -376,7 +383,7 @@ mkLets            :: [Bind b] -> Expr b -> Expr b
 mkLams       :: [b] -> Expr b -> Expr b
 
 mkLit lit        = Lit lit
-mkConApp con args = mkApps (Var (dataConId con)) args
+mkConApp con args = mkApps (Var (dataConWorkId con)) args
 
 mkLams binders body = foldr Lam body binders
 mkLets binds body   = foldr Let body binds