From: Mart Lubbers Date: Fri, 1 Mar 2019 08:40:22 +0000 (+0100) Subject: infix operators X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=475f52ac2129d11252ed627cea84fd7e815e2286;p=minfp.git infix operators --- diff --git a/parse.icl b/parse.icl index c99f600..1a99e90 100644 --- a/parse.icl +++ b/parse.icl @@ -9,6 +9,7 @@ import Data.GenEq import Data.Functor import Data.Func import Data.List +import Data.Tuple import StdEnv import ast @@ -47,15 +48,20 @@ where :: Parser a :== StateT ParseState (Either [String]) a :: ParseState = { tokens :: [Token] - , infixs :: [(Bool, [Char], Int)] + , ifxs :: [((Parser Expression) -> Parser Expression, Int)] } -instance zero ParseState where zero = {tokens=[],infixs=[]} +instance zero ParseState where zero = {tokens=[],ifxs=[]} pTop :: Parser Token pTop = getState >>= \s->case s.tokens of [t:ts] = put {s & tokens=ts} >>| pure t [] = liftT (Left ["Fully consumed input"]) +pEof :: Parser () +pEof = getState >>= \s->case s.tokens of + [] = pure () + [t:ts] = liftT (Left ["Expected EOF"]) + pSatisfy :: (Token -> Bool) -> Parser Token pSatisfy f = pTop >>= \t->if (f t) (pure t) empty @@ -69,37 +75,38 @@ pChainr :: (Parser (a a -> a)) (Parser a) -> Parser a pChainr op p = flip ($) <$> p <*> (flip <$> op <*> pChainr op p) <|> p parse :: [Token] -> Either [String] AST -parse ts = case runStateT pAST {zero & tokens=ts} of - Right (a, {tokens=[]}) = Right a - Right (a, _) = Left ["No complete parse result"] +parse ts = case runStateT (AST<$> pAST <* pEof) {zero & tokens=ts} of + Right (a, _) = Right a Left e = Left e where - pAST :: Parser AST - pAST = AST <$> many pFunction + pAST :: Parser [Function] + pAST = many pFunction >>= mapM \(id, args, body)->Function id args <$ + modify (\t->{t&tokens=body}) <*> pExpression <* pEof pId = (\(TTIdent i)->i) <$> pSatisfy (\t->t=:(TTIdent _)) - pOp t` = pId >>= \t->if (t == t`) (pure t) empty + pCId a = pId >>= \b->if (a == b) (pure a) empty - pFunction :: Parser Function + pFunction :: Parser ([Char], [[Char]], [Token]) pFunction - = Function - <$> pId + = tuple3 + <$> (pFunId <|> pId) <*> many pId <* pToken TTEq - <*> pExpression + <*> many (pSatisfy ((=!=)TTSemiColon)) <* pToken TTSemiColon + + pFunId :: Parser [Char] + pFunId = pId + >>= \i->pChainr <$ pCId ['ifxr'] <|> pChainl <$ pCId ['ifxl'] + >>= \p->(\(TTInt i)->i) <$> pSatisfy (\t->t=:(TTInt _)) + >>= \s->modify (\t->{t & ifxs=[(p (App o App (Var i) <$ pCId i), s):t.ifxs]}) + >>| pure i pExpression :: Parser Expression - pExpression = getState >>= \{infixs}->foldr ($) pBasic - [ pChainl (pure App) - : [ if ifxr pChainr pChainl $ App o App (Var op) <$ pOp op - \\(ifxr, op, _)<-infixs]] - - pBasic :: Parser Expression - pBasic - = Lambda <$ pToken TTLambda <*> pId <* pToken TTDot <*> pExpression + pExpression = getState >>= \{ifxs}->flip (foldr ($)) + [pChainl (pure App):map fst $ sortBy (on (<) snd) ifxs] + $ Lambda <$ pToken TTLambda <*> pId <* pToken TTDot <*> pExpression <|> pToken TTBrackOpen *> pExpression <* pToken TTBrackClose - <|> (\(TTInt i)->Lit (Int i)) <$> pSatisfy (\t->t=:(TTInt _)) - <|> (\(TTInt i)->Lit (Int i)) <$> pSatisfy (\t->t=:(TTInt _)) + <|> Lit o Int <$> (\(TTInt i)->i) <$> pSatisfy (\t->t=:(TTInt _)) <|> (\(TTBool i)->Lit (Bool i)) <$> pSatisfy (\t->t=:(TTBool _)) <|> Var <$> pId