module Language.Egison.Parser.Pattern.Expr
( ExprL
, exprParser
, atomParser
, Table(..)
, initTable
, addInfix
, addPrefix
, module X
)
where
import Language.Egison.Syntax.Pattern.Fixity
as X
import qualified Data.IntMap as IntMap
( toDescList
, fromList
, alter
)
import Data.Bifunctor ( first )
import Control.Monad.Reader ( MonadReader(..) )
import Control.Comonad.Cofree ( Cofree(..) )
import Control.Applicative ( Alternative((<|>)) )
import Control.Applicative.Combinators
( choice
, optional
)
import Language.Egison.Syntax.Pattern.Base
( ExprF(..) )
import Language.Egison.Syntax.Pattern.Fixity
( Fixity(..)
, Precedence(..)
, Associativity(..)
)
import qualified Language.Egison.Syntax.Pattern.Fixity.Precedence
as Prec
( toInt )
import Language.Egison.Parser.Pattern.Prim
( ParseFixity(..)
, ParseMode(..)
, Source
, Parse
, extParser
, lexeme
, Locate(..)
, Location(..)
)
data Table m f a
= Table { Table m f a -> [m (a -> a -> f a)]
infixRight :: [m (a -> a -> f a)]
, Table m f a -> [m (a -> a -> f a)]
infixLeft :: [m (a -> a -> f a)]
, Table m f a -> [m (a -> a -> f a)]
infixNone :: [m (a -> a -> f a)]
, Table m f a -> [m (a -> f a)]
prefix :: [m (a -> f a)]
}
initTable :: Table m f a
initTable :: Table m f a
initTable = [m (a -> a -> f a)]
-> [m (a -> a -> f a)]
-> [m (a -> a -> f a)]
-> [m (a -> f a)]
-> Table m f a
forall (m :: * -> *) (f :: * -> *) a.
[m (a -> a -> f a)]
-> [m (a -> a -> f a)]
-> [m (a -> a -> f a)]
-> [m (a -> f a)]
-> Table m f a
Table [] [] [] []
addInfix :: Associativity -> m (a -> a -> f a) -> Table m f a -> Table m f a
addInfix :: Associativity -> m (a -> a -> f a) -> Table m f a -> Table m f a
addInfix Associativity
AssocRight m (a -> a -> f a)
op table :: Table m f a
table@Table { [m (a -> a -> f a)]
infixRight :: [m (a -> a -> f a)]
$sel:infixRight:Table :: forall (m :: * -> *) (f :: * -> *) a.
Table m f a -> [m (a -> a -> f a)]
infixRight } =
Table m f a
table { $sel:infixRight:Table :: [m (a -> a -> f a)]
infixRight = m (a -> a -> f a)
op m (a -> a -> f a) -> [m (a -> a -> f a)] -> [m (a -> a -> f a)]
forall a. a -> [a] -> [a]
: [m (a -> a -> f a)]
infixRight }
addInfix Associativity
AssocLeft m (a -> a -> f a)
op table :: Table m f a
table@Table { [m (a -> a -> f a)]
infixLeft :: [m (a -> a -> f a)]
$sel:infixLeft:Table :: forall (m :: * -> *) (f :: * -> *) a.
Table m f a -> [m (a -> a -> f a)]
infixLeft } =
Table m f a
table { $sel:infixLeft:Table :: [m (a -> a -> f a)]
infixLeft = m (a -> a -> f a)
op m (a -> a -> f a) -> [m (a -> a -> f a)] -> [m (a -> a -> f a)]
forall a. a -> [a] -> [a]
: [m (a -> a -> f a)]
infixLeft }
addInfix Associativity
AssocNone m (a -> a -> f a)
op table :: Table m f a
table@Table { [m (a -> a -> f a)]
infixNone :: [m (a -> a -> f a)]
$sel:infixNone:Table :: forall (m :: * -> *) (f :: * -> *) a.
Table m f a -> [m (a -> a -> f a)]
infixNone } =
Table m f a
table { $sel:infixNone:Table :: [m (a -> a -> f a)]
infixNone = m (a -> a -> f a)
op m (a -> a -> f a) -> [m (a -> a -> f a)] -> [m (a -> a -> f a)]
forall a. a -> [a] -> [a]
: [m (a -> a -> f a)]
infixNone }
addPrefix :: m (a -> f a) -> Table m f a -> Table m f a
addPrefix :: m (a -> f a) -> Table m f a -> Table m f a
addPrefix m (a -> f a)
op table :: Table m f a
table@Table { [m (a -> f a)]
prefix :: [m (a -> f a)]
$sel:prefix:Table :: forall (m :: * -> *) (f :: * -> *) a. Table m f a -> [m (a -> f a)]
prefix } = Table m f a
table { $sel:prefix:Table :: [m (a -> f a)]
prefix = m (a -> f a)
op m (a -> f a) -> [m (a -> f a)] -> [m (a -> f a)]
forall a. a -> [a] -> [a]
: [m (a -> f a)]
prefix }
locate :: Locate m => m (f (Cofree f Location)) -> m (Cofree f Location)
locate :: m (f (Cofree f Location)) -> m (Cofree f Location)
locate m (f (Cofree f Location))
m = do
(f (Cofree f Location)
x, Location
loc) <- m (f (Cofree f Location)) -> m (f (Cofree f Location), Location)
forall (m :: * -> *) a. Locate m => m a -> m (a, Location)
getLocation m (f (Cofree f Location))
m
Cofree f Location -> m (Cofree f Location)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Location
loc Location -> f (Cofree f Location) -> Cofree f Location
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< f (Cofree f Location)
x)
makeExprParser
:: (Alternative m, Locate m)
=> m (f (Cofree f Location))
-> [Table m f (Cofree f Location)]
-> m (Cofree f Location)
makeExprParser :: m (f (Cofree f Location))
-> [Table m f (Cofree f Location)] -> m (Cofree f Location)
makeExprParser m (f (Cofree f Location))
atom = (m (Cofree f Location)
-> Table m f (Cofree f Location) -> m (Cofree f Location))
-> m (Cofree f Location)
-> [Table m f (Cofree f Location)]
-> m (Cofree f Location)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl m (Cofree f Location)
-> Table m f (Cofree f Location) -> m (Cofree f Location)
forall (m :: * -> *) (f :: * -> *).
(Alternative m, Locate m) =>
m (Cofree f Location)
-> Table m f (Cofree f Location) -> m (Cofree f Location)
addPrecLevel (m (Cofree f Location)
-> [Table m f (Cofree f Location)] -> m (Cofree f Location))
-> m (Cofree f Location)
-> [Table m f (Cofree f Location)]
-> m (Cofree f Location)
forall a b. (a -> b) -> a -> b
$ m (f (Cofree f Location)) -> m (Cofree f Location)
forall (m :: * -> *) (f :: * -> *).
Locate m =>
m (f (Cofree f Location)) -> m (Cofree f Location)
locate m (f (Cofree f Location))
atom
addPrecLevel
:: (Alternative m, Locate m)
=> m (Cofree f Location)
-> Table m f (Cofree f Location)
-> m (Cofree f Location)
addPrecLevel :: m (Cofree f Location)
-> Table m f (Cofree f Location) -> m (Cofree f Location)
addPrecLevel m (Cofree f Location)
atom Table m f (Cofree f Location)
table = do
Position
begin <- m Position
forall (m :: * -> *). Locate m => m Position
getPosition
Cofree f Location
x <- m (Cofree f Location)
atom'
[m (Cofree f Location)] -> m (Cofree f Location)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Position -> Cofree f Location -> m (Cofree f Location)
right Position
begin Cofree f Location
x, Position -> Cofree f Location -> m (Cofree f Location)
left Position
begin Cofree f Location
x, Position -> Cofree f Location -> m (Cofree f Location)
none Position
begin Cofree f Location
x, Cofree f Location -> m (Cofree f Location)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cofree f Location
x]
where
Table { [m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))]
infixRight :: [m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))]
$sel:infixRight:Table :: forall (m :: * -> *) (f :: * -> *) a.
Table m f a -> [m (a -> a -> f a)]
infixRight, [m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))]
infixLeft :: [m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))]
$sel:infixLeft:Table :: forall (m :: * -> *) (f :: * -> *) a.
Table m f a -> [m (a -> a -> f a)]
infixLeft, [m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))]
infixNone :: [m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))]
$sel:infixNone:Table :: forall (m :: * -> *) (f :: * -> *) a.
Table m f a -> [m (a -> a -> f a)]
infixNone, [m (Cofree f Location -> f (Cofree f Location))]
prefix :: [m (Cofree f Location -> f (Cofree f Location))]
$sel:prefix:Table :: forall (m :: * -> *) (f :: * -> *) a. Table m f a -> [m (a -> f a)]
prefix } = Table m f (Cofree f Location)
table
atom' :: m (Cofree f Location)
atom' = m (Cofree f Location -> f (Cofree f Location))
-> m (Cofree f Location)
pPrefix ([m (Cofree f Location -> f (Cofree f Location))]
-> m (Cofree f Location -> f (Cofree f Location))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [m (Cofree f Location -> f (Cofree f Location))]
prefix)
right :: Position -> Cofree f Location -> m (Cofree f Location)
right = m (Cofree f Location -> Cofree f Location -> f (Cofree f Location))
-> m (Cofree f Location)
-> Position
-> Cofree f Location
-> m (Cofree f Location)
forall (m :: * -> *) (f :: * -> *).
(Locate m, Alternative m) =>
m (Cofree f Location -> Cofree f Location -> f (Cofree f Location))
-> m (Cofree f Location)
-> Position
-> Cofree f Location
-> m (Cofree f Location)
pInfixR ([m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))]
-> m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))]
infixRight) m (Cofree f Location)
atom'
left :: Position -> Cofree f Location -> m (Cofree f Location)
left = m (Cofree f Location -> Cofree f Location -> f (Cofree f Location))
-> m (Cofree f Location)
-> Position
-> Cofree f Location
-> m (Cofree f Location)
forall (m :: * -> *) (f :: * -> *) t.
(Locate m, Alternative m) =>
m (Cofree f Location -> t -> f (Cofree f Location))
-> m t -> Position -> Cofree f Location -> m (Cofree f Location)
pInfixL ([m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))]
-> m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))]
infixLeft) m (Cofree f Location)
atom'
none :: Position -> Cofree f Location -> m (Cofree f Location)
none = m (Cofree f Location -> Cofree f Location -> f (Cofree f Location))
-> m (Cofree f Location)
-> Position
-> Cofree f Location
-> m (Cofree f Location)
forall (m :: * -> *) t t (f :: * -> *).
Locate m =>
m (t -> t -> f (Cofree f Location))
-> m t -> Position -> t -> m (Cofree f Location)
pInfixN ([m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))]
-> m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [m (Cofree f Location
-> Cofree f Location -> f (Cofree f Location))]
infixNone) m (Cofree f Location)
atom'
pPrefix :: m (Cofree f Location -> f (Cofree f Location))
-> m (Cofree f Location)
pPrefix m (Cofree f Location -> f (Cofree f Location))
op = do
Position
begin <- m Position
forall (m :: * -> *). Locate m => m Position
getPosition
Maybe (Cofree f Location -> f (Cofree f Location))
mpre <- m (Cofree f Location -> f (Cofree f Location))
-> m (Maybe (Cofree f Location -> f (Cofree f Location)))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m (Cofree f Location -> f (Cofree f Location))
op
Cofree f Location
x <- m (Cofree f Location)
atom
case Maybe (Cofree f Location -> f (Cofree f Location))
mpre of
Maybe (Cofree f Location -> f (Cofree f Location))
Nothing -> Cofree f Location -> m (Cofree f Location)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cofree f Location
x
Just Cofree f Location -> f (Cofree f Location)
f -> Position -> f (Cofree f Location) -> m (Cofree f Location)
forall (m :: * -> *) (f :: * -> *).
Locate m =>
Position -> f (Cofree f Location) -> m (Cofree f Location)
ends Position
begin (f (Cofree f Location) -> m (Cofree f Location))
-> f (Cofree f Location) -> m (Cofree f Location)
forall a b. (a -> b) -> a -> b
$ Cofree f Location -> f (Cofree f Location)
f Cofree f Location
x
pInfixR :: m (Cofree f Location -> Cofree f Location -> f (Cofree f Location))
-> m (Cofree f Location)
-> Position
-> Cofree f Location
-> m (Cofree f Location)
pInfixR m (Cofree f Location -> Cofree f Location -> f (Cofree f Location))
op m (Cofree f Location)
p Position
begin Cofree f Location
x = do
Cofree f Location -> Cofree f Location -> f (Cofree f Location)
f <- m (Cofree f Location -> Cofree f Location -> f (Cofree f Location))
op
Cofree f Location
y <- do
Position
begin' <- m Position
forall (m :: * -> *). Locate m => m Position
getPosition
Cofree f Location
r <- m (Cofree f Location)
p
m (Cofree f Location -> Cofree f Location -> f (Cofree f Location))
-> m (Cofree f Location)
-> Position
-> Cofree f Location
-> m (Cofree f Location)
pInfixR m (Cofree f Location -> Cofree f Location -> f (Cofree f Location))
op m (Cofree f Location)
p Position
begin' Cofree f Location
r m (Cofree f Location)
-> m (Cofree f Location) -> m (Cofree f Location)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Cofree f Location -> m (Cofree f Location)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cofree f Location
r
Position -> f (Cofree f Location) -> m (Cofree f Location)
forall (m :: * -> *) (f :: * -> *).
Locate m =>
Position -> f (Cofree f Location) -> m (Cofree f Location)
ends Position
begin (f (Cofree f Location) -> m (Cofree f Location))
-> f (Cofree f Location) -> m (Cofree f Location)
forall a b. (a -> b) -> a -> b
$ Cofree f Location -> Cofree f Location -> f (Cofree f Location)
f Cofree f Location
x Cofree f Location
y
pInfixL :: m (Cofree f Location -> t -> f (Cofree f Location))
-> m t -> Position -> Cofree f Location -> m (Cofree f Location)
pInfixL m (Cofree f Location -> t -> f (Cofree f Location))
op m t
p Position
begin Cofree f Location
x = do
Cofree f Location
r <- do
Cofree f Location -> t -> f (Cofree f Location)
f <- m (Cofree f Location -> t -> f (Cofree f Location))
op
t
y <- m t
p
Position -> f (Cofree f Location) -> m (Cofree f Location)
forall (m :: * -> *) (f :: * -> *).
Locate m =>
Position -> f (Cofree f Location) -> m (Cofree f Location)
ends Position
begin (f (Cofree f Location) -> m (Cofree f Location))
-> f (Cofree f Location) -> m (Cofree f Location)
forall a b. (a -> b) -> a -> b
$ Cofree f Location -> t -> f (Cofree f Location)
f Cofree f Location
x t
y
m (Cofree f Location -> t -> f (Cofree f Location))
-> m t -> Position -> Cofree f Location -> m (Cofree f Location)
pInfixL m (Cofree f Location -> t -> f (Cofree f Location))
op m t
p Position
begin Cofree f Location
r m (Cofree f Location)
-> m (Cofree f Location) -> m (Cofree f Location)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Cofree f Location -> m (Cofree f Location)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cofree f Location
r
pInfixN :: m (t -> t -> f (Cofree f Location))
-> m t -> Position -> t -> m (Cofree f Location)
pInfixN m (t -> t -> f (Cofree f Location))
op m t
p Position
begin t
x = do
t -> t -> f (Cofree f Location)
f <- m (t -> t -> f (Cofree f Location))
op
t
y <- m t
p
Position -> f (Cofree f Location) -> m (Cofree f Location)
forall (m :: * -> *) (f :: * -> *).
Locate m =>
Position -> f (Cofree f Location) -> m (Cofree f Location)
ends Position
begin (f (Cofree f Location) -> m (Cofree f Location))
-> f (Cofree f Location) -> m (Cofree f Location)
forall a b. (a -> b) -> a -> b
$ t -> t -> f (Cofree f Location)
f t
x t
y
ends :: Position -> f (Cofree f Location) -> m (Cofree f Location)
ends Position
begin f (Cofree f Location)
x = do
Position
end <- m Position
forall (m :: * -> *). Locate m => m Position
getPosition
let location :: Location
location = Location :: Position -> Position -> Location
Location { Position
$sel:begin:Location :: Position
begin :: Position
begin, Position
$sel:end:Location :: Position
end :: Position
end }
Cofree f Location -> m (Cofree f Location)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Location
location Location -> f (Cofree f Location) -> Cofree f Location
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< f (Cofree f Location)
x)
type ExprL n v e = Cofree (ExprF n v e) Location
buildOperatorTable
:: (MonadReader (ParseMode n v e s) m, Source s)
=> [(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> m [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
buildOperatorTable :: [(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> m [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
buildOperatorTable [(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
primInfixes = do
ParseMode { [ParseFixity n s]
$sel:fixities:ParseMode :: forall n v e s. ParseMode n v e s -> [ParseFixity n s]
fixities :: [ParseFixity n s]
fixities } <- m (ParseMode n v e s)
forall r (m :: * -> *). MonadReader r m => m r
ask
[Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
-> m [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
-> m [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)])
-> (IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)])
-> IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> m [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> [(Key, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
forall a b. (a -> b) -> [a] -> [b]
map (Key, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> Table (Parse n v e s) (ExprF n v e) (ExprL n v e)
forall a b. (a, b) -> b
snd ([(Key, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)])
-> (IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> [(Key, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))])
-> IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> [(Key, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
forall a. IntMap a -> [(Key, a)]
IntMap.toDescList (IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> m [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)])
-> IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> m [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
forall a b. (a -> b) -> a -> b
$ (ParseFixity n s
-> IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e)))
-> IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> [ParseFixity n s]
-> IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ParseFixity n s
-> IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
forall s s n n v e v e a.
(Source s, Tokens s ~ Tokens s) =>
ParseFixity n s
-> IntMap (Table (Parse n v e s) (ExprF n v e) a)
-> IntMap (Table (Parse n v e s) (ExprF n v e) a)
go IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
prim [ParseFixity n s]
fixities
where
go :: ParseFixity n s
-> IntMap (Table (Parse n v e s) (ExprF n v e) a)
-> IntMap (Table (Parse n v e s) (ExprF n v e) a)
go (ParseFixity (Fixity Associativity
assoc Precedence
prec n
n) ExtParser s ()
p) =
Precedence
-> (Table (Parse n v e s) (ExprF n v e) a
-> Table (Parse n v e s) (ExprF n v e) a)
-> IntMap (Table (Parse n v e s) (ExprF n v e) a)
-> IntMap (Table (Parse n v e s) (ExprF n v e) a)
forall (m :: * -> *) (f :: * -> *) a.
Precedence
-> (Table m f a -> Table m f a)
-> IntMap (Table m f a)
-> IntMap (Table m f a)
addPrecToTable Precedence
prec ((Table (Parse n v e s) (ExprF n v e) a
-> Table (Parse n v e s) (ExprF n v e) a)
-> IntMap (Table (Parse n v e s) (ExprF n v e) a)
-> IntMap (Table (Parse n v e s) (ExprF n v e) a))
-> (Parse n v e s (a -> a -> ExprF n v e a)
-> Table (Parse n v e s) (ExprF n v e) a
-> Table (Parse n v e s) (ExprF n v e) a)
-> Parse n v e s (a -> a -> ExprF n v e a)
-> IntMap (Table (Parse n v e s) (ExprF n v e) a)
-> IntMap (Table (Parse n v e s) (ExprF n v e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Associativity
-> Parse n v e s (a -> a -> ExprF n v e a)
-> Table (Parse n v e s) (ExprF n v e) a
-> Table (Parse n v e s) (ExprF n v e) a
forall (m :: * -> *) a (f :: * -> *).
Associativity -> m (a -> a -> f a) -> Table m f a -> Table m f a
addInfix Associativity
assoc (Parse n v e s (a -> a -> ExprF n v e a)
-> IntMap (Table (Parse n v e s) (ExprF n v e) a)
-> IntMap (Table (Parse n v e s) (ExprF n v e) a))
-> Parse n v e s (a -> a -> ExprF n v e a)
-> IntMap (Table (Parse n v e s) (ExprF n v e) a)
-> IntMap (Table (Parse n v e s) (ExprF n v e) a)
forall a b. (a -> b) -> a -> b
$ n
-> (Tokens s -> Either String ())
-> Parse n v e s (a -> a -> ExprF n v e a)
forall s n b n v e r v e.
Source s =>
n
-> (Tokens s -> Either String b)
-> Parse n v e s (r -> r -> ExprF n v e r)
makeOperator n
n ExtParser s ()
Tokens s -> Either String ()
p
makeOperator :: n
-> (Tokens s -> Either String b)
-> Parse n v e s (r -> r -> ExprF n v e r)
makeOperator n
n Tokens s -> Either String b
p = n -> r -> r -> ExprF n v e r
forall n v e r. n -> r -> r -> ExprF n v e r
InfixF n
n (r -> r -> ExprF n v e r)
-> Parse n v e s b -> Parse n v e s (r -> r -> ExprF n v e r)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parse n v e s b -> Parse n v e s b
forall s n v e a. Source s => Parse n v e s a -> Parse n v e s a
lexeme ((Tokens s -> Either String b) -> Parse n v e s b
forall s a n v e. Source s => ExtParser s a -> Parse n v e s a
extParser Tokens s -> Either String b
p)
prim :: IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
prim = [(Key, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
forall a. [(Key, a)] -> IntMap a
IntMap.fromList ([(Key, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e)))
-> [(Key, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> IntMap (Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
forall a b. (a -> b) -> a -> b
$ ((Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> (Key, Table (Parse n v e s) (ExprF n v e) (ExprL n v e)))
-> [(Precedence,
Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> [(Key, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
forall a b. (a -> b) -> [a] -> [b]
map ((Precedence -> Key)
-> (Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
-> (Key, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Precedence -> Key
Prec.toInt) [(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
primInfixes
addPrecToTable :: Precedence
-> (Table m f a -> Table m f a)
-> IntMap (Table m f a)
-> IntMap (Table m f a)
addPrecToTable Precedence
prec Table m f a -> Table m f a
f = (Table m f a -> Table m f a)
-> Table m f a
-> Key
-> IntMap (Table m f a)
-> IntMap (Table m f a)
forall a. (a -> a) -> a -> Key -> IntMap a -> IntMap a
adjustWithDefault Table m f a -> Table m f a
f (Table m f a -> Table m f a
f Table m f a
forall (m :: * -> *) (f :: * -> *) a. Table m f a
initTable) (Key -> IntMap (Table m f a) -> IntMap (Table m f a))
-> Key -> IntMap (Table m f a) -> IntMap (Table m f a)
forall a b. (a -> b) -> a -> b
$ Precedence -> Key
Prec.toInt Precedence
prec
adjustWithDefault :: (a -> a) -> a -> Key -> IntMap a -> IntMap a
adjustWithDefault a -> a
f a
def = (Maybe a -> Maybe a) -> Key -> IntMap a -> IntMap a
forall a. (Maybe a -> Maybe a) -> Key -> IntMap a -> IntMap a
IntMap.alter (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (Maybe a -> a) -> Maybe a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
def a -> a
f)
exprParser
:: Source s
=> [(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprL n v e)
exprParser :: [(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprL n v e)
exprParser [(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
primInfixes Parse n v e s (ExprF n v e (ExprL n v e))
atom = do
[Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
ops <- [(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> Parse
n v e s [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
forall n v e s (m :: * -> *).
(MonadReader (ParseMode n v e s) m, Source s) =>
[(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> m [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
buildOperatorTable [(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
primInfixes
Parse n v e s (ExprF n v e (ExprL n v e))
-> [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
-> Parse n v e s (ExprL n v e)
forall (m :: * -> *) (f :: * -> *).
(Alternative m, Locate m) =>
m (f (Cofree f Location))
-> [Table m f (Cofree f Location)] -> m (Cofree f Location)
makeExprParser Parse n v e s (ExprF n v e (ExprL n v e))
atom [Table (Parse n v e s) (ExprF n v e) (ExprL n v e)]
ops
atomParser
:: Source s
=> Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprL n v e)
atomParser :: Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprL n v e)
atomParser = Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprL n v e)
forall (m :: * -> *) (f :: * -> *).
Locate m =>
m (f (Cofree f Location)) -> m (Cofree f Location)
locate