{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Vhdl (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex import qualified Data.Set syntax :: Syntax syntax = Syntax { sName = "VHDL" , sFilename = "vhdl.xml" , sShortname = "Vhdl" , sContexts = fromList [ ( "arch_decl" , Context { cName = "arch_decl" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "attribute" , "constant" , "signal" , "type" , "variable" ]) , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "signal" ) ] } , Rule { rMatcher = StringDetect "function" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "archfunc1" ) ] } , Rule { rMatcher = StringDetect "component" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "entity" ) ] } , Rule { rMatcher = StringDetect "begin" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "arch_start" , Context { cName = "arch_start" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)is\\b" , reCompiled = Just (compileRegex False "(\\b)is\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "arch_decl" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)%2\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)%4\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = KeywordTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "archfunc1" , Context { cName = "archfunc1" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)begin\\b" , reCompiled = Just (compileRegex False "(\\b)begin\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "archfunc2" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end(\\s+function)?(\\s+%2)?\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)%2\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "archfunc2" , Context { cName = "archfunc2" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end(\\s+function)?\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)begin\\b" , reCompiled = Just (compileRegex False "(\\b)begin\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "proc_rules" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "architecture_main" , Context { cName = "architecture_main" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)architecture\\s+(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)\\s+of\\s+(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)\\s+is" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "arch_start" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end(\\s+architecture)?(\\s+%2)?\\s*;" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end(\\s+architecture)?(\\s+\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)\\s*;" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "detect_arch_parts" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "attribute" , Context { cName = "attribute" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = DetectChar '"' , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "quot in att" ) ] } , Rule { rMatcher = DetectChar '"' , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "quot in att" ) ] } , Rule { rMatcher = DetectChar ' ' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = DetectChar '\'' , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = AnyChar ")=<>" , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = BaseNTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "case1" , Context { cName = "case1" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)is\\b" , reCompiled = Just (compileRegex False "(\\b)is\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "case2" ) ] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "case" , "when" ]) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "case2" , Context { cName = "case2" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end\\s+case(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?\\s*;" , reCompiled = Just (compileRegex False "(\\b)end\\s+case(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?\\s*;") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)when(\\s+\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "caseWhen" ) ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "proc_rules" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "caseWhen" , Context { cName = "caseWhen" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = Detect2Chars '=' '>' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "caseWhen2" ) ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)when\\b" , reCompiled = Just (compileRegex False "(\\b)when\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)%2\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "proc_rules" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "caseWhen2" , Context { cName = "caseWhen2" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\s*when\\b" , reCompiled = Just (compileRegex False "\\s*when\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = RegExpr RE { reString = "\\s*end\\s+case\\b" , reCompiled = Just (compileRegex False "\\s*end\\s+case\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "proc_rules" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "comment" , Context { cName = "comment" , cSyntax = "VHDL" , cRules = [] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "conf_decl" , Context { cName = "conf_decl" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = StringDetect "for" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "conf_for" ) ] } , Rule { rMatcher = StringDetect "end" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "conf_for" , Context { cName = "conf_for" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = StringDetect "for" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "conf_for" ) ] } , Rule { rMatcher = RegExpr RE { reString = "end(\\s+\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?" , reCompiled = Just (compileRegex False "end(\\s+\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "conf_start" , Context { cName = "conf_start" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)is\\b" , reCompiled = Just (compileRegex False "(\\b)is\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "conf_decl" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)%2\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)%4\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = KeywordTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "configuration" , Context { cName = "configuration" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)configuration\\s+(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)\\s+of\\s+(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)\\s+is" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "conf_start" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end(\\s+configuration)?(\\s+%2)?\\s*;" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end(\\s+configuration)?(\\s+\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)\\s*;" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "detect_arch_parts" , Context { cName = "detect_arch_parts" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "(\\b)(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b\\s*:\\s*)(if|for).*\\s+generate\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "generate1" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b\\s*:\\s*)?process\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "process1" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)\\s*:\\s*((entity\\s+)?(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)(\\.\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?)" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "instance" ) ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "entity" , Context { cName = "entity" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)" , reCompiled = Just (compileRegex False "(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "entity_main" ) ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "entity_main" , Context { cName = "entity_main" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end(\\s+(entity|component))?(\\s+%1)?\\s*;" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end(\\s+(entity|component))?(\\s+\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?\\s*;" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = RegExpr RE { reString = "generic" , reCompiled = Just (compileRegex False "generic") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "port" , reCompiled = Just (compileRegex False "port") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "forwhile1" , Context { cName = "forwhile1" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)loop\\b" , reCompiled = Just (compileRegex False "(\\b)loop\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "forwhile2" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)%3\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)(for|while)\\b" , reCompiled = Just (compileRegex False "(\\b)(for|while)\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "forwhile2" , Context { cName = "forwhile2" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)begin\\b" , reCompiled = Just (compileRegex False "(\\b)begin\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end\\s+loop(\\s+\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?" , reCompiled = Just (compileRegex False "(\\b)end\\s+loop(\\s+\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "proc_rules" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "generalDetection" , Context { cName = "generalDetection" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "bit" , "bit_vector" , "boolean" , "boolean_vector" , "character" , "delay_length" , "file_open_kind" , "file_open_status" , "integer" , "integer_vector" , "line" , "mux_bit" , "mux_vector" , "natural" , "positive" , "qsim_12state" , "qsim_12state_vector" , "qsim_state" , "qsim_state_vector" , "qsim_strength" , "real" , "real_vector" , "reg_bit" , "reg_vector" , "severity_level" , "side" , "signed" , "std_logic" , "std_logic_vector" , "std_ulogic" , "std_ulogic_vector" , "string" , "text" , "time" , "time_vector" , "unresolved_signed" , "unresolved_unsigned" , "unsigned" , "ux01" , "ux01z" , "width" , "wor_bit" , "wor_vector" , "x01" , "x01z" ]) , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "fs" , "hr" , "min" , "ms" , "ns" , "ps" , "sec" , "us" ]) , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "attribute" , "constant" , "signal" , "type" , "variable" ]) , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "signal" ) ] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "downto" , "others" , "to" ]) , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "abs" , "access" , "after" , "alias" , "all" , "and" , "array" , "assert" , "assume" , "assume_guarantee" , "attribute" , "begin" , "block" , "body" , "buffer" , "bus" , "component" , "constant" , "context" , "cover" , "default" , "disconnect" , "downto" , "end" , "error" , "exit" , "failure" , "fairness" , "falling_edge" , "file" , "for" , "force" , "function" , "generate" , "generic" , "group" , "guarded" , "impure" , "in" , "inertial" , "inout" , "is" , "label" , "linkage" , "literal" , "map" , "mod" , "nand" , "new" , "next" , "nor" , "not" , "note" , "null" , "of" , "on" , "open" , "or" , "others" , "out" , "parameter" , "port" , "postponed" , "procedure" , "process" , "property" , "protected" , "pure" , "range" , "record" , "register" , "reject" , "release" , "rem" , "report" , "return" , "rising_edge" , "rol" , "ror" , "select" , "sequence" , "severity" , "shared" , "signal" , "sla" , "sll" , "sra" , "srl" , "strong" , "subtype" , "to" , "transport" , "type" , "unaffected" , "units" , "until" , "variable" , "vmode" , "vprop" , "vunit" , "wait" , "warning" , "when" , "with" , "xnor" , "xor" ]) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Int , rAttribute = DecValTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = HlCChar , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectSpaces , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "generate1" , Context { cName = "generate1" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)(generate|loop)\\b" , reCompiled = Just (compileRegex False "(\\b)(generate|loop)\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "generate2" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)%3\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)(for|if|while)\\b" , reCompiled = Just (compileRegex False "(\\b)(for|if|while)\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "generate2" , Context { cName = "generate2" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)begin\\b" , reCompiled = Just (compileRegex False "(\\b)begin\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end\\s+(generate|loop)(\\s+\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?" , reCompiled = Just (compileRegex False "(\\b)end\\s+(generate|loop)(\\s+\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "detect_arch_parts" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "if" , Context { cName = "if" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end\\s+if(\\s+\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?\\s*;" , reCompiled = Just (compileRegex False "(\\b)end\\s+if(\\s+\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?\\s*;") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "proc_rules" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "else" , "elsif" , "if" , "then" ]) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "if_start" , Context { cName = "if_start" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)then\\b" , reCompiled = Just (compileRegex False "(\\b)then\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "if" ) ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "instance" , Context { cName = "instance" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)%4\\b" , reCompiled = Nothing , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)%3\\b" , reCompiled = Nothing , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)(port|generic)\\s+map\\s*\\(" , reCompiled = Just (compileRegex True "(\\b)(port|generic)\\s+map\\s*\\(") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "instanceMap" ) ] } , Rule { rMatcher = DetectChar ';' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = ErrorTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "instanceInnerPar" , Context { cName = "instanceInnerPar" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar ')' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = DetectChar '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "instanceInnerPar" ) ] } , Rule { rMatcher = DetectChar ';' , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "instanceMap" , Context { cName = "instanceMap" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = AnyChar "<;:" , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar ':' , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar ')' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = DetectChar '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "instanceInnerPar" ) ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "package" , Context { cName = "package" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)package\\b" , reCompiled = Just (compileRegex False "(\\b)package\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)is\\b" , reCompiled = Just (compileRegex False "(\\b)is\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "packagemain" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)%2\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end(\\s+package)?(\\s+%2)?\\s*;" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "packagebody" , Context { cName = "packagebody" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)package\\b" , reCompiled = Just (compileRegex False "(\\b)package\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)is\\b" , reCompiled = Just (compileRegex False "(\\b)is\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "packagebodymain" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)%2\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end(\\s+package)?(\\s+%2)?\\s*;" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "packagebodyfunc1" , Context { cName = "packagebodyfunc1" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)begin\\b" , reCompiled = Just (compileRegex False "(\\b)begin\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "packagebodyfunc2" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end(\\s+function)?(\\s+%2)?\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)%2\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "packagebodyfunc2" , Context { cName = "packagebodyfunc2" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end(\\s+function)?\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)begin\\b" , reCompiled = Just (compileRegex False "(\\b)begin\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "proc_rules" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "packagebodymain" , Context { cName = "packagebodymain" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end\\s+package\\b" , reCompiled = Just (compileRegex False "(\\b)end\\s+package\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)function\\s+(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "packagebodyfunc1" ) ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "packagefunction" , Context { cName = "packagefunction" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "(\\b)\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b\\b" , reCompiled = Just (compileRegex False "(\\b)\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "packagemain" , Context { cName = "packagemain" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end\\b" , reCompiled = Just (compileRegex False "(\\b)end\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)function\\b" , reCompiled = Just (compileRegex False "(\\b)function\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "packagefunction" ) ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "preDetection" , Context { cName = "preDetection" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = Detect2Chars '-' '-' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "comment" ) ] } , Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "string" ) ] } , Rule { rMatcher = AnyChar "[&><=:+\\-*\\/|].," , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '\'' , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "attribute" ) ] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "proc_rules" , Context { cName = "proc_rules" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "(\\b)\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b(?=\\s*:(?!=))" , reCompiled = Just (compileRegex False "(\\b)\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b(?=\\s*:(?!=))") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)if\\b" , reCompiled = Just (compileRegex False "(\\b)if\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "if_start" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)case\\b" , reCompiled = Just (compileRegex False "(\\b)case\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "case1" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)((\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)\\s*:\\s*)?((for|while)\\s+.+\\s+)loop\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "forwhile1" ) ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "process1" , Context { cName = "process1" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end\\s+process(\\s+%3)?" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)end\\s+process(\\s+\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)?" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)process\\b" , reCompiled = Just (compileRegex False "(\\b)process\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)begin\\b" , reCompiled = Just (compileRegex False "(\\b)begin\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "VHDL" , "proc_rules" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "quot in att" , Context { cName = "quot in att" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = DetectChar '"' , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = BaseNTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "signal" , Context { cName = "signal" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar ';' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "VHDL" , "generalDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "start" , Context { cName = "start" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = IncludeRules ( "VHDL" , "preDetection" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)architecture\\s+(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "architecture_main" ) ] } , Rule { rMatcher = StringDetect "entity" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "entity" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)package\\s+(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)\\s+is\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "package" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)package\\s+body\\s+(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)\\s+is\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "packagebody" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(\\b)configuration\\s+(\\b(?!(?:process|constant|signal|variable))([A-Za-z_][A-Za-z0-9_]*)\\b)\\b" , reCompiled = Nothing , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = True , rCaseSensitive = False , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "VHDL" , "configuration" ) ] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "file" , "library" , "use" ]) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = True } ) , ( "string" , Context { cName = "string" , cSyntax = "VHDL" , cRules = [ Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) ] , sAuthor = "Rocky Scaletta (rocky@purdue.edu), Stefan Endrullis (stefan@endrullis.de), Florent Ouchet (outchy@users.sourceforge.net), Chris Higgs (chiggs.99@gmail.com), Jan Michel (jan@mueschelsoft.de), Luigi Calligaris (luigi.calligaris@stfc.ac.uk)" , sVersion = "2" , sLicense = "" , sExtensions = [ "*.vhdl" , "*.vhd" ] , sStartingContext = "start" }