diff options
| -rw-r--r-- | SPL-compiler.cabal | 4 | ||||
| -rw-r--r-- | src/Main.hs | 11 | ||||
| -rw-r--r-- | src/SPL/Parse.hs | 99 |
3 files changed, 111 insertions, 3 deletions
diff --git a/SPL-compiler.cabal b/SPL-compiler.cabal index 8c8c586..adf84c7 100644 --- a/SPL-compiler.cabal +++ b/SPL-compiler.cabal @@ -21,6 +21,8 @@ executable SPL-compiler main-is: Main.hs other-extensions: LambdaCase build-depends: base >=4.9 && <4.10, - MissingH >=1.4 && <1.5 + MissingH >=1.4 && <1.5, + parsec >=3.1 && <3.2, + mtl >=2.2 && <2.3 hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Main.hs b/src/Main.hs index 0356fee..71734c4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -3,13 +3,20 @@ module Main where import Prelude hiding(lex) +import Text.Parsec.Error (ParseError) + import SPL.Syntax import SPL.Lex +import SPL.Parse main :: IO () main = do contents <- readFile "test/example1.spl" + putStrLn $ (show . lex') contents putStrLn $ (show . result) contents where - result :: String -> Maybe [Token] - result = lex + lex' :: String -> Maybe [Token] + lex' = lex + + result :: String -> Maybe (Either ParseError Program) + result c = parse <$> lex c diff --git a/src/SPL/Parse.hs b/src/SPL/Parse.hs new file mode 100644 index 0000000..afac84a --- /dev/null +++ b/src/SPL/Parse.hs @@ -0,0 +1,99 @@ +-- vim: et ts=2 sw=2 ai: +{-# LANGUAGE LambdaCase #-} +module SPL.Parse (parse) +where + +import Text.Parsec (sepBy) +import qualified Text.Parsec + +import Control.Applicative +import Data.Functor + +import SPL.Syntax hiding (TInt,TBool,TChar,TArrow) +import qualified SPL.Syntax +import SPL.Lex + +type Parser t = Text.Parsec.Parsec [Token] () t + +satisfy :: (Token -> Bool) -> Parser Token +satisfy p = Text.Parsec.tokenPrim + show + (const . const) + (\t -> if p t then Just t else Nothing) + +token :: Token -> Parser Token +token = satisfy . (==) + +check :: (Token -> Maybe a) -> Parser a +check f = Text.Parsec.tokenPrim + show + (const . const) + f + +parse :: [Token] -> Either Text.Parsec.ParseError Program +parse = Text.Parsec.parse spl "Not a valid program" . filter (not . isCommentToken) + +spl :: Parser Program +spl = collect <$> (many toplevel <* Text.Parsec.eof) + where + collect :: [Either Variable Function] -> Program + collect vfs = Program [f | Right f <- vfs] [v | Left v <- vfs] + +toplevel :: Parser (Either Variable Function) +toplevel = Left <$> var <|> Right <$> fun + +comment :: Parser String +comment = toString <$> satisfy isCommentToken + where + toString (TSingleComment s) = s + toString (TBlockComment s) = s + +var :: Parser Variable +var = do + t <- Just <$> plainType <|> (token TVar $> Nothing) + id <- ident + token TEquals + val <- expr + token TSemicolon + return $ Variable id t val + +fun :: Parser Function +fun = do + id <- ident + token TParenOpen + args <- ident `sepBy` token TComma + token TParenClose + ftype <- optional (token TColonColon *> funType) + token TBraceOpen + vars <- many var + stmt <- statement + token TBraceClose + return $ Function id ftype args vars stmt + +ident :: Parser Name +ident = (\(TIdent id) -> id) <$> satisfy isIdentToken + +funType :: Parser Type +funType = do + argtypes <- many plainType + token TArrow + rettype <- plainType + 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 + +expr :: Parser Expression +expr = literal -- TODO + where + literal :: Parser Expression + literal = fmap Literal $ check $ \case + TInt i -> Just (LInt i) + TBool b -> Just (LBool b) + _ -> Nothing + +statement :: Parser Statement +statement = fail "" -- TODO |