-parseExpr =
- (satTok BraceOpenToken *> parseExpr <* satTok BraceCloseToken) <|>
- (satTok BraceOpenToken *> parseExpr <* satTok CommaToken
- >>= \e1->parseExpr <* satTok BraceCloseToken
- >>= \e2->pure $ TupleExpr e1 e2) <|>
- trans1 EmptyListToken EmptyListExpr <|>
- trans2 TrueToken (const $ BoolExpr True) <|>
- trans2 FalseToken (const $ BoolExpr True) <|>
- trans2 (NumberToken zero) (\(NumberToken i)->IntExpr i) <|>
- trans2 (CharToken zero) (\(CharToken c)->CharExpr c) <|>
- (parseOp1 >>= \o->parseExpr >>= \e.pure $ Op1Expr o e) <|>
- (parseIdent <* satTok BraceOpenToken
- >>= \i->parseActArgs <* satTok BraceCloseToken
- >>= \es->pure $ FunExpr i es) <|>
- (parseIdent >>= \i. parseFieldSelector >>= \f.pure $ VarExpr i f)
- //TODO Parse Binary operators
-
-parseActArgs :: Parser Token [Expr]
-parseActArgs =
- //One argument
- (some (parseExpr <* satTok CommaToken) >>= \es->parseExpr >>= \e.pure [e:es]) <|>
- //Two or more arguments
- (parseExpr >>= \e->pure [e]) <|>
- //Zero arguments, dit moet nog mooier kunnen
- empty
+parseExpr = //Operators in order of binding strength
+ parseOpR (trans1 ColonToken BiCons) $
+ parseOpR (trans1 PipesToken BiOr) $
+ parseOpR (trans1 AmpersandsToken BiAnd) $
+ parseOpR (trans1 EqualsToken BiEquals <|>
+ trans1 LesserToken BiLesser <|>
+ trans1 BiggerToken BiGreater <|>
+ trans1 LesserEqToken BiLesserEq <|>
+ trans1 GreaterEqToken BiGreaterEq <|>
+ trans1 NotEqualToken BiUnEqual) $
+ parseOpL (trans1 PlusToken BiPlus <|>
+ trans1 DashToken BiMinus) $
+ parseOpL (trans1 StarToken BiTimes <|>
+ trans1 SlashToken BiDivide <|>
+ trans1 PercentToken BiMod) $ parseBasicExpr
+ where
+ parseOpR :: (Parser Token Op2) (Parser Token Expr) -> Parser Token Expr
+ parseOpR ops prev = prev >>= \e1->optional (
+ ops >>= \op->parseOpR ops prev >>= \e->pure (op, e)
+ ) >>= \moe->pure $ maybe e1 (\(op,e2)->Op2Expr e1 op e2) moe
+
+ parseOpL :: (Parser Token Op2) (Parser Token Expr) -> Parser Token Expr
+ parseOpL ops prev = prev >>= \e1->many (
+ ops >>= \op->prev >>= \e->pure (op, e)
+ ) >>= \moe->foldM (\e->(\(op,e2)->pure $ Op2Expr e op e2)) e1 moe
+
+ parseBasicExpr :: Parser Token Expr
+ parseBasicExpr =
+ (satTok BraceOpenToken *> parseExpr <* satTok CommaToken
+ >>= \e1->parseExpr <* satTok BraceCloseToken
+ >>= \e2->pure $ TupleExpr e1 e2) <|>
+ (parseFunCall >>= \fc->pure $ FunExpr fc) <|>
+ parseBBraces parseExpr <|>
+ trans1 EmptyListToken EmptyListExpr <|>
+ trans2 TrueToken (const $ BoolExpr True) <|>
+ trans2 FalseToken (const $ BoolExpr False) <|>
+ trans2 (NumberToken zero) (\(NumberToken i)->IntExpr i) <|>
+ trans2 (CharToken zero) (\(CharToken c)->CharExpr c) <|>
+ (parseOp1 >>= \o->parseExpr >>= \e.pure $ Op1Expr o e) <|>
+ (parseVarDef >>= \ve->pure $ VarExpr ve)
+
+parseFunCall :: Parser Token FunCall
+parseFunCall = parseIdent <* satTok BraceOpenToken
+ >>= \i->parseSepList CommaToken parseExpr
+ <* satTok BraceCloseToken >>= \es->pure $ FunCall i es
+
+parseVarDef :: Parser Token VarDef
+parseVarDef = parseIdent
+ >>= \i-> many (satTok DotToken *> (
+ (parseIdent >>= (\i.if (i == "hd") (pure FieldHd) empty)) <|>
+ (parseIdent >>= \i.if (i == "tl") (pure FieldTl) empty) <|>
+ (parseIdent >>= \i.if (i == "fst") (pure FieldFst) empty) <|>
+ (parseIdent >>= \i.if (i == "snd") (pure FieldSnd) empty))
+ ) >>= \f->pure $ VarDef i f