papillon 0.0.7 → 0.0.45

raw patch · 12 files changed

+3001/−1852 lines, 12 filesdep +directorydep +filepathdep +papillonsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: directory, filepath, papillon

API changes (from Hackage documentation)

Files

• Setup.hs +1/−0
• bin/Class.hs +283/−0
• bin/papillon.hs +89/−0
• papillon.cabal +12/−6
• src/Text/Papillon.hs +7/−345
• src/Text/Papillon/Class.hs +0/−86
• src/Text/Papillon/List.hs +79/−0
• src/Text/Papillon/Papillon.hs +45/−0
• src/Text/Papillon/Parser.hs +1829/−1408
• src/Text/Papillon/SyntaxTree.hs +229/−0
• src/Text/PapillonCore.hs +427/−0
• src/papillon.hs +0/−7

@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain

@@ -0,0 +1,283 @@+{-# LANGUAGE TypeFamilies, TemplateHaskell, PackageImports #-}++module Class (+	classSourceQ,+	pePositionST,+	pePositionSD,+	instanceErrorParseError,+	parseErrorT+) where++import Language.Haskell.TH+import "monads-tf" Control.Monad.Error+import Control.Monad.Trans.Error (Error(..))++errorN, strMsgN :: Bool -> Name+errorN True = ''Error+errorN False = mkName "Error"+strMsgN True = 'strMsg+strMsgN False = mkName "strMsg"++parseErrorT :: Bool -> DecQ+parseErrorT _ = flip (dataD (cxt []) (mkName "ParseError")+		[PlainTV $ mkName "pos", PlainTV $ mkName "drv"])+	[] $ (:[]) $+	recC (mkName "ParseError") [+		varStrictType c $ strictType notStrict $ conT $ mkName "String",+		varStrictType m $ strictType notStrict $ conT $ mkName "String",+		varStrictType com $ strictType notStrict $ conT $ mkName "String",+		varStrictType d $ strictType notStrict $ varT $ mkName "drv",+		varStrictType r $ strictType notStrict $ listT `appT` conT (mkName "String"),+		varStrictType pos $ strictType notStrict $ varT $ mkName "pos"+	 ]+	where+	[c, m, com, r, d, pos] = map mkName [+		"peCode",+		"peMessage",+		"peComment",+		"peReading",+		"peDerivs",+		"pePosition"+	 ]++{-++pePositionS :: ParseError (Pos String) -> (Int, Int)+pePositionS ParseError{ pePosition = ListPos (CharPos p) } = p++-}++{-++instance Error (ParseError pos) where+	strMsg msg = ParseError "" msg "" undefined++-}++instanceErrorParseError :: Bool -> DecQ+instanceErrorParseError th = instanceD+	(cxt [])+	(conT (errorN th) `appT`+		(conT (mkName "ParseError")+			`appT` varT (mkName "pos")+			`appT` varT (mkName "drv")))+	[funD (strMsgN th) $ (: []) $ flip (clause [varP msg]) [] $ normalB ret]+	where+	msg = mkName "msg"+	ret = conE (mkName "ParseError")+		`appE` litE (stringL "")+		`appE` varE msg+		`appE` litE (stringL "")+		`appE` varE (mkName "undefined")+		`appE` varE (mkName "undefined")+		`appE` varE (mkName "undefined")++infixr 8 `arrT`++arrT :: TypeQ -> TypeQ -> TypeQ+arrT x y = arrowT `appT` x `appT` y++tupT :: [TypeQ] -> TypeQ+tupT ts = foldl appT (tupleT $ length ts) ts++pePositionST :: DecQ+pePositionST = sigD (mkName "pePositionS") $+	forallT [PlainTV $ mkName "drv"] (cxt []) $+	conT (mkName "ParseError")+		`appT` (conT (mkName "Pos") `appT` conT (mkName "String"))+		`appT` varT (mkName "drv")+	`arrT`+	tupT [conT $ mkName "Int", conT $ mkName "Int"]+pePositionSD :: DecQ+pePositionSD = funD (mkName "pePositionS") $ (: []) $ clause+	[pat] (normalB $ varE $ mkName "p") []+	where+	pat = recP (mkName "ParseError") [fieldPat (mkName "pePosition") $+		conP (mkName "ListPos")+			[conP (mkName "CharPos") [varP $ mkName "p"]]]++classSourceQ :: Bool -> DecsQ+classSourceQ th = sequence [classS th, classSL th, instanceSrcStr th,+	instanceSLC th]++maybeN, nothingN, justN, consN, charN :: Bool -> Name+maybeN True = ''Maybe+maybeN False = mkName "Maybe"+nothingN True = 'Nothing+nothingN False = mkName "Nothing"+justN True = 'Just+justN False = mkName "Just"+consN True = '(:)+consN False = mkName ":"+charN True = ''Char+charN False = mkName "Char"++source, sourceList, listTokenN, tokenN, getTokenN, posN, updatePosN,+	listPosN, listUpdatePosN, initialPosN, listInitialPosN+	:: Name+sourceList = mkName "SourceList"+listTokenN = mkName "listToken"+source = mkName "Source"+tokenN = mkName "Token"+getTokenN = mkName "getToken"+posN = mkName "Pos"+updatePosN = mkName "updatePos"+listPosN = mkName "ListPos"+listUpdatePosN = mkName "listUpdatePos"+initialPosN = mkName "initialPos"+listInitialPosN = mkName "listInitialPos"++classS, classSL, instanceSLC, instanceSrcStr :: Bool -> DecQ++{-+class Source sl where+	type Token sl+	data Pos sl+	getToken :: sl -> Maybe (Token sl, sl)+	initialPos :: Pos sl+	updatePos :: Token sl -> Pos sl -> Pos sl+-}++classS th = classD (cxt []) source [PlainTV sl] [] [+	familyNoKindD typeFam tokenN [PlainTV sl],+	familyNoKindD dataFam posN [PlainTV sl],+	sigD getTokenN $ arrowT `appT` varT sl `appT`+		(conT (maybeN th) `appT` tupleBody),+	sigD initialPosN $ conT posN `appT` varT sl,+	sigD updatePosN $ arrowT+		`appT` (conT tokenN `appT` varT sl)+		`appT` (arrowT+			`appT` (conT posN `appT` varT sl)+			`appT` (conT posN `appT` varT sl))+ ] where+	sl = mkName "sl"+	tupleBody = tupleT 2+		`appT` (conT tokenN `appT` varT sl)+		`appT` varT sl++{-+class SourceList c where+	data ListPos c+	listToken :: [c] -> Maybe (c, [c])+	listInitialPos :: ListPos c+	listUpdatePos :: c -> ListPos c -> ListPos c+-}++classSL th = classD (cxt []) sourceList [PlainTV c] [] [+	familyNoKindD dataFam listPosN [PlainTV c],+	sigD listTokenN $ arrowT `appT` (listT `appT` varT c) `appT`+		(conT (maybeN th) `appT` tupleBody),+	sigD listInitialPosN $ conT listPosN `appT` varT c,+	sigD listUpdatePosN $ arrowT+		`appT` varT c+		`appT` (arrowT+			`appT` (conT listPosN `appT` varT c)+			`appT` (conT listPosN `appT` varT c))+ ] where+	c = mkName "c"+	tupleBody = tupleT 2 `appT` varT c `appT` (listT `appT` varT c)++{-+instance (SourceList c) => Source [c] where+	type Token [c] = c+	newtype Pos [c] = ListPos (ListPos c)+	getToken = listToken+	initialPos = ListPos listInitialPos+	updatePos c (ListPos p) = ListPos (listUpdatePos c p)+-}++instanceSrcStr _ =+	instanceD (cxt [classP sourceList [varT c]]) (conT source `appT` listC) [+		tySynInstD tokenN [listC] $ varT c,+		flip (newtypeInstD (cxt []) posN [listC]) [] $+			normalC listPosN [strictType notStrict $+				conT listPosN `appT` varT c],+		valD (varP getTokenN) (normalB $ varE listTokenN) [],+		flip (valD $ varP initialPosN) [] $ normalB $+			conE listPosN `appE` varE listInitialPosN,+		funD updatePosN $ (: []) $ flip (clause [pc, lp]) [] $ normalB $+			conE listPosN `appE`+				(varE listUpdatePosN `appE` varE c `appE` varE p)+	 ]+	where+	c = mkName "c"+	p = mkName "p"+	pc = varP c+	lp = conP listPosN [varP p]+	listC = listT `appT` varT c++{-++instance Show (ListPos a) => Show (Pos [a]) where+	show (ListPos x) = "ListPos " ++ show x+++instanceShowListPosPos :: DecQ+instanceShowListPosPos = instanceD (cxt [cxtShowListPos]) decType [body]+	where+	cxtShowListPos = classP (mkName "Show")+		[conT (mkName "ListPos") `appT` varT (mkName "a")]+	decType = conT (mkName "Show") `appT`+		(conT (mkName "Pos") `appT` (listT  `appT` varT (mkName "a")))+	body = funD (mkName "show") $ (: []) $ flip (clause [patListPos]) [] $+		normalB $ addParens $ infixApp+			(litE $ stringL "ListPos (")+			(varE $ mkName "++") $ infixApp+				(varE (mkName "show") `appE` varE (mkName "x"))+				(varE $ mkName "++")+				(litE $ stringL ")")+	patListPos = conP (mkName "ListPos") [varP $ mkName "x"]+	addParens str = infixApp+		(litE $ stringL "(")+		(varE $ mkName "++") $ infixApp+			str+			(varE $ mkName "++")+			(litE $ stringL ")")++-}++{-+instance SourceList Char where+	newtype ListPos Char = CharPos (Int, Int)+	listToken (c : s) = Just (c, s)+	listToken _ = Nothing+	listInitialPos = CharPos (1, 1)+	listUpdatePos '\n' (CharPos (y, x)) = CharPos (y + 1, 0)+	listUpdatePos '\t' (CharPOs (y, x)) = CharPos (y, x + 8)+	listUpdatePos _ (CharPos (y, x)) = CharPos (y, x + 1)+-}++instanceSLC th = instanceD (cxt []) (conT sourceList `appT` conT (charN th)) [+	newtypeInstD (cxt []) listPosN [conT $ charN th] (+		normalC (mkName "CharPos") [+			strictType notStrict $ tupleT 2+				`appT` conT (mkName "Int")+				`appT` conT (mkName "Int")]+	 ) [mkName "Show"],+	funD listTokenN [+		clause [infixP (varP c) (consN th) (varP s)]+			(normalB $ conE (justN th) `appE` tupleBody) [],+		clause [wildP] (normalB $ conE $ nothingN th) []+	 ],+	flip (valD $ varP listInitialPosN) [] $ normalB $+		conE (mkName "CharPos") `appE` tupE [one, one],+	funD listUpdatePosN [+		flip (clause [litP $ charL '\n', pCharPos [tupP [varP y, wildP]]]) [] $+			normalB $ eCharPos `appE` tupE [+				infixApp (varE y) plus one, zero],+		flip (clause [wildP, pCharPos [tupP [varP y, varP x]]]) [] $+			normalB $ eCharPos `appE` tupE [+				varE y, infixApp (varE x) plus one]+	 ]+ ] where+	c = mkName "c"+	s = mkName "s"+	y = mkName "y"+	x = mkName "x"+	tupleBody = tupE [varE c, varE s]+	one = litE $ integerL 1+	zero = litE $ integerL 0+	plus = varE $ mkName "+"+	charPosN = mkName "CharPos"+	eCharPos = conE charPosN+	pCharPos = conP charPosN

@@ -0,0 +1,89 @@+import Text.PapillonCore+import System.Environment+import System.Directory+import System.FilePath+import Data.List+import Language.Haskell.TH++import Class++papillonStr :: String -> IO (String, String, String)+papillonStr src = do+	let 	(prgm, mn, ppp, pp, decsQ, atp, app) = papillonFile src+		mName = intercalate "." $ myInit mn ++ ["Papillon"]+		importConst = "\nimport " ++ mName ++ "\n"+		dir = joinPath $ myInit mn+	decs <- runQ decsQ+	return (dir, mName,+		unlines (map showPragma $ addPragmas $ delPragmas prgm) +++		(if null mn then "" else "module " ++ intercalate "." mn) +++		ppp ++ importConst +++		(if app then "\nimport Control.Applicative\n" else "") +++		pp ++ "\n" ++ show (ppr decs) ++ "\n" ++ atp ++ "\n")++showPragma :: PPragma -> String+showPragma (LanguagePragma []) = ""+showPragma (LanguagePragma p) = "{-# LANGUAGE " ++ intercalate ", " p ++ " #-}"+showPragma (OtherPragma p) = "{-# " ++ p ++ " #-}"++addPragmas :: [PPragma] -> [PPragma]+addPragmas [] = [LanguagePragma additionalPragmas]+addPragmas (LanguagePragma p : ps) = LanguagePragma (p ++ additionalPragmas) : ps+addPragmas (op : ps) = op : addPragmas ps++delPragmas :: [PPragma] -> [PPragma]+delPragmas [] = []+delPragmas (LanguagePragma p : ps) =+	LanguagePragma (filter (`notElem` ["QuasiQuotes", "TypeFamilies"]) p) : ps+delPragmas (op : ps) = op : delPragmas ps++additionalPragmas :: [String]+additionalPragmas = [+	"PackageImports",+	"TypeFamilies",+	"RankNTypes"+ ]++papillonConstant :: String -> IO String+papillonConstant mName = do+	src <- runQ $ do+		pe <- parseErrorT False+		iepe <- instanceErrorParseError False+		pepst <- pePositionST+		pepsd <- pePositionSD+		cls <- classSourceQ False+		return $ [pe, iepe, pepst, pepsd] ++ cls+	return $+		"{-# LANGUAGE RankNTypes, TypeFamilies #-}\n" +++		"module " ++ mName ++ " (\n\t" +++		intercalate ",\n\t" exportList ++ ") where\n" +++		"import Control.Monad.Trans.Error (Error(..))\n" +++		show (ppr src) ++ "\n"++main :: IO ()+main = do+	args <- getArgs+	case args of+		[fn, dist] -> do+			(d, mName, src) <- papillonStr =<< readFile fn+			let dir = dist </> d+			createDirectoryIfMissing True dir+			writeFile (dir </> takeBaseName fn <.> "hs") src+			writeFile (dir </> "Papillon" <.> "hs")+				=<< papillonConstant mName+		_ -> error "bad arguments"++exportList :: [String]+exportList = [+	"ParseError(..)",+	"Pos(..)",+	"pePositionS",+	"Source(..)",+	"SourceList(..)",+	"ListPos(..)"+ ]++myInit :: [a] -> [a]+myInit [] = []+myInit [_] = []+myInit (x : xs) = x : myInit xs

@@ -2,7 +2,7 @@ cabal-version:	>= 1.8  name:		papillon-version:	0.0.7+version:	0.0.45 stability:	Experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -25,17 +25,23 @@ source-repository	this   type:		git   location:	git://github.com/YoshikuniJujo/papillon.git-  tag:		0.0.7+  tag:		0.0.45  library   hs-source-dirs:	src-  exposed-modules:	Text.Papillon-  other-modules:	Text.Papillon.Parser, Text.Papillon.Class+  exposed-modules:	Text.Papillon, Text.PapillonCore+  other-modules:+    Text.Papillon.Parser,+    Text.Papillon.Papillon,+    Text.Papillon.Papillon,+    Text.Papillon.List,+    Text.Papillon.SyntaxTree   build-depends:	base > 3 && < 5, template-haskell, monads-tf, transformers   ghc-options:		-Wall  executable	papillon-  hs-source-dirs:	src+  hs-source-dirs:	bin   main-is:		papillon.hs-  build-depends:	base > 3 && < 5, template-haskell, monads-tf, transformers+  other-modules:	Class+  build-depends:	directory, filepath, base > 3 && < 5, template-haskell, monads-tf, transformers, papillon   ghc-options:		-Wall

@@ -1,358 +1,20 @@-{-# LANGUAGE TemplateHaskell, PackageImports, TypeFamilies, FlexibleContexts #-}- module Text.Papillon ( 	papillon,-	papillonStr,-	papillonStr',-	classSourceQ,+	ParseError(..), 	Source(..),-	SourceList(..)+	SourceList(..),+	Pos(..),+	ListPos(..),+	pePositionS, ) where +import Text.PapillonCore import Language.Haskell.TH.Quote-import Language.Haskell.TH-import "monads-tf" Control.Monad.State-import "monads-tf" Control.Monad.Error-import Control.Monad.Trans.Error (Error(..))-import Data.Maybe -import Control.Applicative--import Text.Papillon.Parser-import Data.IORef--import Text.Papillon.Class--classSourceQ True--usingNames :: Peg -> [String]-usingNames = concatMap getNamesFromDefinition--getNamesFromDefinition :: Definition -> [String]-getNamesFromDefinition (_, _, sel) =-	concatMap getNamesFromExpressionHs sel--getNamesFromExpressionHs :: ExpressionHs -> [String]-getNamesFromExpressionHs = mapMaybe getLeafName . fst--getLeafName :: NameLeaf_ -> Maybe String-getLeafName (Here (_, Left n)) = Just n-getLeafName (NotAfter (_, Left n)) = Just n-getLeafName _ = Nothing--flipMaybe :: (Error (ErrorType me), MonadError me) =>-	StateT s me a -> StateT s me ()-flipMaybe action = do-	err <- (action >> return False) `catchError` const (return True)-	unless err $ throwError $ strMsg "not error"- papillon :: QuasiQuoter papillon = QuasiQuoter { 	quoteExp = undefined, 	quotePat = undefined, 	quoteType = undefined,-	quoteDec = declaration True+	quoteDec = papillonCore  }--papillonStr :: String -> IO String-papillonStr src = show . ppr <$> runQ (declaration False src)--papillonStr' :: String -> IO String-papillonStr' src = do-	let (pp, decsQ, atp) = declaration' src-	decs <- runQ decsQ-	cls <- runQ $ classSourceQ False-	return $ pp ++ "\n" ++ flipMaybeS ++ show (ppr decs) ++ "\n" ++ atp ++-		"\n" ++ show (ppr cls)--flipMaybeS :: String-flipMaybeS =-{--	"instance MonadError Maybe where\n" ++-	"\ttype ErrorType Maybe = ()\n" ++-	"\tthrowError () = Nothing\n" ++-	"\tcatchError action recover = recover ()\n\n" ++--}--	"flipMaybe :: (Error (ErrorType me), MonadError me) =>\n" ++-	"\tStateT s me a -> StateT s me ()\n" ++-	"flipMaybe action = do\n" ++-	"\terr <- (action >> return False) `catchError` const (return True)\n" ++-	"\tunless err $ throwError $ strMsg \"not error\"\n"--flipMaybeN :: Bool -> Name-flipMaybeN True = 'flipMaybe-flipMaybeN False = mkName "flipMaybe"--returnN, stateTN, stringN, putN, stateTN', getN,-	eitherN, strMsgN, throwErrorN, runStateTN, justN, mplusN,-	getTokenN :: Bool -> Name-returnN True = 'return-returnN False = mkName "return"-throwErrorN True = 'throwError-throwErrorN False = mkName "throwError"-strMsgN True = 'strMsg-strMsgN False = mkName "strMsg"-stateTN True = ''StateT-stateTN False = mkName "StateT"-stringN True = ''String-stringN False = mkName "String"-putN True = 'put-putN False = mkName "put"-stateTN' True = 'StateT-stateTN' False = mkName "StateT"-mplusN True = 'mplus-mplusN False = mkName "mplus"-getN True = 'get-getN False = mkName "get"-eitherN True = ''Either-eitherN False = mkName "Either"-runStateTN True = 'runStateT-runStateTN False = mkName "runStateT"-justN True = 'Just-justN False = mkName "Just"-getTokenN True = 'getToken-getTokenN False = mkName "getToken"--declaration :: Bool -> String -> DecsQ-declaration th str = do---	fm <- dFlipMaybe-	let (src, tkn, parsed) = case dv_peg $ parse str of-		Right ((s, t, p), _) -> (s, t, p)-		_ -> error "bad"-	decParsed th src tkn parsed--declaration' :: String -> (String, DecsQ, String)-declaration' src = case dv_pegFile $ parse src of-	Right ((pp, (s, t, p), atp), _) ->-		(pp, decParsed False s t p, atp)-	_ -> error "bad"--decParsed :: Bool -> TypeQ -> TypeQ -> Peg -> DecsQ-decParsed th src tkn parsed = do---	debug <- flip (valD $ varP $ mkName "debug") [] $ normalB $---		appE (varE $ mkName "putStrLn") (litE $ stringL "debug")-	glb <- runIO $ newIORef 0-	r <- result th-	pm <- pmonad th-	d <- derivs th tkn parsed-	pt <- parseT src th-	p <- funD (mkName "parse") [parseE th parsed]-	tdvm <- typeDvM parsed-	dvsm <- dvSomeM th parsed-	tdvcm <- typeDvCharsM th tkn-	dvcm <- dvCharsM th-	pts <- typeP parsed-	ps <- pSomes glb th parsed -- name expr-	return $ {- fm ++ -} [pm, r, d, pt, p] ++ tdvm ++ dvsm ++ [tdvcm, dvcm] ++ pts ++ ps-	where---	c = clause [wildP] (normalB $ conE $ mkName "Nothing") []--derivs :: Bool -> TypeQ -> Peg -> DecQ-derivs _ tkn peg = dataD (cxt []) (mkName "Derivs") [] [-	recC (mkName "Derivs") $ map derivs1 peg ++ [-		varStrictType (mkName "dvChars") $ strictType notStrict $-			conT (mkName "Result") `appT` tkn-	 ]- ] []--derivs1 :: Definition -> VarStrictTypeQ-derivs1 (name, typ, _) =-	varStrictType (mkName $ "dv_" ++ name) $ strictType notStrict $-		conT (mkName "Result") `appT` conT typ--result :: Bool -> DecQ-result th = tySynD (mkName "Result") [PlainTV $ mkName "v"] $-	conT (eitherN th) `appT` conT (stringN th) `appT`-		(tupleT 2 `appT` varT (mkName "v") `appT` conT (mkName "Derivs"))--pmonad :: Bool -> DecQ-pmonad th = tySynD (mkName "PackratM") [] $ conT (stateTN th) `appT`-	conT (mkName "Derivs") `appT`-		(conT (eitherN th) `appT` conT (stringN th))--parseT :: TypeQ -> Bool -> DecQ-parseT src _ = sigD (mkName "parse") $-	arrowT `appT` src `appT` conT (mkName "Derivs")-parseE :: Bool -> Peg -> ClauseQ-parseE th = parseE' th . map (\(n, _, _) -> n)-parseE' :: Bool -> [String] -> ClauseQ-parseE' th names = clause [varP $ mkName "s"] (normalB $ varE $ mkName "d") $ [-	flip (valD $ varP $ mkName "d") [] $ normalB $ appsE $-		conE (mkName "Derivs") :-			map (varE . mkName) names-			++ [varE (mkName "char")]] ++-	map (parseE1 th) names ++ [-	flip (valD $ varP $ mkName "char") [] $ normalB $-		varE (mkName "flip") `appE` varE (runStateTN th) `appE`-			varE (mkName "d") `appE` caseE (varE (getTokenN th) `appE`-								varE (mkName "s")) [-					match	(justN th `conP` [-							tupP [(varP (mkName "c")),-							(varP (mkName "s'"))]])-						(normalB $ doE [-							noBindS $ varE (putN th)-								`appE`-								(varE (mkName "parse") `appE` varE (mkName "s'")),-							noBindS $ varE (returnN th) `appE`-								varE (mkName "c")-						 ])-						[],-					match	wildP-						(normalB $ varE (throwErrorN th) `appE`-							(varE (strMsgN th) `appE`-							litE (stringL "eof")))-						[]-				 ]- ]-parseE1 :: Bool -> String -> DecQ-parseE1 th name = flip (valD $ varP $ mkName name) [] $ normalB $-	varE (runStateTN th) `appE` varE (mkName $ "p_" ++ name)-		`appE` varE (mkName "d")--typeDvM :: Peg -> DecsQ-typeDvM peg = let-	used = usingNames peg in-	uncurry (zipWithM typeDvM1) $ unzip $ filter ((`elem` used) . fst)-		$ map (\(n, t, _) -> (n, t)) peg--typeDvM1 :: String -> Name -> DecQ-typeDvM1 f t = sigD (mkName $ "dv_" ++ f ++ "M") $ conT (mkName "PackratM") `appT` conT t--dvSomeM :: Bool -> Peg -> DecsQ-dvSomeM th peg = mapM (dvSomeM1 th) $-	filter ((`elem` usingNames peg) . (\(n, _, _) -> n)) peg--dvSomeM1 :: Bool -> Definition -> DecQ-dvSomeM1 th (name, _, _) = flip (valD $ varP $ mkName $ "dv_" ++ name ++ "M") [] $ normalB $-	conE (stateTN' th) `appE` varE (mkName $ "dv_" ++ name)--typeDvCharsM :: Bool -> TypeQ -> DecQ-typeDvCharsM _ tkn =-	sigD (mkName "dvCharsM") $ conT (mkName "PackratM") `appT` tkn-dvCharsM :: Bool -> DecQ-dvCharsM th = flip (valD $ varP $ mkName "dvCharsM") [] $ normalB $-	conE (stateTN' th) `appE` varE (mkName "dvChars")--typeP :: Peg -> DecsQ-typeP = uncurry (zipWithM typeP1) . unzip . map (\(n, t, _) -> (n, t))--typeP1 :: String -> Name -> DecQ-typeP1 f t = sigD (mkName $ "p_" ++ f) $ conT (mkName "PackratM") `appT` conT t--pSomes :: IORef Int -> Bool -> Peg -> DecsQ-pSomes g th = mapM $ pSomes1 g th--pSomes1 :: IORef Int -> Bool -> Definition -> DecQ-pSomes1 g th (name, _, sel) = flip (valD $ varP $ mkName $ "p_" ++ name) [] $ normalB $-	varE (mkName "foldl1") `appE` varE (mplusN th) `appE` listE (map (uncurry $ pSome_ g th) sel)--pSome_ :: IORef Int -> Bool -> [NameLeaf_] -> ExpQ -> ExpQ-pSome_ g th nls ret = fmap DoE $ do-	x <- mapM (transLeaf g th) nls-	r <- noBindS $ varE (returnN th) `appE` ret-	return $ concat x ++ [r]--transLeaf :: IORef Int -> Bool -> NameLeaf_ -> Q [Stmt]-transLeaf g th (Here (n, Right p)) = do-	gn <- runIO $ readIORef g-	runIO $ modifyIORef g succ-	t <- newName $ "xx" ++ show gn-	nn <- n-	case nn of-		VarP _ -> sequence [-			bindS (varP t) $ varE $ mkName "dvCharsM",-			noBindS $ condE (p `appE` varE t)-				(varE (returnN th) `appE` conE (mkName "()"))-				(varE (throwErrorN th) `appE`-					(varE (strMsgN th) `appE`-						litE (stringL "not match"))),-			noBindS $ caseE (varE t) [-				flip (match $ varPToWild n) [] $ normalB $-					varE (returnN th) `appE` tupE []-			 ],-			letS [flip (valD n) [] $ normalB $ varE t],-			noBindS $ varE (returnN th) `appE` tupE []-		 ]-		WildP -> sequence [-			bindS (varP t) $ varE $ mkName "dvCharsM",-			noBindS $ condE (p `appE` varE t)-				(varE (returnN th) `appE` conE (mkName "()"))-				(varE (throwErrorN th) `appE`-					(varE (strMsgN th) `appE`-						litE (stringL "not match"))),-			noBindS $ caseE (varE t) [-				flip (match $ varPToWild n) [] $ normalB $-					varE (returnN th) `appE` tupE []-			 ],-			letS [flip (valD n) [] $ normalB $ varE t],-			noBindS $ varE (returnN th) `appE` tupE []-		 ]-		_ -> sequence [-			bindS (varP t) $ varE $ mkName "dvCharsM",-			noBindS $ condE (p `appE` varE t)-				(varE (returnN th) `appE` conE (mkName "()"))-				(varE (throwErrorN th) `appE`-					(varE (strMsgN th) `appE`-						litE (stringL "not match"))),-			noBindS $ caseE (varE t) [-				flip (match $ varPToWild n) [] $ normalB $-					varE (returnN th) `appE` tupE [],-				flip (match wildP) [] $ normalB $ varE (throwErrorN th) `appE`-					(varE (strMsgN th) `appE` litE (stringL "not match"))-			 ],-			letS [flip (valD n) [] $ normalB $ varE t],-			noBindS $ varE (returnN th) `appE` tupE []-		 ]-transLeaf g th (Here (n, Left v)) = do-	nn <- n-	case nn of-		VarP _ -> sequence [-			bindS n $ varE $ mkName $ "dv_" ++ v ++ "M",-			noBindS $ varE (returnN th) `appE` conE (mkName "()")]-		WildP -> sequence [-			bindS wildP $ varE $ mkName $ "dv_" ++ v ++ "M",-			noBindS $ varE (returnN th) `appE` conE (mkName "()")]-		_ -> do	gn <- runIO $ readIORef g-			runIO $ modifyIORef g succ-			t <- newName $ "xx" ++ show gn-			sequence [-				bindS (varP t) $ varE $ mkName $ "dv_" ++ v ++ "M",-				noBindS $ caseE (varE t) [-					flip (match $ varPToWild n) [] $ normalB $-						varE (returnN th) `appE`-							tupE [],-					flip (match wildP) [] $ normalB $-						varE (throwErrorN th) `appE`-							(varE (strMsgN th) `appE`-								litE (stringL "not match"))-				 ],-				bindS n $ varE (returnN th) `appE` varE t-			 ]-transLeaf g th (NotAfter (n, Right p)) = do-	d <- newName "d"-	sequence [-		bindS (varP d) $ varE (getN th),-		noBindS $ varE (flipMaybeN th) `appE`-			(DoE <$> transLeaf g th (Here (n, Right p))),-		noBindS $ varE (putN th) `appE` varE d]-transLeaf g th (NotAfter (n, Left v)) = do-	d <- newName "d"-	sequence [-		bindS (varP d) $ varE (getN th),-		noBindS $ varE (flipMaybeN th) `appE`-			(DoE <$> transLeaf g th (Here (n, Left v))),-{--		noBindS $ varE (flipMaybeN th) `appE`-			varE (mkName $ "dv_" ++ v ++ "M"),--}-		noBindS $ varE (putN th) `appE` varE d]--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 o = o

@@ -1,86 +0,0 @@-{-# LANGUAGE TypeFamilies, TemplateHaskell #-}--module Text.Papillon.Class (---	Source(..),-	classSourceQ-) where--import Language.Haskell.TH--{--class Source sl where-	type Token sl-	getToken :: sl -> Maybe (Token sl, sl)--class SourceList c where-	listToken :: [c] -> Maybe (c, [c])--instance SourceList Char where-	listToken (c : s) = Just (c, s)-	listToken _ = Nothing--instance (SourceList c) => Source [c] where-	type Token [c] = c-	getToken = listToken--}--classSourceQ :: Bool -> DecsQ-classSourceQ th = sequence-	[classS th, classSL th, instanceSLC th, instanceSrcStr th]--maybeN, nothingN, justN, consN, charN :: Bool -> Name-maybeN True = ''Maybe-maybeN False = mkName "Maybe"-nothingN True = 'Nothing-nothingN False = mkName "Nothing"-justN True = 'Just-justN False = mkName "Just"-consN True = '(:)-consN False = mkName ":"-charN True = ''Char-charN False = mkName "Char"--classS, classSL, instanceSLC, instanceSrcStr :: Bool -> DecQ-classS th = classD (cxt []) source [PlainTV sl] [] [-	familyNoKindD typeFam tokenN [PlainTV sl],-	sigD getTokenN $ arrowT `appT` varT sl `appT`-		(conT (maybeN th) `appT` tupleBody)- ] where-	sl = mkName "sl"-	tupleBody = tupleT 2-		`appT` (conT tokenN `appT` varT sl)-		`appT` varT sl--classSL th = classD (cxt []) sourceList [PlainTV c] [] [-	sigD listTokenN $ arrowT `appT` (listT `appT` varT c) `appT`-		(conT (maybeN th) `appT` tupleBody)- ] where-	c = mkName "c"-	tupleBody = tupleT 2 `appT` varT c `appT` (listT `appT` varT c)--source, sourceList, listTokenN, tokenN, getTokenN :: Name-sourceList = mkName "SourceList"-listTokenN = mkName "listToken"-source = mkName "Source"-tokenN = mkName "Token"-getTokenN = mkName "getToken"--instanceSLC th = instanceD (cxt []) (conT sourceList `appT` conT (charN th)) [-	funD listTokenN [-		clause [infixP (varP c) (consN th) (varP s)]-			(normalB $ conE (justN th) `appE` tupleBody) [],-		clause [wildP] (normalB $ conE $ nothingN th) []-	 ]- ] where-	c = mkName "c"-	s = mkName "s"-	tupleBody = tupE [varE c, varE s]--instanceSrcStr _ =-	instanceD (cxt [classP sourceList [varT c]]) (conT source `appT` listC) [-		tySynInstD tokenN [listC] $ varT c,-		valD (varP getTokenN) (normalB $ varE listTokenN) []-	 ]-	where-	c = mkName "c"-	listC = listT `appT` varT c

@@ -0,0 +1,79 @@+{-# LANGUAGE TemplateHaskell, PackageImports #-}++module Text.Papillon.List (+	listDec,+	optionalDec+) where++import Language.Haskell.TH+import Control.Applicative+import Control.Monad++{-++list, list1 :: (MonadPlus m, Applicative m) => m a -> m [a]+list p = list1 p `mplus` return []+list1 p = (:) <$> p <*> list p++-}++monadPlusN, mplusN, applicativeN, applyN, applyContN :: Bool -> Name+monadPlusN True = ''MonadPlus+monadPlusN False = mkName "MonadPlus"+applicativeN True = ''Applicative+applicativeN False = mkName "Applicative"+mplusN True = 'mplus+mplusN False = mkName "mplus"+applyN True = '(<$>)+applyN False = mkName "<$>"+applyContN True = '(<*>)+applyContN False = mkName "<*>"++m, a, p :: Name+m = mkName "m"+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)+ ] where+	vm = varT m+	returnEmpty = varE (mkName "return") `appE` listE []+	cons = conE $ mkName ":"+	app = varE $ applyN th+	next = varE $ applyContN th++{-++optional :: (MonadPlus m, Applicative m) => m a -> m (Maybe a)+optional p = (Just <$> p) `mplus` return Nothing++-}++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+ ] where+	mplusAndApp = forallT [PlainTV m, PlainTV a] $ cxt [+		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)

@@ -0,0 +1,45 @@+{-# LANGUAGE RankNTypes, TypeFamilies #-}+module Text.Papillon.Papillon (+	ParseError(..),+	Pos(..),+	pePositionS,+	Source(..),+	SourceList(..),+	ListPos(..)) where+import Control.Monad.Trans.Error (Error(..))+data ParseError pos drv+    = ParseError {peCode :: String,+                  peMessage :: String,+                  peComment :: String,+                  peDerivs :: drv,+                  peReading :: ([String]),+                  pePosition :: pos}+instance Error (ParseError pos drv)+    where strMsg msg = ParseError "" msg "" undefined undefined undefined+pePositionS :: forall drv . ParseError (Pos String) drv ->+                            (Int, Int)+pePositionS (ParseError {pePosition = ListPos (CharPos p)}) = p+class Source sl+    where type Token sl+          data Pos sl+          getToken :: sl -> Maybe ((Token sl, sl))+          initialPos :: Pos sl+          updatePos :: Token sl -> Pos sl -> Pos sl+class SourceList c+    where data ListPos c+          listToken :: [c] -> Maybe ((c, [c]))+          listInitialPos :: ListPos c+          listUpdatePos :: c -> ListPos c -> ListPos c+instance SourceList c => Source ([c])+    where type Token ([c]) = c+          newtype Pos ([c]) = ListPos (ListPos c)+          getToken = listToken+          initialPos = ListPos listInitialPos+          updatePos c (ListPos p) = ListPos (listUpdatePos c p)+instance SourceList Char+    where newtype ListPos Char = CharPos ((Int, Int)) deriving (Show)+          listToken (c : s) = Just (c, s)+          listToken _ = Nothing+          listInitialPos = CharPos (1, 1)+          listUpdatePos '\n' (CharPos (y, _)) = CharPos (y + 1, 0)+          listUpdatePos _ (CharPos (y, x)) = CharPos (y, x + 1)

@@ -1,1408 +1,1829 @@-{-# LANGUAGE FlexibleContexts, TemplateHaskell , FlexibleContexts, PackageImports, TypeFamilies #-}-module  Text.Papillon.Parser (-	Peg,-	Definition,-	ExpressionHs,-	NameLeaf,-	NameLeaf_(..),-	parse,-	dv_peg,-	dv_pegFile,-)  where-import "monads-tf" Control.Monad.State-import "monads-tf" Control.Monad.Error-import Control.Monad.Trans.Error (Error (..))----import Data.Char-import Language.Haskell.TH--type MaybeString = Maybe String--type Nil = ()-type Leaf = Either String ExR-type NameLeaf = (PatQ, Leaf)-data NameLeaf_ = NotAfter NameLeaf | Here NameLeaf-notAfter, here :: NameLeaf -> NameLeaf_-notAfter = NotAfter-here = Here-type Expression = [NameLeaf_]-type ExpressionHs = (Expression, ExR)-type Selection = [ExpressionHs]-type Typ = Name-type Definition = (String, Typ, Selection)-type Peg = [Definition]-type TTPeg = (TypeQ, TypeQ, Peg)--type Ex = ExpQ -> ExpQ-type ExR = ExpQ--ctLeaf :: Leaf-ctLeaf = Right $ varE (mkName "const") `appE` conE (mkName "True")--left :: b -> Either a b-right :: a -> Either a b-left = Right-right = Left--just :: a -> Maybe a-just = Just-nothing :: Maybe a-nothing = Nothing--nil :: Nil-nil = ()--cons :: a -> [a] -> [a]-cons = (:)--type PatQs = [PatQ]--mkNameLeaf :: PatQ -> b -> (PatQ, b)-mkNameLeaf = (,)--strToPatQ :: String -> PatQ-strToPatQ = varP . mkName--conToPatQ :: String -> [PatQ] -> PatQ-conToPatQ t ps = conP (mkName t) ps--mkExpressionHs :: a -> Ex -> (a, ExR)-mkExpressionHs x y = (x, getEx y)--mkDef :: a -> String -> c -> (a, Name, c)-mkDef x y z = (x, mkName y, z)--toExp :: String -> Ex-toExp v = \f -> f `appE` varE (mkName v)--apply :: String -> Ex -> Ex-apply f x = \g -> x (toExp f g)--getEx :: Ex -> ExR-getEx ex = ex (varE $ mkName "id")--empty :: [a]-empty = []--type PegFile = (String, TTPeg, String)-mkPegFile :: Maybe String -> Maybe String -> String -> String -> b -> c -> (String, b, c)-mkPegFile (Just p) (Just md) x y z w =-	("{-#" ++ p ++ addPragmas ++ "module " ++ md ++ " where\n" ++-	addModules ++-	x ++ "\n" ++ y, z, w)-mkPegFile Nothing (Just md) x y z w =-	(x ++ "\n" ++ "module " ++ md ++ " where\n" ++-	addModules ++-	x ++ "\n" ++ y, z, w)-mkPegFile (Just p) Nothing x y z w = (-	"{-#" ++ p ++ addPragmas ++-	addModules ++-	x ++ "\n" ++ y-	, z, w)-mkPegFile Nothing Nothing x y z w = (addModules ++ x ++ "\n" ++ y, z, w)--addPragmas, addModules :: String-addPragmas =-	", FlexibleContexts, PackageImports, TypeFamilies #-}\n"-addModules =-	"import \"monads-tf\" Control.Monad.State\n" ++-	"import \"monads-tf\" Control.Monad.Error\n" ++-	"import Control.Monad.Trans.Error (Error (..))\n"--true :: Bool-true = True--charP :: Char -> PatQ-charP = litP . charL-stringP :: String -> PatQ-stringP = litP . stringL--isAlphaNumOt, elemNTs :: Char -> Bool-isAlphaNumOt c = isAlphaNum c || c `elem` "{-#.\":}"-elemNTs = (`elem` "nt\\'")--getNTs :: Char -> Char-getNTs 'n' = '\n'-getNTs 't' = '\t'-getNTs '\\' = '\\'-getNTs '\'' = '\''-getNTs o = o--isEqual, isSlash, isSemi, isColon, isOpenWave, isCloseWave, isLowerU, isNot,-	isChon, isDQ, isBS :: Char -> Bool-isEqual = (== '=')-isSlash = (== '/')-isSemi = (== ';')-isColon = (== ':')-isOpenWave = (== '{')-isCloseWave = (== '}')-isLowerU c = isLower c || c == '_'-isNot = (== '!')-isChon = (== '\'')-isDQ = (== '"')-isBS = (== '\\')--isOpenBr, isP, isA, isI, isL, isO, isN, isBar, isCloseBr, isNL :: Char -> Bool-[isOpenBr, isP, isA, isI, isL, isO, isN, isBar, isCloseBr, isNL] =-	map (==) "[pailon|]\n"--{--tString, tChar :: TypeQ-tString = varT ''String-tChar = varT ''Char--}--tString :: String-tString = "String"-mkTTPeg :: String -> Peg -> TTPeg-mkTTPeg s p =-	(conT $ mkName s, conT (mkName "Token") `appT` conT (mkName s), p)--flipMaybe :: (Error (ErrorType me), MonadError me) =>-	StateT s me a -> StateT s me ()-flipMaybe action = do-	err <- (action >> return False) `catchError` const (return True)-	unless err $ throwError $ strMsg "not error"-type PackratM = StateT Derivs (Either String)-type Result v = Either String ((v, Derivs))-data Derivs-    = Derivs {dv_pegFile :: (Result PegFile),-              dv_pragma :: (Result MaybeString),-              dv_pragmaStr :: (Result String),-              dv_pragmaEnd :: (Result Nil),-              dv_moduleDec :: (Result MaybeString),-              dv_moduleDecStr :: (Result String),-              dv_whr :: (Result Nil),-              dv_preImpPap :: (Result String),-              dv_prePeg :: (Result String),-              dv_afterPeg :: (Result String),-              dv_importPapillon :: (Result Nil),-              dv_varToken :: (Result String),-              dv_typToken :: (Result String),-              dv_pap :: (Result Nil),-              dv_peg :: (Result TTPeg),-              dv_sourceType :: (Result String),-              dv_peg_ :: (Result Peg),-              dv_definition :: (Result Definition),-              dv_selection :: (Result Selection),-              dv_expressionHs :: (Result ExpressionHs),-              dv_expression :: (Result Expression),-              dv_nameLeaf_ :: (Result NameLeaf_),-              dv_nameLeaf :: (Result NameLeaf),-              dv_pat :: (Result PatQ),-              dv_charLit :: (Result Char),-              dv_stringLit :: (Result String),-              dv_dq :: (Result Nil),-              dv_pats :: (Result PatQs),-              dv_leaf :: (Result Leaf),-              dv_test :: (Result ExR),-              dv_hsExp :: (Result Ex),-              dv_typ :: (Result String),-              dv_variable :: (Result String),-              dv_tvtail :: (Result String),-              dv_alpha :: (Result Char),-              dv_upper :: (Result Char),-              dv_lower :: (Result Char),-              dv_digit :: (Result Char),-              dv_spaces :: (Result Nil),-              dv_space :: (Result Nil),-              dv_notNLString :: (Result String),-              dv_nl :: (Result Nil),-              dv_comment :: (Result Nil),-              dv_comments :: (Result Nil),-              dv_notComStr :: (Result Nil),-              dv_comEnd :: (Result Nil),-              dvChars :: (Result (Token String))}-parse :: String -> Derivs-parse s = d-          where d = Derivs pegFile pragma pragmaStr pragmaEnd moduleDec moduleDecStr whr preImpPap prePeg afterPeg importPapillon varToken typToken pap peg sourceType peg_ definition selection expressionHs expression nameLeaf_ nameLeaf pat charLit stringLit dq pats leaf test hsExp typ variable tvtail alpha upper lower digit spaces space notNLString nl comment comments notComStr comEnd char-                pegFile = runStateT p_pegFile d-                pragma = runStateT p_pragma d-                pragmaStr = runStateT p_pragmaStr d-                pragmaEnd = runStateT p_pragmaEnd d-                moduleDec = runStateT p_moduleDec d-                moduleDecStr = runStateT p_moduleDecStr d-                whr = runStateT p_whr d-                preImpPap = runStateT p_preImpPap d-                prePeg = runStateT p_prePeg d-                afterPeg = runStateT p_afterPeg d-                importPapillon = runStateT p_importPapillon d-                varToken = runStateT p_varToken d-                typToken = runStateT p_typToken d-                pap = runStateT p_pap d-                peg = runStateT p_peg d-                sourceType = runStateT p_sourceType d-                peg_ = runStateT p_peg_ d-                definition = runStateT p_definition d-                selection = runStateT p_selection d-                expressionHs = runStateT p_expressionHs d-                expression = runStateT p_expression d-                nameLeaf_ = runStateT p_nameLeaf_ d-                nameLeaf = runStateT p_nameLeaf d-                pat = runStateT p_pat d-                charLit = runStateT p_charLit d-                stringLit = runStateT p_stringLit d-                dq = runStateT p_dq d-                pats = runStateT p_pats d-                leaf = runStateT p_leaf d-                test = runStateT p_test d-                hsExp = runStateT p_hsExp d-                typ = runStateT p_typ d-                variable = runStateT p_variable d-                tvtail = runStateT p_tvtail d-                alpha = runStateT p_alpha d-                upper = runStateT p_upper d-                lower = runStateT p_lower d-                digit = runStateT p_digit d-                spaces = runStateT p_spaces d-                space = runStateT p_space d-                notNLString = runStateT p_notNLString d-                nl = runStateT p_nl d-                comment = runStateT p_comment d-                comments = runStateT p_comments d-                notComStr = runStateT p_notComStr d-                comEnd = runStateT p_comEnd d-                char = flip runStateT d (case getToken s of-                                             Just (c, s') -> do put (parse s')-                                                                return c-                                             _ -> throwError (strMsg "eof"))-dv_pragmaM :: PackratM MaybeString-dv_pragmaStrM :: PackratM String-dv_pragmaEndM :: PackratM Nil-dv_moduleDecM :: PackratM MaybeString-dv_moduleDecStrM :: PackratM String-dv_whrM :: PackratM Nil-dv_preImpPapM :: PackratM String-dv_prePegM :: PackratM String-dv_afterPegM :: PackratM String-dv_importPapillonM :: PackratM Nil-dv_varTokenM :: PackratM String-dv_typTokenM :: PackratM String-dv_papM :: PackratM Nil-dv_pegM :: PackratM TTPeg-dv_sourceTypeM :: PackratM String-dv_peg_M :: PackratM Peg-dv_definitionM :: PackratM Definition-dv_selectionM :: PackratM Selection-dv_expressionHsM :: PackratM ExpressionHs-dv_expressionM :: PackratM Expression-dv_nameLeaf_M :: PackratM NameLeaf_-dv_nameLeafM :: PackratM NameLeaf-dv_patM :: PackratM PatQ-dv_charLitM :: PackratM Char-dv_stringLitM :: PackratM String-dv_dqM :: PackratM Nil-dv_patsM :: PackratM PatQs-dv_leafM :: PackratM Leaf-dv_testM :: PackratM ExR-dv_hsExpM :: PackratM Ex-dv_typM :: PackratM String-dv_variableM :: PackratM String-dv_tvtailM :: PackratM String-dv_alphaM :: PackratM Char-dv_upperM :: PackratM Char-dv_lowerM :: PackratM Char-dv_digitM :: PackratM Char-dv_spacesM :: PackratM Nil-dv_spaceM :: PackratM Nil-dv_notNLStringM :: PackratM String-dv_nlM :: PackratM Nil-dv_commentM :: PackratM Nil-dv_commentsM :: PackratM Nil-dv_notComStrM :: PackratM Nil-dv_comEndM :: PackratM Nil-dv_pragmaM = StateT dv_pragma-dv_pragmaStrM = StateT dv_pragmaStr-dv_pragmaEndM = StateT dv_pragmaEnd-dv_moduleDecM = StateT dv_moduleDec-dv_moduleDecStrM = StateT dv_moduleDecStr-dv_whrM = StateT dv_whr-dv_preImpPapM = StateT dv_preImpPap-dv_prePegM = StateT dv_prePeg-dv_afterPegM = StateT dv_afterPeg-dv_importPapillonM = StateT dv_importPapillon-dv_varTokenM = StateT dv_varToken-dv_typTokenM = StateT dv_typToken-dv_papM = StateT dv_pap-dv_pegM = StateT dv_peg-dv_sourceTypeM = StateT dv_sourceType-dv_peg_M = StateT dv_peg_-dv_definitionM = StateT dv_definition-dv_selectionM = StateT dv_selection-dv_expressionHsM = StateT dv_expressionHs-dv_expressionM = StateT dv_expression-dv_nameLeaf_M = StateT dv_nameLeaf_-dv_nameLeafM = StateT dv_nameLeaf-dv_patM = StateT dv_pat-dv_charLitM = StateT dv_charLit-dv_stringLitM = StateT dv_stringLit-dv_dqM = StateT dv_dq-dv_patsM = StateT dv_pats-dv_leafM = StateT dv_leaf-dv_testM = StateT dv_test-dv_hsExpM = StateT dv_hsExp-dv_typM = StateT dv_typ-dv_variableM = StateT dv_variable-dv_tvtailM = StateT dv_tvtail-dv_alphaM = StateT dv_alpha-dv_upperM = StateT dv_upper-dv_lowerM = StateT dv_lower-dv_digitM = StateT dv_digit-dv_spacesM = StateT dv_spaces-dv_spaceM = StateT dv_space-dv_notNLStringM = StateT dv_notNLString-dv_nlM = StateT dv_nl-dv_commentM = StateT dv_comment-dv_commentsM = StateT dv_comments-dv_notComStrM = StateT dv_notComStr-dv_comEndM = StateT dv_comEnd-dvCharsM :: PackratM (Token String)-dvCharsM = StateT dvChars-p_pegFile :: PackratM PegFile-p_pragma :: PackratM MaybeString-p_pragmaStr :: PackratM String-p_pragmaEnd :: PackratM Nil-p_moduleDec :: PackratM MaybeString-p_moduleDecStr :: PackratM String-p_whr :: PackratM Nil-p_preImpPap :: PackratM String-p_prePeg :: PackratM String-p_afterPeg :: PackratM String-p_importPapillon :: PackratM Nil-p_varToken :: PackratM String-p_typToken :: PackratM String-p_pap :: PackratM Nil-p_peg :: PackratM TTPeg-p_sourceType :: PackratM String-p_peg_ :: PackratM Peg-p_definition :: PackratM Definition-p_selection :: PackratM Selection-p_expressionHs :: PackratM ExpressionHs-p_expression :: PackratM Expression-p_nameLeaf_ :: PackratM NameLeaf_-p_nameLeaf :: PackratM NameLeaf-p_pat :: PackratM PatQ-p_charLit :: PackratM Char-p_stringLit :: PackratM String-p_dq :: PackratM Nil-p_pats :: PackratM PatQs-p_leaf :: PackratM Leaf-p_test :: PackratM ExR-p_hsExp :: PackratM Ex-p_typ :: PackratM String-p_variable :: PackratM String-p_tvtail :: PackratM String-p_alpha :: PackratM Char-p_upper :: PackratM Char-p_lower :: PackratM Char-p_digit :: PackratM Char-p_spaces :: PackratM Nil-p_space :: PackratM Nil-p_notNLString :: PackratM String-p_nl :: PackratM Nil-p_comment :: PackratM Nil-p_comments :: PackratM Nil-p_notComStr :: PackratM Nil-p_comEnd :: PackratM Nil-p_pegFile = msum [do pr <- dv_pragmaM-                     return ()-                     md <- dv_moduleDecM-                     return ()-                     pip <- dv_preImpPapM-                     return ()-                     _ <- dv_importPapillonM-                     return ()-                     pp <- dv_prePegM-                     return ()-                     _ <- dv_papM-                     return ()-                     p <- dv_pegM-                     return ()-                     _ <- dv_spacesM-                     return ()-                     xx0_0 <- dvCharsM-                     if id isBar xx0_0-                      then return ()-                      else throwError (strMsg "not match")-                     case xx0_0 of-                         _ -> return ()-                     let _ = xx0_0-                     return ()-                     xx1_1 <- dvCharsM-                     if id isCloseBr xx1_1-                      then return ()-                      else throwError (strMsg "not match")-                     case xx1_1 of-                         _ -> return ()-                     let _ = xx1_1-                     return ()-                     xx2_2 <- dvCharsM-                     if id isNL xx2_2-                      then return ()-                      else throwError (strMsg "not match")-                     case xx2_2 of-                         _ -> return ()-                     let _ = xx2_2-                     return ()-                     atp <- dv_afterPegM-                     return ()-                     return (id mkPegFile pr md pip pp p atp),-                  do pr <- dv_pragmaM-                     return ()-                     md <- dv_moduleDecM-                     return ()-                     pp <- dv_prePegM-                     return ()-                     _ <- dv_papM-                     return ()-                     p <- dv_pegM-                     return ()-                     _ <- dv_spacesM-                     return ()-                     xx3_3 <- dvCharsM-                     if id isBar xx3_3-                      then return ()-                      else throwError (strMsg "not match")-                     case xx3_3 of-                         _ -> return ()-                     let _ = xx3_3-                     return ()-                     xx4_4 <- dvCharsM-                     if id isCloseBr xx4_4-                      then return ()-                      else throwError (strMsg "not match")-                     case xx4_4 of-                         _ -> return ()-                     let _ = xx4_4-                     return ()-                     xx5_5 <- dvCharsM-                     if id isNL xx5_5-                      then return ()-                      else throwError (strMsg "not match")-                     case xx5_5 of-                         _ -> return ()-                     let _ = xx5_5-                     return ()-                     atp <- dv_afterPegM-                     return ()-                     return (id mkPegFile pr md empty pp p atp)]-p_pragma = msum [do _ <- dv_spacesM-                    return ()-                    xx6_6 <- dvCharsM-                    if const True xx6_6-                     then return ()-                     else throwError (strMsg "not match")-                    case xx6_6 of-                        '{' -> return ()-                        _ -> throwError (strMsg "not match")-                    let '{' = xx6_6-                    return ()-                    xx7_7 <- dvCharsM-                    if const True xx7_7-                     then return ()-                     else throwError (strMsg "not match")-                    case xx7_7 of-                        '-' -> return ()-                        _ -> throwError (strMsg "not match")-                    let '-' = xx7_7-                    return ()-                    xx8_8 <- dvCharsM-                    if const True xx8_8-                     then return ()-                     else throwError (strMsg "not match")-                    case xx8_8 of-                        '#' -> return ()-                        _ -> throwError (strMsg "not match")-                    let '#' = xx8_8-                    return ()-                    s <- dv_pragmaStrM-                    return ()-                    _ <- dv_pragmaEndM-                    return ()-                    _ <- dv_spacesM-                    return ()-                    return (id just s),-                 do _ <- dv_spacesM-                    return ()-                    return (id nothing)]-p_pragmaStr = msum [do d_9 <- get-                       flipMaybe (do _ <- dv_pragmaEndM-                                     return ())-                       put d_9-                       xx9_10 <- dvCharsM-                       if const True xx9_10-                        then return ()-                        else throwError (strMsg "not match")-                       case xx9_10 of-                           _ -> return ()-                       let c = xx9_10-                       return ()-                       s <- dv_pragmaStrM-                       return ()-                       return (id cons c s),-                    do return (id empty)]-p_pragmaEnd = msum [do xx10_11 <- dvCharsM-                       if const True xx10_11-                        then return ()-                        else throwError (strMsg "not match")-                       case xx10_11 of-                           '#' -> return ()-                           _ -> throwError (strMsg "not match")-                       let '#' = xx10_11-                       return ()-                       xx11_12 <- dvCharsM-                       if const True xx11_12-                        then return ()-                        else throwError (strMsg "not match")-                       case xx11_12 of-                           '-' -> return ()-                           _ -> throwError (strMsg "not match")-                       let '-' = xx11_12-                       return ()-                       xx12_13 <- dvCharsM-                       if const True xx12_13-                        then return ()-                        else throwError (strMsg "not match")-                       case xx12_13 of-                           '}' -> return ()-                           _ -> throwError (strMsg "not match")-                       let '}' = xx12_13-                       return ()-                       return (id nil)]-p_moduleDec = msum [do xx13_14 <- dvCharsM-                       if const True xx13_14-                        then return ()-                        else throwError (strMsg "not match")-                       case xx13_14 of-                           'm' -> return ()-                           _ -> throwError (strMsg "not match")-                       let 'm' = xx13_14-                       return ()-                       xx14_15 <- dvCharsM-                       if const True xx14_15-                        then return ()-                        else throwError (strMsg "not match")-                       case xx14_15 of-                           'o' -> return ()-                           _ -> throwError (strMsg "not match")-                       let 'o' = xx14_15-                       return ()-                       xx15_16 <- dvCharsM-                       if const True xx15_16-                        then return ()-                        else throwError (strMsg "not match")-                       case xx15_16 of-                           'd' -> return ()-                           _ -> throwError (strMsg "not match")-                       let 'd' = xx15_16-                       return ()-                       xx16_17 <- dvCharsM-                       if const True xx16_17-                        then return ()-                        else throwError (strMsg "not match")-                       case xx16_17 of-                           'u' -> return ()-                           _ -> throwError (strMsg "not match")-                       let 'u' = xx16_17-                       return ()-                       xx17_18 <- dvCharsM-                       if const True xx17_18-                        then return ()-                        else throwError (strMsg "not match")-                       case xx17_18 of-                           'l' -> return ()-                           _ -> throwError (strMsg "not match")-                       let 'l' = xx17_18-                       return ()-                       xx18_19 <- dvCharsM-                       if const True xx18_19-                        then return ()-                        else throwError (strMsg "not match")-                       case xx18_19 of-                           'e' -> return ()-                           _ -> throwError (strMsg "not match")-                       let 'e' = xx18_19-                       return ()-                       s <- dv_moduleDecStrM-                       return ()-                       _ <- dv_whrM-                       return ()-                       return (id just s),-                    do return (id nothing)]-p_moduleDecStr = msum [do d_20 <- get-                          flipMaybe (do _ <- dv_whrM-                                        return ())-                          put d_20-                          xx19_21 <- dvCharsM-                          if const True xx19_21-                           then return ()-                           else throwError (strMsg "not match")-                          case xx19_21 of-                              _ -> return ()-                          let c = xx19_21-                          return ()-                          s <- dv_moduleDecStrM-                          return ()-                          return (id cons c s),-                       do return (id empty)]-p_whr = msum [do xx20_22 <- dvCharsM-                 if const True xx20_22-                  then return ()-                  else throwError (strMsg "not match")-                 case xx20_22 of-                     'w' -> return ()-                     _ -> throwError (strMsg "not match")-                 let 'w' = xx20_22-                 return ()-                 xx21_23 <- dvCharsM-                 if const True xx21_23-                  then return ()-                  else throwError (strMsg "not match")-                 case xx21_23 of-                     'h' -> return ()-                     _ -> throwError (strMsg "not match")-                 let 'h' = xx21_23-                 return ()-                 xx22_24 <- dvCharsM-                 if const True xx22_24-                  then return ()-                  else throwError (strMsg "not match")-                 case xx22_24 of-                     'e' -> return ()-                     _ -> throwError (strMsg "not match")-                 let 'e' = xx22_24-                 return ()-                 xx23_25 <- dvCharsM-                 if const True xx23_25-                  then return ()-                  else throwError (strMsg "not match")-                 case xx23_25 of-                     'r' -> return ()-                     _ -> throwError (strMsg "not match")-                 let 'r' = xx23_25-                 return ()-                 xx24_26 <- dvCharsM-                 if const True xx24_26-                  then return ()-                  else throwError (strMsg "not match")-                 case xx24_26 of-                     'e' -> return ()-                     _ -> throwError (strMsg "not match")-                 let 'e' = xx24_26-                 return ()-                 return (id nil)]-p_preImpPap = msum [do d_27 <- get-                       flipMaybe (do _ <- dv_importPapillonM-                                     return ())-                       put d_27-                       d_28 <- get-                       flipMaybe (do _ <- dv_papM-                                     return ())-                       put d_28-                       xx25_29 <- dvCharsM-                       if id const true xx25_29-                        then return ()-                        else throwError (strMsg "not match")-                       case xx25_29 of-                           _ -> return ()-                       let c = xx25_29-                       return ()-                       pip <- dv_preImpPapM-                       return ()-                       return (id cons c pip),-                    do return (id empty)]-p_prePeg = msum [do d_30 <- get-                    flipMaybe (do _ <- dv_papM-                                  return ())-                    put d_30-                    xx26_31 <- dvCharsM-                    if id const true xx26_31-                     then return ()-                     else throwError (strMsg "not match")-                    case xx26_31 of-                        _ -> return ()-                    let c = xx26_31-                    return ()-                    pp <- dv_prePegM-                    return ()-                    return (id cons c pp),-                 do return (id empty)]-p_afterPeg = msum [do xx27_32 <- dvCharsM-                      if id const true xx27_32-                       then return ()-                       else throwError (strMsg "not match")-                      case xx27_32 of-                          _ -> return ()-                      let c = xx27_32-                      return ()-                      atp <- dv_afterPegM-                      return ()-                      return (id cons c atp),-                   do return (id empty)]-p_importPapillon = msum [do xx28_33 <- dv_varTokenM-                            case xx28_33 of-                                "import" -> return ()-                                _ -> throwError (strMsg "not match")-                            "import" <- return xx28_33-                            xx29_34 <- dv_typTokenM-                            case xx29_34 of-                                "Text" -> return ()-                                _ -> throwError (strMsg "not match")-                            "Text" <- return xx29_34-                            xx30_35 <- dvCharsM-                            if const True xx30_35-                             then return ()-                             else throwError (strMsg "not match")-                            case xx30_35 of-                                '.' -> return ()-                                _ -> throwError (strMsg "not match")-                            let '.' = xx30_35-                            return ()-                            _ <- dv_spacesM-                            return ()-                            xx31_36 <- dv_typTokenM-                            case xx31_36 of-                                "Papillon" -> return ()-                                _ -> throwError (strMsg "not match")-                            "Papillon" <- return xx31_36-                            return (id nil)]-p_varToken = msum [do v <- dv_variableM-                      return ()-                      _ <- dv_spacesM-                      return ()-                      return (id v)]-p_typToken = msum [do t <- dv_typM-                      return ()-                      _ <- dv_spacesM-                      return ()-                      return (id t)]-p_pap = msum [do xx32_37 <- dvCharsM-                 if id isNL xx32_37-                  then return ()-                  else throwError (strMsg "not match")-                 case xx32_37 of-                     _ -> return ()-                 let _ = xx32_37-                 return ()-                 xx33_38 <- dvCharsM-                 if id isOpenBr xx33_38-                  then return ()-                  else throwError (strMsg "not match")-                 case xx33_38 of-                     _ -> return ()-                 let _ = xx33_38-                 return ()-                 xx34_39 <- dvCharsM-                 if id isP xx34_39-                  then return ()-                  else throwError (strMsg "not match")-                 case xx34_39 of-                     _ -> return ()-                 let _ = xx34_39-                 return ()-                 xx35_40 <- dvCharsM-                 if id isA xx35_40-                  then return ()-                  else throwError (strMsg "not match")-                 case xx35_40 of-                     _ -> return ()-                 let _ = xx35_40-                 return ()-                 xx36_41 <- dvCharsM-                 if id isP xx36_41-                  then return ()-                  else throwError (strMsg "not match")-                 case xx36_41 of-                     _ -> return ()-                 let _ = xx36_41-                 return ()-                 xx37_42 <- dvCharsM-                 if id isI xx37_42-                  then return ()-                  else throwError (strMsg "not match")-                 case xx37_42 of-                     _ -> return ()-                 let _ = xx37_42-                 return ()-                 xx38_43 <- dvCharsM-                 if id isL xx38_43-                  then return ()-                  else throwError (strMsg "not match")-                 case xx38_43 of-                     _ -> return ()-                 let _ = xx38_43-                 return ()-                 xx39_44 <- dvCharsM-                 if id isL xx39_44-                  then return ()-                  else throwError (strMsg "not match")-                 case xx39_44 of-                     _ -> return ()-                 let _ = xx39_44-                 return ()-                 xx40_45 <- dvCharsM-                 if id isO xx40_45-                  then return ()-                  else throwError (strMsg "not match")-                 case xx40_45 of-                     _ -> return ()-                 let _ = xx40_45-                 return ()-                 xx41_46 <- dvCharsM-                 if id isN xx41_46-                  then return ()-                  else throwError (strMsg "not match")-                 case xx41_46 of-                     _ -> return ()-                 let _ = xx41_46-                 return ()-                 xx42_47 <- dvCharsM-                 if id isBar xx42_47-                  then return ()-                  else throwError (strMsg "not match")-                 case xx42_47 of-                     _ -> return ()-                 let _ = xx42_47-                 return ()-                 xx43_48 <- dvCharsM-                 if id isNL xx43_48-                  then return ()-                  else throwError (strMsg "not match")-                 case xx43_48 of-                     _ -> return ()-                 let _ = xx43_48-                 return ()-                 return (id nil)]-p_peg = msum [do _ <- dv_spacesM-                 return ()-                 s <- dv_sourceTypeM-                 return ()-                 p <- dv_peg_M-                 return ()-                 return (id mkTTPeg s p),-              do p <- dv_peg_M-                 return ()-                 return (id mkTTPeg tString p)]-p_sourceType = msum [do xx44_49 <- dv_varTokenM-                        case xx44_49 of-                            "source" -> return ()-                            _ -> throwError (strMsg "not match")-                        "source" <- return xx44_49-                        xx45_50 <- dvCharsM-                        if const True xx45_50-                         then return ()-                         else throwError (strMsg "not match")-                        case xx45_50 of-                            ':' -> return ()-                            _ -> throwError (strMsg "not match")-                        let ':' = xx45_50-                        return ()-                        _ <- dv_spacesM-                        return ()-                        v <- dv_typTokenM-                        return ()-                        return (id v)]-p_peg_ = msum [do _ <- dv_spacesM-                  return ()-                  d <- dv_definitionM-                  return ()-                  p <- dv_peg_M-                  return ()-                  return (id cons d p),-               do return (id empty)]-p_definition = msum [do v <- dv_variableM-                        return ()-                        _ <- dv_spacesM-                        return ()-                        xx46_51 <- dvCharsM-                        if id isColon xx46_51-                         then return ()-                         else throwError (strMsg "not match")-                        case xx46_51 of-                            _ -> return ()-                        let _ = xx46_51-                        return ()-                        xx47_52 <- dvCharsM-                        if id isColon xx47_52-                         then return ()-                         else throwError (strMsg "not match")-                        case xx47_52 of-                            _ -> return ()-                        let _ = xx47_52-                        return ()-                        _ <- dv_spacesM-                        return ()-                        t <- dv_typM-                        return ()-                        _ <- dv_spacesM-                        return ()-                        xx48_53 <- dvCharsM-                        if id isEqual xx48_53-                         then return ()-                         else throwError (strMsg "not match")-                        case xx48_53 of-                            _ -> return ()-                        let _ = xx48_53-                        return ()-                        _ <- dv_spacesM-                        return ()-                        sel <- dv_selectionM-                        return ()-                        _ <- dv_spacesM-                        return ()-                        xx49_54 <- dvCharsM-                        if id isSemi xx49_54-                         then return ()-                         else throwError (strMsg "not match")-                        case xx49_54 of-                            _ -> return ()-                        let _ = xx49_54-                        return ()-                        return (id mkDef v t sel)]-p_selection = msum [do ex <- dv_expressionHsM-                       return ()-                       _ <- dv_spacesM-                       return ()-                       xx50_55 <- dvCharsM-                       if id isSlash xx50_55-                        then return ()-                        else throwError (strMsg "not match")-                       case xx50_55 of-                           _ -> return ()-                       let _ = xx50_55-                       return ()-                       _ <- dv_spacesM-                       return ()-                       sel <- dv_selectionM-                       return ()-                       return (id cons ex sel),-                    do ex <- dv_expressionHsM-                       return ()-                       return (id cons ex empty)]-p_expressionHs = msum [do e <- dv_expressionM-                          return ()-                          _ <- dv_spacesM-                          return ()-                          xx51_56 <- dvCharsM-                          if id isOpenWave xx51_56-                           then return ()-                           else throwError (strMsg "not match")-                          case xx51_56 of-                              _ -> return ()-                          let _ = xx51_56-                          return ()-                          _ <- dv_spacesM-                          return ()-                          h <- dv_hsExpM-                          return ()-                          _ <- dv_spacesM-                          return ()-                          xx52_57 <- dvCharsM-                          if id isCloseWave xx52_57-                           then return ()-                           else throwError (strMsg "not match")-                          case xx52_57 of-                              _ -> return ()-                          let _ = xx52_57-                          return ()-                          return (id mkExpressionHs e h)]-p_expression = msum [do l <- dv_nameLeaf_M-                        return ()-                        _ <- dv_spacesM-                        return ()-                        e <- dv_expressionM-                        return ()-                        return (id cons l e),-                     do return (id empty)]-p_nameLeaf_ = msum [do xx53_58 <- dvCharsM-                       if id isNot xx53_58-                        then return ()-                        else throwError (strMsg "not match")-                       case xx53_58 of-                           _ -> return ()-                       let _ = xx53_58-                       return ()-                       nl <- dv_nameLeafM-                       return ()-                       return (id notAfter nl),-                    do nl <- dv_nameLeafM-                       return ()-                       return (id here nl)]-p_nameLeaf = msum [do n <- dv_patM-                      return ()-                      xx54_59 <- dvCharsM-                      if id isColon xx54_59-                       then return ()-                       else throwError (strMsg "not match")-                      case xx54_59 of-                          _ -> return ()-                      let _ = xx54_59-                      return ()-                      l <- dv_leafM-                      return ()-                      return (id mkNameLeaf n l),-                   do n <- dv_patM-                      return ()-                      return (id mkNameLeaf n ctLeaf)]-p_pat = msum [do xx55_60 <- dv_variableM-                 case xx55_60 of-                     "_" -> return ()-                     _ -> throwError (strMsg "not match")-                 "_" <- return xx55_60-                 return (id wildP),-              do n <- dv_variableM-                 return ()-                 return (id strToPatQ n),-              do t <- dv_typM-                 return ()-                 _ <- dv_spacesM-                 return ()-                 ps <- dv_patsM-                 return ()-                 return (id conToPatQ t ps),-              do xx56_61 <- dvCharsM-                 if id isChon xx56_61-                  then return ()-                  else throwError (strMsg "not match")-                 case xx56_61 of-                     _ -> return ()-                 let _ = xx56_61-                 return ()-                 c <- dv_charLitM-                 return ()-                 xx57_62 <- dvCharsM-                 if id isChon xx57_62-                  then return ()-                  else throwError (strMsg "not match")-                 case xx57_62 of-                     _ -> return ()-                 let _ = xx57_62-                 return ()-                 return (id charP c),-              do xx58_63 <- dvCharsM-                 if id isDQ xx58_63-                  then return ()-                  else throwError (strMsg "not match")-                 case xx58_63 of-                     _ -> return ()-                 let _ = xx58_63-                 return ()-                 s <- dv_stringLitM-                 return ()-                 xx59_64 <- dvCharsM-                 if id isDQ xx59_64-                  then return ()-                  else throwError (strMsg "not match")-                 case xx59_64 of-                     _ -> return ()-                 let _ = xx59_64-                 return ()-                 return (id stringP s)]-p_charLit = msum [do xx60_65 <- dvCharsM-                     if id isAlphaNumOt xx60_65-                      then return ()-                      else throwError (strMsg "not match")-                     case xx60_65 of-                         _ -> return ()-                     let c = xx60_65-                     return ()-                     return (id c),-                  do xx61_66 <- dvCharsM-                     if id isBS xx61_66-                      then return ()-                      else throwError (strMsg "not match")-                     case xx61_66 of-                         _ -> return ()-                     let _ = xx61_66-                     return ()-                     xx62_67 <- dvCharsM-                     if id elemNTs xx62_67-                      then return ()-                      else throwError (strMsg "not match")-                     case xx62_67 of-                         _ -> return ()-                     let c = xx62_67-                     return ()-                     return (id getNTs c)]-p_stringLit = msum [do d_68 <- get-                       flipMaybe (do _ <- dv_dqM-                                     return ())-                       put d_68-                       xx63_69 <- dvCharsM-                       if const True xx63_69-                        then return ()-                        else throwError (strMsg "not match")-                       case xx63_69 of-                           _ -> return ()-                       let c = xx63_69-                       return ()-                       s <- dv_stringLitM-                       return ()-                       return (id cons c s),-                    do return (id empty)]-p_dq = msum [do xx64_70 <- dvCharsM-                if const True xx64_70-                 then return ()-                 else throwError (strMsg "not match")-                case xx64_70 of-                    '"' -> return ()-                    _ -> throwError (strMsg "not match")-                let '"' = xx64_70-                return ()-                return (id nil)]-p_pats = msum [do p <- dv_patM-                  return ()-                  ps <- dv_patsM-                  return ()-                  return (id cons p ps),-               do return (id empty)]-p_leaf = msum [do t <- dv_testM-                  return ()-                  return (id left t),-               do v <- dv_variableM-                  return ()-                  return (id right v)]-p_test = msum [do xx65_71 <- dvCharsM-                  if id isOpenBr xx65_71-                   then return ()-                   else throwError (strMsg "not match")-                  case xx65_71 of-                      _ -> return ()-                  let _ = xx65_71-                  return ()-                  h <- dv_hsExpM-                  return ()-                  xx66_72 <- dvCharsM-                  if id isCloseBr xx66_72-                   then return ()-                   else throwError (strMsg "not match")-                  case xx66_72 of-                      _ -> return ()-                  let _ = xx66_72-                  return ()-                  return (id getEx h)]-p_hsExp = msum [do v <- dv_variableM-                   return ()-                   _ <- dv_spacesM-                   return ()-                   h <- dv_hsExpM-                   return ()-                   return (id apply v h),-                do v <- dv_variableM-                   return ()-                   return (id toExp v)]-p_typ = msum [do u <- dv_upperM-                 return ()-                 t <- dv_tvtailM-                 return ()-                 return (id cons u t)]-p_variable = msum [do l <- dv_lowerM-                      return ()-                      t <- dv_tvtailM-                      return ()-                      return (id cons l t)]-p_tvtail = msum [do a <- dv_alphaM-                    return ()-                    t <- dv_tvtailM-                    return ()-                    return (id cons a t),-                 do return (id empty)]-p_alpha = msum [do u <- dv_upperM-                   return ()-                   return (id u),-                do l <- dv_lowerM-                   return ()-                   return (id l),-                do d <- dv_digitM-                   return ()-                   return (id d)]-p_upper = msum [do xx67_73 <- dvCharsM-                   if id isUpper xx67_73-                    then return ()-                    else throwError (strMsg "not match")-                   case xx67_73 of-                       _ -> return ()-                   let u = xx67_73-                   return ()-                   return (id u)]-p_lower = msum [do xx68_74 <- dvCharsM-                   if id isLowerU xx68_74-                    then return ()-                    else throwError (strMsg "not match")-                   case xx68_74 of-                       _ -> return ()-                   let l = xx68_74-                   return ()-                   return (id l)]-p_digit = msum [do xx69_75 <- dvCharsM-                   if id isDigit xx69_75-                    then return ()-                    else throwError (strMsg "not match")-                   case xx69_75 of-                       _ -> return ()-                   let d = xx69_75-                   return ()-                   return (id d)]-p_spaces = msum [do _ <- dv_spaceM-                    return ()-                    _ <- dv_spacesM-                    return ()-                    return (id nil),-                 do return (id nil)]-p_space = msum [do xx70_76 <- dvCharsM-                   if id isSpace xx70_76-                    then return ()-                    else throwError (strMsg "not match")-                   case xx70_76 of-                       _ -> return ()-                   let _ = xx70_76-                   return ()-                   return (id nil),-                do xx71_77 <- dvCharsM-                   if const True xx71_77-                    then return ()-                    else throwError (strMsg "not match")-                   case xx71_77 of-                       '-' -> return ()-                       _ -> throwError (strMsg "not match")-                   let '-' = xx71_77-                   return ()-                   xx72_78 <- dvCharsM-                   if const True xx72_78-                    then return ()-                    else throwError (strMsg "not match")-                   case xx72_78 of-                       '-' -> return ()-                       _ -> throwError (strMsg "not match")-                   let '-' = xx72_78-                   return ()-                   _ <- dv_notNLStringM-                   return ()-                   _ <- dv_nlM-                   return ()-                   return (id nil),-                do _ <- dv_commentM-                   return ()-                   return (id nil)]-p_notNLString = msum [do d_79 <- get-                         flipMaybe (do _ <- dv_nlM-                                       return ())-                         put d_79-                         xx73_80 <- dvCharsM-                         if const True xx73_80-                          then return ()-                          else throwError (strMsg "not match")-                         case xx73_80 of-                             _ -> return ()-                         let c = xx73_80-                         return ()-                         s <- dv_notNLStringM-                         return ()-                         return (id cons c s),-                      do return (id empty)]-p_nl = msum [do xx74_81 <- dvCharsM-                if id isNL xx74_81-                 then return ()-                 else throwError (strMsg "not match")-                case xx74_81 of-                    _ -> return ()-                let _ = xx74_81-                return ()-                return (id nil)]-p_comment = msum [do xx75_82 <- dvCharsM-                     if const True xx75_82-                      then return ()-                      else throwError (strMsg "not match")-                     case xx75_82 of-                         '{' -> return ()-                         _ -> throwError (strMsg "not match")-                     let '{' = xx75_82-                     return ()-                     xx76_83 <- dvCharsM-                     if const True xx76_83-                      then return ()-                      else throwError (strMsg "not match")-                     case xx76_83 of-                         '-' -> return ()-                         _ -> throwError (strMsg "not match")-                     let '-' = xx76_83-                     return ()-                     d_84 <- get-                     flipMaybe (do xx77_85 <- dvCharsM-                                   if const True xx77_85-                                    then return ()-                                    else throwError (strMsg "not match")-                                   case xx77_85 of-                                       '#' -> return ()-                                       _ -> throwError (strMsg "not match")-                                   let '#' = xx77_85-                                   return ())-                     put d_84-                     _ <- dv_commentsM-                     return ()-                     _ <- dv_comEndM-                     return ()-                     return (id nil)]-p_comments = msum [do _ <- dv_notComStrM-                      return ()-                      _ <- dv_commentM-                      return ()-                      _ <- dv_commentsM-                      return ()-                      return (id nil),-                   do _ <- dv_notComStrM-                      return ()-                      return (id nil)]-p_notComStr = msum [do d_86 <- get-                       flipMaybe (do _ <- dv_commentM-                                     return ())-                       put d_86-                       d_87 <- get-                       flipMaybe (do _ <- dv_comEndM-                                     return ())-                       put d_87-                       xx78_88 <- dvCharsM-                       if const True xx78_88-                        then return ()-                        else throwError (strMsg "not match")-                       case xx78_88 of-                           _ -> return ()-                       let _ = xx78_88-                       return ()-                       _ <- dv_notComStrM-                       return ()-                       return (id nil),-                    do return (id nil)]-p_comEnd = msum [do xx79_89 <- dvCharsM-                    if const True xx79_89-                     then return ()-                     else throwError (strMsg "not match")-                    case xx79_89 of-                        '-' -> return ()-                        _ -> throwError (strMsg "not match")-                    let '-' = xx79_89-                    return ()-                    xx80_90 <- dvCharsM-                    if const True xx80_90-                     then return ()-                     else throwError (strMsg "not match")-                    case xx80_90 of-                        '}' -> return ()-                        _ -> throwError (strMsg "not match")-                    let '}' = xx80_90-                    return ()-                    return (id nil)]--class Source sl-    where type Token sl-          getToken :: sl -> Maybe ((Token sl, sl))-class SourceList c-    where listToken :: [c] -> Maybe ((c, [c]))-instance SourceList Char-    where listToken (c : s) = Just (c, s)-          listToken _ = Nothing-instance SourceList c => Source ([c])-    where type Token ([c]) = c-          getToken = listToken+{-# LANGUAGE FlexibleContexts, TemplateHaskell, UndecidableInstances, PackageImports, TypeFamilies, RankNTypes #-}+module Text.Papillon.Parser (+	Peg,+	Definition,+	Selection,+	ExpressionHs,+	NameLeaf(..),+	NameLeaf_(..),+	ReadFrom(..),+	parse,+	showNameLeaf,+	nameFromRF,+	ParseError(..),+	Derivs(peg, pegFile, derivsChars),+	Pos(..),+	ListPos(..),+	pePositionS,+	Source(..),+	SourceList(..),++	PPragma(..),+	ModuleName+)  where+import "monads-tf" Control.Monad.State+import "monads-tf" Control.Monad.Error++import Text.Papillon.Papillon++import Control.Applicative++++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))),+              pragmaStr2 :: (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], String)), Derivs))),+              moduleName :: (Either (ParseError (Pos String) Derivs)+                                    (([String], 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))),+              expressionHs :: (Either (ParseError (Pos String) Derivs)+                                      ((ExpressionHs, 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))),+              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))),+              derivsChars :: (Either (ParseError (Pos String) Derivs)+                                     ((Token String, Derivs))),+              derivsPosition :: (Pos String)}+parse :: String -> Derivs+parse = parse0_0 initialPos+          where parse0_0 pos s = d+                             where d = Derivs pegFile73_1 pragmas74_2 pragma75_3 pragmaStr276_4 pragmaItems77_5 pragmaEnd78_6 moduleDec79_7 moduleName80_8 moduleDecStr81_9 whr82_10 preImpPap83_11 prePeg84_12 afterPeg85_13 importPapillon86_14 varToken87_15 typToken88_16 pap89_17 peg90_18 sourceType91_19 peg_92_20 definition93_21 selection94_22 expressionHs95_23 expression96_24 nameLeaf_97_25 nameLeaf98_26 nameLeafNoCom99_27 comForErr100_28 leaf101_29 patOp102_30 pat103_31 pat1104_32 patList105_33 opConName106_34 charLit107_35 stringLit108_36 escapeC109_37 pats110_38 readFromLs111_39 readFrom112_40 test113_41 hsExpLam114_42 hsExpTyp115_43 hsExpOp116_44 hsOp117_45 opTail118_46 hsExp119_47 hsExp1120_48 hsExpTpl121_49 hsTypeArr122_50 hsType123_51 hsType1124_52 hsTypeTpl125_53 typ126_54 variable127_55 tvtail128_56 integer129_57 alpha130_58 upper131_59 lower132_60 digit133_61 spaces134_62 space135_63 notNLString136_64 newLine137_65 comment138_66 comments139_67 notComStr140_68 comEnd141_69 chars142_70 pos+                                   pegFile73_1 = runStateT pegFile4_71 d+                                   pragmas74_2 = runStateT pragmas5_72 d+                                   pragma75_3 = runStateT pragma6_73 d+                                   pragmaStr276_4 = runStateT pragmaStr27_74 d+                                   pragmaItems77_5 = runStateT pragmaItems8_75 d+                                   pragmaEnd78_6 = runStateT pragmaEnd9_76 d+                                   moduleDec79_7 = runStateT moduleDec10_77 d+                                   moduleName80_8 = runStateT moduleName11_78 d+                                   moduleDecStr81_9 = runStateT moduleDecStr12_79 d+                                   whr82_10 = runStateT whr13_80 d+                                   preImpPap83_11 = runStateT preImpPap14_81 d+                                   prePeg84_12 = runStateT prePeg15_82 d+                                   afterPeg85_13 = runStateT afterPeg16_83 d+                                   importPapillon86_14 = runStateT importPapillon17_84 d+                                   varToken87_15 = runStateT varToken18_85 d+                                   typToken88_16 = runStateT typToken19_86 d+                                   pap89_17 = runStateT pap20_87 d+                                   peg90_18 = runStateT peg21_88 d+                                   sourceType91_19 = runStateT sourceType22_89 d+                                   peg_92_20 = runStateT peg_23_90 d+                                   definition93_21 = runStateT definition24_91 d+                                   selection94_22 = runStateT selection25_92 d+                                   expressionHs95_23 = runStateT expressionHs26_93 d+                                   expression96_24 = runStateT expression27_94 d+                                   nameLeaf_97_25 = runStateT nameLeaf_28_95 d+                                   nameLeaf98_26 = runStateT nameLeaf29_96 d+                                   nameLeafNoCom99_27 = runStateT nameLeafNoCom30_97 d+                                   comForErr100_28 = runStateT comForErr31_98 d+                                   leaf101_29 = runStateT leaf32_99 d+                                   patOp102_30 = runStateT patOp33_100 d+                                   pat103_31 = runStateT pat34_101 d+                                   pat1104_32 = runStateT pat135_102 d+                                   patList105_33 = runStateT patList36_103 d+                                   opConName106_34 = runStateT opConName37_104 d+                                   charLit107_35 = runStateT charLit38_105 d+                                   stringLit108_36 = runStateT stringLit39_106 d+                                   escapeC109_37 = runStateT escapeC40_107 d+                                   pats110_38 = runStateT pats41_108 d+                                   readFromLs111_39 = runStateT readFromLs42_109 d+                                   readFrom112_40 = runStateT readFrom43_110 d+                                   test113_41 = runStateT test44_111 d+                                   hsExpLam114_42 = runStateT hsExpLam45_112 d+                                   hsExpTyp115_43 = runStateT hsExpTyp46_113 d+                                   hsExpOp116_44 = runStateT hsExpOp47_114 d+                                   hsOp117_45 = runStateT hsOp48_115 d+                                   opTail118_46 = runStateT opTail49_116 d+                                   hsExp119_47 = runStateT hsExp50_117 d+                                   hsExp1120_48 = runStateT hsExp151_118 d+                                   hsExpTpl121_49 = runStateT hsExpTpl52_119 d+                                   hsTypeArr122_50 = runStateT hsTypeArr53_120 d+                                   hsType123_51 = runStateT hsType54_121 d+                                   hsType1124_52 = runStateT hsType155_122 d+                                   hsTypeTpl125_53 = runStateT hsTypeTpl56_123 d+                                   typ126_54 = runStateT typ57_124 d+                                   variable127_55 = runStateT variable58_125 d+                                   tvtail128_56 = runStateT tvtail59_126 d+                                   integer129_57 = runStateT integer60_127 d+                                   alpha130_58 = runStateT alpha61_128 d+                                   upper131_59 = runStateT upper62_129 d+                                   lower132_60 = runStateT lower63_130 d+                                   digit133_61 = runStateT digit64_131 d+                                   spaces134_62 = runStateT spaces65_132 d+                                   space135_63 = runStateT space66_133 d+                                   notNLString136_64 = runStateT notNLString67_134 d+                                   newLine137_65 = runStateT newLine68_135 d+                                   comment138_66 = runStateT comment69_136 d+                                   comments139_67 = runStateT comments70_137 d+                                   notComStr140_68 = runStateT notComStr71_138 d+                                   comEnd141_69 = runStateT comEnd72_139 d+                                   chars142_70 = runStateT (case getToken s of+                                                                Just (c,+                                                                      s') -> do put (parse0_0 (updatePos c pos) s')+                                                                                return c+                                                                _ -> gets derivsPosition >>= (throwError . ParseError "" "end of input" "" undefined [])) d+                pegFile4_71 = 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 ()+                                               d160_140 <- get+                                               xx159_141 <- StateT derivsChars+                                               case xx159_141 of+                                                   '|' -> return ()+                                                   _ -> gets derivsPosition >>= (throwError . ParseError "'|'" "not match pattern: " "" d160_140 ["derivsChars"])+                                               let '|' = xx159_141+                                               return ()+                                               d162_142 <- get+                                               xx161_143 <- StateT derivsChars+                                               case xx161_143 of+                                                   ']' -> return ()+                                                   _ -> gets derivsPosition >>= (throwError . ParseError "']'" "not match pattern: " "" d162_142 ["derivsChars"])+                                               let ']' = xx161_143+                                               return ()+                                               d164_144 <- get+                                               xx163_145 <- StateT derivsChars+                                               case xx163_145 of+                                                   '\n' -> return ()+                                                   _ -> gets derivsPosition >>= (throwError . ParseError "'\\n'" "not match pattern: " "" d164_144 ["derivsChars"])+                                               let '\n' = xx163_145+                                               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 ()+                                               d180_146 <- get+                                               xx179_147 <- StateT derivsChars+                                               case xx179_147 of+                                                   '|' -> return ()+                                                   _ -> gets derivsPosition >>= (throwError . ParseError "'|'" "not match pattern: " "" d180_146 ["derivsChars"])+                                               let '|' = xx179_147+                                               return ()+                                               d182_148 <- get+                                               xx181_149 <- StateT derivsChars+                                               case xx181_149 of+                                                   ']' -> return ()+                                                   _ -> gets derivsPosition >>= (throwError . ParseError "']'" "not match pattern: " "" d182_148 ["derivsChars"])+                                               let ']' = xx181_149+                                               return ()+                                               d184_150 <- get+                                               xx183_151 <- StateT derivsChars+                                               case xx183_151 of+                                                   '\n' -> return ()+                                                   _ -> gets derivsPosition >>= (throwError . ParseError "'\\n'" "not match pattern: " "" d184_150 ["derivsChars"])+                                               let '\n' = xx183_151+                                               return ()+                                               atp <- StateT afterPeg+                                               return (mkPegFile pr md emp pp p atp)]+                pragmas5_72 = foldl1 mplus [do _ <- StateT spaces+                                               return ()+                                               pr <- StateT pragma+                                               prs <- StateT pragmas+                                               return (pr : prs),+                                            do _ <- StateT spaces+                                               return ()+                                               return []]+                pragma6_73 = foldl1 mplus [do d196_152 <- get+                                              xx195_153 <- StateT derivsChars+                                              case xx195_153 of+                                                  '{' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'{'" "not match pattern: " "" d196_152 ["derivsChars"])+                                              let '{' = xx195_153+                                              return ()+                                              d198_154 <- get+                                              xx197_155 <- StateT derivsChars+                                              case xx197_155 of+                                                  '-' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d198_154 ["derivsChars"])+                                              let '-' = xx197_155+                                              return ()+                                              d200_156 <- get+                                              xx199_157 <- StateT derivsChars+                                              case xx199_157 of+                                                  '#' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'#'" "not match pattern: " "" d200_156 ["derivsChars"])+                                              let '#' = xx199_157+                                              return ()+                                              _ <- StateT spaces+                                              return ()+                                              d204_158 <- get+                                              xx203_159 <- StateT derivsChars+                                              case xx203_159 of+                                                  'L' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'L'" "not match pattern: " "" d204_158 ["derivsChars"])+                                              let 'L' = xx203_159+                                              return ()+                                              d206_160 <- get+                                              xx205_161 <- StateT derivsChars+                                              case xx205_161 of+                                                  'A' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'A'" "not match pattern: " "" d206_160 ["derivsChars"])+                                              let 'A' = xx205_161+                                              return ()+                                              d208_162 <- get+                                              xx207_163 <- StateT derivsChars+                                              case xx207_163 of+                                                  'N' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'N'" "not match pattern: " "" d208_162 ["derivsChars"])+                                              let 'N' = xx207_163+                                              return ()+                                              d210_164 <- get+                                              xx209_165 <- StateT derivsChars+                                              case xx209_165 of+                                                  'G' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'G'" "not match pattern: " "" d210_164 ["derivsChars"])+                                              let 'G' = xx209_165+                                              return ()+                                              d212_166 <- get+                                              xx211_167 <- StateT derivsChars+                                              case xx211_167 of+                                                  'U' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'U'" "not match pattern: " "" d212_166 ["derivsChars"])+                                              let 'U' = xx211_167+                                              return ()+                                              d214_168 <- get+                                              xx213_169 <- StateT derivsChars+                                              case xx213_169 of+                                                  'A' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'A'" "not match pattern: " "" d214_168 ["derivsChars"])+                                              let 'A' = xx213_169+                                              return ()+                                              d216_170 <- get+                                              xx215_171 <- StateT derivsChars+                                              case xx215_171 of+                                                  'G' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'G'" "not match pattern: " "" d216_170 ["derivsChars"])+                                              let 'G' = xx215_171+                                              return ()+                                              d218_172 <- get+                                              xx217_173 <- StateT derivsChars+                                              case xx217_173 of+                                                  'E' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'E'" "not match pattern: " "" d218_172 ["derivsChars"])+                                              let 'E' = xx217_173+                                              return ()+                                              _ <- StateT spaces+                                              return ()+                                              s <- StateT pragmaItems+                                              _ <- StateT pragmaEnd+                                              return ()+                                              _ <- StateT spaces+                                              return ()+                                              return (LanguagePragma s),+                                           do d228_174 <- get+                                              xx227_175 <- StateT derivsChars+                                              case xx227_175 of+                                                  '{' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'{'" "not match pattern: " "" d228_174 ["derivsChars"])+                                              let '{' = xx227_175+                                              return ()+                                              d230_176 <- get+                                              xx229_177 <- StateT derivsChars+                                              case xx229_177 of+                                                  '-' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d230_176 ["derivsChars"])+                                              let '-' = xx229_177+                                              return ()+                                              d232_178 <- get+                                              xx231_179 <- StateT derivsChars+                                              case xx231_179 of+                                                  '#' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'#'" "not match pattern: " "" d232_178 ["derivsChars"])+                                              let '#' = xx231_179+                                              return ()+                                              _ <- StateT spaces+                                              return ()+                                              s <- StateT pragmaStr2+                                              _ <- StateT pragmaEnd+                                              return ()+                                              return (OtherPragma s)]+                pragmaStr27_74 = foldl1 mplus [do ddd239_180 <- get+                                                  do err <- ((do _ <- StateT pragmaEnd+                                                                 return ()) >> return False) `catchError` const (return True)+                                                     unless err (gets derivsPosition >>= (throwError . ParseError ('!' : "_:pragmaEnd") "not match: " "" ddd239_180 ["pragmaEnd"]))+                                                  put ddd239_180+                                                  c <- StateT derivsChars+                                                  s <- StateT pragmaStr2+                                                  return (c : s),+                                               return ""]+                pragmaItems8_75 = foldl1 mplus [do t <- StateT typToken+                                                   d249_181 <- get+                                                   xx248_182 <- StateT derivsChars+                                                   case xx248_182 of+                                                       ',' -> return ()+                                                       _ -> gets derivsPosition >>= (throwError . ParseError "','" "not match pattern: " "" d249_181 ["derivsChars"])+                                                   let ',' = xx248_182+                                                   return ()+                                                   _ <- StateT spaces+                                                   return ()+                                                   i <- StateT pragmaItems+                                                   return (t : i),+                                                do t <- StateT typToken+                                                   return [t]]+                pragmaEnd9_76 = foldl1 mplus [do _ <- StateT spaces+                                                 return ()+                                                 d259_183 <- get+                                                 xx258_184 <- StateT derivsChars+                                                 case xx258_184 of+                                                     '#' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'#'" "not match pattern: " "" d259_183 ["derivsChars"])+                                                 let '#' = xx258_184+                                                 return ()+                                                 d261_185 <- get+                                                 xx260_186 <- StateT derivsChars+                                                 case xx260_186 of+                                                     '-' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d261_185 ["derivsChars"])+                                                 let '-' = xx260_186+                                                 return ()+                                                 d263_187 <- get+                                                 xx262_188 <- StateT derivsChars+                                                 case xx262_188 of+                                                     '}' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'}'" "not match pattern: " "" d263_187 ["derivsChars"])+                                                 let '}' = xx262_188+                                                 return ()+                                                 return ()]+                moduleDec10_77 = foldl1 mplus [do d265_189 <- get+                                                  xx264_190 <- StateT derivsChars+                                                  case xx264_190 of+                                                      'm' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'m'" "not match pattern: " "" d265_189 ["derivsChars"])+                                                  let 'm' = xx264_190+                                                  return ()+                                                  d267_191 <- get+                                                  xx266_192 <- StateT derivsChars+                                                  case xx266_192 of+                                                      'o' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'o'" "not match pattern: " "" d267_191 ["derivsChars"])+                                                  let 'o' = xx266_192+                                                  return ()+                                                  d269_193 <- get+                                                  xx268_194 <- StateT derivsChars+                                                  case xx268_194 of+                                                      'd' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'d'" "not match pattern: " "" d269_193 ["derivsChars"])+                                                  let 'd' = xx268_194+                                                  return ()+                                                  d271_195 <- get+                                                  xx270_196 <- StateT derivsChars+                                                  case xx270_196 of+                                                      'u' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'u'" "not match pattern: " "" d271_195 ["derivsChars"])+                                                  let 'u' = xx270_196+                                                  return ()+                                                  d273_197 <- get+                                                  xx272_198 <- StateT derivsChars+                                                  case xx272_198 of+                                                      'l' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'l'" "not match pattern: " "" d273_197 ["derivsChars"])+                                                  let 'l' = xx272_198+                                                  return ()+                                                  d275_199 <- get+                                                  xx274_200 <- StateT derivsChars+                                                  case xx274_200 of+                                                      'e' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'e'" "not match pattern: " "" d275_199 ["derivsChars"])+                                                  let 'e' = xx274_200+                                                  return ()+                                                  _ <- StateT spaces+                                                  return ()+                                                  n <- StateT moduleName+                                                  s <- StateT moduleDecStr+                                                  _ <- StateT whr+                                                  return ()+                                                  return (Just (n, s)),+                                               return Nothing]+                moduleName11_78 = foldl1 mplus [do t <- StateT typ+                                                   d287_201 <- get+                                                   xx286_202 <- StateT derivsChars+                                                   case xx286_202 of+                                                       '.' -> return ()+                                                       _ -> gets derivsPosition >>= (throwError . ParseError "'.'" "not match pattern: " "" d287_201 ["derivsChars"])+                                                   let '.' = xx286_202+                                                   return ()+                                                   n <- StateT moduleName+                                                   return (t : n),+                                                do t <- StateT typ+                                                   return [t]]+                moduleDecStr12_79 = foldl1 mplus [do ddd292_203 <- get+                                                     do err <- ((do _ <- StateT whr+                                                                    return ()) >> return False) `catchError` const (return True)+                                                        unless err (gets derivsPosition >>= (throwError . ParseError ('!' : "_:whr") "not match: " "" ddd292_203 ["whr"]))+                                                     put ddd292_203+                                                     c <- StateT derivsChars+                                                     s <- StateT moduleDecStr+                                                     return (c : s),+                                                  return ""]+                whr13_80 = foldl1 mplus [do d300_204 <- get+                                            xx299_205 <- StateT derivsChars+                                            case xx299_205 of+                                                'w' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'w'" "not match pattern: " "" d300_204 ["derivsChars"])+                                            let 'w' = xx299_205+                                            return ()+                                            d302_206 <- get+                                            xx301_207 <- StateT derivsChars+                                            case xx301_207 of+                                                'h' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'h'" "not match pattern: " "" d302_206 ["derivsChars"])+                                            let 'h' = xx301_207+                                            return ()+                                            d304_208 <- get+                                            xx303_209 <- StateT derivsChars+                                            case xx303_209 of+                                                'e' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'e'" "not match pattern: " "" d304_208 ["derivsChars"])+                                            let 'e' = xx303_209+                                            return ()+                                            d306_210 <- get+                                            xx305_211 <- StateT derivsChars+                                            case xx305_211 of+                                                'r' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'r'" "not match pattern: " "" d306_210 ["derivsChars"])+                                            let 'r' = xx305_211+                                            return ()+                                            d308_212 <- get+                                            xx307_213 <- StateT derivsChars+                                            case xx307_213 of+                                                'e' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'e'" "not match pattern: " "" d308_212 ["derivsChars"])+                                            let 'e' = xx307_213+                                            return ()+                                            return ()]+                preImpPap14_81 = foldl1 mplus [do ddd309_214 <- get+                                                  do err <- ((do _ <- StateT importPapillon+                                                                 return ()) >> return False) `catchError` const (return True)+                                                     unless err (gets derivsPosition >>= (throwError . ParseError ('!' : "_:importPapillon") "not match: " "" ddd309_214 ["importPapillon"]))+                                                  put ddd309_214+                                                  ddd312_215 <- get+                                                  do err <- ((do _ <- StateT pap+                                                                 return ()) >> return False) `catchError` const (return True)+                                                     unless err (gets derivsPosition >>= (throwError . ParseError ('!' : "_:pap") "not match: " "" ddd312_215 ["pap"]))+                                                  put ddd312_215+                                                  c <- StateT derivsChars+                                                  pip <- StateT preImpPap+                                                  return (cons c pip),+                                               return emp]+                prePeg15_82 = foldl1 mplus [do ddd319_216 <- get+                                               do err <- ((do _ <- StateT pap+                                                              return ()) >> return False) `catchError` const (return True)+                                                  unless err (gets derivsPosition >>= (throwError . ParseError ('!' : "_:pap") "not match: " "" ddd319_216 ["pap"]))+                                               put ddd319_216+                                               c <- StateT derivsChars+                                               pp <- StateT prePeg+                                               return (cons c pp),+                                            return emp]+                afterPeg16_83 = foldl1 mplus [do c <- StateT derivsChars+                                                 atp <- StateT afterPeg+                                                 return (cons c atp),+                                              return emp]+                importPapillon17_84 = foldl1 mplus [do d331_217 <- get+                                                       xx330_218 <- StateT varToken+                                                       case xx330_218 of+                                                           "import" -> return ()+                                                           _ -> gets derivsPosition >>= (throwError . ParseError "\"import\"" "not match pattern: " "" d331_217 ["varToken"])+                                                       let "import" = xx330_218+                                                       return ()+                                                       d333_219 <- get+                                                       xx332_220 <- StateT typToken+                                                       case xx332_220 of+                                                           "Text" -> return ()+                                                           _ -> gets derivsPosition >>= (throwError . ParseError "\"Text\"" "not match pattern: " "" d333_219 ["typToken"])+                                                       let "Text" = xx332_220+                                                       return ()+                                                       d335_221 <- get+                                                       xx334_222 <- StateT derivsChars+                                                       case xx334_222 of+                                                           '.' -> return ()+                                                           _ -> gets derivsPosition >>= (throwError . ParseError "'.'" "not match pattern: " "" d335_221 ["derivsChars"])+                                                       let '.' = xx334_222+                                                       return ()+                                                       _ <- StateT spaces+                                                       return ()+                                                       d339_223 <- get+                                                       xx338_224 <- StateT typToken+                                                       case xx338_224 of+                                                           "Papillon" -> return ()+                                                           _ -> gets derivsPosition >>= (throwError . ParseError "\"Papillon\"" "not match pattern: " "" d339_223 ["typToken"])+                                                       let "Papillon" = xx338_224+                                                       return ()+                                                       ddd340_225 <- get+                                                       do err <- ((do d342_226 <- get+                                                                      xx341_227 <- StateT derivsChars+                                                                      case xx341_227 of+                                                                          '.' -> return ()+                                                                          _ -> gets derivsPosition >>= (throwError . ParseError "'.'" "not match pattern: " "" d342_226 ["derivsChars"])+                                                                      let '.' = xx341_227+                                                                      return ()) >> return False) `catchError` const (return True)+                                                          unless err (gets derivsPosition >>= (throwError . ParseError ('!' : "'.':") "not match: " "" ddd340_225 ["derivsChars"]))+                                                       put ddd340_225+                                                       return ()]+                varToken18_85 = foldl1 mplus [do v <- StateT variable+                                                 _ <- StateT spaces+                                                 return ()+                                                 return v]+                typToken19_86 = foldl1 mplus [do t <- StateT typ+                                                 _ <- StateT spaces+                                                 return ()+                                                 return t]+                pap20_87 = foldl1 mplus [do d352_228 <- get+                                            xx351_229 <- StateT derivsChars+                                            case xx351_229 of+                                                '\n' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'\\n'" "not match pattern: " "" d352_228 ["derivsChars"])+                                            let '\n' = xx351_229+                                            return ()+                                            d354_230 <- get+                                            xx353_231 <- StateT derivsChars+                                            case xx353_231 of+                                                '[' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'['" "not match pattern: " "" d354_230 ["derivsChars"])+                                            let '[' = xx353_231+                                            return ()+                                            d356_232 <- get+                                            xx355_233 <- StateT derivsChars+                                            case xx355_233 of+                                                'p' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'p'" "not match pattern: " "" d356_232 ["derivsChars"])+                                            let 'p' = xx355_233+                                            return ()+                                            d358_234 <- get+                                            xx357_235 <- StateT derivsChars+                                            case xx357_235 of+                                                'a' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'a'" "not match pattern: " "" d358_234 ["derivsChars"])+                                            let 'a' = xx357_235+                                            return ()+                                            d360_236 <- get+                                            xx359_237 <- StateT derivsChars+                                            case xx359_237 of+                                                'p' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'p'" "not match pattern: " "" d360_236 ["derivsChars"])+                                            let 'p' = xx359_237+                                            return ()+                                            d362_238 <- get+                                            xx361_239 <- StateT derivsChars+                                            case xx361_239 of+                                                'i' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'i'" "not match pattern: " "" d362_238 ["derivsChars"])+                                            let 'i' = xx361_239+                                            return ()+                                            d364_240 <- get+                                            xx363_241 <- StateT derivsChars+                                            case xx363_241 of+                                                'l' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'l'" "not match pattern: " "" d364_240 ["derivsChars"])+                                            let 'l' = xx363_241+                                            return ()+                                            d366_242 <- get+                                            xx365_243 <- StateT derivsChars+                                            case xx365_243 of+                                                'l' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'l'" "not match pattern: " "" d366_242 ["derivsChars"])+                                            let 'l' = xx365_243+                                            return ()+                                            d368_244 <- get+                                            xx367_245 <- StateT derivsChars+                                            case xx367_245 of+                                                'o' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'o'" "not match pattern: " "" d368_244 ["derivsChars"])+                                            let 'o' = xx367_245+                                            return ()+                                            d370_246 <- get+                                            xx369_247 <- StateT derivsChars+                                            case xx369_247 of+                                                'n' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'n'" "not match pattern: " "" d370_246 ["derivsChars"])+                                            let 'n' = xx369_247+                                            return ()+                                            d372_248 <- get+                                            xx371_249 <- StateT derivsChars+                                            case xx371_249 of+                                                '|' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'|'" "not match pattern: " "" d372_248 ["derivsChars"])+                                            let '|' = xx371_249+                                            return ()+                                            d374_250 <- get+                                            xx373_251 <- StateT derivsChars+                                            case xx373_251 of+                                                '\n' -> return ()+                                                _ -> gets derivsPosition >>= (throwError . ParseError "'\\n'" "not match pattern: " "" d374_250 ["derivsChars"])+                                            let '\n' = xx373_251+                                            return ()+                                            return ()]+                peg21_88 = 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_89 = foldl1 mplus [do d384_252 <- get+                                                   xx383_253 <- StateT varToken+                                                   case xx383_253 of+                                                       "source" -> return ()+                                                       _ -> gets derivsPosition >>= (throwError . ParseError "\"source\"" "not match pattern: " "" d384_252 ["varToken"])+                                                   let "source" = xx383_253+                                                   return ()+                                                   d386_254 <- get+                                                   xx385_255 <- StateT derivsChars+                                                   case xx385_255 of+                                                       ':' -> return ()+                                                       _ -> gets derivsPosition >>= (throwError . ParseError "':'" "not match pattern: " "" d386_254 ["derivsChars"])+                                                   let ':' = xx385_255+                                                   return ()+                                                   _ <- StateT spaces+                                                   return ()+                                                   v <- StateT typToken+                                                   return v]+                peg_23_90 = foldl1 mplus [do _ <- StateT spaces+                                             return ()+                                             d <- StateT definition+                                             p <- StateT peg_+                                             return (cons d p),+                                          return emp]+                definition24_91 = foldl1 mplus [do v <- StateT variable+                                                   _ <- StateT spaces+                                                   return ()+                                                   d402_256 <- get+                                                   xx401_257 <- StateT derivsChars+                                                   case xx401_257 of+                                                       ':' -> return ()+                                                       _ -> gets derivsPosition >>= (throwError . ParseError "':'" "not match pattern: " "" d402_256 ["derivsChars"])+                                                   let ':' = xx401_257+                                                   return ()+                                                   d404_258 <- get+                                                   xx403_259 <- StateT derivsChars+                                                   case xx403_259 of+                                                       ':' -> return ()+                                                       _ -> gets derivsPosition >>= (throwError . ParseError "':'" "not match pattern: " "" d404_258 ["derivsChars"])+                                                   let ':' = xx403_259+                                                   return ()+                                                   _ <- StateT spaces+                                                   return ()+                                                   t <- StateT hsTypeArr+                                                   _ <- StateT spaces+                                                   return ()+                                                   d412_260 <- get+                                                   xx411_261 <- StateT derivsChars+                                                   case xx411_261 of+                                                       '=' -> return ()+                                                       _ -> gets derivsPosition >>= (throwError . ParseError "'='" "not match pattern: " "" d412_260 ["derivsChars"])+                                                   let '=' = xx411_261+                                                   return ()+                                                   _ <- StateT spaces+                                                   return ()+                                                   sel <- StateT selection+                                                   _ <- StateT spaces+                                                   return ()+                                                   d420_262 <- get+                                                   xx419_263 <- StateT derivsChars+                                                   case xx419_263 of+                                                       ';' -> return ()+                                                       _ -> gets derivsPosition >>= (throwError . ParseError "';'" "not match pattern: " "" d420_262 ["derivsChars"])+                                                   let ';' = xx419_263+                                                   return ()+                                                   return (mkDef v t sel)]+                selection25_92 = foldl1 mplus [do ex <- StateT expressionHs+                                                  _ <- StateT spaces+                                                  return ()+                                                  d426_264 <- get+                                                  xx425_265 <- StateT derivsChars+                                                  case xx425_265 of+                                                      '/' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'/'" "not match pattern: " "" d426_264 ["derivsChars"])+                                                  let '/' = xx425_265+                                                  return ()+                                                  _ <- StateT spaces+                                                  return ()+                                                  sel <- StateT selection+                                                  return (cons ex sel),+                                               do ex <- StateT expressionHs+                                                  return (cons ex emp)]+                expressionHs26_93 = foldl1 mplus [do e <- StateT expression+                                                     _ <- StateT spaces+                                                     return ()+                                                     d438_266 <- get+                                                     xx437_267 <- StateT derivsChars+                                                     case xx437_267 of+                                                         '{' -> return ()+                                                         _ -> gets derivsPosition >>= (throwError . ParseError "'{'" "not match pattern: " "" d438_266 ["derivsChars"])+                                                     let '{' = xx437_267+                                                     return ()+                                                     _ <- StateT spaces+                                                     return ()+                                                     h <- StateT hsExpLam+                                                     _ <- StateT spaces+                                                     return ()+                                                     d446_268 <- get+                                                     xx445_269 <- StateT derivsChars+                                                     case xx445_269 of+                                                         '}' -> return ()+                                                         _ -> gets derivsPosition >>= (throwError . ParseError "'}'" "not match pattern: " "" d446_268 ["derivsChars"])+                                                     let '}' = xx445_269+                                                     return ()+                                                     return (mkExpressionHs e h)]+                expression27_94 = foldl1 mplus [do l <- StateT nameLeaf_+                                                   _ <- StateT spaces+                                                   return ()+                                                   e <- StateT expression+                                                   return (cons l e),+                                                return emp]+                nameLeaf_28_95 = foldl1 mplus [do d454_270 <- get+                                                  xx453_271 <- StateT derivsChars+                                                  case xx453_271 of+                                                      '!' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'!'" "not match pattern: " "" d454_270 ["derivsChars"])+                                                  let '!' = xx453_271+                                                  return ()+                                                  nl <- StateT nameLeafNoCom+                                                  _ <- StateT spaces+                                                  return ()+                                                  com <- optional3_272 (StateT comForErr)+                                                  return (NotAfter nl $ maybe "" id com),+                                               do d462_273 <- get+                                                  xx461_274 <- StateT derivsChars+                                                  let c = xx461_274+                                                  unless (isAmp c) (gets derivsPosition >>= (throwError . ParseError "isAmp c" "not match: " "" d462_273 ["derivsChars"]))+                                                  nl <- StateT nameLeaf+                                                  return (After nl),+                                               do nl <- StateT nameLeaf+                                                  return (Here nl)]+                nameLeaf29_96 = foldl1 mplus [do n <- StateT pat1+                                                 _ <- StateT spaces+                                                 return ()+                                                 com <- optional3_272 (StateT comForErr)+                                                 d474_275 <- get+                                                 xx473_276 <- StateT derivsChars+                                                 case xx473_276 of+                                                     ':' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "':'" "not match pattern: " "" d474_275 ["derivsChars"])+                                                 let ':' = xx473_276+                                                 return ()+                                                 (rf, p) <- StateT leaf+                                                 return (NameLeaf (n, maybe "" id com) rf p),+                                              do n <- StateT pat1+                                                 _ <- StateT spaces+                                                 return ()+                                                 com <- optional3_272 (StateT comForErr)+                                                 return (NameLeaf (n,+                                                                   maybe "" id com) FromToken Nothing)]+                nameLeafNoCom30_97 = foldl1 mplus [do n <- StateT pat1+                                                      _ <- StateT spaces+                                                      return ()+                                                      com <- optional3_272 (StateT comForErr)+                                                      d490_277 <- get+                                                      xx489_278 <- StateT derivsChars+                                                      case xx489_278 of+                                                          ':' -> return ()+                                                          _ -> gets derivsPosition >>= (throwError . ParseError "':'" "not match pattern: " "" d490_277 ["derivsChars"])+                                                      let ':' = xx489_278+                                                      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)]+                comForErr31_98 = foldl1 mplus [do d498_279 <- get+                                                  xx497_280 <- StateT derivsChars+                                                  case xx497_280 of+                                                      '{' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'{'" "not match pattern: " "" d498_279 ["derivsChars"])+                                                  let '{' = xx497_280+                                                  return ()+                                                  d500_281 <- get+                                                  xx499_282 <- StateT derivsChars+                                                  case xx499_282 of+                                                      '-' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d500_281 ["derivsChars"])+                                                  let '-' = xx499_282+                                                  return ()+                                                  d502_283 <- get+                                                  xx501_284 <- StateT derivsChars+                                                  case xx501_284 of+                                                      '#' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'#'" "not match pattern: " "" d502_283 ["derivsChars"])+                                                  let '#' = xx501_284+                                                  return ()+                                                  _ <- StateT spaces+                                                  return ()+                                                  d506_285 <- get+                                                  xx505_286 <- StateT derivsChars+                                                  case xx505_286 of+                                                      '"' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'\"'" "not match pattern: " "" d506_285 ["derivsChars"])+                                                  let '"' = xx505_286+                                                  return ()+                                                  s <- StateT stringLit+                                                  d510_287 <- get+                                                  xx509_288 <- StateT derivsChars+                                                  case xx509_288 of+                                                      '"' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'\"'" "not match pattern: " "" d510_287 ["derivsChars"])+                                                  let '"' = xx509_288+                                                  return ()+                                                  _ <- StateT spaces+                                                  return ()+                                                  d514_289 <- get+                                                  xx513_290 <- StateT derivsChars+                                                  case xx513_290 of+                                                      '#' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'#'" "not match pattern: " "" d514_289 ["derivsChars"])+                                                  let '#' = xx513_290+                                                  return ()+                                                  d516_291 <- get+                                                  xx515_292 <- StateT derivsChars+                                                  case xx515_292 of+                                                      '-' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d516_291 ["derivsChars"])+                                                  let '-' = xx515_292+                                                  return ()+                                                  d518_293 <- get+                                                  xx517_294 <- StateT derivsChars+                                                  case xx517_294 of+                                                      '}' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'}'" "not match pattern: " "" d518_293 ["derivsChars"])+                                                  let '}' = xx517_294+                                                  return ()+                                                  _ <- StateT spaces+                                                  return ()+                                                  return s]+                leaf32_99 = 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)]+                patOp33_100 = foldl1 mplus [do p <- StateT pat+                                               o <- StateT opConName+                                               po <- StateT patOp+                                               return (uInfixP p o po),+                                            do p <- StateT pat+                                               _ <- StateT spaces+                                               return ()+                                               d540_295 <- get+                                               xx539_296 <- StateT derivsChars+                                               let q = xx539_296+                                               unless (isBQ q) (gets derivsPosition >>= (throwError . ParseError "isBQ q" "not match: " "" d540_295 ["derivsChars"]))+                                               t <- StateT typ+                                               d544_297 <- get+                                               xx543_298 <- StateT derivsChars+                                               let q_ = xx543_298+                                               unless (isBQ q_) (gets derivsPosition >>= (throwError . ParseError "isBQ q_" "not match: " "" d544_297 ["derivsChars"]))+                                               _ <- StateT spaces+                                               return ()+                                               po <- StateT patOp+                                               return (uInfixP p (mkName t) po),+                                            do p <- StateT pat+                                               return p]+                pat34_101 = foldl1 mplus [do t <- StateT typ+                                             _ <- StateT spaces+                                             return ()+                                             ps <- StateT pats+                                             return (conToPatQ t ps),+                                          do d558_299 <- get+                                             xx557_300 <- StateT derivsChars+                                             case xx557_300 of+                                                 '(' -> return ()+                                                 _ -> gets derivsPosition >>= (throwError . ParseError "'('" "not match pattern: " "" d558_299 ["derivsChars"])+                                             let '(' = xx557_300+                                             return ()+                                             o <- StateT opConName+                                             d562_301 <- get+                                             xx561_302 <- StateT derivsChars+                                             case xx561_302 of+                                                 ')' -> return ()+                                                 _ -> gets derivsPosition >>= (throwError . ParseError "')'" "not match pattern: " "" d562_301 ["derivsChars"])+                                             let ')' = xx561_302+                                             return ()+                                             _ <- StateT spaces+                                             return ()+                                             ps <- StateT pats+                                             return (conP o ps),+                                          do p <- StateT pat1+                                             return p]+                pat135_102 = foldl1 mplus [do t <- StateT typ+                                              return (conToPatQ t emp),+                                           do d572_303 <- get+                                              xx571_304 <- StateT variable+                                              case xx571_304 of+                                                  "_" -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "\"_\"" "not match pattern: " "" d572_303 ["variable"])+                                              let "_" = xx571_304+                                              return ()+                                              return wildP,+                                           do n <- StateT variable+                                              return (strToPatQ n),+                                           do i <- StateT integer+                                              return (litP (integerL i)),+                                           do d578_305 <- get+                                              xx577_306 <- StateT derivsChars+                                              case xx577_306 of+                                                  '-' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d578_305 ["derivsChars"])+                                              let '-' = xx577_306+                                              return ()+                                              _ <- StateT spaces+                                              return ()+                                              i <- StateT integer+                                              return (litP (integerL $ negate i)),+                                           do d584_307 <- get+                                              xx583_308 <- StateT derivsChars+                                              case xx583_308 of+                                                  '\'' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'\\''" "not match pattern: " "" d584_307 ["derivsChars"])+                                              let '\'' = xx583_308+                                              return ()+                                              c <- StateT charLit+                                              d588_309 <- get+                                              xx587_310 <- StateT derivsChars+                                              case xx587_310 of+                                                  '\'' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'\\''" "not match pattern: " "" d588_309 ["derivsChars"])+                                              let '\'' = xx587_310+                                              return ()+                                              return (charP c),+                                           do d590_311 <- get+                                              xx589_312 <- StateT derivsChars+                                              case xx589_312 of+                                                  '"' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'\"'" "not match pattern: " "" d590_311 ["derivsChars"])+                                              let '"' = xx589_312+                                              return ()+                                              s <- StateT stringLit+                                              d594_313 <- get+                                              xx593_314 <- StateT derivsChars+                                              case xx593_314 of+                                                  '"' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'\"'" "not match pattern: " "" d594_313 ["derivsChars"])+                                              let '"' = xx593_314+                                              return ()+                                              return (stringP s),+                                           do d596_315 <- get+                                              xx595_316 <- StateT derivsChars+                                              case xx595_316 of+                                                  '(' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'('" "not match pattern: " "" d596_315 ["derivsChars"])+                                              let '(' = xx595_316+                                              return ()+                                              p <- StateT patList+                                              d600_317 <- get+                                              xx599_318 <- StateT derivsChars+                                              case xx599_318 of+                                                  ')' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "')'" "not match pattern: " "" d600_317 ["derivsChars"])+                                              let ')' = xx599_318+                                              return ()+                                              return (tupP p),+                                           do d602_319 <- get+                                              xx601_320 <- StateT derivsChars+                                              case xx601_320 of+                                                  '[' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'['" "not match pattern: " "" d602_319 ["derivsChars"])+                                              let '[' = xx601_320+                                              return ()+                                              p <- StateT patList+                                              d606_321 <- get+                                              xx605_322 <- StateT derivsChars+                                              case xx605_322 of+                                                  ']' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "']'" "not match pattern: " "" d606_321 ["derivsChars"])+                                              let ']' = xx605_322+                                              return ()+                                              return (listP p)]+                patList36_103 = foldl1 mplus [do p <- StateT patOp+                                                 _ <- StateT spaces+                                                 return ()+                                                 d612_323 <- get+                                                 xx611_324 <- StateT derivsChars+                                                 case xx611_324 of+                                                     ',' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "','" "not match pattern: " "" d612_323 ["derivsChars"])+                                                 let ',' = xx611_324+                                                 return ()+                                                 _ <- StateT spaces+                                                 return ()+                                                 ps <- StateT patList+                                                 return (p : ps),+                                              do p <- StateT patOp+                                                 return [p],+                                              return []]+                opConName37_104 = foldl1 mplus [do d620_325 <- get+                                                   xx619_326 <- StateT derivsChars+                                                   case xx619_326 of+                                                       ':' -> return ()+                                                       _ -> gets derivsPosition >>= (throwError . ParseError "':'" "not match pattern: " "" d620_325 ["derivsChars"])+                                                   let ':' = xx619_326+                                                   return ()+                                                   ot <- StateT opTail+                                                   return (mkName $ colon : ot)]+                charLit38_105 = foldl1 mplus [do d624_327 <- get+                                                 xx623_328 <- StateT derivsChars+                                                 let c = xx623_328+                                                 unless (isAlphaNumOt c) (gets derivsPosition >>= (throwError . ParseError "isAlphaNumOt c" "not match: " "" d624_327 ["derivsChars"]))+                                                 return c,+                                              do d626_329 <- get+                                                 xx625_330 <- StateT derivsChars+                                                 case xx625_330 of+                                                     '\\' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'\\\\'" "not match pattern: " "" d626_329 ["derivsChars"])+                                                 let '\\' = xx625_330+                                                 return ()+                                                 c <- StateT escapeC+                                                 return c]+                stringLit39_106 = foldl1 mplus [do d630_331 <- get+                                                   xx629_332 <- StateT derivsChars+                                                   let c = xx629_332+                                                   unless (isStrLitC c) (gets derivsPosition >>= (throwError . ParseError "isStrLitC c" "not match: " "" d630_331 ["derivsChars"]))+                                                   s <- StateT stringLit+                                                   return (cons c s),+                                                do d634_333 <- get+                                                   xx633_334 <- StateT derivsChars+                                                   case xx633_334 of+                                                       '\\' -> return ()+                                                       _ -> gets derivsPosition >>= (throwError . ParseError "'\\\\'" "not match pattern: " "" d634_333 ["derivsChars"])+                                                   let '\\' = xx633_334+                                                   return ()+                                                   c <- StateT escapeC+                                                   s <- StateT stringLit+                                                   return (c : s),+                                                return emp]+                escapeC40_107 = foldl1 mplus [do d640_335 <- get+                                                 xx639_336 <- StateT derivsChars+                                                 case xx639_336 of+                                                     '"' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'\"'" "not match pattern: " "" d640_335 ["derivsChars"])+                                                 let '"' = xx639_336+                                                 return ()+                                                 return '"',+                                              do d642_337 <- get+                                                 xx641_338 <- StateT derivsChars+                                                 case xx641_338 of+                                                     '\'' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'\\''" "not match pattern: " "" d642_337 ["derivsChars"])+                                                 let '\'' = xx641_338+                                                 return ()+                                                 return '\'',+                                              do d644_339 <- get+                                                 xx643_340 <- StateT derivsChars+                                                 case xx643_340 of+                                                     '\\' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'\\\\'" "not match pattern: " "" d644_339 ["derivsChars"])+                                                 let '\\' = xx643_340+                                                 return ()+                                                 return '\\',+                                              do d646_341 <- get+                                                 xx645_342 <- StateT derivsChars+                                                 case xx645_342 of+                                                     'n' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'n'" "not match pattern: " "" d646_341 ["derivsChars"])+                                                 let 'n' = xx645_342+                                                 return ()+                                                 return '\n',+                                              do d648_343 <- get+                                                 xx647_344 <- StateT derivsChars+                                                 case xx647_344 of+                                                     't' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'t'" "not match pattern: " "" d648_343 ["derivsChars"])+                                                 let 't' = xx647_344+                                                 return ()+                                                 return tab]+                pats41_108 = foldl1 mplus [do p <- StateT pat+                                              _ <- StateT spaces+                                              return ()+                                              ps <- StateT pats+                                              return (cons p ps),+                                           return emp]+                readFromLs42_109 = foldl1 mplus [do rf <- StateT readFrom+                                                    d658_345 <- get+                                                    xx657_346 <- StateT derivsChars+                                                    case xx657_346 of+                                                        '*' -> return ()+                                                        _ -> gets derivsPosition >>= (throwError . ParseError "'*'" "not match pattern: " "" d658_345 ["derivsChars"])+                                                    let '*' = xx657_346+                                                    return ()+                                                    return (FromList rf),+                                                 do rf <- StateT readFrom+                                                    d662_347 <- get+                                                    xx661_348 <- StateT derivsChars+                                                    case xx661_348 of+                                                        '+' -> return ()+                                                        _ -> gets derivsPosition >>= (throwError . ParseError "'+'" "not match pattern: " "" d662_347 ["derivsChars"])+                                                    let '+' = xx661_348+                                                    return ()+                                                    return (FromList1 rf),+                                                 do rf <- StateT readFrom+                                                    d666_349 <- get+                                                    xx665_350 <- StateT derivsChars+                                                    case xx665_350 of+                                                        '?' -> return ()+                                                        _ -> gets derivsPosition >>= (throwError . ParseError "'?'" "not match pattern: " "" d666_349 ["derivsChars"])+                                                    let '?' = xx665_350+                                                    return ()+                                                    return (FromOptional rf),+                                                 do rf <- StateT readFrom+                                                    return rf]+                readFrom43_110 = foldl1 mplus [do v <- StateT variable+                                                  return (FromVariable v),+                                               do d672_351 <- get+                                                  xx671_352 <- StateT derivsChars+                                                  case xx671_352 of+                                                      '(' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'('" "not match pattern: " "" d672_351 ["derivsChars"])+                                                  let '(' = xx671_352+                                                  return ()+                                                  s <- StateT selection+                                                  d676_353 <- get+                                                  xx675_354 <- StateT derivsChars+                                                  case xx675_354 of+                                                      ')' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "')'" "not match pattern: " "" d676_353 ["derivsChars"])+                                                  let ')' = xx675_354+                                                  return ()+                                                  return (FromSelection s)]+                test44_111 = foldl1 mplus [do d678_355 <- get+                                              xx677_356 <- StateT derivsChars+                                              case xx677_356 of+                                                  '[' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "'['" "not match pattern: " "" d678_355 ["derivsChars"])+                                              let '[' = xx677_356+                                              return ()+                                              h <- StateT hsExpLam+                                              _ <- StateT spaces+                                              return ()+                                              com <- optional3_272 (StateT comForErr)+                                              d686_357 <- get+                                              xx685_358 <- StateT derivsChars+                                              case xx685_358 of+                                                  ']' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "']'" "not match pattern: " "" d686_357 ["derivsChars"])+                                              let ']' = xx685_358+                                              return ()+                                              return (h, maybe "" id com)]+                hsExpLam45_112 = foldl1 mplus [do d688_359 <- get+                                                  xx687_360 <- StateT derivsChars+                                                  case xx687_360 of+                                                      '\\' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'\\\\'" "not match pattern: " "" d688_359 ["derivsChars"])+                                                  let '\\' = xx687_360+                                                  return ()+                                                  _ <- StateT spaces+                                                  return ()+                                                  ps <- StateT pats+                                                  _ <- StateT spaces+                                                  return ()+                                                  d696_361 <- get+                                                  xx695_362 <- StateT derivsChars+                                                  case xx695_362 of+                                                      '-' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d696_361 ["derivsChars"])+                                                  let '-' = xx695_362+                                                  return ()+                                                  d698_363 <- get+                                                  xx697_364 <- StateT derivsChars+                                                  let c = xx697_364+                                                  unless (isGt c) (gets derivsPosition >>= (throwError . ParseError "isGt c" "not match: " "" d698_363 ["derivsChars"]))+                                                  _ <- StateT spaces+                                                  return ()+                                                  e <- StateT hsExpTyp+                                                  return (lamE ps e),+                                               do e <- StateT hsExpTyp+                                                  return e]+                hsExpTyp46_113 = foldl1 mplus [do eo <- StateT hsExpOp+                                                  d708_365 <- get+                                                  xx707_366 <- StateT derivsChars+                                                  case xx707_366 of+                                                      ':' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "':'" "not match pattern: " "" d708_365 ["derivsChars"])+                                                  let ':' = xx707_366+                                                  return ()+                                                  d710_367 <- get+                                                  xx709_368 <- StateT derivsChars+                                                  case xx709_368 of+                                                      ':' -> return ()+                                                      _ -> gets derivsPosition >>= (throwError . ParseError "':'" "not match pattern: " "" d710_367 ["derivsChars"])+                                                  let ':' = xx709_368+                                                  return ()+                                                  _ <- StateT spaces+                                                  return ()+                                                  t <- StateT hsTypeArr+                                                  return (sigE eo t),+                                               do eo <- StateT hsExpOp+                                                  return eo]+                hsExpOp47_114 = 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)]+                hsOp48_115 = foldl1 mplus [do d730_369 <- get+                                              xx729_370 <- StateT derivsChars+                                              let c = xx729_370+                                              unless (isOpHeadChar c) (gets derivsPosition >>= (throwError . ParseError "isOpHeadChar c" "not match: " "" d730_369 ["derivsChars"]))+                                              o <- StateT opTail+                                              return (varE (mkName (cons c o))),+                                           do d734_371 <- get+                                              xx733_372 <- StateT derivsChars+                                              case xx733_372 of+                                                  ':' -> return ()+                                                  _ -> gets derivsPosition >>= (throwError . ParseError "':'" "not match pattern: " "" d734_371 ["derivsChars"])+                                              let ':' = xx733_372+                                              return ()+                                              ddd735_373 <- get+                                              do err <- ((do d737_374 <- get+                                                             xx736_375 <- StateT derivsChars+                                                             case xx736_375 of+                                                                 ':' -> return ()+                                                                 _ -> gets derivsPosition >>= (throwError . ParseError "':'" "not match pattern: " "" d737_374 ["derivsChars"])+                                                             let ':' = xx736_375+                                                             return ()) >> return False) `catchError` const (return True)+                                                 unless err (gets derivsPosition >>= (throwError . ParseError ('!' : "':':") "not match: " "" ddd735_373 ["derivsChars"]))+                                              put ddd735_373+                                              o <- StateT opTail+                                              return (conE (mkName (':' : o))),+                                           do d741_376 <- get+                                              xx740_377 <- StateT derivsChars+                                              let c = xx740_377+                                              unless (isBQ c) (gets derivsPosition >>= (throwError . ParseError "isBQ c" "not match: " "" d741_376 ["derivsChars"]))+                                              v <- StateT variable+                                              d745_378 <- get+                                              xx744_379 <- StateT derivsChars+                                              let c_ = xx744_379+                                              unless (isBQ c_) (gets derivsPosition >>= (throwError . ParseError "isBQ c_" "not match: " "" d745_378 ["derivsChars"]))+                                              return (varE (mkName v)),+                                           do d747_380 <- get+                                              xx746_381 <- StateT derivsChars+                                              let c = xx746_381+                                              unless (isBQ c) (gets derivsPosition >>= (throwError . ParseError "isBQ c" "not match: " "" d747_380 ["derivsChars"]))+                                              t <- StateT typ+                                              d751_382 <- get+                                              xx750_383 <- StateT derivsChars+                                              let c_ = xx750_383+                                              unless (isBQ c_) (gets derivsPosition >>= (throwError . ParseError "isBQ c_" "not match: " "" d751_382 ["derivsChars"]))+                                              return (conE (mkName t))]+                opTail49_116 = foldl1 mplus [do d753_384 <- get+                                                xx752_385 <- StateT derivsChars+                                                let c = xx752_385+                                                unless (isOpTailChar c) (gets derivsPosition >>= (throwError . ParseError "isOpTailChar c" "not match: " "" d753_384 ["derivsChars"]))+                                                s <- StateT opTail+                                                return (cons c s),+                                             return emp]+                hsExp50_117 = foldl1 mplus [do e <- StateT hsExp1+                                               _ <- StateT spaces+                                               return ()+                                               h <- StateT hsExp+                                               return (applyExR e h),+                                            do e <- StateT hsExp1+                                               return (toEx e)]+                hsExp151_118 = foldl1 mplus [do d765_386 <- get+                                                xx764_387 <- StateT derivsChars+                                                case xx764_387 of+                                                    '(' -> return ()+                                                    _ -> gets derivsPosition >>= (throwError . ParseError "'('" "not match pattern: " "" d765_386 ["derivsChars"])+                                                let '(' = xx764_387+                                                return ()+                                                l <- optional3_272 (foldl1 mplus [do e <- StateT hsExpTyp+                                                                                     return e])+                                                _ <- StateT spaces+                                                return ()+                                                o <- StateT hsOp+                                                _ <- StateT spaces+                                                return ()+                                                r <- optional3_272 (foldl1 mplus [do e <- StateT hsExpTyp+                                                                                     return e])+                                                d781_388 <- get+                                                xx780_389 <- StateT derivsChars+                                                case xx780_389 of+                                                    ')' -> return ()+                                                    _ -> gets derivsPosition >>= (throwError . ParseError "')'" "not match pattern: " "" d781_388 ["derivsChars"])+                                                let ')' = xx780_389+                                                return ()+                                                return (infixE l o r),+                                             do d783_390 <- get+                                                xx782_391 <- StateT derivsChars+                                                case xx782_391 of+                                                    '(' -> return ()+                                                    _ -> gets derivsPosition >>= (throwError . ParseError "'('" "not match pattern: " "" d783_390 ["derivsChars"])+                                                let '(' = xx782_391+                                                return ()+                                                et <- StateT hsExpTpl+                                                d787_392 <- get+                                                xx786_393 <- StateT derivsChars+                                                case xx786_393 of+                                                    ')' -> return ()+                                                    _ -> gets derivsPosition >>= (throwError . ParseError "')'" "not match pattern: " "" d787_392 ["derivsChars"])+                                                let ')' = xx786_393+                                                return ()+                                                return (tupE et),+                                             do d789_394 <- get+                                                xx788_395 <- StateT derivsChars+                                                case xx788_395 of+                                                    '[' -> return ()+                                                    _ -> gets derivsPosition >>= (throwError . ParseError "'['" "not match pattern: " "" d789_394 ["derivsChars"])+                                                let '[' = xx788_395+                                                return ()+                                                et <- StateT hsExpTpl+                                                d793_396 <- get+                                                xx792_397 <- StateT derivsChars+                                                case xx792_397 of+                                                    ']' -> return ()+                                                    _ -> gets derivsPosition >>= (throwError . ParseError "']'" "not match pattern: " "" d793_396 ["derivsChars"])+                                                let ']' = xx792_397+                                                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 d803_398 <- get+                                                xx802_399 <- StateT derivsChars+                                                case xx802_399 of+                                                    '\'' -> return ()+                                                    _ -> gets derivsPosition >>= (throwError . ParseError "'\\''" "not match pattern: " "" d803_398 ["derivsChars"])+                                                let '\'' = xx802_399+                                                return ()+                                                c <- StateT charLit+                                                d807_400 <- get+                                                xx806_401 <- StateT derivsChars+                                                case xx806_401 of+                                                    '\'' -> return ()+                                                    _ -> gets derivsPosition >>= (throwError . ParseError "'\\''" "not match pattern: " "" d807_400 ["derivsChars"])+                                                let '\'' = xx806_401+                                                return ()+                                                return (litE (charL c)),+                                             do d809_402 <- get+                                                xx808_403 <- StateT derivsChars+                                                case xx808_403 of+                                                    '"' -> return ()+                                                    _ -> gets derivsPosition >>= (throwError . ParseError "'\"'" "not match pattern: " "" d809_402 ["derivsChars"])+                                                let '"' = xx808_403+                                                return ()+                                                s <- StateT stringLit+                                                d813_404 <- get+                                                xx812_405 <- StateT derivsChars+                                                case xx812_405 of+                                                    '"' -> return ()+                                                    _ -> gets derivsPosition >>= (throwError . ParseError "'\"'" "not match pattern: " "" d813_404 ["derivsChars"])+                                                let '"' = xx812_405+                                                return ()+                                                return (litE (stringL s)),+                                             do d815_406 <- get+                                                xx814_407 <- StateT derivsChars+                                                case xx814_407 of+                                                    '-' -> return ()+                                                    _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d815_406 ["derivsChars"])+                                                let '-' = xx814_407+                                                return ()+                                                _ <- StateT spaces+                                                return ()+                                                e <- StateT hsExp1+                                                return (appE (varE $ mkName "negate") e)]+                hsExpTpl52_119 = foldl1 mplus [do e <- StateT hsExpLam+                                                  _ <- StateT spaces+                                                  return ()+                                                  d825_408 <- get+                                                  xx824_409 <- StateT derivsChars+                                                  let c = xx824_409+                                                  unless (isComma c) (gets derivsPosition >>= (throwError . ParseError "isComma c" "not match: " "" d825_408 ["derivsChars"]))+                                                  _ <- StateT spaces+                                                  return ()+                                                  et <- StateT hsExpTpl+                                                  return (cons e et),+                                               do e <- StateT hsExpLam+                                                  return (cons e emp),+                                               return emp]+                hsTypeArr53_120 = foldl1 mplus [do l <- StateT hsType+                                                   d835_410 <- get+                                                   xx834_411 <- StateT derivsChars+                                                   case xx834_411 of+                                                       '-' -> return ()+                                                       _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d835_410 ["derivsChars"])+                                                   let '-' = xx834_411+                                                   return ()+                                                   d837_412 <- get+                                                   xx836_413 <- StateT derivsChars+                                                   let c = xx836_413+                                                   unless (isGt c) (gets derivsPosition >>= (throwError . ParseError "isGt c" "not match: " "" d837_412 ["derivsChars"]))+                                                   _ <- StateT spaces+                                                   return ()+                                                   r <- StateT hsTypeArr+                                                   return (appT (appT arrowT (getTyp l)) r),+                                                do t <- StateT hsType+                                                   return (getTyp t)]+                hsType54_121 = foldl1 mplus [do t <- StateT hsType1+                                                ts <- StateT hsType+                                                return (applyTyp (toTyp t) ts),+                                             do t <- StateT hsType1+                                                return (toTyp t)]+                hsType155_122 = foldl1 mplus [do d851_414 <- get+                                                 xx850_415 <- StateT derivsChars+                                                 case xx850_415 of+                                                     '[' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'['" "not match pattern: " "" d851_414 ["derivsChars"])+                                                 let '[' = xx850_415+                                                 return ()+                                                 d853_416 <- get+                                                 xx852_417 <- StateT derivsChars+                                                 case xx852_417 of+                                                     ']' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "']'" "not match pattern: " "" d853_416 ["derivsChars"])+                                                 let ']' = xx852_417+                                                 return ()+                                                 _ <- StateT spaces+                                                 return ()+                                                 return listT,+                                              do d857_418 <- get+                                                 xx856_419 <- StateT derivsChars+                                                 case xx856_419 of+                                                     '[' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'['" "not match pattern: " "" d857_418 ["derivsChars"])+                                                 let '[' = xx856_419+                                                 return ()+                                                 t <- StateT hsTypeArr+                                                 d861_420 <- get+                                                 xx860_421 <- StateT derivsChars+                                                 case xx860_421 of+                                                     ']' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "']'" "not match pattern: " "" d861_420 ["derivsChars"])+                                                 let ']' = xx860_421+                                                 return ()+                                                 _ <- StateT spaces+                                                 return ()+                                                 return (appT listT t),+                                              do d865_422 <- get+                                                 xx864_423 <- StateT derivsChars+                                                 case xx864_423 of+                                                     '(' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'('" "not match pattern: " "" d865_422 ["derivsChars"])+                                                 let '(' = xx864_423+                                                 return ()+                                                 _ <- StateT spaces+                                                 return ()+                                                 tt <- StateT hsTypeTpl+                                                 d871_424 <- get+                                                 xx870_425 <- StateT derivsChars+                                                 case xx870_425 of+                                                     ')' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "')'" "not match pattern: " "" d871_424 ["derivsChars"])+                                                 let ')' = xx870_425+                                                 return ()+                                                 return (tupT tt),+                                              do t <- StateT typToken+                                                 return (conT (mkName t)),+                                              do d875_426 <- get+                                                 xx874_427 <- StateT derivsChars+                                                 case xx874_427 of+                                                     '(' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'('" "not match pattern: " "" d875_426 ["derivsChars"])+                                                 let '(' = xx874_427+                                                 return ()+                                                 d877_428 <- get+                                                 xx876_429 <- StateT derivsChars+                                                 case xx876_429 of+                                                     '-' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d877_428 ["derivsChars"])+                                                 let '-' = xx876_429+                                                 return ()+                                                 d879_430 <- get+                                                 xx878_431 <- StateT derivsChars+                                                 let c = xx878_431+                                                 unless (isGt c) (gets derivsPosition >>= (throwError . ParseError "isGt c" "not match: " "" d879_430 ["derivsChars"]))+                                                 d881_432 <- get+                                                 xx880_433 <- StateT derivsChars+                                                 case xx880_433 of+                                                     ')' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "')'" "not match pattern: " "" d881_432 ["derivsChars"])+                                                 let ')' = xx880_433+                                                 return ()+                                                 _ <- StateT spaces+                                                 return ()+                                                 return arrowT]+                hsTypeTpl56_123 = foldl1 mplus [do t <- StateT hsTypeArr+                                                   d887_434 <- get+                                                   xx886_435 <- StateT derivsChars+                                                   let c = xx886_435+                                                   unless (isComma c) (gets derivsPosition >>= (throwError . ParseError "isComma c" "not match: " "" d887_434 ["derivsChars"]))+                                                   _ <- StateT spaces+                                                   return ()+                                                   tt <- StateT hsTypeTpl+                                                   return (cons t tt),+                                                do t <- StateT hsTypeArr+                                                   return (cons t emp),+                                                return emp]+                typ57_124 = foldl1 mplus [do u <- StateT upper+                                             t <- StateT tvtail+                                             return (cons u t)]+                variable58_125 = foldl1 mplus [do l <- StateT lower+                                                  t <- StateT tvtail+                                                  return (cons l t)]+                tvtail59_126 = foldl1 mplus [do a <- StateT alpha+                                                t <- StateT tvtail+                                                return (cons a t),+                                             return emp]+                integer60_127 = foldl1 mplus [do dh <- StateT digit+                                                 ds <- list1_436 (foldl1 mplus [do d <- StateT digit+                                                                                   return d])+                                                 return (read (cons dh ds))]+                alpha61_128 = foldl1 mplus [do u <- StateT upper+                                               return u,+                                            do l <- StateT lower+                                               return l,+                                            do d <- StateT digit+                                               return d,+                                            do d919_437 <- get+                                               xx918_438 <- StateT derivsChars+                                               case xx918_438 of+                                                   '\'' -> return ()+                                                   _ -> gets derivsPosition >>= (throwError . ParseError "'\\''" "not match pattern: " "" d919_437 ["derivsChars"])+                                               let '\'' = xx918_438+                                               return ()+                                               return '\'']+                upper62_129 = foldl1 mplus [do d921_439 <- get+                                               xx920_440 <- StateT derivsChars+                                               let u = xx920_440+                                               unless (isUpper u) (gets derivsPosition >>= (throwError . ParseError "isUpper u" "not match: " "" d921_439 ["derivsChars"]))+                                               return u]+                lower63_130 = foldl1 mplus [do d923_441 <- get+                                               xx922_442 <- StateT derivsChars+                                               let l = xx922_442+                                               unless (isLowerU l) (gets derivsPosition >>= (throwError . ParseError "isLowerU l" "not match: " "" d923_441 ["derivsChars"]))+                                               return l]+                digit64_131 = foldl1 mplus [do d925_443 <- get+                                               xx924_444 <- StateT derivsChars+                                               let d = xx924_444+                                               unless (isDigit d) (gets derivsPosition >>= (throwError . ParseError "isDigit d" "not match: " "" d925_443 ["derivsChars"]))+                                               return d]+                spaces65_132 = foldl1 mplus [do _ <- StateT space+                                                return ()+                                                _ <- StateT spaces+                                                return ()+                                                return (),+                                             return ()]+                space66_133 = foldl1 mplus [do d931_445 <- get+                                               xx930_446 <- StateT derivsChars+                                               let s = xx930_446+                                               unless (isSpace s) (gets derivsPosition >>= (throwError . ParseError "isSpace s" "not match: " "" d931_445 ["derivsChars"]))+                                               return (),+                                            do d933_447 <- get+                                               xx932_448 <- StateT derivsChars+                                               case xx932_448 of+                                                   '-' -> return ()+                                                   _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d933_447 ["derivsChars"])+                                               let '-' = xx932_448+                                               return ()+                                               d935_449 <- get+                                               xx934_450 <- StateT derivsChars+                                               case xx934_450 of+                                                   '-' -> return ()+                                                   _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d935_449 ["derivsChars"])+                                               let '-' = xx934_450+                                               return ()+                                               _ <- StateT notNLString+                                               return ()+                                               _ <- StateT newLine+                                               return ()+                                               return (),+                                            do _ <- StateT comment+                                               return ()+                                               return ()]+                notNLString67_134 = foldl1 mplus [do ddd942_451 <- get+                                                     do err <- ((do _ <- StateT newLine+                                                                    return ()) >> return False) `catchError` const (return True)+                                                        unless err (gets derivsPosition >>= (throwError . ParseError ('!' : "_:newLine") "not match: " "" ddd942_451 ["newLine"]))+                                                     put ddd942_451+                                                     c <- StateT derivsChars+                                                     s <- StateT notNLString+                                                     return (cons c s),+                                                  return emp]+                newLine68_135 = foldl1 mplus [do d950_452 <- get+                                                 xx949_453 <- StateT derivsChars+                                                 case xx949_453 of+                                                     '\n' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'\\n'" "not match pattern: " "" d950_452 ["derivsChars"])+                                                 let '\n' = xx949_453+                                                 return ()+                                                 return ()]+                comment69_136 = foldl1 mplus [do d952_454 <- get+                                                 xx951_455 <- StateT derivsChars+                                                 case xx951_455 of+                                                     '{' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'{'" "not match pattern: " "" d952_454 ["derivsChars"])+                                                 let '{' = xx951_455+                                                 return ()+                                                 d954_456 <- get+                                                 xx953_457 <- StateT derivsChars+                                                 case xx953_457 of+                                                     '-' -> return ()+                                                     _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d954_456 ["derivsChars"])+                                                 let '-' = xx953_457+                                                 return ()+                                                 ddd955_458 <- get+                                                 do err <- ((do d957_459 <- get+                                                                xx956_460 <- StateT derivsChars+                                                                case xx956_460 of+                                                                    '#' -> return ()+                                                                    _ -> gets derivsPosition >>= (throwError . ParseError "'#'" "not match pattern: " "" d957_459 ["derivsChars"])+                                                                let '#' = xx956_460+                                                                return ()) >> return False) `catchError` const (return True)+                                                    unless err (gets derivsPosition >>= (throwError . ParseError ('!' : "'#':") "not match: " "" ddd955_458 ["derivsChars"]))+                                                 put ddd955_458+                                                 _ <- StateT comments+                                                 return ()+                                                 _ <- StateT comEnd+                                                 return ()+                                                 return ()]+                comments70_137 = foldl1 mplus [do _ <- StateT notComStr+                                                  return ()+                                                  _ <- StateT comment+                                                  return ()+                                                  _ <- StateT comments+                                                  return ()+                                                  return (),+                                               do _ <- StateT notComStr+                                                  return ()+                                                  return ()]+                notComStr71_138 = foldl1 mplus [do ddd970_461 <- get+                                                   do err <- ((do _ <- StateT comment+                                                                  return ()) >> return False) `catchError` const (return True)+                                                      unless err (gets derivsPosition >>= (throwError . ParseError ('!' : "_:comment") "not match: " "" ddd970_461 ["comment"]))+                                                   put ddd970_461+                                                   ddd973_462 <- get+                                                   do err <- ((do _ <- StateT comEnd+                                                                  return ()) >> return False) `catchError` const (return True)+                                                      unless err (gets derivsPosition >>= (throwError . ParseError ('!' : "_:comEnd") "not match: " "" ddd973_462 ["comEnd"]))+                                                   put ddd973_462+                                                   _ <- StateT derivsChars+                                                   return ()+                                                   _ <- StateT notComStr+                                                   return ()+                                                   return (),+                                                return ()]+                comEnd72_139 = foldl1 mplus [do d981_463 <- get+                                                xx980_464 <- StateT derivsChars+                                                case xx980_464 of+                                                    '-' -> return ()+                                                    _ -> gets derivsPosition >>= (throwError . ParseError "'-'" "not match pattern: " "" d981_463 ["derivsChars"])+                                                let '-' = xx980_464+                                                return ()+                                                d983_465 <- get+                                                xx982_466 <- StateT derivsChars+                                                case xx982_466 of+                                                    '}' -> return ()+                                                    _ -> gets derivsPosition >>= (throwError . ParseError "'}'" "not match pattern: " "" d983_465 ["derivsChars"])+                                                let '}' = xx982_466+                                                return ()+                                                return ()]+                list1_436 :: forall m a . (MonadPlus m, Applicative m) =>+                                          m a -> m ([a])+                list12_467 :: forall m a . (MonadPlus m, Applicative m) =>+                                           m a -> m ([a])+                list1_436 p = list12_467 p `mplus` return []+                list12_467 p = ((:) <$> p) <*> list1_436 p+                optional3_272 :: forall m a . (MonadPlus m, Applicative m) =>+                                              m a -> m (Maybe a)+                optional3_272 p = (Just <$> p) `mplus` return Nothing+

@@ -0,0 +1,229 @@+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+	| FromList ReadFrom+	| FromList1 ReadFrom+	| FromOptional ReadFrom++nameFromRF :: ReadFrom -> [String]+nameFromRF (FromVariable s) = [s]+nameFromRF FromToken = ["derivsChars"]+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 (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++type Expression = [NameLeaf_]++showExpression :: Expression -> Q String+showExpression ex = unwords <$> mapM showNameLeaf_ ex++nameFromExpression :: Expression -> [String]+nameFromExpression = nameFromNameLeaf_ . head++type ExpressionHs = (Expression, ExR)++showExpressionHs :: ExpressionHs -> Q String+showExpressionHs (ex, hs) = do+	expp <- showExpression ex+	hss <- hs+	return $ expp ++ " { " ++ show (ppr hss) ++ " }"++nameFromExpressionHs :: ExpressionHs -> [String]+nameFromExpressionHs = nameFromExpression . fst++type Selection = [ExpressionHs]++showSelection :: Selection -> Q String+showSelection ehss = intercalate " / " <$> mapM showExpressionHs ehss++nameFromSelection :: Selection -> [String]+nameFromSelection = concatMap nameFromExpressionHs++type Definition = (String, TypeQ, Selection)+type Peg = [Definition]+type TTPeg = (TypeQ, TypeQ, Peg)++type Ex = (ExpQ -> ExpQ) -> ExpQ+type ExR = ExpQ+type ExRL = [ExpQ]++type Typ = (TypeQ -> TypeQ) -> TypeQ+type TypeQL = [TypeQ]++tupT :: [TypeQ] -> TypeQ+tupT ts = foldl appT (tupleT $ length ts) ts++getTyp :: Typ -> TypeQ+getTyp t = t id++toTyp :: TypeQ -> Typ+toTyp tp f = f tp++ctLeaf_ :: PatQ -> NameLeaf+ctLeaf_ n = NameLeaf (n, "") FromToken Nothing++true :: ExpQ+true = conE $ mkName "True"++just :: a -> Maybe a+just = Just+nothing :: Maybe a+nothing = Nothing++cons :: a -> [a] -> [a]+cons = (:)++type PatQs = [PatQ]++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 :: a -> TypeQ -> c -> (a, TypeQ, c)+mkDef x y z = (x, y, z)++isOpTailChar :: Char -> Bool+isOpTailChar = (`elem` ":+*/-!|&.^=<>$")++colon :: Char+colon = ':'++isOpHeadChar :: Char -> Bool+isOpHeadChar = (`elem` "+*/-!|&.^=<>$")++toExp :: String -> Ex+toExp v f = f $ varE (mkName v)++toEx :: ExR -> Ex+toEx v f = f v++apply :: String -> Ex -> Ex+apply f x g = x (toExp f g `appE`)++applyExR :: ExR -> Ex -> Ex+applyExR f x g = x (toEx f g `appE`)++applyTyp :: Typ -> Typ -> Typ+applyTyp f t g = t (f g `appT`)++getEx :: Ex -> ExR+getEx ex = ex id++toExGetEx :: Ex -> Ex+toExGetEx = toEx . getEx++emp :: [a]+emp = []++type PegFile = ([PPragma], ModuleName, String, String, TTPeg, String)+data PPragma = LanguagePragma [String] | OtherPragma String deriving Show+type ModuleName = [String]++addModules :: String+addModules =+	"import \"monads-tf\" Control.Monad.State\n" +++	"import \"monads-tf\" Control.Monad.Error\n"++correctMD :: ([String], String) -> String+correctMD (n, o) = intercalate "." n ++ o+mkPegFile :: [PPragma] -> Maybe ([String], String) -> String -> String ->+	TTPeg -> String -> PegFile+mkPegFile ps (Just md) x y z w = (+	ps,+	fst md,+	snd md ++ " where\n" +++	addModules,+	x ++ "\n" ++ y, z, w)+mkPegFile ps Nothing x y z w =+	(ps, [], 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)

@@ -0,0 +1,427 @@+{-# LANGUAGE TemplateHaskell, PackageImports, TypeFamilies, FlexibleContexts,+	FlexibleInstances #-}++module Text.PapillonCore (+	papillonCore,+	papillonFile,+	PPragma(..),++	Source(..),+	SourceList(..),+	ParseError(..),+	Pos(..),+	ListPos(..),+	pePositionS,+) where++import Language.Haskell.TH+import "monads-tf" Control.Monad.State+import "monads-tf" Control.Monad.Error++import Control.Applicative++import Text.Papillon.Parser+import Data.IORef+-- import Data.List++import Text.Papillon.List++isOptionalUsed :: Peg -> Bool+isOptionalUsed = any isOptionalUsedDefinition++isOptionalUsedDefinition :: Definition -> Bool+isOptionalUsedDefinition (_, _, sel) = any isOptionalUsedSelection sel++isOptionalUsedSelection :: ExpressionHs -> Bool+isOptionalUsedSelection = any isOptionalUsedLeafName . fst++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 sel) = any isOptionalUsedSelection sel+isOptionalUsedReadFrom _ = False++isListUsed :: Peg -> Bool+isListUsed = any isListUsedDefinition++isListUsedDefinition :: Definition -> Bool+isListUsedDefinition (_, _, sel) = any isListUsedSelection sel++isListUsedSelection :: ExpressionHs -> Bool+isListUsedSelection = any isListUsedLeafName . fst++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++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"++eitherN :: Name+eitherN = mkName "Either"++papillonCore :: String -> DecsQ+papillonCore str = case peg $ parse str of+	Right ((src, tkn, parsed), _) -> decParsed True src tkn parsed+	Left err -> error $ "parse error: " ++ showParseError err++papillonFile :: String ->+	([PPragma], ModuleName, String, String, DecsQ, String, Bool)+papillonFile str = case pegFile $ parse str of+	Right ((prgm, mn, ppp, pp, (src, tkn, parsed), atp), _) ->+		(prgm, mn, ppp, pp, decParsed False src tkn parsed, atp,+			needApplicative parsed)+	Left err -> error $ "parse error: " ++ showParseError err+	where+	needApplicative pg = isListUsed pg || isOptionalUsed pg++showParseError :: ParseError (Pos String) Derivs -> String+showParseError (ParseError c m _ d ns (ListPos (CharPos p))) =+	unwords (map (showReading d) ns) ++ (if null ns then "" else " ") +++	m ++ c ++ " at position: " ++ show p++showReading :: Derivs -> String -> String+showReading d "derivsChars" = case derivsChars d of+	Right (c, _) -> show c+	Left _ -> error "bad"+showReading _ n = "yet: " ++ n++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]++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 . \(n, _, _) -> n) pg++	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 [])++dvCharsN, dvPosN :: Name+dvCharsN = mkName "derivsChars"+dvPosN = mkName "derivsPosition"++derivs :: Bool -> TypeQ -> TypeQ -> Peg -> DecQ+derivs _ src tkn pegg = dataD (cxt []) (mkName "Derivs") [] [+	recC (mkName "Derivs") $ map (derivs1 src) pegg ++ [+		varStrictType dvCharsN $ strictType notStrict $+			resultT src tkn,+		varStrictType dvPosN $ strictType notStrict $+			conT (mkName "Pos") `appT` src+	 ]+ ] []++derivs1 :: TypeQ -> Definition -> VarStrictTypeQ+derivs1 src (name, typ, _) =+	varStrictType (mkName name) $ strictType notStrict $ resultT src typ++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 ".")+		(conE (mkName "ParseError")+			`appE` code+			`appE` msg+			`appE` com+			`appE` d+			`appE` ns))++resultT :: TypeQ -> TypeQ -> TypeQ+resultT src typ =+	conT eitherN `appT` pe `appT`+		(tupleT 2 `appT` typ `appT` conT (mkName "Derivs"))+	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")++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+	where+	names = map (\(n, _, _) -> n) pegg+parseE' :: IORef Int -> Bool -> Name -> [Name] -> [Name] -> ClauseQ+parseE' g th pgn tmps pnames = 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"]+	 ] ++ zipWith (parseE1 th) tmps pnames ++ [parseChar th pgn chars]++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")+	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 -> DecQ+parseE1 th tmp name = flip (valD $ varP tmp) [] $ normalB $+	varE (runStateTN th) `appE` varE name+		`appE` varE (mkName "d")++pSomes :: IORef Int -> Bool -> Name -> Name -> Name -> [Name] -> Peg -> DecsQ+pSomes g th lst lst1 opt = zipWithM $ pSomes1 g th lst lst1 opt++pSomes1 :: IORef Int -> Bool -> Name -> Name -> Name -> Name -> Definition -> DecQ+pSomes1 g th lst lst1 opt pname (_, _, sel) = flip (valD $ varP pname) [] $+	normalB $ pSomes1Sel g th lst lst1 opt sel++pSomes1Sel :: IORef Int -> Bool -> Name -> Name -> Name -> Selection -> ExpQ+pSomes1Sel g th lst lst1 opt sel =+	varE (mkName "foldl1") `appE` varE (mplusN th) `appE`+		listE (map (uncurry $ pSome_ g th lst lst1 opt) sel)++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 -> 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++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 []+	 ]++getNewName :: IORef Int -> String -> Q Name+getNewName g n = do+	gn <- runIO $ readIORef g+	runIO $ modifyIORef g succ+	newName $ n ++ show gn++{-++showSelection :: Selection -> Q String = mapM showExpression++showNameLeaf :: NameLeaf -> Q String+showNameLeaf (NameLeafList pat sel) =+	(\ps ss -> sho (ppr ps) ++ ":(" ++ selS ++ ")*")+		<$> pat <*> showSelection sel++-}++transReadFrom :: IORef Int -> Bool -> Name -> Name -> Name -> ReadFrom -> ExpQ+transReadFrom _ th _ _ _ FromToken = conE (stateTN' th) `appE` varE dvCharsN+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++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)++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++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]++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

@@ -1,7 +0,0 @@-import Text.Papillon-import System.Environment--main :: IO ()-main = do-	fn : _ <- getArgs-	putStr =<< papillonStr' =<< readFile fn