BlockParser.y

-- Generated by RTK from grammar 'Block'. Do not edit by hand.
{
{-# LANGUAGE DeriveDataTypeable #-}
module BlockParser where
import qualified Data.Generics as Gen
import qualified BlockLexer as L (Token(..), PosToken(..), AlexPosn(..), alexScanTokens)
}

%name parseBlock
%tokentype { L.PosToken }
%monad { Either String }
%error { parseError }

%token

rtk__eof { L.PosToken _ L.EndOfFile }
tok_Block_dummy_8 { L.PosToken _ L.Tk__tok_Block_dummy_8 }
tok_Exp_dummy_7 { L.PosToken _ L.Tk__tok_Exp_dummy_7 }
tok_Function_dummy_6 { L.PosToken _ L.Tk__tok_Function_dummy_6 }
tok_Ident_dummy_5 { L.PosToken _ L.Tk__tok_Ident_dummy_5 }
tok_ParamList_dummy_4 { L.PosToken _ L.Tk__tok_ParamList_dummy_4 }
tok_Program_dummy_9 { L.PosToken _ L.Tk__tok_Program_dummy_9 }
tok_Statement_dummy_3 { L.PosToken _ L.Tk__tok_Statement_dummy_3 }
tok_StatementList_dummy_2 { L.PosToken _ L.Tk__tok_StatementList_dummy_2 }
tok__symbol__5 { L.PosToken _ L.Tk__tok__symbol__5 }
tok__symbol__4 { L.PosToken _ L.Tk__tok__symbol__4 }
tok_return_8 { L.PosToken _ L.Tk__tok_return_8 }
tok_fn_0 { L.PosToken _ L.Tk__tok_fn_0 }
tok__eql__6 { L.PosToken _ L.Tk__tok__eql__6 }
tok__semi__7 { L.PosToken _ L.Tk__tok__semi__7 }
tok__coma__3 { L.PosToken _ L.Tk__tok__coma__3 }
tok__rparen__2 { L.PosToken _ L.Tk__tok__rparen__2 }
tok__lparen__1 { L.PosToken _ L.Tk__tok__lparen__1 }
num { L.PosToken _ (L.Tk__num _) }
id { L.PosToken _ (L.Tk__id _) }
qq_Ident { L.PosToken _ (L.Tk__qq_Ident _) }
qq_Exp { L.PosToken _ (L.Tk__qq_Exp _) }
qq_Statement { L.PosToken _ (L.Tk__qq_Statement _) }
qq_StatementList { L.PosToken _ (L.Tk__qq_StatementList _) }
qq_Block { L.PosToken _ (L.Tk__qq_Block _) }
qq_ParamList { L.PosToken _ (L.Tk__qq_ParamList _) }
qq_Function { L.PosToken _ (L.Tk__qq_Function _) }
qq_Program { L.PosToken _ (L.Tk__qq_Program _) }

%%

Block__top : Program rtk__eof { $1 }

Program : tok_Program_dummy_9 Program tok_Program_dummy_9 { Ctr__Program__0 (rtkPosOf $1) $2 } |
          tok_Block_dummy_8 Block tok_Block_dummy_8 { Ctr__Program__1 (rtkPosOf $1) $2 } |
          tok_Exp_dummy_7 Exp tok_Exp_dummy_7 { Ctr__Program__2 (rtkPosOf $1) $2 } |
          tok_Function_dummy_6 Function tok_Function_dummy_6 { Ctr__Program__3 (rtkPosOf $1) $2 } |
          tok_Ident_dummy_5 Ident tok_Ident_dummy_5 { Ctr__Program__4 (rtkPosOf $1) $2 } |
          tok_ParamList_dummy_4 ParamList tok_ParamList_dummy_4 { Ctr__Program__5 (rtkPosOf $1) (reverse $2) } |
          tok_Statement_dummy_3 Statement tok_Statement_dummy_3 { Ctr__Program__6 (rtkPosOf $1) $2 } |
          tok_StatementList_dummy_2 StatementList tok_StatementList_dummy_2 { Ctr__Program__7 (rtkPosOf $1) (reverse $2) }

Program : qq_Program { Anti_Program (tkVal_qq_Program $1) } |
          Function { Prog (rtkPosOf $1) $1 }

Block : qq_Block { Anti_Block (tkVal_qq_Block $1) } |
        tok__symbol__4 StatementList tok__symbol__5 { Blk (rtkPosOf $1) (reverse $2) }

Exp : qq_Exp { Anti_Exp (tkVal_qq_Exp $1) } |
      Ident { Var (rtkPosOf $1) $1 } |
      num { Num (rtkPosOf $1) (tkVal_num $1) }

Function : qq_Function { Anti_Function (tkVal_qq_Function $1) } |
           tok_fn_0 Ident tok__lparen__1 ParamList tok__rparen__2 Block { Func (rtkPosOf $1) $2 (reverse $4) $6 }

Ident : qq_Ident { Anti_Ident (tkVal_qq_Ident $1) } |
        id { Name (rtkPosOf $1) (tkVal_id $1) }

ListElem_ParamList0 : qq_ParamList { Anti_Ident (tkVal_qq_ParamList $1) } |
                      Ident { $1 }

ParamList__plus_list_ : ListElem_ParamList0 { [$1] } |
                        ParamList__plus_list_ tok__coma__3 ListElem_ParamList0 { $3 : $1 }

ParamList : ParamList__plus_list_ { $1 } |
            {- empty -} { [] }

Statement : qq_Statement { Anti_Statement (tkVal_qq_Statement $1) } |
            Ident tok__eql__6 Exp tok__semi__7 { Assign (rtkPosOf $1) $1 $3 } |
            tok_return_8 Exp tok__semi__7 { Return (rtkPosOf $1) $2 } |
            Block { Nested (rtkPosOf $1) $1 }

ListElem_StatementList1 : qq_StatementList { Anti_Statement (tkVal_qq_StatementList $1) } |
                          Statement { $1 }

StatementList : {- empty -} { [] } |
                StatementList ListElem_StatementList1 { $2 : $1 }


{
parseError :: [L.PosToken] -> Either String a
parseError [] = Left "unexpected end of input"
parseError (L.PosToken (L.AlexPn _ line col) tok : _) =
    Left $ show line ++ ":" ++ show col ++ ":unexpected " ++ showRtkToken tok

-- Render a token the way it appears in the source, for error messages
showRtkToken :: L.Token -> String
showRtkToken L.EndOfFile = "end of input"
showRtkToken L.Tk__tok_Block_dummy_8 = "'tok_Block_dummy_8'"
showRtkToken L.Tk__tok_Exp_dummy_7 = "'tok_Exp_dummy_7'"
showRtkToken L.Tk__tok_Function_dummy_6 = "'tok_Function_dummy_6'"
showRtkToken L.Tk__tok_Ident_dummy_5 = "'tok_Ident_dummy_5'"
showRtkToken L.Tk__tok_ParamList_dummy_4 = "'tok_ParamList_dummy_4'"
showRtkToken L.Tk__tok_Program_dummy_9 = "'tok_Program_dummy_9'"
showRtkToken L.Tk__tok_Statement_dummy_3 = "'tok_Statement_dummy_3'"
showRtkToken L.Tk__tok_StatementList_dummy_2 = "'tok_StatementList_dummy_2'"
showRtkToken L.Tk__tok__symbol__5 = "'}'"
showRtkToken L.Tk__tok__symbol__4 = "'{'"
showRtkToken L.Tk__tok_return_8 = "'return'"
showRtkToken L.Tk__tok_fn_0 = "'fn'"
showRtkToken L.Tk__tok__eql__6 = "'='"
showRtkToken L.Tk__tok__semi__7 = "';'"
showRtkToken L.Tk__tok__coma__3 = "','"
showRtkToken L.Tk__tok__rparen__2 = "')'"
showRtkToken L.Tk__tok__lparen__1 = "'('"
showRtkToken (L.Tk__num v) = "num " ++ show v
showRtkToken (L.Tk__id v) = "id " ++ show v
showRtkToken (L.Tk__qq_Ident v) = "qq_Ident " ++ show v
showRtkToken (L.Tk__qq_Exp v) = "qq_Exp " ++ show v
showRtkToken (L.Tk__qq_Statement v) = "qq_Statement " ++ show v
showRtkToken (L.Tk__qq_StatementList v) = "qq_StatementList " ++ show v
showRtkToken (L.Tk__qq_Block v) = "qq_Block " ++ show v
showRtkToken (L.Tk__qq_ParamList v) = "qq_ParamList " ++ show v
showRtkToken (L.Tk__qq_Function v) = "qq_Function " ++ show v
showRtkToken (L.Tk__qq_Program v) = "qq_Program " ++ show v

-- Source position of a node: every constructor except the Anti_* splice
-- artifacts stores the position of its alternative's first symbol in its
-- first field. Positions are transparent for equality and ordering, so two
-- ASTs that differ only in source positions (e.g. a quasi-quote parsed at
-- compile time vs the same construct parsed at run time) compare equal.
newtype RtkPos = RtkPos L.AlexPosn deriving (Show, Gen.Data, Gen.Typeable)
instance Eq RtkPos where _ == _ = True
instance Ord RtkPos where compare _ _ = EQ

-- The position used where no source token exists: empty productions, empty
-- lists, absent optionals and Anti_* quasi-quote splices
rtkNoPos :: RtkPos
rtkNoPos = RtkPos (L.AlexPn 0 0 0)

class RtkPosOf a where
    rtkPosOf :: a -> RtkPos
instance RtkPosOf L.PosToken where
    rtkPosOf (L.PosToken p _) = RtkPos p
instance RtkPosOf a => RtkPosOf [a] where
    rtkPosOf (x : _) = rtkPosOf x
    rtkPosOf []      = rtkNoPos
instance RtkPosOf a => RtkPosOf (Maybe a) where
    rtkPosOf (Just x) = rtkPosOf x
    rtkPosOf Nothing  = rtkNoPos
-- A Char carries no position; this also covers String token payloads
instance RtkPosOf Char where
    rtkPosOf _ = rtkNoPos
instance RtkPosOf Int where rtkPosOf _ = rtkNoPos

-- Recover a token's payload from the whole positioned token: %token
-- bindings keep the L.PosToken so semantic actions can read its position
tkVal_num :: L.PosToken -> Int
tkVal_num (L.PosToken _ (L.Tk__num v)) = v
tkVal_num t = error ("rtk internal error: token num expected, got " ++ showRtkToken (L.ptToken t))
tkVal_id :: L.PosToken -> String
tkVal_id (L.PosToken _ (L.Tk__id v)) = v
tkVal_id t = error ("rtk internal error: token id expected, got " ++ showRtkToken (L.ptToken t))
tkVal_qq_Ident :: L.PosToken -> String
tkVal_qq_Ident (L.PosToken _ (L.Tk__qq_Ident v)) = v
tkVal_qq_Ident t = error ("rtk internal error: token qq_Ident expected, got " ++ showRtkToken (L.ptToken t))
tkVal_qq_Exp :: L.PosToken -> String
tkVal_qq_Exp (L.PosToken _ (L.Tk__qq_Exp v)) = v
tkVal_qq_Exp t = error ("rtk internal error: token qq_Exp expected, got " ++ showRtkToken (L.ptToken t))
tkVal_qq_Statement :: L.PosToken -> String
tkVal_qq_Statement (L.PosToken _ (L.Tk__qq_Statement v)) = v
tkVal_qq_Statement t = error ("rtk internal error: token qq_Statement expected, got " ++ showRtkToken (L.ptToken t))
tkVal_qq_StatementList :: L.PosToken -> String
tkVal_qq_StatementList (L.PosToken _ (L.Tk__qq_StatementList v)) = v
tkVal_qq_StatementList t = error ("rtk internal error: token qq_StatementList expected, got " ++ showRtkToken (L.ptToken t))
tkVal_qq_Block :: L.PosToken -> String
tkVal_qq_Block (L.PosToken _ (L.Tk__qq_Block v)) = v
tkVal_qq_Block t = error ("rtk internal error: token qq_Block expected, got " ++ showRtkToken (L.ptToken t))
tkVal_qq_ParamList :: L.PosToken -> String
tkVal_qq_ParamList (L.PosToken _ (L.Tk__qq_ParamList v)) = v
tkVal_qq_ParamList t = error ("rtk internal error: token qq_ParamList expected, got " ++ showRtkToken (L.ptToken t))
tkVal_qq_Function :: L.PosToken -> String
tkVal_qq_Function (L.PosToken _ (L.Tk__qq_Function v)) = v
tkVal_qq_Function t = error ("rtk internal error: token qq_Function expected, got " ++ showRtkToken (L.ptToken t))
tkVal_qq_Program :: L.PosToken -> String
tkVal_qq_Program (L.PosToken _ (L.Tk__qq_Program v)) = v
tkVal_qq_Program t = error ("rtk internal error: token qq_Program expected, got " ++ showRtkToken (L.ptToken t))

data Program = Ctr__Program__0 RtkPos Program |
               Ctr__Program__1 RtkPos Block |
               Ctr__Program__2 RtkPos Exp |
               Ctr__Program__3 RtkPos Function |
               Ctr__Program__4 RtkPos Ident |
               Ctr__Program__5 RtkPos ParamList |
               Ctr__Program__6 RtkPos Statement |
               Ctr__Program__7 RtkPos StatementList |
               Anti_Program String |
               Prog RtkPos Function
               deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable)
instance RtkPosOf Program where
    rtkPosOf (Ctr__Program__0 p _) = p
    rtkPosOf (Ctr__Program__1 p _) = p
    rtkPosOf (Ctr__Program__2 p _) = p
    rtkPosOf (Ctr__Program__3 p _) = p
    rtkPosOf (Ctr__Program__4 p _) = p
    rtkPosOf (Ctr__Program__5 p _) = p
    rtkPosOf (Ctr__Program__6 p _) = p
    rtkPosOf (Ctr__Program__7 p _) = p
    rtkPosOf (Anti_Program _) = rtkNoPos
    rtkPosOf (Prog p _) = p
data Block = Anti_Block String |
             Blk RtkPos StatementList
             deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable)
instance RtkPosOf Block where
    rtkPosOf (Anti_Block _) = rtkNoPos
    rtkPosOf (Blk p _) = p
data Exp = Anti_Exp String |
           Var RtkPos Ident |
           Num RtkPos Int
           deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable)
instance RtkPosOf Exp where
    rtkPosOf (Anti_Exp _) = rtkNoPos
    rtkPosOf (Var p _) = p
    rtkPosOf (Num p _) = p
data Function = Anti_Function String |
                Func RtkPos Ident ParamList Block
                deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable)
instance RtkPosOf Function where
    rtkPosOf (Anti_Function _) = rtkNoPos
    rtkPosOf (Func p _ _ _) = p
data Ident = Anti_Ident String |
             Name RtkPos String
             deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable)
instance RtkPosOf Ident where
    rtkPosOf (Anti_Ident _) = rtkNoPos
    rtkPosOf (Name p _) = p
type ParamList = [Ident]
data Statement = Anti_Statement String |
                 Assign RtkPos Ident Exp |
                 Return RtkPos Exp |
                 Nested RtkPos Block
                 deriving (Ord, Eq, Show, Gen.Data, Gen.Typeable)
instance RtkPosOf Statement where
    rtkPosOf (Anti_Statement _) = rtkNoPos
    rtkPosOf (Assign p _ _) = p
    rtkPosOf (Return p _) = p
    rtkPosOf (Nested p _) = p
type StatementList = [Statement]
}