aboutsummaryrefslogtreecommitdiff
path: root/Sil/Parse.icl
diff options
context:
space:
mode:
Diffstat (limited to 'Sil/Parse.icl')
-rw-r--r--Sil/Parse.icl34
1 files changed, 19 insertions, 15 deletions
diff --git a/Sil/Parse.icl b/Sil/Parse.icl
index 0f816fe..0d2b913 100644
--- a/Sil/Parse.icl
+++ b/Sil/Parse.icl
@@ -237,33 +237,37 @@ where
op token operator = item token $> operator
rightAssoc :: (Parser Token Op2) (Parser Token Expression) -> Parser Token Expression
- rightAssoc opp appp = appp >>= \e1 -> optional (opp >>= \op -> rightAssoc opp appp >>= \e -> pure (op,e))
- >>= pure o maybe e1 (\(op,e2) -> BuiltinApp2 e1 op e2)
+ rightAssoc opp appp = appp >>= \e1 ->
+ optional (opp >>= \op -> getPosition >>= \pos -> rightAssoc opp appp >>= \e -> pure (pos,op,e)) >>=
+ pure o maybe e1 (\(pos,op,e2) -> BuiltinApp2 pos e1 op e2)
leftAssoc :: (Parser Token Op2) (Parser Token Expression) -> Parser Token Expression
- leftAssoc opp appp = appp >>= \e1 -> many (opp >>= \op -> appp >>= \e -> pure (op,e))
- >>= foldM (\e (op,e2) -> pure $ BuiltinApp2 e op e2) e1
+ leftAssoc opp appp = appp >>= \e1 ->
+ many (opp >>= \op -> getPosition >>= \pos -> appp >>= \e -> pure (pos,op,e)) >>=
+ foldM (\e (pos,op,e2) -> pure $ BuiltinApp2 pos e op e2) e1
noInfix :: Parser Token Expression
noInfix
- = liftM2 App name (item TParenOpen *> seplistUntil TParenClose TComma expression)
+ = liftM3 App getPosition name (item TParenOpen *> seplistUntil TParenClose TComma expression)
<|> op TTilde Neg
<|> op TExclamation Not
- <|> (simpleExpr >>= \e -> foldl (flip Field) e <$> many field)
+ <|> (simpleExpr >>= \e -> foldl (flip $ uncurry Field) e <$> many field)
where
op :: Token Op1 -> Parser Token Expression
- op token operator = liftM (BuiltinApp operator) (item token *> noInfix)
+ op token operator = liftM3 BuiltinApp getPosition (pure operator) (item token *> noInfix)
- field :: Parser Token Name
- field = satisfy (\t -> t =: TField _) >>= \(TField f) -> pure f
+ field :: Parser Token (ParsePosition, Name)
+ field = satisfy (\t -> t =: TField _) >>= \(TField f) -> getPosition >>= \p -> pure (p,f)
simpleExpr :: Parser Token Expression
- simpleExpr = liftM Literal literal
- <|> liftM Name name
- <|> flip List [] o pure <$> bracked type
- <|> List Nothing <$> bracked (seplist TComma expression)
- <|> (item TParenOpen *> seplistUntil TParenClose TComma expression >>= \es ->
- pure $ case es of [x] -> x; _ -> Tuple (length es) es)
+ simpleExpr
+ = liftM2 Literal getPosition literal
+ <|> liftM2 Name getPosition name
+ <|> liftM3 List getPosition (pure <$> bracked type) (pure [])
+ <|> liftM3 List getPosition (pure Nothing) (bracked $ seplist TComma expression)
+ <|> (item TParenOpen *> getPosition >>= \pos ->
+ seplistUntil TParenClose TComma expression >>= \es ->
+ pure $ case es of [x] -> x; _ -> Tuple pos (length es) es)
name :: Parser Token Name
name = (\(TName n) -> n) <$> satisfy isName <#> "name"