-- |
--
-- Module:      Language.Egison.Parser.Pattern.Expr
-- Description: Helpers to build a parser for expressions
-- Stability:   experimental
--
-- A helper module to build a parser for expressions.

module Language.Egison.Parser.Pattern.Expr
  ( ExprL
  , exprParser
  , atomParser
  , Table(..)
  , initTable
  , addInfix
  , addPrefix
  -- * Re-exports
  , module X
  )
where

-- re-exports
import           Language.Egison.Syntax.Pattern.Fixity
                                               as X

-- main
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(..)
                                                )


-- | A list of operators with same precedence.
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)]
          }

-- | Initial 'Table' with no operator.
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 [] [] [] []

-- | Add an infix operator to '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 }

-- | Add a prefix operator to 'Table'.
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)

-- | 'Language.Egison.Syntax.Pattern.Expr.Expr' with locations annotated.
type ExprL n v e = Cofree (ExprF n v e) Location

-- | Build an operator table from primitive operator table and 'ParseMode' context.
-- Note that the behavior is undefined when the supplied 'ParseMode' contains some fixities that conflict with ones provided via the parameter.
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)

-- | Build an expression parser with location information, from an atom parser.
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

-- | Build an atom parser with location information, from an atom parser. (i.e. just adds a location information)
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