[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: base: Add inits1 and tails1 to Data.List

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Fri Jun 21 19:28:41 UTC 2024



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


Commits:
0f5f19f0 by Ryan Hendrickson at 2024-06-21T15:28:27-04:00
base: Add inits1 and tails1 to Data.List

- - - - -
74c9ce12 by Matthew Pickering at 2024-06-21T15:28:29-04:00
bindist: Use complete relative paths when cding to directories

If a user has configured CDPATH on their system then `cd lib` may change
into an unexpected directory during the installation process.

If you write `cd ./lib` then it will not consult `CDPATH` to determine
what you mean.

I have added a check on ghcup-ci to verify that the bindist installation
works in this situation.

Fixes #24951

- - - - -


15 changed files:

- hadrian/bindist/Makefile
- libraries/base/changelog.md
- libraries/base/src/Data/List.hs
- libraries/base/src/Data/List/NonEmpty.hs
- libraries/ghc-internal/ghc-internal.cabal
- + libraries/ghc-internal/src/GHC/Internal/Data/List/NonEmpty.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/lib/base/InitsTails.hs
- + testsuite/tests/lib/base/InitsTails.stdout
- testsuite/tests/lib/base/all.T
- utils/haddock/html-test/ref/Identifiers.html
- utils/haddock/html-test/ref/Instances.html


Changes:

=====================================
hadrian/bindist/Makefile
=====================================
@@ -169,7 +169,7 @@ install_lib: lib/settings
 	$(INSTALL_DIR) "$(DESTDIR)$(ActualLibsDir)"
 
 	@dest="$(DESTDIR)$(ActualLibsDir)"; \
-	cd lib; \
+	cd ./lib; \
 	for i in `$(FIND) . -type f`; do \
 		dir="`dirname $$i`" ; \
 		$(INSTALL_DIR) "$$dest/$$dir" ; \
@@ -197,7 +197,7 @@ install_docs:
 	$(INSTALL_DIR) "$(DESTDIR)$(docdir)"
 
 	if [ -d doc ]; then \
-		cd doc; $(FIND) . -type f -exec sh -c \
+		cd ./doc; $(FIND) . -type f -exec sh -c \
 			'$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`"' \
 			sh '{}' ';'; \
 	fi
@@ -213,7 +213,7 @@ install_data:
 	@echo "Copying data to $(DESTDIR)share"
 	$(INSTALL_DIR) "$(DESTDIR)$(datadir)"
 	if [ -d share ]; then \
-		cd share; $(FIND) . -type f -exec sh -c \
+		cd ./share; $(FIND) . -type f -exec sh -c \
 			'$(INSTALL_DIR) "$(DESTDIR)$(datadir)/`dirname $$1`" && \
 			$(INSTALL_DATA) "$$1" "$(DESTDIR)$(datadir)/`dirname $$1`"' \
 			sh '{}' ';'; \
@@ -235,7 +235,7 @@ export SHELL
 install_wrappers: install_bin_libdir install_hsc2hs_wrapper
 	@echo "Installing wrapper scripts"
 	$(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)"
-	for p in `cd wrappers; $(FIND) . ! -type d`; do \
+	for p in `cd ./wrappers; $(FIND) . ! -type d`; do \
 	    mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \
 	done
 


=====================================
libraries/base/changelog.md
=====================================
@@ -8,6 +8,7 @@
   * The `HasField` class now supports representation polymorphism ([CLC proposal #194](https://github.com/haskell/core-libraries-committee/issues/194))
   * Make `read` accept binary integer notation ([CLC proposal #177](https://github.com/haskell/core-libraries-committee/issues/177))
   * Improve the performance of `Data.List.sort` using an improved merging strategy. Instead of `compare`, `sort` now uses `(>)` which may break *malformed* `Ord` instances ([CLC proposal #236](https://github.com/haskell/core-libraries-committee/issues/236))
+  * Add `inits1` and `tails1` to `Data.List`, factored from the corresponding functions in `Data.List.NonEmpty` ([CLC proposal #252](https://github.com/haskell/core-libraries-committee/issues/252))
   * Add `firstA` and `secondA` to `Data.Bitraversable`. ([CLC proposal #172](https://github.com/haskell/core-libraries-committee/issues/172))
 
 ## 4.20.0.0 *TBA*


=====================================
libraries/base/src/Data/List.hs
=====================================
@@ -83,7 +83,9 @@ module Data.List
      stripPrefix,
      group,
      inits,
+     inits1,
      tails,
+     tails1,
      -- **  Predicates
      isPrefixOf,
      isSuffixOf,
@@ -177,3 +179,67 @@ module Data.List
      ) where
 
 import GHC.Internal.Data.List
+import GHC.Internal.Data.List.NonEmpty (NonEmpty(..))
+import GHC.List (build)
+
+inits1, tails1 :: [a] -> [NonEmpty a]
+
+-- | The 'inits1' function returns all non-empty initial segments of the
+-- argument, shortest first.
+--
+-- @since 4.21.0.0
+--
+-- ==== __Laziness__
+--
+-- Note that 'inits1' has the following strictness property:
+-- @inits1 (xs ++ _|_) = inits1 xs ++ _|_@
+--
+-- In particular,
+-- @inits1 _|_ = _|_@
+--
+-- ==== __Examples__
+--
+-- >>> inits1 "abc"
+-- ['a' :| "",'a' :| "b",'a' :| "bc"]
+--
+-- >>> inits1 []
+-- []
+--
+-- inits1 is productive on infinite lists:
+--
+-- >>> take 3 $ inits1 [1..]
+-- [1 :| [],1 :| [2],1 :| [2,3]]
+inits1 [] = []
+inits1 (x : xs) = map (x :|) (inits xs)
+
+-- | \(\mathcal{O}(n)\). The 'tails1' function returns all non-empty final
+-- segments of the argument, longest first.
+--
+-- @since 4.21.0.0
+--
+-- ==== __Laziness__
+--
+-- Note that 'tails1' has the following strictness property:
+-- @tails1 _|_ = _|_@
+--
+-- >>> tails1 undefined
+-- *** Exception: Prelude.undefined
+--
+-- >>> drop 1 (tails1 [undefined, 1, 2])
+-- [1 :| [2],2 :| []]
+--
+-- ==== __Examples__
+--
+-- >>> tails1 "abc"
+-- ['a' :| "bc",'b' :| "c",'c' :| ""]
+--
+-- >>> tails1 [1, 2, 3]
+-- [1 :| [2,3],2 :| [3],3 :| []]
+--
+-- >>> tails1 []
+-- []
+{-# INLINABLE tails1 #-}
+tails1 lst = build (\c n ->
+  let tails1Go [] = n
+      tails1Go (x : xs) = (x :| xs) `c` tails1Go xs
+  in tails1Go lst)


=====================================
libraries/base/src/Data/List/NonEmpty.hs
=====================================
@@ -109,10 +109,10 @@ import           Prelude             hiding (break, cycle, drop, dropWhile,
 import qualified Prelude
 
 import           Control.Applicative (Applicative (..), Alternative (many))
+import qualified Data.List                        as List
 import           GHC.Internal.Data.Foldable       hiding (length, toList)
 import qualified GHC.Internal.Data.Foldable       as Foldable
 import           GHC.Internal.Data.Function       (on)
-import qualified GHC.Internal.Data.List           as List
 import           GHC.Internal.Data.Ord            (comparing)
 import           GHC.Internal.Base            (NonEmpty(..))
 import           GHC.Internal.Stack.Types     (HasCallStack)
@@ -273,15 +273,7 @@ inits = fromList . List.inits . Foldable.toList
 --
 -- @since 4.18
 inits1 :: NonEmpty a -> NonEmpty (NonEmpty a)
-inits1 =
-  -- fromList is an unsafe function, but this usage should be safe, since:
-  -- * `inits xs = [[], ..., init (init xs), init xs, xs]`
-  -- * If `xs` is nonempty, it follows that `inits xs` contains at least one nonempty
-  --   list, since `last (inits xs) = xs`.
-  -- * The only empty element of `inits xs` is the first one (by the definition of `inits`)
-  -- * Therefore, if we take all but the first element of `inits xs` i.e.
-  --   `tail (inits xs)`, we have a nonempty list of nonempty lists
-  fromList . Prelude.map fromList . List.drop 1 . List.inits . Foldable.toList
+inits1 = fromList . List.inits1 . Foldable.toList
 
 -- | The 'tails' function takes a stream @xs@ and returns all the
 -- suffixes of @xs@, starting with the longest. The result is 'NonEmpty'
@@ -301,15 +293,7 @@ tails = fromList . List.tails . Foldable.toList
 --
 -- @since 4.18
 tails1 :: NonEmpty a -> NonEmpty (NonEmpty a)
-tails1 =
-  -- fromList is an unsafe function, but this usage should be safe, since:
-  -- * `tails xs = [xs, tail xs, tail (tail xs), ..., []]`
-  -- * If `xs` is nonempty, it follows that `tails xs` contains at least one nonempty
-  --   list, since `head (tails xs) = xs`.
-  -- * The only empty element of `tails xs` is the last one (by the definition of `tails`)
-  -- * Therefore, if we take all but the last element of `tails xs` i.e.
-  --   `init (tails xs)`, we have a nonempty list of nonempty lists
-  fromList . Prelude.map fromList . List.init . List.tails . Foldable.toList
+tails1 = fromList . List.tails1 . Foldable.toList
 
 -- | @'insert' x xs@ inserts @x@ into the last position in @xs@ where it
 -- is still less than or equal to the next element. In particular, if the


=====================================
libraries/ghc-internal/ghc-internal.cabal
=====================================
@@ -122,6 +122,7 @@ Library
         GHC.Internal.Data.IORef
         GHC.Internal.Data.Ix
         GHC.Internal.Data.List
+        GHC.Internal.Data.List.NonEmpty
         GHC.Internal.Data.Maybe
         GHC.Internal.Data.Monoid
         GHC.Internal.Data.OldList


=====================================
libraries/ghc-internal/src/GHC/Internal/Data/List/NonEmpty.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE Trustworthy #-}
+
+module GHC.Internal.Data.List.NonEmpty
+  ( NonEmpty(..)
+  ) where
+
+import GHC.Internal.Base


=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -1332,6 +1332,7 @@ module Data.List where
   head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
   init :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
   inits :: forall a. [a] -> [[a]]
+  inits1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
   insert :: forall a. GHC.Classes.Ord a => a -> [a] -> [a]
   insertBy :: forall a. (a -> a -> GHC.Types.Ordering) -> a -> [a] -> [a]
   intercalate :: forall a. [a] -> [[a]] -> [a]
@@ -1382,6 +1383,7 @@ module Data.List where
   sum :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Num.Num a) => t a -> a
   tail :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
   tails :: forall a. [a] -> [[a]]
+  tails1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
   take :: forall a. GHC.Types.Int -> [a] -> [a]
   takeWhile :: forall a. (a -> GHC.Types.Bool) -> [a] -> [a]
   transpose :: forall a. [[a]] -> [[a]]


=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -1332,6 +1332,7 @@ module Data.List where
   head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
   init :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
   inits :: forall a. [a] -> [[a]]
+  inits1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
   insert :: forall a. GHC.Classes.Ord a => a -> [a] -> [a]
   insertBy :: forall a. (a -> a -> GHC.Types.Ordering) -> a -> [a] -> [a]
   intercalate :: forall a. [a] -> [[a]] -> [a]
@@ -1382,6 +1383,7 @@ module Data.List where
   sum :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Num.Num a) => t a -> a
   tail :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
   tails :: forall a. [a] -> [[a]]
+  tails1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
   take :: forall a. GHC.Types.Int -> [a] -> [a]
   takeWhile :: forall a. (a -> GHC.Types.Bool) -> [a] -> [a]
   transpose :: forall a. [[a]] -> [[a]]


=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -1332,6 +1332,7 @@ module Data.List where
   head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
   init :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
   inits :: forall a. [a] -> [[a]]
+  inits1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
   insert :: forall a. GHC.Classes.Ord a => a -> [a] -> [a]
   insertBy :: forall a. (a -> a -> GHC.Types.Ordering) -> a -> [a] -> [a]
   intercalate :: forall a. [a] -> [[a]] -> [a]
@@ -1382,6 +1383,7 @@ module Data.List where
   sum :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Num.Num a) => t a -> a
   tail :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
   tails :: forall a. [a] -> [[a]]
+  tails1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
   take :: forall a. GHC.Types.Int -> [a] -> [a]
   takeWhile :: forall a. (a -> GHC.Types.Bool) -> [a] -> [a]
   transpose :: forall a. [[a]] -> [[a]]


=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -1332,6 +1332,7 @@ module Data.List where
   head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
   init :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
   inits :: forall a. [a] -> [[a]]
+  inits1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
   insert :: forall a. GHC.Classes.Ord a => a -> [a] -> [a]
   insertBy :: forall a. (a -> a -> GHC.Types.Ordering) -> a -> [a] -> [a]
   intercalate :: forall a. [a] -> [[a]] -> [a]
@@ -1382,6 +1383,7 @@ module Data.List where
   sum :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Num.Num a) => t a -> a
   tail :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
   tails :: forall a. [a] -> [[a]]
+  tails1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
   take :: forall a. GHC.Types.Int -> [a] -> [a]
   takeWhile :: forall a. (a -> GHC.Types.Bool) -> [a] -> [a]
   transpose :: forall a. [[a]] -> [[a]]


=====================================
testsuite/tests/lib/base/InitsTails.hs
=====================================
@@ -0,0 +1,23 @@
+module Main (main) where
+
+import Data.List (inits, inits1, tails, tails1)
+
+main :: IO ()
+main = do
+  print $ inits "abc"
+  print $ inits ([] :: [Int])
+  print $ take 5 $ inits [1..]
+  print $ take 3 $ inits ([1, 2] ++ undefined)
+
+  print $ inits1 "abc"
+  print $ inits1 ([] :: [Int])
+  print $ take 3 $ inits1 [1..]
+  print $ take 2 $ inits1 ([1, 2] ++ undefined)
+
+  print $ tails "abc"
+  print $ tails ([] :: [Int])
+  print $ drop 1 (tails [undefined, 1, 2])
+
+  print $ tails1 "abc"
+  print $ tails1 ([] :: [Int])
+  print $ drop 1 (tails1 [undefined, 1, 2])


=====================================
testsuite/tests/lib/base/InitsTails.stdout
=====================================
@@ -0,0 +1,14 @@
+["","a","ab","abc"]
+[[]]
+[[],[1],[1,2],[1,2,3],[1,2,3,4]]
+[[],[1],[1,2]]
+['a' :| "",'a' :| "b",'a' :| "bc"]
+[]
+[1 :| [],1 :| [2],1 :| [2,3]]
+[1 :| [],1 :| [2]]
+["abc","bc","c",""]
+[[]]
+[[1,2],[2],[]]
+['a' :| "bc",'b' :| "c",'c' :| ""]
+[]
+[1 :| [2],2 :| []]


=====================================
testsuite/tests/lib/base/all.T
=====================================
@@ -12,3 +12,4 @@ test('Unsnoc', normal, compile_and_run, [''])
 test('First-Semigroup-sconcat', normal, compile_and_run, [''])
 test('First-Monoid-sconcat', normal, compile_and_run, [''])
 test('Sort', normal, compile_and_run, [''])
+test('InitsTails', normal, compile_and_run, [''])


=====================================
utils/haddock/html-test/ref/Identifiers.html
=====================================
@@ -142,7 +142,7 @@
 		><ul
 		><li
 		  >Unqualified: <code
-		    ><a href="#" title="Data.List"
+		    ><a href="#" title="GHC.List"
 		      >++</a
 		      ></code
 		    >, <code
@@ -162,7 +162,7 @@
 		    ></li
 		  ><li
 		  >Namespaced: <code
-		    ><a href="#" title="Data.List"
+		    ><a href="#" title="GHC.List"
 		      >++</a
 		      ></code
 		    >, <code class="inline-code"
@@ -199,7 +199,7 @@
 		><li
 		  >Unqualified: <code class="inline-code"
 		    ><code
-		      ><a href="#" title="Data.List"
+		      ><a href="#" title="GHC.List"
 			>(++)</a
 			></code
 		      > [1,2,3] [4,5,6]</code
@@ -214,7 +214,7 @@
 		    ></li
 		  ><li
 		  >Namespaced: <code
-		    ><a href="#" title="Data.List"
+		    ><a href="#" title="GHC.List"
 		      >(++)</a
 		      ></code
 		    >, <code class="inline-code"


=====================================
utils/haddock/html-test/ref/Instances.html
=====================================
@@ -266,7 +266,7 @@
 		      ></span
 		      > <a href="#" title="Instances"
 		      >Foo</a
-		      > <a href="#" title="Data.List"
+		      > <a href="#" title="GHC.Exts"
 		      >[]</a
 		      ></span
 		    > <a href="#" class="selflink"
@@ -910,7 +910,7 @@
 		      ></span
 		      > <a href="#" title="Instances"
 		      >Bar</a
-		      > <a href="#" title="Data.List"
+		      > <a href="#" title="GHC.Exts"
 		      >[]</a
 		      > (a, a)</span
 		    > <a href="#" class="selflink"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d48159c5dca07c172e2126926c66e420e92fdf41...74c9ce12e072f8499f6a247d1f88f7726f401297

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d48159c5dca07c172e2126926c66e420e92fdf41...74c9ce12e072f8499f6a247d1f88f7726f401297
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/20240621/3babd77e/attachment-0001.html>


More information about the ghc-commits mailing list