Fix previous commit (chunking of multiple single-line comments in Clean.Parse.Comments)

parent 4259738f
Pipeline #31218 passed with stage
in 3 minutes and 8 seconds
...@@ -118,18 +118,17 @@ defaultScanState = ...@@ -118,18 +118,17 @@ defaultScanState =
} }
advance :: !ScanState -> ScanState advance :: !ScanState -> ScanState
advance ss = {ss & col=ss.col+1, idx=ss.idx+1} advance ss = case ss.input.[ss.idx] of
'\t' -> {ss & col=ss.col+4, idx=ss.idx+1} // We assume that there are no tabs in a line
'\n' -> {ss & ln=ss.ln+1, col=0, idx=ss.idx+1}
_ -> {ss & col=ss.col+1, idx=ss.idx+1}
scan :: !ScanState -> (![CleanComment], !ScanState) scan :: !ScanState -> (![CleanComment], !ScanState)
scan ss=:{idx} scan ss=:{idx}
| idx >= size ss.input = ([], ss) | idx >= size ss.input = ([], ss)
| otherwise = case [ss.input.[i] \\ i <- [idx..]] of | otherwise = case [ss.input.[i] \\ i <- [idx..]] of
['\r':_] [s:_] | s=='\r' || s=='\n' || s=='\t'
-> scan (advance ss) -> scan (advance ss)
['\n':_]
-> scan {ss & idx=idx+1, ln=ss.ln+1, col=0}
['\t':_] // We assume that there are no tabs within a line: each tab counts as 4 characters
-> scan {ss & idx=idx+1, col=ss.col+4}
['//':_] | ss.comment_level == 0 ['//':_] | ss.comment_level == 0
# cmnt = # cmnt =
{ line = ss.ln { line = ss.ln
...@@ -139,7 +138,9 @@ scan ss=:{idx} ...@@ -139,7 +138,9 @@ scan ss=:{idx}
, multiline = False , multiline = False
} }
# ss = scan_to_newline ss # ss = scan_to_newline ss
# cmnt & content = ss.input % (idx+2,ss.idx-1) # content = ss.input % (idx+2,ss.idx-1)
# (extra_content,ss) = collect_single_line_comments cmnt.line cmnt.column ss
# cmnt & content = concat [content:extra_content]
# (cmnts,ss) = scan ss # (cmnts,ss) = scan ss
-> ([cmnt:cmnts],ss) -> ([cmnt:cmnts],ss)
['/*':_] ['/*':_]
...@@ -171,13 +172,32 @@ scan ss=:{idx} ...@@ -171,13 +172,32 @@ scan ss=:{idx}
-> scan (skip_string_literal '"' (advance ss)) -> scan (skip_string_literal '"' (advance ss))
_ _
-> scan (advance ss) -> scan (advance ss)
where
collect_single_line_comments :: !Int !Int !ScanState -> (![String], !ScanState)
collect_single_line_comments ln col ss
# ss=:{idx} = skip_whitespace ss
| ss.ln==ln+1 && ss.col==col
&& ss.idx<size ss.input-2
&& ss.input.[idx]=='/' && ss.input.[idx+1]=='/'
# ss = scan_to_newline ss
# content = ss.input % (idx+2,ss.idx-1)
# (cmnts,ss) = collect_single_line_comments (ln+1) col ss
= ([content:cmnts],ss)
= ([],ss)
scan_to_newline :: !ScanState -> ScanState scan_to_newline :: !ScanState -> ScanState
scan_to_newline ss scan_to_newline ss
| ss.idx >= size ss.input = ss | ss.idx >= size ss.input = ss
# c = ss.input.[ss.idx] # c = ss.input.[ss.idx]
| c == '\n' = {ss & ln=ss.ln+1, col=0, idx=ss.idx+1} # ss = advance ss
| otherwise = scan_to_newline (advance ss) = if (c=='\n') ss (scan_to_newline ss)
skip_whitespace :: !ScanState -> ScanState
skip_whitespace ss
| ss.idx >= size ss.input = ss
# c = ss.input.[ss.idx]
| isSpace c = skip_whitespace (advance ss)
| otherwise = ss
skip_list_literal :: !ScanState -> ScanState skip_list_literal :: !ScanState -> ScanState
skip_list_literal ss skip_list_literal ss
...@@ -247,17 +267,8 @@ collectComments comments pm ...@@ -247,17 +267,8 @@ collectComments comments pm
[c:cs] [c:cs]
| c.line <= 3 && startsWith "*" c.content -> (cs, putCC pm c coll) | c.line <= 3 && startsWith "*" c.content -> (cs, putCC pm c coll)
| otherwise -> (comments, coll) | otherwise -> (comments, coll)
# comments = chunkSingleLineComments comments
# (_,_,coll) = collect comments Nothing pm.mod_defs coll # (_,_,coll) = collect comments Nothing pm.mod_defs coll
= coll = coll
where
chunkSingleLineComments [] = []
chunkSingleLineComments [c:cs]
| c.multiline = [c:chunkSingleLineComments cs]
# (same,rest) = bifmap (map snd) (map snd) $ span
(\(i,c`) -> i==c`.line && c.column==c`.column)
[(i,c`) \\ c` <- cs & i <- [c.line+1..]]
= [{c & content=concat [c`.content \\ c` <- [c:same]]}:chunkSingleLineComments rest]
collect :: ![CleanComment] !(Maybe CleanComment) ![a] !CollectedComments -> (![CleanComment], !Maybe CleanComment, !CollectedComments) | pos, singleLineAbove, commentIndex, children a collect :: ![CleanComment] !(Maybe CleanComment) ![a] !CollectedComments -> (![CleanComment], !Maybe CleanComment, !CollectedComments) | pos, singleLineAbove, commentIndex, children a
collect cc prev [] coll = (cc, prev, coll) collect cc prev [] coll = (cc, prev, coll)
......
...@@ -19,10 +19,11 @@ import Clean.Parse.Comments ...@@ -19,10 +19,11 @@ import Clean.Parse.Comments
//* This type is just here to test; it isn't used //* This type is just here to test; it isn't used
:: TrickyADT :: TrickyADT
= TrickyADT_A //* Documentation on same line = TrickyADT_A //* Documentation on same line
| TrickyADT_B | TrickyADT_B //* New constructor with matching column
| TrickyADT_C
//* Documentation on new line //* Documentation on new line
//* Extra documentation line //* Extra documentation line
| TrickyADT_C | TrickyADT_D
//* Documentation on new line //* Documentation on new line
list_comments :: !ParsedModule !CollectedComments -> [Entry] list_comments :: !ParsedModule !CollectedComments -> [Entry]
......
...@@ -38,8 +38,9 @@ expected = ...@@ -38,8 +38,9 @@ expected =
, {kind="selector", name="value", value=Nothing} , {kind="selector", name="value", value=Nothing}
, {kind="type", name="TrickyADT", value=Just "* This type is just here to test; it isn't used\n"} , {kind="type", name="TrickyADT", value=Just "* This type is just here to test; it isn't used\n"}
, {kind="constructor", name="TrickyADT_A", value=Just "* Documentation on same line\n"} , {kind="constructor", name="TrickyADT_A", value=Just "* Documentation on same line\n"}
, {kind="constructor", name="TrickyADT_B", value=Just "* Documentation on new line\n* Extra documentation line\n"} , {kind="constructor", name="TrickyADT_B", value=Just "* New constructor with matching column\n"}
, {kind="constructor", name="TrickyADT_C", value=Just "* Documentation on new line\n"} , {kind="constructor", name="TrickyADT_C", value=Just "* Documentation on new line\n* Extra documentation line\n"}
, {kind="constructor", name="TrickyADT_D", value=Just "* Documentation on new line\n"}
, {kind="typespec", name="list_comments", value=Nothing} , {kind="typespec", name="list_comments", value=Nothing}
] ]
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment