diff options
Diffstat (limited to 'snug-clean/src/Snug/Parse.icl')
| -rw-r--r-- | snug-clean/src/Snug/Parse.icl | 24 |
1 files changed, 23 insertions, 1 deletions
diff --git a/snug-clean/src/Snug/Parse.icl b/snug-clean/src/Snug/Parse.icl index 63a9fda..75d9295 100644 --- a/snug-clean/src/Snug/Parse.icl +++ b/snug-clean/src/Snug/Parse.icl @@ -16,9 +16,11 @@ import Text.Parsers.Simple.Core import Snug.Syntax parseSnug :: ![Char] -> MaybeError String [Definition] -parseSnug cs = case parse (many definition`) (lex cs) of +parseSnug cs = case parse (many definition`) (filterComments (lex cs)) of Left errors -> Error ('Text'.join "; " errors) Right defs -> Ok defs +where + filterComments tks = [t \\ t <- tks | not (t=:(TComment _))] definition` :: Parser Token Definition definition` = parenthesized def @@ -146,6 +148,7 @@ nonEmpty p = p >>= \xs -> if (isEmpty xs) pFail (pure xs) | TInt !Int | TChar !Char + | TComment !String //* (# ... #) | TError !Int !Int !String instance == Token @@ -161,6 +164,8 @@ where (==) (TInt _) _ = False (==) (TChar x) (TChar y) = x == y (==) (TChar _) _ = False + (==) (TComment x) (TComment y) = x == y + (==) (TComment _) _ = False (==) (TError _ _ _) _ = False lex :: ![Char] -> [Token] @@ -169,6 +174,23 @@ lex cs = lex` 0 0 cs lex` :: !Int !Int ![Char] -> [Token] lex` _ _ [] = [] +lex` line col ['(#':cs] + = stripComment line (col+2) cs 0 [] +where + stripComment line col ['#)':cs] 0 acc + = [TComment (toString (reverse acc)) : lex` line (col+2) cs] + stripComment line col ['(#':cs] n acc + = stripComment line (col+2) cs (n+1) ['#(':acc] + stripComment line col ['\r\n':cs] n acc + = stripComment (line+1) 0 cs n ['\n\r':acc] + stripComment line col ['\n\r':cs] n acc + = stripComment (line+1) 0 cs n ['\r\n':acc] + stripComment line col [c:cs] n acc + | c=='\n' || c=='\r' + = stripComment (line+1) 0 cs n [c:acc] + = stripComment line (col+1) cs n [c:acc] + stripComment line col [] _ _ + = [TError line col "end of file while scanning comment"] /* This alternative is for characters that can never be part of identifiers: */ lex` line col [c:cs] | isJust mbToken |