1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
|
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
module Comments where
import Control.Arrow
parseComments :: (Num col, Num lin) => lin -> col -> [Char] -> [(lin, col, [Char])]
parseComments !lin !col = \case
('/':'*':cs) -> let (lcnt,col',bcnt) = findCloser 1 (0,col,0) cs
(xs,cs') = case drop (bcnt-2) cs of
'*':'/':_ -> second (drop 2) $ splitAt (bcnt-2) cs
_ -> splitAt bcnt cs
in mkComment lin col xs : parseComments (lin + lcnt) col' cs'
('/':'/':cs) -> let (comment,ds) = break (=='\n') cs
in mkComment lin col comment : parseComments (lin + 1) 1 cs
('\n' : cs) -> parseComments (lin+1) 1 cs
( x : cs) -> parseComments lin (col+1) cs
[] -> []
findCloser :: (Num a4, Num a3, Num a2, Num a1, Eq a1) =>
a1 -> (a4, a2, a3) -> [Char] -> (a4, a2, a3)
findCloser !1 (l,c,b) ('*':'/':_) = (l,c+2,b+2)
findCloser !d (l,c,b) ('*':'/':xs) = findCloser (d - 1) (l,c+2,b+2) xs
findCloser !d (l,c,b) ('/':'*':xs) = findCloser (d + 1) (l,c+2,b+2) xs
findCloser !d (l,c,b) ('\n':xs) = findCloser d (l+1,1,b+1) xs
findCloser !d (l,c,b) (_:xs) = findCloser d (l,c+1,b+1) xs
findCloser !d (l,c,b) [] = (l,c,b)
mkComment :: a -> b -> c -> (a, b, c)
mkComment lin no str = (lin,no,str)
|
