[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: ghcid: use multi repl for ghcid
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sun Oct 27 12:40:06 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
589fea7f by Cheng Shao at 2024-10-27T05:36:38-04:00
ghcid: use multi repl for ghcid
- - - - -
d52a0475 by Andrew Lelechenko at 2024-10-27T05:37:13-04:00
documentation: add motivating section to Control.Monad.Fix
- - - - -
301c3b54 by Cheng Shao at 2024-10-27T05:37:49-04:00
wasm: fix safari console error message related to import("node:timers")
This patch fixes the wasm backend JSFFI prelude script to avoid
calling `import("node:timers")` on non-deno hosts. Safari doesn't like
it and would print an error message to the console. Fixes
https://gitlab.haskell.org/ghc/ghc-wasm-meta/-/issues/13.
- - - - -
8ac497bc by Simon Peyton Jones at 2024-10-27T08:39:59-04:00
Add a missing tidy in UnivCo
We were failing to tidy the argument coercions of a UnivCo, which
led directly to #25391.
The fix is, happily, trivial.
I don't have a small repro case (it came up when building horde-ad,
which uses typechecker plugins). It should be possible to make a
repro case, by using a plugin (which builds a UnivCo) but I decided
it was not worth the bother. The bug is egregious and easily fixed.
- - - - -
6bd383ea by Andrew Lelechenko at 2024-10-27T08:39:59-04:00
Bump text submodule to 2.1.2
- - - - -
311f6a08 by Andrew Lelechenko at 2024-10-27T08:39:59-04:00
hadrian: allow -Wunused-imports for text package
- - - - -
6 changed files:
- .ghcid
- compiler/GHC/Core/TyCo/Tidy.hs
- hadrian/src/Settings/Warnings.hs
- libraries/base/src/Control/Monad/Fix.hs
- libraries/text
- utils/jsffi/prelude.mjs
Changes:
=====================================
.ghcid
=====================================
@@ -1,5 +1,5 @@
---command sh -c "HADRIAN_ARGS=-j ./hadrian/ghci -j"
+--command sh -c "HADRIAN_ARGS=-j exec ./hadrian/ghci-multi -j"
--reload compiler
--reload ghc
--reload includes
---restart hadrian/ghci
+--restart hadrian/ghci-multi
=====================================
compiler/GHC/Core/TyCo/Tidy.hs
=====================================
@@ -336,16 +336,18 @@ tidyCo env co
go (AppCo co1 co2) = (AppCo $! go co1) $! go co2
go (ForAllCo tv visL visR h co)
= ((((ForAllCo $! tvp) $! visL) $! visR) $! (go h)) $! (tidyCo envp co)
- where (envp, tvp) = tidyVarBndr env tv
+ where (envp, tvp) = tidyVarBndr env tv
-- the case above duplicates a bit of work in tidying h and the kind
-- of tv. But the alternative is to use coercionKind, which seems worse.
go (FunCo r afl afr w co1 co2) = ((FunCo r afl afr $! go w) $! go co1) $! go co2
go (CoVarCo cv) = CoVarCo $! go_cv cv
go (HoleCo h) = HoleCo $! go_hole h
go (AxiomCo ax cos) = AxiomCo ax $ strictMap go cos
- go co@(UnivCo { uco_lty = t1, uco_rty = t2 })
- = co { uco_lty = tidyType env t1, uco_rty = tidyType env t2 }
- -- Don't bother to tidy the uco_deps field
+ go (UnivCo prov role t1 t2 cos)
+ = ((UnivCo prov role
+ $! tidyType env t1)
+ $! tidyType env t2)
+ $! strictMap go cos
go (SymCo co) = SymCo $! go co
go (TransCo co1 co2) = (TransCo $! go co1) $! go co2
go (SelCo d co) = SelCo d $! go co
=====================================
hadrian/src/Settings/Warnings.hs
=====================================
@@ -66,7 +66,9 @@ ghcWarningsArgs = do
, package primitive ? pure [ "-Wno-unused-imports"
, "-Wno-deprecations" ]
, package rts ? pure [ "-Wcpp-undef" ]
- , package text ? pure [ "-Wno-deprecations", "-Wno-deriving-typeable" ]
+ , package text ? pure [ "-Wno-deprecations"
+ , "-Wno-deriving-typeable"
+ , "-Wno-unused-imports" ]
, package terminfo ? pure [ "-Wno-unused-imports", "-Wno-deriving-typeable" ]
, package stm ? pure [ "-Wno-deriving-typeable" ]
, package osString ? pure [ "-Wno-deriving-typeable" ]
=====================================
libraries/base/src/Control/Monad/Fix.hs
=====================================
@@ -10,11 +10,108 @@
-- Stability : stable
-- Portability : portable
--
--- Monadic fixpoints.
+-- Monadic fixpoints, used for desugaring of @{-# LANGUAGE RecursiveDo #-}@.
--
--- For a detailed discussion, see Levent Erkok's thesis,
--- /Value Recursion in Monadic Computations/, Oregon Graduate Institute, 2002.
+-- Consider the generalized version of so-called @repmin@
+-- (/replace with minimum/) problem:
+-- accumulate elements of a container into a 'Monoid'
+-- and modify each element using the final accumulator.
--
+-- @
+-- repmin
+-- :: (Functor t, Foldable t, Monoid b)
+-- => (a -> b) -> (a -> b -> c) -> t a -> t c
+-- repmin f g as = fmap (\`g\` foldMap f as) as
+-- @
+--
+-- The naive implementation as above makes two traversals. Can we do better
+-- and achieve the goal in a single pass? It's seemingly impossible, because we would
+-- have to know the future,
+-- but lazy evaluation comes to the rescue:
+--
+-- @
+-- import Data.Traversable (mapAccumR)
+--
+-- repmin
+-- :: (Traversable t, Monoid b)
+-- => (a -> b) -> (a -> b -> c) -> t a -> t c
+-- repmin f g as =
+-- let (b, cs) = mapAccumR (\\acc a -> (f a <> acc, g a b)) mempty as in cs
+-- @
+--
+-- How can we check that @repmin@ indeed traverses only once?
+-- Let's run it on an infinite input:
+--
+-- >>> import Data.Monoid (All(..))
+-- >>> take 3 $ repmin All (const id) ([True, True, False] ++ undefined)
+-- [All {getAll = False},All {getAll = False},All {getAll = False}]
+--
+-- So far so good, but can we generalise @g@ to return a monadic value @a -> b -> m c@?
+-- The following does not work, complaining that @b@ is not in scope:
+--
+-- @
+-- import Data.Traversable (mapAccumM)
+--
+-- repminM
+-- :: (Traversable t, Monoid b, Monad m)
+-- => (a -> b) -> (a -> b -> m c) -> t a -> m (t c)
+-- repminM f g as = do
+-- (b, cs) \<- mapAccumM (\\acc a -> (f a <> acc,) <$> g a b) mempty as
+-- pure cs
+-- @
+--
+-- To solve the riddle, let's rewrite @repmin@ via 'fix':
+--
+-- @
+-- repmin
+-- :: (Traversable t, Monoid b)
+-- => (a -> b) -> (a -> b -> c) -> t a -> t c
+-- repmin f g as = snd $ fix $
+-- \\(b, cs) -> mapAccumR (\\acc a -> (f a <> acc, g a b)) mempty as
+-- @
+--
+-- Now we can replace 'fix' with 'mfix' to obtain the solution:
+--
+-- @
+-- repminM
+-- :: (Traversable t, Monoid b, MonadFix m)
+-- => (a -> b) -> (a -> b -> m c) -> t a -> m (t c)
+-- repminM f g as = fmap snd $ mfix $
+-- \\(~(b, cs)) -> mapAccumM (\\acc a -> (f a <> acc,) <$> g a b) mempty as
+-- @
+--
+-- For example,
+--
+-- >>> import Data.Monoid (Sum(..))
+-- >>> repminM Sum (\a b -> print a >> pure (a + getSum b)) [3, 5, 2]
+-- 3
+-- 5
+-- 2
+-- [13,15,12]
+--
+-- Incredibly, GHC is capable to do this transformation automatically,
+-- when {-# LANGUAGE RecursiveDo #-} is enabled. Namely, the following
+-- implementation of @repminM@ works (note @mdo@ instead of @do@):
+--
+-- @
+-- {-# LANGUAGE RecursiveDo #-}
+--
+-- repminM
+-- :: (Traversable t, Monoid b, MonadFix m)
+-- => (a -> b) -> (a -> b -> m c) -> t a -> m (t c)
+-- repminM f g as = mdo
+-- (b, cs) \<- mapAccumM (\\acc a -> (f a <> acc,) <$> g a b) mempty as
+-- pure cs
+-- @
+--
+-- Further reading:
+--
+-- * GHC User’s Guide, The recursive do-notation.
+-- * Haskell Wiki, <https://wiki.haskell.org/MonadFix MonadFix>.
+-- * Levent Erkök, <https://leventerkok.github.io/papers/erkok-thesis.pdf Value recursion in monadic computations>, Oregon Graduate Institute, 2002.
+-- * Levent Erkök, John Launchbury, <https://leventerkok.github.io/papers/recdo.pdf A recursive do for Haskell>, Haskell '02, 29-37, 2002.
+-- * Richard S. Bird, <https://doi.org/10.1007/BF00264249 Using circular programs to eliminate multiple traversals of data>, Acta Informatica 21, 239-250, 1984.
+-- * Jasper Van der Jeugt, <https://jaspervdj.be/posts/2023-07-22-lazy-layout.html Lazy layout>, 2023.
module Control.Monad.Fix
(MonadFix(mfix),
=====================================
libraries/text
=====================================
@@ -1 +1 @@
-Subproject commit cdb9e13b39079904eed9d75cd332b66ee0cad0c0
+Subproject commit ee0a8f8b9a4bd3fdad23e9ac0db56e7f08ce35cd
=====================================
utils/jsffi/prelude.mjs
=====================================
@@ -58,9 +58,9 @@ const setImmediate = await (async () => {
}
// deno
- try {
+ if (globalThis.Deno) {
return (await import("node:timers")).setImmediate;
- } catch {}
+ }
// https://developer.mozilla.org/en-US/docs/Web/API/Scheduler/postTask
if (globalThis.scheduler) {
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ea6165aadff1d9954b9d351461b1b9c7b48bb45...311f6a08f517f1ec909c744d293aba8b5ebaeb23
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ea6165aadff1d9954b9d351461b1b9c7b48bb45...311f6a08f517f1ec909c744d293aba8b5ebaeb23
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/20241027/dce5597e/attachment-0001.html>
More information about the ghc-commits
mailing list