Add support for more operators
This commit is contained in:
parent
2468bf6826
commit
072b2e8d51
|
@ -28,20 +28,21 @@ nixExpr :: Bool -> Parser NExpr
|
||||||
nixExpr = buildExpressionParser table . nixTerm
|
nixExpr = buildExpressionParser table . nixTerm
|
||||||
where
|
where
|
||||||
table =
|
table =
|
||||||
[ [ prefix "-" NNeg ]
|
[ [ binary "." NAttr AssocNone ]
|
||||||
, [ prefix "~" NNeg ]
|
, [ prefix "-" NNeg ]
|
||||||
, [ prefix "?" NNeg ]
|
-- , [ prefix "~" NSubpath ] -- deprecated
|
||||||
, [ binary "++" NConcat AssocRight ]
|
, [ binary "?" NHasAttr AssocNone ]
|
||||||
, [ binary "*" NMult AssocLeft, binary "/" NDiv AssocLeft ]
|
, [ binary "++" NConcat AssocRight ]
|
||||||
, [ binary "+" NPlus AssocLeft, binary "-" NMinus AssocLeft ]
|
, [ binary "*" NMult AssocLeft, binary "/" NDiv AssocLeft ]
|
||||||
|
, [ binary "+" NPlus AssocLeft, binary "-" NMinus AssocLeft ]
|
||||||
, [ prefix "!" NNot ]
|
, [ prefix "!" NNot ]
|
||||||
, [ binary "//" NUpdate AssocRight ]
|
, [ binary "//" NUpdate AssocRight ]
|
||||||
, [ binary "<" NLt AssocLeft, binary ">" NGt AssocLeft
|
, [ binary "<" NLt AssocLeft, binary ">" NGt AssocLeft
|
||||||
, binary "<=" NLte AssocLeft, binary ">=" NGte AssocLeft ]
|
, binary "<=" NLte AssocLeft, binary ">=" NGte AssocLeft ]
|
||||||
, [ binary "==" NEq AssocNone, binary "!=" NNEq AssocNone ]
|
, [ binary "==" NEq AssocNone, binary "!=" NNEq AssocNone ]
|
||||||
, [ binary "&&" NAnd AssocLeft ]
|
, [ binary "&&" NAnd AssocLeft ]
|
||||||
, [ binary "||" NOr AssocLeft ]
|
, [ binary "||" NOr AssocLeft ]
|
||||||
, [ binary "->" NImpl AssocNone ]
|
, [ binary "->" NImpl AssocNone ]
|
||||||
]
|
]
|
||||||
|
|
||||||
binary name fun = Infix ((\x y -> Fix (NOper (fun x y))) <$ symbol name)
|
binary name fun = Infix ((\x y -> Fix (NOper (fun x y))) <$ symbol name)
|
||||||
|
|
|
@ -23,7 +23,7 @@ lexer = P.makeTokenParser P.LanguageDef
|
||||||
, P.commentLine = "#"
|
, P.commentLine = "#"
|
||||||
, P.nestedComments = True
|
, P.nestedComments = True
|
||||||
, P.identStart = letter <|> char '_'
|
, P.identStart = letter <|> char '_'
|
||||||
, P.identLetter = alphaNum <|> oneOf "_."
|
, P.identLetter = alphaNum <|> oneOf "_"
|
||||||
, P.opStart = oneOf ":!#$%&*+./<=>?@\\^|-~"
|
, P.opStart = oneOf ":!#$%&*+./<=>?@\\^|-~"
|
||||||
, P.opLetter = oneOf "@"
|
, P.opLetter = oneOf "@"
|
||||||
, P.reservedNames =
|
, P.reservedNames =
|
||||||
|
@ -91,44 +91,52 @@ reserved = fmap pack . symbol
|
||||||
-----------------------------------------------------------
|
-----------------------------------------------------------
|
||||||
-- White space & symbols
|
-- White space & symbols
|
||||||
-----------------------------------------------------------
|
-----------------------------------------------------------
|
||||||
|
symbol :: (CharParsing m, Monad m) => String -> m String
|
||||||
symbol name = lexeme (string name)
|
symbol name = lexeme (string name)
|
||||||
|
|
||||||
lexeme p
|
lexeme :: (CharParsing m, Monad m) => m b -> m b
|
||||||
= do{ x <- p; whiteSpace; return x }
|
lexeme p = do{ x <- p; whiteSpace; return x }
|
||||||
|
|
||||||
|
whiteSpace :: (CharParsing m, Monad m) => m ()
|
||||||
whiteSpace =
|
whiteSpace =
|
||||||
skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <?> "")
|
skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <?> "")
|
||||||
|
|
||||||
|
simpleSpace :: CharParsing m => m ()
|
||||||
simpleSpace = skipSome (satisfy isSpace)
|
simpleSpace = skipSome (satisfy isSpace)
|
||||||
|
|
||||||
|
oneLineComment :: (CharParsing m, Monad m) => m ()
|
||||||
oneLineComment =
|
oneLineComment =
|
||||||
do{ try (string "#")
|
do{ _ <- try (string "#")
|
||||||
; skipMany (satisfy (/= '\n'))
|
; skipMany (satisfy (/= '\n'))
|
||||||
; return ()
|
; return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
|
multiLineComment :: (CharParsing m, Monad m) => m ()
|
||||||
multiLineComment =
|
multiLineComment =
|
||||||
do { try (string "/*")
|
do { _ <- try (string "/*")
|
||||||
; inComment
|
; inComment
|
||||||
}
|
}
|
||||||
|
|
||||||
|
inComment :: (CharParsing m, Monad m) => m ()
|
||||||
inComment
|
inComment
|
||||||
| True = inCommentMulti
|
| True = inCommentMulti
|
||||||
| otherwise = inCommentSingle
|
| otherwise = inCommentSingle
|
||||||
|
|
||||||
|
inCommentMulti :: (CharParsing m, Monad m) => m ()
|
||||||
inCommentMulti
|
inCommentMulti
|
||||||
= do{ try (string "*/") ; return () }
|
= do{ _ <- try (string "*/") ; return () }
|
||||||
<|> do{ multiLineComment ; inCommentMulti }
|
<|> do{ multiLineComment ; inCommentMulti }
|
||||||
<|> do{ skipSome (noneOf startEnd) ; inCommentMulti }
|
<|> do{ skipSome (noneOf startEnd) ; inCommentMulti }
|
||||||
<|> do{ oneOf startEnd ; inCommentMulti }
|
<|> do{ _ <- oneOf startEnd ; inCommentMulti }
|
||||||
<?> "end of comment"
|
<?> "end of comment"
|
||||||
where
|
where
|
||||||
startEnd = nub ("*/" ++ "/*")
|
startEnd = nub ("*/" ++ "/*")
|
||||||
|
|
||||||
|
inCommentSingle :: (CharParsing m, Monad m) => m ()
|
||||||
inCommentSingle
|
inCommentSingle
|
||||||
= do{ try (string "*/"); return () }
|
= do{ _ <- try (string "*/"); return () }
|
||||||
<|> do{ skipSome (noneOf startEnd) ; inCommentSingle }
|
<|> do{ skipSome (noneOf startEnd) ; inCommentSingle }
|
||||||
<|> do{ oneOf startEnd ; inCommentSingle }
|
<|> do{ _ <- oneOf startEnd ; inCommentSingle }
|
||||||
<?> "end of comment"
|
<?> "end of comment"
|
||||||
where
|
where
|
||||||
startEnd = nub ("*/" ++ "/*")
|
startEnd = nub ("*/" ++ "/*")
|
||||||
|
|
|
@ -59,6 +59,7 @@ data NOperF r
|
||||||
| NImpl r r
|
| NImpl r r
|
||||||
| NUpdate r r
|
| NUpdate r r
|
||||||
| NHasAttr r r
|
| NHasAttr r r
|
||||||
|
| NAttr r r
|
||||||
|
|
||||||
| NPlus r r
|
| NPlus r r
|
||||||
| NMinus r r
|
| NMinus r r
|
||||||
|
@ -82,6 +83,7 @@ instance Show f => Show (NOperF f) where
|
||||||
show (NImpl r1 r2) = show r1 ++ " -> " ++ show r2
|
show (NImpl r1 r2) = show r1 ++ " -> " ++ show r2
|
||||||
show (NUpdate r1 r2) = show r1 ++ " // " ++ show r2
|
show (NUpdate r1 r2) = show r1 ++ " // " ++ show r2
|
||||||
show (NHasAttr r1 r2) = show r1 ++ " ? " ++ show r2
|
show (NHasAttr r1 r2) = show r1 ++ " ? " ++ show r2
|
||||||
|
show (NAttr r1 r2) = show r1 ++ "." ++ show r2
|
||||||
|
|
||||||
show (NPlus r1 r2) = show r1 ++ " + " ++ show r2
|
show (NPlus r1 r2) = show r1 ++ " + " ++ show r2
|
||||||
show (NMinus r1 r2) = show r1 ++ " - " ++ show r2
|
show (NMinus r1 r2) = show r1 ++ " - " ++ show r2
|
||||||
|
|
Loading…
Reference in New Issue