aboutsummaryrefslogtreecommitdiff
path: root/src/Haskell/SimpleParser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haskell/SimpleParser.hs')
-rw-r--r--src/Haskell/SimpleParser.hs135
1 files changed, 0 insertions, 135 deletions
diff --git a/src/Haskell/SimpleParser.hs b/src/Haskell/SimpleParser.hs
deleted file mode 100644
index 841e41c..0000000
--- a/src/Haskell/SimpleParser.hs
+++ /dev/null
@@ -1,135 +0,0 @@
-module Haskell.SimpleParser where
-
-import Control.Monad
-import Data.Char
-import Haskell.AST
-import Text.Parsec
-import Text.Parsec.String
-
-
-parseAST :: String -> String -> Either ParseError AST
-parseAST fname source = parse pAST fname source
-
-pAST :: Parser AST
-pAST = do
- whitespace
- tops <- many pToplevel
- eof
- return $ AST tops
-
-pToplevel :: Parser Toplevel
-pToplevel = TopDef <$> pDef
-
-pDef :: Parser Def
-pDef = do
- n <- pVariable
- args <- many pNameV
- symbolO "="
- ex <- pExpr
- symbolO ";"
- case args of
- [] -> return $ Def n ex
- _ -> return $ Def n (Lam args ex)
-
-pExpr :: Parser Expr
-pExpr = pLam <|> pCase <|> pApp
- where
- pSimpleExpr = choice [Num <$> pNum
- ,Ref <$> pVariable
- ,parens (pExpr `sepBy` symbolO ",") >>= \case
- [ex] -> return ex
- exs -> return $ Tup exs]
-
- pLam = do
- symbolO "\\"
- args <- many1 pNameV
- body <- pExpr
- return $ Lam args body
-
- pApp = many1 pSimpleExpr >>= \case
- [] -> undefined
- [e] -> return e
- (e:es) -> return $ App e es
-
- pCase = do
- symbolW "case"
- e <- pExpr
- symbolW "of"
- arms <- braces (pCaseArm `sepBy` symbolO ";")
- return $ Case e arms
-
- pCaseArm = do
- pat <- pLargePat
- symbolO "->"
- ex <- pExpr
- return (pat, ex)
-
-pSimplePat :: Parser Pat
-pSimplePat = choice [symbolW "_" >> return PatAny
- ,PatVar <$> pNameV
- ,pNameT >>= \n -> return (PatCon n [])
- ,parens (pLargePat `sepBy` symbolO ",") >>= \case
- [pat] -> return pat
- pats -> return $ PatTup pats]
-
-pLargePat :: Parser Pat
-pLargePat = choice [PatCon <$> pNameT <*> many pSimplePat
- ,pSimplePat]
-
-pNum :: Parser Integer
-pNum = (char '-' >> (negate <$> pPositive)) <|> pPositive
- where pPositive = read <$> many1 digit
-
-pVariable :: Parser Name
-pVariable = pName <|> try (parens pOperator)
-
-pName :: Parser Name
-pName = notReserved $ liftM2 (:) (satisfy isAlpha) pNameRest
-
-pNameV :: Parser Name
-pNameV = notReserved $ liftM2 (:) (satisfy isLower) pNameRest
-
-pNameT :: Parser Name
-pNameT = notReserved $ liftM2 (:) (satisfy isUpper) pNameRest
-
-pNameRest :: Parser Name
-pNameRest = many (satisfy $ \d -> isAlphaNum d || d == '_') <* aheadW
-
-notReserved :: Parser Name -> Parser Name
-notReserved p =
- try $ p >>= \n ->
- if n `elem` reservedWords then unexpected "reserved word" else return n
-
-pOperator :: Parser String
-pOperator = many1 (oneOf ":!#$%&*+./<=>?@\\^|-~") <* aheadO
-
-parens :: Parser a -> Parser a
-parens = between (symbolBare "(") (symbolBare ")")
-
-braces :: Parser a -> Parser a
-braces = between (symbolBare "{") (symbolBare "}")
-
-symbolW :: String -> Parser ()
-symbolW s = string s >> aheadW
-
-symbolO :: String -> Parser ()
-symbolO s = string s >> aheadO
-
-symbolBare :: String -> Parser ()
-symbolBare s = string s >> whitespace
-
-aheadW :: Parser ()
-aheadW = do
- void (lookAhead (space <|> satisfy (\d -> not (isAlphaNum d) && d /= '_'))) <|> eof
- whitespace
-
-aheadO :: Parser ()
-aheadO = do
- void (lookAhead (space <|> alphaNum <|> oneOf ")};")) <|> eof
- whitespace
-
-whitespace :: Parser ()
-whitespace = void $ many space
-
-reservedWords :: [String]
-reservedWords = ["case", "of", "class", "instance", "where", "let", "in"]