diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/SPL/Parse.hs | 165 | ||||
| -rw-r--r-- | src/SPL/Syntax.hs | 7 |
2 files changed, 124 insertions, 48 deletions
diff --git a/src/SPL/Parse.hs b/src/SPL/Parse.hs index 4331ccb..28230f8 100644 --- a/src/SPL/Parse.hs +++ b/src/SPL/Parse.hs @@ -10,29 +10,26 @@ import Data.Functor import Text.Parsec (sepBy, (<?>)) import qualified Text.Parsec as P -import SPL.Syntax hiding (TInt,TBool,TChar,TArrow) +import SPL.Syntax hiding (TInt,TBool,TChar,TArrow,TVar) import qualified SPL.Syntax import SPL.Lex type Parser t = P.Parsec [Token] () t -satisfy :: (Token -> Bool) -> Parser Token -satisfy p = P.tokenPrim - show - (const . const) - (\t -> if p t then Just t else Nothing) +parse :: [Token] -> Either P.ParseError Program +parse = P.parse spl "Not a valid program" . filter (not . isCommentToken) + +check :: (Token -> Maybe a) -> Parser a +check f = P.tokenPrim show (const . const) f token :: Token -> Parser Token -token t = satisfy (== t) <?> show t +token t = check (\u -> if t == u then Just t else Nothing) -check :: (Token -> Maybe a) -> Parser a -check f = P.tokenPrim - show - (const . const) - f +choice :: [Parser a] -> Parser a +choice = P.choice . map P.try -parse :: [Token] -> Either P.ParseError Program -parse = P.parse spl "Not a valid program" . filter (not . isCommentToken) +trans :: Token -> a -> Parser a +trans t x = token t $> x spl :: Parser Program spl = collect <$> (many toplevel <* P.eof) @@ -41,19 +38,25 @@ spl = collect <$> (many toplevel <* P.eof) collect vfs = Program [f | Right f <- vfs] [v | Left v <- vfs] toplevel :: Parser (Either Variable Function) -toplevel = Left <$> var <|> Right <$> fun +toplevel = choice + [ Left <$> var + , Right <$> fun + ] comment :: Parser String -comment = toString <$> satisfy isCommentToken - where - toString (TSingleComment s) = s - toString (TBlockComment s) = s +comment = check $ \case + TSingleComment s -> Just s + TBlockComment s -> Just s + _ -> Nothing parenthesised :: Parser a -> Parser a -parenthesised p = token TParenOpen *> p <* token TParenClose +parenthesised = P.between (token TParenOpen) (token TParenClose) braced :: Parser a -> Parser a -braced p = token TBraceOpen *> p <* token TBraceClose +braced = P.between (token TBraceOpen) (token TBraceClose) + +bracked :: Parser a -> Parser a +bracked = P.between (token TBrackOpen) (token TBrackClose) var :: Parser Variable var = do @@ -67,16 +70,18 @@ var = do fun :: Parser Function fun = do id <- ident - args <- parenthesised $ ident `sepBy` token TComma - ftype <- optional (token TColonColon *> funType) + args <- parenthesised (ident `sepBy` token TComma) <?> "arguments" + ftype <- optional (token TColonColon *> funType) <?> "optional function type" token TBraceOpen - vars <- many var - stmt <- statements + vars <- many (P.try var) <?> "local variables" + stmt <- statements <?> "function body" token TBraceClose return $ Function id ftype args vars stmt ident :: Parser Name -ident = (\(TIdent id) -> id) <$> satisfy isIdentToken +ident = check $ \case + TIdent id -> Just id + _ -> Nothing funType :: Parser Type funType = do @@ -86,34 +91,102 @@ funType = do return $ SPL.Syntax.TArrow argtypes rettype plainType :: Parser Type -plainType = -- TODO - token TIntType $> SPL.Syntax.TInt <|> - token TBoolType $> SPL.Syntax.TBool <|> - token TCharType $> SPL.Syntax.TChar +plainType = choice + [ trans TIntType SPL.Syntax.TInt + , trans TBoolType SPL.Syntax.TBool + , trans TCharType SPL.Syntax.TChar + , trans TVoidType SPL.Syntax.TVoid + , TList <$> bracked plainType + , parenthesised $ liftM2 TTuple plainType (token TComma *> plainType) + , SPL.Syntax.TVar <$> ident + ] expr :: Parser Expression -expr = literal -- TODO +expr = + rightAssoc (trans TPipePipe Or) $ + rightAssoc (trans TAmpAmp And) $ + rightAssoc (trans TEqEq Eq + <|> trans TExclamEq Ne + <|> trans TLtEq Le + <|> trans TGtEq Ge + <|> trans TLt Lt + <|> trans TGt Gt) $ + rightAssoc (trans TColon Cons) $ + leftAssoc (trans TPlus Add + <|> trans TMinus Sub) $ + leftAssoc (trans TAsterisk Mul + <|> trans TSlash Div) $ + leftAssoc (trans TPercent Mod) $ + fields $ + simpleExpr where + rightAssoc :: Parser Op2 -> Parser Expression -> Parser Expression + rightAssoc op e = do + e1 <- e + rest <- optional (liftM2 (,) op (rightAssoc op e)) + return $ case rest of + Nothing -> e1 + Just (op,e2) -> Op2 e1 op e2 + + leftAssoc :: Parser Op2 -> Parser Expression -> Parser Expression + leftAssoc op e = do + e1 <- e + rest <- many (liftM2 (,) op e) + foldM (\e1 (op,e2) -> pure $ Op2 e1 op e2) e1 rest + + fields :: Parser Expression -> Parser Expression + fields p = liftM2 (foldl Field) p (many field) + + simpleExpr = choice + [ liftM2 Op1 (trans TExclam Not <|> trans TMinus Neg) simpleExpr + , literal + , tuple + , funcall + , var + , parenthesised expr + ] + literal :: Parser Expression - literal = fmap Literal $ check $ \case + literal = fmap Literal $ nil <|> (check $ \case TInt i -> Just (LInt i) TBool b -> Just (LBool b) - _ -> Nothing + TChar c -> Just (LChar c) + _ -> Nothing) + where nil = pure LNil <* token TBrackOpen <* token TBrackClose + + tuple = parenthesised (liftM2 Tuple expr (token TComma *> expr)) + + funcall = liftM2 FunCall ident (parenthesised $ expr `sepBy` token TComma) + + var = Var <$> ident statements :: Parser Statement statements = foldr1 Seq <$> some statement <|> pure Nop +-- NOTE: we here assume that if/while blocks need not be braced, as in the +-- example function `abs`. The alternative is using `braced statements`. statement :: Parser Statement -statement = - liftM3 If - (token TIf *> parenthesised expr) - (braced statements) - (optional (token TElse *> braced statements)) <|> - liftM2 While - (token TWhile *> parenthesised expr) - (braced statements) <|> - liftM2 Assign - ident - (token TEquals *> expr <* token TSemicolon) <|> - Eval <$> (expr <* token TSemicolon) <|> - Return <$> (token TReturn *> optional expr <* token TSemicolon) +statement = choice + [ liftM3 If + (token TIf *> parenthesised expr) + statement + (optional (token TElse *> statement)) + , liftM2 While + (token TWhile *> parenthesised expr) + statement + , Eval <$> (expr <* token TSemicolon) + , liftM3 Assign + ident + (many field) + (token TEquals *> expr <* token TSemicolon) + , Return <$> (token TReturn *> optional expr <* token TSemicolon) + , braced statements + ] + +field :: Parser Field +field = token TDot *> check (\case + TIdent "hd" -> Just Hd + TIdent "tl" -> Just Tl + TIdent "fst" -> Just Fst + TIdent "snd" -> Just Snd + _ -> Nothing) diff --git a/src/SPL/Syntax.hs b/src/SPL/Syntax.hs index e40d47c..f52b866 100644 --- a/src/SPL/Syntax.hs +++ b/src/SPL/Syntax.hs @@ -30,15 +30,17 @@ data Type = TInt | TBool | TChar + | TVoid | TList Type | TTuple Type Type | TArrow [Type] Type + | TVar Name deriving (Show) data Statement = If Expression Statement (Maybe Statement) | While Expression Statement - | Assign Name Expression + | Assign Name [Field] Expression | Eval Expression | Return (Maybe Expression) | Seq Statement Statement @@ -46,7 +48,8 @@ data Statement deriving (Show) data Expression - = Field Name Field + = Var Name + | Field Expression Field | Op2 Expression Op2 Expression | Op1 Op1 Expression | Literal Literal |