{-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# LANGUAGE LambdaCase #-} -- UUAGC 0.9.53.1 (src/GLuaFixer/AG/ASTLint.ag) module GLuaFixer.AG.ASTLint where {-# LINE 9 "src/GLuaFixer/AG/../../GLua/AG/Token.ag" #-} import Text.ParserCombinators.UU.BasicInstances hiding (pos) import GHC.Generics {-# LINE 19 "src/GLuaFixer/AG/ASTLint.hs" #-} {-# LINE 10 "src/GLuaFixer/AG/../../GLua/AG/AST.ag" #-} import GLua.AG.Token import GLua.TokenTypes () import GHC.Generics import Data.Aeson {-# LINE 27 "src/GLuaFixer/AG/ASTLint.hs" #-} {-# LINE 10 "src/GLuaFixer/AG/ASTLint.ag" #-} import GLua.AG.AST import qualified GLua.AG.PrettyPrint as PP import qualified GLua.AG.Token as T import GLua.TokenTypes import qualified Data.Set as S import qualified Data.Map.Strict as M import Data.Char (isLower, isUpper) import Data.Maybe import GLuaFixer.LintMessage import GLuaFixer.LintSettings {-# LINE 41 "src/GLuaFixer/AG/ASTLint.hs" #-} {-# LINE 28 "src/GLuaFixer/AG/ASTLint.ag" #-} warn :: Region -> Issue -> FilePath -> LintMessage warn pos issue = LintMessage LintWarning pos issue -- Used in detecting "not (a == b)" kind of things oppositeBinOp :: BinOp -> Maybe String oppositeBinOp ALT = Just ">=" oppositeBinOp AGT = Just "<=" oppositeBinOp ALEQ = Just ">" oppositeBinOp AGEQ = Just "<" oppositeBinOp ANEq = Just "==" oppositeBinOp AEq = Just "~=" oppositeBinOp _ = Nothing -- Checks whether a variable shadows existing variables checkShadows :: [M.Map String (Bool, Region)] -> MToken -> Maybe (FilePath -> LintMessage) checkShadows [] _ = Nothing checkShadows _ (MToken _ (Identifier "_")) = Nothing -- Exception for vars named '_' checkShadows (scope : scs) mtok' = if M.member lbl scope then Just $ warn (mpos mtok') $ VariableShadows lbl location else checkShadows scs mtok' where lbl = tokenLabel mtok' location = snd $ fromMaybe (error "checkShadows fromMaybe") $ M.lookup lbl scope -- Determines whether a variable is local -- It is local if it does not exist in any but the topmost (global) scope -- it may or may not exist in the topmost scope. isVariableLocal :: [M.Map String (Bool, Region)] -> String -> Bool isVariableLocal [] _ = False isVariableLocal [_] _ = False isVariableLocal (scope : scs) var = case M.lookup var scope of Just _ -> True Nothing -> isVariableLocal scs var -- Registers a variable as global variable when it hasn't been -- introduced in any of the visible scopes registerVariable :: [M.Map String (Bool, Region)] -> Region -> String -> Bool -> [M.Map String (Bool, Region)] registerVariable [] _ _ _ = error "cannot register top level variable" registerVariable (scope : []) pos var used = [ case M.lookup var scope of Just (used', pos') -> M.insert var (used || used', pos') scope Nothing -> M.insert var (used, pos) scope ] -- global scope registerVariable (scope : scs) pos var used = case M.lookup var scope of Just (True, _) -> scope : scs Just (False, pos') -> M.insert var (used, pos') scope : scs Nothing -> scope : registerVariable scs pos var used findSelf :: [MToken] -> Bool findSelf ((MToken _ (Identifier "self")) : _) = True findSelf _ = False data VariableStyle = StartsLowerCase | StartsUpperCase | VariableStyleNeither deriving (Eq) data DeterminedVariableStyle = VarStyleNotDetermined | VarStyleDetermined !VariableStyle combineDeterminedVarStyle :: DeterminedVariableStyle -> VariableStyle -> DeterminedVariableStyle combineDeterminedVarStyle old new = case old of VarStyleNotDetermined -> VarStyleDetermined new VarStyleDetermined VariableStyleNeither -> VarStyleDetermined new _ -> old determineVariableStyle :: String -> VariableStyle determineVariableStyle = \case [] -> VariableStyleNeither (c : _) | isLower c -> StartsLowerCase | isUpper c -> StartsUpperCase | otherwise -> VariableStyleNeither variableStyleInconsistent :: DeterminedVariableStyle -> VariableStyle -> Bool variableStyleInconsistent determinedStyle varStyle = case determinedStyle of VarStyleNotDetermined -> False VarStyleDetermined VariableStyleNeither -> False VarStyleDetermined existing -> case varStyle of VariableStyleNeither -> False _ -> existing /= varStyle unknownIdentifier :: String unknownIdentifier = "Unknown identifier" {-# LINE 135 "src/GLuaFixer/AG/ASTLint.hs" #-} {-# LINE 647 "src/GLuaFixer/AG/ASTLint.ag" #-} inh_AST :: LintSettings -> Inh_AST inh_AST conf = Inh_AST { config_Inh_AST = conf, isMeta_Inh_AST = False, loopLevel_Inh_AST = 0, globalDefinitions_Inh_AST = M.empty, mtokenPos_Inh_AST = emptyRg, scopeLevel_Inh_AST = 0, scopes_Inh_AST = [M.empty], funcName_Inh_AST = "", isInModule_Inh_AST = False, variableStyle_Inh_AST = VarStyleNotDetermined } allAttributes :: LintSettings -> AST -> Syn_AST allAttributes conf p = wrap_AST (sem_AST p) (inh_AST conf) astWarnings :: LintSettings -> AST -> [String -> LintMessage] astWarnings conf p = warnings_Syn_AST $ allAttributes conf p globalDefinitions :: LintSettings -> AST -> M.Map String [Region] globalDefinitions conf p = globalDefinitions_Syn_AST $ allAttributes conf p {-# LINE 161 "src/GLuaFixer/AG/ASTLint.hs" #-} -- AReturn ----------------------------------------------------- -- cata sem_AReturn :: AReturn -> T_AReturn sem_AReturn (AReturn _pos _values) = (sem_AReturn_AReturn (sem_Region _pos) (sem_MExprList _values)) sem_AReturn (NoReturn) = (sem_AReturn_NoReturn) -- semantic domain type T_AReturn = ( AReturn,T_AReturn_1) type T_AReturn_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),Int,DeterminedVariableStyle,([String -> LintMessage])) data Inh_AReturn = Inh_AReturn {config_Inh_AReturn :: LintSettings,funcName_Inh_AReturn :: String,globalDefinitions_Inh_AReturn :: (M.Map String [Region]),isInModule_Inh_AReturn :: Bool,isMeta_Inh_AReturn :: Bool,loopLevel_Inh_AReturn :: Int,mtokenPos_Inh_AReturn :: Region,scopeLevel_Inh_AReturn :: Int,scopes_Inh_AReturn :: ([M.Map String (Bool, Region)]),variableStyle_Inh_AReturn :: DeterminedVariableStyle} data Syn_AReturn = Syn_AReturn {copy_Syn_AReturn :: AReturn,globalDefinitions_Syn_AReturn :: (M.Map String [Region]),identifier_Syn_AReturn :: String,isInModule_Syn_AReturn :: Bool,mtokenPos_Syn_AReturn :: Region,scopes_Syn_AReturn :: ([M.Map String (Bool, Region)]),statementCount_Syn_AReturn :: Int,variableStyle_Syn_AReturn :: DeterminedVariableStyle,warnings_Syn_AReturn :: ([String -> LintMessage])} wrap_AReturn :: T_AReturn -> Inh_AReturn -> Syn_AReturn wrap_AReturn sem (Inh_AReturn _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOstatementCount,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_AReturn _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOstatementCount _lhsOvariableStyle _lhsOwarnings)) sem_AReturn_AReturn :: T_Region -> T_MExprList -> T_AReturn sem_AReturn_AReturn pos_ values_ = (case (values_) of { ( _valuesIcopy,values_1) -> (case (pos_) of { ( _posIcopy,_posIidentifier,_posIwarnings) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AReturn _posIcopy _valuesIcopy {-# LINE 202 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 207 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_AReturn_AReturn_1 :: T_AReturn_1 sem_AReturn_AReturn_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 224 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valuesOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 229 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valuesOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 234 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valuesOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 239 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valuesOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 244 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valuesOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 249 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valuesOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 254 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valuesOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 259 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valuesOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 264 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valuesOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 269 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valuesOfuncName -> (case (({-# LINE 492 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 274 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valuesOtopLevel -> (case (({-# LINE 491 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 279 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valuesOinParentheses -> (case (values_1 _valuesOconfig _valuesOfuncName _valuesOglobalDefinitions _valuesOinParentheses _valuesOisInModule _valuesOisMeta _valuesOloopLevel _valuesOmtokenPos _valuesOscopeLevel _valuesOscopes _valuesOtopLevel _valuesOvariableStyle) of { ( _valuesIglobalDefinitions,_valuesIidentifier,_valuesIisInModule,_valuesImtokenPos,_valuesIscopes,_valuesIvariableStyle,_valuesIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _valuesIglobalDefinitions {-# LINE 286 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _posIidentifier _valuesIidentifier) {-# LINE 291 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _valuesIisInModule {-# LINE 296 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 493 "src/GLuaFixer/AG/ASTLint.ag" #-} _posIcopy {-# LINE 301 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _valuesIscopes {-# LINE 306 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 157 "src/GLuaFixer/AG/ASTLint.ag" #-} 1 {-# LINE 311 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOstatementCount -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _valuesIvariableStyle {-# LINE 316 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _posIwarnings ++ _valuesIwarnings {-# LINE 321 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOstatementCount,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_AReturn_AReturn_1)) of { ( sem_AReturn_1) -> ( _lhsOcopy,sem_AReturn_1) }) }) }) }) }) sem_AReturn_NoReturn :: T_AReturn sem_AReturn_NoReturn = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} NoReturn {-# LINE 332 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 337 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_AReturn_NoReturn_1 :: T_AReturn_1 sem_AReturn_NoReturn_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 354 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 359 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 364 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 369 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 374 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 495 "src/GLuaFixer/AG/ASTLint.ag" #-} 0 {-# LINE 379 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOstatementCount -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 384 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 389 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOstatementCount,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) })) in sem_AReturn_NoReturn_1)) of { ( sem_AReturn_1) -> ( _lhsOcopy,sem_AReturn_1) }) }) }) -- AST --------------------------------------------------------- -- cata sem_AST :: AST -> T_AST sem_AST (AST _comments _chunk) = (sem_AST_AST _comments (sem_Block _chunk)) -- semantic domain type T_AST = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( AST,(M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_AST = Inh_AST {config_Inh_AST :: LintSettings,funcName_Inh_AST :: String,globalDefinitions_Inh_AST :: (M.Map String [Region]),isInModule_Inh_AST :: Bool,isMeta_Inh_AST :: Bool,loopLevel_Inh_AST :: Int,mtokenPos_Inh_AST :: Region,scopeLevel_Inh_AST :: Int,scopes_Inh_AST :: ([M.Map String (Bool, Region)]),variableStyle_Inh_AST :: DeterminedVariableStyle} data Syn_AST = Syn_AST {copy_Syn_AST :: AST,globalDefinitions_Syn_AST :: (M.Map String [Region]),identifier_Syn_AST :: String,isInModule_Syn_AST :: Bool,mtokenPos_Syn_AST :: Region,scopes_Syn_AST :: ([M.Map String (Bool, Region)]),variableStyle_Syn_AST :: DeterminedVariableStyle,warnings_Syn_AST :: ([String -> LintMessage])} wrap_AST :: T_AST -> Inh_AST -> Syn_AST wrap_AST sem (Inh_AST _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_AST _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_AST_AST :: ([MToken]) -> T_Block -> T_AST sem_AST_AST comments_ chunk_ = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (chunk_) of { ( _chunkIcopy,chunk_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AST comments_ _chunkIcopy {-# LINE 440 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 445 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 450 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _chunkOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 455 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _chunkOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 460 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _chunkOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 465 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _chunkOconfig -> (case (({-# LINE 292 "src/GLuaFixer/AG/ASTLint.ag" #-} M.empty : _lhsIscopes {-# LINE 470 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _chunkOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 475 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _chunkOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 480 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _chunkOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 485 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _chunkOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 490 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _chunkOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 495 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _chunkOfuncName -> (case (({-# LINE 293 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 500 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _chunkOisRepeat -> (case (chunk_1 _chunkOconfig _chunkOfuncName _chunkOglobalDefinitions _chunkOisInModule _chunkOisMeta _chunkOisRepeat _chunkOloopLevel _chunkOmtokenPos _chunkOscopeLevel _chunkOscopes _chunkOvariableStyle) of { ( _chunkIglobalDefinitions,_chunkIidentifier,_chunkIisIfStatement,_chunkIisInModule,_chunkImtokenPos,_chunkIscopes,_chunkIstatementCount,_chunkIvariableStyle,_chunkIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _chunkIglobalDefinitions {-# LINE 507 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _chunkIidentifier {-# LINE 512 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _chunkIisInModule {-# LINE 517 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _chunkImtokenPos {-# LINE 522 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _chunkIscopes {-# LINE 527 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _chunkIvariableStyle {-# LINE 532 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _chunkIwarnings {-# LINE 537 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) -- Args -------------------------------------------------------- -- cata sem_Args :: Args -> T_Args sem_Args (ListArgs _args) = (sem_Args_ListArgs (sem_MExprList _args)) sem_Args (TableArg _arg) = (sem_Args_TableArg (sem_FieldList _arg)) sem_Args (StringArg _arg) = (sem_Args_StringArg (sem_MToken _arg)) -- semantic domain type T_Args = ( Args,T_Args_1) type T_Args_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_Args = Inh_Args {config_Inh_Args :: LintSettings,funcName_Inh_Args :: String,globalDefinitions_Inh_Args :: (M.Map String [Region]),isInModule_Inh_Args :: Bool,isMeta_Inh_Args :: Bool,loopLevel_Inh_Args :: Int,mtokenPos_Inh_Args :: Region,scopeLevel_Inh_Args :: Int,scopes_Inh_Args :: ([M.Map String (Bool, Region)]),variableStyle_Inh_Args :: DeterminedVariableStyle} data Syn_Args = Syn_Args {copy_Syn_Args :: Args,globalDefinitions_Syn_Args :: (M.Map String [Region]),identifier_Syn_Args :: String,isInModule_Syn_Args :: Bool,mtokenPos_Syn_Args :: Region,scopes_Syn_Args :: ([M.Map String (Bool, Region)]),variableStyle_Syn_Args :: DeterminedVariableStyle,warnings_Syn_Args :: ([String -> LintMessage])} wrap_Args :: T_Args -> Inh_Args -> Syn_Args wrap_Args sem (Inh_Args _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_Args _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_Args_ListArgs :: T_MExprList -> T_Args sem_Args_ListArgs args_ = (case (args_) of { ( _argsIcopy,args_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ListArgs _argsIcopy {-# LINE 580 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 585 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Args_ListArgs_1 :: T_Args_1 sem_Args_ListArgs_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 602 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 607 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 612 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 617 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 622 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 627 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 632 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 637 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 642 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 647 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOfuncName -> (case (({-# LINE 606 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 652 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOtopLevel -> (case (({-# LINE 605 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 657 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOinParentheses -> (case (args_1 _argsOconfig _argsOfuncName _argsOglobalDefinitions _argsOinParentheses _argsOisInModule _argsOisMeta _argsOloopLevel _argsOmtokenPos _argsOscopeLevel _argsOscopes _argsOtopLevel _argsOvariableStyle) of { ( _argsIglobalDefinitions,_argsIidentifier,_argsIisInModule,_argsImtokenPos,_argsIscopes,_argsIvariableStyle,_argsIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIglobalDefinitions {-# LINE 664 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIidentifier {-# LINE 669 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIisInModule {-# LINE 674 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsImtokenPos {-# LINE 679 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIscopes {-# LINE 684 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIvariableStyle {-# LINE 689 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIwarnings {-# LINE 694 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Args_ListArgs_1)) of { ( sem_Args_1) -> ( _lhsOcopy,sem_Args_1) }) }) }) }) sem_Args_TableArg :: T_FieldList -> T_Args sem_Args_TableArg arg_ = (case (arg_) of { ( _argIcopy,arg_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} TableArg _argIcopy {-# LINE 708 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 713 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Args_TableArg_1 :: T_Args_1 sem_Args_TableArg_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 730 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 735 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 740 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 745 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 750 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 755 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 760 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 765 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 770 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 775 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOfuncName -> (case (({-# LINE 608 "src/GLuaFixer/AG/ASTLint.ag" #-} S.empty {-# LINE 780 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOfieldNames -> (case (arg_1 _argOconfig _argOfieldNames _argOfuncName _argOglobalDefinitions _argOisInModule _argOisMeta _argOloopLevel _argOmtokenPos _argOscopeLevel _argOscopes _argOvariableStyle) of { ( _argIfieldNames,_argIglobalDefinitions,_argIidentifier,_argIisInModule,_argImtokenPos,_argIscopes,_argIvariableStyle,_argIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _argIglobalDefinitions {-# LINE 787 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _argIidentifier {-# LINE 792 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _argIisInModule {-# LINE 797 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _argImtokenPos {-# LINE 802 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _argIscopes {-# LINE 807 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _argIvariableStyle {-# LINE 812 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _argIwarnings {-# LINE 817 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Args_TableArg_1)) of { ( sem_Args_1) -> ( _lhsOcopy,sem_Args_1) }) }) }) }) sem_Args_StringArg :: T_MToken -> T_Args sem_Args_StringArg arg_ = (case (arg_) of { ( _argIcopy,_argImtok,_argImtokenPos,arg_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} StringArg _argIcopy {-# LINE 831 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 836 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Args_StringArg_1 :: T_Args_1 sem_Args_StringArg_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 853 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOglobalDefinitions -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 858 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOscopes -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 863 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOmtokenPos -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 868 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 873 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOisInModule -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 878 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 883 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argOconfig -> (case (arg_1 _argOconfig _argOfuncName _argOglobalDefinitions _argOisInModule _argOisMeta _argOmtokenPos _argOscopes) of { ( _argIglobalDefinitions,_argIidentifier,_argIisInModule,_argIscopes,_argIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _argIglobalDefinitions {-# LINE 890 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _argIidentifier {-# LINE 895 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _argIisInModule {-# LINE 900 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _argImtokenPos {-# LINE 905 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _argIscopes {-# LINE 910 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 915 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _argIwarnings {-# LINE 920 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Args_StringArg_1)) of { ( sem_Args_1) -> ( _lhsOcopy,sem_Args_1) }) }) }) }) -- BinOp ------------------------------------------------------- -- cata sem_BinOp :: BinOp -> T_BinOp sem_BinOp (AOr) = (sem_BinOp_AOr) sem_BinOp (AAnd) = (sem_BinOp_AAnd) sem_BinOp (ALT) = (sem_BinOp_ALT) sem_BinOp (AGT) = (sem_BinOp_AGT) sem_BinOp (ALEQ) = (sem_BinOp_ALEQ) sem_BinOp (AGEQ) = (sem_BinOp_AGEQ) sem_BinOp (ANEq) = (sem_BinOp_ANEq) sem_BinOp (AEq) = (sem_BinOp_AEq) sem_BinOp (AConcatenate) = (sem_BinOp_AConcatenate) sem_BinOp (APlus) = (sem_BinOp_APlus) sem_BinOp (BinMinus) = (sem_BinOp_BinMinus) sem_BinOp (AMultiply) = (sem_BinOp_AMultiply) sem_BinOp (ADivide) = (sem_BinOp_ADivide) sem_BinOp (AModulus) = (sem_BinOp_AModulus) sem_BinOp (APower) = (sem_BinOp_APower) -- semantic domain type T_BinOp = ( BinOp,T_BinOp_1) type T_BinOp_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_BinOp = Inh_BinOp {config_Inh_BinOp :: LintSettings,funcName_Inh_BinOp :: String,globalDefinitions_Inh_BinOp :: (M.Map String [Region]),isInModule_Inh_BinOp :: Bool,isMeta_Inh_BinOp :: Bool,loopLevel_Inh_BinOp :: Int,mtokenPos_Inh_BinOp :: Region,scopeLevel_Inh_BinOp :: Int,scopes_Inh_BinOp :: ([M.Map String (Bool, Region)]),variableStyle_Inh_BinOp :: DeterminedVariableStyle} data Syn_BinOp = Syn_BinOp {copy_Syn_BinOp :: BinOp,globalDefinitions_Syn_BinOp :: (M.Map String [Region]),identifier_Syn_BinOp :: String,isInModule_Syn_BinOp :: Bool,mtokenPos_Syn_BinOp :: Region,scopes_Syn_BinOp :: ([M.Map String (Bool, Region)]),variableStyle_Syn_BinOp :: DeterminedVariableStyle,warnings_Syn_BinOp :: ([String -> LintMessage])} wrap_BinOp :: T_BinOp -> Inh_BinOp -> Syn_BinOp wrap_BinOp sem (Inh_BinOp _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_BinOp _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_BinOp_AOr :: T_BinOp sem_BinOp_AOr = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AOr {-# LINE 987 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 992 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_AOr_1 :: T_BinOp_1 sem_BinOp_AOr_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1009 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1014 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1019 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1024 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1029 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1034 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1039 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_AOr_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_AAnd :: T_BinOp sem_BinOp_AAnd = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AAnd {-# LINE 1050 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1055 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_AAnd_1 :: T_BinOp_1 sem_BinOp_AAnd_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1072 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1077 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1082 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1087 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1092 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1097 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1102 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_AAnd_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_ALT :: T_BinOp sem_BinOp_ALT = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ALT {-# LINE 1113 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1118 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_ALT_1 :: T_BinOp_1 sem_BinOp_ALT_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1135 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1140 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1145 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1150 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1155 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1160 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1165 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_ALT_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_AGT :: T_BinOp sem_BinOp_AGT = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AGT {-# LINE 1176 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1181 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_AGT_1 :: T_BinOp_1 sem_BinOp_AGT_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1198 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1203 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1208 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1213 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1218 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1223 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1228 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_AGT_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_ALEQ :: T_BinOp sem_BinOp_ALEQ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ALEQ {-# LINE 1239 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1244 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_ALEQ_1 :: T_BinOp_1 sem_BinOp_ALEQ_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1261 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1266 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1271 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1276 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1281 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1286 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1291 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_ALEQ_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_AGEQ :: T_BinOp sem_BinOp_AGEQ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AGEQ {-# LINE 1302 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1307 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_AGEQ_1 :: T_BinOp_1 sem_BinOp_AGEQ_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1324 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1329 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1334 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1339 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1344 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1349 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1354 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_AGEQ_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_ANEq :: T_BinOp sem_BinOp_ANEq = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ANEq {-# LINE 1365 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1370 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_ANEq_1 :: T_BinOp_1 sem_BinOp_ANEq_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1387 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1392 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1397 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1402 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1407 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1412 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1417 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_ANEq_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_AEq :: T_BinOp sem_BinOp_AEq = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AEq {-# LINE 1428 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1433 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_AEq_1 :: T_BinOp_1 sem_BinOp_AEq_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1450 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1455 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1460 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1465 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1470 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1475 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1480 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_AEq_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_AConcatenate :: T_BinOp sem_BinOp_AConcatenate = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AConcatenate {-# LINE 1491 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1496 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_AConcatenate_1 :: T_BinOp_1 sem_BinOp_AConcatenate_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1513 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1518 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1523 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1528 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1533 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1538 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1543 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_AConcatenate_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_APlus :: T_BinOp sem_BinOp_APlus = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} APlus {-# LINE 1554 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1559 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_APlus_1 :: T_BinOp_1 sem_BinOp_APlus_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1576 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1581 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1586 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1591 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1596 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1601 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1606 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_APlus_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_BinMinus :: T_BinOp sem_BinOp_BinMinus = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} BinMinus {-# LINE 1617 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1622 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_BinMinus_1 :: T_BinOp_1 sem_BinOp_BinMinus_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1639 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1644 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1649 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1654 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1659 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1664 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1669 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_BinMinus_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_AMultiply :: T_BinOp sem_BinOp_AMultiply = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AMultiply {-# LINE 1680 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1685 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_AMultiply_1 :: T_BinOp_1 sem_BinOp_AMultiply_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1702 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1707 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1712 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1717 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1722 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1727 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1732 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_AMultiply_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_ADivide :: T_BinOp sem_BinOp_ADivide = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ADivide {-# LINE 1743 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1748 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_ADivide_1 :: T_BinOp_1 sem_BinOp_ADivide_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1765 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1770 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1775 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1780 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1785 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1790 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1795 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_ADivide_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_AModulus :: T_BinOp sem_BinOp_AModulus = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AModulus {-# LINE 1806 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1811 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_AModulus_1 :: T_BinOp_1 sem_BinOp_AModulus_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1828 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1833 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1838 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1843 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1848 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1853 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1858 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_AModulus_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) sem_BinOp_APower :: T_BinOp sem_BinOp_APower = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} APower {-# LINE 1869 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1874 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_BinOp_APower_1 :: T_BinOp_1 sem_BinOp_APower_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 1891 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 1896 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 1901 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 1906 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1911 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 1916 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 1921 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_BinOp_APower_1)) of { ( sem_BinOp_1) -> ( _lhsOcopy,sem_BinOp_1) }) }) }) -- Block ------------------------------------------------------- -- cata sem_Block :: Block -> T_Block sem_Block (Block _stats _ret) = (sem_Block_Block (sem_MStatList _stats) (sem_AReturn _ret)) -- semantic domain type T_Block = ( Block,T_Block_1) type T_Block_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Bool,Region,([M.Map String (Bool, Region)]),Int,DeterminedVariableStyle,([String -> LintMessage])) data Inh_Block = Inh_Block {config_Inh_Block :: LintSettings,funcName_Inh_Block :: String,globalDefinitions_Inh_Block :: (M.Map String [Region]),isInModule_Inh_Block :: Bool,isMeta_Inh_Block :: Bool,isRepeat_Inh_Block :: Bool,loopLevel_Inh_Block :: Int,mtokenPos_Inh_Block :: Region,scopeLevel_Inh_Block :: Int,scopes_Inh_Block :: ([M.Map String (Bool, Region)]),variableStyle_Inh_Block :: DeterminedVariableStyle} data Syn_Block = Syn_Block {copy_Syn_Block :: Block,globalDefinitions_Syn_Block :: (M.Map String [Region]),identifier_Syn_Block :: String,isIfStatement_Syn_Block :: Bool,isInModule_Syn_Block :: Bool,mtokenPos_Syn_Block :: Region,scopes_Syn_Block :: ([M.Map String (Bool, Region)]),statementCount_Syn_Block :: Int,variableStyle_Syn_Block :: DeterminedVariableStyle,warnings_Syn_Block :: ([String -> LintMessage])} wrap_Block :: T_Block -> Inh_Block -> Syn_Block wrap_Block sem (Inh_Block _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIisRepeat _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOstatementCount,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIisRepeat _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_Block _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisIfStatement _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOstatementCount _lhsOvariableStyle _lhsOwarnings)) sem_Block_Block :: T_MStatList -> T_AReturn -> T_Block sem_Block_Block stats_ ret_ = (case (ret_) of { ( _retIcopy,ret_1) -> (case (stats_) of { ( _statsIcopy,stats_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Block _statsIcopy _retIcopy {-# LINE 1967 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 1972 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Block_Block_1 :: T_Block_1 sem_Block_Block_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIisRepeat _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 1990 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statsOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 1995 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statsOisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 2000 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statsOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 2005 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statsOvariableStyle -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 2010 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statsOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 2015 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statsOloopLevel -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 2020 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statsOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 2025 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statsOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 2030 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statsOfuncName -> (case (({-# LINE 297 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel + 1 {-# LINE 2035 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statsOscopeLevel -> (case (stats_1 _statsOconfig _statsOfuncName _statsOglobalDefinitions _statsOisInModule _statsOisMeta _statsOloopLevel _statsOmtokenPos _statsOscopeLevel _statsOscopes _statsOvariableStyle) of { ( _statsIglobalDefinitions,_statsIidentifier,_statsIisIfStatement,_statsIisInModule,_statsImtokenPos,_statsIscopes,_statsIstatementCount,_statsIvariableStyle,_statsIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _statsIscopes {-# LINE 2042 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _retOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 2047 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _retOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _statsIisInModule {-# LINE 2052 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _retOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _statsIglobalDefinitions {-# LINE 2057 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _retOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 2062 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _retOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _statsIvariableStyle {-# LINE 2067 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _retOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 2072 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _retOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _statsImtokenPos {-# LINE 2077 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _retOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 2082 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _retOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 2087 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _retOfuncName -> (case (ret_1 _retOconfig _retOfuncName _retOglobalDefinitions _retOisInModule _retOisMeta _retOloopLevel _retOmtokenPos _retOscopeLevel _retOscopes _retOvariableStyle) of { ( _retIglobalDefinitions,_retIidentifier,_retIisInModule,_retImtokenPos,_retIscopes,_retIstatementCount,_retIvariableStyle,_retIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _retIglobalDefinitions {-# LINE 2094 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _statsIidentifier _retIidentifier) {-# LINE 2099 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 208 "src/GLuaFixer/AG/ASTLint.ag" #-} _statsIisIfStatement {-# LINE 2104 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _retIisInModule {-# LINE 2109 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _retImtokenPos {-# LINE 2114 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 304 "src/GLuaFixer/AG/ASTLint.ag" #-} if _lhsIisRepeat then _retIscopes else tail _retIscopes {-# LINE 2119 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 157 "src/GLuaFixer/AG/ASTLint.ag" #-} _statsIstatementCount + _retIstatementCount {-# LINE 2124 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOstatementCount -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _retIvariableStyle {-# LINE 2129 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 302 "src/GLuaFixer/AG/ASTLint.ag" #-} _statsIwarnings ++ _retIwarnings {-# LINE 2134 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 301 "src/GLuaFixer/AG/ASTLint.ag" #-} M.filterWithKey (\k (b, _) -> not (null k) && head k /= '_' && not b) (head _retIscopes) {-# LINE 2139 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _deadVars -> (case (({-# LINE 298 "src/GLuaFixer/AG/ASTLint.ag" #-} lint_maxScopeDepth _lhsIconfig {-# LINE 2144 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _maxScopeDepth -> (case (({-# LINE 302 "src/GLuaFixer/AG/ASTLint.ag" #-} if _maxScopeDepth == 0 || _lhsIscopeLevel /= _maxScopeDepth then id else (:) $ warn _statsImtokenPos ScopePyramids {-# LINE 2150 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f2 -> (case (({-# LINE 302 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_unusedVars _lhsIconfig) || _lhsIisRepeat then id else (++) $ M.foldrWithKey (\k (_, pos) ls -> warn pos (UnusedVariable k) : ls) [] _deadVars {-# LINE 2156 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 302 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1, _warnings_augmented_f2] {-# LINE 2161 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOstatementCount,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Block_Block_1)) of { ( sem_Block_1) -> ( _lhsOcopy,sem_Block_1) }) }) }) }) }) -- Declaration ------------------------------------------------- -- cata sem_Declaration :: Declaration -> T_Declaration sem_Declaration ( x1,x2) = (sem_Declaration_Tuple (sem_PrefixExp x1) (sem_MaybeMExpr x2)) -- semantic domain type T_Declaration = ( Declaration,T_Declaration_1) type T_Declaration_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_Declaration = Inh_Declaration {config_Inh_Declaration :: LintSettings,funcName_Inh_Declaration :: String,globalDefinitions_Inh_Declaration :: (M.Map String [Region]),isInModule_Inh_Declaration :: Bool,isMeta_Inh_Declaration :: Bool,localDefinition_Inh_Declaration :: Bool,loopLevel_Inh_Declaration :: Int,mtokenPos_Inh_Declaration :: Region,scopeLevel_Inh_Declaration :: Int,scopes_Inh_Declaration :: ([M.Map String (Bool, Region)]),variableStyle_Inh_Declaration :: DeterminedVariableStyle} data Syn_Declaration = Syn_Declaration {copy_Syn_Declaration :: Declaration,globalDefinitions_Syn_Declaration :: (M.Map String [Region]),identifier_Syn_Declaration :: String,isInModule_Syn_Declaration :: Bool,mtokenPos_Syn_Declaration :: Region,scopes_Syn_Declaration :: ([M.Map String (Bool, Region)]),variableStyle_Syn_Declaration :: DeterminedVariableStyle,warnings_Syn_Declaration :: ([String -> LintMessage])} wrap_Declaration :: T_Declaration -> Inh_Declaration -> Syn_Declaration wrap_Declaration sem (Inh_Declaration _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIlocalDefinition _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIlocalDefinition _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_Declaration _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_Declaration_Tuple :: T_PrefixExp -> T_MaybeMExpr -> T_Declaration sem_Declaration_Tuple x1_ x2_ = (case (x2_) of { ( _x2Icopy,x2_1) -> (case (x1_) of { ( _x1Icopy,_x1IhasSuffixes,_x1ImtokenPos,_x1IvarName,x1_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} (_x1Icopy,_x2Icopy) {-# LINE 2207 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 2212 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Declaration_Tuple_1 :: T_Declaration_1 sem_Declaration_Tuple_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIlocalDefinition _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 2230 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 2235 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1Oconfig -> (case (({-# LINE 267 "src/GLuaFixer/AG/ASTLint.ag" #-} tokenLabel . fromMaybe (error "fromMaybe sem Declaration loc.var") $ _x1IvarName {-# LINE 2240 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _var -> (case (({-# LINE 275 "src/GLuaFixer/AG/ASTLint.ag" #-} if _lhsIlocalDefinition then M.insert _var (False, _x1ImtokenPos) (head _lhsIscopes) : tail _lhsIscopes else if isJust _x1IvarName then registerVariable _lhsIscopes _x1ImtokenPos _var _x1IhasSuffixes else _lhsIscopes {-# LINE 2250 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1Oscopes -> (case (({-# LINE 263 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 2255 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OvarBeingDefined -> (case (({-# LINE 259 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 2260 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OregisterVarUse -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 2265 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 2270 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 2275 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 2280 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OloopLevel -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 2285 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 2290 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 2295 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OfuncName -> (case (({-# LINE 261 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 2300 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OtopLevel -> (case (({-# LINE 260 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 2305 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OinParentheses -> (case (({-# LINE 258 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 2310 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OisNegation -> (case (x1_1 _x1Oconfig _x1OfuncName _x1OglobalDefinitions _x1OinParentheses _x1OisInModule _x1OisMeta _x1OisNegation _x1OloopLevel _x1OmtokenPos _x1OregisterVarUse _x1OscopeLevel _x1Oscopes _x1OtopLevel _x1OvarBeingDefined _x1OvariableStyle) of { ( _x1IglobalDefinitions,_x1Iidentifier,_x1IisInModule,_x1IisSimpleExpression,_x1IisSingleVar,_x1Iscopes,_x1IvariableStyle,_x1Iwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _x1Iscopes {-# LINE 2317 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2Oscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 2322 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _x1IisInModule {-# LINE 2327 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _x1IglobalDefinitions {-# LINE 2332 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 2337 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2Oconfig -> (case (({-# LINE 265 "src/GLuaFixer/AG/ASTLint.ag" #-} if _x1IhasSuffixes || not _lhsIlocalDefinition then Nothing else _x1IvarName {-# LINE 2342 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OvarBeingDefined -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _x1IvariableStyle {-# LINE 2347 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 2352 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _x1ImtokenPos {-# LINE 2357 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 2362 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 2367 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OfuncName -> (case (({-# LINE 262 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 2372 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OisNegation -> (case (x2_1 _x2Oconfig _x2OfuncName _x2OglobalDefinitions _x2OisInModule _x2OisMeta _x2OisNegation _x2OloopLevel _x2OmtokenPos _x2OscopeLevel _x2Oscopes _x2OvarBeingDefined _x2OvariableStyle) of { ( _x2IglobalDefinitions,_x2Iidentifier,_x2IisInModule,_x2IisSingleVar,_x2ImtokenPos,_x2Iscopes,_x2IvariableStyle,_x2Iwarnings) -> (case (({-# LINE 282 "src/GLuaFixer/AG/ASTLint.ag" #-} _x2IglobalDefinitions {-# LINE 2379 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _globalDefinitions_augmented_syn -> (case (({-# LINE 282 "src/GLuaFixer/AG/ASTLint.ag" #-} if _lhsIisInModule || _lhsIlocalDefinition || isVariableLocal _lhsIscopes _var || _x1IhasSuffixes then id else M.insertWith (++) _var [_x1ImtokenPos] {-# LINE 2385 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _globalDefinitions_augmented_f1 -> (case (({-# LINE 282 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _globalDefinitions_augmented_syn [_globalDefinitions_augmented_f1] {-# LINE 2390 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _x1Iidentifier _x2Iidentifier) {-# LINE 2395 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _x2IisInModule {-# LINE 2400 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 256 "src/GLuaFixer/AG/ASTLint.ag" #-} _x1ImtokenPos {-# LINE 2405 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _x2Iscopes {-# LINE 2410 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 268 "src/GLuaFixer/AG/ASTLint.ag" #-} determineVariableStyle _var {-# LINE 2415 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varStyle -> (case (({-# LINE 257 "src/GLuaFixer/AG/ASTLint.ag" #-} if _lhsIlocalDefinition then combineDeterminedVarStyle _lhsIvariableStyle _varStyle else _lhsIvariableStyle {-# LINE 2420 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 287 "src/GLuaFixer/AG/ASTLint.ag" #-} _x1Iwarnings ++ _x2Iwarnings {-# LINE 2425 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 269 "src/GLuaFixer/AG/ASTLint.ag" #-} do var <- _x1IvarName if (Just var /= _x2IisSingleVar) then checkShadows _lhsIscopes var else Nothing {-# LINE 2434 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _shadowWarning -> (case (({-# LINE 287 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_shadowing _lhsIconfig) || not _lhsIlocalDefinition || isNothing _shadowWarning then id else (:) . fromMaybe (error "fromMaybe sem Declaration +warnings") $ _shadowWarning {-# LINE 2440 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f2 -> (case (({-# LINE 287 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_inconsistentVariableStyle _lhsIconfig) || not _lhsIlocalDefinition || not (variableStyleInconsistent _lhsIvariableStyle _varStyle ) then id else (:) $ warn _x1ImtokenPos InconsistentVariableNaming {-# LINE 2446 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 287 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1, _warnings_augmented_f2] {-# LINE 2451 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Declaration_Tuple_1)) of { ( sem_Declaration_1) -> ( _lhsOcopy,sem_Declaration_1) }) }) }) }) }) -- Else -------------------------------------------------------- -- cata sem_Else :: Else -> T_Else sem_Else (Prelude.Just x) = (sem_Else_Just (sem_MElse x)) sem_Else Prelude.Nothing = sem_Else_Nothing -- semantic domain type T_Else = ( Else,T_Else_1) type T_Else_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( Bool,(M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_Else = Inh_Else {config_Inh_Else :: LintSettings,funcName_Inh_Else :: String,globalDefinitions_Inh_Else :: (M.Map String [Region]),isInModule_Inh_Else :: Bool,isMeta_Inh_Else :: Bool,loopLevel_Inh_Else :: Int,mtokenPos_Inh_Else :: Region,scopeLevel_Inh_Else :: Int,scopes_Inh_Else :: ([M.Map String (Bool, Region)]),variableStyle_Inh_Else :: DeterminedVariableStyle} data Syn_Else = Syn_Else {copy_Syn_Else :: Else,elseExists_Syn_Else :: Bool,globalDefinitions_Syn_Else :: (M.Map String [Region]),identifier_Syn_Else :: String,isInModule_Syn_Else :: Bool,mtokenPos_Syn_Else :: Region,scopes_Syn_Else :: ([M.Map String (Bool, Region)]),variableStyle_Syn_Else :: DeterminedVariableStyle,warnings_Syn_Else :: ([String -> LintMessage])} wrap_Else :: T_Else -> Inh_Else -> Syn_Else wrap_Else sem (Inh_Else _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOelseExists,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_Else _lhsOcopy _lhsOelseExists _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_Else_Just :: T_MElse -> T_Else sem_Else_Just just_ = (case (just_) of { ( _justIcopy,just_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Just _justIcopy {-# LINE 2495 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 2500 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Else_Just_1 :: T_Else_1 sem_Else_Just_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 485 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 2517 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOelseExists -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 2522 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 2527 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 2532 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 2537 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOconfig -> (case (({-# LINE 484 "src/GLuaFixer/AG/ASTLint.ag" #-} M.empty : _lhsIscopes {-# LINE 2542 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 2547 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 2552 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 2557 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 2562 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 2567 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOfuncName -> (case (just_1 _justOconfig _justOfuncName _justOglobalDefinitions _justOisInModule _justOisMeta _justOloopLevel _justOmtokenPos _justOscopeLevel _justOscopes _justOvariableStyle) of { ( _justIelseExists,_justIglobalDefinitions,_justIidentifier,_justIisInModule,_justImtokenPos,_justIscopes,_justIstatementCount,_justIvariableStyle,_justIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _justIglobalDefinitions {-# LINE 2574 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _justIidentifier {-# LINE 2579 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _justIisInModule {-# LINE 2584 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _justImtokenPos {-# LINE 2589 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _justIscopes {-# LINE 2594 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _justIvariableStyle {-# LINE 2599 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 487 "src/GLuaFixer/AG/ASTLint.ag" #-} _justIwarnings {-# LINE 2604 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 486 "src/GLuaFixer/AG/ASTLint.ag" #-} Region (rgStart _justImtokenPos) (customAdvanceToken (rgStart _justImtokenPos) T.Else) {-# LINE 2609 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keywordPos -> (case (({-# LINE 487 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_emptyBlocks _lhsIconfig) || _justIstatementCount > 0 then id else (:) $ warn _keywordPos EmptyElse {-# LINE 2615 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 487 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 2620 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOelseExists,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Else_Just_1)) of { ( sem_Else_1) -> ( _lhsOcopy,sem_Else_1) }) }) }) }) sem_Else_Nothing :: T_Else sem_Else_Nothing = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 2631 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 2636 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Else_Nothing_1 :: T_Else_1 sem_Else_Nothing_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 202 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 2653 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOelseExists -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 2658 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 2663 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 2668 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 2673 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 2678 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 2683 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 2688 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOelseExists,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) })) in sem_Else_Nothing_1)) of { ( sem_Else_1) -> ( _lhsOcopy,sem_Else_1) }) }) }) -- ElseIf ------------------------------------------------------ -- cata sem_ElseIf :: ElseIf -> T_ElseIf sem_ElseIf ( x1,x2) = (sem_ElseIf_Tuple (sem_MExpr x1) (sem_Block x2)) -- semantic domain type T_ElseIf = ( ElseIf,T_ElseIf_1) type T_ElseIf_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_ElseIf = Inh_ElseIf {config_Inh_ElseIf :: LintSettings,funcName_Inh_ElseIf :: String,globalDefinitions_Inh_ElseIf :: (M.Map String [Region]),isInModule_Inh_ElseIf :: Bool,isMeta_Inh_ElseIf :: Bool,loopLevel_Inh_ElseIf :: Int,mtokenPos_Inh_ElseIf :: Region,scopeLevel_Inh_ElseIf :: Int,scopes_Inh_ElseIf :: ([M.Map String (Bool, Region)]),variableStyle_Inh_ElseIf :: DeterminedVariableStyle} data Syn_ElseIf = Syn_ElseIf {copy_Syn_ElseIf :: ElseIf,globalDefinitions_Syn_ElseIf :: (M.Map String [Region]),identifier_Syn_ElseIf :: String,isInModule_Syn_ElseIf :: Bool,mtokenPos_Syn_ElseIf :: Region,scopes_Syn_ElseIf :: ([M.Map String (Bool, Region)]),variableStyle_Syn_ElseIf :: DeterminedVariableStyle,warnings_Syn_ElseIf :: ([String -> LintMessage])} wrap_ElseIf :: T_ElseIf -> Inh_ElseIf -> Syn_ElseIf wrap_ElseIf sem (Inh_ElseIf _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_ElseIf _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_ElseIf_Tuple :: T_MExpr -> T_Block -> T_ElseIf sem_ElseIf_Tuple x1_ x2_ = (case (x2_) of { ( _x2Icopy,x2_1) -> (case (x1_) of { ( _x1Icopy,_x1ImtokenPos,x1_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} (_x1Icopy,_x2Icopy) {-# LINE 2733 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 2738 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_ElseIf_Tuple_1 :: T_ElseIf_1 sem_ElseIf_Tuple_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 2755 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 2760 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OisInModule -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 2765 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 2770 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1Oscopes -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 2775 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 2780 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 2785 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OloopLevel -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 2790 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OisMeta -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 2795 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 2800 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 2805 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1Oconfig -> (case (({-# LINE 470 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 2810 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OvarBeingDefined -> (case (({-# LINE 469 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 2815 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OtopLevel -> (case (({-# LINE 468 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 2820 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OinParentheses -> (case (({-# LINE 467 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 2825 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x1OisNegation -> (case (x1_1 _x1Oconfig _x1OfuncName _x1OglobalDefinitions _x1OinParentheses _x1OisInModule _x1OisMeta _x1OisNegation _x1OloopLevel _x1OmtokenPos _x1OscopeLevel _x1Oscopes _x1OtopLevel _x1OvarBeingDefined _x1OvariableStyle) of { ( _x1IglobalDefinitions,_x1Iidentifier,_x1IisInModule,_x1IisSimpleExpression,_x1IisSingleVar,_x1Iscopes,_x1IvariableStyle,_x1Iwarnings) -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _x1IisInModule {-# LINE 2832 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _x1IglobalDefinitions {-# LINE 2837 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 2842 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2Oconfig -> (case (({-# LINE 471 "src/GLuaFixer/AG/ASTLint.ag" #-} M.empty : _x1Iscopes {-# LINE 2847 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2Oscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _x1IvariableStyle {-# LINE 2852 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 2857 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _x1ImtokenPos {-# LINE 2862 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 2867 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 2872 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OfuncName -> (case (({-# LINE 472 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 2877 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _x2OisRepeat -> (case (x2_1 _x2Oconfig _x2OfuncName _x2OglobalDefinitions _x2OisInModule _x2OisMeta _x2OisRepeat _x2OloopLevel _x2OmtokenPos _x2OscopeLevel _x2Oscopes _x2OvariableStyle) of { ( _x2IglobalDefinitions,_x2Iidentifier,_x2IisIfStatement,_x2IisInModule,_x2ImtokenPos,_x2Iscopes,_x2IstatementCount,_x2IvariableStyle,_x2Iwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _x2IglobalDefinitions {-# LINE 2884 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _x1Iidentifier _x2Iidentifier) {-# LINE 2889 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _x2IisInModule {-# LINE 2894 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _x2ImtokenPos {-# LINE 2899 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _x2Iscopes {-# LINE 2904 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _x2IvariableStyle {-# LINE 2909 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 474 "src/GLuaFixer/AG/ASTLint.ag" #-} _x1Iwarnings ++ _x2Iwarnings {-# LINE 2914 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 473 "src/GLuaFixer/AG/ASTLint.ag" #-} Region (rgStart _lhsImtokenPos) (customAdvanceToken (rgStart _lhsImtokenPos) T.Elseif) {-# LINE 2919 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keywordPos -> (case (({-# LINE 474 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_emptyBlocks _lhsIconfig) || _x2IstatementCount > 0 then id else (:) $ warn _keywordPos EmptyElseIf {-# LINE 2925 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 474 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 2930 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_ElseIf_Tuple_1)) of { ( sem_ElseIf_1) -> ( _lhsOcopy,sem_ElseIf_1) }) }) }) }) }) -- ElseIfList -------------------------------------------------- -- cata sem_ElseIfList :: ElseIfList -> T_ElseIfList sem_ElseIfList list = (Prelude.foldr sem_ElseIfList_Cons sem_ElseIfList_Nil (Prelude.map sem_MElseIf list)) -- semantic domain type T_ElseIfList = ( ElseIfList,T_ElseIfList_1) type T_ElseIfList_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( Bool,(M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_ElseIfList = Inh_ElseIfList {config_Inh_ElseIfList :: LintSettings,funcName_Inh_ElseIfList :: String,globalDefinitions_Inh_ElseIfList :: (M.Map String [Region]),isInModule_Inh_ElseIfList :: Bool,isMeta_Inh_ElseIfList :: Bool,loopLevel_Inh_ElseIfList :: Int,mtokenPos_Inh_ElseIfList :: Region,scopeLevel_Inh_ElseIfList :: Int,scopes_Inh_ElseIfList :: ([M.Map String (Bool, Region)]),variableStyle_Inh_ElseIfList :: DeterminedVariableStyle} data Syn_ElseIfList = Syn_ElseIfList {copy_Syn_ElseIfList :: ElseIfList,elseExists_Syn_ElseIfList :: Bool,globalDefinitions_Syn_ElseIfList :: (M.Map String [Region]),identifier_Syn_ElseIfList :: String,isInModule_Syn_ElseIfList :: Bool,mtokenPos_Syn_ElseIfList :: Region,scopes_Syn_ElseIfList :: ([M.Map String (Bool, Region)]),variableStyle_Syn_ElseIfList :: DeterminedVariableStyle,warnings_Syn_ElseIfList :: ([String -> LintMessage])} wrap_ElseIfList :: T_ElseIfList -> Inh_ElseIfList -> Syn_ElseIfList wrap_ElseIfList sem (Inh_ElseIfList _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOelseExists,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_ElseIfList _lhsOcopy _lhsOelseExists _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_ElseIfList_Cons :: T_MElseIf -> T_ElseIfList -> T_ElseIfList sem_ElseIfList_Cons hd_ tl_ = (case (tl_) of { ( _tlIcopy,tl_1) -> (case (hd_) of { ( _hdIcopy,hd_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} (:) _hdIcopy _tlIcopy {-# LINE 2975 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 2980 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_ElseIfList_Cons_1 :: T_ElseIfList_1 sem_ElseIfList_Cons_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 459 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 2997 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOelseExists -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 3002 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 3007 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 3012 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 3017 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 3022 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 3027 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 3032 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOloopLevel -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 3037 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 3042 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 3047 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOfuncName -> (case (hd_1 _hdOconfig _hdOfuncName _hdOglobalDefinitions _hdOisInModule _hdOisMeta _hdOloopLevel _hdOmtokenPos _hdOscopeLevel _hdOscopes _hdOvariableStyle) of { ( _hdIglobalDefinitions,_hdIidentifier,_hdIisInModule,_hdImtokenPos,_hdIscopes,_hdIvariableStyle,_hdIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIscopes {-# LINE 3054 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 3059 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIisInModule {-# LINE 3064 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIglobalDefinitions {-# LINE 3069 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 3074 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIvariableStyle {-# LINE 3079 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 3084 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdImtokenPos {-# LINE 3089 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 3094 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 3099 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOfuncName -> (case (tl_1 _tlOconfig _tlOfuncName _tlOglobalDefinitions _tlOisInModule _tlOisMeta _tlOloopLevel _tlOmtokenPos _tlOscopeLevel _tlOscopes _tlOvariableStyle) of { ( _tlIelseExists,_tlIglobalDefinitions,_tlIidentifier,_tlIisInModule,_tlImtokenPos,_tlIscopes,_tlIvariableStyle,_tlIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIglobalDefinitions {-# LINE 3106 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _hdIidentifier _tlIidentifier) {-# LINE 3111 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIisInModule {-# LINE 3116 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlImtokenPos {-# LINE 3121 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIscopes {-# LINE 3126 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIvariableStyle {-# LINE 3131 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIwarnings ++ _tlIwarnings {-# LINE 3136 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOelseExists,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_ElseIfList_Cons_1)) of { ( sem_ElseIfList_1) -> ( _lhsOcopy,sem_ElseIfList_1) }) }) }) }) }) sem_ElseIfList_Nil :: T_ElseIfList sem_ElseIfList_Nil = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 3147 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 3152 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_ElseIfList_Nil_1 :: T_ElseIfList_1 sem_ElseIfList_Nil_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 202 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 3169 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOelseExists -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 3174 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 3179 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 3184 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 3189 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 3194 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 3199 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 3204 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOelseExists,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) })) in sem_ElseIfList_Nil_1)) of { ( sem_ElseIfList_1) -> ( _lhsOcopy,sem_ElseIfList_1) }) }) }) -- Expr -------------------------------------------------------- -- cata sem_Expr :: Expr -> T_Expr sem_Expr (ANil) = (sem_Expr_ANil) sem_Expr (AFalse) = (sem_Expr_AFalse) sem_Expr (ATrue) = (sem_Expr_ATrue) sem_Expr (ANumber _num) = (sem_Expr_ANumber _num) sem_Expr (AString _str) = (sem_Expr_AString (sem_MToken _str)) sem_Expr (AVarArg) = (sem_Expr_AVarArg) sem_Expr (AnonymousFunc _pars _body) = (sem_Expr_AnonymousFunc _pars (sem_Block _body)) sem_Expr (APrefixExpr _pexpr) = (sem_Expr_APrefixExpr (sem_PrefixExp _pexpr)) sem_Expr (ATableConstructor _fields) = (sem_Expr_ATableConstructor (sem_FieldList _fields)) sem_Expr (BinOpExpr _op _left _right) = (sem_Expr_BinOpExpr (sem_BinOp _op) (sem_MExpr _left) (sem_MExpr _right)) sem_Expr (UnOpExpr _op _right) = (sem_Expr_UnOpExpr (sem_UnOp _op) (sem_MExpr _right)) -- semantic domain type T_Expr = ( Expr,T_Expr_1) type T_Expr_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> Bool -> (Maybe MToken) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Bool,(Maybe MToken),Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_Expr = Inh_Expr {config_Inh_Expr :: LintSettings,funcName_Inh_Expr :: String,globalDefinitions_Inh_Expr :: (M.Map String [Region]),inParentheses_Inh_Expr :: Bool,isInModule_Inh_Expr :: Bool,isMeta_Inh_Expr :: Bool,isNegation_Inh_Expr :: Bool,loopLevel_Inh_Expr :: Int,mtokenPos_Inh_Expr :: Region,scopeLevel_Inh_Expr :: Int,scopes_Inh_Expr :: ([M.Map String (Bool, Region)]),topLevel_Inh_Expr :: Bool,varBeingDefined_Inh_Expr :: (Maybe MToken),variableStyle_Inh_Expr :: DeterminedVariableStyle} data Syn_Expr = Syn_Expr {copy_Syn_Expr :: Expr,globalDefinitions_Syn_Expr :: (M.Map String [Region]),identifier_Syn_Expr :: String,isInModule_Syn_Expr :: Bool,isSimpleExpression_Syn_Expr :: Bool,isSingleVar_Syn_Expr :: (Maybe MToken),mtokenPos_Syn_Expr :: Region,scopes_Syn_Expr :: ([M.Map String (Bool, Region)]),variableStyle_Syn_Expr :: DeterminedVariableStyle,warnings_Syn_Expr :: ([String -> LintMessage])} wrap_Expr :: T_Expr -> Inh_Expr -> Syn_Expr wrap_Expr sem (Inh_Expr _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle in (Syn_Expr _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOisSimpleExpression _lhsOisSingleVar _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_Expr_ANil :: T_Expr sem_Expr_ANil = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ANil {-# LINE 3267 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 3272 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Expr_ANil_1 :: T_Expr_1 sem_Expr_ANil_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 3293 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 3298 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 3303 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 3308 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 3313 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 3318 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 3323 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 3328 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 3333 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) })) in sem_Expr_ANil_1)) of { ( sem_Expr_1) -> ( _lhsOcopy,sem_Expr_1) }) }) }) sem_Expr_AFalse :: T_Expr sem_Expr_AFalse = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AFalse {-# LINE 3344 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 3349 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Expr_AFalse_1 :: T_Expr_1 sem_Expr_AFalse_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 3370 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 3375 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 3380 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 3385 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 3390 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 3395 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 3400 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 3405 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 3410 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) })) in sem_Expr_AFalse_1)) of { ( sem_Expr_1) -> ( _lhsOcopy,sem_Expr_1) }) }) }) sem_Expr_ATrue :: T_Expr sem_Expr_ATrue = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ATrue {-# LINE 3421 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 3426 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Expr_ATrue_1 :: T_Expr_1 sem_Expr_ATrue_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 3447 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 3452 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 3457 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 3462 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 3467 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 3472 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 3477 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 3482 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 3487 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) })) in sem_Expr_ATrue_1)) of { ( sem_Expr_1) -> ( _lhsOcopy,sem_Expr_1) }) }) }) sem_Expr_ANumber :: String -> T_Expr sem_Expr_ANumber num_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ANumber num_ {-# LINE 3499 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 3504 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Expr_ANumber_1 :: T_Expr_1 sem_Expr_ANumber_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 3525 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 3530 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 3535 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 3540 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 3545 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 3550 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 3555 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 3560 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 3565 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) })) in sem_Expr_ANumber_1)) of { ( sem_Expr_1) -> ( _lhsOcopy,sem_Expr_1) }) }) }) sem_Expr_AString :: T_MToken -> T_Expr sem_Expr_AString str_ = (case (str_) of { ( _strIcopy,_strImtok,_strImtokenPos,str_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AString _strIcopy {-# LINE 3579 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 3584 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Expr_AString_1 :: T_Expr_1 sem_Expr_AString_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 3605 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _strOglobalDefinitions -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 3610 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _strOscopes -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 3615 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _strOmtokenPos -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 3620 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _strOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 3625 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _strOisInModule -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 3630 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _strOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 3635 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _strOconfig -> (case (str_1 _strOconfig _strOfuncName _strOglobalDefinitions _strOisInModule _strOisMeta _strOmtokenPos _strOscopes) of { ( _strIglobalDefinitions,_strIidentifier,_strIisInModule,_strIscopes,_strIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _strIglobalDefinitions {-# LINE 3642 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _strIidentifier {-# LINE 3647 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _strIisInModule {-# LINE 3652 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 3657 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 3662 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _strImtokenPos {-# LINE 3667 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _strIscopes {-# LINE 3672 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 3677 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _strIwarnings {-# LINE 3682 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Expr_AString_1)) of { ( sem_Expr_1) -> ( _lhsOcopy,sem_Expr_1) }) }) }) }) sem_Expr_AVarArg :: T_Expr sem_Expr_AVarArg = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AVarArg {-# LINE 3693 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 3698 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Expr_AVarArg_1 :: T_Expr_1 sem_Expr_AVarArg_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 3719 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 3724 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 3729 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 567 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 3734 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 3739 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 3744 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 3749 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 3754 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 3759 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) })) in sem_Expr_AVarArg_1)) of { ( sem_Expr_1) -> ( _lhsOcopy,sem_Expr_1) }) }) }) sem_Expr_AnonymousFunc :: ([MToken]) -> T_Block -> T_Expr sem_Expr_AnonymousFunc pars_ body_ = (case (body_) of { ( _bodyIcopy,body_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AnonymousFunc pars_ _bodyIcopy {-# LINE 3774 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 3779 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Expr_AnonymousFunc_1 :: T_Expr_1 sem_Expr_AnonymousFunc_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 3800 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 3805 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 3810 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOconfig -> (case (({-# LINE 572 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta || findSelf pars_ {-# LINE 3815 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisMeta -> (case (({-# LINE 569 "src/GLuaFixer/AG/ASTLint.ag" #-} M.fromList $ map (\mt -> (tokenLabel mt, (not . lint_unusedParameters $ _lhsIconfig, mpos mt))) pars_ {-# LINE 3820 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _introduces -> (case (({-# LINE 570 "src/GLuaFixer/AG/ASTLint.ag" #-} _introduces : _lhsIscopes {-# LINE 3825 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 3830 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 3835 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 3840 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 3845 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 3850 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOfuncName -> (case (({-# LINE 571 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 3855 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisRepeat -> (case (body_1 _bodyOconfig _bodyOfuncName _bodyOglobalDefinitions _bodyOisInModule _bodyOisMeta _bodyOisRepeat _bodyOloopLevel _bodyOmtokenPos _bodyOscopeLevel _bodyOscopes _bodyOvariableStyle) of { ( _bodyIglobalDefinitions,_bodyIidentifier,_bodyIisIfStatement,_bodyIisInModule,_bodyImtokenPos,_bodyIscopes,_bodyIstatementCount,_bodyIvariableStyle,_bodyIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIglobalDefinitions {-# LINE 3862 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIidentifier {-# LINE 3867 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIisInModule {-# LINE 3872 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 3877 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 3882 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyImtokenPos {-# LINE 3887 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIscopes {-# LINE 3892 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIvariableStyle {-# LINE 3897 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 575 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIwarnings {-# LINE 3902 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 573 "src/GLuaFixer/AG/ASTLint.ag" #-} filter (/= MToken emptyRg VarArg) $ pars_ {-# LINE 3907 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argIdentifiers -> (case (({-# LINE 575 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_shadowing _lhsIconfig) then id else (++) . catMaybes . map (checkShadows _lhsIscopes) $ _argIdentifiers {-# LINE 3913 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 575 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 3918 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Expr_AnonymousFunc_1)) of { ( sem_Expr_1) -> ( _lhsOcopy,sem_Expr_1) }) }) }) }) sem_Expr_APrefixExpr :: T_PrefixExp -> T_Expr sem_Expr_APrefixExpr pexpr_ = (case (pexpr_) of { ( _pexprIcopy,_pexprIhasSuffixes,_pexprImtokenPos,_pexprIvarName,pexpr_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} APrefixExpr _pexprIcopy {-# LINE 3932 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 3937 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Expr_APrefixExpr_1 :: T_Expr_1 sem_Expr_APrefixExpr_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 178 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvarBeingDefined {-# LINE 3958 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOvarBeingDefined -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 3963 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 3968 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 3973 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 3978 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 3983 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOconfig -> (case (({-# LINE 578 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 3988 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOregisterVarUse -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 3993 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOvariableStyle -> (case (({-# LINE 182 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsItopLevel {-# LINE 3998 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOtopLevel -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 4003 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 4008 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 4013 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOloopLevel -> (case (({-# LINE 169 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisNegation {-# LINE 4018 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOisNegation -> (case (({-# LINE 181 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIinParentheses {-# LINE 4023 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOinParentheses -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 4028 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _pexprOfuncName -> (case (pexpr_1 _pexprOconfig _pexprOfuncName _pexprOglobalDefinitions _pexprOinParentheses _pexprOisInModule _pexprOisMeta _pexprOisNegation _pexprOloopLevel _pexprOmtokenPos _pexprOregisterVarUse _pexprOscopeLevel _pexprOscopes _pexprOtopLevel _pexprOvarBeingDefined _pexprOvariableStyle) of { ( _pexprIglobalDefinitions,_pexprIidentifier,_pexprIisInModule,_pexprIisSimpleExpression,_pexprIisSingleVar,_pexprIscopes,_pexprIvariableStyle,_pexprIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _pexprIglobalDefinitions {-# LINE 4035 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _pexprIidentifier {-# LINE 4040 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _pexprIisInModule {-# LINE 4045 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} _pexprIisSimpleExpression {-# LINE 4050 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} _pexprIisSingleVar {-# LINE 4055 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _pexprImtokenPos {-# LINE 4060 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _pexprIscopes {-# LINE 4065 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _pexprIvariableStyle {-# LINE 4070 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _pexprIwarnings {-# LINE 4075 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Expr_APrefixExpr_1)) of { ( sem_Expr_1) -> ( _lhsOcopy,sem_Expr_1) }) }) }) }) sem_Expr_ATableConstructor :: T_FieldList -> T_Expr sem_Expr_ATableConstructor fields_ = (case (fields_) of { ( _fieldsIcopy,fields_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ATableConstructor _fieldsIcopy {-# LINE 4089 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 4094 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Expr_ATableConstructor_1 :: T_Expr_1 sem_Expr_ATableConstructor_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 4115 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fieldsOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 4120 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fieldsOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 4125 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fieldsOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 4130 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fieldsOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 4135 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fieldsOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 4140 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fieldsOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 4145 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fieldsOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 4150 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fieldsOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 4155 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fieldsOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 4160 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fieldsOfuncName -> (case (({-# LINE 580 "src/GLuaFixer/AG/ASTLint.ag" #-} S.empty {-# LINE 4165 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fieldsOfieldNames -> (case (fields_1 _fieldsOconfig _fieldsOfieldNames _fieldsOfuncName _fieldsOglobalDefinitions _fieldsOisInModule _fieldsOisMeta _fieldsOloopLevel _fieldsOmtokenPos _fieldsOscopeLevel _fieldsOscopes _fieldsOvariableStyle) of { ( _fieldsIfieldNames,_fieldsIglobalDefinitions,_fieldsIidentifier,_fieldsIisInModule,_fieldsImtokenPos,_fieldsIscopes,_fieldsIvariableStyle,_fieldsIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _fieldsIglobalDefinitions {-# LINE 4172 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _fieldsIidentifier {-# LINE 4177 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _fieldsIisInModule {-# LINE 4182 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 4187 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 4192 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _fieldsImtokenPos {-# LINE 4197 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _fieldsIscopes {-# LINE 4202 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _fieldsIvariableStyle {-# LINE 4207 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _fieldsIwarnings {-# LINE 4212 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Expr_ATableConstructor_1)) of { ( sem_Expr_1) -> ( _lhsOcopy,sem_Expr_1) }) }) }) }) sem_Expr_BinOpExpr :: T_BinOp -> T_MExpr -> T_MExpr -> T_Expr sem_Expr_BinOpExpr op_ left_ right_ = (case (right_) of { ( _rightIcopy,_rightImtokenPos,right_1) -> (case (left_) of { ( _leftIcopy,_leftImtokenPos,left_1) -> (case (op_) of { ( _opIcopy,op_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} BinOpExpr _opIcopy _leftIcopy _rightIcopy {-# LINE 4232 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 4237 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Expr_BinOpExpr_1 :: T_Expr_1 sem_Expr_BinOpExpr_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 4258 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 4263 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 4268 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 4273 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 4278 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOloopLevel -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 4283 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 4288 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 4293 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 4298 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 4303 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOconfig -> (case (op_1 _opOconfig _opOfuncName _opOglobalDefinitions _opOisInModule _opOisMeta _opOloopLevel _opOmtokenPos _opOscopeLevel _opOscopes _opOvariableStyle) of { ( _opIglobalDefinitions,_opIidentifier,_opIisInModule,_opImtokenPos,_opIscopes,_opIvariableStyle,_opIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _opIscopes {-# LINE 4310 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 4315 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 4320 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOconfig -> (case (({-# LINE 586 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 4325 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOvarBeingDefined -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _opIvariableStyle {-# LINE 4330 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 4335 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _opImtokenPos {-# LINE 4340 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 4345 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOloopLevel -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _opIisInModule {-# LINE 4350 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _opIglobalDefinitions {-# LINE 4355 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 4360 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOfuncName -> (case (({-# LINE 585 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 4365 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOtopLevel -> (case (({-# LINE 584 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 4370 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOinParentheses -> (case (({-# LINE 583 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 4375 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _leftOisNegation -> (case (left_1 _leftOconfig _leftOfuncName _leftOglobalDefinitions _leftOinParentheses _leftOisInModule _leftOisMeta _leftOisNegation _leftOloopLevel _leftOmtokenPos _leftOscopeLevel _leftOscopes _leftOtopLevel _leftOvarBeingDefined _leftOvariableStyle) of { ( _leftIglobalDefinitions,_leftIidentifier,_leftIisInModule,_leftIisSimpleExpression,_leftIisSingleVar,_leftIscopes,_leftIvariableStyle,_leftIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _leftIscopes {-# LINE 4382 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 4387 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _leftIisInModule {-# LINE 4392 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _leftIglobalDefinitions {-# LINE 4397 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 4402 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOconfig -> (case (({-# LINE 590 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 4407 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOvarBeingDefined -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _leftIvariableStyle {-# LINE 4412 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 4417 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _leftImtokenPos {-# LINE 4422 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 4427 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 4432 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOfuncName -> (case (({-# LINE 589 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 4437 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOtopLevel -> (case (({-# LINE 588 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 4442 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOinParentheses -> (case (({-# LINE 587 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 4447 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOisNegation -> (case (right_1 _rightOconfig _rightOfuncName _rightOglobalDefinitions _rightOinParentheses _rightOisInModule _rightOisMeta _rightOisNegation _rightOloopLevel _rightOmtokenPos _rightOscopeLevel _rightOscopes _rightOtopLevel _rightOvarBeingDefined _rightOvariableStyle) of { ( _rightIglobalDefinitions,_rightIidentifier,_rightIisInModule,_rightIisSimpleExpression,_rightIisSingleVar,_rightIscopes,_rightIvariableStyle,_rightIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _rightIglobalDefinitions {-# LINE 4454 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _opIidentifier (const _leftIidentifier _rightIidentifier)) {-# LINE 4459 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _rightIisInModule {-# LINE 4464 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 582 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 4469 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} (const (const Nothing) _leftIisSingleVar _rightIisSingleVar) {-# LINE 4474 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _rightImtokenPos {-# LINE 4479 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _rightIscopes {-# LINE 4484 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _rightIvariableStyle {-# LINE 4489 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 594 "src/GLuaFixer/AG/ASTLint.ag" #-} _opIwarnings ++ _leftIwarnings ++ _rightIwarnings {-# LINE 4494 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 593 "src/GLuaFixer/AG/ASTLint.ag" #-} oppositeBinOp _opIcopy {-# LINE 4499 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stupidNegation -> (case (({-# LINE 594 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_doubleNegations _lhsIconfig) || not _lhsIisNegation || isNothing _stupidNegation then id else (:) $ warn _lhsImtokenPos $ SillyNegation$ fromMaybe (error "fromMaybe sem Expr loc.stupidNegation") _stupidNegation {-# LINE 4505 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 594 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 4510 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Expr_BinOpExpr_1)) of { ( sem_Expr_1) -> ( _lhsOcopy,sem_Expr_1) }) }) }) }) }) }) sem_Expr_UnOpExpr :: T_UnOp -> T_MExpr -> T_Expr sem_Expr_UnOpExpr op_ right_ = (case (right_) of { ( _rightIcopy,_rightImtokenPos,right_1) -> (case (op_) of { ( _opIcopy,op_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} UnOpExpr _opIcopy _rightIcopy {-# LINE 4527 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 4532 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Expr_UnOpExpr_1 :: T_Expr_1 sem_Expr_UnOpExpr_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 4553 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 4558 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 4563 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 4568 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 4573 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOloopLevel -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 4578 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 4583 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 4588 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 4593 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 4598 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _opOconfig -> (case (op_1 _opOconfig _opOfuncName _opOglobalDefinitions _opOisInModule _opOisMeta _opOloopLevel _opOmtokenPos _opOscopeLevel _opOscopes _opOvariableStyle) of { ( _opIglobalDefinitions,_opIidentifier,_opIisInModule,_opIisNegation,_opImtokenPos,_opIscopes,_opIvariableStyle,_opIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _opIscopes {-# LINE 4605 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 4610 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _opIisInModule {-# LINE 4615 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _opIglobalDefinitions {-# LINE 4620 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 4625 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOconfig -> (case (({-# LINE 601 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 4630 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOvarBeingDefined -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _opIvariableStyle {-# LINE 4635 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 4640 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _opImtokenPos {-# LINE 4645 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 4650 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 4655 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOfuncName -> (case (({-# LINE 600 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 4660 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOtopLevel -> (case (({-# LINE 599 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 4665 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOinParentheses -> (case (({-# LINE 598 "src/GLuaFixer/AG/ASTLint.ag" #-} _opIisNegation {-# LINE 4670 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _rightOisNegation -> (case (right_1 _rightOconfig _rightOfuncName _rightOglobalDefinitions _rightOinParentheses _rightOisInModule _rightOisMeta _rightOisNegation _rightOloopLevel _rightOmtokenPos _rightOscopeLevel _rightOscopes _rightOtopLevel _rightOvarBeingDefined _rightOvariableStyle) of { ( _rightIglobalDefinitions,_rightIidentifier,_rightIisInModule,_rightIisSimpleExpression,_rightIisSingleVar,_rightIscopes,_rightIvariableStyle,_rightIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _rightIglobalDefinitions {-# LINE 4677 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _opIidentifier _rightIidentifier) {-# LINE 4682 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _rightIisInModule {-# LINE 4687 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 597 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 4692 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} _rightIisSingleVar {-# LINE 4697 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _rightImtokenPos {-# LINE 4702 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _rightIscopes {-# LINE 4707 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _rightIvariableStyle {-# LINE 4712 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _opIwarnings ++ _rightIwarnings {-# LINE 4717 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Expr_UnOpExpr_1)) of { ( sem_Expr_1) -> ( _lhsOcopy,sem_Expr_1) }) }) }) }) }) -- ExprSuffixList ---------------------------------------------- -- cata sem_ExprSuffixList :: ExprSuffixList -> T_ExprSuffixList sem_ExprSuffixList list = (Prelude.foldr sem_ExprSuffixList_Cons sem_ExprSuffixList_Nil (Prelude.map sem_PFExprSuffix list)) -- semantic domain type T_ExprSuffixList = ( ExprSuffixList,T_ExprSuffixList_1) type T_ExprSuffixList_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_ExprSuffixList = Inh_ExprSuffixList {config_Inh_ExprSuffixList :: LintSettings,funcName_Inh_ExprSuffixList :: String,globalDefinitions_Inh_ExprSuffixList :: (M.Map String [Region]),isInModule_Inh_ExprSuffixList :: Bool,isMeta_Inh_ExprSuffixList :: Bool,loopLevel_Inh_ExprSuffixList :: Int,mtokenPos_Inh_ExprSuffixList :: Region,scopeLevel_Inh_ExprSuffixList :: Int,scopes_Inh_ExprSuffixList :: ([M.Map String (Bool, Region)]),variableStyle_Inh_ExprSuffixList :: DeterminedVariableStyle} data Syn_ExprSuffixList = Syn_ExprSuffixList {copy_Syn_ExprSuffixList :: ExprSuffixList,globalDefinitions_Syn_ExprSuffixList :: (M.Map String [Region]),identifier_Syn_ExprSuffixList :: String,isInModule_Syn_ExprSuffixList :: Bool,isSimpleExpression_Syn_ExprSuffixList :: Bool,mtokenPos_Syn_ExprSuffixList :: Region,scopes_Syn_ExprSuffixList :: ([M.Map String (Bool, Region)]),variableStyle_Syn_ExprSuffixList :: DeterminedVariableStyle,warnings_Syn_ExprSuffixList :: ([String -> LintMessage])} wrap_ExprSuffixList :: T_ExprSuffixList -> Inh_ExprSuffixList -> Syn_ExprSuffixList wrap_ExprSuffixList sem (Inh_ExprSuffixList _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_ExprSuffixList _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOisSimpleExpression _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_ExprSuffixList_Cons :: T_PFExprSuffix -> T_ExprSuffixList -> T_ExprSuffixList sem_ExprSuffixList_Cons hd_ tl_ = (case (tl_) of { ( _tlIcopy,tl_1) -> (case (hd_) of { ( _hdIcopy,hd_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} (:) _hdIcopy _tlIcopy {-# LINE 4762 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 4767 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_ExprSuffixList_Cons_1 :: T_ExprSuffixList_1 sem_ExprSuffixList_Cons_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 4784 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 4789 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 4794 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 4799 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 4804 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 4809 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 4814 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOloopLevel -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 4819 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 4824 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 4829 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOfuncName -> (case (hd_1 _hdOconfig _hdOfuncName _hdOglobalDefinitions _hdOisInModule _hdOisMeta _hdOloopLevel _hdOmtokenPos _hdOscopeLevel _hdOscopes _hdOvariableStyle) of { ( _hdIglobalDefinitions,_hdIidentifier,_hdIisInModule,_hdIisSimpleExpression,_hdImtokenPos,_hdIscopes,_hdIvariableStyle,_hdIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIscopes {-# LINE 4836 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 4841 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIisInModule {-# LINE 4846 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIglobalDefinitions {-# LINE 4851 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 4856 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIvariableStyle {-# LINE 4861 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 4866 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdImtokenPos {-# LINE 4871 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 4876 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 4881 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOfuncName -> (case (tl_1 _tlOconfig _tlOfuncName _tlOglobalDefinitions _tlOisInModule _tlOisMeta _tlOloopLevel _tlOmtokenPos _tlOscopeLevel _tlOscopes _tlOvariableStyle) of { ( _tlIglobalDefinitions,_tlIidentifier,_tlIisInModule,_tlIisSimpleExpression,_tlImtokenPos,_tlIscopes,_tlIvariableStyle,_tlIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIglobalDefinitions {-# LINE 4888 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _hdIidentifier _tlIidentifier) {-# LINE 4893 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIisInModule {-# LINE 4898 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIisSimpleExpression && _tlIisSimpleExpression {-# LINE 4903 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlImtokenPos {-# LINE 4908 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIscopes {-# LINE 4913 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIvariableStyle {-# LINE 4918 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIwarnings ++ _tlIwarnings {-# LINE 4923 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_ExprSuffixList_Cons_1)) of { ( sem_ExprSuffixList_1) -> ( _lhsOcopy,sem_ExprSuffixList_1) }) }) }) }) }) sem_ExprSuffixList_Nil :: T_ExprSuffixList sem_ExprSuffixList_Nil = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 4934 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 4939 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_ExprSuffixList_Nil_1 :: T_ExprSuffixList_1 sem_ExprSuffixList_Nil_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 4956 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 4961 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 4966 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 4971 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 4976 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 4981 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 4986 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 4991 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) })) in sem_ExprSuffixList_Nil_1)) of { ( sem_ExprSuffixList_1) -> ( _lhsOcopy,sem_ExprSuffixList_1) }) }) }) -- Field ------------------------------------------------------- -- cata sem_Field :: Field -> T_Field sem_Field (ExprField _key _value _sep) = (sem_Field_ExprField (sem_MExpr _key) (sem_MExpr _value) (sem_FieldSep _sep)) sem_Field (NamedField _key _value _sep) = (sem_Field_NamedField (sem_MToken _key) (sem_MExpr _value) (sem_FieldSep _sep)) sem_Field (UnnamedField _value _sep) = (sem_Field_UnnamedField (sem_MExpr _value) (sem_FieldSep _sep)) -- semantic domain type T_Field = ( Field,T_Field_1) type T_Field_1 = LintSettings -> (S.Set Token) -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (S.Set Token),(M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_Field = Inh_Field {config_Inh_Field :: LintSettings,fieldNames_Inh_Field :: (S.Set Token),funcName_Inh_Field :: String,globalDefinitions_Inh_Field :: (M.Map String [Region]),isInModule_Inh_Field :: Bool,isMeta_Inh_Field :: Bool,loopLevel_Inh_Field :: Int,mtokenPos_Inh_Field :: Region,scopeLevel_Inh_Field :: Int,scopes_Inh_Field :: ([M.Map String (Bool, Region)]),variableStyle_Inh_Field :: DeterminedVariableStyle} data Syn_Field = Syn_Field {copy_Syn_Field :: Field,fieldNames_Syn_Field :: (S.Set Token),globalDefinitions_Syn_Field :: (M.Map String [Region]),identifier_Syn_Field :: String,isInModule_Syn_Field :: Bool,mtokenPos_Syn_Field :: Region,scopes_Syn_Field :: ([M.Map String (Bool, Region)]),variableStyle_Syn_Field :: DeterminedVariableStyle,warnings_Syn_Field :: ([String -> LintMessage])} wrap_Field :: T_Field -> Inh_Field -> Syn_Field wrap_Field sem (Inh_Field _lhsIconfig _lhsIfieldNames _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOfieldNames,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfieldNames _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_Field _lhsOcopy _lhsOfieldNames _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_Field_ExprField :: T_MExpr -> T_MExpr -> T_FieldSep -> T_Field sem_Field_ExprField key_ value_ sep_ = (case (sep_) of { ( _sepIcopy,sep_1) -> (case (value_) of { ( _valueIcopy,_valueImtokenPos,value_1) -> (case (key_) of { ( _keyIcopy,_keyImtokenPos,key_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ExprField _keyIcopy _valueIcopy _sepIcopy {-# LINE 5044 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 5049 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Field_ExprField_1 :: T_Field_1 sem_Field_ExprField_1 = (\ _lhsIconfig _lhsIfieldNames _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 163 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfieldNames {-# LINE 5067 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOfieldNames -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 5072 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 5077 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 5082 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOconfig -> (case (({-# LINE 617 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 5087 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOvarBeingDefined -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 5092 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 5097 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 5102 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 5107 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOloopLevel -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 5112 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 5117 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 5122 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOfuncName -> (case (({-# LINE 616 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 5127 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOtopLevel -> (case (({-# LINE 615 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 5132 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOinParentheses -> (case (({-# LINE 614 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 5137 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOisNegation -> (case (key_1 _keyOconfig _keyOfuncName _keyOglobalDefinitions _keyOinParentheses _keyOisInModule _keyOisMeta _keyOisNegation _keyOloopLevel _keyOmtokenPos _keyOscopeLevel _keyOscopes _keyOtopLevel _keyOvarBeingDefined _keyOvariableStyle) of { ( _keyIglobalDefinitions,_keyIidentifier,_keyIisInModule,_keyIisSimpleExpression,_keyIisSingleVar,_keyIscopes,_keyIvariableStyle,_keyIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _keyIscopes {-# LINE 5144 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 5149 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _keyIisInModule {-# LINE 5154 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _keyIglobalDefinitions {-# LINE 5159 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 5164 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOconfig -> (case (({-# LINE 621 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 5169 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOvarBeingDefined -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _keyIvariableStyle {-# LINE 5174 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 5179 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _keyImtokenPos {-# LINE 5184 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 5189 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 5194 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOfuncName -> (case (({-# LINE 620 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 5199 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOtopLevel -> (case (({-# LINE 619 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 5204 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOinParentheses -> (case (({-# LINE 618 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 5209 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOisNegation -> (case (value_1 _valueOconfig _valueOfuncName _valueOglobalDefinitions _valueOinParentheses _valueOisInModule _valueOisMeta _valueOisNegation _valueOloopLevel _valueOmtokenPos _valueOscopeLevel _valueOscopes _valueOtopLevel _valueOvarBeingDefined _valueOvariableStyle) of { ( _valueIglobalDefinitions,_valueIidentifier,_valueIisInModule,_valueIisSimpleExpression,_valueIisSingleVar,_valueIscopes,_valueIvariableStyle,_valueIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueIglobalDefinitions {-# LINE 5216 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOglobalDefinitions -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueIvariableStyle {-# LINE 5221 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueIscopes {-# LINE 5226 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOscopes -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 5231 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueImtokenPos {-# LINE 5236 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 5241 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOloopLevel -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 5246 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueIisInModule {-# LINE 5251 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOisInModule -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 5256 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 5261 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOconfig -> (case (sep_1 _sepOconfig _sepOfuncName _sepOglobalDefinitions _sepOisInModule _sepOisMeta _sepOloopLevel _sepOmtokenPos _sepOscopeLevel _sepOscopes _sepOvariableStyle) of { ( _sepIglobalDefinitions,_sepIidentifier,_sepIisInModule,_sepImtokenPos,_sepIscopes,_sepIvariableStyle,_sepIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _sepIglobalDefinitions {-# LINE 5268 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _keyIidentifier (const _valueIidentifier _sepIidentifier)) {-# LINE 5273 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _sepIisInModule {-# LINE 5278 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 613 "src/GLuaFixer/AG/ASTLint.ag" #-} _keyImtokenPos {-# LINE 5283 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _sepIscopes {-# LINE 5288 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _sepIvariableStyle {-# LINE 5293 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _keyIwarnings ++ _valueIwarnings ++ _sepIwarnings {-# LINE 5298 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOfieldNames,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Field_ExprField_1)) of { ( sem_Field_1) -> ( _lhsOcopy,sem_Field_1) }) }) }) }) }) }) sem_Field_NamedField :: T_MToken -> T_MExpr -> T_FieldSep -> T_Field sem_Field_NamedField key_ value_ sep_ = (case (sep_) of { ( _sepIcopy,sep_1) -> (case (value_) of { ( _valueIcopy,_valueImtokenPos,value_1) -> (case (key_) of { ( _keyIcopy,_keyImtok,_keyImtokenPos,key_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} NamedField _keyIcopy _valueIcopy _sepIcopy {-# LINE 5318 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 5323 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Field_NamedField_1 :: T_Field_1 sem_Field_NamedField_1 = (\ _lhsIconfig _lhsIfieldNames _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 624 "src/GLuaFixer/AG/ASTLint.ag" #-} S.insert _keyImtok _lhsIfieldNames {-# LINE 5341 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOfieldNames -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 5346 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOscopes -> (case (({-# LINE 623 "src/GLuaFixer/AG/ASTLint.ag" #-} _keyImtokenPos {-# LINE 5351 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _mtokenPos -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _mtokenPos {-# LINE 5356 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOmtokenPos -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 5361 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 5366 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 5371 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 5376 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 5381 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keyOconfig -> (case (key_1 _keyOconfig _keyOfuncName _keyOglobalDefinitions _keyOisInModule _keyOisMeta _keyOmtokenPos _keyOscopes) of { ( _keyIglobalDefinitions,_keyIidentifier,_keyIisInModule,_keyIscopes,_keyIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _keyIscopes {-# LINE 5388 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 5393 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _keyIisInModule {-# LINE 5398 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _keyIglobalDefinitions {-# LINE 5403 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 5408 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOconfig -> (case (({-# LINE 625 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 5413 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOvarBeingDefined -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 5418 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 5423 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _mtokenPos {-# LINE 5428 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 5433 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 5438 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOfuncName -> (case (({-# LINE 628 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 5443 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOtopLevel -> (case (({-# LINE 627 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 5448 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOinParentheses -> (case (({-# LINE 626 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 5453 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOisNegation -> (case (value_1 _valueOconfig _valueOfuncName _valueOglobalDefinitions _valueOinParentheses _valueOisInModule _valueOisMeta _valueOisNegation _valueOloopLevel _valueOmtokenPos _valueOscopeLevel _valueOscopes _valueOtopLevel _valueOvarBeingDefined _valueOvariableStyle) of { ( _valueIglobalDefinitions,_valueIidentifier,_valueIisInModule,_valueIisSimpleExpression,_valueIisSingleVar,_valueIscopes,_valueIvariableStyle,_valueIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueIglobalDefinitions {-# LINE 5460 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOglobalDefinitions -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueIvariableStyle {-# LINE 5465 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueIscopes {-# LINE 5470 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOscopes -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 5475 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _mtokenPos {-# LINE 5480 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 5485 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOloopLevel -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 5490 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueIisInModule {-# LINE 5495 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOisInModule -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 5500 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 5505 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOconfig -> (case (sep_1 _sepOconfig _sepOfuncName _sepOglobalDefinitions _sepOisInModule _sepOisMeta _sepOloopLevel _sepOmtokenPos _sepOscopeLevel _sepOscopes _sepOvariableStyle) of { ( _sepIglobalDefinitions,_sepIidentifier,_sepIisInModule,_sepImtokenPos,_sepIscopes,_sepIvariableStyle,_sepIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _sepIglobalDefinitions {-# LINE 5512 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _keyIidentifier (const _valueIidentifier _sepIidentifier)) {-# LINE 5517 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _sepIisInModule {-# LINE 5522 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _mtokenPos {-# LINE 5527 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _sepIscopes {-# LINE 5532 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _sepIvariableStyle {-# LINE 5537 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 629 "src/GLuaFixer/AG/ASTLint.ag" #-} _keyIwarnings ++ _valueIwarnings ++ _sepIwarnings {-# LINE 5542 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 629 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_duplicateTableKeys _lhsIconfig) || not (S.member _keyImtok _lhsIfieldNames) then id else (:) $ warn _keyImtokenPos $ DuplicateKeyInTable _keyImtok {-# LINE 5548 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 629 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 5553 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOfieldNames,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Field_NamedField_1)) of { ( sem_Field_1) -> ( _lhsOcopy,sem_Field_1) }) }) }) }) }) }) sem_Field_UnnamedField :: T_MExpr -> T_FieldSep -> T_Field sem_Field_UnnamedField value_ sep_ = (case (sep_) of { ( _sepIcopy,sep_1) -> (case (value_) of { ( _valueIcopy,_valueImtokenPos,value_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} UnnamedField _valueIcopy _sepIcopy {-# LINE 5570 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 5575 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Field_UnnamedField_1 :: T_Field_1 sem_Field_UnnamedField_1 = (\ _lhsIconfig _lhsIfieldNames _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 163 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfieldNames {-# LINE 5593 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOfieldNames -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 5598 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 5603 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 5608 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 5613 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 5618 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOconfig -> (case (({-# LINE 635 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 5623 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOvarBeingDefined -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 5628 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 5633 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 5638 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 5643 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 5648 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOfuncName -> (case (({-# LINE 634 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 5653 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOtopLevel -> (case (({-# LINE 633 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 5658 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOinParentheses -> (case (({-# LINE 632 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 5663 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valueOisNegation -> (case (value_1 _valueOconfig _valueOfuncName _valueOglobalDefinitions _valueOinParentheses _valueOisInModule _valueOisMeta _valueOisNegation _valueOloopLevel _valueOmtokenPos _valueOscopeLevel _valueOscopes _valueOtopLevel _valueOvarBeingDefined _valueOvariableStyle) of { ( _valueIglobalDefinitions,_valueIidentifier,_valueIisInModule,_valueIisSimpleExpression,_valueIisSingleVar,_valueIscopes,_valueIvariableStyle,_valueIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueIglobalDefinitions {-# LINE 5670 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOglobalDefinitions -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueIvariableStyle {-# LINE 5675 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueIscopes {-# LINE 5680 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOscopes -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 5685 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueImtokenPos {-# LINE 5690 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 5695 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOloopLevel -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 5700 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueIisInModule {-# LINE 5705 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOisInModule -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 5710 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 5715 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _sepOconfig -> (case (sep_1 _sepOconfig _sepOfuncName _sepOglobalDefinitions _sepOisInModule _sepOisMeta _sepOloopLevel _sepOmtokenPos _sepOscopeLevel _sepOscopes _sepOvariableStyle) of { ( _sepIglobalDefinitions,_sepIidentifier,_sepIisInModule,_sepImtokenPos,_sepIscopes,_sepIvariableStyle,_sepIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _sepIglobalDefinitions {-# LINE 5722 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _valueIidentifier _sepIidentifier) {-# LINE 5727 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _sepIisInModule {-# LINE 5732 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _sepImtokenPos {-# LINE 5737 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _sepIscopes {-# LINE 5742 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _sepIvariableStyle {-# LINE 5747 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _valueIwarnings ++ _sepIwarnings {-# LINE 5752 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOfieldNames,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Field_UnnamedField_1)) of { ( sem_Field_1) -> ( _lhsOcopy,sem_Field_1) }) }) }) }) }) -- FieldList --------------------------------------------------- -- cata sem_FieldList :: FieldList -> T_FieldList sem_FieldList list = (Prelude.foldr sem_FieldList_Cons sem_FieldList_Nil (Prelude.map sem_Field list)) -- semantic domain type T_FieldList = ( FieldList,T_FieldList_1) type T_FieldList_1 = LintSettings -> (S.Set Token) -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (S.Set Token),(M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_FieldList = Inh_FieldList {config_Inh_FieldList :: LintSettings,fieldNames_Inh_FieldList :: (S.Set Token),funcName_Inh_FieldList :: String,globalDefinitions_Inh_FieldList :: (M.Map String [Region]),isInModule_Inh_FieldList :: Bool,isMeta_Inh_FieldList :: Bool,loopLevel_Inh_FieldList :: Int,mtokenPos_Inh_FieldList :: Region,scopeLevel_Inh_FieldList :: Int,scopes_Inh_FieldList :: ([M.Map String (Bool, Region)]),variableStyle_Inh_FieldList :: DeterminedVariableStyle} data Syn_FieldList = Syn_FieldList {copy_Syn_FieldList :: FieldList,fieldNames_Syn_FieldList :: (S.Set Token),globalDefinitions_Syn_FieldList :: (M.Map String [Region]),identifier_Syn_FieldList :: String,isInModule_Syn_FieldList :: Bool,mtokenPos_Syn_FieldList :: Region,scopes_Syn_FieldList :: ([M.Map String (Bool, Region)]),variableStyle_Syn_FieldList :: DeterminedVariableStyle,warnings_Syn_FieldList :: ([String -> LintMessage])} wrap_FieldList :: T_FieldList -> Inh_FieldList -> Syn_FieldList wrap_FieldList sem (Inh_FieldList _lhsIconfig _lhsIfieldNames _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOfieldNames,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfieldNames _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_FieldList _lhsOcopy _lhsOfieldNames _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_FieldList_Cons :: T_Field -> T_FieldList -> T_FieldList sem_FieldList_Cons hd_ tl_ = (case (tl_) of { ( _tlIcopy,tl_1) -> (case (hd_) of { ( _hdIcopy,hd_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} (:) _hdIcopy _tlIcopy {-# LINE 5798 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 5803 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_FieldList_Cons_1 :: T_FieldList_1 sem_FieldList_Cons_1 = (\ _lhsIconfig _lhsIfieldNames _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 163 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfieldNames {-# LINE 5821 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOfieldNames -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 5826 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 5831 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOscopes -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 5836 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 5841 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 5846 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOloopLevel -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 5851 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 5856 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 5861 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 5866 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 5871 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOconfig -> (case (hd_1 _hdOconfig _hdOfieldNames _hdOfuncName _hdOglobalDefinitions _hdOisInModule _hdOisMeta _hdOloopLevel _hdOmtokenPos _hdOscopeLevel _hdOscopes _hdOvariableStyle) of { ( _hdIfieldNames,_hdIglobalDefinitions,_hdIidentifier,_hdIisInModule,_hdImtokenPos,_hdIscopes,_hdIvariableStyle,_hdIwarnings) -> (case (({-# LINE 163 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIfieldNames {-# LINE 5878 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOfieldNames -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIvariableStyle {-# LINE 5883 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIscopes {-# LINE 5888 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOscopes -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 5893 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdImtokenPos {-# LINE 5898 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 5903 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOloopLevel -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 5908 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIisInModule {-# LINE 5913 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIglobalDefinitions {-# LINE 5918 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 5923 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 5928 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOconfig -> (case (tl_1 _tlOconfig _tlOfieldNames _tlOfuncName _tlOglobalDefinitions _tlOisInModule _tlOisMeta _tlOloopLevel _tlOmtokenPos _tlOscopeLevel _tlOscopes _tlOvariableStyle) of { ( _tlIfieldNames,_tlIglobalDefinitions,_tlIidentifier,_tlIisInModule,_tlImtokenPos,_tlIscopes,_tlIvariableStyle,_tlIwarnings) -> (case (({-# LINE 163 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIfieldNames {-# LINE 5935 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOfieldNames -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIglobalDefinitions {-# LINE 5940 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _hdIidentifier _tlIidentifier) {-# LINE 5945 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIisInModule {-# LINE 5950 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 234 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdImtokenPos {-# LINE 5955 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIscopes {-# LINE 5960 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIvariableStyle {-# LINE 5965 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIwarnings ++ _tlIwarnings {-# LINE 5970 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOfieldNames,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_FieldList_Cons_1)) of { ( sem_FieldList_1) -> ( _lhsOcopy,sem_FieldList_1) }) }) }) }) }) sem_FieldList_Nil :: T_FieldList sem_FieldList_Nil = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 5981 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 5986 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_FieldList_Nil_1 :: T_FieldList_1 sem_FieldList_Nil_1 = (\ _lhsIconfig _lhsIfieldNames _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 163 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfieldNames {-# LINE 6004 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOfieldNames -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 6009 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 6014 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 6019 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 6024 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 6029 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 6034 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 6039 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOfieldNames,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) })) in sem_FieldList_Nil_1)) of { ( sem_FieldList_1) -> ( _lhsOcopy,sem_FieldList_1) }) }) }) -- FieldSep ---------------------------------------------------- -- cata sem_FieldSep :: FieldSep -> T_FieldSep sem_FieldSep (CommaSep) = (sem_FieldSep_CommaSep) sem_FieldSep (SemicolonSep) = (sem_FieldSep_SemicolonSep) sem_FieldSep (NoSep) = (sem_FieldSep_NoSep) -- semantic domain type T_FieldSep = ( FieldSep,T_FieldSep_1) type T_FieldSep_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_FieldSep = Inh_FieldSep {config_Inh_FieldSep :: LintSettings,funcName_Inh_FieldSep :: String,globalDefinitions_Inh_FieldSep :: (M.Map String [Region]),isInModule_Inh_FieldSep :: Bool,isMeta_Inh_FieldSep :: Bool,loopLevel_Inh_FieldSep :: Int,mtokenPos_Inh_FieldSep :: Region,scopeLevel_Inh_FieldSep :: Int,scopes_Inh_FieldSep :: ([M.Map String (Bool, Region)]),variableStyle_Inh_FieldSep :: DeterminedVariableStyle} data Syn_FieldSep = Syn_FieldSep {copy_Syn_FieldSep :: FieldSep,globalDefinitions_Syn_FieldSep :: (M.Map String [Region]),identifier_Syn_FieldSep :: String,isInModule_Syn_FieldSep :: Bool,mtokenPos_Syn_FieldSep :: Region,scopes_Syn_FieldSep :: ([M.Map String (Bool, Region)]),variableStyle_Syn_FieldSep :: DeterminedVariableStyle,warnings_Syn_FieldSep :: ([String -> LintMessage])} wrap_FieldSep :: T_FieldSep -> Inh_FieldSep -> Syn_FieldSep wrap_FieldSep sem (Inh_FieldSep _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_FieldSep _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_FieldSep_CommaSep :: T_FieldSep sem_FieldSep_CommaSep = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} CommaSep {-# LINE 6082 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 6087 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_FieldSep_CommaSep_1 :: T_FieldSep_1 sem_FieldSep_CommaSep_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 6104 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 6109 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 6114 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 6119 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 6124 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 6129 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 6134 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_FieldSep_CommaSep_1)) of { ( sem_FieldSep_1) -> ( _lhsOcopy,sem_FieldSep_1) }) }) }) sem_FieldSep_SemicolonSep :: T_FieldSep sem_FieldSep_SemicolonSep = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} SemicolonSep {-# LINE 6145 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 6150 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_FieldSep_SemicolonSep_1 :: T_FieldSep_1 sem_FieldSep_SemicolonSep_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 6167 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 6172 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 6177 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 6182 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 6187 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 6192 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 6197 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_FieldSep_SemicolonSep_1)) of { ( sem_FieldSep_1) -> ( _lhsOcopy,sem_FieldSep_1) }) }) }) sem_FieldSep_NoSep :: T_FieldSep sem_FieldSep_NoSep = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} NoSep {-# LINE 6208 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 6213 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_FieldSep_NoSep_1 :: T_FieldSep_1 sem_FieldSep_NoSep_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 6230 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 6235 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 6240 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 6245 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 6250 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 6255 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 6260 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_FieldSep_NoSep_1)) of { ( sem_FieldSep_1) -> ( _lhsOcopy,sem_FieldSep_1) }) }) }) -- FuncName ---------------------------------------------------- -- cata sem_FuncName :: FuncName -> T_FuncName sem_FuncName (FuncName _names _meta) = (sem_FuncName_FuncName _names _meta) -- semantic domain type T_FuncName = ( FuncName,Bool,T_FuncName_1) type T_FuncName_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),Bool,String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_FuncName = Inh_FuncName {config_Inh_FuncName :: LintSettings,funcName_Inh_FuncName :: String,globalDefinitions_Inh_FuncName :: (M.Map String [Region]),isInModule_Inh_FuncName :: Bool,isMeta_Inh_FuncName :: Bool,loopLevel_Inh_FuncName :: Int,mtokenPos_Inh_FuncName :: Region,scopeLevel_Inh_FuncName :: Int,scopes_Inh_FuncName :: ([M.Map String (Bool, Region)]),variableStyle_Inh_FuncName :: DeterminedVariableStyle} data Syn_FuncName = Syn_FuncName {copy_Syn_FuncName :: FuncName,globalDefinitions_Syn_FuncName :: (M.Map String [Region]),hasSuffixes_Syn_FuncName :: Bool,identifier_Syn_FuncName :: String,isInModule_Syn_FuncName :: Bool,isMeta_Syn_FuncName :: Bool,mtokenPos_Syn_FuncName :: Region,scopes_Syn_FuncName :: ([M.Map String (Bool, Region)]),variableStyle_Syn_FuncName :: DeterminedVariableStyle,warnings_Syn_FuncName :: ([String -> LintMessage])} wrap_FuncName :: T_FuncName -> Inh_FuncName -> Syn_FuncName wrap_FuncName sem (Inh_FuncName _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,_lhsOisMeta,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOhasSuffixes,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_FuncName _lhsOcopy _lhsOglobalDefinitions _lhsOhasSuffixes _lhsOidentifier _lhsOisInModule _lhsOisMeta _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_FuncName_FuncName :: ([MToken]) -> (Maybe MToken) -> T_FuncName sem_FuncName_FuncName names_ meta_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} FuncName names_ meta_ {-# LINE 6301 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 6306 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 501 "src/GLuaFixer/AG/ASTLint.ag" #-} isJust meta_ {-# LINE 6311 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisMeta -> (case ((let sem_FuncName_FuncName_1 :: T_FuncName_1 sem_FuncName_FuncName_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 6328 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 502 "src/GLuaFixer/AG/ASTLint.ag" #-} length names_ > 1 {-# LINE 6333 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOhasSuffixes -> (case (({-# LINE 500 "src/GLuaFixer/AG/ASTLint.ag" #-} tokenLabel . head $ names_ {-# LINE 6338 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 6343 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 499 "src/GLuaFixer/AG/ASTLint.ag" #-} mpos (head names_) {-# LINE 6348 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 6353 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 6358 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 6363 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOhasSuffixes,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) })) in sem_FuncName_FuncName_1)) of { ( sem_FuncName_1) -> ( _lhsOcopy,_lhsOisMeta,sem_FuncName_1) }) }) }) }) -- MElse ------------------------------------------------------- -- cata sem_MElse :: MElse -> T_MElse sem_MElse (MElse _pos _body) = (sem_MElse_MElse (sem_Region _pos) (sem_Block _body)) -- semantic domain type T_MElse = ( MElse,T_MElse_1) type T_MElse_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( Bool,(M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),Int,DeterminedVariableStyle,([String -> LintMessage])) data Inh_MElse = Inh_MElse {config_Inh_MElse :: LintSettings,funcName_Inh_MElse :: String,globalDefinitions_Inh_MElse :: (M.Map String [Region]),isInModule_Inh_MElse :: Bool,isMeta_Inh_MElse :: Bool,loopLevel_Inh_MElse :: Int,mtokenPos_Inh_MElse :: Region,scopeLevel_Inh_MElse :: Int,scopes_Inh_MElse :: ([M.Map String (Bool, Region)]),variableStyle_Inh_MElse :: DeterminedVariableStyle} data Syn_MElse = Syn_MElse {copy_Syn_MElse :: MElse,elseExists_Syn_MElse :: Bool,globalDefinitions_Syn_MElse :: (M.Map String [Region]),identifier_Syn_MElse :: String,isInModule_Syn_MElse :: Bool,mtokenPos_Syn_MElse :: Region,scopes_Syn_MElse :: ([M.Map String (Bool, Region)]),statementCount_Syn_MElse :: Int,variableStyle_Syn_MElse :: DeterminedVariableStyle,warnings_Syn_MElse :: ([String -> LintMessage])} wrap_MElse :: T_MElse -> Inh_MElse -> Syn_MElse wrap_MElse sem (Inh_MElse _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOelseExists,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOstatementCount,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_MElse _lhsOcopy _lhsOelseExists _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOstatementCount _lhsOvariableStyle _lhsOwarnings)) sem_MElse_MElse :: T_Region -> T_Block -> T_MElse sem_MElse_MElse pos_ body_ = (case (body_) of { ( _bodyIcopy,body_1) -> (case (pos_) of { ( _posIcopy,_posIidentifier,_posIwarnings) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} MElse _posIcopy _bodyIcopy {-# LINE 6408 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 6413 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_MElse_MElse_1 :: T_MElse_1 sem_MElse_MElse_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 202 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 6430 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOelseExists -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 6435 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 6440 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 6445 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 6450 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 6455 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 6460 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 6465 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 6470 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 6475 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 6480 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOfuncName -> (case (({-# LINE 479 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 6485 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisRepeat -> (case (body_1 _bodyOconfig _bodyOfuncName _bodyOglobalDefinitions _bodyOisInModule _bodyOisMeta _bodyOisRepeat _bodyOloopLevel _bodyOmtokenPos _bodyOscopeLevel _bodyOscopes _bodyOvariableStyle) of { ( _bodyIglobalDefinitions,_bodyIidentifier,_bodyIisIfStatement,_bodyIisInModule,_bodyImtokenPos,_bodyIscopes,_bodyIstatementCount,_bodyIvariableStyle,_bodyIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIglobalDefinitions {-# LINE 6492 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _posIidentifier _bodyIidentifier) {-# LINE 6497 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIisInModule {-# LINE 6502 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 480 "src/GLuaFixer/AG/ASTLint.ag" #-} _posIcopy {-# LINE 6507 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIscopes {-# LINE 6512 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 157 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIstatementCount {-# LINE 6517 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOstatementCount -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIvariableStyle {-# LINE 6522 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _posIwarnings ++ _bodyIwarnings {-# LINE 6527 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOelseExists,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOstatementCount,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_MElse_MElse_1)) of { ( sem_MElse_1) -> ( _lhsOcopy,sem_MElse_1) }) }) }) }) }) -- MElseIf ----------------------------------------------------- -- cata sem_MElseIf :: MElseIf -> T_MElseIf sem_MElseIf (MElseIf _pos _elif) = (sem_MElseIf_MElseIf (sem_Region _pos) (sem_ElseIf _elif)) -- semantic domain type T_MElseIf = ( MElseIf,T_MElseIf_1) type T_MElseIf_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_MElseIf = Inh_MElseIf {config_Inh_MElseIf :: LintSettings,funcName_Inh_MElseIf :: String,globalDefinitions_Inh_MElseIf :: (M.Map String [Region]),isInModule_Inh_MElseIf :: Bool,isMeta_Inh_MElseIf :: Bool,loopLevel_Inh_MElseIf :: Int,mtokenPos_Inh_MElseIf :: Region,scopeLevel_Inh_MElseIf :: Int,scopes_Inh_MElseIf :: ([M.Map String (Bool, Region)]),variableStyle_Inh_MElseIf :: DeterminedVariableStyle} data Syn_MElseIf = Syn_MElseIf {copy_Syn_MElseIf :: MElseIf,globalDefinitions_Syn_MElseIf :: (M.Map String [Region]),identifier_Syn_MElseIf :: String,isInModule_Syn_MElseIf :: Bool,mtokenPos_Syn_MElseIf :: Region,scopes_Syn_MElseIf :: ([M.Map String (Bool, Region)]),variableStyle_Syn_MElseIf :: DeterminedVariableStyle,warnings_Syn_MElseIf :: ([String -> LintMessage])} wrap_MElseIf :: T_MElseIf -> Inh_MElseIf -> Syn_MElseIf wrap_MElseIf sem (Inh_MElseIf _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_MElseIf _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_MElseIf_MElseIf :: T_Region -> T_ElseIf -> T_MElseIf sem_MElseIf_MElseIf pos_ elif_ = (case (elif_) of { ( _elifIcopy,elif_1) -> (case (pos_) of { ( _posIcopy,_posIidentifier,_posIwarnings) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} MElseIf _posIcopy _elifIcopy {-# LINE 6572 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 6577 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_MElseIf_MElseIf_1 :: T_MElseIf_1 sem_MElseIf_MElseIf_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 6594 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 6599 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 6604 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 6609 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 6614 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 6619 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 6624 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifOscopeLevel -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 6629 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 6634 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifOfuncName -> (case (({-# LINE 463 "src/GLuaFixer/AG/ASTLint.ag" #-} _posIcopy {-# LINE 6639 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifOmtokenPos -> (case (elif_1 _elifOconfig _elifOfuncName _elifOglobalDefinitions _elifOisInModule _elifOisMeta _elifOloopLevel _elifOmtokenPos _elifOscopeLevel _elifOscopes _elifOvariableStyle) of { ( _elifIglobalDefinitions,_elifIidentifier,_elifIisInModule,_elifImtokenPos,_elifIscopes,_elifIvariableStyle,_elifIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _elifIglobalDefinitions {-# LINE 6646 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _posIidentifier _elifIidentifier) {-# LINE 6651 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _elifIisInModule {-# LINE 6656 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _elifImtokenPos {-# LINE 6661 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _elifIscopes {-# LINE 6666 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _elifIvariableStyle {-# LINE 6671 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _posIwarnings ++ _elifIwarnings {-# LINE 6676 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_MElseIf_MElseIf_1)) of { ( sem_MElseIf_1) -> ( _lhsOcopy,sem_MElseIf_1) }) }) }) }) }) -- MExpr ------------------------------------------------------- -- cata sem_MExpr :: MExpr -> T_MExpr sem_MExpr (MExpr _pos _expr) = (sem_MExpr_MExpr (sem_Region _pos) (sem_Expr _expr)) -- semantic domain type T_MExpr = ( MExpr,Region,T_MExpr_1) type T_MExpr_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> Bool -> (Maybe MToken) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Bool,(Maybe MToken),([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_MExpr = Inh_MExpr {config_Inh_MExpr :: LintSettings,funcName_Inh_MExpr :: String,globalDefinitions_Inh_MExpr :: (M.Map String [Region]),inParentheses_Inh_MExpr :: Bool,isInModule_Inh_MExpr :: Bool,isMeta_Inh_MExpr :: Bool,isNegation_Inh_MExpr :: Bool,loopLevel_Inh_MExpr :: Int,mtokenPos_Inh_MExpr :: Region,scopeLevel_Inh_MExpr :: Int,scopes_Inh_MExpr :: ([M.Map String (Bool, Region)]),topLevel_Inh_MExpr :: Bool,varBeingDefined_Inh_MExpr :: (Maybe MToken),variableStyle_Inh_MExpr :: DeterminedVariableStyle} data Syn_MExpr = Syn_MExpr {copy_Syn_MExpr :: MExpr,globalDefinitions_Syn_MExpr :: (M.Map String [Region]),identifier_Syn_MExpr :: String,isInModule_Syn_MExpr :: Bool,isSimpleExpression_Syn_MExpr :: Bool,isSingleVar_Syn_MExpr :: (Maybe MToken),mtokenPos_Syn_MExpr :: Region,scopes_Syn_MExpr :: ([M.Map String (Bool, Region)]),variableStyle_Syn_MExpr :: DeterminedVariableStyle,warnings_Syn_MExpr :: ([String -> LintMessage])} wrap_MExpr :: T_MExpr -> Inh_MExpr -> Syn_MExpr wrap_MExpr sem (Inh_MExpr _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle) = (let ( _lhsOcopy,_lhsOmtokenPos,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle in (Syn_MExpr _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOisSimpleExpression _lhsOisSingleVar _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_MExpr_MExpr :: T_Region -> T_Expr -> T_MExpr sem_MExpr_MExpr pos_ expr_ = (case (expr_) of { ( _exprIcopy,expr_1) -> (case (pos_) of { ( _posIcopy,_posIidentifier,_posIwarnings) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} MExpr _posIcopy _exprIcopy {-# LINE 6725 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 6730 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 557 "src/GLuaFixer/AG/ASTLint.ag" #-} _posIcopy {-# LINE 6735 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case ((let sem_MExpr_MExpr_1 :: T_MExpr_1 sem_MExpr_MExpr_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 178 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvarBeingDefined {-# LINE 6756 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOvarBeingDefined -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 6761 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 6766 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 6771 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 6776 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 6781 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 6786 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOvariableStyle -> (case (({-# LINE 182 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsItopLevel {-# LINE 6791 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOtopLevel -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 6796 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOscopeLevel -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 6801 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOloopLevel -> (case (({-# LINE 169 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisNegation {-# LINE 6806 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOisNegation -> (case (({-# LINE 181 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIinParentheses {-# LINE 6811 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOinParentheses -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 6816 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOfuncName -> (case (({-# LINE 558 "src/GLuaFixer/AG/ASTLint.ag" #-} _posIcopy {-# LINE 6821 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOmtokenPos -> (case (expr_1 _exprOconfig _exprOfuncName _exprOglobalDefinitions _exprOinParentheses _exprOisInModule _exprOisMeta _exprOisNegation _exprOloopLevel _exprOmtokenPos _exprOscopeLevel _exprOscopes _exprOtopLevel _exprOvarBeingDefined _exprOvariableStyle) of { ( _exprIglobalDefinitions,_exprIidentifier,_exprIisInModule,_exprIisSimpleExpression,_exprIisSingleVar,_exprImtokenPos,_exprIscopes,_exprIvariableStyle,_exprIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprIglobalDefinitions {-# LINE 6828 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _posIidentifier _exprIidentifier) {-# LINE 6833 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprIisInModule {-# LINE 6838 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprIisSimpleExpression {-# LINE 6843 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprIisSingleVar {-# LINE 6848 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprIscopes {-# LINE 6853 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprIvariableStyle {-# LINE 6858 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _posIwarnings ++ _exprIwarnings {-# LINE 6863 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_MExpr_MExpr_1)) of { ( sem_MExpr_1) -> ( _lhsOcopy,_lhsOmtokenPos,sem_MExpr_1) }) }) }) }) }) }) -- MExprList --------------------------------------------------- -- cata sem_MExprList :: MExprList -> T_MExprList sem_MExprList list = (Prelude.foldr sem_MExprList_Cons sem_MExprList_Nil (Prelude.map sem_MExpr list)) -- semantic domain type T_MExprList = ( MExprList,T_MExprList_1) type T_MExprList_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> Bool -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_MExprList = Inh_MExprList {config_Inh_MExprList :: LintSettings,funcName_Inh_MExprList :: String,globalDefinitions_Inh_MExprList :: (M.Map String [Region]),inParentheses_Inh_MExprList :: Bool,isInModule_Inh_MExprList :: Bool,isMeta_Inh_MExprList :: Bool,loopLevel_Inh_MExprList :: Int,mtokenPos_Inh_MExprList :: Region,scopeLevel_Inh_MExprList :: Int,scopes_Inh_MExprList :: ([M.Map String (Bool, Region)]),topLevel_Inh_MExprList :: Bool,variableStyle_Inh_MExprList :: DeterminedVariableStyle} data Syn_MExprList = Syn_MExprList {copy_Syn_MExprList :: MExprList,globalDefinitions_Syn_MExprList :: (M.Map String [Region]),identifier_Syn_MExprList :: String,isInModule_Syn_MExprList :: Bool,mtokenPos_Syn_MExprList :: Region,scopes_Syn_MExprList :: ([M.Map String (Bool, Region)]),variableStyle_Syn_MExprList :: DeterminedVariableStyle,warnings_Syn_MExprList :: ([String -> LintMessage])} wrap_MExprList :: T_MExprList -> Inh_MExprList -> Syn_MExprList wrap_MExprList sem (Inh_MExprList _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvariableStyle in (Syn_MExprList _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_MExprList_Cons :: T_MExpr -> T_MExprList -> T_MExprList sem_MExprList_Cons hd_ tl_ = (case (tl_) of { ( _tlIcopy,tl_1) -> (case (hd_) of { ( _hdIcopy,_hdImtokenPos,hd_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} (:) _hdIcopy _tlIcopy {-# LINE 6910 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 6915 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_MExprList_Cons_1 :: T_MExprList_1 sem_MExprList_Cons_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 6934 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 6939 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 6944 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOconfig -> (case (({-# LINE 245 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 6949 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOvarBeingDefined -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 6954 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOvariableStyle -> (case (({-# LINE 182 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsItopLevel {-# LINE 6959 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOtopLevel -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 6964 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 6969 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 6974 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOloopLevel -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 6979 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisInModule -> (case (({-# LINE 181 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIinParentheses {-# LINE 6984 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOinParentheses -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 6989 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 6994 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOfuncName -> (case (({-# LINE 244 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 6999 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisNegation -> (case (hd_1 _hdOconfig _hdOfuncName _hdOglobalDefinitions _hdOinParentheses _hdOisInModule _hdOisMeta _hdOisNegation _hdOloopLevel _hdOmtokenPos _hdOscopeLevel _hdOscopes _hdOtopLevel _hdOvarBeingDefined _hdOvariableStyle) of { ( _hdIglobalDefinitions,_hdIidentifier,_hdIisInModule,_hdIisSimpleExpression,_hdIisSingleVar,_hdIscopes,_hdIvariableStyle,_hdIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIscopes {-# LINE 7006 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 7011 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIisInModule {-# LINE 7016 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIglobalDefinitions {-# LINE 7021 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 7026 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIvariableStyle {-# LINE 7031 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOvariableStyle -> (case (({-# LINE 182 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsItopLevel {-# LINE 7036 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOtopLevel -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 7041 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdImtokenPos {-# LINE 7046 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 7051 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOloopLevel -> (case (({-# LINE 181 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIinParentheses {-# LINE 7056 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOinParentheses -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 7061 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOfuncName -> (case (tl_1 _tlOconfig _tlOfuncName _tlOglobalDefinitions _tlOinParentheses _tlOisInModule _tlOisMeta _tlOloopLevel _tlOmtokenPos _tlOscopeLevel _tlOscopes _tlOtopLevel _tlOvariableStyle) of { ( _tlIglobalDefinitions,_tlIidentifier,_tlIisInModule,_tlImtokenPos,_tlIscopes,_tlIvariableStyle,_tlIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIglobalDefinitions {-# LINE 7068 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _hdIidentifier _tlIidentifier) {-# LINE 7073 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIisInModule {-# LINE 7078 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 234 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdImtokenPos {-# LINE 7083 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIscopes {-# LINE 7088 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIvariableStyle {-# LINE 7093 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIwarnings ++ _tlIwarnings {-# LINE 7098 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_MExprList_Cons_1)) of { ( sem_MExprList_1) -> ( _lhsOcopy,sem_MExprList_1) }) }) }) }) }) sem_MExprList_Nil :: T_MExprList sem_MExprList_Nil = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 7109 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 7114 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_MExprList_Nil_1 :: T_MExprList_1 sem_MExprList_Nil_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 7133 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 7138 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 7143 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 7148 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 7153 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 7158 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 7163 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_MExprList_Nil_1)) of { ( sem_MExprList_1) -> ( _lhsOcopy,sem_MExprList_1) }) }) }) -- MStat ------------------------------------------------------- -- cata sem_MStat :: MStat -> T_MStat sem_MStat (MStat _pos _stat) = (sem_MStat_MStat (sem_Region _pos) (sem_Stat _stat)) -- semantic domain type T_MStat = ( MStat,T_MStat_1) type T_MStat_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Bool,Region,([M.Map String (Bool, Region)]),Int,DeterminedVariableStyle,([String -> LintMessage])) data Inh_MStat = Inh_MStat {config_Inh_MStat :: LintSettings,funcName_Inh_MStat :: String,globalDefinitions_Inh_MStat :: (M.Map String [Region]),isInModule_Inh_MStat :: Bool,isMeta_Inh_MStat :: Bool,loopLevel_Inh_MStat :: Int,mtokenPos_Inh_MStat :: Region,scopeLevel_Inh_MStat :: Int,scopes_Inh_MStat :: ([M.Map String (Bool, Region)]),variableStyle_Inh_MStat :: DeterminedVariableStyle} data Syn_MStat = Syn_MStat {copy_Syn_MStat :: MStat,globalDefinitions_Syn_MStat :: (M.Map String [Region]),identifier_Syn_MStat :: String,isIfStatement_Syn_MStat :: Bool,isInModule_Syn_MStat :: Bool,mtokenPos_Syn_MStat :: Region,scopes_Syn_MStat :: ([M.Map String (Bool, Region)]),statementCount_Syn_MStat :: Int,variableStyle_Syn_MStat :: DeterminedVariableStyle,warnings_Syn_MStat :: ([String -> LintMessage])} wrap_MStat :: T_MStat -> Inh_MStat -> Syn_MStat wrap_MStat sem (Inh_MStat _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOstatementCount,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_MStat _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisIfStatement _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOstatementCount _lhsOvariableStyle _lhsOwarnings)) sem_MStat_MStat :: T_Region -> T_Stat -> T_MStat sem_MStat_MStat pos_ stat_ = (case (stat_) of { ( _statIcopy,stat_1) -> (case (pos_) of { ( _posIcopy,_posIidentifier,_posIwarnings) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} MStat _posIcopy _statIcopy {-# LINE 7208 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 7213 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_MStat_MStat_1 :: T_MStat_1 sem_MStat_MStat_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 7230 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 7235 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 7240 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 7245 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 7250 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 7255 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 7260 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statOscopeLevel -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 7265 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 7270 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statOfuncName -> (case (({-# LINE 309 "src/GLuaFixer/AG/ASTLint.ag" #-} _posIcopy {-# LINE 7275 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _statOmtokenPos -> (case (stat_1 _statOconfig _statOfuncName _statOglobalDefinitions _statOisInModule _statOisMeta _statOloopLevel _statOmtokenPos _statOscopeLevel _statOscopes _statOvariableStyle) of { ( _statIglobalDefinitions,_statIidentifier,_statIisIfStatement,_statIisInModule,_statImtokenPos,_statIscopes,_statIvariableStyle,_statIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _statIglobalDefinitions {-# LINE 7282 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _posIidentifier _statIidentifier) {-# LINE 7287 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 208 "src/GLuaFixer/AG/ASTLint.ag" #-} _statIisIfStatement {-# LINE 7292 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _statIisInModule {-# LINE 7297 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 308 "src/GLuaFixer/AG/ASTLint.ag" #-} _posIcopy {-# LINE 7302 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _statIscopes {-# LINE 7307 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 157 "src/GLuaFixer/AG/ASTLint.ag" #-} 1 {-# LINE 7312 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOstatementCount -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _statIvariableStyle {-# LINE 7317 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _posIwarnings ++ _statIwarnings {-# LINE 7322 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOstatementCount,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_MStat_MStat_1)) of { ( sem_MStat_1) -> ( _lhsOcopy,sem_MStat_1) }) }) }) }) }) -- MStatList --------------------------------------------------- -- cata sem_MStatList :: MStatList -> T_MStatList sem_MStatList list = (Prelude.foldr sem_MStatList_Cons sem_MStatList_Nil (Prelude.map sem_MStat list)) -- semantic domain type T_MStatList = ( MStatList,T_MStatList_1) type T_MStatList_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Bool,Region,([M.Map String (Bool, Region)]),Int,DeterminedVariableStyle,([String -> LintMessage])) data Inh_MStatList = Inh_MStatList {config_Inh_MStatList :: LintSettings,funcName_Inh_MStatList :: String,globalDefinitions_Inh_MStatList :: (M.Map String [Region]),isInModule_Inh_MStatList :: Bool,isMeta_Inh_MStatList :: Bool,loopLevel_Inh_MStatList :: Int,mtokenPos_Inh_MStatList :: Region,scopeLevel_Inh_MStatList :: Int,scopes_Inh_MStatList :: ([M.Map String (Bool, Region)]),variableStyle_Inh_MStatList :: DeterminedVariableStyle} data Syn_MStatList = Syn_MStatList {copy_Syn_MStatList :: MStatList,globalDefinitions_Syn_MStatList :: (M.Map String [Region]),identifier_Syn_MStatList :: String,isIfStatement_Syn_MStatList :: Bool,isInModule_Syn_MStatList :: Bool,mtokenPos_Syn_MStatList :: Region,scopes_Syn_MStatList :: ([M.Map String (Bool, Region)]),statementCount_Syn_MStatList :: Int,variableStyle_Syn_MStatList :: DeterminedVariableStyle,warnings_Syn_MStatList :: ([String -> LintMessage])} wrap_MStatList :: T_MStatList -> Inh_MStatList -> Syn_MStatList wrap_MStatList sem (Inh_MStatList _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOstatementCount,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_MStatList _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisIfStatement _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOstatementCount _lhsOvariableStyle _lhsOwarnings)) sem_MStatList_Cons :: T_MStat -> T_MStatList -> T_MStatList sem_MStatList_Cons hd_ tl_ = (case (tl_) of { ( _tlIcopy,tl_1) -> (case (hd_) of { ( _hdIcopy,hd_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} (:) _hdIcopy _tlIcopy {-# LINE 7367 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 7372 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_MStatList_Cons_1 :: T_MStatList_1 sem_MStatList_Cons_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 7389 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 7394 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 7399 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 7404 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 7409 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 7414 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 7419 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOloopLevel -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 7424 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 7429 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 7434 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOfuncName -> (case (hd_1 _hdOconfig _hdOfuncName _hdOglobalDefinitions _hdOisInModule _hdOisMeta _hdOloopLevel _hdOmtokenPos _hdOscopeLevel _hdOscopes _hdOvariableStyle) of { ( _hdIglobalDefinitions,_hdIidentifier,_hdIisIfStatement,_hdIisInModule,_hdImtokenPos,_hdIscopes,_hdIstatementCount,_hdIvariableStyle,_hdIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIscopes {-# LINE 7441 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 7446 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIisInModule {-# LINE 7451 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIglobalDefinitions {-# LINE 7456 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 7461 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIvariableStyle {-# LINE 7466 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 7471 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdImtokenPos {-# LINE 7476 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 7481 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 7486 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOfuncName -> (case (tl_1 _tlOconfig _tlOfuncName _tlOglobalDefinitions _tlOisInModule _tlOisMeta _tlOloopLevel _tlOmtokenPos _tlOscopeLevel _tlOscopes _tlOvariableStyle) of { ( _tlIglobalDefinitions,_tlIidentifier,_tlIisIfStatement,_tlIisInModule,_tlImtokenPos,_tlIscopes,_tlIstatementCount,_tlIvariableStyle,_tlIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIglobalDefinitions {-# LINE 7493 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _hdIidentifier _tlIidentifier) {-# LINE 7498 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 208 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIisIfStatement || _tlIisIfStatement {-# LINE 7503 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIisInModule {-# LINE 7508 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 234 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdImtokenPos {-# LINE 7513 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIscopes {-# LINE 7518 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 157 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIstatementCount + _tlIstatementCount {-# LINE 7523 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOstatementCount -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIvariableStyle {-# LINE 7528 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIwarnings ++ _tlIwarnings {-# LINE 7533 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOstatementCount,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_MStatList_Cons_1)) of { ( sem_MStatList_1) -> ( _lhsOcopy,sem_MStatList_1) }) }) }) }) }) sem_MStatList_Nil :: T_MStatList sem_MStatList_Nil = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 7544 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 7549 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_MStatList_Nil_1 :: T_MStatList_1 sem_MStatList_Nil_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 7566 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 7571 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 208 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 7576 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 7581 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 7586 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 7591 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 240 "src/GLuaFixer/AG/ASTLint.ag" #-} 0 {-# LINE 7596 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOstatementCount -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 7601 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 7606 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOstatementCount,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) })) in sem_MStatList_Nil_1)) of { ( sem_MStatList_1) -> ( _lhsOcopy,sem_MStatList_1) }) }) }) -- MToken ------------------------------------------------------ -- cata sem_MToken :: MToken -> T_MToken sem_MToken (MToken _mpos _mtok) = (sem_MToken_MToken (sem_Region _mpos) (sem_Token _mtok)) -- semantic domain type T_MToken = ( MToken,Token,Region,T_MToken_1) type T_MToken_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Region -> ([M.Map String (Bool, Region)]) -> ( (M.Map String [Region]),String,Bool,([M.Map String (Bool, Region)]),([String -> LintMessage])) data Inh_MToken = Inh_MToken {config_Inh_MToken :: LintSettings,funcName_Inh_MToken :: String,globalDefinitions_Inh_MToken :: (M.Map String [Region]),isInModule_Inh_MToken :: Bool,isMeta_Inh_MToken :: Bool,mtokenPos_Inh_MToken :: Region,scopes_Inh_MToken :: ([M.Map String (Bool, Region)])} data Syn_MToken = Syn_MToken {copy_Syn_MToken :: MToken,globalDefinitions_Syn_MToken :: (M.Map String [Region]),identifier_Syn_MToken :: String,isInModule_Syn_MToken :: Bool,mtok_Syn_MToken :: Token,mtokenPos_Syn_MToken :: Region,scopes_Syn_MToken :: ([M.Map String (Bool, Region)]),warnings_Syn_MToken :: ([String -> LintMessage])} wrap_MToken :: T_MToken -> Inh_MToken -> Syn_MToken wrap_MToken sem (Inh_MToken _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsImtokenPos _lhsIscopes) = (let ( _lhsOcopy,_lhsOmtok,_lhsOmtokenPos,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOscopes,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsImtokenPos _lhsIscopes in (Syn_MToken _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtok _lhsOmtokenPos _lhsOscopes _lhsOwarnings)) sem_MToken_MToken :: T_Region -> T_Token -> T_MToken sem_MToken_MToken mpos_ mtok_ = (case (mtok_) of { ( _mtokIcopy,_mtokIidentifier,_mtokIwarnings) -> (case (mpos_) of { ( _mposIcopy,_mposIidentifier,_mposIwarnings) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} MToken _mposIcopy _mtokIcopy {-# LINE 7648 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 7653 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 227 "src/GLuaFixer/AG/ASTLint.ag" #-} _mtokIcopy {-# LINE 7658 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtok -> (case (({-# LINE 226 "src/GLuaFixer/AG/ASTLint.ag" #-} _mposIcopy {-# LINE 7663 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case ((let sem_MToken_MToken_1 :: T_MToken_1 sem_MToken_MToken_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsImtokenPos _lhsIscopes -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 7677 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 228 "src/GLuaFixer/AG/ASTLint.ag" #-} _mtokIidentifier {-# LINE 7682 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 7687 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 7692 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 229 "src/GLuaFixer/AG/ASTLint.ag" #-} _mposIwarnings ++ _mtokIwarnings {-# LINE 7697 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 229 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_goto_identifier _lhsIconfig) || _mtokIidentifier /= "goto" then id else (:) $ warn _mposIcopy GotoAsIdentifier {-# LINE 7703 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 229 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 7708 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOscopes,_lhsOwarnings) }) }) }) }) }) }) })) in sem_MToken_MToken_1)) of { ( sem_MToken_1) -> ( _lhsOcopy,_lhsOmtok,_lhsOmtokenPos,sem_MToken_1) }) }) }) }) }) }) }) -- MTokenList -------------------------------------------------- -- cata sem_MTokenList :: MTokenList -> T_MTokenList sem_MTokenList list = (Prelude.foldr sem_MTokenList_Cons sem_MTokenList_Nil (Prelude.map sem_MToken list)) -- semantic domain type T_MTokenList = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Region -> ([M.Map String (Bool, Region)]) -> ( MTokenList,(M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),([String -> LintMessage])) data Inh_MTokenList = Inh_MTokenList {config_Inh_MTokenList :: LintSettings,funcName_Inh_MTokenList :: String,globalDefinitions_Inh_MTokenList :: (M.Map String [Region]),isInModule_Inh_MTokenList :: Bool,isMeta_Inh_MTokenList :: Bool,mtokenPos_Inh_MTokenList :: Region,scopes_Inh_MTokenList :: ([M.Map String (Bool, Region)])} data Syn_MTokenList = Syn_MTokenList {copy_Syn_MTokenList :: MTokenList,globalDefinitions_Syn_MTokenList :: (M.Map String [Region]),identifier_Syn_MTokenList :: String,isInModule_Syn_MTokenList :: Bool,mtokenPos_Syn_MTokenList :: Region,scopes_Syn_MTokenList :: ([M.Map String (Bool, Region)]),warnings_Syn_MTokenList :: ([String -> LintMessage])} wrap_MTokenList :: T_MTokenList -> Inh_MTokenList -> Syn_MTokenList wrap_MTokenList sem (Inh_MTokenList _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsImtokenPos _lhsIscopes) = (let ( _lhsOcopy,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOwarnings) = sem _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsImtokenPos _lhsIscopes in (Syn_MTokenList _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOwarnings)) sem_MTokenList_Cons :: T_MToken -> T_MTokenList -> T_MTokenList sem_MTokenList_Cons hd_ tl_ = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsImtokenPos _lhsIscopes -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 7751 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOscopes -> (case (hd_) of { ( _hdIcopy,_hdImtok,_hdImtokenPos,hd_1) -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 7758 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOmtokenPos -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 7763 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 7768 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 7773 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 7778 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 7783 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOconfig -> (case (hd_1 _hdOconfig _hdOfuncName _hdOglobalDefinitions _hdOisInModule _hdOisMeta _hdOmtokenPos _hdOscopes) of { ( _hdIglobalDefinitions,_hdIidentifier,_hdIisInModule,_hdIscopes,_hdIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIscopes {-# LINE 7790 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOscopes -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdImtokenPos {-# LINE 7795 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOmtokenPos -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 7800 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIisInModule {-# LINE 7805 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIglobalDefinitions {-# LINE 7810 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 7815 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 7820 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOconfig -> (case (tl_ _tlOconfig _tlOfuncName _tlOglobalDefinitions _tlOisInModule _tlOisMeta _tlOmtokenPos _tlOscopes) of { ( _tlIcopy,_tlIglobalDefinitions,_tlIidentifier,_tlIisInModule,_tlImtokenPos,_tlIscopes,_tlIwarnings) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} (:) _hdIcopy _tlIcopy {-# LINE 7827 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 7832 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIglobalDefinitions {-# LINE 7837 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _hdIidentifier _tlIidentifier) {-# LINE 7842 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIisInModule {-# LINE 7847 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 234 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdImtokenPos {-# LINE 7852 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIscopes {-# LINE 7857 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIwarnings ++ _tlIwarnings {-# LINE 7862 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_MTokenList_Nil :: T_MTokenList sem_MTokenList_Nil = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsImtokenPos _lhsIscopes -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 7877 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 7882 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 7887 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 7892 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 7897 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 7902 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 7907 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 7912 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOwarnings) }) }) }) }) }) }) }) })) -- MaybeMExpr -------------------------------------------------- -- cata sem_MaybeMExpr :: MaybeMExpr -> T_MaybeMExpr sem_MaybeMExpr (Prelude.Just x) = (sem_MaybeMExpr_Just (sem_MExpr x)) sem_MaybeMExpr Prelude.Nothing = sem_MaybeMExpr_Nothing -- semantic domain type T_MaybeMExpr = ( MaybeMExpr,T_MaybeMExpr_1) type T_MaybeMExpr_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> (Maybe MToken) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,(Maybe MToken),Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_MaybeMExpr = Inh_MaybeMExpr {config_Inh_MaybeMExpr :: LintSettings,funcName_Inh_MaybeMExpr :: String,globalDefinitions_Inh_MaybeMExpr :: (M.Map String [Region]),isInModule_Inh_MaybeMExpr :: Bool,isMeta_Inh_MaybeMExpr :: Bool,isNegation_Inh_MaybeMExpr :: Bool,loopLevel_Inh_MaybeMExpr :: Int,mtokenPos_Inh_MaybeMExpr :: Region,scopeLevel_Inh_MaybeMExpr :: Int,scopes_Inh_MaybeMExpr :: ([M.Map String (Bool, Region)]),varBeingDefined_Inh_MaybeMExpr :: (Maybe MToken),variableStyle_Inh_MaybeMExpr :: DeterminedVariableStyle} data Syn_MaybeMExpr = Syn_MaybeMExpr {copy_Syn_MaybeMExpr :: MaybeMExpr,globalDefinitions_Syn_MaybeMExpr :: (M.Map String [Region]),identifier_Syn_MaybeMExpr :: String,isInModule_Syn_MaybeMExpr :: Bool,isSingleVar_Syn_MaybeMExpr :: (Maybe MToken),mtokenPos_Syn_MaybeMExpr :: Region,scopes_Syn_MaybeMExpr :: ([M.Map String (Bool, Region)]),variableStyle_Syn_MaybeMExpr :: DeterminedVariableStyle,warnings_Syn_MaybeMExpr :: ([String -> LintMessage])} wrap_MaybeMExpr :: T_MaybeMExpr -> Inh_MaybeMExpr -> Syn_MaybeMExpr wrap_MaybeMExpr sem (Inh_MaybeMExpr _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvarBeingDefined _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvarBeingDefined _lhsIvariableStyle in (Syn_MaybeMExpr _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOisSingleVar _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_MaybeMExpr_Just :: T_MExpr -> T_MaybeMExpr sem_MaybeMExpr_Just just_ = (case (just_) of { ( _justIcopy,_justImtokenPos,just_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Just _justIcopy {-# LINE 7955 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 7960 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_MaybeMExpr_Just_1 :: T_MaybeMExpr_1 sem_MaybeMExpr_Just_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 178 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvarBeingDefined {-# LINE 7979 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOvarBeingDefined -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 7984 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 7989 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 7994 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 7999 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 8004 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 8009 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 8014 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 8019 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 8024 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOloopLevel -> (case (({-# LINE 169 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisNegation {-# LINE 8029 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOisNegation -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 8034 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOfuncName -> (case (({-# LINE 251 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 8039 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOtopLevel -> (case (({-# LINE 250 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 8044 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _justOinParentheses -> (case (just_1 _justOconfig _justOfuncName _justOglobalDefinitions _justOinParentheses _justOisInModule _justOisMeta _justOisNegation _justOloopLevel _justOmtokenPos _justOscopeLevel _justOscopes _justOtopLevel _justOvarBeingDefined _justOvariableStyle) of { ( _justIglobalDefinitions,_justIidentifier,_justIisInModule,_justIisSimpleExpression,_justIisSingleVar,_justIscopes,_justIvariableStyle,_justIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _justIglobalDefinitions {-# LINE 8051 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _justIidentifier {-# LINE 8056 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _justIisInModule {-# LINE 8061 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} _justIisSingleVar {-# LINE 8066 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _justImtokenPos {-# LINE 8071 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _justIscopes {-# LINE 8076 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _justIvariableStyle {-# LINE 8081 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _justIwarnings {-# LINE 8086 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_MaybeMExpr_Just_1)) of { ( sem_MaybeMExpr_1) -> ( _lhsOcopy,sem_MaybeMExpr_1) }) }) }) }) sem_MaybeMExpr_Nothing :: T_MaybeMExpr sem_MaybeMExpr_Nothing = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 8097 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 8102 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_MaybeMExpr_Nothing_1 :: T_MaybeMExpr_1 sem_MaybeMExpr_Nothing_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 8121 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 8126 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 8131 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 213 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 8136 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 8141 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 8146 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 8151 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 8156 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSingleVar,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) })) in sem_MaybeMExpr_Nothing_1)) of { ( sem_MaybeMExpr_1) -> ( _lhsOcopy,sem_MaybeMExpr_1) }) }) }) -- PFExprSuffix ------------------------------------------------ -- cata sem_PFExprSuffix :: PFExprSuffix -> T_PFExprSuffix sem_PFExprSuffix (Call _args) = (sem_PFExprSuffix_Call (sem_Args _args)) sem_PFExprSuffix (MetaCall _fn _args) = (sem_PFExprSuffix_MetaCall (sem_MToken _fn) (sem_Args _args)) sem_PFExprSuffix (ExprIndex _index) = (sem_PFExprSuffix_ExprIndex (sem_MExpr _index)) sem_PFExprSuffix (DotIndex _index) = (sem_PFExprSuffix_DotIndex (sem_MToken _index)) -- semantic domain type T_PFExprSuffix = ( PFExprSuffix,T_PFExprSuffix_1) type T_PFExprSuffix_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_PFExprSuffix = Inh_PFExprSuffix {config_Inh_PFExprSuffix :: LintSettings,funcName_Inh_PFExprSuffix :: String,globalDefinitions_Inh_PFExprSuffix :: (M.Map String [Region]),isInModule_Inh_PFExprSuffix :: Bool,isMeta_Inh_PFExprSuffix :: Bool,loopLevel_Inh_PFExprSuffix :: Int,mtokenPos_Inh_PFExprSuffix :: Region,scopeLevel_Inh_PFExprSuffix :: Int,scopes_Inh_PFExprSuffix :: ([M.Map String (Bool, Region)]),variableStyle_Inh_PFExprSuffix :: DeterminedVariableStyle} data Syn_PFExprSuffix = Syn_PFExprSuffix {copy_Syn_PFExprSuffix :: PFExprSuffix,globalDefinitions_Syn_PFExprSuffix :: (M.Map String [Region]),identifier_Syn_PFExprSuffix :: String,isInModule_Syn_PFExprSuffix :: Bool,isSimpleExpression_Syn_PFExprSuffix :: Bool,mtokenPos_Syn_PFExprSuffix :: Region,scopes_Syn_PFExprSuffix :: ([M.Map String (Bool, Region)]),variableStyle_Syn_PFExprSuffix :: DeterminedVariableStyle,warnings_Syn_PFExprSuffix :: ([String -> LintMessage])} wrap_PFExprSuffix :: T_PFExprSuffix -> Inh_PFExprSuffix -> Syn_PFExprSuffix wrap_PFExprSuffix sem (Inh_PFExprSuffix _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_PFExprSuffix _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOisSimpleExpression _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_PFExprSuffix_Call :: T_Args -> T_PFExprSuffix sem_PFExprSuffix_Call args_ = (case (args_) of { ( _argsIcopy,args_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Call _argsIcopy {-# LINE 8204 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 8209 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_PFExprSuffix_Call_1 :: T_PFExprSuffix_1 sem_PFExprSuffix_Call_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 8226 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 8231 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 8236 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 8241 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 8246 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 8251 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 8256 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 8261 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 8266 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 8271 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOfuncName -> (case (args_1 _argsOconfig _argsOfuncName _argsOglobalDefinitions _argsOisInModule _argsOisMeta _argsOloopLevel _argsOmtokenPos _argsOscopeLevel _argsOscopes _argsOvariableStyle) of { ( _argsIglobalDefinitions,_argsIidentifier,_argsIisInModule,_argsImtokenPos,_argsIscopes,_argsIvariableStyle,_argsIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIglobalDefinitions {-# LINE 8278 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIidentifier {-# LINE 8283 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIisInModule {-# LINE 8288 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 545 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 8293 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsImtokenPos {-# LINE 8298 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIscopes {-# LINE 8303 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIvariableStyle {-# LINE 8308 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIwarnings {-# LINE 8313 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_PFExprSuffix_Call_1)) of { ( sem_PFExprSuffix_1) -> ( _lhsOcopy,sem_PFExprSuffix_1) }) }) }) }) sem_PFExprSuffix_MetaCall :: T_MToken -> T_Args -> T_PFExprSuffix sem_PFExprSuffix_MetaCall fn_ args_ = (case (args_) of { ( _argsIcopy,args_1) -> (case (fn_) of { ( _fnIcopy,_fnImtok,_fnImtokenPos,fn_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} MetaCall _fnIcopy _argsIcopy {-# LINE 8330 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 8335 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_PFExprSuffix_MetaCall_1 :: T_PFExprSuffix_1 sem_PFExprSuffix_MetaCall_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 8352 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOscopes -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 8357 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOmtokenPos -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 8362 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 8367 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 8372 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 8377 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 8382 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOconfig -> (case (fn_1 _fnOconfig _fnOfuncName _fnOglobalDefinitions _fnOisInModule _fnOisMeta _fnOmtokenPos _fnOscopes) of { ( _fnIglobalDefinitions,_fnIidentifier,_fnIisInModule,_fnIscopes,_fnIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _fnIscopes {-# LINE 8389 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 8394 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _fnIisInModule {-# LINE 8399 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _fnIglobalDefinitions {-# LINE 8404 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 8409 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 8414 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 8419 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _fnImtokenPos {-# LINE 8424 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 8429 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 8434 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argsOfuncName -> (case (args_1 _argsOconfig _argsOfuncName _argsOglobalDefinitions _argsOisInModule _argsOisMeta _argsOloopLevel _argsOmtokenPos _argsOscopeLevel _argsOscopes _argsOvariableStyle) of { ( _argsIglobalDefinitions,_argsIidentifier,_argsIisInModule,_argsImtokenPos,_argsIscopes,_argsIvariableStyle,_argsIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIglobalDefinitions {-# LINE 8441 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _fnIidentifier _argsIidentifier) {-# LINE 8446 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIisInModule {-# LINE 8451 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 547 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 8456 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsImtokenPos {-# LINE 8461 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIscopes {-# LINE 8466 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _argsIvariableStyle {-# LINE 8471 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _fnIwarnings ++ _argsIwarnings {-# LINE 8476 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_PFExprSuffix_MetaCall_1)) of { ( sem_PFExprSuffix_1) -> ( _lhsOcopy,sem_PFExprSuffix_1) }) }) }) }) }) sem_PFExprSuffix_ExprIndex :: T_MExpr -> T_PFExprSuffix sem_PFExprSuffix_ExprIndex index_ = (case (index_) of { ( _indexIcopy,_indexImtokenPos,index_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ExprIndex _indexIcopy {-# LINE 8490 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 8495 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_PFExprSuffix_ExprIndex_1 :: T_PFExprSuffix_1 sem_PFExprSuffix_ExprIndex_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 8512 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 8517 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 8522 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 8527 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 8532 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOconfig -> (case (({-# LINE 552 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 8537 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOvarBeingDefined -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 8542 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 8547 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 8552 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 8557 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 8562 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOfuncName -> (case (({-# LINE 551 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 8567 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOtopLevel -> (case (({-# LINE 550 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 8572 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOinParentheses -> (case (({-# LINE 549 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 8577 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOisNegation -> (case (index_1 _indexOconfig _indexOfuncName _indexOglobalDefinitions _indexOinParentheses _indexOisInModule _indexOisMeta _indexOisNegation _indexOloopLevel _indexOmtokenPos _indexOscopeLevel _indexOscopes _indexOtopLevel _indexOvarBeingDefined _indexOvariableStyle) of { ( _indexIglobalDefinitions,_indexIidentifier,_indexIisInModule,_indexIisSimpleExpression,_indexIisSingleVar,_indexIscopes,_indexIvariableStyle,_indexIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexIglobalDefinitions {-# LINE 8584 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexIidentifier {-# LINE 8589 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexIisInModule {-# LINE 8594 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexIisSimpleExpression {-# LINE 8599 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexImtokenPos {-# LINE 8604 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexIscopes {-# LINE 8609 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexIvariableStyle {-# LINE 8614 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexIwarnings {-# LINE 8619 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_PFExprSuffix_ExprIndex_1)) of { ( sem_PFExprSuffix_1) -> ( _lhsOcopy,sem_PFExprSuffix_1) }) }) }) }) sem_PFExprSuffix_DotIndex :: T_MToken -> T_PFExprSuffix sem_PFExprSuffix_DotIndex index_ = (case (index_) of { ( _indexIcopy,_indexImtok,_indexImtokenPos,index_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} DotIndex _indexIcopy {-# LINE 8633 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 8638 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_PFExprSuffix_DotIndex_1 :: T_PFExprSuffix_1 sem_PFExprSuffix_DotIndex_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 8655 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOglobalDefinitions -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 8660 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOscopes -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 8665 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOmtokenPos -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 8670 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 8675 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOisInModule -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 8680 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 8685 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _indexOconfig -> (case (index_1 _indexOconfig _indexOfuncName _indexOglobalDefinitions _indexOisInModule _indexOisMeta _indexOmtokenPos _indexOscopes) of { ( _indexIglobalDefinitions,_indexIidentifier,_indexIisInModule,_indexIscopes,_indexIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexIglobalDefinitions {-# LINE 8692 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexIidentifier {-# LINE 8697 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexIisInModule {-# LINE 8702 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 8707 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexImtokenPos {-# LINE 8712 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexIscopes {-# LINE 8717 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 8722 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _indexIwarnings {-# LINE 8727 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_PFExprSuffix_DotIndex_1)) of { ( sem_PFExprSuffix_1) -> ( _lhsOcopy,sem_PFExprSuffix_1) }) }) }) }) -- PrefixExp --------------------------------------------------- -- cata sem_PrefixExp :: PrefixExp -> T_PrefixExp sem_PrefixExp (PFVar _name _suffixes) = (sem_PrefixExp_PFVar (sem_MToken _name) (sem_ExprSuffixList _suffixes)) sem_PrefixExp (ExprVar _expr _suffixes) = (sem_PrefixExp_ExprVar (sem_MExpr _expr) (sem_ExprSuffixList _suffixes)) -- semantic domain type T_PrefixExp = ( PrefixExp,Bool,Region,(Maybe MToken),T_PrefixExp_1) type T_PrefixExp_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Bool -> Bool -> Int -> Region -> Bool -> Int -> ([M.Map String (Bool, Region)]) -> Bool -> (Maybe MToken) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Bool,(Maybe MToken),([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_PrefixExp = Inh_PrefixExp {config_Inh_PrefixExp :: LintSettings,funcName_Inh_PrefixExp :: String,globalDefinitions_Inh_PrefixExp :: (M.Map String [Region]),inParentheses_Inh_PrefixExp :: Bool,isInModule_Inh_PrefixExp :: Bool,isMeta_Inh_PrefixExp :: Bool,isNegation_Inh_PrefixExp :: Bool,loopLevel_Inh_PrefixExp :: Int,mtokenPos_Inh_PrefixExp :: Region,registerVarUse_Inh_PrefixExp :: Bool,scopeLevel_Inh_PrefixExp :: Int,scopes_Inh_PrefixExp :: ([M.Map String (Bool, Region)]),topLevel_Inh_PrefixExp :: Bool,varBeingDefined_Inh_PrefixExp :: (Maybe MToken),variableStyle_Inh_PrefixExp :: DeterminedVariableStyle} data Syn_PrefixExp = Syn_PrefixExp {copy_Syn_PrefixExp :: PrefixExp,globalDefinitions_Syn_PrefixExp :: (M.Map String [Region]),hasSuffixes_Syn_PrefixExp :: Bool,identifier_Syn_PrefixExp :: String,isInModule_Syn_PrefixExp :: Bool,isSimpleExpression_Syn_PrefixExp :: Bool,isSingleVar_Syn_PrefixExp :: (Maybe MToken),mtokenPos_Syn_PrefixExp :: Region,scopes_Syn_PrefixExp :: ([M.Map String (Bool, Region)]),varName_Syn_PrefixExp :: (Maybe MToken),variableStyle_Syn_PrefixExp :: DeterminedVariableStyle,warnings_Syn_PrefixExp :: ([String -> LintMessage])} wrap_PrefixExp :: T_PrefixExp -> Inh_PrefixExp -> Syn_PrefixExp wrap_PrefixExp sem (Inh_PrefixExp _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIregisterVarUse _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle) = (let ( _lhsOcopy,_lhsOhasSuffixes,_lhsOmtokenPos,_lhsOvarName,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIregisterVarUse _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle in (Syn_PrefixExp _lhsOcopy _lhsOglobalDefinitions _lhsOhasSuffixes _lhsOidentifier _lhsOisInModule _lhsOisSimpleExpression _lhsOisSingleVar _lhsOmtokenPos _lhsOscopes _lhsOvarName _lhsOvariableStyle _lhsOwarnings)) sem_PrefixExp_PFVar :: T_MToken -> T_ExprSuffixList -> T_PrefixExp sem_PrefixExp_PFVar name_ suffixes_ = (case (suffixes_) of { ( _suffixesIcopy,suffixes_1) -> (case (name_) of { ( _nameIcopy,_nameImtok,_nameImtokenPos,name_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} PFVar _nameIcopy _suffixesIcopy {-# LINE 8779 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 8784 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 507 "src/GLuaFixer/AG/ASTLint.ag" #-} not . null $ _suffixesIcopy {-# LINE 8789 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOhasSuffixes -> (case (({-# LINE 506 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameImtokenPos {-# LINE 8794 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 509 "src/GLuaFixer/AG/ASTLint.ag" #-} Just _nameIcopy {-# LINE 8799 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varName -> (case (({-# LINE 192 "src/GLuaFixer/AG/ASTLint.ag" #-} _varName {-# LINE 8804 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvarName -> (case ((let sem_PrefixExp_PFVar_1 :: T_PrefixExp_1 sem_PrefixExp_PFVar_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIregisterVarUse _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 513 "src/GLuaFixer/AG/ASTLint.ag" #-} if isJust _lhsIvarBeingDefined && _lhsIvarBeingDefined == _varName then case _lhsIscopes of deepestScope : otherScopes -> deepestScope : registerVariable otherScopes _nameImtokenPos (show _nameImtok) _lhsIregisterVarUse noScopes -> noScopes else registerVariable _lhsIscopes _nameImtokenPos (show _nameImtok) _lhsIregisterVarUse {-# LINE 8831 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _foundVars -> (case (({-# LINE 523 "src/GLuaFixer/AG/ASTLint.ag" #-} _foundVars {-# LINE 8836 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOscopes -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 8841 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOmtokenPos -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 8846 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 8851 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 8856 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 8861 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 8866 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOconfig -> (case (name_1 _nameOconfig _nameOfuncName _nameOglobalDefinitions _nameOisInModule _nameOisMeta _nameOmtokenPos _nameOscopes) of { ( _nameIglobalDefinitions,_nameIidentifier,_nameIisInModule,_nameIscopes,_nameIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIscopes {-# LINE 8873 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 8878 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIisInModule {-# LINE 8883 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIglobalDefinitions {-# LINE 8888 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 8893 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 8898 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 8903 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameImtokenPos {-# LINE 8908 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 8913 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 8918 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOfuncName -> (case (suffixes_1 _suffixesOconfig _suffixesOfuncName _suffixesOglobalDefinitions _suffixesOisInModule _suffixesOisMeta _suffixesOloopLevel _suffixesOmtokenPos _suffixesOscopeLevel _suffixesOscopes _suffixesOvariableStyle) of { ( _suffixesIglobalDefinitions,_suffixesIidentifier,_suffixesIisInModule,_suffixesIisSimpleExpression,_suffixesImtokenPos,_suffixesIscopes,_suffixesIvariableStyle,_suffixesIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _suffixesIglobalDefinitions {-# LINE 8925 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _nameIidentifier _suffixesIidentifier) {-# LINE 8930 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _suffixesIisInModule {-# LINE 8935 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} _suffixesIisSimpleExpression {-# LINE 8940 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 508 "src/GLuaFixer/AG/ASTLint.ag" #-} if null _suffixesIcopy then _varName else Nothing {-# LINE 8945 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _suffixesIscopes {-# LINE 8950 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _suffixesIvariableStyle {-# LINE 8955 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 529 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIwarnings ++ _suffixesIwarnings {-# LINE 8960 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 522 "src/GLuaFixer/AG/ASTLint.ag" #-} tokenLabel _nameIcopy {-# LINE 8965 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _name -> (case (({-# LINE 529 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_beginnerMistakes _lhsIconfig) || _lhsIisMeta || _name /= "self" then id else (:) $ warn _nameImtokenPos SelfInNonMeta {-# LINE 8971 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f3 -> (case (({-# LINE 529 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_beginnerMistakes _lhsIconfig) || not _lhsIisMeta || _name /= "self" || _lhsIfuncName /= "ENT" || _suffixesIidentifier /= "Entity" then id else (:) $ warn _nameImtokenPos SelfEntity {-# LINE 8978 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f2 -> (case (({-# LINE 529 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_beginnerMistakes _lhsIconfig) || not _lhsIisMeta || _name /= "self" || _lhsIfuncName /= "SWEP" || _suffixesIidentifier /= "Weapon" then id else (:) $ warn _nameImtokenPos SelfWeapon {-# LINE 8985 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 529 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1, _warnings_augmented_f2, _warnings_augmented_f3] {-# LINE 8990 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_PrefixExp_PFVar_1)) of { ( sem_PrefixExp_1) -> ( _lhsOcopy,_lhsOhasSuffixes,_lhsOmtokenPos,_lhsOvarName,sem_PrefixExp_1) }) }) }) }) }) }) }) }) }) sem_PrefixExp_ExprVar :: T_MExpr -> T_ExprSuffixList -> T_PrefixExp sem_PrefixExp_ExprVar expr_ suffixes_ = (case (suffixes_) of { ( _suffixesIcopy,suffixes_1) -> (case (expr_) of { ( _exprIcopy,_exprImtokenPos,expr_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ExprVar _exprIcopy _suffixesIcopy {-# LINE 9007 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 9012 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 536 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 9017 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOhasSuffixes -> (case (({-# LINE 533 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprImtokenPos {-# LINE 9022 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 535 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 9027 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvarName -> (case ((let sem_PrefixExp_ExprVar_1 :: T_PrefixExp_1 sem_PrefixExp_ExprVar_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIinParentheses _lhsIisInModule _lhsIisMeta _lhsIisNegation _lhsIloopLevel _lhsImtokenPos _lhsIregisterVarUse _lhsIscopeLevel _lhsIscopes _lhsItopLevel _lhsIvarBeingDefined _lhsIvariableStyle -> (case (({-# LINE 178 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvarBeingDefined {-# LINE 9049 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOvarBeingDefined -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 9054 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 9059 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 9064 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 9069 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 9074 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 9079 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 9084 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOloopLevel -> (case (({-# LINE 169 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisNegation {-# LINE 9089 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOisNegation -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 9094 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 9099 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 9104 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOfuncName -> (case (({-# LINE 538 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 9109 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOtopLevel -> (case (({-# LINE 537 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 9114 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _exprOinParentheses -> (case (expr_1 _exprOconfig _exprOfuncName _exprOglobalDefinitions _exprOinParentheses _exprOisInModule _exprOisMeta _exprOisNegation _exprOloopLevel _exprOmtokenPos _exprOscopeLevel _exprOscopes _exprOtopLevel _exprOvarBeingDefined _exprOvariableStyle) of { ( _exprIglobalDefinitions,_exprIidentifier,_exprIisInModule,_exprIisSimpleExpression,_exprIisSingleVar,_exprIscopes,_exprIvariableStyle,_exprIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprIscopes {-# LINE 9121 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 9126 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprIisInModule {-# LINE 9131 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprIglobalDefinitions {-# LINE 9136 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 9141 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprIvariableStyle {-# LINE 9146 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 9151 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprImtokenPos {-# LINE 9156 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 9161 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 9166 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _suffixesOfuncName -> (case (suffixes_1 _suffixesOconfig _suffixesOfuncName _suffixesOglobalDefinitions _suffixesOisInModule _suffixesOisMeta _suffixesOloopLevel _suffixesOmtokenPos _suffixesOscopeLevel _suffixesOscopes _suffixesOvariableStyle) of { ( _suffixesIglobalDefinitions,_suffixesIidentifier,_suffixesIisInModule,_suffixesIisSimpleExpression,_suffixesImtokenPos,_suffixesIscopes,_suffixesIvariableStyle,_suffixesIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _suffixesIglobalDefinitions {-# LINE 9173 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _exprIidentifier _suffixesIidentifier) {-# LINE 9178 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _suffixesIisInModule {-# LINE 9183 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 186 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprIisSimpleExpression && _suffixesIisSimpleExpression {-# LINE 9188 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSimpleExpression -> (case (({-# LINE 534 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 9193 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisSingleVar -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _suffixesIscopes {-# LINE 9198 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _suffixesIvariableStyle {-# LINE 9203 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 539 "src/GLuaFixer/AG/ASTLint.ag" #-} _exprIwarnings ++ _suffixesIwarnings {-# LINE 9208 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 539 "src/GLuaFixer/AG/ASTLint.ag" #-} if lint_redundantParentheses _lhsIconfig && null _suffixesIcopy && (_lhsIinParentheses || (not _lhsItopLevel && _exprIisSimpleExpression)) then (:) $ warn _lhsImtokenPos UnnecessaryParentheses else id {-# LINE 9215 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 539 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 9220 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisSimpleExpression,_lhsOisSingleVar,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_PrefixExp_ExprVar_1)) of { ( sem_PrefixExp_1) -> ( _lhsOcopy,_lhsOhasSuffixes,_lhsOmtokenPos,_lhsOvarName,sem_PrefixExp_1) }) }) }) }) }) }) }) }) -- Region ------------------------------------------------------ -- cata sem_Region :: Region -> T_Region sem_Region (Region _start _end) = (sem_Region_Region _start _end) -- semantic domain type T_Region = ( Region,String,([String -> LintMessage])) data Inh_Region = Inh_Region {} data Syn_Region = Syn_Region {copy_Syn_Region :: Region,identifier_Syn_Region :: String,warnings_Syn_Region :: ([String -> LintMessage])} wrap_Region :: T_Region -> Inh_Region -> Syn_Region wrap_Region sem (Inh_Region) = (let ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) = sem in (Syn_Region _lhsOcopy _lhsOidentifier _lhsOwarnings)) sem_Region_Region :: LineColPos -> LineColPos -> T_Region sem_Region_Region start_ end_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Region start_ end_ {-# LINE 9249 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 9254 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 9259 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 9264 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) -- Stat -------------------------------------------------------- -- cata sem_Stat :: Stat -> T_Stat sem_Stat (Def _vars) = (sem_Stat_Def (sem_VarsList _vars)) sem_Stat (LocDef _vars) = (sem_Stat_LocDef (sem_VarsList _vars)) sem_Stat (AFuncCall _fn) = (sem_Stat_AFuncCall (sem_PrefixExp _fn)) sem_Stat (ALabel _lbl) = (sem_Stat_ALabel (sem_MToken _lbl)) sem_Stat (ABreak) = (sem_Stat_ABreak) sem_Stat (AContinue) = (sem_Stat_AContinue) sem_Stat (AGoto _lbl) = (sem_Stat_AGoto (sem_MToken _lbl)) sem_Stat (ADo _body) = (sem_Stat_ADo (sem_Block _body)) sem_Stat (AWhile _cond _body) = (sem_Stat_AWhile (sem_MExpr _cond) (sem_Block _body)) sem_Stat (ARepeat _body _cond) = (sem_Stat_ARepeat (sem_Block _body) (sem_MExpr _cond)) sem_Stat (AIf _cond _body _elifs _els) = (sem_Stat_AIf (sem_MExpr _cond) (sem_Block _body) (sem_ElseIfList _elifs) (sem_Else _els)) sem_Stat (ANFor _var _val _to _step _body) = (sem_Stat_ANFor (sem_MToken _var) (sem_MExpr _val) (sem_MExpr _to) (sem_MExpr _step) (sem_Block _body)) sem_Stat (AGFor _vars _vals _body) = (sem_Stat_AGFor _vars (sem_MExprList _vals) (sem_Block _body)) sem_Stat (AFunc _name _args _body) = (sem_Stat_AFunc (sem_FuncName _name) _args (sem_Block _body)) sem_Stat (ALocFunc _name _args _body) = (sem_Stat_ALocFunc (sem_FuncName _name) _args (sem_Block _body)) -- semantic domain type T_Stat = ( Stat,T_Stat_1) type T_Stat_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_Stat = Inh_Stat {config_Inh_Stat :: LintSettings,funcName_Inh_Stat :: String,globalDefinitions_Inh_Stat :: (M.Map String [Region]),isInModule_Inh_Stat :: Bool,isMeta_Inh_Stat :: Bool,loopLevel_Inh_Stat :: Int,mtokenPos_Inh_Stat :: Region,scopeLevel_Inh_Stat :: Int,scopes_Inh_Stat :: ([M.Map String (Bool, Region)]),variableStyle_Inh_Stat :: DeterminedVariableStyle} data Syn_Stat = Syn_Stat {copy_Syn_Stat :: Stat,globalDefinitions_Syn_Stat :: (M.Map String [Region]),identifier_Syn_Stat :: String,isIfStatement_Syn_Stat :: Bool,isInModule_Syn_Stat :: Bool,mtokenPos_Syn_Stat :: Region,scopes_Syn_Stat :: ([M.Map String (Bool, Region)]),variableStyle_Syn_Stat :: DeterminedVariableStyle,warnings_Syn_Stat :: ([String -> LintMessage])} wrap_Stat :: T_Stat -> Inh_Stat -> Syn_Stat wrap_Stat sem (Inh_Stat _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_Stat _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisIfStatement _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_Stat_Def :: T_VarsList -> T_Stat sem_Stat_Def vars_ = (case (vars_) of { ( _varsIcopy,vars_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Def _varsIcopy {-# LINE 9331 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 9336 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_Def_1 :: T_Stat_1 sem_Stat_Def_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 9353 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 9358 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 9363 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 9368 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 9373 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOconfig -> (case (({-# LINE 314 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 9378 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOlocalDefinition -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 9383 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 9388 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 9393 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 9398 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 9403 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOfuncName -> (case (vars_1 _varsOconfig _varsOfuncName _varsOglobalDefinitions _varsOisInModule _varsOisMeta _varsOlocalDefinition _varsOloopLevel _varsOmtokenPos _varsOscopeLevel _varsOscopes _varsOvariableStyle) of { ( _varsIglobalDefinitions,_varsIidentifier,_varsIisInModule,_varsImtokenPos,_varsIscopes,_varsIvariableStyle,_varsIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsIglobalDefinitions {-# LINE 9410 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsIidentifier {-# LINE 9415 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 208 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 9420 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsIisInModule {-# LINE 9425 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsImtokenPos {-# LINE 9430 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsIscopes {-# LINE 9435 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsIvariableStyle {-# LINE 9440 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsIwarnings {-# LINE 9445 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Stat_Def_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) }) sem_Stat_LocDef :: T_VarsList -> T_Stat sem_Stat_LocDef vars_ = (case (vars_) of { ( _varsIcopy,vars_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} LocDef _varsIcopy {-# LINE 9459 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 9464 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_LocDef_1 :: T_Stat_1 sem_Stat_LocDef_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 9481 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 9486 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 9491 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 9496 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 9501 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOconfig -> (case (({-# LINE 317 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 9506 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOlocalDefinition -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 9511 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 9516 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 9521 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 9526 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 9531 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varsOfuncName -> (case (vars_1 _varsOconfig _varsOfuncName _varsOglobalDefinitions _varsOisInModule _varsOisMeta _varsOlocalDefinition _varsOloopLevel _varsOmtokenPos _varsOscopeLevel _varsOscopes _varsOvariableStyle) of { ( _varsIglobalDefinitions,_varsIidentifier,_varsIisInModule,_varsImtokenPos,_varsIscopes,_varsIvariableStyle,_varsIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsIglobalDefinitions {-# LINE 9538 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsIidentifier {-# LINE 9543 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 208 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 9548 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsIisInModule {-# LINE 9553 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsImtokenPos {-# LINE 9558 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsIscopes {-# LINE 9563 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsIvariableStyle {-# LINE 9568 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _varsIwarnings {-# LINE 9573 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Stat_LocDef_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) }) sem_Stat_AFuncCall :: T_PrefixExp -> T_Stat sem_Stat_AFuncCall fn_ = (case (fn_) of { ( _fnIcopy,_fnIhasSuffixes,_fnImtokenPos,_fnIvarName,fn_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AFuncCall _fnIcopy {-# LINE 9587 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 9592 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_AFuncCall_1 :: T_Stat_1 sem_Stat_AFuncCall_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 9609 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 9614 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 9619 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 9624 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 9629 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOconfig -> (case (({-# LINE 323 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 9634 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOvarBeingDefined -> (case (({-# LINE 320 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 9639 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOregisterVarUse -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 9644 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 9649 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 9654 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 9659 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 9664 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOfuncName -> (case (({-# LINE 322 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 9669 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOtopLevel -> (case (({-# LINE 321 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 9674 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOinParentheses -> (case (({-# LINE 319 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 9679 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _fnOisNegation -> (case (fn_1 _fnOconfig _fnOfuncName _fnOglobalDefinitions _fnOinParentheses _fnOisInModule _fnOisMeta _fnOisNegation _fnOloopLevel _fnOmtokenPos _fnOregisterVarUse _fnOscopeLevel _fnOscopes _fnOtopLevel _fnOvarBeingDefined _fnOvariableStyle) of { ( _fnIglobalDefinitions,_fnIidentifier,_fnIisInModule,_fnIisSimpleExpression,_fnIisSingleVar,_fnIscopes,_fnIvariableStyle,_fnIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _fnIglobalDefinitions {-# LINE 9686 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _fnIidentifier {-# LINE 9691 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 208 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 9696 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 324 "src/GLuaFixer/AG/ASTLint.ag" #-} (tokenLabel <$> _fnIvarName) == Just "module" {-# LINE 9701 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _isModuleCall -> (case (({-# LINE 325 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule || _isModuleCall {-# LINE 9706 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _fnImtokenPos {-# LINE 9711 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _fnIscopes {-# LINE 9716 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _fnIvariableStyle {-# LINE 9721 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _fnIwarnings {-# LINE 9726 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Stat_AFuncCall_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) }) sem_Stat_ALabel :: T_MToken -> T_Stat sem_Stat_ALabel lbl_ = (case (lbl_) of { ( _lblIcopy,_lblImtok,_lblImtokenPos,lbl_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ALabel _lblIcopy {-# LINE 9740 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 9745 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_ALabel_1 :: T_Stat_1 sem_Stat_ALabel_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 9762 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOglobalDefinitions -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 9767 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOscopes -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 9772 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOmtokenPos -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 9777 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 9782 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOisInModule -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 9787 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 9792 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOconfig -> (case (lbl_1 _lblOconfig _lblOfuncName _lblOglobalDefinitions _lblOisInModule _lblOisMeta _lblOmtokenPos _lblOscopes) of { ( _lblIglobalDefinitions,_lblIidentifier,_lblIisInModule,_lblIscopes,_lblIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lblIglobalDefinitions {-# LINE 9799 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _lblIidentifier {-# LINE 9804 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 208 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 9809 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lblIisInModule {-# LINE 9814 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lblImtokenPos {-# LINE 9819 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lblIscopes {-# LINE 9824 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 9829 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _lblIwarnings {-# LINE 9834 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Stat_ALabel_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) }) sem_Stat_ABreak :: T_Stat sem_Stat_ABreak = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ABreak {-# LINE 9845 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 9850 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_ABreak_1 :: T_Stat_1 sem_Stat_ABreak_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 9867 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 9872 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 208 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 9877 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 9882 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 9887 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 9892 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 9897 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 9902 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) })) in sem_Stat_ABreak_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) sem_Stat_AContinue :: T_Stat sem_Stat_AContinue = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AContinue {-# LINE 9913 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 9918 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_AContinue_1 :: T_Stat_1 sem_Stat_AContinue_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 9935 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 9940 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 208 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 9945 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 9950 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 9955 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 9960 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 9965 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 9970 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) })) in sem_Stat_AContinue_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) sem_Stat_AGoto :: T_MToken -> T_Stat sem_Stat_AGoto lbl_ = (case (lbl_) of { ( _lblIcopy,_lblImtok,_lblImtokenPos,lbl_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AGoto _lblIcopy {-# LINE 9984 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 9989 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_AGoto_1 :: T_Stat_1 sem_Stat_AGoto_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 10006 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOglobalDefinitions -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 10011 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOscopes -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 10016 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOmtokenPos -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 10021 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 10026 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOisInModule -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 10031 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 10036 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lblOconfig -> (case (lbl_1 _lblOconfig _lblOfuncName _lblOglobalDefinitions _lblOisInModule _lblOisMeta _lblOmtokenPos _lblOscopes) of { ( _lblIglobalDefinitions,_lblIidentifier,_lblIisInModule,_lblIscopes,_lblIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lblIglobalDefinitions {-# LINE 10043 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _lblIidentifier {-# LINE 10048 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 208 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 10053 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lblIisInModule {-# LINE 10058 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lblImtokenPos {-# LINE 10063 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lblIscopes {-# LINE 10068 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 10073 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 330 "src/GLuaFixer/AG/ASTLint.ag" #-} _lblIwarnings {-# LINE 10078 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 330 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_gotos _lhsIconfig) || _lhsIloopLevel >= 2 then id else (:) $ warn _lblImtokenPos AvoidGoto {-# LINE 10084 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 330 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 10089 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Stat_AGoto_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) }) sem_Stat_ADo :: T_Block -> T_Stat sem_Stat_ADo body_ = (case (body_) of { ( _bodyIcopy,body_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ADo _bodyIcopy {-# LINE 10103 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 10108 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_ADo_1 :: T_Stat_1 sem_Stat_ADo_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 10125 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 10130 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 10135 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 10140 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOconfig -> (case (({-# LINE 334 "src/GLuaFixer/AG/ASTLint.ag" #-} M.empty : _lhsIscopes {-# LINE 10145 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 10150 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 10155 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 10160 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 10165 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 10170 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOfuncName -> (case (({-# LINE 335 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 10175 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisRepeat -> (case (body_1 _bodyOconfig _bodyOfuncName _bodyOglobalDefinitions _bodyOisInModule _bodyOisMeta _bodyOisRepeat _bodyOloopLevel _bodyOmtokenPos _bodyOscopeLevel _bodyOscopes _bodyOvariableStyle) of { ( _bodyIglobalDefinitions,_bodyIidentifier,_bodyIisIfStatement,_bodyIisInModule,_bodyImtokenPos,_bodyIscopes,_bodyIstatementCount,_bodyIvariableStyle,_bodyIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIglobalDefinitions {-# LINE 10182 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIidentifier {-# LINE 10187 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 333 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 10192 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIisInModule {-# LINE 10197 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyImtokenPos {-# LINE 10202 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIscopes {-# LINE 10207 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIvariableStyle {-# LINE 10212 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 336 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIwarnings {-# LINE 10217 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 336 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_emptyBlocks _lhsIconfig) || _bodyIstatementCount > 0 then id else (:) $ warn _lhsImtokenPos EmptyDoBlock {-# LINE 10223 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 336 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 10228 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Stat_ADo_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) }) sem_Stat_AWhile :: T_MExpr -> T_Block -> T_Stat sem_Stat_AWhile cond_ body_ = (case (body_) of { ( _bodyIcopy,body_1) -> (case (cond_) of { ( _condIcopy,_condImtokenPos,cond_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AWhile _condIcopy _bodyIcopy {-# LINE 10245 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 10250 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_AWhile_1 :: T_Stat_1 sem_Stat_AWhile_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 10267 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 10272 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOisInModule -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 10277 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 10282 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOscopes -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 10287 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 10292 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 10297 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOloopLevel -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 10302 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOisMeta -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 10307 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 10312 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 10317 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOconfig -> (case (({-# LINE 344 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 10322 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOvarBeingDefined -> (case (({-# LINE 343 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 10327 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOtopLevel -> (case (({-# LINE 342 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 10332 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOinParentheses -> (case (({-# LINE 341 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 10337 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOisNegation -> (case (cond_1 _condOconfig _condOfuncName _condOglobalDefinitions _condOinParentheses _condOisInModule _condOisMeta _condOisNegation _condOloopLevel _condOmtokenPos _condOscopeLevel _condOscopes _condOtopLevel _condOvarBeingDefined _condOvariableStyle) of { ( _condIglobalDefinitions,_condIidentifier,_condIisInModule,_condIisSimpleExpression,_condIisSingleVar,_condIscopes,_condIvariableStyle,_condIwarnings) -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _condIisInModule {-# LINE 10344 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _condIglobalDefinitions {-# LINE 10349 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 10354 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOconfig -> (case (({-# LINE 346 "src/GLuaFixer/AG/ASTLint.ag" #-} M.empty : _condIscopes {-# LINE 10359 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _condIvariableStyle {-# LINE 10364 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 10369 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _condImtokenPos {-# LINE 10374 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOmtokenPos -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 10379 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOfuncName -> (case (({-# LINE 345 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 10384 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisRepeat -> (case (({-# LINE 340 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel + 1 {-# LINE 10389 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOloopLevel -> (case (body_1 _bodyOconfig _bodyOfuncName _bodyOglobalDefinitions _bodyOisInModule _bodyOisMeta _bodyOisRepeat _bodyOloopLevel _bodyOmtokenPos _bodyOscopeLevel _bodyOscopes _bodyOvariableStyle) of { ( _bodyIglobalDefinitions,_bodyIidentifier,_bodyIisIfStatement,_bodyIisInModule,_bodyImtokenPos,_bodyIscopes,_bodyIstatementCount,_bodyIvariableStyle,_bodyIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIglobalDefinitions {-# LINE 10396 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _condIidentifier _bodyIidentifier) {-# LINE 10401 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 339 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 10406 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIisInModule {-# LINE 10411 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyImtokenPos {-# LINE 10416 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIscopes {-# LINE 10421 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIvariableStyle {-# LINE 10426 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 347 "src/GLuaFixer/AG/ASTLint.ag" #-} _condIwarnings ++ _bodyIwarnings {-# LINE 10431 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 347 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_emptyBlocks _lhsIconfig) || _bodyIstatementCount > 0 then id else (:) $ warn _lhsImtokenPos EmptyWhileLoop {-# LINE 10437 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 347 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 10442 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Stat_AWhile_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) }) }) sem_Stat_ARepeat :: T_Block -> T_MExpr -> T_Stat sem_Stat_ARepeat body_ cond_ = (case (cond_) of { ( _condIcopy,_condImtokenPos,cond_1) -> (case (body_) of { ( _bodyIcopy,body_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ARepeat _bodyIcopy _condIcopy {-# LINE 10459 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 10464 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_ARepeat_1 :: T_Stat_1 sem_Stat_ARepeat_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 10481 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 10486 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOconfig -> (case (({-# LINE 358 "src/GLuaFixer/AG/ASTLint.ag" #-} M.empty : _lhsIscopes {-# LINE 10491 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopes -> (case (({-# LINE 357 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 10496 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisRepeat -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 10501 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 10506 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 10511 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOmtokenPos -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 10516 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 10521 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 10526 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOfuncName -> (case (({-# LINE 352 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel + 1 {-# LINE 10531 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOloopLevel -> (case (body_1 _bodyOconfig _bodyOfuncName _bodyOglobalDefinitions _bodyOisInModule _bodyOisMeta _bodyOisRepeat _bodyOloopLevel _bodyOmtokenPos _bodyOscopeLevel _bodyOscopes _bodyOvariableStyle) of { ( _bodyIglobalDefinitions,_bodyIidentifier,_bodyIisIfStatement,_bodyIisInModule,_bodyImtokenPos,_bodyIscopes,_bodyIstatementCount,_bodyIvariableStyle,_bodyIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIscopes {-# LINE 10538 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 10543 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIisInModule {-# LINE 10548 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIglobalDefinitions {-# LINE 10553 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 10558 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOconfig -> (case (({-# LINE 356 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 10563 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOvarBeingDefined -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIvariableStyle {-# LINE 10568 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 10573 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyImtokenPos {-# LINE 10578 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 10583 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 10588 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOfuncName -> (case (({-# LINE 355 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 10593 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOtopLevel -> (case (({-# LINE 354 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 10598 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOinParentheses -> (case (({-# LINE 353 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 10603 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOisNegation -> (case (cond_1 _condOconfig _condOfuncName _condOglobalDefinitions _condOinParentheses _condOisInModule _condOisMeta _condOisNegation _condOloopLevel _condOmtokenPos _condOscopeLevel _condOscopes _condOtopLevel _condOvarBeingDefined _condOvariableStyle) of { ( _condIglobalDefinitions,_condIidentifier,_condIisInModule,_condIisSimpleExpression,_condIisSingleVar,_condIscopes,_condIvariableStyle,_condIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _condIglobalDefinitions {-# LINE 10610 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _bodyIidentifier _condIidentifier) {-# LINE 10615 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 351 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 10620 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _condIisInModule {-# LINE 10625 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _condImtokenPos {-# LINE 10630 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 359 "src/GLuaFixer/AG/ASTLint.ag" #-} tail _condIscopes {-# LINE 10635 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _condIvariableStyle {-# LINE 10640 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 360 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIwarnings ++ _condIwarnings {-# LINE 10645 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 360 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_emptyBlocks _lhsIconfig) || _bodyIstatementCount > 0 then id else (:) $ warn _lhsImtokenPos EmptyRepeat {-# LINE 10651 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 360 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 10656 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Stat_ARepeat_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) }) }) sem_Stat_AIf :: T_MExpr -> T_Block -> T_ElseIfList -> T_Else -> T_Stat sem_Stat_AIf cond_ body_ elifs_ els_ = (case (els_) of { ( _elsIcopy,els_1) -> (case (elifs_) of { ( _elifsIcopy,elifs_1) -> (case (body_) of { ( _bodyIcopy,body_1) -> (case (cond_) of { ( _condIcopy,_condImtokenPos,cond_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AIf _condIcopy _bodyIcopy _elifsIcopy _elsIcopy {-# LINE 10679 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 10684 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_AIf_1 :: T_Stat_1 sem_Stat_AIf_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 10701 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 10706 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOconfig -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 10711 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 10716 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 10721 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOconfig -> (case (({-# LINE 373 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 10726 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisRepeat -> (case (({-# LINE 371 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 10731 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOvarBeingDefined -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 10736 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 10741 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 10746 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 10751 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOloopLevel -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 10756 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 10761 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 10766 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOfuncName -> (case (({-# LINE 370 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 10771 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOtopLevel -> (case (({-# LINE 369 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 10776 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOinParentheses -> (case (({-# LINE 368 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 10781 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _condOisNegation -> (case (cond_1 _condOconfig _condOfuncName _condOglobalDefinitions _condOinParentheses _condOisInModule _condOisMeta _condOisNegation _condOloopLevel _condOmtokenPos _condOscopeLevel _condOscopes _condOtopLevel _condOvarBeingDefined _condOvariableStyle) of { ( _condIglobalDefinitions,_condIidentifier,_condIisInModule,_condIisSimpleExpression,_condIisSingleVar,_condIscopes,_condIvariableStyle,_condIwarnings) -> (case (({-# LINE 372 "src/GLuaFixer/AG/ASTLint.ag" #-} M.empty : _condIscopes {-# LINE 10788 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _condIvariableStyle {-# LINE 10793 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 10798 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _condImtokenPos {-# LINE 10803 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 10808 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOloopLevel -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _condIisInModule {-# LINE 10813 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _condIglobalDefinitions {-# LINE 10818 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 10823 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOfuncName -> (case (body_1 _bodyOconfig _bodyOfuncName _bodyOglobalDefinitions _bodyOisInModule _bodyOisMeta _bodyOisRepeat _bodyOloopLevel _bodyOmtokenPos _bodyOscopeLevel _bodyOscopes _bodyOvariableStyle) of { ( _bodyIglobalDefinitions,_bodyIidentifier,_bodyIisIfStatement,_bodyIisInModule,_bodyImtokenPos,_bodyIscopes,_bodyIstatementCount,_bodyIvariableStyle,_bodyIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIscopes {-# LINE 10830 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifsOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 10835 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifsOisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 10840 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifsOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIvariableStyle {-# LINE 10845 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifsOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 10850 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifsOscopeLevel -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 10855 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifsOloopLevel -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIisInModule {-# LINE 10860 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifsOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIglobalDefinitions {-# LINE 10865 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifsOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 10870 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifsOfuncName -> (case (({-# LINE 374 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 10875 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elifsOmtokenPos -> (case (elifs_1 _elifsOconfig _elifsOfuncName _elifsOglobalDefinitions _elifsOisInModule _elifsOisMeta _elifsOloopLevel _elifsOmtokenPos _elifsOscopeLevel _elifsOscopes _elifsOvariableStyle) of { ( _elifsIelseExists,_elifsIglobalDefinitions,_elifsIidentifier,_elifsIisInModule,_elifsImtokenPos,_elifsIscopes,_elifsIvariableStyle,_elifsIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _elifsIscopes {-# LINE 10882 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elsOscopes -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 10887 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elsOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _elifsIisInModule {-# LINE 10892 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elsOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _elifsIglobalDefinitions {-# LINE 10897 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elsOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 10902 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elsOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _elifsIvariableStyle {-# LINE 10907 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elsOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 10912 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elsOscopeLevel -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 10917 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elsOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 10922 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elsOfuncName -> (case (({-# LINE 375 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 10927 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _elsOmtokenPos -> (case (els_1 _elsOconfig _elsOfuncName _elsOglobalDefinitions _elsOisInModule _elsOisMeta _elsOloopLevel _elsOmtokenPos _elsOscopeLevel _elsOscopes _elsOvariableStyle) of { ( _elsIelseExists,_elsIglobalDefinitions,_elsIidentifier,_elsIisInModule,_elsImtokenPos,_elsIscopes,_elsIvariableStyle,_elsIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _elsIglobalDefinitions {-# LINE 10934 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _condIidentifier (const _bodyIidentifier (const _elifsIidentifier _elsIidentifier))) {-# LINE 10939 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 367 "src/GLuaFixer/AG/ASTLint.ag" #-} not _elifsIelseExists && not _elsIelseExists {-# LINE 10944 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _elsIisInModule {-# LINE 10949 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _elsImtokenPos {-# LINE 10954 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _elsIscopes {-# LINE 10959 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _elsIvariableStyle {-# LINE 10964 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 383 "src/GLuaFixer/AG/ASTLint.ag" #-} _condIwarnings ++ _bodyIwarnings ++ _elifsIwarnings ++ _elsIwarnings {-# LINE 10969 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 376 "src/GLuaFixer/AG/ASTLint.ag" #-} Region (rgStart _lhsImtokenPos) (customAdvanceToken (rgStart _lhsImtokenPos) If) {-# LINE 10974 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _keywordPos -> (case (({-# LINE 383 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_emptyBlocks _lhsIconfig) || _bodyIstatementCount > 0 then id else (:) $ warn _keywordPos EmptyIf {-# LINE 10980 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f2 -> (case (({-# LINE 383 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_redundantIfStatements _lhsIconfig) || _bodyIstatementCount /= 1 || not _bodyIisIfStatement || _elifsIelseExists || _elsIelseExists then id else (:) $ warn _bodyImtokenPos DoubleIf {-# LINE 10986 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 383 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1, _warnings_augmented_f2] {-# LINE 10991 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Stat_AIf_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) }) }) }) }) sem_Stat_ANFor :: T_MToken -> T_MExpr -> T_MExpr -> T_MExpr -> T_Block -> T_Stat sem_Stat_ANFor var_ val_ to_ step_ body_ = (case (body_) of { ( _bodyIcopy,body_1) -> (case (step_) of { ( _stepIcopy,_stepImtokenPos,step_1) -> (case (to_) of { ( _toIcopy,_toImtokenPos,to_1) -> (case (val_) of { ( _valIcopy,_valImtokenPos,val_1) -> (case (var_) of { ( _varIcopy,_varImtok,_varImtokenPos,var_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ANFor _varIcopy _valIcopy _toIcopy _stepIcopy _bodyIcopy {-# LINE 11017 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 11022 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_ANFor_1 :: T_Stat_1 sem_Stat_ANFor_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 11039 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 11044 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varOisInModule -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 11049 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varOscopes -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 11054 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varOmtokenPos -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 11059 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varOisMeta -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 11064 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 11069 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 11074 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _varOconfig -> (case (var_1 _varOconfig _varOfuncName _varOglobalDefinitions _varOisInModule _varOisMeta _varOmtokenPos _varOscopes) of { ( _varIglobalDefinitions,_varIidentifier,_varIisInModule,_varIscopes,_varIwarnings) -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _varIisInModule {-# LINE 11081 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOisInModule -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 11086 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _varIscopes {-# LINE 11091 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOscopes -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 11096 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _varImtokenPos {-# LINE 11101 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 11106 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOloopLevel -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 11111 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOisMeta -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _varIglobalDefinitions {-# LINE 11116 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 11121 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 11126 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOconfig -> (case (({-# LINE 391 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 11131 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOvarBeingDefined -> (case (({-# LINE 390 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 11136 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOtopLevel -> (case (({-# LINE 389 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 11141 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOinParentheses -> (case (({-# LINE 388 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 11146 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valOisNegation -> (case (val_1 _valOconfig _valOfuncName _valOglobalDefinitions _valOinParentheses _valOisInModule _valOisMeta _valOisNegation _valOloopLevel _valOmtokenPos _valOscopeLevel _valOscopes _valOtopLevel _valOvarBeingDefined _valOvariableStyle) of { ( _valIglobalDefinitions,_valIidentifier,_valIisInModule,_valIisSimpleExpression,_valIisSingleVar,_valIscopes,_valIvariableStyle,_valIwarnings) -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _valIisInModule {-# LINE 11153 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOisInModule -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _valIvariableStyle {-# LINE 11158 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _valIscopes {-# LINE 11163 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOscopes -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 11168 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _valImtokenPos {-# LINE 11173 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 11178 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOloopLevel -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 11183 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOisMeta -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _valIglobalDefinitions {-# LINE 11188 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 11193 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 11198 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOconfig -> (case (({-# LINE 395 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 11203 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOvarBeingDefined -> (case (({-# LINE 394 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 11208 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOtopLevel -> (case (({-# LINE 393 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 11213 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOinParentheses -> (case (({-# LINE 392 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 11218 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _toOisNegation -> (case (to_1 _toOconfig _toOfuncName _toOglobalDefinitions _toOinParentheses _toOisInModule _toOisMeta _toOisNegation _toOloopLevel _toOmtokenPos _toOscopeLevel _toOscopes _toOtopLevel _toOvarBeingDefined _toOvariableStyle) of { ( _toIglobalDefinitions,_toIidentifier,_toIisInModule,_toIisSimpleExpression,_toIisSingleVar,_toIscopes,_toIvariableStyle,_toIwarnings) -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _toIisInModule {-# LINE 11225 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOisInModule -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _toIvariableStyle {-# LINE 11230 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _toIscopes {-# LINE 11235 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOscopes -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 11240 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _toImtokenPos {-# LINE 11245 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 11250 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOloopLevel -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 11255 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOisMeta -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _toIglobalDefinitions {-# LINE 11260 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 11265 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 11270 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOconfig -> (case (({-# LINE 400 "src/GLuaFixer/AG/ASTLint.ag" #-} Nothing {-# LINE 11275 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOvarBeingDefined -> (case (({-# LINE 399 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 11280 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOtopLevel -> (case (({-# LINE 398 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 11285 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOinParentheses -> (case (({-# LINE 397 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 11290 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _stepOisNegation -> (case (step_1 _stepOconfig _stepOfuncName _stepOglobalDefinitions _stepOinParentheses _stepOisInModule _stepOisMeta _stepOisNegation _stepOloopLevel _stepOmtokenPos _stepOscopeLevel _stepOscopes _stepOtopLevel _stepOvarBeingDefined _stepOvariableStyle) of { ( _stepIglobalDefinitions,_stepIidentifier,_stepIisInModule,_stepIisSimpleExpression,_stepIisSingleVar,_stepIscopes,_stepIvariableStyle,_stepIwarnings) -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _stepIisInModule {-# LINE 11297 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _stepIglobalDefinitions {-# LINE 11302 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 11307 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOconfig -> (case (({-# LINE 401 "src/GLuaFixer/AG/ASTLint.ag" #-} M.singleton _varIidentifier (not (lint_unusedLoopVars _lhsIconfig), _varImtokenPos) : _stepIscopes {-# LINE 11312 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _stepIvariableStyle {-# LINE 11317 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 11322 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _stepImtokenPos {-# LINE 11327 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOmtokenPos -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 11332 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOfuncName -> (case (({-# LINE 396 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 11337 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisRepeat -> (case (({-# LINE 387 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel + 1 {-# LINE 11342 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOloopLevel -> (case (body_1 _bodyOconfig _bodyOfuncName _bodyOglobalDefinitions _bodyOisInModule _bodyOisMeta _bodyOisRepeat _bodyOloopLevel _bodyOmtokenPos _bodyOscopeLevel _bodyOscopes _bodyOvariableStyle) of { ( _bodyIglobalDefinitions,_bodyIidentifier,_bodyIisIfStatement,_bodyIisInModule,_bodyImtokenPos,_bodyIscopes,_bodyIstatementCount,_bodyIvariableStyle,_bodyIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIglobalDefinitions {-# LINE 11349 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _varIidentifier (const _valIidentifier (const _toIidentifier (const _stepIidentifier _bodyIidentifier)))) {-# LINE 11354 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 386 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 11359 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIisInModule {-# LINE 11364 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyImtokenPos {-# LINE 11369 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIscopes {-# LINE 11374 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIvariableStyle {-# LINE 11379 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 405 "src/GLuaFixer/AG/ASTLint.ag" #-} _varIwarnings ++ _valIwarnings ++ _toIwarnings ++ _stepIwarnings ++ _bodyIwarnings {-# LINE 11384 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 402 "src/GLuaFixer/AG/ASTLint.ag" #-} checkShadows _lhsIscopes _varIcopy {-# LINE 11389 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _shadowWarning -> (case (({-# LINE 405 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_shadowing _lhsIconfig) || isNothing _shadowWarning then id else (:) . fromMaybe (error "fromMaybe ANFor +warnings") $ _shadowWarning {-# LINE 11395 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f2 -> (case (({-# LINE 405 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_emptyBlocks _lhsIconfig) || _bodyIstatementCount > 0 then id else (:) $ warn _lhsImtokenPos EmptyFor {-# LINE 11401 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 405 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1, _warnings_augmented_f2] {-# LINE 11406 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Stat_ANFor_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) }) }) }) }) }) sem_Stat_AGFor :: ([MToken]) -> T_MExprList -> T_Block -> T_Stat sem_Stat_AGFor vars_ vals_ body_ = (case (body_) of { ( _bodyIcopy,body_1) -> (case (vals_) of { ( _valsIcopy,vals_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AGFor vars_ _valsIcopy _bodyIcopy {-# LINE 11424 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 11429 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_AGFor_1 :: T_Stat_1 sem_Stat_AGFor_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 11446 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 11451 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valsOisInModule -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 11456 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valsOvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 11461 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valsOscopes -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 11466 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valsOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 11471 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valsOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 11476 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valsOloopLevel -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 11481 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valsOisMeta -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 11486 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valsOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 11491 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valsOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 11496 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valsOconfig -> (case (({-# LINE 410 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 11501 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valsOtopLevel -> (case (({-# LINE 409 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 11506 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _valsOinParentheses -> (case (vals_1 _valsOconfig _valsOfuncName _valsOglobalDefinitions _valsOinParentheses _valsOisInModule _valsOisMeta _valsOloopLevel _valsOmtokenPos _valsOscopeLevel _valsOscopes _valsOtopLevel _valsOvariableStyle) of { ( _valsIglobalDefinitions,_valsIidentifier,_valsIisInModule,_valsImtokenPos,_valsIscopes,_valsIvariableStyle,_valsIwarnings) -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _valsIisInModule {-# LINE 11513 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _valsIglobalDefinitions {-# LINE 11518 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 11523 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOconfig -> (case (({-# LINE 414 "src/GLuaFixer/AG/ASTLint.ag" #-} M.fromList $ map (\mt -> (tokenLabel mt, (not (lint_unusedLoopVars _lhsIconfig), mpos mt))) vars_ {-# LINE 11528 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _introduces -> (case (({-# LINE 415 "src/GLuaFixer/AG/ASTLint.ag" #-} _introduces : _valsIscopes {-# LINE 11533 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _valsIvariableStyle {-# LINE 11538 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 11543 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _valsImtokenPos {-# LINE 11548 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOmtokenPos -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 11553 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOfuncName -> (case (({-# LINE 412 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 11558 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisRepeat -> (case (({-# LINE 411 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel + 1 {-# LINE 11563 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOloopLevel -> (case (body_1 _bodyOconfig _bodyOfuncName _bodyOglobalDefinitions _bodyOisInModule _bodyOisMeta _bodyOisRepeat _bodyOloopLevel _bodyOmtokenPos _bodyOscopeLevel _bodyOscopes _bodyOvariableStyle) of { ( _bodyIglobalDefinitions,_bodyIidentifier,_bodyIisIfStatement,_bodyIisInModule,_bodyImtokenPos,_bodyIscopes,_bodyIstatementCount,_bodyIvariableStyle,_bodyIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIglobalDefinitions {-# LINE 11570 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _valsIidentifier _bodyIidentifier) {-# LINE 11575 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 408 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 11580 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIisInModule {-# LINE 11585 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyImtokenPos {-# LINE 11590 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIscopes {-# LINE 11595 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIvariableStyle {-# LINE 11600 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 418 "src/GLuaFixer/AG/ASTLint.ag" #-} _valsIwarnings ++ _bodyIwarnings {-# LINE 11605 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 418 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_shadowing _lhsIconfig) then id else (++) . catMaybes . map (checkShadows _lhsIscopes) $ vars_ {-# LINE 11611 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f2 -> (case (({-# LINE 418 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_emptyBlocks _lhsIconfig) || _bodyIstatementCount > 0 then id else (:) $ warn _lhsImtokenPos EmptyFor {-# LINE 11617 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 418 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1, _warnings_augmented_f2] {-# LINE 11622 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Stat_AGFor_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) }) }) sem_Stat_AFunc :: T_FuncName -> ([MToken]) -> T_Block -> T_Stat sem_Stat_AFunc name_ args_ body_ = (case (body_) of { ( _bodyIcopy,body_1) -> (case (name_) of { ( _nameIcopy,_nameIisMeta,name_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AFunc _nameIcopy args_ _bodyIcopy {-# LINE 11640 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 11645 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_AFunc_1 :: T_Stat_1 sem_Stat_AFunc_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 11662 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOisInModule -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 11667 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 11672 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOscopes -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 11677 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 11682 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 11687 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOloopLevel -> (case (({-# LINE 433 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIisMeta || findSelf args_ || _lhsIisMeta {-# LINE 11692 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _isMeta -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _isMeta {-# LINE 11697 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOisMeta -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 11702 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 11707 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 11712 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOconfig -> (case (name_1 _nameOconfig _nameOfuncName _nameOglobalDefinitions _nameOisInModule _nameOisMeta _nameOloopLevel _nameOmtokenPos _nameOscopeLevel _nameOscopes _nameOvariableStyle) of { ( _nameIglobalDefinitions,_nameIhasSuffixes,_nameIidentifier,_nameIisInModule,_nameImtokenPos,_nameIscopes,_nameIvariableStyle,_nameIwarnings) -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIisInModule {-# LINE 11719 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIglobalDefinitions {-# LINE 11724 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 11729 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOconfig -> (case (({-# LINE 434 "src/GLuaFixer/AG/ASTLint.ag" #-} _isMeta {-# LINE 11734 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisMeta -> (case (({-# LINE 422 "src/GLuaFixer/AG/ASTLint.ag" #-} filter (/= MToken emptyRg VarArg) $ args_ {-# LINE 11739 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argIdentifiers -> (case (({-# LINE 424 "src/GLuaFixer/AG/ASTLint.ag" #-} (if _isMeta then M.insert "self" (True, _nameImtokenPos) else id) $ M.fromList . map (\mt -> (tokenLabel mt, (not . lint_unusedParameters $ _lhsIconfig, mpos mt))) $ _argIdentifiers {-# LINE 11745 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _introduces -> (case (({-# LINE 426 "src/GLuaFixer/AG/ASTLint.ag" #-} _introduces : (registerVariable _nameIscopes _nameImtokenPos _nameIidentifier True) {-# LINE 11750 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIvariableStyle {-# LINE 11755 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 11760 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameImtokenPos {-# LINE 11765 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 11770 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOloopLevel -> (case (({-# LINE 435 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIidentifier {-# LINE 11775 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOfuncName -> (case (({-# LINE 423 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 11780 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisRepeat -> (case (body_1 _bodyOconfig _bodyOfuncName _bodyOglobalDefinitions _bodyOisInModule _bodyOisMeta _bodyOisRepeat _bodyOloopLevel _bodyOmtokenPos _bodyOscopeLevel _bodyOscopes _bodyOvariableStyle) of { ( _bodyIglobalDefinitions,_bodyIidentifier,_bodyIisIfStatement,_bodyIisInModule,_bodyImtokenPos,_bodyIscopes,_bodyIstatementCount,_bodyIvariableStyle,_bodyIwarnings) -> (case (({-# LINE 428 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIglobalDefinitions {-# LINE 11787 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _globalDefinitions_augmented_syn -> (case (({-# LINE 428 "src/GLuaFixer/AG/ASTLint.ag" #-} if _lhsIisInModule || isVariableLocal _lhsIscopes _nameIidentifier || _nameIisMeta || _nameIhasSuffixes then id else M.insertWith (++) _nameIidentifier [_nameImtokenPos] {-# LINE 11793 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _globalDefinitions_augmented_f1 -> (case (({-# LINE 428 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _globalDefinitions_augmented_syn [_globalDefinitions_augmented_f1] {-# LINE 11798 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _nameIidentifier _bodyIidentifier) {-# LINE 11803 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 421 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 11808 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIisInModule {-# LINE 11813 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyImtokenPos {-# LINE 11818 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIscopes {-# LINE 11823 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIvariableStyle {-# LINE 11828 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 431 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIwarnings ++ _bodyIwarnings {-# LINE 11833 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 431 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_shadowing _lhsIconfig) then id else (++) . catMaybes . map (checkShadows _lhsIscopes) $ _argIdentifiers {-# LINE 11839 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 431 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 11844 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Stat_AFunc_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) }) }) sem_Stat_ALocFunc :: T_FuncName -> ([MToken]) -> T_Block -> T_Stat sem_Stat_ALocFunc name_ args_ body_ = (case (body_) of { ( _bodyIcopy,body_1) -> (case (name_) of { ( _nameIcopy,_nameIisMeta,name_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ALocFunc _nameIcopy args_ _bodyIcopy {-# LINE 11862 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 11867 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_Stat_ALocFunc_1 :: T_Stat_1 sem_Stat_ALocFunc_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 11884 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOisInModule -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 11889 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 11894 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOscopes -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 11899 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 11904 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 11909 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOloopLevel -> (case (({-# LINE 446 "src/GLuaFixer/AG/ASTLint.ag" #-} findSelf args_ || _lhsIisMeta {-# LINE 11914 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _isMeta -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _isMeta {-# LINE 11919 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOisMeta -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 11924 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 11929 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOfuncName -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 11934 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _nameOconfig -> (case (name_1 _nameOconfig _nameOfuncName _nameOglobalDefinitions _nameOisInModule _nameOisMeta _nameOloopLevel _nameOmtokenPos _nameOscopeLevel _nameOscopes _nameOvariableStyle) of { ( _nameIglobalDefinitions,_nameIhasSuffixes,_nameIidentifier,_nameIisInModule,_nameImtokenPos,_nameIscopes,_nameIvariableStyle,_nameIwarnings) -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIisInModule {-# LINE 11941 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIglobalDefinitions {-# LINE 11946 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 11951 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOconfig -> (case (({-# LINE 447 "src/GLuaFixer/AG/ASTLint.ag" #-} _isMeta {-# LINE 11956 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisMeta -> (case (({-# LINE 444 "src/GLuaFixer/AG/ASTLint.ag" #-} M.insert _nameIidentifier (False, _nameImtokenPos) (head _nameIscopes) : tail _nameIscopes {-# LINE 11961 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _passedScopes -> (case (({-# LINE 438 "src/GLuaFixer/AG/ASTLint.ag" #-} filter (/= MToken emptyRg VarArg) $ args_ {-# LINE 11966 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _argIdentifiers -> (case (({-# LINE 440 "src/GLuaFixer/AG/ASTLint.ag" #-} (if _isMeta then M.insert "self" (True, _nameImtokenPos) else id) $ M.fromList . map (\mt -> (tokenLabel mt, (not . lint_unusedParameters $ _lhsIconfig, mpos mt))) $ _argIdentifiers {-# LINE 11972 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _introduces -> (case (({-# LINE 445 "src/GLuaFixer/AG/ASTLint.ag" #-} _introduces : _passedScopes {-# LINE 11977 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIvariableStyle {-# LINE 11982 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 11987 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameImtokenPos {-# LINE 11992 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 11997 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOloopLevel -> (case (({-# LINE 448 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIidentifier {-# LINE 12002 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOfuncName -> (case (({-# LINE 439 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 12007 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _bodyOisRepeat -> (case (body_1 _bodyOconfig _bodyOfuncName _bodyOglobalDefinitions _bodyOisInModule _bodyOisMeta _bodyOisRepeat _bodyOloopLevel _bodyOmtokenPos _bodyOscopeLevel _bodyOscopes _bodyOvariableStyle) of { ( _bodyIglobalDefinitions,_bodyIidentifier,_bodyIisIfStatement,_bodyIisInModule,_bodyImtokenPos,_bodyIscopes,_bodyIstatementCount,_bodyIvariableStyle,_bodyIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIglobalDefinitions {-# LINE 12014 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _nameIidentifier _bodyIidentifier) {-# LINE 12019 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 437 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 12024 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisIfStatement -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIisInModule {-# LINE 12029 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyImtokenPos {-# LINE 12034 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIscopes {-# LINE 12039 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _bodyIvariableStyle {-# LINE 12044 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 454 "src/GLuaFixer/AG/ASTLint.ag" #-} _nameIwarnings ++ _bodyIwarnings {-# LINE 12049 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 443 "src/GLuaFixer/AG/ASTLint.ag" #-} MToken _nameImtokenPos (Identifier _nameIidentifier) {-# LINE 12054 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _funcname -> (case (({-# LINE 453 "src/GLuaFixer/AG/ASTLint.ag" #-} checkShadows _lhsIscopes _funcname {-# LINE 12059 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _funcNameShadows -> (case (({-# LINE 454 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_shadowing _lhsIconfig) then id else (++) . catMaybes . map (checkShadows _lhsIscopes) $ _argIdentifiers {-# LINE 12065 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f2 -> (case (({-# LINE 454 "src/GLuaFixer/AG/ASTLint.ag" #-} if not (lint_shadowing _lhsIconfig) || isNothing _funcNameShadows then id else (:) . fromMaybe (error "fromMaybe ALocFunc +warnings") $ _funcNameShadows {-# LINE 12071 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 454 "src/GLuaFixer/AG/ASTLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1, _warnings_augmented_f2] {-# LINE 12076 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisIfStatement,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Stat_ALocFunc_1)) of { ( sem_Stat_1) -> ( _lhsOcopy,sem_Stat_1) }) }) }) }) }) -- Token ------------------------------------------------------- -- cata sem_Token :: Token -> T_Token sem_Token (Whitespace _space) = (sem_Token_Whitespace _space) sem_Token (DashComment _comment) = (sem_Token_DashComment _comment) sem_Token (DashBlockComment _depth _comment) = (sem_Token_DashBlockComment _depth _comment) sem_Token (SlashComment _comment) = (sem_Token_SlashComment _comment) sem_Token (SlashBlockComment _comment) = (sem_Token_SlashBlockComment _comment) sem_Token (Semicolon) = (sem_Token_Semicolon) sem_Token (TNumber _num) = (sem_Token_TNumber _num) sem_Token (DQString _str) = (sem_Token_DQString _str) sem_Token (SQString _str) = (sem_Token_SQString _str) sem_Token (MLString _str) = (sem_Token_MLString _str) sem_Token (TTrue) = (sem_Token_TTrue) sem_Token (TFalse) = (sem_Token_TFalse) sem_Token (Nil) = (sem_Token_Nil) sem_Token (VarArg) = (sem_Token_VarArg) sem_Token (Plus) = (sem_Token_Plus) sem_Token (Minus) = (sem_Token_Minus) sem_Token (Multiply) = (sem_Token_Multiply) sem_Token (Divide) = (sem_Token_Divide) sem_Token (Modulus) = (sem_Token_Modulus) sem_Token (Power) = (sem_Token_Power) sem_Token (TEq) = (sem_Token_TEq) sem_Token (TNEq) = (sem_Token_TNEq) sem_Token (TCNEq) = (sem_Token_TCNEq) sem_Token (TLEQ) = (sem_Token_TLEQ) sem_Token (TGEQ) = (sem_Token_TGEQ) sem_Token (TLT) = (sem_Token_TLT) sem_Token (TGT) = (sem_Token_TGT) sem_Token (Equals) = (sem_Token_Equals) sem_Token (Concatenate) = (sem_Token_Concatenate) sem_Token (Colon) = (sem_Token_Colon) sem_Token (Dot) = (sem_Token_Dot) sem_Token (Comma) = (sem_Token_Comma) sem_Token (Hash) = (sem_Token_Hash) sem_Token (Not) = (sem_Token_Not) sem_Token (CNot) = (sem_Token_CNot) sem_Token (And) = (sem_Token_And) sem_Token (CAnd) = (sem_Token_CAnd) sem_Token (Or) = (sem_Token_Or) sem_Token (COr) = (sem_Token_COr) sem_Token (Function) = (sem_Token_Function) sem_Token (Local) = (sem_Token_Local) sem_Token (If) = (sem_Token_If) sem_Token (Then) = (sem_Token_Then) sem_Token (Elseif) = (sem_Token_Elseif) sem_Token (Else) = (sem_Token_Else) sem_Token (For) = (sem_Token_For) sem_Token (In) = (sem_Token_In) sem_Token (Do) = (sem_Token_Do) sem_Token (While) = (sem_Token_While) sem_Token (Until) = (sem_Token_Until) sem_Token (Repeat) = (sem_Token_Repeat) sem_Token (Continue) = (sem_Token_Continue) sem_Token (Break) = (sem_Token_Break) sem_Token (Return) = (sem_Token_Return) sem_Token (End) = (sem_Token_End) sem_Token (LRound) = (sem_Token_LRound) sem_Token (RRound) = (sem_Token_RRound) sem_Token (LCurly) = (sem_Token_LCurly) sem_Token (RCurly) = (sem_Token_RCurly) sem_Token (LSquare) = (sem_Token_LSquare) sem_Token (RSquare) = (sem_Token_RSquare) sem_Token (Label _lbl) = (sem_Token_Label _lbl) sem_Token (Identifier _ident) = (sem_Token_Identifier _ident) -- semantic domain type T_Token = ( Token,String,([String -> LintMessage])) data Inh_Token = Inh_Token {} data Syn_Token = Syn_Token {copy_Syn_Token :: Token,identifier_Syn_Token :: String,warnings_Syn_Token :: ([String -> LintMessage])} wrap_Token :: T_Token -> Inh_Token -> Syn_Token wrap_Token sem (Inh_Token) = (let ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) = sem in (Syn_Token _lhsOcopy _lhsOidentifier _lhsOwarnings)) sem_Token_Whitespace :: String -> T_Token sem_Token_Whitespace space_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Whitespace space_ {-# LINE 12228 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12233 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12238 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12243 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_DashComment :: String -> T_Token sem_Token_DashComment comment_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} DashComment comment_ {-# LINE 12252 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12257 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12262 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12267 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_DashBlockComment :: Int -> String -> T_Token sem_Token_DashBlockComment depth_ comment_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} DashBlockComment depth_ comment_ {-# LINE 12277 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12282 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12287 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12292 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_SlashComment :: String -> T_Token sem_Token_SlashComment comment_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} SlashComment comment_ {-# LINE 12301 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12306 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12311 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12316 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_SlashBlockComment :: String -> T_Token sem_Token_SlashBlockComment comment_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} SlashBlockComment comment_ {-# LINE 12325 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12330 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12335 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12340 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Semicolon :: T_Token sem_Token_Semicolon = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Semicolon {-# LINE 12348 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12353 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12358 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12363 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_TNumber :: String -> T_Token sem_Token_TNumber num_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} TNumber num_ {-# LINE 12372 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12377 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12382 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12387 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_DQString :: String -> T_Token sem_Token_DQString str_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} DQString str_ {-# LINE 12396 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12401 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12406 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12411 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_SQString :: String -> T_Token sem_Token_SQString str_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} SQString str_ {-# LINE 12420 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12425 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12430 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12435 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_MLString :: String -> T_Token sem_Token_MLString str_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} MLString str_ {-# LINE 12444 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12449 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12454 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12459 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_TTrue :: T_Token sem_Token_TTrue = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} TTrue {-# LINE 12467 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12472 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12477 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12482 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_TFalse :: T_Token sem_Token_TFalse = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} TFalse {-# LINE 12490 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12495 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12500 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12505 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Nil :: T_Token sem_Token_Nil = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Nil {-# LINE 12513 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12518 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12523 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12528 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_VarArg :: T_Token sem_Token_VarArg = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} VarArg {-# LINE 12536 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12541 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12546 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12551 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Plus :: T_Token sem_Token_Plus = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Plus {-# LINE 12559 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12564 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12569 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12574 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Minus :: T_Token sem_Token_Minus = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Minus {-# LINE 12582 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12587 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12592 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12597 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Multiply :: T_Token sem_Token_Multiply = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Multiply {-# LINE 12605 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12610 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12615 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12620 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Divide :: T_Token sem_Token_Divide = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Divide {-# LINE 12628 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12633 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12638 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12643 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Modulus :: T_Token sem_Token_Modulus = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Modulus {-# LINE 12651 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12656 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12661 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12666 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Power :: T_Token sem_Token_Power = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Power {-# LINE 12674 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12679 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12684 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12689 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_TEq :: T_Token sem_Token_TEq = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} TEq {-# LINE 12697 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12702 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12707 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12712 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_TNEq :: T_Token sem_Token_TNEq = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} TNEq {-# LINE 12720 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12725 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12730 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12735 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_TCNEq :: T_Token sem_Token_TCNEq = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} TCNEq {-# LINE 12743 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12748 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12753 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12758 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_TLEQ :: T_Token sem_Token_TLEQ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} TLEQ {-# LINE 12766 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12771 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12776 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12781 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_TGEQ :: T_Token sem_Token_TGEQ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} TGEQ {-# LINE 12789 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12794 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12799 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12804 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_TLT :: T_Token sem_Token_TLT = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} TLT {-# LINE 12812 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12817 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12822 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12827 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_TGT :: T_Token sem_Token_TGT = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} TGT {-# LINE 12835 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12840 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12845 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12850 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Equals :: T_Token sem_Token_Equals = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Equals {-# LINE 12858 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12863 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12868 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12873 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Concatenate :: T_Token sem_Token_Concatenate = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Concatenate {-# LINE 12881 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12886 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12891 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12896 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Colon :: T_Token sem_Token_Colon = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Colon {-# LINE 12904 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12909 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12914 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12919 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Dot :: T_Token sem_Token_Dot = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Dot {-# LINE 12927 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12932 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12937 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12942 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Comma :: T_Token sem_Token_Comma = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Comma {-# LINE 12950 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12955 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12960 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12965 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Hash :: T_Token sem_Token_Hash = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Hash {-# LINE 12973 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 12978 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 12983 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 12988 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Not :: T_Token sem_Token_Not = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Not {-# LINE 12996 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13001 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13006 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13011 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_CNot :: T_Token sem_Token_CNot = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} CNot {-# LINE 13019 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13024 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13029 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13034 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_And :: T_Token sem_Token_And = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} And {-# LINE 13042 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13047 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13052 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13057 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_CAnd :: T_Token sem_Token_CAnd = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} CAnd {-# LINE 13065 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13070 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13075 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13080 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Or :: T_Token sem_Token_Or = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Or {-# LINE 13088 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13093 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13098 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13103 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_COr :: T_Token sem_Token_COr = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} COr {-# LINE 13111 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13116 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13121 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13126 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Function :: T_Token sem_Token_Function = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Function {-# LINE 13134 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13139 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13144 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13149 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Local :: T_Token sem_Token_Local = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Local {-# LINE 13157 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13162 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13167 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13172 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_If :: T_Token sem_Token_If = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} If {-# LINE 13180 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13185 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13190 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13195 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Then :: T_Token sem_Token_Then = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Then {-# LINE 13203 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13208 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13213 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13218 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Elseif :: T_Token sem_Token_Elseif = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Elseif {-# LINE 13226 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13231 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13236 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13241 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Else :: T_Token sem_Token_Else = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Else {-# LINE 13249 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13254 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13259 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13264 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_For :: T_Token sem_Token_For = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} For {-# LINE 13272 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13277 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13282 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13287 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_In :: T_Token sem_Token_In = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} In {-# LINE 13295 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13300 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13305 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13310 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Do :: T_Token sem_Token_Do = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Do {-# LINE 13318 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13323 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13328 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13333 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_While :: T_Token sem_Token_While = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} While {-# LINE 13341 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13346 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13351 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13356 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Until :: T_Token sem_Token_Until = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Until {-# LINE 13364 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13369 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13374 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13379 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Repeat :: T_Token sem_Token_Repeat = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Repeat {-# LINE 13387 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13392 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13397 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13402 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Continue :: T_Token sem_Token_Continue = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Continue {-# LINE 13410 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13415 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13420 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13425 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Break :: T_Token sem_Token_Break = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Break {-# LINE 13433 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13438 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13443 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13448 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Return :: T_Token sem_Token_Return = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Return {-# LINE 13456 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13461 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13466 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13471 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_End :: T_Token sem_Token_End = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} End {-# LINE 13479 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13484 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13489 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13494 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_LRound :: T_Token sem_Token_LRound = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} LRound {-# LINE 13502 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13507 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13512 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13517 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_RRound :: T_Token sem_Token_RRound = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} RRound {-# LINE 13525 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13530 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13535 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13540 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_LCurly :: T_Token sem_Token_LCurly = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} LCurly {-# LINE 13548 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13553 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13558 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13563 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_RCurly :: T_Token sem_Token_RCurly = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} RCurly {-# LINE 13571 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13576 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13581 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13586 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_LSquare :: T_Token sem_Token_LSquare = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} LSquare {-# LINE 13594 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13599 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13604 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13609 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_RSquare :: T_Token sem_Token_RSquare = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} RSquare {-# LINE 13617 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13622 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13627 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13632 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Label :: String -> T_Token sem_Token_Label lbl_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Label lbl_ {-# LINE 13641 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13646 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 220 "src/GLuaFixer/AG/ASTLint.ag" #-} lbl_ {-# LINE 13651 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13656 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) sem_Token_Identifier :: String -> T_Token sem_Token_Identifier ident_ = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} Identifier ident_ {-# LINE 13665 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13670 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 222 "src/GLuaFixer/AG/ASTLint.ag" #-} ident_ {-# LINE 13675 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13680 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) -- TokenList --------------------------------------------------- -- cata sem_TokenList :: TokenList -> T_TokenList sem_TokenList list = (Prelude.foldr sem_TokenList_Cons sem_TokenList_Nil (Prelude.map sem_Token list)) -- semantic domain type T_TokenList = ( TokenList,String,([String -> LintMessage])) data Inh_TokenList = Inh_TokenList {} data Syn_TokenList = Syn_TokenList {copy_Syn_TokenList :: TokenList,identifier_Syn_TokenList :: String,warnings_Syn_TokenList :: ([String -> LintMessage])} wrap_TokenList :: T_TokenList -> Inh_TokenList -> Syn_TokenList wrap_TokenList sem (Inh_TokenList) = (let ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) = sem in (Syn_TokenList _lhsOcopy _lhsOidentifier _lhsOwarnings)) sem_TokenList_Cons :: T_Token -> T_TokenList -> T_TokenList sem_TokenList_Cons hd_ tl_ = (case (tl_) of { ( _tlIcopy,_tlIidentifier,_tlIwarnings) -> (case (hd_) of { ( _hdIcopy,_hdIidentifier,_hdIwarnings) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} (:) _hdIcopy _tlIcopy {-# LINE 13710 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13715 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _hdIidentifier _tlIidentifier) {-# LINE 13720 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIwarnings ++ _tlIwarnings {-# LINE 13725 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) }) }) sem_TokenList_Nil :: T_TokenList sem_TokenList_Nil = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13733 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13738 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13743 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13748 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOcopy,_lhsOidentifier,_lhsOwarnings) }) }) }) }) -- UnOp -------------------------------------------------------- -- cata sem_UnOp :: UnOp -> T_UnOp sem_UnOp (UnMinus) = (sem_UnOp_UnMinus) sem_UnOp (ANot) = (sem_UnOp_ANot) sem_UnOp (AHash) = (sem_UnOp_AHash) -- semantic domain type T_UnOp = ( UnOp,T_UnOp_1) type T_UnOp_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_UnOp = Inh_UnOp {config_Inh_UnOp :: LintSettings,funcName_Inh_UnOp :: String,globalDefinitions_Inh_UnOp :: (M.Map String [Region]),isInModule_Inh_UnOp :: Bool,isMeta_Inh_UnOp :: Bool,loopLevel_Inh_UnOp :: Int,mtokenPos_Inh_UnOp :: Region,scopeLevel_Inh_UnOp :: Int,scopes_Inh_UnOp :: ([M.Map String (Bool, Region)]),variableStyle_Inh_UnOp :: DeterminedVariableStyle} data Syn_UnOp = Syn_UnOp {copy_Syn_UnOp :: UnOp,globalDefinitions_Syn_UnOp :: (M.Map String [Region]),identifier_Syn_UnOp :: String,isInModule_Syn_UnOp :: Bool,isNegation_Syn_UnOp :: Bool,mtokenPos_Syn_UnOp :: Region,scopes_Syn_UnOp :: ([M.Map String (Bool, Region)]),variableStyle_Syn_UnOp :: DeterminedVariableStyle,warnings_Syn_UnOp :: ([String -> LintMessage])} wrap_UnOp :: T_UnOp -> Inh_UnOp -> Syn_UnOp wrap_UnOp sem (Inh_UnOp _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisNegation,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_UnOp _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOisNegation _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_UnOp_UnMinus :: T_UnOp sem_UnOp_UnMinus = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} UnMinus {-# LINE 13788 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13793 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_UnOp_UnMinus_1 :: T_UnOp_1 sem_UnOp_UnMinus_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 13810 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13815 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 13820 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 639 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 13825 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisNegation -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 13830 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 13835 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 13840 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13845 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisNegation,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) })) in sem_UnOp_UnMinus_1)) of { ( sem_UnOp_1) -> ( _lhsOcopy,sem_UnOp_1) }) }) }) sem_UnOp_ANot :: T_UnOp sem_UnOp_ANot = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} ANot {-# LINE 13856 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13861 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_UnOp_ANot_1 :: T_UnOp_1 sem_UnOp_ANot_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 13878 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13883 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 13888 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 641 "src/GLuaFixer/AG/ASTLint.ag" #-} True {-# LINE 13893 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisNegation -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 13898 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 13903 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 13908 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13913 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisNegation,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) })) in sem_UnOp_ANot_1)) of { ( sem_UnOp_1) -> ( _lhsOcopy,sem_UnOp_1) }) }) }) sem_UnOp_AHash :: T_UnOp sem_UnOp_AHash = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} AHash {-# LINE 13924 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 13929 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_UnOp_AHash_1 :: T_UnOp_1 sem_UnOp_AHash_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 13946 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 13951 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 13956 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 643 "src/GLuaFixer/AG/ASTLint.ag" #-} False {-# LINE 13961 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisNegation -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 13966 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 13971 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 13976 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 13981 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOisNegation,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) })) in sem_UnOp_AHash_1)) of { ( sem_UnOp_1) -> ( _lhsOcopy,sem_UnOp_1) }) }) }) -- VarsList ---------------------------------------------------- -- cata sem_VarsList :: VarsList -> T_VarsList sem_VarsList list = (Prelude.foldr sem_VarsList_Cons sem_VarsList_Nil (Prelude.map sem_Declaration list)) -- semantic domain type T_VarsList = ( VarsList,T_VarsList_1) type T_VarsList_1 = LintSettings -> String -> (M.Map String [Region]) -> Bool -> Bool -> Bool -> Int -> Region -> Int -> ([M.Map String (Bool, Region)]) -> DeterminedVariableStyle -> ( (M.Map String [Region]),String,Bool,Region,([M.Map String (Bool, Region)]),DeterminedVariableStyle,([String -> LintMessage])) data Inh_VarsList = Inh_VarsList {config_Inh_VarsList :: LintSettings,funcName_Inh_VarsList :: String,globalDefinitions_Inh_VarsList :: (M.Map String [Region]),isInModule_Inh_VarsList :: Bool,isMeta_Inh_VarsList :: Bool,localDefinition_Inh_VarsList :: Bool,loopLevel_Inh_VarsList :: Int,mtokenPos_Inh_VarsList :: Region,scopeLevel_Inh_VarsList :: Int,scopes_Inh_VarsList :: ([M.Map String (Bool, Region)]),variableStyle_Inh_VarsList :: DeterminedVariableStyle} data Syn_VarsList = Syn_VarsList {copy_Syn_VarsList :: VarsList,globalDefinitions_Syn_VarsList :: (M.Map String [Region]),identifier_Syn_VarsList :: String,isInModule_Syn_VarsList :: Bool,mtokenPos_Syn_VarsList :: Region,scopes_Syn_VarsList :: ([M.Map String (Bool, Region)]),variableStyle_Syn_VarsList :: DeterminedVariableStyle,warnings_Syn_VarsList :: ([String -> LintMessage])} wrap_VarsList :: T_VarsList -> Inh_VarsList -> Syn_VarsList wrap_VarsList sem (Inh_VarsList _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIlocalDefinition _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle) = (let ( _lhsOcopy,sem_1) = sem ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) = sem_1 _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIlocalDefinition _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle in (Syn_VarsList _lhsOcopy _lhsOglobalDefinitions _lhsOidentifier _lhsOisInModule _lhsOmtokenPos _lhsOscopes _lhsOvariableStyle _lhsOwarnings)) sem_VarsList_Cons :: T_Declaration -> T_VarsList -> T_VarsList sem_VarsList_Cons hd_ tl_ = (case (tl_) of { ( _tlIcopy,tl_1) -> (case (hd_) of { ( _hdIcopy,hd_1) -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} (:) _hdIcopy _tlIcopy {-# LINE 14027 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 14032 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_VarsList_Cons_1 :: T_VarsList_1 sem_VarsList_Cons_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIlocalDefinition _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 14050 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOscopes -> (case (({-# LINE 189 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIlocalDefinition {-# LINE 14055 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOlocalDefinition -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 14060 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisMeta -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 14065 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 14070 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 14075 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 14080 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 14085 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOloopLevel -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 14090 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 14095 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOglobalDefinitions -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 14100 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _hdOfuncName -> (case (hd_1 _hdOconfig _hdOfuncName _hdOglobalDefinitions _hdOisInModule _hdOisMeta _hdOlocalDefinition _hdOloopLevel _hdOmtokenPos _hdOscopeLevel _hdOscopes _hdOvariableStyle) of { ( _hdIglobalDefinitions,_hdIidentifier,_hdIisInModule,_hdImtokenPos,_hdIscopes,_hdIvariableStyle,_hdIwarnings) -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIscopes {-# LINE 14107 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOscopes -> (case (({-# LINE 189 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIlocalDefinition {-# LINE 14112 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOlocalDefinition -> (case (({-# LINE 145 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisMeta {-# LINE 14117 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisMeta -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIisInModule {-# LINE 14122 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOisInModule -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIglobalDefinitions {-# LINE 14127 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOglobalDefinitions -> (case (({-# LINE 134 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIconfig {-# LINE 14132 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOconfig -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIvariableStyle {-# LINE 14137 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOvariableStyle -> (case (({-# LINE 127 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopeLevel {-# LINE 14142 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOscopeLevel -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdImtokenPos {-# LINE 14147 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOmtokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIloopLevel {-# LINE 14152 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOloopLevel -> (case (({-# LINE 146 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIfuncName {-# LINE 14157 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _tlOfuncName -> (case (tl_1 _tlOconfig _tlOfuncName _tlOglobalDefinitions _tlOisInModule _tlOisMeta _tlOlocalDefinition _tlOloopLevel _tlOmtokenPos _tlOscopeLevel _tlOscopes _tlOvariableStyle) of { ( _tlIglobalDefinitions,_tlIidentifier,_tlIisInModule,_tlImtokenPos,_tlIscopes,_tlIvariableStyle,_tlIwarnings) -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIglobalDefinitions {-# LINE 14164 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} (const _hdIidentifier _tlIidentifier) {-# LINE 14169 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIisInModule {-# LINE 14174 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 234 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdImtokenPos {-# LINE 14179 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIscopes {-# LINE 14184 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _tlIvariableStyle {-# LINE 14189 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} _hdIwarnings ++ _tlIwarnings {-# LINE 14194 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_VarsList_Cons_1)) of { ( sem_VarsList_1) -> ( _lhsOcopy,sem_VarsList_1) }) }) }) }) }) sem_VarsList_Nil :: T_VarsList sem_VarsList_Nil = (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 14205 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _copy -> (case (({-# LINE 153 "src/GLuaFixer/AG/ASTLint.ag" #-} _copy {-# LINE 14210 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOcopy -> (case ((let sem_VarsList_Nil_1 :: T_VarsList_1 sem_VarsList_Nil_1 = (\ _lhsIconfig _lhsIfuncName _lhsIglobalDefinitions _lhsIisInModule _lhsIisMeta _lhsIlocalDefinition _lhsIloopLevel _lhsImtokenPos _lhsIscopeLevel _lhsIscopes _lhsIvariableStyle -> (case (({-# LINE 138 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIglobalDefinitions {-# LINE 14228 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOglobalDefinitions -> (case (({-# LINE 154 "src/GLuaFixer/AG/ASTLint.ag" #-} unknownIdentifier {-# LINE 14233 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOidentifier -> (case (({-# LINE 143 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIisInModule {-# LINE 14238 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOisInModule -> (case (({-# LINE 135 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsImtokenPos {-# LINE 14243 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOmtokenPos -> (case (({-# LINE 144 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIscopes {-# LINE 14248 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOscopes -> (case (({-# LINE 131 "src/GLuaFixer/AG/ASTLint.ag" #-} _lhsIvariableStyle {-# LINE 14253 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOvariableStyle -> (case (({-# LINE 152 "src/GLuaFixer/AG/ASTLint.ag" #-} [] {-# LINE 14258 "src/GLuaFixer/AG/ASTLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOglobalDefinitions,_lhsOidentifier,_lhsOisInModule,_lhsOmtokenPos,_lhsOscopes,_lhsOvariableStyle,_lhsOwarnings) }) }) }) }) }) }) })) in sem_VarsList_Nil_1)) of { ( sem_VarsList_1) -> ( _lhsOcopy,sem_VarsList_1) }) }) })