diff options
Diffstat (limited to 'snug-clean/src/Snug/Parse.icl')
| -rw-r--r-- | snug-clean/src/Snug/Parse.icl | 35 |
1 files changed, 26 insertions, 9 deletions
diff --git a/snug-clean/src/Snug/Parse.icl b/snug-clean/src/Snug/Parse.icl index 9d58f23..4347c34 100644 --- a/snug-clean/src/Snug/Parse.icl +++ b/snug-clean/src/Snug/Parse.icl @@ -43,6 +43,11 @@ where (simpleList (parenthesized typedArgument)) (pToken TColon *> type) (pToken TColon *> expression) + <<|> liftM4 TestDef + (pToken (TIdent "test") *> string) + (pToken TColon *> type) + (pToken TColon *> simpleOrParenthesizedExpression) + string simpleConstructorDef = liftM2 ConstructorDef constructorIdent (pure []) constructorDef = liftM2 ConstructorDef constructorIdent (many simpleOrParenthesizedType) @@ -101,6 +106,9 @@ basicValue = (\(TInt i) -> BVInt i) <$> pSatisfy (\t -> t=:(TInt _)) <<|> (\(TChar c) -> BVChar c) <$> pSatisfy (\t -> t=:(TChar _)) +string :: Parser Token String +string = (\(TString s) -> s) <$> pSatisfy (\t -> t=:(TString _)) + typeIdent :: Parser Token TypeIdent typeIdent = fromIdent <$> pSatisfy isUpperCaseIdent @@ -152,6 +160,7 @@ nonEmpty p = p >>= \xs -> if (isEmpty xs) pFail (pure xs) | TIdent !String | TInt !Int | TChar !Char + | TString !String | TComment !String //* (# ... #) | TError !Int !Int !String @@ -169,6 +178,8 @@ where (==) (TInt _) _ = False (==) (TChar x) (TChar y) = x == y (==) (TChar _) _ = False + (==) (TString x) (TString y) = x == y + (==) (TString _) _ = False (==) (TComment x) (TComment y) = x == y (==) (TComment _) _ = False (==) (TError _ _ _) _ = False @@ -238,15 +249,6 @@ lex` line col [c:cs] | isSpace c = lex` line (col+1) cs -/* Identifiers*/ -lex` line col cs=:[c:_] - | isAlpha c - # (name,cs) = span isIdentChar cs - = [TIdent (toString name) : lex` line (col + length name) cs] - | isFunnySymbol c - # (name,cs) = span isFunnySymbol cs - = [TIdent (toString name) : lex` line (col + length name) cs] - /* Basic values */ lex` line col cs=:[c:_] | isDigit c @@ -258,6 +260,21 @@ lex` line col [c:cs] = [TInt (0 - toInt (toString i)) : lex` line (col + 1 + length i) cs] lex` line col ['\'',c,'\'':cs] // TODO: escape sequences = [TChar c : lex` line (col+3) cs] +lex` line col ['"':cs] // TODO: escape sequences; correctly compute new line/col in case of newlines + = [TString s : lex` line (col + 2 + size s) (tl rest)] +where + (chars,rest) = span ((<>) '"') cs + s = {c \\ c <- chars} + +/* Identifiers (must come after basic values for correct lexing of negative + * integers) */ +lex` line col cs=:[c:_] + | isAlpha c + # (name,cs) = span isIdentChar cs + = [TIdent (toString name) : lex` line (col + length name) cs] + | isFunnySymbol c + # (name,cs) = span isFunnySymbol cs + = [TIdent (toString name) : lex` line (col + length name) cs] /* Unparseable input */ lex` line col cs |