[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: llvmGen: Fix built-in variable predicate

8 May 2025

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
350d26d2 by Ben Gamari at 2025-05-08T00:10:36-04:00
llvmGen: Fix built-in variable predicate

Previously the predicate to identify LLVM builtin global variables was
checking for `$llvm` rather than `@llvm` as it should.

- - - - -
43396402 by Ben Gamari at 2025-05-08T00:10:36-04:00
llvmGen: Fix linkage of built-in arrays

LLVM now insists that built-in arrays use Appending linkage, not
Internal.

Fixes #25769.

- - - - -
4dbf5b41 by sheaf at 2025-05-08T00:10:41-04:00
Use mkTrAppChecked in ds_ev_typeable

This change avoids violating the invariant of mkTrApp according to which
the argument should not be a fully saturated function type.
This ensures we don't return false negatives for type equality
involving function types.

Fixes #25998

- - - - -
0c7147d2 by Ryan Hendrickson at 2025-05-08T00:10:45-04:00
haddock: Preserve indentation in multiline examples

Intended for use with :{ :}, but doesn't look for those characters. Any
consecutive lines with birdtracks will only have initial whitespace
stripped up to the column of the first line.

- - - - -
3b5267fd by Cheng Shao at 2025-05-08T00:10:46-04:00
ci: re-enable chrome for wasm ghci browser tests

Currently only firefox is enabled for wasm ghci browser tests, for
some reason testing with chrome works on my machine but gets stuck on
gitlab instance runners. This patch re-enables testing with chrome by
passing `--no-sandbox`, since chrome sandboxing doesn't work in
containers without `--cap-add=SYS_ADMIN`.

- - - - -


11 changed files:

- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/CmmToLlvm/Base.hs
- compiler/GHC/CmmToLlvm/Data.hs
- compiler/GHC/HsToCore/Binds.hs
- + testsuite/tests/typecheck/should_run/T25998.hs
- + testsuite/tests/typecheck/should_run/T25998.stdout
- testsuite/tests/typecheck/should_run/all.T
- utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs
- utils/haddock/haddock-library/test/Documentation/Haddock/ParserSpec.hs


Changes:

=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -1322,6 +1322,7 @@ cross_jobs = [
       modifyJobs
         ( -- See Note [Testing wasm ghci browser mode]
           setVariable "FIREFOX_LAUNCH_OPTS" "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}"
+            . setVariable "CHROME_LAUNCH_OPTS" "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}"
             . setVariable "HADRIAN_ARGS" "--docs=no-sphinx-pdfs --docs=no-sphinx-man"
             . delVariable "INSTALL_CONFIGURE_ARGS"
         )


=====================================
.gitlab/jobs.yaml
=====================================
@@ -1786,6 +1786,7 @@
       "BIGNUM_BACKEND": "gmp",
       "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_20-wasm-cross_wasm32-wasi-release+host_fully_static+text_simdutf",
       "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf",
+      "CHROME_LAUNCH_OPTS": "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}",
       "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check",
       "CROSS_TARGET": "wasm32-wasi",
       "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}",
@@ -1851,6 +1852,7 @@
       "BIGNUM_BACKEND": "native",
       "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_20-wasm-int_native-cross_wasm32-wasi-release+host_fully_static+text_simdutf",
       "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf",
+      "CHROME_LAUNCH_OPTS": "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}",
       "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check",
       "CROSS_TARGET": "wasm32-wasi",
       "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}",
@@ -1916,6 +1918,7 @@
       "BIGNUM_BACKEND": "gmp",
       "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_20-wasm-unreg-cross_wasm32-wasi-release+host_fully_static+text_simdutf",
       "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf",
+      "CHROME_LAUNCH_OPTS": "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}",
       "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check",
       "CROSS_TARGET": "wasm32-wasi",
       "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}",
@@ -6031,6 +6034,7 @@
       "BIGNUM_BACKEND": "gmp",
       "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_20-wasm-cross_wasm32-wasi-release+host_fully_static+text_simdutf",
       "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf",
+      "CHROME_LAUNCH_OPTS": "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}",
       "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check",
       "CROSS_TARGET": "wasm32-wasi",
       "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}",
@@ -6096,6 +6100,7 @@
       "BIGNUM_BACKEND": "native",
       "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_20-wasm-int_native-cross_wasm32-wasi-release+host_fully_static+text_simdutf",
       "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf",
+      "CHROME_LAUNCH_OPTS": "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}",
       "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check",
       "CROSS_TARGET": "wasm32-wasi",
       "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}",
@@ -6161,6 +6166,7 @@
       "BIGNUM_BACKEND": "gmp",
       "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_20-wasm-unreg-cross_wasm32-wasi-release+host_fully_static+text_simdutf",
       "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf",
+      "CHROME_LAUNCH_OPTS": "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}",
       "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check",
       "CROSS_TARGET": "wasm32-wasi",
       "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}",


=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -245,7 +245,7 @@ basicKnownKeyNames
         typeRepIdName,
         mkTrTypeName,
         mkTrConName,
-        mkTrAppName,
+        mkTrAppCheckedName,
         mkTrFunName,
         typeSymbolTypeRepName, typeNatTypeRepName, typeCharTypeRepName,
         trGhcPrimModuleName,
@@ -1356,7 +1356,7 @@ typeableClassName
   , someTypeRepDataConName
   , mkTrTypeName
   , mkTrConName
-  , mkTrAppName
+  , mkTrAppCheckedName
   , mkTrFunName
   , typeRepIdName
   , typeNatTypeRepName
@@ -1371,7 +1371,7 @@ someTypeRepDataConName = dcQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "SomeTypeR
 typeRepIdName         = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeRep#")       typeRepIdKey
 mkTrTypeName          = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrType")       mkTrTypeKey
 mkTrConName           = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrCon")        mkTrConKey
-mkTrAppName           = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrApp")        mkTrAppKey
+mkTrAppCheckedName    = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrAppChecked") mkTrAppCheckedKey
 mkTrFunName           = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrFun")        mkTrFunKey
 typeNatTypeRepName    = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey
 typeSymbolTypeRepName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey
@@ -2499,7 +2499,7 @@ proxyHashKey = mkPreludeMiscIdUnique 502
 mkTyConKey
   , mkTrTypeKey
   , mkTrConKey
-  , mkTrAppKey
+  , mkTrAppCheckedKey
   , mkTrFunKey
   , typeNatTypeRepKey
   , typeSymbolTypeRepKey
@@ -2509,7 +2509,7 @@ mkTyConKey
 mkTyConKey            = mkPreludeMiscIdUnique 503
 mkTrTypeKey           = mkPreludeMiscIdUnique 504
 mkTrConKey            = mkPreludeMiscIdUnique 505
-mkTrAppKey            = mkPreludeMiscIdUnique 506
+mkTrAppCheckedKey     = mkPreludeMiscIdUnique 506
 typeNatTypeRepKey     = mkPreludeMiscIdUnique 507
 typeSymbolTypeRepKey  = mkPreludeMiscIdUnique 508
 typeCharTypeRepKey    = mkPreludeMiscIdUnique 509


=====================================
compiler/GHC/CmmToLlvm/Base.hs
=====================================
@@ -526,10 +526,10 @@ generateExternDecls = do
   modifyEnv $ \env -> env { envAliases = emptyUniqSet }
   return (concat defss, [])

--- | Is a variable one of the special @$llvm@ globals?
+-- | Is a variable one of the special @\@llvm@ globals?
 isBuiltinLlvmVar :: LlvmVar -> Bool
 isBuiltinLlvmVar (LMGlobalVar lbl _ _ _ _ _) =
-    "$llvm" `isPrefixOf` unpackFS lbl
+    "llvm." `isPrefixOf` unpackFS lbl
 isBuiltinLlvmVar _ = False
 
 -- | Here we take a global variable definition, rename it with a


=====================================
compiler/GHC/CmmToLlvm/Data.hs
=====================================
@@ -125,7 +125,7 @@ genGlobalLabelArray var_nm clbls = do
             prio = LMStaticLit $ LMIntLit 0xffff i32
         in LMStaticStrucU [prio, fn, null] entry_ty
 
-    arr_var = LMGlobalVar var_nm arr_ty Internal Nothing Nothing Global
+    arr_var = LMGlobalVar var_nm arr_ty Appending Nothing Nothing Global
     mkFunTy lbl = LMFunction $ LlvmFunctionDecl lbl ExternallyVisible CC_Ccc LMVoid FixedArgs [] Nothing
     entry_ty = LMStructU [i32, LMPointer $ mkFunTy $ fsLit "placeholder", LMPointer i8]
     arr_ty = LMArray (length clbls) entry_ty


=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -1850,14 +1850,14 @@ ds_ev_typeable ty (EvTypeableTyApp ev1 ev2)
   | Just (t1,t2) <- splitAppTy_maybe ty
   = do { e1  <- getRep ev1 t1
        ; e2  <- getRep ev2 t2
-       ; mkTrApp <- dsLookupGlobalId mkTrAppName
-                    -- mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
-                    --            TypeRep a -> TypeRep b -> TypeRep (a b)
+       ; mkTrAppChecked <- dsLookupGlobalId mkTrAppCheckedName
+                    -- mkTrAppChecked :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
+                    --                   TypeRep a -> TypeRep b -> TypeRep (a b)
        ; let (_, k1, k2) = splitFunTy (typeKind t1)  -- drop the multiplicity,
                                                      -- since it's a kind
-       ; let expr =  mkApps (mkTyApps (Var mkTrApp) [ k1, k2, t1, t2 ])
+       ; let expr =  mkApps (mkTyApps (Var mkTrAppChecked) [ k1, k2, t1, t2 ])
                             [ e1, e2 ]
-       -- ; pprRuntimeTrace "Trace mkTrApp" (ppr expr) expr
+       -- ; pprRuntimeTrace "Trace mkTrAppChecked" (ppr expr) expr
        ; return expr
        }
 


=====================================
testsuite/tests/typecheck/should_run/T25998.hs
=====================================
@@ -0,0 +1,21 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Main where
+
+import Data.Kind
+import Type.Reflection
+
+test :: forall (a :: Type) (b :: Type). TypeRep a -> TypeRep b -> String
+test a b = case eqTypeRep a b of
+             Just _ -> "Equal!\n"
+             Nothing -> "Not equal:\n" <> show a <> "\n" <> show b <> "\n"
+
+combine :: forall (t :: Type -> Type -> Type). Typeable t => TypeRep (t Bool Int)
+combine = typeRep
+
+main :: IO ()
+main = do
+  putStrLn $ test (typeRep @(Bool -> Int)) (combine @(->))


=====================================
testsuite/tests/typecheck/should_run/T25998.stdout
=====================================
@@ -0,0 +1,2 @@
+Equal!
+


=====================================
testsuite/tests/typecheck/should_run/all.T
=====================================
@@ -173,6 +173,7 @@ test('T23761', normal, compile_and_run, [''])
 test('T25529', normal, compile_and_run, [''])
 test('T23761b', normal, compile_and_run, [''])
 test('T17594e', normal, compile_and_run, [''])
+test('T25998', normal, compile_and_run, [''])
 
 # Tests for expanding do before typechecking (Impredicative + RebindableSyntax)
 test('T18324', normal, compile_and_run, [''])


=====================================
utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs
=====================================
@@ -795,31 +795,33 @@ stripSpace = fromMaybe <*> mapM strip'
 -- | Parses examples. Examples are a paragraph level entity (separated by an empty line).
 -- Consecutive examples are accepted.
 examples :: Parser (DocH mod a)
-examples = DocExamples <$> (many (try (skipHorizontalSpace *> "\n")) *> go)
+examples = DocExamples <$> (many (try (skipHorizontalSpace *> "\n")) *> go Nothing)
   where
-    go :: Parser [Example]
-    go = do
+    go :: Maybe Text -> Parser [Example]
+    go mbInitialIndent = do
       prefix <- takeHorizontalSpace <* ">>>"
+      initialIndent <- maybe takeHorizontalSpace pure mbInitialIndent
       expr <- takeLine
-      (rs, es) <- resultAndMoreExamples
-      return (makeExample prefix expr rs : es)
+      (rs, es) <- resultAndMoreExamples (Just initialIndent)
+      return (makeExample prefix initialIndent expr rs : es)
+
+    resultAndMoreExamples :: Maybe Text -> Parser ([Text], [Example])
+    resultAndMoreExamples mbInitialIndent = choice' [moreExamples, result, pure ([], [])]
       where
-        resultAndMoreExamples :: Parser ([Text], [Example])
-        resultAndMoreExamples = choice' [moreExamples, result, pure ([], [])]
-          where
-            moreExamples :: Parser ([Text], [Example])
-            moreExamples = (,) [] <$> go
+        moreExamples :: Parser ([Text], [Example])
+        moreExamples = (,) [] <$> go mbInitialIndent
 
-            result :: Parser ([Text], [Example])
-            result = first . (:) <$> nonEmptyLine <*> resultAndMoreExamples
+        result :: Parser ([Text], [Example])
+        result = first . (:) <$> nonEmptyLine <*> resultAndMoreExamples Nothing
 
-    makeExample :: Text -> Text -> [Text] -> Example
-    makeExample prefix expression res =
-      Example (T.unpack (T.strip expression)) result
+    makeExample :: Text -> Text -> Text -> [Text] -> Example
+    makeExample prefix indent expression res =
+      Example (T.unpack (tryStripIndent (T.stripEnd expression))) result
       where
         result = map (T.unpack . substituteBlankLine . tryStripPrefix) res
 
         tryStripPrefix xs = fromMaybe xs (T.stripPrefix prefix xs)
+        tryStripIndent = liftA2 fromMaybe T.stripStart (T.stripPrefix indent)
 
         substituteBlankLine "<BLANKLINE>" = ""
         substituteBlankLine xs = xs


=====================================
utils/haddock/haddock-library/test/Documentation/Haddock/ParserSpec.hs
=====================================
@@ -864,6 +864,29 @@ spec = do
       it "accepts unicode in examples" $ do
         ">>> 灼眼\nシャナ" `shouldParseTo` DocExamples [Example "灼眼" ["シャナ"]]
 
+      it "preserves indentation in consecutive example lines" $ do
+        unlines
+          [ ">>> line 1"
+          , ">>>   line 2"
+          , ">>> line 3"
+          ]
+          `shouldParseTo` DocExamples
+            [ Example "line 1" []
+            , Example "  line 2" []
+            , Example "line 3" []
+            ]
+
+      it "resets indentation after results" $ do
+        unlines
+          [ ">>> line 1"
+          , "result"
+          , ">>>   line 2"
+          ]
+          `shouldParseTo` DocExamples
+            [ Example "line 1" ["result"]
+            , Example "line 2" []
+            ]
+
       context "when prompt is prefixed by whitespace" $ do
         it "strips the exact same amount of whitespace from result lines" $ do
           unlines



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6836f724f2b10bb2d527f6ca026cb2b...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6836f724f2b10bb2d527f6ca026cb2b...
You're receiving this email because of your account on gitlab.haskell.org.

    

Marge Bot (＠marge-bot)

tags

participants (1)