Skip to content

Commit

Permalink
Merge branch 'master' into fisx/fix-file-search
Browse files Browse the repository at this point in the history
  • Loading branch information
ocharles authored Aug 10, 2024
2 parents 0dae376 + 1cb230b commit f9f9756
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 12 deletions.
31 changes: 20 additions & 11 deletions src/Weeder.hs
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,7 @@ import GHC.Generics ( Generic )
import Prelude hiding ( span )

-- containers
import Data.Containers.ListUtils ( nubOrd )
import Data.Map.Strict ( Map )
import qualified Data.Map.Strict as Map
import Data.Sequence ( Seq )
Expand Down Expand Up @@ -730,22 +731,30 @@ requestEvidence n d = do
}


-- | Follow the given evidence uses back to their instance bindings,
-- and connect the declaration to those bindings.
followEvidenceUses :: RefMap TypeIndex -> Declaration -> Set Name -> Graph Declaration
followEvidenceUses refMap d names =
let getEvidenceTrees = mapMaybe (getEvidenceTree refMap) . Set.toList
evidenceInfos = concatMap Tree.flatten (getEvidenceTrees names)
-- | Follow the given evidence use back to their instance bindings
followEvidenceUses :: RefMap TypeIndex -> Name -> [Declaration]
followEvidenceUses rf name =
let evidenceInfos = maybe [] (nubOrd . Tree.flatten) (getEvidenceTree rf name)
-- Often, we get duplicates in the flattened evidence trees. Sometimes, it's
-- just one or two elements and other times there are 5x as many
instanceEvidenceInfos = evidenceInfos & filter \case
EvidenceInfo _ _ _ (Just (EvInstBind _ _, ModuleScope, _)) -> True
_ -> False
evBindSiteDecls = mapMaybe (nameToDeclaration . evidenceVar) instanceEvidenceInfos
in star d evBindSiteDecls
in mapMaybe (nameToDeclaration . evidenceVar) instanceEvidenceInfos


-- | Follow evidence uses listed under 'requestedEvidence' back to their
-- | Follow evidence uses listed under 'requestedEvidence' back to their
-- instance bindings, and connect their corresponding declaration to those bindings.
analyseEvidenceUses :: RefMap TypeIndex -> Analysis -> Analysis
analyseEvidenceUses rf a@Analysis{ requestedEvidence, dependencyGraph } =
let graphs = map (uncurry (followEvidenceUses rf)) $ Map.toList requestedEvidence
analyseEvidenceUses rf a@Analysis{ requestedEvidence, dependencyGraph } = do
let combinedNames = mconcat (Map.elems requestedEvidence)
-- We combine all the names in all sets into one set, because the names
-- are duplicated a lot. In one example, the number of elements in the
-- combined sizes of all the sets are 16961625 as opposed to the
-- number of elements by combining all sets into one: 200330, that's an
-- 80x difference!
declMap = Map.fromSet (followEvidenceUses rf) combinedNames
-- Map.! is safe because declMap contains all elements of v by definition
graphs = map (\(d, v) -> star d ((nubOrd $ foldMap (declMap Map.!) v)))
(Map.toList requestedEvidence)
in a { dependencyGraph = overlays (dependencyGraph : graphs) }
2 changes: 1 addition & 1 deletion weeder.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,7 @@ library
, generic-lens ^>= 2.2.0.0
, ghc ^>= 9.4 || ^>= 9.6 || ^>= 9.8
, Glob ^>= 0.9 || ^>= 0.10
, lens ^>= 5.1 || ^>= 5.2
, lens ^>= 5.1 || ^>= 5.2 || ^>= 5.3
, mtl ^>= 2.2.2 || ^>= 2.3
, optparse-applicative ^>= 0.14.3.0 || ^>= 0.15.1.0 || ^>= 0.16.0.0 || ^>= 0.17 || ^>= 0.18.1.0
, parallel ^>= 3.2.0.0
Expand Down

0 comments on commit f9f9756

Please sign in to comment.