/-----------------------------------------------------------------------------
The Grammar data type.

(c) 1993-2001 Andy Gill, Simon Marlow
-----------------------------------------------------------------------------

> {-# LANGUAGE GeneralizedNewtypeDeriving #-}

> -- | This module exports the 'Grammar' data type, which
> module Happy.Grammar (
>       Name (..),
>
>       Production(..),
>       TokenSpec(..),
>       Grammar(..),
>       AttributeGrammarExtras(..),
>       Priority(..),
>       Assoc(..),
>       ErrorHandlerInfo(..),
>       ErrorExpectedMode(..),
>       Directives(..),
>
>       errorName, errorTok, catchName, catchTok,
>       startName, dummyName, firstStartTok, dummyTok,
>       eofName, epsilonTok,
>       ) where

> import Data.Array
> import Happy.Grammar.ExpressionWithHole (ExpressionWithHole)

> data Production eliminator
>       = Production Name [Name] (eliminator,[Int]) Priority
>       deriving Int -> Production eliminator -> ShowS
[Production eliminator] -> ShowS
Production eliminator -> String
(Int -> Production eliminator -> ShowS)
-> (Production eliminator -> String)
-> ([Production eliminator] -> ShowS)
-> Show (Production eliminator)
forall eliminator.
Show eliminator =>
Int -> Production eliminator -> ShowS
forall eliminator.
Show eliminator =>
[Production eliminator] -> ShowS
forall eliminator.
Show eliminator =>
Production eliminator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall eliminator.
Show eliminator =>
Int -> Production eliminator -> ShowS
showsPrec :: Int -> Production eliminator -> ShowS
$cshow :: forall eliminator.
Show eliminator =>
Production eliminator -> String
show :: Production eliminator -> String
$cshowList :: forall eliminator.
Show eliminator =>
[Production eliminator] -> ShowS
showList :: [Production eliminator] -> ShowS
Show

> data TokenSpec
>
>        -- | The token is just a fixed value
>        = TokenFixed String
>
>        -- | The token is an expression involving the value of the lexed token.
>        | TokenWithValue ExpressionWithHole
>
>       deriving (TokenSpec -> TokenSpec -> Bool
(TokenSpec -> TokenSpec -> Bool)
-> (TokenSpec -> TokenSpec -> Bool) -> Eq TokenSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TokenSpec -> TokenSpec -> Bool
== :: TokenSpec -> TokenSpec -> Bool
$c/= :: TokenSpec -> TokenSpec -> Bool
/= :: TokenSpec -> TokenSpec -> Bool
Eq, Int -> TokenSpec -> ShowS
[TokenSpec] -> ShowS
TokenSpec -> String
(Int -> TokenSpec -> ShowS)
-> (TokenSpec -> String)
-> ([TokenSpec] -> ShowS)
-> Show TokenSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenSpec -> ShowS
showsPrec :: Int -> TokenSpec -> ShowS
$cshow :: TokenSpec -> String
show :: TokenSpec -> String
$cshowList :: [TokenSpec] -> ShowS
showList :: [TokenSpec] -> ShowS
Show)

> data Grammar eliminator
>       = Grammar {
>               forall eliminator. Grammar eliminator -> [Production eliminator]
productions       :: [Production eliminator],
>               forall eliminator.
Grammar eliminator -> Int -> Production eliminator
lookupProdNo      :: Int -> Production eliminator,
>               forall eliminator. Grammar eliminator -> Name -> [Int]
lookupProdsOfName :: Name -> [Int],
>               forall eliminator. Grammar eliminator -> [(Name, TokenSpec)]
token_specs       :: [(Name, TokenSpec)],
>               forall eliminator. Grammar eliminator -> [Name]
terminals         :: [Name],
>               forall eliminator. Grammar eliminator -> [Name]
non_terminals     :: [Name],
>               forall eliminator.
Grammar eliminator -> [(String, Name, Name, Bool)]
starts            :: [(String,Name,Name,Bool)],
>               forall eliminator. Grammar eliminator -> Array Name (Maybe String)
types             :: Array Name (Maybe String),
>               forall eliminator. Grammar eliminator -> Array Name String
token_names       :: Array Name String,
>               forall eliminator. Grammar eliminator -> Name
first_nonterm     :: Name,
>               forall eliminator. Grammar eliminator -> Name
first_term        :: Name,
>               forall eliminator. Grammar eliminator -> Name
eof_term          :: Name,
>               forall eliminator. Grammar eliminator -> [(Name, Priority)]
priorities        :: [(Name,Priority)]
>       }

> data AttributeGrammarExtras
>       = AttributeGrammarExtras {
>               AttributeGrammarExtras -> [(String, String)]
attributes        :: [(String,String)],
>               AttributeGrammarExtras -> String
attributetype     :: String
>       }

> instance Show eliminator => Show (Grammar eliminator) where
>       showsPrec :: Int -> Grammar eliminator -> ShowS
showsPrec Int
_ (Grammar
>               { productions :: forall eliminator. Grammar eliminator -> [Production eliminator]
productions           = [Production eliminator]
p
>               , token_specs :: forall eliminator. Grammar eliminator -> [(Name, TokenSpec)]
token_specs           = [(Name, TokenSpec)]
t
>               , terminals :: forall eliminator. Grammar eliminator -> [Name]
terminals             = [Name]
ts
>               , non_terminals :: forall eliminator. Grammar eliminator -> [Name]
non_terminals         = [Name]
nts
>               , starts :: forall eliminator.
Grammar eliminator -> [(String, Name, Name, Bool)]
starts                = [(String, Name, Name, Bool)]
sts
>               , types :: forall eliminator. Grammar eliminator -> Array Name (Maybe String)
types                 = Array Name (Maybe String)
tys
>               , token_names :: forall eliminator. Grammar eliminator -> Array Name String
token_names           = Array Name String
e
>               , first_nonterm :: forall eliminator. Grammar eliminator -> Name
first_nonterm         = Name
fnt
>               , first_term :: forall eliminator. Grammar eliminator -> Name
first_term            = Name
ft
>               , eof_term :: forall eliminator. Grammar eliminator -> Name
eof_term              = Name
eof
>               })
>        = String -> ShowS
showString String
"productions = "     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Production eliminator] -> ShowS
forall a. Show a => a -> ShowS
shows [Production eliminator]
p
>        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\ntoken_specs = "   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, TokenSpec)] -> ShowS
forall a. Show a => a -> ShowS
shows [(Name, TokenSpec)]
t
>        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\nterminals = "     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> ShowS
forall a. Show a => a -> ShowS
shows [Name]
ts
>        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\nnonterminals = "  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> ShowS
forall a. Show a => a -> ShowS
shows [Name]
nts
>        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\nstarts = "        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, Name, Name, Bool)] -> ShowS
forall a. Show a => a -> ShowS
shows [(String, Name, Name, Bool)]
sts
>        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\ntypes = "         ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Name (Maybe String) -> ShowS
forall a. Show a => a -> ShowS
shows Array Name (Maybe String)
tys
>        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\ntoken_names = "   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Name String -> ShowS
forall a. Show a => a -> ShowS
shows Array Name String
e
>        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\nfirst_nonterm = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ShowS
forall a. Show a => a -> ShowS
shows Name
fnt
>        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\nfirst_term = "    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ShowS
forall a. Show a => a -> ShowS
shows Name
ft
>        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\neof = "           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ShowS
forall a. Show a => a -> ShowS
shows Name
eof
>        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\n"

> data Assoc = LeftAssoc | RightAssoc | None
>       deriving Int -> Assoc -> ShowS
[Assoc] -> ShowS
Assoc -> String
(Int -> Assoc -> ShowS)
-> (Assoc -> String) -> ([Assoc] -> ShowS) -> Show Assoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Assoc -> ShowS
showsPrec :: Int -> Assoc -> ShowS
$cshow :: Assoc -> String
show :: Assoc -> String
$cshowList :: [Assoc] -> ShowS
showList :: [Assoc] -> ShowS
Show

> data Priority = No | Prio Assoc Int | PrioLowest
>       deriving Int -> Priority -> ShowS
[Priority] -> ShowS
Priority -> String
(Int -> Priority -> ShowS)
-> (Priority -> String) -> ([Priority] -> ShowS) -> Show Priority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Priority -> ShowS
showsPrec :: Int -> Priority -> ShowS
$cshow :: Priority -> String
show :: Priority -> String
$cshowList :: [Priority] -> ShowS
showList :: [Priority] -> ShowS
Show

> instance Eq Priority where
>   Priority
No == :: Priority -> Priority -> Bool
== Priority
No = Bool
True
>   Prio Assoc
_ Int
i == Prio Assoc
_ Int
j = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j
>   Priority
_ == Priority
_ = Bool
False

> data ErrorHandlerInfo
>   = DefaultErrorHandler
>   -- ^ Default handler `happyError`
>   | CustomErrorHandler String
>   -- ^ Call this handler on error.
>   | ResumptiveErrorHandler String String
>   -- ^ `ResumptiveErrorHandler abort report`:
>   -- Upon encountering a parse error, call non-fatal function `report`.
>   -- Then try to resume parsing by finding a catch production.
>   -- If that ultimately fails, call `abort`.

> data ErrorExpectedMode
>   = NoExpected   -- ^ Neither `%errorhandertype explist` nor `%error.expected`
>   | OldExpected  -- ^ `%errorhandertype explist`. The error handler takes a pair `(Token, [String])`
>   | NewExpected  -- ^ `%error.expected`. The error handler takes two (or more) args `Token -> [String] -> ...`.
>   deriving ErrorExpectedMode -> ErrorExpectedMode -> Bool
(ErrorExpectedMode -> ErrorExpectedMode -> Bool)
-> (ErrorExpectedMode -> ErrorExpectedMode -> Bool)
-> Eq ErrorExpectedMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorExpectedMode -> ErrorExpectedMode -> Bool
== :: ErrorExpectedMode -> ErrorExpectedMode -> Bool
$c/= :: ErrorExpectedMode -> ErrorExpectedMode -> Bool
/= :: ErrorExpectedMode -> ErrorExpectedMode -> Bool
Eq

> -- | Stuff like `\%monad`, `\%expect`
> data Directives
>       = Directives {
>               Directives -> String
token_type        :: String,
>               Directives -> Bool
imported_identity :: Bool,
>               Directives -> (Bool, String, String, String, String)
monad             :: (Bool,String,String,String,String),
>               Directives -> Maybe Int
expect            :: Maybe Int,
>               Directives -> Maybe (String, String)
lexer             :: Maybe (String,String),
>               Directives -> ErrorHandlerInfo
error_handler     :: ErrorHandlerInfo,
>               Directives -> ErrorExpectedMode
error_expected    :: ErrorExpectedMode
>                 -- ^ Error handler specified in `error_handler` takes
>                 -- a `[String]` carrying the pretty-printed expected tokens
>       }

-----------------------------------------------------------------------------
-- Magic name values

> newtype Name
>       = MkName { Name -> Int
getName :: Int }
>       deriving ( ReadPrec [Name]
ReadPrec Name
Int -> ReadS Name
ReadS [Name]
(Int -> ReadS Name)
-> ReadS [Name] -> ReadPrec Name -> ReadPrec [Name] -> Read Name
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Name
readsPrec :: Int -> ReadS Name
$creadList :: ReadS [Name]
readList :: ReadS [Name]
$creadPrec :: ReadPrec Name
readPrec :: ReadPrec Name
$creadListPrec :: ReadPrec [Name]
readListPrec :: ReadPrec [Name]
Read, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Name -> ShowS
showsPrec :: Int -> Name -> ShowS
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> ShowS
showList :: [Name] -> ShowS
Show
>                , Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, Eq Name
Eq Name =>
(Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
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
$ccompare :: Name -> Name -> Ordering
compare :: Name -> Name -> Ordering
$c< :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
>= :: Name -> Name -> Bool
$cmax :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
min :: Name -> Name -> Name
Ord, Int -> Name
Name -> Int
Name -> [Name]
Name -> Name
Name -> Name -> [Name]
Name -> Name -> Name -> [Name]
(Name -> Name)
-> (Name -> Name)
-> (Int -> Name)
-> (Name -> Int)
-> (Name -> [Name])
-> (Name -> Name -> [Name])
-> (Name -> Name -> [Name])
-> (Name -> Name -> Name -> [Name])
-> Enum Name
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Name -> Name
succ :: Name -> Name
$cpred :: Name -> Name
pred :: Name -> Name
$ctoEnum :: Int -> Name
toEnum :: Int -> Name
$cfromEnum :: Name -> Int
fromEnum :: Name -> Int
$cenumFrom :: Name -> [Name]
enumFrom :: Name -> [Name]
$cenumFromThen :: Name -> Name -> [Name]
enumFromThen :: Name -> Name -> [Name]
$cenumFromTo :: Name -> Name -> [Name]
enumFromTo :: Name -> Name -> [Name]
$cenumFromThenTo :: Name -> Name -> Name -> [Name]
enumFromThenTo :: Name -> Name -> Name -> [Name]
Enum, Ord Name
Ord Name =>
((Name, Name) -> [Name])
-> ((Name, Name) -> Name -> Int)
-> ((Name, Name) -> Name -> Int)
-> ((Name, Name) -> Name -> Bool)
-> ((Name, Name) -> Int)
-> ((Name, Name) -> Int)
-> Ix Name
(Name, Name) -> Int
(Name, Name) -> [Name]
(Name, Name) -> Name -> Bool
(Name, Name) -> Name -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (Name, Name) -> [Name]
range :: (Name, Name) -> [Name]
$cindex :: (Name, Name) -> Name -> Int
index :: (Name, Name) -> Name -> Int
$cunsafeIndex :: (Name, Name) -> Name -> Int
unsafeIndex :: (Name, Name) -> Name -> Int
$cinRange :: (Name, Name) -> Name -> Bool
inRange :: (Name, Name) -> Name -> Bool
$crangeSize :: (Name, Name) -> Int
rangeSize :: (Name, Name) -> Int
$cunsafeRangeSize :: (Name, Name) -> Int
unsafeRangeSize :: (Name, Name) -> Int
Ix)

All the tokens in the grammar are mapped onto integers, for speed.
The namespace is broken up as follows:

epsilon         = 0
error           = 1
dummy           = 2
%start          = 3..s
non-terminals   = s..n
terminals       = n..m
%eof            = m

where n_nonterminals = n - 3 (including %starts)
      n_terminals    = 1{-error-} + (m-n) + 1{-eof-} (including error and %eof)

These numbers are deeply magical, change at your own risk.  Several
other places rely on these being arranged as they are, including
ProduceCode.lhs and the various HappyTemplates.

Unfortunately this means you can't tell whether a given token is a
terminal or non-terminal without knowing the boundaries of the
namespace, which are kept in the Grammar structure.

In hindsight, this was probably a bad idea.

In normal and GHC-based parsers, these numbers are also used in the
generated grammar itself, except that the error token is mapped to -1.
For array-based parsers, see the note in Tabular/LALR.lhs.

> startName, eofName, errorName, catchName, dummyName :: String
> startName :: String
startName = String
"%start" -- with a suffix, like %start_1, %start_2 etc.
> eofName :: String
eofName   = String
"%eof"
> errorName :: String
errorName = String
"error"
> catchName :: String
catchName = String
"catch"
> dummyName :: String
dummyName = String
"%dummy"  -- shouldn't occur in the grammar anywhere

TODO: Should rename firstStartTok to firstStartName!
It denotes the *Name* of the first start non-terminal and semantically has
nothing to do with Tokens at all.

> firstStartTok, dummyTok, errorTok, catchTok, epsilonTok :: Name
> firstStartTok :: Name
firstStartTok   = Int -> Name
MkName Int
4
> dummyTok :: Name
dummyTok        = Int -> Name
MkName Int
3
> catchTok :: Name
catchTok        = Int -> Name
MkName Int
2
> errorTok :: Name
errorTok        = Int -> Name
MkName Int
1
> epsilonTok :: Name
epsilonTok      = Int -> Name
MkName Int
0