diff --git a/bin/Class.hs b/bin/Class.hs --- a/bin/Class.hs +++ b/bin/Class.hs @@ -7,12 +7,48 @@ mkParseErrorTHT, mkParseErrorTH, instanceErrorParseError, - parseErrorT + parseErrorT, + runErrorTHT, + runErrorTH ) where import Language.Haskell.TH import "monads-tf" Control.Monad.Error +import "monads-tf" Control.Monad.Identity import Control.Monad.Trans.Error (Error(..)) + +{- + +runError :: ErrorT err Identity a -> Either err a +runError = runIdentity . runErrorT + +-} + +runErrorTHT :: Bool -> DecQ +runErrorTHT th = + sigD (mkName "runError") $ forallT [PlainTV err, PlainTV a] (cxt []) $ + conT (errorTNT th) + `appT` varT err + `appT` conT (identityNT th) + `appT` varT a + `arrT` + conT (mkName "Either") `appT` varT err `appT` varT a + where + err = mkName "err" + a = mkName "a" +runErrorTH :: Bool -> DecQ +runErrorTH th = flip (valD $ varP $ mkName "runError") [] $ normalB $ + infixApp (varE $ runIdentityN th) (varE $ mkName ".") (varE $ runErrorTN th) + +errorTNT, identityNT, runIdentityN, runErrorTN :: Bool -> Name +errorTNT True = ''ErrorT +errorTNT False = mkName "ErrorT" +identityNT True = ''Identity +identityNT False = mkName "Identity" +runIdentityN True = 'runIdentity +runIdentityN False = mkName "runIdentity" +runErrorTN True = 'runErrorT +runErrorTN False = mkName "runErrorT" errorN, strMsgN :: Bool -> Name errorN True = ''Error diff --git a/bin/papillon.hs b/bin/papillon.hs --- a/bin/papillon.hs +++ b/bin/papillon.hs @@ -7,10 +7,16 @@ import Class +addModules :: String +addModules = + "import \"monads-tf\" Control.Monad.State\n" ++ + "import \"monads-tf\" Control.Monad.Identity\n" ++ + "import \"monads-tf\" Control.Monad.Error\n" + papillonStr :: String -> IO (String, String, String) papillonStr src = do - let (prgm, mn, ppp, pp, decsQ, atp) = papillonFile src - mName = intercalate "." $ myInit mn ++ ["Papillon"] + (prgm, mn, ppp, pp, decsQ, atp) <- runQ $ papillonFile src + let mName = intercalate "." $ myInit mn ++ ["Papillon"] importConst = "\nimport " ++ mName ++ "\n" dir = joinPath $ myInit mn decs <- runQ decsQ @@ -18,10 +24,10 @@ unlines (map showPragma $ addPragmas $ delPragmas prgm) ++ (if null mn then "" else "module " ++ intercalate "." mn) ++ showExportList ppp ++ (if null mn then "" else "where\n") ++ - importConst ++ + importConst ++ addModules ++ pp ++ "\n" ++ show (ppr decs) ++ "\n" ++ atp ++ "\n") -showExportList :: Maybe ExportList -> String +showExportList :: Maybe Exports -> String showExportList (Just el) = " (\n\t" ++ el ++ "\n) " showExportList Nothing = " " @@ -58,12 +64,16 @@ pepst <- pePositionST pepsd <- pePositionSD cls <- classSourceQ False - return $ [pe, iepe, mkpet, mkpe, pepst, pepsd] ++ cls + ret <- runErrorTHT False + re <- runErrorTH False + return $ [pe, iepe, mkpet, mkpe, pepst, pepsd] ++ cls ++ [ret, re] return $ - "{-# LANGUAGE RankNTypes, TypeFamilies #-}\n" ++ + "{-# LANGUAGE RankNTypes, TypeFamilies, PackageImports #-}\n" ++ "module " ++ mName ++ " (\n\t" ++ intercalate ",\n\t" exportList ++ ") where\n" ++ "import Control.Monad.Trans.Error (Error(..))\n" ++ + "import \"monads-tf\" Control.Monad.Error\n" ++ + "import \"monads-tf\" Control.Monad.Identity\n" ++ show (ppr src) ++ "\n" main :: IO () @@ -93,7 +103,8 @@ "Pos(..)", "Source(..)", "SourceList(..)", - "ListPos(..)" + "ListPos(..)", + "runError" ] myInit :: [a] -> [a] diff --git a/examples/arith.hs b/examples/arith.hs --- a/examples/arith.hs +++ b/examples/arith.hs @@ -7,7 +7,7 @@ main :: IO () main = do arg : _ <- getArgs - case expr $ parse arg of + case runError $ expr $ parse arg of Right (r, _) -> print r Left _ -> putStrLn "parse error" @@ -27,11 +27,12 @@ / '(' e:expr ')' { e } ; term :: Int - = v0:factor vs:(op:op1 v:factor { (`op` v) })* - { foldl (flip ($)) v0 vs } + = f0:factor fs:(op:op1 f:factor { (`op` f) })* + { foldl (flip ($)) f0 fs } ; expr :: Int - = p0:term ps:(op:op2 p:term { (`op` p) })* - { foldl (flip ($)) p0 ps } + = t0:term ts:(op:op2 t:term { (`op` t) })* + { foldl (flip ($)) t0 ts } ; + |] diff --git a/examples/config.hs b/examples/config.hs --- a/examples/config.hs +++ b/examples/config.hs @@ -8,7 +8,7 @@ main = do fp : _ <- getArgs cnt <- readFile fp - case conf $ parse cnt of + case runError $ conf $ parse cnt of Right (r, _) -> print r Left _ -> putStrLn "parse error" diff --git a/papillon.cabal b/papillon.cabal --- a/papillon.cabal +++ b/papillon.cabal @@ -2,7 +2,7 @@ cabal-version: >= 1.8 name: papillon -version: 0.0.58 +version: 0.0.62 stability: Experimental author: Yoshikuni Jujo maintainer: Yoshikuni Jujo @@ -28,7 +28,7 @@ source-repository this type: git location: git://github.com/YoshikuniJujo/papillon.git - tag: 0.0.58 + tag: 0.0.62 library hs-source-dirs: src diff --git a/src/Text/Papillon.hs b/src/Text/Papillon.hs --- a/src/Text/Papillon.hs +++ b/src/Text/Papillon.hs @@ -14,7 +14,9 @@ peComment, pePosition, pePositionS, - (<*>) + (<*>), + (<$>), + runError ) where import Text.PapillonCore diff --git a/src/Text/Papillon/List.hs b/src/Text/Papillon/List.hs --- a/src/Text/Papillon/List.hs +++ b/src/Text/Papillon/List.hs @@ -34,26 +34,32 @@ a = mkName "a" p = mkName "p" -listDec :: Name -> Name -> Bool -> DecsQ -listDec list list1 th = sequence [ - sigD list $ forallT [PlainTV m, PlainTV a] - (cxt [classP (monadPlusN th) [vm], classP (applicativeN th) [vm]]) $ - arrowT `appT` (varT m `appT` varT a) - `appT` (varT m `appT` (listT `appT` varT a)), - sigD list1 $ forallT [PlainTV m, PlainTV a] - (cxt [classP (monadPlusN th) [vm], classP (applicativeN th) [vm]]) $ - arrowT `appT` (varT m `appT` varT a) - `appT` (varT m `appT` (listT `appT` varT a)), - funD list $ (: []) $ flip (clause [varP p]) [] $ normalB $ - infixApp (varE list1 `appE` varE p) (varE $ mplusN th) returnEmpty, - funD list1 $ (: []) $ flip (clause [varP p]) [] $ normalB $ - infixApp (infixApp cons app (varE p)) next (varE list `appE` varE p) +listDec :: Name -> Name -> Bool -> [Dec] +listDec list list1 th = [ + SigD list $ ForallT [PlainTV m, PlainTV a] + ([ClassP (monadPlusN th) [vm], + ClassP (applicativeN th) [vm]]) $ + ArrowT `AppT` (VarT m `AppT` VarT a) + `AppT` (VarT m `AppT` (ListT `AppT` VarT a)), + SigD list1 $ ForallT [PlainTV m, PlainTV a] + ([ClassP (monadPlusN th) [vm], + ClassP (applicativeN th) [vm]]) $ + ArrowT `AppT` (VarT m `AppT` VarT a) + `AppT` (VarT m `AppT` (ListT `AppT` VarT a)), + FunD list $ (: []) $ flip (Clause [VarP p]) [] $ NormalB $ + InfixE (Just $ VarE list1 `AppE` VarE p) + (VarE $ mplusN th) + (Just returnEmpty), + FunD list1 $ (: []) $ flip (Clause [VarP p]) [] $ NormalB $ + InfixE (Just $ InfixE (Just cons) app (Just $ VarE p)) + next + (Just $ VarE list `AppE` VarE p) ] where - vm = varT m - returnEmpty = varE (mkName "return") `appE` listE [] - cons = conE $ mkName ":" - app = varE $ applyN th - next = varE $ applyContN th + vm = VarT m + returnEmpty = VarE (mkName "return") `AppE` ListE [] + cons = ConE $ mkName ":" + app = VarE $ applyN th + next = VarE $ applyContN th {- @@ -62,18 +68,18 @@ -} -optionalDec :: Name -> Bool -> DecsQ -optionalDec optionalN th = sequence [ - sigD optionalN $ mplusAndApp $ (varT m `appT` varT a) `arrT` - (varT m `appT` (conT (mkName "Maybe") `appT` varT a)), - funD optionalN $ (: []) $ flip (clause [varP p]) [] $ normalB $ - conE (mkName "Just") `app` varE p `mplusE` returnNothing +optionalDec :: Name -> Bool -> [Dec] +optionalDec optionalN th = [ + SigD optionalN $ mplusAndApp $ (VarT m `AppT` VarT a) `arrT` + (VarT m `AppT` (ConT (mkName "Maybe") `AppT` VarT a)), + FunD optionalN $ (: []) $ flip (Clause [VarP p]) [] $ NormalB $ + ConE (mkName "Just") `app` VarE p `mplusE` returnNothing ] where - mplusAndApp = forallT [PlainTV m, PlainTV a] $ cxt [ - classP (monadPlusN th) [varT m], - classP (applicativeN th) [varT m] + mplusAndApp = ForallT [PlainTV m, PlainTV a] [ + ClassP (monadPlusN th) [VarT m], + ClassP (applicativeN th) [VarT m] ] - arrT f x = arrowT `appT` f `appT` x - mplusE x = infixApp x (varE $ mplusN th) - returnNothing = varE (mkName "return") `appE` conE (mkName "Nothing") - app x = infixApp x (varE $ applyN th) + arrT f x = ArrowT `AppT` f `AppT` x + mplusE x = InfixE (Just x) (VarE $ mplusN th) . Just + returnNothing = VarE (mkName "return") `AppE` ConE (mkName "Nothing") + app x = InfixE (Just x) (VarE $ applyN th) . Just diff --git a/src/Text/Papillon/Papillon.hs b/src/Text/Papillon/Papillon.hs --- a/src/Text/Papillon/Papillon.hs +++ b/src/Text/Papillon/Papillon.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RankNTypes, TypeFamilies #-} +{-# LANGUAGE RankNTypes, TypeFamilies, PackageImports #-} module Text.Papillon.Papillon ( ParseError, mkParseError, @@ -12,8 +12,11 @@ Pos(..), Source(..), SourceList(..), - ListPos(..)) where + ListPos(..), + runError) where import Control.Monad.Trans.Error (Error(..)) +import "monads-tf" Control.Monad.Error +import "monads-tf" Control.Monad.Identity data ParseError pos drv = ParseError {peCode :: String, peMessage :: String, @@ -53,3 +56,5 @@ listInitialPos = CharPos (1, 1) listUpdatePos '\n' (CharPos (y, _)) = CharPos (y + 1, 0) listUpdatePos _ (CharPos (y, x)) = CharPos (y, x + 1) +runError :: forall err a . ErrorT err Identity a -> Either err a +runError = runIdentity . runErrorT diff --git a/src/Text/Papillon/Parser.hs b/src/Text/Papillon/Parser.hs --- a/src/Text/Papillon/Parser.hs +++ b/src/Text/Papillon/Parser.hs @@ -1,2141 +1,2335 @@ {-# LANGUAGE FlexibleContexts, TemplateHaskell, UndecidableInstances, PackageImports, TypeFamilies, RankNTypes #-} module Text.Papillon.Parser ( - Peg, - Definition(..), - Selection(..), - getSelectionType, - ExpressionHs(..), - NameLeaf(..), - NameLeaf_(..), - ReadFrom(..), - parse, - showNameLeaf, - nameFromRF, - ParseError(..), - mkParseError, - Derivs(peg, pegFile, char), - Pos(..), - ListPos(..), - pePositionS, - Source(..), - SourceList(..), - - PPragma(..), - ModuleName, - ExportList, - Code -) where - -import Text.Papillon.Papillon -import Control.Applicative -import "monads-tf" Control.Monad.State -import "monads-tf" Control.Monad.Error - - - -import Data.Char -import Language.Haskell.TH -import Text.Papillon.SyntaxTree - -data Derivs - = Derivs {pegFile :: (Either (ParseError (Pos String) Derivs) - ((PegFile, Derivs))), - pragmas :: (Either (ParseError (Pos String) Derivs) - (([PPragma], Derivs))), - pragma :: (Either (ParseError (Pos String) Derivs) - ((PPragma, Derivs))), - pragmaStr :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - pragmaItems :: (Either (ParseError (Pos String) Derivs) - (([String], Derivs))), - pragmaEnd :: (Either (ParseError (Pos String) Derivs) - (((), Derivs))), - moduleDec :: (Either (ParseError (Pos String) Derivs) - ((Maybe (([String], Maybe String)), Derivs))), - moduleName :: (Either (ParseError (Pos String) Derivs) - ((ModuleName, Derivs))), - moduleDecStr :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - whr :: (Either (ParseError (Pos String) Derivs) (((), Derivs))), - preImpPap :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - prePeg :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - afterPeg :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - importPapillon :: (Either (ParseError (Pos String) Derivs) - (((), Derivs))), - varToken :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - typToken :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - pap :: (Either (ParseError (Pos String) Derivs) (((), Derivs))), - peg :: (Either (ParseError (Pos String) Derivs) ((TTPeg, Derivs))), - sourceType :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - peg_ :: (Either (ParseError (Pos String) Derivs) ((Peg, Derivs))), - definition :: (Either (ParseError (Pos String) Derivs) - ((Definition, Derivs))), - selection :: (Either (ParseError (Pos String) Derivs) - ((Selection, Derivs))), - normalSelection :: (Either (ParseError (Pos String) Derivs) - ((Selection, Derivs))), - plainSelection :: (Either (ParseError (Pos String) Derivs) - ((Selection, Derivs))), - expressionHs :: (Either (ParseError (Pos String) Derivs) - ((ExpressionHs, Derivs))), - expressionHsSugar :: (Either (ParseError (Pos String) Derivs) - ((ExpressionHs, Derivs))), - plainExpressionHs :: (Either (ParseError (Pos String) Derivs) - ((ExpressionHs, Derivs))), - plainReadFromLs :: (Either (ParseError (Pos String) Derivs) - ((ReadFrom, Derivs))), - expression :: (Either (ParseError (Pos String) Derivs) - ((Expression, Derivs))), - nameLeaf_ :: (Either (ParseError (Pos String) Derivs) - ((NameLeaf_, Derivs))), - nameLeaf :: (Either (ParseError (Pos String) Derivs) - ((NameLeaf, Derivs))), - nameLeafNoCom :: (Either (ParseError (Pos String) Derivs) - ((NameLeaf, Derivs))), - comForErr :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - leaf :: (Either (ParseError (Pos String) Derivs) - (((ReadFrom, Maybe ((ExpQ, String))), Derivs))), - patOp :: (Either (ParseError (Pos String) Derivs) - ((PatQ, Derivs))), - pat :: (Either (ParseError (Pos String) Derivs) ((PatQ, Derivs))), - pat1 :: (Either (ParseError (Pos String) Derivs) ((PatQ, Derivs))), - patList :: (Either (ParseError (Pos String) Derivs) - (([PatQ], Derivs))), - opConName :: (Either (ParseError (Pos String) Derivs) - ((Name, Derivs))), - charLit :: (Either (ParseError (Pos String) Derivs) - ((Char, Derivs))), - stringLit :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - escapeC :: (Either (ParseError (Pos String) Derivs) - ((Char, Derivs))), - pats :: (Either (ParseError (Pos String) Derivs) - ((PatQs, Derivs))), - readFromLs :: (Either (ParseError (Pos String) Derivs) - ((ReadFrom, Derivs))), - readFrom :: (Either (ParseError (Pos String) Derivs) - ((ReadFrom, Derivs))), - selectCharsLs :: (Either (ParseError (Pos String) Derivs) - ((ReadFrom, Derivs))), - selectChars :: (Either (ParseError (Pos String) Derivs) - ((ReadFrom, Derivs))), - test :: (Either (ParseError (Pos String) Derivs) - (((ExR, String), Derivs))), - hsExpLam :: (Either (ParseError (Pos String) Derivs) - ((ExR, Derivs))), - hsExpTyp :: (Either (ParseError (Pos String) Derivs) - ((ExR, Derivs))), - hsExpOp :: (Either (ParseError (Pos String) Derivs) - ((ExR, Derivs))), - hsOp :: (Either (ParseError (Pos String) Derivs) ((ExR, Derivs))), - opTail :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - hsExp :: (Either (ParseError (Pos String) Derivs) ((Ex, Derivs))), - hsExp1 :: (Either (ParseError (Pos String) Derivs) - ((ExR, Derivs))), - hsExpTpl :: (Either (ParseError (Pos String) Derivs) - ((ExRL, Derivs))), - hsTypeArr :: (Either (ParseError (Pos String) Derivs) - ((TypeQ, Derivs))), - hsType :: (Either (ParseError (Pos String) Derivs) - ((Typ, Derivs))), - hsType1 :: (Either (ParseError (Pos String) Derivs) - ((TypeQ, Derivs))), - hsTypeTpl :: (Either (ParseError (Pos String) Derivs) - ((TypeQL, Derivs))), - typ :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - variable :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - tvtail :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - integer :: (Either (ParseError (Pos String) Derivs) - ((Integer, Derivs))), - alpha :: (Either (ParseError (Pos String) Derivs) - ((Char, Derivs))), - upper :: (Either (ParseError (Pos String) Derivs) - ((Char, Derivs))), - lower :: (Either (ParseError (Pos String) Derivs) - ((Char, Derivs))), - digit :: (Either (ParseError (Pos String) Derivs) - ((Char, Derivs))), - spaces :: (Either (ParseError (Pos String) Derivs) (((), Derivs))), - space :: (Either (ParseError (Pos String) Derivs) (((), Derivs))), - notNLString :: (Either (ParseError (Pos String) Derivs) - ((String, Derivs))), - newLine :: (Either (ParseError (Pos String) Derivs) - (((), Derivs))), - comment :: (Either (ParseError (Pos String) Derivs) - (((), Derivs))), - comments :: (Either (ParseError (Pos String) Derivs) - (((), Derivs))), - notComStr :: (Either (ParseError (Pos String) Derivs) - (((), Derivs))), - comEnd :: (Either (ParseError (Pos String) Derivs) (((), Derivs))), - char :: (Either (ParseError (Pos String) Derivs) - ((Token String, Derivs))), - position :: (Pos String)} -parse :: String -> Derivs -parse = parse0_0 initialPos - where parse0_0 pos s = d - where d = Derivs pegFile80_1 pragmas81_2 pragma82_3 pragmaStr83_4 pragmaItems84_5 pragmaEnd85_6 moduleDec86_7 moduleName87_8 moduleDecStr88_9 whr89_10 preImpPap90_11 prePeg91_12 afterPeg92_13 importPapillon93_14 varToken94_15 typToken95_16 pap96_17 peg97_18 sourceType98_19 peg_99_20 definition100_21 selection101_22 normalSelection102_23 plainSelection103_24 expressionHs104_25 expressionHsSugar105_26 plainExpressionHs106_27 plainReadFromLs107_28 expression108_29 nameLeaf_109_30 nameLeaf110_31 nameLeafNoCom111_32 comForErr112_33 leaf113_34 patOp114_35 pat115_36 pat1116_37 patList117_38 opConName118_39 charLit119_40 stringLit120_41 escapeC121_42 pats122_43 readFromLs123_44 readFrom124_45 selectCharsLs125_46 selectChars126_47 test127_48 hsExpLam128_49 hsExpTyp129_50 hsExpOp130_51 hsOp131_52 opTail132_53 hsExp133_54 hsExp1134_55 hsExpTpl135_56 hsTypeArr136_57 hsType137_58 hsType1138_59 hsTypeTpl139_60 typ140_61 variable141_62 tvtail142_63 integer143_64 alpha144_65 upper145_66 lower146_67 digit147_68 spaces148_69 space149_70 notNLString150_71 newLine151_72 comment152_73 comments153_74 notComStr154_75 comEnd155_76 chars156_77 pos - pegFile80_1 = runStateT pegFile4_78 d - pragmas81_2 = runStateT pragmas5_79 d - pragma82_3 = runStateT pragma6_80 d - pragmaStr83_4 = runStateT pragmaStr7_81 d - pragmaItems84_5 = runStateT pragmaItems8_82 d - pragmaEnd85_6 = runStateT pragmaEnd9_83 d - moduleDec86_7 = runStateT moduleDec10_84 d - moduleName87_8 = runStateT moduleName11_85 d - moduleDecStr88_9 = runStateT moduleDecStr12_86 d - whr89_10 = runStateT whr13_87 d - preImpPap90_11 = runStateT preImpPap14_88 d - prePeg91_12 = runStateT prePeg15_89 d - afterPeg92_13 = runStateT afterPeg16_90 d - importPapillon93_14 = runStateT importPapillon17_91 d - varToken94_15 = runStateT varToken18_92 d - typToken95_16 = runStateT typToken19_93 d - pap96_17 = runStateT pap20_94 d - peg97_18 = runStateT peg21_95 d - sourceType98_19 = runStateT sourceType22_96 d - peg_99_20 = runStateT peg_23_97 d - definition100_21 = runStateT definition24_98 d - selection101_22 = runStateT selection25_99 d - normalSelection102_23 = runStateT normalSelection26_100 d - plainSelection103_24 = runStateT plainSelection27_101 d - expressionHs104_25 = runStateT expressionHs28_102 d - expressionHsSugar105_26 = runStateT expressionHsSugar29_103 d - plainExpressionHs106_27 = runStateT plainExpressionHs30_104 d - plainReadFromLs107_28 = runStateT plainReadFromLs31_105 d - expression108_29 = runStateT expression32_106 d - nameLeaf_109_30 = runStateT nameLeaf_33_107 d - nameLeaf110_31 = runStateT nameLeaf34_108 d - nameLeafNoCom111_32 = runStateT nameLeafNoCom35_109 d - comForErr112_33 = runStateT comForErr36_110 d - leaf113_34 = runStateT leaf37_111 d - patOp114_35 = runStateT patOp38_112 d - pat115_36 = runStateT pat39_113 d - pat1116_37 = runStateT pat140_114 d - patList117_38 = runStateT patList41_115 d - opConName118_39 = runStateT opConName42_116 d - charLit119_40 = runStateT charLit43_117 d - stringLit120_41 = runStateT stringLit44_118 d - escapeC121_42 = runStateT escapeC45_119 d - pats122_43 = runStateT pats46_120 d - readFromLs123_44 = runStateT readFromLs47_121 d - readFrom124_45 = runStateT readFrom48_122 d - selectCharsLs125_46 = runStateT selectCharsLs49_123 d - selectChars126_47 = runStateT selectChars50_124 d - test127_48 = runStateT test51_125 d - hsExpLam128_49 = runStateT hsExpLam52_126 d - hsExpTyp129_50 = runStateT hsExpTyp53_127 d - hsExpOp130_51 = runStateT hsExpOp54_128 d - hsOp131_52 = runStateT hsOp55_129 d - opTail132_53 = runStateT opTail56_130 d - hsExp133_54 = runStateT hsExp57_131 d - hsExp1134_55 = runStateT hsExp158_132 d - hsExpTpl135_56 = runStateT hsExpTpl59_133 d - hsTypeArr136_57 = runStateT hsTypeArr60_134 d - hsType137_58 = runStateT hsType61_135 d - hsType1138_59 = runStateT hsType162_136 d - hsTypeTpl139_60 = runStateT hsTypeTpl63_137 d - typ140_61 = runStateT typ64_138 d - variable141_62 = runStateT variable65_139 d - tvtail142_63 = runStateT tvtail66_140 d - integer143_64 = runStateT integer67_141 d - alpha144_65 = runStateT alpha68_142 d - upper145_66 = runStateT upper69_143 d - lower146_67 = runStateT lower70_144 d - digit147_68 = runStateT digit71_145 d - spaces148_69 = runStateT spaces72_146 d - space149_70 = runStateT space73_147 d - notNLString150_71 = runStateT notNLString74_148 d - newLine151_72 = runStateT newLine75_149 d - comment152_73 = runStateT comment76_150 d - comments153_74 = runStateT comments77_151 d - notComStr154_75 = runStateT notComStr78_152 d - comEnd155_76 = runStateT comEnd79_153 d - chars156_77 = runStateT (case getToken s of - Just (c, - s') -> do put (parse0_0 (updatePos c pos) s') - return c - _ -> gets position >>= (throwError . mkParseError "" "end of input" "" undefined [])) d - pegFile4_78 = foldl1 mplus [do pr <- StateT pragmas - md <- StateT moduleDec - pip <- StateT preImpPap - _ <- StateT importPapillon - return () - pp <- StateT prePeg - _ <- StateT pap - return () - p <- StateT peg - _ <- StateT spaces - return () - d174_154 <- get - xx173_155 <- StateT char - case xx173_155 of - '|' -> return () - _ -> gets position >>= (throwError . mkParseError "'|'" "not match pattern: " "" d174_154 ["char"]) - let '|' = xx173_155 - return () - d176_156 <- get - xx175_157 <- StateT char - case xx175_157 of - ']' -> return () - _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d176_156 ["char"]) - let ']' = xx175_157 - return () - d178_158 <- get - xx177_159 <- StateT char - case xx177_159 of - '\n' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d178_158 ["char"]) - let '\n' = xx177_159 - return () - atp <- StateT afterPeg - return (mkPegFile pr md pip pp p atp), - do pr <- StateT pragmas - md <- StateT moduleDec - pp <- StateT prePeg - _ <- StateT pap - return () - p <- StateT peg - _ <- StateT spaces - return () - d194_160 <- get - xx193_161 <- StateT char - case xx193_161 of - '|' -> return () - _ -> gets position >>= (throwError . mkParseError "'|'" "not match pattern: " "" d194_160 ["char"]) - let '|' = xx193_161 - return () - d196_162 <- get - xx195_163 <- StateT char - case xx195_163 of - ']' -> return () - _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d196_162 ["char"]) - let ']' = xx195_163 - return () - d198_164 <- get - xx197_165 <- StateT char - case xx197_165 of - '\n' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d198_164 ["char"]) - let '\n' = xx197_165 - return () - atp <- StateT afterPeg - return (mkPegFile pr md emp pp p atp)] - pragmas5_79 = foldl1 mplus [do _ <- StateT spaces - return () - pr <- StateT pragma - prs <- StateT pragmas - return (pr : prs), - do _ <- StateT spaces - return () - return []] - pragma6_80 = foldl1 mplus [do d210_166 <- get - xx209_167 <- StateT char - case xx209_167 of - '{' -> return () - _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d210_166 ["char"]) - let '{' = xx209_167 - return () - d212_168 <- get - xx211_169 <- StateT char - case xx211_169 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d212_168 ["char"]) - let '-' = xx211_169 - return () - d214_170 <- get - xx213_171 <- StateT char - case xx213_171 of - '#' -> return () - _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d214_170 ["char"]) - let '#' = xx213_171 - return () - _ <- StateT spaces - return () - d218_172 <- get - xx217_173 <- StateT char - case xx217_173 of - 'L' -> return () - _ -> gets position >>= (throwError . mkParseError "'L'" "not match pattern: " "" d218_172 ["char"]) - let 'L' = xx217_173 - return () - d220_174 <- get - xx219_175 <- StateT char - case xx219_175 of - 'A' -> return () - _ -> gets position >>= (throwError . mkParseError "'A'" "not match pattern: " "" d220_174 ["char"]) - let 'A' = xx219_175 - return () - d222_176 <- get - xx221_177 <- StateT char - case xx221_177 of - 'N' -> return () - _ -> gets position >>= (throwError . mkParseError "'N'" "not match pattern: " "" d222_176 ["char"]) - let 'N' = xx221_177 - return () - d224_178 <- get - xx223_179 <- StateT char - case xx223_179 of - 'G' -> return () - _ -> gets position >>= (throwError . mkParseError "'G'" "not match pattern: " "" d224_178 ["char"]) - let 'G' = xx223_179 - return () - d226_180 <- get - xx225_181 <- StateT char - case xx225_181 of - 'U' -> return () - _ -> gets position >>= (throwError . mkParseError "'U'" "not match pattern: " "" d226_180 ["char"]) - let 'U' = xx225_181 - return () - d228_182 <- get - xx227_183 <- StateT char - case xx227_183 of - 'A' -> return () - _ -> gets position >>= (throwError . mkParseError "'A'" "not match pattern: " "" d228_182 ["char"]) - let 'A' = xx227_183 - return () - d230_184 <- get - xx229_185 <- StateT char - case xx229_185 of - 'G' -> return () - _ -> gets position >>= (throwError . mkParseError "'G'" "not match pattern: " "" d230_184 ["char"]) - let 'G' = xx229_185 - return () - d232_186 <- get - xx231_187 <- StateT char - case xx231_187 of - 'E' -> return () - _ -> gets position >>= (throwError . mkParseError "'E'" "not match pattern: " "" d232_186 ["char"]) - let 'E' = xx231_187 - return () - _ <- StateT spaces - return () - s <- StateT pragmaItems - _ <- StateT pragmaEnd - return () - _ <- StateT spaces - return () - return (LanguagePragma s), - do d242_188 <- get - xx241_189 <- StateT char - case xx241_189 of - '{' -> return () - _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d242_188 ["char"]) - let '{' = xx241_189 - return () - d244_190 <- get - xx243_191 <- StateT char - case xx243_191 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d244_190 ["char"]) - let '-' = xx243_191 - return () - d246_192 <- get - xx245_193 <- StateT char - case xx245_193 of - '#' -> return () - _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d246_192 ["char"]) - let '#' = xx245_193 - return () - _ <- StateT spaces - return () - s <- StateT pragmaStr - _ <- StateT pragmaEnd - return () - return (OtherPragma s)] - pragmaStr7_81 = foldl1 mplus [do ddd253_194 <- get - do err <- ((do _ <- StateT pragmaEnd - return ()) >> return False) `catchError` const (return True) - unless err (gets position >>= (throwError . mkParseError ('!' : "_:pragmaEnd") "not match: " "" ddd253_194 ["pragmaEnd"])) - put ddd253_194 - c <- StateT char - s <- StateT pragmaStr - return (c : s), - return ""] - pragmaItems8_82 = foldl1 mplus [do t <- StateT typToken - d263_195 <- get - xx262_196 <- StateT char - case xx262_196 of - ',' -> return () - _ -> gets position >>= (throwError . mkParseError "','" "not match pattern: " "" d263_195 ["char"]) - let ',' = xx262_196 - return () - _ <- StateT spaces - return () - i <- StateT pragmaItems - return (t : i), - do t <- StateT typToken - return [t]] - pragmaEnd9_83 = foldl1 mplus [do _ <- StateT spaces - return () - d273_197 <- get - xx272_198 <- StateT char - case xx272_198 of - '#' -> return () - _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d273_197 ["char"]) - let '#' = xx272_198 - return () - d275_199 <- get - xx274_200 <- StateT char - case xx274_200 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d275_199 ["char"]) - let '-' = xx274_200 - return () - d277_201 <- get - xx276_202 <- StateT char - case xx276_202 of - '}' -> return () - _ -> gets position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d277_201 ["char"]) - let '}' = xx276_202 - return () - return ()] - moduleDec10_84 = foldl1 mplus [do d279_203 <- get - xx278_204 <- StateT char - case xx278_204 of - 'm' -> return () - _ -> gets position >>= (throwError . mkParseError "'m'" "not match pattern: " "" d279_203 ["char"]) - let 'm' = xx278_204 - return () - d281_205 <- get - xx280_206 <- StateT char - case xx280_206 of - 'o' -> return () - _ -> gets position >>= (throwError . mkParseError "'o'" "not match pattern: " "" d281_205 ["char"]) - let 'o' = xx280_206 - return () - d283_207 <- get - xx282_208 <- StateT char - case xx282_208 of - 'd' -> return () - _ -> gets position >>= (throwError . mkParseError "'d'" "not match pattern: " "" d283_207 ["char"]) - let 'd' = xx282_208 - return () - d285_209 <- get - xx284_210 <- StateT char - case xx284_210 of - 'u' -> return () - _ -> gets position >>= (throwError . mkParseError "'u'" "not match pattern: " "" d285_209 ["char"]) - let 'u' = xx284_210 - return () - d287_211 <- get - xx286_212 <- StateT char - case xx286_212 of - 'l' -> return () - _ -> gets position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d287_211 ["char"]) - let 'l' = xx286_212 - return () - d289_213 <- get - xx288_214 <- StateT char - case xx288_214 of - 'e' -> return () - _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d289_213 ["char"]) - let 'e' = xx288_214 - return () - _ <- StateT spaces - return () - n <- StateT moduleName - _ <- StateT spaces - return () - d297_215 <- get - xx296_216 <- StateT char - case xx296_216 of - '(' -> return () - _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d297_215 ["char"]) - let '(' = xx296_216 - return () - _ <- StateT spaces - return () - s <- StateT moduleDecStr - _ <- StateT whr - return () - return (Just (n, Just s)), - do d305_217 <- get - xx304_218 <- StateT char - case xx304_218 of - 'm' -> return () - _ -> gets position >>= (throwError . mkParseError "'m'" "not match pattern: " "" d305_217 ["char"]) - let 'm' = xx304_218 - return () - d307_219 <- get - xx306_220 <- StateT char - case xx306_220 of - 'o' -> return () - _ -> gets position >>= (throwError . mkParseError "'o'" "not match pattern: " "" d307_219 ["char"]) - let 'o' = xx306_220 - return () - d309_221 <- get - xx308_222 <- StateT char - case xx308_222 of - 'd' -> return () - _ -> gets position >>= (throwError . mkParseError "'d'" "not match pattern: " "" d309_221 ["char"]) - let 'd' = xx308_222 - return () - d311_223 <- get - xx310_224 <- StateT char - case xx310_224 of - 'u' -> return () - _ -> gets position >>= (throwError . mkParseError "'u'" "not match pattern: " "" d311_223 ["char"]) - let 'u' = xx310_224 - return () - d313_225 <- get - xx312_226 <- StateT char - case xx312_226 of - 'l' -> return () - _ -> gets position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d313_225 ["char"]) - let 'l' = xx312_226 - return () - d315_227 <- get - xx314_228 <- StateT char - case xx314_228 of - 'e' -> return () - _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d315_227 ["char"]) - let 'e' = xx314_228 - return () - _ <- StateT spaces - return () - n <- StateT moduleName - _ <- StateT spaces - return () - d323_229 <- get - xx322_230 <- StateT char - case xx322_230 of - 'w' -> return () - _ -> gets position >>= (throwError . mkParseError "'w'" "not match pattern: " "" d323_229 ["char"]) - let 'w' = xx322_230 - return () - d325_231 <- get - xx324_232 <- StateT char - case xx324_232 of - 'h' -> return () - _ -> gets position >>= (throwError . mkParseError "'h'" "not match pattern: " "" d325_231 ["char"]) - let 'h' = xx324_232 - return () - d327_233 <- get - xx326_234 <- StateT char - case xx326_234 of - 'e' -> return () - _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d327_233 ["char"]) - let 'e' = xx326_234 - return () - d329_235 <- get - xx328_236 <- StateT char - case xx328_236 of - 'r' -> return () - _ -> gets position >>= (throwError . mkParseError "'r'" "not match pattern: " "" d329_235 ["char"]) - let 'r' = xx328_236 - return () - d331_237 <- get - xx330_238 <- StateT char - case xx330_238 of - 'e' -> return () - _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d331_237 ["char"]) - let 'e' = xx330_238 - return () - _ <- StateT spaces - return () - return (Just (n, Nothing)), - return Nothing] - moduleName11_85 = foldl1 mplus [do t <- StateT typ - d337_239 <- get - xx336_240 <- StateT char - case xx336_240 of - '.' -> return () - _ -> gets position >>= (throwError . mkParseError "'.'" "not match pattern: " "" d337_239 ["char"]) - let '.' = xx336_240 - return () - n <- StateT moduleName - return (t : n), - do t <- StateT typ - return [t]] - moduleDecStr12_86 = foldl1 mplus [do ddd342_241 <- get - do err <- ((do _ <- StateT whr - return ()) >> return False) `catchError` const (return True) - unless err (gets position >>= (throwError . mkParseError ('!' : "_:whr") "not match: " "" ddd342_241 ["whr"])) - put ddd342_241 - c <- StateT char - s <- StateT moduleDecStr - return (c : s), - return ""] - whr13_87 = foldl1 mplus [do _ <- StateT spaces - return () - d352_242 <- get - xx351_243 <- StateT char - case xx351_243 of - ')' -> return () - _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d352_242 ["char"]) - let ')' = xx351_243 - return () - _ <- StateT spaces - return () - d356_244 <- get - xx355_245 <- StateT char - case xx355_245 of - 'w' -> return () - _ -> gets position >>= (throwError . mkParseError "'w'" "not match pattern: " "" d356_244 ["char"]) - let 'w' = xx355_245 - return () - d358_246 <- get - xx357_247 <- StateT char - case xx357_247 of - 'h' -> return () - _ -> gets position >>= (throwError . mkParseError "'h'" "not match pattern: " "" d358_246 ["char"]) - let 'h' = xx357_247 - return () - d360_248 <- get - xx359_249 <- StateT char - case xx359_249 of - 'e' -> return () - _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d360_248 ["char"]) - let 'e' = xx359_249 - return () - d362_250 <- get - xx361_251 <- StateT char - case xx361_251 of - 'r' -> return () - _ -> gets position >>= (throwError . mkParseError "'r'" "not match pattern: " "" d362_250 ["char"]) - let 'r' = xx361_251 - return () - d364_252 <- get - xx363_253 <- StateT char - case xx363_253 of - 'e' -> return () - _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d364_252 ["char"]) - let 'e' = xx363_253 - return () - return ()] - preImpPap14_88 = foldl1 mplus [do ddd365_254 <- get - do err <- ((do _ <- StateT importPapillon - return ()) >> return False) `catchError` const (return True) - unless err (gets position >>= (throwError . mkParseError ('!' : "_:importPapillon") "not match: " "" ddd365_254 ["importPapillon"])) - put ddd365_254 - ddd368_255 <- get - do err <- ((do _ <- StateT pap - return ()) >> return False) `catchError` const (return True) - unless err (gets position >>= (throwError . mkParseError ('!' : "_:pap") "not match: " "" ddd368_255 ["pap"])) - put ddd368_255 - c <- StateT char - pip <- StateT preImpPap - return (cons c pip), - return emp] - prePeg15_89 = foldl1 mplus [do ddd375_256 <- get - do err <- ((do _ <- StateT pap - return ()) >> return False) `catchError` const (return True) - unless err (gets position >>= (throwError . mkParseError ('!' : "_:pap") "not match: " "" ddd375_256 ["pap"])) - put ddd375_256 - c <- StateT char - pp <- StateT prePeg - return (cons c pp), - return emp] - afterPeg16_90 = foldl1 mplus [do c <- StateT char - atp <- StateT afterPeg - return (cons c atp), - return emp] - importPapillon17_91 = foldl1 mplus [do d387_257 <- get - xx386_258 <- StateT varToken - case xx386_258 of - "import" -> return () - _ -> gets position >>= (throwError . mkParseError "\"import\"" "not match pattern: " "" d387_257 ["varToken"]) - let "import" = xx386_258 - return () - d389_259 <- get - xx388_260 <- StateT typToken - case xx388_260 of - "Text" -> return () - _ -> gets position >>= (throwError . mkParseError "\"Text\"" "not match pattern: " "" d389_259 ["typToken"]) - let "Text" = xx388_260 - return () - d391_261 <- get - xx390_262 <- StateT char - case xx390_262 of - '.' -> return () - _ -> gets position >>= (throwError . mkParseError "'.'" "not match pattern: " "" d391_261 ["char"]) - let '.' = xx390_262 - return () - _ <- StateT spaces - return () - d395_263 <- get - xx394_264 <- StateT typToken - case xx394_264 of - "Papillon" -> return () - _ -> gets position >>= (throwError . mkParseError "\"Papillon\"" "not match pattern: " "" d395_263 ["typToken"]) - let "Papillon" = xx394_264 - return () - ddd396_265 <- get - do err <- ((do d398_266 <- get - xx397_267 <- StateT char - case xx397_267 of - '.' -> return () - _ -> gets position >>= (throwError . mkParseError "'.'" "not match pattern: " "" d398_266 ["char"]) - let '.' = xx397_267 - return ()) >> return False) `catchError` const (return True) - unless err (gets position >>= (throwError . mkParseError ('!' : "'.':") "not match: " "" ddd396_265 ["char"])) - put ddd396_265 - return ()] - varToken18_92 = foldl1 mplus [do v <- StateT variable - _ <- StateT spaces - return () - return v] - typToken19_93 = foldl1 mplus [do t <- StateT typ - _ <- StateT spaces - return () - return t] - pap20_94 = foldl1 mplus [do d408_268 <- get - xx407_269 <- StateT char - case xx407_269 of - '\n' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d408_268 ["char"]) - let '\n' = xx407_269 - return () - d410_270 <- get - xx409_271 <- StateT char - case xx409_271 of - '[' -> return () - _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d410_270 ["char"]) - let '[' = xx409_271 - return () - d412_272 <- get - xx411_273 <- StateT char - case xx411_273 of - 'p' -> return () - _ -> gets position >>= (throwError . mkParseError "'p'" "not match pattern: " "" d412_272 ["char"]) - let 'p' = xx411_273 - return () - d414_274 <- get - xx413_275 <- StateT char - case xx413_275 of - 'a' -> return () - _ -> gets position >>= (throwError . mkParseError "'a'" "not match pattern: " "" d414_274 ["char"]) - let 'a' = xx413_275 - return () - d416_276 <- get - xx415_277 <- StateT char - case xx415_277 of - 'p' -> return () - _ -> gets position >>= (throwError . mkParseError "'p'" "not match pattern: " "" d416_276 ["char"]) - let 'p' = xx415_277 - return () - d418_278 <- get - xx417_279 <- StateT char - case xx417_279 of - 'i' -> return () - _ -> gets position >>= (throwError . mkParseError "'i'" "not match pattern: " "" d418_278 ["char"]) - let 'i' = xx417_279 - return () - d420_280 <- get - xx419_281 <- StateT char - case xx419_281 of - 'l' -> return () - _ -> gets position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d420_280 ["char"]) - let 'l' = xx419_281 - return () - d422_282 <- get - xx421_283 <- StateT char - case xx421_283 of - 'l' -> return () - _ -> gets position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d422_282 ["char"]) - let 'l' = xx421_283 - return () - d424_284 <- get - xx423_285 <- StateT char - case xx423_285 of - 'o' -> return () - _ -> gets position >>= (throwError . mkParseError "'o'" "not match pattern: " "" d424_284 ["char"]) - let 'o' = xx423_285 - return () - d426_286 <- get - xx425_287 <- StateT char - case xx425_287 of - 'n' -> return () - _ -> gets position >>= (throwError . mkParseError "'n'" "not match pattern: " "" d426_286 ["char"]) - let 'n' = xx425_287 - return () - d428_288 <- get - xx427_289 <- StateT char - case xx427_289 of - '|' -> return () - _ -> gets position >>= (throwError . mkParseError "'|'" "not match pattern: " "" d428_288 ["char"]) - let '|' = xx427_289 - return () - d430_290 <- get - xx429_291 <- StateT char - case xx429_291 of - '\n' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d430_290 ["char"]) - let '\n' = xx429_291 - return () - return ()] - peg21_95 = foldl1 mplus [do _ <- StateT spaces - return () - s <- StateT sourceType - p <- StateT peg_ - return (mkTTPeg s p), - do p <- StateT peg_ - return (mkTTPeg tString p)] - sourceType22_96 = foldl1 mplus [do d440_292 <- get - xx439_293 <- StateT varToken - case xx439_293 of - "source" -> return () - _ -> gets position >>= (throwError . mkParseError "\"source\"" "not match pattern: " "" d440_292 ["varToken"]) - let "source" = xx439_293 - return () - d442_294 <- get - xx441_295 <- StateT char - case xx441_295 of - ':' -> return () - _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d442_294 ["char"]) - let ':' = xx441_295 - return () - _ <- StateT spaces - return () - v <- StateT typToken - return v] - peg_23_97 = foldl1 mplus [do _ <- StateT spaces - return () - d <- StateT definition - p <- StateT peg_ - return (cons d p), - return emp] - definition24_98 = foldl1 mplus [do v <- StateT variable - _ <- StateT spaces - return () - d458_296 <- get - xx457_297 <- StateT char - case xx457_297 of - ':' -> return () - _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d458_296 ["char"]) - let ':' = xx457_297 - return () - d460_298 <- get - xx459_299 <- StateT char - case xx459_299 of - ':' -> return () - _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d460_298 ["char"]) - let ':' = xx459_299 - return () - _ <- StateT spaces - return () - t <- StateT hsTypeArr - _ <- StateT spaces - return () - d468_300 <- get - xx467_301 <- StateT char - case xx467_301 of - '=' -> return () - _ -> gets position >>= (throwError . mkParseError "'='" "not match pattern: " "" d468_300 ["char"]) - let '=' = xx467_301 - return () - _ <- StateT spaces - return () - sel <- StateT selection - _ <- StateT spaces - return () - d476_302 <- get - xx475_303 <- StateT char - case xx475_303 of - ';' -> return () - _ -> gets position >>= (throwError . mkParseError "';'" "not match pattern: " "" d476_302 ["char"]) - let ';' = xx475_303 - return () - return (mkDef v t sel), - do v <- StateT variable - _ <- StateT spaces - return () - d482_304 <- get - xx481_305 <- StateT char - case xx481_305 of - '<' -> return () - _ -> gets position >>= (throwError . mkParseError "'<'" "not match pattern: " "" d482_304 ["char"]) - let '<' = xx481_305 - return () - d484_306 <- get - xx483_307 <- StateT char - case xx483_307 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d484_306 ["char"]) - let '-' = xx483_307 - return () - _ <- StateT spaces - return () - sel <- StateT plainSelection - _ <- StateT spaces - return () - d492_308 <- get - xx491_309 <- StateT char - case xx491_309 of - ';' -> return () - _ -> gets position >>= (throwError . mkParseError "';'" "not match pattern: " "" d492_308 ["char"]) - let ';' = xx491_309 - return () - return (PlainDefinition v sel)] - selection25_99 = foldl1 mplus [do s <- StateT normalSelection - return s, - do s <- StateT plainSelection - return s] - normalSelection26_100 = foldl1 mplus [do ex <- StateT expressionHs - _ <- StateT spaces - return () - d502_310 <- get - xx501_311 <- StateT char - case xx501_311 of - '/' -> return () - _ -> gets position >>= (throwError . mkParseError "'/'" "not match pattern: " "" d502_310 ["char"]) - let '/' = xx501_311 - return () - _ <- StateT spaces - return () - sel <- StateT normalSelection - return (Selection $ ex : expressions sel), - do ex <- StateT expressionHs - return (Selection [ex])] - plainSelection27_101 = foldl1 mplus [do ex <- StateT plainExpressionHs - _ <- StateT spaces - return () - d514_312 <- get - xx513_313 <- StateT char - case xx513_313 of - '/' -> return () - _ -> gets position >>= (throwError . mkParseError "'/'" "not match pattern: " "" d514_312 ["char"]) - let '/' = xx513_313 - return () - _ <- StateT spaces - return () - sel <- StateT plainSelection - return (PlainSelection $ ex : plainExpressions sel), - do ex <- StateT plainExpressionHs - return (PlainSelection [ex])] - expressionHs28_102 = foldl1 mplus [do e <- StateT expression - _ <- StateT spaces - return () - d526_314 <- get - xx525_315 <- StateT char - case xx525_315 of - '{' -> return () - _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d526_314 ["char"]) - let '{' = xx525_315 - return () - _ <- StateT spaces - return () - h <- StateT hsExpLam - _ <- StateT spaces - return () - d534_316 <- get - xx533_317 <- StateT char - case xx533_317 of - '}' -> return () - _ -> gets position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d534_316 ["char"]) - let '}' = xx533_317 - return () - return (ExpressionHs e h), - do e <- StateT expressionHsSugar - return e] - expressionHsSugar29_103 = foldl1 mplus [do d538_318 <- get - xx537_319 <- StateT char - case xx537_319 of - '<' -> return () - _ -> gets position >>= (throwError . mkParseError "'<'" "not match pattern: " "" d538_318 ["char"]) - let '<' = xx537_319 - return () - _ <- StateT spaces - return () - h <- StateT hsExpLam - _ <- StateT spaces - return () - d546_320 <- get - xx545_321 <- StateT char - case xx545_321 of - '>' -> return () - _ -> gets position >>= (throwError . mkParseError "'>'" "not match pattern: " "" d546_320 ["char"]) - let '>' = xx545_321 - return () - return (ExpressionHsSugar h)] - plainExpressionHs30_104 = foldl1 mplus [do rfs <- list1_322 (foldl1 mplus [do rf <- StateT plainReadFromLs - _ <- StateT spaces - return () - return rf]) - return (PlainExpressionHs rfs)] - plainReadFromLs31_105 = foldl1 mplus [do rf <- StateT readFromLs - return rf, - do rf <- StateT selectCharsLs - return rf] - expression32_106 = foldl1 mplus [do l <- StateT nameLeaf_ - _ <- StateT spaces - return () - e <- StateT expression - return (cons l e), - return emp] - nameLeaf_33_107 = foldl1 mplus [do d564_323 <- get - xx563_324 <- StateT char - case xx563_324 of - '!' -> return () - _ -> gets position >>= (throwError . mkParseError "'!'" "not match pattern: " "" d564_323 ["char"]) - let '!' = xx563_324 - return () - nl <- StateT nameLeafNoCom - _ <- StateT spaces - return () - com <- optional3_325 (StateT comForErr) - return (NotAfter nl $ maybe "" id com), - do d572_326 <- get - xx571_327 <- StateT char - let c = xx571_327 - unless (isAmp c) (gets position >>= (throwError . mkParseError "isAmp c" "not match: " "" d572_326 ["char"])) - nl <- StateT nameLeaf - return (After nl), - do nl <- StateT nameLeaf - return (Here nl)] - nameLeaf34_108 = foldl1 mplus [do n <- StateT pat1 - _ <- StateT spaces - return () - com <- optional3_325 (StateT comForErr) - d584_328 <- get - xx583_329 <- StateT char - case xx583_329 of - ':' -> return () - _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d584_328 ["char"]) - let ':' = xx583_329 - return () - (rf, p) <- StateT leaf - return (NameLeaf (n, maybe "" id com) rf p), - do n <- StateT pat1 - _ <- StateT spaces - return () - com <- optional3_325 (StateT comForErr) - return (NameLeaf (n, - maybe "" id com) FromToken Nothing)] - nameLeafNoCom35_109 = foldl1 mplus [do n <- StateT pat1 - _ <- StateT spaces - return () - com <- optional3_325 (StateT comForErr) - d600_330 <- get - xx599_331 <- StateT char - case xx599_331 of - ':' -> return () - _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d600_330 ["char"]) - let ':' = xx599_331 - return () - (rf, p) <- StateT leaf - return (NameLeaf (n, maybe "" id com) rf p), - do n <- StateT pat1 - _ <- StateT spaces - return () - return (NameLeaf (n, "") FromToken Nothing)] - comForErr36_110 = foldl1 mplus [do d608_332 <- get - xx607_333 <- StateT char - case xx607_333 of - '{' -> return () - _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d608_332 ["char"]) - let '{' = xx607_333 - return () - d610_334 <- get - xx609_335 <- StateT char - case xx609_335 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d610_334 ["char"]) - let '-' = xx609_335 - return () - d612_336 <- get - xx611_337 <- StateT char - case xx611_337 of - '#' -> return () - _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d612_336 ["char"]) - let '#' = xx611_337 - return () - _ <- StateT spaces - return () - d616_338 <- get - xx615_339 <- StateT char - case xx615_339 of - '"' -> return () - _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d616_338 ["char"]) - let '"' = xx615_339 - return () - s <- StateT stringLit - d620_340 <- get - xx619_341 <- StateT char - case xx619_341 of - '"' -> return () - _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d620_340 ["char"]) - let '"' = xx619_341 - return () - _ <- StateT spaces - return () - d624_342 <- get - xx623_343 <- StateT char - case xx623_343 of - '#' -> return () - _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d624_342 ["char"]) - let '#' = xx623_343 - return () - d626_344 <- get - xx625_345 <- StateT char - case xx625_345 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d626_344 ["char"]) - let '-' = xx625_345 - return () - d628_346 <- get - xx627_347 <- StateT char - case xx627_347 of - '}' -> return () - _ -> gets position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d628_346 ["char"]) - let '}' = xx627_347 - return () - _ <- StateT spaces - return () - return s] - leaf37_111 = foldl1 mplus [do rf <- StateT readFromLs - t <- StateT test - return (rf, Just t), - do rf <- StateT readFromLs - return (rf, Nothing), - do t <- StateT test - return (FromToken, Just t)] - patOp38_112 = foldl1 mplus [do p <- StateT pat - o <- StateT opConName - po <- StateT patOp - return (uInfixP p o po), - do p <- StateT pat - _ <- StateT spaces - return () - d650_348 <- get - xx649_349 <- StateT char - let q = xx649_349 - unless (isBQ q) (gets position >>= (throwError . mkParseError "isBQ q" "not match: " "" d650_348 ["char"])) - t <- StateT typ - d654_350 <- get - xx653_351 <- StateT char - let q_ = xx653_351 - unless (isBQ q_) (gets position >>= (throwError . mkParseError "isBQ q_" "not match: " "" d654_350 ["char"])) - _ <- StateT spaces - return () - po <- StateT patOp - return (uInfixP p (mkName t) po), - do p <- StateT pat - return p] - pat39_113 = foldl1 mplus [do t <- StateT typ - _ <- StateT spaces - return () - ps <- StateT pats - return (conToPatQ t ps), - do d668_352 <- get - xx667_353 <- StateT char - case xx667_353 of - '(' -> return () - _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d668_352 ["char"]) - let '(' = xx667_353 - return () - o <- StateT opConName - d672_354 <- get - xx671_355 <- StateT char - case xx671_355 of - ')' -> return () - _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d672_354 ["char"]) - let ')' = xx671_355 - return () - _ <- StateT spaces - return () - ps <- StateT pats - return (conP o ps), - do p <- StateT pat1 - return p] - pat140_114 = foldl1 mplus [do t <- StateT typ - return (conToPatQ t emp), - do d682_356 <- get - xx681_357 <- StateT variable - case xx681_357 of - "_" -> return () - _ -> gets position >>= (throwError . mkParseError "\"_\"" "not match pattern: " "" d682_356 ["variable"]) - let "_" = xx681_357 - return () - return wildP, - do n <- StateT variable - return (strToPatQ n), - do i <- StateT integer - return (litP (integerL i)), - do d688_358 <- get - xx687_359 <- StateT char - case xx687_359 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d688_358 ["char"]) - let '-' = xx687_359 - return () - _ <- StateT spaces - return () - i <- StateT integer - return (litP (integerL $ negate i)), - do d694_360 <- get - xx693_361 <- StateT char - case xx693_361 of - '\'' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d694_360 ["char"]) - let '\'' = xx693_361 - return () - c <- StateT charLit - d698_362 <- get - xx697_363 <- StateT char - case xx697_363 of - '\'' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d698_362 ["char"]) - let '\'' = xx697_363 - return () - return (charP c), - do d700_364 <- get - xx699_365 <- StateT char - case xx699_365 of - '"' -> return () - _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d700_364 ["char"]) - let '"' = xx699_365 - return () - s <- StateT stringLit - d704_366 <- get - xx703_367 <- StateT char - case xx703_367 of - '"' -> return () - _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d704_366 ["char"]) - let '"' = xx703_367 - return () - return (stringP s), - do d706_368 <- get - xx705_369 <- StateT char - case xx705_369 of - '(' -> return () - _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d706_368 ["char"]) - let '(' = xx705_369 - return () - p <- StateT patList - d710_370 <- get - xx709_371 <- StateT char - case xx709_371 of - ')' -> return () - _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d710_370 ["char"]) - let ')' = xx709_371 - return () - return (tupP p), - do d712_372 <- get - xx711_373 <- StateT char - case xx711_373 of - '[' -> return () - _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d712_372 ["char"]) - let '[' = xx711_373 - return () - p <- StateT patList - d716_374 <- get - xx715_375 <- StateT char - case xx715_375 of - ']' -> return () - _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d716_374 ["char"]) - let ']' = xx715_375 - return () - return (listP p)] - patList41_115 = foldl1 mplus [do p <- StateT patOp - _ <- StateT spaces - return () - d722_376 <- get - xx721_377 <- StateT char - case xx721_377 of - ',' -> return () - _ -> gets position >>= (throwError . mkParseError "','" "not match pattern: " "" d722_376 ["char"]) - let ',' = xx721_377 - return () - _ <- StateT spaces - return () - ps <- StateT patList - return (p : ps), - do p <- StateT patOp - return [p], - return []] - opConName42_116 = foldl1 mplus [do d730_378 <- get - xx729_379 <- StateT char - case xx729_379 of - ':' -> return () - _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d730_378 ["char"]) - let ':' = xx729_379 - return () - ot <- StateT opTail - return (mkName $ colon : ot)] - charLit43_117 = foldl1 mplus [do d734_380 <- get - xx733_381 <- StateT char - let c = xx733_381 - unless (isAlphaNumOt c) (gets position >>= (throwError . mkParseError "isAlphaNumOt c" "not match: " "" d734_380 ["char"])) - return c, - do d736_382 <- get - xx735_383 <- StateT char - case xx735_383 of - '\\' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d736_382 ["char"]) - let '\\' = xx735_383 - return () - c <- StateT escapeC - return c] - stringLit44_118 = foldl1 mplus [do d740_384 <- get - xx739_385 <- StateT char - let c = xx739_385 - unless (isStrLitC c) (gets position >>= (throwError . mkParseError "isStrLitC c" "not match: " "" d740_384 ["char"])) - s <- StateT stringLit - return (cons c s), - do d744_386 <- get - xx743_387 <- StateT char - case xx743_387 of - '\\' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d744_386 ["char"]) - let '\\' = xx743_387 - return () - c <- StateT escapeC - s <- StateT stringLit - return (c : s), - return emp] - escapeC45_119 = foldl1 mplus [do d750_388 <- get - xx749_389 <- StateT char - case xx749_389 of - '"' -> return () - _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d750_388 ["char"]) - let '"' = xx749_389 - return () - return '"', - do d752_390 <- get - xx751_391 <- StateT char - case xx751_391 of - '\'' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d752_390 ["char"]) - let '\'' = xx751_391 - return () - return '\'', - do d754_392 <- get - xx753_393 <- StateT char - case xx753_393 of - '\\' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d754_392 ["char"]) - let '\\' = xx753_393 - return () - return '\\', - do d756_394 <- get - xx755_395 <- StateT char - case xx755_395 of - 'n' -> return () - _ -> gets position >>= (throwError . mkParseError "'n'" "not match pattern: " "" d756_394 ["char"]) - let 'n' = xx755_395 - return () - return '\n', - do d758_396 <- get - xx757_397 <- StateT char - case xx757_397 of - 't' -> return () - _ -> gets position >>= (throwError . mkParseError "'t'" "not match pattern: " "" d758_396 ["char"]) - let 't' = xx757_397 - return () - return tab] - pats46_120 = foldl1 mplus [do p <- StateT pat - _ <- StateT spaces - return () - ps <- StateT pats - return (cons p ps), - return emp] - readFromLs47_121 = foldl1 mplus [do rf <- StateT readFrom - d768_398 <- get - xx767_399 <- StateT char - case xx767_399 of - '*' -> return () - _ -> gets position >>= (throwError . mkParseError "'*'" "not match pattern: " "" d768_398 ["char"]) - let '*' = xx767_399 - return () - return (FromList rf), - do rf <- StateT readFrom - d772_400 <- get - xx771_401 <- StateT char - case xx771_401 of - '+' -> return () - _ -> gets position >>= (throwError . mkParseError "'+'" "not match pattern: " "" d772_400 ["char"]) - let '+' = xx771_401 - return () - return (FromList1 rf), - do rf <- StateT readFrom - d776_402 <- get - xx775_403 <- StateT char - case xx775_403 of - '?' -> return () - _ -> gets position >>= (throwError . mkParseError "'?'" "not match pattern: " "" d776_402 ["char"]) - let '?' = xx775_403 - return () - return (FromOptional rf), - do rf <- StateT readFrom - return rf] - readFrom48_122 = foldl1 mplus [do v <- StateT variable - return (FromVariable v), - do d782_404 <- get - xx781_405 <- StateT char - case xx781_405 of - '(' -> return () - _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d782_404 ["char"]) - let '(' = xx781_405 - return () - s <- StateT selection - d786_406 <- get - xx785_407 <- StateT char - case xx785_407 of - ')' -> return () - _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d786_406 ["char"]) - let ')' = xx785_407 - return () - return (FromSelection s), - do e <- StateT expressionHsSugar - return (FromSelection $ Selection [e])] - selectCharsLs49_123 = foldl1 mplus [do rf <- StateT selectChars - d792_408 <- get - xx791_409 <- StateT char - case xx791_409 of - '*' -> return () - _ -> gets position >>= (throwError . mkParseError "'*'" "not match pattern: " "" d792_408 ["char"]) - let '*' = xx791_409 - return () - return (FromList rf), - do rf <- StateT selectChars - d796_410 <- get - xx795_411 <- StateT char - case xx795_411 of - '+' -> return () - _ -> gets position >>= (throwError . mkParseError "'+'" "not match pattern: " "" d796_410 ["char"]) - let '+' = xx795_411 - return () - return (FromList1 rf), - do rf <- StateT selectChars - d800_412 <- get - xx799_413 <- StateT char - case xx799_413 of - '?' -> return () - _ -> gets position >>= (throwError . mkParseError "'?'" "not match pattern: " "" d800_412 ["char"]) - let '?' = xx799_413 - return () - return (FromOptional rf), - do rf <- StateT selectChars - return rf] - selectChars50_124 = foldl1 mplus [do d804_414 <- get - xx803_415 <- StateT char - case xx803_415 of - '[' -> return () - _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d804_414 ["char"]) - let '[' = xx803_415 - return () - cs <- list12_416 (foldl1 mplus [do d808_417 <- get - xx807_418 <- StateT char - let c = xx807_418 - unless (isLower c) (gets position >>= (throwError . mkParseError "isLower c" "not match: " "" d808_417 ["char"])) - return c]) - d810_419 <- get - xx809_420 <- StateT char - case xx809_420 of - ']' -> return () - _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d810_419 ["char"]) - let ']' = xx809_420 - return () - return (FromTokenChars cs), - do d812_421 <- get - xx811_422 <- StateT char - case xx811_422 of - '[' -> return () - _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d812_421 ["char"]) - let '[' = xx811_422 - return () - d814_423 <- get - xx813_424 <- StateT char - let cb = xx813_424 - unless (cb `notElem` "\\-") (gets position >>= (throwError . mkParseError "cb `notElem` \"\\\\-\"" "not match: " "" d814_423 ["char"])) - d816_425 <- get - xx815_426 <- StateT char - case xx815_426 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d816_425 ["char"]) - let '-' = xx815_426 - return () - d818_427 <- get - xx817_428 <- StateT char - let ce = xx817_428 - unless (ce `notElem` "\\-") (gets position >>= (throwError . mkParseError "ce `notElem` \"\\\\-\"" "not match: " "" d818_427 ["char"])) - d820_429 <- get - xx819_430 <- StateT char - case xx819_430 of - ']' -> return () - _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d820_429 ["char"]) - let ']' = xx819_430 - return () - return (FromTokenChars [cb .. ce]), - do d822_431 <- get - xx821_432 <- StateT char - case xx821_432 of - '\'' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d822_431 ["char"]) - let '\'' = xx821_432 - return () - d824_433 <- get - xx823_434 <- StateT char - let c = xx823_434 - unless (c `notElem` "\\'") (gets position >>= (throwError . mkParseError "c `notElem` \"\\\\'\"" "not match: " "" d824_433 ["char"])) - d826_435 <- get - xx825_436 <- StateT char - case xx825_436 of - '\'' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d826_435 ["char"]) - let '\'' = xx825_436 - return () - return (FromTokenChars [c])] - test51_125 = foldl1 mplus [do d828_437 <- get - xx827_438 <- StateT char - case xx827_438 of - '[' -> return () - _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d828_437 ["char"]) - let '[' = xx827_438 - return () - h <- StateT hsExpLam - _ <- StateT spaces - return () - com <- optional3_325 (StateT comForErr) - d836_439 <- get - xx835_440 <- StateT char - case xx835_440 of - ']' -> return () - _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d836_439 ["char"]) - let ']' = xx835_440 - return () - return (h, maybe "" id com)] - hsExpLam52_126 = foldl1 mplus [do d838_441 <- get - xx837_442 <- StateT char - case xx837_442 of - '\\' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d838_441 ["char"]) - let '\\' = xx837_442 - return () - _ <- StateT spaces - return () - ps <- StateT pats - _ <- StateT spaces - return () - d846_443 <- get - xx845_444 <- StateT char - case xx845_444 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d846_443 ["char"]) - let '-' = xx845_444 - return () - d848_445 <- get - xx847_446 <- StateT char - let c = xx847_446 - unless (isGt c) (gets position >>= (throwError . mkParseError "isGt c" "not match: " "" d848_445 ["char"])) - _ <- StateT spaces - return () - e <- StateT hsExpTyp - return (lamE ps e), - do e <- StateT hsExpTyp - return e] - hsExpTyp53_127 = foldl1 mplus [do eo <- StateT hsExpOp - d858_447 <- get - xx857_448 <- StateT char - case xx857_448 of - ':' -> return () - _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d858_447 ["char"]) - let ':' = xx857_448 - return () - d860_449 <- get - xx859_450 <- StateT char - case xx859_450 of - ':' -> return () - _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d860_449 ["char"]) - let ':' = xx859_450 - return () - _ <- StateT spaces - return () - t <- StateT hsTypeArr - return (sigE eo t), - do eo <- StateT hsExpOp - return eo] - hsExpOp54_128 = foldl1 mplus [do l <- StateT hsExp - _ <- StateT spaces - return () - o <- StateT hsOp - _ <- StateT spaces - return () - r <- StateT hsExpOp - return (uInfixE (getEx l) o r), - do e <- StateT hsExp - return (getEx e)] - hsOp55_129 = foldl1 mplus [do d880_451 <- get - xx879_452 <- StateT char - let c = xx879_452 - unless (isOpHeadChar c) (gets position >>= (throwError . mkParseError "isOpHeadChar c" "not match: " "" d880_451 ["char"])) - o <- StateT opTail - return (varE (mkName (cons c o))), - do d884_453 <- get - xx883_454 <- StateT char - case xx883_454 of - ':' -> return () - _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d884_453 ["char"]) - let ':' = xx883_454 - return () - ddd885_455 <- get - do err <- ((do d887_456 <- get - xx886_457 <- StateT char - case xx886_457 of - ':' -> return () - _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d887_456 ["char"]) - let ':' = xx886_457 - return ()) >> return False) `catchError` const (return True) - unless err (gets position >>= (throwError . mkParseError ('!' : "':':") "not match: " "" ddd885_455 ["char"])) - put ddd885_455 - o <- StateT opTail - return (conE (mkName (':' : o))), - do d891_458 <- get - xx890_459 <- StateT char - let c = xx890_459 - unless (isBQ c) (gets position >>= (throwError . mkParseError "isBQ c" "not match: " "" d891_458 ["char"])) - v <- StateT variable - d895_460 <- get - xx894_461 <- StateT char - let c_ = xx894_461 - unless (isBQ c_) (gets position >>= (throwError . mkParseError "isBQ c_" "not match: " "" d895_460 ["char"])) - return (varE (mkName v)), - do d897_462 <- get - xx896_463 <- StateT char - let c = xx896_463 - unless (isBQ c) (gets position >>= (throwError . mkParseError "isBQ c" "not match: " "" d897_462 ["char"])) - t <- StateT typ - d901_464 <- get - xx900_465 <- StateT char - let c_ = xx900_465 - unless (isBQ c_) (gets position >>= (throwError . mkParseError "isBQ c_" "not match: " "" d901_464 ["char"])) - return (conE (mkName t))] - opTail56_130 = foldl1 mplus [do d903_466 <- get - xx902_467 <- StateT char - let c = xx902_467 - unless (isOpTailChar c) (gets position >>= (throwError . mkParseError "isOpTailChar c" "not match: " "" d903_466 ["char"])) - s <- StateT opTail - return (cons c s), - return emp] - hsExp57_131 = foldl1 mplus [do e <- StateT hsExp1 - _ <- StateT spaces - return () - h <- StateT hsExp - return (applyExR e h), - do e <- StateT hsExp1 - return (toEx e)] - hsExp158_132 = foldl1 mplus [do d915_468 <- get - xx914_469 <- StateT char - case xx914_469 of - '(' -> return () - _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d915_468 ["char"]) - let '(' = xx914_469 - return () - l <- optional3_325 (foldl1 mplus [do e <- StateT hsExpTyp - return e]) - _ <- StateT spaces - return () - o <- StateT hsOp - _ <- StateT spaces - return () - r <- optional3_325 (foldl1 mplus [do e <- StateT hsExpTyp - return e]) - d931_470 <- get - xx930_471 <- StateT char - case xx930_471 of - ')' -> return () - _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d931_470 ["char"]) - let ')' = xx930_471 - return () - return (infixE l o r), - do d933_472 <- get - xx932_473 <- StateT char - case xx932_473 of - '(' -> return () - _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d933_472 ["char"]) - let '(' = xx932_473 - return () - et <- StateT hsExpTpl - d937_474 <- get - xx936_475 <- StateT char - case xx936_475 of - ')' -> return () - _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d937_474 ["char"]) - let ')' = xx936_475 - return () - return (tupE et), - do d939_476 <- get - xx938_477 <- StateT char - case xx938_477 of - '[' -> return () - _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d939_476 ["char"]) - let '[' = xx938_477 - return () - et <- StateT hsExpTpl - d943_478 <- get - xx942_479 <- StateT char - case xx942_479 of - ']' -> return () - _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d943_478 ["char"]) - let ']' = xx942_479 - return () - return (listE et), - do v <- StateT variable - return (varE (mkName v)), - do t <- StateT typ - return (conE (mkName t)), - do i <- StateT integer - _ <- StateT spaces - return () - return (litE (integerL i)), - do d953_480 <- get - xx952_481 <- StateT char - case xx952_481 of - '\'' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d953_480 ["char"]) - let '\'' = xx952_481 - return () - c <- StateT charLit - d957_482 <- get - xx956_483 <- StateT char - case xx956_483 of - '\'' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d957_482 ["char"]) - let '\'' = xx956_483 - return () - return (litE (charL c)), - do d959_484 <- get - xx958_485 <- StateT char - case xx958_485 of - '"' -> return () - _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d959_484 ["char"]) - let '"' = xx958_485 - return () - s <- StateT stringLit - d963_486 <- get - xx962_487 <- StateT char - case xx962_487 of - '"' -> return () - _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d963_486 ["char"]) - let '"' = xx962_487 - return () - return (litE (stringL s)), - do d965_488 <- get - xx964_489 <- StateT char - case xx964_489 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d965_488 ["char"]) - let '-' = xx964_489 - return () - _ <- StateT spaces - return () - e <- StateT hsExp1 - return (appE (varE $ mkName "negate") e)] - hsExpTpl59_133 = foldl1 mplus [do e <- StateT hsExpLam - _ <- StateT spaces - return () - d975_490 <- get - xx974_491 <- StateT char - let c = xx974_491 - unless (isComma c) (gets position >>= (throwError . mkParseError "isComma c" "not match: " "" d975_490 ["char"])) - _ <- StateT spaces - return () - et <- StateT hsExpTpl - return (cons e et), - do e <- StateT hsExpLam - return (cons e emp), - return emp] - hsTypeArr60_134 = foldl1 mplus [do l <- StateT hsType - d985_492 <- get - xx984_493 <- StateT char - case xx984_493 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d985_492 ["char"]) - let '-' = xx984_493 - return () - d987_494 <- get - xx986_495 <- StateT char - let c = xx986_495 - unless (isGt c) (gets position >>= (throwError . mkParseError "isGt c" "not match: " "" d987_494 ["char"])) - _ <- StateT spaces - return () - r <- StateT hsTypeArr - return (appT (appT arrowT (getTyp l)) r), - do t <- StateT hsType - return (getTyp t)] - hsType61_135 = foldl1 mplus [do t <- StateT hsType1 - ts <- StateT hsType - return (applyTyp (toTyp t) ts), - do t <- StateT hsType1 - return (toTyp t)] - hsType162_136 = foldl1 mplus [do d1001_496 <- get - xx1000_497 <- StateT char - case xx1000_497 of - '[' -> return () - _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d1001_496 ["char"]) - let '[' = xx1000_497 - return () - d1003_498 <- get - xx1002_499 <- StateT char - case xx1002_499 of - ']' -> return () - _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d1003_498 ["char"]) - let ']' = xx1002_499 - return () - _ <- StateT spaces - return () - return listT, - do d1007_500 <- get - xx1006_501 <- StateT char - case xx1006_501 of - '[' -> return () - _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d1007_500 ["char"]) - let '[' = xx1006_501 - return () - t <- StateT hsTypeArr - d1011_502 <- get - xx1010_503 <- StateT char - case xx1010_503 of - ']' -> return () - _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d1011_502 ["char"]) - let ']' = xx1010_503 - return () - _ <- StateT spaces - return () - return (appT listT t), - do d1015_504 <- get - xx1014_505 <- StateT char - case xx1014_505 of - '(' -> return () - _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d1015_504 ["char"]) - let '(' = xx1014_505 - return () - _ <- StateT spaces - return () - tt <- StateT hsTypeTpl - d1021_506 <- get - xx1020_507 <- StateT char - case xx1020_507 of - ')' -> return () - _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d1021_506 ["char"]) - let ')' = xx1020_507 - return () - return (tupT tt), - do t <- StateT typToken - return (conT (mkName t)), - do d1025_508 <- get - xx1024_509 <- StateT char - case xx1024_509 of - '(' -> return () - _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d1025_508 ["char"]) - let '(' = xx1024_509 - return () - d1027_510 <- get - xx1026_511 <- StateT char - case xx1026_511 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1027_510 ["char"]) - let '-' = xx1026_511 - return () - d1029_512 <- get - xx1028_513 <- StateT char - let c = xx1028_513 - unless (isGt c) (gets position >>= (throwError . mkParseError "isGt c" "not match: " "" d1029_512 ["char"])) - d1031_514 <- get - xx1030_515 <- StateT char - case xx1030_515 of - ')' -> return () - _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d1031_514 ["char"]) - let ')' = xx1030_515 - return () - _ <- StateT spaces - return () - return arrowT] - hsTypeTpl63_137 = foldl1 mplus [do t <- StateT hsTypeArr - d1037_516 <- get - xx1036_517 <- StateT char - let c = xx1036_517 - unless (isComma c) (gets position >>= (throwError . mkParseError "isComma c" "not match: " "" d1037_516 ["char"])) - _ <- StateT spaces - return () - tt <- StateT hsTypeTpl - return (cons t tt), - do t <- StateT hsTypeArr - return (cons t emp), - return emp] - typ64_138 = foldl1 mplus [do u <- StateT upper - t <- StateT tvtail - return (cons u t)] - variable65_139 = foldl1 mplus [do l <- StateT lower - t <- StateT tvtail - return (cons l t)] - tvtail66_140 = foldl1 mplus [do a <- StateT alpha - t <- StateT tvtail - return (cons a t), - return emp] - integer67_141 = foldl1 mplus [do dh <- StateT digit - ds <- list1_322 (foldl1 mplus [do d <- StateT digit - return d]) - return (read (cons dh ds))] - alpha68_142 = foldl1 mplus [do u <- StateT upper - return u, - do l <- StateT lower - return l, - do d <- StateT digit - return d, - do d1069_518 <- get - xx1068_519 <- StateT char - case xx1068_519 of - '\'' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d1069_518 ["char"]) - let '\'' = xx1068_519 - return () - return '\''] - upper69_143 = foldl1 mplus [do d1071_520 <- get - xx1070_521 <- StateT char - let u = xx1070_521 - unless (isUpper u) (gets position >>= (throwError . mkParseError "isUpper u" "not match: " "" d1071_520 ["char"])) - return u] - lower70_144 = foldl1 mplus [do d1073_522 <- get - xx1072_523 <- StateT char - let l = xx1072_523 - unless (isLowerU l) (gets position >>= (throwError . mkParseError "isLowerU l" "not match: " "" d1073_522 ["char"])) - return l] - digit71_145 = foldl1 mplus [do d1075_524 <- get - xx1074_525 <- StateT char - let d = xx1074_525 - unless (isDigit d) (gets position >>= (throwError . mkParseError "isDigit d" "not match: " "" d1075_524 ["char"])) - return d] - spaces72_146 = foldl1 mplus [do _ <- StateT space - return () - _ <- StateT spaces - return () - return (), - return ()] - space73_147 = foldl1 mplus [do d1081_526 <- get - xx1080_527 <- StateT char - let s = xx1080_527 - unless (isSpace s) (gets position >>= (throwError . mkParseError "isSpace s" "not match: " "" d1081_526 ["char"])) - return (), - do d1083_528 <- get - xx1082_529 <- StateT char - case xx1082_529 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1083_528 ["char"]) - let '-' = xx1082_529 - return () - d1085_530 <- get - xx1084_531 <- StateT char - case xx1084_531 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1085_530 ["char"]) - let '-' = xx1084_531 - return () - _ <- StateT notNLString - return () - _ <- StateT newLine - return () - return (), - do _ <- StateT comment - return () - return ()] - notNLString74_148 = foldl1 mplus [do ddd1092_532 <- get - do err <- ((do _ <- StateT newLine - return ()) >> return False) `catchError` const (return True) - unless err (gets position >>= (throwError . mkParseError ('!' : "_:newLine") "not match: " "" ddd1092_532 ["newLine"])) - put ddd1092_532 - c <- StateT char - s <- StateT notNLString - return (cons c s), - return emp] - newLine75_149 = foldl1 mplus [do d1100_533 <- get - xx1099_534 <- StateT char - case xx1099_534 of - '\n' -> return () - _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d1100_533 ["char"]) - let '\n' = xx1099_534 - return () - return ()] - comment76_150 = foldl1 mplus [do d1102_535 <- get - xx1101_536 <- StateT char - case xx1101_536 of - '{' -> return () - _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d1102_535 ["char"]) - let '{' = xx1101_536 - return () - d1104_537 <- get - xx1103_538 <- StateT char - case xx1103_538 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1104_537 ["char"]) - let '-' = xx1103_538 - return () - ddd1105_539 <- get - do err <- ((do d1107_540 <- get - xx1106_541 <- StateT char - case xx1106_541 of - '#' -> return () - _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d1107_540 ["char"]) - let '#' = xx1106_541 - return ()) >> return False) `catchError` const (return True) - unless err (gets position >>= (throwError . mkParseError ('!' : "'#':") "not match: " "" ddd1105_539 ["char"])) - put ddd1105_539 - _ <- StateT comments - return () - _ <- StateT comEnd - return () - return ()] - comments77_151 = foldl1 mplus [do _ <- StateT notComStr - return () - _ <- StateT comment - return () - _ <- StateT comments - return () - return (), - do _ <- StateT notComStr - return () - return ()] - notComStr78_152 = foldl1 mplus [do ddd1120_542 <- get - do err <- ((do _ <- StateT comment - return ()) >> return False) `catchError` const (return True) - unless err (gets position >>= (throwError . mkParseError ('!' : "_:comment") "not match: " "" ddd1120_542 ["comment"])) - put ddd1120_542 - ddd1123_543 <- get - do err <- ((do _ <- StateT comEnd - return ()) >> return False) `catchError` const (return True) - unless err (gets position >>= (throwError . mkParseError ('!' : "_:comEnd") "not match: " "" ddd1123_543 ["comEnd"])) - put ddd1123_543 - _ <- StateT char - return () - _ <- StateT notComStr - return () - return (), - return ()] - comEnd79_153 = foldl1 mplus [do d1131_544 <- get - xx1130_545 <- StateT char - case xx1130_545 of - '-' -> return () - _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1131_544 ["char"]) - let '-' = xx1130_545 - return () - d1133_546 <- get - xx1132_547 <- StateT char - case xx1132_547 of - '}' -> return () - _ -> gets position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d1133_546 ["char"]) - let '}' = xx1132_547 - return () - return ()] - list1_322 :: forall m a . (MonadPlus m, Applicative m) => - m a -> m ([a]) - list12_416 :: forall m a . (MonadPlus m, Applicative m) => - m a -> m ([a]) - list1_322 p = list12_416 p `mplus` return [] - list12_416 p = ((:) <$> p) <*> list1_322 p - optional3_325 :: forall m a . (MonadPlus m, Applicative m) => - m a -> m (Maybe a) - optional3_325 p = (Just <$> p) `mplus` return Nothing + Lookahead(..), + Lists(..), + + Peg, + Definition, + Selection, + Expression, + PlainExpression, + Check, + ReadFrom(..), + + PegQ, + + selectionType, + pprCheck, + nameFromRF, + + parse, + Source(..), + SourceList(..), + Derivs(pegFile, peg, char), + ParseError(..), + mkParseError, + pePositionS, + Pos(..), + ListPos(..), + + PPragma(..), + ModuleName, + Exports, + Code, + + runError, + + dvCharsN +) where + +import Text.Papillon.Papillon +import "monads-tf" Control.Monad.State +import "monads-tf" Control.Monad.Identity +import "monads-tf" Control.Monad.Error +import Control.Applicative + + + +import Text.Papillon.SyntaxTree +import Language.Haskell.TH {- ( + Name, TypeQ, PatQ, ExpQ, mkName, + conT, tupleT, listT, appT, arrowT, + wildP, litP, varP, conP, tupP, listP, uInfixP, + litE, varE, conE, tupE, listE, sigE, appE, infixE, uInfixE, lamE, + integerL, charL, stringL) -} +import Data.Char (isSpace, isDigit, isUpper, isLower) + +data Derivs + = Derivs {pegFile :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((PegFileQ, Derivs))), + pragmas :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (([PPragma], Derivs))), + pragma :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((PPragma, Derivs))), + pragmaStr :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + pragmaItems :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (([String], Derivs))), + pragmaEnd :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((), Derivs))), + moduleDec :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Maybe (([String], Maybe String)), Derivs))), + moduleName :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((ModuleName, Derivs))), + moduleDecStr :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + whr :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((), Derivs))), + preImpPap :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + prePeg :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + afterPeg :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + importPapillon :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((), Derivs))), + varToken :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + typToken :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + pap :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((), Derivs))), + peg :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((STPegQ, Derivs))), + monadType :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Type, Derivs))), + sourceType :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + peg_ :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((PegQ, Derivs))), + definition :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((DefinitionQ, Derivs))), + selection :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((SelectionQ, Derivs))), + normalSelection :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (([ExpressionQ], Derivs))), + plainSelection :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (([PlainExpressionQ], Derivs))), + expressionHs :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((ExpressionQ, Derivs))), + expressionHsSugar :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((ExpressionQ, Derivs))), + plainExpressionHs :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((PlainExpressionQ, Derivs))), + plainHAReadFromLs :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((Lookahead, ReadFromQ), Derivs))), + plainReadFromLs :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((ReadFromQ, Derivs))), + expression :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (([(Lookahead, CheckQ)], Derivs))), + nameLeaf_ :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((Lookahead, CheckQ), Derivs))), + nameLeaf :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((CheckQ, Derivs))), + nameLeafNoCom :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((CheckQ, Derivs))), + comForErr :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + leaf :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((ReadFromQ, Maybe ((Exp, String))), Derivs))), + patOp :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Pat, Derivs))), + pat :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Pat, Derivs))), + pat1 :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Pat, Derivs))), + patList :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (([Pat], Derivs))), + opConName :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Name, Derivs))), + charLit :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Char, Derivs))), + stringLit :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + escapeC :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Char, Derivs))), + pats :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (([Pat], Derivs))), + readFromLs :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((ReadFromQ, Derivs))), + readFrom :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((ReadFromQ, Derivs))), + selectCharsLs :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((ReadFromQ, Derivs))), + selectChars :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((ReadFromQ, Derivs))), + test :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((Exp, String), Derivs))), + hsExpLam :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Exp, Derivs))), + hsExpTyp :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Exp, Derivs))), + hsExpOp :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Exp, Derivs))), + hsOp :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Exp, Derivs))), + opTail :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + hsExp :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((Exp -> Exp) -> Exp, Derivs))), + hsExp1 :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Exp, Derivs))), + hsExpTpl :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (([Exp], Derivs))), + hsTypeArr :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Type, Derivs))), + hsType :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((Type -> Type) -> Type, Derivs))), + hsType1 :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Type, Derivs))), + hsTypeTpl :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (([Type], Derivs))), + typ :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + variable :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + tvtail :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + integer :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Integer, Derivs))), + alpha :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Char, Derivs))), + upper :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Char, Derivs))), + lower :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Char, Derivs))), + digit :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Char, Derivs))), + spaces :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((), Derivs))), + space :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((), Derivs))), + notNLString :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((String, Derivs))), + newLine :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((), Derivs))), + comment :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((), Derivs))), + comments :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((), Derivs))), + notComStr :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((), Derivs))), + comEnd :: (ErrorT (ParseError (Pos String) Derivs) + Identity + (((), Derivs))), + char :: (ErrorT (ParseError (Pos String) Derivs) + Identity + ((Token String, Derivs))), + position :: (Pos String)} +parse :: String -> Derivs +parse = parse1176_0 initialPos + where parse1176_0 pos1175_1 s1177_2 = d655_3 + where d655_3 = Derivs pegFile0_4 pragmas1_5 pragma2_6 pragmaStr3_7 pragmaItems4_8 pragmaEnd5_9 moduleDec6_10 moduleName7_11 moduleDecStr8_12 whr9_13 preImpPap10_14 prePeg11_15 afterPeg12_16 importPapillon13_17 varToken14_18 typToken15_19 pap16_20 peg17_21 monadType18_22 sourceType19_23 peg_20_24 definition21_25 selection22_26 normalSelection23_27 plainSelection24_28 expressionHs25_29 expressionHsSugar26_30 plainExpressionHs27_31 plainHAReadFromLs28_32 plainReadFromLs29_33 expression30_34 nameLeaf_31_35 nameLeaf32_36 nameLeafNoCom33_37 comForErr34_38 leaf35_39 patOp36_40 pat37_41 pat138_42 patList39_43 opConName40_44 charLit41_45 stringLit42_46 escapeC43_47 pats44_48 readFromLs45_49 readFrom46_50 selectCharsLs47_51 selectChars48_52 test49_53 hsExpLam50_54 hsExpTyp51_55 hsExpOp52_56 hsOp53_57 opTail54_58 hsExp55_59 hsExp156_60 hsExpTpl57_61 hsTypeArr58_62 hsType59_63 hsType160_64 hsTypeTpl61_65 typ62_66 variable63_67 tvtail64_68 integer65_69 alpha66_70 upper67_71 lower68_72 digit69_73 spaces70_74 space71_75 notNLString72_76 newLine73_77 comment74_78 comments75_79 notComStr76_80 comEnd77_81 chars1178_82 pos1175_1 + pegFile0_4 = runStateT pegFile78_83 d655_3 + pragmas1_5 = runStateT pragmas79_84 d655_3 + pragma2_6 = runStateT pragma80_85 d655_3 + pragmaStr3_7 = runStateT pragmaStr81_86 d655_3 + pragmaItems4_8 = runStateT pragmaItems82_87 d655_3 + pragmaEnd5_9 = runStateT pragmaEnd83_88 d655_3 + moduleDec6_10 = runStateT moduleDec84_89 d655_3 + moduleName7_11 = runStateT moduleName85_90 d655_3 + moduleDecStr8_12 = runStateT moduleDecStr86_91 d655_3 + whr9_13 = runStateT whr87_92 d655_3 + preImpPap10_14 = runStateT preImpPap88_93 d655_3 + prePeg11_15 = runStateT prePeg89_94 d655_3 + afterPeg12_16 = runStateT afterPeg90_95 d655_3 + importPapillon13_17 = runStateT importPapillon91_96 d655_3 + varToken14_18 = runStateT varToken92_97 d655_3 + typToken15_19 = runStateT typToken93_98 d655_3 + pap16_20 = runStateT pap94_99 d655_3 + peg17_21 = runStateT peg95_100 d655_3 + monadType18_22 = runStateT monadType96_101 d655_3 + sourceType19_23 = runStateT sourceType97_102 d655_3 + peg_20_24 = runStateT peg_98_103 d655_3 + definition21_25 = runStateT definition99_104 d655_3 + selection22_26 = runStateT selection100_105 d655_3 + normalSelection23_27 = runStateT normalSelection101_106 d655_3 + plainSelection24_28 = runStateT plainSelection102_107 d655_3 + expressionHs25_29 = runStateT expressionHs103_108 d655_3 + expressionHsSugar26_30 = runStateT expressionHsSugar104_109 d655_3 + plainExpressionHs27_31 = runStateT plainExpressionHs105_110 d655_3 + plainHAReadFromLs28_32 = runStateT plainHAReadFromLs106_111 d655_3 + plainReadFromLs29_33 = runStateT plainReadFromLs107_112 d655_3 + expression30_34 = runStateT expression108_113 d655_3 + nameLeaf_31_35 = runStateT nameLeaf_109_114 d655_3 + nameLeaf32_36 = runStateT nameLeaf110_115 d655_3 + nameLeafNoCom33_37 = runStateT nameLeafNoCom111_116 d655_3 + comForErr34_38 = runStateT comForErr112_117 d655_3 + leaf35_39 = runStateT leaf113_118 d655_3 + patOp36_40 = runStateT patOp114_119 d655_3 + pat37_41 = runStateT pat115_120 d655_3 + pat138_42 = runStateT pat1116_121 d655_3 + patList39_43 = runStateT patList117_122 d655_3 + opConName40_44 = runStateT opConName118_123 d655_3 + charLit41_45 = runStateT charLit119_124 d655_3 + stringLit42_46 = runStateT stringLit120_125 d655_3 + escapeC43_47 = runStateT escapeC121_126 d655_3 + pats44_48 = runStateT pats122_127 d655_3 + readFromLs45_49 = runStateT readFromLs123_128 d655_3 + readFrom46_50 = runStateT readFrom124_129 d655_3 + selectCharsLs47_51 = runStateT selectCharsLs125_130 d655_3 + selectChars48_52 = runStateT selectChars126_131 d655_3 + test49_53 = runStateT test127_132 d655_3 + hsExpLam50_54 = runStateT hsExpLam128_133 d655_3 + hsExpTyp51_55 = runStateT hsExpTyp129_134 d655_3 + hsExpOp52_56 = runStateT hsExpOp130_135 d655_3 + hsOp53_57 = runStateT hsOp131_136 d655_3 + opTail54_58 = runStateT opTail132_137 d655_3 + hsExp55_59 = runStateT hsExp133_138 d655_3 + hsExp156_60 = runStateT hsExp1134_139 d655_3 + hsExpTpl57_61 = runStateT hsExpTpl135_140 d655_3 + hsTypeArr58_62 = runStateT hsTypeArr136_141 d655_3 + hsType59_63 = runStateT hsType137_142 d655_3 + hsType160_64 = runStateT hsType1138_143 d655_3 + hsTypeTpl61_65 = runStateT hsTypeTpl139_144 d655_3 + typ62_66 = runStateT typ140_145 d655_3 + variable63_67 = runStateT variable141_146 d655_3 + tvtail64_68 = runStateT tvtail142_147 d655_3 + integer65_69 = runStateT integer143_148 d655_3 + alpha66_70 = runStateT alpha144_149 d655_3 + upper67_71 = runStateT upper145_150 d655_3 + lower68_72 = runStateT lower146_151 d655_3 + digit69_73 = runStateT digit147_152 d655_3 + spaces70_74 = runStateT spaces148_153 d655_3 + space71_75 = runStateT space149_154 d655_3 + notNLString72_76 = runStateT notNLString150_155 d655_3 + newLine73_77 = runStateT newLine151_156 d655_3 + comment74_78 = runStateT comment152_157 d655_3 + comments75_79 = runStateT comments153_158 d655_3 + notComStr76_80 = runStateT notComStr154_159 d655_3 + comEnd77_81 = runStateT comEnd155_160 d655_3 + chars1178_82 = runStateT (case getToken s1177_2 of + Just (c1173_161, + s'1174_162) -> do put (parse1176_0 (updatePos c1173_161 pos1175_1) s'1174_162) + return c1173_161 + _ -> gets position >>= (throwError . mkParseError "" "end of input" "" undefined [])) d655_3 + pegFile78_83 = foldl1 mplus [do pr <- StateT pragmas + md <- StateT moduleDec + pip <- StateT preImpPap + _ <- StateT importPapillon + return () + pp <- StateT prePeg + _ <- StateT pap + return () + p <- StateT peg + _ <- StateT spaces + return () + d663_163 <- get + t167_164 <- StateT char + case t167_164 of + '|' -> return () + _ -> gets position >>= (throwError . mkParseError "'|'" "not match pattern: " "" d663_163 ["char"]) + let '|' = t167_164 + return () + d664_165 <- get + t168_166 <- StateT char + case t168_166 of + ']' -> return () + _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d664_165 ["char"]) + let ']' = t168_166 + return () + d665_167 <- get + t169_168 <- StateT char + case t169_168 of + '\n' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d665_167 ["char"]) + let '\n' = t169_168 + return () + atp <- StateT afterPeg + return (mkPegFile pr md pip pp p atp), + do pr <- StateT pragmas + md <- StateT moduleDec + pp <- StateT prePeg + _ <- StateT pap + return () + p <- StateT peg + _ <- StateT spaces + return () + d673_169 <- get + t177_170 <- StateT char + case t177_170 of + '|' -> return () + _ -> gets position >>= (throwError . mkParseError "'|'" "not match pattern: " "" d673_169 ["char"]) + let '|' = t177_170 + return () + d674_171 <- get + t178_172 <- StateT char + case t178_172 of + ']' -> return () + _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d674_171 ["char"]) + let ']' = t178_172 + return () + d675_173 <- get + t179_174 <- StateT char + case t179_174 of + '\n' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d675_173 ["char"]) + let '\n' = t179_174 + return () + atp <- StateT afterPeg + return (mkPegFile pr md [] pp p atp)] + pragmas79_84 = foldl1 mplus [do _ <- StateT spaces + return () + pr <- StateT pragma + prs <- StateT pragmas + return (pr : prs), + do _ <- StateT spaces + return () + return []] + pragma80_85 = foldl1 mplus [do d681_175 <- get + t185_176 <- StateT char + case t185_176 of + '{' -> return () + _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d681_175 ["char"]) + let '{' = t185_176 + return () + d682_177 <- get + t186_178 <- StateT char + case t186_178 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d682_177 ["char"]) + let '-' = t186_178 + return () + d683_179 <- get + t187_180 <- StateT char + case t187_180 of + '#' -> return () + _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d683_179 ["char"]) + let '#' = t187_180 + return () + _ <- StateT spaces + return () + d685_181 <- get + t189_182 <- StateT char + case t189_182 of + 'L' -> return () + _ -> gets position >>= (throwError . mkParseError "'L'" "not match pattern: " "" d685_181 ["char"]) + let 'L' = t189_182 + return () + d686_183 <- get + t190_184 <- StateT char + case t190_184 of + 'A' -> return () + _ -> gets position >>= (throwError . mkParseError "'A'" "not match pattern: " "" d686_183 ["char"]) + let 'A' = t190_184 + return () + d687_185 <- get + t191_186 <- StateT char + case t191_186 of + 'N' -> return () + _ -> gets position >>= (throwError . mkParseError "'N'" "not match pattern: " "" d687_185 ["char"]) + let 'N' = t191_186 + return () + d688_187 <- get + t192_188 <- StateT char + case t192_188 of + 'G' -> return () + _ -> gets position >>= (throwError . mkParseError "'G'" "not match pattern: " "" d688_187 ["char"]) + let 'G' = t192_188 + return () + d689_189 <- get + t193_190 <- StateT char + case t193_190 of + 'U' -> return () + _ -> gets position >>= (throwError . mkParseError "'U'" "not match pattern: " "" d689_189 ["char"]) + let 'U' = t193_190 + return () + d690_191 <- get + t194_192 <- StateT char + case t194_192 of + 'A' -> return () + _ -> gets position >>= (throwError . mkParseError "'A'" "not match pattern: " "" d690_191 ["char"]) + let 'A' = t194_192 + return () + d691_193 <- get + t195_194 <- StateT char + case t195_194 of + 'G' -> return () + _ -> gets position >>= (throwError . mkParseError "'G'" "not match pattern: " "" d691_193 ["char"]) + let 'G' = t195_194 + return () + d692_195 <- get + t196_196 <- StateT char + case t196_196 of + 'E' -> return () + _ -> gets position >>= (throwError . mkParseError "'E'" "not match pattern: " "" d692_195 ["char"]) + let 'E' = t196_196 + return () + _ <- StateT spaces + return () + s <- StateT pragmaItems + _ <- StateT pragmaEnd + return () + _ <- StateT spaces + return () + return (LanguagePragma s), + do d697_197 <- get + t201_198 <- StateT char + case t201_198 of + '{' -> return () + _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d697_197 ["char"]) + let '{' = t201_198 + return () + d698_199 <- get + t202_200 <- StateT char + case t202_200 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d698_199 ["char"]) + let '-' = t202_200 + return () + d699_201 <- get + t203_202 <- StateT char + case t203_202 of + '#' -> return () + _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d699_201 ["char"]) + let '#' = t203_202 + return () + _ <- StateT spaces + return () + s <- StateT pragmaStr + _ <- StateT pragmaEnd + return () + return (OtherPragma s)] + pragmaStr81_86 = foldl1 mplus [do d704_203 <- get + do err1162_204 <- ((do _ <- StateT pragmaEnd + return ()) >> return False) `catchError` const (return True) + unless err1162_204 (gets position >>= (throwError . mkParseError "!_:pragmaEnd" "not match: " "" d704_203 ["pragmaEnd"])) + put d704_203 + c <- StateT char + s <- StateT pragmaStr + return (c : s), + return ""] + pragmaItems82_87 = foldl1 mplus [do t <- StateT typToken + d708_205 <- get + t211_206 <- StateT char + case t211_206 of + ',' -> return () + _ -> gets position >>= (throwError . mkParseError "','" "not match pattern: " "" d708_205 ["char"]) + let ',' = t211_206 + return () + _ <- StateT spaces + return () + i <- StateT pragmaItems + return (t : i), + do t <- StateT typToken + return [t]] + pragmaEnd83_88 = foldl1 mplus [do _ <- StateT spaces + return () + d713_207 <- get + t216_208 <- StateT char + case t216_208 of + '#' -> return () + _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d713_207 ["char"]) + let '#' = t216_208 + return () + d714_209 <- get + t217_210 <- StateT char + case t217_210 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d714_209 ["char"]) + let '-' = t217_210 + return () + d715_211 <- get + t218_212 <- StateT char + case t218_212 of + '}' -> return () + _ -> gets position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d715_211 ["char"]) + let '}' = t218_212 + return () + return ()] + moduleDec84_89 = foldl1 mplus [do d716_213 <- get + t219_214 <- StateT char + case t219_214 of + 'm' -> return () + _ -> gets position >>= (throwError . mkParseError "'m'" "not match pattern: " "" d716_213 ["char"]) + let 'm' = t219_214 + return () + d717_215 <- get + t220_216 <- StateT char + case t220_216 of + 'o' -> return () + _ -> gets position >>= (throwError . mkParseError "'o'" "not match pattern: " "" d717_215 ["char"]) + let 'o' = t220_216 + return () + d718_217 <- get + t221_218 <- StateT char + case t221_218 of + 'd' -> return () + _ -> gets position >>= (throwError . mkParseError "'d'" "not match pattern: " "" d718_217 ["char"]) + let 'd' = t221_218 + return () + d719_219 <- get + t222_220 <- StateT char + case t222_220 of + 'u' -> return () + _ -> gets position >>= (throwError . mkParseError "'u'" "not match pattern: " "" d719_219 ["char"]) + let 'u' = t222_220 + return () + d720_221 <- get + t223_222 <- StateT char + case t223_222 of + 'l' -> return () + _ -> gets position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d720_221 ["char"]) + let 'l' = t223_222 + return () + d721_223 <- get + t224_224 <- StateT char + case t224_224 of + 'e' -> return () + _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d721_223 ["char"]) + let 'e' = t224_224 + return () + _ <- StateT spaces + return () + n <- StateT moduleName + _ <- StateT spaces + return () + d725_225 <- get + t228_226 <- StateT char + case t228_226 of + '(' -> return () + _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d725_225 ["char"]) + let '(' = t228_226 + return () + _ <- StateT spaces + return () + s <- StateT moduleDecStr + _ <- StateT whr + return () + return (Just (n, Just s)), + do d729_227 <- get + t232_228 <- StateT char + case t232_228 of + 'm' -> return () + _ -> gets position >>= (throwError . mkParseError "'m'" "not match pattern: " "" d729_227 ["char"]) + let 'm' = t232_228 + return () + d730_229 <- get + t233_230 <- StateT char + case t233_230 of + 'o' -> return () + _ -> gets position >>= (throwError . mkParseError "'o'" "not match pattern: " "" d730_229 ["char"]) + let 'o' = t233_230 + return () + d731_231 <- get + t234_232 <- StateT char + case t234_232 of + 'd' -> return () + _ -> gets position >>= (throwError . mkParseError "'d'" "not match pattern: " "" d731_231 ["char"]) + let 'd' = t234_232 + return () + d732_233 <- get + t235_234 <- StateT char + case t235_234 of + 'u' -> return () + _ -> gets position >>= (throwError . mkParseError "'u'" "not match pattern: " "" d732_233 ["char"]) + let 'u' = t235_234 + return () + d733_235 <- get + t236_236 <- StateT char + case t236_236 of + 'l' -> return () + _ -> gets position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d733_235 ["char"]) + let 'l' = t236_236 + return () + d734_237 <- get + t237_238 <- StateT char + case t237_238 of + 'e' -> return () + _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d734_237 ["char"]) + let 'e' = t237_238 + return () + _ <- StateT spaces + return () + n <- StateT moduleName + _ <- StateT spaces + return () + d738_239 <- get + t241_240 <- StateT char + case t241_240 of + 'w' -> return () + _ -> gets position >>= (throwError . mkParseError "'w'" "not match pattern: " "" d738_239 ["char"]) + let 'w' = t241_240 + return () + d739_241 <- get + t242_242 <- StateT char + case t242_242 of + 'h' -> return () + _ -> gets position >>= (throwError . mkParseError "'h'" "not match pattern: " "" d739_241 ["char"]) + let 'h' = t242_242 + return () + d740_243 <- get + t243_244 <- StateT char + case t243_244 of + 'e' -> return () + _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d740_243 ["char"]) + let 'e' = t243_244 + return () + d741_245 <- get + t244_246 <- StateT char + case t244_246 of + 'r' -> return () + _ -> gets position >>= (throwError . mkParseError "'r'" "not match pattern: " "" d741_245 ["char"]) + let 'r' = t244_246 + return () + d742_247 <- get + t245_248 <- StateT char + case t245_248 of + 'e' -> return () + _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d742_247 ["char"]) + let 'e' = t245_248 + return () + _ <- StateT spaces + return () + return (Just (n, Nothing)), + return Nothing] + moduleName85_90 = foldl1 mplus [do t <- StateT typ + d745_249 <- get + t248_250 <- StateT char + case t248_250 of + '.' -> return () + _ -> gets position >>= (throwError . mkParseError "'.'" "not match pattern: " "" d745_249 ["char"]) + let '.' = t248_250 + return () + n <- StateT moduleName + return (t : n), + do t <- StateT typ + return [t]] + moduleDecStr86_91 = foldl1 mplus [do d749_251 <- get + do err1163_252 <- ((do _ <- StateT whr + return ()) >> return False) `catchError` const (return True) + unless err1163_252 (gets position >>= (throwError . mkParseError "!_:whr" "not match: " "" d749_251 ["whr"])) + put d749_251 + c <- StateT char + s <- StateT moduleDecStr + return (c : s), + return ""] + whr87_92 = foldl1 mplus [do _ <- StateT spaces + return () + d753_253 <- get + t255_254 <- StateT char + case t255_254 of + ')' -> return () + _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d753_253 ["char"]) + let ')' = t255_254 + return () + _ <- StateT spaces + return () + d755_255 <- get + t257_256 <- StateT char + case t257_256 of + 'w' -> return () + _ -> gets position >>= (throwError . mkParseError "'w'" "not match pattern: " "" d755_255 ["char"]) + let 'w' = t257_256 + return () + d756_257 <- get + t258_258 <- StateT char + case t258_258 of + 'h' -> return () + _ -> gets position >>= (throwError . mkParseError "'h'" "not match pattern: " "" d756_257 ["char"]) + let 'h' = t258_258 + return () + d757_259 <- get + t259_260 <- StateT char + case t259_260 of + 'e' -> return () + _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d757_259 ["char"]) + let 'e' = t259_260 + return () + d758_261 <- get + t260_262 <- StateT char + case t260_262 of + 'r' -> return () + _ -> gets position >>= (throwError . mkParseError "'r'" "not match pattern: " "" d758_261 ["char"]) + let 'r' = t260_262 + return () + d759_263 <- get + t261_264 <- StateT char + case t261_264 of + 'e' -> return () + _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d759_263 ["char"]) + let 'e' = t261_264 + return () + return ()] + preImpPap88_93 = foldl1 mplus [do d761_265 <- get + do err1164_266 <- ((do _ <- StateT importPapillon + return ()) >> return False) `catchError` const (return True) + unless err1164_266 (gets position >>= (throwError . mkParseError "!_:importPapillon" "not match: " "" d761_265 ["importPapillon"])) + put d761_265 + d763_267 <- get + do err1165_268 <- ((do _ <- StateT pap + return ()) >> return False) `catchError` const (return True) + unless err1165_268 (gets position >>= (throwError . mkParseError "!_:pap" "not match: " "" d763_267 ["pap"])) + put d763_267 + c <- StateT char + pip <- StateT preImpPap + return (c : pip), + return ""] + prePeg89_94 = foldl1 mplus [do d767_269 <- get + do err1166_270 <- ((do _ <- StateT pap + return ()) >> return False) `catchError` const (return True) + unless err1166_270 (gets position >>= (throwError . mkParseError "!_:pap" "not match: " "" d767_269 ["pap"])) + put d767_269 + c <- StateT char + pp <- StateT prePeg + return (c : pp), + return ""] + afterPeg90_95 = foldl1 mplus [do c <- StateT char + atp <- StateT afterPeg + return (c : atp), + return ""] + importPapillon91_96 = foldl1 mplus [do d772_271 <- get + t271_272 <- StateT varToken + case t271_272 of + "import" -> return () + _ -> gets position >>= (throwError . mkParseError "\"import\"" "not match pattern: " "" d772_271 ["varToken"]) + let "import" = t271_272 + return () + d773_273 <- get + t272_274 <- StateT typToken + case t272_274 of + "Text" -> return () + _ -> gets position >>= (throwError . mkParseError "\"Text\"" "not match pattern: " "" d773_273 ["typToken"]) + let "Text" = t272_274 + return () + d774_275 <- get + t273_276 <- StateT char + case t273_276 of + '.' -> return () + _ -> gets position >>= (throwError . mkParseError "'.'" "not match pattern: " "" d774_275 ["char"]) + let '.' = t273_276 + return () + _ <- StateT spaces + return () + d776_277 <- get + t275_278 <- StateT typToken + case t275_278 of + "Papillon" -> return () + _ -> gets position >>= (throwError . mkParseError "\"Papillon\"" "not match pattern: " "" d776_277 ["typToken"]) + let "Papillon" = t275_278 + return () + d778_279 <- get + do err1167_280 <- ((do d777_281 <- get + t276_282 <- StateT char + case t276_282 of + '.' -> return () + _ -> gets position >>= (throwError . mkParseError "'.'" "not match pattern: " "" d777_281 ["char"]) + let '.' = t276_282 + return ()) >> return False) `catchError` const (return True) + unless err1167_280 (gets position >>= (throwError . mkParseError "!'.':" "not match: " "" d778_279 ["char"])) + put d778_279 + return ()] + varToken92_97 = foldl1 mplus [do v <- StateT variable + _ <- StateT spaces + return () + return v] + typToken93_98 = foldl1 mplus [do t <- StateT typ + _ <- StateT spaces + return () + return t] + pap94_99 = foldl1 mplus [do d783_283 <- get + t281_284 <- StateT char + case t281_284 of + '\n' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d783_283 ["char"]) + let '\n' = t281_284 + return () + d784_285 <- get + t282_286 <- StateT char + case t282_286 of + '[' -> return () + _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d784_285 ["char"]) + let '[' = t282_286 + return () + d785_287 <- get + t283_288 <- StateT char + case t283_288 of + 'p' -> return () + _ -> gets position >>= (throwError . mkParseError "'p'" "not match pattern: " "" d785_287 ["char"]) + let 'p' = t283_288 + return () + d786_289 <- get + t284_290 <- StateT char + case t284_290 of + 'a' -> return () + _ -> gets position >>= (throwError . mkParseError "'a'" "not match pattern: " "" d786_289 ["char"]) + let 'a' = t284_290 + return () + d787_291 <- get + t285_292 <- StateT char + case t285_292 of + 'p' -> return () + _ -> gets position >>= (throwError . mkParseError "'p'" "not match pattern: " "" d787_291 ["char"]) + let 'p' = t285_292 + return () + d788_293 <- get + t286_294 <- StateT char + case t286_294 of + 'i' -> return () + _ -> gets position >>= (throwError . mkParseError "'i'" "not match pattern: " "" d788_293 ["char"]) + let 'i' = t286_294 + return () + d789_295 <- get + t287_296 <- StateT char + case t287_296 of + 'l' -> return () + _ -> gets position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d789_295 ["char"]) + let 'l' = t287_296 + return () + d790_297 <- get + t288_298 <- StateT char + case t288_298 of + 'l' -> return () + _ -> gets position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d790_297 ["char"]) + let 'l' = t288_298 + return () + d791_299 <- get + t289_300 <- StateT char + case t289_300 of + 'o' -> return () + _ -> gets position >>= (throwError . mkParseError "'o'" "not match pattern: " "" d791_299 ["char"]) + let 'o' = t289_300 + return () + d792_301 <- get + t290_302 <- StateT char + case t290_302 of + 'n' -> return () + _ -> gets position >>= (throwError . mkParseError "'n'" "not match pattern: " "" d792_301 ["char"]) + let 'n' = t290_302 + return () + d793_303 <- get + t291_304 <- StateT char + case t291_304 of + '|' -> return () + _ -> gets position >>= (throwError . mkParseError "'|'" "not match pattern: " "" d793_303 ["char"]) + let '|' = t291_304 + return () + d794_305 <- get + t292_306 <- StateT char + case t292_306 of + '\n' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d794_305 ["char"]) + let '\n' = t292_306 + return () + return ()] + peg95_100 = foldl1 mplus [do mt <- optional156_307 (StateT monadType) + _ <- StateT spaces + return () + s <- StateT sourceType + p <- StateT peg_ + return (stPegQ mt (ConT $ mkName s) p), + do mt <- optional156_307 (StateT monadType) + p <- StateT peg_ + return (stPegQ mt (ConT $ mkName "String") p)] + monadType96_101 = foldl1 mplus [do _ <- StateT spaces + return () + d802_308 <- get + t300_309 <- StateT varToken + case t300_309 of + "monad" -> return () + _ -> gets position >>= (throwError . mkParseError "\"monad\"" "not match pattern: " "" d802_308 ["varToken"]) + let "monad" = t300_309 + return () + d803_310 <- get + t301_311 <- StateT char + case t301_311 of + ':' -> return () + _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d803_310 ["char"]) + let ':' = t301_311 + return () + _ <- StateT spaces + return () + t <- StateT hsTypeArr + return t] + sourceType97_102 = foldl1 mplus [do d806_312 <- get + t304_313 <- StateT varToken + case t304_313 of + "source" -> return () + _ -> gets position >>= (throwError . mkParseError "\"source\"" "not match pattern: " "" d806_312 ["varToken"]) + let "source" = t304_313 + return () + d807_314 <- get + t305_315 <- StateT char + case t305_315 of + ':' -> return () + _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d807_314 ["char"]) + let ':' = t305_315 + return () + _ <- StateT spaces + return () + v <- StateT typToken + return v] + peg_98_103 = foldl1 mplus [do _ <- StateT spaces + return () + d <- StateT definition + p <- StateT peg_ + return (d : p), + return []] + definition99_104 = foldl1 mplus [do v <- StateT variable + _ <- StateT spaces + return () + d815_316 <- get + t313_317 <- StateT char + case t313_317 of + ':' -> return () + _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d815_316 ["char"]) + let ':' = t313_317 + return () + d816_318 <- get + t314_319 <- StateT char + case t314_319 of + ':' -> return () + _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d816_318 ["char"]) + let ':' = t314_319 + return () + _ <- StateT spaces + return () + t <- StateT hsTypeArr + _ <- StateT spaces + return () + d820_320 <- get + t318_321 <- StateT char + case t318_321 of + '=' -> return () + _ -> gets position >>= (throwError . mkParseError "'='" "not match pattern: " "" d820_320 ["char"]) + let '=' = t318_321 + return () + _ <- StateT spaces + return () + sel <- StateT selection + _ <- StateT spaces + return () + d824_322 <- get + t322_323 <- StateT char + case t322_323 of + ';' -> return () + _ -> gets position >>= (throwError . mkParseError "';'" "not match pattern: " "" d824_322 ["char"]) + let ';' = t322_323 + return () + return (definitionQ v (Just t) sel), + do v <- StateT variable + _ <- StateT spaces + return () + d827_324 <- get + t325_325 <- StateT char + case t325_325 of + '<' -> return () + _ -> gets position >>= (throwError . mkParseError "'<'" "not match pattern: " "" d827_324 ["char"]) + let '<' = t325_325 + return () + d828_326 <- get + t326_327 <- StateT char + case t326_327 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d828_326 ["char"]) + let '-' = t326_327 + return () + _ <- StateT spaces + return () + sel <- StateT plainSelection + _ <- StateT spaces + return () + d832_328 <- get + t330_329 <- StateT char + case t330_329 of + ';' -> return () + _ -> gets position >>= (throwError . mkParseError "';'" "not match pattern: " "" d832_328 ["char"]) + let ';' = t330_329 + return () + return (definitionQ v Nothing $ plainSelectionQ sel)] + selection100_105 = foldl1 mplus [do s <- StateT normalSelection + return (normalSelectionQ s), + do s <- StateT plainSelection + return (plainSelectionQ s)] + normalSelection101_106 = foldl1 mplus [do ex <- StateT expressionHs + _ <- StateT spaces + return () + d837_330 <- get + t335_331 <- StateT char + case t335_331 of + '/' -> return () + _ -> gets position >>= (throwError . mkParseError "'/'" "not match pattern: " "" d837_330 ["char"]) + let '/' = t335_331 + return () + _ <- StateT spaces + return () + sel <- StateT normalSelection + return (ex : sel), + do ex <- StateT expressionHs + return [ex]] + plainSelection102_107 = foldl1 mplus [do ex <- StateT plainExpressionHs + _ <- StateT spaces + return () + d843_332 <- get + t341_333 <- StateT char + case t341_333 of + '/' -> return () + _ -> gets position >>= (throwError . mkParseError "'/'" "not match pattern: " "" d843_332 ["char"]) + let '/' = t341_333 + return () + _ <- StateT spaces + return () + sel <- StateT plainSelection + return (ex : sel), + do ex <- StateT plainExpressionHs + return [ex]] + expressionHs103_108 = foldl1 mplus [do e <- StateT expression + _ <- StateT spaces + return () + d849_334 <- get + t347_335 <- StateT char + case t347_335 of + '{' -> return () + _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d849_334 ["char"]) + let '{' = t347_335 + return () + _ <- StateT spaces + return () + h <- StateT hsExpLam + _ <- StateT spaces + return () + d853_336 <- get + t351_337 <- StateT char + case t351_337 of + '}' -> return () + _ -> gets position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d853_336 ["char"]) + let '}' = t351_337 + return () + return (expressionQ (e, h)), + do e <- StateT expressionHsSugar + return e] + expressionHsSugar104_109 = foldl1 mplus [do d855_338 <- get + t353_339 <- StateT char + case t353_339 of + '<' -> return () + _ -> gets position >>= (throwError . mkParseError "'<'" "not match pattern: " "" d855_338 ["char"]) + let '<' = t353_339 + return () + _ <- StateT spaces + return () + h <- StateT hsExpLam + _ <- StateT spaces + return () + d859_340 <- get + t357_341 <- StateT char + case t357_341 of + '>' -> return () + _ -> gets position >>= (throwError . mkParseError "'>'" "not match pattern: " "" d859_340 ["char"]) + let '>' = t357_341 + return () + return (expressionSugar h)] + plainExpressionHs105_110 = foldl1 mplus [do rfs <- list157_342 (foldl1 mplus [do rf <- StateT plainHAReadFromLs + _ <- StateT spaces + return () + return rf]) + return (plainExpressionQ rfs)] + plainHAReadFromLs106_111 = foldl1 mplus [do rf <- StateT plainReadFromLs + return (Here, rf), + do d864_343 <- get + t362_344 <- StateT char + case t362_344 of + '&' -> return () + _ -> gets position >>= (throwError . mkParseError "'&'" "not match pattern: " "" d864_343 ["char"]) + let '&' = t362_344 + return () + rf <- StateT plainReadFromLs + return (Ahead, rf), + do d866_345 <- get + t364_346 <- StateT char + case t364_346 of + '!' -> return () + _ -> gets position >>= (throwError . mkParseError "'!'" "not match pattern: " "" d866_345 ["char"]) + let '!' = t364_346 + return () + rf <- StateT plainReadFromLs + return (NAhead "", rf)] + plainReadFromLs107_112 = foldl1 mplus [do rf <- StateT readFromLs + return rf, + do rf <- StateT selectCharsLs + return rf] + expression108_113 = foldl1 mplus [do l <- StateT nameLeaf_ + _ <- StateT spaces + return () + e <- StateT expression + return (l : e), + return []] + nameLeaf_109_114 = foldl1 mplus [do d873_347 <- get + t371_348 <- StateT char + case t371_348 of + '!' -> return () + _ -> gets position >>= (throwError . mkParseError "'!'" "not match pattern: " "" d873_347 ["char"]) + let '!' = t371_348 + return () + nl <- StateT nameLeafNoCom + _ <- StateT spaces + return () + com <- optional156_307 (StateT comForErr) + return (NAhead $ maybe "" id com, nl), + do d877_349 <- get + t375_350 <- StateT char + case t375_350 of + '&' -> return () + _ -> gets position >>= (throwError . mkParseError "'&'" "not match pattern: " "" d877_349 ["char"]) + let '&' = t375_350 + return () + nl <- StateT nameLeaf + return (Ahead, nl), + do nl <- StateT nameLeaf + return (Here, nl)] + nameLeaf110_115 = foldl1 mplus [do n <- StateT pat1 + _ <- StateT spaces + return () + com <- optional156_307 (StateT comForErr) + d883_351 <- get + t381_352 <- StateT char + case t381_352 of + ':' -> return () + _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d883_351 ["char"]) + let ':' = t381_352 + return () + (rf, p) <- StateT leaf + return (check (n, maybe "" id com) rf p), + do n <- StateT pat1 + _ <- StateT spaces + return () + com <- optional156_307 (StateT comForErr) + return (check (n, + maybe "" id com) (FromVariable Nothing) Nothing)] + nameLeafNoCom111_116 = foldl1 mplus [do n <- StateT pat1 + _ <- StateT spaces + return () + com <- optional156_307 (StateT comForErr) + d891_353 <- get + t389_354 <- StateT char + case t389_354 of + ':' -> return () + _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d891_353 ["char"]) + let ':' = t389_354 + return () + (rf, p) <- StateT leaf + return (check (n, maybe "" id com) rf p), + do n <- StateT pat1 + _ <- StateT spaces + return () + return (check (n, + "") (FromVariable Nothing) Nothing)] + comForErr112_117 = foldl1 mplus [do d895_355 <- get + t393_356 <- StateT char + case t393_356 of + '{' -> return () + _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d895_355 ["char"]) + let '{' = t393_356 + return () + d896_357 <- get + t394_358 <- StateT char + case t394_358 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d896_357 ["char"]) + let '-' = t394_358 + return () + d897_359 <- get + t395_360 <- StateT char + case t395_360 of + '#' -> return () + _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d897_359 ["char"]) + let '#' = t395_360 + return () + _ <- StateT spaces + return () + d899_361 <- get + t397_362 <- StateT char + case t397_362 of + '"' -> return () + _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d899_361 ["char"]) + let '"' = t397_362 + return () + s <- StateT stringLit + d901_363 <- get + t399_364 <- StateT char + case t399_364 of + '"' -> return () + _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d901_363 ["char"]) + let '"' = t399_364 + return () + _ <- StateT spaces + return () + d903_365 <- get + t401_366 <- StateT char + case t401_366 of + '#' -> return () + _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d903_365 ["char"]) + let '#' = t401_366 + return () + d904_367 <- get + t402_368 <- StateT char + case t402_368 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d904_367 ["char"]) + let '-' = t402_368 + return () + d905_369 <- get + t403_370 <- StateT char + case t403_370 of + '}' -> return () + _ -> gets position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d905_369 ["char"]) + let '}' = t403_370 + return () + _ <- StateT spaces + return () + return s] + leaf113_118 = foldl1 mplus [do rf <- StateT readFromLs + t <- StateT test + return (rf, Just t), + do rf <- StateT readFromLs + return (rf, Nothing), + do t <- StateT test + return (FromVariable Nothing, Just t)] + patOp114_119 = foldl1 mplus [do p <- StateT pat + o <- StateT opConName + po <- StateT patOp + return (UInfixP p o po), + do p <- StateT pat + _ <- StateT spaces + return () + d916_371 <- get + t414_372 <- StateT char + case t414_372 of + '`' -> return () + _ -> gets position >>= (throwError . mkParseError "'`'" "not match pattern: " "" d916_371 ["char"]) + let '`' = t414_372 + return () + t <- StateT typ + d918_373 <- get + t416_374 <- StateT char + case t416_374 of + '`' -> return () + _ -> gets position >>= (throwError . mkParseError "'`'" "not match pattern: " "" d918_373 ["char"]) + let '`' = t416_374 + return () + _ <- StateT spaces + return () + po <- StateT patOp + return (UInfixP p (mkName t) po), + do p <- StateT pat + return p] + pat115_120 = foldl1 mplus [do t <- StateT typ + _ <- StateT spaces + return () + ps <- StateT pats + return (ConP (mkName t) ps), + do d925_375 <- get + t423_376 <- StateT char + case t423_376 of + '(' -> return () + _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d925_375 ["char"]) + let '(' = t423_376 + return () + o <- StateT opConName + d927_377 <- get + t425_378 <- StateT char + case t425_378 of + ')' -> return () + _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d927_377 ["char"]) + let ')' = t425_378 + return () + _ <- StateT spaces + return () + ps <- StateT pats + return (ConP o ps), + do p <- StateT pat1 + return p] + pat1116_121 = foldl1 mplus [do t <- StateT typ + return (ConP (mkName t) []), + do d932_379 <- get + t430_380 <- StateT variable + case t430_380 of + "_" -> return () + _ -> gets position >>= (throwError . mkParseError "\"_\"" "not match pattern: " "" d932_379 ["variable"]) + let "_" = t430_380 + return () + return WildP, + do n <- StateT variable + return (VarP $ mkName n), + do i <- StateT integer + return (LitP (IntegerL i)), + do d935_381 <- get + t433_382 <- StateT char + case t433_382 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d935_381 ["char"]) + let '-' = t433_382 + return () + _ <- StateT spaces + return () + i <- StateT integer + return (LitP (IntegerL $ negate i)), + do d938_383 <- get + t436_384 <- StateT char + case t436_384 of + '\'' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d938_383 ["char"]) + let '\'' = t436_384 + return () + c <- StateT charLit + d940_385 <- get + t438_386 <- StateT char + case t438_386 of + '\'' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d940_385 ["char"]) + let '\'' = t438_386 + return () + return (LitP $ CharL c), + do d941_387 <- get + t439_388 <- StateT char + case t439_388 of + '"' -> return () + _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d941_387 ["char"]) + let '"' = t439_388 + return () + s <- StateT stringLit + d943_389 <- get + t441_390 <- StateT char + case t441_390 of + '"' -> return () + _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d943_389 ["char"]) + let '"' = t441_390 + return () + return (LitP $ StringL s), + do d944_391 <- get + t442_392 <- StateT char + case t442_392 of + '(' -> return () + _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d944_391 ["char"]) + let '(' = t442_392 + return () + p <- StateT patList + d946_393 <- get + t444_394 <- StateT char + case t444_394 of + ')' -> return () + _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d946_393 ["char"]) + let ')' = t444_394 + return () + return (TupP p), + do d947_395 <- get + t445_396 <- StateT char + case t445_396 of + '[' -> return () + _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d947_395 ["char"]) + let '[' = t445_396 + return () + p <- StateT patList + d949_397 <- get + t447_398 <- StateT char + case t447_398 of + ']' -> return () + _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d949_397 ["char"]) + let ']' = t447_398 + return () + return (ListP p)] + patList117_122 = foldl1 mplus [do p <- StateT patOp + _ <- StateT spaces + return () + d952_399 <- get + t450_400 <- StateT char + case t450_400 of + ',' -> return () + _ -> gets position >>= (throwError . mkParseError "','" "not match pattern: " "" d952_399 ["char"]) + let ',' = t450_400 + return () + _ <- StateT spaces + return () + ps <- StateT patList + return (p : ps), + do p <- StateT patOp + return [p], + return []] + opConName118_123 = foldl1 mplus [do d956_401 <- get + t454_402 <- StateT char + case t454_402 of + ':' -> return () + _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d956_401 ["char"]) + let ':' = t454_402 + return () + ot <- StateT opTail + return (mkName $ ':' : ot)] + charLit119_124 = foldl1 mplus [do d958_403 <- get + t456_404 <- StateT char + let c = t456_404 + unless (c `notElem` "\\'") (gets position >>= (throwError . mkParseError "c `notElem` \"\\\\'\"" "not match: " "" d958_403 ["char"])) + return c, + do d959_405 <- get + t457_406 <- StateT char + case t457_406 of + '\\' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d959_405 ["char"]) + let '\\' = t457_406 + return () + c <- StateT escapeC + return c] + stringLit120_125 = foldl1 mplus [do d961_407 <- get + t459_408 <- StateT char + let c = t459_408 + unless (c `notElem` "\"\\") (gets position >>= (throwError . mkParseError "c `notElem` \"\\\"\\\\\"" "not match: " "" d961_407 ["char"])) + s <- StateT stringLit + return (c : s), + do d963_409 <- get + t461_410 <- StateT char + case t461_410 of + '\\' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d963_409 ["char"]) + let '\\' = t461_410 + return () + c <- StateT escapeC + s <- StateT stringLit + return (c : s), + return ""] + escapeC121_126 = foldl1 mplus [do d966_411 <- get + t464_412 <- StateT char + case t464_412 of + '"' -> return () + _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d966_411 ["char"]) + let '"' = t464_412 + return () + return '"', + do d967_413 <- get + t465_414 <- StateT char + case t465_414 of + '\'' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d967_413 ["char"]) + let '\'' = t465_414 + return () + return '\'', + do d968_415 <- get + t466_416 <- StateT char + case t466_416 of + '\\' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d968_415 ["char"]) + let '\\' = t466_416 + return () + return '\\', + do d969_417 <- get + t467_418 <- StateT char + case t467_418 of + 'n' -> return () + _ -> gets position >>= (throwError . mkParseError "'n'" "not match pattern: " "" d969_417 ["char"]) + let 'n' = t467_418 + return () + return '\n', + do d970_419 <- get + t468_420 <- StateT char + case t468_420 of + 't' -> return () + _ -> gets position >>= (throwError . mkParseError "'t'" "not match pattern: " "" d970_419 ["char"]) + let 't' = t468_420 + return () + return '\t'] + pats122_127 = foldl1 mplus [do p <- StateT pat + _ <- StateT spaces + return () + ps <- StateT pats + return (p : ps), + return []] + readFromLs123_128 = foldl1 mplus [do rf <- StateT readFrom + d975_421 <- get + t473_422 <- StateT char + case t473_422 of + '*' -> return () + _ -> gets position >>= (throwError . mkParseError "'*'" "not match pattern: " "" d975_421 ["char"]) + let '*' = t473_422 + return () + return (FromL List rf), + do rf <- StateT readFrom + d977_423 <- get + t475_424 <- StateT char + case t475_424 of + '+' -> return () + _ -> gets position >>= (throwError . mkParseError "'+'" "not match pattern: " "" d977_423 ["char"]) + let '+' = t475_424 + return () + return (FromL List1 rf), + do rf <- StateT readFrom + d979_425 <- get + t477_426 <- StateT char + case t477_426 of + '?' -> return () + _ -> gets position >>= (throwError . mkParseError "'?'" "not match pattern: " "" d979_425 ["char"]) + let '?' = t477_426 + return () + return (FromL Optional rf), + do rf <- StateT readFrom + return rf] + readFrom124_129 = foldl1 mplus [do v <- StateT variable + return (FromVariable $ Just v), + do d982_427 <- get + t480_428 <- StateT char + case t480_428 of + '(' -> return () + _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d982_427 ["char"]) + let '(' = t480_428 + return () + s <- StateT selection + d984_429 <- get + t482_430 <- StateT char + case t482_430 of + ')' -> return () + _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d984_429 ["char"]) + let ')' = t482_430 + return () + return (fromSelectionQ s), + do e <- StateT expressionHsSugar + return (fromSelectionQ $ normalSelectionQ [e])] + selectCharsLs125_130 = foldl1 mplus [do rf <- StateT selectChars + d987_431 <- get + t485_432 <- StateT char + case t485_432 of + '*' -> return () + _ -> gets position >>= (throwError . mkParseError "'*'" "not match pattern: " "" d987_431 ["char"]) + let '*' = t485_432 + return () + return (FromL List rf), + do rf <- StateT selectChars + d989_433 <- get + t487_434 <- StateT char + case t487_434 of + '+' -> return () + _ -> gets position >>= (throwError . mkParseError "'+'" "not match pattern: " "" d989_433 ["char"]) + let '+' = t487_434 + return () + return (FromL List1 rf), + do rf <- StateT selectChars + d991_435 <- get + t489_436 <- StateT char + case t489_436 of + '?' -> return () + _ -> gets position >>= (throwError . mkParseError "'?'" "not match pattern: " "" d991_435 ["char"]) + let '?' = t489_436 + return () + return (FromL Optional rf), + do rf <- StateT selectChars + return rf] + selectChars126_131 = foldl1 mplus [do d993_437 <- get + t491_438 <- StateT char + case t491_438 of + '[' -> return () + _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d993_437 ["char"]) + let '[' = t491_438 + return () + cs <- list1158_439 (foldl1 mplus [do d995_440 <- get + t493_441 <- StateT char + let c = t493_441 + unless (isLower c) (gets position >>= (throwError . mkParseError "isLower c" "not match: " "" d995_440 ["char"])) + return c]) + d996_442 <- get + t494_443 <- StateT char + case t494_443 of + ']' -> return () + _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d996_442 ["char"]) + let ']' = t494_443 + return () + return (fromTokenChars cs), + do d997_444 <- get + t495_445 <- StateT char + case t495_445 of + '[' -> return () + _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d997_444 ["char"]) + let '[' = t495_445 + return () + d998_446 <- get + t496_447 <- StateT char + let cb = t496_447 + unless (cb `notElem` "\\-") (gets position >>= (throwError . mkParseError "cb `notElem` \"\\\\-\"" "not match: " "" d998_446 ["char"])) + d999_448 <- get + t497_449 <- StateT char + case t497_449 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d999_448 ["char"]) + let '-' = t497_449 + return () + d1000_450 <- get + t498_451 <- StateT char + let ce = t498_451 + unless (ce `notElem` "\\-") (gets position >>= (throwError . mkParseError "ce `notElem` \"\\\\-\"" "not match: " "" d1000_450 ["char"])) + d1001_452 <- get + t499_453 <- StateT char + case t499_453 of + ']' -> return () + _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d1001_452 ["char"]) + let ']' = t499_453 + return () + return (fromTokenChars [cb .. ce]), + do d1002_454 <- get + t500_455 <- StateT char + case t500_455 of + '\'' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d1002_454 ["char"]) + let '\'' = t500_455 + return () + d1003_456 <- get + t501_457 <- StateT char + let c = t501_457 + unless (c `notElem` "\\'") (gets position >>= (throwError . mkParseError "c `notElem` \"\\\\'\"" "not match: " "" d1003_456 ["char"])) + d1004_458 <- get + t502_459 <- StateT char + case t502_459 of + '\'' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d1004_458 ["char"]) + let '\'' = t502_459 + return () + return (fromTokenChars [c])] + test127_132 = foldl1 mplus [do d1005_460 <- get + t503_461 <- StateT char + case t503_461 of + '[' -> return () + _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d1005_460 ["char"]) + let '[' = t503_461 + return () + h <- StateT hsExpLam + _ <- StateT spaces + return () + com <- optional156_307 (StateT comForErr) + d1009_462 <- get + t507_463 <- StateT char + case t507_463 of + ']' -> return () + _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d1009_462 ["char"]) + let ']' = t507_463 + return () + return (h, maybe "" id com)] + hsExpLam128_133 = foldl1 mplus [do d1010_464 <- get + t508_465 <- StateT char + case t508_465 of + '\\' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d1010_464 ["char"]) + let '\\' = t508_465 + return () + _ <- StateT spaces + return () + ps <- StateT pats + _ <- StateT spaces + return () + d1014_466 <- get + t512_467 <- StateT char + case t512_467 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1014_466 ["char"]) + let '-' = t512_467 + return () + d1015_468 <- get + t513_469 <- StateT char + case t513_469 of + '>' -> return () + _ -> gets position >>= (throwError . mkParseError "'>'" "not match pattern: " "" d1015_468 ["char"]) + let '>' = t513_469 + return () + _ <- StateT spaces + return () + e <- StateT hsExpTyp + return (LamE ps e), + do e <- StateT hsExpTyp + return e] + hsExpTyp129_134 = foldl1 mplus [do eo <- StateT hsExpOp + d1020_470 <- get + t518_471 <- StateT char + case t518_471 of + ':' -> return () + _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d1020_470 ["char"]) + let ':' = t518_471 + return () + d1021_472 <- get + t519_473 <- StateT char + case t519_473 of + ':' -> return () + _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d1021_472 ["char"]) + let ':' = t519_473 + return () + _ <- StateT spaces + return () + t <- StateT hsTypeArr + return (SigE eo t), + do eo <- StateT hsExpOp + return eo] + hsExpOp130_135 = foldl1 mplus [do l <- StateT hsExp + _ <- StateT spaces + return () + o <- StateT hsOp + _ <- StateT spaces + return () + r <- StateT hsExpOp + return (UInfixE (l id) o r), + do e <- StateT hsExp + return (e id)] + hsOp131_136 = foldl1 mplus [do d1031_474 <- get + t529_475 <- StateT char + let c = t529_475 + unless (c `elem` "+*/-!|&.^=<>$") (gets position >>= (throwError . mkParseError "c `elem` \"+*/-!|&.^=<>$\"" "not match: " "" d1031_474 ["char"])) + o <- StateT opTail + return (VarE $ mkName $ c : o), + do d1033_476 <- get + t531_477 <- StateT char + case t531_477 of + ':' -> return () + _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d1033_476 ["char"]) + let ':' = t531_477 + return () + d1035_478 <- get + do err1168_479 <- ((do d1034_480 <- get + t532_481 <- StateT char + case t532_481 of + ':' -> return () + _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d1034_480 ["char"]) + let ':' = t532_481 + return ()) >> return False) `catchError` const (return True) + unless err1168_479 (gets position >>= (throwError . mkParseError "!':':" "not match: " "" d1035_478 ["char"])) + put d1035_478 + o <- StateT opTail + return (ConE $ mkName $ ':' : o), + do d1037_482 <- get + t534_483 <- StateT char + case t534_483 of + '`' -> return () + _ -> gets position >>= (throwError . mkParseError "'`'" "not match pattern: " "" d1037_482 ["char"]) + let '`' = t534_483 + return () + v <- StateT variable + d1039_484 <- get + t536_485 <- StateT char + case t536_485 of + '`' -> return () + _ -> gets position >>= (throwError . mkParseError "'`'" "not match pattern: " "" d1039_484 ["char"]) + let '`' = t536_485 + return () + return (VarE $ mkName v), + do d1040_486 <- get + t537_487 <- StateT char + case t537_487 of + '`' -> return () + _ -> gets position >>= (throwError . mkParseError "'`'" "not match pattern: " "" d1040_486 ["char"]) + let '`' = t537_487 + return () + t <- StateT typ + d1042_488 <- get + t539_489 <- StateT char + case t539_489 of + '`' -> return () + _ -> gets position >>= (throwError . mkParseError "'`'" "not match pattern: " "" d1042_488 ["char"]) + let '`' = t539_489 + return () + return (ConE $ mkName t)] + opTail132_137 = foldl1 mplus [do d1043_490 <- get + t540_491 <- StateT char + let c = t540_491 + unless (c `elem` ":+*/-!|&.^=<>$") (gets position >>= (throwError . mkParseError "c `elem` \":+*/-!|&.^=<>$\"" "not match: " "" d1043_490 ["char"])) + s <- StateT opTail + return (c : s), + return ""] + hsExp133_138 = foldl1 mplus [do e <- StateT hsExp1 + _ <- StateT spaces + return () + h <- StateT hsExp + return (\f -> h (f e `AppE`)), + do e <- StateT hsExp1 + return (\f -> f e)] + hsExp1134_139 = foldl1 mplus [do d1049_492 <- get + t546_493 <- StateT char + case t546_493 of + '(' -> return () + _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d1049_492 ["char"]) + let '(' = t546_493 + return () + l <- optional156_307 (foldl1 mplus [do e <- StateT hsExpTyp + return e]) + _ <- StateT spaces + return () + o <- StateT hsOp + _ <- StateT spaces + return () + r <- optional156_307 (foldl1 mplus [do e <- StateT hsExpTyp + return e]) + d1057_494 <- get + t554_495 <- StateT char + case t554_495 of + ')' -> return () + _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d1057_494 ["char"]) + let ')' = t554_495 + return () + return (InfixE l o r), + do d1058_496 <- get + t555_497 <- StateT char + case t555_497 of + '(' -> return () + _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d1058_496 ["char"]) + let '(' = t555_497 + return () + et <- StateT hsExpTpl + d1060_498 <- get + t557_499 <- StateT char + case t557_499 of + ')' -> return () + _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d1060_498 ["char"]) + let ')' = t557_499 + return () + return (TupE et), + do d1061_500 <- get + t558_501 <- StateT char + case t558_501 of + '[' -> return () + _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d1061_500 ["char"]) + let '[' = t558_501 + return () + et <- StateT hsExpTpl + d1063_502 <- get + t560_503 <- StateT char + case t560_503 of + ']' -> return () + _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d1063_502 ["char"]) + let ']' = t560_503 + return () + return (ListE et), + do v <- StateT variable + return (VarE $ mkName v), + do t <- StateT typ + return (ConE $ mkName t), + do i <- StateT integer + _ <- StateT spaces + return () + return (LitE $ integerL i), + do d1068_504 <- get + t565_505 <- StateT char + case t565_505 of + '\'' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d1068_504 ["char"]) + let '\'' = t565_505 + return () + c <- StateT charLit + d1070_506 <- get + t567_507 <- StateT char + case t567_507 of + '\'' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d1070_506 ["char"]) + let '\'' = t567_507 + return () + return (LitE $ charL c), + do d1071_508 <- get + t568_509 <- StateT char + case t568_509 of + '"' -> return () + _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d1071_508 ["char"]) + let '"' = t568_509 + return () + s <- StateT stringLit + d1073_510 <- get + t570_511 <- StateT char + case t570_511 of + '"' -> return () + _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d1073_510 ["char"]) + let '"' = t570_511 + return () + return (LitE $ stringL s), + do d1074_512 <- get + t571_513 <- StateT char + case t571_513 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1074_512 ["char"]) + let '-' = t571_513 + return () + _ <- StateT spaces + return () + e <- StateT hsExp1 + return (AppE (VarE $ mkName "negate") e)] + hsExpTpl135_140 = foldl1 mplus [do e <- StateT hsExpLam + _ <- StateT spaces + return () + d1079_514 <- get + t576_515 <- StateT char + case t576_515 of + ',' -> return () + _ -> gets position >>= (throwError . mkParseError "','" "not match pattern: " "" d1079_514 ["char"]) + let ',' = t576_515 + return () + _ <- StateT spaces + return () + et <- StateT hsExpTpl + return (e : et), + do e <- StateT hsExpLam + return [e], + return []] + hsTypeArr136_141 = foldl1 mplus [do l <- StateT hsType + d1084_516 <- get + t581_517 <- StateT char + case t581_517 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1084_516 ["char"]) + let '-' = t581_517 + return () + d1085_518 <- get + t582_519 <- StateT char + case t582_519 of + '>' -> return () + _ -> gets position >>= (throwError . mkParseError "'>'" "not match pattern: " "" d1085_518 ["char"]) + let '>' = t582_519 + return () + _ <- StateT spaces + return () + r <- StateT hsTypeArr + return (AppT (AppT ArrowT $ l id) r), + do t <- StateT hsType + return (t id)] + hsType137_142 = foldl1 mplus [do t <- StateT hsType1 + ts <- StateT hsType + return (\f -> ts (f t `AppT`)), + do t <- StateT hsType1 + return ($ t)] + hsType1138_143 = foldl1 mplus [do d1092_520 <- get + t589_521 <- StateT char + case t589_521 of + '[' -> return () + _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d1092_520 ["char"]) + let '[' = t589_521 + return () + d1093_522 <- get + t590_523 <- StateT char + case t590_523 of + ']' -> return () + _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d1093_522 ["char"]) + let ']' = t590_523 + return () + _ <- StateT spaces + return () + return ListT, + do d1095_524 <- get + t592_525 <- StateT char + case t592_525 of + '[' -> return () + _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d1095_524 ["char"]) + let '[' = t592_525 + return () + t <- StateT hsTypeArr + d1097_526 <- get + t594_527 <- StateT char + case t594_527 of + ']' -> return () + _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d1097_526 ["char"]) + let ']' = t594_527 + return () + _ <- StateT spaces + return () + return (ListT `AppT` t), + do d1099_528 <- get + t596_529 <- StateT char + case t596_529 of + '(' -> return () + _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d1099_528 ["char"]) + let '(' = t596_529 + return () + _ <- StateT spaces + return () + tt <- StateT hsTypeTpl + d1102_530 <- get + t599_531 <- StateT char + case t599_531 of + ')' -> return () + _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d1102_530 ["char"]) + let ')' = t599_531 + return () + _ <- StateT spaces + return () + return (foldl AppT (TupleT $ length tt) tt), + do t <- StateT typToken + return (ConT $ mkName t), + do d1105_532 <- get + t602_533 <- StateT char + case t602_533 of + '(' -> return () + _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d1105_532 ["char"]) + let '(' = t602_533 + return () + d1106_534 <- get + t603_535 <- StateT char + case t603_535 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1106_534 ["char"]) + let '-' = t603_535 + return () + d1107_536 <- get + t604_537 <- StateT char + case t604_537 of + '>' -> return () + _ -> gets position >>= (throwError . mkParseError "'>'" "not match pattern: " "" d1107_536 ["char"]) + let '>' = t604_537 + return () + d1108_538 <- get + t605_539 <- StateT char + case t605_539 of + ')' -> return () + _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d1108_538 ["char"]) + let ')' = t605_539 + return () + _ <- StateT spaces + return () + return ArrowT] + hsTypeTpl139_144 = foldl1 mplus [do t <- StateT hsTypeArr + d1111_540 <- get + t608_541 <- StateT char + case t608_541 of + ',' -> return () + _ -> gets position >>= (throwError . mkParseError "','" "not match pattern: " "" d1111_540 ["char"]) + let ',' = t608_541 + return () + _ <- StateT spaces + return () + tt <- StateT hsTypeTpl + return (t : tt), + do t <- StateT hsTypeArr + return [t], + return []] + typ140_145 = foldl1 mplus [do u <- StateT upper + t <- StateT tvtail + return (u : t)] + variable141_146 = foldl1 mplus [do l <- StateT lower + t <- StateT tvtail + return (l : t)] + tvtail142_147 = foldl1 mplus [do a <- StateT alpha + t <- StateT tvtail + return (a : t), + return ""] + integer143_148 = foldl1 mplus [do dh <- StateT digit + ds <- list157_342 (foldl1 mplus [do d <- StateT digit + return d]) + return (read $ dh : ds)] + alpha144_149 = foldl1 mplus [do u <- StateT upper + return u, + do l <- StateT lower + return l, + do d <- StateT digit + return d, + do d1127_542 <- get + t624_543 <- StateT char + case t624_543 of + '\'' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d1127_542 ["char"]) + let '\'' = t624_543 + return () + return '\''] + upper145_150 = foldl1 mplus [do d1128_544 <- get + t625_545 <- StateT char + let u = t625_545 + unless (isUpper u) (gets position >>= (throwError . mkParseError "isUpper u" "not match: " "" d1128_544 ["char"])) + return u] + lower146_151 = foldl1 mplus [do d1129_546 <- get + t626_547 <- StateT char + let l = t626_547 + unless (isLower l || l == '_') (gets position >>= (throwError . mkParseError "isLower l || l == '_'" "not match: " "" d1129_546 ["char"])) + return l] + digit147_152 = foldl1 mplus [do d1130_548 <- get + t627_549 <- StateT char + let d = t627_549 + unless (isDigit d) (gets position >>= (throwError . mkParseError "isDigit d" "not match: " "" d1130_548 ["char"])) + return d] + spaces148_153 = foldl1 mplus [do _ <- StateT space + return () + _ <- StateT spaces + return () + return (), + return ()] + space149_154 = foldl1 mplus [do d1133_550 <- get + t630_551 <- StateT char + let s = t630_551 + unless (isSpace s) (gets position >>= (throwError . mkParseError "isSpace s" "not match: " "" d1133_550 ["char"])) + return (), + do d1134_552 <- get + t631_553 <- StateT char + case t631_553 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1134_552 ["char"]) + let '-' = t631_553 + return () + d1135_554 <- get + t632_555 <- StateT char + case t632_555 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1135_554 ["char"]) + let '-' = t632_555 + return () + _ <- StateT notNLString + return () + _ <- StateT newLine + return () + return (), + do _ <- StateT comment + return () + return ()] + notNLString150_155 = foldl1 mplus [do d1140_556 <- get + do err1169_557 <- ((do _ <- StateT newLine + return ()) >> return False) `catchError` const (return True) + unless err1169_557 (gets position >>= (throwError . mkParseError "!_:newLine" "not match: " "" d1140_556 ["newLine"])) + put d1140_556 + c <- StateT char + s <- StateT notNLString + return (c : s), + return ""] + newLine151_156 = foldl1 mplus [do d1143_558 <- get + t639_559 <- StateT char + case t639_559 of + '\n' -> return () + _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d1143_558 ["char"]) + let '\n' = t639_559 + return () + return ()] + comment152_157 = foldl1 mplus [do d1144_560 <- get + t640_561 <- StateT char + case t640_561 of + '{' -> return () + _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d1144_560 ["char"]) + let '{' = t640_561 + return () + d1145_562 <- get + t641_563 <- StateT char + case t641_563 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1145_562 ["char"]) + let '-' = t641_563 + return () + d1147_564 <- get + do err1170_565 <- ((do d1146_566 <- get + t642_567 <- StateT char + case t642_567 of + '#' -> return () + _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d1146_566 ["char"]) + let '#' = t642_567 + return ()) >> return False) `catchError` const (return True) + unless err1170_565 (gets position >>= (throwError . mkParseError "!'#':" "not match: " "" d1147_564 ["char"])) + put d1147_564 + _ <- StateT comments + return () + _ <- StateT comEnd + return () + return ()] + comments153_158 = foldl1 mplus [do _ <- StateT notComStr + return () + _ <- StateT comment + return () + _ <- StateT comments + return () + return (), + do _ <- StateT notComStr + return () + return ()] + notComStr154_159 = foldl1 mplus [do d1155_568 <- get + do err1171_569 <- ((do _ <- StateT comment + return ()) >> return False) `catchError` const (return True) + unless err1171_569 (gets position >>= (throwError . mkParseError "!_:comment" "not match: " "" d1155_568 ["comment"])) + put d1155_568 + d1157_570 <- get + do err1172_571 <- ((do _ <- StateT comEnd + return ()) >> return False) `catchError` const (return True) + unless err1172_571 (gets position >>= (throwError . mkParseError "!_:comEnd" "not match: " "" d1157_570 ["comEnd"])) + put d1157_570 + _ <- StateT char + return () + _ <- StateT notComStr + return () + return (), + return ()] + comEnd155_160 = foldl1 mplus [do d1160_572 <- get + t653_573 <- StateT char + case t653_573 of + '-' -> return () + _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1160_572 ["char"]) + let '-' = t653_573 + return () + d1161_574 <- get + t654_575 <- StateT char + case t654_575 of + '}' -> return () + _ -> gets position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d1161_574 ["char"]) + let '}' = t654_575 + return () + return ()] + list157_342 :: forall m a . (MonadPlus m, Applicative m) => + m a -> m ([a]) + list1158_439 :: forall m a . (MonadPlus m, Applicative m) => + m a -> m ([a]) + list157_342 p = list1158_439 p `mplus` return [] + list1158_439 p = ((:) <$> p) <*> list157_342 p + optional156_307 :: forall m a . (MonadPlus m, Applicative m) => + m a -> m (Maybe a) + optional156_307 p = (Just <$> p) `mplus` return Nothing diff --git a/src/Text/Papillon/SyntaxTree.hs b/src/Text/Papillon/SyntaxTree.hs --- a/src/Text/Papillon/SyntaxTree.hs +++ b/src/Text/Papillon/SyntaxTree.hs @@ -1,288 +1,230 @@ -module Text.Papillon.SyntaxTree where - -import Language.Haskell.TH -import Data.Char -import Control.Applicative -import Data.List - -data ReadFrom - = FromVariable String - | FromSelection Selection - | FromToken - | FromTokenChars [Char] - | FromList ReadFrom - | FromList1 ReadFrom - | FromOptional ReadFrom - -getReadFromType :: Peg -> TypeQ -> ReadFrom -> TypeQ -getReadFromType peg tknt (FromVariable var) = - getDefinitionType peg tknt $ searchDefinition peg var -getReadFromType peg tknt (FromSelection sel) = getSelectionType peg tknt sel -getReadFromType _ tknt FromToken = tknt -getReadFromType _ tknt (FromTokenChars _) = tknt -getReadFromType peg tknt (FromList rf) = listT `appT` getReadFromType peg tknt rf -getReadFromType peg tknt (FromList1 rf) = listT `appT` getReadFromType peg tknt rf -getReadFromType peg tknt (FromOptional rf) = - conT (mkName "Maybe") `appT` getReadFromType peg tknt rf - -nameFromRF :: ReadFrom -> [String] -nameFromRF (FromVariable s) = [s] -nameFromRF FromToken = ["char"] -nameFromRF (FromTokenChars _) = ["char"] -nameFromRF (FromList rf) = nameFromRF rf -nameFromRF (FromList1 rf) = nameFromRF rf -nameFromRF (FromOptional rf) = nameFromRF rf -nameFromRF (FromSelection sel) = nameFromSelection sel - -showReadFrom :: ReadFrom -> Q String -showReadFrom FromToken = return "" -showReadFrom (FromTokenChars cs) = return $ '[' : cs ++ "]" -showReadFrom (FromVariable v) = return v -showReadFrom (FromList rf) = (++ "*") <$> showReadFrom rf -showReadFrom (FromList1 rf) = (++ "+") <$> showReadFrom rf -showReadFrom (FromOptional rf) = (++ "?") <$> showReadFrom rf -showReadFrom (FromSelection sel) = ('(' :) <$> (++ ")") <$> showSelection sel - -data NameLeaf = NameLeaf (PatQ, String) ReadFrom (Maybe (ExR, String)) - -showNameLeaf :: NameLeaf -> Q String -showNameLeaf (NameLeaf (pat, _) rf (Just (p, _))) = do - patt <- pat - rff <- showReadFrom rf - pp <- p - return $ show (ppr patt) ++ ":" ++ rff ++ "[" ++ show (ppr pp) ++ "]" -showNameLeaf (NameLeaf (pat, _) rf Nothing) = do - patt <- pat - rff <- showReadFrom rf - return $ show (ppr patt) ++ ":" ++ rff - -nameFromNameLeaf :: NameLeaf -> [String] -nameFromNameLeaf (NameLeaf _ rf _) = nameFromRF rf - -data NameLeaf_ - = Here NameLeaf - | After NameLeaf - | NotAfter NameLeaf String - -showNameLeaf_ :: NameLeaf_ -> Q String -showNameLeaf_ (Here nl) = showNameLeaf nl -showNameLeaf_ (After nl) = ('&' :) <$> showNameLeaf nl -showNameLeaf_ (NotAfter nl _) = ('!' :) <$> showNameLeaf nl - -nameFromNameLeaf_ :: NameLeaf_ -> [String] -nameFromNameLeaf_ (Here nl) = nameFromNameLeaf nl -nameFromNameLeaf_ (After nl) = nameFromNameLeaf nl -nameFromNameLeaf_ (NotAfter nl _) = nameFromNameLeaf nl +{-# LANGUAGE TupleSections #-} -type Expression = [NameLeaf_] +module Text.Papillon.SyntaxTree ( + Peg, + Definition, + Selection, + Expression, + PlainExpression, + Check, + ReadFrom(..), -showExpression :: Expression -> Q String -showExpression ex = unwords <$> mapM showNameLeaf_ ex + Q, + STPegQ, + PegQ, + DefinitionQ, + SelectionQ, + ExpressionQ, + PlainExpressionQ, + CheckQ, + ReadFromQ, -nameFromExpression :: Expression -> [String] -nameFromExpression = nameFromNameLeaf_ . head + stPegQ, + definitionQ, + normalSelectionQ, + plainSelectionQ, + expressionQ, + plainExpressionQ, + check, + fromSelectionQ, -data ExpressionHs - = ExpressionHs { - expressionHsExpression :: Expression, - expressionHsExR :: ExR - } - | ExpressionHsSugar ExR - | PlainExpressionHs [ReadFrom] + Lookahead(..), + Lists(..), -getExpressionHsType :: Peg -> TypeQ -> ExpressionHs -> TypeQ -getExpressionHsType peg tknt (PlainExpressionHs rfs) = - foldl appT (tupleT $ length rfs) $ map (getReadFromType peg tknt) rfs -getExpressionHsType _ _ _ = error "getExpressionHsType: can't get type" + fromTokenChars, + expressionSugar, -showExpressionHs :: ExpressionHs -> Q String -showExpressionHs (ExpressionHs ex hs) = do - expp <- showExpression ex - hss <- hs - return $ expp ++ " { " ++ show (ppr hss) ++ " }" -showExpressionHs (ExpressionHsSugar hs) = do - hss <- hs - return $ "<" ++ show (ppr hss) ++ ">" -showExpressionHs (PlainExpressionHs rfs) = unwords <$> mapM showReadFrom rfs + selectionType, + pprCheck, + nameFromRF, -nameFromExpressionHs :: ExpressionHs -> [String] -nameFromExpressionHs (ExpressionHs ex _) = nameFromExpression ex -nameFromExpressionHs (ExpressionHsSugar _) = [] -nameFromExpressionHs (PlainExpressionHs rfs) = concatMap nameFromRF rfs + PegFileQ, + mkPegFile, + PPragma(..), + ModuleName, + Exports, + Code, -data Selection - = Selection { expressions :: [ExpressionHs] } - | PlainSelection { plainExpressions :: [ExpressionHs] } + dvCharsN +) where -getSelectionType :: Peg -> TypeQ -> Selection -> TypeQ -getSelectionType peg tknt (PlainSelection ex) = - foldr (\x y -> (eitherT `appT` x) `appT` y) (conT $ mkName "()") $ - map (getExpressionHsType peg tknt) ex - where - eitherT = conT $ mkName "Either" -getSelectionType _ _ _ = error "getSelectionType: can't get type" +import Language.Haskell.TH +import Language.Haskell.TH.PprLib +import Control.Arrow ((***)) +import Data.List -showSelection :: Selection -> Q String -showSelection (Selection ehss) = intercalate " / " <$> mapM showExpressionHs ehss -showSelection (PlainSelection ehss) = - intercalate " / " <$> mapM showExpressionHs ehss +dvCharsN :: String +dvCharsN = "char" -nameFromSelection :: Selection -> [String] -nameFromSelection (Selection exs) = concatMap nameFromExpressionHs exs -nameFromSelection (PlainSelection exs) = concatMap nameFromExpressionHs exs +data Lookahead = Here | Ahead | NAhead String deriving (Show, Eq) +data Lists = List | List1 | Optional deriving (Show, Eq) -data Definition - = Definition String TypeQ Selection - | PlainDefinition String Selection +type STPeg = (Maybe Type, Type, Peg) type Peg = [Definition] -type TTPeg = (TypeQ, TypeQ, Peg) +type Definition = (String, Maybe Type, Selection) +type Selection = Either [Expression] [PlainExpression] +type Expression = Either ([(Lookahead, Check)], Exp) Exp +type PlainExpression = [(Lookahead, ReadFrom)] +type Check = ((Pat, String), ReadFrom, Maybe (Exp, String)) +data ReadFrom + = FromVariable (Maybe String) + | FromSelection Selection + | FromL Lists ReadFrom + deriving Show -searchDefinition :: Peg -> String -> Definition -searchDefinition peg var = case filter ((== var) . getDefinitionName) peg of - [d] -> d - _ -> error "searchDefinition: bad" +type STPegQ = STPeg +type PegQ = Peg +type DefinitionQ = Definition +type SelectionQ = Selection +type ExpressionQ = Expression +type PlainExpressionQ = PlainExpression +type CheckQ = Check +type ReadFromQ = ReadFrom -getDefinitionName :: Definition -> String -getDefinitionName (Definition n _ _) = n -getDefinitionName (PlainDefinition n _) = n +stPegQ :: Maybe Type -> Type -> PegQ -> STPegQ +stPegQ = (,,) -getDefinitionType :: Peg -> TypeQ -> Definition -> TypeQ -getDefinitionType _ _ (Definition _ typ _) = typ -getDefinitionType peg tknt (PlainDefinition _ sel) = getSelectionType peg tknt sel +fromSelectionQ :: SelectionQ -> ReadFromQ +fromSelectionQ sel = FromSelection sel -type Ex = (ExpQ -> ExpQ) -> ExpQ -type ExR = ExpQ -type ExRL = [ExpQ] +definitionQ :: String -> Maybe Type -> SelectionQ -> DefinitionQ +definitionQ name typq selq = let + sel = selq + typ = case typq of + Just t -> Just t + _ -> Nothing in + (name, typ, sel) -type Typ = (TypeQ -> TypeQ) -> TypeQ -type TypeQL = [TypeQ] +normalSelectionQ :: [ExpressionQ] -> SelectionQ +normalSelectionQ expqs = Left expqs -tupT :: [TypeQ] -> TypeQ -tupT ts = foldl appT (tupleT $ length ts) ts +plainSelectionQ :: [PlainExpressionQ] -> SelectionQ +plainSelectionQ expqs = Right expqs -getTyp :: Typ -> TypeQ -getTyp t = t id +expressionQ :: ([(Lookahead, CheckQ)], Exp) -> ExpressionQ +expressionQ (ls, ex) = + let e = ex + l = map (\(la, c) -> (la ,) c) ls in + Left (l, e) -toTyp :: TypeQ -> Typ -toTyp tp f = f tp +plainExpressionQ :: [(Lookahead, ReadFromQ)] -> PlainExpressionQ +plainExpressionQ ls = map (\(la, c) -> (la ,) c) ls -ctLeaf_ :: PatQ -> NameLeaf -ctLeaf_ n = NameLeaf (n, "") FromToken Nothing +check :: (Pat, String) -> ReadFromQ -> Maybe (Exp, String) -> CheckQ +check (pat, pcom) rfq (Just (test, tcom)) = do + let rf = rfq + p = pat + t = test in + ((p, pcom), rf, Just (t, tcom)) +check (pat, pcom) rfq Nothing = do + let rf = rfq + p = pat in + ((p, pcom), rf, Nothing) -true :: ExpQ -true = conE $ mkName "True" +expressionSugar :: Exp -> ExpressionQ +expressionSugar pm = Right pm -just :: a -> Maybe a -just = Just -nothing :: Maybe a -nothing = Nothing +fromTokenChars :: String -> ReadFromQ +fromTokenChars cs = do + let ex = expressionSugar $ InfixE Nothing (VarE $ mkName "elem") $ + Just $ LitE $ StringL cs + FromSelection $ Left [ex] -cons :: a -> [a] -> [a] -cons = (:) +pprCheck :: Check -> Doc +pprCheck ((pat, _), rf, test) = + ppr pat <> colon <> ppr rf <> maybe empty (brackets . ppr . fst) test -type PatQs = [PatQ] +instance Ppr ReadFrom where + ppr (FromVariable (Just v)) = text v + ppr (FromVariable _) = empty + ppr (FromL l rf) = ppr rf <> ppr l + ppr (FromSelection sel) = parens $ ps sel + where + ps = hsep . intersperse (char '/') . either (map pe) (map ppe) + pe (Left (ex, hs)) = (<+> braces (ppr hs)) $ hsep $ + map (uncurry ($) . (((<>) . ppr) *** pprCheck)) ex + pe (Right ex) = char '<' <> ppr ex <> char '>' + ppe = hsep . map (uncurry (<>) . (ppr *** ppr)) -strToPatQ :: String -> PatQ -strToPatQ = varP . mkName -conToPatQ :: String -> [PatQ] -> PatQ -conToPatQ t = conP (mkName t) - -mkExpressionHs :: a -> ExR -> (a, ExR) -mkExpressionHs x y = (x, y) - -mkDef :: String -> TypeQ -> Selection -> Definition -mkDef = Definition +instance Ppr Lookahead where + ppr Here = empty + ppr Ahead = char '&' + ppr (NAhead _) = char '!' -isOpTailChar :: Char -> Bool -isOpTailChar = (`elem` ":+*/-!|&.^=<>$") +instance Ppr Lists where + ppr List = char '*' + ppr List1 = char '+' + ppr Optional = char '?' -colon :: Char -colon = ':' +definitionType :: Peg -> Type -> Definition -> Type +definitionType _ _ (_, Just typ, _) = typ +definitionType peg tk (_, _, sel) = selectionType peg tk sel -isOpHeadChar :: Char -> Bool -isOpHeadChar = (`elem` "+*/-!|&.^=<>$") +selectionType :: Peg -> Type -> Selection -> Type +selectionType peg tk e = do + case e of + Right ex -> foldr (\x y -> (eitherT `AppT` x) `AppT` y) + (last $ types ex) (init $ types ex) + Left [Left ex] | tc ex -> tk + Left [Right _] -> tk + _ -> error "selectionType: can't get type" + where + eitherT = ConT $ mkName "Either" + types e' = map (plainExpressionType peg tk) e' + tc ([(Here, ((VarP p, _), FromVariable Nothing, _))], VarE v) = p == v + tc _ = False -toExp :: String -> Ex -toExp v f = f $ varE (mkName v) +plainExpressionType :: Peg -> Type -> PlainExpression -> Type +plainExpressionType peg tk e = let fe = filter ((== Here) . fst) e in + foldl AppT (TupleT $ length fe) $ map (readFromType peg tk . snd) $ fe -toEx :: ExR -> Ex -toEx v f = f v +readFromType :: Peg -> Type -> ReadFrom -> Type +readFromType peg tk (FromVariable (Just v)) = + definitionType peg tk $ searchDefinition peg v +readFromType peg tk (FromSelection sel) = selectionType peg tk sel +readFromType _ tk (FromVariable _) = tk +readFromType peg tk (FromL l rf) = lt l `AppT` readFromType peg tk rf + where lt Optional = ConT $ mkName "Maybe" + lt _ = ListT -apply :: String -> Ex -> Ex -apply f x g = x (toExp f g `appE`) +searchDefinition :: Peg -> String -> Definition +searchDefinition peg name = case flip filter peg $ (== name) . \(n, _, _) -> n of + [d] -> d + _ -> error "searchDefinitionQ: bad" -applyExR :: ExR -> Ex -> Ex -applyExR f x g = x (toEx f g `appE`) +nameFromSelection :: Selection -> [String] +nameFromSelection exs = concat $ + (either (mapM nameFromExpression) (mapM nameFromPlainExpression) exs) -applyTyp :: Typ -> Typ -> Typ -applyTyp f t g = t (f g `appT`) +nameFromExpression :: Expression -> [String] +nameFromExpression (Left e) = nameFromCheck $ snd $ head $ fst e +nameFromExpression (Right _) = [dvCharsN] -getEx :: Ex -> ExR -getEx ex = ex id +nameFromPlainExpression :: PlainExpression -> [String] +nameFromPlainExpression = concat . map (nameFromRF . snd) -toExGetEx :: Ex -> Ex -toExGetEx = toEx . getEx +nameFromCheck :: Check -> [String] +nameFromCheck (_, rf, _) = nameFromRF rf -emp :: [a] -emp = [] +nameFromRF :: ReadFrom -> [String] +nameFromRF (FromVariable (Just s)) = [s] +nameFromRF (FromVariable _) = [dvCharsN] +nameFromRF (FromL _ rf) = nameFromRF rf +nameFromRF (FromSelection sel) = nameFromSelection sel -type PegFile = ([PPragma], ModuleName, Maybe ExportList, Code, TTPeg, Code) +type PegFile = ([PPragma], ModuleName, Maybe Exports, Code, STPeg, Code) +type PegFileQ = Q PegFile data PPragma = LanguagePragma [String] | OtherPragma String deriving Show type ModuleName = [String] -type ExportList = String +type Exports = String type Code = String -addModules :: String -addModules = - "import \"monads-tf\" Control.Monad.State\n" ++ - "import \"monads-tf\" Control.Monad.Error\n" - mkPegFile :: [PPragma] -> Maybe ([String], Maybe String) -> String -> String -> - TTPeg -> String -> PegFile -mkPegFile ps (Just md) x y z w = ( - ps, - fst md, - snd md, - addModules ++ - x ++ "\n" ++ y, z, w) -mkPegFile ps Nothing x y z w = - (ps, [], Nothing, addModules ++ x ++ "\n" ++ y, z, w) - -charP :: Char -> PatQ -charP = litP . charL -stringP :: String -> PatQ -stringP = litP . stringL - -isStrLitC, isAlphaNumOt, elemNTs :: Char -> Bool -isAlphaNumOt = (`notElem` "\\'") -elemNTs = (`elem` "nt\\'") -isStrLitC = (`notElem` "\"\\") - -tab :: Char -tab = '\t' - -isComma, isKome, isOpen, isClose, isGt, isQuestion, isBQ, isAmp :: Char -> Bool -isComma = (== ',') -isKome = (== '*') -isOpen = (== '(') -isClose = (== ')') -isGt = (== '>') -isQuestion = (== '?') -isBQ = (== '`') -isAmp = (== '&') - -getNTs :: Char -> Char -getNTs 'n' = '\n' -getNTs 't' = '\t' -getNTs '\\' = '\\' -getNTs '\'' = '\'' -getNTs o = o -isLowerU :: Char -> Bool -isLowerU c = isLower c || c == '_' - -tString :: String -tString = "String" -mkTTPeg :: String -> Peg -> TTPeg -mkTTPeg s p = - (conT $ mkName s, conT (mkName "Token") `appT` conT (mkName s), p) + STPegQ -> String -> PegFileQ +mkPegFile ps (Just md) x y zq w = do + let z = zq + return (ps, fst md, snd md, x ++ "\n" ++ y, z, w) +mkPegFile ps Nothing x y zq w = do + let z = zq + return (ps, [], Nothing, x ++ "\n" ++ y, z, w) diff --git a/src/Text/PapillonCore.hs b/src/Text/PapillonCore.hs --- a/src/Text/PapillonCore.hs +++ b/src/Text/PapillonCore.hs @@ -25,512 +25,403 @@ papillonFile, PPragma(..), ModuleName, - ExportList, + Exports, Code, - (<*>) + (<*>), + (<$>), + runError ) where -import Language.Haskell.TH +import Language.Haskell.TH hiding (infixApp, doE) import "monads-tf" Control.Monad.State +import "monads-tf" Control.Monad.Identity import "monads-tf" Control.Monad.Error import Control.Applicative import Text.Papillon.Parser +import Data.Maybe import Data.IORef --- import Data.List import Text.Papillon.List -isOptionalUsed :: Peg -> Bool -isOptionalUsed = any isOptionalUsedDefinition - -isOptionalUsedDefinition :: Definition -> Bool -isOptionalUsedDefinition (Definition _ _ (Selection sel)) = - any isOptionalUsedSelection sel -isOptionalUsedDefinition (Definition _ _ (PlainSelection sel)) = - any isOptionalUsedSelection sel -isOptionalUsedDefinition (PlainDefinition _ (Selection sel)) = - any isOptionalUsedSelection sel -isOptionalUsedDefinition (PlainDefinition _ (PlainSelection sel)) = - any isOptionalUsedSelection sel - -isOptionalUsedSelection :: ExpressionHs -> Bool -isOptionalUsedSelection (ExpressionHs ex _) = any isOptionalUsedLeafName ex -isOptionalUsedSelection (ExpressionHsSugar _) = False -isOptionalUsedSelection (PlainExpressionHs rfs) = any isOptionalUsedReadFrom rfs - -isOptionalUsedLeafName :: NameLeaf_ -> Bool -isOptionalUsedLeafName (Here nl) = isOptionalUsedLeafName' nl -isOptionalUsedLeafName (NotAfter nl _) = isOptionalUsedLeafName' nl -isOptionalUsedLeafName (After nl) = isOptionalUsedLeafName' nl - -isOptionalUsedLeafName' :: NameLeaf -> Bool -isOptionalUsedLeafName' (NameLeaf _ rf _) = isOptionalUsedReadFrom rf - -isOptionalUsedReadFrom :: ReadFrom -> Bool -isOptionalUsedReadFrom (FromOptional _) = True -isOptionalUsedReadFrom (FromSelection (Selection sel)) = - any isOptionalUsedSelection sel -isOptionalUsedReadFrom _ = False - -isListUsed :: Peg -> Bool -isListUsed = any isListUsedDefinition - -isListUsedDefinition :: Definition -> Bool -isListUsedDefinition (Definition _ _ (Selection sel)) = - any isListUsedSelection sel -isListUsedDefinition (Definition _ _ (PlainSelection sel)) = - any isListUsedSelection sel -isListUsedDefinition (PlainDefinition _ (Selection sel)) = - any isListUsedSelection sel -isListUsedDefinition (PlainDefinition _ (PlainSelection sel)) = - any isListUsedSelection sel - -isListUsedSelection :: ExpressionHs -> Bool -isListUsedSelection (ExpressionHs ex _) = any isListUsedLeafName ex -isListUsedSelection (ExpressionHsSugar _) = False -isListUsedSelection (PlainExpressionHs rfs) = any isListUsedReadFrom rfs - -isListUsedLeafName :: NameLeaf_ -> Bool -isListUsedLeafName (Here nl) = isListUsedLeafName' nl -isListUsedLeafName (NotAfter nl _) = isListUsedLeafName' nl -isListUsedLeafName (After nl) = isListUsedLeafName' nl - -isListUsedLeafName' :: NameLeaf -> Bool -isListUsedLeafName' (NameLeaf _ (FromList _) _) = True -isListUsedLeafName' (NameLeaf _ (FromList1 _) _) = True -isListUsedLeafName' _ = False - -isListUsedReadFrom :: ReadFrom -> Bool -isListUsedReadFrom (FromList _) = True -isListUsedReadFrom (FromList1 _) = True -isListUsedReadFrom _ = False - -catchErrorN, unlessN :: Bool -> Name -catchErrorN True = 'catchError -catchErrorN False = mkName "catchError" -unlessN True = 'unless -unlessN False = mkName "unless" - -smartDoE :: [Stmt] -> Exp -smartDoE [NoBindS ex] = ex -smartDoE stmts = DoE stmts - -flipMaybeBody :: Bool -> ExpQ -> ExpQ -> ExpQ -> ExpQ -> ExpQ -> ExpQ -flipMaybeBody th code com d ns act = doE [ - bindS (varP $ mkName "err") $ infixApp - actionReturnFalse - (varE $ catchErrorN th) - constReturnTrue, - noBindS $ varE (unlessN th) - `appE` varE (mkName "err") - `appE` throwErrorPackratMBody th - (infixApp (litE $ charL '!') (conE $ mkName ":") code) - (stringE "not match: ") com d ns - ] where - actionReturnFalse = infixApp act (varE $ mkName ">>") - (varE (mkName "return") `appE` conE (mkName "False")) - constReturnTrue = varE (mkName "const") `appE` - (varE (mkName "return") `appE` conE (mkName "True")) - -newThrowQ :: Bool -> String -> String -> Name -> [String] -> String -> ExpQ -newThrowQ th code msg d ns com = - throwErrorPackratMBody th (stringE code) (stringE msg) (stringE com) - (varE d) (listE $ map stringE ns) - -returnN, putN, stateTN', getN, - throwErrorN, runStateTN, justN, mplusN, - getsN :: Bool -> Name -returnN True = 'return -returnN False = mkName "return" -throwErrorN True = 'throwError -throwErrorN False = mkName "throwError" -putN True = 'put -putN False = mkName "put" -getsN True = 'gets -getsN False = mkName "gets" -stateTN' True = 'StateT -stateTN' False = mkName "StateT" -mplusN True = 'mplus -mplusN False = mkName "mplus" -getN True = 'get -getN False = mkName "get" -runStateTN True = 'runStateT -runStateTN False = mkName "runStateT" -justN True = 'Just -justN False = mkName "Just" +import System.IO.Unsafe -eitherN :: Name -eitherN = mkName "Either" +dvPosN :: Name +dvPosN = mkName "position" papillonCore :: String -> DecsQ -papillonCore str = case peg $ parse str of - Right ((src, tkn, parsed), _) -> decParsed True src tkn parsed +papillonCore str = case runError $ peg $ parse str of + Right (stpegq, _) -> do + let (monad, src, parsed) = stpegq + decParsed True monad src parsed Left err -> error $ "parse error: " ++ showParseError err papillonFile :: String -> - ([PPragma], ModuleName, Maybe ExportList, Code, DecsQ, Code) -papillonFile str = case pegFile $ parse str of - Right ((prgm, mn, ppp, pp, (src, tkn, parsed), atp), _) -> - (prgm, mn, ppp, addApplicative parsed ++ pp, - decParsed False src tkn parsed, atp) + Q ([PPragma], ModuleName, Maybe Exports, Code, DecsQ, Code) +papillonFile str = case runError $ pegFile $ parse str of + Right (pegfileq, _) -> do + (prgm, mn, ppp, pp, (monad, src, parsed), atp) <- pegfileq + let lu = listUsed parsed + ou = optionalUsed parsed + let addApplicative = + if lu || ou then "import Control.Applicative\n" else "" + return (prgm, mn, ppp, addApplicative ++ pp, decs monad src parsed, atp) + where + decs = decParsed False Left err -> error $ "parse error: " ++ showParseError err - where - addApplicative pg = if needApplicative pg - then "import Control.Applicative\n" - else "" - needApplicative pg = isListUsed pg || isOptionalUsed pg -showParseError :: ParseError (Pos String) Derivs -> String -showParseError pe = -- (ParseError c m _ d ns (ListPos (CharPos p))) = - unwords (map (showReading d) ns) ++ (if null ns then "" else " ") ++ - m ++ c ++ " at position: " ++ show p - where - [c, m, _] = ($ pe) `map` [peCode, peMessage, peComment] - ns = peReading pe - d = peDerivs pe - p = pePositionS pe +decParsed :: Bool -> Maybe Type -> Type -> Peg -> DecsQ +decParsed th monad src parsed = do + let d = derivs th (fromMaybe (ConT $ identityN th) monad) src parsed + pt = SigD (mkName "parse") $ src `arrT` ConT (mkName "Derivs") + p <- funD (mkName "parse") [mkParseBody th (isJust monad) parsed] + return [d, pt, p] -showReading :: Derivs -> String -> String -showReading d "char" = case char d of - Right (c, _) -> show c - Left _ -> error "bad" -showReading _ n = "yet: " ++ n +derivs :: Bool -> Type -> Type -> Peg -> Dec +derivs th monad src pg = DataD [] (mkName "Derivs") [] [ + RecC (mkName "Derivs") $ map derivs1 pg ++ [ + (mkName dvCharsN, NotStrict, resultT tkn), + (dvPosN, NotStrict, ConT (mkName "Pos") `AppT` src) + ]] [] + where + tkn = ConT (mkName "Token") `AppT` src + derivs1 (name, Just t, _) = (mkName name, NotStrict, resultT t) + derivs1 (name, Nothing, sel) = + (mkName name, NotStrict, resultT $ selectionType pg tkn sel) + resultT typ = ConT (errorTTN th) + `AppT` (ConT (mkName "ParseError") + `AppT` (ConT (mkName "Pos") `AppT` src) + `AppT` ConT (mkName "Derivs")) + `AppT` monad + `AppT` (TupleT 2 `AppT` typ `AppT` ConT (mkName "Derivs")) -decParsed :: Bool -> TypeQ -> TypeQ -> Peg -> DecsQ -decParsed th src tkn parsed = do - glb <- runIO $ newIORef 0 - d <- derivs th src tkn parsed - pt <- parseT src th - p <- funD (mkName "parse") [parseEE glb th parsed] - return $ d : pt : [p] +type Variables = [(String, [Name])] -parseEE :: IORef Int -> Bool -> Peg -> ClauseQ -parseEE glb th pg = do - pgn <- newNewName glb "parse" - listN <- newNewName glb "list" - list1N <- newNewName glb "list1" - optionalN <- newNewName glb "optional" - pNames <- mapM (newNewName glb . getDefinitionName) pg +newVariable :: IORef Int -> Variables -> String -> Q Variables +newVariable g vs n = (: vs) . (n ,) <$> vars + where vars = runIO $ unsafeInterleaveIO $ (:) + <$> runQ (newNewName g n) <*> runQ vars - pgenE <- varE pgn `appE` varE (mkName "initialPos") - decs <- (:) - <$> funD pgn [parseE glb th pgn pNames pg] - <*> pSomes glb th listN list1N optionalN pNames pg - ld <- listDec listN list1N th - od <- optionalDec optionalN th - return $ Clause [] (NormalB pgenE) $ decs ++ - (if isListUsed pg then ld else []) ++ - (if isOptionalUsed pg then od else []) +getVariable :: String -> Variables -> Name +getVariable = ((head . fromJust) .) . lookup -dvCharsN, dvPosN :: Name -dvCharsN = mkName "char" -dvPosN = mkName "position" +nextVariable :: String -> Variables -> Variables +nextVariable n vs = (n, tail $ fromJust $ lookup n vs) : vs -derivs :: Bool -> TypeQ -> TypeQ -> Peg -> DecQ -derivs _ src tkn pegg = dataD (cxt []) (mkName "Derivs") [] [ - recC (mkName "Derivs") $ map (derivs1 pegg src tkn) pegg ++ [ - varStrictType dvCharsN $ strictType notStrict $ - resultT src tkn, - varStrictType dvPosN $ strictType notStrict $ - conT (mkName "Pos") `appT` src - ] - ] [] +mkParseBody :: Bool -> Bool -> Peg -> ClauseQ +mkParseBody th monadic pg = do + glb <- runIO $ newIORef 0 + vars <- foldM (newVariable glb) [] [ + "parse", "chars", "pos", "d", "c", "s", "s'", "x", "t", "err", "b", + "list", "list1", "optional"] + let pgn = getVariable "parse" vars + rets <- mapM (newNewName glb . \(n, _, _) -> n) pg + rules <- mapM (newNewName glb . \(n, _, _) -> n) pg + let decs = flip evalState vars $ (:) + <$> (FunD pgn <$> (: []) <$> mkParseCore th rets rules) + <*> zipWithM mkr rules pg + list = if not $ listUsed pg then [] else listDec + (getVariable "list" vars) (getVariable "list1" vars) th + opt = if not $ optionalUsed pg then [] else optionalDec + (getVariable "optional" vars) th + return $ Clause [] (NormalB $ -- VarE (runErrorTN th) `AppE` + VarE pgn `AppE` VarE (mkName "initialPos")) $ + decs ++ list ++ opt + where + mkr rule (_, _, sel) = + flip (ValD $ VarP rule) [] . NormalB <$> mkRule th monadic sel -derivs1 :: Peg -> TypeQ -> TypeQ -> Definition -> VarStrictTypeQ -derivs1 _ src _ (Definition name typ _) = - varStrictType (mkName name) $ strictType notStrict $ resultT src typ -derivs1 pg src tkn (PlainDefinition name sel) = - varStrictType (mkName name) $ strictType notStrict $ resultT src $ - getSelectionType pg tkn sel +mkParseCore :: Bool -> [Name] -> [Name] -> State Variables Clause +mkParseCore th rets rules = do + [ch, p, s, d] <- mapM (gets . getVariable) ["chars", "pos", "s", "d"] + let def ret rule = flip (ValD $ VarP ret) [] $ + NormalB $ VarE (runStateTN th) `AppE` VarE rule `AppE` VarE d + pc <- parseChar th + return $ Clause [VarP p, VarP s] (NormalB $ VarE d) $ [ + flip (ValD $ VarP d) [] $ NormalB $ foldl1 AppE $ + ConE (mkName "Derivs") : map VarE rets ++ [VarE ch, VarE p] + ] ++ zipWith def rets rules ++ [pc] -throwErrorPackratMBody :: Bool -> ExpQ -> ExpQ -> ExpQ -> ExpQ -> ExpQ -> ExpQ -throwErrorPackratMBody th code msg com d ns = infixApp - (varE (getsN th) `appE` varE dvPosN) - (varE $ mkName ">>=") (infixApp - (varE $ throwErrorN th) - (varE $ mkName ".") - (varE (mkName "mkParseError") - `appE` code - `appE` msg - `appE` com - `appE` d - `appE` ns)) +parseChar :: Bool -> State Variables Dec +parseChar th = do + [prs, ch, p, c, s, s', d] <- mapM (gets . getVariable) + ["parse", "chars", "pos", "c", "s", "s'", "d"] + let emsg = "end of input" + np = VarE (mkName "updatePos") `AppE` VarE c `AppE` VarE p + return $ flip (ValD $ VarP ch) [] $ NormalB $ VarE (runStateTN th) `AppE` + CaseE (VarE (mkName "getToken") `AppE` VarE s) [ + Match (mkName "Just" `ConP` [TupP [VarP c, VarP s']]) + (NormalB $ DoE $ map NoBindS [ + VarE (putN th) `AppE` + (VarE prs `AppE` np + `AppE` VarE s'), + VarE (mkName "return") `AppE` VarE c]) + [], + flip (Match WildP) [] $ NormalB $ + throwErrorTH th (mkName "undefined") [] emsg "" "" + ] `AppE` VarE d -resultT :: TypeQ -> TypeQ -> TypeQ -resultT src typ = - conT eitherN `appT` pe `appT` - (tupleT 2 `appT` typ `appT` conT (mkName "Derivs")) +mkRule :: Bool -> Bool -> Selection -> State Variables Exp +mkRule t m s = (VarE (mkName "foldl1") `AppE` VarE (mplusN t) `AppE`) . ListE <$> + case s of + Left exs -> expression t m `mapM` exs + Right exs -> zipWithM ((<$>) . lr (length exs)) [0 .. ] $ + map (plainExpression t) exs where - pe = conT (mkName "ParseError") - `appT` (conT (mkName "Pos") `appT` src) - `appT` conT (mkName "Derivs") - -parseT :: TypeQ -> Bool -> DecQ -parseT src _ = sigD (mkName "parse") $ arrowT - `appT` src - `appT` conT (mkName "Derivs") + lr 1 0 ex = ex + lr _ 0 ex = infixApp (ConE $ mkName "Left") (VarE $ mkName "<$>") ex + lr l n ex = infixApp (ConE $ mkName "Right") (VarE $ mkName "<$>") $ + lr (l - if n == l - 1 then 1 else 0) (n - 1) ex -newNewName :: IORef Int -> String -> Q Name -newNewName g base = do - n <- runIO $ readIORef g - runIO $ modifyIORef g succ - newName (base ++ show n) -parseE :: IORef Int -> Bool -> Name -> [Name] -> Peg -> ClauseQ -parseE g th pgn pnames pegg = do - tmps <- mapM (newNewName g) names - parseE' g th pgn tmps pnames $ map mkName names +expression :: Bool -> Bool -> Expression -> State Variables Exp +expression th m (Left (e, r)) = + (doE . (++ [NoBindS $ retLift `AppE` r]) . concat <$>) $ + forM e $ \(la, ck@(_, rf, _)) -> + lookahead th la (show $ pprCheck ck) (nameFromRF rf) =<< + check th m ck where - names = map getDefinitionName pegg - -getDefinitionName :: Definition -> String -getDefinitionName (Definition n _ _) = n -getDefinitionName (PlainDefinition n _) = n - -parseE' :: IORef Int -> Bool -> Name -> [Name] -> [Name] -> [Name] -> ClauseQ -parseE' g th pgn tmps pnames names = do - chars <- newNewName g "chars" - clause [varP $ mkName "pos", varP $ mkName "s"] - (normalB $ varE $ mkName "d") $ [ - flip (valD $ varP $ mkName "d") [] $ normalB $ appsE $ - conE (mkName "Derivs") : - map varE tmps ++ [varE chars, varE $ mkName "pos"] - ] ++ zipWith3 (parseE1 th) tmps pnames names ++ [parseChar th pgn chars] + retLift = if m then VarE $ liftN th else VarE $ mkName "return" +expression th _ (Right e) = do + c <- gets $ getVariable "c" + modify $ nextVariable "c" + let e' = [(Here, ((VarP c, ""), FromVariable Nothing, + Just (e `AppE` VarE c, "")))] + r = VarE c + expression th False (Left (e', r)) -parseChar :: Bool -> Name -> Name -> DecQ -parseChar th pgn chars = flip (valD $ varP chars) [] $ normalB $ - varE (runStateTN th) `appE` - caseE (varE (mkName "getToken") `appE` varE s) [ - match (justN th `conP` [tupP [varP c, varP s']]) - (normalB $ doE [ - noBindS $ varE (putN th) `appE` - (parseGenE - `appE` newPos - `appE` varE s'), - noBindS $ returnE `appE` varE c]) - [], - match wildP - (normalB $ newThrowQ th "" "end of input" - (mkName "undefined") - [] "") - [] - ] `appE` varE (mkName "d") +check :: Bool -> Bool -> Check -> State Variables [Stmt] +check th monadic ((n, nc), rf, test) = do + t <- gets $ getVariable "t" + d <- gets $ getVariable "d" + b <- gets $ getVariable "b" + modify $ nextVariable "t" + modify $ nextVariable "d" + modify $ nextVariable "b" + case (n, test) of + (WildP, Just p) -> ((BindS (VarP d) (VarE $ getN th) :) . + (: afterCheck th monadic b p d (nameFromRF rf))) . + BindS WildP <$> transReadFrom th rf + (_, Just p) + | notHaveOthers n -> do + let bd = BindS (VarP d) $ VarE $ getN th + m = LetS [ValD n (NormalB $ VarE t) []] + c = afterCheck th monadic b p d (nameFromRF rf) + s <- BindS (VarP t) <$> transReadFrom th rf + return $ [bd, s, m] ++ c + | otherwise -> do + let bd = BindS (VarP d) $ VarE $ getN th + m = beforeMatch th t n d (nameFromRF rf) nc + c = afterCheck th monadic b p d (nameFromRF rf) + s <- BindS (VarP t) <$> transReadFrom th rf + return $ [bd, s] ++ m ++ c + (WildP, _) -> sequence [ + BindS WildP <$> transReadFrom th rf, + return $ NoBindS $ VarE (mkName "return") `AppE` TupE [] + ] + _ | notHaveOthers n -> + (: []) . BindS n <$> transReadFrom th rf + | otherwise -> do + let bd = BindS (VarP d) $ VarE $ getN th + m = beforeMatch th t n d (nameFromRF rf) nc + s <- BindS (VarP t) <$> transReadFrom th rf + return $ bd : s : m where - newPos = varE (mkName "updatePos") - `appE` varE (mkName "c") - `appE` varE pos - pos = mkName "pos" - c = mkName "c" - s = mkName "s" - s' = mkName "s'" - returnE = varE $ returnN th - parseGenE = varE pgn -parseE1 :: Bool -> Name -> Name -> Name -> DecQ -parseE1 th tmp name _ = flip (valD $ varP tmp) [] $ normalB $ - varE (runStateTN th) `appE` varE name `appE` varE (mkName "d") + notHaveOthers (VarP _) = True + notHaveOthers (TupP pats) = all notHaveOthers pats + notHaveOthers _ = False -pSomes :: IORef Int -> Bool -> Name -> Name -> Name -> [Name] -> Peg -> DecsQ -pSomes g th lst lst1 opt = zipWithM $ pSomes1 g th lst lst1 opt +plainExpression :: Bool -> PlainExpression -> State Variables Exp +plainExpression th pexs = do + laxs <- gets $ zip (map fst pexs) . fromJust . lookup "x" + let mkt = LamE (map (uncurry mkp) laxs) $ + TupE $ map (VarE . snd) $ filter ((== Here) . fst) laxs + foldl (\x y -> infixApp x (VarE $ mkName "<*>") y) + (VarE (mkName "return") `AppE` mkt) <$> + mapM (transHAReadFrom th) pexs + where + mkp Here n = VarP n + mkp _ _ = WildP -pSomes1 :: IORef Int -> Bool -> Name -> Name -> Name -> Name -> Definition -> DecQ -pSomes1 g th lst lst1 opt pname (Definition _ _ sel) = - flip (valD $ varP pname) [] $ normalB $ pSomes1Sel g th lst lst1 opt sel -pSomes1 g th lst lst1 opt pname (PlainDefinition _ sel) = - flip (valD $ varP pname) [] $ normalB $ pSomes1Sel g th lst lst1 opt sel +transHAReadFrom :: Bool -> (Lookahead, ReadFrom) -> State Variables Exp +transHAReadFrom th (ha, rf) = do + modify $ nextVariable "d" + doE <$> (lookahead th ha "" (nameFromRF rf) =<< + ((: []) . NoBindS <$> transReadFrom th rf)) -pSomes1Sel :: IORef Int -> Bool -> Name -> Name -> Name -> Selection -> ExpQ -pSomes1Sel g th lst lst1 opt (Selection sel) = - varE (mkName "foldl1") `appE` varE (mplusN th) `appE` - listE (map (processExpressionHs g th lst lst1 opt) sel) -pSomes1Sel g th lst lst1 opt (PlainSelection sel) = - varE (mkName "foldl1") `appE` varE (mplusN th) `appE` - listE (zipWith - (flip putLeftRight . processExpressionHs g th lst lst1 opt) - sel [0..]) +lookahead :: Bool -> Lookahead -> String -> [String] -> [Stmt] -> + State Variables [Stmt] +lookahead _ Here _ _ ret = return ret +lookahead th Ahead _ _ ret = do + d <- gets $ getVariable "d" + modify $ nextVariable "d" + return [BindS (VarP d) $ VarE (getN th), + BindS WildP $ doE ret, + NoBindS $ VarE (putN th) `AppE` VarE d] +lookahead th (NAhead com) ck ns ret = do + d <- gets $ getVariable "d" + modify $ nextVariable "d" + n <- negative th ('!' : ck) com + d ns (doE ret) + return [BindS (VarP d) $ VarE (getN th), + NoBindS n, + NoBindS $ VarE (putN th) `AppE` VarE d] -putLeftRight :: Int -> ExpQ -> ExpQ -putLeftRight 0 ex = leftE `appE` ex -putLeftRight n ex = rightE `appE` putLeftRight (n - 1) ex +negative :: Bool -> String -> String -> Name -> [String] -> Exp -> + State Variables Exp +negative th code com d ns act = do + err <- gets $ getVariable "err" + modify $ nextVariable "err" + return $ DoE [ + BindS (VarP err) $ infixApp + (infixApp act (VarE $ mkName ">>") + (VarE (mkName "return") `AppE` + ConE (mkName "False"))) + (VarE $ catchErrorN th) + (VarE (mkName "const") `AppE` + (VarE (mkName "return") `AppE` + ConE (mkName "True"))), + NoBindS $ VarE (unlessN th) `AppE` VarE err `AppE` + throwErrorTH th d ns "not match: " code com] -rightE, leftE :: ExpQ -rightE = varE (mkName "fmap") `appE` conE (mkName "Right") -leftE = varE (mkName "fmap") `appE` conE (mkName "Left") +transReadFrom :: Bool -> ReadFrom -> State Variables Exp +transReadFrom th (FromVariable Nothing) = return $ + ConE (stateTN th) `AppE` VarE (mkName dvCharsN) +transReadFrom th (FromVariable (Just var)) = return $ + ConE (stateTN th) `AppE` VarE (mkName var) +transReadFrom th (FromSelection sel) = mkRule th {- stub -} False {- stub -} sel +transReadFrom th (FromL List rf) = do + list <- gets $ getVariable "list" + (VarE list `AppE`) <$> transReadFrom th rf +transReadFrom th (FromL List1 rf) = do + list1 <- gets $ getVariable "list1" + (VarE list1 `AppE`) <$> transReadFrom th rf +transReadFrom th (FromL Optional rf) = do + opt <- gets $ getVariable "optional" + (VarE opt `AppE`) <$> transReadFrom th rf -processExpressionHs :: - IORef Int -> Bool -> Name -> Name -> Name -> ExpressionHs -> ExpQ -processExpressionHs g th lst lst1 opt (ExpressionHs expr exr) = - pSome_ g th lst lst1 opt expr exr -processExpressionHs g th lst lst1 opt (ExpressionHsSugar ex) = do - r <- newNewName g "r" - pSome_ g th lst lst1 opt [expr r] (varE r) +beforeMatch :: Bool -> Name -> Pat -> Name -> [String] -> String -> [Stmt] +beforeMatch th t nn d ns nc = [ + NoBindS $ CaseE (VarE t) [ + flip (Match $ vpw nn) [] $ NormalB $ + VarE (mkName "return") `AppE` TupE [], + flip (Match WildP) [] $ NormalB $ + throwErrorTH th d ns "not match pattern: " (show $ ppr nn) nc], + LetS [ValD nn (NormalB $ VarE t) []], + NoBindS $ VarE (mkName "return") `AppE` TupE []] where - expr x = Here $ NameLeaf (varP x, "") FromToken $ Just $ (, "") $ - ex `appE` varE x -processExpressionHs g th lst lst1 opt (PlainExpressionHs rfs) = - foldl (\x y -> infixApp x appApply y) - (returnEQ `appE` tupleE g (length rfs)) $ - map (transReadFrom g th lst lst1 opt) rfs - -tupleE :: IORef Int -> Int -> ExpQ -tupleE _ 0 = conE $ mkName "()" -tupleE _ 1 = varE $ mkName "id" -tupleE g n = do - xs <- replicateM n $ newNewName g "x" - lamE (map varP xs) $ tupE (map varE xs) - -appApply :: ExpQ -appApply = varE $ mkName "<*>" - -returnEQ :: ExpQ -returnEQ = varE $ mkName "return" + vpw (VarP _) = WildP + vpw (ConP n ps) = ConP n $ map vpw ps + vpw (InfixP p1 n p2) = InfixP (vpw p1) n (vpw p2) + vpw (UInfixP p1 n p2) = InfixP (vpw p1) n (vpw p2) + vpw (ListP ps) = ListP $ vpw `map` ps + vpw (TupP ps) = TupP $ vpw `map` ps + vpw o = o -pSome_ :: IORef Int -> Bool -> Name -> Name -> Name -> [NameLeaf_] -> ExpQ -> ExpQ -pSome_ g th lst lst1 opt nls ret = fmap smartDoE $ do - x <- mapM (transLeaf g th lst lst1 opt) nls - r <- noBindS $ varE (returnN th) `appE` ret - return $ concat x ++ [r] +afterCheck :: Bool -> Bool -> Name -> (Exp, String) -> Name -> [String] -> [Stmt] +afterCheck th monadic b (pp, pc) d ns = [ + BindS (VarP b) $ retLift `AppE` pp, + NoBindS $ VarE (unlessN th) `AppE` VarE b `AppE` + throwErrorTH th d ns "not match: " (show $ ppr pp) pc] + where + retLift = if monadic then VarE $ liftN th else VarE $ mkName "return" -afterCheck :: Bool -> ExpQ -> Name -> [String] -> String -> StmtQ -afterCheck th p d ns pc = do - pp <- p - noBindS $ varE (unlessN th) `appE` p `appE` - newThrowQ th (show $ ppr pp) "not match: " d ns pc +listUsed, optionalUsed :: Peg -> Bool +listUsed = any $ sel . \(_, _, s) -> s + where + sel = either (any ex) (any $ any $ rf . snd) + ex (Left e) = any (rf . (\(_, r, _) -> r) . snd) $ fst e + ex (Right _) = False + rf (FromL List _) = True + rf (FromL List1 _) = True + rf (FromSelection s) = sel s + rf _ = False +optionalUsed = any $ sel . \(_, _, s) -> s + where + sel = either (any $ ex) (any $ any $ rf . snd) + ex (Left e) = any (rf . (\(_, r, _) -> r) . snd) $ fst e + ex (Right _) = False + rf (FromL Optional _) = True + rf (FromSelection s) = sel s + rf _ = False -beforeMatch :: Bool -> Name -> PatQ -> Name -> [String] -> String -> Q [Stmt] -beforeMatch th t n d ns nc = do - nn <- n - sequence [ - noBindS $ caseE (varE t) [ - flip (match $ varPToWild n) [] $ normalB $ - varE (returnN th) `appE` tupE [], - flip (match wildP) [] $ normalB $ - newThrowQ th (show $ ppr nn) "not match pattern: " - d ns nc - ], - letS [flip (valD n) [] $ normalB $ varE t], - noBindS $ varE (returnN th) `appE` tupE [] - ] +throwErrorTH :: Bool -> Name -> [String] -> String -> String -> String -> Exp +throwErrorTH th d ns msg code com = InfixE + (Just $ VarE (getsN th) `AppE` VarE dvPosN) + (VarE $ mkName ">>=") + (Just $ InfixE + (Just $ VarE $ throwErrorN th) + (VarE $ mkName ".") + (Just $ VarE (mkName "mkParseError") + `AppE` LitE (StringL code) + `AppE` LitE (StringL msg) + `AppE` LitE (StringL com) + `AppE` VarE d + `AppE` ListE (map (LitE . StringL) ns))) -getNewName :: IORef Int -> String -> Q Name -getNewName g n = do - gn <- runIO $ readIORef g +newNewName :: IORef Int -> String -> Q Name +newNewName g base = do + n <- runIO $ readIORef g runIO $ modifyIORef g succ - newName $ n ++ show gn + newName $ base ++ show n -{- +showParseError :: ParseError (Pos String) Derivs -> String +showParseError pe = + unwords (map (showReading d) ns) ++ (if null ns then "" else " ") ++ + m ++ c ++ " at position: " ++ show p + where + [c, m, _] = ($ pe) `map` [peCode, peMessage, peComment] + ns = peReading pe + d = peDerivs pe + p = pePositionS pe -showSelection :: Selection -> Q String = mapM showExpression +showReading :: Derivs -> String -> String +showReading d n + | n == dvCharsN = case runError $ char d of + Right (c, _) -> show c + Left _ -> error "bad" +showReading _ n = "yet: " ++ n -showNameLeaf :: NameLeaf -> Q String -showNameLeaf (NameLeafList pat sel) = - (\ps ss -> sho (ppr ps) ++ ":(" ++ selS ++ ")*") - <$> pat <*> showSelection sel +doE :: [Stmt] -> Exp +doE [NoBindS ex] = ex +doE stmts = DoE stmts --} +arrT :: Type -> Type -> Type +arrT a r = ArrowT `AppT` a `AppT` r -transReadFrom :: IORef Int -> Bool -> Name -> Name -> Name -> ReadFrom -> ExpQ -transReadFrom _ th _ _ _ FromToken = conE (stateTN' th) `appE` varE dvCharsN -transReadFrom g th _ _ _ rf@(FromTokenChars cs) = do - d <- newNewName g "d" - r <- newNewName g "r" - doE [ - bindS (varP d) $ varE $ getN th, - bindS (varP r) $ conE (stateTN' th) `appE` varE dvCharsN, - afterCheck th (test r) d (nameFromRF rf) "", - noBindS $ varE (mkName "return") `appE` varE r - ] - where - test d' = infixApp (varE d') (varE $ mkName "elem") (litE $ stringL cs) -transReadFrom _ th _ _ _ (FromVariable var) = conE (stateTN' th) `appE` varE (mkName var) -transReadFrom g th l l1 o (FromSelection sel) = pSomes1Sel g th l l1 o sel -transReadFrom g th l l1 o (FromList rf) = varE l `appE` transReadFrom g th l l1 o rf -transReadFrom g th l l1 o (FromList1 rf) = varE l1 `appE` transReadFrom g th l l1 o rf -transReadFrom g th l l1 o (FromOptional rf) = varE o `appE` transReadFrom g th l l1 o rf +infixApp :: Exp -> Exp -> Exp -> Exp +infixApp e1 op e2 = InfixE (Just e1) op (Just e2) -mkTDNN :: IORef Int -> PatQ -> Q (Name, Name, Pat) -mkTDNN g n = do - t <- getNewName g "xx" - d <- getNewName g "d" - nn <- n - return (t, d, nn) +stateTN, runStateTN, putN, getN, getsN :: Bool -> Name +stateTN True = 'StateT +stateTN False = mkName "StateT" +runStateTN True = 'runStateT +runStateTN False = mkName "runStateT" +putN True = 'put +putN False = mkName "put" +getN True = 'get +getN False = mkName "get" +getsN True = 'gets +getsN False = mkName "gets" -transLeaf' :: IORef Int -> Bool -> Name -> Name -> Name -> NameLeaf -> Q [Stmt] -transLeaf' g th lst lst1 opt (NameLeaf (n, nc) rf (Just (p, pc))) = do - (t, d, nn) <- mkTDNN g n - case nn of - WildP -> sequence [ - bindS (varP d) $ varE $ getN th, - bindS wildP $ transReadFrom g th lst lst1 opt rf, - afterCheck th p d (nameFromRF rf) pc - ] - _ | notHaveOthers nn -> do - bd <- bindS (varP d) $ varE $ getN th - s <- bindS (varP t) $ transReadFrom g th lst lst1 opt rf - m <- letS [flip (valD n) [] $ normalB $ varE t] - c <- afterCheck th p d (nameFromRF rf) pc - return $ bd : s : m : [c] - | otherwise -> do - bd <- bindS (varP d) $ varE $ getN th - s <- bindS (varP t) $ - transReadFrom g th lst lst1 opt rf - m <- beforeMatch th t n d (nameFromRF rf) nc - c <- afterCheck th p d (nameFromRF rf) pc - return $ bd : s : m ++ [c] - where - notHaveOthers (VarP _) = True - notHaveOthers (TupP pats) = all notHaveOthers pats - notHaveOthers _ = False -transLeaf' g th lst lst1 opt (NameLeaf (n, nc) rf Nothing) = do - (t, d, nn) <- mkTDNN g n - case nn of - WildP -> sequence [ - bindS wildP $ transReadFrom g th lst lst1 opt rf, - noBindS $ varE (returnN th) `appE` tupE [] - ] - _ | notHaveOthers nn -> (: []) <$> - bindS n (transReadFrom g th lst lst1 opt rf) - | otherwise -> do - bd <- bindS (varP d) $ varE $ getN th - s <- bindS (varP t) $ - transReadFrom g th lst lst1 opt rf - m <- beforeMatch th t n d (nameFromRF rf) nc - return $ bd : s : m - where - notHaveOthers (VarP _) = True - notHaveOthers (TupP pats) = all notHaveOthers pats - notHaveOthers _ = False +unlessN, mplusN :: Bool -> Name +unlessN True = 'unless +unlessN False = mkName "unless" +mplusN True = 'mplus +mplusN False = mkName "mplus" -transLeaf :: IORef Int -> Bool -> Name -> Name -> Name -> NameLeaf_ -> Q [Stmt] -transLeaf g th lst lst1 opt (Here nl) = transLeaf' g th lst lst1 opt nl -transLeaf g th lst lst1 opt (After nl) = do - d <- getNewName g "ddd" - sequence [ - bindS (varP d) $ varE (getN th), - noBindS $ smartDoE <$> transLeaf' g th lst lst1 opt nl, - noBindS $ varE (putN th) `appE` varE d] -transLeaf g th lst lst1 opt (NotAfter nl@(NameLeaf _ rf _) com) = do - d <- getNewName g "ddd" - nls <- showNameLeaf nl - sequence [ - bindS (varP d) $ varE (getN th), - noBindS $ flipMaybeBody th - (stringE nls) - (stringE com) - (varE d) - (listE $ map stringE $ nameFromRF rf) - (smartDoE <$> transLeaf' g th lst lst1 opt nl), - noBindS $ varE (putN th) `appE` varE d] +throwErrorN, catchErrorN :: Bool -> Name +throwErrorN True = 'throwError +throwErrorN False = mkName "throwError" +catchErrorN True = 'catchError +catchErrorN False = mkName "catchError" -varPToWild :: PatQ -> PatQ -varPToWild p = do - pp <- p - return $ vpw pp - where - vpw (VarP _) = WildP - vpw (ConP n ps) = ConP n $ map vpw ps - vpw (InfixP p1 n p2) = InfixP (vpw p1) n (vpw p2) - vpw (UInfixP p1 n p2) = InfixP (vpw p1) n (vpw p2) - vpw (ListP ps) = ListP $ vpw `map` ps - vpw (TupP ps) = TupP $ vpw `map` ps - vpw o = o +errorTTN, identityN :: Bool -> Name +errorTTN True = ''ErrorT +errorTTN False = mkName "ErrorT" +identityN True = ''Identity +identityN False = mkName "Identity" + +liftN :: Bool -> Name +liftN True = 'lift +liftN False = mkName "lift"