-- File generated by the BNF Converter. -- Parser definition for use with Happy. { {-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} {-# LANGUAGE PatternSynonyms #-} module ParGF ( happyError , myLexer , pGrammar , pListModDef , pModDef , pConcSpec , pListConcSpec , pConcExp , pListTransfer , pTransfer , pModType , pModBody , pListTopDef , pExtend , pListOpenDecl , pOpens , pOpenDecl , pComplMod , pQualOpen , pListIncluded , pIncluded , pDef , pTopDef , pCatDef , pFunDef , pDataDef , pDataConstr , pListDataConstr , pParDef , pParConstr , pPrintDef , pFlagDef , pListDef , pListCatDef , pListFunDef , pListDataDef , pListParDef , pListPrintDef , pListFlagDef , pListParConstr , pListIdent , pName , pListName , pLocDef , pListLocDef , pExp4 , pExp3 , pExp2 , pExp1 , pExp , pListExp , pExps , pPatt1 , pPatt , pPattAss , pLabel , pSort , pListPattAss , pPattAlt , pListPatt , pListPattAlt , pBind , pListBind , pDecl , pTupleComp , pPattTupleComp , pListTupleComp , pListPattTupleComp , pCase , pListCase , pEquation , pListEquation , pAltern , pListAltern , pDDecl , pListDDecl , pOldGrammar , pIncludeDecl , pFileName , pListFileName ) where import Prelude import qualified AbsGF import LexGF } %name pGrammar_internal Grammar %name pListModDef_internal ListModDef %name pModDef_internal ModDef %name pConcSpec_internal ConcSpec %name pListConcSpec_internal ListConcSpec %name pConcExp_internal ConcExp %name pListTransfer_internal ListTransfer %name pTransfer_internal Transfer %name pModType_internal ModType %name pModBody_internal ModBody %name pListTopDef_internal ListTopDef %name pExtend_internal Extend %name pListOpenDecl_internal ListOpenDecl %name pOpens_internal Opens %name pOpenDecl_internal OpenDecl %name pComplMod_internal ComplMod %name pQualOpen_internal QualOpen %name pListIncluded_internal ListIncluded %name pIncluded_internal Included %name pDef_internal Def %name pTopDef_internal TopDef %name pCatDef_internal CatDef %name pFunDef_internal FunDef %name pDataDef_internal DataDef %name pDataConstr_internal DataConstr %name pListDataConstr_internal ListDataConstr %name pParDef_internal ParDef %name pParConstr_internal ParConstr %name pPrintDef_internal PrintDef %name pFlagDef_internal FlagDef %name pListDef_internal ListDef %name pListCatDef_internal ListCatDef %name pListFunDef_internal ListFunDef %name pListDataDef_internal ListDataDef %name pListParDef_internal ListParDef %name pListPrintDef_internal ListPrintDef %name pListFlagDef_internal ListFlagDef %name pListParConstr_internal ListParConstr %name pListIdent_internal ListIdent %name pName_internal Name %name pListName_internal ListName %name pLocDef_internal LocDef %name pListLocDef_internal ListLocDef %name pExp4_internal Exp4 %name pExp3_internal Exp3 %name pExp2_internal Exp2 %name pExp1_internal Exp1 %name pExp_internal Exp %name pListExp_internal ListExp %name pExps_internal Exps %name pPatt1_internal Patt1 %name pPatt_internal Patt %name pPattAss_internal PattAss %name pLabel_internal Label %name pSort_internal Sort %name pListPattAss_internal ListPattAss %name pPattAlt_internal PattAlt %name pListPatt_internal ListPatt %name pListPattAlt_internal ListPattAlt %name pBind_internal Bind %name pListBind_internal ListBind %name pDecl_internal Decl %name pTupleComp_internal TupleComp %name pPattTupleComp_internal PattTupleComp %name pListTupleComp_internal ListTupleComp %name pListPattTupleComp_internal ListPattTupleComp %name pCase_internal Case %name pListCase_internal ListCase %name pEquation_internal Equation %name pListEquation_internal ListEquation %name pAltern_internal Altern %name pListAltern_internal ListAltern %name pDDecl_internal DDecl %name pListDDecl_internal ListDDecl %name pOldGrammar_internal OldGrammar %name pIncludeDecl_internal IncludeDecl %name pFileName_internal FileName %name pListFileName_internal ListFileName %monad { Err } { (>>=) } { return } %tokentype {Token} %token '!' { PT _ (TS _ 1) } '$' { PT _ (TS _ 2) } '%' { PT _ (TS _ 3) } '(' { PT _ (TS _ 4) } ')' { PT _ (TS _ 5) } '*' { PT _ (TS _ 6) } '**' { PT _ (TS _ 7) } '+' { PT _ (TS _ 8) } '++' { PT _ (TS _ 9) } ',' { PT _ (TS _ 10) } '-' { PT _ (TS _ 11) } '->' { PT _ (TS _ 12) } '.' { PT _ (TS _ 13) } '/' { PT _ (TS _ 14) } ':' { PT _ (TS _ 15) } ';' { PT _ (TS _ 16) } '<' { PT _ (TS _ 17) } '=' { PT _ (TS _ 18) } '=>' { PT _ (TS _ 19) } '>' { PT _ (TS _ 20) } '?' { PT _ (TS _ 21) } '@' { PT _ (TS _ 22) } 'Lin' { PT _ (TS _ 23) } 'PType' { PT _ (TS _ 24) } 'Str' { PT _ (TS _ 25) } 'Strs' { PT _ (TS _ 26) } 'Tok' { PT _ (TS _ 27) } 'Type' { PT _ (TS _ 28) } '[' { PT _ (TS _ 29) } '\\' { PT _ (TS _ 30) } ']' { PT _ (TS _ 31) } '_' { PT _ (TS _ 32) } 'abstract' { PT _ (TS _ 33) } 'case' { PT _ (TS _ 34) } 'cat' { PT _ (TS _ 35) } 'concrete' { PT _ (TS _ 36) } 'data' { PT _ (TS _ 37) } 'def' { PT _ (TS _ 38) } 'flags' { PT _ (TS _ 39) } 'fn' { PT _ (TS _ 40) } 'fun' { PT _ (TS _ 41) } 'grammar' { PT _ (TS _ 42) } 'in' { PT _ (TS _ 43) } 'include' { PT _ (TS _ 44) } 'incomplete' { PT _ (TS _ 45) } 'instance' { PT _ (TS _ 46) } 'interface' { PT _ (TS _ 47) } 'let' { PT _ (TS _ 48) } 'lin' { PT _ (TS _ 49) } 'lincat' { PT _ (TS _ 50) } 'lindef' { PT _ (TS _ 51) } 'lintype' { PT _ (TS _ 52) } 'of' { PT _ (TS _ 53) } 'open' { PT _ (TS _ 54) } 'oper' { PT _ (TS _ 55) } 'out' { PT _ (TS _ 56) } 'package' { PT _ (TS _ 57) } 'param' { PT _ (TS _ 58) } 'pattern' { PT _ (TS _ 59) } 'pre' { PT _ (TS _ 60) } 'printname' { PT _ (TS _ 61) } 'resource' { PT _ (TS _ 62) } 'reuse' { PT _ (TS _ 63) } 'strs' { PT _ (TS _ 64) } 'table' { PT _ (TS _ 65) } 'tokenizer' { PT _ (TS _ 66) } 'transfer' { PT _ (TS _ 67) } 'union' { PT _ (TS _ 68) } 'var' { PT _ (TS _ 69) } 'variants' { PT _ (TS _ 70) } 'where' { PT _ (TS _ 71) } 'with' { PT _ (TS _ 72) } '{' { PT _ (TS _ 73) } '|' { PT _ (TS _ 74) } '}' { PT _ (TS _ 75) } L_Ident { PT _ (TV _)} L_integ { PT _ (TI _)} L_quoted { PT _ (TL _)} L_LString { PT _ (T_LString _) } %% Ident :: { (AbsGF.BNFC'Position, AbsGF.Ident) } Ident : L_Ident { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.Ident (tokenText $1)) } Integer :: { (AbsGF.BNFC'Position, Integer) } Integer : L_integ { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), (read (tokenText $1) ) :: Integer) } String :: { (AbsGF.BNFC'Position, String) } String : L_quoted { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), ((\(PT _ (TL s)) -> s) $1)) } LString :: { (AbsGF.BNFC'Position, AbsGF.LString) } LString : L_LString { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.LString (tokenText $1)) } Grammar :: { (AbsGF.BNFC'Position, AbsGF.Grammar) } Grammar : ListModDef { (fst $1, AbsGF.Gr (fst $1) (snd $1)) } ListModDef :: { (AbsGF.BNFC'Position, [AbsGF.ModDef]) } ListModDef : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | ModDef ListModDef { (fst $1, (:) (snd $1) (snd $2)) } ModDef :: { (AbsGF.BNFC'Position, AbsGF.ModDef) } ModDef : 'grammar' Ident '=' '{' 'abstract' '=' Ident ';' ListConcSpec '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.MMain (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $7) (snd $9)) } | ComplMod ModType '=' ModBody { (fst $1, AbsGF.MModule (fst $1) (snd $1) (snd $2) (snd $4)) } | ModDef ';' { (fst $1, (snd $1)) } ConcSpec :: { (AbsGF.BNFC'Position, AbsGF.ConcSpec) } ConcSpec : Ident '=' ConcExp { (fst $1, AbsGF.ConcSpecC (fst $1) (snd $1) (snd $3)) } ListConcSpec :: { (AbsGF.BNFC'Position, [AbsGF.ConcSpec]) } ListConcSpec : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | ConcSpec { (fst $1, (:[]) (snd $1)) } | ConcSpec ';' ListConcSpec { (fst $1, (:) (snd $1) (snd $3)) } ConcExp :: { (AbsGF.BNFC'Position, AbsGF.ConcExp) } ConcExp : Ident ListTransfer { (fst $1, AbsGF.ConcExpC (fst $1) (snd $1) (snd $2)) } ListTransfer :: { (AbsGF.BNFC'Position, [AbsGF.Transfer]) } ListTransfer : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | Transfer ListTransfer { (fst $1, (:) (snd $1) (snd $2)) } Transfer :: { (AbsGF.BNFC'Position, AbsGF.Transfer) } Transfer : '(' 'transfer' 'in' OpenDecl ')' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.TransferIn (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $4)) } | '(' 'transfer' 'out' OpenDecl ')' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.TransferOut (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $4)) } ModType :: { (AbsGF.BNFC'Position, AbsGF.ModType) } ModType : 'abstract' Ident { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.MTAbstract (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'concrete' Ident 'of' Ident { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.MTConcrete (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) } | 'instance' Ident 'of' Ident { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.MTInstance (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) } | 'interface' Ident { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.MTInterface (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'resource' Ident { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.MTResource (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'transfer' Ident ':' OpenDecl '->' OpenDecl { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.MTTransfer (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4) (snd $6)) } ModBody :: { (AbsGF.BNFC'Position, AbsGF.ModBody) } ModBody : 'reuse' Ident { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.MReuse (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'union' ListIncluded { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.MUnion (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | Ident 'with' ListOpenDecl { (fst $1, AbsGF.MWith (fst $1) (snd $1) (snd $3)) } | Extend Opens '{' ListTopDef '}' { (fst $1, AbsGF.MBody (fst $1) (snd $1) (snd $2) (snd $4)) } | ListIncluded '**' Ident 'with' ListOpenDecl { (fst $1, AbsGF.MWithE (fst $1) (snd $1) (snd $3) (snd $5)) } ListTopDef :: { (AbsGF.BNFC'Position, [AbsGF.TopDef]) } ListTopDef : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | TopDef ListTopDef { (fst $1, (:) (snd $1) (snd $2)) } Extend :: { (AbsGF.BNFC'Position, AbsGF.Extend) } Extend : {- empty -} { (AbsGF.BNFC'NoPosition, AbsGF.NoExt (AbsGF.BNFC'NoPosition)) } | ListIncluded '**' { (fst $1, AbsGF.Ext (fst $1) (snd $1)) } ListOpenDecl :: { (AbsGF.BNFC'Position, [AbsGF.OpenDecl]) } ListOpenDecl : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | OpenDecl { (fst $1, (:[]) (snd $1)) } | OpenDecl ',' ListOpenDecl { (fst $1, (:) (snd $1) (snd $3)) } Opens :: { (AbsGF.BNFC'Position, AbsGF.Opens) } Opens : {- empty -} { (AbsGF.BNFC'NoPosition, AbsGF.NoOpens (AbsGF.BNFC'NoPosition)) } | 'open' ListOpenDecl 'in' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.OpenIn (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } OpenDecl :: { (AbsGF.BNFC'Position, AbsGF.OpenDecl) } OpenDecl : '(' QualOpen Ident ')' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.OQualQO (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $3)) } | '(' QualOpen Ident '=' Ident ')' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.OQual (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $3) (snd $5)) } | Ident { (fst $1, AbsGF.OName (fst $1) (snd $1)) } ComplMod :: { (AbsGF.BNFC'Position, AbsGF.ComplMod) } ComplMod : {- empty -} { (AbsGF.BNFC'NoPosition, AbsGF.CMCompl (AbsGF.BNFC'NoPosition)) } | 'incomplete' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.CMIncompl (uncurry AbsGF.BNFC'Position (tokenLineCol $1))) } QualOpen :: { (AbsGF.BNFC'Position, AbsGF.QualOpen) } QualOpen : {- empty -} { (AbsGF.BNFC'NoPosition, AbsGF.QOCompl (AbsGF.BNFC'NoPosition)) } | 'incomplete' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.QOIncompl (uncurry AbsGF.BNFC'Position (tokenLineCol $1))) } | 'interface' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.QOInterface (uncurry AbsGF.BNFC'Position (tokenLineCol $1))) } ListIncluded :: { (AbsGF.BNFC'Position, [AbsGF.Included]) } ListIncluded : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | Included { (fst $1, (:[]) (snd $1)) } | Included ',' ListIncluded { (fst $1, (:) (snd $1) (snd $3)) } Included :: { (AbsGF.BNFC'Position, AbsGF.Included) } Included : Ident { (fst $1, AbsGF.IAll (fst $1) (snd $1)) } | Ident '-' '[' ListIdent ']' { (fst $1, AbsGF.IMinus (fst $1) (snd $1) (snd $4)) } | Ident '[' ListIdent ']' { (fst $1, AbsGF.ISome (fst $1) (snd $1) (snd $3)) } Def :: { (AbsGF.BNFC'Position, AbsGF.Def) } Def : Name ListPatt '=' Exp { (fst $1, AbsGF.DPatt (fst $1) (snd $1) (snd $2) (snd $4)) } | ListName ':' Exp { (fst $1, AbsGF.DDeclC (fst $1) (snd $1) (snd $3)) } | ListName ':' Exp '=' Exp { (fst $1, AbsGF.DFull (fst $1) (snd $1) (snd $3) (snd $5)) } | ListName '=' Exp { (fst $1, AbsGF.DDef (fst $1) (snd $1) (snd $3)) } TopDef :: { (AbsGF.BNFC'Position, AbsGF.TopDef) } TopDef : 'cat' ListCatDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefCat (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'data' ListDataDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefData (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'data' ListFunDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefFunData (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'def' ListDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefDef (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'flags' ListFlagDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefFlag (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'fun' ListFunDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefFun (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'lin' ListDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefLin (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'lincat' ListPrintDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefLincat (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'lindef' ListDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefLindef (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'lintype' ListDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefLintype (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'oper' ListDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefOper (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'package' Ident '=' '{' ListTopDef '}' ';' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefPackage (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $5)) } | 'param' ListParDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefPar (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'pattern' ListDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefPattern (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'printname' 'cat' ListPrintDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefPrintCat (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $3)) } | 'printname' 'fun' ListPrintDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefPrintFun (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $3)) } | 'printname' ListPrintDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefPrintOld (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'tokenizer' Ident ';' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefTokenizer (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'transfer' ListDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefTrans (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'var' ListDef { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DefVars (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } CatDef :: { (AbsGF.BNFC'Position, AbsGF.CatDef) } CatDef : '[' Ident ListDDecl ']' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ListCatDefC (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $3)) } | '[' Ident ListDDecl ']' '{' Integer '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ListSizeCatDef (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $3) (snd $6)) } | Ident ListDDecl { (fst $1, AbsGF.SimpleCatDef (fst $1) (snd $1) (snd $2)) } FunDef :: { (AbsGF.BNFC'Position, AbsGF.FunDef) } FunDef : ListIdent ':' Exp { (fst $1, AbsGF.FunDefC (fst $1) (snd $1) (snd $3)) } DataDef :: { (AbsGF.BNFC'Position, AbsGF.DataDef) } DataDef : Ident '=' ListDataConstr { (fst $1, AbsGF.DataDefC (fst $1) (snd $1) (snd $3)) } DataConstr :: { (AbsGF.BNFC'Position, AbsGF.DataConstr) } DataConstr : Ident { (fst $1, AbsGF.DataId (fst $1) (snd $1)) } | Ident '.' Ident { (fst $1, AbsGF.DataQId (fst $1) (snd $1) (snd $3)) } ListDataConstr :: { (AbsGF.BNFC'Position, [AbsGF.DataConstr]) } ListDataConstr : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | DataConstr { (fst $1, (:[]) (snd $1)) } | DataConstr '|' ListDataConstr { (fst $1, (:) (snd $1) (snd $3)) } ParDef :: { (AbsGF.BNFC'Position, AbsGF.ParDef) } ParDef : Ident { (fst $1, AbsGF.ParDefAbs (fst $1) (snd $1)) } | Ident '=' '(' 'in' Ident ')' { (fst $1, AbsGF.ParDefIndir (fst $1) (snd $1) (snd $5)) } | Ident '=' ListParConstr { (fst $1, AbsGF.ParDefDir (fst $1) (snd $1) (snd $3)) } ParConstr :: { (AbsGF.BNFC'Position, AbsGF.ParConstr) } ParConstr : Ident ListDDecl { (fst $1, AbsGF.ParConstrC (fst $1) (snd $1) (snd $2)) } PrintDef :: { (AbsGF.BNFC'Position, AbsGF.PrintDef) } PrintDef : ListName '=' Exp { (fst $1, AbsGF.PrintDefC (fst $1) (snd $1) (snd $3)) } FlagDef :: { (AbsGF.BNFC'Position, AbsGF.FlagDef) } FlagDef : Ident '=' Ident { (fst $1, AbsGF.FlagDefC (fst $1) (snd $1) (snd $3)) } ListDef :: { (AbsGF.BNFC'Position, [AbsGF.Def]) } ListDef : Def ';' { (fst $1, (:[]) (snd $1)) } | Def ';' ListDef { (fst $1, (:) (snd $1) (snd $3)) } ListCatDef :: { (AbsGF.BNFC'Position, [AbsGF.CatDef]) } ListCatDef : CatDef ';' { (fst $1, (:[]) (snd $1)) } | CatDef ';' ListCatDef { (fst $1, (:) (snd $1) (snd $3)) } ListFunDef :: { (AbsGF.BNFC'Position, [AbsGF.FunDef]) } ListFunDef : FunDef ';' { (fst $1, (:[]) (snd $1)) } | FunDef ';' ListFunDef { (fst $1, (:) (snd $1) (snd $3)) } ListDataDef :: { (AbsGF.BNFC'Position, [AbsGF.DataDef]) } ListDataDef : DataDef ';' { (fst $1, (:[]) (snd $1)) } | DataDef ';' ListDataDef { (fst $1, (:) (snd $1) (snd $3)) } ListParDef :: { (AbsGF.BNFC'Position, [AbsGF.ParDef]) } ListParDef : ParDef ';' { (fst $1, (:[]) (snd $1)) } | ParDef ';' ListParDef { (fst $1, (:) (snd $1) (snd $3)) } ListPrintDef :: { (AbsGF.BNFC'Position, [AbsGF.PrintDef]) } ListPrintDef : PrintDef ';' { (fst $1, (:[]) (snd $1)) } | PrintDef ';' ListPrintDef { (fst $1, (:) (snd $1) (snd $3)) } ListFlagDef :: { (AbsGF.BNFC'Position, [AbsGF.FlagDef]) } ListFlagDef : FlagDef ';' { (fst $1, (:[]) (snd $1)) } | FlagDef ';' ListFlagDef { (fst $1, (:) (snd $1) (snd $3)) } ListParConstr :: { (AbsGF.BNFC'Position, [AbsGF.ParConstr]) } ListParConstr : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | ParConstr { (fst $1, (:[]) (snd $1)) } | ParConstr '|' ListParConstr { (fst $1, (:) (snd $1) (snd $3)) } ListIdent :: { (AbsGF.BNFC'Position, [AbsGF.Ident]) } ListIdent : Ident { (fst $1, (:[]) (snd $1)) } | Ident ',' ListIdent { (fst $1, (:) (snd $1) (snd $3)) } Name :: { (AbsGF.BNFC'Position, AbsGF.Name) } Name : '[' Ident ']' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ListNameC (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | Ident { (fst $1, AbsGF.IdentName (fst $1) (snd $1)) } ListName :: { (AbsGF.BNFC'Position, [AbsGF.Name]) } ListName : Name { (fst $1, (:[]) (snd $1)) } | Name ',' ListName { (fst $1, (:) (snd $1) (snd $3)) } LocDef :: { (AbsGF.BNFC'Position, AbsGF.LocDef) } LocDef : ListIdent ':' Exp { (fst $1, AbsGF.LDDecl (fst $1) (snd $1) (snd $3)) } | ListIdent ':' Exp '=' Exp { (fst $1, AbsGF.LDFull (fst $1) (snd $1) (snd $3) (snd $5)) } | ListIdent '=' Exp { (fst $1, AbsGF.LDDef (fst $1) (snd $1) (snd $3)) } ListLocDef :: { (AbsGF.BNFC'Position, [AbsGF.LocDef]) } ListLocDef : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | LocDef { (fst $1, (:[]) (snd $1)) } | LocDef ';' ListLocDef { (fst $1, (:) (snd $1) (snd $3)) } Exp4 :: { (AbsGF.BNFC'Position, AbsGF.Exp) } Exp4 : '%' Ident '%' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ECons (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | '(' 'in' Ident ')' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EIndir (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $3)) } | '(' Exp ')' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), (snd $2)) } | '<' Exp ':' Exp '>' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ETyped (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) } | '<' ListTupleComp '>' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ETuple (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | '?' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EMeta (uncurry AbsGF.BNFC'Position (tokenLineCol $1))) } | '[' ']' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EEmpty (uncurry AbsGF.BNFC'Position (tokenLineCol $1))) } | '[' String ']' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EStrings (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | '[' Ident Exps ']' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EList (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $3)) } | 'data' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EData (uncurry AbsGF.BNFC'Position (tokenLineCol $1))) } | '{' Ident '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EConstr (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | '{' ListLocDef '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ERecord (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | Integer { (fst $1, AbsGF.EInt (fst $1) (snd $1)) } | String { (fst $1, AbsGF.EString (fst $1) (snd $1)) } | Ident { (fst $1, AbsGF.EIdent (fst $1) (snd $1)) } | LString { (fst $1, AbsGF.ELString (fst $1) (snd $1)) } | Sort { (fst $1, AbsGF.ESort (fst $1) (snd $1)) } Exp3 :: { (AbsGF.BNFC'Position, AbsGF.Exp) } Exp3 : '%' Ident '.' Ident { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EQCons (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) } | '{' Ident '.' Ident '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EQConstr (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) } | Exp3 '.' Label { (fst $1, AbsGF.EProj (fst $1) (snd $1) (snd $3)) } | Exp4 { (fst $1, (snd $1)) } Exp2 :: { (AbsGF.BNFC'Position, AbsGF.Exp) } Exp2 : 'Lin' Ident { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ELin (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | 'case' Exp 'of' '{' ListCase '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ECase (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $5)) } | 'pre' '{' Exp ';' ListAltern '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EPre (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $3) (snd $5)) } | 'strs' '{' ListExp '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EStrs (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $3)) } | 'table' '{' ListCase '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ETable (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $3)) } | 'table' Exp4 '[' ListExp ']' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EVTable (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) } | 'table' Exp4 '{' ListCase '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ETTable (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) } | 'variants' '{' ListExp '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EVariants (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $3)) } | Ident '@' Exp4 { (fst $1, AbsGF.EConAt (fst $1) (snd $1) (snd $3)) } | Exp2 Exp3 { (fst $1, AbsGF.EApp (fst $1) (snd $1) (snd $2)) } | Exp3 { (fst $1, (snd $1)) } Exp1 :: { (AbsGF.BNFC'Position, AbsGF.Exp) } Exp1 : Exp1 '!' Exp2 { (fst $1, AbsGF.ESelect (fst $1) (snd $1) (snd $3)) } | Exp1 '*' Exp2 { (fst $1, AbsGF.ETupTyp (fst $1) (snd $1) (snd $3)) } | Exp1 '**' Exp2 { (fst $1, AbsGF.EExtend (fst $1) (snd $1) (snd $3)) } | Exp2 { (fst $1, (snd $1)) } Exp :: { (AbsGF.BNFC'Position, AbsGF.Exp) } Exp : '\\' '\\' ListBind '=>' Exp { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ECTable (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $3) (snd $5)) } | '\\' ListBind '->' Exp { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EAbstr (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) } | 'fn' '{' ListEquation '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.EEqs (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $3)) } | 'let' '{' ListLocDef '}' 'in' Exp { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ELet (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $3) (snd $6)) } | 'let' ListLocDef 'in' Exp { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.ELetb (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) } | Decl '->' Exp { (fst $1, AbsGF.EProd (fst $1) (snd $1) (snd $3)) } | Exp1 { (fst $1, (snd $1)) } | Exp1 '+' Exp { (fst $1, AbsGF.EGlue (fst $1) (snd $1) (snd $3)) } | Exp1 '++' Exp { (fst $1, AbsGF.EConcat (fst $1) (snd $1) (snd $3)) } | Exp1 '=>' Exp { (fst $1, AbsGF.ETType (fst $1) (snd $1) (snd $3)) } | Exp1 'where' '{' ListLocDef '}' { (fst $1, AbsGF.EWhere (fst $1) (snd $1) (snd $4)) } ListExp :: { (AbsGF.BNFC'Position, [AbsGF.Exp]) } ListExp : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | Exp { (fst $1, (:[]) (snd $1)) } | Exp ';' ListExp { (fst $1, (:) (snd $1) (snd $3)) } Exps :: { (AbsGF.BNFC'Position, AbsGF.Exps) } Exps : {- empty -} { (AbsGF.BNFC'NoPosition, AbsGF.NilExp (AbsGF.BNFC'NoPosition)) } | Exp4 Exps { (fst $1, AbsGF.ConsExp (fst $1) (snd $1) (snd $2)) } Patt1 :: { (AbsGF.BNFC'Position, AbsGF.Patt) } Patt1 : '(' Patt ')' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), (snd $2)) } | '<' ListPattTupleComp '>' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.PTup (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | '_' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.PW (uncurry AbsGF.BNFC'Position (tokenLineCol $1))) } | '{' Ident '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.PCon (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | '{' ListPattAss '}' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.PR (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | Integer { (fst $1, AbsGF.PInt (fst $1) (snd $1)) } | String { (fst $1, AbsGF.PStr (fst $1) (snd $1)) } | Ident { (fst $1, AbsGF.PV (fst $1) (snd $1)) } | Ident '.' Ident { (fst $1, AbsGF.PQ (fst $1) (snd $1) (snd $3)) } Patt :: { (AbsGF.BNFC'Position, AbsGF.Patt) } Patt : Ident '.' Ident ListPatt { (fst $1, AbsGF.PQC (fst $1) (snd $1) (snd $3) (snd $4)) } | Ident ListPatt { (fst $1, AbsGF.PC (fst $1) (snd $1) (snd $2)) } | Patt1 { (fst $1, (snd $1)) } PattAss :: { (AbsGF.BNFC'Position, AbsGF.PattAss) } PattAss : ListIdent '=' Patt { (fst $1, AbsGF.PA (fst $1) (snd $1) (snd $3)) } Label :: { (AbsGF.BNFC'Position, AbsGF.Label) } Label : '$' Integer { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.LVar (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | Ident { (fst $1, AbsGF.LIdent (fst $1) (snd $1)) } Sort :: { (AbsGF.BNFC'Position, AbsGF.Sort) } Sort : 'PType' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.Sort_PType (uncurry AbsGF.BNFC'Position (tokenLineCol $1))) } | 'Str' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.Sort_Str (uncurry AbsGF.BNFC'Position (tokenLineCol $1))) } | 'Strs' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.Sort_Strs (uncurry AbsGF.BNFC'Position (tokenLineCol $1))) } | 'Tok' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.Sort_Tok (uncurry AbsGF.BNFC'Position (tokenLineCol $1))) } | 'Type' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.Sort_Type (uncurry AbsGF.BNFC'Position (tokenLineCol $1))) } ListPattAss :: { (AbsGF.BNFC'Position, [AbsGF.PattAss]) } ListPattAss : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | PattAss { (fst $1, (:[]) (snd $1)) } | PattAss ';' ListPattAss { (fst $1, (:) (snd $1) (snd $3)) } PattAlt :: { (AbsGF.BNFC'Position, AbsGF.PattAlt) } PattAlt : Patt { (fst $1, AbsGF.AltP (fst $1) (snd $1)) } ListPatt :: { (AbsGF.BNFC'Position, [AbsGF.Patt]) } ListPatt : Patt1 { (fst $1, (:[]) (snd $1)) } | Patt1 ListPatt { (fst $1, (:) (snd $1) (snd $2)) } ListPattAlt :: { (AbsGF.BNFC'Position, [AbsGF.PattAlt]) } ListPattAlt : PattAlt { (fst $1, (:[]) (snd $1)) } | PattAlt '|' ListPattAlt { (fst $1, (:) (snd $1) (snd $3)) } Bind :: { (AbsGF.BNFC'Position, AbsGF.Bind) } Bind : '_' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.BWild (uncurry AbsGF.BNFC'Position (tokenLineCol $1))) } | Ident { (fst $1, AbsGF.BIdent (fst $1) (snd $1)) } ListBind :: { (AbsGF.BNFC'Position, [AbsGF.Bind]) } ListBind : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | Bind { (fst $1, (:[]) (snd $1)) } | Bind ',' ListBind { (fst $1, (:) (snd $1) (snd $3)) } Decl :: { (AbsGF.BNFC'Position, AbsGF.Decl) } Decl : '(' ListBind ':' Exp ')' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DDec (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) } | Exp2 { (fst $1, AbsGF.DExp (fst $1) (snd $1)) } TupleComp :: { (AbsGF.BNFC'Position, AbsGF.TupleComp) } TupleComp : Exp { (fst $1, AbsGF.TComp (fst $1) (snd $1)) } PattTupleComp :: { (AbsGF.BNFC'Position, AbsGF.PattTupleComp) } PattTupleComp : Patt { (fst $1, AbsGF.PTComp (fst $1) (snd $1)) } ListTupleComp :: { (AbsGF.BNFC'Position, [AbsGF.TupleComp]) } ListTupleComp : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | TupleComp { (fst $1, (:[]) (snd $1)) } | TupleComp ',' ListTupleComp { (fst $1, (:) (snd $1) (snd $3)) } ListPattTupleComp :: { (AbsGF.BNFC'Position, [AbsGF.PattTupleComp]) } ListPattTupleComp : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | PattTupleComp { (fst $1, (:[]) (snd $1)) } | PattTupleComp ',' ListPattTupleComp { (fst $1, (:) (snd $1) (snd $3)) } Case :: { (AbsGF.BNFC'Position, AbsGF.Case) } Case : ListPattAlt '=>' Exp { (fst $1, AbsGF.CaseC (fst $1) (snd $1) (snd $3)) } ListCase :: { (AbsGF.BNFC'Position, [AbsGF.Case]) } ListCase : Case { (fst $1, (:[]) (snd $1)) } | Case ';' ListCase { (fst $1, (:) (snd $1) (snd $3)) } Equation :: { (AbsGF.BNFC'Position, AbsGF.Equation) } Equation : ListPatt '->' Exp { (fst $1, AbsGF.Equ (fst $1) (snd $1) (snd $3)) } ListEquation :: { (AbsGF.BNFC'Position, [AbsGF.Equation]) } ListEquation : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | Equation { (fst $1, (:[]) (snd $1)) } | Equation ';' ListEquation { (fst $1, (:) (snd $1) (snd $3)) } Altern :: { (AbsGF.BNFC'Position, AbsGF.Altern) } Altern : Exp '/' Exp { (fst $1, AbsGF.Alt (fst $1) (snd $1) (snd $3)) } ListAltern :: { (AbsGF.BNFC'Position, [AbsGF.Altern]) } ListAltern : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | Altern { (fst $1, (:[]) (snd $1)) } | Altern ';' ListAltern { (fst $1, (:) (snd $1) (snd $3)) } DDecl :: { (AbsGF.BNFC'Position, AbsGF.DDecl) } DDecl : '(' ListBind ':' Exp ')' { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.DDDec (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2) (snd $4)) } | Exp4 { (fst $1, AbsGF.DDExp (fst $1) (snd $1)) } ListDDecl :: { (AbsGF.BNFC'Position, [AbsGF.DDecl]) } ListDDecl : {- empty -} { (AbsGF.BNFC'NoPosition, []) } | DDecl ListDDecl { (fst $1, (:) (snd $1) (snd $2)) } OldGrammar :: { (AbsGF.BNFC'Position, AbsGF.OldGrammar) } OldGrammar : IncludeDecl ListTopDef { (fst $1, AbsGF.OldGr (fst $1) (snd $1) (snd $2)) } IncludeDecl :: { (AbsGF.BNFC'Position, AbsGF.IncludeDecl) } IncludeDecl : {- empty -} { (AbsGF.BNFC'NoPosition, AbsGF.NoIncl (AbsGF.BNFC'NoPosition)) } | 'include' ListFileName { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.Incl (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } FileName :: { (AbsGF.BNFC'Position, AbsGF.FileName) } FileName : '-' FileName { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.FMinus (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | '.' FileName { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.FDot (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | '/' FileName { (uncurry AbsGF.BNFC'Position (tokenLineCol $1), AbsGF.FSlash (uncurry AbsGF.BNFC'Position (tokenLineCol $1)) (snd $2)) } | String { (fst $1, AbsGF.FString (fst $1) (snd $1)) } | Ident { (fst $1, AbsGF.FIdent (fst $1) (snd $1)) } | Ident FileName { (fst $1, AbsGF.FAddId (fst $1) (snd $1) (snd $2)) } ListFileName :: { (AbsGF.BNFC'Position, [AbsGF.FileName]) } ListFileName : FileName ';' { (fst $1, (:[]) (snd $1)) } | FileName ';' ListFileName { (fst $1, (:) (snd $1) (snd $3)) } { type Err = Either String happyError :: [Token] -> Err a happyError ts = Left $ "syntax error at " ++ tokenPos ts ++ case ts of [] -> [] [Err _] -> " due to lexer error" t:_ -> " before `" ++ (prToken t) ++ "'" myLexer :: String -> [Token] myLexer = tokens -- Entrypoints pGrammar :: [Token] -> Err AbsGF.Grammar pGrammar = fmap snd . pGrammar_internal pListModDef :: [Token] -> Err [AbsGF.ModDef] pListModDef = fmap snd . pListModDef_internal pModDef :: [Token] -> Err AbsGF.ModDef pModDef = fmap snd . pModDef_internal pConcSpec :: [Token] -> Err AbsGF.ConcSpec pConcSpec = fmap snd . pConcSpec_internal pListConcSpec :: [Token] -> Err [AbsGF.ConcSpec] pListConcSpec = fmap snd . pListConcSpec_internal pConcExp :: [Token] -> Err AbsGF.ConcExp pConcExp = fmap snd . pConcExp_internal pListTransfer :: [Token] -> Err [AbsGF.Transfer] pListTransfer = fmap snd . pListTransfer_internal pTransfer :: [Token] -> Err AbsGF.Transfer pTransfer = fmap snd . pTransfer_internal pModType :: [Token] -> Err AbsGF.ModType pModType = fmap snd . pModType_internal pModBody :: [Token] -> Err AbsGF.ModBody pModBody = fmap snd . pModBody_internal pListTopDef :: [Token] -> Err [AbsGF.TopDef] pListTopDef = fmap snd . pListTopDef_internal pExtend :: [Token] -> Err AbsGF.Extend pExtend = fmap snd . pExtend_internal pListOpenDecl :: [Token] -> Err [AbsGF.OpenDecl] pListOpenDecl = fmap snd . pListOpenDecl_internal pOpens :: [Token] -> Err AbsGF.Opens pOpens = fmap snd . pOpens_internal pOpenDecl :: [Token] -> Err AbsGF.OpenDecl pOpenDecl = fmap snd . pOpenDecl_internal pComplMod :: [Token] -> Err AbsGF.ComplMod pComplMod = fmap snd . pComplMod_internal pQualOpen :: [Token] -> Err AbsGF.QualOpen pQualOpen = fmap snd . pQualOpen_internal pListIncluded :: [Token] -> Err [AbsGF.Included] pListIncluded = fmap snd . pListIncluded_internal pIncluded :: [Token] -> Err AbsGF.Included pIncluded = fmap snd . pIncluded_internal pDef :: [Token] -> Err AbsGF.Def pDef = fmap snd . pDef_internal pTopDef :: [Token] -> Err AbsGF.TopDef pTopDef = fmap snd . pTopDef_internal pCatDef :: [Token] -> Err AbsGF.CatDef pCatDef = fmap snd . pCatDef_internal pFunDef :: [Token] -> Err AbsGF.FunDef pFunDef = fmap snd . pFunDef_internal pDataDef :: [Token] -> Err AbsGF.DataDef pDataDef = fmap snd . pDataDef_internal pDataConstr :: [Token] -> Err AbsGF.DataConstr pDataConstr = fmap snd . pDataConstr_internal pListDataConstr :: [Token] -> Err [AbsGF.DataConstr] pListDataConstr = fmap snd . pListDataConstr_internal pParDef :: [Token] -> Err AbsGF.ParDef pParDef = fmap snd . pParDef_internal pParConstr :: [Token] -> Err AbsGF.ParConstr pParConstr = fmap snd . pParConstr_internal pPrintDef :: [Token] -> Err AbsGF.PrintDef pPrintDef = fmap snd . pPrintDef_internal pFlagDef :: [Token] -> Err AbsGF.FlagDef pFlagDef = fmap snd . pFlagDef_internal pListDef :: [Token] -> Err [AbsGF.Def] pListDef = fmap snd . pListDef_internal pListCatDef :: [Token] -> Err [AbsGF.CatDef] pListCatDef = fmap snd . pListCatDef_internal pListFunDef :: [Token] -> Err [AbsGF.FunDef] pListFunDef = fmap snd . pListFunDef_internal pListDataDef :: [Token] -> Err [AbsGF.DataDef] pListDataDef = fmap snd . pListDataDef_internal pListParDef :: [Token] -> Err [AbsGF.ParDef] pListParDef = fmap snd . pListParDef_internal pListPrintDef :: [Token] -> Err [AbsGF.PrintDef] pListPrintDef = fmap snd . pListPrintDef_internal pListFlagDef :: [Token] -> Err [AbsGF.FlagDef] pListFlagDef = fmap snd . pListFlagDef_internal pListParConstr :: [Token] -> Err [AbsGF.ParConstr] pListParConstr = fmap snd . pListParConstr_internal pListIdent :: [Token] -> Err [AbsGF.Ident] pListIdent = fmap snd . pListIdent_internal pName :: [Token] -> Err AbsGF.Name pName = fmap snd . pName_internal pListName :: [Token] -> Err [AbsGF.Name] pListName = fmap snd . pListName_internal pLocDef :: [Token] -> Err AbsGF.LocDef pLocDef = fmap snd . pLocDef_internal pListLocDef :: [Token] -> Err [AbsGF.LocDef] pListLocDef = fmap snd . pListLocDef_internal pExp4 :: [Token] -> Err AbsGF.Exp pExp4 = fmap snd . pExp4_internal pExp3 :: [Token] -> Err AbsGF.Exp pExp3 = fmap snd . pExp3_internal pExp2 :: [Token] -> Err AbsGF.Exp pExp2 = fmap snd . pExp2_internal pExp1 :: [Token] -> Err AbsGF.Exp pExp1 = fmap snd . pExp1_internal pExp :: [Token] -> Err AbsGF.Exp pExp = fmap snd . pExp_internal pListExp :: [Token] -> Err [AbsGF.Exp] pListExp = fmap snd . pListExp_internal pExps :: [Token] -> Err AbsGF.Exps pExps = fmap snd . pExps_internal pPatt1 :: [Token] -> Err AbsGF.Patt pPatt1 = fmap snd . pPatt1_internal pPatt :: [Token] -> Err AbsGF.Patt pPatt = fmap snd . pPatt_internal pPattAss :: [Token] -> Err AbsGF.PattAss pPattAss = fmap snd . pPattAss_internal pLabel :: [Token] -> Err AbsGF.Label pLabel = fmap snd . pLabel_internal pSort :: [Token] -> Err AbsGF.Sort pSort = fmap snd . pSort_internal pListPattAss :: [Token] -> Err [AbsGF.PattAss] pListPattAss = fmap snd . pListPattAss_internal pPattAlt :: [Token] -> Err AbsGF.PattAlt pPattAlt = fmap snd . pPattAlt_internal pListPatt :: [Token] -> Err [AbsGF.Patt] pListPatt = fmap snd . pListPatt_internal pListPattAlt :: [Token] -> Err [AbsGF.PattAlt] pListPattAlt = fmap snd . pListPattAlt_internal pBind :: [Token] -> Err AbsGF.Bind pBind = fmap snd . pBind_internal pListBind :: [Token] -> Err [AbsGF.Bind] pListBind = fmap snd . pListBind_internal pDecl :: [Token] -> Err AbsGF.Decl pDecl = fmap snd . pDecl_internal pTupleComp :: [Token] -> Err AbsGF.TupleComp pTupleComp = fmap snd . pTupleComp_internal pPattTupleComp :: [Token] -> Err AbsGF.PattTupleComp pPattTupleComp = fmap snd . pPattTupleComp_internal pListTupleComp :: [Token] -> Err [AbsGF.TupleComp] pListTupleComp = fmap snd . pListTupleComp_internal pListPattTupleComp :: [Token] -> Err [AbsGF.PattTupleComp] pListPattTupleComp = fmap snd . pListPattTupleComp_internal pCase :: [Token] -> Err AbsGF.Case pCase = fmap snd . pCase_internal pListCase :: [Token] -> Err [AbsGF.Case] pListCase = fmap snd . pListCase_internal pEquation :: [Token] -> Err AbsGF.Equation pEquation = fmap snd . pEquation_internal pListEquation :: [Token] -> Err [AbsGF.Equation] pListEquation = fmap snd . pListEquation_internal pAltern :: [Token] -> Err AbsGF.Altern pAltern = fmap snd . pAltern_internal pListAltern :: [Token] -> Err [AbsGF.Altern] pListAltern = fmap snd . pListAltern_internal pDDecl :: [Token] -> Err AbsGF.DDecl pDDecl = fmap snd . pDDecl_internal pListDDecl :: [Token] -> Err [AbsGF.DDecl] pListDDecl = fmap snd . pListDDecl_internal pOldGrammar :: [Token] -> Err AbsGF.OldGrammar pOldGrammar = fmap snd . pOldGrammar_internal pIncludeDecl :: [Token] -> Err AbsGF.IncludeDecl pIncludeDecl = fmap snd . pIncludeDecl_internal pFileName :: [Token] -> Err AbsGF.FileName pFileName = fmap snd . pFileName_internal pListFileName :: [Token] -> Err [AbsGF.FileName] pListFileName = fmap snd . pListFileName_internal }