diff options
Diffstat (limited to 'snug-clean/src/Snug')
| -rw-r--r-- | snug-clean/src/Snug/Parse.icl | 41 |
1 files changed, 23 insertions, 18 deletions
diff --git a/snug-clean/src/Snug/Parse.icl b/snug-clean/src/Snug/Parse.icl index 75d9295..64331c5 100644 --- a/snug-clean/src/Snug/Parse.icl +++ b/snug-clean/src/Snug/Parse.icl @@ -12,9 +12,14 @@ import Data.Tuple import qualified Text from Text import class Text, instance Text String import Text.Parsers.Simple.Core +import qualified Text.Parsers.Simple.Core import Snug.Syntax +// override infix priority to use easily with <$> +(<<|>) infixr 3 :: !(Parser t a) (Parser t a) -> Parser t a +(<<|>) left right = left 'Text.Parsers.Simple.Core'. <<|> right + parseSnug :: ![Char] -> MaybeError String [Definition] parseSnug cs = case parse (many definition`) (filterComments (lex cs)) of Left errors -> Error ('Text'.join "; " errors) @@ -30,10 +35,10 @@ where (pToken (TIdent "data") *> typeIdent) (fromMaybe [] <$> optional (simpleList typeVarIdent)) (list simpleConstructorDef constructorDef) - <|> liftM2 TypeDef + <<|> liftM2 TypeDef (pToken (TIdent "type") *> typeIdent) simpleOrParenthesizedType - <|> liftM4 FunDef + <<|> liftM4 FunDef (pToken (TIdent "fun") *> symbolIdent) (simpleList (parenthesized typedArgument)) (pToken TColon *> type) @@ -50,20 +55,20 @@ complexType = liftM2 (foldl TyApp) simpleType (some simpleOrParenthesizedType) simpleType :: Parser Token Type simpleType = Type <$> typeIdent - <|> TyVar <$> typeVarIdent + <<|> TyVar <$> typeVarIdent type :: Parser Token Type -type = complexType <|> simpleType +type = complexType <<|> simpleType simpleOrParenthesizedType :: Parser Token Type -simpleOrParenthesizedType = simpleType <|> parenthesized complexType +simpleOrParenthesizedType = simpleType <<|> parenthesized complexType complexExpression :: Parser Token Expression complexExpression = liftM2 Case (pToken (TIdent "case") *> simpleOrParenthesizedExpression) (nonEmpty (simpleList (parenthesized caseAlternative))) - <|> liftM2 (foldl ExpApp) + <<|> liftM2 (foldl ExpApp) simpleExpression (some simpleOrParenthesizedExpression) where @@ -73,28 +78,28 @@ where = liftM2 ConstructorPattern constructorIdent (many simpleOrParenthesizedPattern) simplePattern = pToken TUnderscore $> Wildcard - <|> BasicValuePattern <$> basicValue - <|> IdentPattern <$> symbolIdent - <|> liftM2 ConstructorPattern constructorIdent (pure []) - simpleOrParenthesizedPattern = simplePattern <|> parenthesized complexPattern - pattern = complexPattern <|> simplePattern + <<|> BasicValuePattern <$> basicValue + <<|> IdentPattern <$> symbolIdent + <<|> liftM2 ConstructorPattern constructorIdent (pure []) + simpleOrParenthesizedPattern = simplePattern <<|> parenthesized complexPattern + pattern = complexPattern <<|> simplePattern simpleExpression :: Parser Token Expression simpleExpression = BasicValue <$> basicValue - <|> Symbol <$> symbolIdent - <|> Constructor <$> constructorIdent + <<|> Symbol <$> symbolIdent + <<|> Constructor <$> constructorIdent simpleOrParenthesizedExpression :: Parser Token Expression -simpleOrParenthesizedExpression = simpleExpression <|> parenthesized expression +simpleOrParenthesizedExpression = simpleExpression <<|> parenthesized expression expression :: Parser Token Expression -expression = complexExpression <|> simpleExpression +expression = complexExpression <<|> simpleExpression basicValue :: Parser Token BasicValue basicValue = (\(TInt i) -> BVInt i) <$> pSatisfy (\t -> t=:(TInt _)) - <|> (\(TChar c) -> BVChar c) <$> pSatisfy (\t -> t=:(TChar _)) + <<|> (\(TChar c) -> BVChar c) <$> pSatisfy (\t -> t=:(TChar _)) typeIdent :: Parser Token TypeIdent typeIdent = fromIdent <$> pSatisfy isUpperCaseIdent @@ -108,7 +113,7 @@ typeVarIdent = fromIdent <$> pSatisfy isLowerCaseIdent symbolIdent :: Parser Token SymbolIdent symbolIdent = fromIdent <$> pSatisfy isLowerCaseIdent - <|> fromIdent <$> pSatisfy isFunnyIdent + <<|> fromIdent <$> pSatisfy isFunnyIdent fromIdent (TIdent id) :== id @@ -128,7 +133,7 @@ parenthesized :: !(Parser Token a) -> Parser Token a parenthesized p = pToken TParenOpen *> p <* pToken TParenClose list :: !(Parser Token a) !(Parser Token a) -> Parser Token [a] -list simpleElem elem = simpleList (simpleElem <|> parenthesized elem) +list simpleElem elem = simpleList (simpleElem <<|> parenthesized elem) simpleList :: !(Parser Token a) -> Parser Token [a] simpleList simpleElem = parenthesized (many simpleElem) |