Abstract syntax for grammar files.
(c) 1993-2001 Andy Gill, Simon Marlow
Here is the abstract syntax of the language we parse.
> module Happy.Frontend.AbsSyn (
> BookendedAbsSyn(..),
> AbsSyn(..), Directive(..),
> getTokenType, getTokenSpec, getParserNames, getLexer,
> getImportedIdentity, getMonad, getError,
> getPrios, getPrioNames, getExpect, getErrorHandlerType,
> getAttributes, getAttributetype,
> Rule(..), Prod(..), Term(..), Prec(..)
> ) where
> import Happy.Grammar (ErrorHandlerType(..))
> data BookendedAbsSyn
> = BookendedAbsSyn
> (Maybe String)
> AbsSyn
> (Maybe String)
> data AbsSyn
> = AbsSyn
> [Directive String]
> [Rule]
> data Rule
> = Rule
> String
> [String]
> [Prod]
> (Maybe String)
> data Prod
> = Prod
> [Term]
> String
> Int
> Prec
> data Term
> = App
> String
> [Term]
> data Prec
> = PrecNone
> | PrecShift
> | PrecId String
> deriving Int -> Prec -> ShowS
[Prec] -> ShowS
Prec -> String
(Int -> Prec -> ShowS)
-> (Prec -> String) -> ([Prec] -> ShowS) -> Show Prec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Prec -> ShowS
showsPrec :: Int -> Prec -> ShowS
$cshow :: Prec -> String
show :: Prec -> String
$cshowList :: [Prec] -> ShowS
showList :: [Prec] -> ShowS
Show
%-----------------------------------------------------------------------------
Parser Generator Directives.
ToDo: find a consistent way to analyse all the directives together and
generate some error messages.
>
> data Directive a
> = TokenType String
> | TokenSpec [(a,String)]
> | TokenName String (Maybe String) Bool
> | TokenLexer String String
> | TokenErrorHandlerType String
> | TokenImportedIdentity
> | TokenMonad String String String String
> | TokenNonassoc [String]
> | TokenRight [String]
> | TokenLeft [String]
> | TokenExpect Int
> | TokenError String
> | TokenAttributetype String
> | TokenAttribute String String
> deriving Int -> Directive a -> ShowS
[Directive a] -> ShowS
Directive a -> String
(Int -> Directive a -> ShowS)
-> (Directive a -> String)
-> ([Directive a] -> ShowS)
-> Show (Directive a)
forall a. Show a => Int -> Directive a -> ShowS
forall a. Show a => [Directive a] -> ShowS
forall a. Show a => Directive a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Directive a -> ShowS
showsPrec :: Int -> Directive a -> ShowS
$cshow :: forall a. Show a => Directive a -> String
show :: Directive a -> String
$cshowList :: forall a. Show a => [Directive a] -> ShowS
showList :: [Directive a] -> ShowS
Show
> getTokenType :: [Directive t] -> String
> getTokenType :: forall t. [Directive t] -> String
getTokenType [Directive t]
ds
> = case [ String
t | (TokenType String
t) <- [Directive t]
ds ] of
> [String
t] -> String
t
> [] -> ShowS
forall a. HasCallStack => String -> a
error String
"no token type given"
> [String]
_ -> ShowS
forall a. HasCallStack => String -> a
error String
"multiple token types"
> getParserNames :: [Directive t] -> [Directive t]
> getParserNames :: forall t. [Directive t] -> [Directive t]
getParserNames [Directive t]
ds = [ Directive t
t | t :: Directive t
t@(TokenName String
_ Maybe String
_ Bool
_) <- [Directive t]
ds ]
> getLexer :: [Directive t] -> Maybe (String, String)
> getLexer :: forall t. [Directive t] -> Maybe (String, String)
getLexer [Directive t]
ds
> = case [ (String
a,String
b) | (TokenLexer String
a String
b) <- [Directive t]
ds ] of
> [(String, String)
t] -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String, String)
t
> [] -> Maybe (String, String)
forall a. Maybe a
Nothing
> [(String, String)]
_ -> String -> Maybe (String, String)
forall a. HasCallStack => String -> a
error String
"multiple lexer directives"
> getImportedIdentity :: [Directive t] -> Bool
> getImportedIdentity :: forall t. [Directive t] -> Bool
getImportedIdentity [Directive t]
ds
> = case [ (()) | Directive t
TokenImportedIdentity <- [Directive t]
ds ] of
> [()
_] -> Bool
True
> [] -> Bool
False
> [()]
_ -> String -> Bool
forall a. HasCallStack => String -> a
error String
"multiple importedidentity directives"
> getMonad :: [Directive t] -> (Bool, String, String, String, String)
> getMonad :: forall t. [Directive t] -> (Bool, String, String, String, String)
getMonad [Directive t]
ds
> = case [ (Bool
True,String
a,String
b,String
c,String
d) | (TokenMonad String
a String
b String
c String
d) <- [Directive t]
ds ] of
> [(Bool, String, String, String, String)
t] -> (Bool, String, String, String, String)
t
> [] -> (Bool
False,String
"()",String
"HappyIdentity",String
"Prelude.>>=",String
"Prelude.return")
> [(Bool, String, String, String, String)]
_ -> String -> (Bool, String, String, String, String)
forall a. HasCallStack => String -> a
error String
"multiple monad directives"
> getTokenSpec :: [Directive t] -> [(t, String)]
> getTokenSpec :: forall t. [Directive t] -> [(t, String)]
getTokenSpec [Directive t]
ds = [[(t, String)]] -> [(t, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [(t, String)]
t | (TokenSpec [(t, String)]
t) <- [Directive t]
ds ]
> getPrios :: [Directive t] -> [Directive t]
> getPrios :: forall t. [Directive t] -> [Directive t]
getPrios [Directive t]
ds = [ Directive t
d | Directive t
d <- [Directive t]
ds,
> case Directive t
d of
> TokenNonassoc [String]
_ -> Bool
True
> TokenLeft [String]
_ -> Bool
True
> TokenRight [String]
_ -> Bool
True
> Directive t
_ -> Bool
False
> ]
> getPrioNames :: Directive t -> [String]
> getPrioNames :: forall t. Directive t -> [String]
getPrioNames (TokenNonassoc [String]
s) = [String]
s
> getPrioNames (TokenLeft [String]
s) = [String]
s
> getPrioNames (TokenRight [String]
s) = [String]
s
> getPrioNames Directive t
_ = String -> [String]
forall a. HasCallStack => String -> a
error String
"Not an associativity token"
> getExpect :: [Directive t] -> Maybe Int
> getExpect :: forall t. [Directive t] -> Maybe Int
getExpect [Directive t]
ds
> = case [ Int
n | (TokenExpect Int
n) <- [Directive t]
ds ] of
> [Int
t] -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
t
> [] -> Maybe Int
forall a. Maybe a
Nothing
> [Int]
_ -> String -> Maybe Int
forall a. HasCallStack => String -> a
error String
"multiple expect directives"
> getError :: [Directive t] -> Maybe String
> getError :: forall t. [Directive t] -> Maybe String
getError [Directive t]
ds
> = case [ String
a | (TokenError String
a) <- [Directive t]
ds ] of
> [String
t] -> String -> Maybe String
forall a. a -> Maybe a
Just String
t
> [] -> Maybe String
forall a. Maybe a
Nothing
> [String]
_ -> String -> Maybe String
forall a. HasCallStack => String -> a
error String
"multiple error directives"
> getErrorHandlerType :: [Directive t] -> ErrorHandlerType
> getErrorHandlerType :: forall t. [Directive t] -> ErrorHandlerType
getErrorHandlerType [Directive t]
ds
> = case [ String
a | (TokenErrorHandlerType String
a) <- [Directive t]
ds ] of
> [String
t] -> case String
t of
> String
"explist" -> ErrorHandlerType
ErrorHandlerTypeExpList
> String
"default" -> ErrorHandlerType
ErrorHandlerTypeDefault
> String
_ -> String -> ErrorHandlerType
forall a. HasCallStack => String -> a
error String
"unsupported %errorhandlertype value"
> [] -> ErrorHandlerType
ErrorHandlerTypeDefault
> [String]
_ -> String -> ErrorHandlerType
forall a. HasCallStack => String -> a
error String
"multiple errorhandlertype directives"
> getAttributes :: [Directive t] -> [(String, String)]
> getAttributes :: forall t. [Directive t] -> [(String, String)]
getAttributes [Directive t]
ds
> = [ (String
ident,String
typ) | (TokenAttribute String
ident String
typ) <- [Directive t]
ds ]
> getAttributetype :: [Directive t] -> Maybe String
> getAttributetype :: forall t. [Directive t] -> Maybe String
getAttributetype [Directive t]
ds
> = case [ String
t | (TokenAttributetype String
t) <- [Directive t]
ds ] of
> [String
t] -> String -> Maybe String
forall a. a -> Maybe a
Just String
t
> [] -> Maybe String
forall a. Maybe a
Nothing
> [String]
_ -> String -> Maybe String
forall a. HasCallStack => String -> a
error String
"multiple attributetype directives"