Commit 5f34bb74 authored by sof's avatar sof
Browse files

[project @ 1997-07-05 02:55:34 by sof]

parent 8d6910cb
......@@ -52,8 +52,9 @@ import TysWiredIn
-- others:
import SpecEnv ( SpecEnv )
import RdrHsSyn ( RdrName(..), varQual, tcQual, qual )
import BasicTypes ( IfaceFlavour )
import Id ( GenId, SYN_IE(Id) )
import Name ( Name, OccName(..), DefnInfo(..), Provenance(..),
import Name ( Name, OccName(..), Provenance(..),
getName, mkGlobalName, modAndOcc )
import Class ( Class(..), GenClass, classKey )
import TyCon ( tyConDataCons, mkFunTyCon, TyCon )
......@@ -250,7 +251,8 @@ Ids, Synonyms, Classes and ClassOps with builtin keys.
\begin{code}
mkKnownKeyGlobal :: (RdrName, Unique) -> Name
mkKnownKeyGlobal (Qual mod occ, uniq) = mkGlobalName uniq mod occ VanillaDefn Implicit
mkKnownKeyGlobal (Qual mod occ hif, uniq)
= mkGlobalName uniq mod occ (Implicit hif)
allClass_NAME = mkKnownKeyGlobal (allClass_RDR, allClassKey)
main_NAME = mkKnownKeyGlobal (main_RDR, mainKey)
......
......@@ -525,7 +525,7 @@ runSTId
id_info
= noIdInfo
`addArityInfo` exactArity 1
`addStrictnessInfo` mkStrictnessInfo [WwStrict] Nothing
`addStrictnessInfo` mkStrictnessInfo [WwStrict] False
`addArgUsageInfo` mkArgUsageInfo [ArgUsage 1]
-- ABSOLUTELY NO UNFOLDING, e.g.: (mk_inline_unfolding run_ST_template)
-- see example below
......@@ -601,7 +601,7 @@ buildId
= pcMiscPrelId buildIdKey gHC_ERR SLIT("build") buildTy
((((noIdInfo
{-LATER:`addUnfoldInfo` mkMagicUnfolding buildIdKey-})
`addStrictnessInfo` mkStrictnessInfo [WwStrict] Nothing)
`addStrictnessInfo` mkStrictnessInfo [WwStrict] False)
`addArgUsageInfo` mkArgUsageInfo [ArgUsage 2])
`addSpecInfo` pcGenerateSpecs buildIdKey buildId noIdInfo{-ToDo-} buildTy)
-- cheating, but since _build never actually exists ...
......@@ -646,7 +646,7 @@ augmentId
= pcMiscPrelId augmentIdKey gHC_ERR SLIT("augment") augmentTy
(((noIdInfo
{-LATER:`addUnfoldInfo` mkMagicUnfolding augmentIdKey-})
`addStrictnessInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
`addStrictnessInfo` mkStrictnessInfo [WwStrict,WwLazy False] False)
`addArgUsageInfo` mkArgUsageInfo [ArgUsage 2,UnknownArgUsage])
-- cheating, but since _augment never actually exists ...
where
......@@ -669,7 +669,7 @@ foldrId = pcMiscPrelId foldrIdKey pREL_BASE SLIT("foldr")
idInfo = (((((noIdInfo
{-LATER:`addUnfoldInfo` mkMagicUnfolding foldrIdKey-})
`addStrictnessInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
`addStrictnessInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] False)
`addArityInfo` exactArity 3)
`addUpdateInfo` mkUpdateInfo [2,2,1])
`addSpecInfo` pcGenerateSpecs foldrIdKey foldrId noIdInfo{-ToDo-} foldrTy)
......@@ -683,7 +683,7 @@ foldlId = pcMiscPrelId foldlIdKey pREL_LIST SLIT("foldl")
idInfo = (((((noIdInfo
{-LATER:`addUnfoldInfo` mkMagicUnfolding foldlIdKey-})
`addStrictnessInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
`addStrictnessInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] False)
`addArityInfo` exactArity 3)
`addUpdateInfo` mkUpdateInfo [2,2,1])
`addSpecInfo` pcGenerateSpecs foldlIdKey foldlId noIdInfo{-ToDo-} foldlTy)
......@@ -709,7 +709,7 @@ appendId
(mkSigmaTy [alphaTyVar] []
(mkFunTys [mkListTy alphaTy, mkListTy alphaTy] (mkListTy alphaTy)))
idInfo = (((noIdInfo
`addStrictnessInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
`addStrictnessInfo` mkStrictnessInfo [WwStrict,WwLazy False] False)
`addArityInfo` exactArity 2)
`addUpdateInfo` mkUpdateInfo [1,2])
-}
......
......@@ -21,6 +21,7 @@ module StdIdInfo (
IMP_Ubiq()
import Type
import TyVar ( alphaTyVar )
import CmdLineOpts ( opt_PprUserLength )
import CoreSyn
import Literal
......@@ -36,7 +37,7 @@ import Id ( GenId, mkTemplateLocals, idType,
SYN_IE(Id)
)
import IdInfo ( ArityInfo, exactArity )
import Class ( GenClass, GenClassOp, classSig, classOpLocalType )
import Class ( GenClass, classBigSig, classDictArgTys )
import TyCon ( isNewTyCon, isDataTyCon, isAlgTyCon )
import FieldLabel ( FieldLabel )
import PrelVals ( pAT_ERROR_ID )
......@@ -187,41 +188,17 @@ addStandardIdInfo sel_id
\begin{code}
addStandardIdInfo sel_id
| maybeToBool maybe_sc_sel_id
= sel_id `addIdUnfolding` unfolding
-- The always-inline thing means we don't need any other IdInfo
= sel_id `addIdUnfolding` (mk_selector_unfolding cls sel_id)
where
maybe_sc_sel_id = isSuperDictSelId_maybe sel_id
Just (cls, the_sc) = maybe_sc_sel_id
unfolding = mkUnfolding IWantToBeINLINEd {- Always inline selectors -} rhs
rhs = mk_dict_selector [tyvar] dict_id arg_ids the_arg_id
(tyvar, scs, ops) = classSig cls
tyvar_ty = mkTyVarTy tyvar
[dict_id] = mkTemplateLocals [mkDictTy cls tyvar_ty]
arg_ids = mkTemplateLocals ([mkDictTy sc tyvar_ty | sc <- scs] ++
map classOpLocalType ops)
the_arg_id = assoc "StdIdInfoSC" (scs `zip` arg_ids) the_sc
Just (cls, _) = maybe_sc_sel_id
addStandardIdInfo sel_id
| maybeToBool maybe_meth_sel_id
= sel_id `addIdUnfolding` unfolding
-- The always-inline thing means we don't need any other IdInfo
= sel_id `addIdUnfolding` (mk_selector_unfolding cls sel_id)
where
maybe_meth_sel_id = isMethodSelId_maybe sel_id
Just (cls, the_op) = maybe_meth_sel_id
unfolding = mkUnfolding IWantToBeINLINEd {- Always inline selectors -} rhs
rhs = mk_dict_selector [tyvar] dict_id arg_ids the_arg_id
(tyvar, scs, ops) = classSig cls
n_scs = length scs
tyvar_ty = mkTyVarTy tyvar
[dict_id] = mkTemplateLocals [mkDictTy cls tyvar_ty]
arg_ids = mkTemplateLocals ([mkDictTy sc tyvar_ty | sc <- scs] ++
map classOpLocalType ops)
the_arg_id = assoc "StdIdInfoMeth" (ops `zip` (drop n_scs arg_ids)) the_op
Just cls = maybe_meth_sel_id
\end{code}
......@@ -275,6 +252,19 @@ Selecting a field for a dictionary. If there is just one field, then
there's nothing to do.
\begin{code}
mk_selector_unfolding clas sel_id
= mkUnfolding IWantToBeINLINEd {- Always inline selectors -} rhs
-- The always-inline thing means we don't need any other IdInfo
where
rhs = mk_dict_selector [alphaTyVar] dict_id arg_ids the_arg_id
tyvar_ty = mkTyVarTy alphaTyVar
[dict_id] = mkTemplateLocals [mkDictTy clas tyvar_ty]
arg_tys = classDictArgTys clas tyvar_ty
arg_ids = mkTemplateLocals arg_tys
the_arg_id = assoc "StdIdInfo:mk_sel" ((sc_sel_ids ++ op_sel_ids) `zip` arg_ids) sel_id
(_, _, sc_sel_ids, op_sel_ids, defms) = classBigSig clas
mk_dict_selector tyvars dict_id [arg_id] the_arg_id
= mkLam tyvars [dict_id] (Var dict_id)
......
......@@ -2,5 +2,5 @@ _interface_ TysWiredIn 1
_exports_
TysWiredIn tupleCon tupleTyCon;
_declarations_
1 tupleCon _:_ PrelBase.Int -> Id.Id ;;
1 tupleTyCon _:_ PrelBase.Int -> TyCon.TyCon ;;
1 tupleCon _:_ BasicTypes.Arity -> Id.Id ;;
1 tupleTyCon _:_ BasicTypes.Arity -> TyCon.TyCon ;;
......@@ -94,8 +94,6 @@ IMPORT_DELOOPER(IdLoop) ( SpecEnv, nullSpecEnv,
#else
import {-# SOURCE #-} Id ( Id, mkDataCon, mkTupleCon, StrictnessMark(..) )
import {-# SOURCE #-} SpecEnv ( SpecEnv, nullSpecEnv )
import {-# SOURCE #-} Type ( Type )
import {-# SOURCE #-} TyVar ( TyVar )
#endif
-- friends:
......@@ -103,16 +101,17 @@ import PrelMods
import TysPrim
-- others:
import FieldLabel () --
import Kind ( mkBoxedTypeKind, mkArrowKind )
import Name --( mkWiredInTyConName, mkWiredInIdName, mkTupNameStr )
import Name ( mkWiredInTyConName, mkWiredInIdName )
import TyCon ( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
TyCon, SYN_IE(Arity)
)
import BasicTypes ( NewOrData(..) )
import Type ( mkTyConTy, applyTyCon, mkSigmaTy, mkTyVarTys,
import BasicTypes ( SYN_IE(Module), NewOrData(..) )
import Type ( SYN_IE(Type), mkTyConTy, applyTyCon, mkSigmaTy, mkTyVarTys,
mkFunTy, mkFunTys, maybeAppTyCon,
GenType(..), SYN_IE(ThetaType), SYN_IE(TauType) )
import TyVar ( tyVarKind, alphaTyVars, alphaTyVar, betaTyVar )
import TyVar ( SYN_IE(TyVar), tyVarKind, alphaTyVars, alphaTyVar, betaTyVar )
import Lex ( mkTupNameStr )
import Unique
import Util ( assoc, panic )
......
......@@ -34,7 +34,7 @@ import PrelBase ( Char(..) )
import CmdLineOpts ( opt_IgnoreIfacePragmas )
import Demand ( Demand(..) {- instance Read -} )
import UniqFM ( UniqFM, listToUFM, lookupUFM)
import BasicTypes ( NewOrData(..) )
import BasicTypes ( NewOrData(..), IfaceFlavour(..) )
#if __GLASGOW_HASKELL__ >= 202
import Maybes ( MaybeErr(..) )
......@@ -205,10 +205,10 @@ data IfaceToken
| ITconid FAST_STRING
| ITvarsym FAST_STRING
| ITconsym FAST_STRING
| ITqvarid (FAST_STRING,FAST_STRING)
| ITqconid (FAST_STRING,FAST_STRING)
| ITqvarsym (FAST_STRING,FAST_STRING)
| ITqconsym (FAST_STRING,FAST_STRING)
| ITqvarid (FAST_STRING,FAST_STRING,IfaceFlavour)
| ITqconid (FAST_STRING,FAST_STRING,IfaceFlavour)
| ITqvarsym (FAST_STRING,FAST_STRING,IfaceFlavour)
| ITqconsym (FAST_STRING,FAST_STRING,IfaceFlavour)
| ITidinfo [IfaceToken] -- lazily return the stream of tokens for
-- the info attached to an id.
......@@ -624,15 +624,19 @@ lex_id buf =
case expandWhile (is_mod_char) buf of
buf' ->
case currentChar# buf' of
'.'# ->
'.'# -> munch buf' HiFile
'!'# -> munch buf' HiBootFile
_ -> lex_id2 Nothing buf'
where
munch buf' hif =
if not (emptyLexeme buf') then
-- _trace ("lex_id: "++(C# (currentChar# (stepOverLexeme buf'))):show (lexemeToFastString buf')) $
case lexemeToFastString buf' of
l@(FastString u# l# ba#) -> lex_id2 (Just (FastString u# l# ba#))
l@(FastString u# l# ba#) -> lex_id2 (Just (FastString u# l# ba#, hif))
(stepOn (stepOverLexeme buf'))
else
lex_id2 Nothing buf'
_ -> lex_id2 Nothing buf'
-- Dealt with the Module.part
lex_id2 module_dot buf =
......@@ -719,14 +723,14 @@ mk_var_token pk_str =
-}
end_lex_id Nothing token buf = token : lexIface buf
end_lex_id (Just m) token buf =
end_lex_id (Just (m,hif)) token buf =
case token of
ITconid n -> ITqconid (m,n) : lexIface buf
ITvarid n -> ITqvarid (m,n) : lexIface buf
ITconsym n -> ITqconsym (m,n) : lexIface buf
ITvarsym n -> ITqvarsym (m,n) : lexIface buf
ITbang -> ITqvarsym (m,SLIT("!")) : lexIface buf
_ -> ITunknown (show token) : lexIface buf
ITconid n -> ITqconid (m,n,hif) : lexIface buf
ITvarid n -> ITqvarid (m,n,hif) : lexIface buf
ITconsym n -> ITqconsym (m,n,hif) : lexIface buf
ITvarsym n -> ITqvarsym (m,n,hif) : lexIface buf
ITbang -> ITqvarsym (m,SLIT("!"),hif) : lexIface buf
_ -> ITunknown (show token) : lexIface buf
------------
ifaceKeywordsFM :: UniqFM IfaceToken
......
......@@ -27,6 +27,7 @@ IMPORT_1_3(Char(isDigit))
import HsSyn
import RdrHsSyn
import BasicTypes ( IfaceFlavour )
import Util ( panic )
import SrcLoc ( SrcLoc )
......
......@@ -45,7 +45,7 @@ cvValSig (RdrTySig vars poly_ty src_loc)
= [ Sig v poly_ty src_loc | v <- vars ]
cvClassOpSig (RdrTySig vars poly_ty src_loc)
= [ ClassOpSig v v poly_ty src_loc | v <- vars ]
= [ ClassOpSig v Nothing poly_ty src_loc | v <- vars ]
cvInstDeclSig (RdrSpecValSig sigs) = sigs
cvInstDeclSig (RdrInlineValSig sig) = [ sig ]
......
......@@ -46,7 +46,7 @@ module RdrHsSyn (
extractHsTyVars,
RdrName(..),
qual, varQual, tcQual, varUnqual,
qual, varQual, tcQual, varUnqual, lexVarQual, lexTcQual,
dummyRdrVarName, dummyRdrTcName,
isUnqual, isQual,
showRdr, rdrNameOcc, ieOcc,
......@@ -60,7 +60,7 @@ IMP_Ubiq()
import HsSyn
import Lex
import PrelMods ( pRELUDE )
import BasicTypes ( Module(..), NewOrData )
import BasicTypes ( Module(..), NewOrData, IfaceFlavour(..) )
import Name ( ExportFlag(..), pprModule,
OccName(..), pprOccName,
prefixOccName, SYN_IE(NamedThing) )
......@@ -138,7 +138,7 @@ extractHsTyVars ty
where
locals = map getTyVarName tvs
insert (Qual _ _) acc = acc
insert (Qual _ _ _) acc = acc
insert (Unqual (TCOcc _)) acc = acc
insert other acc | other `elem` acc = acc
| otherwise = other : acc
......@@ -162,11 +162,15 @@ mkOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
\begin{code}
data RdrName
= Unqual OccName
| Qual Module OccName
| Qual Module OccName IfaceFlavour -- HiBootFile for M!.t (interface files only),
-- HiFile for the common M.t
qual (m,n) = Qual m n
tcQual (m,n) = Qual m (TCOcc n)
varQual (m,n) = Qual m (VarOcc n)
qual (m,n) = Qual m n HiFile
tcQual (m,n) = Qual m (TCOcc n) HiFile
varQual (m,n) = Qual m (VarOcc n) HiFile
lexTcQual (m,n,hif) = Qual m (TCOcc n) hif
lexVarQual (m,n,hif) = Qual m (VarOcc n) hif
-- This guy is used by the reader when HsSyn has a slot for
-- an implicit name that's going to be filled in by
......@@ -178,26 +182,26 @@ dummyRdrTcName = Unqual (VarOcc SLIT("TC-DUMMY"))
varUnqual n = Unqual (VarOcc n)
isUnqual (Unqual _) = True
isUnqual (Qual _ _) = False
isUnqual (Unqual _) = True
isUnqual (Qual _ _ _) = False
isQual (Unqual _) = False
isQual (Qual _ _) = True
isQual (Unqual _) = False
isQual (Qual _ _ _) = True
-- Used for adding a prefix to a RdrName
prefixRdrName :: FAST_STRING -> RdrName -> RdrName
prefixRdrName prefix (Qual m n) = Qual m (prefixOccName prefix n)
prefixRdrName prefix (Unqual n) = Unqual (prefixOccName prefix n)
prefixRdrName prefix (Qual m n hif) = Qual m (prefixOccName prefix n) hif
prefixRdrName prefix (Unqual n) = Unqual (prefixOccName prefix n)
cmpRdr (Unqual n1) (Unqual n2) = n1 `cmp` n2
cmpRdr (Unqual n1) (Qual m2 n2) = LT_
cmpRdr (Qual m1 n1) (Unqual n2) = GT_
cmpRdr (Qual m1 n1) (Qual m2 n2) = (n1 `cmp` n2) `thenCmp` (_CMP_STRING_ m1 m2)
cmpRdr (Unqual n1) (Unqual n2) = n1 `cmp` n2
cmpRdr (Unqual n1) (Qual m2 n2 _) = LT_
cmpRdr (Qual m1 n1 _) (Unqual n2) = GT_
cmpRdr (Qual m1 n1 _) (Qual m2 n2 _) = (n1 `cmp` n2) `thenCmp` (_CMP_STRING_ m1 m2)
-- always compare module-names *second*
rdrNameOcc :: RdrName -> OccName
rdrNameOcc (Unqual occ) = occ
rdrNameOcc (Qual _ occ) = occ
rdrNameOcc (Unqual occ) = occ
rdrNameOcc (Qual _ occ _) = occ
ieOcc :: RdrNameIE -> OccName
ieOcc ie = rdrNameOcc (ieName ie)
......@@ -219,8 +223,8 @@ instance Ord3 RdrName where
cmp = cmpRdr
instance Outputable RdrName where
ppr sty (Unqual n) = pprQuote sty $ \ sty -> pprOccName sty n
ppr sty (Qual m n) = pprQuote sty $ \ sty -> hcat [pprModule sty m, char '.', pprOccName sty n]
ppr sty (Unqual n) = pprQuote sty $ \ sty -> pprOccName sty n
ppr sty (Qual m n _) = pprQuote sty $ \ sty -> hcat [pprModule sty m, char '.', pprOccName sty n]
instance NamedThing RdrName where -- Just so that pretty-printing of expressions works
getOccName = rdrNameOcc
......
......@@ -24,7 +24,7 @@ import HsSyn
import HsTypes ( HsTyVar(..) )
import HsPragmas ( noDataPragmas, noClassPragmas, noInstancePragmas, noGenPragmas )
import RdrHsSyn
import BasicTypes ( Fixity(..), FixityDirection(..), NewOrData(..) )
import BasicTypes ( Fixity(..), FixityDirection(..), NewOrData(..), IfaceFlavour(..) )
import PrefixToHs
import CmdLineOpts ( opt_PprUserLength )
......@@ -78,7 +78,7 @@ wlkQid :: (FAST_STRING -> OccName) -> U_qid -> UgnM RdrName
wlkQid mk_occ_name (U_noqual name)
= returnUgn (Unqual (mk_occ_name name))
wlkQid mk_occ_name (U_aqual mod name)
= returnUgn (Qual mod (mk_occ_name name))
= returnUgn (Qual mod (mk_occ_name name) HiFile)
-- I don't understand this one! It is what shows up when we meet (), [], or (,,,).
wlkQid mk_occ_name (U_gid n name)
......@@ -905,7 +905,7 @@ rdImport pt
mkSrcLocUgn srcline $ \ src_loc ->
wlkMaybe rdU_stringId ias `thenUgn` \ maybe_as ->
wlkMaybe rd_spec ispec `thenUgn` \ maybe_spec ->
returnUgn (ImportDecl imod (cvFlag iqual) (cvFlag isrc) maybe_as maybe_spec src_loc)
returnUgn (ImportDecl imod (cvFlag iqual) (cvIfaceFlavour isrc) maybe_as maybe_spec src_loc)
where
rd_spec pt = rdU_either pt `thenUgn` \ spec ->
case spec of
......@@ -913,6 +913,9 @@ rdImport pt
returnUgn (False, ents)
U_right pt -> rdEntities pt `thenUgn` \ ents ->
returnUgn (True, ents)
cvIfaceFlavour 0 = HiFile -- No pragam
cvIfaceFlavour 1 = HiBootFile -- {-# SOURCE #-}
\end{code}
\begin{code}
......
......@@ -6,18 +6,18 @@ IMP_Ubiq(){-uitous-}
import HsSyn -- quite a bit of stuff
import RdrHsSyn -- oodles of synonyms
import HsDecls ( HsIdInfo(..) )
import HsDecls ( HsIdInfo(..), HsStrictnessInfo )
import HsTypes ( mkHsForAllTy )
import HsCore
import Literal
import BasicTypes ( Fixity(..), FixityDirection(..), NewOrData(..), Version(..) )
import BasicTypes ( IfaceFlavour(..), Fixity(..), FixityDirection(..), NewOrData(..), Version(..) )
import HsPragmas ( noDataPragmas, noClassPragmas )
import Kind ( Kind, mkArrowKind, mkBoxedTypeKind )
import IdInfo ( ArgUsageInfo, FBTypeInfo )
import Lex
import RnMonad ( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
SYN_IE(RdrNamePragma), SYN_IE(ExportItem), SYN_IE(RdrAvailInfo), GenAvailInfo(..)
)
import Bag ( emptyBag, unitBag, snocBag )
import FiniteMap ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
......@@ -149,8 +149,8 @@ module_stuff_pairs : { [] }
| module_stuff_pair module_stuff_pairs { $1 : $2 }
module_stuff_pair :: { ImportVersion OccName }
module_stuff_pair : mod_name INTEGER DCOLON name_version_pairs SEMI
{ ($1, fromInteger $2, $4) }
module_stuff_pair : mod_name opt_bang INTEGER DCOLON name_version_pairs SEMI
{ ($1, $2, fromInteger $3, $5) }
versions_part :: { [LocalVersion OccName] }
versions_part : VERSIONS_PART name_version_pairs { $2 }
......@@ -171,23 +171,27 @@ exports_part : EXPORTS_PART export_items { $2 }
export_items :: { [ExportItem] }
export_items : { [] }
| mod_name entities SEMI export_items { ($1,$2) : $4 }
| opt_bang mod_name entities SEMI export_items { ($2,$1,$3) : $5 }
entities :: { [(OccName, [OccName])] }
opt_bang :: { IfaceFlavour }
opt_bang : { HiFile }
| BANG { HiBootFile }
entities :: { [RdrAvailInfo] }
entities : { [] }
| entity entities { $1 : $2 }
entity :: { (OccName, [OccName]) }
entity : entity_occ { ($1, if isTCOcc $1
then [$1] {- AvailTC -}
else []) {- Avail -} }
| entity_occ stuff_inside { ($1, ($1 : $2)) {- TyCls exported too -} }
| entity_occ BANG stuff_inside { ($1, $3) {- TyCls not exported -} }
entity :: { RdrAvailInfo }
entity : entity_occ { if isTCOcc $1
then AvailTC $1 [$1]
else Avail $1 }
| entity_occ stuff_inside { AvailTC $1 ($1:$2) }
| entity_occ VBAR stuff_inside { AvailTC $1 $3 }
stuff_inside :: { [OccName] }
stuff_inside : OPAREN val_occs1 CPAREN { $2
stuff_inside : OPAREN val_occs1 CPAREN { $2
--------------------------------------------------------------------------
}
}
inst_modules_part :: { [Module] }
inst_modules_part : { [] }
......@@ -259,7 +263,9 @@ csigs1 : csig { [$1] }
| csig SEMI csigs1 { $1 : $3 }
csig :: { RdrNameSig }
csig : var_name DCOLON type { ClassOpSig $1 $1 $3 mkIfaceSrcLoc
csig : var_name DCOLON type { ClassOpSig $1 Nothing $3 mkIfaceSrcLoc }
| var_name EQUAL DCOLON type { ClassOpSig $1 (Just (error "Un-filled-in default method"))
$4 mkIfaceSrcLoc
----------------------------------------------------------------
}
......@@ -371,8 +377,8 @@ val_occs1 :: { [OccName] }
qvar_name :: { RdrName }
: QVARID { varQual $1 }
| QVARSYM { varQual $1 }
: QVARID { lexVarQual $1 }
| QVARSYM { lexVarQual $1 }
var_name :: { RdrName }
var_name : var_occ { Unqual $1 }
......@@ -386,8 +392,8 @@ any_var_name : var_name { $1 }
| qvar_name { $1 }
qdata_name :: { RdrName }
qdata_name : QCONID { varQual $1 }
| QCONSYM { varQual $1 }
qdata_name : QCONID { lexVarQual $1 }
| QCONSYM { lexVarQual $1 }
data_name :: { RdrName }
data_name : CONID { Unqual (VarOcc $1) }
......@@ -400,10 +406,11 @@ tc_names1 :: { [RdrName] }
tc_name :: { RdrName }
tc_name : tc_occ { Unqual $1 }
| QCONID { tcQual $1 }
| QCONID { lexTcQual $1 }
tv_name :: { RdrName }
tv_name : VARID { Unqual (TvOcc $1) }
| VARSYM { Unqual (TvOcc $1) {- Allow $t2 as a tyvar -} }
tv_names :: { [RdrName] }
: { [] }
......
......@@ -6,7 +6,7 @@ IMP_Ubiq(){-uitous-}
import HsSyn -- quite a bit of stuff
import RdrHsSyn -- oodles of synonyms
import HsDecls ( HsIdInfo(..) )
import HsDecls ( HsIdInfo(..), HsStrictnessInfo )
import HsTypes ( mkHsForAllTy )
import HsCore
import Literal
......@@ -18,7 +18,7 @@ import Kind ( Kind, mkArrowKind, mkBoxedTypeKind )
import Lex
import RnMonad ( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
SYN_IE(RdrNamePragma), SYN_IE(ExportItem), GenAvailInfo
)
import Bag ( emptyBag, unitBag, snocBag )
import FiniteMap ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
......@@ -128,13 +128,14 @@ akind :: { Kind }
tv_name :: { RdrName }
tv_name : VARID { Unqual (TvOcc $1) }
| VARSYM { Unqual (TvOcc $1) {- Allow $t2 as a tyvar -} }
tv_names :: { [RdrName] }
: { [] }
| tv_name tv_names { $1 : $2 }
tc_name :: { RdrName }
tc_name : QCONID { tcQual $1 }
tc_name : QCONID { lexTcQual $1 }
| CONID { Unqual (TCOcc $1) }
| CONSYM { Unqual (TCOcc $1) }
| OPAREN RARROW CPAREN { Unqual (TCOcc SLIT("->")) }
......
......@@ -6,7 +6,7 @@ IMP_Ubiq(){-uitous-}
import HsSyn -- quite a bit of stuff
import RdrHsSyn -- oodles of synonyms
import HsDecls ( HsIdInfo(..) )
import HsDecls ( HsIdInfo(..), HsStrictnessInfo(..) )
import HsTypes ( mkHsForAllTy )
import HsCore
import Literal
......@@ -19,7 +19,7 @@ import Kind ( Kind, mkArrowKind, mkBoxedTypeKind )
import Lex
import RnMonad ( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
SYN_IE(RdrNamePragma), SYN_IE(ExportItem), GenAvailInfo
)
import Bag ( emptyBag, unitBag, snocBag )
import FiniteMap ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
......@@ -123,16 +123,16 @@ id_info : { [] }
id_info_item :: { HsIdInfo RdrName }
id_info_item : ARITY_PART arity_info { HsArity $2 }
| STRICT_PART strict_info { HsStrictness $2 }
| BOTTOM { HsStrictness mkBottomStrictnessInfo }
| BOTTOM { HsStrictness HsBottom }
| UNFOLD_PART core_expr { HsUnfold $1 $2 }
arity_info :: { ArityInfo }
arity_info : INTEGER { exactArity (fromInteger $1) }
strict_info :: { StrictnessInfo RdrName }
strict_info : DEMAND any_var_name OCURLY data_names CCURLY { mkStrictnessInfo $1 (Just ($2,$4)) }
| DEMAND any_var_name { mkStrictnessInfo $1 (Just ($2,[])) }
| DEMAND { mkStrictnessInfo $1 Nothing }
strict_info :: { HsStrictnessInfo RdrName }
strict_info : DEMAND any_var_name OCURLY data_names CCURLY { HsStrictnessInfo $1 (Just ($2,$4)) }
| DEMAND any_var_name { HsStrictnessInfo $1 (Just ($2,[])) }
| DEMAND { HsStrictnessInfo $1 Nothing }
core_expr :: { UfExpr RdrName }
core_expr : any_var_name { UfVar $1 }
......@@ -255,14 +255,14 @@ var_occ : VARID { VarOcc $1 }
| BANG { VarOcc SLIT("!") {-sigh, double-sigh-} }
data_name :: { RdrName }
data_name : QCONID { varQual $1 }
| QCONSYM { varQual $1 }
data_name : QCONID { lexVarQual $1 }
| QCONSYM { lexVarQual $1 }
| CONID { Unqual (VarOcc $1) }
| CONSYM { Unqual (VarOcc $1) }
qvar_name :: { RdrName }
: QVARID { varQual $1 }
| QVARSYM { varQual $1 }
: QVARID { lexVarQual $1 }
| QVARSYM { lexVarQual $1 }
var_name :: { RdrName }
var_name : var_occ { Unqual $1 }
......@@ -339,13 +339,14 @@ akind :: { Kind }
tv_name :: { RdrName }
tv_name : VARID { Unqual (TvOcc $1) }
| VARSYM { Unqual (TvOcc $1) {- Allow $t2 as a tyvar -} }
tv_names :: { [RdrName] }
: { [] }
| tv_name tv_names { $1 : $2 }
tc_name :: { RdrName }
tc_name : QCONID { tcQual $1 }
tc_name : QCONID { lexTcQual $1 }
| CONID { Unqual (TCOcc $1) }
| CONSYM { Unqual (TCOcc $1) }
| OPAREN RARROW CPAREN { Unqual (TCOcc SLIT("->")) }
......@@ -220,7 +220,7 @@ closeDecls necessity decls
-- An unresolved name
Just name
-> -- Slurp its declaration, if any
traceRn (sep [ptext SLIT("Considering"), ppr PprDebug name]) `thenRn_`
-- traceRn (sep [ptext SLIT("Considering"), ppr PprDebug name]) `thenRn_`
importDecl name necessity `thenRn` \ maybe_decl ->
case maybe_decl of
......