From cb495b3cb416be82e36dbb4eca10a68743ebc549 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Tue, 23 Jul 2019 14:30:46 -0400
Subject: [PATCH] Make DefUses = OrdList DefUse
Before, `type DefUses = [DefUse]`. But lists are a terrible choice of
data structure here, as we frequently append to the right of a
`DefUses`, which yields some displeasing asymptotics. Let's instead
use `OrdList`, which has constant-time appending to the right.
This is one step on the way to #10347.
---
compiler/basicTypes/NameSet.hs | 11 ++++++-----
compiler/rename/RnBinds.hs | 3 ++-
compiler/rename/RnSource.hs | 3 ++-
3 files changed, 10 insertions(+), 7 deletions(-)
diff --git a/compiler/basicTypes/NameSet.hs b/compiler/basicTypes/NameSet.hs
index 76b66265897f..1605deb9af2c 100644
--- a/compiler/basicTypes/NameSet.hs
+++ b/compiler/basicTypes/NameSet.hs
@@ -36,6 +36,7 @@ module NameSet (
import GhcPrelude
import Name
+import OrdList
import UniqSet
import Data.List (sortBy)
@@ -160,19 +161,19 @@ type DefUse = (Maybe Defs, Uses)
-- | A number of 'DefUse's in dependency order: earlier 'Defs' scope over later 'Uses'
-- In a single (def, use) pair, the defs also scope over the uses
-type DefUses = [DefUse]
+type DefUses = OrdList DefUse
emptyDUs :: DefUses
-emptyDUs = []
+emptyDUs = nilOL
usesOnly :: Uses -> DefUses
-usesOnly uses = [(Nothing, uses)]
+usesOnly uses = unitOL (Nothing, uses)
mkDUs :: [(Defs,Uses)] -> DefUses
-mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]
+mkDUs pairs = toOL [(Just defs, uses) | (defs,uses) <- pairs]
plusDU :: DefUses -> DefUses -> DefUses
-plusDU = (++)
+plusDU = appOL
duDefs :: DefUses -> Defs
duDefs dus = foldr get emptyNameSet dus
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index db215522217e..d756272e266a 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -56,6 +56,7 @@ import Util
import Outputable
import UniqSet
import Maybes ( orElse )
+import OrdList
import qualified GHC.LanguageExtensions as LangExt
import Control.Monad
@@ -568,7 +569,7 @@ depAnalBinds :: Bag (LHsBind GhcRn, [Name], Uses)
-- Dependency analysis; this is important so that
-- unused-binding reporting is accurate
depAnalBinds binds_w_dus
- = (map get_binds sccs, map get_du sccs)
+ = (map get_binds sccs, toOL $ map get_du sccs)
where
sccs = depAnal (\(_, defs, _) -> defs)
(\(_, _, uses) -> nonDetEltsUniqSet uses)
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index a9b3c3f2838e..aea4b0d5eb3c 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -62,6 +62,7 @@ import ListSetOps ( findDupsEq, removeDups, equivClasses )
import Digraph ( SCC, flattenSCC, flattenSCCs, Node(..)
, stronglyConnCompFromEdgedVerticesUniq )
import UniqSet
+import OrdList
import qualified GHC.LanguageExtensions as LangExt
import Control.Monad
@@ -217,7 +218,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls,
src_fvs5, src_fvs6, src_fvs7] ;
-- It is tiresome to gather the binders from type and class decls
- src_dus = [other_def] `plusDU` bind_dus `plusDU` usesOnly other_fvs ;
+ src_dus = unitOL other_def `plusDU` bind_dus `plusDU` usesOnly other_fvs ;
-- Instance decls may have occurrences of things bound in bind_dus
-- so we must put other_fvs last
--
GitLab