Commit 756b2283 authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari
Browse files

Refactor lookupFixityRn-related code following D1744

Test Plan: ./validate

Reviewers: goldfire, austin, bgamari, simonpj

Subscribers: simonpj, thomie

Differential Revision: https://phabricator.haskell.org/D1766

GHC Trac Issues: #11345
parent 7cf16aaf
......@@ -647,7 +647,7 @@ The ABI of a declaration consists of:
definition of an Id is included in the fingerprint only if
it is made available as an unfolding in the interface.
(c) the fixity of the identifier
(c) the fixity of the identifier (if it exists)
(d) for Ids: rules
(e) for classes: instances, fixity & rules for methods
(f) for datatypes: instances, fixity & rules for constrs
......@@ -664,29 +664,29 @@ data IfaceDeclExtras
= IfaceIdExtras IfaceIdExtras
| IfaceDataExtras
Fixity -- Fixity of the tycon itself
(Maybe Fixity) -- Fixity of the tycon itself (if it exists)
[IfaceInstABI] -- Local class and family instances of this tycon
-- See Note [Orphans] in InstEnv
[AnnPayload] -- Annotations of the type itself
[IfaceIdExtras] -- For each constructor: fixity, RULES and annotations
| IfaceClassExtras
Fixity -- Fixity of the class itself
(Maybe Fixity) -- Fixity of the class itself (if it exists)
[IfaceInstABI] -- Local instances of this class *or*
-- of its associated data types
-- See Note [Orphans] in InstEnv
[AnnPayload] -- Annotations of the type itself
[IfaceIdExtras] -- For each class method: fixity, RULES and annotations
| IfaceSynonymExtras Fixity [AnnPayload]
| IfaceSynonymExtras (Maybe Fixity) [AnnPayload]
| IfaceFamilyExtras Fixity [IfaceInstABI] [AnnPayload]
| IfaceFamilyExtras (Maybe Fixity) [IfaceInstABI] [AnnPayload]
| IfaceOtherDeclExtras
data IfaceIdExtras
= IdExtras
Fixity -- Fixity of the Id
(Maybe Fixity) -- Fixity of the Id (if it exists)
[IfaceRule] -- Rules for the Id
[AnnPayload] -- Annotations for the Id
......@@ -762,7 +762,7 @@ instance Binary IfaceIdExtras where
get _bh = panic "no get for IfaceIdExtras"
put_ bh (IdExtras fix rules anns)= do { put_ bh fix; put_ bh rules; put_ bh anns }
declExtras :: (OccName -> Fixity)
declExtras :: (OccName -> Maybe Fixity)
-> (OccName -> [AnnPayload])
-> OccEnv [IfaceRule]
-> OccEnv [IfaceClsInst]
......
......@@ -70,7 +70,7 @@ module HscTypes (
-- * Interfaces
ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
emptyIfaceWarnCache, mi_boot,
emptyIfaceWarnCache, mi_boot, mi_fix,
-- * Fixity
FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
......@@ -830,7 +830,7 @@ data ModIface
-- and are not put into the interface file
mi_warn_fn :: OccName -> Maybe WarningTxt,
-- ^ Cached lookup for 'mi_warns'
mi_fix_fn :: OccName -> Fixity,
mi_fix_fn :: OccName -> Maybe Fixity,
-- ^ Cached lookup for 'mi_fixities'
mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint),
-- ^ Cached lookup for 'mi_decls'.
......@@ -859,6 +859,11 @@ data ModIface
mi_boot :: ModIface -> Bool
mi_boot iface = mi_hsc_src iface == HsBootFile
-- | Lookups up a (possibly cached) fixity from a 'ModIface'. If one cannot be
-- found, 'defaultFixity' is returned instead.
mi_fix :: ModIface -> OccName -> Fixity
mi_fix iface name = mi_fix_fn iface name `orElse` defaultFixity
instance Binary ModIface where
put_ bh (ModIface {
mi_module = mod,
......@@ -2055,14 +2060,14 @@ plusWarns (WarnAll t) _ = WarnAll t
plusWarns (WarnSome v1) (WarnSome v2) = WarnSome (v1 ++ v2)
-- | Creates cached lookup for the 'mi_fix_fn' field of 'ModIface'
mkIfaceFixCache :: [(OccName, Fixity)] -> OccName -> Fixity
mkIfaceFixCache :: [(OccName, Fixity)] -> OccName -> Maybe Fixity
mkIfaceFixCache pairs
= \n -> lookupOccEnv env n `orElse` defaultFixity
= \n -> lookupOccEnv env n
where
env = mkOccEnv pairs
emptyIfaceFixCache :: OccName -> Fixity
emptyIfaceFixCache _ = defaultFixity
emptyIfaceFixCache :: OccName -> Maybe Fixity
emptyIfaceFixCache _ = Nothing
-- | Fixity environment mapping names to their fixities
type FixityEnv = NameEnv FixItem
......
......@@ -21,7 +21,8 @@ module RnEnv (
HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,
lookupSigCtxtOccRn,
lookupFixityRn, lookupFieldFixityRn, lookupTyFixityRn,
lookupFixityRn, lookupFixityRn_help,
lookupFieldFixityRn, lookupTyFixityRn,
lookupInstDeclBndr, lookupRecFieldOcc, lookupFamInstName,
lookupConstructorFields,
lookupSyntaxName, lookupSyntaxNames, lookupIfThenElse,
......@@ -1403,9 +1404,23 @@ lookupFixityRn :: Name -> RnM Fixity
lookupFixityRn name = lookupFixityRn' name (nameOccName name)
lookupFixityRn' :: Name -> OccName -> RnM Fixity
lookupFixityRn' name occ
lookupFixityRn' name = fmap snd . lookupFixityRn_help' name
-- | 'lookupFixityRn_help' returns @(True, fixity)@ if it finds a 'Fixity'
-- in a local environment or from an interface file. Otherwise, it returns
-- @(False, fixity)@ (e.g., for unbound 'Name's or 'Name's without
-- user-supplied fixity declarations).
lookupFixityRn_help :: Name
-> RnM (Bool, Fixity)
lookupFixityRn_help name =
lookupFixityRn_help' name (nameOccName name)
lookupFixityRn_help' :: Name
-> OccName
-> RnM (Bool, Fixity)
lookupFixityRn_help' name occ
| isUnboundName name
= return (Fixity minPrecedence InfixL)
= return (False, Fixity minPrecedence InfixL)
-- Minimise errors from ubound names; eg
-- a>0 `foo` b>0
-- where 'foo' is not in scope, should not give an error (Trac #7937)
......@@ -1413,14 +1428,14 @@ lookupFixityRn' name occ
| otherwise
= do { local_fix_env <- getFixityEnv
; case lookupNameEnv local_fix_env name of {
Just (FixItem _ fix) -> return fix ;
Just (FixItem _ fix) -> return (True, fix) ;
Nothing ->
do { this_mod <- getModule
; if nameIsLocalOrFrom this_mod name
-- Local (and interactive) names are all in the
-- fixity env, and don't have entries in the HPT
then return defaultFixity
then return (False, defaultFixity)
else lookup_imported } } }
where
lookup_imported
......@@ -1441,9 +1456,17 @@ lookupFixityRn' name occ
-- loadInterfaceForName will find B.hi even if B is a hidden module,
-- and that's what we want.
= do { iface <- loadInterfaceForName doc name
; traceRn (text "lookupFixityRn: looking up name in iface cache and found:" <+>
vcat [ppr name, ppr $ mi_fix_fn iface occ])
; return (mi_fix_fn iface occ) }
; let mb_fix = mi_fix_fn iface occ
; let msg = case mb_fix of
Nothing ->
text "looking up name" <+> ppr name
<+> text "in iface, but found no fixity for it."
<+> text "Using default fixity instead."
Just f ->
text "looking up name in iface and found:"
<+> vcat [ppr name, ppr f]
; traceRn (text "lookupFixityRn_either:" <+> msg)
; return (maybe (False, defaultFixity) (\f -> (True, f)) mb_fix) }
doc = ptext (sLit "Checking fixity for") <+> ppr name
......
......@@ -2107,7 +2107,7 @@ getDataConFixityFun tc
; return (lookupFixity fix_env) }
else do { iface <- loadInterfaceForName doc name
-- Should already be loaded!
; return (mi_fix_fn iface . nameOccName) } }
; return (mi_fix iface . nameOccName) } }
where
name = tyConName tc
doc = ptext (sLit "Data con fixities for") <+> ppr name
......
......@@ -1809,26 +1809,8 @@ reifySelector id tc
------------------------------
reifyFixity :: Name -> TcM (Maybe TH.Fixity)
reifyFixity name
= do { -- Repeat much of lookupFixityRn, because if we don't find a
-- user-supplied fixity declaration, we want to return Nothing
-- instead of defaultFixity
; env <- getFixityEnv
; case lookupNameEnv env name of
Just (FixItem _ fix) -> return (Just (conv_fix fix))
Nothing ->
do { this_mod <- getModule
; if nameIsLocalOrFrom this_mod name
then return Nothing
else
-- Do NOT use mi_fix_fn to look up the fixity,
-- because if there is a cache miss, it will return
-- defaultFixity, which we want to avoid
do { let doc = ptext (sLit "Checking fixity for")
<+> ppr name
; iface <- loadInterfaceForName doc name
; return . fmap conv_fix
. lookup (nameOccName name)
$ mi_fixities iface } } }
= do { (found, fix) <- lookupFixityRn_help name
; return (if found then Just (conv_fix fix) else Nothing) }
where
conv_fix (BasicTypes.Fixity i d) = TH.Fixity i (conv_dir d)
conv_dir BasicTypes.InfixR = TH.InfixR
......
......@@ -106,7 +106,7 @@ Language
programmers to easily specify how type parameters should be
instantiated when calling a function. See
:ref:`visible-type-application` for the details.
- To conform to the common case, the default role assigned to
parameters of datatypes declared in ``hs-boot`` files is
``representational``. However, if the constructor(s) for the datatype
......@@ -548,6 +548,14 @@ ghc
- Add ``isImport``, ``isDecl``, and ``isStmt`` functions.
- The `mi_fix_fn` field of `ModIface` had its type changed from
``OccName -> Fixity`` to ``OccName -> Maybe Fixity``, where a returned value
of ``Nothing`` indicates a cache miss. As a result, the types of
``mkIfaceFixCache`` and ``emptyIfaceFixCache`` were also changed to have a
return type of ``Maybe Fixity``, and a new ``mi_fix :: OccName -> Fixity``
function was introduced which invokes ``mi_fix_fn`` but returns
``defaultFixity`` upon a cache miss.
ghc-boot
~~~~~~~~
......
Markdown is supported
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