Commit f6c36181 authored by simonpj's avatar simonpj
Browse files

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

Bug fixes to pragmas
parent 8f7ac3fe
......@@ -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
......
......@@ -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}
%************************************************************************
......
......@@ -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 _)
......
......@@ -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)
......
......@@ -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 }
......
......@@ -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
......
#-----------------------------------------------------------------------------
# $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
......
......@@ -9,7 +9,7 @@
module ArrBase where
import {#- SOURCE #-} IOBase ( error )
import {-# SOURCE #-} IOBase ( error )
import Ix
import PrelList
import STBase
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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}
......
......@@ -69,7 +69,7 @@ module PackedString (
packCBytesST, unpackCString
) where
import {#- SOURCE #-} IOBase ( error )
import {-# SOURCE #-} IOBase ( error )
import Ix
import PrelList
import STBase
......
......@@ -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
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment