Commit 7e7fd8cb authored by wz1000's avatar wz1000

record superclass parent selectors, improve validation

parent 5dfc34f8
Pipeline #19534 failed with stages
in 12 minutes and 30 seconds
......@@ -107,28 +107,23 @@ validAst (Node _ span children) = do
-- | Look for any identifiers which occur outside of their supposed scopes.
-- Returns a list of error messages.
validateScopes :: Module -> M.Map FastString (HieAST a) -> [SDoc]
validateScopes mod asts = validScopes ++ validEvLets
validateScopes mod asts = validScopes ++ validEvs
where
refMap = generateReferencesMap asts
-- We use a refmap for most of the computation
-- Check if everything on the RHS of an EvLet binding is also bound
-- somewhere in the AST
validEvLets = concatMap evVarInScope evletrhs
evs = M.keys
$ M.filter (any isEvidenceContext . concatMap (S.toList . identInfo . snd)) refMap
-- Check if a given evidence variable is bound
evVarInScope n = case M.lookup (Right n) refMap of
Nothing -> return $ hsep ["Local evidence variable:", ppr n
, "occuring in the rhs of a EvLet doesn't appear in the refmap"]
Just xs
| any (any isEvidenceBind) (map (identInfo . snd) xs) -> []
| otherwise -> return $ hsep ["Local evidence variable:"
, ppr n, "occuring in the rhs of a EvLet isn't bound in the refmap"]
-- All the evidence variables occuring on the RHS of an EvLet
evletrhs = S.fromList $ concatMap (evLets . identInfo . snd)
$ concat $ M.elems refMap
evLets = concatMap getEvidenceBindDeps
validEvs = do
i@(Right ev) <- evs
case M.lookup i refMap of
Nothing -> ["Impossible, ev"<+> ppr ev <+> "not found in refmap" ]
Just refs
| nameIsLocalOrFrom mod ev
, not (any isEvidenceBind . concatMap (S.toList . identInfo . snd) $ refs)
-> ["Evidence var" <+> ppr ev <+> "not bound in refmap"]
| otherwise -> []
-- Check if all the names occur in their calculated scopes
validScopes = M.foldrWithKey (\k a b -> valid k a ++ b) [] refMap
......@@ -145,9 +140,9 @@ validateScopes mod asts = validScopes ++ validEvLets
-- We validate scopes for names which are defined locally, and occur
-- in this span, or are evidence variables
= case scopes of
[] | any isEvidenceContext (identInfo dets)
|| (nameIsLocalOrFrom mod n
&& not (isDerivedOccName $ nameOccName n))
[] | nameIsLocalOrFrom mod n
, ( not (isDerivedOccName $ nameOccName n)
|| any isEvidenceContext (identInfo dets))
-- If we don't get any scopes for a local name or
-- an evidence variable, then its an error.
-- We can ignore other kinds of derived names as
......
......@@ -501,7 +501,7 @@ data EvVarSource
| EvSigBind -- ^ bound by a type signature
| EvWrapperBind -- ^ bound by a hswrapper
| EvImplicitBind -- ^ bound by an implicit variable
| EvInstBind Name -- ^ Bound by some instance of given class
| EvInstBind { isSuperInst :: Bool, cls :: Name } -- ^ Bound by some instance of given class
| EvLetBind EvBindDeps -- ^ A direct let binding
deriving (Eq,Ord)
......@@ -510,8 +510,9 @@ instance Binary EvVarSource where
put_ bh EvSigBind = putByte bh 1
put_ bh EvWrapperBind = putByte bh 2
put_ bh EvImplicitBind = putByte bh 3
put_ bh (EvInstBind cls) = do
put_ bh (EvInstBind b cls) = do
putByte bh 4
put_ bh b
put_ bh cls
put_ bh (EvLetBind deps) = do
putByte bh 5
......@@ -524,7 +525,7 @@ instance Binary EvVarSource where
1 -> pure EvSigBind
2 -> pure EvWrapperBind
3 -> pure EvImplicitBind
4 -> EvInstBind <$> get bh
4 -> EvInstBind <$> get bh <*> get bh
5 -> EvLetBind <$> get bh
_ -> panic "Binary EvVarSource: invalid tag"
......@@ -533,7 +534,8 @@ instance Outputable EvVarSource where
ppr EvSigBind = text "bound by a type signature"
ppr EvWrapperBind = text "bound by a HsWrapper"
ppr EvImplicitBind = text "bound by an implicit variable binding"
ppr (EvInstBind cls) = text "bound by an instance of class" <+> ppr cls
ppr (EvInstBind False cls) = text "bound by an instance of class" <+> ppr cls
ppr (EvInstBind True cls) = text "bound due to a superclass of " <+> ppr cls
ppr (EvLetBind deps) = text "bound by a let, depending on:" <+> ppr deps
-- | Eq/Ord instances compare on the converted HieName,
......
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