{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Gnuassembler (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex import qualified Data.Set syntax :: Syntax syntax = Syntax { sName = "GNU Assembler" , sFilename = "gnuassembler.xml" , sShortname = "Gnuassembler" , sContexts = fromList [ ( "Commentar 1" , Context { cName = "Commentar 1" , cSyntax = "GNU Assembler" , cRules = [ Rule { rMatcher = IncludeRules ( "Alerts" , "" ) , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '*' '/' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Commentar 2" , Context { cName = "Commentar 2" , cSyntax = "GNU Assembler" , cRules = [ Rule { rMatcher = IncludeRules ( "Alerts" , "" ) , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Define" , Context { cName = "Define" , cSyntax = "GNU Assembler" , cRules = [ Rule { rMatcher = LineContinue , rAttribute = PreprocessorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = PreprocessorTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Normal" , Context { cName = "Normal" , cSyntax = "GNU Assembler" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "[_\\w\\d-]*\\s*:" , reCompiled = Just (compileRegex True "[_\\w\\d-]*\\s*:") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-/:;<=>?[\\]^{|}~" } (makeWordSet True [ ".abort" , ".align" , ".app-file" , ".appline" , ".arm" , ".ascii" , ".asciz" , ".att_syntax" , ".balign" , ".balignl" , ".balignw" , ".bss" , ".byte" , ".code" , ".code16" , ".code32" , ".comm" , ".common" , ".common.s" , ".data" , ".dc" , ".dc.b" , ".dc.d" , ".dc.l" , ".dc.s" , ".dc.w" , ".dc.x" , ".dcb" , ".dcb.b" , ".dcb.d" , ".dcb.l" , ".dcb.s" , ".dcb.w" , ".dcb.x" , ".debug" , ".def" , ".desc" , ".dim" , ".double" , ".ds" , ".ds.b" , ".ds.d" , ".ds.l" , ".ds.p" , ".ds.s" , ".ds.w" , ".ds.x" , ".dsect" , ".eject" , ".else" , ".elsec" , ".elseif" , ".end" , ".endc" , ".endef" , ".endfunc" , ".endif" , ".endm" , ".endr" , ".equ" , ".equiv" , ".err" , ".even" , ".exitm" , ".extend" , ".extern" , ".fail" , ".file" , ".fill" , ".float" , ".force_thumb" , ".format" , ".func" , ".global" , ".globl" , ".hidden" , ".hword" , ".ident" , ".if" , ".ifc" , ".ifdef" , ".ifeq" , ".ifeqs" , ".ifge" , ".ifgt" , ".ifle" , ".iflt" , ".ifnc" , ".ifndef" , ".ifne" , ".ifnes" , ".ifnotdef" , ".include" , ".int" , ".intel_syntax" , ".internal" , ".irep" , ".irepc" , ".irp" , ".irpc" , ".lcomm" , ".ldouble" , ".lflags" , ".line" , ".linkonce" , ".list" , ".llen" , ".ln" , ".loc" , ".long" , ".lsym" , ".ltorg" , ".macro" , ".mexit" , ".name" , ".noformat" , ".nolist" , ".nopage" , ".octa" , ".offset" , ".org" , ".p2align" , ".p2alignl" , ".p2alignw" , ".packed" , ".page" , ".plen" , ".pool" , ".popsection" , ".previous" , ".print" , ".protected" , ".psize" , ".purgem" , ".pushsection" , ".quad" , ".rep" , ".rept" , ".req" , ".rodata" , ".rva" , ".sbttl" , ".scl" , ".sect" , ".sect.s" , ".section" , ".section.s" , ".set" , ".short" , ".single" , ".size" , ".skip" , ".sleb128" , ".space" , ".spc" , ".stabd" , ".stabn" , ".stabs" , ".string" , ".struct" , ".subsection" , ".symver" , ".tag" , ".text" , ".thumb" , ".thumb_func" , ".thumb_set" , ".title" , ".ttl" , ".type" , ".uleb128" , ".use" , ".val" , ".version" , ".vtable_entry" , ".vtable_inherit" , ".weak" , ".word" , ".xcom" , ".xdef" , ".xref" , ".xstabs" , ".zero" , "noprefix" ]) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = HlCOct , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = HlCHex , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "0[bB][01]+" , reCompiled = Just (compileRegex True "0[bB][01]+") , reCaseSensitive = True } , rAttribute = BaseNTok , 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 = "0[fFeEdD][-+]?[0-9]*\\.?[0-9]*[eE]?[-+]?[0-9]+" , reCompiled = Just (compileRegex True "0[fFeEdD][-+]?[0-9]*\\.?[0-9]*[eE]?[-+]?[0-9]+") , reCaseSensitive = True } , rAttribute = FloatTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "[A-Za-z_.$][A-Za-z0-9_.$]*" , reCompiled = Just (compileRegex True "[A-Za-z_.$][A-Za-z0-9_.$]*") , reCaseSensitive = True } , rAttribute = NormalTok , 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 = RegExpr RE { reString = "'(\\\\x[0-9a-fA-F][0-9a-fA-F]?|\\\\[0-7]?[0-7]?[0-7]?|\\\\.|.)" , reCompiled = Just (compileRegex True "'(\\\\x[0-9a-fA-F][0-9a-fA-F]?|\\\\[0-7]?[0-7]?[0-7]?|\\\\.|.)") , 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 ( "GNU Assembler" , "String" ) ] } , Rule { rMatcher = RegExpr RE { reString = "#\\s*if(?:def|ndef)?(?=\\s+\\S)" , reCompiled = Just (compileRegex False "#\\s*if(?:def|ndef)?(?=\\s+\\S)") , reCaseSensitive = False } , rAttribute = PreprocessorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = True , rColumn = Nothing , rContextSwitch = [ Push ( "GNU Assembler" , "Preprocessor" ) ] } , Rule { rMatcher = RegExpr RE { reString = "#\\s*endif" , reCompiled = Just (compileRegex False "#\\s*endif") , reCaseSensitive = False } , rAttribute = PreprocessorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = True , rColumn = Nothing , rContextSwitch = [ Push ( "GNU Assembler" , "Preprocessor" ) ] } , Rule { rMatcher = RegExpr RE { reString = "#\\s*define.*((?=\\\\))" , reCompiled = Just (compileRegex False "#\\s*define.*((?=\\\\))") , reCaseSensitive = False } , rAttribute = PreprocessorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = True , rColumn = Nothing , rContextSwitch = [ Push ( "GNU Assembler" , "Define" ) ] } , Rule { rMatcher = RegExpr RE { reString = "#\\s*(?:el(?:se|if)|include(?:_next)?|define|undef|line|error|warning|pragma)" , reCompiled = Just (compileRegex True "#\\s*(?:el(?:se|if)|include(?:_next)?|define|undef|line|error|warning|pragma)") , reCaseSensitive = True } , rAttribute = PreprocessorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = True , rColumn = Nothing , rContextSwitch = [ Push ( "GNU Assembler" , "Preprocessor" ) ] } , Rule { rMatcher = Detect2Chars '/' '*' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "GNU Assembler" , "Commentar 1" ) ] } , Rule { rMatcher = AnyChar "@;#" , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "GNU Assembler" , "Commentar 2" ) ] } , 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 } ) , ( "Preprocessor" , Context { cName = "Preprocessor" , cSyntax = "GNU Assembler" , cRules = [] , cAttribute = PreprocessorTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Some Context" , Context { cName = "Some Context" , cSyntax = "GNU Assembler" , cRules = [] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "String" , Context { cName = "String" , cSyntax = "GNU Assembler" , cRules = [ Rule { rMatcher = LineContinue , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "GNU Assembler" , "Some Context" ) ] } , Rule { rMatcher = HlCStringChar , rAttribute = SpecialCharTok , 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 = [ Pop ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) ] , sAuthor = "John Zaitseff (J.Zaitseff@zap.org.au), Roland Pabel (roland@pabel.name), Miquel Sabat\233 (mikisabate@gmail.com)" , sVersion = "3" , sLicense = "GPLv2+" , sExtensions = [ "*.s" , "*.S" ] , sStartingContext = "Normal" }