2013-02-27 07:33:47 +00:00
|
|
|
module Parse.Parser (parseProgram, preParse) where
|
2012-04-19 06:32:10 +00:00
|
|
|
|
|
|
|
import Ast
|
2012-06-10 04:21:16 +00:00
|
|
|
import Control.Applicative ((<$>), (<*>))
|
|
|
|
import Control.Monad
|
|
|
|
import Data.Char (isSymbol, isDigit)
|
2013-02-27 07:33:47 +00:00
|
|
|
import Data.List (foldl',intercalate)
|
2012-06-10 04:21:16 +00:00
|
|
|
import Text.Parsec hiding (newline,spaces)
|
|
|
|
|
2012-11-23 04:15:59 +00:00
|
|
|
import Parse.Library
|
|
|
|
import Parse.Expr
|
2012-11-23 04:24:20 +00:00
|
|
|
import Parse.Types
|
2012-11-23 04:15:59 +00:00
|
|
|
import Parse.Modules
|
|
|
|
import Parse.Foreign
|
2012-06-10 04:21:16 +00:00
|
|
|
|
2012-04-19 06:32:10 +00:00
|
|
|
|
2013-03-12 07:48:11 +00:00
|
|
|
statement = choice (typeAlias:defs) <|> def <?> "datatype or variable definition"
|
|
|
|
where defs = map ((:[]) <$>) [ foreignDef, datatype, typeAnnotation ]
|
2012-08-01 23:37:37 +00:00
|
|
|
|
2012-06-12 06:28:45 +00:00
|
|
|
freshDef = commitIf (freshLine >> (letter <|> char '_')) $ do
|
|
|
|
freshLine
|
2012-08-01 23:37:37 +00:00
|
|
|
statement <?> "another datatype or variable definition"
|
2012-04-19 06:32:10 +00:00
|
|
|
|
2012-08-01 23:37:37 +00:00
|
|
|
defs1 = do d <- statement <?> "at least one datatype or variable definition"
|
|
|
|
concat <$> (d:) <$> many freshDef
|
2012-06-10 04:21:16 +00:00
|
|
|
|
2012-06-11 13:11:15 +00:00
|
|
|
program = do
|
|
|
|
optional freshLine
|
2012-06-28 08:52:47 +00:00
|
|
|
(names,exports) <- option (["Main"],[]) (moduleDef `followedBy` freshLine)
|
2012-06-12 06:28:45 +00:00
|
|
|
is <- (do try (lookAhead $ reserved "import")
|
|
|
|
imports `followedBy` freshLine) <|> return []
|
2012-08-01 23:37:37 +00:00
|
|
|
statements <- defs1
|
2012-06-10 04:21:16 +00:00
|
|
|
optional freshLine ; optional spaces ; eof
|
2012-08-01 23:37:37 +00:00
|
|
|
return $ Module names exports is statements
|
2012-04-19 06:32:10 +00:00
|
|
|
|
2013-02-27 07:33:47 +00:00
|
|
|
parseProgram = setupParser program
|
|
|
|
|
|
|
|
preParse :: String -> Either String (String, [String])
|
|
|
|
preParse = setupParser $ do
|
|
|
|
optional skip
|
|
|
|
(,) <$> option "Main" moduleName <*> option [] imprts
|
|
|
|
where
|
|
|
|
skip = try (manyTill anyChar (try (string "/**")))
|
|
|
|
imprts = fmap (map fst) imports `followedBy` freshLine
|
|
|
|
getName = intercalate "." . fst
|
|
|
|
moduleName = do optional freshLine
|
|
|
|
getName <$> moduleDef `followedBy` freshLine
|
|
|
|
|
|
|
|
setupParser p source =
|
|
|
|
case iParse p "" source of
|
2012-06-11 13:11:15 +00:00
|
|
|
Right result -> Right result
|
|
|
|
Left err -> Left $ "Parse error at " ++ show err
|