Commit 8de16184 authored by simonpj's avatar simonpj
Browse files

[project @ 1997-01-18 10:03:27 by simonpj]

More polishing by Simon; to get nofib to run!
parent fa44695e
......@@ -113,6 +113,7 @@ module Unique (
liftTyConKey,
listTyConKey,
ltDataConKey,
mainKey, mainPrimIoKey,
monadClassKey,
monadPlusClassKey,
monadZeroClassKey,
......@@ -669,4 +670,7 @@ thenMClassOpKey = mkPreludeMiscIdUnique 63 -- (>>=)
unboundKey = mkPreludeMiscIdUnique 64 -- Just a place holder for unbound
-- variables produced by the renamer
fromEnumClassOpKey = mkPreludeMiscIdUnique 65
mainKey = mkPreludeMiscIdUnique 66
mainPrimIoKey = mkPreludeMiscIdUnique 67
\end{code}
......@@ -267,7 +267,7 @@ ppr_expr pe expr@(Lam _ _)
(uvars, tyvars, vars, body) = collectBinders expr
in
ppHang (ppCat [pp_vars SLIT("/u\\") (pUVar pe) uvars,
pp_vars SLIT("/\\") (pTyVarB pe) tyvars,
pp_vars SLIT("_/\\_") (pTyVarB pe) tyvars,
pp_vars SLIT("\\") (pMinBndr pe) vars])
4 (ppr_expr pe body)
where
......@@ -393,7 +393,7 @@ ppr_default pe (BindDefault val_bdr expr)
\begin{code}
ppr_arg pe (LitArg lit) = pLit pe lit
ppr_arg pe (VarArg v) = pOcc pe v
ppr_arg pe (TyArg ty) = ppStr "@ " `ppBeside` pTy pe ty
ppr_arg pe (TyArg ty) = ppStr "_@_ " `ppBeside` pTy pe ty
ppr_arg pe (UsageArg use) = pUse pe use
\end{code}
......@@ -405,9 +405,8 @@ pprBigCoreBinder sty binder
= ppAboves [sig, pragmas, ppr sty binder]
where
sig = ifnotPprShowAll sty (
ppHang (ppCat [ppr sty binder, ppStr "::"])
ppHang (ppCat [ppr sty binder, ppDcolon])
4 (ppr sty (idType binder)))
pragmas =
ifnotPprForUser sty
(ppIdInfo sty False{-no specs, thanks-} (getIdInfo binder))
......@@ -424,5 +423,9 @@ pprBabyCoreBinder sty binder
-- ppStr ("{- " ++ (showList xx "") ++ " -}")
pprTypedCoreBinder sty binder
= ppBesides [ppr sty binder, ppStr "::", pprParendGenType sty (idType binder)]
= ppBesides [ppr sty binder, ppDcolon, pprParendGenType sty (idType binder)]
ppDcolon = ppStr " :: "
-- The space before the :: is important; it helps the lexer
-- when reading inferfaces. Otherwise it would lex "a::b" as one thing.
\end{code}
......@@ -13,7 +13,7 @@ IMPORT_DELOOPER(DsLoop) -- partly to get dsBinds, partly to chk dsExpr
import HsSyn ( failureFreePat,
HsExpr(..), OutPat(..), HsLit(..), ArithSeqInfo(..),
Stmt(..), Match(..), Qualifier, HsBinds, HsType,
Stmt(..), Match(..), Qualifier, HsBinds, HsType, Fixity,
GRHSsAndBinds
)
import TcHsSyn ( SYN_IE(TypecheckedHsExpr), SYN_IE(TypecheckedHsBinds),
......@@ -188,8 +188,8 @@ dsExpr expr@(HsLam a_Match)
= matchWrapper LambdaMatch [a_Match] "lambda" `thenDs` \ (binders, matching_code) ->
returnDs ( mkValLam binders matching_code )
dsExpr expr@(HsApp e1 e2) = dsApp expr []
dsExpr expr@(OpApp e1 op e2) = dsApp expr []
dsExpr expr@(HsApp e1 e2) = dsApp expr []
dsExpr expr@(OpApp e1 op _ e2) = dsApp expr []
\end{code}
Operator sections. At first it looks as if we can convert
......@@ -549,7 +549,7 @@ dsApp (HsApp e1 e2) args
= dsExpr e2 `thenDs` \ core_e2 ->
dsApp e1 (VarArg core_e2 : args)
dsApp (OpApp e1 op e2) args
dsApp (OpApp e1 op _ e2) args
= dsExpr e1 `thenDs` \ core_e1 ->
dsExpr e2 `thenDs` \ core_e2 ->
dsApp op (VarArg core_e1 : VarArg core_e2 : args)
......
......@@ -30,7 +30,7 @@ module DsUtils (
IMP_Ubiq()
IMPORT_DELOOPER(DsLoop) ( match, matchSimply )
import HsSyn ( HsExpr(..), OutPat(..), HsLit(..),
import HsSyn ( HsExpr(..), OutPat(..), HsLit(..), Fixity,
Match, HsBinds, Stmt, Qualifier, HsType, ArithSeqInfo )
import TcHsSyn ( SYN_IE(TypecheckedPat) )
import DsHsSyn ( outPatType )
......
......@@ -11,7 +11,7 @@ module MatchLit ( matchLiterals ) where
IMP_Ubiq()
IMPORT_DELOOPER(DsLoop) -- break match-ish and dsExpr-ish loops
import HsSyn ( HsLit(..), OutPat(..), HsExpr(..),
import HsSyn ( HsLit(..), OutPat(..), HsExpr(..), Fixity,
Match, HsBinds, Stmt, Qualifier, HsType, ArithSeqInfo )
import TcHsSyn ( SYN_IE(TypecheckedHsExpr), SYN_IE(TypecheckedHsBinds),
SYN_IE(TypecheckedPat)
......
......@@ -6,7 +6,7 @@
\begin{code}
#include "HsVersions.h"
module HsLit where
module HsBasic where
IMP_Ubiq(){-uitous-}
IMPORT_1_3(Ratio(Rational))
......@@ -14,6 +14,23 @@ IMPORT_1_3(Ratio(Rational))
import Pretty
\end{code}
%************************************************************************
%* *
\subsection[Version]{Module and identifier version numbers}
%* *
%************************************************************************
\begin{code}
type Version = Int
\end{code}
%************************************************************************
%* *
\subsection[HsLit]{Literals}
%* *
%************************************************************************
\begin{code}
data HsLit
= HsChar Char -- characters
......@@ -59,3 +76,27 @@ instance Outputable HsLit where
ppr sty (HsIntPrim i) = ppBeside (ppInteger i) (ppChar '#')
ppr sty (HsLitLit s) = ppBesides [ppStr "``", ppPStr s, ppStr "''"]
\end{code}
%************************************************************************
%* *
\subsection[Fixity]{Fixity info}
%* *
%************************************************************************
\begin{code}
data Fixity = Fixity Int FixityDirection
data FixityDirection = InfixL | InfixR | InfixN
deriving(Eq)
instance Outputable Fixity where
ppr sty (Fixity prec dir) = ppBesides [ppr sty dir, ppSP, ppInt prec]
instance Outputable FixityDirection where
ppr sty InfixL = ppStr "infixl"
ppr sty InfixR = ppStr "infixr"
ppr sty InfixN = ppStr "infix"
instance Eq Fixity where -- Used to determine if two fixities conflict
(Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
\end{code}
......@@ -22,6 +22,7 @@ import HsTypes
import IdInfo
import SpecEnv ( SpecEnv )
import HsCore ( UfExpr )
import HsBasic ( Fixity )
-- others:
import Name ( pprSym, pprNonSym, getOccName, OccName )
......@@ -86,26 +87,6 @@ instance Outputable name => Outputable (FixityDecl name) where
ppr sty (FixityDecl name fixity loc) = ppSep [ppr sty fixity, ppr sty name]
\end{code}
It's convenient to keep the source location in the @Fixity@; it makes error reporting
in the renamer easier.
\begin{code}
data Fixity = Fixity Int FixityDirection
data FixityDirection = InfixL | InfixR | InfixN
deriving(Eq)
instance Outputable Fixity where
ppr sty (Fixity prec dir) = ppBesides [ppr sty dir, ppSP, ppInt prec]
instance Outputable FixityDirection where
ppr sty InfixL = ppStr "infixl"
ppr sty InfixR = ppStr "infixr"
ppr sty InfixN = ppStr "infix"
instance Eq Fixity where -- Used to determine if two fixities conflict
(Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
\end{code}
%************************************************************************
%* *
......@@ -252,7 +233,10 @@ instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where
pp_field (ns, ty) = ppCat [ppCat (map (ppr sty . getOccName) ns),
ppPStr SLIT("::"), ppr_bang sty ty]
ppr_bang sty (Banged ty) = ppBeside (ppChar '!') (pprParendHsType sty ty)
ppr_bang sty (Banged ty) = ppBeside (ppStr "! ") (pprParendHsType sty ty)
-- The extra space helps the lexical analyser that lexes
-- interface files; it doesn't make the rigid operator/identifier
-- distinction, so "!a" is a valid identifier so far as it is concerned
ppr_bang sty (Unbanged ty) = pprParendHsType sty ty
\end{code}
......
......@@ -13,7 +13,7 @@ IMPORT_DELOOPER(HsLoop) -- for paranoia checking
-- friends:
import HsBinds ( HsBinds )
import HsLit ( HsLit )
import HsBasic ( HsLit, Fixity(..), FixityDirection(..) )
import HsMatches ( pprMatches, pprMatch, Match )
import HsTypes ( HsType )
......@@ -54,6 +54,7 @@ data HsExpr tyvar uvar id pat
| OpApp (HsExpr tyvar uvar id pat) -- left operand
(HsExpr tyvar uvar id pat) -- operator
Fixity -- Renamer adds fixity; bottom until then
(HsExpr tyvar uvar id pat) -- right operand
-- We preserve prefix negation and parenthesis for the precedence parser.
......@@ -208,13 +209,13 @@ pprExpr sty expr@(HsApp e1 e2)
collect_args (HsApp fun arg) args = collect_args fun (arg:args)
collect_args fun args = (fun, args)
pprExpr sty (OpApp e1 op e2)
pprExpr sty (OpApp e1 op fixity e2)
= case op of
HsVar v -> pp_infixly v
_ -> pp_prefixly
where
pp_e1 = pprExpr sty e1
pp_e2 = pprExpr sty e2
pp_e1 = pprParendExpr sty e1 -- Add parens to make precedence clear
pp_e2 = pprParendExpr sty e2
pp_prefixly
= ppHang (pprExpr sty op) 4 (ppSep [pp_e1, pp_e2])
......@@ -374,10 +375,13 @@ pprParendExpr sty expr
case expr of
HsLit l -> ppr sty l
HsLitOut l _ -> ppr sty l
HsVar _ -> pp_as_was
ExplicitList _ -> pp_as_was
ExplicitListOut _ _ -> pp_as_was
ExplicitTuple _ -> pp_as_was
HsPar _ -> pp_as_was
_ -> ppParens pp_as_was
\end{code}
......
......@@ -20,7 +20,7 @@ module HsPat (
IMP_Ubiq()
-- friends:
import HsLit ( HsLit )
import HsBasic ( HsLit, Fixity )
IMPORT_DELOOPER(HsLoop) ( HsExpr )
-- others:
......@@ -47,6 +47,7 @@ data InPat name
[InPat name]
| ConOpPatIn (InPat name)
name
Fixity -- c.f. OpApp in HsExpr
(InPat name)
-- We preserve prefix negation and parenthesis for the precedence parser.
......@@ -127,7 +128,7 @@ pprInPat sty (ConPatIn c pats)
else
ppCat [ppr sty c, interppSP sty pats] -- ParPats put in the parens
pprInPat sty (ConOpPatIn pat1 op pat2)
pprInPat sty (ConOpPatIn pat1 op fixity pat2)
= ppCat [ppr sty pat1, ppr sty op, ppr sty pat2] -- ParPats put in parens
-- ToDo: use pprSym to print op (but this involves fiddling various
......@@ -290,16 +291,16 @@ collected is important; see @HsBinds.lhs@.
\begin{code}
collectPatBinders :: InPat a -> [a]
collectPatBinders WildPatIn = []
collectPatBinders (VarPatIn var) = [var]
collectPatBinders (LitPatIn _) = []
collectPatBinders (LazyPatIn pat) = collectPatBinders pat
collectPatBinders (AsPatIn a pat) = a : collectPatBinders pat
collectPatBinders (ConPatIn c pats) = concat (map collectPatBinders pats)
collectPatBinders (ConOpPatIn p1 c p2)= collectPatBinders p1 ++ collectPatBinders p2
collectPatBinders (NegPatIn pat) = collectPatBinders pat
collectPatBinders (ParPatIn pat) = collectPatBinders pat
collectPatBinders (ListPatIn pats) = concat (map collectPatBinders pats)
collectPatBinders (TuplePatIn pats) = concat (map collectPatBinders pats)
collectPatBinders (RecPatIn c fields) = concat (map (\ (f,pat,_) -> collectPatBinders pat) fields)
collectPatBinders WildPatIn = []
collectPatBinders (VarPatIn var) = [var]
collectPatBinders (LitPatIn _) = []
collectPatBinders (LazyPatIn pat) = collectPatBinders pat
collectPatBinders (AsPatIn a pat) = a : collectPatBinders pat
collectPatBinders (ConPatIn c pats) = concat (map collectPatBinders pats)
collectPatBinders (ConOpPatIn p1 c f p2) = collectPatBinders p1 ++ collectPatBinders p2
collectPatBinders (NegPatIn pat) = collectPatBinders pat
collectPatBinders (ParPatIn pat) = collectPatBinders pat
collectPatBinders (ListPatIn pats) = concat (map collectPatBinders pats)
collectPatBinders (TuplePatIn pats) = concat (map collectPatBinders pats)
collectPatBinders (RecPatIn c fields) = concat (map (\ (f,pat,_) -> collectPatBinders pat) fields)
\end{code}
......@@ -20,7 +20,7 @@ module HsSyn (
EXP_MODULE(HsDecls) ,
EXP_MODULE(HsExpr) ,
EXP_MODULE(HsImpExp) ,
EXP_MODULE(HsLit) ,
EXP_MODULE(HsBasic) ,
EXP_MODULE(HsMatches) ,
EXP_MODULE(HsPat) ,
EXP_MODULE(HsTypes)
......@@ -32,14 +32,14 @@ IMP_Ubiq()
import HsBinds
import HsDecls ( HsDecl(..), TyDecl(..), InstDecl(..), ClassDecl(..),
DefaultDecl(..),
FixityDecl(..), Fixity(..), FixityDirection(..),
FixityDecl(..),
ConDecl(..), BangType(..),
IfaceSig(..), HsIdInfo, SpecDataSig(..), SpecInstSig(..),
hsDeclName
)
import HsExpr
import HsImpExp
import HsLit
import HsBasic
import HsMatches
import HsPat
import HsTypes
......@@ -63,8 +63,6 @@ instance Outputable Fake
All we actually declare here is the top-level structure for a module.
\begin{code}
type Version = Int
data HsModule tyvar uvar name pat
= HsModule
Module -- module name
......
......@@ -34,6 +34,7 @@ module CmdLineOpts (
opt_D_dump_realC,
opt_D_dump_rn,
opt_D_dump_simpl,
opt_D_dump_simpl_iterations,
opt_D_dump_spec,
opt_D_dump_stg,
opt_D_dump_stranal,
......@@ -56,6 +57,7 @@ module CmdLineOpts (
opt_GranMacros,
opt_Haskell_1_3,
opt_HiMap,
opt_HiSuffix,
opt_IgnoreIfacePragmas,
opt_IgnoreStrictnessPragmas,
opt_IrrefutableEverything,
......@@ -267,6 +269,7 @@ opt_D_dump_rdr = lookUp SLIT("-ddump-rdr")
opt_D_dump_realC = lookUp SLIT("-ddump-realC")
opt_D_dump_rn = lookUp SLIT("-ddump-rn")
opt_D_dump_simpl = lookUp SLIT("-ddump-simpl")
opt_D_dump_simpl_iterations = lookUp SLIT("-ddump-simpl_iterations")
opt_D_dump_spec = lookUp SLIT("-ddump-spec")
opt_D_dump_stg = lookUp SLIT("-ddump-stg")
opt_D_dump_stranal = lookUp SLIT("-ddump-stranal")
......@@ -289,6 +292,7 @@ opt_GranMacros = lookUp SLIT("-fgransim")
opt_GlasgowExts = lookUp SLIT("-fglasgow-exts")
opt_Haskell_1_3 = lookUp SLIT("-fhaskell-1.3")
opt_HiMap = lookup_str "-himap=" -- file saying where to look for .hi files
opt_HiSuffix = lookup_str "-hisuf="
opt_IgnoreIfacePragmas = lookUp SLIT("-fignore-interface-pragmas")
opt_IgnoreStrictnessPragmas = lookUp SLIT("-fignore-strictness-pragmas")
opt_IrrefutableEverything = lookUp SLIT("-firrefutable-everything")
......
......@@ -251,7 +251,7 @@ ifaceId get_idinfo needed_ids is_rec id rhs
= Nothing -- Well, that was easy!
ifaceId get_idinfo needed_ids is_rec id rhs
= Just (ppCat [sig_pretty, prag_pretty, ppSemi], new_needed_ids)
= Just (ppCat [sig_pretty, prag_pretty, ppStr ";;"], new_needed_ids)
where
idinfo = get_idinfo id
inline_pragma = idWantsToBeINLINEd id
......@@ -383,9 +383,9 @@ upp_export names = uppBesides [uppStr "(",
uppIntersperse uppSP (map (upp_occname . getOccName) names),
uppStr ")"]
upp_fixity (occ, Fixity prec dir, prov) = uppBesides [upp_dir dir, uppSP,
uppInt prec, uppSP,
upp_occname occ, uppSemi]
upp_fixity (occ, (Fixity prec dir, prov)) = uppBesides [upp_dir dir, uppSP,
uppInt prec, uppSP,
upp_occname occ, uppSemi]
upp_dir InfixR = uppStr "infixr"
upp_dir InfixL = uppStr "infixl"
upp_dir InfixN = uppStr "infix"
......
......@@ -8,7 +8,7 @@
module PrelInfo (
-- finite maps for built-in things (for the renamer and typechecker):
builtinNames, builtinKeys, derivingOccurrences,
builtinNames, derivingOccurrences,
SYN_IE(BuiltinNames),
maybeCharLikeTyCon, maybeIntLikeTyCon,
......@@ -27,6 +27,8 @@ module PrelInfo (
numClass_RDR, fractionalClass_RDR, eqClass_RDR, ccallableClass_RDR, creturnableClass_RDR,
monadZeroClass_RDR, enumClass_RDR, evalClass_RDR, ordClass_RDR,
main_NAME, mainPrimIO_NAME, ioTyCon_NAME, primIoTyCon_NAME,
needsDataDeclCtxtClassKeys, cCallishClassKeys, isNoDictClass,
isNumericClass, isStandardClass, isCcallishClass
) where
......@@ -82,7 +84,7 @@ builtinNames
listToBag (map (getName.primOpName) allThePrimOps) `unionBags`
-- Other names with magic keys
listToBag builtinKeys
listToBag knownKeyNames
\end{code}
......@@ -243,58 +245,62 @@ wired_in_ids
Ids, Synonyms, Classes and ClassOps with builtin keys.
\begin{code}
getKeyOrig :: (Module, OccName, Unique) -> Name
getKeyOrig (mod, occ, uniq) = mkGlobalName uniq mod occ VanillaDefn Implicit
builtinKeys :: [Name]
builtinKeys
= map getKeyOrig
mkKnownKeyGlobal :: (RdrName, Unique) -> Name
mkKnownKeyGlobal (Qual mod occ, uniq) = mkGlobalName uniq mod occ VanillaDefn Implicit
main_NAME = mkKnownKeyGlobal (main_RDR, mainKey)
mainPrimIO_NAME = mkKnownKeyGlobal (mainPrimIO_RDR, mainPrimIoKey)
ioTyCon_NAME = mkKnownKeyGlobal (ioTyCon_RDR, iOTyConKey)
primIoTyCon_NAME = getName primIoTyCon
knownKeyNames :: [Name]
knownKeyNames
= [main_NAME, mainPrimIO_NAME, ioTyCon_NAME]
++
map mkKnownKeyGlobal
[
-- Type constructors (synonyms especially)
(iO_BASE, TCOcc SLIT("IO"), iOTyConKey)
, (pREL_BASE, TCOcc SLIT("Ordering"), orderingTyConKey)
, (pREL_NUM, TCOcc SLIT("Rational"), rationalTyConKey)
, (pREL_NUM, TCOcc SLIT("Ratio"), ratioTyConKey)
(orderingTyCon_RDR, orderingTyConKey)
, (rationalTyCon_RDR, rationalTyConKey)
, (ratioTyCon_RDR, ratioTyConKey)
-- Classes. *Must* include:
-- classes that are grabbed by key (e.g., eqClassKey)
-- classes in "Class.standardClassKeys" (quite a few)
, (pREL_BASE, TCOcc SLIT("Eq"), eqClassKey) -- mentioned, derivable
, (pREL_BASE, TCOcc SLIT("Eval"), evalClassKey) -- mentioned
, (pREL_BASE, TCOcc SLIT("Ord"), ordClassKey) -- derivable
, (pREL_BASE, TCOcc SLIT("Bounded"), boundedClassKey) -- derivable
, (pREL_BASE, TCOcc SLIT("Num"), numClassKey) -- mentioned, numeric
, (pREL_BASE, TCOcc SLIT("Enum"), enumClassKey) -- derivable
, (pREL_BASE, TCOcc SLIT("Monad"), monadClassKey)
, (pREL_BASE, TCOcc SLIT("MonadZero"), monadZeroClassKey)
, (pREL_BASE, TCOcc SLIT("MonadPlus"), monadPlusClassKey)
, (pREL_BASE, TCOcc SLIT("Functor"), functorClassKey)
, (pREL_BASE, TCOcc SLIT("Show"), showClassKey) -- derivable
, (pREL_NUM, TCOcc SLIT("Real"), realClassKey) -- numeric
, (pREL_NUM, TCOcc SLIT("Integral"), integralClassKey) -- numeric
, (pREL_NUM, TCOcc SLIT("Fractional"), fractionalClassKey) -- numeric
, (pREL_NUM, TCOcc SLIT("Floating"), floatingClassKey) -- numeric
, (pREL_NUM, TCOcc SLIT("RealFrac"), realFracClassKey) -- numeric
, (pREL_NUM, TCOcc SLIT("RealFloat"), realFloatClassKey) -- numeric
, (pREL_READ, TCOcc SLIT("Read"), readClassKey) -- derivable
, (iX, TCOcc SLIT("Ix"), ixClassKey) -- derivable (but it isn't Prelude.Ix; hmmm)
, (fOREIGN, TCOcc SLIT("CCallable"), cCallableClassKey) -- mentioned, ccallish
, (fOREIGN, TCOcc SLIT("CReturnable"), cReturnableClassKey) -- mentioned, ccallish
, (eqClass_RDR, eqClassKey) -- mentioned, derivable
, (ordClass_RDR, ordClassKey) -- derivable
, (evalClass_RDR, evalClassKey) -- mentioned
, (boundedClass_RDR, boundedClassKey) -- derivable
, (numClass_RDR, numClassKey) -- mentioned, numeric
, (enumClass_RDR, enumClassKey) -- derivable
, (monadClass_RDR, monadClassKey)
, (monadZeroClass_RDR, monadZeroClassKey)
, (monadPlusClass_RDR, monadPlusClassKey)
, (functorClass_RDR, functorClassKey)
, (showClass_RDR, showClassKey) -- derivable
, (realClass_RDR, realClassKey) -- numeric
, (integralClass_RDR, integralClassKey) -- numeric
, (fractionalClass_RDR, fractionalClassKey) -- numeric
, (floatingClass_RDR, floatingClassKey) -- numeric
, (realFracClass_RDR, realFracClassKey) -- numeric
, (realFloatClass_RDR, realFloatClassKey) -- numeric
, (readClass_RDR, readClassKey) -- derivable
, (ixClass_RDR, ixClassKey) -- derivable (but it isn't Prelude.Ix; hmmm)
, (ccallableClass_RDR, cCallableClassKey) -- mentioned, ccallish
, (creturnableClass_RDR, cReturnableClassKey) -- mentioned, ccallish
-- ClassOps
, (pREL_BASE, VarOcc SLIT("fromInt"), fromIntClassOpKey)
, (pREL_BASE, VarOcc SLIT("fromInteger"), fromIntegerClassOpKey)
, (pREL_BASE, VarOcc SLIT("enumFrom"), enumFromClassOpKey)
, (pREL_BASE, VarOcc SLIT("enumFromThen"), enumFromThenClassOpKey)
, (pREL_BASE, VarOcc SLIT("enumFromTo"), enumFromToClassOpKey)
, (pREL_BASE, VarOcc SLIT("enumFromThenTo"), enumFromThenToClassOpKey)
, (pREL_BASE, VarOcc SLIT("fromEnum"), fromEnumClassOpKey)
, (pREL_BASE, VarOcc SLIT("=="), eqClassOpKey)
, (pREL_BASE, VarOcc SLIT(">>="), thenMClassOpKey)
, (pREL_BASE, VarOcc SLIT("zero"), zeroClassOpKey)
, (pREL_NUM, VarOcc SLIT("fromRational"), fromRationalClassOpKey)
, (fromInt_RDR, fromIntClassOpKey)
, (fromInteger_RDR, fromIntegerClassOpKey)
, (enumFrom_RDR, enumFromClassOpKey)
, (enumFromThen_RDR, enumFromThenClassOpKey)
, (enumFromTo_RDR, enumFromToClassOpKey)
, (enumFromThenTo_RDR, enumFromThenToClassOpKey)
, (fromEnum_RDR, fromEnumClassOpKey)
, (eq_RDR, eqClassOpKey)
, (thenM_RDR, thenMClassOpKey)
, (zeroM_RDR, zeroClassOpKey)
, (fromRational_RDR, fromRationalClassOpKey)
]
\end{code}
......@@ -318,16 +324,46 @@ to write them all down in one place.
\begin{code}
prelude_primop op = qual (modAndOcc (primOpName op))
intTyCon_RDR = qual (modAndOcc intTyCon)
ioTyCon_RDR = tcQual (iO_BASE, SLIT("IO"))
orderingTyCon_RDR = tcQual (pREL_BASE, SLIT("Ordering"))
rationalTyCon_RDR = tcQual (pREL_NUM, SLIT("Rational"))
ratioTyCon_RDR = tcQual (pREL_NUM, SLIT("Ratio"))
eqClass_RDR = tcQual (pREL_BASE, SLIT("Eq"))
ordClass_RDR = tcQual (pREL_BASE, SLIT("Ord"))
evalClass_RDR = tcQual (pREL_BASE, SLIT("Eval"))
monadZeroClass_RDR = tcQual (pREL_BASE, SLIT("MonadZero"))
enumClass_RDR = tcQual (pREL_BASE, SLIT("Enum"))
boundedClass_RDR = tcQual (pREL_BASE, SLIT("Bounded"))
numClass_RDR = tcQual (pREL_BASE, SLIT("Num"))
enumClass_RDR = tcQual (pREL_BASE, SLIT("Enum"))
monadClass_RDR = tcQual (pREL_BASE, SLIT("Monad"))
monadZeroClass_RDR = tcQual (pREL_BASE, SLIT("MonadZero"))
monadPlusClass_RDR = tcQual (pREL_BASE, SLIT("MonadPlus"))
functorClass_RDR = tcQual (pREL_BASE, SLIT("Functor"))
showClass_RDR = tcQual (pREL_BASE, SLIT("Show"))
realClass_RDR = tcQual (pREL_NUM, SLIT("Real"))
integralClass_RDR = tcQual (pREL_NUM, SLIT("Integral"))
fractionalClass_RDR = tcQual (pREL_NUM, SLIT("Fractional"))
floatingClass_RDR = tcQual (pREL_NUM, SLIT("Floating"))
realFracClass_RDR = tcQual (pREL_NUM, SLIT("RealFrac"))
realFloatClass_RDR = tcQual (pREL_NUM, SLIT("RealFloat"))
readClass_RDR = tcQual (pREL_READ, SLIT("Read"))
ixClass_RDR = tcQual (iX, SLIT("Ix"))
ccallableClass_RDR = tcQual (fOREIGN, SLIT("CCallable"))
creturnableClass_RDR = tcQual (fOREIGN, SLIT("CReturnable"))
fromInt_RDR = varQual (pREL_BASE, SLIT("fromInt"))
fromInteger_RDR = varQual (pREL_BASE, SLIT("fromInteger"))
fromEnum_RDR = varQual (pREL_BASE, SLIT("fromEnum"))
enumFrom_RDR = varQual (pREL_BASE, SLIT("enumFrom"))
enumFromTo_RDR = varQual (pREL_BASE, SLIT("enumFromTo"))
enumFromThen_RDR = varQual (pREL_BASE, SLIT("enumFromThen"))
enumFromThenTo_RDR = varQual (pREL_BASE, SLIT("enumFromThenTo"))
thenM_RDR = varQual (pREL_BASE, SLIT(">>="))
zeroM_RDR = varQual (pREL_BASE, SLIT("zero"))
fromRational_RDR = varQual (pREL_NUM, SLIT("fromRational"))
negate_RDR = varQual (pREL_BASE, SLIT("negate"))
eq_RDR = varQual (pREL_BASE, SLIT("=="))
ne_RDR = varQual (pREL_BASE, SLIT("/="))
......@@ -368,11 +404,6 @@ readParen_RDR = varQual (pREL_READ, SLIT("readParen"))
lex_RDR = varQual (pREL_READ, SLIT("lex"))
readList___RDR = varQual (pREL_READ, SLIT("readList__"))
fromEnum_RDR = varQual (pREL_BASE, SLIT("fromEnum"))
enumFrom_RDR = varQual (pREL_BASE, SLIT("enumFrom"))
enumFromTo_RDR = varQual (pREL_BASE, SLIT("enumFromTo"))
enumFromThen_RDR = varQual (pREL_BASE, SLIT("enumFromThen"))
enumFromThenTo_RDR = varQual (pREL_BASE, SLIT("enumFromThenTo"))
plus_RDR = varQual (pREL_BASE, SLIT("+"))
times_RDR = varQual (pREL_BASE, SLIT("*"))
mkInt_RDR = varQual (pREL_BASE, SLIT("I#"))
......@@ -395,7 +426,8 @@ geH_RDR = prelude_primop IntGeOp
leH_RDR = prelude_primop IntLeOp
minusH_RDR = prelude_primop IntSubOp
intType_RDR = qual (modAndOcc intTyCon)
main_RDR = varQual (mAIN, SLIT("main"))
mainPrimIO_RDR = varQual (gHC_MAIN, SLIT("mainPrimIO"))
\end{code}
%************************************************************************
......@@ -423,18 +455,18 @@ derivingOccurrences = listToUFM deriving_occ_info
derivableClassKeys = map fst deriving_occ_info
deriving_occ_info
= [ (eqClassKey, [intType_RDR, and_RDR, not_RDR])
, (ordClassKey, [intType_RDR, compose_RDR])
, (enumClassKey, [intType_RDR, map_RDR])
, (evalClassKey, [intType_RDR])
, (boundedClassKey, [intType_RDR])
, (showClassKey, [intType_RDR, numClass_RDR, ordClass_RDR, compose_RDR, showString_RDR,
= [ (eqClassKey, [intTyCon_RDR, and_RDR, not_RDR])
, (ordClassKey, [intTyCon_RDR, compose_RDR])
, (enumClassKey, [intTyCon_RDR, map_RDR])
, (evalClassKey, [intTyCon_RDR])
, (boundedClassKey, [intTyCon_RDR])
, (showClassKey, [intTyCon_RDR, numClass_RDR, ordClass_RDR, compose_RDR, showString_RDR,
showParen_RDR, showSpace_RDR, showList___RDR])
, (readClassKey, [intType_RDR, numClass_RDR, ordClass_RDR, append_RDR,
, (readClassKey, [intTyCon_RDR, numClass_RDR, ordClass_RDR, append_RDR,
lex_RDR, readParen_RDR, readList___RDR])
, (ixClassKey, [intType_RDR, numClass_RDR, and_RDR, map_RDR])
, (ixClassKey, [intTyCon_RDR, numClass_RDR, and_RDR, map_RDR])
]
-- intType: Practically any deriving needs Int, either for index calculations,
-- intTyCon: Practically any deriving needs Int, either for index calculations,
-- or for taggery.
-- ordClass: really it's the methods that are actually used.
-- numClass: for Int literals
......
......@@ -510,7 +510,7 @@ mkPrimIoTy a = mkStateTransformerTy realWorldTy a
primIoTyCon
= pcSynTyCon
primIoTyConKey iO_BASE SLIT("PrimIO")
primIoTyConKey sT_BASE SLIT("PrimIO")
(mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind)
1 alpha_tyvar (mkPrimIoTy alphaTy)
\end{code}
......
......@@ -20,6 +20,7 @@ module Lex (
IMPORT_1_3(Char(isDigit, isAlpha, isAlphanum, isUpper))
import CmdLineOpts ( opt_IgnoreIfacePragmas )
import Demand ( Demand {- instance Read -} )