[Git][ghc/ghc][wip/romes/25304] determinism: Interface re-export list det

Rodrigo Mesquita (@alt-romes) gitlab at gitlab.haskell.org
Mon Oct 7 15:14:29 UTC 2024



Rodrigo Mesquita pushed to branch wip/romes/25304 at Glasgow Haskell Compiler / GHC


Commits:
77d2c1d9 by Rodrigo Mesquita at 2024-10-07T16:14:16+01:00
determinism: Interface re-export list det

In 'DocStructureItem' we want to make sure the 'Avails' are sorted, for
interface file determinism. This commit introduces 'SortedAvails', an
abstract newtype that can only be constructed by sorting Avails with
'sortAvails'. This newtype is used by 'DocStructureItem' where 'Avails'
was previously used to ensure the list of avails is deterministically
sorted by construction.

Note: Even though we order the constructors and avails in the interface
file, the order of constructors in the haddock output is still
determined from the order of declaration in the source. This was also
true before, when the list of constructors in the interface file <docs>
section was non-deterministic. Some haddock tests such as
"ConstructorArgs" observe this (check the order of constructors in
out/ConstructorArgs.html vs src/ConstructorArgs.hs vs its interface file)

The updated tests are caused by haddock corners where the order in the
source is not preserved (and was non-deterministic before this PR):
    * Module header in the latex backend
    * Re-export of pattern synonyms associated to a datatype (#25342)

Fixes #25304

- - - - -


17 changed files:

- compiler/GHC/Hs/Doc.hs
- compiler/GHC/HsToCore/Docs.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Types/Avail.hs
- + testsuite/tests/determinism/T25304/A.hs
- + testsuite/tests/determinism/T25304/B.hs
- + testsuite/tests/determinism/T25304/Makefile
- + testsuite/tests/determinism/T25304/T25304a.stdout
- + testsuite/tests/determinism/T25304/all.T
- testsuite/tests/showIface/DocsInHiFileTH.stdout
- testsuite/tests/showIface/NoExportList.stdout
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
- utils/haddock/html-test/ref/BundledPatterns2.html
- utils/haddock/latex-test/ref/ConstructorArgs/ConstructorArgs.tex
- utils/haddock/latex-test/ref/DefaultSignatures/DefaultSignatures.tex
- utils/haddock/latex-test/ref/GadtConstructorArgs/GadtConstructorArgs.tex
- utils/haddock/latex-test/ref/TypeFamilies3/TypeFamilies3.tex


Changes:

=====================================
compiler/GHC/Hs/Doc.hs
=====================================
@@ -124,7 +124,7 @@ data DocStructureItem
   = DsiSectionHeading !Int !(HsDoc GhcRn)
   | DsiDocChunk !(HsDoc GhcRn)
   | DsiNamedChunkRef !String
-  | DsiExports !Avails
+  | DsiExports !SortedAvails
   | DsiModExport
       !(NonEmpty ModuleName) -- ^ We might re-export avails from multiple
                             -- modules with a single export declaration. E.g.
@@ -136,7 +136,7 @@ data DocStructureItem
                             --
                             -- Invariant: This list of ModuleNames must be
                             -- sorted to guarantee interface file determinism.
-      !Avails
+      !SortedAvails
                             -- ^ Invariant: This list of Avails must be sorted
                             -- to guarantee interface file determinism.
 


=====================================
compiler/GHC/HsToCore/Docs.hs
=====================================
@@ -160,7 +160,11 @@ mkDocStructureFromExportList mdl import_avails export_list =
       (IEGroup _ level doc, _)         -> DsiSectionHeading level (unLoc doc)
       (IEDoc _ doc, _)                 -> DsiDocChunk (unLoc doc)
       (IEDocNamed _ name, _)           -> DsiNamedChunkRef name
-      (_, avails)                      -> DsiExports (nubAvails avails)
+      (IEThingWith{}, avails)          ->
+        DsiExports $
+          {- For explicit export lists, use the explicit order. It is deterministic by construction -}
+          UnsafeSortedAvails (nubAvails avails)
+      (_, avails)                      -> DsiExports (sortAvails (nubAvails avails))
 
     moduleExport :: ModuleName -- Alias
                  -> Avails
@@ -201,10 +205,10 @@ mkDocStructureFromDecls env all_exports decls =
     avails :: [Located DocStructureItem]
     avails = flip fmap all_exports $ \avail ->
       case M.lookup (availName avail) name_locs of
-        Just loc -> L loc (DsiExports [avail])
+        Just loc -> L loc (DsiExports (sortAvails [avail]))
         -- FIXME: This is just a workaround that we use when handling e.g.
         -- associated data families like in the html-test Instances.hs.
-        Nothing -> noLoc (DsiExports [])
+        Nothing -> noLoc (DsiExports (sortAvails []))
 
         -- This causes the associated data family to be incorrectly documented
         -- separately from its class:


=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -518,8 +518,8 @@ mkIfaceImports = map go
     go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))
     go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)
 
-mkIfaceExports :: [AvailInfo] -> [IfaceExport]  -- Sort to make canonical
-mkIfaceExports = sortAvails
+mkIfaceExports :: [AvailInfo] -> [IfaceExport] -- Sort to make canonical
+mkIfaceExports as = case sortAvails as of SortedAvails sas -> sas
 
 {-
 Note [Original module]


=====================================
compiler/GHC/Types/Avail.hs
=====================================
@@ -1,5 +1,7 @@
 
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE PatternSynonyms #-}
 --
 -- (c) The University of Glasgow
 --
@@ -20,6 +22,7 @@ module GHC.Types.Avail (
     filterAvails,
     nubAvails,
     sortAvails,
+    SortedAvails(SortedAvails, UnsafeSortedAvails)
   ) where
 
 import GHC.Prelude
@@ -65,6 +68,20 @@ data AvailInfo
 -- | A collection of 'AvailInfo' - several things that are \"available\"
 type Avails = [AvailInfo]
 
+-- | Occurrences of Avails in interface files must be sorted to guarantee
+-- interface file determinism.
+--
+-- To construct 'SortedAvails' using 'UnsafeSortedAvails' you must be sure the
+-- 'Avails' are already sorted. Otherwise, you should use 'sortAvails'.
+newtype SortedAvails = UnsafeSortedAvails Avails
+  deriving newtype (Binary, Outputable, NFData)
+
+-- | Safe matching on 'SortedAvails'
+-- To construct 'SortedAvails' use 'sortAvails'.
+pattern SortedAvails :: Avails -> SortedAvails
+pattern SortedAvails x <- UnsafeSortedAvails x
+{-# COMPLETE SortedAvails #-}
+
 {- Note [Representing pattern synonym fields in AvailInfo]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Record pattern synonym fields cannot be represented using AvailTC like fields of
@@ -133,8 +150,8 @@ availSubordinateNames avail@(AvailTC _ ns)
   | otherwise              = ns
 
 -- | Sort 'Avails'/'AvailInfo's
-sortAvails :: Avails -> Avails
-sortAvails = sortBy stableAvailCmp . map sort_subs
+sortAvails :: Avails -> SortedAvails
+sortAvails = UnsafeSortedAvails . sortBy stableAvailCmp . map sort_subs
   where
     sort_subs :: AvailInfo -> AvailInfo
     sort_subs (Avail n) = Avail n


=====================================
testsuite/tests/determinism/T25304/A.hs
=====================================
@@ -0,0 +1,84 @@
+module A
+  ( MyType(..)
+  ) where
+
+data MyType
+    = A
+    | B
+    | C
+    | D
+    | E
+    | F
+    | G
+    | H
+    | I
+    | J
+    | K
+    | L
+    | M
+    | N
+    | O
+    | P
+    | Q
+    | R
+    | S
+    | T
+    | U
+    | V
+    | W
+    | X
+    | Y
+    | Z
+    | AA
+    | AB
+    | AC
+    | AD
+    | AE
+    | AF
+    | AG
+    | AH
+    | AI
+    | AJ
+    | AK
+    | AL
+    | AM
+    | AN
+    | AO
+    | AP
+    | AQ
+    | AR
+    | AS
+    | AT
+    | AU
+    | AV
+    | AW
+    | AX
+    | AY
+    | AZ
+    | BA
+    | BB
+    | BC
+    | BD
+    | BE
+    | BF
+    | BG
+    | BH
+    | BI
+    | BJ
+    | BK
+    | BL
+    | BM
+    | BN
+    | BO
+    | BP
+    | BQ
+    | BR
+    | BS
+    | BT
+    | BU
+    | BV
+    | BW
+    | BX
+    | BY
+    | BZ
+    | CA


=====================================
testsuite/tests/determinism/T25304/B.hs
=====================================
@@ -0,0 +1,86 @@
+module B
+( MyType
+    ( BA
+    , BB
+    , BC
+    , BD
+    , BE
+    , BF
+    , BG
+    , BH
+    , BI
+    , BJ
+    , BK
+    , BL
+    , BM
+    , BN
+    , BO
+    , BP
+    , BQ
+    , BR
+    , BS
+    , BT
+    , BU
+    , BV
+    , BW
+    , BX
+    , BY
+    , BZ
+    , CA
+    , AA
+    , AB
+    , AC
+    , AD
+    , AE
+    , AF
+    , AG
+    , AH
+    , AI
+    , AJ
+    , AK
+    , AL
+    , AM
+    , AN
+    , AO
+    , AP
+    , AQ
+    , AR
+    , AS
+    , AT
+    , AU
+    , AV
+    , AW
+    , AX
+    , AY
+    , AZ
+    , A
+    , B
+    , C
+    , D
+    , E
+    , F
+    , G
+    , H
+    , I
+    , J
+    , K
+    , L
+    , M
+    , N
+    , O
+    , P
+    , Q
+    , R
+    , S
+    , T
+    , U
+    , V
+    , W
+    , X
+    , Y
+    , Z
+    )
+) where
+
+import A
+


=====================================
testsuite/tests/determinism/T25304/Makefile
=====================================
@@ -0,0 +1,25 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T25304:
+	$(RM) A.hi A.o B.hi B.o
+	# Use -haddock to get docs: output in the interface file
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -haddock B.hs
+	'$(TEST_HC)' --show-iface A.hi > A_clean_iface
+	'$(TEST_HC)' --show-iface B.hi > B_clean_iface
+	'$(TEST_HC)' $(TEST_HC_OPTS) -dinitial-unique=16777215 -dunique-increment=-1 -v0 -haddock A.hs B.hs -fforce-recomp
+	'$(TEST_HC)' --show-iface A.hi > A_dirty_iface
+	'$(TEST_HC)' --show-iface B.hi > B_dirty_iface
+	diff A_clean_iface A_dirty_iface
+	diff B_clean_iface B_dirty_iface
+
+T25304a:
+	$(RM) A.hi A.o B.hi B.o
+	# Use -haddock to get docs: output in the interface file
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -haddock B.hs
+	'$(TEST_HC)' --show-iface B.hi > B_clean_iface
+	# The goal is to see the export list in the documentation structure of the
+	# interface file preserves the order used in the source
+	cat B_clean_iface | grep -A7 "documentation structure"
+


=====================================
testsuite/tests/determinism/T25304/T25304a.stdout
=====================================
@@ -0,0 +1,8 @@
+       documentation structure:
+         avails:
+           [A.MyType{A.MyType, A.BA, A.BB, A.BC, A.BD, A.BE, A.BF, A.BG, A.BH,
+                     A.BI, A.BJ, A.BK, A.BL, A.BM, A.BN, A.BO, A.BP, A.BQ, A.BR, A.BS,
+                     A.BT, A.BU, A.BV, A.BW, A.BX, A.BY, A.BZ, A.CA, A.AA, A.AB, A.AC,
+                     A.AD, A.AE, A.AF, A.AG, A.AH, A.AI, A.AJ, A.AK, A.AL, A.AM, A.AN,
+                     A.AO, A.AP, A.AQ, A.AR, A.AS, A.AT, A.AU, A.AV, A.AW, A.AX, A.AY,
+                     A.AZ, A.A, A.B, A.C, A.D, A.E, A.F, A.G, A.H, A.I, A.J, A.K, A.L,


=====================================
testsuite/tests/determinism/T25304/all.T
=====================================
@@ -0,0 +1,2 @@
+test('T25304', [extra_files(['A.hs', 'B.hs'])], makefile_test, ['T25304'])
+test('T25304a', [extra_files(['A.hs', 'B.hs'])], makefile_test, ['T25304a'])


=====================================
testsuite/tests/showIface/DocsInHiFileTH.stdout
=====================================
@@ -187,7 +187,7 @@ docs:
          avails:
            [i]
          avails:
-           [WD11{WD11, WD11Bool, WD11Int, WD11Foo}]
+           [WD11{WD11, WD11Bool, WD11Foo, WD11Int}]
          avails:
            [WD13{WD13}]
          avails:
@@ -221,11 +221,11 @@ docs:
          avails:
            [Pretty{Pretty, prettyPrint}]
          avails:
-           [Corge{Corge, runCorge, Corge}]
+           [Corge{Corge, Corge, runCorge}]
          avails:
-           [Quuz{Quuz, quuz1_a, Quuz}]
+           [Quuz{Quuz, Quuz, quuz1_a}]
          avails:
-           [Quux{Quux, Quux2, Quux1}]
+           [Quux{Quux, Quux1, Quux2}]
          avails:
            [Tup2]
          avails:


=====================================
testsuite/tests/showIface/NoExportList.stdout
=====================================
@@ -32,7 +32,7 @@ docs:
 -- Actually we have only one type.
            identifiers:
          avails:
-           [R{R, fβ, fα, R}]
+           [R{R, R, fα, fβ}]
          section heading, level 1:
            text:
              -- * Functions


=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
=====================================
@@ -201,7 +201,14 @@ createInterface1' flags unit_state dflags hie_file mod_iface ifaces inst_ifaces
   -- See Note [Exporting built-in items]
   let builtinTys = DsiSectionHeading 1 (WithHsDocIdentifiers (mkGeneratedHsDocString "Builtin syntax") [])
       bonus_ds mods
-        | mdl == gHC_PRIM = [builtinTys, DsiExports funAvail] <> mods
+        | mdl == gHC_PRIM =
+            [ builtinTys
+            , DsiExports $
+                {- Haddock does not want to sort avails, the order should be derived from the source.
+                   In this particular case, sorting funAvail would be a no-op anyway. -}
+                UnsafeSortedAvails
+                  funAvail
+            ] <> mods
         | otherwise = mods
 
   let
@@ -461,11 +468,11 @@ mkExportItems
             Just hsDoc' -> do
               doc <- processDocStringParas parserOpts sDocContext pkgName hsDoc'
               pure [ExportDoc doc]
-        DsiExports avails ->
+        DsiExports (SortedAvails avails) ->
           -- TODO: We probably don't need nubAvails here.
           -- mkDocStructureFromExportList already uses it.
           concat <$> traverse availExport (nubAvails avails)
-        DsiModExport mod_names avails -> do
+        DsiModExport mod_names (SortedAvails avails) -> do
           -- only consider exporting a module if we are sure we are really
           -- exporting the whole module and not some subset.
           (unrestricted_mods, remaining_avails) <- unrestrictedModExports sDocContext thisMod modMap instIfaceMap avails (NE.toList mod_names)


=====================================
utils/haddock/html-test/ref/BundledPatterns2.html
=====================================
@@ -96,14 +96,6 @@
 	      >where</span
 	      ><ul class="subs"
 	      ><li
-		><span class="keyword"
-		  >pattern</span
-		  > <a href="#"
-		  >LR</a
-		  > :: a -> <a href="#" title="BundledPatterns2"
-		  >RTree</a
-		  > 0 a</li
-		><li
 		><span class="keyword"
 		  >pattern</span
 		  > <a href="#"
@@ -117,6 +109,14 @@
 		  > (d <a href="#" title="GHC.TypeLits"
 		  >+</a
 		  > 1) a</li
+		><li
+		><span class="keyword"
+		  >pattern</span
+		  > <a href="#"
+		  >LR</a
+		  > :: a -> <a href="#" title="BundledPatterns2"
+		  >RTree</a
+		  > 0 a</li
 		></ul
 	      ></li
 	    ></ul
@@ -318,28 +318,34 @@
 	      ><td class="src"
 		><span class="keyword"
 		  >pattern</span
-		  > <a id="v:LR" class="def"
-		  >LR</a
-		  > :: a -> <a href="#" title="BundledPatterns2"
+		  > <a id="v:BR" class="def"
+		  >BR</a
+		  > :: <a href="#" title="BundledPatterns2"
 		  >RTree</a
-		  > 0 a</td
+		  > d a -> <a href="#" title="BundledPatterns2"
+		  >RTree</a
+		  > d a -> <a href="#" title="BundledPatterns2"
+		  >RTree</a
+		  > (d <a href="#" title="GHC.TypeLits"
+		  >+</a
+		  > 1) a</td
 		><td class="doc"
 		><p
-		  >Leaf of a perfect depth tree</p
+		  >Branch of a perfect depth tree</p
 		  ><pre class="screen"
 		  ><code class="prompt"
 		    >>>> </code
 		    ><strong class="userinput"
 		    ><code
-		      >LR 1
+		      >BR (LR 1) (LR 2)
 </code
 		      ></strong
-		    >1
+		    ><1,2>
 <code class="prompt"
 		    >>>> </code
 		    ><strong class="userinput"
 		    ><code
-		      >let x = LR 1
+		      >let x = BR (LR 1) (LR 2)
 </code
 		      ></strong
 		    ><code class="prompt"
@@ -349,16 +355,16 @@
 		      >:t x
 </code
 		      ></strong
-		    >x :: Num a => RTree 0 a
+		    >x :: Num a => RTree 1 a
 </pre
 		  ><p
-		  >Can be used as a pattern:</p
+		  >Case be used a pattern:</p
 		  ><pre class="screen"
 		  ><code class="prompt"
 		    >>>> </code
 		    ><strong class="userinput"
 		    ><code
-		      >let f (LR a) (LR b) = a + b
+		      >let f (BR (LR a) (LR b)) = LR (a + b)
 </code
 		      ></strong
 		    ><code class="prompt"
@@ -368,12 +374,12 @@
 		      >:t f
 </code
 		      ></strong
-		    >f :: Num a => RTree 0 a -> RTree 0 a -> a
+		    >f :: Num a => RTree 1 a -> RTree 0 a
 <code class="prompt"
 		    >>>> </code
 		    ><strong class="userinput"
 		    ><code
-		      >f (LR 1) (LR 2)
+		      >f (BR (LR 1) (LR 2))
 </code
 		      ></strong
 		    >3
@@ -384,34 +390,28 @@
 	      ><td class="src"
 		><span class="keyword"
 		  >pattern</span
-		  > <a id="v:BR" class="def"
-		  >BR</a
-		  > :: <a href="#" title="BundledPatterns2"
-		  >RTree</a
-		  > d a -> <a href="#" title="BundledPatterns2"
-		  >RTree</a
-		  > d a -> <a href="#" title="BundledPatterns2"
+		  > <a id="v:LR" class="def"
+		  >LR</a
+		  > :: a -> <a href="#" title="BundledPatterns2"
 		  >RTree</a
-		  > (d <a href="#" title="GHC.TypeLits"
-		  >+</a
-		  > 1) a</td
+		  > 0 a</td
 		><td class="doc"
 		><p
-		  >Branch of a perfect depth tree</p
+		  >Leaf of a perfect depth tree</p
 		  ><pre class="screen"
 		  ><code class="prompt"
 		    >>>> </code
 		    ><strong class="userinput"
 		    ><code
-		      >BR (LR 1) (LR 2)
+		      >LR 1
 </code
 		      ></strong
-		    ><1,2>
+		    >1
 <code class="prompt"
 		    >>>> </code
 		    ><strong class="userinput"
 		    ><code
-		      >let x = BR (LR 1) (LR 2)
+		      >let x = LR 1
 </code
 		      ></strong
 		    ><code class="prompt"
@@ -421,16 +421,16 @@
 		      >:t x
 </code
 		      ></strong
-		    >x :: Num a => RTree 1 a
+		    >x :: Num a => RTree 0 a
 </pre
 		  ><p
-		  >Case be used a pattern:</p
+		  >Can be used as a pattern:</p
 		  ><pre class="screen"
 		  ><code class="prompt"
 		    >>>> </code
 		    ><strong class="userinput"
 		    ><code
-		      >let f (BR (LR a) (LR b)) = LR (a + b)
+		      >let f (LR a) (LR b) = a + b
 </code
 		      ></strong
 		    ><code class="prompt"
@@ -440,12 +440,12 @@
 		      >:t f
 </code
 		      ></strong
-		    >f :: Num a => RTree 1 a -> RTree 0 a
+		    >f :: Num a => RTree 0 a -> RTree 0 a -> a
 <code class="prompt"
 		    >>>> </code
 		    ><strong class="userinput"
 		    ><code
-		      >f (BR (LR 1) (LR 2))
+		      >f (LR 1) (LR 2)
 </code
 		      ></strong
 		    >3


=====================================
utils/haddock/latex-test/ref/ConstructorArgs/ConstructorArgs.tex
=====================================
@@ -3,7 +3,7 @@
 \haddockbeginheader
 {\haddockverb\begin{verbatim}
 module ConstructorArgs (
-    Foo((:|), Rec, x, y, Baz, Boa, (:*)), Boo(Foo, Foa, Fo, Fo'), pattern Bo,
+    Foo((:*), (:|), Baz, Boa, Rec, x, y), Boo(Foo, Foa, Fo, Fo'), pattern Bo,
     pattern Bo'
   ) where\end{verbatim}}
 \haddockendheader


=====================================
utils/haddock/latex-test/ref/DefaultSignatures/DefaultSignatures.tex
=====================================
@@ -3,7 +3,7 @@
 \haddockbeginheader
 {\haddockverb\begin{verbatim}
 module DefaultSignatures (
-    Foo(baz', baz, bar)
+    Foo(bar, baz, baz')
   ) where\end{verbatim}}
 \haddockendheader
 


=====================================
utils/haddock/latex-test/ref/GadtConstructorArgs/GadtConstructorArgs.tex
=====================================
@@ -3,7 +3,7 @@
 \haddockbeginheader
 {\haddockverb\begin{verbatim}
 module GadtConstructorArgs (
-    Boo(Fot, x, y, Fob, w, z)
+    Boo(Fob, Fot, w, x, y, z)
   ) where\end{verbatim}}
 \haddockendheader
 


=====================================
utils/haddock/latex-test/ref/TypeFamilies3/TypeFamilies3.tex
=====================================
@@ -3,7 +3,7 @@
 \haddockbeginheader
 {\haddockverb\begin{verbatim}
 module TypeFamilies3 (
-    Foo, Bar, Baz(Baz3, Baz2, Baz1)
+    Foo, Bar, Baz(Baz1, Baz2, Baz3)
   ) where\end{verbatim}}
 \haddockendheader
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77d2c1d9b81aca0ca75432888a8068da2b306a87

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77d2c1d9b81aca0ca75432888a8068da2b306a87
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241007/32057397/attachment-0001.html>


More information about the ghc-commits mailing list