> module AbsSyn (
> 	AbsSyn(..), Directive(..),
> 	getTokenType, getTokenSpec, getParserNames, getLexer,
>	getImportedIdentity, getMonad, getError,
>       getPrios, getPrioNames, getExpect,
>       getAttributes, getAttributetype,
>       Rule,Prod,Term(..)
>  ) where


> data AbsSyn
>     = AbsSyn
>         (Maybe String)					-- header
>         [Directive String]      				-- directives
>         [Rule]	-- productions
>         (Maybe String)					-- footer


> type Rule     = (String,[String],[Prod],Maybe String)
> type Prod     = ([Term],String,Int,Maybe String)
> data Term     = App String [Term]






#ifdef DEBUG


>   deriving Show


#endif














> data Directive a
>       = TokenType     String              	-- %tokentype
>       | TokenSpec     [(a,String)]         	-- %token
>       | TokenName     String (Maybe String) Bool -- %name/%partial (True <=> %partial)
>       | TokenLexer    String String        	-- %lexer
>       | TokenImportedIdentity					-- %importedidentity
>	| TokenMonad    String String String String -- %monad
>	| TokenNonassoc [String]	  	-- %nonassoc
>	| TokenRight    [String]		-- %right
>	| TokenLeft     [String]		-- %left
>       | TokenExpect   Int                     -- %expect
>       | TokenError    String                  -- %error
>       | TokenAttributetype String             -- %attributetype
>       | TokenAttribute String String          -- %attribute




#ifdef DEBUG


>   deriving Show


#endif


> 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
>		[]  -> forall a. HasCallStack => String -> a
error String
"no token type given"
>		[String]
_   -> 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] -> forall a. a -> Maybe a
Just (String, String)
t
>		[]  -> forall a. Maybe a
Nothing
>		[(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
>		[()]
_   -> 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
">>=",String
"return")
>		[(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 = 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
_                 = 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] -> forall a. a -> Maybe a
Just Int
t
>                 []  -> forall a. Maybe a
Nothing
>                 [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] -> forall a. a -> Maybe a
Just String
t
>		[]  -> forall a. Maybe a
Nothing
>		[String]
_   -> forall a. HasCallStack => String -> a
error String
"multiple error 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] -> forall a. a -> Maybe a
Just String
t
>                  []  -> forall a. Maybe a
Nothing
>                  [String]
_   -> forall a. HasCallStack => String -> a
error String
"multiple attributetype directives"