module Text.Earley.Mixfix where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Data.Either
import Data.Foldable(asum, foldrM)
import Text.Earley
data Associativity
= LeftAssoc
| NonAssoc
| RightAssoc
deriving (Eq, Show)
type Holey a = [Maybe a]
mixfixExpression
:: [[(Holey (Prod r e t ident), Associativity)]]
-> Prod r e t expr
-> (Holey ident -> [expr] -> expr)
-> Grammar r e (Prod r e t expr)
mixfixExpression table atom app = mdo
expr <- foldrM ($) atom $ map (level expr) table
return expr
where
app' xs = app (either (const Nothing) Just <$> xs) $ lefts xs
level expr idents next = mdo
same <- rule $ asum $ next : map (mixfixIdent same) idents
return same
where
cons p q = (:) <$> p <*> q
mixfixIdent same (ps, a) = app' <$> go ps
where
go ps' = case ps' of
[] -> pure []
[Just p] -> pure . Right <$> p
Nothing:rest -> cons (Left <$> if a == RightAssoc then next
else same)
$ go rest
[Just p, Nothing] -> cons (Right <$> p)
$ pure . Left <$> if a == LeftAssoc then next else same
Just p:Nothing:rest -> cons (Right <$> p)
$ cons (Left <$> expr)
$ go rest
Just p:rest@(Just _:_) -> cons (Right <$> p) $ go rest