Fix deserialization of docs (#15240)

We were using Map.fromDistinctAscList to deserialize a
(Map Name HsDocString). As the Names' Uniques had changed, we
ended up with an invalid map in which we couldn't lookup certain keys.

Switching to Map.fromList fixed the issue.

Added comments in several places.

Reviewers: alexbiehl, hvr, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #15240

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

3 files changed, 29 insertions, 18 deletions

diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs
index 4e11276b6f..8fa60a8f64 100644
--- a/compiler/basicTypes/Name.hs
+++ b/compiler/basicTypes/Name.hs
@@ -454,10 +454,18 @@ stableNameCmp (Name { n_sort = s1, n_occ = occ1 })
 ************************************************************************
 -}
 
+-- | The same comments as for `Name`'s `Ord` instance apply.
 instance Eq Name where
     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
     a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
 
+-- | __Caution__: This instance is implemented via `nonDetCmpUnique`, which
+-- means that the ordering is not stable across deserialization or rebuilds.
+--
+-- See `nonDetCmpUnique` for further information, and trac #15240 for a bug
+-- caused by improper use of this instance.
+
+-- For a deterministic lexicographic ordering, use `stableNameCmp`.
 instance Ord Name where
     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
diff --git a/compiler/hsSyn/HsDoc.hs b/compiler/hsSyn/HsDoc.hs
index ed887636a6..affbf1bac0 100644
--- a/compiler/hsSyn/HsDoc.hs
+++ b/compiler/hsSyn/HsDoc.hs
@@ -118,8 +118,10 @@ concatDocs xs =
 newtype DeclDocMap = DeclDocMap (Map Name HsDocString)
 
 instance Binary DeclDocMap where
-  put_ bh (DeclDocMap m) = put_ bh (Map.toAscList m)
-  get bh = DeclDocMap . Map.fromDistinctAscList <$> get bh
+  put_ bh (DeclDocMap m) = put_ bh (Map.toList m)
+  -- We can't rely on a deterministic ordering of the `Name`s here.
+  -- See the comments on `Name`'s `Ord` instance for context.
+  get bh = DeclDocMap . Map.fromList <$> get bh
 
 instance Outputable DeclDocMap where
   ppr (DeclDocMap m) = vcat (map pprPair (Map.toAscList m))
@@ -133,9 +135,10 @@ emptyDeclDocMap = DeclDocMap Map.empty
 newtype ArgDocMap = ArgDocMap (Map Name (Map Int HsDocString))
 
 instance Binary ArgDocMap where
-  put_ bh (ArgDocMap m) = put_ bh (Map.toAscList (Map.toAscList <$> m))
-  get bh = ArgDocMap . fmap Map.fromDistinctAscList . Map.fromDistinctAscList
-             <$> get bh
+  put_ bh (ArgDocMap m) = put_ bh (Map.toList (Map.toAscList <$> m))
+  -- We can't rely on a deterministic ordering of the `Name`s here.
+  -- See the comments on `Name`'s `Ord` instance for context.
+  get bh = ArgDocMap . fmap Map.fromDistinctAscList . Map.fromList <$> get bh
 
 instance Outputable ArgDocMap where
   ppr (ArgDocMap m) = vcat (map pprPair (Map.toAscList m))
diff --git a/testsuite/tests/showIface/DocsInHiFile1.stdout b/testsuite/tests/showIface/DocsInHiFile1.stdout
index fcb5f94f71..2576c2560c 100644
--- a/testsuite/tests/showIface/DocsInHiFile1.stdout
+++ b/testsuite/tests/showIface/DocsInHiFile1.stdout
@@ -4,28 +4,25 @@ module header:
 '<>', ':=:', 'Bool'
 "
 declaration docs:
-  D':
-    " Another datatype...
-
- ...with two docstrings."
-  P:
-    " A class"
-  p:
-    " A class method"
+  elem:
+    " '()', 'elem'."
   D:
     " A datatype."
   D0:
     " A constructor for 'D'. '"
   D1:
     " Another constructor"
-  elem:
-    " '()', 'elem'."
+  P:
+    " A class"
+  p:
+    " A class method"
   $fShowD:
     " 'Show' instance"
+  D':
+    " Another datatype...
+
+ ...with two docstrings."
 arg docs:
-  p:
-    0:
-      " An argument"
   add:
     0:
       " First summand for 'add'"
@@ -33,4 +30,7 @@ arg docs:
       " Second summand"
     2:
       " Sum"
+  p:
+    0:
+      " An argument"