Skip to content

Commit 8f666b7

Browse files
author
Pascal "Pixel" Rigaux
committed
1 parent 55d28ca commit 8f666b7

File tree

9 files changed

+86
-89
lines changed

9 files changed

+86
-89
lines changed

‎Perl5Parser/Document.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ initial_state = State { prototypes = initial_prototypes, env = initial_env, next
1717
prog :: Perl5Parser Node
1818

1919
prog = newNode "prog" $ do
20-
l1 <- toNodes spaces_comments_token
20+
l1 <- onList (\l -> Token(Pod "", l)) spaces_comments
2121
l2 <- lines_
2222
eof <?> ""
2323
return$ l1 ++ l2

‎Perl5Parser/Expr.hs

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@ elem_local (LocalIdent, i) l = elem i l
6868
elem_local _ _ = False
6969

7070
op = toList . operator_node
71-
operator' s = if s == "x" then fmap Tokens (pcons (fmap Symbol (string s)) spaces_comments_token)
71+
operator' s = if s == "x" then fmap Token (with_spaces_comments (fmap Symbol$ string s))
7272
else if isWordAny (last s) then symbol_node s else try $ operator_node s
7373
operator_to_parser (i, prio, op) = fmap (\s -> (i, prio, (s,op))) (operator' op)
7474

@@ -110,10 +110,10 @@ curlyB_option_expr = do open <- op "{"
110110
l <- try (pcons word_node (op "}")) <|> seQ [ option_expr, op "}" ]
111111
return (open ++ l)
112112

113-
-- | mostly similar to curlyB_option_expr, but we need to handle {^XXX},
113+
-- | mostly similar to curlyB_option_expr, but we need to handle {^Xxx} (and not {^xxx} nor {^Xxx })
114114
curlyB_option_expr_special =
115115
do open <- op "{"
116-
l <- pcons (fmap (\e -> Tokens [ Word e ]) (pcons (char '^') word_raw)) (op "}")
116+
l <- pcons (fmap (\e -> Token (Word e, [])) (pcons (char '^') word_raw)) (op "}")
117117
<|> try (pcons word_node (op "}"))
118118
<|> seQ [ option_expr, op "}" ]
119119
return (open ++ l)
@@ -146,13 +146,13 @@ expr = newNode"expr"$ expr_ >>= reduce
146146
call_paren [f] <|> to_call_no_para [f]
147147

148148
filetest_call = do f <- Perl5Parser.Token.p_Filetest_raw
149-
s <- spaces_comments_token
150-
let e = Tokens (Ident LocalIdent f : s)
149+
s <- spaces_comments
150+
let e = Token (Ident LocalIdent f, s)
151151
bareword_call_proto (LocalIdent, f) [e]
152152

153153
get_bareword = try$ do f@(l, i) <- Perl5Parser.Token.p_Ident_raw
154-
s <- spaces_comments_token
155-
let e = Tokens (Ident l i : s)
154+
s <- spaces_comments
155+
let e = Token (Ident l i, s)
156156
dont_keep_bareword <- fmap isNothing $ toMaybe $ lookAhead (try_string "->" <|> try_string "=>")
157157
if dont_keep_bareword && elem_local f keywords
158158
then pzero
@@ -189,19 +189,19 @@ expr = newNode"expr"$ expr_ >>= reduce
189189
o_fh <- get_filehandle has
190190
bareword_call_proto f (e ++ o_fh)
191191

192-
get_filehandle True = toNodes Perl5Parser.Token.p_Ident <|> toList scalar
192+
get_filehandle True = toList (fmap Token Perl5Parser.Token.p_Ident <|> scalar)
193193
get_filehandle False = return []
194194

195-
has_file_handle (ZZ (NodeName"") Nothing [Call (NodeName"call", Tokens (Ident LocalIdent i' : _) : para)] Nothing _ _ _) | i == i' = is_filehandle para
196-
has_file_handle (ZZ (NodeName"call") Nothing [Tokens [Ident LocalIdent i']] Nothing _ _ _) | i == i' = return False
195+
has_file_handle (ZZ (NodeName"") Nothing [Call (NodeName"call", Token (Ident LocalIdent i', _) : para)] Nothing _ _ _) | i == i' = is_filehandle para
196+
has_file_handle (ZZ (NodeName"call") Nothing [Token (Ident LocalIdent i', _)] Nothing _ _ _) | i == i' = return False
197197
has_file_handle z = show4debug "call_print, weird" z `seq` return False
198198

199199
has_file_handle' [Node(NodeName"expr", e)] = is_filehandle e
200200
has_file_handle' _ = return False
201201

202202
is_filehandle (Node(NodeName"$", _) : _) = return True
203203
is_filehandle (Call (NodeName"<<", (Node(NodeName"$", _) : _)) : _) = return True
204-
is_filehandle (Call (NodeName"call", (Tokens(Ident l s : _) : _)) : _) = fmap isNothing (Env.get_prototype (l, s))
204+
is_filehandle (Call (NodeName"call", (Token(Ident l s, _) : _)) : _) = fmap isNothing (Env.get_prototype (l, s))
205205
is_filehandle _ = return False
206206

207207
bareword_call_proto :: (IdentT, String) -> [Node] -> Perl5Parser ZZ

‎Perl5Parser/Lines.hs

Lines changed: 16 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ import qualified Perl5Parser.Token.Number
1212

1313
op = toList . operator_node
1414

15-
local_ident s = toList $ fmap Tokens $ pcons (fmap (Ident LocalIdent) $ endWord (string s)) spaces_comments_token
15+
local_ident s = toList $ fmap Token $ with_spaces_comments (fmap (Ident LocalIdent) $ endWord (string s))
1616
symbol_ = toList . symbol_node
1717

1818
-- | A collection of "lines" in the program
@@ -35,10 +35,9 @@ line = format
3535

3636
format = newNode"format"$ seQ
3737
[ local_ident "format"
38-
, toNodes word
38+
, toList (fmap Token word)
3939
, op "="
40-
, toNodes $ pcons (fmap PictureFormat $ anyTill (try_string "\n.\n"))
41-
spaces_comments_token
40+
, toList (fmap Token $ with_spaces_comments (fmap PictureFormat $ anyTill (try_string "\n.\n")))
4241
]
4342

4443
sub_declaration = newNode"Statement::Sub" p
@@ -52,8 +51,8 @@ sub_declaration = newNode"Statement::Sub" p
5251
return (l1 ++ l2 ++ l3 ++ l4)
5352
sub_xxx = do l1 <- symbol_ "sub"
5453
(fq, i) <- Perl5Parser.Token.p_Ident_sure_raw
55-
l2 <- spaces_comments_token
56-
return ((fq, i), l1 ++ [Tokens (Ident fq i : l2)])
54+
l2 <- spaces_comments
55+
return ((fq, i), l1 ++ [Token (Ident fq i, l2)])
5756

5857

5958
scheduled_declaration = newNode"Statement::Scheduled"$ seQ
@@ -75,18 +74,18 @@ prototype :: Perl5Parser (Maybe String, [Node])
7574
prototype = do char '('
7675
proto <- many (satisfy (/= ')'))
7776
char ')'
78-
l <- spaces_comments_token
79-
return (Just proto, [Tokens (Prototype proto : l)])
77+
l <- spaces_comments
78+
return (Just proto, [Token (Prototype proto, l)])
8079

81-
subattrlist = option [] (toNodes Perl5Parser.Token.p_Attributes)
80+
subattrlist = option [] Perl5Parser.Token.p_Attributes
8281

8382
package = newNode"package"$ p
8483
where p = do l1 <- symbol_node "package"
8584
(fq, i) <- Perl5Parser.Token.p_Ident_raw
8685
let pkg = case fq of LocalIdent -> i ; _ -> fq_canonical fq ++ "::" ++ i
8786
Env.set_package pkg
88-
l2 <- spaces_comments_token
89-
return$ l1 : [Tokens $ Word pkg : l2]
87+
l2 <- spaces_comments
88+
return$ l1 : [Token (Word pkg, l2)]
9089

9190
-- | Real conditional expressions
9291
if_then = newNode"if_then"$ Env.with_new_lexical_block$ seQ l
@@ -132,7 +131,7 @@ foreach_var = seQ
132131
, paren_expr
133132
]
134133

135-
pod = newNode"pod" (toList $ fmap Tokens Perl5Parser.Token.p_Pod)
134+
pod = newNode"pod" (toList $ fmap Token Perl5Parser.Token.p_Pod)
136135

137136
block :: Perl5Parser [Node]
138137
block = Env.with_new_lexical_block$ seQ [ op "{", lines_, op "}" ]
@@ -141,7 +140,7 @@ block_allow_pod = seQ [ block, many pod ]
141140

142141
var_declarator = any_symbol_node [ "my", "our" ]
143142
semi_colon = newNode"Token::Structure"$ op ";"
144-
label = fmap Tokens Perl5Parser.Token.p_Label
143+
label = fmap Token Perl5Parser.Token.p_Label
145144

146145

147146
-- | An expression which may have a side-effect
@@ -157,11 +156,10 @@ infix_cmd_optional = seQ [ choice (map symbol_ infix_cmds) <?> ""
157156

158157
use :: Perl5Parser Node
159158
use = newNode"use"$ try$ seQ [ symbol_ "use"
160-
, toNodes $ version_number <|> use_module
159+
, toList version_number <|> use_module
161160
, lexpr
162161
]
163162
where
164-
version_number = pcons (fmap (Number VersionNumber) Perl5Parser.Token.Number.p_VersionNumber) spaces_comments_token
165-
use_module = seQ [ Perl5Parser.Token.p_Ident
166-
, option [] version_number
167-
]
163+
version_number = with_spaces_comments_ (fmap (Number VersionNumber) Perl5Parser.Token.Number.p_VersionNumber)
164+
use_module = pcons (fmap Token Perl5Parser.Token.p_Ident) (option [] (toList version_number))
165+

‎Perl5Parser/ParserHelper.hs

Lines changed: 22 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -4,18 +4,17 @@ module Perl5Parser.ParserHelper
44
-- ^ above are re-exported
55
--
66
, show4debug_pretty
7-
, toList, onList, pcons, seQ, manY, manyl, fold_many, lineBegin, toMaybe
7+
, toList, onList, pcons, p_t2, 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_token, spaces_comments_with_here_doc
14+
, spaces_token, word_raw_token, spaces_comments, spaces_comments_with_here_doc, with_spaces_comments, with_spaces_comments_
1515
, word, symbol, any_symbol, operator
1616
--
1717
, operator_node, symbol_node, any_symbol_node, word_node, newNode
18-
, toNodes
1918
) where
2019

2120
import Data.Char (isAlphaNum, isDigit, isAlpha, isSpace)
@@ -48,6 +47,11 @@ pcons li lis = do l <- li
4847
ls <- lis
4948
return$ l : ls
5049

50+
p_t2 :: GenParser tok st a -> GenParser tok st b -> GenParser tok st (a, b)
51+
p_t2 p1 p2 = do v1 <- p1
52+
v2 <- p2
53+
return (v1, v2)
54+
5155
seQ :: [GenParser tok st [a]] -> GenParser tok st [a]
5256
seQ = fmap concat . sequence
5357

@@ -163,9 +167,6 @@ spaces_comments = do state <- getState
163167
Nothing -> spaces_comments_normal
164168
Just limit -> spaces_comments_with_here_doc limit
165169

166-
spaces_comments_token :: Perl5Parser [TokenT]
167-
spaces_comments_token = onList SpaceComment spaces_comments
168-
169170
spaces_comments_with_here_doc :: String -> Perl5Parser [SpaceCommentT]
170171
spaces_comments_with_here_doc limit = do l <- fmap(map Whitespace) spaces_no_nl
171172
l2 <- option [] (toList comment_token)
@@ -177,31 +178,32 @@ spaces_comments_with_here_doc limit = do l <- fmap(map Whitespace) spaces_no_nl
177178
l2 <- spaces_comments_normal
178179
return$ [HereDocValue here_doc] ++ l2
179180

181+
with_spaces_comments :: Perl5Parser TokenT -> Perl5Parser (TokenT, [SpaceCommentT])
182+
with_spaces_comments p = p_t2 p spaces_comments
180183

181-
word :: Perl5Parser [TokenT]
182-
word = pcons word_raw_token spaces_comments_token
184+
word :: Perl5Parser (TokenT, [SpaceCommentT])
185+
word = with_spaces_comments word_raw_token
183186

184-
symbol :: String -> Perl5Parser [TokenT]
185-
symbol s = pcons (fmap Symbol $ endWord (string s)) spaces_comments_token
187+
symbol :: String -> Perl5Parser (TokenT, [SpaceCommentT])
188+
symbol s = with_spaces_comments (fmap Symbol $ endWord (string s))
186189

187-
any_symbol :: [String] -> Perl5Parser [TokenT]
190+
any_symbol :: [String] -> Perl5Parser (TokenT, [SpaceCommentT])
188191
any_symbol = choice . map symbol
189192

190-
operator :: String -> Perl5Parser [TokenT]
191-
operator s = pcons (fmap Operator $ try_string s) spaces_comments_token
193+
operator :: String -> Perl5Parser (TokenT, [SpaceCommentT])
194+
operator s = with_spaces_comments (fmap Operator (try_string s))
192195

193196

194197
--
195198
--seq_toTokens :: [Perl5Parser String] -> Perl5Parser [Node]
196199
--seq_toTokens = fmap (map Token) . sequence
197200

198-
operator_node s = fmap Tokens $ operator s
199-
symbol_node s = fmap Tokens $ symbol s
200-
any_symbol_node l = fmap Tokens $ any_symbol l
201-
word_node = fmap Tokens word
201+
with_spaces_comments_ = fmap Token . with_spaces_comments
202+
203+
operator_node s = fmap Token $ operator s
204+
symbol_node s = fmap Token $ symbol s
205+
any_symbol_node l = fmap Token $ any_symbol l
206+
word_node = fmap Token word
202207

203208
newNode :: String -> Perl5Parser [Node] -> Perl5Parser Node
204209
newNode s r = fmap (\l -> debug "newNode: " (Node(NodeName s, l))) r <?> s
205-
206-
toNodes :: Perl5Parser [TokenT] -> Perl5Parser [Node]
207-
toNodes = toList . fmap Tokens

‎Perl5Parser/Serialize.hs

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -21,16 +21,16 @@ instance Serialize a => Serialize [a] where
2121
instance Serialize Node where
2222
verbatim (Node(_, l)) = verbatim l
2323
verbatim (Call(_, l)) = verbatim l
24-
verbatim (Tokens l) = verbatim l
24+
verbatim (Token (e, l)) = verbatim e ++ verbatim l
2525

2626
with_parentheses (Call(_, l)) = concat $ map may_add_para l
2727
where may_add_para e = if add_para e then "(" ++ s ++ ")" else s
2828
where s = with_parentheses e
29-
add_para (Tokens _) = False
29+
add_para (Token _) = False
3030
add_para (Node(NodeName n, _)) = not $ elem n ["paren_option_expr", "$", "@", "%", "{}", "[]" ]
3131
add_para _ = True
3232
with_parentheses (Node(_, l)) = with_parentheses l
33-
with_parentheses (Tokens l) = with_parentheses l
33+
with_parentheses (Token (e, l)) = with_parentheses e ++ verbatim l
3434

3535
instance Serialize SpaceCommentT where
3636
verbatim (Whitespace s) = s
@@ -46,7 +46,6 @@ instance Serialize TokenT where
4646
verbatim (Label label co) = label ++ verbatim co ++ ":"
4747
verbatim (Number _ s) = s
4848
verbatim (Word s) = s
49-
verbatim (SpaceComment l) = verbatim l
5049
verbatim (PictureFormat s) = s
5150
verbatim (Prototype s) = "(" ++ s ++ ")"
5251
verbatim (Ident fq i) = to_s_IdentT fq ++ i

‎Perl5Parser/Term.hs

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

5-
import Perl5Parser.Common
65
import Perl5Parser.Types
76
import Perl5Parser.ParserHelper
87
import qualified Perl5Parser.Token
@@ -20,7 +19,7 @@ term = anonymous
2019
<|> hash
2120
<|> scalar_maybe_subscript
2221
<|> array_maybe_slice
23-
<|> fmap Tokens Perl5Parser.Token.p_Token
22+
<|> fmap Token Perl5Parser.Token.p_Token
2423

2524

2625
grouped = newNode"grouped" (seQ [ paren_option_expr, option [] paren_next_slice ])
@@ -63,10 +62,10 @@ simple_subscript = squareB_option_expr
6362
decl_variable :: Perl5Parser [Node]
6463
decl_variable = seQ [ option [] (toList word_node)
6564
, toList (decl_grouped <|> var)
66-
, option [] (toNodes Perl5Parser.Token.p_Attributes)
65+
, option [] Perl5Parser.Token.p_Attributes
6766
]
6867

69-
var = star <|> hash <|> scalar <|> array <|> fmap (\e -> Tokens [Word e]) (try_string "undef")
68+
var = star <|> hash <|> scalar <|> array <|> fmap Token (with_spaces_comments (fmap Word $ try_string "undef"))
7069

7170
op = toList . operator_node
7271
decl_grouped = newNode "grouped"$ seQ [ op "(", list, op ")" ]
@@ -77,15 +76,15 @@ after_deref :: Perl5Parser [Node]
7776
after_deref = fmap concat (many1 simple_subscript)
7877
<|> pcons method (option [] paren_option_expr)
7978
where method = scalar
80-
<|> fmap Tokens Perl5Parser.Token.p_Ident
81-
<|> fmap Tokens (toList Perl5Parser.Token.Quote.p_Double)
82-
<|> fmap Tokens (toList Perl5Parser.Token.Quote.p_Single)
79+
<|> fmap Token Perl5Parser.Token.p_Ident
80+
<|> fmap Token (with_spaces_comments Perl5Parser.Token.Quote.p_Double)
81+
<|> fmap Token (with_spaces_comments Perl5Parser.Token.Quote.p_Single)
8382

8483
----------------------------------------
8584
-- E = [@%$&*] space* R <|> $# R
8685
-- R = $* (ident <|> { expr })
8786

88-
op_no_space s = try_string s >> return (Tokens [ Operator s ])
87+
op_no_space s = fmap Operator (try_string s)
8988

9089
arraylen = var_context "$#" (return []) []
9190
scalar = var_context "$" spaces_comments magic_scalars
@@ -99,32 +98,32 @@ func = var_context_ "&" (try one_ampersand_only) spaces_comments []
9998
var_context :: String -> Perl5Parser [SpaceCommentT] -> [String] -> Perl5Parser Node
10099
var_context s between = var_context_ s (op_no_space s) between
101100

102-
var_context_ :: String -> Perl5Parser Node -> Perl5Parser [SpaceCommentT] -> [String] -> Perl5Parser Node
101+
var_context_ :: String -> Perl5Parser TokenT -> Perl5Parser [SpaceCommentT] -> [String] -> Perl5Parser Node
103102
var_context_ s p between l_magics =
104103
do pval <- p
105104
bval <- between
106105
l <- var_context_after s <|> if has_comment bval then pzero else magics
107-
newNode s $ return (pval : map_non_empty_list (\c -> Tokens [ SpaceComment c ]) bval ++ l) -- ^ do magics after var_context_after to handle $:: vs $:
106+
newNode s $ return (Token (pval, bval) : l) -- ^ do magics after var_context_after to handle $:: vs $:
108107
where
109108
magics = do magic <- choice (map try_string l_magics)
110-
l <- spaces_comments_token
111-
return [Tokens $ Word magic : l]
109+
l <- spaces_comments
110+
return [Token (Word magic, l)]
112111

113112
has_comment = any is_comment
114113
is_comment (Comment _) = True
115114
is_comment _ = False
116115

117116

118117
var_context_after :: String -> Perl5Parser [Node]
119-
var_context_after s = do dollars <- many (op_no_space "$")
118+
var_context_after s = do dollars <- many (fmap (\c -> Token(c, [])) $ op_no_space "$")
120119
fmap (\l -> dollars ++ l) after_end <|> catch_magic_PID s dollars
121120
where after_end = curlyB_option_expr_special
122-
<|> toNodes Perl5Parser.Token.p_Ident_sure
123-
<|> toNodes (pcons (fmap Word $ many1 digit) spaces_comments_token)
121+
<|> toList (fmap Token $ Perl5Parser.Token.p_Ident_sure)
122+
<|> toList (fmap Token $ with_spaces_comments (fmap Word $ many1 digit))
124123
catch_magic_PID s dollars =
125124
if (s == "$" || s == "*") && length dollars > 0 then
126-
do sp <- spaces_comments_token
127-
return$ tail dollars ++ [Tokens (Word "$" : sp)]
125+
do sp <- spaces_comments
126+
return$ tail dollars ++ [Token (Word "$", sp)]
128127
else pzero
129128

130129
magic_scalars = [ "&", "`", "'", "+", "*", ".", "/", "|", "\\", "\"", ";", "%", "=", "-", ")", "#", "~", ":", "?", "!", "@", "$", "<", ">", "(", "0", "[", "]", "}", ",", "#+", "#-", "^L", "^A", "^E", "^C", "^D", "^F", "^H", "^I", "^M", "^N", "^O", "^P", "^R", "^S", "^T", "^V", "^W", "^X", "^" ]

0 commit comments

Comments
 (0)