diff options
Diffstat (limited to 'src/Haskell/SimpleParser.hs')
-rw-r--r-- | src/Haskell/SimpleParser.hs | 135 |
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"] |