papillon 0.0.58 → 0.0.62
raw patch · 11 files changed
+2973/−2885 lines, 11 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Text.PapillonCore: type ExportList = String
+ Text.Papillon: (<$>) :: Functor f => (a -> b) -> f a -> f b
+ Text.Papillon: runError :: ErrorT err Identity a -> Either err a
+ Text.PapillonCore: (<$>) :: Functor f => (a -> b) -> f a -> f b
+ Text.PapillonCore: runError :: ErrorT err Identity a -> Either err a
+ Text.PapillonCore: type Exports = String
- Text.PapillonCore: papillonFile :: String -> ([PPragma], ModuleName, Maybe ExportList, Code, DecsQ, Code)
+ Text.PapillonCore: papillonFile :: String -> Q ([PPragma], ModuleName, Maybe Exports, Code, DecsQ, Code)
Files
- bin/Class.hs +37/−1
- bin/papillon.hs +18/−7
- examples/arith.hs +6/−5
- examples/config.hs +1/−1
- papillon.cabal +2/−2
- src/Text/Papillon.hs +3/−1
- src/Text/Papillon/List.hs +38/−32
- src/Text/Papillon/Papillon.hs +7/−2
- src/Text/Papillon/Parser.hs +2332/−2138
- src/Text/Papillon/SyntaxTree.hs +185/−243
- src/Text/PapillonCore.hs +344/−453
bin/Class.hs view
@@ -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
bin/papillon.hs view
@@ -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]
examples/arith.hs view
@@ -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 } ;+ |]
examples/config.hs view
@@ -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"
papillon.cabal view
@@ -2,7 +2,7 @@ cabal-version: >= 1.8 name: papillon-version: 0.0.58+version: 0.0.62 stability: Experimental author: Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer: Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -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
src/Text/Papillon.hs view
@@ -14,7 +14,9 @@ peComment, pePosition, pePositionS,- (<*>)+ (<*>),+ (<$>),+ runError ) where import Text.PapillonCore
src/Text/Papillon/List.hs view
@@ -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
src/Text/Papillon/Papillon.hs view
@@ -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
src/Text/Papillon/Parser.hs view
@@ -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
src/Text/Papillon/SyntaxTree.hs view
@@ -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)
src/Text/PapillonCore.hs view
@@ -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"