[project @ 1997-01-07 01:17:30 by simonpj]

Bug fixes to pragmas

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index 824d7a5..593d61b 100644 (file)
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -257,8 +257,9 @@ mkInstDeclName uniq mod occ loc from_here
          | otherwise = Implicit
 
 
-setNameProvenance :: Name -> Provenance -> Name                -- Globals only
-setNameProvenance (Global uniq mod occ def _) prov = Global uniq mod occ def prov
+setNameProvenance :: Name -> Provenance -> Name                -- Implicit Globals only
+setNameProvenance (Global uniq mod occ def Implicit) prov = Global uniq mod occ def prov
+setNameProvenance other_name                        prov = other_name
 
 -- When we renumber/rename things, we need to be
 -- able to change a Name's Unique to match the cached
@@ -404,14 +405,19 @@ instance Outputable Name where
     ppr PprForUser (Local _ n _) = ppPStr (occNameString n)
     ppr other_sty  (Local u n _) = ppBesides [ppPStr (occNameString n), ppPStr SLIT("_"), pprUnique u]
 
-    ppr sty (Global u m n _ _) = ppBesides [pp_name, pp_uniq sty u]
+    ppr sty name@(Global u m n _ _) = ppBesides [pp_name, pp_debug sty name]
                               where
                                 pp_name | codeStyle sty = identToC qual_name
                                         | otherwise     = ppPStr qual_name
                                 qual_name = m _APPEND_ SLIT(".") _APPEND_ occNameString n
 
-pp_uniq PprDebug uniq = ppBesides [ppStr "{-", pprUnique uniq, ppStr "-}"]
-pp_uniq other    uniq = ppNil
+pp_debug PprDebug (Global uniq m n _ prov) = ppBesides [ppStr "{-", pprUnique uniq, ppStr ",", 
+                                                       pp_prov prov, ppStr "-}"]
+                                       where
+                                               pp_prov (LocalDef _ _) = ppChar 'l'
+                                               pp_prov (Imported _ _) = ppChar 'i'
+                                               pp_prov Implicit       = ppChar 'p'
+pp_debug other    name                         = ppNil
 
 -- pprNameProvenance is used in error messages to say where a name came from
 pprNameProvenance :: PprStyle -> Name -> Pretty

diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs
index 2c2a687..fd1f1f3 100644 (file)
--- a/ghc/compiler/hsSyn/HsBinds.lhs
+++ b/ghc/compiler/hsSyn/HsBinds.lhs
@@ -154,7 +154,7 @@ data Sig name
 \begin{code}
 instance (NamedThing name, Outputable name) => Outputable (Sig name) where
     ppr sty (Sig var ty _)
-      = ppHang (ppCat [pprNonSym sty var, ppPStr SLIT("::")])
+      = ppHang (ppCat [ppr sty var, ppPStr SLIT("::")])
             4 (ppr sty ty)
 
     ppr sty (ClassOpSig var ty pragmas _)
@@ -270,14 +270,14 @@ instance (NamedThing id, Outputable id, Outputable pat,
       = ppHang (ppr sty pat) 4 (pprGRHSsAndBinds sty False grhss_n_binds)
 
     ppr sty (FunMonoBind fun inf matches locn)
-      = pprMatches sty (False, pprNonSym sty fun) matches
+      = pprMatches sty (False, ppr sty fun) matches
       -- ToDo: print infix if appropriate
 
     ppr sty (VarMonoBind name expr)
-      = ppHang (ppCat [pprNonSym sty name, ppEquals]) 4 (ppr sty expr)
+      = ppHang (ppCat [ppr sty name, ppEquals]) 4 (ppr sty expr)
 
     ppr sty (CoreMonoBind name expr)
-      = ppHang (ppCat [pprNonSym sty name, ppEquals]) 4 (ppr sty expr)
+      = ppHang (ppCat [ppr sty name, ppEquals]) 4 (ppr sty expr)
 \end{code}
 
 %************************************************************************

diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs
index a993d6c..8f6b099 100644 (file)
--- a/ghc/compiler/hsSyn/HsExpr.lhs
+++ b/ghc/compiler/hsSyn/HsExpr.lhs
@@ -193,7 +193,7 @@ instance (NamedThing id, Outputable id, Outputable pat,
 \end{code}
 
 \begin{code}
-pprExpr sty (HsVar v) = pprNonSym sty v
+pprExpr sty (HsVar v) = ppr sty v
 
 pprExpr sty (HsLit    lit)   = ppr sty lit
 pprExpr sty (HsLitOut lit _) = ppr sty lit
@@ -220,7 +220,7 @@ pprExpr sty (OpApp e1 op e2)
       = ppHang (pprExpr sty op) 4 (ppSep [pp_e1, pp_e2])
 
     pp_infixly v
-      = ppSep [pp_e1, ppCat [pprSym sty v, pp_e2]]
+      = ppSep [pp_e1, ppCat [ppr sty v, pp_e2]]
 
 pprExpr sty (NegApp e _)
   = ppBeside (ppChar '-') (pprParendExpr sty e)
@@ -239,7 +239,7 @@ pprExpr sty (SectionL expr op)
                       4 (ppCat [pp_expr, ppStr "x_ )"])
     pp_infixly v
       = ppSep [ ppBeside ppLparen pp_expr,
-               ppBeside (pprSym sty v) ppRparen ]
+               ppBeside (ppr sty v) ppRparen ]
 
 pprExpr sty (SectionR op expr)
   = case op of
@@ -251,7 +251,7 @@ pprExpr sty (SectionR op expr)
     pp_prefixly = ppHang (ppCat [ppStr "( \\ x_ ->", ppr sty op, ppPStr SLIT("x_")])
                       4 (ppBeside pp_expr ppRparen)
     pp_infixly v
-      = ppSep [ ppBeside ppLparen (pprSym sty v),
+      = ppSep [ ppBeside ppLparen (ppr sty v),
                ppBeside pp_expr  ppRparen ]
 
 pprExpr sty (HsCase expr matches _)

diff --git a/ghc/compiler/hsSyn/HsPat.lhs b/ghc/compiler/hsSyn/HsPat.lhs
index 4f6e457..d90dd1e 100644 (file)
--- a/ghc/compiler/hsSyn/HsPat.lhs
+++ b/ghc/compiler/hsSyn/HsPat.lhs
@@ -115,7 +115,7 @@ instance (Outputable name, NamedThing name) => Outputable (InPat name) where
 pprInPat :: (Outputable name, NamedThing name) => PprStyle -> InPat name -> Pretty
 
 pprInPat sty (WildPatIn)       = ppStr "_"
-pprInPat sty (VarPatIn var)    = pprNonSym sty var
+pprInPat sty (VarPatIn var)    = ppr sty var
 pprInPat sty (LitPatIn s)      = ppr sty s
 pprInPat sty (LazyPatIn pat)   = ppBeside (ppChar '~') (ppr sty pat)
 pprInPat sty (AsPatIn name pat)

diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index 1092208..18eeace 100644 (file)
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -291,7 +291,7 @@ class               :: { (RdrName, RdrNameHsType) }
 class          :  qtc_name atype                       { ($1, $2) }
 
 type           :: { RdrNameHsType }
-type           : FORALL forall context DARROW tautype  { mkHsForAllTy $2 $3 $5 }
+type           : FORALL forall context DARROW type     { mkHsForAllTy $2 $3 $5 }
                | tautype                               { $1 }
 
 tautype                :: { RdrNameHsType }

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 5db5ead..51b8424 100644 (file)
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -268,6 +268,8 @@ qualifyImports this_mod qual_imp unqual_imp as_mod (ExportEnv avails fixities)
     foldlRn (add_fixity name_env) emptyFixityEnv fixities      `thenRn` \ fixity_env ->
     returnRn (RnEnv name_env fixity_env, mod_avail_env)
   where
+    show_it (rdr, (fix,prov)) = ppSep [ppLbrack, ppr PprDebug rdr, ppr PprDebug fix, pprProvenance PprDebug prov, ppRbrack]
+
     qual_mod = case as_mod of
                  Nothing           -> this_mod
                  Just another_name -> another_name
@@ -441,9 +443,7 @@ mk_export_fn avails
     exported_names = availsToNameSet avails
 
 export_fixity :: NameEnv -> NameSet -> RdrName -> Bool
-export_fixity name_env exports (Unqual _)
-  = False      -- The qualified fixity is always there as well
-export_fixity name_env exports rdr_name@(Qual _ occ)
+export_fixity name_env exports rdr_name
   = case lookupFM name_env rdr_name of
        Just fixity_name -> fixity_name `elemNameSet` exports
                                -- Check whether the exported thing is

diff --git a/ghc/lib/Makefile.libHS b/ghc/lib/Makefile.libHS
index 1dba5a2..2c24aff 100644 (file)
--- a/ghc/lib/Makefile.libHS
+++ b/ghc/lib/Makefile.libHS
@@ -1,5 +1,5 @@
 #-----------------------------------------------------------------------------
-# $Id: Makefile.libHS,v 1.4 1997/01/06 21:10:03 simonpj Exp $
+# $Id: Makefile.libHS,v 1.5 1997/01/07 01:17:38 simonpj Exp $
 
 TOP = ../..
 include $(TOP)/ghc/mk/ghc.mk
@@ -93,6 +93,27 @@ ghc/PackedString_flags        = '-\#include"cbits/stgio.h"' -monly-3-regs
 required/Directory_flags = '-\#include"cbits/stgio.h"' -monly-3-regs
 required/System_flags   = '-\#include"cbits/stgio.h"'
 
+ghc/ArrBase_flags      = '-fno-implicit-prelude'
+ghc/IOBase_flags       = '-fno-implicit-prelude'
+ghc/IOHandle_flags     = '-fno-implicit-prelude'
+ghc/PrelBase_flags     = '-fno-implicit-prelude'
+ghc/PrelIO_flags       = '-fno-implicit-prelude'
+ghc/PrelList_flags     = '-fno-implicit-prelude'
+ghc/PrelNum_flags      = '-fno-implicit-prelude'
+ghc/PrelRead_flags     = '-fno-implicit-prelude'
+ghc/PrelTup_flags      = '-fno-implicit-prelude'
+ghc/STBase_flags       = '-fno-implicit-prelude'
+glaExts/Foreign_flags  = '-fno-implicit-prelude'
+glaExts/PackedString_flags     = '-fno-implicit-prelude'
+glaExts/ST_flags       = '-fno-implicit-prelude'
+required/Array_flags   = '-fno-implicit-prelude'
+required/Char_flags    = '-fno-implicit-prelude'
+required/IO_flags      = '-fno-implicit-prelude'
+required/Ix_flags      = '-fno-implicit-prelude'
+required/Maybe_flags   = '-fno-implicit-prelude'
+required/Monad_flags   = '-fno-implicit-prelude'
+required/Ratio_flags   = '-fno-implicit-prelude'
+
 concurrent/Merge_flags = -iconcurrent
 concurrent/Parallel_flags = -fglasgow-exts
 concurrent/Concurrent_flags = -iconcurrent

diff --git a/ghc/lib/ghc/ArrBase.lhs b/ghc/lib/ghc/ArrBase.lhs
index 4c134cf..c46aef5 100644 (file)
--- a/ghc/lib/ghc/ArrBase.lhs
+++ b/ghc/lib/ghc/ArrBase.lhs
@@ -9,7 +9,7 @@
 
 module  ArrBase where
 
-import {#- SOURCE #-}  IOBase  ( error )
+import {-# SOURCE #-}  IOBase  ( error )
 import Ix
 import PrelList
 import STBase

diff --git a/ghc/lib/ghc/PrelList.lhs b/ghc/lib/ghc/PrelList.lhs
index e249135..b11aafb 100644 (file)
--- a/ghc/lib/ghc/PrelList.lhs
+++ b/ghc/lib/ghc/PrelList.lhs
@@ -22,7 +22,7 @@ module PrelList (
    zip, zip3, zipWith, zipWith3, unzip, unzip3
  ) where
 
-import {#- SOURCE #-}  IOBase  ( error )
+import {-# SOURCE #-}  IOBase  ( error )
 import PrelTup
 import PrelBase
 

diff --git a/ghc/lib/ghc/PrelNum.lhs b/ghc/lib/ghc/PrelNum.lhs
index 7db21c4..0b081fd 100644 (file)
--- a/ghc/lib/ghc/PrelNum.lhs
+++ b/ghc/lib/ghc/PrelNum.lhs
@@ -18,7 +18,7 @@ It's rather big!
 
 module PrelNum where
 
-import {#- SOURCE #-}  IOBase  ( error )
+import {-# SOURCE #-}  IOBase  ( error )
 import PrelList
 import PrelBase
 import GHC

diff --git a/ghc/lib/ghc/PrelRead.lhs b/ghc/lib/ghc/PrelRead.lhs
index 6f3b8aa..683c42b 100644 (file)
--- a/ghc/lib/ghc/PrelRead.lhs
+++ b/ghc/lib/ghc/PrelRead.lhs
@@ -11,7 +11,7 @@ The @Read@ class and many of its instances.
 
 module PrelRead where
 
-import {#- SOURCE #-}  IOBase  ( error )
+import {-# SOURCE #-}  IOBase  ( error )
 import PrelNum
 import PrelList
 import PrelTup

diff --git a/ghc/lib/ghc/PrelTup.lhs b/ghc/lib/ghc/PrelTup.lhs
index 0935611..842fd1b 100644 (file)
--- a/ghc/lib/ghc/PrelTup.lhs
+++ b/ghc/lib/ghc/PrelTup.lhs
@@ -11,7 +11,7 @@ This modules defines the typle data types.
 
 module PrelTup where
 
-import {#- SOURCE #-}  IOBase  ( error )
+import {-# SOURCE #-}  IOBase  ( error )
 import PrelBase
 \end{code}
 

diff --git a/ghc/lib/glaExts/PackedString.lhs b/ghc/lib/glaExts/PackedString.lhs
index 989316c..2159874 100644 (file)
--- a/ghc/lib/glaExts/PackedString.lhs
+++ b/ghc/lib/glaExts/PackedString.lhs
@@ -69,7 +69,7 @@ module PackedString (
        packCBytesST, unpackCString
     ) where
 
-import {#- SOURCE #-}  IOBase  ( error )
+import {-# SOURCE #-}  IOBase  ( error )
 import Ix
 import PrelList
 import STBase

diff --git a/ghc/lib/required/Ix.lhs b/ghc/lib/required/Ix.lhs
index e57c3f6..c68546f 100644 (file)
--- a/ghc/lib/required/Ix.lhs
+++ b/ghc/lib/required/Ix.lhs
@@ -11,7 +11,7 @@ module Ix (
        Ix(range, index, inRange)
   ) where
 
-import {#- SOURCE #-}  IOBase  ( error )
+import {-# SOURCE #-}  IOBase  ( error )
 import PrelNum
 import PrelTup
 import PrelBase