{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}

{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# LANGUAGE CPP #-}
-- UUAGC 0.9.53.1 (src/GLuaFixer/AG/LexLint.ag)
module GLuaFixer.AG.LexLint(
    lintWarnings,
    fixedLexPositions
) where

{-# LINE 9 "src/GLuaFixer/AG/../../GLua/AG/Token.ag" #-}

import GHC.Generics
import GLua.Position
{-# LINE 19 "src/GLuaFixer/AG/LexLint.hs" #-}

{-# LINE 15 "src/GLuaFixer/AG/LexLint.ag" #-}

import Control.Applicative ((<|>))
import Data.List
import GLua.TokenTypes
import GLua.AG.Token
import GLua.Position
import GLuaFixer.LintMessage
import GLuaFixer.LintSettings
{-# LINE 30 "src/GLuaFixer/AG/LexLint.hs" #-}
{-# LINE 27 "src/GLuaFixer/AG/LexLint.ag" #-}


----------------------------------------
--  C-style / Lua-style syntax inconsistencies
----------------------------------------
-- For detecting the usage of Lua/C syntax inconsistently. 'Nothing' means no evidence of the style,
-- and 'Just Region' represents the last place where the style was found to be used.
data SyntaxUsed = SyntaxUsed
    { lastLuaExample :: Maybe Region
    , lastCExample :: Maybe Region
    }
    deriving (Show)

instance Semigroup SyntaxUsed where
    -- Later uses have preference over earlier uses
    (SyntaxUsed l1 c1) <> (SyntaxUsed l2 c2) = SyntaxUsed (l2 <|> l1) (c2 <|> c1)

-- Monoid instance
instance Monoid SyntaxUsed where
    mempty = SyntaxUsed Nothing Nothing

previousSyntaxUsedRegion :: SyntaxUsed -> Maybe Region
previousSyntaxUsedRegion syntaxUsed = case syntaxUsed of
    SyntaxUsed (Just l) (Just c) -> Just $ min l c
    -- There is no previous region if there is no syntax inconsistency
    SyntaxUsed {} -> Nothing

-- | Whether there is evidence of Lua style code
luaUsed :: SyntaxUsed -> Bool
luaUsed (SyntaxUsed (Just _) _) = True
luaUsed _ = False

-- | Whether there is evidence of C style code
cUsed :: SyntaxUsed -> Bool
cUsed (SyntaxUsed _ (Just _)) = True
cUsed _ = False

-- | Quick helper to turn a bool and region into a member for 'SyntaxUsed'
mkSyntax :: Bool -> Region -> Maybe Region
mkSyntax b region = if b then Just region else Nothing

-- | Whether the syntax is consistent
consistent :: SyntaxUsed -> Bool
consistent syntaxUsed = case syntaxUsed of
    SyntaxUsed (Just _) (Just _) -> False
    _ -> True

mTokenWarning :: Region -> Issue -> FilePath -> LintMessage
mTokenWarning pos issue = LintMessage LintWarning pos issue

-- | Shorthand for throwing _two_ warnings when an inconsistency occurs: one at the original place
-- and one at the new place.
warnInconsistency :: SyntaxUsed -> Issue -> [FilePath -> LintMessage] -> [FilePath -> LintMessage]
warnInconsistency syntaxUsed issue messages = case syntaxUsed of
    SyntaxUsed (Just luaRegion) (Just cRegion) ->
        LintMessage LintWarning luaRegion issue :
        LintMessage LintWarning cRegion issue :
        messages
    _ -> messages

-- | Handy function to reset the built up knowledge of 'SyntaxUsed' when it is found to be
-- inconsistent.
resetIfInconsistent :: SyntaxUsed -> SyntaxUsed
resetIfInconsistent syntaxUsed = case syntaxUsed of
    SyntaxUsed (Just {}) (Just {}) -> SyntaxUsed Nothing Nothing
    _ -> syntaxUsed

isSingleChar :: String -> Bool
isSingleChar [] = True
isSingleChar ('\\' : xs) = length xs == 1
isSingleChar (_ : []) = True
isSingleChar _ = False

-- Locate the exact position of trailing whitespace
locateTrailingWhitespace :: LineColPos -> String -> (LineColPos, String)
locateTrailingWhitespace pos (' ' : xs) = (pos, xs)
locateTrailingWhitespace pos ('\t' : xs) = (pos, xs)
locateTrailingWhitespace pos (x : xs) = locateTrailingWhitespace (customAdvanceChr pos x) xs
locateTrailingWhitespace pos [] = (pos, "")

-- Locate the start of a line's indentation in a string of whitespace
indentationStart :: LineColPos -> String -> LineColPos
indentationStart pos = go pos pos
  where
    go :: LineColPos -> LineColPos -> String -> LineColPos
    go _ cur ('\n' : xs) = let next = customAdvanceChr cur '\n' in go next next xs
    go found cur (x : xs) = go found (customAdvanceChr cur x) xs
    go found _ [] = found

endOfTrailingWhitespace :: (LineColPos, String) -> LineColPos
endOfTrailingWhitespace (pos, ('\n' : _)) = pos
endOfTrailingWhitespace (pos, (x : xs)) = endOfTrailingWhitespace (customAdvanceChr pos x, xs)
endOfTrailingWhitespace (pos, []) = pos


{-# LINE 127 "src/GLuaFixer/AG/LexLint.hs" #-}

{-# LINE 296 "src/GLuaFixer/AG/LexLint.ag" #-}



inh_MTokenList :: LintSettings -> Inh_MTokenList
inh_MTokenList conf =
                 Inh_MTokenList {
                    config_Inh_MTokenList                   = conf,
                    andSyntax_Inh_MTokenList                = mempty,
                    indentation_Inh_MTokenList              = mempty,
                    lineCommentSyntax_Inh_MTokenList        = mempty,
                    multilineCommentSyntax_Inh_MTokenList   = mempty,
                    neqSyntax_Inh_MTokenList                = mempty,
                    notSyntax_Inh_MTokenList                = mempty,
                    orSyntax_Inh_MTokenList                 = mempty,
                    strSyntax_Inh_MTokenList                = mempty,
                    nextTokenPos_Inh_MTokenList             = LineColPos 0 0 0
                 }

lintWarnings        :: LintSettings -> [MToken] -> [String -> LintMessage]
lintWarnings conf p = warnings_Syn_MTokenList (wrap_MTokenList (sem_MTokenList p) (inh_MTokenList conf))

-- Necessary because the parser walks over tabs as though they are 8 spaces.
fixedLexPositions   :: [MToken] -> [MToken]
fixedLexPositions p = copy_Syn_MTokenList (wrap_MTokenList (sem_MTokenList p) (inh_MTokenList defaultLintSettings))
{-# LINE 154 "src/GLuaFixer/AG/LexLint.hs" #-}
-- MToken ------------------------------------------------------
-- cata
sem_MToken :: MToken ->
              T_MToken
sem_MToken :: MToken -> T_MToken
sem_MToken (MToken Region
_mpos Token
_mtok) =
    (Region -> T_Token -> T_MToken
sem_MToken_MToken Region
_mpos (Token -> T_Token
sem_Token Token
_mtok))
-- semantic domain
type T_MToken = SyntaxUsed ->
                LintSettings ->
                SyntaxUsed ->
                SyntaxUsed ->
                SyntaxUsed ->
                SyntaxUsed ->
                LineColPos ->
                SyntaxUsed ->
                SyntaxUsed ->
                SyntaxUsed ->
                ( SyntaxUsed,MToken,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,LineColPos,SyntaxUsed,SyntaxUsed,SyntaxUsed,([FilePath -> LintMessage]))
data Inh_MToken = Inh_MToken {Inh_MToken -> SyntaxUsed
andSyntax_Inh_MToken :: SyntaxUsed,Inh_MToken -> LintSettings
config_Inh_MToken :: LintSettings,Inh_MToken -> SyntaxUsed
indentation_Inh_MToken :: SyntaxUsed,Inh_MToken -> SyntaxUsed
lineCommentSyntax_Inh_MToken :: SyntaxUsed,Inh_MToken -> SyntaxUsed
multilineCommentSyntax_Inh_MToken :: SyntaxUsed,Inh_MToken -> SyntaxUsed
neqSyntax_Inh_MToken :: SyntaxUsed,Inh_MToken -> LineColPos
nextTokenPos_Inh_MToken :: LineColPos,Inh_MToken -> SyntaxUsed
notSyntax_Inh_MToken :: SyntaxUsed,Inh_MToken -> SyntaxUsed
orSyntax_Inh_MToken :: SyntaxUsed,Inh_MToken -> SyntaxUsed
strSyntax_Inh_MToken :: SyntaxUsed}
data Syn_MToken = Syn_MToken {Syn_MToken -> SyntaxUsed
andSyntax_Syn_MToken :: SyntaxUsed,Syn_MToken -> MToken
copy_Syn_MToken :: MToken,Syn_MToken -> SyntaxUsed
indentation_Syn_MToken :: SyntaxUsed,Syn_MToken -> SyntaxUsed
lineCommentSyntax_Syn_MToken :: SyntaxUsed,Syn_MToken -> SyntaxUsed
multilineCommentSyntax_Syn_MToken :: SyntaxUsed,Syn_MToken -> SyntaxUsed
neqSyntax_Syn_MToken :: SyntaxUsed,Syn_MToken -> LineColPos
nextTokenPos_Syn_MToken :: LineColPos,Syn_MToken -> SyntaxUsed
notSyntax_Syn_MToken :: SyntaxUsed,Syn_MToken -> SyntaxUsed
orSyntax_Syn_MToken :: SyntaxUsed,Syn_MToken -> SyntaxUsed
strSyntax_Syn_MToken :: SyntaxUsed,Syn_MToken -> [String -> LintMessage]
warnings_Syn_MToken :: ([FilePath -> LintMessage])}
wrap_MToken :: T_MToken ->
               Inh_MToken ->
               Syn_MToken
wrap_MToken :: T_MToken -> Inh_MToken -> Syn_MToken
wrap_MToken T_MToken
sem (Inh_MToken SyntaxUsed
_lhsIandSyntax LintSettings
_lhsIconfig SyntaxUsed
_lhsIindentation SyntaxUsed
_lhsIlineCommentSyntax SyntaxUsed
_lhsImultilineCommentSyntax SyntaxUsed
_lhsIneqSyntax LineColPos
_lhsInextTokenPos SyntaxUsed
_lhsInotSyntax SyntaxUsed
_lhsIorSyntax SyntaxUsed
_lhsIstrSyntax) =
    (let ( SyntaxUsed
_lhsOandSyntax,MToken
_lhsOcopy,SyntaxUsed
_lhsOindentation,SyntaxUsed
_lhsOlineCommentSyntax,SyntaxUsed
_lhsOmultilineCommentSyntax,SyntaxUsed
_lhsOneqSyntax,LineColPos
_lhsOnextTokenPos,SyntaxUsed
_lhsOnotSyntax,SyntaxUsed
_lhsOorSyntax,SyntaxUsed
_lhsOstrSyntax,[String -> LintMessage]
_lhsOwarnings) = T_MToken
sem SyntaxUsed
_lhsIandSyntax LintSettings
_lhsIconfig SyntaxUsed
_lhsIindentation SyntaxUsed
_lhsIlineCommentSyntax SyntaxUsed
_lhsImultilineCommentSyntax SyntaxUsed
_lhsIneqSyntax LineColPos
_lhsInextTokenPos SyntaxUsed
_lhsInotSyntax SyntaxUsed
_lhsIorSyntax SyntaxUsed
_lhsIstrSyntax
     in  (SyntaxUsed
-> MToken
-> SyntaxUsed
-> SyntaxUsed
-> SyntaxUsed
-> SyntaxUsed
-> LineColPos
-> SyntaxUsed
-> SyntaxUsed
-> SyntaxUsed
-> [String -> LintMessage]
-> Syn_MToken
Syn_MToken SyntaxUsed
_lhsOandSyntax MToken
_lhsOcopy SyntaxUsed
_lhsOindentation SyntaxUsed
_lhsOlineCommentSyntax SyntaxUsed
_lhsOmultilineCommentSyntax SyntaxUsed
_lhsOneqSyntax LineColPos
_lhsOnextTokenPos SyntaxUsed
_lhsOnotSyntax SyntaxUsed
_lhsOorSyntax SyntaxUsed
_lhsOstrSyntax [String -> LintMessage]
_lhsOwarnings))
sem_MToken_MToken :: Region ->
                     T_Token ->
                     T_MToken
sem_MToken_MToken :: Region -> T_Token -> T_MToken
sem_MToken_MToken Region
mpos_ T_Token
mtok_ =
    (\ SyntaxUsed
_lhsIandSyntax
       LintSettings
_lhsIconfig
       SyntaxUsed
_lhsIindentation
       SyntaxUsed
_lhsIlineCommentSyntax
       SyntaxUsed
_lhsImultilineCommentSyntax
       SyntaxUsed
_lhsIneqSyntax
       LineColPos
_lhsInextTokenPos
       SyntaxUsed
_lhsInotSyntax
       SyntaxUsed
_lhsIorSyntax
       SyntaxUsed
_lhsIstrSyntax ->
         (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-}
                 _lhsInextTokenPos
                 {-# LINE 197 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _mtokOnextTokenPos ->
          (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                  _lhsIandSyntax
                  {-# LINE 202 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _mtokOandSyntax ->
           (case (mtok_ _mtokOnextTokenPos) of
            { ( _mtokInextTokenPos,mtok_1) ->
                (case (({-# LINE 156 "src/GLuaFixer/AG/LexLint.ag" #-}
                        Region _lhsInextTokenPos _mtokInextTokenPos
                        {-# LINE 209 "src/GLuaFixer/AG/LexLint.hs" #-}
                        )) of
                 { _mpos ->
                 (case (({-# LINE 157 "src/GLuaFixer/AG/LexLint.ag" #-}
                         _mpos
                         {-# LINE 214 "src/GLuaFixer/AG/LexLint.hs" #-}
                         )) of
                  { _mtokOmpos ->
                  (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                          _lhsIstrSyntax
                          {-# LINE 219 "src/GLuaFixer/AG/LexLint.hs" #-}
                          )) of
                   { _mtokOstrSyntax ->
                   (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                           _lhsIorSyntax
                           {-# LINE 224 "src/GLuaFixer/AG/LexLint.hs" #-}
                           )) of
                    { _mtokOorSyntax ->
                    (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                            _lhsInotSyntax
                            {-# LINE 229 "src/GLuaFixer/AG/LexLint.hs" #-}
                            )) of
                     { _mtokOnotSyntax ->
                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                             _lhsIneqSyntax
                             {-# LINE 234 "src/GLuaFixer/AG/LexLint.hs" #-}
                             )) of
                      { _mtokOneqSyntax ->
                      (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                              _lhsImultilineCommentSyntax
                              {-# LINE 239 "src/GLuaFixer/AG/LexLint.hs" #-}
                              )) of
                       { _mtokOmultilineCommentSyntax ->
                       (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                               _lhsIlineCommentSyntax
                               {-# LINE 244 "src/GLuaFixer/AG/LexLint.hs" #-}
                               )) of
                        { _mtokOlineCommentSyntax ->
                        (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                _lhsIindentation
                                {-# LINE 249 "src/GLuaFixer/AG/LexLint.hs" #-}
                                )) of
                         { _mtokOindentation ->
                         (case (({-# LINE 128 "src/GLuaFixer/AG/LexLint.ag" #-}
                                 _lhsIconfig
                                 {-# LINE 254 "src/GLuaFixer/AG/LexLint.hs" #-}
                                 )) of
                          { _mtokOconfig ->
                          (case (mtok_1 _mtokOandSyntax _mtokOconfig _mtokOindentation _mtokOlineCommentSyntax _mtokOmpos _mtokOmultilineCommentSyntax _mtokOneqSyntax _mtokOnotSyntax _mtokOorSyntax _mtokOstrSyntax) of
                           { ( _mtokIandSyntax,_mtokIcopy,_mtokIindentation,_mtokIlineCommentSyntax,_mtokImultilineCommentSyntax,_mtokIneqSyntax,_mtokInotSyntax,_mtokIorSyntax,_mtokIstrSyntax,_mtokIwarnings) ->
                               (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                       _mtokIandSyntax
                                       {-# LINE 261 "src/GLuaFixer/AG/LexLint.hs" #-}
                                       )) of
                                { _lhsOandSyntax ->
                                (case (({-# LINE 160 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        MToken (const _mpos     mpos_) _mtokIcopy
                                        {-# LINE 266 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _copy ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 271 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _mtokIindentation
                                          {-# LINE 276 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _mtokIlineCommentSyntax
                                           {-# LINE 281 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _mtokImultilineCommentSyntax
                                            {-# LINE 286 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _mtokIneqSyntax
                                             {-# LINE 291 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _mtokInextTokenPos
                                              {-# LINE 296 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnextTokenPos ->
                                       (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _mtokInotSyntax
                                               {-# LINE 301 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOnotSyntax ->
                                        (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _mtokIorSyntax
                                                {-# LINE 306 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOorSyntax ->
                                         (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _mtokIstrSyntax
                                                 {-# LINE 311 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOstrSyntax ->
                                          (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _mtokIwarnings
                                                  {-# LINE 316 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOwarnings ->
                                           ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
-- MTokenList --------------------------------------------------
-- cata
sem_MTokenList :: MTokenList ->
                  T_MTokenList
sem_MTokenList :: [MToken] -> T_MTokenList
sem_MTokenList [MToken]
list =
    (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr T_MToken -> T_MTokenList -> T_MTokenList
sem_MTokenList_Cons T_MTokenList
sem_MTokenList_Nil (forall a b. (a -> b) -> [a] -> [b]
Prelude.map MToken -> T_MToken
sem_MToken [MToken]
list))
-- semantic domain
type T_MTokenList = SyntaxUsed ->
                    LintSettings ->
                    SyntaxUsed ->
                    SyntaxUsed ->
                    SyntaxUsed ->
                    SyntaxUsed ->
                    LineColPos ->
                    SyntaxUsed ->
                    SyntaxUsed ->
                    SyntaxUsed ->
                    ( SyntaxUsed,MTokenList,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,LineColPos,SyntaxUsed,SyntaxUsed,SyntaxUsed,([FilePath -> LintMessage]))
data Inh_MTokenList = Inh_MTokenList {Inh_MTokenList -> SyntaxUsed
andSyntax_Inh_MTokenList :: SyntaxUsed,Inh_MTokenList -> LintSettings
config_Inh_MTokenList :: LintSettings,Inh_MTokenList -> SyntaxUsed
indentation_Inh_MTokenList :: SyntaxUsed,Inh_MTokenList -> SyntaxUsed
lineCommentSyntax_Inh_MTokenList :: SyntaxUsed,Inh_MTokenList -> SyntaxUsed
multilineCommentSyntax_Inh_MTokenList :: SyntaxUsed,Inh_MTokenList -> SyntaxUsed
neqSyntax_Inh_MTokenList :: SyntaxUsed,Inh_MTokenList -> LineColPos
nextTokenPos_Inh_MTokenList :: LineColPos,Inh_MTokenList -> SyntaxUsed
notSyntax_Inh_MTokenList :: SyntaxUsed,Inh_MTokenList -> SyntaxUsed
orSyntax_Inh_MTokenList :: SyntaxUsed,Inh_MTokenList -> SyntaxUsed
strSyntax_Inh_MTokenList :: SyntaxUsed}
data Syn_MTokenList = Syn_MTokenList {Syn_MTokenList -> SyntaxUsed
andSyntax_Syn_MTokenList :: SyntaxUsed,Syn_MTokenList -> [MToken]
copy_Syn_MTokenList :: MTokenList,Syn_MTokenList -> SyntaxUsed
indentation_Syn_MTokenList :: SyntaxUsed,Syn_MTokenList -> SyntaxUsed
lineCommentSyntax_Syn_MTokenList :: SyntaxUsed,Syn_MTokenList -> SyntaxUsed
multilineCommentSyntax_Syn_MTokenList :: SyntaxUsed,Syn_MTokenList -> SyntaxUsed
neqSyntax_Syn_MTokenList :: SyntaxUsed,Syn_MTokenList -> LineColPos
nextTokenPos_Syn_MTokenList :: LineColPos,Syn_MTokenList -> SyntaxUsed
notSyntax_Syn_MTokenList :: SyntaxUsed,Syn_MTokenList -> SyntaxUsed
orSyntax_Syn_MTokenList :: SyntaxUsed,Syn_MTokenList -> SyntaxUsed
strSyntax_Syn_MTokenList :: SyntaxUsed,Syn_MTokenList -> [String -> LintMessage]
warnings_Syn_MTokenList :: ([FilePath -> LintMessage])}
wrap_MTokenList :: T_MTokenList ->
                   Inh_MTokenList ->
                   Syn_MTokenList
wrap_MTokenList :: T_MTokenList -> Inh_MTokenList -> Syn_MTokenList
wrap_MTokenList T_MTokenList
sem (Inh_MTokenList SyntaxUsed
_lhsIandSyntax LintSettings
_lhsIconfig SyntaxUsed
_lhsIindentation SyntaxUsed
_lhsIlineCommentSyntax SyntaxUsed
_lhsImultilineCommentSyntax SyntaxUsed
_lhsIneqSyntax LineColPos
_lhsInextTokenPos SyntaxUsed
_lhsInotSyntax SyntaxUsed
_lhsIorSyntax SyntaxUsed
_lhsIstrSyntax) =
    (let ( SyntaxUsed
_lhsOandSyntax,[MToken]
_lhsOcopy,SyntaxUsed
_lhsOindentation,SyntaxUsed
_lhsOlineCommentSyntax,SyntaxUsed
_lhsOmultilineCommentSyntax,SyntaxUsed
_lhsOneqSyntax,LineColPos
_lhsOnextTokenPos,SyntaxUsed
_lhsOnotSyntax,SyntaxUsed
_lhsOorSyntax,SyntaxUsed
_lhsOstrSyntax,[String -> LintMessage]
_lhsOwarnings) = T_MTokenList
sem SyntaxUsed
_lhsIandSyntax LintSettings
_lhsIconfig SyntaxUsed
_lhsIindentation SyntaxUsed
_lhsIlineCommentSyntax SyntaxUsed
_lhsImultilineCommentSyntax SyntaxUsed
_lhsIneqSyntax LineColPos
_lhsInextTokenPos SyntaxUsed
_lhsInotSyntax SyntaxUsed
_lhsIorSyntax SyntaxUsed
_lhsIstrSyntax
     in  (SyntaxUsed
-> [MToken]
-> SyntaxUsed
-> SyntaxUsed
-> SyntaxUsed
-> SyntaxUsed
-> LineColPos
-> SyntaxUsed
-> SyntaxUsed
-> SyntaxUsed
-> [String -> LintMessage]
-> Syn_MTokenList
Syn_MTokenList SyntaxUsed
_lhsOandSyntax [MToken]
_lhsOcopy SyntaxUsed
_lhsOindentation SyntaxUsed
_lhsOlineCommentSyntax SyntaxUsed
_lhsOmultilineCommentSyntax SyntaxUsed
_lhsOneqSyntax LineColPos
_lhsOnextTokenPos SyntaxUsed
_lhsOnotSyntax SyntaxUsed
_lhsOorSyntax SyntaxUsed
_lhsOstrSyntax [String -> LintMessage]
_lhsOwarnings))
sem_MTokenList_Cons :: T_MToken ->
                       T_MTokenList ->
                       T_MTokenList
sem_MTokenList_Cons :: T_MToken -> T_MTokenList -> T_MTokenList
sem_MTokenList_Cons T_MToken
hd_ T_MTokenList
tl_ =
    (\ SyntaxUsed
_lhsIandSyntax
       LintSettings
_lhsIconfig
       SyntaxUsed
_lhsIindentation
       SyntaxUsed
_lhsIlineCommentSyntax
       SyntaxUsed
_lhsImultilineCommentSyntax
       SyntaxUsed
_lhsIneqSyntax
       LineColPos
_lhsInextTokenPos
       SyntaxUsed
_lhsInotSyntax
       SyntaxUsed
_lhsIorSyntax
       SyntaxUsed
_lhsIstrSyntax ->
         (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-}
                 _lhsInextTokenPos
                 {-# LINE 362 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _hdOnextTokenPos ->
          (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                  _lhsIstrSyntax
                  {-# LINE 367 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _hdOstrSyntax ->
           (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                   _lhsIorSyntax
                   {-# LINE 372 "src/GLuaFixer/AG/LexLint.hs" #-}
                   )) of
            { _hdOorSyntax ->
            (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                    _lhsInotSyntax
                    {-# LINE 377 "src/GLuaFixer/AG/LexLint.hs" #-}
                    )) of
             { _hdOnotSyntax ->
             (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                     _lhsIneqSyntax
                     {-# LINE 382 "src/GLuaFixer/AG/LexLint.hs" #-}
                     )) of
              { _hdOneqSyntax ->
              (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                      _lhsImultilineCommentSyntax
                      {-# LINE 387 "src/GLuaFixer/AG/LexLint.hs" #-}
                      )) of
               { _hdOmultilineCommentSyntax ->
               (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                       _lhsIlineCommentSyntax
                       {-# LINE 392 "src/GLuaFixer/AG/LexLint.hs" #-}
                       )) of
                { _hdOlineCommentSyntax ->
                (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                        _lhsIindentation
                        {-# LINE 397 "src/GLuaFixer/AG/LexLint.hs" #-}
                        )) of
                 { _hdOindentation ->
                 (case (({-# LINE 128 "src/GLuaFixer/AG/LexLint.ag" #-}
                         _lhsIconfig
                         {-# LINE 402 "src/GLuaFixer/AG/LexLint.hs" #-}
                         )) of
                  { _hdOconfig ->
                  (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                          _lhsIandSyntax
                          {-# LINE 407 "src/GLuaFixer/AG/LexLint.hs" #-}
                          )) of
                   { _hdOandSyntax ->
                   (case (hd_ _hdOandSyntax _hdOconfig _hdOindentation _hdOlineCommentSyntax _hdOmultilineCommentSyntax _hdOneqSyntax _hdOnextTokenPos _hdOnotSyntax _hdOorSyntax _hdOstrSyntax) of
                    { ( _hdIandSyntax,_hdIcopy,_hdIindentation,_hdIlineCommentSyntax,_hdImultilineCommentSyntax,_hdIneqSyntax,_hdInextTokenPos,_hdInotSyntax,_hdIorSyntax,_hdIstrSyntax,_hdIwarnings) ->
                        (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-}
                                _hdInextTokenPos
                                {-# LINE 414 "src/GLuaFixer/AG/LexLint.hs" #-}
                                )) of
                         { _tlOnextTokenPos ->
                         (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                 _hdIandSyntax
                                 {-# LINE 419 "src/GLuaFixer/AG/LexLint.hs" #-}
                                 )) of
                          { _tlOandSyntax ->
                          (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                  _hdIstrSyntax
                                  {-# LINE 424 "src/GLuaFixer/AG/LexLint.hs" #-}
                                  )) of
                           { _tlOstrSyntax ->
                           (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                   _hdIorSyntax
                                   {-# LINE 429 "src/GLuaFixer/AG/LexLint.hs" #-}
                                   )) of
                            { _tlOorSyntax ->
                            (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                    _hdInotSyntax
                                    {-# LINE 434 "src/GLuaFixer/AG/LexLint.hs" #-}
                                    )) of
                             { _tlOnotSyntax ->
                             (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                     _hdIneqSyntax
                                     {-# LINE 439 "src/GLuaFixer/AG/LexLint.hs" #-}
                                     )) of
                              { _tlOneqSyntax ->
                              (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                      _hdImultilineCommentSyntax
                                      {-# LINE 444 "src/GLuaFixer/AG/LexLint.hs" #-}
                                      )) of
                               { _tlOmultilineCommentSyntax ->
                               (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                       _hdIlineCommentSyntax
                                       {-# LINE 449 "src/GLuaFixer/AG/LexLint.hs" #-}
                                       )) of
                                { _tlOlineCommentSyntax ->
                                (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _hdIindentation
                                        {-# LINE 454 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _tlOindentation ->
                                 (case (({-# LINE 128 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _lhsIconfig
                                         {-# LINE 459 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _tlOconfig ->
                                  (case (tl_ _tlOandSyntax _tlOconfig _tlOindentation _tlOlineCommentSyntax _tlOmultilineCommentSyntax _tlOneqSyntax _tlOnextTokenPos _tlOnotSyntax _tlOorSyntax _tlOstrSyntax) of
                                   { ( _tlIandSyntax,_tlIcopy,_tlIindentation,_tlIlineCommentSyntax,_tlImultilineCommentSyntax,_tlIneqSyntax,_tlInextTokenPos,_tlInotSyntax,_tlIorSyntax,_tlIstrSyntax,_tlIwarnings) ->
                                       (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _tlIandSyntax
                                               {-# LINE 466 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOandSyntax ->
                                        (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                (:) _hdIcopy _tlIcopy
                                                {-# LINE 471 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _copy ->
                                         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _copy
                                                 {-# LINE 476 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOcopy ->
                                          (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _tlIindentation
                                                  {-# LINE 481 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOindentation ->
                                           (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   _tlIlineCommentSyntax
                                                   {-# LINE 486 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _lhsOlineCommentSyntax ->
                                            (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    _tlImultilineCommentSyntax
                                                    {-# LINE 491 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _lhsOmultilineCommentSyntax ->
                                             (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     _tlIneqSyntax
                                                     {-# LINE 496 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _lhsOneqSyntax ->
                                              (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                      _tlInextTokenPos
                                                      {-# LINE 501 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                      )) of
                                               { _lhsOnextTokenPos ->
                                               (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                       _tlInotSyntax
                                                       {-# LINE 506 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                       )) of
                                                { _lhsOnotSyntax ->
                                                (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                        _tlIorSyntax
                                                        {-# LINE 511 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                        )) of
                                                 { _lhsOorSyntax ->
                                                 (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                         _tlIstrSyntax
                                                         {-# LINE 516 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                         )) of
                                                  { _lhsOstrSyntax ->
                                                  (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                          _hdIwarnings ++ _tlIwarnings
                                                          {-# LINE 521 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                          )) of
                                                   { _lhsOwarnings ->
                                                   ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
sem_MTokenList_Nil :: T_MTokenList
sem_MTokenList_Nil :: T_MTokenList
sem_MTokenList_Nil =
    (\ SyntaxUsed
_lhsIandSyntax
       LintSettings
_lhsIconfig
       SyntaxUsed
_lhsIindentation
       SyntaxUsed
_lhsIlineCommentSyntax
       SyntaxUsed
_lhsImultilineCommentSyntax
       SyntaxUsed
_lhsIneqSyntax
       LineColPos
_lhsInextTokenPos
       SyntaxUsed
_lhsInotSyntax
       SyntaxUsed
_lhsIorSyntax
       SyntaxUsed
_lhsIstrSyntax ->
         (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                 _lhsIandSyntax
                 {-# LINE 539 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _lhsOandSyntax ->
          (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                  []
                  {-# LINE 544 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _copy ->
           (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                   _copy
                   {-# LINE 549 "src/GLuaFixer/AG/LexLint.hs" #-}
                   )) of
            { _lhsOcopy ->
            (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                    _lhsIindentation
                    {-# LINE 554 "src/GLuaFixer/AG/LexLint.hs" #-}
                    )) of
             { _lhsOindentation ->
             (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                     _lhsIlineCommentSyntax
                     {-# LINE 559 "src/GLuaFixer/AG/LexLint.hs" #-}
                     )) of
              { _lhsOlineCommentSyntax ->
              (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                      _lhsImultilineCommentSyntax
                      {-# LINE 564 "src/GLuaFixer/AG/LexLint.hs" #-}
                      )) of
               { _lhsOmultilineCommentSyntax ->
               (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                       _lhsIneqSyntax
                       {-# LINE 569 "src/GLuaFixer/AG/LexLint.hs" #-}
                       )) of
                { _lhsOneqSyntax ->
                (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-}
                        _lhsInextTokenPos
                        {-# LINE 574 "src/GLuaFixer/AG/LexLint.hs" #-}
                        )) of
                 { _lhsOnextTokenPos ->
                 (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                         _lhsInotSyntax
                         {-# LINE 579 "src/GLuaFixer/AG/LexLint.hs" #-}
                         )) of
                  { _lhsOnotSyntax ->
                  (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                          _lhsIorSyntax
                          {-# LINE 584 "src/GLuaFixer/AG/LexLint.hs" #-}
                          )) of
                   { _lhsOorSyntax ->
                   (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                           _lhsIstrSyntax
                           {-# LINE 589 "src/GLuaFixer/AG/LexLint.hs" #-}
                           )) of
                    { _lhsOstrSyntax ->
                    (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                            []
                            {-# LINE 594 "src/GLuaFixer/AG/LexLint.hs" #-}
                            )) of
                     { _lhsOwarnings ->
                     ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }))
-- Token -------------------------------------------------------
-- cata
sem_Token :: Token ->
             T_Token
sem_Token :: Token -> T_Token
sem_Token (Whitespace String
_space) =
    (String -> T_Token
sem_Token_Whitespace String
_space)
sem_Token (DashComment String
_comment) =
    (String -> T_Token
sem_Token_DashComment String
_comment)
sem_Token (DashBlockComment Int
_depth String
_comment) =
    (Int -> String -> T_Token
sem_Token_DashBlockComment Int
_depth String
_comment)
sem_Token (SlashComment String
_comment) =
    (String -> T_Token
sem_Token_SlashComment String
_comment)
sem_Token (SlashBlockComment String
_comment) =
    (String -> T_Token
sem_Token_SlashBlockComment String
_comment)
sem_Token (Token
Semicolon) =
    (T_Token
sem_Token_Semicolon)
sem_Token (TNumber String
_num) =
    (String -> T_Token
sem_Token_TNumber String
_num)
sem_Token (DQString String
_str) =
    (String -> T_Token
sem_Token_DQString String
_str)
sem_Token (SQString String
_str) =
    (String -> T_Token
sem_Token_SQString String
_str)
sem_Token (MLString String
_str) =
    (String -> T_Token
sem_Token_MLString String
_str)
sem_Token (Token
TTrue) =
    (T_Token
sem_Token_TTrue)
sem_Token (Token
TFalse) =
    (T_Token
sem_Token_TFalse)
sem_Token (Token
Nil) =
    (T_Token
sem_Token_Nil)
sem_Token (Token
VarArg) =
    (T_Token
sem_Token_VarArg)
sem_Token (Token
Plus) =
    (T_Token
sem_Token_Plus)
sem_Token (Token
Minus) =
    (T_Token
sem_Token_Minus)
sem_Token (Token
Multiply) =
    (T_Token
sem_Token_Multiply)
sem_Token (Token
Divide) =
    (T_Token
sem_Token_Divide)
sem_Token (Token
Modulus) =
    (T_Token
sem_Token_Modulus)
sem_Token (Token
Power) =
    (T_Token
sem_Token_Power)
sem_Token (Token
TEq) =
    (T_Token
sem_Token_TEq)
sem_Token (Token
TNEq) =
    (T_Token
sem_Token_TNEq)
sem_Token (Token
TCNEq) =
    (T_Token
sem_Token_TCNEq)
sem_Token (Token
TLEQ) =
    (T_Token
sem_Token_TLEQ)
sem_Token (Token
TGEQ) =
    (T_Token
sem_Token_TGEQ)
sem_Token (Token
TLT) =
    (T_Token
sem_Token_TLT)
sem_Token (Token
TGT) =
    (T_Token
sem_Token_TGT)
sem_Token (Token
Equals) =
    (T_Token
sem_Token_Equals)
sem_Token (Token
Concatenate) =
    (T_Token
sem_Token_Concatenate)
sem_Token (Token
Colon) =
    (T_Token
sem_Token_Colon)
sem_Token (Token
Dot) =
    (T_Token
sem_Token_Dot)
sem_Token (Token
Comma) =
    (T_Token
sem_Token_Comma)
sem_Token (Token
Hash) =
    (T_Token
sem_Token_Hash)
sem_Token (Token
Not) =
    (T_Token
sem_Token_Not)
sem_Token (Token
CNot) =
    (T_Token
sem_Token_CNot)
sem_Token (Token
And) =
    (T_Token
sem_Token_And)
sem_Token (Token
CAnd) =
    (T_Token
sem_Token_CAnd)
sem_Token (Token
Or) =
    (T_Token
sem_Token_Or)
sem_Token (Token
COr) =
    (T_Token
sem_Token_COr)
sem_Token (Token
Function) =
    (T_Token
sem_Token_Function)
sem_Token (Token
Local) =
    (T_Token
sem_Token_Local)
sem_Token (Token
If) =
    (T_Token
sem_Token_If)
sem_Token (Token
Then) =
    (T_Token
sem_Token_Then)
sem_Token (Token
Elseif) =
    (T_Token
sem_Token_Elseif)
sem_Token (Token
Else) =
    (T_Token
sem_Token_Else)
sem_Token (Token
For) =
    (T_Token
sem_Token_For)
sem_Token (Token
In) =
    (T_Token
sem_Token_In)
sem_Token (Token
Do) =
    (T_Token
sem_Token_Do)
sem_Token (Token
While) =
    (T_Token
sem_Token_While)
sem_Token (Token
Until) =
    (T_Token
sem_Token_Until)
sem_Token (Token
Repeat) =
    (T_Token
sem_Token_Repeat)
sem_Token (Token
Continue) =
    (T_Token
sem_Token_Continue)
sem_Token (Token
Break) =
    (T_Token
sem_Token_Break)
sem_Token (Token
Return) =
    (T_Token
sem_Token_Return)
sem_Token (Token
End) =
    (T_Token
sem_Token_End)
sem_Token (Token
LRound) =
    (T_Token
sem_Token_LRound)
sem_Token (Token
RRound) =
    (T_Token
sem_Token_RRound)
sem_Token (Token
LCurly) =
    (T_Token
sem_Token_LCurly)
sem_Token (Token
RCurly) =
    (T_Token
sem_Token_RCurly)
sem_Token (Token
LSquare) =
    (T_Token
sem_Token_LSquare)
sem_Token (Token
RSquare) =
    (T_Token
sem_Token_RSquare)
sem_Token (Label String
_whitespaceBefore String
_lbl String
_whitespaceAfter) =
    (String -> String -> String -> T_Token
sem_Token_Label String
_whitespaceBefore String
_lbl String
_whitespaceAfter)
sem_Token (Identifier String
_ident) =
    (String -> T_Token
sem_Token_Identifier String
_ident)
-- semantic domain
type T_Token = LineColPos ->
               ( LineColPos,T_Token_1)
type T_Token_1 = SyntaxUsed ->
                 LintSettings ->
                 SyntaxUsed ->
                 SyntaxUsed ->
                 Region ->
                 SyntaxUsed ->
                 SyntaxUsed ->
                 SyntaxUsed ->
                 SyntaxUsed ->
                 SyntaxUsed ->
                 ( SyntaxUsed,Token,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,([FilePath -> LintMessage]))
data Inh_Token = Inh_Token {Inh_Token -> SyntaxUsed
andSyntax_Inh_Token :: SyntaxUsed,Inh_Token -> LintSettings
config_Inh_Token :: LintSettings,Inh_Token -> SyntaxUsed
indentation_Inh_Token :: SyntaxUsed,Inh_Token -> SyntaxUsed
lineCommentSyntax_Inh_Token :: SyntaxUsed,Inh_Token -> Region
mpos_Inh_Token :: Region,Inh_Token -> SyntaxUsed
multilineCommentSyntax_Inh_Token :: SyntaxUsed,Inh_Token -> SyntaxUsed
neqSyntax_Inh_Token :: SyntaxUsed,Inh_Token -> LineColPos
nextTokenPos_Inh_Token :: LineColPos,Inh_Token -> SyntaxUsed
notSyntax_Inh_Token :: SyntaxUsed,Inh_Token -> SyntaxUsed
orSyntax_Inh_Token :: SyntaxUsed,Inh_Token -> SyntaxUsed
strSyntax_Inh_Token :: SyntaxUsed}
data Syn_Token = Syn_Token {Syn_Token -> SyntaxUsed
andSyntax_Syn_Token :: SyntaxUsed,Syn_Token -> Token
copy_Syn_Token :: Token,Syn_Token -> SyntaxUsed
indentation_Syn_Token :: SyntaxUsed,Syn_Token -> SyntaxUsed
lineCommentSyntax_Syn_Token :: SyntaxUsed,Syn_Token -> SyntaxUsed
multilineCommentSyntax_Syn_Token :: SyntaxUsed,Syn_Token -> SyntaxUsed
neqSyntax_Syn_Token :: SyntaxUsed,Syn_Token -> LineColPos
nextTokenPos_Syn_Token :: LineColPos,Syn_Token -> SyntaxUsed
notSyntax_Syn_Token :: SyntaxUsed,Syn_Token -> SyntaxUsed
orSyntax_Syn_Token :: SyntaxUsed,Syn_Token -> SyntaxUsed
strSyntax_Syn_Token :: SyntaxUsed,Syn_Token -> [String -> LintMessage]
warnings_Syn_Token :: ([FilePath -> LintMessage])}
wrap_Token :: T_Token ->
              Inh_Token ->
              Syn_Token
wrap_Token :: T_Token -> Inh_Token -> Syn_Token
wrap_Token T_Token
sem (Inh_Token SyntaxUsed
_lhsIandSyntax LintSettings
_lhsIconfig SyntaxUsed
_lhsIindentation SyntaxUsed
_lhsIlineCommentSyntax Region
_lhsImpos SyntaxUsed
_lhsImultilineCommentSyntax SyntaxUsed
_lhsIneqSyntax LineColPos
_lhsInextTokenPos SyntaxUsed
_lhsInotSyntax SyntaxUsed
_lhsIorSyntax SyntaxUsed
_lhsIstrSyntax) =
    (let ( LineColPos
_lhsOnextTokenPos,T_Token_1
sem_1) = T_Token
sem LineColPos
_lhsInextTokenPos
         ( SyntaxUsed
_lhsOandSyntax,Token
_lhsOcopy,SyntaxUsed
_lhsOindentation,SyntaxUsed
_lhsOlineCommentSyntax,SyntaxUsed
_lhsOmultilineCommentSyntax,SyntaxUsed
_lhsOneqSyntax,SyntaxUsed
_lhsOnotSyntax,SyntaxUsed
_lhsOorSyntax,SyntaxUsed
_lhsOstrSyntax,[String -> LintMessage]
_lhsOwarnings) = T_Token_1
sem_1 SyntaxUsed
_lhsIandSyntax LintSettings
_lhsIconfig SyntaxUsed
_lhsIindentation SyntaxUsed
_lhsIlineCommentSyntax Region
_lhsImpos SyntaxUsed
_lhsImultilineCommentSyntax SyntaxUsed
_lhsIneqSyntax SyntaxUsed
_lhsInotSyntax SyntaxUsed
_lhsIorSyntax SyntaxUsed
_lhsIstrSyntax
     in  (SyntaxUsed
-> Token
-> SyntaxUsed
-> SyntaxUsed
-> SyntaxUsed
-> SyntaxUsed
-> LineColPos
-> SyntaxUsed
-> SyntaxUsed
-> SyntaxUsed
-> [String -> LintMessage]
-> Syn_Token
Syn_Token SyntaxUsed
_lhsOandSyntax Token
_lhsOcopy SyntaxUsed
_lhsOindentation SyntaxUsed
_lhsOlineCommentSyntax SyntaxUsed
_lhsOmultilineCommentSyntax SyntaxUsed
_lhsOneqSyntax LineColPos
_lhsOnextTokenPos SyntaxUsed
_lhsOnotSyntax SyntaxUsed
_lhsOorSyntax SyntaxUsed
_lhsOstrSyntax [String -> LintMessage]
_lhsOwarnings))
sem_Token_Whitespace :: String ->
                        T_Token
sem_Token_Whitespace :: String -> T_Token
sem_Token_Whitespace String
space_ =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 164 "src/GLuaFixer/AG/LexLint.ag" #-}
                 _lhsInextTokenPos
                 {-# LINE 757 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _curTokenPos ->
          (case (({-# LINE 165 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceStr _curTokenPos     space_
                  {-# LINE 762 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _nextTokenPos ->
           (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-}
                   _nextTokenPos
                   {-# LINE 767 "src/GLuaFixer/AG/LexLint.hs" #-}
                   )) of
            { _lhsOnextTokenPos ->
            (case ((let sem_Token_Whitespace_1 :: T_Token_1
                        sem_Token_Whitespace_1 =
                            (\ _lhsIandSyntax
                               _lhsIconfig
                               _lhsIindentation
                               _lhsIlineCommentSyntax
                               _lhsImpos
                               _lhsImultilineCommentSyntax
                               _lhsIneqSyntax
                               _lhsInotSyntax
                               _lhsIorSyntax
                               _lhsIstrSyntax ->
                                 (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _lhsIandSyntax
                                         {-# LINE 784 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOandSyntax ->
                                  (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          Whitespace space_
                                          {-# LINE 789 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _copy ->
                                   (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _copy
                                           {-# LINE 794 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOcopy ->
                                    (case (({-# LINE 177 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            Region (indentationStart _curTokenPos     space_) _nextTokenPos
                                            {-# LINE 799 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _indentationRg ->
                                     (case (({-# LINE 168 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             mkSyntax (isInfixOf "\n\t" space_) _indentationRg
                                             {-# LINE 804 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _usesTabs ->
                                      (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              mkSyntax (isInfixOf "\n " space_) _indentationRg
                                              {-# LINE 809 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _usesSpaces ->
                                       (case (({-# LINE 169 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIindentation <> SyntaxUsed _usesSpaces     _usesTabs
                                               {-# LINE 814 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _combinedSyntaxUsed ->
                                        (case (({-# LINE 170 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                resetIfInconsistent _combinedSyntaxUsed
                                                {-# LINE 819 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _indentation ->
                                         (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _indentation
                                                 {-# LINE 824 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOindentation ->
                                          (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _lhsIlineCommentSyntax
                                                  {-# LINE 829 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOlineCommentSyntax ->
                                           (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   _lhsImultilineCommentSyntax
                                                   {-# LINE 834 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _lhsOmultilineCommentSyntax ->
                                            (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    _lhsIneqSyntax
                                                    {-# LINE 839 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _lhsOneqSyntax ->
                                             (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     _lhsInotSyntax
                                                     {-# LINE 844 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _lhsOnotSyntax ->
                                              (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                      _lhsIorSyntax
                                                      {-# LINE 849 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                      )) of
                                               { _lhsOorSyntax ->
                                               (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                       _lhsIstrSyntax
                                                       {-# LINE 854 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                       )) of
                                                { _lhsOstrSyntax ->
                                                (case (({-# LINE 181 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                        []
                                                        {-# LINE 859 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                        )) of
                                                 { _warnings_augmented_syn ->
                                                 (case (({-# LINE 173 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                         locateTrailingWhitespace _curTokenPos     space_
                                                         {-# LINE 864 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                         )) of
                                                  { _whitespaceStart ->
                                                  (case (({-# LINE 174 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                          endOfTrailingWhitespace _whitespaceStart
                                                          {-# LINE 869 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                          )) of
                                                   { _whitespaceEnd ->
                                                   (case (({-# LINE 181 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                           if not (lint_trailingWhitespace _lhsIconfig) || (not (isInfixOf " \n" space_) && not (isInfixOf "\t\n" space_)) then id else (:) $ mTokenWarning (Region (fst _whitespaceStart    ) _whitespaceEnd    ) TrailingWhitespace
                                                           {-# LINE 874 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                           )) of
                                                    { _warnings_augmented_f2 ->
                                                    (case (({-# LINE 181 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                            if not (lint_whitespaceStyle _lhsIconfig) then id else
                                                                warnInconsistency _combinedSyntaxUsed     InconsistentTabsSpaces
                                                            {-# LINE 880 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                            )) of
                                                     { _warnings_augmented_f1 ->
                                                     (case (({-# LINE 181 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                             foldr ($) _warnings_augmented_syn [_warnings_augmented_f1, _warnings_augmented_f2]
                                                             {-# LINE 885 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                             )) of
                                                      { _lhsOwarnings ->
                                                      ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                    in  sem_Token_Whitespace_1)) of
             { ( sem_Token_1) ->
             ( _lhsOnextTokenPos,sem_Token_1) }) }) }) }))
sem_Token_DashComment :: String ->
                         T_Token
sem_Token_DashComment :: String -> T_Token
sem_Token_DashComment String
comment_ =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 DashComment comment_
                 {-# LINE 898 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 185 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 903 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _nextTokenPos ->
           (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-}
                   _nextTokenPos
                   {-# LINE 908 "src/GLuaFixer/AG/LexLint.hs" #-}
                   )) of
            { _lhsOnextTokenPos ->
            (case ((let sem_Token_DashComment_1 :: T_Token_1
                        sem_Token_DashComment_1 =
                            (\ _lhsIandSyntax
                               _lhsIconfig
                               _lhsIindentation
                               _lhsIlineCommentSyntax
                               _lhsImpos
                               _lhsImultilineCommentSyntax
                               _lhsIneqSyntax
                               _lhsInotSyntax
                               _lhsIorSyntax
                               _lhsIstrSyntax ->
                                 (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _lhsIandSyntax
                                         {-# LINE 925 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOandSyntax ->
                                  (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _copy
                                          {-# LINE 930 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOcopy ->
                                   (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIindentation
                                           {-# LINE 935 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOindentation ->
                                    (case (({-# LINE 187 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsIlineCommentSyntax <> SyntaxUsed (Just _lhsImpos) Nothing
                                            {-# LINE 940 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _combinedSyntaxUsed ->
                                     (case (({-# LINE 188 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             resetIfInconsistent _combinedSyntaxUsed
                                             {-# LINE 945 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lineCommentSyntax ->
                                      (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lineCommentSyntax
                                              {-# LINE 950 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOlineCommentSyntax ->
                                       (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsImultilineCommentSyntax
                                               {-# LINE 955 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOmultilineCommentSyntax ->
                                        (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIneqSyntax
                                                {-# LINE 960 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOneqSyntax ->
                                         (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _lhsInotSyntax
                                                 {-# LINE 965 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOnotSyntax ->
                                          (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _lhsIorSyntax
                                                  {-# LINE 970 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOorSyntax ->
                                           (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   _lhsIstrSyntax
                                                   {-# LINE 975 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _lhsOstrSyntax ->
                                            (case (({-# LINE 189 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    []
                                                    {-# LINE 980 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_syn ->
                                             (case (({-# LINE 189 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                         warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "--" "//"
                                                     {-# LINE 986 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _warnings_augmented_f1 ->
                                              (case (({-# LINE 189 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                      foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                      {-# LINE 991 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                      )) of
                                               { _lhsOwarnings ->
                                               ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                    in  sem_Token_DashComment_1)) of
             { ( sem_Token_1) ->
             ( _lhsOnextTokenPos,sem_Token_1) }) }) }) }))
sem_Token_DashBlockComment :: Int ->
                              String ->
                              T_Token
sem_Token_DashBlockComment :: Int -> String -> T_Token
sem_Token_DashBlockComment Int
depth_ String
comment_ =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 202 "src/GLuaFixer/AG/LexLint.ag" #-}
                 showString "--[" . showString (replicate depth_ '-') . showChar '[' . showString comment_ . showChar ']' . showString (replicate depth_ '-') . showChar ']' $ ""
                 {-# LINE 1005 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _str ->
          (case (({-# LINE 203 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceStr _lhsInextTokenPos _str
                  {-# LINE 1010 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_DashBlockComment_1 :: T_Token_1
                       sem_Token_DashBlockComment_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 1027 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         DashBlockComment depth_ comment_
                                         {-# LINE 1032 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _copy ->
                                  (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _copy
                                          {-# LINE 1037 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOcopy ->
                                   (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIindentation
                                           {-# LINE 1042 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOindentation ->
                                    (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsIlineCommentSyntax
                                            {-# LINE 1047 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOlineCommentSyntax ->
                                     (case (({-# LINE 205 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsImultilineCommentSyntax <> SyntaxUsed (Just _lhsImpos) Nothing
                                             {-# LINE 1052 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _combinedSyntaxUsed ->
                                      (case (({-# LINE 206 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              resetIfInconsistent _combinedSyntaxUsed
                                              {-# LINE 1057 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _multilineCommentSyntax ->
                                       (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _multilineCommentSyntax
                                               {-# LINE 1062 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOmultilineCommentSyntax ->
                                        (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIneqSyntax
                                                {-# LINE 1067 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOneqSyntax ->
                                         (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _lhsInotSyntax
                                                 {-# LINE 1072 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOnotSyntax ->
                                          (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _lhsIorSyntax
                                                  {-# LINE 1077 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOorSyntax ->
                                           (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   _lhsIstrSyntax
                                                   {-# LINE 1082 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _lhsOstrSyntax ->
                                            (case (({-# LINE 207 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    []
                                                    {-# LINE 1087 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_syn ->
                                             (case (({-# LINE 207 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                         warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "--[[ ]]" "/* */"
                                                     {-# LINE 1093 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _warnings_augmented_f1 ->
                                              (case (({-# LINE 207 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                      foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                      {-# LINE 1098 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                      )) of
                                               { _lhsOwarnings ->
                                               ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_DashBlockComment_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_SlashComment :: String ->
                          T_Token
sem_Token_SlashComment :: String -> T_Token
sem_Token_SlashComment String
comment_ =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 SlashComment comment_
                 {-# LINE 1111 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 193 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 1116 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _nextTokenPos ->
           (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-}
                   _nextTokenPos
                   {-# LINE 1121 "src/GLuaFixer/AG/LexLint.hs" #-}
                   )) of
            { _lhsOnextTokenPos ->
            (case ((let sem_Token_SlashComment_1 :: T_Token_1
                        sem_Token_SlashComment_1 =
                            (\ _lhsIandSyntax
                               _lhsIconfig
                               _lhsIindentation
                               _lhsIlineCommentSyntax
                               _lhsImpos
                               _lhsImultilineCommentSyntax
                               _lhsIneqSyntax
                               _lhsInotSyntax
                               _lhsIorSyntax
                               _lhsIstrSyntax ->
                                 (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _lhsIandSyntax
                                         {-# LINE 1138 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOandSyntax ->
                                  (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _copy
                                          {-# LINE 1143 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOcopy ->
                                   (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIindentation
                                           {-# LINE 1148 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOindentation ->
                                    (case (({-# LINE 195 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsIlineCommentSyntax <> SyntaxUsed Nothing (Just _lhsImpos)
                                            {-# LINE 1153 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _combinedSyntaxUsed ->
                                     (case (({-# LINE 196 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             resetIfInconsistent _combinedSyntaxUsed
                                             {-# LINE 1158 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lineCommentSyntax ->
                                      (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lineCommentSyntax
                                              {-# LINE 1163 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOlineCommentSyntax ->
                                       (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsImultilineCommentSyntax
                                               {-# LINE 1168 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOmultilineCommentSyntax ->
                                        (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIneqSyntax
                                                {-# LINE 1173 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOneqSyntax ->
                                         (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _lhsInotSyntax
                                                 {-# LINE 1178 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOnotSyntax ->
                                          (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _lhsIorSyntax
                                                  {-# LINE 1183 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOorSyntax ->
                                           (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   _lhsIstrSyntax
                                                   {-# LINE 1188 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _lhsOstrSyntax ->
                                            (case (({-# LINE 197 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    []
                                                    {-# LINE 1193 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_syn ->
                                             (case (({-# LINE 197 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                         warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "//" "--"
                                                     {-# LINE 1199 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _warnings_augmented_f1 ->
                                              (case (({-# LINE 197 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                      foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                      {-# LINE 1204 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                      )) of
                                               { _lhsOwarnings ->
                                               ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                    in  sem_Token_SlashComment_1)) of
             { ( sem_Token_1) ->
             ( _lhsOnextTokenPos,sem_Token_1) }) }) }) }))
sem_Token_SlashBlockComment :: String ->
                               T_Token
sem_Token_SlashBlockComment :: String -> T_Token
sem_Token_SlashBlockComment String
comment_ =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 211 "src/GLuaFixer/AG/LexLint.ag" #-}
                 showString "/*" . showString comment_ . showString "*/" $ ""
                 {-# LINE 1217 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _str ->
          (case (({-# LINE 212 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceStr _lhsInextTokenPos _str
                  {-# LINE 1222 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_SlashBlockComment_1 :: T_Token_1
                       sem_Token_SlashBlockComment_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 1239 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         SlashBlockComment comment_
                                         {-# LINE 1244 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _copy ->
                                  (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _copy
                                          {-# LINE 1249 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOcopy ->
                                   (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIindentation
                                           {-# LINE 1254 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOindentation ->
                                    (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsIlineCommentSyntax
                                            {-# LINE 1259 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOlineCommentSyntax ->
                                     (case (({-# LINE 214 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsImultilineCommentSyntax <> SyntaxUsed Nothing (Just _lhsImpos)
                                             {-# LINE 1264 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _combinedSyntaxUsed ->
                                      (case (({-# LINE 215 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              resetIfInconsistent _combinedSyntaxUsed
                                              {-# LINE 1269 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _multilineCommentSyntax ->
                                       (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _multilineCommentSyntax
                                               {-# LINE 1274 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOmultilineCommentSyntax ->
                                        (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIneqSyntax
                                                {-# LINE 1279 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOneqSyntax ->
                                         (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _lhsInotSyntax
                                                 {-# LINE 1284 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOnotSyntax ->
                                          (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _lhsIorSyntax
                                                  {-# LINE 1289 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOorSyntax ->
                                           (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   _lhsIstrSyntax
                                                   {-# LINE 1294 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _lhsOstrSyntax ->
                                            (case (({-# LINE 216 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    []
                                                    {-# LINE 1299 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_syn ->
                                             (case (({-# LINE 216 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                         warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "/* */" "--[[ ]]"
                                                     {-# LINE 1305 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _warnings_augmented_f1 ->
                                              (case (({-# LINE 216 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                      foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                      {-# LINE 1310 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                      )) of
                                               { _lhsOwarnings ->
                                               ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_SlashBlockComment_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Semicolon :: T_Token
sem_Token_Semicolon :: T_Token
sem_Token_Semicolon =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Semicolon
                 {-# LINE 1322 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 1327 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Semicolon_1 :: T_Token_1
                       sem_Token_Semicolon_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 1344 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 1349 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 1354 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 1359 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 1364 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 1369 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 1374 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 1379 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 1384 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 1389 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Semicolon_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_TNumber :: String ->
                     T_Token
sem_Token_TNumber :: String -> T_Token
sem_Token_TNumber String
num_ =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 TNumber num_
                 {-# LINE 1402 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 1407 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_TNumber_1 :: T_Token_1
                       sem_Token_TNumber_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 1424 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 1429 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 1434 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 1439 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 1444 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 1449 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 1454 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 1459 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 1464 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 1469 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_TNumber_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_DQString :: String ->
                      T_Token
sem_Token_DQString :: String -> T_Token
sem_Token_DQString String
str_ =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 224 "src/GLuaFixer/AG/LexLint.ag" #-}
                 customAdvanceStr _lhsInextTokenPos $ "\"" <> str_ <> "\""
                 {-# LINE 1482 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _lhsOnextTokenPos ->
          (case ((let sem_Token_DQString_1 :: T_Token_1
                      sem_Token_DQString_1 =
                          (\ _lhsIandSyntax
                             _lhsIconfig
                             _lhsIindentation
                             _lhsIlineCommentSyntax
                             _lhsImpos
                             _lhsImultilineCommentSyntax
                             _lhsIneqSyntax
                             _lhsInotSyntax
                             _lhsIorSyntax
                             _lhsIstrSyntax ->
                               (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                       _lhsIandSyntax
                                       {-# LINE 1499 "src/GLuaFixer/AG/LexLint.hs" #-}
                                       )) of
                                { _lhsOandSyntax ->
                                (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        DQString str_
                                        {-# LINE 1504 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _copy ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 1509 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 1514 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 1519 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 1524 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 1529 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 1534 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 1539 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 226 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax <> SyntaxUsed (Just _lhsImpos) Nothing
                                                {-# LINE 1544 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _combinedSyntaxUsed ->
                                         (case (({-# LINE 227 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 resetIfInconsistent _combinedSyntaxUsed
                                                 {-# LINE 1549 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _strSyntax ->
                                          (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _strSyntax
                                                  {-# LINE 1554 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOstrSyntax ->
                                           (case (({-# LINE 228 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   []
                                                   {-# LINE 1559 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _warnings_augmented_syn ->
                                            (case (({-# LINE 228 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                        warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "double quoted strings" "single quoted strings"
                                                    {-# LINE 1565 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_f1 ->
                                             (case (({-# LINE 228 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                     {-# LINE 1570 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _lhsOwarnings ->
                                              ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                  in  sem_Token_DQString_1)) of
           { ( sem_Token_1) ->
           ( _lhsOnextTokenPos,sem_Token_1) }) }))
sem_Token_SQString :: String ->
                      T_Token
sem_Token_SQString :: String -> T_Token
sem_Token_SQString String
str_ =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 233 "src/GLuaFixer/AG/LexLint.ag" #-}
                 customAdvanceStr _lhsInextTokenPos $ "'" <> str_ <> "'"
                 {-# LINE 1583 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _lhsOnextTokenPos ->
          (case ((let sem_Token_SQString_1 :: T_Token_1
                      sem_Token_SQString_1 =
                          (\ _lhsIandSyntax
                             _lhsIconfig
                             _lhsIindentation
                             _lhsIlineCommentSyntax
                             _lhsImpos
                             _lhsImultilineCommentSyntax
                             _lhsIneqSyntax
                             _lhsInotSyntax
                             _lhsIorSyntax
                             _lhsIstrSyntax ->
                               (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                       _lhsIandSyntax
                                       {-# LINE 1600 "src/GLuaFixer/AG/LexLint.hs" #-}
                                       )) of
                                { _lhsOandSyntax ->
                                (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        SQString str_
                                        {-# LINE 1605 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _copy ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 1610 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 1615 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 1620 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 1625 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 1630 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 1635 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 1640 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 236 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                if isSingleChar str_ then Nothing else Just _lhsImpos
                                                {-# LINE 1645 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _usesSingleQuotedSyntax ->
                                         (case (({-# LINE 237 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _lhsIstrSyntax <> SyntaxUsed Nothing _usesSingleQuotedSyntax
                                                 {-# LINE 1650 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _combinedSyntaxUsed ->
                                          (case (({-# LINE 238 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  resetIfInconsistent _combinedSyntaxUsed
                                                  {-# LINE 1655 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _strSyntax ->
                                           (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   _strSyntax
                                                   {-# LINE 1660 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _lhsOstrSyntax ->
                                            (case (({-# LINE 239 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    []
                                                    {-# LINE 1665 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_syn ->
                                             (case (({-# LINE 239 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                         warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "single quoted strings" "double quoted strings"
                                                     {-# LINE 1671 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _warnings_augmented_f1 ->
                                              (case (({-# LINE 239 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                      foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                      {-# LINE 1676 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                      )) of
                                               { _lhsOwarnings ->
                                               ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                  in  sem_Token_SQString_1)) of
           { ( sem_Token_1) ->
           ( _lhsOnextTokenPos,sem_Token_1) }) }))
sem_Token_MLString :: String ->
                      T_Token
sem_Token_MLString :: String -> T_Token
sem_Token_MLString String
str_ =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 243 "src/GLuaFixer/AG/LexLint.ag" #-}
                 customAdvanceStr _lhsInextTokenPos str_
                 {-# LINE 1689 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _lhsOnextTokenPos ->
          (case ((let sem_Token_MLString_1 :: T_Token_1
                      sem_Token_MLString_1 =
                          (\ _lhsIandSyntax
                             _lhsIconfig
                             _lhsIindentation
                             _lhsIlineCommentSyntax
                             _lhsImpos
                             _lhsImultilineCommentSyntax
                             _lhsIneqSyntax
                             _lhsInotSyntax
                             _lhsIorSyntax
                             _lhsIstrSyntax ->
                               (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                       _lhsIandSyntax
                                       {-# LINE 1706 "src/GLuaFixer/AG/LexLint.hs" #-}
                                       )) of
                                { _lhsOandSyntax ->
                                (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        MLString str_
                                        {-# LINE 1711 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _copy ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 1716 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 1721 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 1726 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 1731 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 1736 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 1741 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 1746 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 1751 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 1756 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }))
                  in  sem_Token_MLString_1)) of
           { ( sem_Token_1) ->
           ( _lhsOnextTokenPos,sem_Token_1) }) }))
sem_Token_TTrue :: T_Token
sem_Token_TTrue :: T_Token
sem_Token_TTrue =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 TTrue
                 {-# LINE 1768 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 1773 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_TTrue_1 :: T_Token_1
                       sem_Token_TTrue_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 1790 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 1795 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 1800 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 1805 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 1810 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 1815 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 1820 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 1825 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 1830 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 1835 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_TTrue_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_TFalse :: T_Token
sem_Token_TFalse :: T_Token
sem_Token_TFalse =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 TFalse
                 {-# LINE 1847 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 1852 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_TFalse_1 :: T_Token_1
                       sem_Token_TFalse_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 1869 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 1874 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 1879 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 1884 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 1889 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 1894 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 1899 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 1904 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 1909 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 1914 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_TFalse_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Nil :: T_Token
sem_Token_Nil :: T_Token
sem_Token_Nil =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Nil
                 {-# LINE 1926 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 1931 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Nil_1 :: T_Token_1
                       sem_Token_Nil_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 1948 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 1953 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 1958 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 1963 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 1968 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 1973 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 1978 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 1983 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 1988 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 1993 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Nil_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_VarArg :: T_Token
sem_Token_VarArg :: T_Token
sem_Token_VarArg =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 VarArg
                 {-# LINE 2005 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 2010 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_VarArg_1 :: T_Token_1
                       sem_Token_VarArg_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 2027 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 2032 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 2037 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 2042 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 2047 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 2052 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 2057 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 2062 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 2067 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 2072 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_VarArg_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Plus :: T_Token
sem_Token_Plus :: T_Token
sem_Token_Plus =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Plus
                 {-# LINE 2084 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 2089 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Plus_1 :: T_Token_1
                       sem_Token_Plus_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 2106 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 2111 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 2116 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 2121 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 2126 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 2131 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 2136 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 2141 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 2146 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 2151 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Plus_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Minus :: T_Token
sem_Token_Minus :: T_Token
sem_Token_Minus =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Minus
                 {-# LINE 2163 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 2168 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Minus_1 :: T_Token_1
                       sem_Token_Minus_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 2185 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 2190 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 2195 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 2200 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 2205 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 2210 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 2215 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 2220 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 2225 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 2230 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Minus_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Multiply :: T_Token
sem_Token_Multiply :: T_Token
sem_Token_Multiply =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Multiply
                 {-# LINE 2242 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 2247 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Multiply_1 :: T_Token_1
                       sem_Token_Multiply_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 2264 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 2269 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 2274 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 2279 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 2284 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 2289 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 2294 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 2299 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 2304 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 2309 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Multiply_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Divide :: T_Token
sem_Token_Divide :: T_Token
sem_Token_Divide =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Divide
                 {-# LINE 2321 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 2326 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Divide_1 :: T_Token_1
                       sem_Token_Divide_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 2343 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 2348 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 2353 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 2358 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 2363 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 2368 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 2373 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 2378 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 2383 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 2388 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Divide_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Modulus :: T_Token
sem_Token_Modulus :: T_Token
sem_Token_Modulus =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Modulus
                 {-# LINE 2400 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 2405 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Modulus_1 :: T_Token_1
                       sem_Token_Modulus_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 2422 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 2427 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 2432 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 2437 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 2442 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 2447 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 2452 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 2457 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 2462 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 2467 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Modulus_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Power :: T_Token
sem_Token_Power :: T_Token
sem_Token_Power =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Power
                 {-# LINE 2479 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 2484 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Power_1 :: T_Token_1
                       sem_Token_Power_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 2501 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 2506 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 2511 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 2516 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 2521 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 2526 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 2531 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 2536 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 2541 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 2546 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Power_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_TEq :: T_Token
sem_Token_TEq :: T_Token
sem_Token_TEq =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 TEq
                 {-# LINE 2558 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 2563 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_TEq_1 :: T_Token_1
                       sem_Token_TEq_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 2580 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 2585 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 2590 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 2595 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 2600 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 2605 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 2610 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 2615 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 2620 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 2625 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_TEq_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_TNEq :: T_Token
sem_Token_TNEq :: T_Token
sem_Token_TNEq =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 TNEq
                 {-# LINE 2637 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 2642 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_TNEq_1 :: T_Token_1
                       sem_Token_TNEq_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 2659 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 2664 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 2669 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 2674 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 2679 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 282 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax <> SyntaxUsed (Just _lhsImpos) Nothing
                                             {-# LINE 2684 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _combinedSyntaxUsed ->
                                      (case (({-# LINE 283 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              resetIfInconsistent _combinedSyntaxUsed
                                              {-# LINE 2689 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _neqSyntax ->
                                       (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _neqSyntax
                                               {-# LINE 2694 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOneqSyntax ->
                                        (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsInotSyntax
                                                {-# LINE 2699 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOnotSyntax ->
                                         (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _lhsIorSyntax
                                                 {-# LINE 2704 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOorSyntax ->
                                          (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _lhsIstrSyntax
                                                  {-# LINE 2709 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOstrSyntax ->
                                           (case (({-# LINE 284 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   []
                                                   {-# LINE 2714 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _warnings_augmented_syn ->
                                            (case (({-# LINE 284 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                        warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "~=" "!="
                                                    {-# LINE 2720 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_f1 ->
                                             (case (({-# LINE 284 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                     {-# LINE 2725 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _lhsOwarnings ->
                                              ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_TNEq_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_TCNEq :: T_Token
sem_Token_TCNEq :: T_Token
sem_Token_TCNEq =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 TCNEq
                 {-# LINE 2737 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 2742 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_TCNEq_1 :: T_Token_1
                       sem_Token_TCNEq_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 2759 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 2764 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 2769 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 2774 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 2779 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 288 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax <> SyntaxUsed Nothing (Just _lhsImpos)
                                             {-# LINE 2784 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _combinedSyntaxUsed ->
                                      (case (({-# LINE 289 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              resetIfInconsistent _combinedSyntaxUsed
                                              {-# LINE 2789 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _neqSyntax ->
                                       (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _neqSyntax
                                               {-# LINE 2794 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOneqSyntax ->
                                        (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsInotSyntax
                                                {-# LINE 2799 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOnotSyntax ->
                                         (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _lhsIorSyntax
                                                 {-# LINE 2804 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOorSyntax ->
                                          (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _lhsIstrSyntax
                                                  {-# LINE 2809 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOstrSyntax ->
                                           (case (({-# LINE 290 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   []
                                                   {-# LINE 2814 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _warnings_augmented_syn ->
                                            (case (({-# LINE 290 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                        warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "!=" "~="
                                                    {-# LINE 2820 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_f1 ->
                                             (case (({-# LINE 290 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                     {-# LINE 2825 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _lhsOwarnings ->
                                              ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_TCNEq_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_TLEQ :: T_Token
sem_Token_TLEQ :: T_Token
sem_Token_TLEQ =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 TLEQ
                 {-# LINE 2837 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 2842 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_TLEQ_1 :: T_Token_1
                       sem_Token_TLEQ_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 2859 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 2864 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 2869 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 2874 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 2879 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 2884 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 2889 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 2894 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 2899 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 2904 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_TLEQ_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_TGEQ :: T_Token
sem_Token_TGEQ :: T_Token
sem_Token_TGEQ =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 TGEQ
                 {-# LINE 2916 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 2921 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_TGEQ_1 :: T_Token_1
                       sem_Token_TGEQ_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 2938 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 2943 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 2948 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 2953 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 2958 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 2963 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 2968 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 2973 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 2978 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 2983 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_TGEQ_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_TLT :: T_Token
sem_Token_TLT :: T_Token
sem_Token_TLT =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 TLT
                 {-# LINE 2995 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 3000 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_TLT_1 :: T_Token_1
                       sem_Token_TLT_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 3017 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 3022 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 3027 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 3032 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 3037 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 3042 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 3047 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 3052 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 3057 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 3062 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_TLT_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_TGT :: T_Token
sem_Token_TGT :: T_Token
sem_Token_TGT =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 TGT
                 {-# LINE 3074 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 3079 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_TGT_1 :: T_Token_1
                       sem_Token_TGT_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 3096 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 3101 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 3106 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 3111 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 3116 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 3121 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 3126 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 3131 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 3136 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 3141 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_TGT_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Equals :: T_Token
sem_Token_Equals :: T_Token
sem_Token_Equals =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Equals
                 {-# LINE 3153 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 3158 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Equals_1 :: T_Token_1
                       sem_Token_Equals_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 3175 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 3180 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 3185 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 3190 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 3195 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 3200 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 3205 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 3210 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 3215 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 3220 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Equals_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Concatenate :: T_Token
sem_Token_Concatenate :: T_Token
sem_Token_Concatenate =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Concatenate
                 {-# LINE 3232 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 3237 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Concatenate_1 :: T_Token_1
                       sem_Token_Concatenate_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 3254 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 3259 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 3264 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 3269 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 3274 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 3279 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 3284 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 3289 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 3294 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 3299 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Concatenate_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Colon :: T_Token
sem_Token_Colon :: T_Token
sem_Token_Colon =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Colon
                 {-# LINE 3311 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 3316 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Colon_1 :: T_Token_1
                       sem_Token_Colon_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 3333 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 3338 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 3343 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 3348 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 3353 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 3358 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 3363 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 3368 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 3373 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 3378 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Colon_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Dot :: T_Token
sem_Token_Dot :: T_Token
sem_Token_Dot =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Dot
                 {-# LINE 3390 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 3395 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Dot_1 :: T_Token_1
                       sem_Token_Dot_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 3412 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 3417 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 3422 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 3427 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 3432 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 3437 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 3442 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 3447 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 3452 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 3457 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Dot_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Comma :: T_Token
sem_Token_Comma :: T_Token
sem_Token_Comma =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Comma
                 {-# LINE 3469 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 3474 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Comma_1 :: T_Token_1
                       sem_Token_Comma_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 3491 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 3496 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 3501 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 3506 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 3511 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 3516 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 3521 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 3526 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 3531 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 3536 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Comma_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Hash :: T_Token
sem_Token_Hash :: T_Token
sem_Token_Hash =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Hash
                 {-# LINE 3548 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 3553 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Hash_1 :: T_Token_1
                       sem_Token_Hash_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 3570 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 3575 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 3580 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 3585 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 3590 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 3595 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 3600 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 3605 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 3610 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 3615 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Hash_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Not :: T_Token
sem_Token_Not :: T_Token
sem_Token_Not =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Not
                 {-# LINE 3627 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 3632 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Not_1 :: T_Token_1
                       sem_Token_Not_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 3649 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 3654 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 3659 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 3664 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 3669 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 3674 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 246 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax <> SyntaxUsed (Just _lhsImpos) Nothing
                                              {-# LINE 3679 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _combinedSyntaxUsed ->
                                       (case (({-# LINE 247 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               resetIfInconsistent _combinedSyntaxUsed
                                               {-# LINE 3684 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _notSyntax ->
                                        (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _notSyntax
                                                {-# LINE 3689 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOnotSyntax ->
                                         (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _lhsIorSyntax
                                                 {-# LINE 3694 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOorSyntax ->
                                          (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _lhsIstrSyntax
                                                  {-# LINE 3699 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOstrSyntax ->
                                           (case (({-# LINE 248 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   []
                                                   {-# LINE 3704 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _warnings_augmented_syn ->
                                            (case (({-# LINE 248 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                        warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "not" "!"
                                                    {-# LINE 3710 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_f1 ->
                                             (case (({-# LINE 248 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                     {-# LINE 3715 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _lhsOwarnings ->
                                              ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Not_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_CNot :: T_Token
sem_Token_CNot :: T_Token
sem_Token_CNot =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 CNot
                 {-# LINE 3727 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 3732 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_CNot_1 :: T_Token_1
                       sem_Token_CNot_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 3749 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 3754 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 3759 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 3764 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 3769 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 3774 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 252 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax <> SyntaxUsed Nothing (Just _lhsImpos)
                                              {-# LINE 3779 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _combinedSyntaxUsed ->
                                       (case (({-# LINE 253 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               resetIfInconsistent _combinedSyntaxUsed
                                               {-# LINE 3784 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _notSyntax ->
                                        (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _notSyntax
                                                {-# LINE 3789 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOnotSyntax ->
                                         (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _lhsIorSyntax
                                                 {-# LINE 3794 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOorSyntax ->
                                          (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _lhsIstrSyntax
                                                  {-# LINE 3799 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOstrSyntax ->
                                           (case (({-# LINE 254 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   []
                                                   {-# LINE 3804 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _warnings_augmented_syn ->
                                            (case (({-# LINE 254 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                        warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "!" "not"
                                                    {-# LINE 3810 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_f1 ->
                                             (case (({-# LINE 254 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                     {-# LINE 3815 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _lhsOwarnings ->
                                              ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_CNot_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_And :: T_Token
sem_Token_And :: T_Token
sem_Token_And =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 And
                 {-# LINE 3827 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 3832 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_And_1 :: T_Token_1
                       sem_Token_And_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 258 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax <> SyntaxUsed (Just _lhsImpos) Nothing
                                        {-# LINE 3849 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _combinedSyntaxUsed ->
                                 (case (({-# LINE 259 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         resetIfInconsistent _combinedSyntaxUsed
                                         {-# LINE 3854 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _andSyntax ->
                                  (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _andSyntax
                                          {-# LINE 3859 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOandSyntax ->
                                   (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _copy
                                           {-# LINE 3864 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOcopy ->
                                    (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsIindentation
                                            {-# LINE 3869 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOindentation ->
                                     (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIlineCommentSyntax
                                             {-# LINE 3874 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOlineCommentSyntax ->
                                      (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsImultilineCommentSyntax
                                              {-# LINE 3879 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOmultilineCommentSyntax ->
                                       (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIneqSyntax
                                               {-# LINE 3884 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOneqSyntax ->
                                        (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsInotSyntax
                                                {-# LINE 3889 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOnotSyntax ->
                                         (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _lhsIorSyntax
                                                 {-# LINE 3894 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOorSyntax ->
                                          (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _lhsIstrSyntax
                                                  {-# LINE 3899 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOstrSyntax ->
                                           (case (({-# LINE 260 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   []
                                                   {-# LINE 3904 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _warnings_augmented_syn ->
                                            (case (({-# LINE 260 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                        warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "and" "&&"
                                                    {-# LINE 3910 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_f1 ->
                                             (case (({-# LINE 260 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                     {-# LINE 3915 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _lhsOwarnings ->
                                              ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_And_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_CAnd :: T_Token
sem_Token_CAnd :: T_Token
sem_Token_CAnd =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 CAnd
                 {-# LINE 3927 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 3932 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_CAnd_1 :: T_Token_1
                       sem_Token_CAnd_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 264 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax <> SyntaxUsed Nothing (Just _lhsImpos)
                                        {-# LINE 3949 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _combinedSyntaxUsed ->
                                 (case (({-# LINE 265 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         resetIfInconsistent _combinedSyntaxUsed
                                         {-# LINE 3954 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _andSyntax ->
                                  (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _andSyntax
                                          {-# LINE 3959 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOandSyntax ->
                                   (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _copy
                                           {-# LINE 3964 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOcopy ->
                                    (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsIindentation
                                            {-# LINE 3969 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOindentation ->
                                     (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIlineCommentSyntax
                                             {-# LINE 3974 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOlineCommentSyntax ->
                                      (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsImultilineCommentSyntax
                                              {-# LINE 3979 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOmultilineCommentSyntax ->
                                       (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIneqSyntax
                                               {-# LINE 3984 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOneqSyntax ->
                                        (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsInotSyntax
                                                {-# LINE 3989 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOnotSyntax ->
                                         (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _lhsIorSyntax
                                                 {-# LINE 3994 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOorSyntax ->
                                          (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _lhsIstrSyntax
                                                  {-# LINE 3999 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOstrSyntax ->
                                           (case (({-# LINE 266 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   []
                                                   {-# LINE 4004 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _warnings_augmented_syn ->
                                            (case (({-# LINE 266 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                        warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "&&" "and"
                                                    {-# LINE 4010 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_f1 ->
                                             (case (({-# LINE 266 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                     {-# LINE 4015 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _lhsOwarnings ->
                                              ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_CAnd_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Or :: T_Token
sem_Token_Or :: T_Token
sem_Token_Or =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Or
                 {-# LINE 4027 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 4032 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Or_1 :: T_Token_1
                       sem_Token_Or_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 4049 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 4054 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 4059 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 4064 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 4069 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 4074 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 4079 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 270 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax <> SyntaxUsed (Just _lhsImpos) Nothing
                                               {-# LINE 4084 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _combinedSyntaxUsed ->
                                        (case (({-# LINE 271 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                resetIfInconsistent _combinedSyntaxUsed
                                                {-# LINE 4089 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _orSyntax ->
                                         (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _orSyntax
                                                 {-# LINE 4094 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOorSyntax ->
                                          (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _lhsIstrSyntax
                                                  {-# LINE 4099 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOstrSyntax ->
                                           (case (({-# LINE 272 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   []
                                                   {-# LINE 4104 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _warnings_augmented_syn ->
                                            (case (({-# LINE 272 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                        warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "or" "||"
                                                    {-# LINE 4110 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_f1 ->
                                             (case (({-# LINE 272 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                     {-# LINE 4115 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _lhsOwarnings ->
                                              ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Or_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_COr :: T_Token
sem_Token_COr :: T_Token
sem_Token_COr =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 COr
                 {-# LINE 4127 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 4132 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_COr_1 :: T_Token_1
                       sem_Token_COr_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 4149 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 4154 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 4159 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 4164 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 4169 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 4174 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 4179 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 276 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax <> SyntaxUsed Nothing (Just _lhsImpos)
                                               {-# LINE 4184 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _combinedSyntaxUsed ->
                                        (case (({-# LINE 277 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                resetIfInconsistent _combinedSyntaxUsed
                                                {-# LINE 4189 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _orSyntax ->
                                         (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 _orSyntax
                                                 {-# LINE 4194 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOorSyntax ->
                                          (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                  _lhsIstrSyntax
                                                  {-# LINE 4199 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                  )) of
                                           { _lhsOstrSyntax ->
                                           (case (({-# LINE 278 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                   []
                                                   {-# LINE 4204 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                   )) of
                                            { _warnings_augmented_syn ->
                                            (case (({-# LINE 278 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                    if not (lint_syntaxInconsistencies _lhsIconfig) then id else
                                                        warnInconsistency _combinedSyntaxUsed     $ SyntaxInconsistency "||" "or"
                                                    {-# LINE 4210 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                    )) of
                                             { _warnings_augmented_f1 ->
                                             (case (({-# LINE 278 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                     foldr ($) _warnings_augmented_syn [_warnings_augmented_f1]
                                                     {-# LINE 4215 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                     )) of
                                              { _lhsOwarnings ->
                                              ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_COr_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Function :: T_Token
sem_Token_Function :: T_Token
sem_Token_Function =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Function
                 {-# LINE 4227 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 4232 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Function_1 :: T_Token_1
                       sem_Token_Function_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 4249 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 4254 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 4259 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 4264 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 4269 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 4274 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 4279 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 4284 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 4289 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 4294 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Function_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Local :: T_Token
sem_Token_Local :: T_Token
sem_Token_Local =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Local
                 {-# LINE 4306 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 4311 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Local_1 :: T_Token_1
                       sem_Token_Local_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 4328 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 4333 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 4338 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 4343 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 4348 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 4353 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 4358 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 4363 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 4368 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 4373 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Local_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_If :: T_Token
sem_Token_If :: T_Token
sem_Token_If =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 If
                 {-# LINE 4385 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 4390 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_If_1 :: T_Token_1
                       sem_Token_If_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 4407 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 4412 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 4417 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 4422 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 4427 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 4432 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 4437 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 4442 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 4447 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 4452 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_If_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Then :: T_Token
sem_Token_Then :: T_Token
sem_Token_Then =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Then
                 {-# LINE 4464 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 4469 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Then_1 :: T_Token_1
                       sem_Token_Then_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 4486 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 4491 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 4496 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 4501 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 4506 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 4511 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 4516 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 4521 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 4526 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 4531 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Then_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Elseif :: T_Token
sem_Token_Elseif :: T_Token
sem_Token_Elseif =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Elseif
                 {-# LINE 4543 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 4548 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Elseif_1 :: T_Token_1
                       sem_Token_Elseif_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 4565 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 4570 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 4575 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 4580 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 4585 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 4590 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 4595 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 4600 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 4605 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 4610 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Elseif_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Else :: T_Token
sem_Token_Else :: T_Token
sem_Token_Else =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Else
                 {-# LINE 4622 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 4627 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Else_1 :: T_Token_1
                       sem_Token_Else_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 4644 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 4649 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 4654 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 4659 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 4664 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 4669 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 4674 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 4679 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 4684 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 4689 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Else_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_For :: T_Token
sem_Token_For :: T_Token
sem_Token_For =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 For
                 {-# LINE 4701 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 4706 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_For_1 :: T_Token_1
                       sem_Token_For_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 4723 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 4728 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 4733 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 4738 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 4743 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 4748 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 4753 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 4758 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 4763 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 4768 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_For_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_In :: T_Token
sem_Token_In :: T_Token
sem_Token_In =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 In
                 {-# LINE 4780 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 4785 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_In_1 :: T_Token_1
                       sem_Token_In_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 4802 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 4807 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 4812 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 4817 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 4822 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 4827 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 4832 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 4837 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 4842 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 4847 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_In_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Do :: T_Token
sem_Token_Do :: T_Token
sem_Token_Do =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Do
                 {-# LINE 4859 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 4864 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Do_1 :: T_Token_1
                       sem_Token_Do_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 4881 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 4886 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 4891 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 4896 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 4901 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 4906 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 4911 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 4916 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 4921 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 4926 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Do_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_While :: T_Token
sem_Token_While :: T_Token
sem_Token_While =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 While
                 {-# LINE 4938 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 4943 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_While_1 :: T_Token_1
                       sem_Token_While_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 4960 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 4965 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 4970 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 4975 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 4980 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 4985 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 4990 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 4995 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 5000 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 5005 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_While_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Until :: T_Token
sem_Token_Until :: T_Token
sem_Token_Until =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Until
                 {-# LINE 5017 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 5022 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Until_1 :: T_Token_1
                       sem_Token_Until_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 5039 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 5044 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 5049 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 5054 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 5059 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 5064 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 5069 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 5074 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 5079 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 5084 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Until_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Repeat :: T_Token
sem_Token_Repeat :: T_Token
sem_Token_Repeat =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Repeat
                 {-# LINE 5096 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 5101 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Repeat_1 :: T_Token_1
                       sem_Token_Repeat_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 5118 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 5123 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 5128 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 5133 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 5138 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 5143 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 5148 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 5153 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 5158 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 5163 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Repeat_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Continue :: T_Token
sem_Token_Continue :: T_Token
sem_Token_Continue =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Continue
                 {-# LINE 5175 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 5180 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Continue_1 :: T_Token_1
                       sem_Token_Continue_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 5197 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 5202 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 5207 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 5212 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 5217 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 5222 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 5227 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 5232 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 5237 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 5242 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Continue_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Break :: T_Token
sem_Token_Break :: T_Token
sem_Token_Break =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Break
                 {-# LINE 5254 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 5259 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Break_1 :: T_Token_1
                       sem_Token_Break_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 5276 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 5281 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 5286 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 5291 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 5296 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 5301 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 5306 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 5311 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 5316 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 5321 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Break_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Return :: T_Token
sem_Token_Return :: T_Token
sem_Token_Return =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Return
                 {-# LINE 5333 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 5338 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Return_1 :: T_Token_1
                       sem_Token_Return_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 5355 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 5360 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 5365 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 5370 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 5375 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 5380 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 5385 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 5390 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 5395 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 5400 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Return_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_End :: T_Token
sem_Token_End :: T_Token
sem_Token_End =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 End
                 {-# LINE 5412 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 5417 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_End_1 :: T_Token_1
                       sem_Token_End_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 5434 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 5439 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 5444 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 5449 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 5454 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 5459 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 5464 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 5469 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 5474 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 5479 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_End_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_LRound :: T_Token
sem_Token_LRound :: T_Token
sem_Token_LRound =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 LRound
                 {-# LINE 5491 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 5496 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_LRound_1 :: T_Token_1
                       sem_Token_LRound_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 5513 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 5518 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 5523 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 5528 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 5533 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 5538 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 5543 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 5548 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 5553 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 5558 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_LRound_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_RRound :: T_Token
sem_Token_RRound :: T_Token
sem_Token_RRound =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 RRound
                 {-# LINE 5570 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 5575 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_RRound_1 :: T_Token_1
                       sem_Token_RRound_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 5592 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 5597 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 5602 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 5607 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 5612 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 5617 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 5622 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 5627 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 5632 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 5637 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_RRound_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_LCurly :: T_Token
sem_Token_LCurly :: T_Token
sem_Token_LCurly =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 LCurly
                 {-# LINE 5649 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 5654 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_LCurly_1 :: T_Token_1
                       sem_Token_LCurly_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 5671 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 5676 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 5681 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 5686 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 5691 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 5696 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 5701 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 5706 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 5711 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 5716 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_LCurly_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_RCurly :: T_Token
sem_Token_RCurly :: T_Token
sem_Token_RCurly =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 RCurly
                 {-# LINE 5728 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 5733 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_RCurly_1 :: T_Token_1
                       sem_Token_RCurly_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 5750 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 5755 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 5760 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 5765 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 5770 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 5775 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 5780 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 5785 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 5790 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 5795 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_RCurly_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_LSquare :: T_Token
sem_Token_LSquare :: T_Token
sem_Token_LSquare =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 LSquare
                 {-# LINE 5807 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 5812 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_LSquare_1 :: T_Token_1
                       sem_Token_LSquare_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 5829 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 5834 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 5839 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 5844 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 5849 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 5854 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 5859 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 5864 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 5869 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 5874 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_LSquare_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_RSquare :: T_Token
sem_Token_RSquare :: T_Token
sem_Token_RSquare =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 RSquare
                 {-# LINE 5886 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 5891 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_RSquare_1 :: T_Token_1
                       sem_Token_RSquare_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 5908 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 5913 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 5918 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 5923 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 5928 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 5933 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 5938 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 5943 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 5948 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 5953 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_RSquare_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Label :: String ->
                   String ->
                   String ->
                   T_Token
sem_Token_Label :: String -> String -> String -> T_Token
sem_Token_Label String
whitespaceBefore_ String
lbl_ String
whitespaceAfter_ =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Label whitespaceBefore_ lbl_ whitespaceAfter_
                 {-# LINE 5968 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 294 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceStr _lhsInextTokenPos (show _copy    )
                  {-# LINE 5973 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Label_1 :: T_Token_1
                       sem_Token_Label_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 5990 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 5995 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 6000 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 6005 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 6010 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 6015 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 6020 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 6025 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 6030 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 6035 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Label_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))
sem_Token_Identifier :: String ->
                        T_Token
sem_Token_Identifier :: String -> T_Token
sem_Token_Identifier String
ident_ =
    (\ LineColPos
_lhsInextTokenPos ->
         (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                 Identifier ident_
                 {-# LINE 6048 "src/GLuaFixer/AG/LexLint.hs" #-}
                 )) of
          { _copy ->
          (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-}
                  customAdvanceToken _lhsInextTokenPos _copy
                  {-# LINE 6053 "src/GLuaFixer/AG/LexLint.hs" #-}
                  )) of
           { _lhsOnextTokenPos ->
           (case ((let sem_Token_Identifier_1 :: T_Token_1
                       sem_Token_Identifier_1 =
                           (\ _lhsIandSyntax
                              _lhsIconfig
                              _lhsIindentation
                              _lhsIlineCommentSyntax
                              _lhsImpos
                              _lhsImultilineCommentSyntax
                              _lhsIneqSyntax
                              _lhsInotSyntax
                              _lhsIorSyntax
                              _lhsIstrSyntax ->
                                (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-}
                                        _lhsIandSyntax
                                        {-# LINE 6070 "src/GLuaFixer/AG/LexLint.hs" #-}
                                        )) of
                                 { _lhsOandSyntax ->
                                 (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-}
                                         _copy
                                         {-# LINE 6075 "src/GLuaFixer/AG/LexLint.hs" #-}
                                         )) of
                                  { _lhsOcopy ->
                                  (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-}
                                          _lhsIindentation
                                          {-# LINE 6080 "src/GLuaFixer/AG/LexLint.hs" #-}
                                          )) of
                                   { _lhsOindentation ->
                                   (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-}
                                           _lhsIlineCommentSyntax
                                           {-# LINE 6085 "src/GLuaFixer/AG/LexLint.hs" #-}
                                           )) of
                                    { _lhsOlineCommentSyntax ->
                                    (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-}
                                            _lhsImultilineCommentSyntax
                                            {-# LINE 6090 "src/GLuaFixer/AG/LexLint.hs" #-}
                                            )) of
                                     { _lhsOmultilineCommentSyntax ->
                                     (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-}
                                             _lhsIneqSyntax
                                             {-# LINE 6095 "src/GLuaFixer/AG/LexLint.hs" #-}
                                             )) of
                                      { _lhsOneqSyntax ->
                                      (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-}
                                              _lhsInotSyntax
                                              {-# LINE 6100 "src/GLuaFixer/AG/LexLint.hs" #-}
                                              )) of
                                       { _lhsOnotSyntax ->
                                       (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-}
                                               _lhsIorSyntax
                                               {-# LINE 6105 "src/GLuaFixer/AG/LexLint.hs" #-}
                                               )) of
                                        { _lhsOorSyntax ->
                                        (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                _lhsIstrSyntax
                                                {-# LINE 6110 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                )) of
                                         { _lhsOstrSyntax ->
                                         (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-}
                                                 []
                                                 {-# LINE 6115 "src/GLuaFixer/AG/LexLint.hs" #-}
                                                 )) of
                                          { _lhsOwarnings ->
                                          ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }))
                   in  sem_Token_Identifier_1)) of
            { ( sem_Token_1) ->
            ( _lhsOnextTokenPos,sem_Token_1) }) }) }))