aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Language/SimpleShell/Parser.hs6
-rw-r--r--src/Language/SimpleShell/Parser/Expr.hs35
2 files changed, 40 insertions, 1 deletions
diff --git a/src/Language/SimpleShell/Parser.hs b/src/Language/SimpleShell/Parser.hs
index d75602b..be16c9f 100644
--- a/src/Language/SimpleShell/Parser.hs
+++ b/src/Language/SimpleShell/Parser.hs
@@ -4,6 +4,7 @@ module Language.SimpleShell.Parser
( Parser
, lexeme
, symbol
+ , commentFirstChars
, lookupVar
, lookupFun
, declareVars
@@ -50,12 +51,17 @@ initContext = Context
}
+-- Must be kept in sync with 'commentFirstChars'.
sc :: Parser ()
sc = L.space
space1
(L.skipLineComment "//")
(L.skipBlockComment "/*" "*/")
+-- | List of all characters that may start a comment.
+commentFirstChars :: [Char]
+commentFirstChars = "/"
+
lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc
diff --git a/src/Language/SimpleShell/Parser/Expr.hs b/src/Language/SimpleShell/Parser/Expr.hs
index 1c782bc..cabf522 100644
--- a/src/Language/SimpleShell/Parser/Expr.hs
+++ b/src/Language/SimpleShell/Parser/Expr.hs
@@ -4,6 +4,7 @@
module Language.SimpleShell.Parser.Expr
( exprP
, strongTermP
+ , strongTermP_ -- TODO: Unused.
)
where
@@ -14,6 +15,7 @@ import Language.SimpleShell.Parser
( Parser
, lexeme
, symbol
+ , commentFirstChars
, lookupVar
, lookupFun
)
@@ -26,9 +28,11 @@ import Control.Monad.Combinators.FailExpr
)
import Control.Applicative ((<|>))
+import Control.Monad (void)
import Control.Monad.Combinators (manyTill)
import Data.Foldable (asum)
import Data.Text (Text)
+import Text.Megaparsec (takeWhile1P, oneOf, many)
import Text.Megaparsec.Char (char)
import qualified Text.Megaparsec.Char.Lexer as L (charLiteral, decimal)
@@ -50,6 +54,30 @@ strongTermP
<|> varP
<|> symbol "(" *> exprP <* symbol ")"
+-- | Parse a strong term--assuming its correctness--without yielding a result.
+-- This basically only checks for matching parentheses.
+strongTermP_ :: Parser ()
+strongTermP_
+ = void literalP
+ <|> varP_
+ <|> symbol "(" *> void (many tok) <* symbol ")"
+ where
+ -- Notes:
+ -- * We need to make sure to correctly handle:
+ -- * parentheses
+ -- * string literals
+ -- * comments
+
+ tok :: Parser ()
+ tok
+ = void strLitP
+ <|> symbol "(" *> void (many tok) <* symbol ")"
+ <|> void (lexeme $ takeWhile1P Nothing isBoring)
+ <|> void (lexeme $ oneOf commentFirstChars)
+ where
+ isBoring :: Char -> Bool
+ isBoring = not . (`elem` "()\"" ++ commentFirstChars)
+
-- | Parse "strong" term with fixed type.
strongTermP' :: String -> SimpleType -> Parser Expr
@@ -62,11 +90,13 @@ literalP
<|> (StrType,) . StrLiteral <$> strLitP
<|> (BoolType,) . BoolLiteral <$> boolLitP
where
- strLitP = lexeme $ char '"' *> manyTill L.charLiteral (char '"')
boolLitP
= True <$ keyword "true"
<|> False <$ keyword "false"
+strLitP :: Parser String
+strLitP = lexeme $ char '"' *> manyTill L.charLiteral (char '"')
+
varP :: Parser TypedExpr
varP = do
_ <- char '$'
@@ -74,6 +104,9 @@ varP = do
t <- lookupVar x
return (t, Var x)
+varP_ :: Parser ()
+varP_ = void (char '$') <* nameP
+
funP :: Parser TypedExpr
funP = do
fname <- nameP