[project @ 2005-01-26 15:04:08 by simonmar]

[ghc-hetmet.git] / ghc / compiler / iface / IfaceSyn.lhs

diff --git a/ghc/compiler/iface/IfaceSyn.lhs b/ghc/compiler/iface/IfaceSyn.lhs
index 6a0a1c7..c6a8eb2 100644 (file)
--- a/ghc/compiler/iface/IfaceSyn.lhs
+++ b/ghc/compiler/iface/IfaceSyn.lhs
@@ -53,16 +53,16 @@ import TyCon                ( TyCon, ArgVrcs, AlgTyConRhs(..), isRecursiveTyCon, isForeignTyCo
                          isSynTyCon, isAlgTyCon, isPrimTyCon, isFunTyCon,
                          isTupleTyCon, tupleTyConBoxity,
                          tyConHasGenerics, tyConArgVrcs, getSynTyConDefn,
-                         tyConArity, tyConTyVars, algTcRhs, tyConExtName  )
+                         tyConArity, tyConTyVars, algTyConRhs, tyConExtName  )
 import DataCon         ( dataConName, dataConSig, dataConFieldLabels, dataConStrictMarks,
                          dataConTyCon, dataConIsInfix, isVanillaDataCon )
 import Class           ( FunDep, DefMeth, classExtraBigSig, classTyCon )
 import OccName         ( OccName, OccEnv, lookupOccEnv, emptyOccEnv, 
                          lookupOccEnv, extendOccEnv, emptyOccEnv,
                          OccSet, unionOccSets, unitOccSet )
-import Name            ( Name, NamedThing(..), getOccName, nameOccName, nameModuleName, isExternalName )
+import Name            ( Name, NamedThing(..), getOccName, nameOccName, nameModule, isExternalName )
 import NameSet         ( NameSet, elemNameSet )
-import Module          ( ModuleName )
+import Module          ( Module )
 import CostCentre      ( CostCentre, pprCostCentreCore )
 import Literal         ( Literal )
 import ForeignCall     ( ForeignCall )
@@ -446,6 +446,10 @@ ppr_hs_info (HsWorker w a) = ptext SLIT("Worker:") <+> ppr w <+> int a
 tyThingToIfaceDecl :: Bool 
                   -> NameSet           -- Tycons and classes to export abstractly
                   -> (Name -> IfaceExtName) -> TyThing -> IfaceDecl
+-- Assumption: the thing is already tidied, so that locally-bound names
+--            (lambdas, for-alls) already have non-clashing OccNames
+-- Reason: Iface stuff uses OccNames, and the conversion here does
+--        not do tidying on the way
 tyThingToIfaceDecl discard_id_info _ ext (AnId id)
   = IfaceId { ifName   = getOccName id, 
              ifType   = toIfaceType ext (idType id),
@@ -490,7 +494,7 @@ tyThingToIfaceDecl _ abstract_tcs ext (ATyCon tycon)
   | isAlgTyCon tycon
   = IfaceData {        ifName    = getOccName tycon,
                ifTyVars  = toIfaceTvBndrs tyvars,
-               ifCons    = ifaceConDecls (algTcRhs tycon),
+               ifCons    = ifaceConDecls (algTyConRhs tycon),
                ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
                ifVrcs    = tyConArgVrcs tycon,
                ifGeneric = tyConHasGenerics tycon }
@@ -558,7 +562,7 @@ dfunToIfaceInst dfun_id
                ifInstHead = toIfaceType (mkLhsNameFn mod) tidy_ty }
   where
     dfun_name = idName dfun_id
-    mod = nameModuleName dfun_name
+    mod = nameModule dfun_name
     (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
     head_ty = mkForAllTys tvs (mkPredTy (mkClassPred cls tys))
        -- No need to record the instance context; 
@@ -617,15 +621,15 @@ toIfaceIdInfo ext id_info
                  | otherwise   = Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
 
 --------------------------
-coreRuleToIfaceRule :: ModuleName -> (Name -> IfaceExtName) -> IdCoreRule -> IfaceRule
-coreRuleToIfaceRule mod ext (id, BuiltinRule _ _)
+coreRuleToIfaceRule :: Module -> (Name -> IfaceExtName) -> IdCoreRule -> IfaceRule
+coreRuleToIfaceRule mod ext (IdCoreRule id _ (BuiltinRule _ _))
   = pprTrace "toHsRule: builtin" (ppr id) (bogusIfaceRule (mkIfaceExtName (getName id)))
 
-coreRuleToIfaceRule mod ext (id, Rule name act bndrs args rhs)
-  = IfaceRule { ifRuleName = name, ifActivation = act, 
+coreRuleToIfaceRule mod ext (IdCoreRule id _ (Rule name act bndrs args rhs))
+  = IfaceRule { ifRuleName  = name, ifActivation = act, 
                ifRuleBndrs = map (toIfaceBndr ext) bndrs,
-               ifRuleHead = ext (idName id), 
-               ifRuleArgs = map (toIfaceExpr (mkLhsNameFn mod)) args,
+               ifRuleHead  = ext (idName id), 
+               ifRuleArgs  = map (toIfaceExpr (mkLhsNameFn mod)) args,
                        -- Use LHS name-fn for the args
                ifRuleRhs = toIfaceExpr ext rhs }
 
@@ -701,12 +705,12 @@ toIfaceVar ext v
 -- mkLhsNameFn ignores versioning info altogether
 -- Used for the LHS of instance decls and rules, where we 
 -- there's no point in recording version info
-mkLhsNameFn :: ModuleName -> Name -> IfaceExtName
+mkLhsNameFn :: Module -> Name -> IfaceExtName
 mkLhsNameFn this_mod name      
   | mod == this_mod = LocalTop occ
   | otherwise      = ExtPkg mod occ
   where
-    mod = nameModuleName name
+    mod = nameModule name
     occ        = nameOccName name
 \end{code}