{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- | The internal representation of LBNF grammars.
--
-- Pragmas have been desugared as far as possible.

module BNFC.CF where

import BNFC.Prelude

import Lens.Micro.TH (makeLenses)

import qualified Data.Map         as Map
import qualified BNFC.Utils.List1 as List1

import BNFC.Types.Position
import BNFC.Types.Regex

import BNFC.Backend.Common.StringUtils (escapeChars)

-- | The internal representation of a LBNF grammar.
--
-- The name is an abbreviation of Context-Free (Grammar).
--
-- Rules are stored in:
--
--   1. The signature: a map from rule names to their type (Id labels only).
--      The signature is used for type-checking definitions and special rules (lists).
--
--   2. The AST rules: a map from categories to labels to rhss.
--      This representation is useful for generating the abstract syntax and the printer.
--      Keywords are not trimmed here to allow the extra whitespace to be printed
--      (see BNFC/bnfc#70).
--
--   3. The parser rules: a map from categories to rhss to labels.
--      @internal@ rules are not contained in this map.
--      This representation expresses that each parseable BNF rule can have at most one label.
--      It is useful for detecting overlapping rules, e.g. coming from
--      proper rules and list/coercion pragmas.
--      The parser generation should start with these rules.
--      Keywords are trimmed since BNFC-generated parsers are not whitespace-sensitive.


data LBNF = LBNF
  --- Typing and definitions
  { LBNF -> Signature
_lbnfSignature      :: Signature
       -- ^ Type for each AST constructor and defined function.
  , LBNF -> Functions
_lbnfFunctions      :: Functions
       -- ^ Checked functions from @define@ pragmas.
  , LBNF -> ASTRules
_lbnfASTRules       :: ASTRules
       -- ^ Per category, its rules ordered by label.
  , LBNF -> ASTRulesAP
_lbnfASTRulesAP     :: ASTRulesAP
       -- ^ AST rules used to generate abstract syntax and printer.
       --   Per type (category without precedence),
       --   its rules non terminals and a map from category precedence
       --   to rhs, ordered by label.
  , LBNF -> UsedBuiltins
_lbnfASTBuiltins    :: UsedBuiltins
       -- ^ Builtin categories @Char, Integer, ...@ (non-overwritten) mentioned in the AST.
       --   (Includes builtin categories only mentioned in 'Internal' rules.)
  --- Parser components
  , LBNF -> ParserRules
_lbnfParserRules    :: ParserRules
       -- ^ Per category, its 'Parseable' rules ordered by 'RHS'.
  , LBNF -> UsedBuiltins
_lbnfParserBuiltins :: UsedBuiltins
       -- ^ Builtin categories @Char, Integer, ...@ mentioned in the 'Parseable' rules.
       --   (and not overwritten).
  , LBNF -> EntryPoints
_lbnfEntryPoints    :: EntryPoints
       -- ^ Collection of entry points for parser,
       --   each with the position(s) where it was declared entry point.
  --- Lexer components
  , LBNF -> TokenDefs
_lbnfTokenDefs      :: TokenDefs
       -- ^ User-defined token categories.
  , LBNF -> KeywordUses
_lbnfKeywords       :: KeywordUses
       -- ^ Keywords and their occurrences in rhss. Computed by pass 1.
  , LBNF -> SymbolUses
_lbnfSymbols        :: SymbolUses
       -- ^ Symbols and their occurrences in rhss. Computed by pass 1.
  , LBNF -> SymbolsKeywords
_lbnfSymbolsKeywords :: SymbolsKeywords
       -- ^ Symbols and keywords used in lexer and parser specifications
  , LBNF -> LineComments
_lbnfLineComments   :: LineComments
       -- ^ Line comment pragmas by position, e.g. @comment "--"@.
  , LBNF -> BlockComments
_lbnfBlockComments  :: BlockComments
       -- ^ Block comment pragmas by position, e.g. @comment "{-" "-}"@.
  , LBNF -> LayoutKeywords
_lbnfLayoutStart    :: LayoutKeywords
       -- ^ @layout@ start keywords with the pragma position.
       --   Keywords are members of '_lbnfKeywords'.
  , LBNF -> LayoutKeywords
_lbnfLayoutStop     :: LayoutKeywords
       -- ^ @layout stop@ keywords with the pragma position.
       --   Disjoint from '_lbnfLayout'.
       --   Keywords are members of '_lbnfKeywords'.
  , LBNF -> Maybe Position
_lbnfLayoutTop      :: Maybe Position
       -- ^ 'Position' of @layout toplevel@, if present.
  }
  deriving Int -> LBNF -> ShowS
[LBNF] -> ShowS
LBNF -> String
(Int -> LBNF -> ShowS)
-> (LBNF -> String) -> ([LBNF] -> ShowS) -> Show LBNF
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LBNF] -> ShowS
$cshowList :: [LBNF] -> ShowS
show :: LBNF -> String
$cshow :: LBNF -> String
showsPrec :: Int -> LBNF -> ShowS
$cshowsPrec :: Int -> LBNF -> ShowS
Show

type Signature       = Map LabelName (WithPosition FunType)
type Functions       = Map LabelName (WithPosition Function)
type ASTRules        = Map Cat (Map Label (WithPosition ARuleRHS))
type ASTRulesAP      = Map Type (Map Label ([Type], (Integer, WithPosition ARHS)))
type ParserRules     = Map Cat (Map RHS (WithPosition RuleLabel))
type EntryPoints     = Map Cat (List1 Position)
type UsedBuiltins    = Map BuiltinCat (List1 Position)
type TokenDefs       = Map CatName (WithPosition TokenDef)
type KeywordUses     = Map Keyword (List1 Position)
type SymbolUses      = Map Symbol (List1 Position)
type SymbolsKeywords = Map String1 Int
type LineComments    = Map Position LineComment
type BlockComments   = Map Position BlockComment
type LayoutKeywords  = Map Keyword Position

initLBNF :: LBNF
initLBNF :: LBNF
initLBNF = LBNF :: Signature
-> Functions
-> ASTRules
-> ASTRulesAP
-> UsedBuiltins
-> ParserRules
-> UsedBuiltins
-> EntryPoints
-> TokenDefs
-> KeywordUses
-> SymbolUses
-> SymbolsKeywords
-> LineComments
-> BlockComments
-> LayoutKeywords
-> LayoutKeywords
-> Maybe Position
-> LBNF
LBNF
  { _lbnfSignature :: Signature
_lbnfSignature          = Signature
forall a. Monoid a => a
mempty
  , _lbnfFunctions :: Functions
_lbnfFunctions          = Functions
forall a. Monoid a => a
mempty
  , _lbnfASTRules :: ASTRules
_lbnfASTRules           = ASTRules
forall a. Monoid a => a
mempty
  , _lbnfASTRulesAP :: ASTRulesAP
_lbnfASTRulesAP         = ASTRulesAP
forall a. Monoid a => a
mempty
  , _lbnfASTBuiltins :: UsedBuiltins
_lbnfASTBuiltins        = UsedBuiltins
forall a. Monoid a => a
mempty
  , _lbnfParserRules :: ParserRules
_lbnfParserRules        = ParserRules
forall a. Monoid a => a
mempty
  , _lbnfParserBuiltins :: UsedBuiltins
_lbnfParserBuiltins     = UsedBuiltins
forall a. Monoid a => a
mempty
  , _lbnfEntryPoints :: EntryPoints
_lbnfEntryPoints        = EntryPoints
forall a. Monoid a => a
mempty
  , _lbnfTokenDefs :: TokenDefs
_lbnfTokenDefs          = TokenDefs
forall a. Monoid a => a
mempty
  , _lbnfKeywords :: KeywordUses
_lbnfKeywords           = KeywordUses
forall a. Monoid a => a
mempty
  , _lbnfSymbols :: SymbolUses
_lbnfSymbols            = SymbolUses
forall a. Monoid a => a
mempty
  , _lbnfSymbolsKeywords :: SymbolsKeywords
_lbnfSymbolsKeywords    = SymbolsKeywords
forall a. Monoid a => a
mempty
  , _lbnfLineComments :: LineComments
_lbnfLineComments       = LineComments
forall a. Monoid a => a
mempty
  , _lbnfBlockComments :: BlockComments
_lbnfBlockComments      = BlockComments
forall a. Monoid a => a
mempty
  , _lbnfLayoutStart :: LayoutKeywords
_lbnfLayoutStart        = LayoutKeywords
forall a. Monoid a => a
mempty
  , _lbnfLayoutStop :: LayoutKeywords
_lbnfLayoutStop         = LayoutKeywords
forall a. Monoid a => a
mempty
  , _lbnfLayoutTop :: Maybe Position
_lbnfLayoutTop          = Maybe Position
forall a. Maybe a
Nothing
  }

-- -- | A (non-token) category is defined by one or more rules.
-- --   These are stored as a stack, with last rule on top.  Reverse before processing!
-- type CatDef = List1 (WithPosition RuleBody)

-- | A token category is defined by a regular expression.

data TokenDef = TokenDef
  { TokenDef -> PositionToken
positionToken :: PositionToken
      -- ^ Is it a @position token@?
  , TokenDef -> Regex
regexToken    :: Regex
      -- ^ The defining regular expression.
  , TokenDef -> Bool
isIdent       :: Bool
      -- ^ Is it the @Ident@ token?
  } deriving Int -> TokenDef -> ShowS
[TokenDef] -> ShowS
TokenDef -> String
(Int -> TokenDef -> ShowS)
-> (TokenDef -> String) -> ([TokenDef] -> ShowS) -> Show TokenDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenDef] -> ShowS
$cshowList :: [TokenDef] -> ShowS
show :: TokenDef -> String
$cshow :: TokenDef -> String
showsPrec :: Int -> TokenDef -> ShowS
$cshowsPrec :: Int -> TokenDef -> ShowS
Show

-- | Keywords are non-empty 'trim'med strings.
--   Trimming happens since LBNF is a whitespace-insensitive formalism.
--   Should a future version of BNFC become whitespace sensitive,
--   we have to abstain from 'trim'ming keywords by default.

newtype Keyword = Keyword { Keyword -> List1 Char
theKeyword :: List1 Char }
  deriving (Keyword -> Keyword -> Bool
(Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool) -> Eq Keyword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Keyword -> Keyword -> Bool
$c/= :: Keyword -> Keyword -> Bool
== :: Keyword -> Keyword -> Bool
$c== :: Keyword -> Keyword -> Bool
Eq, Eq Keyword
Eq Keyword
-> (Keyword -> Keyword -> Ordering)
-> (Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Keyword)
-> (Keyword -> Keyword -> Keyword)
-> Ord Keyword
Keyword -> Keyword -> Bool
Keyword -> Keyword -> Ordering
Keyword -> Keyword -> Keyword
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Keyword -> Keyword -> Keyword
$cmin :: Keyword -> Keyword -> Keyword
max :: Keyword -> Keyword -> Keyword
$cmax :: Keyword -> Keyword -> Keyword
>= :: Keyword -> Keyword -> Bool
$c>= :: Keyword -> Keyword -> Bool
> :: Keyword -> Keyword -> Bool
$c> :: Keyword -> Keyword -> Bool
<= :: Keyword -> Keyword -> Bool
$c<= :: Keyword -> Keyword -> Bool
< :: Keyword -> Keyword -> Bool
$c< :: Keyword -> Keyword -> Bool
compare :: Keyword -> Keyword -> Ordering
$ccompare :: Keyword -> Keyword -> Ordering
$cp1Ord :: Eq Keyword
Ord)

instance Show Keyword where
  showsPrec :: Int -> Keyword -> ShowS
showsPrec Int
i (Keyword (Char
c:|String
s)) =
    Bool -> ShowS -> ShowS
showParen (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Data.List.NonEmpty.fromList" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
s)
    -- See https://hackage.haskell.org/package/base-4.16.0.0/docs/GHC-Show.html#t:Show
    -- Application has a precedence of 10.

newtype Symbol = Symbol { Symbol -> List1 Char
theSymbol :: List1 Char }
  deriving (Symbol -> Symbol -> Bool
(Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool) -> Eq Symbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Symbol -> Symbol -> Bool
$c/= :: Symbol -> Symbol -> Bool
== :: Symbol -> Symbol -> Bool
$c== :: Symbol -> Symbol -> Bool
Eq, Eq Symbol
Eq Symbol
-> (Symbol -> Symbol -> Ordering)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Symbol)
-> (Symbol -> Symbol -> Symbol)
-> Ord Symbol
Symbol -> Symbol -> Bool
Symbol -> Symbol -> Ordering
Symbol -> Symbol -> Symbol
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Symbol -> Symbol -> Symbol
$cmin :: Symbol -> Symbol -> Symbol
max :: Symbol -> Symbol -> Symbol
$cmax :: Symbol -> Symbol -> Symbol
>= :: Symbol -> Symbol -> Bool
$c>= :: Symbol -> Symbol -> Bool
> :: Symbol -> Symbol -> Bool
$c> :: Symbol -> Symbol -> Bool
<= :: Symbol -> Symbol -> Bool
$c<= :: Symbol -> Symbol -> Bool
< :: Symbol -> Symbol -> Bool
$c< :: Symbol -> Symbol -> Bool
compare :: Symbol -> Symbol -> Ordering
$ccompare :: Symbol -> Symbol -> Ordering
$cp1Ord :: Eq Symbol
Ord)

instance Show Symbol where
  showsPrec :: Int -> Symbol -> ShowS
showsPrec Int
i (Symbol (Char
c:|String
s)) =
    Bool -> ShowS -> ShowS
showParen (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Data.List.NonEmpty.fromList" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
s)

newtype LineComment = LineComment String1
  deriving (Int -> LineComment -> ShowS
[LineComment] -> ShowS
LineComment -> String
(Int -> LineComment -> ShowS)
-> (LineComment -> String)
-> ([LineComment] -> ShowS)
-> Show LineComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineComment] -> ShowS
$cshowList :: [LineComment] -> ShowS
show :: LineComment -> String
$cshow :: LineComment -> String
showsPrec :: Int -> LineComment -> ShowS
$cshowsPrec :: Int -> LineComment -> ShowS
Show)
data BlockComment = BlockComment String1 String1
  deriving (Int -> BlockComment -> ShowS
[BlockComment] -> ShowS
BlockComment -> String
(Int -> BlockComment -> ShowS)
-> (BlockComment -> String)
-> ([BlockComment] -> ShowS)
-> Show BlockComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockComment] -> ShowS
$cshowList :: [BlockComment] -> ShowS
show :: BlockComment -> String
$cshow :: BlockComment -> String
showsPrec :: Int -> BlockComment -> ShowS
$cshowsPrec :: Int -> BlockComment -> ShowS
Show)

-- newtype LayoutKeyword = LayoutKeyword String
-- newtype LayoutStop    = LayoutStop String

-- * Categories
---------------------------------------------------------------------------

type CatName = String1
type Cat     = Cat' BaseCat

-- | Categories (non-terminals).

data Cat' a
  = Cat a
      -- ^ Base category, e.g. @Ident@, @Exp@.
  | ListCat (Cat' a)
      -- ^ List non-terminals, e.g., @[Ident]@, @[Exp]@, @[Exp1]@.
  | CoerceCat CatName Integer
      -- ^ E.g. @Exp1@, @Exp2@.
  deriving (Cat' a -> Cat' a -> Bool
(Cat' a -> Cat' a -> Bool)
-> (Cat' a -> Cat' a -> Bool) -> Eq (Cat' a)
forall a. Eq a => Cat' a -> Cat' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cat' a -> Cat' a -> Bool
$c/= :: forall a. Eq a => Cat' a -> Cat' a -> Bool
== :: Cat' a -> Cat' a -> Bool
$c== :: forall a. Eq a => Cat' a -> Cat' a -> Bool
Eq, Eq (Cat' a)
Eq (Cat' a)
-> (Cat' a -> Cat' a -> Ordering)
-> (Cat' a -> Cat' a -> Bool)
-> (Cat' a -> Cat' a -> Bool)
-> (Cat' a -> Cat' a -> Bool)
-> (Cat' a -> Cat' a -> Bool)
-> (Cat' a -> Cat' a -> Cat' a)
-> (Cat' a -> Cat' a -> Cat' a)
-> Ord (Cat' a)
Cat' a -> Cat' a -> Bool
Cat' a -> Cat' a -> Ordering
Cat' a -> Cat' a -> Cat' a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Cat' a)
forall a. Ord a => Cat' a -> Cat' a -> Bool
forall a. Ord a => Cat' a -> Cat' a -> Ordering
forall a. Ord a => Cat' a -> Cat' a -> Cat' a
min :: Cat' a -> Cat' a -> Cat' a
$cmin :: forall a. Ord a => Cat' a -> Cat' a -> Cat' a
max :: Cat' a -> Cat' a -> Cat' a
$cmax :: forall a. Ord a => Cat' a -> Cat' a -> Cat' a
>= :: Cat' a -> Cat' a -> Bool
$c>= :: forall a. Ord a => Cat' a -> Cat' a -> Bool
> :: Cat' a -> Cat' a -> Bool
$c> :: forall a. Ord a => Cat' a -> Cat' a -> Bool
<= :: Cat' a -> Cat' a -> Bool
$c<= :: forall a. Ord a => Cat' a -> Cat' a -> Bool
< :: Cat' a -> Cat' a -> Bool
$c< :: forall a. Ord a => Cat' a -> Cat' a -> Bool
compare :: Cat' a -> Cat' a -> Ordering
$ccompare :: forall a. Ord a => Cat' a -> Cat' a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Cat' a)
Ord, Int -> Cat' a -> ShowS
[Cat' a] -> ShowS
Cat' a -> String
(Int -> Cat' a -> ShowS)
-> (Cat' a -> String) -> ([Cat' a] -> ShowS) -> Show (Cat' a)
forall a. Show a => Int -> Cat' a -> ShowS
forall a. Show a => [Cat' a] -> ShowS
forall a. Show a => Cat' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cat' a] -> ShowS
$cshowList :: forall a. Show a => [Cat' a] -> ShowS
show :: Cat' a -> String
$cshow :: forall a. Show a => Cat' a -> String
showsPrec :: Int -> Cat' a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Cat' a -> ShowS
Show)

data BaseCat
  = BuiltinCat BuiltinCat
      -- ^ @Char@, @Double@, @Integer@, @String@.
  | IdentCat IdentCat
      -- ^ @Ident@
  | TokenCat CatName
      -- ^ User-defined @token@ category.
  | BaseCat  CatName
      -- ^ Base category defined by CFG, like @Exp@.
  deriving (BaseCat -> BaseCat -> Bool
(BaseCat -> BaseCat -> Bool)
-> (BaseCat -> BaseCat -> Bool) -> Eq BaseCat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BaseCat -> BaseCat -> Bool
$c/= :: BaseCat -> BaseCat -> Bool
== :: BaseCat -> BaseCat -> Bool
$c== :: BaseCat -> BaseCat -> Bool
Eq, Eq BaseCat
Eq BaseCat
-> (BaseCat -> BaseCat -> Ordering)
-> (BaseCat -> BaseCat -> Bool)
-> (BaseCat -> BaseCat -> Bool)
-> (BaseCat -> BaseCat -> Bool)
-> (BaseCat -> BaseCat -> Bool)
-> (BaseCat -> BaseCat -> BaseCat)
-> (BaseCat -> BaseCat -> BaseCat)
-> Ord BaseCat
BaseCat -> BaseCat -> Bool
BaseCat -> BaseCat -> Ordering
BaseCat -> BaseCat -> BaseCat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BaseCat -> BaseCat -> BaseCat
$cmin :: BaseCat -> BaseCat -> BaseCat
max :: BaseCat -> BaseCat -> BaseCat
$cmax :: BaseCat -> BaseCat -> BaseCat
>= :: BaseCat -> BaseCat -> Bool
$c>= :: BaseCat -> BaseCat -> Bool
> :: BaseCat -> BaseCat -> Bool
$c> :: BaseCat -> BaseCat -> Bool
<= :: BaseCat -> BaseCat -> Bool
$c<= :: BaseCat -> BaseCat -> Bool
< :: BaseCat -> BaseCat -> Bool
$c< :: BaseCat -> BaseCat -> Bool
compare :: BaseCat -> BaseCat -> Ordering
$ccompare :: BaseCat -> BaseCat -> Ordering
$cp1Ord :: Eq BaseCat
Ord, Int -> BaseCat -> ShowS
[BaseCat] -> ShowS
BaseCat -> String
(Int -> BaseCat -> ShowS)
-> (BaseCat -> String) -> ([BaseCat] -> ShowS) -> Show BaseCat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BaseCat] -> ShowS
$cshowList :: [BaseCat] -> ShowS
show :: BaseCat -> String
$cshow :: BaseCat -> String
showsPrec :: Int -> BaseCat -> ShowS
$cshowsPrec :: Int -> BaseCat -> ShowS
Show)

-- | Built-in token categories with special token representation.

data BuiltinCat
  = BChar    -- ^ @Char@
  | BDouble  -- ^ @Double@
  | BInteger -- ^ @Integer@
  | BString  -- ^ @String@
  deriving (BuiltinCat -> BuiltinCat -> Bool
(BuiltinCat -> BuiltinCat -> Bool)
-> (BuiltinCat -> BuiltinCat -> Bool) -> Eq BuiltinCat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuiltinCat -> BuiltinCat -> Bool
$c/= :: BuiltinCat -> BuiltinCat -> Bool
== :: BuiltinCat -> BuiltinCat -> Bool
$c== :: BuiltinCat -> BuiltinCat -> Bool
Eq, Eq BuiltinCat
Eq BuiltinCat
-> (BuiltinCat -> BuiltinCat -> Ordering)
-> (BuiltinCat -> BuiltinCat -> Bool)
-> (BuiltinCat -> BuiltinCat -> Bool)
-> (BuiltinCat -> BuiltinCat -> Bool)
-> (BuiltinCat -> BuiltinCat -> Bool)
-> (BuiltinCat -> BuiltinCat -> BuiltinCat)
-> (BuiltinCat -> BuiltinCat -> BuiltinCat)
-> Ord BuiltinCat
BuiltinCat -> BuiltinCat -> Bool
BuiltinCat -> BuiltinCat -> Ordering
BuiltinCat -> BuiltinCat -> BuiltinCat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BuiltinCat -> BuiltinCat -> BuiltinCat
$cmin :: BuiltinCat -> BuiltinCat -> BuiltinCat
max :: BuiltinCat -> BuiltinCat -> BuiltinCat
$cmax :: BuiltinCat -> BuiltinCat -> BuiltinCat
>= :: BuiltinCat -> BuiltinCat -> Bool
$c>= :: BuiltinCat -> BuiltinCat -> Bool
> :: BuiltinCat -> BuiltinCat -> Bool
$c> :: BuiltinCat -> BuiltinCat -> Bool
<= :: BuiltinCat -> BuiltinCat -> Bool
$c<= :: BuiltinCat -> BuiltinCat -> Bool
< :: BuiltinCat -> BuiltinCat -> Bool
$c< :: BuiltinCat -> BuiltinCat -> Bool
compare :: BuiltinCat -> BuiltinCat -> Ordering
$ccompare :: BuiltinCat -> BuiltinCat -> Ordering
$cp1Ord :: Eq BuiltinCat
Ord, Int -> BuiltinCat -> ShowS
[BuiltinCat] -> ShowS
BuiltinCat -> String
(Int -> BuiltinCat -> ShowS)
-> (BuiltinCat -> String)
-> ([BuiltinCat] -> ShowS)
-> Show BuiltinCat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuiltinCat] -> ShowS
$cshowList :: [BuiltinCat] -> ShowS
show :: BuiltinCat -> String
$cshow :: BuiltinCat -> String
showsPrec :: Int -> BuiltinCat -> ShowS
$cshowsPrec :: Int -> BuiltinCat -> ShowS
Show, BuiltinCat
BuiltinCat -> BuiltinCat -> Bounded BuiltinCat
forall a. a -> a -> Bounded a
maxBound :: BuiltinCat
$cmaxBound :: BuiltinCat
minBound :: BuiltinCat
$cminBound :: BuiltinCat
Bounded, Int -> BuiltinCat
BuiltinCat -> Int
BuiltinCat -> [BuiltinCat]
BuiltinCat -> BuiltinCat
BuiltinCat -> BuiltinCat -> [BuiltinCat]
BuiltinCat -> BuiltinCat -> BuiltinCat -> [BuiltinCat]
(BuiltinCat -> BuiltinCat)
-> (BuiltinCat -> BuiltinCat)
-> (Int -> BuiltinCat)
-> (BuiltinCat -> Int)
-> (BuiltinCat -> [BuiltinCat])
-> (BuiltinCat -> BuiltinCat -> [BuiltinCat])
-> (BuiltinCat -> BuiltinCat -> [BuiltinCat])
-> (BuiltinCat -> BuiltinCat -> BuiltinCat -> [BuiltinCat])
-> Enum BuiltinCat
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BuiltinCat -> BuiltinCat -> BuiltinCat -> [BuiltinCat]
$cenumFromThenTo :: BuiltinCat -> BuiltinCat -> BuiltinCat -> [BuiltinCat]
enumFromTo :: BuiltinCat -> BuiltinCat -> [BuiltinCat]
$cenumFromTo :: BuiltinCat -> BuiltinCat -> [BuiltinCat]
enumFromThen :: BuiltinCat -> BuiltinCat -> [BuiltinCat]
$cenumFromThen :: BuiltinCat -> BuiltinCat -> [BuiltinCat]
enumFrom :: BuiltinCat -> [BuiltinCat]
$cenumFrom :: BuiltinCat -> [BuiltinCat]
fromEnum :: BuiltinCat -> Int
$cfromEnum :: BuiltinCat -> Int
toEnum :: Int -> BuiltinCat
$ctoEnum :: Int -> BuiltinCat
pred :: BuiltinCat -> BuiltinCat
$cpred :: BuiltinCat -> BuiltinCat
succ :: BuiltinCat -> BuiltinCat
$csucc :: BuiltinCat -> BuiltinCat
Enum)

-- | Built-in token Ident, treated as a string.

data IdentCat = BIdent -- ^ @Ident@
  deriving(IdentCat -> IdentCat -> Bool
(IdentCat -> IdentCat -> Bool)
-> (IdentCat -> IdentCat -> Bool) -> Eq IdentCat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdentCat -> IdentCat -> Bool
$c/= :: IdentCat -> IdentCat -> Bool
== :: IdentCat -> IdentCat -> Bool
$c== :: IdentCat -> IdentCat -> Bool
Eq, Eq IdentCat
Eq IdentCat
-> (IdentCat -> IdentCat -> Ordering)
-> (IdentCat -> IdentCat -> Bool)
-> (IdentCat -> IdentCat -> Bool)
-> (IdentCat -> IdentCat -> Bool)
-> (IdentCat -> IdentCat -> Bool)
-> (IdentCat -> IdentCat -> IdentCat)
-> (IdentCat -> IdentCat -> IdentCat)
-> Ord IdentCat
IdentCat -> IdentCat -> Bool
IdentCat -> IdentCat -> Ordering
IdentCat -> IdentCat -> IdentCat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IdentCat -> IdentCat -> IdentCat
$cmin :: IdentCat -> IdentCat -> IdentCat
max :: IdentCat -> IdentCat -> IdentCat
$cmax :: IdentCat -> IdentCat -> IdentCat
>= :: IdentCat -> IdentCat -> Bool
$c>= :: IdentCat -> IdentCat -> Bool
> :: IdentCat -> IdentCat -> Bool
$c> :: IdentCat -> IdentCat -> Bool
<= :: IdentCat -> IdentCat -> Bool
$c<= :: IdentCat -> IdentCat -> Bool
< :: IdentCat -> IdentCat -> Bool
$c< :: IdentCat -> IdentCat -> Bool
compare :: IdentCat -> IdentCat -> Ordering
$ccompare :: IdentCat -> IdentCat -> Ordering
$cp1Ord :: Eq IdentCat
Ord, Int -> IdentCat -> ShowS
[IdentCat] -> ShowS
IdentCat -> String
(Int -> IdentCat -> ShowS)
-> (IdentCat -> String) -> ([IdentCat] -> ShowS) -> Show IdentCat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdentCat] -> ShowS
$cshowList :: [IdentCat] -> ShowS
show :: IdentCat -> String
$cshow :: IdentCat -> String
showsPrec :: Int -> IdentCat -> ShowS
$cshowsPrec :: Int -> IdentCat -> ShowS
Show)

-- * Types (categories in AST)
---------------------------------------------------------------------------

-- | Types are categories without the precedences ('CoerceCat').

data Type
  = BaseType BaseCat  -- ^ Base category.
  | ListType Type     -- ^ List category.
  deriving (Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Eq Type
Eq Type
-> (Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
$cp1Ord :: Eq Type
Ord, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show)

-- | Function type @t(t₁,...,tₙ)@ or @t₁ → ... → tₙ → t@.
data FunType = FunType
  { FunType -> Type
targetType :: Type    -- ^ Result type.
  , FunType -> [Type]
argTypes   :: [Type]  -- ^ Types of parameters, left to right.
  }
  deriving (FunType -> FunType -> Bool
(FunType -> FunType -> Bool)
-> (FunType -> FunType -> Bool) -> Eq FunType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunType -> FunType -> Bool
$c/= :: FunType -> FunType -> Bool
== :: FunType -> FunType -> Bool
$c== :: FunType -> FunType -> Bool
Eq, Int -> FunType -> ShowS
[FunType] -> ShowS
FunType -> String
(Int -> FunType -> ShowS)
-> (FunType -> String) -> ([FunType] -> ShowS) -> Show FunType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunType] -> ShowS
$cshowList :: [FunType] -> ShowS
show :: FunType -> String
$cshow :: FunType -> String
showsPrec :: Int -> FunType -> ShowS
$cshowsPrec :: Int -> FunType -> ShowS
Show)

-- * Expressions (for defined constructors)
---------------------------------------------------------------------------

-- | Bodies of 'A.Function'.
--   For convenience, these are fully typed.

data Exp
  = App Label FunType [Exp]
      -- ^ (Possibly defined) label with its type
      --   applied to the correct number of expressions.
  | Var Parameter
      -- ^ Use of function parameter.
  | LitInteger Integer
  | LitDouble  Double
  | LitChar    Char
  | LitString  String
  deriving (Int -> Exp -> ShowS
[Exp] -> ShowS
Exp -> String
(Int -> Exp -> ShowS)
-> (Exp -> String) -> ([Exp] -> ShowS) -> Show Exp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exp] -> ShowS
$cshowList :: [Exp] -> ShowS
show :: Exp -> String
$cshow :: Exp -> String
showsPrec :: Int -> Exp -> ShowS
$cshowsPrec :: Int -> Exp -> ShowS
Show)

-- | Bound variable.

data Parameter = Parameter
  { Parameter -> List1 Char
paramName :: VarName
  , Parameter -> Type
paramType :: Type
  }
  deriving (Int -> Parameter -> ShowS
[Parameter] -> ShowS
Parameter -> String
(Int -> Parameter -> ShowS)
-> (Parameter -> String)
-> ([Parameter] -> ShowS)
-> Show Parameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parameter] -> ShowS
$cshowList :: [Parameter] -> ShowS
show :: Parameter -> String
$cshow :: Parameter -> String
showsPrec :: Int -> Parameter -> ShowS
$cshowsPrec :: Int -> Parameter -> ShowS
Show)

type VarName = String1

-- | Definition body of a constructor.

data Function = Function
  { Function -> [Parameter]
funPars :: [Parameter]
  , Function -> Exp
funBody :: Exp
  , Function -> Type
funType :: Type
  }
  deriving (Int -> Function -> ShowS
[Function] -> ShowS
Function -> String
(Int -> Function -> ShowS)
-> (Function -> String) -> ([Function] -> ShowS) -> Show Function
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Function] -> ShowS
$cshowList :: [Function] -> ShowS
show :: Function -> String
$cshow :: Function -> String
showsPrec :: Int -> Function -> ShowS
$cshowsPrec :: Int -> Function -> ShowS
Show)

-- * Labels
---------------------------------------------------------------------------

-- | Label names are nonempty strings.

type LabelName = String1

-- | LBNF rule label (AST constructor).

-- the constructors order is important as it will determine
-- the order labels are matched in pattern match.
-- (e.g. if LCons appears before LSg it would catch all cases
-- that would belong to LCons)
data Label
  = LId LabelName  -- ^ ordinary rule label (uppercase)
  | LDef LabelName -- ^ defined label (lowercase)
  -- No representation in AST:
  | LWild          -- ^ coercion @_@
  -- List labels, mapped to the list constructors of the target language.
  | LNil           -- ^ empty list @[]@
  | LSg            -- ^ singleton list @(:[])@ ("robot gorilla")
  | LCons          -- ^ list constructor @(:)@
  deriving (Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq, Eq Label
Eq Label
-> (Label -> Label -> Ordering)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Label)
-> (Label -> Label -> Label)
-> Ord Label
Label -> Label -> Bool
Label -> Label -> Ordering
Label -> Label -> Label
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmax :: Label -> Label -> Label
>= :: Label -> Label -> Bool
$c>= :: Label -> Label -> Bool
> :: Label -> Label -> Bool
$c> :: Label -> Label -> Bool
<= :: Label -> Label -> Bool
$c<= :: Label -> Label -> Bool
< :: Label -> Label -> Bool
$c< :: Label -> Label -> Bool
compare :: Label -> Label -> Ordering
$ccompare :: Label -> Label -> Ordering
$cp1Ord :: Eq Label
Ord, Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
(Int -> Label -> ShowS)
-> (Label -> String) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
Show)

-- * Rule definition
---------------------------------------------------------------------------

-- | Element of a rule right hand side (rhs).

data Item' a
  = Terminal a
      -- ^ Keyword or symbol (not represented in AST).
  | NTerminal Cat
      -- ^ Category (represented in AST).
  deriving (Item' a -> Item' a -> Bool
(Item' a -> Item' a -> Bool)
-> (Item' a -> Item' a -> Bool) -> Eq (Item' a)
forall a. Eq a => Item' a -> Item' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Item' a -> Item' a -> Bool
$c/= :: forall a. Eq a => Item' a -> Item' a -> Bool
== :: Item' a -> Item' a -> Bool
$c== :: forall a. Eq a => Item' a -> Item' a -> Bool
Eq, Eq (Item' a)
Eq (Item' a)
-> (Item' a -> Item' a -> Ordering)
-> (Item' a -> Item' a -> Bool)
-> (Item' a -> Item' a -> Bool)
-> (Item' a -> Item' a -> Bool)
-> (Item' a -> Item' a -> Bool)
-> (Item' a -> Item' a -> Item' a)
-> (Item' a -> Item' a -> Item' a)
-> Ord (Item' a)
Item' a -> Item' a -> Bool
Item' a -> Item' a -> Ordering
Item' a -> Item' a -> Item' a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Item' a)
forall a. Ord a => Item' a -> Item' a -> Bool
forall a. Ord a => Item' a -> Item' a -> Ordering
forall a. Ord a => Item' a -> Item' a -> Item' a
min :: Item' a -> Item' a -> Item' a
$cmin :: forall a. Ord a => Item' a -> Item' a -> Item' a
max :: Item' a -> Item' a -> Item' a
$cmax :: forall a. Ord a => Item' a -> Item' a -> Item' a
>= :: Item' a -> Item' a -> Bool
$c>= :: forall a. Ord a => Item' a -> Item' a -> Bool
> :: Item' a -> Item' a -> Bool
$c> :: forall a. Ord a => Item' a -> Item' a -> Bool
<= :: Item' a -> Item' a -> Bool
$c<= :: forall a. Ord a => Item' a -> Item' a -> Bool
< :: Item' a -> Item' a -> Bool
$c< :: forall a. Ord a => Item' a -> Item' a -> Bool
compare :: Item' a -> Item' a -> Ordering
$ccompare :: forall a. Ord a => Item' a -> Item' a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Item' a)
Ord, Int -> Item' a -> ShowS
[Item' a] -> ShowS
Item' a -> String
(Int -> Item' a -> ShowS)
-> (Item' a -> String) -> ([Item' a] -> ShowS) -> Show (Item' a)
forall a. Show a => Int -> Item' a -> ShowS
forall a. Show a => [Item' a] -> ShowS
forall a. Show a => Item' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item' a] -> ShowS
$cshowList :: forall a. Show a => [Item' a] -> ShowS
show :: Item' a -> String
$cshow :: forall a. Show a => Item' a -> String
showsPrec :: Int -> Item' a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Item' a -> ShowS
Show, a -> Item' b -> Item' a
(a -> b) -> Item' a -> Item' b
(forall a b. (a -> b) -> Item' a -> Item' b)
-> (forall a b. a -> Item' b -> Item' a) -> Functor Item'
forall a b. a -> Item' b -> Item' a
forall a b. (a -> b) -> Item' a -> Item' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Item' b -> Item' a
$c<$ :: forall a b. a -> Item' b -> Item' a
fmap :: (a -> b) -> Item' a -> Item' b
$cfmap :: forall a b. (a -> b) -> Item' a -> Item' b
Functor, Item' a -> Bool
(a -> m) -> Item' a -> m
(a -> b -> b) -> b -> Item' a -> b
(forall m. Monoid m => Item' m -> m)
-> (forall m a. Monoid m => (a -> m) -> Item' a -> m)
-> (forall m a. Monoid m => (a -> m) -> Item' a -> m)
-> (forall a b. (a -> b -> b) -> b -> Item' a -> b)
-> (forall a b. (a -> b -> b) -> b -> Item' a -> b)
-> (forall b a. (b -> a -> b) -> b -> Item' a -> b)
-> (forall b a. (b -> a -> b) -> b -> Item' a -> b)
-> (forall a. (a -> a -> a) -> Item' a -> a)
-> (forall a. (a -> a -> a) -> Item' a -> a)
-> (forall a. Item' a -> [a])
-> (forall a. Item' a -> Bool)
-> (forall a. Item' a -> Int)
-> (forall a. Eq a => a -> Item' a -> Bool)
-> (forall a. Ord a => Item' a -> a)
-> (forall a. Ord a => Item' a -> a)
-> (forall a. Num a => Item' a -> a)
-> (forall a. Num a => Item' a -> a)
-> Foldable Item'
forall a. Eq a => a -> Item' a -> Bool
forall a. Num a => Item' a -> a
forall a. Ord a => Item' a -> a
forall m. Monoid m => Item' m -> m
forall a. Item' a -> Bool
forall a. Item' a -> Int
forall a. Item' a -> [a]
forall a. (a -> a -> a) -> Item' a -> a
forall m a. Monoid m => (a -> m) -> Item' a -> m
forall b a. (b -> a -> b) -> b -> Item' a -> b
forall a b. (a -> b -> b) -> b -> Item' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Item' a -> a
$cproduct :: forall a. Num a => Item' a -> a
sum :: Item' a -> a
$csum :: forall a. Num a => Item' a -> a
minimum :: Item' a -> a
$cminimum :: forall a. Ord a => Item' a -> a
maximum :: Item' a -> a
$cmaximum :: forall a. Ord a => Item' a -> a
elem :: a -> Item' a -> Bool
$celem :: forall a. Eq a => a -> Item' a -> Bool
length :: Item' a -> Int
$clength :: forall a. Item' a -> Int
null :: Item' a -> Bool
$cnull :: forall a. Item' a -> Bool
toList :: Item' a -> [a]
$ctoList :: forall a. Item' a -> [a]
foldl1 :: (a -> a -> a) -> Item' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Item' a -> a
foldr1 :: (a -> a -> a) -> Item' a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Item' a -> a
foldl' :: (b -> a -> b) -> b -> Item' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Item' a -> b
foldl :: (b -> a -> b) -> b -> Item' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Item' a -> b
foldr' :: (a -> b -> b) -> b -> Item' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Item' a -> b
foldr :: (a -> b -> b) -> b -> Item' a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Item' a -> b
foldMap' :: (a -> m) -> Item' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Item' a -> m
foldMap :: (a -> m) -> Item' a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Item' a -> m
fold :: Item' m -> m
$cfold :: forall m. Monoid m => Item' m -> m
Foldable, Functor Item'
Foldable Item'
Functor Item'
-> Foldable Item'
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Item' a -> f (Item' b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Item' (f a) -> f (Item' a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Item' a -> m (Item' b))
-> (forall (m :: * -> *) a. Monad m => Item' (m a) -> m (Item' a))
-> Traversable Item'
(a -> f b) -> Item' a -> f (Item' b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Item' (m a) -> m (Item' a)
forall (f :: * -> *) a. Applicative f => Item' (f a) -> f (Item' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Item' a -> m (Item' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Item' a -> f (Item' b)
sequence :: Item' (m a) -> m (Item' a)
$csequence :: forall (m :: * -> *) a. Monad m => Item' (m a) -> m (Item' a)
mapM :: (a -> m b) -> Item' a -> m (Item' b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Item' a -> m (Item' b)
sequenceA :: Item' (f a) -> f (Item' a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Item' (f a) -> f (Item' a)
traverse :: (a -> f b) -> Item' a -> f (Item' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Item' a -> f (Item' b)
$cp2Traversable :: Foldable Item'
$cp1Traversable :: Functor Item'
Traversable)

type AItem = Item' String1  -- ^ AST/printer flavor.
type Item  = Item' Keyword  -- ^ Parser flavor.

-- | The bare rhs of a rule.

type RHS' a = [Item' a]

-- newtype RHS' a = RHS { theRHS :: [Item' a] }
--   deriving (Eq, Ord, Show, Functor, Foldable, Traversable)

type ARHS = RHS' String1
type RHS  = RHS' Keyword

-- -- | The rule (except lhs) with meta information.

-- data RuleBody = RuleBody
--   { ruleOrigin    :: RuleOrigin  -- ^ A rule can also originate from pragmas.
--   , ruleParseable :: Parseable   -- ^ @internal@ or parseable?
--   , ruleLabel     :: Label       -- ^ The name of the rule.
--   , ruleRHS       :: RHS         -- ^ Right hand side.
--   }
--   deriving (Eq, Show)

-- | The origin of a rule.

data RuleOrigin
  = FromOrdinary   -- ^ Ordinary LBNF rule.
  | FromRules      -- ^ Expanded from @rules@ pragma.
  | FromCoercions  -- ^ Expanded from @coercions@ pragma.
  | FromList       -- ^ Expanded from list pragma: @separator@ or @terminator@.
  deriving (RuleOrigin -> RuleOrigin -> Bool
(RuleOrigin -> RuleOrigin -> Bool)
-> (RuleOrigin -> RuleOrigin -> Bool) -> Eq RuleOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuleOrigin -> RuleOrigin -> Bool
$c/= :: RuleOrigin -> RuleOrigin -> Bool
== :: RuleOrigin -> RuleOrigin -> Bool
$c== :: RuleOrigin -> RuleOrigin -> Bool
Eq, Eq RuleOrigin
Eq RuleOrigin
-> (RuleOrigin -> RuleOrigin -> Ordering)
-> (RuleOrigin -> RuleOrigin -> Bool)
-> (RuleOrigin -> RuleOrigin -> Bool)
-> (RuleOrigin -> RuleOrigin -> Bool)
-> (RuleOrigin -> RuleOrigin -> Bool)
-> (RuleOrigin -> RuleOrigin -> RuleOrigin)
-> (RuleOrigin -> RuleOrigin -> RuleOrigin)
-> Ord RuleOrigin
RuleOrigin -> RuleOrigin -> Bool
RuleOrigin -> RuleOrigin -> Ordering
RuleOrigin -> RuleOrigin -> RuleOrigin
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RuleOrigin -> RuleOrigin -> RuleOrigin
$cmin :: RuleOrigin -> RuleOrigin -> RuleOrigin
max :: RuleOrigin -> RuleOrigin -> RuleOrigin
$cmax :: RuleOrigin -> RuleOrigin -> RuleOrigin
>= :: RuleOrigin -> RuleOrigin -> Bool
$c>= :: RuleOrigin -> RuleOrigin -> Bool
> :: RuleOrigin -> RuleOrigin -> Bool
$c> :: RuleOrigin -> RuleOrigin -> Bool
<= :: RuleOrigin -> RuleOrigin -> Bool
$c<= :: RuleOrigin -> RuleOrigin -> Bool
< :: RuleOrigin -> RuleOrigin -> Bool
$c< :: RuleOrigin -> RuleOrigin -> Bool
compare :: RuleOrigin -> RuleOrigin -> Ordering
$ccompare :: RuleOrigin -> RuleOrigin -> Ordering
$cp1Ord :: Eq RuleOrigin
Ord, Int -> RuleOrigin -> ShowS
[RuleOrigin] -> ShowS
RuleOrigin -> String
(Int -> RuleOrigin -> ShowS)
-> (RuleOrigin -> String)
-> ([RuleOrigin] -> ShowS)
-> Show RuleOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuleOrigin] -> ShowS
$cshowList :: [RuleOrigin] -> ShowS
show :: RuleOrigin -> String
$cshow :: RuleOrigin -> String
showsPrec :: Int -> RuleOrigin -> ShowS
$cshowsPrec :: Int -> RuleOrigin -> ShowS
Show)

-- | The AST-flavor representation of the rule rhs with meta information.

data ARuleRHS = ARuleRHS
  { ARuleRHS -> RuleOrigin
aruleOrigin    :: RuleOrigin  -- ^ A rule can also originate from pragmas.
  , ARuleRHS -> Parseable
aruleParseable :: Parseable   -- ^ @internal@ or parseable?
  , ARuleRHS -> ARHS
aruleRHS       :: ARHS        -- ^ Right hand side.
  }
  deriving (ARuleRHS -> ARuleRHS -> Bool
(ARuleRHS -> ARuleRHS -> Bool)
-> (ARuleRHS -> ARuleRHS -> Bool) -> Eq ARuleRHS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ARuleRHS -> ARuleRHS -> Bool
$c/= :: ARuleRHS -> ARuleRHS -> Bool
== :: ARuleRHS -> ARuleRHS -> Bool
$c== :: ARuleRHS -> ARuleRHS -> Bool
Eq, Int -> ARuleRHS -> ShowS
[ARuleRHS] -> ShowS
ARuleRHS -> String
(Int -> ARuleRHS -> ShowS)
-> (ARuleRHS -> String) -> ([ARuleRHS] -> ShowS) -> Show ARuleRHS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ARuleRHS] -> ShowS
$cshowList :: [ARuleRHS] -> ShowS
show :: ARuleRHS -> String
$cshow :: ARuleRHS -> String
showsPrec :: Int -> ARuleRHS -> ShowS
$cshowsPrec :: Int -> ARuleRHS -> ShowS
Show)

-- | The parser-flavor representation of the rule label with meta information.

data RuleLabel = RuleLabel
  { RuleLabel -> RuleOrigin
ruleOrigin    :: RuleOrigin  -- ^ A rule can also originate from pragmas.
  , RuleLabel -> Label
ruleLabel     :: Label       -- ^ The name of the rule.
  }
  deriving (RuleLabel -> RuleLabel -> Bool
(RuleLabel -> RuleLabel -> Bool)
-> (RuleLabel -> RuleLabel -> Bool) -> Eq RuleLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuleLabel -> RuleLabel -> Bool
$c/= :: RuleLabel -> RuleLabel -> Bool
== :: RuleLabel -> RuleLabel -> Bool
$c== :: RuleLabel -> RuleLabel -> Bool
Eq, Int -> RuleLabel -> ShowS
[RuleLabel] -> ShowS
RuleLabel -> String
(Int -> RuleLabel -> ShowS)
-> (RuleLabel -> String)
-> ([RuleLabel] -> ShowS)
-> Show RuleLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuleLabel] -> ShowS
$cshowList :: [RuleLabel] -> ShowS
show :: RuleLabel -> String
$cshow :: RuleLabel -> String
showsPrec :: Int -> RuleLabel -> ShowS
$cshowsPrec :: Int -> RuleLabel -> ShowS
Show)

-- * List pragmas
---------------------------------------------------------------------------

data Separator' a
  = Separator a
      -- ^ E.g. @separator _ ","@.
  | Terminator a
      -- ^ E.g. @terminator _ ";"@.
  -- The last case is better represented as @Nothing@.
  -- -- | NoSeparator
  -- --     -- ^ E.g. @separator _ ""@ or @terminator _ ""@.
  deriving (Separator' a -> Separator' a -> Bool
(Separator' a -> Separator' a -> Bool)
-> (Separator' a -> Separator' a -> Bool) -> Eq (Separator' a)
forall a. Eq a => Separator' a -> Separator' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Separator' a -> Separator' a -> Bool
$c/= :: forall a. Eq a => Separator' a -> Separator' a -> Bool
== :: Separator' a -> Separator' a -> Bool
$c== :: forall a. Eq a => Separator' a -> Separator' a -> Bool
Eq, Eq (Separator' a)
Eq (Separator' a)
-> (Separator' a -> Separator' a -> Ordering)
-> (Separator' a -> Separator' a -> Bool)
-> (Separator' a -> Separator' a -> Bool)
-> (Separator' a -> Separator' a -> Bool)
-> (Separator' a -> Separator' a -> Bool)
-> (Separator' a -> Separator' a -> Separator' a)
-> (Separator' a -> Separator' a -> Separator' a)
-> Ord (Separator' a)
Separator' a -> Separator' a -> Bool
Separator' a -> Separator' a -> Ordering
Separator' a -> Separator' a -> Separator' a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Separator' a)
forall a. Ord a => Separator' a -> Separator' a -> Bool
forall a. Ord a => Separator' a -> Separator' a -> Ordering
forall a. Ord a => Separator' a -> Separator' a -> Separator' a
min :: Separator' a -> Separator' a -> Separator' a
$cmin :: forall a. Ord a => Separator' a -> Separator' a -> Separator' a
max :: Separator' a -> Separator' a -> Separator' a
$cmax :: forall a. Ord a => Separator' a -> Separator' a -> Separator' a
>= :: Separator' a -> Separator' a -> Bool
$c>= :: forall a. Ord a => Separator' a -> Separator' a -> Bool
> :: Separator' a -> Separator' a -> Bool
$c> :: forall a. Ord a => Separator' a -> Separator' a -> Bool
<= :: Separator' a -> Separator' a -> Bool
$c<= :: forall a. Ord a => Separator' a -> Separator' a -> Bool
< :: Separator' a -> Separator' a -> Bool
$c< :: forall a. Ord a => Separator' a -> Separator' a -> Bool
compare :: Separator' a -> Separator' a -> Ordering
$ccompare :: forall a. Ord a => Separator' a -> Separator' a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Separator' a)
Ord, Int -> Separator' a -> ShowS
[Separator' a] -> ShowS
Separator' a -> String
(Int -> Separator' a -> ShowS)
-> (Separator' a -> String)
-> ([Separator' a] -> ShowS)
-> Show (Separator' a)
forall a. Show a => Int -> Separator' a -> ShowS
forall a. Show a => [Separator' a] -> ShowS
forall a. Show a => Separator' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Separator' a] -> ShowS
$cshowList :: forall a. Show a => [Separator' a] -> ShowS
show :: Separator' a -> String
$cshow :: forall a. Show a => Separator' a -> String
showsPrec :: Int -> Separator' a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Separator' a -> ShowS
Show, a -> Separator' b -> Separator' a
(a -> b) -> Separator' a -> Separator' b
(forall a b. (a -> b) -> Separator' a -> Separator' b)
-> (forall a b. a -> Separator' b -> Separator' a)
-> Functor Separator'
forall a b. a -> Separator' b -> Separator' a
forall a b. (a -> b) -> Separator' a -> Separator' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Separator' b -> Separator' a
$c<$ :: forall a b. a -> Separator' b -> Separator' a
fmap :: (a -> b) -> Separator' a -> Separator' b
$cfmap :: forall a b. (a -> b) -> Separator' a -> Separator' b
Functor, Separator' a -> Bool
(a -> m) -> Separator' a -> m
(a -> b -> b) -> b -> Separator' a -> b
(forall m. Monoid m => Separator' m -> m)
-> (forall m a. Monoid m => (a -> m) -> Separator' a -> m)
-> (forall m a. Monoid m => (a -> m) -> Separator' a -> m)
-> (forall a b. (a -> b -> b) -> b -> Separator' a -> b)
-> (forall a b. (a -> b -> b) -> b -> Separator' a -> b)
-> (forall b a. (b -> a -> b) -> b -> Separator' a -> b)
-> (forall b a. (b -> a -> b) -> b -> Separator' a -> b)
-> (forall a. (a -> a -> a) -> Separator' a -> a)
-> (forall a. (a -> a -> a) -> Separator' a -> a)
-> (forall a. Separator' a -> [a])
-> (forall a. Separator' a -> Bool)
-> (forall a. Separator' a -> Int)
-> (forall a. Eq a => a -> Separator' a -> Bool)
-> (forall a. Ord a => Separator' a -> a)
-> (forall a. Ord a => Separator' a -> a)
-> (forall a. Num a => Separator' a -> a)
-> (forall a. Num a => Separator' a -> a)
-> Foldable Separator'
forall a. Eq a => a -> Separator' a -> Bool
forall a. Num a => Separator' a -> a
forall a. Ord a => Separator' a -> a
forall m. Monoid m => Separator' m -> m
forall a. Separator' a -> Bool
forall a. Separator' a -> Int
forall a. Separator' a -> [a]
forall a. (a -> a -> a) -> Separator' a -> a
forall m a. Monoid m => (a -> m) -> Separator' a -> m
forall b a. (b -> a -> b) -> b -> Separator' a -> b
forall a b. (a -> b -> b) -> b -> Separator' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Separator' a -> a
$cproduct :: forall a. Num a => Separator' a -> a
sum :: Separator' a -> a
$csum :: forall a. Num a => Separator' a -> a
minimum :: Separator' a -> a
$cminimum :: forall a. Ord a => Separator' a -> a
maximum :: Separator' a -> a
$cmaximum :: forall a. Ord a => Separator' a -> a
elem :: a -> Separator' a -> Bool
$celem :: forall a. Eq a => a -> Separator' a -> Bool
length :: Separator' a -> Int
$clength :: forall a. Separator' a -> Int
null :: Separator' a -> Bool
$cnull :: forall a. Separator' a -> Bool
toList :: Separator' a -> [a]
$ctoList :: forall a. Separator' a -> [a]
foldl1 :: (a -> a -> a) -> Separator' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Separator' a -> a
foldr1 :: (a -> a -> a) -> Separator' a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Separator' a -> a
foldl' :: (b -> a -> b) -> b -> Separator' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Separator' a -> b
foldl :: (b -> a -> b) -> b -> Separator' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Separator' a -> b
foldr' :: (a -> b -> b) -> b -> Separator' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Separator' a -> b
foldr :: (a -> b -> b) -> b -> Separator' a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Separator' a -> b
foldMap' :: (a -> m) -> Separator' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Separator' a -> m
foldMap :: (a -> m) -> Separator' a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Separator' a -> m
fold :: Separator' m -> m
$cfold :: forall m. Monoid m => Separator' m -> m
Foldable, Functor Separator'
Foldable Separator'
Functor Separator'
-> Foldable Separator'
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Separator' a -> f (Separator' b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Separator' (f a) -> f (Separator' a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Separator' a -> m (Separator' b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Separator' (m a) -> m (Separator' a))
-> Traversable Separator'
(a -> f b) -> Separator' a -> f (Separator' b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Separator' (m a) -> m (Separator' a)
forall (f :: * -> *) a.
Applicative f =>
Separator' (f a) -> f (Separator' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Separator' a -> m (Separator' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Separator' a -> f (Separator' b)
sequence :: Separator' (m a) -> m (Separator' a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Separator' (m a) -> m (Separator' a)
mapM :: (a -> m b) -> Separator' a -> m (Separator' b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Separator' a -> m (Separator' b)
sequenceA :: Separator' (f a) -> f (Separator' a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Separator' (f a) -> f (Separator' a)
traverse :: (a -> f b) -> Separator' a -> f (Separator' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Separator' a -> f (Separator' b)
$cp2Traversable :: Foldable Separator'
$cp1Traversable :: Functor Separator'
Traversable)

type ASeparator = Separator' String1
type  Separator = Separator' Keyword

-- * Flags etc.
---------------------------------------------------------------------------

-- | Is a rule relevant for the parser or only for the AST/printer?

data Parseable
  = Internal   -- ^ @internal@ rule (only for AST & printer)
  | Parseable  -- ^ ordinary rule (also for parser)
  deriving (Parseable -> Parseable -> Bool
(Parseable -> Parseable -> Bool)
-> (Parseable -> Parseable -> Bool) -> Eq Parseable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parseable -> Parseable -> Bool
$c/= :: Parseable -> Parseable -> Bool
== :: Parseable -> Parseable -> Bool
$c== :: Parseable -> Parseable -> Bool
Eq, Eq Parseable
Eq Parseable
-> (Parseable -> Parseable -> Ordering)
-> (Parseable -> Parseable -> Bool)
-> (Parseable -> Parseable -> Bool)
-> (Parseable -> Parseable -> Bool)
-> (Parseable -> Parseable -> Bool)
-> (Parseable -> Parseable -> Parseable)
-> (Parseable -> Parseable -> Parseable)
-> Ord Parseable
Parseable -> Parseable -> Bool
Parseable -> Parseable -> Ordering
Parseable -> Parseable -> Parseable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Parseable -> Parseable -> Parseable
$cmin :: Parseable -> Parseable -> Parseable
max :: Parseable -> Parseable -> Parseable
$cmax :: Parseable -> Parseable -> Parseable
>= :: Parseable -> Parseable -> Bool
$c>= :: Parseable -> Parseable -> Bool
> :: Parseable -> Parseable -> Bool
$c> :: Parseable -> Parseable -> Bool
<= :: Parseable -> Parseable -> Bool
$c<= :: Parseable -> Parseable -> Bool
< :: Parseable -> Parseable -> Bool
$c< :: Parseable -> Parseable -> Bool
compare :: Parseable -> Parseable -> Ordering
$ccompare :: Parseable -> Parseable -> Ordering
$cp1Ord :: Eq Parseable
Ord, Int -> Parseable -> ShowS
[Parseable] -> ShowS
Parseable -> String
(Int -> Parseable -> ShowS)
-> (Parseable -> String)
-> ([Parseable] -> ShowS)
-> Show Parseable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parseable] -> ShowS
$cshowList :: [Parseable] -> ShowS
show :: Parseable -> String
$cshow :: Parseable -> String
showsPrec :: Int -> Parseable -> ShowS
$cshowsPrec :: Int -> Parseable -> ShowS
Show)

-- | Does a token category carry position information?

data PositionToken
  = PositionToken     -- ^ from 'position token' pragma
  | NoPositionToken   -- ^ from ordinary 'token' pragma
  deriving (PositionToken -> PositionToken -> Bool
(PositionToken -> PositionToken -> Bool)
-> (PositionToken -> PositionToken -> Bool) -> Eq PositionToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositionToken -> PositionToken -> Bool
$c/= :: PositionToken -> PositionToken -> Bool
== :: PositionToken -> PositionToken -> Bool
$c== :: PositionToken -> PositionToken -> Bool
Eq, Eq PositionToken
Eq PositionToken
-> (PositionToken -> PositionToken -> Ordering)
-> (PositionToken -> PositionToken -> Bool)
-> (PositionToken -> PositionToken -> Bool)
-> (PositionToken -> PositionToken -> Bool)
-> (PositionToken -> PositionToken -> Bool)
-> (PositionToken -> PositionToken -> PositionToken)
-> (PositionToken -> PositionToken -> PositionToken)
-> Ord PositionToken
PositionToken -> PositionToken -> Bool
PositionToken -> PositionToken -> Ordering
PositionToken -> PositionToken -> PositionToken
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PositionToken -> PositionToken -> PositionToken
$cmin :: PositionToken -> PositionToken -> PositionToken
max :: PositionToken -> PositionToken -> PositionToken
$cmax :: PositionToken -> PositionToken -> PositionToken
>= :: PositionToken -> PositionToken -> Bool
$c>= :: PositionToken -> PositionToken -> Bool
> :: PositionToken -> PositionToken -> Bool
$c> :: PositionToken -> PositionToken -> Bool
<= :: PositionToken -> PositionToken -> Bool
$c<= :: PositionToken -> PositionToken -> Bool
< :: PositionToken -> PositionToken -> Bool
$c< :: PositionToken -> PositionToken -> Bool
compare :: PositionToken -> PositionToken -> Ordering
$ccompare :: PositionToken -> PositionToken -> Ordering
$cp1Ord :: Eq PositionToken
Ord, Int -> PositionToken -> ShowS
[PositionToken] -> ShowS
PositionToken -> String
(Int -> PositionToken -> ShowS)
-> (PositionToken -> String)
-> ([PositionToken] -> ShowS)
-> Show PositionToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PositionToken] -> ShowS
$cshowList :: [PositionToken] -> ShowS
show :: PositionToken -> String
$cshow :: PositionToken -> String
showsPrec :: Int -> PositionToken -> ShowS
$cshowsPrec :: Int -> PositionToken -> ShowS
Show)

makeLenses ''LBNF

---------------------------------------------------------------------------
-- * Utilities
---------------------------------------------------------------------------

-- ** Categories
---------------------------------------------------------------------------

-- | Convert 'Cat' to 'Type', converting 'CoerceCat' to 'BaseCat'.

catToType :: Cat -> Type
catToType :: Cat -> Type
catToType = \case
  Cat BaseCat
c         -> BaseCat -> Type
BaseType BaseCat
c
  ListCat Cat
c     -> Type -> Type
ListType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Cat -> Type
catToType Cat
c
  CoerceCat List1 Char
x Integer
_ -> BaseCat -> Type
BaseType (BaseCat -> Type) -> BaseCat -> Type
forall a b. (a -> b) -> a -> b
$ List1 Char -> BaseCat
BaseCat List1 Char
x

catToIdentifier :: Cat -> String1
catToIdentifier :: Cat -> List1 Char
catToIdentifier = \case
  Cat BaseCat
x         -> BaseCat -> List1 Char
baseCatToIdentifier BaseCat
x
  CoerceCat List1 Char
x Integer
n -> List1 Char -> String -> List1 Char
forall a. List1 a -> [a] -> List1 a
List1.appendList List1 Char
x (String -> List1 Char) -> String -> List1 Char
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
n
  ListCat Cat
c     -> List1 Char
"List" List1 Char -> List1 Char -> List1 Char
forall a. Semigroup a => a -> a -> a
<> Cat -> List1 Char
catToIdentifier Cat
c

baseCatToIdentifier :: BaseCat -> String1
baseCatToIdentifier :: BaseCat -> List1 Char
baseCatToIdentifier = \case
  BuiltinCat BuiltinCat
b -> BuiltinCat -> List1 Char
printBuiltinCat BuiltinCat
b
  IdentCat   IdentCat
i -> IdentCat -> List1 Char
printIdentCat IdentCat
i
  TokenCat   List1 Char
x -> List1 Char
x
  BaseCat    List1 Char
x -> List1 Char
x

-- | Print @CatName@ from @Cat@ in AST generator.

printCatName :: Cat -> String
printCatName :: Cat -> String
printCatName = \case
  Cat       BaseCat
b   -> BaseCat -> String
printBaseCatName BaseCat
b
  ListCat   Cat
c   -> Cat -> String
printCatName Cat
c
  CoerceCat List1 Char
c Integer
_ -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 Char
c

printCatNamePrec :: Cat -> String
printCatNamePrec :: Cat -> String
printCatNamePrec = \case
  Cat       BaseCat
b   -> BaseCat -> String
printBaseCatName BaseCat
b
  ListCat   Cat
c   -> Cat -> String
printCatNamePrec Cat
c
  CoerceCat List1 Char
c Integer
i -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 Char
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i

printCatNamePrec' :: Cat -> String
printCatNamePrec' :: Cat -> String
printCatNamePrec' = \case
  Cat       BaseCat
b   -> BaseCat -> String
printBaseCatName BaseCat
b
  ListCat   Cat
c   -> String
"List" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Cat -> String
printCatNamePrec' Cat
c
  CoerceCat List1 Char
c Integer
i -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 Char
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i

catToString :: Cat -> String
catToString :: Cat -> String
catToString = \case
  Cat       BaseCat
b   -> BaseCat -> String
printBaseCatName BaseCat
b
  ListCat   Cat
c   -> Cat -> String
printCatName Cat
c
  CoerceCat List1 Char
c Integer
i -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 Char
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i

printBaseCatName :: BaseCat -> String
printBaseCatName :: BaseCat -> String
printBaseCatName = \case
  BuiltinCat BuiltinCat
b -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (List1 Char -> String) -> List1 Char -> String
forall a b. (a -> b) -> a -> b
$ BuiltinCat -> List1 Char
printBuiltinCat BuiltinCat
b
  IdentCat   IdentCat
i -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (List1 Char -> String) -> List1 Char -> String
forall a b. (a -> b) -> a -> b
$ IdentCat -> List1 Char
printIdentCat IdentCat
i
  TokenCat   List1 Char
c -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 Char
c
  BaseCat    List1 Char
c -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 Char
c

-- | is @Cat@ coerced?

isCatCoerced :: Cat -> Bool
isCatCoerced :: Cat -> Bool
isCatCoerced = \case
  (Cat BaseCat
_)         -> Bool
False
  (ListCat Cat
_)     -> Bool
False
  (CoerceCat List1 Char
_ Integer
_) -> Bool
True

-- | is @Cat@ list category?

isCatList :: Cat -> Bool
isCatList :: Cat -> Bool
isCatList = \case
  (Cat BaseCat
_)         -> Bool
False
  (ListCat Cat
_)     -> Bool
True
  (CoerceCat List1 Char
_ Integer
_) -> Bool
False

-- | is @Cat@ between used builtins.

isCatBuiltin :: Cat -> Bool
isCatBuiltin :: Cat -> Bool
isCatBuiltin = \case
  (Cat BaseCat
bcat)         -> case BaseCat
bcat of
    BuiltinCat BuiltinCat
_ -> Bool
True
    IdentCat IdentCat
_   -> Bool
False
    TokenCat List1 Char
_   -> Bool
False
    BaseCat List1 Char
_    -> Bool
False
  (ListCat Cat
c)     -> Cat -> Bool
isCatBuiltin Cat
c
  (CoerceCat List1 Char
_ Integer
_) -> Bool
False


-- | get @Cat@ coercion number, returns 0 if @Cat@ is not coerced.

getCatPrec :: Cat -> Integer
getCatPrec :: Cat -> Integer
getCatPrec = \case
  (Cat BaseCat
_)         -> Integer
0
  (ListCat Cat
c)     -> Cat -> Integer
getCatPrec Cat
c
  (CoerceCat List1 Char
_ Integer
i) -> Integer
i

-- | When given a list Cat, i.e. '[C]', it removes the square
-- brackets, and adds the prefix List, i.e. 'ListC'.  (for Happy and
-- Latex)
identCat :: Cat -> String
identCat :: Cat -> String
identCat c :: Cat
c@(Cat BaseCat
_) = Cat -> String
catToString Cat
c
identCat (ListCat Cat
c) = String
"List" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Cat -> String
identCat Cat
c
identCat c :: Cat
c@(CoerceCat List1 Char
_ Integer
_) = Cat -> String
catToString Cat
c

-- Is a @BaseCat@ a builtin category.
isBuiltin :: BaseCat -> Bool
isBuiltin :: BaseCat -> Bool
isBuiltin = \case
  BuiltinCat BuiltinCat
_ -> Bool
True
  IdentCat   IdentCat
_ -> Bool
False
  TokenCat   List1 Char
_ -> Bool
False
  BaseCat    List1 Char
_ -> Bool
False

-- Is a @BaseCat@ an identifier.
isIdentifier :: BaseCat -> Bool
isIdentifier :: BaseCat -> Bool
isIdentifier = \case
  BuiltinCat BuiltinCat
_ -> Bool
False
  IdentCat   IdentCat
_ -> Bool
True
  TokenCat   List1 Char
_ -> Bool
False
  BaseCat    List1 Char
_ -> Bool
False

-- Is a @BaseCat@ a token category.
isToken :: BaseCat -> Bool
isToken :: BaseCat -> Bool
isToken = \case
  BuiltinCat BuiltinCat
_ -> Bool
False
  IdentCat   IdentCat
_ -> Bool
False
  TokenCat   List1 Char
_ -> Bool
True
  BaseCat    List1 Char
_ -> Bool
False

-- ** Builtin categories
---------------------------------------------------------------------------

builtinCats :: [(BuiltinCat, String1)]
builtinCats :: [(BuiltinCat, List1 Char)]
builtinCats = (BuiltinCat -> (BuiltinCat, List1 Char))
-> [BuiltinCat] -> [(BuiltinCat, List1 Char)]
forall a b. (a -> b) -> [a] -> [b]
map (\ BuiltinCat
b -> (BuiltinCat
b, BuiltinCat -> List1 Char
printBuiltinCat BuiltinCat
b)) [BuiltinCat
forall a. Bounded a => a
minBound..BuiltinCat
forall a. Bounded a => a
maxBound]

printBuiltinCat :: BuiltinCat -> String1
printBuiltinCat :: BuiltinCat -> List1 Char
printBuiltinCat = \case
  BuiltinCat
BChar    -> List1 Char
"Char"
  BuiltinCat
BDouble  -> List1 Char
"Double"
  BuiltinCat
BInteger -> List1 Char
"Integer"
  BuiltinCat
BString  -> List1 Char
"String"

printIdentCat :: IdentCat -> String1
printIdentCat :: IdentCat -> List1 Char
printIdentCat IdentCat
BIdent = List1 Char
"Ident"

parseBuiltinCat :: String1 -> Maybe (Either IdentCat BuiltinCat)
parseBuiltinCat :: List1 Char -> Maybe (Either IdentCat BuiltinCat)
parseBuiltinCat = (List1 Char
-> Map (List1 Char) (Either IdentCat BuiltinCat)
-> Maybe (Either IdentCat BuiltinCat)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map (List1 Char) (Either IdentCat BuiltinCat)
dict)
  where
  dict :: Map String1 (Either IdentCat BuiltinCat)
  dict :: Map (List1 Char) (Either IdentCat BuiltinCat)
dict = [(List1 Char, Either IdentCat BuiltinCat)]
-> Map (List1 Char) (Either IdentCat BuiltinCat)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(List1 Char, Either IdentCat BuiltinCat)]
 -> Map (List1 Char) (Either IdentCat BuiltinCat))
-> [(List1 Char, Either IdentCat BuiltinCat)]
-> Map (List1 Char) (Either IdentCat BuiltinCat)
forall a b. (a -> b) -> a -> b
$ ((Either IdentCat BuiltinCat, List1 Char)
 -> (List1 Char, Either IdentCat BuiltinCat))
-> [(Either IdentCat BuiltinCat, List1 Char)]
-> [(List1 Char, Either IdentCat BuiltinCat)]
forall a b. (a -> b) -> [a] -> [b]
map (Either IdentCat BuiltinCat, List1 Char)
-> (List1 Char, Either IdentCat BuiltinCat)
forall a b. (a, b) -> (b, a)
swap [(Either IdentCat BuiltinCat, List1 Char)]
identBuiltinCats

identBuiltinCats :: [(Either IdentCat BuiltinCat, String1)]
identBuiltinCats :: [(Either IdentCat BuiltinCat, List1 Char)]
identBuiltinCats =
  [ (BuiltinCat -> Either IdentCat BuiltinCat
forall a b. b -> Either a b
Right BuiltinCat
BChar,    List1 Char
"Char")
  , (BuiltinCat -> Either IdentCat BuiltinCat
forall a b. b -> Either a b
Right BuiltinCat
BDouble,  List1 Char
"Double")
  , (BuiltinCat -> Either IdentCat BuiltinCat
forall a b. b -> Either a b
Right BuiltinCat
BInteger, List1 Char
"Integer")
  , (BuiltinCat -> Either IdentCat BuiltinCat
forall a b. b -> Either a b
Right BuiltinCat
BString,  List1 Char
"String")
  , (IdentCat -> Either IdentCat BuiltinCat
forall a b. a -> Either a b
Left  IdentCat
BIdent,   List1 Char
"Ident") ]

tChar, tDouble, tInteger, tString :: Type
tChar :: Type
tChar    = BaseCat -> Type
BaseType (BaseCat -> Type) -> BaseCat -> Type
forall a b. (a -> b) -> a -> b
$ BuiltinCat -> BaseCat
BuiltinCat BuiltinCat
BChar
tDouble :: Type
tDouble  = BaseCat -> Type
BaseType (BaseCat -> Type) -> BaseCat -> Type
forall a b. (a -> b) -> a -> b
$ BuiltinCat -> BaseCat
BuiltinCat BuiltinCat
BDouble
tInteger :: Type
tInteger = BaseCat -> Type
BaseType (BaseCat -> Type) -> BaseCat -> Type
forall a b. (a -> b) -> a -> b
$ BuiltinCat -> BaseCat
BuiltinCat BuiltinCat
BInteger
tString :: Type
tString  = BaseCat -> Type
BaseType (BaseCat -> Type) -> BaseCat -> Type
forall a b. (a -> b) -> a -> b
$ BuiltinCat -> BaseCat
BuiltinCat BuiltinCat
BString

-- ** Types
---------------------------------------------------------------------------

printTypeName :: Type -> String
printTypeName :: Type -> String
printTypeName (BaseType BaseCat
b) = BaseCat -> String
printBaseCatName BaseCat
b
printTypeName (ListType Type
t) = Type -> String
printTypeName Type
t

-- | When given a list Type, i.e. '[C]', it removes the square
-- brackets, and adds the prefix List, i.e. 'ListC'.  (for Happy and
-- Latex)
identType :: Type -> String
identType :: Type -> String
identType (BaseType BaseCat
b) = BaseCat -> String
printBaseCatName BaseCat
b
identType (ListType Type
t) = String
"List" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
identType Type
t

isListType :: Type -> Bool
isListType :: Type -> Bool
isListType (BaseType BaseCat
_) = Bool
False
isListType (ListType Type
_) = Bool
True

isBuiltinType :: Type -> Bool
isBuiltinType :: Type -> Bool
isBuiltinType (BaseType BaseCat
b) = BaseCat -> Bool
isBuiltin BaseCat
b
isBuiltinType (ListType Type
t) = Type -> Bool
isBuiltinType Type
t

isIdentType :: Type -> Bool
isIdentType :: Type -> Bool
isIdentType (BaseType BaseCat
b) = BaseCat -> Bool
isIdentifier BaseCat
b
isIdentType (ListType Type
t) = Type -> Bool
isIdentType Type
t

isTokenType :: Type -> Bool
isTokenType :: Type -> Bool
isTokenType (BaseType BaseCat
b) = BaseCat -> Bool
isToken BaseCat
b
isTokenType (ListType Type
t) = Type -> Bool
isTokenType Type
t

-- ** Labels
---------------------------------------------------------------------------

labelFromIdentifier :: LabelName -> Label
labelFromIdentifier :: List1 Char -> Label
labelFromIdentifier List1 Char
x
  | Char -> Bool
isLower Char
c = List1 Char -> Label
LDef List1 Char
x
  | Char -> Bool
isUpper Char
c = List1 Char -> Label
LId  List1 Char
x
  | Bool
otherwise = String -> Label
forall a. HasCallStack => String -> a
panic String
"label has to start with letter"
  where
  c :: Char
c = List1 Char -> Char
forall a. NonEmpty a -> a
List1.head List1 Char
x

-- | Print @Label@ name.
printLabelName :: Label -> String
printLabelName :: Label -> String
printLabelName = \case
  LId  List1 Char
lname -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 Char
lname
  LDef List1 Char
lname -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 Char
lname
  Label
LWild      -> String
forall a. a
panicName
  Label
LNil       -> String
forall a. a
panicName
  Label
LCons      -> String
forall a. a
panicName
  Label
LSg        -> String
forall a. a
panicName
  where
    panicName :: a
panicName = String -> a
forall a. HasCallStack => String -> a
panic String
"trying to print name from label with no name"

-- Print parser rule name.
printRuleName :: Label -> String
printRuleName :: Label -> String
printRuleName = \case
  LId  List1 Char
lname -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 Char
lname
  LDef List1 Char
lname -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 Char
lname
  Label
LWild      -> String
"_"
  Label
LNil       -> String
"[]"
  Label
LCons      -> String
"(:)"
  Label
LSg        -> String
"(:[])"

isDef :: Label -> Bool
isDef :: Label -> Bool
isDef = \case
  LId  List1 Char
_ -> Bool
False
  LDef List1 Char
_ -> Bool
True
  Label
LWild  -> Bool
False
  Label
LNil   -> Bool
False
  Label
LCons  -> Bool
False
  Label
LSg    -> Bool
False

isCoercion :: Label -> Bool
isCoercion :: Label -> Bool
isCoercion = \case
  LId  List1 Char
_ -> Bool
False
  LDef List1 Char
_ -> Bool
False
  Label
LWild  -> Bool
True
  Label
LNil   -> Bool
False
  Label
LCons  -> Bool
False
  Label
LSg    -> Bool
False

isList :: Label -> Bool
isList :: Label -> Bool
isList = \case
  LId  List1 Char
_ -> Bool
False
  LDef List1 Char
_ -> Bool
False
  Label
LWild  -> Bool
False
  Label
LNil   -> Bool
True
  Label
LCons  -> Bool
True
  Label
LSg    -> Bool
True

-- Will the @Label@ be used to print the AST ?
isALabel :: Label -> Bool
isALabel :: Label -> Bool
isALabel = \case
  LId  List1 Char
_ -> Bool
True
  LDef List1 Char
_ -> Bool
False
  Label
LWild  -> Bool
False
  Label
LNil   -> Bool
False
  Label
LCons  -> Bool
False
  Label
LSg    -> Bool
False

-- Will the @Label@ be used to print the pretty printer ?
isPLabel :: Label -> Bool
isPLabel :: Label -> Bool
isPLabel = \case
  LId  List1 Char
_ -> Bool
True
  LDef List1 Char
_ -> Bool
False
  Label
LWild  -> Bool
False
  Label
LNil   -> Bool
True
  Label
LCons  -> Bool
True
  Label
LSg    -> Bool
True

-- | Filter @Label@s that will be printed in the AST datatypes.

filterLabelsAST :: [String]
                -> [(Label, ([Type], (Integer, ARHS)))]
                -> [(Label, ([Type], (Integer, ARHS)))]
filterLabelsAST :: [String]
-> [(Label, ([Type], (Integer, ARHS)))]
-> [(Label, ([Type], (Integer, ARHS)))]
filterLabelsAST [String]
fNames =
  ((Label, ([Type], (Integer, ARHS))) -> Bool)
-> [(Label, ([Type], (Integer, ARHS)))]
-> [(Label, ([Type], (Integer, ARHS)))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Label
l,([Type], (Integer, ARHS))
_) -> Label -> Bool
isALabel Label
l Bool -> Bool -> Bool
&& String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem (Label -> String
printLabelName Label
l) [String]
fNames)

-- | Filter @Label@s that will be printed in the Pretty printer.

filterLabelsPrinter :: [String]
                    -> [(Label, ([Type], (Integer, ARHS)))]
                    -> [(Label, ([Type], (Integer, ARHS)))]
filterLabelsPrinter :: [String]
-> [(Label, ([Type], (Integer, ARHS)))]
-> [(Label, ([Type], (Integer, ARHS)))]
filterLabelsPrinter [String]
fNames =
  ((Label, ([Type], (Integer, ARHS))) -> Bool)
-> [(Label, ([Type], (Integer, ARHS)))]
-> [(Label, ([Type], (Integer, ARHS)))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Label
l,([Type], (Integer, ARHS))
_) -> Label -> Bool
isPLabel Label
l Bool -> Bool -> Bool
&& String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem (Label -> String
printLabelName Label
l) [String]
fNames)

-- ** RHS
---------------------------------------------------------------------------

-- | Print names of @Cat@ in a rhs.
printRhsCats :: [Item' a] -> [String]
printRhsCats :: [Item' a] -> [String]
printRhsCats = (Item' a -> Maybe String) -> [Item' a] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Item' a -> Maybe String
forall a. Item' a -> Maybe String
printItemCat
  where
    printItemCat :: Item' a -> Maybe String
    printItemCat :: Item' a -> Maybe String
printItemCat (Terminal a
_)    = Maybe String
forall a. Maybe a
Nothing
    printItemCat (NTerminal Cat
cat) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Cat -> String
printCatName Cat
cat

-- | Print rhs @Item@s, both non terminals and terminals.
printRHS :: [Item' Keyword] -> [String]
printRHS :: [Item' Keyword] -> [String]
printRHS [Item' Keyword]
items = Item' Keyword -> String
printItem (Item' Keyword -> String) -> [Item' Keyword] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Item' Keyword]
items
  where
  printItem :: Item' Keyword -> String
  printItem :: Item' Keyword -> String
printItem (Terminal Keyword
k)    = String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
escapeChars ShowS -> (Keyword -> String) -> Keyword -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (List1 Char -> String)
-> (Keyword -> List1 Char) -> Keyword -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keyword -> List1 Char
theKeyword) Keyword
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
  printItem (NTerminal Cat
cat) = Cat -> String
printCatNamePrec' Cat
cat


-- | Get @Cat@s in a rhs.
getRhsCats :: [Item' a] -> [Cat]
getRhsCats :: [Item' a] -> [Cat]
getRhsCats = (Item' a -> Maybe Cat) -> [Item' a] -> [Cat]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Item' a -> Maybe Cat
forall a. Item' a -> Maybe Cat
getItemCat
  where
    getItemCat :: Item' a -> Maybe Cat
    getItemCat :: Item' a -> Maybe Cat
getItemCat (Terminal a
_)    = Maybe Cat
forall a. Maybe a
Nothing
    getItemCat (NTerminal Cat
cat) = Cat -> Maybe Cat
forall a. a -> Maybe a
Just Cat
cat


printItemName :: Item' String1 -> String
printItemName :: Item' (List1 Char) -> String
printItemName (Terminal List1 Char
s1)   = Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: (ShowS
escapeChars ShowS -> (List1 Char -> String) -> List1 Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) List1 Char
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'"']
printItemName (NTerminal Cat
cat) = Cat -> String
printCatNamePrec Cat
cat

isNTerminal :: Item' a -> Bool
isNTerminal :: Item' a -> Bool
isNTerminal (Terminal a
_)  = Bool
False
isNTerminal (NTerminal Cat
_) = Bool
True

isItemListCat :: Item' a -> Bool
isItemListCat :: Item' a -> Bool
isItemListCat (Terminal a
_)  = Bool
False
isItemListCat (NTerminal Cat
cat) = case Cat
cat of
  (Cat BaseCat
_)         -> Bool
False
  (ListCat Cat
_)     -> Bool
True
  (CoerceCat List1 Char
_ Integer
_) -> Bool
False

isItemBuiltin :: Item' a -> Bool
isItemBuiltin :: Item' a -> Bool
isItemBuiltin (Terminal a
_)  = Bool
False
isItemBuiltin (NTerminal Cat
cat) = Cat -> Bool
isCatBuiltin Cat
cat

-- | Get the non-terminals of a rhs in left-to-right order.
--
rhsCats :: RHS' a -> [Cat]
rhsCats :: RHS' a -> [Cat]
rhsCats = (Item' a -> Maybe Cat) -> RHS' a -> [Cat]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Item' a -> Maybe Cat) -> RHS' a -> [Cat])
-> (Item' a -> Maybe Cat) -> RHS' a -> [Cat]
forall a b. (a -> b) -> a -> b
$ \case
    Terminal{}  -> Maybe Cat
forall a. Maybe a
Nothing
    NTerminal Cat
c -> Cat -> Maybe Cat
forall a. a -> Maybe a
Just Cat
c

-- | Get the types of a rhs.
--
rhsType :: RHS' a -> [Type]
rhsType :: RHS' a -> [Type]
rhsType = (Cat -> Type) -> [Cat] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Cat -> Type
catToType ([Cat] -> [Type]) -> (RHS' a -> [Cat]) -> RHS' a -> [Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RHS' a -> [Cat]
forall a. RHS' a -> [Cat]
rhsCats

-- ** Token definitions
---------------------------------------------------------------------------

-- | does a token definition contain a no position token.
isNoPositionToken :: WithPosition TokenDef -> Bool
isNoPositionToken :: WithPosition TokenDef -> Bool
isNoPositionToken WithPosition TokenDef
def = TokenDef -> PositionToken
positionToken (WithPosition TokenDef -> TokenDef
forall a. WithPosition a -> a
wpThing WithPosition TokenDef
def) PositionToken -> PositionToken -> Bool
forall a. Eq a => a -> a -> Bool
== PositionToken
NoPositionToken

-- | does a token definition contain (with position) a position token.
isPositionToken :: WithPosition TokenDef -> Bool
isPositionToken :: WithPosition TokenDef -> Bool
isPositionToken WithPosition TokenDef
def = TokenDef -> PositionToken
positionToken (WithPosition TokenDef -> TokenDef
forall a. WithPosition a -> a
wpThing WithPosition TokenDef
def) PositionToken -> PositionToken -> Bool
forall a. Eq a => a -> a -> Bool
== PositionToken
PositionToken

-- | does a token definition contain a position token.
isPosToken :: TokenDef -> Bool
isPosToken :: TokenDef -> Bool
isPosToken TokenDef
def = TokenDef -> PositionToken
positionToken TokenDef
def PositionToken -> PositionToken -> Bool
forall a. Eq a => a -> a -> Bool
== PositionToken
PositionToken

hasIdentifier :: TokenDefs -> Bool
hasIdentifier :: TokenDefs -> Bool
hasIdentifier TokenDefs
defs =
  [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
  ((Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) (TokenDef -> Bool
isIdent (TokenDef -> Bool)
-> (WithPosition TokenDef -> TokenDef)
-> WithPosition TokenDef
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithPosition TokenDef -> TokenDef
forall a. WithPosition a -> a
wpThing (WithPosition TokenDef -> Bool)
-> [WithPosition TokenDef] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenDefs -> [WithPosition TokenDef]
forall k a. Map k a -> [a]
Map.elems TokenDefs
defs))
  Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

-- ** Functions
---------------------------------------------------------------------------

-- | Print @Exp@ (function body in define pragma).

printExp :: Bool -> String -> Exp -> String
printExp :: Bool -> String -> Exp -> String
printExp Bool
functor String
functorParam Exp
exp =
  if Bool
functor
  then String -> Exp -> String
printExp2 String
functorParam Exp
exp
  else Exp -> String
printExp1 Exp
exp

printExp1 :: Exp -> String
printExp1 :: Exp -> String
printExp1 = \case
  (App Label
label FunType
_fType [Exp]
exps)
    -> Label -> String
printLabelName Label
label
       String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Exp -> String) -> [Exp] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          (\Exp
e ->
          if Exp -> Bool
isApp1 Exp
e
          then String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Exp -> String
printExp1 Exp
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
          else ((String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Exp -> String) -> Exp -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> String
printExp1) Exp
e)
          [Exp]
exps
  (Var Parameter
p)        -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (List1 Char -> String) -> List1 Char -> String
forall a b. (a -> b) -> a -> b
$ Parameter -> List1 Char
paramName Parameter
p
  (LitInteger Integer
i) -> Integer -> String
forall a. Show a => a -> String
show Integer
i
  (LitDouble Double
d)  -> Double -> String
forall a. Show a => a -> String
show Double
d
  (LitChar Char
c)    -> String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
  (LitString String
s)  -> String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""

printExp2 :: String -> Exp -> String
printExp2 :: String -> Exp -> String
printExp2 String
functorParam = \case
  (App Label
label FunType
fType [Exp]
exps)
    -> if Type -> Bool
isTokenType (Type -> Bool) -> Type -> Bool
forall a b. (a -> b) -> a -> b
$ FunType -> Type
targetType FunType
fType
       then Label -> String
printLabelName Label
label
       else Label -> String
printLabelName Label
label String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
functorParam
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Exp -> String) -> [Exp] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          (\Exp
e ->
          if Exp -> Bool
isApp2 Exp
e
          then String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> Exp -> String
printExp2 String
functorParam Exp
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
          else ((String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Exp -> String) -> Exp -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exp -> String
printExp2 String
functorParam) Exp
e)
          [Exp]
exps
  (Var Parameter
p)        -> List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (List1 Char -> String) -> List1 Char -> String
forall a b. (a -> b) -> a -> b
$ Parameter -> List1 Char
paramName Parameter
p
  (LitInteger Integer
i) -> Integer -> String
forall a. Show a => a -> String
show Integer
i
  (LitDouble Double
d)  -> Double -> String
forall a. Show a => a -> String
show Double
d
  (LitChar Char
c)    -> String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
  (LitString String
s)  -> String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""

-- Is @Exp@ an application containing a non emtpy list of expressions.
isApp1 :: Exp -> Bool
isApp1 :: Exp -> Bool
isApp1 = \case
  App Label
_ FunType
_ [Exp]
exps -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Exp] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Exp]
exps
  Var Parameter
_ -> Bool
False
  LitInteger Integer
_ -> Bool
False
  LitDouble Double
_ -> Bool
False
  LitChar Char
_ -> Bool
False
  LitString String
_ -> Bool
False

-- Is @Exp@ an application.
isApp2 :: Exp -> Bool
isApp2 :: Exp -> Bool
isApp2 = \case
  App Label
_ FunType
_ [Exp]
_ -> Bool
True
  Var Parameter
_ -> Bool
False
  LitInteger Integer
_ -> Bool
False
  LitDouble Double
_ -> Bool
False
  LitChar Char
_ -> Bool
False
  LitString String
_ -> Bool
False

-- ** Keywords
---------------------------------------------------------------------------

-- | All-whitespace strings (in particular, empty strings) give 'Nothing'.

getKeyword :: Separator -> Keyword
getKeyword :: Separator -> Keyword
getKeyword = \case
  (Separator Keyword
k) -> Keyword
k
  (Terminator Keyword
k) -> Keyword
k

parseKeyword :: String -> Maybe Keyword
parseKeyword :: String -> Maybe Keyword
parseKeyword String
s = List1 Char -> Keyword
Keyword (List1 Char -> Keyword) -> Maybe (List1 Char) -> Maybe Keyword
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe (List1 Char)
trim1 String
s

parseASeparator :: Separator' String -> Maybe ASeparator
parseASeparator :: Separator' String -> Maybe ASeparator
parseASeparator = (String -> Maybe (List1 Char))
-> Separator' String -> Maybe ASeparator
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> Maybe (List1 Char)
forall a. [a] -> Maybe (NonEmpty a)
List1.nonEmpty

trimSeparator :: ASeparator -> Maybe Separator
trimSeparator :: ASeparator -> Maybe Separator
trimSeparator = (List1 Char -> Maybe Keyword) -> ASeparator -> Maybe Separator
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((List1 Char -> Maybe Keyword) -> ASeparator -> Maybe Separator)
-> (List1 Char -> Maybe Keyword) -> ASeparator -> Maybe Separator
forall a b. (a -> b) -> a -> b
$ String -> Maybe Keyword
parseKeyword (String -> Maybe Keyword)
-> (List1 Char -> String) -> List1 Char -> Maybe Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


-- ** Parser rules.
---------------------------------------------------------------------------

lookupRHS :: Cat -> RHS -> ParserRules -> Maybe (WithPosition RuleLabel)
lookupRHS :: Cat
-> [Item' Keyword] -> ParserRules -> Maybe (WithPosition RuleLabel)
lookupRHS Cat
cat [Item' Keyword]
rhs = [Item' Keyword]
-> Map [Item' Keyword] (WithPosition RuleLabel)
-> Maybe (WithPosition RuleLabel)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Item' Keyword]
rhs (Map [Item' Keyword] (WithPosition RuleLabel)
 -> Maybe (WithPosition RuleLabel))
-> (ParserRules
    -> Maybe (Map [Item' Keyword] (WithPosition RuleLabel)))
-> ParserRules
-> Maybe (WithPosition RuleLabel)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Cat
-> ParserRules
-> Maybe (Map [Item' Keyword] (WithPosition RuleLabel))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Cat
cat


-- ** Layouts.
---------------------------------------------------------------------------

-- This function doesn't check for layout stop since a layout stop can not
-- occur without a layout start. This is checked in the checks performed before
-- the state initialization.
layoutsAreUsed :: LBNF -> Bool
layoutsAreUsed :: LBNF -> Bool
layoutsAreUsed LBNF
lbnf =
  Maybe Position -> Bool
forall a. Maybe a -> Bool
isJust (LBNF -> Maybe Position
_lbnfLayoutTop LBNF
lbnf)
  Bool -> Bool -> Bool
||
  Bool -> Bool
not (LayoutKeywords -> Bool
forall k a. Map k a -> Bool
Map.null (LBNF -> LayoutKeywords
_lbnfLayoutStart LBNF
lbnf))