From f6c3618186068097765dca11414e3383f2b71ba5 Mon Sep 17 00:00:00 2001 From: simonpj Date: Tue, 7 Jan 1997 01:17:45 +0000 Subject: [PATCH] [project @ 1997-01-07 01:17:30 by simonpj] Bug fixes to pragmas --- ghc/compiler/basicTypes/Name.lhs | 16 +++++++++++----- ghc/compiler/hsSyn/HsBinds.lhs | 8 ++++---- ghc/compiler/hsSyn/HsExpr.lhs | 8 ++++---- ghc/compiler/hsSyn/HsPat.lhs | 2 +- ghc/compiler/rename/ParseIface.y | 2 +- ghc/compiler/rename/RnNames.lhs | 6 +++--- ghc/lib/Makefile.libHS | 23 ++++++++++++++++++++++- ghc/lib/ghc/ArrBase.lhs | 2 +- ghc/lib/ghc/PrelList.lhs | 2 +- ghc/lib/ghc/PrelNum.lhs | 2 +- ghc/lib/ghc/PrelRead.lhs | 2 +- ghc/lib/ghc/PrelTup.lhs | 2 +- ghc/lib/glaExts/PackedString.lhs | 2 +- ghc/lib/required/Ix.lhs | 2 +- 14 files changed, 53 insertions(+), 26 deletions(-) diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs index 824d7a5..593d61b 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 -- 1.7.10.4