Skip to content

Commit 8e55324

Browse files
author
Pascal "Pixel" Rigaux
committed
1 parent 2c702ef commit 8e55324

File tree

11 files changed

+63
-47
lines changed

11 files changed

+63
-47
lines changed

‎Perl5Parser/Common.hs

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
module Perl5Parser.Common
22
( show4debug
3-
, map_t2
3+
, map_t2, map_non_empty_list
44
, internal_error
55
, isNothing, fromMaybe
66
) where
@@ -10,6 +10,10 @@ import System.IO.Unsafe (unsafePerformIO)
1010

1111
map_t2 f (a,b) = (f a, f b)
1212

13+
map_non_empty_list :: ([a] -> b) -> [a] -> [b]
14+
map_non_empty_list _ [] = []
15+
map_non_empty_list f l = [f l]
16+
1317
show4debug :: Show a => String -> a -> a
1418
show4debug s e = seq (unsafePerformIO $ putStrLn (s ++ ": " ++ show e)) e
1519

‎Perl5Parser/Document.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ initial_state = State initial_prototypes Nothing
1313
prog :: Perl5Parser Node
1414

1515
prog = newNode "prog" $ do
16-
l1 <- toNodes spaces_comments
16+
l1 <- toNodes spaces_comments_token
1717
l2 <- lines_
1818
eof <?> ""
1919
return$ l1 ++ l2

‎Perl5Parser/Expr.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,7 @@ fmap_maybe _ Nothing = return Nothing
6565
fmap_maybe f (Just e) = fmap Just (f e)
6666

6767
op = toList . operator_node
68-
operator' s = if s == "x" then fmap Tokens (pcons (fmap Symbol (string s)) spaces_comments)
68+
operator' s = if s == "x" then fmap Tokens (pcons (fmap Symbol (string s)) spaces_comments_token)
6969
else if isWordAny (last s) then symbol_node s else try $ operator_node s
7070
operator_to_parser (i, prio, op) = fmap (\s -> (i, prio, (s,op))) (operator' op)
7171

@@ -147,12 +147,12 @@ expr = newNode"expr"$ expr_ >>= reduce
147147
call_paren [f] <|> to_call_no_para [f]
148148

149149
filetest_call = do f <- Perl5Parser.Token.p_Filetest_raw
150-
s <- spaces_comments
150+
s <- spaces_comments_token
151151
let e = Tokens (Word f : s)
152152
bareword_call_proto f [e]
153153

154154
get_bareword = try$ do f <- Perl5Parser.Token.p_Ident_raw
155-
s <- spaces_comments
155+
s <- spaces_comments_token
156156
let e = Tokens (Word f : s)
157157
dont_keep_bareword <- fmap isNothing $ toMaybe $ lookAhead (try_string "->" <|> try_string "=>")
158158
if dont_keep_bareword && elem f keywords

‎Perl5Parser/Lines.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ format = newNode"format"$ seQ
3636
, toNodes word
3737
, op "="
3838
, toNodes $ pcons (fmap PictureFormat $ anyTill (try_string "\n.\n"))
39-
spaces_comments
39+
spaces_comments_token
4040
]
4141

4242
sub_declaration = newNode"Statement::Sub"$ seQ
@@ -60,7 +60,7 @@ anonymous_sub = newNode"anonymous_sub"$ seQ
6060
, block
6161
]
6262

63-
prototype = option [] (toNodes $ pcons prototype_ spaces_comments)
63+
prototype = option [] (toNodes $ pcons prototype_ spaces_comments_token)
6464
where prototype_ = fmap Prototype $ seQ [ charl '(' , anyTill (charl ')') ]
6565

6666
subattrlist = option [] (toNodes Perl5Parser.Token.p_Attributes)
@@ -139,7 +139,7 @@ use = newNode"use"$ try$ seQ [ symbol_ "use"
139139
, lexpr
140140
]
141141
where
142-
version_number = pcons (fmap (Number VersionNumber) Perl5Parser.Token.Number.p_VersionNumber) spaces_comments
142+
version_number = pcons (fmap (Number VersionNumber) Perl5Parser.Token.Number.p_VersionNumber) spaces_comments_token
143143
use_module = seQ [ Perl5Parser.Token.p_Ident
144144
, option [] version_number
145145
]

‎Perl5Parser/ParserHelper.hs

Lines changed: 15 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -4,14 +4,14 @@ module Perl5Parser.ParserHelper
44
-- ^ above are re-exported
55
--
66
, show4debug_pretty
7-
, toList, pcons, seQ, manY, manyl, fold_many, lineBegin, toMaybe
7+
, toList, onList, pcons, seQ, manY, manyl, fold_many, lineBegin, toMaybe
88
, anyTill, parse
99
, isWordAny, isDigit_, isAlpha_, isSpace, balancedDelim, infix_cmds, keywords
1010
, charl, oneOfl, try_string
1111
, notWord, wordAny, digit_
1212
, word_raw, comment, spaces_no_nl, spaces, spaces_comments_normal, endWord
1313
--
14-
, spaces_token, word_raw_token, spaces_comments, spaces_comments_with_here_doc
14+
, spaces_token, word_raw_token, spaces_comments, spaces_comments_token, spaces_comments_with_here_doc
1515
, word, symbol, any_symbol, operator
1616
--
1717
, operator_node, symbol_node, any_symbol_node, word_node, newNode
@@ -40,6 +40,9 @@ show4debug_pretty s e = seq (unsafePerformIO $ putStrLn (s ++ ": " ++ Perl5Parse
4040
toList :: GenParser tok st a -> GenParser tok st [a]
4141
toList = fmap (\c -> [c])
4242

43+
onList :: ([a] -> b) -> GenParser tok st [a] -> GenParser tok st [b]
44+
onList f = fmap (map_non_empty_list f)
45+
4346
pcons :: GenParser tok st a -> GenParser tok st [a] -> GenParser tok st [a]
4447
pcons li lis = do l <- li
4548
ls <- lis
@@ -53,7 +56,7 @@ manY = fmap concat . many
5356
--manY1 = fmap concat . many1
5457

5558
manyl :: Eq a => GenParser tok st a -> GenParser tok st [[a]]
56-
manyl = fmap (\c -> if c == [] then [] else [c]) . many
59+
manyl = onList id . many
5760

5861
fold_many :: (a -> GenParser tok st a) -> a -> GenParser tok st a
5962
fold_many p accu = option accu (p accu >>= fold_many p)
@@ -150,17 +153,20 @@ word_raw_token = fmap Word word_raw
150153
spaces_token = fmap (map Whitespace) spaces
151154
comment_token = fmap Comment comment
152155

153-
spaces_comments_normal :: CharParser st [TokenT]
156+
spaces_comments_normal :: CharParser st [SpaceCommentT]
154157
spaces_comments_normal = seQ [ spaces_token, manY $ seQ [ toList comment_token, spaces_token ] ]
155158

156159

157-
spaces_comments :: Perl5Parser [TokenT]
160+
spaces_comments :: Perl5Parser [SpaceCommentT]
158161
spaces_comments = do state <- getState
159162
case next_line_is_here_doc state of
160163
Nothing -> spaces_comments_normal
161164
Just limit -> spaces_comments_with_here_doc limit
162165

163-
spaces_comments_with_here_doc :: String -> Perl5Parser [TokenT]
166+
spaces_comments_token :: Perl5Parser [TokenT]
167+
spaces_comments_token = onList SpaceComment spaces_comments
168+
169+
spaces_comments_with_here_doc :: String -> Perl5Parser [SpaceCommentT]
164170
spaces_comments_with_here_doc limit = do l <- fmap(map Whitespace) spaces_no_nl
165171
l2 <- option [] (toList comment_token)
166172
l3 <- option [] get_here_doc
@@ -173,16 +179,16 @@ spaces_comments_with_here_doc limit = do l <- fmap(map Whitespace) spaces_no_nl
173179

174180

175181
word :: Perl5Parser [TokenT]
176-
word = pcons word_raw_token spaces_comments
182+
word = pcons word_raw_token spaces_comments_token
177183

178184
symbol :: String -> Perl5Parser [TokenT]
179-
symbol s = pcons (fmap Symbol $ endWord (string s)) spaces_comments
185+
symbol s = pcons (fmap Symbol $ endWord (string s)) spaces_comments_token
180186

181187
any_symbol :: [String] -> Perl5Parser [TokenT]
182188
any_symbol = choice . map symbol
183189

184190
operator :: String -> Perl5Parser [TokenT]
185-
operator s = pcons (fmap Operator $ try_string s) spaces_comments
191+
operator s = pcons (fmap Operator $ try_string s) spaces_comments_token
186192

187193

188194
--

‎Perl5Parser/Serialize.hs

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -32,18 +32,21 @@ instance Serialize Node where
3232
with_parentheses (Node(_, l)) = with_parentheses l
3333
with_parentheses (Tokens l) = with_parentheses l
3434

35+
instance Serialize SpaceCommentT where
36+
verbatim (Whitespace s) = s
37+
verbatim (Comment s) = s
38+
verbatim (HereDocValue s) = s
39+
3540
instance Serialize TokenT where
3641
verbatim (Quote t s) = to_s_Quote t s
3742
verbatim (QuoteLike t s) = to_s_QuoteLike t s
3843
verbatim (Regexp t) = to_s_Regexp t
3944
verbatim (Separator sep l s) = to_s_Separator sep ++ concat l ++ s
4045
verbatim (HereDoc co name) = "<<" ++ verbatim co ++ verbatim name
41-
verbatim (Label label co) = label ++ verbatim co
46+
verbatim (Label label co) = label ++ verbatim co ++ ":"
4247
verbatim (Number _ s) = s
4348
verbatim (Word s) = s
44-
verbatim (Whitespace s) = s
45-
verbatim (Comment s) = s
46-
verbatim (HereDocValue s) = s
49+
verbatim (SpaceComment l) = verbatim l
4750
verbatim (PictureFormat s) = s
4851
verbatim (Prototype s) = s
4952
verbatim (Symbol s) = s

‎Perl5Parser/Term.hs

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@ module Perl5Parser.Term
22
( term, func, scalar, after_deref, decl_variable
33
) where
44

5+
import Perl5Parser.Common
56
import Perl5Parser.Types
67
import Perl5Parser.ParserHelper
78
import qualified Perl5Parser.Token
@@ -95,18 +96,18 @@ func = var_context_ "&" (try one_ampersand_only) spaces_comments []
9596
-- | ugly special case to handle "eval {} && ...", so here we accept only one ampersand
9697
where one_ampersand_only = notFollowedBy_ (char '&') (op_no_space "&")
9798

98-
var_context :: String -> Perl5Parser [TokenT] -> [String] -> Perl5Parser Node
99+
var_context :: String -> Perl5Parser [SpaceCommentT] -> [String] -> Perl5Parser Node
99100
var_context s between = var_context_ s (op_no_space s) between
100101

101-
var_context_ :: String -> Perl5Parser Node -> Perl5Parser [TokenT] -> [String] -> Perl5Parser Node
102+
var_context_ :: String -> Perl5Parser Node -> Perl5Parser [SpaceCommentT] -> [String] -> Perl5Parser Node
102103
var_context_ s p between l_magics =
103104
do pval <- p
104105
bval <- between
105106
l <- var_context_after s <|> if has_comment bval then pzero else magics
106-
newNode s $ return (pval : Tokens bval : l) -- ^ do magics after var_context_after to handle $:: vs $:
107+
newNode s $ return (pval : map_non_empty_list (\c -> Tokens [ SpaceComment c ]) bval ++ l) -- ^ do magics after var_context_after to handle $:: vs $:
107108
where
108109
magics = do magic <- choice (map try_string l_magics)
109-
l <- spaces_comments
110+
l <- spaces_comments_token
110111
return [Tokens $ Word magic : l]
111112

112113
has_comment = any is_comment
@@ -119,10 +120,10 @@ var_context_after s = do dollars <- many (op_no_space "$")
119120
fmap (\l -> dollars ++ l) after_end <|> catch_magic_PID s dollars
120121
where after_end = curlyB_option_expr_special
121122
<|> toNodes Perl5Parser.Token.p_Ident_sure
122-
<|> toNodes (pcons (fmap Word $ many1 digit) spaces_comments)
123+
<|> toNodes (pcons (fmap Word $ many1 digit) spaces_comments_token)
123124
catch_magic_PID s dollars =
124125
if (s == "$" || s == "*") && length dollars > 0 then
125-
do sp <- spaces_comments
126+
do sp <- spaces_comments_token
126127
return$ tail dollars ++ [Tokens (Word "$" : sp)]
127128
else pzero
128129

‎Perl5Parser/Token.hs

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -17,28 +17,28 @@ import qualified Perl5Parser.Token.HereDoc
1717

1818

1919
p_Pod :: Perl5Parser [TokenT]
20-
p_Pod = pcons (fmap Pod p_Pod_raw) spaces_comments
20+
p_Pod = pcons (fmap Pod p_Pod_raw) spaces_comments_token
2121
p_Pod_raw = seQ
2222
[ seQ [ lineBegin (charl '='), toList (satisfy isAlpha) ]
2323
, anyTill (try_string "\n=cut" <|> (eof >> return "")) -- ^ allow non closed pods (eg: the buggy ExtUtils/MM_BeOS.pm)
2424
, anyTill (charl '\n' <|> (eof >> return ""))
2525
]
2626

2727
p_Label :: Perl5Parser [TokenT]
28-
p_Label = pcons p_Label_raw spaces_comments
28+
p_Label = pcons p_Label_raw spaces_comments_token
2929
p_Label_raw = try$ do s <- word_raw
3030
if s == "s" then pzero else return []
31-
sp <- fmap (map Whitespace) spaces_no_nl
32-
l <- notFollowedBy_ (char ':') (operator ":") -- for pkg::f()
33-
return$ Label s (sp ++ l)
31+
sp <- spaces_no_nl
32+
notFollowedBy_ (char ':') (char ':') -- for pkg::f()
33+
return$ Label s (map Whitespace sp)
3434

3535
-- | :: a ::b c:: ::d:: e::f e'f e::'f e::2
3636
p_Ident :: Perl5Parser [TokenT]
37-
p_Ident = pcons (fmap Word p_Ident_raw) spaces_comments
37+
p_Ident = pcons (fmap Word p_Ident_raw) spaces_comments_token
3838

3939
-- | same as p_Ident with also 'b (::b)
4040
p_Ident_sure :: Perl5Parser [TokenT]
41-
p_Ident_sure = pcons (fmap Word p_Ident_raw_cont) spaces_comments
41+
p_Ident_sure = pcons (fmap Word p_Ident_raw_cont) spaces_comments_token
4242

4343
p_Ident_raw :: Perl5Parser String
4444
p_Ident_raw = seQ [ try_string "::"
@@ -56,7 +56,7 @@ p_Filetest_raw = try $ do char '-'
5656

5757
p_Attributes :: Perl5Parser [TokenT]
5858
p_Attributes = fmap concat $ many1 $ seQ [ operator ":"
59-
, manY (pcons attribute spaces_comments)
59+
, manY (pcons attribute spaces_comments_token)
6060
]
6161
where attribute = do w <- word_raw
6262
para <- toMaybe parameters
@@ -68,7 +68,7 @@ p_Attributes = fmap concat $ many1 $ seQ [ operator ":"
6868

6969

7070
p_Token :: Perl5Parser [TokenT]
71-
p_Token = do pcons p spaces_comments
71+
p_Token = do pcons p spaces_comments_token
7272
where p =
7373
fmap to_Quote Perl5Parser.Token.Quote.p_Interpolate
7474
<|> fmap to_Quote Perl5Parser.Token.Quote.p_Literal

‎Perl5Parser/Token/HereDoc.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ p_HereDoc = do try_string "<<"
1515
updateState (\state -> state { next_line_is_here_doc = Just s })
1616
return$ HereDoc space tok
1717

18-
here_doc_next :: Perl5Parser ([TokenT], TokenT, String)
18+
here_doc_next :: Perl5Parser ([SpaceCommentT], TokenT, String)
1919
here_doc_next = do s <- many1 wordAny -- ^ and not word_raw because <<1 is allowed
2020
return ([], Word s, s)
2121
<|> do l <- spaces_token

‎Perl5Parser/Token/Quote.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ user_delimited_string :: String -> Perl5Parser (LiteralT, String)
4242
user_delimited_string s = user_delimited_string_p$ try (string s >> notWord)
4343

4444

45-
find_next_if_space :: Char -> Perl5Parser ([TokenT], Char)
45+
find_next_if_space :: Char -> Perl5Parser ([SpaceCommentT], Char)
4646
find_next_if_space c =
4747
if isSpace c then
4848
do l <- spaces_comments

‎Perl5Parser/Types.hs

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
module Perl5Parser.Types
22
( State(..)
3-
, NodeName(..), CommentO, BalancedOrNot(..), LiteralT, SubstituteT
3+
, NodeName(..), SpaceCommentT(..), BalancedOrNot(..), LiteralT, SubstituteT
44
, QuoteT(..), QuoteLikeT(..), RegexpOptionT, RegexpT(..), NumberT(..), SeparatorT(..), TokenT(..), Node(..)
55
, Perl5Parser
66
) where
@@ -22,16 +22,20 @@ newtype NodeName = NodeName String deriving Eq
2222
instance Show NodeName where
2323
show (NodeName s) = s
2424

25-
type CommentO = Maybe String
25+
data SpaceCommentT =
26+
Whitespace String
27+
| Comment String
28+
| HereDocValue String
29+
deriving Show
2630

2731
data BalancedOrNot a =
2832
NonBalanced Char
2933
| Balanced Char a
3034
deriving Show
3135

3236
-- | [TokenT] is the optional comment
33-
type LiteralT = ([TokenT], BalancedOrNot Char)
34-
type SubstituteT = ([TokenT], BalancedOrNot (Char, LiteralT))
37+
type LiteralT = ([SpaceCommentT], BalancedOrNot Char)
38+
type SubstituteT = ([SpaceCommentT], BalancedOrNot (Char, LiteralT))
3539

3640
data QuoteT =
3741
Double
@@ -73,17 +77,15 @@ data TokenT =
7377
| Regexp RegexpT
7478
| Number NumberT String
7579
| Word String
76-
| Whitespace String
77-
| Comment String
80+
| SpaceComment [SpaceCommentT]
7881
| Separator SeparatorT [String] String
79-
| HereDoc [TokenT] TokenT
80-
| HereDocValue String
82+
| HereDoc [SpaceCommentT] TokenT
8183
| PictureFormat String
8284
| Prototype String
8385
| Symbol String
8486
| Operator String
8587
| Pod String
86-
| Label String [TokenT]
88+
| Label String [SpaceCommentT]
8789
| Attribute String (Maybe String)
8890
deriving Show
8991

0 commit comments

Comments
 (0)