Refactor lookupFixityRn-related code following D1744
authorRyanGlScott <ryan.gl.scott@gmail.com>
Fri, 15 Jan 2016 15:37:18 +0000 (16:37 +0100)
committerBen Gamari <ben@smart-cactus.org>
Fri, 15 Jan 2016 15:37:20 +0000 (16:37 +0100)
Test Plan: ./validate

Reviewers: goldfire, austin, bgamari, simonpj

Subscribers: simonpj, thomie

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

GHC Trac Issues: #11345

compiler/iface/MkIface.hs
compiler/main/HscTypes.hs
compiler/rename/RnEnv.hs
compiler/typecheck/TcDeriv.hs
compiler/typecheck/TcSplice.hs
docs/users_guide/8.0.1-notes.rst

index 98f08fd..d44a197 100644 (file)
@@ -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]
index 9e04920..bb978d6 100644 (file)
@@ -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
index f2835b8..6b71abf 100644 (file)
@@ -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
 
index 3abc491..d40aca1 100644 (file)
@@ -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
index 16c0883..985798b 100644 (file)
@@ -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
index 80580e2..aaf9ca3 100644 (file)
@@ -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
 ~~~~~~~~