87 lines
2.7 KiB
Haskell
87 lines
2.7 KiB
Haskell
module Parser where
|
|
|
|
import Monpar
|
|
import Control.Applicative ((<|>), many, some)
|
|
import Control.Monad (void)
|
|
import Data.Char (isDigit, digitToInt)
|
|
|
|
type ZorthAST = [ZorthExpr]
|
|
|
|
data ZorthExpr = ZorthASTInteger Int
|
|
| ZorthASTWord String
|
|
| ZorthASTWordDecl (String,ZorthAST)
|
|
| ZorthASTIfElse (ZorthAST,ZorthAST)
|
|
| ZorthASTWhile (ZorthAST,ZorthAST)
|
|
| ZorthASTComment String
|
|
deriving Show
|
|
|
|
word1 :: Parser String
|
|
word1 = do
|
|
x <- sat (\x -> x /= '\n' && x /= ' ')
|
|
xs <- word
|
|
return $ x:xs
|
|
|
|
nonsenseSymbol :: Parser Char
|
|
nonsenseSymbol = char ' ' <|> char '\n'
|
|
|
|
skipNonsenseSymbols :: Parser [Char]
|
|
skipNonsenseSymbols = many nonsenseSymbol
|
|
|
|
digit :: Parser Int
|
|
digit = digitToInt <$> sat isDigit
|
|
|
|
pZorthUnsignedInteger :: Parser ZorthExpr
|
|
pZorthUnsignedInteger = ZorthASTInteger . foldr (\n t -> n + t*10) 0 . reverse <$> some digit
|
|
|
|
pZorthSignedInteger :: Parser ZorthExpr
|
|
pZorthSignedInteger = do
|
|
_ <- char '-'
|
|
(ZorthASTInteger i) <- pZorthUnsignedInteger
|
|
return $ ZorthASTInteger $ negate i
|
|
|
|
pZorthInteger :: Parser ZorthExpr
|
|
pZorthInteger = skipNonsenseSymbols >> pZorthSignedInteger <|> pZorthUnsignedInteger
|
|
|
|
pZorthWord :: Parser ZorthExpr
|
|
pZorthWord = do
|
|
_ <- skipNonsenseSymbols
|
|
w <- word1
|
|
eof <|> void nonsenseSymbol
|
|
return $ ZorthASTWord w
|
|
|
|
pZorthWordDecl :: Parser ZorthExpr
|
|
pZorthWordDecl = do
|
|
ZorthASTWord ":" <- pZorthWord
|
|
ZorthASTWord name <- pZorthWord
|
|
xs <- manyTill pZorthExpr (do { ZorthASTWord ";" <- pZorthWord; return () })
|
|
return $ ZorthASTWordDecl (name,xs)
|
|
|
|
pZorthIfElse :: Parser ZorthExpr
|
|
pZorthIfElse = do
|
|
ZorthASTWord "if" <- pZorthWord
|
|
ifBranch <- manyTill pZorthExpr (do { ZorthASTWord "else" <- pZorthWord; return () })
|
|
elseBranch <- manyTill pZorthExpr (do { ZorthASTWord "fi" <- pZorthWord; return () })
|
|
return $ ZorthASTIfElse (ifBranch,elseBranch)
|
|
|
|
pZorthWhile :: Parser ZorthExpr
|
|
pZorthWhile = do
|
|
ZorthASTWord "begin" <- pZorthWord
|
|
condition <- manyTill pZorthExpr (do { ZorthASTWord "while" <- pZorthWord; return () })
|
|
body <- manyTill pZorthExpr (do { ZorthASTWord "repeat" <- pZorthWord; return () })
|
|
return $ ZorthASTWhile (condition,body)
|
|
|
|
pZorthComment :: Parser ZorthExpr
|
|
pZorthComment = do
|
|
ZorthASTWord "(" <- pZorthWord
|
|
body <- manyTill get (do { ZorthASTWord ")" <- pZorthWord; return () })
|
|
return $ ZorthASTComment body
|
|
|
|
pZorthExpr :: Parser ZorthExpr
|
|
pZorthExpr = pZorthComment <|> pZorthWhile <|> pZorthIfElse <|> pZorthWordDecl <++ pZorthInteger <++ pZorthWord
|
|
|
|
pZorth :: Parser ZorthAST
|
|
pZorth = some pZorthExpr
|
|
|
|
parseZorth :: String -> ZorthAST
|
|
parseZorth = fst . head . runParser pZorth
|