papillon 0.0.62 → 0.0.88
raw patch · 9 files changed
+3355/−3002 lines, 9 files
Files
- bin/Class.hs +13/−2
- bin/papillon.hs +2/−2
- papillon.cabal +4/−5
- src/Text/Papillon.hs +2/−1
- src/Text/Papillon/Core.hs +451/−0
- src/Text/Papillon/Papillon.hs +3/−1
- src/Text/Papillon/Parser.hs +2880/−2334
- src/Text/Papillon/SyntaxTree.hs +0/−230
- src/Text/PapillonCore.hs +0/−427
bin/Class.hs view
@@ -323,7 +323,10 @@ funD listUpdatePosN [ flip (clause [litP $ charL '\n', pCharPos [tupP [varP y, wildP]]]) [] $ normalB $ eCharPos `appE` tupE [- infixApp (varE y) plus one, zero],+ infixApp (varE y) plus one, one],+ flip (clause [litP $ charL '\t', pCharPos [tupP [varP y, varP x]]]) [] $+ normalB $ eCharPos `appE` tupE [+ varE y, procTab `appE` varE x], flip (clause [wildP, pCharPos [tupP [varP y, varP x]]]) [] $ normalB $ eCharPos `appE` tupE [ varE y, infixApp (varE x) plus one]@@ -335,8 +338,16 @@ x = mkName "x" tupleBody = tupE [varE c, varE s] one = litE $ integerL 1- zero = litE $ integerL 0+-- zero = litE $ integerL 0+ eight = litE $ integerL 8 plus = varE $ mkName "+" charPosN = mkName "CharPos" eCharPos = conE charPosN pCharPos = conP charPosN+ procTab = addOne `conc` mulEight `conc` addOne `conc` divEight `conc`+ subOne+ conc f g = uInfixE f (varE $ mkName ".") g+ addOne = infixE Nothing (varE $ mkName "+") $ Just one+ mulEight = infixE Nothing (varE $ mkName "*") $ Just eight+ divEight = infixE Nothing (varE $ mkName "div") $ Just eight+ subOne = varE (mkName "subtract") `appE` one
bin/papillon.hs view
@@ -1,4 +1,4 @@-import Text.PapillonCore+import Text.Papillon.Core import System.Environment import System.Directory import System.FilePath@@ -10,7 +10,7 @@ addModules :: String addModules = "import \"monads-tf\" Control.Monad.State\n" ++- "import \"monads-tf\" Control.Monad.Identity\n" +++-- "import \"monads-tf\" Control.Monad.Identity\n" ++ "import \"monads-tf\" Control.Monad.Error\n" papillonStr :: String -> IO (String, String, String)
papillon.cabal view
@@ -2,7 +2,7 @@ cabal-version: >= 1.8 name: papillon-version: 0.0.62+version: 0.0.88 stability: Experimental author: Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer: Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -28,17 +28,16 @@ source-repository this type: git location: git://github.com/YoshikuniJujo/papillon.git- tag: 0.0.62+ tag: 0.0.88 library hs-source-dirs: src- exposed-modules: Text.Papillon, Text.PapillonCore+ exposed-modules: Text.Papillon, Text.Papillon.Core other-modules: Text.Papillon.Parser, Text.Papillon.Papillon, Text.Papillon.Papillon,- Text.Papillon.List,- Text.Papillon.SyntaxTree+ Text.Papillon.List build-depends: base > 3 && < 5, template-haskell, monads-tf, transformers ghc-options: -Wall
src/Text/Papillon.hs view
@@ -4,6 +4,7 @@ SourceList(..), Pos(..), ListPos(..),+ -- * For parse error message ParseError, mkParseError,@@ -19,7 +20,7 @@ runError ) where -import Text.PapillonCore+import Text.Papillon.Core import Language.Haskell.TH.Quote papillon :: QuasiQuoter
+ src/Text/Papillon/Core.hs view
@@ -0,0 +1,451 @@+{-# LANGUAGE TemplateHaskell, PackageImports, TypeFamilies, FlexibleContexts,+ FlexibleInstances, TupleSections #-}++module Text.Papillon.Core (+ -- * For Text.Papillon library+ papillonCore,++ Source(..),+ SourceList(..),++ -- ** For parse error message+ ParseError,+ mkParseError,+ peDerivs,+ peReading,+ peMessage,+ peCode,+ peComment,+ pePosition,+ pePositionS,+ Pos(..),+ ListPos(..),++ -- * For papillon command+ papillonFile,+ PPragma(..),+ ModuleName,+ Exports,+ Code,+ (<*>),+ (<$>),+ runError+) where++import Language.Haskell.TH hiding (infixApp, doE)+import "monads-tf" Control.Monad.State+import "monads-tf" Control.Monad.Identity+import "monads-tf" Control.Monad.Error++import Control.Applicative++import Text.Papillon.Parser+import Data.Maybe+import Data.IORef+import Data.Char++import Text.Papillon.List++import System.IO.Unsafe++dvPosN :: String -> Name+dvPosN prefix = mkName $ prefix ++ "position"++mkPrName :: String -> String -> Name+mkPrName prefix = mkName . (prefix ++)++mkPrUName :: String -> String -> Name+mkPrUName prefix = mkName . (capitalize prefix ++)+ where+ capitalize "" = ""+ capitalize (h : t) = toUpper h : t++papillonCore :: String -> DecsQ+papillonCore str = case flip evalState Nothing $ runErrorT $ peg $ parse str of+ Right (stpegq, _) -> do+ let (monad, src, prefix, parsed) = stpegq+ decParsed True monad src prefix parsed+ Left err -> error $ "parse error: " ++ showParseError err++papillonFile :: String ->+ Q ([PPragma], ModuleName, Maybe Exports, Code, DecsQ, Code)+papillonFile str = case flip evalState Nothing $ runErrorT $ pegFile $ parse str of+ Right (pegfileq, _) -> do+ let (prgm, mn, ppp, pp, (monad, src, prefix, parsed), atp) = pegfileq+ lu = listUsed parsed+ ou = optionalUsed parsed+ addApplicative = if lu || ou+ then "import Control.Applicative" +++ "(Applicative, (<$>), (<*>))\n" else ""+ addIdentity = if isJust monad then ""+ else "import \"monads-tf\" Control.Monad.Identity\n"+ return (prgm, mn, ppp,+ addApplicative ++ addIdentity ++ pp,+ decs monad src prefix parsed, atp)+ where+ decs = decParsed False+ Left err -> error $ "parse error: " ++ showParseError err++decParsed :: Bool -> Maybe Type -> Type -> String -> Peg -> DecsQ+decParsed th monad src prefix parsed = do+ let d = derivs th (fromMaybe (ConT $ identityN th) monad) src prefix parsed+ pt = SigD (mkPrName prefix "parse") $+ src `arrT` ConT (mkPrUName prefix "Derivs")+ p <- funD (mkPrName prefix "parse") [mkParseBody th (isJust monad) prefix parsed]+ return [d, pt, p]++derivs :: Bool -> Type -> Type -> String -> Peg -> Dec+derivs th monad src prefix pg = DataD [] (mkPrUName prefix "Derivs") [] [+ RecC (mkPrUName prefix "Derivs") $ map derivs1 pg ++ [+ (mkPrName prefix dvCharsN, NotStrict, resultT tkn),+ (dvPosN prefix, NotStrict, resultT $ ConT (mkName "Pos") `AppT` src)+ ]] []+ where+ tkn = ConT (mkName "Token") `AppT` src+ derivs1 (name, Just t, _) = (mkPrName prefix name, NotStrict, resultT t)+ derivs1 (name, Nothing, _) =+ (mkPrName prefix name, NotStrict, resultT $ TupleT 0)+ resultT typ = ConT (errorTTN th)+ `AppT` (ConT (mkName "ParseError")+ `AppT` (ConT (mkName "Pos") `AppT` src)+ `AppT` ConT (mkPrUName prefix "Derivs"))+ `AppT` monad+ `AppT` (TupleT 2 `AppT` typ `AppT` ConT (mkPrUName prefix "Derivs"))++type Variables = [(String, [Name])]++newVariable :: IORef Int -> Variables -> String -> Q Variables+newVariable g vs n = (: vs) . (n ,) <$> vars+ where vars = runIO $ unsafeInterleaveIO $ (:)+ <$> runQ (newNewName g n) <*> runQ vars++getVariable :: String -> Variables -> Name+getVariable = ((head . fromJust) .) . lookup++nextVariable :: String -> Variables -> Variables+nextVariable n vs = (n, tail $ fromJust $ lookup n vs) : vs++mkParseBody :: Bool -> Bool -> String -> Peg -> ClauseQ+mkParseBody th monadic prefix pg = do+ glb <- runIO $ newIORef 1+ vars <- foldM (newVariable glb) [] [+ "parse", "chars", "pos", "d", "c", "s", "s'", "x", "t", "err", "b",+ "list", "list1", "optional"]+ let pgn = getVariable "parse" vars+ rets <- mapM (newNewName glb . \(n, _, _) -> prefix ++ n) pg+ rules <- mapM (newNewName glb . \(n, _, _) -> prefix ++ n) pg+ let decs = flip evalState vars $ (:)+ <$> (FunD pgn <$> (: []) <$> mkParseCore th prefix rets rules)+ <*> zipWithM mkr rules pg+ list = if not $ listUsed pg then [] else listDec+ (getVariable "list" vars) (getVariable "list1" vars) th+ opt = if not $ optionalUsed pg then [] else optionalDec+ (getVariable "optional" vars) th+ return $ flip (Clause []) (decs ++ list ++ opt) $ NormalB $+ VarE pgn `AppE` VarE (mkName "initialPos")+ where+ mkr rule (_, _, sel) =+ flip (ValD $ VarP rule) [] . NormalB <$> mkRule th monadic prefix sel++mkParseCore :: Bool -> String -> [Name] -> [Name] -> State Variables Clause+mkParseCore th prefix rets rules = do+ [ch, p, s, d] <- mapM (gets . getVariable) ["chars", "pos", "s", "d"]+ let def ret rule = flip (ValD $ VarP ret) [] $+ NormalB $ VarE (runStateTN th) `AppE` VarE rule `AppE` VarE d+ pc <- parseChar th prefix+ return $ Clause [VarP p, VarP s] (NormalB $ VarE d) $ [+ flip (ValD $ VarP d) [] $ NormalB $ foldl1 AppE $+ ConE (mkPrUName prefix "Derivs") : map VarE rets ++ [VarE ch,+ VarE (mkName "return") `AppE` TupE [VarE p, VarE d]]+ ] ++ zipWith def rets rules ++ [pc]++parseChar :: Bool -> String -> State Variables Dec+parseChar th prefix = do+ [prs, ch, p, c, s, s', d] <- mapM (gets . getVariable)+ ["parse", "chars", "pos", "c", "s", "s'", "d"]+ let emsg = "end of input"+ np = VarE (mkName "updatePos") `AppE` VarE c `AppE` VarE p+ return $ flip (ValD $ VarP ch) [] $ NormalB $ VarE (runStateTN th) `AppE`+ CaseE (VarE (mkName "getToken") `AppE` VarE s) [+ Match (mkName "Just" `ConP` [TupP [VarP c, VarP s']])+ (NormalB $ DoE $ map NoBindS [+ VarE (putN th) `AppE`+ (VarE prs `AppE` np+ `AppE` VarE s'),+ VarE (mkName "return") `AppE` VarE c])+ [],+ flip (Match WildP) [] $ NormalB $+ throwErrorTH th prefix (mkName "undefined") [] emsg "" ""+ ] `AppE` VarE d++mkRule :: Bool -> Bool -> String -> Selection -> State Variables Exp+mkRule t m prefix s = (VarE (mkName "foldl1") `AppE` VarE (mplusN t) `AppE`) . ListE <$>+ case s of+ exs -> expression t m prefix `mapM` exs++expression :: Bool -> Bool -> String -> Expression -> State Variables Exp+expression th m prefix (Left (e, r)) =+-- (doE . (++ [NoBindS $ retLift `AppE` r]) . concat <$>) $+ (doE . (++ [NoBindS $ mkRetLift r]) . concat <$>) $+ forM e $ \(la, ck) ->+ lookahead th prefix la (show $ pprCheck ck) (getReadings ck) =<<+ check th m prefix ck+ where+ mkRetLift (Just rr) = retLift rr+ mkRetLift Nothing = VarE (mkName "return") `AppE` TupE []+ retLift x = if m+ then VarE (liftN th) `AppE` (VarE (liftN th) `AppE` x)+ else VarE (mkName "return") `AppE` x+ getReadings (Left (_, rf, _)) = readings rf+ getReadings (Right _) = [dvCharsN]+expression th _ prefix (Right e) = do+ c <- gets $ getVariable "c"+ modify $ nextVariable "c"+ let e' = [(Here, Left ((VarP c, ""), FromVariable Nothing,+ Just (e `AppE` VarE c, "")))]+ r = VarE c+ expression th False prefix (Left (e', Just r))++check :: Bool -> Bool -> String -> Check -> State Variables [Stmt]+check th monadic prefix (Left ((n, nc), rf, test)) = do+ t <- gets $ getVariable "t"+ d <- gets $ getVariable "d"+ b <- gets $ getVariable "b"+ modify $ nextVariable "t"+ modify $ nextVariable "d"+ modify $ nextVariable "b"+ case (n, test) of+ (WildP, Just p) -> ((BindS (VarP d) (VarE $ getN th) :) .+ (: afterCheck th monadic prefix b p d (readings rf))) .+ BindS WildP <$> transReadFrom th monadic prefix rf+ (_, Just p)+ | notHaveOthers n -> do+ let bd = BindS (VarP d) $ VarE $ getN th+ m = LetS [ValD n (NormalB $ VarE t) []]+ c = afterCheck th monadic prefix b p d (readings rf)+ s <- BindS (VarP t) <$> transReadFrom th monadic prefix rf+ return $ [bd, s, m] ++ c+ | otherwise -> do+ let bd = BindS (VarP d) $ VarE $ getN th+ m = beforeMatch th prefix t n d (readings rf) nc+ c = afterCheck th monadic prefix b p d (readings rf)+ s <- BindS (VarP t) <$> transReadFrom th monadic prefix rf+ return $ [bd, s] ++ m ++ c+ (WildP, _) -> sequence [+ BindS WildP <$> transReadFrom th monadic prefix rf,+ return $ NoBindS $ VarE (mkName "return") `AppE` TupE []+ ]+ _ | notHaveOthers n ->+ (: []) . BindS n <$> transReadFrom th monadic prefix rf+ | otherwise -> do+ let bd = BindS (VarP d) $ VarE $ getN th+ m = beforeMatch th prefix t n d (readings rf) nc+ s <- BindS (VarP t) <$> transReadFrom th monadic prefix rf+ return $ bd : s : m+ where+ notHaveOthers (VarP _) = True+ notHaveOthers (TupP pats) = all notHaveOthers pats+ notHaveOthers (BangP _) = True+ notHaveOthers _ = False+check th monadic prefix (Right (c, l)) =+ check th monadic prefix+ (Left ((WildP, ""), FromL l $ FromSelection sel, Nothing))+ where+ sel = [Left+ ([(Here, Left ((LitP $ CharL c, ""), FromVariable Nothing, Nothing))],+ Just $ if monadic then VarE (mkName "return") `AppE` TupE [] else TupE [])]++lookahead :: Bool -> String -> Lookahead -> String -> [String] -> [Stmt] ->+ State Variables [Stmt]+lookahead _ _ Here _ _ ret = return ret+lookahead th _ Ahead _ _ ret = do+ d <- gets $ getVariable "d"+ modify $ nextVariable "d"+ return [BindS (VarP d) $ VarE (getN th),+ BindS WildP $ doE ret,+ NoBindS $ VarE (putN th) `AppE` VarE d]+lookahead th prefix (NAhead com) ck ns ret = do+ d <- gets $ getVariable "d"+ modify $ nextVariable "d"+ n <- negative th prefix ('!' : ck) com+ d ns (doE ret)+ return [BindS (VarP d) $ VarE (getN th),+ NoBindS n,+ NoBindS $ VarE (putN th) `AppE` VarE d]++negative :: Bool -> String -> String -> String -> Name -> [String] -> Exp ->+ State Variables Exp+negative th prefix code com d ns act = do+ err <- gets $ getVariable "err"+ modify $ nextVariable "err"+ return $ DoE [+ BindS (VarP err) $ infixApp+ (infixApp act (VarE $ mkName ">>")+ (VarE (mkName "return") `AppE`+ ConE (mkName "False")))+ (VarE $ catchErrorN th)+ (VarE (mkName "const") `AppE`+ (VarE (mkName "return") `AppE`+ ConE (mkName "True"))),+ NoBindS $ VarE (unlessN th) `AppE` VarE err `AppE`+ throwErrorTH th prefix d ns "not match: " code com]++transReadFrom :: Bool -> Bool -> String -> ReadFrom -> State Variables Exp+transReadFrom th _ prefix (FromVariable Nothing) = return $+ ConE (stateTN th) `AppE` VarE (mkPrName prefix dvCharsN)+transReadFrom th _ prefix (FromVariable (Just var)) = return $+ ConE (stateTN th) `AppE` VarE (mkPrName prefix var)+transReadFrom th m prefix (FromSelection sel) = mkRule th m prefix sel+transReadFrom th m prefix (FromL List rf) = do+ list <- gets $ getVariable "list"+ (VarE list `AppE`) <$> transReadFrom th m prefix rf+transReadFrom th m prefix (FromL List1 rf) = do+ list1 <- gets $ getVariable "list1"+ (VarE list1 `AppE`) <$> transReadFrom th m prefix rf+transReadFrom th m prefix (FromL Optional rf) = do+ opt <- gets $ getVariable "optional"+ (VarE opt `AppE`) <$> transReadFrom th m prefix rf++beforeMatch :: Bool -> String -> Name -> Pat -> Name -> [String] -> String -> [Stmt]+beforeMatch th prefix t nn d ns nc = [+ NoBindS $ CaseE (VarE t) [+ flip (Match $ vpw nn) [] $ NormalB $+ VarE (mkName "return") `AppE` TupE [],+ flip (Match WildP) [] $ NormalB $+ throwErrorTH th prefix d ns "not match pattern: " (show $ ppr nn) nc],+ LetS [ValD nn (NormalB $ VarE t) []],+ NoBindS $ VarE (mkName "return") `AppE` TupE []]+ 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++afterCheck :: Bool -> Bool -> String -> Name -> (Exp, String) -> Name -> [String] -> [Stmt]+afterCheck th monadic prefix b (pp, pc) d ns = [+ BindS (VarP b) $ retLift pp,+ NoBindS $ VarE (unlessN th) `AppE` VarE b `AppE`+ throwErrorTH th prefix d ns "not match: " (show $ ppr pp) pc]+ where+ retLift x = if monadic+ then VarE (liftN th) `AppE` (VarE (liftN th) `AppE` x)+ else VarE (mkName "return") `AppE` x++listUsed, optionalUsed :: Peg -> Bool+listUsed = any $ sel . \(_, _, s) -> s+ where+ sel = any ex+ ex (Left e) = any (either (rf . \(_, r, _) -> r) chr . snd) $ fst e+ ex (Right _) = False+ chr (_, List) = True+ chr (_, List1) = True+ chr (_, _) = False+ rf (FromL List _) = True+ rf (FromL List1 _) = True+ rf (FromSelection s) = sel s+ rf _ = False+optionalUsed = any $ sel . \(_, _, s) -> s+ where+ sel = any ex+ ex (Left e) = any (either (rf . \(_, r, _) -> r) chr . snd) $ fst e+ ex (Right _) = False+ chr (_, Optional) = True+ chr (_, _) = False+ rf (FromL Optional _) = True+ rf (FromSelection s) = sel s+ rf _ = False++throwErrorTH :: Bool -> String -> Name -> [String] -> String -> String -> String -> Exp+throwErrorTH th prefix d ns msg code com = InfixE+ (Just $ ConE (stateTN th) `AppE` VarE (dvPosN prefix))+ (VarE $ mkName ">>=")+ (Just $ InfixE+ (Just $ VarE $ throwErrorN th)+ (VarE $ mkName ".")+ (Just $ VarE (mkName "mkParseError")+ `AppE` LitE (StringL code)+ `AppE` LitE (StringL msg)+ `AppE` LitE (StringL com)+ `AppE` VarE d+ `AppE` ListE (map (LitE . StringL) ns)))++newNewName :: IORef Int -> String -> Q Name+newNewName g base = do+ n <- runIO $ readIORef g+ runIO $ modifyIORef g succ+ newName $ base ++ show n++showParseError :: ParseError (Pos String) Derivs -> String+showParseError pe =+ unwords (map (showReading d) ns) ++ (if null ns then "" else " ") +++ m ++ c ++ " at position: " ++ show p+ where+ [c, m, _] = ($ pe) `map` [peCode, peMessage, peComment]+ ns = peReading pe+ d = peDerivs pe+ p = pePositionS pe++showReading :: Derivs -> String -> String+showReading d n+ | n == dvCharsN = case flip evalState Nothing $ runErrorT $ char d of+ Right (c, _) -> show c+ Left _ -> error "bad"+showReading d "hsw" = case flip evalState Nothing $ runErrorT $ hsw d of+ Right (c, _) -> show c+ Left _ -> error "bad"+showReading _ n = "yet: " ++ n++doE :: [Stmt] -> Exp+doE [NoBindS ex] = ex+doE stmts = DoE stmts++arrT :: Type -> Type -> Type+arrT a r = ArrowT `AppT` a `AppT` r++infixApp :: Exp -> Exp -> Exp -> Exp+infixApp e1 op e2 = InfixE (Just e1) op (Just e2)++stateTN, runStateTN, putN, getN :: Bool -> Name+stateTN True = 'StateT+stateTN False = mkName "StateT"+runStateTN True = 'runStateT+runStateTN False = mkName "runStateT"+putN True = 'put+putN False = mkName "put"+getN True = 'get+getN False = mkName "get"++unlessN, mplusN :: Bool -> Name+unlessN True = 'unless+unlessN False = mkName "unless"+mplusN True = 'mplus+mplusN False = mkName "mplus"++throwErrorN, catchErrorN :: Bool -> Name+throwErrorN True = 'throwError+throwErrorN False = mkName "throwError"+catchErrorN True = 'catchError+catchErrorN False = mkName "catchError"++errorTTN, identityN :: Bool -> Name+errorTTN True = ''ErrorT+errorTTN False = mkName "ErrorT"+identityN True = ''Identity+identityN False = mkName "Identity"++liftN :: Bool -> Name+liftN True = 'lift+liftN False = mkName "lift"++readings :: ReadFrom -> [String]+readings (FromVariable (Just s)) = [s]+readings (FromVariable _) = [dvCharsN]+readings (FromL _ rf) = readings rf+readings (FromSelection s) = concat $+ (mapM $ either+ (either (readings . \(_, rf, _) -> rf) (const [dvCharsN]) . snd .+ head . fst)+ (const [dvCharsN])) s
src/Text/Papillon/Papillon.hs view
@@ -54,7 +54,9 @@ listToken (c : s) = Just (c, s) listToken _ = Nothing listInitialPos = CharPos (1, 1)- listUpdatePos '\n' (CharPos (y, _)) = CharPos (y + 1, 0)+ listUpdatePos '\n' (CharPos (y, _)) = CharPos (y + 1, 1)+ listUpdatePos '\t' (CharPos (y, x)) = CharPos (y,+ ((+ 1) . (* 8) . (+ 1) . (`div` 8) . subtract 1) x) listUpdatePos _ (CharPos (y, x)) = CharPos (y, x + 1) runError :: forall err a . ErrorT err Identity a -> Either err a runError = runIdentity . runErrorT
src/Text/Papillon/Parser.hs view
@@ -1,2335 +1,2881 @@-{-# LANGUAGE FlexibleContexts, TemplateHaskell, UndecidableInstances, PackageImports, TypeFamilies, RankNTypes #-}-module Text.Papillon.Parser (- Lookahead(..),- Lists(..),-- Peg,- Definition,- Selection,- Expression,- PlainExpression,- Check,- ReadFrom(..),-- PegQ,-- selectionType,- pprCheck,- nameFromRF,-- parse,- Source(..),- SourceList(..),- Derivs(pegFile, peg, char),- ParseError(..),- mkParseError,- pePositionS,- Pos(..),- ListPos(..),-- PPragma(..),- ModuleName,- Exports,- Code,-- runError,-- dvCharsN-) where--import Text.Papillon.Papillon-import "monads-tf" Control.Monad.State-import "monads-tf" Control.Monad.Identity-import "monads-tf" Control.Monad.Error-import Control.Applicative----import Text.Papillon.SyntaxTree-import Language.Haskell.TH {- (- Name, TypeQ, PatQ, ExpQ, mkName,- conT, tupleT, listT, appT, arrowT,- wildP, litP, varP, conP, tupP, listP, uInfixP,- litE, varE, conE, tupE, listE, sigE, appE, infixE, uInfixE, lamE,- integerL, charL, stringL) -}-import Data.Char (isSpace, isDigit, isUpper, isLower)--data Derivs- = Derivs {pegFile :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((PegFileQ, Derivs))),- pragmas :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (([PPragma], Derivs))),- pragma :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((PPragma, Derivs))),- pragmaStr :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- pragmaItems :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (([String], Derivs))),- pragmaEnd :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((), Derivs))),- moduleDec :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Maybe (([String], Maybe String)), Derivs))),- moduleName :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((ModuleName, Derivs))),- moduleDecStr :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- whr :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((), Derivs))),- preImpPap :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- prePeg :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- afterPeg :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- importPapillon :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((), Derivs))),- varToken :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- typToken :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- pap :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((), Derivs))),- peg :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((STPegQ, Derivs))),- monadType :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Type, Derivs))),- sourceType :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- peg_ :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((PegQ, Derivs))),- definition :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((DefinitionQ, Derivs))),- selection :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((SelectionQ, Derivs))),- normalSelection :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (([ExpressionQ], Derivs))),- plainSelection :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (([PlainExpressionQ], Derivs))),- expressionHs :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((ExpressionQ, Derivs))),- expressionHsSugar :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((ExpressionQ, Derivs))),- plainExpressionHs :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((PlainExpressionQ, Derivs))),- plainHAReadFromLs :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((Lookahead, ReadFromQ), Derivs))),- plainReadFromLs :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((ReadFromQ, Derivs))),- expression :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (([(Lookahead, CheckQ)], Derivs))),- nameLeaf_ :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((Lookahead, CheckQ), Derivs))),- nameLeaf :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((CheckQ, Derivs))),- nameLeafNoCom :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((CheckQ, Derivs))),- comForErr :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- leaf :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((ReadFromQ, Maybe ((Exp, String))), Derivs))),- patOp :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Pat, Derivs))),- pat :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Pat, Derivs))),- pat1 :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Pat, Derivs))),- patList :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (([Pat], Derivs))),- opConName :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Name, Derivs))),- charLit :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Char, Derivs))),- stringLit :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- escapeC :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Char, Derivs))),- pats :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (([Pat], Derivs))),- readFromLs :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((ReadFromQ, Derivs))),- readFrom :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((ReadFromQ, Derivs))),- selectCharsLs :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((ReadFromQ, Derivs))),- selectChars :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((ReadFromQ, Derivs))),- test :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((Exp, String), Derivs))),- hsExpLam :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Exp, Derivs))),- hsExpTyp :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Exp, Derivs))),- hsExpOp :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Exp, Derivs))),- hsOp :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Exp, Derivs))),- opTail :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- hsExp :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((Exp -> Exp) -> Exp, Derivs))),- hsExp1 :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Exp, Derivs))),- hsExpTpl :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (([Exp], Derivs))),- hsTypeArr :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Type, Derivs))),- hsType :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((Type -> Type) -> Type, Derivs))),- hsType1 :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Type, Derivs))),- hsTypeTpl :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (([Type], Derivs))),- typ :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- variable :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- tvtail :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- integer :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Integer, Derivs))),- alpha :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Char, Derivs))),- upper :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Char, Derivs))),- lower :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Char, Derivs))),- digit :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Char, Derivs))),- spaces :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((), Derivs))),- space :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((), Derivs))),- notNLString :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((String, Derivs))),- newLine :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((), Derivs))),- comment :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((), Derivs))),- comments :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((), Derivs))),- notComStr :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((), Derivs))),- comEnd :: (ErrorT (ParseError (Pos String) Derivs)- Identity- (((), Derivs))),- char :: (ErrorT (ParseError (Pos String) Derivs)- Identity- ((Token String, Derivs))),- position :: (Pos String)}-parse :: String -> Derivs-parse = parse1176_0 initialPos- where parse1176_0 pos1175_1 s1177_2 = d655_3- where d655_3 = Derivs pegFile0_4 pragmas1_5 pragma2_6 pragmaStr3_7 pragmaItems4_8 pragmaEnd5_9 moduleDec6_10 moduleName7_11 moduleDecStr8_12 whr9_13 preImpPap10_14 prePeg11_15 afterPeg12_16 importPapillon13_17 varToken14_18 typToken15_19 pap16_20 peg17_21 monadType18_22 sourceType19_23 peg_20_24 definition21_25 selection22_26 normalSelection23_27 plainSelection24_28 expressionHs25_29 expressionHsSugar26_30 plainExpressionHs27_31 plainHAReadFromLs28_32 plainReadFromLs29_33 expression30_34 nameLeaf_31_35 nameLeaf32_36 nameLeafNoCom33_37 comForErr34_38 leaf35_39 patOp36_40 pat37_41 pat138_42 patList39_43 opConName40_44 charLit41_45 stringLit42_46 escapeC43_47 pats44_48 readFromLs45_49 readFrom46_50 selectCharsLs47_51 selectChars48_52 test49_53 hsExpLam50_54 hsExpTyp51_55 hsExpOp52_56 hsOp53_57 opTail54_58 hsExp55_59 hsExp156_60 hsExpTpl57_61 hsTypeArr58_62 hsType59_63 hsType160_64 hsTypeTpl61_65 typ62_66 variable63_67 tvtail64_68 integer65_69 alpha66_70 upper67_71 lower68_72 digit69_73 spaces70_74 space71_75 notNLString72_76 newLine73_77 comment74_78 comments75_79 notComStr76_80 comEnd77_81 chars1178_82 pos1175_1- pegFile0_4 = runStateT pegFile78_83 d655_3- pragmas1_5 = runStateT pragmas79_84 d655_3- pragma2_6 = runStateT pragma80_85 d655_3- pragmaStr3_7 = runStateT pragmaStr81_86 d655_3- pragmaItems4_8 = runStateT pragmaItems82_87 d655_3- pragmaEnd5_9 = runStateT pragmaEnd83_88 d655_3- moduleDec6_10 = runStateT moduleDec84_89 d655_3- moduleName7_11 = runStateT moduleName85_90 d655_3- moduleDecStr8_12 = runStateT moduleDecStr86_91 d655_3- whr9_13 = runStateT whr87_92 d655_3- preImpPap10_14 = runStateT preImpPap88_93 d655_3- prePeg11_15 = runStateT prePeg89_94 d655_3- afterPeg12_16 = runStateT afterPeg90_95 d655_3- importPapillon13_17 = runStateT importPapillon91_96 d655_3- varToken14_18 = runStateT varToken92_97 d655_3- typToken15_19 = runStateT typToken93_98 d655_3- pap16_20 = runStateT pap94_99 d655_3- peg17_21 = runStateT peg95_100 d655_3- monadType18_22 = runStateT monadType96_101 d655_3- sourceType19_23 = runStateT sourceType97_102 d655_3- peg_20_24 = runStateT peg_98_103 d655_3- definition21_25 = runStateT definition99_104 d655_3- selection22_26 = runStateT selection100_105 d655_3- normalSelection23_27 = runStateT normalSelection101_106 d655_3- plainSelection24_28 = runStateT plainSelection102_107 d655_3- expressionHs25_29 = runStateT expressionHs103_108 d655_3- expressionHsSugar26_30 = runStateT expressionHsSugar104_109 d655_3- plainExpressionHs27_31 = runStateT plainExpressionHs105_110 d655_3- plainHAReadFromLs28_32 = runStateT plainHAReadFromLs106_111 d655_3- plainReadFromLs29_33 = runStateT plainReadFromLs107_112 d655_3- expression30_34 = runStateT expression108_113 d655_3- nameLeaf_31_35 = runStateT nameLeaf_109_114 d655_3- nameLeaf32_36 = runStateT nameLeaf110_115 d655_3- nameLeafNoCom33_37 = runStateT nameLeafNoCom111_116 d655_3- comForErr34_38 = runStateT comForErr112_117 d655_3- leaf35_39 = runStateT leaf113_118 d655_3- patOp36_40 = runStateT patOp114_119 d655_3- pat37_41 = runStateT pat115_120 d655_3- pat138_42 = runStateT pat1116_121 d655_3- patList39_43 = runStateT patList117_122 d655_3- opConName40_44 = runStateT opConName118_123 d655_3- charLit41_45 = runStateT charLit119_124 d655_3- stringLit42_46 = runStateT stringLit120_125 d655_3- escapeC43_47 = runStateT escapeC121_126 d655_3- pats44_48 = runStateT pats122_127 d655_3- readFromLs45_49 = runStateT readFromLs123_128 d655_3- readFrom46_50 = runStateT readFrom124_129 d655_3- selectCharsLs47_51 = runStateT selectCharsLs125_130 d655_3- selectChars48_52 = runStateT selectChars126_131 d655_3- test49_53 = runStateT test127_132 d655_3- hsExpLam50_54 = runStateT hsExpLam128_133 d655_3- hsExpTyp51_55 = runStateT hsExpTyp129_134 d655_3- hsExpOp52_56 = runStateT hsExpOp130_135 d655_3- hsOp53_57 = runStateT hsOp131_136 d655_3- opTail54_58 = runStateT opTail132_137 d655_3- hsExp55_59 = runStateT hsExp133_138 d655_3- hsExp156_60 = runStateT hsExp1134_139 d655_3- hsExpTpl57_61 = runStateT hsExpTpl135_140 d655_3- hsTypeArr58_62 = runStateT hsTypeArr136_141 d655_3- hsType59_63 = runStateT hsType137_142 d655_3- hsType160_64 = runStateT hsType1138_143 d655_3- hsTypeTpl61_65 = runStateT hsTypeTpl139_144 d655_3- typ62_66 = runStateT typ140_145 d655_3- variable63_67 = runStateT variable141_146 d655_3- tvtail64_68 = runStateT tvtail142_147 d655_3- integer65_69 = runStateT integer143_148 d655_3- alpha66_70 = runStateT alpha144_149 d655_3- upper67_71 = runStateT upper145_150 d655_3- lower68_72 = runStateT lower146_151 d655_3- digit69_73 = runStateT digit147_152 d655_3- spaces70_74 = runStateT spaces148_153 d655_3- space71_75 = runStateT space149_154 d655_3- notNLString72_76 = runStateT notNLString150_155 d655_3- newLine73_77 = runStateT newLine151_156 d655_3- comment74_78 = runStateT comment152_157 d655_3- comments75_79 = runStateT comments153_158 d655_3- notComStr76_80 = runStateT notComStr154_159 d655_3- comEnd77_81 = runStateT comEnd155_160 d655_3- chars1178_82 = runStateT (case getToken s1177_2 of- Just (c1173_161,- s'1174_162) -> do put (parse1176_0 (updatePos c1173_161 pos1175_1) s'1174_162)- return c1173_161- _ -> gets position >>= (throwError . mkParseError "" "end of input" "" undefined [])) d655_3- pegFile78_83 = foldl1 mplus [do pr <- StateT pragmas- md <- StateT moduleDec- pip <- StateT preImpPap- _ <- StateT importPapillon- return ()- pp <- StateT prePeg- _ <- StateT pap- return ()- p <- StateT peg- _ <- StateT spaces- return ()- d663_163 <- get- t167_164 <- StateT char- case t167_164 of- '|' -> return ()- _ -> gets position >>= (throwError . mkParseError "'|'" "not match pattern: " "" d663_163 ["char"])- let '|' = t167_164- return ()- d664_165 <- get- t168_166 <- StateT char- case t168_166 of- ']' -> return ()- _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d664_165 ["char"])- let ']' = t168_166- return ()- d665_167 <- get- t169_168 <- StateT char- case t169_168 of- '\n' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d665_167 ["char"])- let '\n' = t169_168- return ()- atp <- StateT afterPeg- return (mkPegFile pr md pip pp p atp),- do pr <- StateT pragmas- md <- StateT moduleDec- pp <- StateT prePeg- _ <- StateT pap- return ()- p <- StateT peg- _ <- StateT spaces- return ()- d673_169 <- get- t177_170 <- StateT char- case t177_170 of- '|' -> return ()- _ -> gets position >>= (throwError . mkParseError "'|'" "not match pattern: " "" d673_169 ["char"])- let '|' = t177_170- return ()- d674_171 <- get- t178_172 <- StateT char- case t178_172 of- ']' -> return ()- _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d674_171 ["char"])- let ']' = t178_172- return ()- d675_173 <- get- t179_174 <- StateT char- case t179_174 of- '\n' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d675_173 ["char"])- let '\n' = t179_174- return ()- atp <- StateT afterPeg- return (mkPegFile pr md [] pp p atp)]- pragmas79_84 = foldl1 mplus [do _ <- StateT spaces- return ()- pr <- StateT pragma- prs <- StateT pragmas- return (pr : prs),- do _ <- StateT spaces- return ()- return []]- pragma80_85 = foldl1 mplus [do d681_175 <- get- t185_176 <- StateT char- case t185_176 of- '{' -> return ()- _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d681_175 ["char"])- let '{' = t185_176- return ()- d682_177 <- get- t186_178 <- StateT char- case t186_178 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d682_177 ["char"])- let '-' = t186_178- return ()- d683_179 <- get- t187_180 <- StateT char- case t187_180 of- '#' -> return ()- _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d683_179 ["char"])- let '#' = t187_180- return ()- _ <- StateT spaces- return ()- d685_181 <- get- t189_182 <- StateT char- case t189_182 of- 'L' -> return ()- _ -> gets position >>= (throwError . mkParseError "'L'" "not match pattern: " "" d685_181 ["char"])- let 'L' = t189_182- return ()- d686_183 <- get- t190_184 <- StateT char- case t190_184 of- 'A' -> return ()- _ -> gets position >>= (throwError . mkParseError "'A'" "not match pattern: " "" d686_183 ["char"])- let 'A' = t190_184- return ()- d687_185 <- get- t191_186 <- StateT char- case t191_186 of- 'N' -> return ()- _ -> gets position >>= (throwError . mkParseError "'N'" "not match pattern: " "" d687_185 ["char"])- let 'N' = t191_186- return ()- d688_187 <- get- t192_188 <- StateT char- case t192_188 of- 'G' -> return ()- _ -> gets position >>= (throwError . mkParseError "'G'" "not match pattern: " "" d688_187 ["char"])- let 'G' = t192_188- return ()- d689_189 <- get- t193_190 <- StateT char- case t193_190 of- 'U' -> return ()- _ -> gets position >>= (throwError . mkParseError "'U'" "not match pattern: " "" d689_189 ["char"])- let 'U' = t193_190- return ()- d690_191 <- get- t194_192 <- StateT char- case t194_192 of- 'A' -> return ()- _ -> gets position >>= (throwError . mkParseError "'A'" "not match pattern: " "" d690_191 ["char"])- let 'A' = t194_192- return ()- d691_193 <- get- t195_194 <- StateT char- case t195_194 of- 'G' -> return ()- _ -> gets position >>= (throwError . mkParseError "'G'" "not match pattern: " "" d691_193 ["char"])- let 'G' = t195_194- return ()- d692_195 <- get- t196_196 <- StateT char- case t196_196 of- 'E' -> return ()- _ -> gets position >>= (throwError . mkParseError "'E'" "not match pattern: " "" d692_195 ["char"])- let 'E' = t196_196- return ()- _ <- StateT spaces- return ()- s <- StateT pragmaItems- _ <- StateT pragmaEnd- return ()- _ <- StateT spaces- return ()- return (LanguagePragma s),- do d697_197 <- get- t201_198 <- StateT char- case t201_198 of- '{' -> return ()- _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d697_197 ["char"])- let '{' = t201_198- return ()- d698_199 <- get- t202_200 <- StateT char- case t202_200 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d698_199 ["char"])- let '-' = t202_200- return ()- d699_201 <- get- t203_202 <- StateT char- case t203_202 of- '#' -> return ()- _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d699_201 ["char"])- let '#' = t203_202- return ()- _ <- StateT spaces- return ()- s <- StateT pragmaStr- _ <- StateT pragmaEnd- return ()- return (OtherPragma s)]- pragmaStr81_86 = foldl1 mplus [do d704_203 <- get- do err1162_204 <- ((do _ <- StateT pragmaEnd- return ()) >> return False) `catchError` const (return True)- unless err1162_204 (gets position >>= (throwError . mkParseError "!_:pragmaEnd" "not match: " "" d704_203 ["pragmaEnd"]))- put d704_203- c <- StateT char- s <- StateT pragmaStr- return (c : s),- return ""]- pragmaItems82_87 = foldl1 mplus [do t <- StateT typToken- d708_205 <- get- t211_206 <- StateT char- case t211_206 of- ',' -> return ()- _ -> gets position >>= (throwError . mkParseError "','" "not match pattern: " "" d708_205 ["char"])- let ',' = t211_206- return ()- _ <- StateT spaces- return ()- i <- StateT pragmaItems- return (t : i),- do t <- StateT typToken- return [t]]- pragmaEnd83_88 = foldl1 mplus [do _ <- StateT spaces- return ()- d713_207 <- get- t216_208 <- StateT char- case t216_208 of- '#' -> return ()- _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d713_207 ["char"])- let '#' = t216_208- return ()- d714_209 <- get- t217_210 <- StateT char- case t217_210 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d714_209 ["char"])- let '-' = t217_210- return ()- d715_211 <- get- t218_212 <- StateT char- case t218_212 of- '}' -> return ()- _ -> gets position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d715_211 ["char"])- let '}' = t218_212- return ()- return ()]- moduleDec84_89 = foldl1 mplus [do d716_213 <- get- t219_214 <- StateT char- case t219_214 of- 'm' -> return ()- _ -> gets position >>= (throwError . mkParseError "'m'" "not match pattern: " "" d716_213 ["char"])- let 'm' = t219_214- return ()- d717_215 <- get- t220_216 <- StateT char- case t220_216 of- 'o' -> return ()- _ -> gets position >>= (throwError . mkParseError "'o'" "not match pattern: " "" d717_215 ["char"])- let 'o' = t220_216- return ()- d718_217 <- get- t221_218 <- StateT char- case t221_218 of- 'd' -> return ()- _ -> gets position >>= (throwError . mkParseError "'d'" "not match pattern: " "" d718_217 ["char"])- let 'd' = t221_218- return ()- d719_219 <- get- t222_220 <- StateT char- case t222_220 of- 'u' -> return ()- _ -> gets position >>= (throwError . mkParseError "'u'" "not match pattern: " "" d719_219 ["char"])- let 'u' = t222_220- return ()- d720_221 <- get- t223_222 <- StateT char- case t223_222 of- 'l' -> return ()- _ -> gets position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d720_221 ["char"])- let 'l' = t223_222- return ()- d721_223 <- get- t224_224 <- StateT char- case t224_224 of- 'e' -> return ()- _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d721_223 ["char"])- let 'e' = t224_224- return ()- _ <- StateT spaces- return ()- n <- StateT moduleName- _ <- StateT spaces- return ()- d725_225 <- get- t228_226 <- StateT char- case t228_226 of- '(' -> return ()- _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d725_225 ["char"])- let '(' = t228_226- return ()- _ <- StateT spaces- return ()- s <- StateT moduleDecStr- _ <- StateT whr- return ()- return (Just (n, Just s)),- do d729_227 <- get- t232_228 <- StateT char- case t232_228 of- 'm' -> return ()- _ -> gets position >>= (throwError . mkParseError "'m'" "not match pattern: " "" d729_227 ["char"])- let 'm' = t232_228- return ()- d730_229 <- get- t233_230 <- StateT char- case t233_230 of- 'o' -> return ()- _ -> gets position >>= (throwError . mkParseError "'o'" "not match pattern: " "" d730_229 ["char"])- let 'o' = t233_230- return ()- d731_231 <- get- t234_232 <- StateT char- case t234_232 of- 'd' -> return ()- _ -> gets position >>= (throwError . mkParseError "'d'" "not match pattern: " "" d731_231 ["char"])- let 'd' = t234_232- return ()- d732_233 <- get- t235_234 <- StateT char- case t235_234 of- 'u' -> return ()- _ -> gets position >>= (throwError . mkParseError "'u'" "not match pattern: " "" d732_233 ["char"])- let 'u' = t235_234- return ()- d733_235 <- get- t236_236 <- StateT char- case t236_236 of- 'l' -> return ()- _ -> gets position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d733_235 ["char"])- let 'l' = t236_236- return ()- d734_237 <- get- t237_238 <- StateT char- case t237_238 of- 'e' -> return ()- _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d734_237 ["char"])- let 'e' = t237_238- return ()- _ <- StateT spaces- return ()- n <- StateT moduleName- _ <- StateT spaces- return ()- d738_239 <- get- t241_240 <- StateT char- case t241_240 of- 'w' -> return ()- _ -> gets position >>= (throwError . mkParseError "'w'" "not match pattern: " "" d738_239 ["char"])- let 'w' = t241_240- return ()- d739_241 <- get- t242_242 <- StateT char- case t242_242 of- 'h' -> return ()- _ -> gets position >>= (throwError . mkParseError "'h'" "not match pattern: " "" d739_241 ["char"])- let 'h' = t242_242- return ()- d740_243 <- get- t243_244 <- StateT char- case t243_244 of- 'e' -> return ()- _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d740_243 ["char"])- let 'e' = t243_244- return ()- d741_245 <- get- t244_246 <- StateT char- case t244_246 of- 'r' -> return ()- _ -> gets position >>= (throwError . mkParseError "'r'" "not match pattern: " "" d741_245 ["char"])- let 'r' = t244_246- return ()- d742_247 <- get- t245_248 <- StateT char- case t245_248 of- 'e' -> return ()- _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d742_247 ["char"])- let 'e' = t245_248- return ()- _ <- StateT spaces- return ()- return (Just (n, Nothing)),- return Nothing]- moduleName85_90 = foldl1 mplus [do t <- StateT typ- d745_249 <- get- t248_250 <- StateT char- case t248_250 of- '.' -> return ()- _ -> gets position >>= (throwError . mkParseError "'.'" "not match pattern: " "" d745_249 ["char"])- let '.' = t248_250- return ()- n <- StateT moduleName- return (t : n),- do t <- StateT typ- return [t]]- moduleDecStr86_91 = foldl1 mplus [do d749_251 <- get- do err1163_252 <- ((do _ <- StateT whr- return ()) >> return False) `catchError` const (return True)- unless err1163_252 (gets position >>= (throwError . mkParseError "!_:whr" "not match: " "" d749_251 ["whr"]))- put d749_251- c <- StateT char- s <- StateT moduleDecStr- return (c : s),- return ""]- whr87_92 = foldl1 mplus [do _ <- StateT spaces- return ()- d753_253 <- get- t255_254 <- StateT char- case t255_254 of- ')' -> return ()- _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d753_253 ["char"])- let ')' = t255_254- return ()- _ <- StateT spaces- return ()- d755_255 <- get- t257_256 <- StateT char- case t257_256 of- 'w' -> return ()- _ -> gets position >>= (throwError . mkParseError "'w'" "not match pattern: " "" d755_255 ["char"])- let 'w' = t257_256- return ()- d756_257 <- get- t258_258 <- StateT char- case t258_258 of- 'h' -> return ()- _ -> gets position >>= (throwError . mkParseError "'h'" "not match pattern: " "" d756_257 ["char"])- let 'h' = t258_258- return ()- d757_259 <- get- t259_260 <- StateT char- case t259_260 of- 'e' -> return ()- _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d757_259 ["char"])- let 'e' = t259_260- return ()- d758_261 <- get- t260_262 <- StateT char- case t260_262 of- 'r' -> return ()- _ -> gets position >>= (throwError . mkParseError "'r'" "not match pattern: " "" d758_261 ["char"])- let 'r' = t260_262- return ()- d759_263 <- get- t261_264 <- StateT char- case t261_264 of- 'e' -> return ()- _ -> gets position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d759_263 ["char"])- let 'e' = t261_264- return ()- return ()]- preImpPap88_93 = foldl1 mplus [do d761_265 <- get- do err1164_266 <- ((do _ <- StateT importPapillon- return ()) >> return False) `catchError` const (return True)- unless err1164_266 (gets position >>= (throwError . mkParseError "!_:importPapillon" "not match: " "" d761_265 ["importPapillon"]))- put d761_265- d763_267 <- get- do err1165_268 <- ((do _ <- StateT pap- return ()) >> return False) `catchError` const (return True)- unless err1165_268 (gets position >>= (throwError . mkParseError "!_:pap" "not match: " "" d763_267 ["pap"]))- put d763_267- c <- StateT char- pip <- StateT preImpPap- return (c : pip),- return ""]- prePeg89_94 = foldl1 mplus [do d767_269 <- get- do err1166_270 <- ((do _ <- StateT pap- return ()) >> return False) `catchError` const (return True)- unless err1166_270 (gets position >>= (throwError . mkParseError "!_:pap" "not match: " "" d767_269 ["pap"]))- put d767_269- c <- StateT char- pp <- StateT prePeg- return (c : pp),- return ""]- afterPeg90_95 = foldl1 mplus [do c <- StateT char- atp <- StateT afterPeg- return (c : atp),- return ""]- importPapillon91_96 = foldl1 mplus [do d772_271 <- get- t271_272 <- StateT varToken- case t271_272 of- "import" -> return ()- _ -> gets position >>= (throwError . mkParseError "\"import\"" "not match pattern: " "" d772_271 ["varToken"])- let "import" = t271_272- return ()- d773_273 <- get- t272_274 <- StateT typToken- case t272_274 of- "Text" -> return ()- _ -> gets position >>= (throwError . mkParseError "\"Text\"" "not match pattern: " "" d773_273 ["typToken"])- let "Text" = t272_274- return ()- d774_275 <- get- t273_276 <- StateT char- case t273_276 of- '.' -> return ()- _ -> gets position >>= (throwError . mkParseError "'.'" "not match pattern: " "" d774_275 ["char"])- let '.' = t273_276- return ()- _ <- StateT spaces- return ()- d776_277 <- get- t275_278 <- StateT typToken- case t275_278 of- "Papillon" -> return ()- _ -> gets position >>= (throwError . mkParseError "\"Papillon\"" "not match pattern: " "" d776_277 ["typToken"])- let "Papillon" = t275_278- return ()- d778_279 <- get- do err1167_280 <- ((do d777_281 <- get- t276_282 <- StateT char- case t276_282 of- '.' -> return ()- _ -> gets position >>= (throwError . mkParseError "'.'" "not match pattern: " "" d777_281 ["char"])- let '.' = t276_282- return ()) >> return False) `catchError` const (return True)- unless err1167_280 (gets position >>= (throwError . mkParseError "!'.':" "not match: " "" d778_279 ["char"]))- put d778_279- return ()]- varToken92_97 = foldl1 mplus [do v <- StateT variable- _ <- StateT spaces- return ()- return v]- typToken93_98 = foldl1 mplus [do t <- StateT typ- _ <- StateT spaces- return ()- return t]- pap94_99 = foldl1 mplus [do d783_283 <- get- t281_284 <- StateT char- case t281_284 of- '\n' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d783_283 ["char"])- let '\n' = t281_284- return ()- d784_285 <- get- t282_286 <- StateT char- case t282_286 of- '[' -> return ()- _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d784_285 ["char"])- let '[' = t282_286- return ()- d785_287 <- get- t283_288 <- StateT char- case t283_288 of- 'p' -> return ()- _ -> gets position >>= (throwError . mkParseError "'p'" "not match pattern: " "" d785_287 ["char"])- let 'p' = t283_288- return ()- d786_289 <- get- t284_290 <- StateT char- case t284_290 of- 'a' -> return ()- _ -> gets position >>= (throwError . mkParseError "'a'" "not match pattern: " "" d786_289 ["char"])- let 'a' = t284_290- return ()- d787_291 <- get- t285_292 <- StateT char- case t285_292 of- 'p' -> return ()- _ -> gets position >>= (throwError . mkParseError "'p'" "not match pattern: " "" d787_291 ["char"])- let 'p' = t285_292- return ()- d788_293 <- get- t286_294 <- StateT char- case t286_294 of- 'i' -> return ()- _ -> gets position >>= (throwError . mkParseError "'i'" "not match pattern: " "" d788_293 ["char"])- let 'i' = t286_294- return ()- d789_295 <- get- t287_296 <- StateT char- case t287_296 of- 'l' -> return ()- _ -> gets position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d789_295 ["char"])- let 'l' = t287_296- return ()- d790_297 <- get- t288_298 <- StateT char- case t288_298 of- 'l' -> return ()- _ -> gets position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d790_297 ["char"])- let 'l' = t288_298- return ()- d791_299 <- get- t289_300 <- StateT char- case t289_300 of- 'o' -> return ()- _ -> gets position >>= (throwError . mkParseError "'o'" "not match pattern: " "" d791_299 ["char"])- let 'o' = t289_300- return ()- d792_301 <- get- t290_302 <- StateT char- case t290_302 of- 'n' -> return ()- _ -> gets position >>= (throwError . mkParseError "'n'" "not match pattern: " "" d792_301 ["char"])- let 'n' = t290_302- return ()- d793_303 <- get- t291_304 <- StateT char- case t291_304 of- '|' -> return ()- _ -> gets position >>= (throwError . mkParseError "'|'" "not match pattern: " "" d793_303 ["char"])- let '|' = t291_304- return ()- d794_305 <- get- t292_306 <- StateT char- case t292_306 of- '\n' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d794_305 ["char"])- let '\n' = t292_306- return ()- return ()]- peg95_100 = foldl1 mplus [do mt <- optional156_307 (StateT monadType)- _ <- StateT spaces- return ()- s <- StateT sourceType- p <- StateT peg_- return (stPegQ mt (ConT $ mkName s) p),- do mt <- optional156_307 (StateT monadType)- p <- StateT peg_- return (stPegQ mt (ConT $ mkName "String") p)]- monadType96_101 = foldl1 mplus [do _ <- StateT spaces- return ()- d802_308 <- get- t300_309 <- StateT varToken- case t300_309 of- "monad" -> return ()- _ -> gets position >>= (throwError . mkParseError "\"monad\"" "not match pattern: " "" d802_308 ["varToken"])- let "monad" = t300_309- return ()- d803_310 <- get- t301_311 <- StateT char- case t301_311 of- ':' -> return ()- _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d803_310 ["char"])- let ':' = t301_311- return ()- _ <- StateT spaces- return ()- t <- StateT hsTypeArr- return t]- sourceType97_102 = foldl1 mplus [do d806_312 <- get- t304_313 <- StateT varToken- case t304_313 of- "source" -> return ()- _ -> gets position >>= (throwError . mkParseError "\"source\"" "not match pattern: " "" d806_312 ["varToken"])- let "source" = t304_313- return ()- d807_314 <- get- t305_315 <- StateT char- case t305_315 of- ':' -> return ()- _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d807_314 ["char"])- let ':' = t305_315- return ()- _ <- StateT spaces- return ()- v <- StateT typToken- return v]- peg_98_103 = foldl1 mplus [do _ <- StateT spaces- return ()- d <- StateT definition- p <- StateT peg_- return (d : p),- return []]- definition99_104 = foldl1 mplus [do v <- StateT variable- _ <- StateT spaces- return ()- d815_316 <- get- t313_317 <- StateT char- case t313_317 of- ':' -> return ()- _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d815_316 ["char"])- let ':' = t313_317- return ()- d816_318 <- get- t314_319 <- StateT char- case t314_319 of- ':' -> return ()- _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d816_318 ["char"])- let ':' = t314_319- return ()- _ <- StateT spaces- return ()- t <- StateT hsTypeArr- _ <- StateT spaces- return ()- d820_320 <- get- t318_321 <- StateT char- case t318_321 of- '=' -> return ()- _ -> gets position >>= (throwError . mkParseError "'='" "not match pattern: " "" d820_320 ["char"])- let '=' = t318_321- return ()- _ <- StateT spaces- return ()- sel <- StateT selection- _ <- StateT spaces- return ()- d824_322 <- get- t322_323 <- StateT char- case t322_323 of- ';' -> return ()- _ -> gets position >>= (throwError . mkParseError "';'" "not match pattern: " "" d824_322 ["char"])- let ';' = t322_323- return ()- return (definitionQ v (Just t) sel),- do v <- StateT variable- _ <- StateT spaces- return ()- d827_324 <- get- t325_325 <- StateT char- case t325_325 of- '<' -> return ()- _ -> gets position >>= (throwError . mkParseError "'<'" "not match pattern: " "" d827_324 ["char"])- let '<' = t325_325- return ()- d828_326 <- get- t326_327 <- StateT char- case t326_327 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d828_326 ["char"])- let '-' = t326_327- return ()- _ <- StateT spaces- return ()- sel <- StateT plainSelection- _ <- StateT spaces- return ()- d832_328 <- get- t330_329 <- StateT char- case t330_329 of- ';' -> return ()- _ -> gets position >>= (throwError . mkParseError "';'" "not match pattern: " "" d832_328 ["char"])- let ';' = t330_329- return ()- return (definitionQ v Nothing $ plainSelectionQ sel)]- selection100_105 = foldl1 mplus [do s <- StateT normalSelection- return (normalSelectionQ s),- do s <- StateT plainSelection- return (plainSelectionQ s)]- normalSelection101_106 = foldl1 mplus [do ex <- StateT expressionHs- _ <- StateT spaces- return ()- d837_330 <- get- t335_331 <- StateT char- case t335_331 of- '/' -> return ()- _ -> gets position >>= (throwError . mkParseError "'/'" "not match pattern: " "" d837_330 ["char"])- let '/' = t335_331- return ()- _ <- StateT spaces- return ()- sel <- StateT normalSelection- return (ex : sel),- do ex <- StateT expressionHs- return [ex]]- plainSelection102_107 = foldl1 mplus [do ex <- StateT plainExpressionHs- _ <- StateT spaces- return ()- d843_332 <- get- t341_333 <- StateT char- case t341_333 of- '/' -> return ()- _ -> gets position >>= (throwError . mkParseError "'/'" "not match pattern: " "" d843_332 ["char"])- let '/' = t341_333- return ()- _ <- StateT spaces- return ()- sel <- StateT plainSelection- return (ex : sel),- do ex <- StateT plainExpressionHs- return [ex]]- expressionHs103_108 = foldl1 mplus [do e <- StateT expression- _ <- StateT spaces- return ()- d849_334 <- get- t347_335 <- StateT char- case t347_335 of- '{' -> return ()- _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d849_334 ["char"])- let '{' = t347_335- return ()- _ <- StateT spaces- return ()- h <- StateT hsExpLam- _ <- StateT spaces- return ()- d853_336 <- get- t351_337 <- StateT char- case t351_337 of- '}' -> return ()- _ -> gets position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d853_336 ["char"])- let '}' = t351_337- return ()- return (expressionQ (e, h)),- do e <- StateT expressionHsSugar- return e]- expressionHsSugar104_109 = foldl1 mplus [do d855_338 <- get- t353_339 <- StateT char- case t353_339 of- '<' -> return ()- _ -> gets position >>= (throwError . mkParseError "'<'" "not match pattern: " "" d855_338 ["char"])- let '<' = t353_339- return ()- _ <- StateT spaces- return ()- h <- StateT hsExpLam- _ <- StateT spaces- return ()- d859_340 <- get- t357_341 <- StateT char- case t357_341 of- '>' -> return ()- _ -> gets position >>= (throwError . mkParseError "'>'" "not match pattern: " "" d859_340 ["char"])- let '>' = t357_341- return ()- return (expressionSugar h)]- plainExpressionHs105_110 = foldl1 mplus [do rfs <- list157_342 (foldl1 mplus [do rf <- StateT plainHAReadFromLs- _ <- StateT spaces- return ()- return rf])- return (plainExpressionQ rfs)]- plainHAReadFromLs106_111 = foldl1 mplus [do rf <- StateT plainReadFromLs- return (Here, rf),- do d864_343 <- get- t362_344 <- StateT char- case t362_344 of- '&' -> return ()- _ -> gets position >>= (throwError . mkParseError "'&'" "not match pattern: " "" d864_343 ["char"])- let '&' = t362_344- return ()- rf <- StateT plainReadFromLs- return (Ahead, rf),- do d866_345 <- get- t364_346 <- StateT char- case t364_346 of- '!' -> return ()- _ -> gets position >>= (throwError . mkParseError "'!'" "not match pattern: " "" d866_345 ["char"])- let '!' = t364_346- return ()- rf <- StateT plainReadFromLs- return (NAhead "", rf)]- plainReadFromLs107_112 = foldl1 mplus [do rf <- StateT readFromLs- return rf,- do rf <- StateT selectCharsLs- return rf]- expression108_113 = foldl1 mplus [do l <- StateT nameLeaf_- _ <- StateT spaces- return ()- e <- StateT expression- return (l : e),- return []]- nameLeaf_109_114 = foldl1 mplus [do d873_347 <- get- t371_348 <- StateT char- case t371_348 of- '!' -> return ()- _ -> gets position >>= (throwError . mkParseError "'!'" "not match pattern: " "" d873_347 ["char"])- let '!' = t371_348- return ()- nl <- StateT nameLeafNoCom- _ <- StateT spaces- return ()- com <- optional156_307 (StateT comForErr)- return (NAhead $ maybe "" id com, nl),- do d877_349 <- get- t375_350 <- StateT char- case t375_350 of- '&' -> return ()- _ -> gets position >>= (throwError . mkParseError "'&'" "not match pattern: " "" d877_349 ["char"])- let '&' = t375_350- return ()- nl <- StateT nameLeaf- return (Ahead, nl),- do nl <- StateT nameLeaf- return (Here, nl)]- nameLeaf110_115 = foldl1 mplus [do n <- StateT pat1- _ <- StateT spaces- return ()- com <- optional156_307 (StateT comForErr)- d883_351 <- get- t381_352 <- StateT char- case t381_352 of- ':' -> return ()- _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d883_351 ["char"])- let ':' = t381_352- return ()- (rf, p) <- StateT leaf- return (check (n, maybe "" id com) rf p),- do n <- StateT pat1- _ <- StateT spaces- return ()- com <- optional156_307 (StateT comForErr)- return (check (n,- maybe "" id com) (FromVariable Nothing) Nothing)]- nameLeafNoCom111_116 = foldl1 mplus [do n <- StateT pat1- _ <- StateT spaces- return ()- com <- optional156_307 (StateT comForErr)- d891_353 <- get- t389_354 <- StateT char- case t389_354 of- ':' -> return ()- _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d891_353 ["char"])- let ':' = t389_354- return ()- (rf, p) <- StateT leaf- return (check (n, maybe "" id com) rf p),- do n <- StateT pat1- _ <- StateT spaces- return ()- return (check (n,- "") (FromVariable Nothing) Nothing)]- comForErr112_117 = foldl1 mplus [do d895_355 <- get- t393_356 <- StateT char- case t393_356 of- '{' -> return ()- _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d895_355 ["char"])- let '{' = t393_356- return ()- d896_357 <- get- t394_358 <- StateT char- case t394_358 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d896_357 ["char"])- let '-' = t394_358- return ()- d897_359 <- get- t395_360 <- StateT char- case t395_360 of- '#' -> return ()- _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d897_359 ["char"])- let '#' = t395_360- return ()- _ <- StateT spaces- return ()- d899_361 <- get- t397_362 <- StateT char- case t397_362 of- '"' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d899_361 ["char"])- let '"' = t397_362- return ()- s <- StateT stringLit- d901_363 <- get- t399_364 <- StateT char- case t399_364 of- '"' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d901_363 ["char"])- let '"' = t399_364- return ()- _ <- StateT spaces- return ()- d903_365 <- get- t401_366 <- StateT char- case t401_366 of- '#' -> return ()- _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d903_365 ["char"])- let '#' = t401_366- return ()- d904_367 <- get- t402_368 <- StateT char- case t402_368 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d904_367 ["char"])- let '-' = t402_368- return ()- d905_369 <- get- t403_370 <- StateT char- case t403_370 of- '}' -> return ()- _ -> gets position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d905_369 ["char"])- let '}' = t403_370- return ()- _ <- StateT spaces- return ()- return s]- leaf113_118 = foldl1 mplus [do rf <- StateT readFromLs- t <- StateT test- return (rf, Just t),- do rf <- StateT readFromLs- return (rf, Nothing),- do t <- StateT test- return (FromVariable Nothing, Just t)]- patOp114_119 = foldl1 mplus [do p <- StateT pat- o <- StateT opConName- po <- StateT patOp- return (UInfixP p o po),- do p <- StateT pat- _ <- StateT spaces- return ()- d916_371 <- get- t414_372 <- StateT char- case t414_372 of- '`' -> return ()- _ -> gets position >>= (throwError . mkParseError "'`'" "not match pattern: " "" d916_371 ["char"])- let '`' = t414_372- return ()- t <- StateT typ- d918_373 <- get- t416_374 <- StateT char- case t416_374 of- '`' -> return ()- _ -> gets position >>= (throwError . mkParseError "'`'" "not match pattern: " "" d918_373 ["char"])- let '`' = t416_374- return ()- _ <- StateT spaces- return ()- po <- StateT patOp- return (UInfixP p (mkName t) po),- do p <- StateT pat- return p]- pat115_120 = foldl1 mplus [do t <- StateT typ- _ <- StateT spaces- return ()- ps <- StateT pats- return (ConP (mkName t) ps),- do d925_375 <- get- t423_376 <- StateT char- case t423_376 of- '(' -> return ()- _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d925_375 ["char"])- let '(' = t423_376- return ()- o <- StateT opConName- d927_377 <- get- t425_378 <- StateT char- case t425_378 of- ')' -> return ()- _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d927_377 ["char"])- let ')' = t425_378- return ()- _ <- StateT spaces- return ()- ps <- StateT pats- return (ConP o ps),- do p <- StateT pat1- return p]- pat1116_121 = foldl1 mplus [do t <- StateT typ- return (ConP (mkName t) []),- do d932_379 <- get- t430_380 <- StateT variable- case t430_380 of- "_" -> return ()- _ -> gets position >>= (throwError . mkParseError "\"_\"" "not match pattern: " "" d932_379 ["variable"])- let "_" = t430_380- return ()- return WildP,- do n <- StateT variable- return (VarP $ mkName n),- do i <- StateT integer- return (LitP (IntegerL i)),- do d935_381 <- get- t433_382 <- StateT char- case t433_382 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d935_381 ["char"])- let '-' = t433_382- return ()- _ <- StateT spaces- return ()- i <- StateT integer- return (LitP (IntegerL $ negate i)),- do d938_383 <- get- t436_384 <- StateT char- case t436_384 of- '\'' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d938_383 ["char"])- let '\'' = t436_384- return ()- c <- StateT charLit- d940_385 <- get- t438_386 <- StateT char- case t438_386 of- '\'' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d940_385 ["char"])- let '\'' = t438_386- return ()- return (LitP $ CharL c),- do d941_387 <- get- t439_388 <- StateT char- case t439_388 of- '"' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d941_387 ["char"])- let '"' = t439_388- return ()- s <- StateT stringLit- d943_389 <- get- t441_390 <- StateT char- case t441_390 of- '"' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d943_389 ["char"])- let '"' = t441_390- return ()- return (LitP $ StringL s),- do d944_391 <- get- t442_392 <- StateT char- case t442_392 of- '(' -> return ()- _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d944_391 ["char"])- let '(' = t442_392- return ()- p <- StateT patList- d946_393 <- get- t444_394 <- StateT char- case t444_394 of- ')' -> return ()- _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d946_393 ["char"])- let ')' = t444_394- return ()- return (TupP p),- do d947_395 <- get- t445_396 <- StateT char- case t445_396 of- '[' -> return ()- _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d947_395 ["char"])- let '[' = t445_396- return ()- p <- StateT patList- d949_397 <- get- t447_398 <- StateT char- case t447_398 of- ']' -> return ()- _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d949_397 ["char"])- let ']' = t447_398- return ()- return (ListP p)]- patList117_122 = foldl1 mplus [do p <- StateT patOp- _ <- StateT spaces- return ()- d952_399 <- get- t450_400 <- StateT char- case t450_400 of- ',' -> return ()- _ -> gets position >>= (throwError . mkParseError "','" "not match pattern: " "" d952_399 ["char"])- let ',' = t450_400- return ()- _ <- StateT spaces- return ()- ps <- StateT patList- return (p : ps),- do p <- StateT patOp- return [p],- return []]- opConName118_123 = foldl1 mplus [do d956_401 <- get- t454_402 <- StateT char- case t454_402 of- ':' -> return ()- _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d956_401 ["char"])- let ':' = t454_402- return ()- ot <- StateT opTail- return (mkName $ ':' : ot)]- charLit119_124 = foldl1 mplus [do d958_403 <- get- t456_404 <- StateT char- let c = t456_404- unless (c `notElem` "\\'") (gets position >>= (throwError . mkParseError "c `notElem` \"\\\\'\"" "not match: " "" d958_403 ["char"]))- return c,- do d959_405 <- get- t457_406 <- StateT char- case t457_406 of- '\\' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d959_405 ["char"])- let '\\' = t457_406- return ()- c <- StateT escapeC- return c]- stringLit120_125 = foldl1 mplus [do d961_407 <- get- t459_408 <- StateT char- let c = t459_408- unless (c `notElem` "\"\\") (gets position >>= (throwError . mkParseError "c `notElem` \"\\\"\\\\\"" "not match: " "" d961_407 ["char"]))- s <- StateT stringLit- return (c : s),- do d963_409 <- get- t461_410 <- StateT char- case t461_410 of- '\\' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d963_409 ["char"])- let '\\' = t461_410- return ()- c <- StateT escapeC- s <- StateT stringLit- return (c : s),- return ""]- escapeC121_126 = foldl1 mplus [do d966_411 <- get- t464_412 <- StateT char- case t464_412 of- '"' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d966_411 ["char"])- let '"' = t464_412- return ()- return '"',- do d967_413 <- get- t465_414 <- StateT char- case t465_414 of- '\'' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d967_413 ["char"])- let '\'' = t465_414- return ()- return '\'',- do d968_415 <- get- t466_416 <- StateT char- case t466_416 of- '\\' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d968_415 ["char"])- let '\\' = t466_416- return ()- return '\\',- do d969_417 <- get- t467_418 <- StateT char- case t467_418 of- 'n' -> return ()- _ -> gets position >>= (throwError . mkParseError "'n'" "not match pattern: " "" d969_417 ["char"])- let 'n' = t467_418- return ()- return '\n',- do d970_419 <- get- t468_420 <- StateT char- case t468_420 of- 't' -> return ()- _ -> gets position >>= (throwError . mkParseError "'t'" "not match pattern: " "" d970_419 ["char"])- let 't' = t468_420- return ()- return '\t']- pats122_127 = foldl1 mplus [do p <- StateT pat- _ <- StateT spaces- return ()- ps <- StateT pats- return (p : ps),- return []]- readFromLs123_128 = foldl1 mplus [do rf <- StateT readFrom- d975_421 <- get- t473_422 <- StateT char- case t473_422 of- '*' -> return ()- _ -> gets position >>= (throwError . mkParseError "'*'" "not match pattern: " "" d975_421 ["char"])- let '*' = t473_422- return ()- return (FromL List rf),- do rf <- StateT readFrom- d977_423 <- get- t475_424 <- StateT char- case t475_424 of- '+' -> return ()- _ -> gets position >>= (throwError . mkParseError "'+'" "not match pattern: " "" d977_423 ["char"])- let '+' = t475_424- return ()- return (FromL List1 rf),- do rf <- StateT readFrom- d979_425 <- get- t477_426 <- StateT char- case t477_426 of- '?' -> return ()- _ -> gets position >>= (throwError . mkParseError "'?'" "not match pattern: " "" d979_425 ["char"])- let '?' = t477_426- return ()- return (FromL Optional rf),- do rf <- StateT readFrom- return rf]- readFrom124_129 = foldl1 mplus [do v <- StateT variable- return (FromVariable $ Just v),- do d982_427 <- get- t480_428 <- StateT char- case t480_428 of- '(' -> return ()- _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d982_427 ["char"])- let '(' = t480_428- return ()- s <- StateT selection- d984_429 <- get- t482_430 <- StateT char- case t482_430 of- ')' -> return ()- _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d984_429 ["char"])- let ')' = t482_430- return ()- return (fromSelectionQ s),- do e <- StateT expressionHsSugar- return (fromSelectionQ $ normalSelectionQ [e])]- selectCharsLs125_130 = foldl1 mplus [do rf <- StateT selectChars- d987_431 <- get- t485_432 <- StateT char- case t485_432 of- '*' -> return ()- _ -> gets position >>= (throwError . mkParseError "'*'" "not match pattern: " "" d987_431 ["char"])- let '*' = t485_432- return ()- return (FromL List rf),- do rf <- StateT selectChars- d989_433 <- get- t487_434 <- StateT char- case t487_434 of- '+' -> return ()- _ -> gets position >>= (throwError . mkParseError "'+'" "not match pattern: " "" d989_433 ["char"])- let '+' = t487_434- return ()- return (FromL List1 rf),- do rf <- StateT selectChars- d991_435 <- get- t489_436 <- StateT char- case t489_436 of- '?' -> return ()- _ -> gets position >>= (throwError . mkParseError "'?'" "not match pattern: " "" d991_435 ["char"])- let '?' = t489_436- return ()- return (FromL Optional rf),- do rf <- StateT selectChars- return rf]- selectChars126_131 = foldl1 mplus [do d993_437 <- get- t491_438 <- StateT char- case t491_438 of- '[' -> return ()- _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d993_437 ["char"])- let '[' = t491_438- return ()- cs <- list1158_439 (foldl1 mplus [do d995_440 <- get- t493_441 <- StateT char- let c = t493_441- unless (isLower c) (gets position >>= (throwError . mkParseError "isLower c" "not match: " "" d995_440 ["char"]))- return c])- d996_442 <- get- t494_443 <- StateT char- case t494_443 of- ']' -> return ()- _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d996_442 ["char"])- let ']' = t494_443- return ()- return (fromTokenChars cs),- do d997_444 <- get- t495_445 <- StateT char- case t495_445 of- '[' -> return ()- _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d997_444 ["char"])- let '[' = t495_445- return ()- d998_446 <- get- t496_447 <- StateT char- let cb = t496_447- unless (cb `notElem` "\\-") (gets position >>= (throwError . mkParseError "cb `notElem` \"\\\\-\"" "not match: " "" d998_446 ["char"]))- d999_448 <- get- t497_449 <- StateT char- case t497_449 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d999_448 ["char"])- let '-' = t497_449- return ()- d1000_450 <- get- t498_451 <- StateT char- let ce = t498_451- unless (ce `notElem` "\\-") (gets position >>= (throwError . mkParseError "ce `notElem` \"\\\\-\"" "not match: " "" d1000_450 ["char"]))- d1001_452 <- get- t499_453 <- StateT char- case t499_453 of- ']' -> return ()- _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d1001_452 ["char"])- let ']' = t499_453- return ()- return (fromTokenChars [cb .. ce]),- do d1002_454 <- get- t500_455 <- StateT char- case t500_455 of- '\'' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d1002_454 ["char"])- let '\'' = t500_455- return ()- d1003_456 <- get- t501_457 <- StateT char- let c = t501_457- unless (c `notElem` "\\'") (gets position >>= (throwError . mkParseError "c `notElem` \"\\\\'\"" "not match: " "" d1003_456 ["char"]))- d1004_458 <- get- t502_459 <- StateT char- case t502_459 of- '\'' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d1004_458 ["char"])- let '\'' = t502_459- return ()- return (fromTokenChars [c])]- test127_132 = foldl1 mplus [do d1005_460 <- get- t503_461 <- StateT char- case t503_461 of- '[' -> return ()- _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d1005_460 ["char"])- let '[' = t503_461- return ()- h <- StateT hsExpLam- _ <- StateT spaces- return ()- com <- optional156_307 (StateT comForErr)- d1009_462 <- get- t507_463 <- StateT char- case t507_463 of- ']' -> return ()- _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d1009_462 ["char"])- let ']' = t507_463- return ()- return (h, maybe "" id com)]- hsExpLam128_133 = foldl1 mplus [do d1010_464 <- get- t508_465 <- StateT char- case t508_465 of- '\\' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d1010_464 ["char"])- let '\\' = t508_465- return ()- _ <- StateT spaces- return ()- ps <- StateT pats- _ <- StateT spaces- return ()- d1014_466 <- get- t512_467 <- StateT char- case t512_467 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1014_466 ["char"])- let '-' = t512_467- return ()- d1015_468 <- get- t513_469 <- StateT char- case t513_469 of- '>' -> return ()- _ -> gets position >>= (throwError . mkParseError "'>'" "not match pattern: " "" d1015_468 ["char"])- let '>' = t513_469- return ()- _ <- StateT spaces- return ()- e <- StateT hsExpTyp- return (LamE ps e),- do e <- StateT hsExpTyp- return e]- hsExpTyp129_134 = foldl1 mplus [do eo <- StateT hsExpOp- d1020_470 <- get- t518_471 <- StateT char- case t518_471 of- ':' -> return ()- _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d1020_470 ["char"])- let ':' = t518_471- return ()- d1021_472 <- get- t519_473 <- StateT char- case t519_473 of- ':' -> return ()- _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d1021_472 ["char"])- let ':' = t519_473- return ()- _ <- StateT spaces- return ()- t <- StateT hsTypeArr- return (SigE eo t),- do eo <- StateT hsExpOp- return eo]- hsExpOp130_135 = foldl1 mplus [do l <- StateT hsExp- _ <- StateT spaces- return ()- o <- StateT hsOp- _ <- StateT spaces- return ()- r <- StateT hsExpOp- return (UInfixE (l id) o r),- do e <- StateT hsExp- return (e id)]- hsOp131_136 = foldl1 mplus [do d1031_474 <- get- t529_475 <- StateT char- let c = t529_475- unless (c `elem` "+*/-!|&.^=<>$") (gets position >>= (throwError . mkParseError "c `elem` \"+*/-!|&.^=<>$\"" "not match: " "" d1031_474 ["char"]))- o <- StateT opTail- return (VarE $ mkName $ c : o),- do d1033_476 <- get- t531_477 <- StateT char- case t531_477 of- ':' -> return ()- _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d1033_476 ["char"])- let ':' = t531_477- return ()- d1035_478 <- get- do err1168_479 <- ((do d1034_480 <- get- t532_481 <- StateT char- case t532_481 of- ':' -> return ()- _ -> gets position >>= (throwError . mkParseError "':'" "not match pattern: " "" d1034_480 ["char"])- let ':' = t532_481- return ()) >> return False) `catchError` const (return True)- unless err1168_479 (gets position >>= (throwError . mkParseError "!':':" "not match: " "" d1035_478 ["char"]))- put d1035_478- o <- StateT opTail- return (ConE $ mkName $ ':' : o),- do d1037_482 <- get- t534_483 <- StateT char- case t534_483 of- '`' -> return ()- _ -> gets position >>= (throwError . mkParseError "'`'" "not match pattern: " "" d1037_482 ["char"])- let '`' = t534_483- return ()- v <- StateT variable- d1039_484 <- get- t536_485 <- StateT char- case t536_485 of- '`' -> return ()- _ -> gets position >>= (throwError . mkParseError "'`'" "not match pattern: " "" d1039_484 ["char"])- let '`' = t536_485- return ()- return (VarE $ mkName v),- do d1040_486 <- get- t537_487 <- StateT char- case t537_487 of- '`' -> return ()- _ -> gets position >>= (throwError . mkParseError "'`'" "not match pattern: " "" d1040_486 ["char"])- let '`' = t537_487- return ()- t <- StateT typ- d1042_488 <- get- t539_489 <- StateT char- case t539_489 of- '`' -> return ()- _ -> gets position >>= (throwError . mkParseError "'`'" "not match pattern: " "" d1042_488 ["char"])- let '`' = t539_489- return ()- return (ConE $ mkName t)]- opTail132_137 = foldl1 mplus [do d1043_490 <- get- t540_491 <- StateT char- let c = t540_491- unless (c `elem` ":+*/-!|&.^=<>$") (gets position >>= (throwError . mkParseError "c `elem` \":+*/-!|&.^=<>$\"" "not match: " "" d1043_490 ["char"]))- s <- StateT opTail- return (c : s),- return ""]- hsExp133_138 = foldl1 mplus [do e <- StateT hsExp1- _ <- StateT spaces- return ()- h <- StateT hsExp- return (\f -> h (f e `AppE`)),- do e <- StateT hsExp1- return (\f -> f e)]- hsExp1134_139 = foldl1 mplus [do d1049_492 <- get- t546_493 <- StateT char- case t546_493 of- '(' -> return ()- _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d1049_492 ["char"])- let '(' = t546_493- return ()- l <- optional156_307 (foldl1 mplus [do e <- StateT hsExpTyp- return e])- _ <- StateT spaces- return ()- o <- StateT hsOp- _ <- StateT spaces- return ()- r <- optional156_307 (foldl1 mplus [do e <- StateT hsExpTyp- return e])- d1057_494 <- get- t554_495 <- StateT char- case t554_495 of- ')' -> return ()- _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d1057_494 ["char"])- let ')' = t554_495- return ()- return (InfixE l o r),- do d1058_496 <- get- t555_497 <- StateT char- case t555_497 of- '(' -> return ()- _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d1058_496 ["char"])- let '(' = t555_497- return ()- et <- StateT hsExpTpl- d1060_498 <- get- t557_499 <- StateT char- case t557_499 of- ')' -> return ()- _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d1060_498 ["char"])- let ')' = t557_499- return ()- return (TupE et),- do d1061_500 <- get- t558_501 <- StateT char- case t558_501 of- '[' -> return ()- _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d1061_500 ["char"])- let '[' = t558_501- return ()- et <- StateT hsExpTpl- d1063_502 <- get- t560_503 <- StateT char- case t560_503 of- ']' -> return ()- _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d1063_502 ["char"])- let ']' = t560_503- return ()- return (ListE et),- do v <- StateT variable- return (VarE $ mkName v),- do t <- StateT typ- return (ConE $ mkName t),- do i <- StateT integer- _ <- StateT spaces- return ()- return (LitE $ integerL i),- do d1068_504 <- get- t565_505 <- StateT char- case t565_505 of- '\'' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d1068_504 ["char"])- let '\'' = t565_505- return ()- c <- StateT charLit- d1070_506 <- get- t567_507 <- StateT char- case t567_507 of- '\'' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d1070_506 ["char"])- let '\'' = t567_507- return ()- return (LitE $ charL c),- do d1071_508 <- get- t568_509 <- StateT char- case t568_509 of- '"' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d1071_508 ["char"])- let '"' = t568_509- return ()- s <- StateT stringLit- d1073_510 <- get- t570_511 <- StateT char- case t570_511 of- '"' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d1073_510 ["char"])- let '"' = t570_511- return ()- return (LitE $ stringL s),- do d1074_512 <- get- t571_513 <- StateT char- case t571_513 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1074_512 ["char"])- let '-' = t571_513- return ()- _ <- StateT spaces- return ()- e <- StateT hsExp1- return (AppE (VarE $ mkName "negate") e)]- hsExpTpl135_140 = foldl1 mplus [do e <- StateT hsExpLam- _ <- StateT spaces- return ()- d1079_514 <- get- t576_515 <- StateT char- case t576_515 of- ',' -> return ()- _ -> gets position >>= (throwError . mkParseError "','" "not match pattern: " "" d1079_514 ["char"])- let ',' = t576_515- return ()- _ <- StateT spaces- return ()- et <- StateT hsExpTpl- return (e : et),- do e <- StateT hsExpLam- return [e],- return []]- hsTypeArr136_141 = foldl1 mplus [do l <- StateT hsType- d1084_516 <- get- t581_517 <- StateT char- case t581_517 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1084_516 ["char"])- let '-' = t581_517- return ()- d1085_518 <- get- t582_519 <- StateT char- case t582_519 of- '>' -> return ()- _ -> gets position >>= (throwError . mkParseError "'>'" "not match pattern: " "" d1085_518 ["char"])- let '>' = t582_519- return ()- _ <- StateT spaces- return ()- r <- StateT hsTypeArr- return (AppT (AppT ArrowT $ l id) r),- do t <- StateT hsType- return (t id)]- hsType137_142 = foldl1 mplus [do t <- StateT hsType1- ts <- StateT hsType- return (\f -> ts (f t `AppT`)),- do t <- StateT hsType1- return ($ t)]- hsType1138_143 = foldl1 mplus [do d1092_520 <- get- t589_521 <- StateT char- case t589_521 of- '[' -> return ()- _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d1092_520 ["char"])- let '[' = t589_521- return ()- d1093_522 <- get- t590_523 <- StateT char- case t590_523 of- ']' -> return ()- _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d1093_522 ["char"])- let ']' = t590_523- return ()- _ <- StateT spaces- return ()- return ListT,- do d1095_524 <- get- t592_525 <- StateT char- case t592_525 of- '[' -> return ()- _ -> gets position >>= (throwError . mkParseError "'['" "not match pattern: " "" d1095_524 ["char"])- let '[' = t592_525- return ()- t <- StateT hsTypeArr- d1097_526 <- get- t594_527 <- StateT char- case t594_527 of- ']' -> return ()- _ -> gets position >>= (throwError . mkParseError "']'" "not match pattern: " "" d1097_526 ["char"])- let ']' = t594_527- return ()- _ <- StateT spaces- return ()- return (ListT `AppT` t),- do d1099_528 <- get- t596_529 <- StateT char- case t596_529 of- '(' -> return ()- _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d1099_528 ["char"])- let '(' = t596_529- return ()- _ <- StateT spaces- return ()- tt <- StateT hsTypeTpl- d1102_530 <- get- t599_531 <- StateT char- case t599_531 of- ')' -> return ()- _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d1102_530 ["char"])- let ')' = t599_531- return ()- _ <- StateT spaces- return ()- return (foldl AppT (TupleT $ length tt) tt),- do t <- StateT typToken- return (ConT $ mkName t),- do d1105_532 <- get- t602_533 <- StateT char- case t602_533 of- '(' -> return ()- _ -> gets position >>= (throwError . mkParseError "'('" "not match pattern: " "" d1105_532 ["char"])- let '(' = t602_533- return ()- d1106_534 <- get- t603_535 <- StateT char- case t603_535 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1106_534 ["char"])- let '-' = t603_535- return ()- d1107_536 <- get- t604_537 <- StateT char- case t604_537 of- '>' -> return ()- _ -> gets position >>= (throwError . mkParseError "'>'" "not match pattern: " "" d1107_536 ["char"])- let '>' = t604_537- return ()- d1108_538 <- get- t605_539 <- StateT char- case t605_539 of- ')' -> return ()- _ -> gets position >>= (throwError . mkParseError "')'" "not match pattern: " "" d1108_538 ["char"])- let ')' = t605_539- return ()- _ <- StateT spaces- return ()- return ArrowT]- hsTypeTpl139_144 = foldl1 mplus [do t <- StateT hsTypeArr- d1111_540 <- get- t608_541 <- StateT char- case t608_541 of- ',' -> return ()- _ -> gets position >>= (throwError . mkParseError "','" "not match pattern: " "" d1111_540 ["char"])- let ',' = t608_541- return ()- _ <- StateT spaces- return ()- tt <- StateT hsTypeTpl- return (t : tt),- do t <- StateT hsTypeArr- return [t],- return []]- typ140_145 = foldl1 mplus [do u <- StateT upper- t <- StateT tvtail- return (u : t)]- variable141_146 = foldl1 mplus [do l <- StateT lower- t <- StateT tvtail- return (l : t)]- tvtail142_147 = foldl1 mplus [do a <- StateT alpha- t <- StateT tvtail- return (a : t),- return ""]- integer143_148 = foldl1 mplus [do dh <- StateT digit- ds <- list157_342 (foldl1 mplus [do d <- StateT digit- return d])- return (read $ dh : ds)]- alpha144_149 = foldl1 mplus [do u <- StateT upper- return u,- do l <- StateT lower- return l,- do d <- StateT digit- return d,- do d1127_542 <- get- t624_543 <- StateT char- case t624_543 of- '\'' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d1127_542 ["char"])- let '\'' = t624_543- return ()- return '\'']- upper145_150 = foldl1 mplus [do d1128_544 <- get- t625_545 <- StateT char- let u = t625_545- unless (isUpper u) (gets position >>= (throwError . mkParseError "isUpper u" "not match: " "" d1128_544 ["char"]))- return u]- lower146_151 = foldl1 mplus [do d1129_546 <- get- t626_547 <- StateT char- let l = t626_547- unless (isLower l || l == '_') (gets position >>= (throwError . mkParseError "isLower l || l == '_'" "not match: " "" d1129_546 ["char"]))- return l]- digit147_152 = foldl1 mplus [do d1130_548 <- get- t627_549 <- StateT char- let d = t627_549- unless (isDigit d) (gets position >>= (throwError . mkParseError "isDigit d" "not match: " "" d1130_548 ["char"]))- return d]- spaces148_153 = foldl1 mplus [do _ <- StateT space- return ()- _ <- StateT spaces- return ()- return (),- return ()]- space149_154 = foldl1 mplus [do d1133_550 <- get- t630_551 <- StateT char- let s = t630_551- unless (isSpace s) (gets position >>= (throwError . mkParseError "isSpace s" "not match: " "" d1133_550 ["char"]))- return (),- do d1134_552 <- get- t631_553 <- StateT char- case t631_553 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1134_552 ["char"])- let '-' = t631_553- return ()- d1135_554 <- get- t632_555 <- StateT char- case t632_555 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1135_554 ["char"])- let '-' = t632_555- return ()- _ <- StateT notNLString- return ()- _ <- StateT newLine- return ()- return (),- do _ <- StateT comment- return ()- return ()]- notNLString150_155 = foldl1 mplus [do d1140_556 <- get- do err1169_557 <- ((do _ <- StateT newLine- return ()) >> return False) `catchError` const (return True)- unless err1169_557 (gets position >>= (throwError . mkParseError "!_:newLine" "not match: " "" d1140_556 ["newLine"]))- put d1140_556- c <- StateT char- s <- StateT notNLString- return (c : s),- return ""]- newLine151_156 = foldl1 mplus [do d1143_558 <- get- t639_559 <- StateT char- case t639_559 of- '\n' -> return ()- _ -> gets position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d1143_558 ["char"])- let '\n' = t639_559- return ()- return ()]- comment152_157 = foldl1 mplus [do d1144_560 <- get- t640_561 <- StateT char- case t640_561 of- '{' -> return ()- _ -> gets position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d1144_560 ["char"])- let '{' = t640_561- return ()- d1145_562 <- get- t641_563 <- StateT char- case t641_563 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1145_562 ["char"])- let '-' = t641_563- return ()- d1147_564 <- get- do err1170_565 <- ((do d1146_566 <- get- t642_567 <- StateT char- case t642_567 of- '#' -> return ()- _ -> gets position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d1146_566 ["char"])- let '#' = t642_567- return ()) >> return False) `catchError` const (return True)- unless err1170_565 (gets position >>= (throwError . mkParseError "!'#':" "not match: " "" d1147_564 ["char"]))- put d1147_564- _ <- StateT comments- return ()- _ <- StateT comEnd- return ()- return ()]- comments153_158 = foldl1 mplus [do _ <- StateT notComStr- return ()- _ <- StateT comment- return ()- _ <- StateT comments- return ()- return (),- do _ <- StateT notComStr- return ()- return ()]- notComStr154_159 = foldl1 mplus [do d1155_568 <- get- do err1171_569 <- ((do _ <- StateT comment- return ()) >> return False) `catchError` const (return True)- unless err1171_569 (gets position >>= (throwError . mkParseError "!_:comment" "not match: " "" d1155_568 ["comment"]))- put d1155_568- d1157_570 <- get- do err1172_571 <- ((do _ <- StateT comEnd- return ()) >> return False) `catchError` const (return True)- unless err1172_571 (gets position >>= (throwError . mkParseError "!_:comEnd" "not match: " "" d1157_570 ["comEnd"]))- put d1157_570- _ <- StateT char- return ()- _ <- StateT notComStr- return ()- return (),- return ()]- comEnd155_160 = foldl1 mplus [do d1160_572 <- get- t653_573 <- StateT char- case t653_573 of- '-' -> return ()- _ -> gets position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d1160_572 ["char"])- let '-' = t653_573- return ()- d1161_574 <- get- t654_575 <- StateT char- case t654_575 of- '}' -> return ()- _ -> gets position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d1161_574 ["char"])- let '}' = t654_575- return ()- return ()]- list157_342 :: forall m a . (MonadPlus m, Applicative m) =>- m a -> m ([a])- list1158_439 :: forall m a . (MonadPlus m, Applicative m) =>- m a -> m ([a])- list157_342 p = list1158_439 p `mplus` return []- list1158_439 p = ((:) <$> p) <*> list157_342 p- optional156_307 :: forall m a . (MonadPlus m, Applicative m) =>- m a -> m (Maybe a)- optional156_307 p = (Just <$> p) `mplus` return Nothing+{-# LANGUAGE FlexibleContexts, TemplateHaskell, UndecidableInstances, BangPatterns, PackageImports, TypeFamilies, RankNTypes #-}+module Text.Papillon.Parser (+ Lookahead(..),+ Lists(..),++ Peg,+ Definition,+ Selection,+ Expression,+ Check,+ ReadFrom(..),++ hsw,++ pprCheck,++ parse,+ Source(..),+ SourceList(..),+ Derivs(pegFile, peg, char),+ ParseError(..),+ mkParseError,+ pePositionS,+ Pos(..),+ ListPos(..),++ PPragma(..),+ ModuleName,+ Exports,+ Code,++ runError,++ dvCharsN++) where++import Text.Papillon.Papillon+import "monads-tf" Control.Monad.State+import "monads-tf" Control.Monad.Error+import Control.Applicative(Applicative, (<$>), (<*>))++import Language.Haskell.TH {- (+ Name, TypeQ, PatQ, ExpQ, mkName,+ conT, tupleT, listT, appT, arrowT,+ wildP, litP, varP, conP, tupP, listP, uInfixP,+ litE, varE, conE, tupE, listE, sigE, appE, infixE, uInfixE, lamE,+ integerL, charL, stringL) -}+import Data.Char (isDigit, isUpper, isLower, isAlphaNum, isHexDigit, chr)+import Numeric (readHex)++import Language.Haskell.TH.PprLib+ ((<>), hsep, colon, brackets, text, braces, Doc, parens, (<+>), quotes)+import qualified Language.Haskell.TH.PprLib as P+import Control.Arrow ((***))+import Data.List+import Data.Maybe++data Lookahead = Here | Ahead | NAhead String deriving (Show, Eq)+data Lists = List | List1 | Optional deriving (Show, Eq)++type PegFile = ([PPragma], ModuleName, Maybe Exports, Code, STPeg, Code)+data PPragma = LanguagePragma [String] | OtherPragma String deriving Show+type ModuleName = [String]+type Exports = String+type Code = String++type STPeg = (Maybe Type, Type, String, Peg)+type Peg = [Definition]+type Definition = (String, Maybe Type, Selection)+type Selection = [Expression]+type Expression = Either ([(Lookahead, Check)], Maybe Exp) Exp+type Check = Either ((Pat, String), ReadFrom, Maybe (Exp, String)) (Char, Lists)+data ReadFrom+ = FromVariable (Maybe String)+ | FromSelection Selection+ | FromL Lists ReadFrom+ deriving Show++pprCheck :: Check -> Doc+pprCheck (Left ((pt, _), rf, tst)) =+ ppr pt <> colon <> ppr rf <> maybe P.empty (brackets . ppr . fst) tst+pprCheck (Right (c, l)) = quotes (P.char c) <> ppr l++instance Ppr ReadFrom where+ ppr (FromVariable (Just v)) = text v+ ppr (FromVariable _) = P.empty+ ppr (FromL l rf) = ppr rf <> ppr l+ ppr (FromSelection sel) = parens $ ps sel+ where+ ps = hsep . intersperse (P.char '/') . map pe+ pe (Left (ex, hs)) = (<+> braces (maybe P.empty ppr hs)) $ hsep $+ map (uncurry ($) . (((<>) . ppr) *** pprCheck)) ex+ pe (Right ex) = P.char '<' <> ppr ex <> P.char '>'+++instance Ppr Lookahead where+ ppr Here = P.empty+ ppr Ahead = P.char '&'+ ppr (NAhead _) = P.char '!'++instance Ppr Lists where+ ppr List = P.char '*'+ ppr List1 = P.char '+'+ ppr Optional = P.char '?'++mkPegFile :: [PPragma] -> Maybe ([String], Maybe String) -> String -> String ->+ STPeg -> String -> PegFile+mkPegFile ps (Just md) x y z w = (ps, fst md, snd md, x ++ "\n" ++ y, z, w)+mkPegFile ps Nothing x y z w = (ps, [], Nothing, x ++ "\n" ++ y, z, w)++dvCharsN :: String+dvCharsN = "char"++opChars :: String+opChars = ":!#$%&*+./<=>?@\\^|-~"++data Word+ = WSymbol String+ | WType [String] String+ | WVar [String] String+ | WOpCon String+ | WOp String+ | WChar Char+ | WString String+ | WInteger Integer+ | WOQuasiQuote String+ | WCQuasiQuote++ -- ["module", "where", "import", "if", "then", "else"]+ | WModule+ | WWhere+ | WImport+ | WIf+ | WThen+ | WElse+ | WLet+ | WIn++ -- ["::", "->", "..", "{-#", "#-}"]+ | WTypeDef+ | WRightArrow+ | WDotDot+ | WOComment+ | WCComment++ -- "!&*+?=/:<>"+ | WBang+ | WAmp+ | WAsterisk+ | WPlus+ | WQuestion+ | WEqual+ | WSlash+ | WColon+ | WLT+ | WGT++ -- "[]{}()"+ | WOBracket+ | WCBracket+ | WOBrace+ | WCBrace+ | WOParen+ | WCParen++ -- ",;`"+ | WComma+ | WSemiColon+ | WBackQuote+ deriving Show+++data Derivs+ = Derivs {pegFile :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((PegFile, Derivs))),+ pragma :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((PPragma, Derivs))),+ pragmaStr :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((String, Derivs))),+ pragmaItems :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (([String], Derivs))),+ moduleDec :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Maybe (([String], Maybe String)), Derivs))),+ moduleName :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((ModuleName, Derivs))),+ moduleDecStr :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((String, Derivs))),+ whr :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((), Derivs))),+ preImpPap :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((String, Derivs))),+ prePeg :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((String, Derivs))),+ afterPeg :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((String, Derivs))),+ importPapillon :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((), Derivs))),+ peg :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((STPeg, Derivs))),+ peg_ :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((STPeg, Derivs))),+ monadType :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Type, Derivs))),+ sourceType :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Type, Derivs))),+ prefix :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((String, Derivs))),+ definition :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Definition, Derivs))),+ selection :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (([Expression], Derivs))),+ normalSelection :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (([Expression], Derivs))),+ expressionHs :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Expression, Derivs))),+ expressionHsSugar :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Expression, Derivs))),+ expressionHsSugar' :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Expression, Derivs))),+ expression :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (([(Lookahead, Check)], Derivs))),+ nameLeaf_ :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((Lookahead, Check), Derivs))),+ nameLeaf :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Check, Derivs))),+ nameLeafNoCom :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Check, Derivs))),+ comForErr :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((String, Derivs))),+ leaf :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((ReadFrom, Maybe ((Exp, String))), Derivs))),+ patOp :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Pat, Derivs))),+ pat :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Pat, Derivs))),+ pat1 :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Pat, Derivs))),+ patList :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (([Pat], Derivs))),+ pats :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (([Pat], Derivs))),+ charLitLs :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Check, Derivs))),+ readFromLs :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((ReadFrom, Derivs))),+ readFrom :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((ReadFrom, Derivs))),+ test :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((Exp, String), Derivs))),+ hsExpLam :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Exp, Derivs))),+ hsExpTyp :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Exp, Derivs))),+ hsExpOp :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Exp, Derivs))),+ hsOp :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Exp, Derivs))),+ hsExpLam' :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Exp, Derivs))),+ hsExpTyp' :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Exp, Derivs))),+ hsExpOp' :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Exp, Derivs))),+ hsOp' :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Exp, Derivs))),+ hsExp :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((Exp -> Exp) -> Exp, Derivs))),+ hsExp1 :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Exp, Derivs))),+ hsExpTpl :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (([Exp], Derivs))),+ hsTypeArr :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Type, Derivs))),+ hsType :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((Type -> Type) -> Type, Derivs))),+ hsType1 :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Type, Derivs))),+ hsTypeTpl :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (([Type], Derivs))),+ wrd :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Word, Derivs))),+ hsw :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Word, Derivs))),+ word :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Word, Derivs))),+ hsWord :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Word, Derivs))),+ bras :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Word, Derivs))),+ typ :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((String, Derivs))),+ var :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((String, Derivs))),+ strLit :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((String, Derivs))),+ escChar :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Char, Derivs))),+ space :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((), Derivs))),+ space' :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((), Derivs))),+ lineComment :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((), Derivs))),+ comment :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((), Derivs))),+ comments :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((), Derivs))),+ comStr :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((), Derivs))),+ semiColon :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((), Derivs))),+ notSemiColon :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ (((), Derivs))),+ char :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Token String, Derivs))),+ position :: (ErrorT (ParseError (Pos String) Derivs)+ (State ((Maybe Int)))+ ((Pos String, Derivs)))}+parse :: String -> Derivs+parse = parse1632_0 initialPos+ where parse1632_0 pos1631_1 s1633_2 = d144_3+ where d144_3 = Derivs pegFile1_4 pragma2_5 pragmaStr3_6 pragmaItems4_7 moduleDec5_8 moduleName6_9 moduleDecStr7_10 whr8_11 preImpPap9_12 prePeg10_13 afterPeg11_14 importPapillon12_15 peg13_16 peg_14_17 monadType15_18 sourceType16_19 prefix17_20 definition18_21 selection19_22 normalSelection20_23 expressionHs21_24 expressionHsSugar22_25 expressionHsSugar'23_26 expression24_27 nameLeaf_25_28 nameLeaf26_29 nameLeafNoCom27_30 comForErr28_31 leaf29_32 patOp30_33 pat31_34 pat132_35 patList33_36 pats34_37 charLitLs35_38 readFromLs36_39 readFrom37_40 test38_41 hsExpLam39_42 hsExpTyp40_43 hsExpOp41_44 hsOp42_45 hsExpLam'43_46 hsExpTyp'44_47 hsExpOp'45_48 hsOp'46_49 hsExp47_50 hsExp148_51 hsExpTpl49_52 hsTypeArr50_53 hsType51_54 hsType152_55 hsTypeTpl53_56 wrd54_57 hsw55_58 word56_59 hsWord57_60 bras58_61 typ59_62 var60_63 strLit61_64 escChar62_65 space63_66 space'64_67 lineComment65_68 comment66_69 comments67_70 comStr68_71 semiColon69_72 notSemiColon70_73 chars1634_74 (return (pos1631_1,+ d144_3))+ pegFile1_4 = runStateT pegFile71_75 d144_3+ pragma2_5 = runStateT pragma72_76 d144_3+ pragmaStr3_6 = runStateT pragmaStr73_77 d144_3+ pragmaItems4_7 = runStateT pragmaItems74_78 d144_3+ moduleDec5_8 = runStateT moduleDec75_79 d144_3+ moduleName6_9 = runStateT moduleName76_80 d144_3+ moduleDecStr7_10 = runStateT moduleDecStr77_81 d144_3+ whr8_11 = runStateT whr78_82 d144_3+ preImpPap9_12 = runStateT preImpPap79_83 d144_3+ prePeg10_13 = runStateT prePeg80_84 d144_3+ afterPeg11_14 = runStateT afterPeg81_85 d144_3+ importPapillon12_15 = runStateT importPapillon82_86 d144_3+ peg13_16 = runStateT peg83_87 d144_3+ peg_14_17 = runStateT peg_84_88 d144_3+ monadType15_18 = runStateT monadType85_89 d144_3+ sourceType16_19 = runStateT sourceType86_90 d144_3+ prefix17_20 = runStateT prefix87_91 d144_3+ definition18_21 = runStateT definition88_92 d144_3+ selection19_22 = runStateT selection89_93 d144_3+ normalSelection20_23 = runStateT normalSelection90_94 d144_3+ expressionHs21_24 = runStateT expressionHs91_95 d144_3+ expressionHsSugar22_25 = runStateT expressionHsSugar92_96 d144_3+ expressionHsSugar'23_26 = runStateT expressionHsSugar'93_97 d144_3+ expression24_27 = runStateT expression94_98 d144_3+ nameLeaf_25_28 = runStateT nameLeaf_95_99 d144_3+ nameLeaf26_29 = runStateT nameLeaf96_100 d144_3+ nameLeafNoCom27_30 = runStateT nameLeafNoCom97_101 d144_3+ comForErr28_31 = runStateT comForErr98_102 d144_3+ leaf29_32 = runStateT leaf99_103 d144_3+ patOp30_33 = runStateT patOp100_104 d144_3+ pat31_34 = runStateT pat101_105 d144_3+ pat132_35 = runStateT pat1102_106 d144_3+ patList33_36 = runStateT patList103_107 d144_3+ pats34_37 = runStateT pats104_108 d144_3+ charLitLs35_38 = runStateT charLitLs105_109 d144_3+ readFromLs36_39 = runStateT readFromLs106_110 d144_3+ readFrom37_40 = runStateT readFrom107_111 d144_3+ test38_41 = runStateT test108_112 d144_3+ hsExpLam39_42 = runStateT hsExpLam109_113 d144_3+ hsExpTyp40_43 = runStateT hsExpTyp110_114 d144_3+ hsExpOp41_44 = runStateT hsExpOp111_115 d144_3+ hsOp42_45 = runStateT hsOp112_116 d144_3+ hsExpLam'43_46 = runStateT hsExpLam'113_117 d144_3+ hsExpTyp'44_47 = runStateT hsExpTyp'114_118 d144_3+ hsExpOp'45_48 = runStateT hsExpOp'115_119 d144_3+ hsOp'46_49 = runStateT hsOp'116_120 d144_3+ hsExp47_50 = runStateT hsExp117_121 d144_3+ hsExp148_51 = runStateT hsExp1118_122 d144_3+ hsExpTpl49_52 = runStateT hsExpTpl119_123 d144_3+ hsTypeArr50_53 = runStateT hsTypeArr120_124 d144_3+ hsType51_54 = runStateT hsType121_125 d144_3+ hsType152_55 = runStateT hsType1122_126 d144_3+ hsTypeTpl53_56 = runStateT hsTypeTpl123_127 d144_3+ wrd54_57 = runStateT wrd124_128 d144_3+ hsw55_58 = runStateT hsw125_129 d144_3+ word56_59 = runStateT word126_130 d144_3+ hsWord57_60 = runStateT hsWord127_131 d144_3+ bras58_61 = runStateT bras128_132 d144_3+ typ59_62 = runStateT typ129_133 d144_3+ var60_63 = runStateT var130_134 d144_3+ strLit61_64 = runStateT strLit131_135 d144_3+ escChar62_65 = runStateT escChar132_136 d144_3+ space63_66 = runStateT space133_137 d144_3+ space'64_67 = runStateT space'134_138 d144_3+ lineComment65_68 = runStateT lineComment135_139 d144_3+ comment66_69 = runStateT comment136_140 d144_3+ comments67_70 = runStateT comments137_141 d144_3+ comStr68_71 = runStateT comStr138_142 d144_3+ semiColon69_72 = runStateT semiColon139_143 d144_3+ notSemiColon70_73 = runStateT notSemiColon140_144 d144_3+ chars1634_74 = runStateT (case getToken s1633_2 of+ Just (c1616_145,+ s'1630_146) -> do put (parse1632_0 (updatePos c1616_145 pos1631_1) s'1630_146)+ return c1616_145+ _ -> StateT position >>= (throwError . mkParseError "" "end of input" "" undefined [])) d144_3+ pegFile71_75 = foldl1 mplus [do pr <- list142_147 (StateT pragma)+ md <- StateT moduleDec+ pip <- StateT preImpPap+ _ <- StateT importPapillon+ return ()+ pp <- StateT prePeg+ d149_148 <- get+ t648_149 <- StateT hsw+ case t648_149 of+ (WOQuasiQuote "papillon") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOQuasiQuote \"papillon\")" "not match pattern: " "" d149_148 ["hsw"])+ let (WOQuasiQuote "papillon") = t648_149+ return ()+ p <- StateT peg_+ d151_150 <- get+ t650_151 <- StateT hsw+ case t650_151 of+ WCQuasiQuote -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCQuasiQuote" "not match pattern: " "" d151_150 ["hsw"])+ let WCQuasiQuote = t650_151+ return ()+ atp <- StateT afterPeg+ lift (lift (return $ mkPegFile pr md pip pp p atp)),+ do pr <- list142_147 (StateT pragma)+ md <- StateT moduleDec+ pp <- StateT prePeg+ d156_152 <- get+ t655_153 <- StateT hsw+ case t655_153 of+ (WOQuasiQuote "papillon") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOQuasiQuote \"papillon\")" "not match pattern: " "" d156_152 ["hsw"])+ let (WOQuasiQuote "papillon") = t655_153+ return ()+ p <- StateT peg_+ d158_154 <- get+ t657_155 <- StateT hsw+ case t657_155 of+ WCQuasiQuote -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCQuasiQuote" "not match pattern: " "" d158_154 ["hsw"])+ let WCQuasiQuote = t657_155+ return ()+ atp <- StateT afterPeg+ lift (lift (return $ mkPegFile pr md [] pp p atp))]+ pragma72_76 = foldl1 mplus [do d160_156 <- get+ t659_157 <- StateT hsw+ case t659_157 of+ WOComment -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOComment" "not match pattern: " "" d160_156 ["hsw"])+ let WOComment = t659_157+ return ()+ d161_158 <- get+ t660_159 <- StateT hsw+ case t660_159 of+ (WType [] "LANGUAGE") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WType [] \"LANGUAGE\")" "not match pattern: " "" d161_158 ["hsw"])+ let (WType [] "LANGUAGE") = t660_159+ return ()+ s <- StateT pragmaItems+ d163_160 <- get+ t662_161 <- StateT hsw+ case t662_161 of+ WCComment -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCComment" "not match pattern: " "" d163_160 ["hsw"])+ let WCComment = t662_161+ return ()+ lift (lift (return $ LanguagePragma s)),+ do d164_162 <- get+ t663_163 <- StateT hsw+ case t663_163 of+ WOComment -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOComment" "not match pattern: " "" d164_162 ["hsw"])+ let WOComment = t663_163+ return ()+ s <- StateT pragmaStr+ d166_164 <- get+ t665_165 <- StateT hsw+ case t665_165 of+ WCComment -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCComment" "not match pattern: " "" d166_164 ["hsw"])+ let WCComment = t665_165+ return ()+ lift (lift (return $ OtherPragma s))]+ pragmaStr73_77 = foldl1 mplus [do d168_166 <- get+ do err1604_167 <- ((do d167_168 <- get+ t666_169 <- StateT hsw+ case t666_169 of+ WCComment -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCComment" "not match pattern: " "" d167_168 ["hsw"])+ let WCComment = t666_169+ return ()) >> return False) `catchError` const (return True)+ unless err1604_167 (StateT position >>= (throwError . mkParseError "!WCComment:hsw" "not match: " "" d168_166 ["hsw"]))+ put d168_166+ c <- StateT char+ s <- StateT pragmaStr+ lift (lift (return $ c : s)),+ lift (lift (return ""))]+ pragmaItems74_78 = foldl1 mplus [do d171_170 <- get+ t669_171 <- StateT hsw+ case t669_171 of+ (WType [] _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WType [] t)" "not match pattern: " "" d171_170 ["hsw"])+ let (WType [] t) = t669_171+ return ()+ d172_172 <- get+ t670_173 <- StateT hsw+ case t670_173 of+ WComma -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WComma" "not match pattern: " "" d172_172 ["hsw"])+ let WComma = t670_173+ return ()+ i <- StateT pragmaItems+ lift (lift (return $ t : i)),+ do d174_174 <- get+ t672_175 <- StateT hsw+ case t672_175 of+ (WType [] _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WType [] t)" "not match pattern: " "" d174_174 ["hsw"])+ let (WType [] t) = t672_175+ return ()+ lift (lift (return [t]))]+ moduleDec75_79 = foldl1 mplus [do d175_176 <- get+ t673_177 <- StateT hsw+ case t673_177 of+ WModule -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WModule" "not match pattern: " "" d175_176 ["hsw"])+ let WModule = t673_177+ return ()+ n <- StateT moduleName+ d177_178 <- get+ t675_179 <- StateT hsw+ case t675_179 of+ WOParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOParen" "not match pattern: " "" d177_178 ["hsw"])+ let WOParen = t675_179+ return ()+ s <- StateT moduleDecStr+ _ <- StateT whr+ return ()+ lift (lift (return $ Just (n, Just s))),+ do d180_180 <- get+ t678_181 <- StateT hsw+ case t678_181 of+ WModule -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WModule" "not match pattern: " "" d180_180 ["hsw"])+ let WModule = t678_181+ return ()+ n <- StateT moduleName+ d182_182 <- get+ t680_183 <- StateT hsw+ case t680_183 of+ WWhere -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WWhere" "not match pattern: " "" d182_182 ["hsw"])+ let WWhere = t680_183+ return ()+ lift (lift (return $ Just (n, Nothing))),+ lift (lift (return Nothing))]+ moduleName76_80 = foldl1 mplus [do d183_184 <- get+ t681_185 <- StateT hsw+ case t681_185 of+ (WType _ _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WType m t)" "not match pattern: " "" d183_184 ["hsw"])+ let (WType m t) = t681_185+ return ()+ lift (lift (return $ m ++ [t]))]+ moduleDecStr77_81 = foldl1 mplus [do d185_186 <- get+ do err1605_187 <- ((do _ <- StateT whr+ return ()) >> return False) `catchError` const (return True)+ unless err1605_187 (StateT position >>= (throwError . mkParseError "!_:whr" "not match: " "" d185_186 ["whr"]))+ put d185_186+ c <- StateT char+ s <- StateT moduleDecStr+ lift (lift (return $ c : s)),+ lift (lift (return ""))]+ whr78_82 = foldl1 mplus [do d188_188 <- get+ t685_189 <- StateT hsw+ case t685_189 of+ WCParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCParen" "not match pattern: " "" d188_188 ["hsw"])+ let WCParen = t685_189+ return ()+ d189_190 <- get+ t686_191 <- StateT hsw+ case t686_191 of+ WWhere -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WWhere" "not match pattern: " "" d189_190 ["hsw"])+ let WWhere = t686_191+ return ()+ return ()]+ preImpPap79_83 = foldl1 mplus [do d191_192 <- get+ do err1606_193 <- ((do _ <- StateT importPapillon+ return ()) >> return False) `catchError` const (return True)+ unless err1606_193 (StateT position >>= (throwError . mkParseError "!_:importPapillon" "not match: " "" d191_192 ["importPapillon"]))+ put d191_192+ d193_194 <- get+ do err1607_195 <- ((do d192_196 <- get+ t688_197 <- StateT hsw+ case t688_197 of+ (WOQuasiQuote "papillon") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOQuasiQuote \"papillon\")" "not match pattern: " "" d192_196 ["hsw"])+ let (WOQuasiQuote "papillon") = t688_197+ return ()) >> return False) `catchError` const (return True)+ unless err1607_195 (StateT position >>= (throwError . mkParseError "!(WOQuasiQuote \"papillon\"):hsw" "not match: " "" d193_194 ["hsw"]))+ put d193_194+ c <- StateT char+ pip <- StateT preImpPap+ lift (lift (return $ c : pip)),+ lift (lift (return ""))]+ prePeg80_84 = foldl1 mplus [do d197_198 <- get+ do err1608_199 <- ((do d196_200 <- get+ t691_201 <- StateT hsw+ case t691_201 of+ (WOQuasiQuote "papillon") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOQuasiQuote \"papillon\")" "not match pattern: " "" d196_200 ["hsw"])+ let (WOQuasiQuote "papillon") = t691_201+ return ()) >> return False) `catchError` const (return True)+ unless err1608_199 (StateT position >>= (throwError . mkParseError "!(WOQuasiQuote \"papillon\"):hsw" "not match: " "" d197_198 ["hsw"]))+ put d197_198+ c <- StateT char+ pp <- StateT prePeg+ lift (lift (return $ c : pp)),+ lift (lift (return ""))]+ afterPeg81_85 = foldl1 mplus [do c <- StateT char+ atp <- StateT afterPeg+ lift (lift (return $ c : atp)),+ lift (lift (return ""))]+ importPapillon82_86 = foldl1 mplus [do d202_202 <- get+ t696_203 <- StateT hsw+ case t696_203 of+ WImport -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WImport" "not match pattern: " "" d202_202 ["hsw"])+ let WImport = t696_203+ return ()+ d203_204 <- get+ t697_205 <- StateT hsw+ case t697_205 of+ (WType ["Text"] "Papillon") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WType [\"Text\"] \"Papillon\")" "not match pattern: " "" d203_204 ["hsw"])+ let (WType ["Text"] "Papillon") = t697_205+ return ()+ return ()]+ peg83_87 = foldl1 mplus [do _ <- list142_147 (StateT space)+ return ()+ p <- StateT peg_+ lift (lift (return p))]+ peg_84_88 = foldl1 mplus [do mt <- optional141_206 (StateT monadType)+ st <- optional141_206 (StateT sourceType)+ prfx <- optional141_206 (StateT prefix)+ p <- list142_147 (StateT definition)+ lift (lift (return (mt,+ fromMaybe (ConT $ mkName "String") st,+ fromMaybe "" prfx,+ p)))]+ monadType85_89 = foldl1 mplus [do d210_207 <- get+ t704_208 <- StateT position+ let (!(ListPos (CharPos (_, x)))) = t704_208+ b1189_209 <- lift (lift (put (Just x) >> return True))+ unless b1189_209 (StateT position >>= (throwError . mkParseError "put (Just x) >> return True" "not match: " "" d210_207 ["position"]))+ d211_210 <- get+ t705_211 <- StateT wrd+ case t705_211 of+ (WSymbol "monad") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WSymbol \"monad\")" "not match pattern: " "" d211_210 ["wrd"])+ let (WSymbol "monad") = t705_211+ return ()+ d212_212 <- get+ t706_213 <- StateT wrd+ case t706_213 of+ WColon -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WColon" "not match pattern: " "" d212_212 ["wrd"])+ let WColon = t706_213+ return ()+ t <- StateT hsTypeArr+ d214_214 <- get+ t708_215 <- StateT wrd+ case t708_215 of+ WSemiColon -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WSemiColon" "not match pattern: " "" d214_214 ["wrd"])+ let WSemiColon = t708_215+ return ()+ lift (lift (put Nothing >> return t))]+ sourceType86_90 = foldl1 mplus [do d215_216 <- get+ t709_217 <- StateT position+ let (!(ListPos (CharPos (_, x)))) = t709_217+ b1194_218 <- lift (lift (put (Just x) >> return True))+ unless b1194_218 (StateT position >>= (throwError . mkParseError "put (Just x) >> return True" "not match: " "" d215_216 ["position"]))+ d216_219 <- get+ t710_220 <- StateT wrd+ case t710_220 of+ (WSymbol "source") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WSymbol \"source\")" "not match pattern: " "" d216_219 ["wrd"])+ let (WSymbol "source") = t710_220+ return ()+ d217_221 <- get+ t711_222 <- StateT wrd+ case t711_222 of+ WColon -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WColon" "not match pattern: " "" d217_221 ["wrd"])+ let WColon = t711_222+ return ()+ t <- StateT hsTypeArr+ d219_223 <- get+ t713_224 <- StateT wrd+ case t713_224 of+ WSemiColon -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WSemiColon" "not match pattern: " "" d219_223 ["wrd"])+ let WSemiColon = t713_224+ return ()+ lift (lift (put Nothing >> return t))]+ prefix87_91 = foldl1 mplus [do d220_225 <- get+ t714_226 <- StateT position+ let (!(ListPos (CharPos (_, x)))) = t714_226+ b1199_227 <- lift (lift (put (Just x) >> return True))+ unless b1199_227 (StateT position >>= (throwError . mkParseError "put (Just x) >> return True" "not match: " "" d220_225 ["position"]))+ d221_228 <- get+ t715_229 <- StateT wrd+ case t715_229 of+ (WSymbol "prefix") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WSymbol \"prefix\")" "not match pattern: " "" d221_228 ["wrd"])+ let (WSymbol "prefix") = t715_229+ return ()+ d222_230 <- get+ t716_231 <- StateT wrd+ case t716_231 of+ WColon -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WColon" "not match pattern: " "" d222_230 ["wrd"])+ let WColon = t716_231+ return ()+ d223_232 <- get+ t717_233 <- StateT hsw+ case t717_233 of+ (WString _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WString prfx)" "not match pattern: " "" d223_232 ["hsw"])+ let (WString prfx) = t717_233+ return ()+ d224_234 <- get+ t718_235 <- StateT wrd+ case t718_235 of+ WSemiColon -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WSemiColon" "not match pattern: " "" d224_234 ["wrd"])+ let WSemiColon = t718_235+ return ()+ lift (lift (put Nothing >> return prfx))]+ definition88_92 = foldl1 mplus [do d225_236 <- get+ t719_237 <- StateT position+ let (!(ListPos (CharPos (_, x)))) = t719_237+ b1204_238 <- lift (lift (put (Just x) >> return True))+ unless b1204_238 (StateT position >>= (throwError . mkParseError "put (Just x) >> return True" "not match: " "" d225_236 ["position"]))+ d226_239 <- get+ t720_240 <- StateT wrd+ case t720_240 of+ (WSymbol _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WSymbol v)" "not match pattern: " "" d226_239 ["wrd"])+ let (WSymbol v) = t720_240+ return ()+ mt <- optional141_206 (foldl1 mplus [do d228_241 <- get+ t722_242 <- StateT hsw+ case t722_242 of+ WTypeDef -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WTypeDef" "not match pattern: " "" d228_241 ["hsw"])+ let WTypeDef = t722_242+ return ()+ t <- StateT hsTypeArr+ lift (lift (return t))])+ d230_243 <- get+ t724_244 <- StateT wrd+ case t724_244 of+ WEqual -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WEqual" "not match pattern: " "" d230_243 ["wrd"])+ let WEqual = t724_244+ return ()+ sel <- StateT selection+ d232_245 <- get+ t726_246 <- StateT wrd+ case t726_246 of+ WSemiColon -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WSemiColon" "not match pattern: " "" d232_245 ["wrd"])+ let WSemiColon = t726_246+ return ()+ lift (lift (put Nothing >> return (v, mt, sel)))]+ selection89_93 = foldl1 mplus [do ns <- StateT normalSelection+ lift (lift (return ns))]+ normalSelection90_94 = foldl1 mplus [do ex <- StateT expressionHs+ d235_247 <- get+ t729_248 <- StateT wrd+ case t729_248 of+ WSlash -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WSlash" "not match pattern: " "" d235_247 ["wrd"])+ let WSlash = t729_248+ return ()+ sel <- StateT normalSelection+ lift (lift (return $ ex : sel)),+ do ex <- StateT expressionHs+ lift (lift (return [ex]))]+ expressionHs91_95 = foldl1 mplus [do e <- StateT expressionHsSugar+ lift (lift (return e)),+ do e <- StateT expression+ mh <- optional141_206 (foldl1 mplus [do d241_249 <- get+ t735_250 <- StateT wrd+ case t735_250 of+ WOBrace -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOBrace" "not match pattern: " "" d241_249 ["wrd"])+ let WOBrace = t735_250+ return ()+ h <- StateT hsExpLam+ d243_251 <- get+ t737_252 <- StateT wrd+ case t737_252 of+ WCBrace -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCBrace" "not match pattern: " "" d243_251 ["wrd"])+ let WCBrace = t737_252+ return ()+ lift (lift (return h))])+ lift (lift (return $ Left (e, mh)))]+ expressionHsSugar92_96 = foldl1 mplus [do d244_253 <- get+ t738_254 <- StateT wrd+ case t738_254 of+ WLT -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WLT" "not match pattern: " "" d244_253 ["wrd"])+ let WLT = t738_254+ return ()+ h <- StateT hsExpLam+ d246_255 <- get+ t740_256 <- StateT wrd+ case t740_256 of+ WGT -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WGT" "not match pattern: " "" d246_255 ["wrd"])+ let WGT = t740_256+ return ()+ lift (lift (return $ Right h))]+ expressionHsSugar'93_97 = foldl1 mplus [do d247_257 <- get+ t741_258 <- StateT wrd+ case t741_258 of+ WLT -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WLT" "not match pattern: " "" d247_257 ["wrd"])+ let WLT = t741_258+ return ()+ h <- StateT hsExpLam'+ d249_259 <- get+ t743_260 <- StateT wrd+ case t743_260 of+ WGT -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WGT" "not match pattern: " "" d249_259 ["wrd"])+ let WGT = t743_260+ return ()+ lift (lift (return $ Right h))]+ expression94_98 = foldl1 mplus [do l <- StateT nameLeaf_+ e <- StateT expression+ lift (lift (return $ l : e)),+ lift (lift (return []))]+ nameLeaf_95_99 = foldl1 mplus [do d252_261 <- get+ t746_262 <- StateT wrd+ case t746_262 of+ WBang -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WBang" "not match pattern: " "" d252_261 ["wrd"])+ let WBang = t746_262+ return ()+ nl <- StateT nameLeafNoCom+ com <- optional141_206 (StateT comForErr)+ lift (lift (return (NAhead $ maybe "" id com,+ nl))),+ do d255_263 <- get+ t749_264 <- StateT wrd+ case t749_264 of+ WAmp -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WAmp" "not match pattern: " "" d255_263 ["wrd"])+ let WAmp = t749_264+ return ()+ nl <- StateT nameLeaf+ lift (lift (return (Ahead, nl))),+ do nl <- StateT nameLeaf+ lift (lift (return (Here, nl)))]+ nameLeaf96_100 = foldl1 mplus [do cl <- StateT charLitLs+ lift (lift (return cl)),+ do n <- StateT pat1+ com <- optional141_206 (StateT comForErr)+ d261_265 <- get+ t755_266 <- StateT wrd+ case t755_266 of+ WColon -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WColon" "not match pattern: " "" d261_265 ["wrd"])+ let WColon = t755_266+ return ()+ (rf, p) <- StateT leaf+ lift (lift (return $ Left ((n, maybe "" id com),+ rf,+ p))),+ do n <- StateT pat1+ com <- optional141_206 (StateT comForErr)+ lift (lift (return $ Left ((n, maybe "" id com),+ FromVariable Nothing,+ Nothing)))]+ nameLeafNoCom97_101 = foldl1 mplus [do cl <- StateT charLitLs+ lift (lift (return cl)),+ do n <- StateT pat1+ com <- optional141_206 (StateT comForErr)+ d268_267 <- get+ t762_268 <- StateT wrd+ case t762_268 of+ WColon -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WColon" "not match pattern: " "" d268_267 ["wrd"])+ let WColon = t762_268+ return ()+ (rf, p) <- StateT leaf+ lift (lift (return $ Left ((n,+ maybe "" id com),+ rf,+ p))),+ do n <- StateT pat1+ lift (lift (return $ Left ((n, ""),+ FromVariable Nothing,+ Nothing)))]+ comForErr98_102 = foldl1 mplus [do d271_269 <- get+ t765_270 <- StateT hsw+ case t765_270 of+ WOComment -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOComment" "not match pattern: " "" d271_269 ["hsw"])+ let WOComment = t765_270+ return ()+ d272_271 <- get+ t766_272 <- StateT hsw+ case t766_272 of+ (WString _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WString s)" "not match pattern: " "" d272_271 ["hsw"])+ let (WString s) = t766_272+ return ()+ d273_273 <- get+ t767_274 <- StateT hsw+ case t767_274 of+ WCComment -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCComment" "not match pattern: " "" d273_273 ["hsw"])+ let WCComment = t767_274+ return ()+ lift (lift (return s))]+ leaf99_103 = foldl1 mplus [do rf <- StateT readFromLs+ t <- StateT test+ lift (lift (return (rf, Just t))),+ do rf <- StateT readFromLs+ lift (lift (return (rf, Nothing))),+ do t <- StateT test+ lift (lift (return (FromVariable Nothing, Just t)))]+ patOp100_104 = foldl1 mplus [do p <- StateT pat+ d279_275 <- get+ t773_276 <- StateT hsw+ case t773_276 of+ (WOpCon _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOpCon o)" "not match pattern: " "" d279_275 ["hsw"])+ let (WOpCon o) = t773_276+ return ()+ po <- StateT patOp+ lift (lift (return $ UInfixP p (mkName o) po)),+ do p <- StateT pat+ d282_277 <- get+ t776_278 <- StateT hsw+ case t776_278 of+ WBackQuote -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WBackQuote" "not match pattern: " "" d282_277 ["hsw"])+ let WBackQuote = t776_278+ return ()+ d283_279 <- get+ t777_280 <- StateT hsw+ case t777_280 of+ (WType [] _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WType [] t)" "not match pattern: " "" d283_279 ["hsw"])+ let (WType [] t) = t777_280+ return ()+ d284_281 <- get+ t778_282 <- StateT hsw+ case t778_282 of+ WBackQuote -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WBackQuote" "not match pattern: " "" d284_281 ["hsw"])+ let WBackQuote = t778_282+ return ()+ po <- StateT patOp+ lift (lift (return $ UInfixP p (mkName t) po)),+ do p <- StateT pat+ lift (lift (return p))]+ pat101_105 = foldl1 mplus [do d287_283 <- get+ t781_284 <- StateT hsw+ case t781_284 of+ (WType [] _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WType [] t)" "not match pattern: " "" d287_283 ["hsw"])+ let (WType [] t) = t781_284+ return ()+ ps <- StateT pats+ lift (lift (return $ ConP (mkName t) ps)),+ do d289_285 <- get+ t783_286 <- StateT hsw+ case t783_286 of+ WOParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOParen" "not match pattern: " "" d289_285 ["hsw"])+ let WOParen = t783_286+ return ()+ d290_287 <- get+ t784_288 <- StateT hsw+ case t784_288 of+ (WOpCon _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOpCon o)" "not match pattern: " "" d290_287 ["hsw"])+ let (WOpCon o) = t784_288+ return ()+ d291_289 <- get+ t785_290 <- StateT hsw+ case t785_290 of+ WCParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCParen" "not match pattern: " "" d291_289 ["hsw"])+ let WCParen = t785_290+ return ()+ ps <- StateT pats+ lift (lift (return $ ConP (mkName o) ps)),+ do p <- StateT pat1+ lift (lift (return p))]+ pat1102_106 = foldl1 mplus [do d294_291 <- get+ t788_292 <- StateT hsw+ case t788_292 of+ (WVar [] _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WVar [] n)" "not match pattern: " "" d294_291 ["hsw"])+ let (WVar [] n) = t788_292+ return ()+ d295_293 <- get+ t789_294 <- StateT hsw+ case t789_294 of+ (WOp "@") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOp \"@\")" "not match pattern: " "" d295_293 ["hsw"])+ let (WOp "@") = t789_294+ return ()+ p <- StateT pat1+ lift (lift (return $ AsP (mkName n) p)),+ do d297_295 <- get+ t791_296 <- StateT hsw+ case t791_296 of+ (WType [] _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WType [] t)" "not match pattern: " "" d297_295 ["hsw"])+ let (WType [] t) = t791_296+ return ()+ lift (lift (return $ ConP (mkName t) [])),+ do d298_297 <- get+ t792_298 <- StateT hsw+ case t792_298 of+ (WVar [] "_") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WVar [] \"_\")" "not match pattern: " "" d298_297 ["hsw"])+ let (WVar [] "_") = t792_298+ return ()+ lift (lift (return WildP)),+ do d299_299 <- get+ t793_300 <- StateT hsw+ case t793_300 of+ (WVar [] _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WVar [] n)" "not match pattern: " "" d299_299 ["hsw"])+ let (WVar [] n) = t793_300+ return ()+ lift (lift (return $ VarP $ mkName n)),+ do d300_301 <- get+ t794_302 <- StateT hsw+ case t794_302 of+ (WInteger _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WInteger i)" "not match pattern: " "" d300_301 ["hsw"])+ let (WInteger i) = t794_302+ return ()+ lift (lift (return $ LitP (IntegerL i))),+ do d301_303 <- get+ t795_304 <- StateT hsw+ case t795_304 of+ (WOp "-") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOp \"-\")" "not match pattern: " "" d301_303 ["hsw"])+ let (WOp "-") = t795_304+ return ()+ d302_305 <- get+ t796_306 <- StateT hsw+ case t796_306 of+ (WInteger _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WInteger i)" "not match pattern: " "" d302_305 ["hsw"])+ let (WInteger i) = t796_306+ return ()+ lift (lift (return $ LitP (IntegerL $ negate i))),+ do d303_307 <- get+ t797_308 <- StateT hsw+ case t797_308 of+ (WChar _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WChar c)" "not match pattern: " "" d303_307 ["hsw"])+ let (WChar c) = t797_308+ return ()+ lift (lift (return $ LitP $ CharL c)),+ do d304_309 <- get+ t798_310 <- StateT hsw+ case t798_310 of+ (WString _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WString s)" "not match pattern: " "" d304_309 ["hsw"])+ let (WString s) = t798_310+ return ()+ lift (lift (return $ LitP $ StringL s)),+ do d305_311 <- get+ t799_312 <- StateT hsw+ case t799_312 of+ WOParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOParen" "not match pattern: " "" d305_311 ["hsw"])+ let WOParen = t799_312+ return ()+ p <- StateT patList+ d307_313 <- get+ t801_314 <- StateT hsw+ case t801_314 of+ WCParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCParen" "not match pattern: " "" d307_313 ["hsw"])+ let WCParen = t801_314+ return ()+ lift (lift (return $ TupP p)),+ do d308_315 <- get+ t802_316 <- StateT hsw+ case t802_316 of+ WOBracket -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOBracket" "not match pattern: " "" d308_315 ["hsw"])+ let WOBracket = t802_316+ return ()+ p <- StateT patList+ d310_317 <- get+ t804_318 <- StateT hsw+ case t804_318 of+ WCBracket -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCBracket" "not match pattern: " "" d310_317 ["hsw"])+ let WCBracket = t804_318+ return ()+ lift (lift (return $ ListP p)),+ do d311_319 <- get+ t805_320 <- StateT hsw+ case t805_320 of+ WOParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOParen" "not match pattern: " "" d311_319 ["hsw"])+ let WOParen = t805_320+ return ()+ p <- StateT pat+ d313_321 <- get+ t807_322 <- StateT hsw+ case t807_322 of+ WCParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCParen" "not match pattern: " "" d313_321 ["hsw"])+ let WCParen = t807_322+ return ()+ lift (lift (return p)),+ do d314_323 <- get+ t808_324 <- StateT hsw+ case t808_324 of+ (WOp "!") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOp \"!\")" "not match pattern: " "" d314_323 ["hsw"])+ let (WOp "!") = t808_324+ return ()+ p <- StateT pat+ lift (lift (return $ BangP p))]+ patList103_107 = foldl1 mplus [do p <- StateT patOp+ d317_325 <- get+ t811_326 <- StateT hsw+ case t811_326 of+ WComma -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WComma" "not match pattern: " "" d317_325 ["hsw"])+ let WComma = t811_326+ return ()+ ps <- StateT patList+ lift (lift (return $ p : ps)),+ do p <- StateT patOp+ lift (lift (return [p])),+ lift (lift (return []))]+ pats104_108 = foldl1 mplus [do p <- StateT pat+ ps <- StateT pats+ lift (lift (return $ p : ps)),+ lift (lift (return []))]+ charLitLs105_109 = foldl1 mplus [do d322_327 <- get+ t816_328 <- StateT hsw+ case t816_328 of+ (WChar _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WChar c)" "not match pattern: " "" d322_327 ["hsw"])+ let (WChar c) = t816_328+ return ()+ d323_329 <- get+ t817_330 <- StateT wrd+ case t817_330 of+ WAsterisk -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WAsterisk" "not match pattern: " "" d323_329 ["wrd"])+ let WAsterisk = t817_330+ return ()+ lift (lift (return $ Right (c, List))),+ do d324_331 <- get+ t818_332 <- StateT hsw+ case t818_332 of+ (WChar _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WChar c)" "not match pattern: " "" d324_331 ["hsw"])+ let (WChar c) = t818_332+ return ()+ d325_333 <- get+ t819_334 <- StateT wrd+ case t819_334 of+ WPlus -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WPlus" "not match pattern: " "" d325_333 ["wrd"])+ let WPlus = t819_334+ return ()+ lift (lift (return $ Right (c, List1))),+ do d326_335 <- get+ t820_336 <- StateT hsw+ case t820_336 of+ (WChar _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WChar c)" "not match pattern: " "" d326_335 ["hsw"])+ let (WChar c) = t820_336+ return ()+ d327_337 <- get+ t821_338 <- StateT wrd+ case t821_338 of+ WQuestion -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WQuestion" "not match pattern: " "" d327_337 ["wrd"])+ let WQuestion = t821_338+ return ()+ lift (lift (return $ Right (c, Optional)))]+ readFromLs106_110 = foldl1 mplus [do rf <- StateT readFrom+ d329_339 <- get+ t823_340 <- StateT wrd+ case t823_340 of+ WAsterisk -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WAsterisk" "not match pattern: " "" d329_339 ["wrd"])+ let WAsterisk = t823_340+ return ()+ lift (lift (return $ FromL List rf)),+ do rf <- StateT readFrom+ d331_341 <- get+ t825_342 <- StateT wrd+ case t825_342 of+ WPlus -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WPlus" "not match pattern: " "" d331_341 ["wrd"])+ let WPlus = t825_342+ return ()+ lift (lift (return $ FromL List1 rf)),+ do rf <- StateT readFrom+ d333_343 <- get+ t827_344 <- StateT wrd+ case t827_344 of+ WQuestion -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WQuestion" "not match pattern: " "" d333_343 ["wrd"])+ let WQuestion = t827_344+ return ()+ lift (lift (return $ FromL Optional rf)),+ do rf <- StateT readFrom+ lift (lift (return rf))]+ readFrom107_111 = foldl1 mplus [do d335_345 <- get+ t829_346 <- StateT wrd+ case t829_346 of+ (WSymbol _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WSymbol v)" "not match pattern: " "" d335_345 ["wrd"])+ let (WSymbol v) = t829_346+ return ()+ lift (lift (return $ FromVariable $ Just v)),+ do d336_347 <- get+ t830_348 <- StateT wrd+ case t830_348 of+ WOParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOParen" "not match pattern: " "" d336_347 ["wrd"])+ let WOParen = t830_348+ return ()+ s <- StateT selection+ d338_349 <- get+ t832_350 <- StateT wrd+ case t832_350 of+ WCParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCParen" "not match pattern: " "" d338_349 ["wrd"])+ let WCParen = t832_350+ return ()+ lift (lift (return $ FromSelection s)),+ do e <- StateT expressionHsSugar'+ lift (lift (return $ FromSelection [e]))]+ test108_112 = foldl1 mplus [do d340_351 <- get+ t834_352 <- StateT wrd+ case t834_352 of+ WOBracket -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOBracket" "not match pattern: " "" d340_351 ["wrd"])+ let WOBracket = t834_352+ return ()+ h <- StateT hsExpLam+ com <- optional141_206 (StateT comForErr)+ d343_353 <- get+ t837_354 <- StateT wrd+ case t837_354 of+ WCBracket -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCBracket" "not match pattern: " "" d343_353 ["wrd"])+ let WCBracket = t837_354+ return ()+ lift (lift (return (h, maybe "" id com)))]+ hsExpLam109_113 = foldl1 mplus [do d344_355 <- get+ t838_356 <- StateT hsw+ case t838_356 of+ (WOp "\\") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOp \"\\\\\")" "not match pattern: " "" d344_355 ["hsw"])+ let (WOp "\\") = t838_356+ return ()+ ps <- StateT pats+ d346_357 <- get+ t840_358 <- StateT hsw+ case t840_358 of+ WRightArrow -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WRightArrow" "not match pattern: " "" d346_357 ["hsw"])+ let WRightArrow = t840_358+ return ()+ e <- StateT hsExpTyp+ lift (lift (return $ LamE ps e)),+ do e <- StateT hsExpTyp+ lift (lift (return e))]+ hsExpTyp110_114 = foldl1 mplus [do eo <- StateT hsExpOp+ d350_359 <- get+ t844_360 <- StateT hsw+ case t844_360 of+ WTypeDef -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WTypeDef" "not match pattern: " "" d350_359 ["hsw"])+ let WTypeDef = t844_360+ return ()+ t <- StateT hsTypeArr+ lift (lift (return $ SigE eo t)),+ do eo <- StateT hsExpOp+ lift (lift (return eo))]+ hsExpOp111_115 = foldl1 mplus [do l <- StateT hsExp+ o <- StateT hsOp+ r <- StateT hsExpOp+ lift (lift (return $ UInfixE (l id) o r)),+ do e <- StateT hsExp+ lift (lift (return $ e id))]+ hsOp112_116 = foldl1 mplus [do d357_361 <- get+ t851_362 <- StateT hsw+ case t851_362 of+ (WOp _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOp op)" "not match pattern: " "" d357_361 ["hsw"])+ let (WOp op) = t851_362+ return ()+ lift (lift (return $ VarE $ mkName op)),+ do d358_363 <- get+ t852_364 <- StateT hsw+ case t852_364 of+ (WOpCon _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOpCon op)" "not match pattern: " "" d358_363 ["hsw"])+ let (WOpCon op) = t852_364+ return ()+ lift (lift (return $ ConE $ mkName op)),+ do d359_365 <- get+ t853_366 <- StateT hsw+ case t853_366 of+ WBackQuote -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WBackQuote" "not match pattern: " "" d359_365 ["hsw"])+ let WBackQuote = t853_366+ return ()+ d360_367 <- get+ t854_368 <- StateT hsw+ case t854_368 of+ (WVar [] _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WVar [] v)" "not match pattern: " "" d360_367 ["hsw"])+ let (WVar [] v) = t854_368+ return ()+ d361_369 <- get+ t855_370 <- StateT hsw+ case t855_370 of+ WBackQuote -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WBackQuote" "not match pattern: " "" d361_369 ["hsw"])+ let WBackQuote = t855_370+ return ()+ lift (lift (return $ VarE $ mkName v)),+ do d362_371 <- get+ t856_372 <- StateT hsw+ case t856_372 of+ WBackQuote -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WBackQuote" "not match pattern: " "" d362_371 ["hsw"])+ let WBackQuote = t856_372+ return ()+ d363_373 <- get+ t857_374 <- StateT hsw+ case t857_374 of+ (WType [] _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WType [] t)" "not match pattern: " "" d363_373 ["hsw"])+ let (WType [] t) = t857_374+ return ()+ d364_375 <- get+ t858_376 <- StateT hsw+ case t858_376 of+ WBackQuote -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WBackQuote" "not match pattern: " "" d364_375 ["hsw"])+ let WBackQuote = t858_376+ return ()+ lift (lift (return $ ConE $ mkName t))]+ hsExpLam'113_117 = foldl1 mplus [do d365_377 <- get+ t859_378 <- StateT hsw+ case t859_378 of+ (WOp "\\") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOp \"\\\\\")" "not match pattern: " "" d365_377 ["hsw"])+ let (WOp "\\") = t859_378+ return ()+ ps <- StateT pats+ d367_379 <- get+ t861_380 <- StateT hsw+ case t861_380 of+ WRightArrow -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WRightArrow" "not match pattern: " "" d367_379 ["hsw"])+ let WRightArrow = t861_380+ return ()+ e <- StateT hsExpTyp'+ lift (lift (return $ LamE ps e)),+ do e <- StateT hsExpTyp'+ lift (lift (return e))]+ hsExpTyp'114_118 = foldl1 mplus [do eo <- StateT hsExpOp'+ d371_381 <- get+ t865_382 <- StateT hsw+ case t865_382 of+ WTypeDef -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WTypeDef" "not match pattern: " "" d371_381 ["hsw"])+ let WTypeDef = t865_382+ return ()+ t <- StateT hsTypeArr+ lift (lift (return $ SigE eo t)),+ do eo <- StateT hsExpOp'+ lift (lift (return eo))]+ hsExpOp'115_119 = foldl1 mplus [do l <- StateT hsExp+ o <- StateT hsOp'+ r <- StateT hsExpOp'+ lift (lift (return $ UInfixE (l id) o r)),+ do e <- StateT hsExp+ lift (lift (return $ e id))]+ hsOp'116_120 = foldl1 mplus [do d378_383 <- get+ t872_384 <- StateT hsw+ case t872_384 of+ (WOp _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOp op)" "not match pattern: " "" d378_383 ["hsw"])+ let (WOp op) = t872_384+ return ()+ b1357_385 <- lift (lift (return $ head op /= '>'))+ unless b1357_385 (StateT position >>= (throwError . mkParseError "return $ head op /= '>'" "not match: " "" d378_383 ["hsw"]))+ lift (lift (return $ VarE $ mkName op)),+ do d379_386 <- get+ t873_387 <- StateT hsw+ case t873_387 of+ (WOpCon _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOpCon op)" "not match pattern: " "" d379_386 ["hsw"])+ let (WOpCon op) = t873_387+ return ()+ lift (lift (return $ ConE $ mkName op)),+ do d380_388 <- get+ t874_389 <- StateT hsw+ case t874_389 of+ WBackQuote -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WBackQuote" "not match pattern: " "" d380_388 ["hsw"])+ let WBackQuote = t874_389+ return ()+ v <- StateT var+ d382_390 <- get+ t876_391 <- StateT hsw+ case t876_391 of+ WBackQuote -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WBackQuote" "not match pattern: " "" d382_390 ["hsw"])+ let WBackQuote = t876_391+ return ()+ lift (lift (return $ VarE $ mkName v)),+ do d383_392 <- get+ t877_393 <- StateT hsw+ case t877_393 of+ WBackQuote -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WBackQuote" "not match pattern: " "" d383_392 ["hsw"])+ let WBackQuote = t877_393+ return ()+ t <- StateT typ+ d385_394 <- get+ t879_395 <- StateT hsw+ case t879_395 of+ WBackQuote -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WBackQuote" "not match pattern: " "" d385_394 ["hsw"])+ let WBackQuote = t879_395+ return ()+ lift (lift (return $ ConE $ mkName t))]+ hsExp117_121 = foldl1 mplus [do e <- StateT hsExp1+ h <- StateT hsExp+ lift (lift (return (\f -> h (f e `AppE`)))),+ do e <- StateT hsExp1+ lift (lift (return (\f -> f e)))]+ hsExp1118_122 = foldl1 mplus [do d389_396 <- get+ t883_397 <- StateT hsw+ case t883_397 of+ WOParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOParen" "not match pattern: " "" d389_396 ["hsw"])+ let WOParen = t883_397+ return ()+ l <- optional141_206 (StateT hsExpOp)+ o <- StateT hsOp+ r <- optional141_206 (StateT hsExpOp)+ d393_398 <- get+ t887_399 <- StateT hsw+ case t887_399 of+ WCParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCParen" "not match pattern: " "" d393_398 ["hsw"])+ let WCParen = t887_399+ return ()+ lift (lift (return $ InfixE l o r)),+ do d394_400 <- get+ t888_401 <- StateT hsw+ case t888_401 of+ WOParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOParen" "not match pattern: " "" d394_400 ["hsw"])+ let WOParen = t888_401+ return ()+ et <- StateT hsExpTpl+ d396_402 <- get+ t890_403 <- StateT hsw+ case t890_403 of+ WCParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCParen" "not match pattern: " "" d396_402 ["hsw"])+ let WCParen = t890_403+ return ()+ lift (lift (return $ TupE et)),+ do d397_404 <- get+ t891_405 <- StateT hsw+ case t891_405 of+ WOBracket -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOBracket" "not match pattern: " "" d397_404 ["hsw"])+ let WOBracket = t891_405+ return ()+ et <- StateT hsExpTpl+ d399_406 <- get+ t893_407 <- StateT hsw+ case t893_407 of+ WCBracket -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCBracket" "not match pattern: " "" d399_406 ["hsw"])+ let WCBracket = t893_407+ return ()+ lift (lift (return $ ListE et)),+ do d400_408 <- get+ t894_409 <- StateT hsw+ case t894_409 of+ WOBracket -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOBracket" "not match pattern: " "" d400_408 ["hsw"])+ let WOBracket = t894_409+ return ()+ b <- StateT hsExpOp+ d402_410 <- get+ t896_411 <- StateT hsw+ case t896_411 of+ WDotDot -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WDotDot" "not match pattern: " "" d402_410 ["hsw"])+ let WDotDot = t896_411+ return ()+ e <- StateT hsExpOp+ d404_412 <- get+ t898_413 <- StateT hsw+ case t898_413 of+ WCBracket -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCBracket" "not match pattern: " "" d404_412 ["hsw"])+ let WCBracket = t898_413+ return ()+ lift (lift (return $ ArithSeqE $ FromToR b e)),+ do d405_414 <- get+ t899_415 <- StateT hsw+ case t899_415 of+ (WVar [] _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WVar [] v)" "not match pattern: " "" d405_414 ["hsw"])+ let (WVar [] v) = t899_415+ return ()+ lift (lift (return $ VarE $ mkName v)),+ do d406_416 <- get+ t900_417 <- StateT hsw+ case t900_417 of+ (WType [] _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WType [] t)" "not match pattern: " "" d406_416 ["hsw"])+ let (WType [] t) = t900_417+ return ()+ lift (lift (return $ ConE $ mkName t)),+ do d407_418 <- get+ t901_419 <- StateT hsw+ case t901_419 of+ (WInteger _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WInteger i)" "not match pattern: " "" d407_418 ["hsw"])+ let (WInteger i) = t901_419+ return ()+ lift (lift (return $ LitE $ integerL i)),+ do d408_420 <- get+ t902_421 <- StateT hsw+ case t902_421 of+ (WChar _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WChar c)" "not match pattern: " "" d408_420 ["hsw"])+ let (WChar c) = t902_421+ return ()+ lift (lift (return $ LitE $ charL c)),+ do d409_422 <- get+ t903_423 <- StateT hsw+ case t903_423 of+ (WString _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WString s)" "not match pattern: " "" d409_422 ["hsw"])+ let (WString s) = t903_423+ return ()+ lift (lift (return $ LitE $ stringL s)),+ do d410_424 <- get+ t904_425 <- StateT hsw+ case t904_425 of+ (WOp "-") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOp \"-\")" "not match pattern: " "" d410_424 ["hsw"])+ let (WOp "-") = t904_425+ return ()+ e <- StateT hsExp1+ lift (lift (return $ AppE (VarE $ mkName "negate") e)),+ do d412_426 <- get+ t906_427 <- StateT hsw+ case t906_427 of+ WIf -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WIf" "not match pattern: " "" d412_426 ["hsw"])+ let WIf = t906_427+ return ()+ p <- StateT hsExpLam+ d414_428 <- get+ t908_429 <- StateT hsw+ case t908_429 of+ WThen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WThen" "not match pattern: " "" d414_428 ["hsw"])+ let WThen = t908_429+ return ()+ t <- StateT hsExpLam+ d416_430 <- get+ t910_431 <- StateT hsw+ case t910_431 of+ WElse -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WElse" "not match pattern: " "" d416_430 ["hsw"])+ let WElse = t910_431+ return ()+ e <- StateT hsExpLam+ lift (lift (return $ CondE p t e)),+ do d418_432 <- get+ t912_433 <- StateT hsw+ case t912_433 of+ WLet -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WLet" "not match pattern: " "" d418_432 ["hsw"])+ let WLet = t912_433+ return ()+ d419_434 <- get+ t913_435 <- StateT hsw+ case t913_435 of+ (WVar [] _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WVar [] v)" "not match pattern: " "" d419_434 ["hsw"])+ let (WVar [] v) = t913_435+ return ()+ d420_436 <- get+ t914_437 <- StateT hsw+ case t914_437 of+ (WOp "=") -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WOp \"=\")" "not match pattern: " "" d420_436 ["hsw"])+ let (WOp "=") = t914_437+ return ()+ e <- StateT hsExpLam+ d422_438 <- get+ t916_439 <- StateT hsw+ case t916_439 of+ WIn -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WIn" "not match pattern: " "" d422_438 ["hsw"])+ let WIn = t916_439+ return ()+ b <- StateT hsExpLam+ lift (lift (return $ LetE [ValD (VarP $ mkName v) (NormalB e) []] b))]+ hsExpTpl119_123 = foldl1 mplus [do e <- StateT hsExpLam+ d425_440 <- get+ t919_441 <- StateT hsw+ case t919_441 of+ WComma -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WComma" "not match pattern: " "" d425_440 ["hsw"])+ let WComma = t919_441+ return ()+ et <- StateT hsExpTpl+ lift (lift (return $ e : et)),+ do e <- StateT hsExpLam+ lift (lift (return [e])),+ lift (lift (return []))]+ hsTypeArr120_124 = foldl1 mplus [do l <- StateT hsType+ d429_442 <- get+ t923_443 <- StateT hsw+ case t923_443 of+ WRightArrow -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WRightArrow" "not match pattern: " "" d429_442 ["hsw"])+ let WRightArrow = t923_443+ return ()+ r <- StateT hsTypeArr+ lift (lift (return $ AppT (AppT ArrowT $ l id) r)),+ do t <- StateT hsType+ lift (lift (return $ t id))]+ hsType121_125 = foldl1 mplus [do t <- StateT hsType1+ ts <- StateT hsType+ lift (lift (return $ (\f -> ts (f t `AppT`)))),+ do t <- StateT hsType1+ lift (lift (return ($ t)))]+ hsType1122_126 = foldl1 mplus [do d435_444 <- get+ t929_445 <- StateT hsw+ case t929_445 of+ WOBracket -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOBracket" "not match pattern: " "" d435_444 ["hsw"])+ let WOBracket = t929_445+ return ()+ d436_446 <- get+ t930_447 <- StateT hsw+ case t930_447 of+ WCBracket -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCBracket" "not match pattern: " "" d436_446 ["hsw"])+ let WCBracket = t930_447+ return ()+ lift (lift (return ListT)),+ do d437_448 <- get+ t931_449 <- StateT hsw+ case t931_449 of+ WOBracket -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOBracket" "not match pattern: " "" d437_448 ["hsw"])+ let WOBracket = t931_449+ return ()+ t <- StateT hsTypeArr+ d439_450 <- get+ t933_451 <- StateT hsw+ case t933_451 of+ WCBracket -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCBracket" "not match pattern: " "" d439_450 ["hsw"])+ let WCBracket = t933_451+ return ()+ lift (lift (return $ ListT `AppT` t)),+ do d440_452 <- get+ t934_453 <- StateT hsw+ case t934_453 of+ WOParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOParen" "not match pattern: " "" d440_452 ["hsw"])+ let WOParen = t934_453+ return ()+ tt <- StateT hsTypeTpl+ d442_454 <- get+ t936_455 <- StateT hsw+ case t936_455 of+ WCParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCParen" "not match pattern: " "" d442_454 ["hsw"])+ let WCParen = t936_455+ return ()+ lift (lift (return $ foldl AppT (TupleT $ length tt) tt)),+ do d443_456 <- get+ t937_457 <- StateT hsw+ case t937_457 of+ (WType [] _) -> return ()+ _ -> StateT position >>= (throwError . mkParseError "(WType [] t)" "not match pattern: " "" d443_456 ["hsw"])+ let (WType [] t) = t937_457+ return ()+ lift (lift (return $ ConT $ mkName t)),+ do d444_458 <- get+ t938_459 <- StateT hsw+ case t938_459 of+ WOParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WOParen" "not match pattern: " "" d444_458 ["hsw"])+ let WOParen = t938_459+ return ()+ d445_460 <- get+ t939_461 <- StateT hsw+ case t939_461 of+ WRightArrow -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WRightArrow" "not match pattern: " "" d445_460 ["hsw"])+ let WRightArrow = t939_461+ return ()+ d446_462 <- get+ t940_463 <- StateT hsw+ case t940_463 of+ WCParen -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WCParen" "not match pattern: " "" d446_462 ["hsw"])+ let WCParen = t940_463+ return ()+ lift (lift (return ArrowT))]+ hsTypeTpl123_127 = foldl1 mplus [do t <- StateT hsTypeArr+ d448_464 <- get+ t942_465 <- StateT hsw+ case t942_465 of+ WComma -> return ()+ _ -> StateT position >>= (throwError . mkParseError "WComma" "not match pattern: " "" d448_464 ["hsw"])+ let WComma = t942_465+ return ()+ tt <- StateT hsTypeTpl+ lift (lift (return $ t : tt)),+ do t <- StateT hsTypeArr+ lift (lift (return [t])),+ lift (lift (return []))]+ wrd124_128 = foldl1 mplus [do w <- StateT word+ _ <- list142_147 (StateT space)+ return ()+ lift (lift (return w)),+ do _ <- StateT semiColon+ return ()+ _ <- list142_147 (StateT space')+ return ()+ lift (lift (return WSemiColon))]+ hsw125_129 = foldl1 mplus [do w <- StateT hsWord+ _ <- list142_147 (StateT space)+ return ()+ lift (lift (return w))]+ word126_130 = foldl1 mplus [do v <- list1143_466 (foldl1 mplus [do d458_467 <- get+ t952_468 <- StateT char+ let c1616_145 = t952_468+ b1437_469 <- return (((||) <$> isAlphaNum <*> (`elem` "_'")) c1616_145)+ unless b1437_469 (StateT position >>= (throwError . mkParseError "((||) <$> isAlphaNum <*> (`elem` \"_'\")) c1616_0" "not match: " "" d458_467 ["char"]))+ return c1616_145])+ lift (lift (return $ WSymbol v)),+ do d459_470 <- get+ t953_471 <- StateT char+ case t953_471 of+ '!' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'!'" "not match pattern: " "" d459_470 ["char"])+ let '!' = t953_471+ return ()+ lift (lift (return WBang)),+ do d460_472 <- get+ t954_473 <- StateT char+ case t954_473 of+ '&' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'&'" "not match pattern: " "" d460_472 ["char"])+ let '&' = t954_473+ return ()+ lift (lift (return WAmp)),+ do d461_474 <- get+ t955_475 <- StateT char+ case t955_475 of+ '*' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'*'" "not match pattern: " "" d461_474 ["char"])+ let '*' = t955_475+ return ()+ lift (lift (return WAsterisk)),+ do d462_476 <- get+ t956_477 <- StateT char+ case t956_477 of+ '+' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'+'" "not match pattern: " "" d462_476 ["char"])+ let '+' = t956_477+ return ()+ lift (lift (return WPlus)),+ do d463_478 <- get+ t957_479 <- StateT char+ case t957_479 of+ '?' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'?'" "not match pattern: " "" d463_478 ["char"])+ let '?' = t957_479+ return ()+ lift (lift (return WQuestion)),+ do d464_480 <- get+ t958_481 <- StateT char+ case t958_481 of+ '=' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'='" "not match pattern: " "" d464_480 ["char"])+ let '=' = t958_481+ return ()+ lift (lift (return WEqual)),+ do d465_482 <- get+ t959_483 <- StateT char+ case t959_483 of+ '/' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'/'" "not match pattern: " "" d465_482 ["char"])+ let '/' = t959_483+ return ()+ lift (lift (return WSlash)),+ do d466_484 <- get+ t960_485 <- StateT char+ case t960_485 of+ ':' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "':'" "not match pattern: " "" d466_484 ["char"])+ let ':' = t960_485+ return ()+ lift (lift (return WColon)),+ do d467_486 <- get+ t961_487 <- StateT char+ case t961_487 of+ '<' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'<'" "not match pattern: " "" d467_486 ["char"])+ let '<' = t961_487+ return ()+ lift (lift (return WLT)),+ do d468_488 <- get+ t962_489 <- StateT char+ case t962_489 of+ '>' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'>'" "not match pattern: " "" d468_488 ["char"])+ let '>' = t962_489+ return ()+ lift (lift (return WGT)),+ do b <- StateT bras+ lift (lift (return b))]+ hsWord127_131 = foldl1 mplus [do d470_490 <- get+ t964_491 <- StateT char+ case t964_491 of+ 'm' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'m'" "not match pattern: " "" d470_490 ["char"])+ let 'm' = t964_491+ return ()+ d471_492 <- get+ t965_493 <- StateT char+ case t965_493 of+ 'o' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'o'" "not match pattern: " "" d471_492 ["char"])+ let 'o' = t965_493+ return ()+ d472_494 <- get+ t966_495 <- StateT char+ case t966_495 of+ 'd' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'d'" "not match pattern: " "" d472_494 ["char"])+ let 'd' = t966_495+ return ()+ d473_496 <- get+ t967_497 <- StateT char+ case t967_497 of+ 'u' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'u'" "not match pattern: " "" d473_496 ["char"])+ let 'u' = t967_497+ return ()+ d474_498 <- get+ t968_499 <- StateT char+ case t968_499 of+ 'l' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d474_498 ["char"])+ let 'l' = t968_499+ return ()+ d475_500 <- get+ t969_501 <- StateT char+ case t969_501 of+ 'e' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d475_500 ["char"])+ let 'e' = t969_501+ return ()+ lift (lift (return $ WModule)),+ do d476_502 <- get+ t970_503 <- StateT char+ case t970_503 of+ 'w' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'w'" "not match pattern: " "" d476_502 ["char"])+ let 'w' = t970_503+ return ()+ d477_504 <- get+ t971_505 <- StateT char+ case t971_505 of+ 'h' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'h'" "not match pattern: " "" d477_504 ["char"])+ let 'h' = t971_505+ return ()+ d478_506 <- get+ t972_507 <- StateT char+ case t972_507 of+ 'e' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d478_506 ["char"])+ let 'e' = t972_507+ return ()+ d479_508 <- get+ t973_509 <- StateT char+ case t973_509 of+ 'r' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'r'" "not match pattern: " "" d479_508 ["char"])+ let 'r' = t973_509+ return ()+ d480_510 <- get+ t974_511 <- StateT char+ case t974_511 of+ 'e' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d480_510 ["char"])+ let 'e' = t974_511+ return ()+ lift (lift (return $ WWhere)),+ do d481_512 <- get+ t975_513 <- StateT char+ case t975_513 of+ 'i' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'i'" "not match pattern: " "" d481_512 ["char"])+ let 'i' = t975_513+ return ()+ d482_514 <- get+ t976_515 <- StateT char+ case t976_515 of+ 'm' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'m'" "not match pattern: " "" d482_514 ["char"])+ let 'm' = t976_515+ return ()+ d483_516 <- get+ t977_517 <- StateT char+ case t977_517 of+ 'p' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'p'" "not match pattern: " "" d483_516 ["char"])+ let 'p' = t977_517+ return ()+ d484_518 <- get+ t978_519 <- StateT char+ case t978_519 of+ 'o' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'o'" "not match pattern: " "" d484_518 ["char"])+ let 'o' = t978_519+ return ()+ d485_520 <- get+ t979_521 <- StateT char+ case t979_521 of+ 'r' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'r'" "not match pattern: " "" d485_520 ["char"])+ let 'r' = t979_521+ return ()+ d486_522 <- get+ t980_523 <- StateT char+ case t980_523 of+ 't' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'t'" "not match pattern: " "" d486_522 ["char"])+ let 't' = t980_523+ return ()+ lift (lift (return $ WImport)),+ do d487_524 <- get+ t981_525 <- StateT char+ case t981_525 of+ 'i' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'i'" "not match pattern: " "" d487_524 ["char"])+ let 'i' = t981_525+ return ()+ d488_526 <- get+ t982_527 <- StateT char+ case t982_527 of+ 'f' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'f'" "not match pattern: " "" d488_526 ["char"])+ let 'f' = t982_527+ return ()+ lift (lift (return $ WIf)),+ do d489_528 <- get+ t983_529 <- StateT char+ case t983_529 of+ 't' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'t'" "not match pattern: " "" d489_528 ["char"])+ let 't' = t983_529+ return ()+ d490_530 <- get+ t984_531 <- StateT char+ case t984_531 of+ 'h' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'h'" "not match pattern: " "" d490_530 ["char"])+ let 'h' = t984_531+ return ()+ d491_532 <- get+ t985_533 <- StateT char+ case t985_533 of+ 'e' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d491_532 ["char"])+ let 'e' = t985_533+ return ()+ d492_534 <- get+ t986_535 <- StateT char+ case t986_535 of+ 'n' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'n'" "not match pattern: " "" d492_534 ["char"])+ let 'n' = t986_535+ return ()+ lift (lift (return $ WThen)),+ do d493_536 <- get+ t987_537 <- StateT char+ case t987_537 of+ 'e' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d493_536 ["char"])+ let 'e' = t987_537+ return ()+ d494_538 <- get+ t988_539 <- StateT char+ case t988_539 of+ 'l' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d494_538 ["char"])+ let 'l' = t988_539+ return ()+ d495_540 <- get+ t989_541 <- StateT char+ case t989_541 of+ 's' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'s'" "not match pattern: " "" d495_540 ["char"])+ let 's' = t989_541+ return ()+ d496_542 <- get+ t990_543 <- StateT char+ case t990_543 of+ 'e' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d496_542 ["char"])+ let 'e' = t990_543+ return ()+ lift (lift (return $ WElse)),+ do d497_544 <- get+ t991_545 <- StateT char+ case t991_545 of+ 'l' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'l'" "not match pattern: " "" d497_544 ["char"])+ let 'l' = t991_545+ return ()+ d498_546 <- get+ t992_547 <- StateT char+ case t992_547 of+ 'e' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'e'" "not match pattern: " "" d498_546 ["char"])+ let 'e' = t992_547+ return ()+ d499_548 <- get+ t993_549 <- StateT char+ case t993_549 of+ 't' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'t'" "not match pattern: " "" d499_548 ["char"])+ let 't' = t993_549+ return ()+ lift (lift (return $ WLet)),+ do d500_550 <- get+ t994_551 <- StateT char+ case t994_551 of+ 'i' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'i'" "not match pattern: " "" d500_550 ["char"])+ let 'i' = t994_551+ return ()+ d501_552 <- get+ t995_553 <- StateT char+ case t995_553 of+ 'n' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'n'" "not match pattern: " "" d501_552 ["char"])+ let 'n' = t995_553+ return ()+ lift (lift (return $ WIn)),+ do d502_554 <- get+ t996_555 <- StateT char+ case t996_555 of+ '[' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'['" "not match pattern: " "" d502_554 ["char"])+ let '[' = t996_555+ return ()+ v <- StateT var+ d504_556 <- get+ t998_557 <- StateT char+ case t998_557 of+ '|' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'|'" "not match pattern: " "" d504_556 ["char"])+ let '|' = t998_557+ return ()+ lift (lift (return $ WOQuasiQuote v)),+ do d505_558 <- get+ t999_559 <- StateT char+ case t999_559 of+ '|' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'|'" "not match pattern: " "" d505_558 ["char"])+ let '|' = t999_559+ return ()+ d506_560 <- get+ t1000_561 <- StateT char+ case t1000_561 of+ ']' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "']'" "not match pattern: " "" d506_560 ["char"])+ let ']' = t1000_561+ return ()+ lift (lift (return WCQuasiQuote)),+ do d507_562 <- get+ t1001_563 <- StateT char+ case t1001_563 of+ ':' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "':'" "not match pattern: " "" d507_562 ["char"])+ let ':' = t1001_563+ return ()+ d508_564 <- get+ t1002_565 <- StateT char+ case t1002_565 of+ ':' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "':'" "not match pattern: " "" d508_564 ["char"])+ let ':' = t1002_565+ return ()+ lift (lift (return WTypeDef)),+ do d509_566 <- get+ t1003_567 <- StateT char+ case t1003_567 of+ '-' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d509_566 ["char"])+ let '-' = t1003_567+ return ()+ d510_568 <- get+ t1004_569 <- StateT char+ case t1004_569 of+ '>' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'>'" "not match pattern: " "" d510_568 ["char"])+ let '>' = t1004_569+ return ()+ lift (lift (return WRightArrow)),+ do d511_570 <- get+ t1005_571 <- StateT char+ case t1005_571 of+ '.' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'.'" "not match pattern: " "" d511_570 ["char"])+ let '.' = t1005_571+ return ()+ d512_572 <- get+ t1006_573 <- StateT char+ case t1006_573 of+ '.' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'.'" "not match pattern: " "" d512_572 ["char"])+ let '.' = t1006_573+ return ()+ lift (lift (return WDotDot)),+ do d513_574 <- get+ t1007_575 <- StateT char+ case t1007_575 of+ '{' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d513_574 ["char"])+ let '{' = t1007_575+ return ()+ d514_576 <- get+ t1008_577 <- StateT char+ case t1008_577 of+ '-' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d514_576 ["char"])+ let '-' = t1008_577+ return ()+ d515_578 <- get+ t1009_579 <- StateT char+ case t1009_579 of+ '#' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d515_578 ["char"])+ let '#' = t1009_579+ return ()+ lift (lift (return WOComment)),+ do d516_580 <- get+ t1010_581 <- StateT char+ case t1010_581 of+ '#' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d516_580 ["char"])+ let '#' = t1010_581+ return ()+ d517_582 <- get+ t1011_583 <- StateT char+ case t1011_583 of+ '-' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d517_582 ["char"])+ let '-' = t1011_583+ return ()+ d518_584 <- get+ t1012_585 <- StateT char+ case t1012_585 of+ '}' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d518_584 ["char"])+ let '}' = t1012_585+ return ()+ lift (lift (return WCComment)),+ do m <- list142_147 (foldl1 mplus [do t <- StateT typ+ d521_586 <- get+ t1015_587 <- StateT char+ case t1015_587 of+ '.' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'.'" "not match pattern: " "" d521_586 ["char"])+ let '.' = t1015_587+ return ()+ lift (lift (return t))])+ t1 <- StateT typ+ lift (lift (return $ WType m t1)),+ do m <- list142_147 (foldl1 mplus [do t <- StateT typ+ d525_588 <- get+ t1019_589 <- StateT char+ case t1019_589 of+ '.' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'.'" "not match pattern: " "" d525_588 ["char"])+ let '.' = t1019_589+ return ()+ lift (lift (return t))])+ v1 <- StateT var+ lift (lift (return $ WVar m v1)),+ do d527_590 <- get+ t1021_591 <- StateT char+ case t1021_591 of+ ':' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "':'" "not match pattern: " "" d527_590 ["char"])+ let ':' = t1021_591+ return ()+ w <- list142_147 (foldl1 mplus [do d529_592 <- get+ t1023_593 <- StateT char+ let c1617_594 = t1023_593+ b1508_595 <- return ((`elem` opChars) c1617_594)+ unless b1508_595 (StateT position >>= (throwError . mkParseError "(`elem` opChars) c1617_0" "not match: " "" d529_592 ["char"]))+ return c1617_594])+ lift (lift (return $ WOpCon $ ':' : w)),+ do w <- list1143_466 (foldl1 mplus [do d531_596 <- get+ t1025_597 <- StateT char+ let c1618_598 = t1025_597+ b1510_599 <- return ((`elem` opChars) c1618_598)+ unless b1510_599 (StateT position >>= (throwError . mkParseError "(`elem` opChars) c1618_0" "not match: " "" d531_596 ["char"]))+ return c1618_598])+ lift (lift (return $ WOp w)),+ do d532_600 <- get+ t1026_601 <- StateT char+ case t1026_601 of+ '\'' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d532_600 ["char"])+ let '\'' = t1026_601+ return ()+ c <- foldl1 mplus [do d534_602 <- get+ t1028_603 <- StateT char+ let c1619_604 = t1028_603+ b1513_605 <- return ((`notElem` "\\'") c1619_604)+ unless b1513_605 (StateT position >>= (throwError . mkParseError "(`notElem` \"\\\\'\") c1619_0" "not match: " "" d534_602 ["char"]))+ return c1619_604]+ d535_606 <- get+ t1029_607 <- StateT char+ case t1029_607 of+ '\'' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d535_606 ["char"])+ let '\'' = t1029_607+ return ()+ lift (lift (return $ WChar c)),+ do d536_608 <- get+ t1030_609 <- StateT char+ case t1030_609 of+ '\'' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d536_608 ["char"])+ let '\'' = t1030_609+ return ()+ d537_610 <- get+ t1031_611 <- StateT char+ case t1031_611 of+ '\\' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d537_610 ["char"])+ let '\\' = t1031_611+ return ()+ c <- StateT escChar+ d539_612 <- get+ t1033_613 <- StateT char+ case t1033_613 of+ '\'' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d539_612 ["char"])+ let '\'' = t1033_613+ return ()+ lift (lift (return $ WChar c)),+ do d540_614 <- get+ t1034_615 <- StateT char+ case t1034_615 of+ '"' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d540_614 ["char"])+ let '"' = t1034_615+ return ()+ s <- StateT strLit+ d542_616 <- get+ t1036_617 <- StateT char+ case t1036_617 of+ '"' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d542_616 ["char"])+ let '"' = t1036_617+ return ()+ lift (lift (return $ WString s)),+ do d <- list1143_466 (foldl1 mplus [do d544_618 <- get+ t1038_619 <- StateT char+ let c1620_620 = t1038_619+ b1523_621 <- return (isDigit c1620_620)+ unless b1523_621 (StateT position >>= (throwError . mkParseError "isDigit c1620_0" "not match: " "" d544_618 ["char"]))+ return c1620_620])+ lift (lift (return $ WInteger $ read d)),+ do b <- StateT bras+ lift (lift (return b)),+ do d546_622 <- get+ t1040_623 <- StateT char+ case t1040_623 of+ ',' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "','" "not match pattern: " "" d546_622 ["char"])+ let ',' = t1040_623+ return ()+ lift (lift (return WComma)),+ do d547_624 <- get+ t1041_625 <- StateT char+ case t1041_625 of+ '`' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'`'" "not match pattern: " "" d547_624 ["char"])+ let '`' = t1041_625+ return ()+ lift (lift (return WBackQuote))]+ bras128_132 = foldl1 mplus [do d548_626 <- get+ t1042_627 <- StateT char+ case t1042_627 of+ '[' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'['" "not match pattern: " "" d548_626 ["char"])+ let '[' = t1042_627+ return ()+ lift (lift (return WOBracket)),+ do d549_628 <- get+ t1043_629 <- StateT char+ case t1043_629 of+ ']' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "']'" "not match pattern: " "" d549_628 ["char"])+ let ']' = t1043_629+ return ()+ lift (lift (return WCBracket)),+ do d550_630 <- get+ t1044_631 <- StateT char+ case t1044_631 of+ '{' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d550_630 ["char"])+ let '{' = t1044_631+ return ()+ lift (lift (return WOBrace)),+ do d551_632 <- get+ t1045_633 <- StateT char+ case t1045_633 of+ '}' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d551_632 ["char"])+ let '}' = t1045_633+ return ()+ lift (lift (return WCBrace)),+ do d552_634 <- get+ t1046_635 <- StateT char+ case t1046_635 of+ '(' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'('" "not match pattern: " "" d552_634 ["char"])+ let '(' = t1046_635+ return ()+ lift (lift (return WOParen)),+ do d553_636 <- get+ t1047_637 <- StateT char+ case t1047_637 of+ ')' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "')'" "not match pattern: " "" d553_636 ["char"])+ let ')' = t1047_637+ return ()+ lift (lift (return WCParen))]+ typ129_133 = foldl1 mplus [do u <- foldl1 mplus [do d555_638 <- get+ t1049_639 <- StateT char+ let c1621_640 = t1049_639+ b1534_641 <- return (isUpper c1621_640)+ unless b1534_641 (StateT position >>= (throwError . mkParseError "isUpper c1621_0" "not match: " "" d555_638 ["char"]))+ return c1621_640]+ cs <- list142_147 (foldl1 mplus [do d557_642 <- get+ t1051_643 <- StateT char+ let c1622_644 = t1051_643+ b1536_645 <- return (((||) <$> isAlphaNum <*> (`elem` "_'")) c1622_644)+ unless b1536_645 (StateT position >>= (throwError . mkParseError "((||) <$> isAlphaNum <*> (`elem` \"_'\")) c1622_0" "not match: " "" d557_642 ["char"]))+ return c1622_644])+ lift (lift (return $ u : cs))]+ var130_134 = foldl1 mplus [do l <- foldl1 mplus [do d559_646 <- get+ t1053_647 <- StateT char+ let c1623_648 = t1053_647+ b1538_649 <- return (((||) <$> isLower <*> (== '_')) c1623_648)+ unless b1538_649 (StateT position >>= (throwError . mkParseError "((||) <$> isLower <*> (== '_')) c1623_0" "not match: " "" d559_646 ["char"]))+ return c1623_648]+ cs <- list142_147 (foldl1 mplus [do d561_650 <- get+ t1055_651 <- StateT char+ let c1624_652 = t1055_651+ b1540_653 <- return (((||) <$> isAlphaNum <*> (`elem` "_'")) c1624_652)+ unless b1540_653 (StateT position >>= (throwError . mkParseError "((||) <$> isAlphaNum <*> (`elem` \"_'\")) c1624_0" "not match: " "" d561_650 ["char"]))+ return c1624_652])+ lift (lift (return $ l : cs))]+ strLit131_135 = foldl1 mplus [do c0 <- foldl1 mplus [do d563_654 <- get+ t1057_655 <- StateT char+ case t1057_655 of+ '\\' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d563_654 ["char"])+ let '\\' = t1057_655+ return ()+ c <- StateT escChar+ lift (lift (return c)),+ do d565_656 <- get+ t1059_657 <- StateT char+ let c1625_658 = t1059_657+ b1544_659 <- return ((`notElem` "\"\\") c1625_658)+ unless b1544_659 (StateT position >>= (throwError . mkParseError "(`notElem` \"\\\"\\\\\") c1625_0" "not match: " "" d565_656 ["char"]))+ return c1625_658]+ s <- StateT strLit+ lift (lift (return $ c0 : s)),+ lift (lift (return ""))]+ escChar132_136 = foldl1 mplus [do d567_660 <- get+ t1061_661 <- StateT char+ case t1061_661 of+ '\\' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\\\'" "not match pattern: " "" d567_660 ["char"])+ let '\\' = t1061_661+ return ()+ lift (lift (return '\\')),+ do d568_662 <- get+ t1062_663 <- StateT char+ case t1062_663 of+ '\'' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\''" "not match pattern: " "" d568_662 ["char"])+ let '\'' = t1062_663+ return ()+ lift (lift (return '\'')),+ do d569_664 <- get+ t1063_665 <- StateT char+ case t1063_665 of+ '"' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\"'" "not match pattern: " "" d569_664 ["char"])+ let '"' = t1063_665+ return ()+ lift (lift (return '"')),+ do d570_666 <- get+ t1064_667 <- StateT char+ case t1064_667 of+ 'n' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'n'" "not match pattern: " "" d570_666 ["char"])+ let 'n' = t1064_667+ return ()+ lift (lift (return '\n')),+ do d571_668 <- get+ t1065_669 <- StateT char+ case t1065_669 of+ 'r' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'r'" "not match pattern: " "" d571_668 ["char"])+ let 'r' = t1065_669+ return ()+ lift (lift (return '\r')),+ do d572_670 <- get+ t1066_671 <- StateT char+ case t1066_671 of+ 't' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'t'" "not match pattern: " "" d572_670 ["char"])+ let 't' = t1066_671+ return ()+ lift (lift (return '\t')),+ do d573_672 <- get+ t1067_673 <- StateT char+ case t1067_673 of+ 'x' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'x'" "not match pattern: " "" d573_672 ["char"])+ let 'x' = t1067_673+ return ()+ ds <- list1143_466 (foldl1 mplus [do d575_674 <- get+ t1069_675 <- StateT char+ let c1626_676 = t1069_675+ b1554_677 <- return (isHexDigit c1626_676)+ unless b1554_677 (StateT position >>= (throwError . mkParseError "isHexDigit c1626_0" "not match: " "" d575_674 ["char"]))+ return c1626_676])+ lift (lift (return $ chr $ fst $ head $ readHex ds))]+ space133_137 = foldl1 mplus [do _ <- foldl1 mplus [do d577_678 <- get+ t1071_679 <- StateT char+ let c1627_680 = t1071_679+ b1556_681 <- return ((`elem` " \t") c1627_680)+ unless b1556_681 (StateT position >>= (throwError . mkParseError "(`elem` \" \\t\") c1627_0" "not match: " "" d577_678 ["char"]))+ return c1627_680]+ return ()+ return (),+ do _ <- StateT notSemiColon+ return ()+ return (),+ do _ <- StateT comment+ return ()+ return (),+ do _ <- StateT lineComment+ return ()+ return ()]+ space'134_138 = foldl1 mplus [do _ <- foldl1 mplus [do d582_682 <- get+ t1076_683 <- StateT char+ let c1628_684 = t1076_683+ b1561_685 <- return ((`elem` " \t") c1628_684)+ unless b1561_685 (StateT position >>= (throwError . mkParseError "(`elem` \" \\t\") c1628_0" "not match: " "" d582_682 ["char"]))+ return c1628_684]+ return ()+ return (),+ do _ <- list1143_466 (foldl1 mplus [do d584_686 <- get+ t1078_687 <- StateT char+ case t1078_687 of+ '\n' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d584_686 ["char"])+ let '\n' = t1078_687+ return ()+ lift (lift (return ()))])+ return ()+ return (),+ do _ <- StateT comment+ return ()+ return (),+ do _ <- StateT lineComment+ return ()+ return ()]+ lineComment135_139 = foldl1 mplus [do d587_688 <- get+ t1081_689 <- StateT char+ case t1081_689 of+ '-' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d587_688 ["char"])+ let '-' = t1081_689+ return ()+ d588_690 <- get+ t1082_691 <- StateT char+ case t1082_691 of+ '-' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d588_690 ["char"])+ let '-' = t1082_691+ return ()+ _ <- list142_147 (foldl1 mplus [do d590_692 <- get+ t1084_693 <- StateT char+ let c1629_694 = t1084_693+ b1569_695 <- return ((/= '\n') c1629_694)+ unless b1569_695 (StateT position >>= (throwError . mkParseError "(/= '\\n') c1629_0" "not match: " "" d590_692 ["char"]))+ return c1629_694])+ return ()+ d592_696 <- get+ _ <- do d591_697 <- get+ t1085_698 <- StateT char+ case t1085_698 of+ '\n' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d591_697 ["char"])+ let '\n' = t1085_698+ return ()+ put d592_696+ return ()]+ comment136_140 = foldl1 mplus [do d593_699 <- get+ t1086_700 <- StateT char+ case t1086_700 of+ '{' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'{'" "not match pattern: " "" d593_699 ["char"])+ let '{' = t1086_700+ return ()+ d594_701 <- get+ t1087_702 <- StateT char+ case t1087_702 of+ '-' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d594_701 ["char"])+ let '-' = t1087_702+ return ()+ d596_703 <- get+ do err1609_704 <- ((do d595_705 <- get+ t1088_706 <- StateT char+ case t1088_706 of+ '#' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'#'" "not match pattern: " "" d595_705 ["char"])+ let '#' = t1088_706+ return ()) >> return False) `catchError` const (return True)+ unless err1609_704 (StateT position >>= (throwError . mkParseError "!'#':" "not match: " "" d596_703 ["char"]))+ put d596_703+ _ <- StateT comments+ return ()+ d598_707 <- get+ t1090_708 <- StateT char+ case t1090_708 of+ '-' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d598_707 ["char"])+ let '-' = t1090_708+ return ()+ d599_709 <- get+ t1091_710 <- StateT char+ case t1091_710 of+ '}' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d599_709 ["char"])+ let '}' = t1091_710+ return ()+ return ()]+ comments137_141 = foldl1 mplus [do _ <- StateT comStr+ return ()+ _ <- StateT comment+ return ()+ _ <- StateT comments+ return ()+ return (),+ do _ <- StateT comStr+ return ()+ return ()]+ comStr138_142 = foldl1 mplus [do d605_711 <- get+ do err1610_712 <- ((do _ <- StateT comment+ return ()) >> return False) `catchError` const (return True)+ unless err1610_712 (StateT position >>= (throwError . mkParseError "!_:comment" "not match: " "" d605_711 ["comment"]))+ put d605_711+ d609_713 <- get+ do err1611_714 <- ((do _ <- foldl1 mplus [do d607_715 <- get+ t1098_716 <- StateT char+ case t1098_716 of+ '-' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'-'" "not match pattern: " "" d607_715 ["char"])+ let '-' = t1098_716+ return ()+ d608_717 <- get+ t1099_718 <- StateT char+ case t1099_718 of+ '}' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'}'" "not match pattern: " "" d608_717 ["char"])+ let '}' = t1099_718+ return ()+ return ()]+ return ()) >> return False) `catchError` const (return True)+ unless err1611_714 (StateT position >>= (throwError . mkParseError "!_:('-': '}': {})" "not match: " "" d609_713 ["char"]))+ put d609_713+ _ <- StateT char+ return ()+ _ <- StateT comStr+ return ()+ return (),+ return ()]+ semiColon139_143 = foldl1 mplus [do d612_719 <- get+ t1102_720 <- StateT char+ case t1102_720 of+ ';' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "';'" "not match pattern: " "" d612_719 ["char"])+ let ';' = t1102_720+ return ()+ return (),+ do _ <- list1143_466 (foldl1 mplus [do d614_721 <- get+ t1104_722 <- StateT char+ case t1104_722 of+ '\n' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d614_721 ["char"])+ let '\n' = t1104_722+ return ()+ lift (lift (return ()))])+ return ()+ _ <- list142_147 (foldl1 mplus [do d616_723 <- get+ t1106_724 <- StateT char+ case t1106_724 of+ '\t' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\t'" "not match pattern: " "" d616_723 ["char"])+ let '\t' = t1106_724+ return ()+ return (),+ do d617_725 <- get+ t1107_726 <- StateT char+ case t1107_726 of+ ' ' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "' '" "not match pattern: " "" d617_725 ["char"])+ let ' ' = t1107_726+ return ()+ return ()])+ return ()+ d618_727 <- get+ t1108_728 <- StateT position+ let (!(ListPos (CharPos (_, x)))) = t1108_728+ b1593_729 <- lift (lift (maybe False (x <=) <$> get))+ unless b1593_729 (StateT position >>= (throwError . mkParseError "maybe False (x <=) <$> get" "not match: " "" d618_727 ["position"]))+ d620_730 <- get+ do err1612_731 <- ((do _ <- StateT lineComment+ return ()) >> return False) `catchError` const (return True)+ unless err1612_731 (StateT position >>= (throwError . mkParseError "!_:lineComment" "not match: " "" d620_730 ["lineComment"]))+ put d620_730+ d622_732 <- get+ do err1613_733 <- ((do _ <- StateT comment+ return ()) >> return False) `catchError` const (return True)+ unless err1613_733 (StateT position >>= (throwError . mkParseError "!_:comment" "not match: " "" d622_732 ["comment"]))+ put d622_732+ d624_734 <- get+ do err1614_735 <- ((do d623_736 <- get+ t1111_737 <- StateT char+ case t1111_737 of+ ';' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "';'" "not match pattern: " "" d623_736 ["char"])+ let ';' = t1111_737+ return ()) >> return False) `catchError` const (return True)+ unless err1614_735 (StateT position >>= (throwError . mkParseError "!';':" "not match: " "" d624_734 ["char"]))+ put d624_734+ return (),+ do d626_738 <- get+ do err1615_739 <- ((do d625_740 <- get+ _ <- StateT char+ b1597_741 <- lift (lift (return True))+ unless b1597_741 (StateT position >>= (throwError . mkParseError "return True" "not match: " "" d625_740 ["char"]))) >> return False) `catchError` const (return True)+ unless err1615_739 (StateT position >>= (throwError . mkParseError "!_:[return True]" "not match: " "" d626_738 ["char"]))+ put d626_738+ return ()]+ notSemiColon140_144 = foldl1 mplus [do _ <- list1143_466 (foldl1 mplus [do d628_742 <- get+ t1114_743 <- StateT char+ case t1114_743 of+ '\n' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d628_742 ["char"])+ let '\n' = t1114_743+ return ()+ lift (lift (return ()))])+ return ()+ _ <- list142_147 (foldl1 mplus [do d630_744 <- get+ t1116_745 <- StateT char+ case t1116_745 of+ '\t' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\t'" "not match pattern: " "" d630_744 ["char"])+ let '\t' = t1116_745+ return ()+ return (),+ do d631_746 <- get+ t1117_747 <- StateT char+ case t1117_747 of+ ' ' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "' '" "not match pattern: " "" d631_746 ["char"])+ let ' ' = t1117_747+ return ()+ return ()])+ return ()+ d632_748 <- get+ t1118_749 <- StateT position+ let (!(ListPos (CharPos (_, x)))) = t1118_749+ b1603_750 <- lift (lift (maybe True (x >) <$> get))+ unless b1603_750 (StateT position >>= (throwError . mkParseError "maybe True (x >) <$> get" "not match: " "" d632_748 ["position"]))+ return (),+ do _ <- list1143_466 (foldl1 mplus [do d634_751 <- get+ t1120_752 <- StateT char+ case t1120_752 of+ '\n' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d634_751 ["char"])+ let '\n' = t1120_752+ return ()+ lift (lift (return ()))])+ return ()+ _ <- StateT lineComment+ return ()+ return (),+ do _ <- list1143_466 (foldl1 mplus [do d637_753 <- get+ t1123_754 <- StateT char+ case t1123_754 of+ '\n' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d637_753 ["char"])+ let '\n' = t1123_754+ return ()+ lift (lift (return ()))])+ return ()+ _ <- StateT comment+ return ()+ return (),+ do _ <- list1143_466 (foldl1 mplus [do d640_755 <- get+ t1126_756 <- StateT char+ case t1126_756 of+ '\n' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "'\\n'" "not match pattern: " "" d640_755 ["char"])+ let '\n' = t1126_756+ return ()+ lift (lift (return ()))])+ return ()+ d642_757 <- get+ _ <- do d641_758 <- get+ t1127_759 <- StateT char+ case t1127_759 of+ ';' -> return ()+ _ -> StateT position >>= (throwError . mkParseError "';'" "not match pattern: " "" d641_758 ["char"])+ let ';' = t1127_759+ return ()+ put d642_757+ return ()]+ list142_147 :: forall m a . (MonadPlus m, Applicative m) =>+ m a -> m ([a])+ list1143_466 :: forall m a . (MonadPlus m, Applicative m) =>+ m a -> m ([a])+ list142_147 p = list1143_466 p `mplus` return []+ list1143_466 p = ((:) <$> p) <*> list142_147 p+ optional141_206 :: forall m a . (MonadPlus m, Applicative m) =>+ m a -> m (Maybe a)+ optional141_206 p = (Just <$> p) `mplus` return Nothing+
− src/Text/Papillon/SyntaxTree.hs
@@ -1,230 +0,0 @@-{-# LANGUAGE TupleSections #-}--module Text.Papillon.SyntaxTree (- Peg,- Definition,- Selection,- Expression,- PlainExpression,- Check,- ReadFrom(..),-- Q,- STPegQ,- PegQ,- DefinitionQ,- SelectionQ,- ExpressionQ,- PlainExpressionQ,- CheckQ,- ReadFromQ,-- stPegQ,- definitionQ,- normalSelectionQ,- plainSelectionQ,- expressionQ,- plainExpressionQ,- check,- fromSelectionQ,-- Lookahead(..),- Lists(..),-- fromTokenChars,- expressionSugar,-- selectionType,- pprCheck,- nameFromRF,-- PegFileQ,- mkPegFile,- PPragma(..),- ModuleName,- Exports,- Code,-- dvCharsN-) where--import Language.Haskell.TH-import Language.Haskell.TH.PprLib-import Control.Arrow ((***))-import Data.List--dvCharsN :: String-dvCharsN = "char"--data Lookahead = Here | Ahead | NAhead String deriving (Show, Eq)-data Lists = List | List1 | Optional deriving (Show, Eq)--type STPeg = (Maybe Type, Type, Peg)-type Peg = [Definition]-type Definition = (String, Maybe Type, Selection)-type Selection = Either [Expression] [PlainExpression]-type Expression = Either ([(Lookahead, Check)], Exp) Exp-type PlainExpression = [(Lookahead, ReadFrom)]-type Check = ((Pat, String), ReadFrom, Maybe (Exp, String))-data ReadFrom- = FromVariable (Maybe String)- | FromSelection Selection- | FromL Lists ReadFrom- deriving Show--type STPegQ = STPeg-type PegQ = Peg-type DefinitionQ = Definition-type SelectionQ = Selection-type ExpressionQ = Expression-type PlainExpressionQ = PlainExpression-type CheckQ = Check-type ReadFromQ = ReadFrom--stPegQ :: Maybe Type -> Type -> PegQ -> STPegQ-stPegQ = (,,)--fromSelectionQ :: SelectionQ -> ReadFromQ-fromSelectionQ sel = FromSelection sel--definitionQ :: String -> Maybe Type -> SelectionQ -> DefinitionQ-definitionQ name typq selq = let- sel = selq- typ = case typq of- Just t -> Just t- _ -> Nothing in- (name, typ, sel)--normalSelectionQ :: [ExpressionQ] -> SelectionQ-normalSelectionQ expqs = Left expqs--plainSelectionQ :: [PlainExpressionQ] -> SelectionQ-plainSelectionQ expqs = Right expqs--expressionQ :: ([(Lookahead, CheckQ)], Exp) -> ExpressionQ-expressionQ (ls, ex) =- let e = ex- l = map (\(la, c) -> (la ,) c) ls in- Left (l, e)--plainExpressionQ :: [(Lookahead, ReadFromQ)] -> PlainExpressionQ-plainExpressionQ ls = map (\(la, c) -> (la ,) c) ls--check :: (Pat, String) -> ReadFromQ -> Maybe (Exp, String) -> CheckQ-check (pat, pcom) rfq (Just (test, tcom)) = do- let rf = rfq- p = pat- t = test in- ((p, pcom), rf, Just (t, tcom))-check (pat, pcom) rfq Nothing = do- let rf = rfq- p = pat in- ((p, pcom), rf, Nothing)--expressionSugar :: Exp -> ExpressionQ-expressionSugar pm = Right pm--fromTokenChars :: String -> ReadFromQ-fromTokenChars cs = do- let ex = expressionSugar $ InfixE Nothing (VarE $ mkName "elem") $- Just $ LitE $ StringL cs- FromSelection $ Left [ex]--pprCheck :: Check -> Doc-pprCheck ((pat, _), rf, test) =- ppr pat <> colon <> ppr rf <> maybe empty (brackets . ppr . fst) test--instance Ppr ReadFrom where- ppr (FromVariable (Just v)) = text v- ppr (FromVariable _) = empty- ppr (FromL l rf) = ppr rf <> ppr l- ppr (FromSelection sel) = parens $ ps sel- where- ps = hsep . intersperse (char '/') . either (map pe) (map ppe)- pe (Left (ex, hs)) = (<+> braces (ppr hs)) $ hsep $- map (uncurry ($) . (((<>) . ppr) *** pprCheck)) ex- pe (Right ex) = char '<' <> ppr ex <> char '>'- ppe = hsep . map (uncurry (<>) . (ppr *** ppr))---instance Ppr Lookahead where- ppr Here = empty- ppr Ahead = char '&'- ppr (NAhead _) = char '!'--instance Ppr Lists where- ppr List = char '*'- ppr List1 = char '+'- ppr Optional = char '?'--definitionType :: Peg -> Type -> Definition -> Type-definitionType _ _ (_, Just typ, _) = typ-definitionType peg tk (_, _, sel) = selectionType peg tk sel--selectionType :: Peg -> Type -> Selection -> Type-selectionType peg tk e = do- case e of- Right ex -> foldr (\x y -> (eitherT `AppT` x) `AppT` y)- (last $ types ex) (init $ types ex)- Left [Left ex] | tc ex -> tk- Left [Right _] -> tk- _ -> error "selectionType: can't get type"- where- eitherT = ConT $ mkName "Either"- types e' = map (plainExpressionType peg tk) e'- tc ([(Here, ((VarP p, _), FromVariable Nothing, _))], VarE v) = p == v- tc _ = False--plainExpressionType :: Peg -> Type -> PlainExpression -> Type-plainExpressionType peg tk e = let fe = filter ((== Here) . fst) e in- foldl AppT (TupleT $ length fe) $ map (readFromType peg tk . snd) $ fe--readFromType :: Peg -> Type -> ReadFrom -> Type-readFromType peg tk (FromVariable (Just v)) =- definitionType peg tk $ searchDefinition peg v-readFromType peg tk (FromSelection sel) = selectionType peg tk sel-readFromType _ tk (FromVariable _) = tk-readFromType peg tk (FromL l rf) = lt l `AppT` readFromType peg tk rf- where lt Optional = ConT $ mkName "Maybe"- lt _ = ListT--searchDefinition :: Peg -> String -> Definition-searchDefinition peg name = case flip filter peg $ (== name) . \(n, _, _) -> n of- [d] -> d- _ -> error "searchDefinitionQ: bad"--nameFromSelection :: Selection -> [String]-nameFromSelection exs = concat $- (either (mapM nameFromExpression) (mapM nameFromPlainExpression) exs)--nameFromExpression :: Expression -> [String]-nameFromExpression (Left e) = nameFromCheck $ snd $ head $ fst e-nameFromExpression (Right _) = [dvCharsN]--nameFromPlainExpression :: PlainExpression -> [String]-nameFromPlainExpression = concat . map (nameFromRF . snd)--nameFromCheck :: Check -> [String]-nameFromCheck (_, rf, _) = nameFromRF rf--nameFromRF :: ReadFrom -> [String]-nameFromRF (FromVariable (Just s)) = [s]-nameFromRF (FromVariable _) = [dvCharsN]-nameFromRF (FromL _ rf) = nameFromRF rf-nameFromRF (FromSelection sel) = nameFromSelection sel--type PegFile = ([PPragma], ModuleName, Maybe Exports, Code, STPeg, Code)-type PegFileQ = Q PegFile-data PPragma = LanguagePragma [String] | OtherPragma String deriving Show-type ModuleName = [String]-type Exports = String-type Code = String--mkPegFile :: [PPragma] -> Maybe ([String], Maybe String) -> String -> String ->- STPegQ -> String -> PegFileQ-mkPegFile ps (Just md) x y zq w = do- let z = zq- return (ps, fst md, snd md, x ++ "\n" ++ y, z, w)-mkPegFile ps Nothing x y zq w = do- let z = zq- return (ps, [], Nothing, x ++ "\n" ++ y, z, w)
− src/Text/PapillonCore.hs
@@ -1,427 +0,0 @@-{-# LANGUAGE TemplateHaskell, PackageImports, TypeFamilies, FlexibleContexts,- FlexibleInstances, TupleSections #-}--module Text.PapillonCore (- -- * For Text.Papillon library- papillonCore,-- Source(..),- SourceList(..),-- -- ** For parse error message- ParseError,- mkParseError,- peDerivs,- peReading,- peMessage,- peCode,- peComment,- pePosition,- pePositionS,- Pos(..),- ListPos(..),-- -- * For papillon command- papillonFile,- PPragma(..),- ModuleName,- Exports,- Code,- (<*>),- (<$>),- runError-) where--import Language.Haskell.TH hiding (infixApp, doE)-import "monads-tf" Control.Monad.State-import "monads-tf" Control.Monad.Identity-import "monads-tf" Control.Monad.Error--import Control.Applicative--import Text.Papillon.Parser-import Data.Maybe-import Data.IORef--import Text.Papillon.List--import System.IO.Unsafe--dvPosN :: Name-dvPosN = mkName "position"--papillonCore :: String -> DecsQ-papillonCore str = case runError $ peg $ parse str of- Right (stpegq, _) -> do- let (monad, src, parsed) = stpegq- decParsed True monad src parsed- Left err -> error $ "parse error: " ++ showParseError err--papillonFile :: String ->- Q ([PPragma], ModuleName, Maybe Exports, Code, DecsQ, Code)-papillonFile str = case runError $ pegFile $ parse str of- Right (pegfileq, _) -> do- (prgm, mn, ppp, pp, (monad, src, parsed), atp) <- pegfileq- let lu = listUsed parsed- ou = optionalUsed parsed- let addApplicative =- if lu || ou then "import Control.Applicative\n" else ""- return (prgm, mn, ppp, addApplicative ++ pp, decs monad src parsed, atp)- where- decs = decParsed False- Left err -> error $ "parse error: " ++ showParseError err--decParsed :: Bool -> Maybe Type -> Type -> Peg -> DecsQ-decParsed th monad src parsed = do- let d = derivs th (fromMaybe (ConT $ identityN th) monad) src parsed- pt = SigD (mkName "parse") $ src `arrT` ConT (mkName "Derivs")- p <- funD (mkName "parse") [mkParseBody th (isJust monad) parsed]- return [d, pt, p]--derivs :: Bool -> Type -> Type -> Peg -> Dec-derivs th monad src pg = DataD [] (mkName "Derivs") [] [- RecC (mkName "Derivs") $ map derivs1 pg ++ [- (mkName dvCharsN, NotStrict, resultT tkn),- (dvPosN, NotStrict, ConT (mkName "Pos") `AppT` src)- ]] []- where- tkn = ConT (mkName "Token") `AppT` src- derivs1 (name, Just t, _) = (mkName name, NotStrict, resultT t)- derivs1 (name, Nothing, sel) =- (mkName name, NotStrict, resultT $ selectionType pg tkn sel)- resultT typ = ConT (errorTTN th)- `AppT` (ConT (mkName "ParseError")- `AppT` (ConT (mkName "Pos") `AppT` src)- `AppT` ConT (mkName "Derivs"))- `AppT` monad- `AppT` (TupleT 2 `AppT` typ `AppT` ConT (mkName "Derivs"))--type Variables = [(String, [Name])]--newVariable :: IORef Int -> Variables -> String -> Q Variables-newVariable g vs n = (: vs) . (n ,) <$> vars- where vars = runIO $ unsafeInterleaveIO $ (:)- <$> runQ (newNewName g n) <*> runQ vars--getVariable :: String -> Variables -> Name-getVariable = ((head . fromJust) .) . lookup--nextVariable :: String -> Variables -> Variables-nextVariable n vs = (n, tail $ fromJust $ lookup n vs) : vs--mkParseBody :: Bool -> Bool -> Peg -> ClauseQ-mkParseBody th monadic pg = do- glb <- runIO $ newIORef 0- vars <- foldM (newVariable glb) [] [- "parse", "chars", "pos", "d", "c", "s", "s'", "x", "t", "err", "b",- "list", "list1", "optional"]- let pgn = getVariable "parse" vars- rets <- mapM (newNewName glb . \(n, _, _) -> n) pg- rules <- mapM (newNewName glb . \(n, _, _) -> n) pg- let decs = flip evalState vars $ (:)- <$> (FunD pgn <$> (: []) <$> mkParseCore th rets rules)- <*> zipWithM mkr rules pg- list = if not $ listUsed pg then [] else listDec- (getVariable "list" vars) (getVariable "list1" vars) th- opt = if not $ optionalUsed pg then [] else optionalDec- (getVariable "optional" vars) th- return $ Clause [] (NormalB $ -- VarE (runErrorTN th) `AppE`- VarE pgn `AppE` VarE (mkName "initialPos")) $- decs ++ list ++ opt- where- mkr rule (_, _, sel) =- flip (ValD $ VarP rule) [] . NormalB <$> mkRule th monadic sel--mkParseCore :: Bool -> [Name] -> [Name] -> State Variables Clause-mkParseCore th rets rules = do- [ch, p, s, d] <- mapM (gets . getVariable) ["chars", "pos", "s", "d"]- let def ret rule = flip (ValD $ VarP ret) [] $- NormalB $ VarE (runStateTN th) `AppE` VarE rule `AppE` VarE d- pc <- parseChar th- return $ Clause [VarP p, VarP s] (NormalB $ VarE d) $ [- flip (ValD $ VarP d) [] $ NormalB $ foldl1 AppE $- ConE (mkName "Derivs") : map VarE rets ++ [VarE ch, VarE p]- ] ++ zipWith def rets rules ++ [pc]--parseChar :: Bool -> State Variables Dec-parseChar th = do- [prs, ch, p, c, s, s', d] <- mapM (gets . getVariable)- ["parse", "chars", "pos", "c", "s", "s'", "d"]- let emsg = "end of input"- np = VarE (mkName "updatePos") `AppE` VarE c `AppE` VarE p- return $ flip (ValD $ VarP ch) [] $ NormalB $ VarE (runStateTN th) `AppE`- CaseE (VarE (mkName "getToken") `AppE` VarE s) [- Match (mkName "Just" `ConP` [TupP [VarP c, VarP s']])- (NormalB $ DoE $ map NoBindS [- VarE (putN th) `AppE`- (VarE prs `AppE` np- `AppE` VarE s'),- VarE (mkName "return") `AppE` VarE c])- [],- flip (Match WildP) [] $ NormalB $- throwErrorTH th (mkName "undefined") [] emsg "" ""- ] `AppE` VarE d--mkRule :: Bool -> Bool -> Selection -> State Variables Exp-mkRule t m s = (VarE (mkName "foldl1") `AppE` VarE (mplusN t) `AppE`) . ListE <$>- case s of- Left exs -> expression t m `mapM` exs- Right exs -> zipWithM ((<$>) . lr (length exs)) [0 .. ] $- map (plainExpression t) exs- where- lr 1 0 ex = ex- lr _ 0 ex = infixApp (ConE $ mkName "Left") (VarE $ mkName "<$>") ex- lr l n ex = infixApp (ConE $ mkName "Right") (VarE $ mkName "<$>") $- lr (l - if n == l - 1 then 1 else 0) (n - 1) ex--expression :: Bool -> Bool -> Expression -> State Variables Exp-expression th m (Left (e, r)) =- (doE . (++ [NoBindS $ retLift `AppE` r]) . concat <$>) $- forM e $ \(la, ck@(_, rf, _)) ->- lookahead th la (show $ pprCheck ck) (nameFromRF rf) =<<- check th m ck- where- retLift = if m then VarE $ liftN th else VarE $ mkName "return"-expression th _ (Right e) = do- c <- gets $ getVariable "c"- modify $ nextVariable "c"- let e' = [(Here, ((VarP c, ""), FromVariable Nothing,- Just (e `AppE` VarE c, "")))]- r = VarE c- expression th False (Left (e', r))--check :: Bool -> Bool -> Check -> State Variables [Stmt]-check th monadic ((n, nc), rf, test) = do- t <- gets $ getVariable "t"- d <- gets $ getVariable "d"- b <- gets $ getVariable "b"- modify $ nextVariable "t"- modify $ nextVariable "d"- modify $ nextVariable "b"- case (n, test) of- (WildP, Just p) -> ((BindS (VarP d) (VarE $ getN th) :) .- (: afterCheck th monadic b p d (nameFromRF rf))) .- BindS WildP <$> transReadFrom th rf- (_, Just p)- | notHaveOthers n -> do- let bd = BindS (VarP d) $ VarE $ getN th- m = LetS [ValD n (NormalB $ VarE t) []]- c = afterCheck th monadic b p d (nameFromRF rf)- s <- BindS (VarP t) <$> transReadFrom th rf- return $ [bd, s, m] ++ c- | otherwise -> do- let bd = BindS (VarP d) $ VarE $ getN th- m = beforeMatch th t n d (nameFromRF rf) nc- c = afterCheck th monadic b p d (nameFromRF rf)- s <- BindS (VarP t) <$> transReadFrom th rf- return $ [bd, s] ++ m ++ c- (WildP, _) -> sequence [- BindS WildP <$> transReadFrom th rf,- return $ NoBindS $ VarE (mkName "return") `AppE` TupE []- ]- _ | notHaveOthers n ->- (: []) . BindS n <$> transReadFrom th rf- | otherwise -> do- let bd = BindS (VarP d) $ VarE $ getN th- m = beforeMatch th t n d (nameFromRF rf) nc- s <- BindS (VarP t) <$> transReadFrom th rf- return $ bd : s : m- where- notHaveOthers (VarP _) = True- notHaveOthers (TupP pats) = all notHaveOthers pats- notHaveOthers _ = False--plainExpression :: Bool -> PlainExpression -> State Variables Exp-plainExpression th pexs = do- laxs <- gets $ zip (map fst pexs) . fromJust . lookup "x"- let mkt = LamE (map (uncurry mkp) laxs) $- TupE $ map (VarE . snd) $ filter ((== Here) . fst) laxs- foldl (\x y -> infixApp x (VarE $ mkName "<*>") y)- (VarE (mkName "return") `AppE` mkt) <$>- mapM (transHAReadFrom th) pexs- where- mkp Here n = VarP n- mkp _ _ = WildP--transHAReadFrom :: Bool -> (Lookahead, ReadFrom) -> State Variables Exp-transHAReadFrom th (ha, rf) = do- modify $ nextVariable "d"- doE <$> (lookahead th ha "" (nameFromRF rf) =<<- ((: []) . NoBindS <$> transReadFrom th rf))--lookahead :: Bool -> Lookahead -> String -> [String] -> [Stmt] ->- State Variables [Stmt]-lookahead _ Here _ _ ret = return ret-lookahead th Ahead _ _ ret = do- d <- gets $ getVariable "d"- modify $ nextVariable "d"- return [BindS (VarP d) $ VarE (getN th),- BindS WildP $ doE ret,- NoBindS $ VarE (putN th) `AppE` VarE d]-lookahead th (NAhead com) ck ns ret = do- d <- gets $ getVariable "d"- modify $ nextVariable "d"- n <- negative th ('!' : ck) com- d ns (doE ret)- return [BindS (VarP d) $ VarE (getN th),- NoBindS n,- NoBindS $ VarE (putN th) `AppE` VarE d]--negative :: Bool -> String -> String -> Name -> [String] -> Exp ->- State Variables Exp-negative th code com d ns act = do- err <- gets $ getVariable "err"- modify $ nextVariable "err"- return $ DoE [- BindS (VarP err) $ infixApp- (infixApp act (VarE $ mkName ">>")- (VarE (mkName "return") `AppE`- ConE (mkName "False")))- (VarE $ catchErrorN th)- (VarE (mkName "const") `AppE`- (VarE (mkName "return") `AppE`- ConE (mkName "True"))),- NoBindS $ VarE (unlessN th) `AppE` VarE err `AppE`- throwErrorTH th d ns "not match: " code com]--transReadFrom :: Bool -> ReadFrom -> State Variables Exp-transReadFrom th (FromVariable Nothing) = return $- ConE (stateTN th) `AppE` VarE (mkName dvCharsN)-transReadFrom th (FromVariable (Just var)) = return $- ConE (stateTN th) `AppE` VarE (mkName var)-transReadFrom th (FromSelection sel) = mkRule th {- stub -} False {- stub -} sel-transReadFrom th (FromL List rf) = do- list <- gets $ getVariable "list"- (VarE list `AppE`) <$> transReadFrom th rf-transReadFrom th (FromL List1 rf) = do- list1 <- gets $ getVariable "list1"- (VarE list1 `AppE`) <$> transReadFrom th rf-transReadFrom th (FromL Optional rf) = do- opt <- gets $ getVariable "optional"- (VarE opt `AppE`) <$> transReadFrom th rf--beforeMatch :: Bool -> Name -> Pat -> Name -> [String] -> String -> [Stmt]-beforeMatch th t nn d ns nc = [- NoBindS $ CaseE (VarE t) [- flip (Match $ vpw nn) [] $ NormalB $- VarE (mkName "return") `AppE` TupE [],- flip (Match WildP) [] $ NormalB $- throwErrorTH th d ns "not match pattern: " (show $ ppr nn) nc],- LetS [ValD nn (NormalB $ VarE t) []],- NoBindS $ VarE (mkName "return") `AppE` TupE []]- where- 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--afterCheck :: Bool -> Bool -> Name -> (Exp, String) -> Name -> [String] -> [Stmt]-afterCheck th monadic b (pp, pc) d ns = [- BindS (VarP b) $ retLift `AppE` pp,- NoBindS $ VarE (unlessN th) `AppE` VarE b `AppE`- throwErrorTH th d ns "not match: " (show $ ppr pp) pc]- where- retLift = if monadic then VarE $ liftN th else VarE $ mkName "return"--listUsed, optionalUsed :: Peg -> Bool-listUsed = any $ sel . \(_, _, s) -> s- where- sel = either (any ex) (any $ any $ rf . snd)- ex (Left e) = any (rf . (\(_, r, _) -> r) . snd) $ fst e- ex (Right _) = False- rf (FromL List _) = True- rf (FromL List1 _) = True- rf (FromSelection s) = sel s- rf _ = False-optionalUsed = any $ sel . \(_, _, s) -> s- where- sel = either (any $ ex) (any $ any $ rf . snd)- ex (Left e) = any (rf . (\(_, r, _) -> r) . snd) $ fst e- ex (Right _) = False- rf (FromL Optional _) = True- rf (FromSelection s) = sel s- rf _ = False--throwErrorTH :: Bool -> Name -> [String] -> String -> String -> String -> Exp-throwErrorTH th d ns msg code com = InfixE- (Just $ VarE (getsN th) `AppE` VarE dvPosN)- (VarE $ mkName ">>=")- (Just $ InfixE- (Just $ VarE $ throwErrorN th)- (VarE $ mkName ".")- (Just $ VarE (mkName "mkParseError")- `AppE` LitE (StringL code)- `AppE` LitE (StringL msg)- `AppE` LitE (StringL com)- `AppE` VarE d- `AppE` ListE (map (LitE . StringL) ns)))--newNewName :: IORef Int -> String -> Q Name-newNewName g base = do- n <- runIO $ readIORef g- runIO $ modifyIORef g succ- newName $ base ++ show n--showParseError :: ParseError (Pos String) Derivs -> String-showParseError pe =- unwords (map (showReading d) ns) ++ (if null ns then "" else " ") ++- m ++ c ++ " at position: " ++ show p- where- [c, m, _] = ($ pe) `map` [peCode, peMessage, peComment]- ns = peReading pe- d = peDerivs pe- p = pePositionS pe--showReading :: Derivs -> String -> String-showReading d n- | n == dvCharsN = case runError $ char d of- Right (c, _) -> show c- Left _ -> error "bad"-showReading _ n = "yet: " ++ n--doE :: [Stmt] -> Exp-doE [NoBindS ex] = ex-doE stmts = DoE stmts--arrT :: Type -> Type -> Type-arrT a r = ArrowT `AppT` a `AppT` r--infixApp :: Exp -> Exp -> Exp -> Exp-infixApp e1 op e2 = InfixE (Just e1) op (Just e2)--stateTN, runStateTN, putN, getN, getsN :: Bool -> Name-stateTN True = 'StateT-stateTN False = mkName "StateT"-runStateTN True = 'runStateT-runStateTN False = mkName "runStateT"-putN True = 'put-putN False = mkName "put"-getN True = 'get-getN False = mkName "get"-getsN True = 'gets-getsN False = mkName "gets"--unlessN, mplusN :: Bool -> Name-unlessN True = 'unless-unlessN False = mkName "unless"-mplusN True = 'mplus-mplusN False = mkName "mplus"--throwErrorN, catchErrorN :: Bool -> Name-throwErrorN True = 'throwError-throwErrorN False = mkName "throwError"-catchErrorN True = 'catchError-catchErrorN False = mkName "catchError"--errorTTN, identityN :: Bool -> Name-errorTTN True = ''ErrorT-errorTTN False = mkName "ErrorT"-identityN True = ''Identity-identityN False = mkName "Identity"--liftN :: Bool -> Name-liftN True = 'lift-liftN False = mkName "lift"