From a0f7da74925eaef644a27be1a0337c63c45f5b20 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Thu, 30 Jul 2026 22:27:35 +0100 Subject: [PATCH 1/2] Improve Distribution.Lex.tokenizeQuotedWords The new version is more concise, 25% faster and allocates 50% less. (The reason of my interest to this function is that I'm investigating whether any usages of `DList` throughout Cabal code are up to the purpose and not slowing things down) Tested and benchmarked using the following program: ```haskell {- cabal: build-depends: base, dlist, tasty, tasty-quickcheck, tasty-bench -} {-# LANGUAGE LambdaCase #-} import Data.Char (isSpace) import Data.DList (DList(..), toList, singleton) import Data.List (replicate) import Data.List.NonEmpty (NonEmpty(..)) import Test.Tasty.Bench (defaultMain, bench, nf) import Test.Tasty.QuickCheck tokenizeQuotedWords :: String -> [String] tokenizeQuotedWords = filter (not . null) . go False mempty where go :: Bool -- \^ in quoted region -> DList Char -- \^ accumulator -> String -- \^ string to be parsed -> [String] -- \^ parse result go _ accum [] | [] <- accum' = [] | otherwise = [accum'] where accum' = toList accum go False accum (c : cs) | isSpace c = toList accum : go False mempty cs | c == '"' = go True accum cs go True accum (c : cs) | c == '"' = go False accum cs go quoted accum (c : cs) = go quoted (accum <> singleton c) cs tokenizeQuotedWords2 :: String -> [String] tokenizeQuotedWords2 xs = repack $ foldr alg (const ([] :| [])) xs False where repack :: NonEmpty String -> [String] repack (zs :| acc) = if null zs then acc else zs : acc alg :: Char -> (Bool -> NonEmpty String) -> Bool -> NonEmpty String alg '"' rest mode = rest (not mode) alg c rest False | isSpace c = [] :| repack (rest False) alg c rest mode = case rest mode of w :| ws -> (c : w) :| ws data Foo = Space | Quote | CharA | CharB deriving (Eq, Ord, Show, Bounded, Enum) instance Arbitrary Foo where arbitrary = arbitraryBoundedEnum fooToChar :: Foo -> Char fooToChar = \case Space -> ' ' Quote -> '"' CharA -> 'a' CharB -> 'b' main :: IO () main = defaultMain [ testProperty "same results" $ \xs -> let ys = map fooToChar xs in tokenizeQuotedWords ys === tokenizeQuotedWords2 ys , bench "old" $ nf tokenizeQuotedWords benchString , bench "new" $ nf tokenizeQuotedWords2 benchString ] benchString :: String benchString = concat $ replicate 10 "foo \"bar baz\" quux" ``` --- Cabal/src/Distribution/Lex.hs | 39 +++++++++++++---------------------- 1 file changed, 14 insertions(+), 25 deletions(-) diff --git a/Cabal/src/Distribution/Lex.hs b/Cabal/src/Distribution/Lex.hs index 4c8eb8f6734..00fdbbe0a95 100644 --- a/Cabal/src/Distribution/Lex.hs +++ b/Cabal/src/Distribution/Lex.hs @@ -1,5 +1,3 @@ ------------------------------------------------------------------------------ - -- | -- Module : Distribution.Lex -- Copyright : Ben Gamari 2015-2019 @@ -12,7 +10,6 @@ module Distribution.Lex ( tokenizeQuotedWords ) where -import Distribution.Compat.DList import Distribution.Compat.Prelude import Prelude () @@ -25,26 +22,18 @@ import Prelude () -- This behavior can be useful when parsing text like -- @"ghc-options: -Wl,\"some option with spaces\""@, for instance. tokenizeQuotedWords :: String -> [String] -tokenizeQuotedWords = filter (not . null) . go False mempty +tokenizeQuotedWords xs = repack $ foldr alg (const ([] :| [])) xs False where - go - :: Bool - -- \^ in quoted region - -> DList Char - -- \^ accumulator - -> String - -- \^ string to be parsed - -> [String] - -- \^ parse result - go _ accum [] - | [] <- accum' = [] - | otherwise = [accum'] - where - accum' = runDList accum - go False accum (c : cs) - | isSpace c = runDList accum : go False mempty cs - | c == '"' = go True accum cs - go True accum (c : cs) - | c == '"' = go False accum cs - go quoted accum (c : cs) = - go quoted (accum <> singleton c) cs + repack :: NonEmpty String -> [String] + repack (zs :| acc) = if null zs then acc else zs : acc + + alg + :: Char -- current character + -> (Bool -> NonEmpty String) -- continuation, depending on whether we are in a quoted region or not + -> Bool -- are we in a quoted region? + -> NonEmpty String + alg '"' rest mode = rest (not mode) + alg c rest False + | isSpace c = [] :| repack (rest False) + alg c rest mode = case rest mode of + w :| ws -> (c : w) :| ws From 8e53c572191b1f7570769420b03170d88df392b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=CB=8Cbod=CA=B2=C9=AA=CB=88=C9=A1r=CA=B2im?= Date: Thu, 13 Aug 2026 21:30:53 +0100 Subject: [PATCH 2/2] Add comment with examples for tokenizeQuotedWords Co-authored-by: Phil de Joux --- Cabal/src/Distribution/Lex.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/Cabal/src/Distribution/Lex.hs b/Cabal/src/Distribution/Lex.hs index 00fdbbe0a95..753d6ce4d36 100644 --- a/Cabal/src/Distribution/Lex.hs +++ b/Cabal/src/Distribution/Lex.hs @@ -16,11 +16,19 @@ import Prelude () -- | A simple parser supporting quoted strings. -- -- Please be aware that this will only split strings when seeing whitespace --- outside of quotation marks, i.e, @"foo\"bar baz\"qux quux"@ will be --- converted to @["foobar bazqux", "quux"]@. +-- outside of quotation marks; -- --- This behavior can be useful when parsing text like --- @"ghc-options: -Wl,\"some option with spaces\""@, for instance. +-- > foo"bar baz"qux quux +-- +-- >>> tokenizeQuotedWords "foo\"bar baz\"qux quux" +-- ["foobar bazqux","quux"] +-- +-- This behavior can be useful when parsing text like; +-- +-- > ghc-options: -Wl,"some option with spaces" +-- +-- >>> tokenizeQuotedWords "ghc-options: -Wl,\"some option with spaces\"" +-- ["ghc-options:","-Wl,some option with spaces"] tokenizeQuotedWords :: String -> [String] tokenizeQuotedWords xs = repack $ foldr alg (const ([] :| [])) xs False where