{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Ada (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex import qualified Data.Set syntax :: Syntax syntax = Syntax { sName = "Ada" , sFilename = "ada.xml" , sShortname = "Ada" , sContexts = fromList [ ( "Comment" , Context { cName = "Comment" , cSyntax = "Ada" , cRules = [] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Default" , Context { cName = "Default" , cSyntax = "Ada" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "\\brecord\\b" , reCompiled = Just (compileRegex False "\\brecord\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend\\s+record\\b" , reCompiled = Just (compileRegex False "\\bend\\s+record\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bcase\\b" , reCompiled = Just (compileRegex False "\\bcase\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend\\s+case\\b" , reCompiled = Just (compileRegex False "\\bend\\s+case\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bif\\b" , reCompiled = Just (compileRegex False "\\bif\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend\\s+if\\b" , reCompiled = Just (compileRegex False "\\bend\\s+if\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bloop\\b" , reCompiled = Just (compileRegex False "\\bloop\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend\\s+loop\\b" , reCompiled = Just (compileRegex False "\\bend\\s+loop\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bselect\\b" , reCompiled = Just (compileRegex False "\\bselect\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend\\s+select\\b" , reCompiled = Just (compileRegex False "\\bend\\s+select\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bbegin\\b" , reCompiled = Just (compileRegex False "\\bbegin\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend\\b" , reCompiled = Just (compileRegex False "\\bend\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = StringDetect "-- BEGIN" , rAttribute = RegionMarkerTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = True , rColumn = Nothing , rContextSwitch = [ Push ( "Ada" , "Region Marker" ) ] } , Rule { rMatcher = StringDetect "-- END" , rAttribute = RegionMarkerTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = True , rColumn = Nothing , rContextSwitch = [ Push ( "Ada" , "Region Marker" ) ] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "abort" , "abs" , "abstract" , "accept" , "access" , "aliased" , "all" , "and" , "array" , "at" , "begin" , "body" , "constant" , "declare" , "delay" , "delta" , "digits" , "do" , "else" , "elsif" , "end" , "entry" , "exception" , "exit" , "for" , "function" , "generic" , "goto" , "in" , "interface" , "is" , "limited" , "mod" , "new" , "not" , "null" , "of" , "or" , "others" , "out" , "overriding" , "package" , "pragma" , "private" , "procedure" , "protected" , "raise" , "range" , "record" , "rem" , "renames" , "requeue" , "return" , "reverse" , "separate" , "subtype" , "tagged" , "task" , "terminate" , "then" , "type" , "until" , "use" , "when" , "while" , "with" , "xor" ]) , rAttribute = KeywordTok , 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 [ "all_calls_remote" , "assert" , "assertion_policy" , "asynchronous" , "atomic" , "atomic_components" , "attach_handler" , "controlled" , "convention" , "detect_blocking" , "discard_names" , "elaborate" , "elaborate_all" , "elaborate_body" , "export" , "import" , "inline" , "inspection_point" , "interrupt_handler" , "interrupt_priority" , "linker_options" , "list" , "locking_policy" , "no_return" , "normalize_scalars" , "optimize" , "pack" , "page" , "partition_elaboration_policy" , "preelaborable_initialization" , "preelaborate" , "priority" , "priority_specific_dispatching" , "profile" , "pure" , "queuing_policy" , "relative_deadline" , "remote_call_interface" , "remote_types" , "restrictions" , "reviewable" , "shared_passive" , "storage_size" , "suppress" , "task_dispatching_policy" , "unchecked_union" , "unsuppress" , "volatile" , "volatile_components" ]) , rAttribute = ExtensionTok , 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 [ "boolean" , "character" , "float" , "integer" , "long_float" , "long_integer" , "long_long_float" , "long_long_integer" , "short_float" , "short_integer" , "string" , "wide_character" , "wide_string" , "wide_wide_character" , "wide_wide_string" ]) , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Float , rAttribute = FloatTok , 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 = RegExpr RE { reString = "'.'" , reCompiled = Just (compileRegex True "'.'") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Ada" , "String" ) ] } , Rule { rMatcher = Detect2Chars '-' '-' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Ada" , "Comment" ) ] } , Rule { rMatcher = AnyChar ":!%&()+,-/.*<=>|" , 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 } ) , ( "Region Marker" , Context { cName = "Region Marker" , cSyntax = "Ada" , cRules = [] , cAttribute = RegionMarkerTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "String" , Context { cName = "String" , cSyntax = "Ada" , 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 = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) ] , sAuthor = "" , sVersion = "2" , sLicense = "" , sExtensions = [ "*.adb" , "*.ads" , "*.ada" , "*.a" ] , sStartingContext = "Default" }