diff --git a/bin/Class.hs b/bin/Class.hs --- a/bin/Class.hs +++ b/bin/Class.hs @@ -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 diff --git a/bin/papillon.hs b/bin/papillon.hs --- a/bin/papillon.hs +++ b/bin/papillon.hs @@ -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) diff --git a/papillon.cabal b/papillon.cabal --- a/papillon.cabal +++ b/papillon.cabal @@ -2,7 +2,7 @@ cabal-version: >= 1.8 name: papillon -version: 0.0.62 +version: 0.0.88 stability: Experimental author: Yoshikuni Jujo maintainer: Yoshikuni Jujo @@ -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 diff --git a/src/Text/Papillon.hs b/src/Text/Papillon.hs --- a/src/Text/Papillon.hs +++ b/src/Text/Papillon.hs @@ -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 diff --git a/src/Text/Papillon/Core.hs b/src/Text/Papillon/Core.hs new file mode 100644 --- /dev/null +++ b/src/Text/Papillon/Core.hs @@ -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 diff --git a/src/Text/Papillon/Papillon.hs b/src/Text/Papillon/Papillon.hs --- a/src/Text/Papillon/Papillon.hs +++ b/src/Text/Papillon/Papillon.hs @@ -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 diff --git a/src/Text/Papillon/Parser.hs b/src/Text/Papillon/Parser.hs --- a/src/Text/Papillon/Parser.hs +++ b/src/Text/Papillon/Parser.hs @@ -1,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 + diff --git a/src/Text/Papillon/SyntaxTree.hs b/src/Text/Papillon/SyntaxTree.hs deleted file mode 100644 --- a/src/Text/Papillon/SyntaxTree.hs +++ /dev/null @@ -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) diff --git a/src/Text/PapillonCore.hs b/src/Text/PapillonCore.hs deleted file mode 100644 --- a/src/Text/PapillonCore.hs +++ /dev/null @@ -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"