Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
95283a5d
Commit
95283a5d
authored
Mar 19, 2020
by
Oleg Grenrus
Browse files
Slightly optimise parseUnqualComponentName
The speed-up is smaller than I would like, only 1-2%.
parent
f2717822
Changes
2
Hide whitespace changes
Inline
Side-by-side
Cabal/Distribution/Compat/DList.hs
View file @
95283a5d
...
...
@@ -12,6 +12,7 @@
module
Distribution.Compat.DList
(
DList
,
runDList
,
empty
,
singleton
,
fromList
,
toList
,
...
...
@@ -19,7 +20,7 @@ module Distribution.Compat.DList (
)
where
import
Prelude
()
import
Distribution.Compat.Prelude
hiding
(
toList
)
import
Distribution.Compat.Prelude
hiding
(
toList
,
empty
)
-- | Difference list.
newtype
DList
a
=
DList
([
a
]
->
[
a
])
...
...
@@ -31,6 +32,9 @@ runDList (DList run) = run []
singleton
::
a
->
DList
a
singleton
a
=
DList
(
a
:
)
empty
::
DList
a
empty
=
DList
id
fromList
::
[
a
]
->
DList
a
fromList
as
=
DList
(
as
++
)
...
...
@@ -41,7 +45,7 @@ snoc :: DList a -> a -> DList a
snoc
xs
x
=
xs
<>
singleton
x
instance
Monoid
(
DList
a
)
where
mempty
=
DList
id
mempty
=
empty
mappend
=
(
<>
)
instance
Semigroup
(
DList
a
)
where
...
...
Cabal/Distribution/Parsec.hs
View file @
95283a5d
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
...
...
@@ -56,6 +57,7 @@ import Numeric (showIntAtBase)
import
Prelude
()
import
qualified
Distribution.Compat.CharParsing
as
P
import
qualified
Distribution.Compat.DList
as
DList
import
qualified
Distribution.Compat.MonadFail
as
Fail
import
qualified
Text.Parsec
as
Parsec
...
...
@@ -342,15 +344,65 @@ parsecQuoted = P.between (P.char '"') (P.char '"')
parsecMaybeQuoted
::
CabalParsing
m
=>
m
a
->
m
a
parsecMaybeQuoted
p
=
parsecQuoted
p
<|>
p
parsecUnqualComponentName
::
CabalParsing
m
=>
m
String
parsecUnqualComponentName
=
intercalate
"-"
<$>
toList
<$>
P
.
sepByNonEmpty
component
(
P
.
char
'-'
)
where
component
::
CabalParsing
m
=>
m
String
component
=
do
cs
<-
P
.
munch1
isAlphaNum
if
all
isDigit
cs
then
fail
"all digits in portion of unqualified component name"
else
return
cs
parsecUnqualComponentName
::
forall
m
.
CabalParsing
m
=>
m
String
parsecUnqualComponentName
=
state0
DList
.
empty
where
--
-- using @kleene@ package we can easily see that
-- we need only two states to recognize
-- unqual-component-name
--
-- Compare with declarative
-- 'Distribution.FieldGrammar.Described.reUnqualComponent'.
--
-- @
-- import Kleene
-- import Kleene.Internal.Pretty
-- import Algebra.Lattice
-- import Data.Char
--
-- import qualified Data.RangeSet.Map as RSet
--
-- main = do
-- -- this is an approximation, to get an idea.
-- let component :: RE Char
-- component = star alphaNum <> alpha <> star alphaNum
--
-- alphaNum = alpha \/ num
-- alpha = unions $ map char ['a'..'z']
-- num = unions $ map char ['0'..'9']
--
-- re :: RE Char
-- re = component <> star (char '-' <> component)
--
-- putPretty re
-- putPretty $ fromTM re
-- @
state0
::
DList
.
DList
Char
->
m
String
state0
acc
=
do
c
<-
ch
-- <|> fail ("Invalid component, after " ++ DList.toList acc)
case
()
of
_
|
isDigit
c
->
state0
(
DList
.
snoc
acc
c
)
|
isAlphaNum
c
->
state1
(
DList
.
snoc
acc
c
)
|
c
==
'-'
->
fail
(
"Empty component, after "
++
DList
.
toList
acc
)
|
otherwise
->
fail
(
"Internal error, after "
++
DList
.
toList
acc
)
state1
::
DList
.
DList
Char
->
m
String
state1
acc
=
state1'
acc
`
alt
`
return
(
DList
.
toList
acc
)
state1'
::
DList
.
DList
Char
->
m
String
state1'
acc
=
do
c
<-
ch
case
()
of
_
|
isAlphaNum
c
->
state1
(
DList
.
snoc
acc
c
)
|
c
==
'-'
->
state0
(
DList
.
snoc
acc
c
)
|
otherwise
->
fail
(
"Internal error, after "
++
DList
.
toList
acc
)
ch
::
m
Char
!
ch
=
P
.
satisfy
(
\
c
->
isAlphaNum
c
||
c
==
'-'
)
alt
::
m
String
->
m
String
->
m
String
!
alt
=
(
<|>
)
stringLiteral
::
forall
m
.
P
.
CharParsing
m
=>
m
String
stringLiteral
=
lit
where
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment