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

Bug fixes to pragmas

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

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}
 
 %************************************************************************

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 _)

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)

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 }

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

ghc/lib/Makefile.libHS

 #-----------------------------------------------------------------------------
-# $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

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

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
 

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

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

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}
 

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

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