{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Fasm (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex import qualified Data.Set syntax :: Syntax syntax = Syntax { sName = "Intel x86 (FASM)" , sFilename = "fasm.xml" , sShortname = "Fasm" , sContexts = fromList [ ( "Comment" , Context { cName = "Comment" , cSyntax = "Intel x86 (FASM)" , cRules = [] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Normal" , Context { cName = "Normal" , cSyntax = "Intel x86 (FASM)" , cRules = [ Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "ah" , "al" , "ax" , "bh" , "bl" , "bp" , "bx" , "ch" , "cl" , "cr0" , "cr2" , "cr3" , "cr4" , "cs" , "cx" , "dh" , "di" , "dl" , "dr0" , "dr1" , "dr2" , "dr3" , "dr6" , "dr7" , "ds" , "dx" , "eax" , "ebp" , "ebx" , "ecx" , "edi" , "edx" , "es" , "esi" , "esp" , "fs" , "gs" , "mm0" , "mm1" , "mm2" , "mm3" , "mm4" , "mm5" , "mm6" , "mm7" , "r10" , "r11" , "r12" , "r13" , "r14" , "r15" , "r8" , "r9" , "rax" , "rbp" , "rbx" , "rcx" , "rdi" , "rdx" , "rsi" , "rsp" , "si" , "sp" , "ss" , "st" , "xmm0" , "xmm1" , "xmm2" , "xmm3" , "xmm4" , "xmm5" , "xmm6" , "xmm7" ]) , 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 [ "byte" , "db" , "dd" , "df" , "dp" , "dq" , "dqword" , "dt" , "du" , "dw" , "dword" , "file" , "ptr" , "pword" , "qword" , "rb" , "rd" , "rf" , "rp" , "rq" , "rt" , "rw" , "tbyte" , "tword" , "word" ]) , 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 [ "aaa" , "aad" , "aam" , "aas" , "adc" , "add" , "addpd" , "addps" , "addsd" , "addss" , "addsubpd" , "addsubps" , "and" , "andnpd" , "andnps" , "andpd" , "andps" , "arpl" , "bound" , "bsf" , "bsr" , "bswap" , "bt" , "btc" , "btr" , "bts" , "call" , "cbw" , "cdq" , "cdqe" , "clc" , "cld" , "clflush" , "clgi" , "cli" , "clts" , "cmc" , "cmova" , "cmovae" , "cmovb" , "cmovbe" , "cmovc" , "cmove" , "cmovg" , "cmovge" , "cmovl" , "cmovle" , "cmovna" , "cmovnae" , "cmovnb" , "cmovnbe" , "cmovnc" , "cmovne" , "cmovng" , "cmovnge" , "cmovnl" , "cmovnle" , "cmovno" , "cmovnp" , "cmovns" , "cmovnz" , "cmovo" , "cmovp" , "cmovpe" , "cmovpo" , "cmovs" , "cmovz" , "cmp" , "cmpeqpd" , "cmpeqps" , "cmpeqsd" , "cmpeqss" , "cmplepd" , "cmpleps" , "cmplesd" , "cmpless" , "cmpltpd" , "cmpltps" , "cmpltsd" , "cmpltss" , "cmpneqpd" , "cmpneqps" , "cmpneqsd" , "cmpneqss" , "cmpnlepd" , "cmpnleps" , "cmpnlesd" , "cmpnless" , "cmpnltpd" , "cmpnltps" , "cmpnltsd" , "cmpnltss" , "cmpordpd" , "cmpordps" , "cmpordsd" , "cmpordss" , "cmppd" , "cmpps" , "cmps" , "cmpsb" , "cmpsd" , "cmpss" , "cmpsw" , "cmpunordpd" , "cmpunordps" , "cmpunordsd" , "cmpunordss" , "cmpxchg" , "cmpxchg16b" , "cmpxchg486" , "cmpxchg8b" , "comisd" , "comiss" , "cpuid" , "cqo" , "cvtdq2pd" , "cvtdq2ps" , "cvtpd2dq" , "cvtpd2pi" , "cvtpd2ps" , "cvtpi2pd" , "cvtpi2ps" , "cvtps2dq" , "cvtps2pd" , "cvtps2pi" , "cvtsd2si" , "cvtsd2ss" , "cvtsi2sd" , "cvtsi2ss" , "cvtss2sd" , "cvtss2si" , "cvttpd2dq" , "cvttpd2pi" , "cvttps2dq" , "cvttps2pi" , "cvttsd2si" , "cvttss2si" , "cwd" , "cwde" , "daa" , "das" , "dec" , "div" , "divpd" , "divps" , "divsd" , "divss" , "emms" , "enter" , "f2xm1" , "fabs" , "fadd" , "faddp" , "fbld" , "fbstp" , "fchs" , "fclex" , "fcmovb" , "fcmovbe" , "fcmove" , "fcmovnb" , "fcmovnbe" , "fcmovne" , "fcmovnu" , "fcmovu" , "fcom" , "fcomi" , "fcomip" , "fcomp" , "fcompp" , "fcos" , "fdecstp" , "fdisi" , "fdiv" , "fdivp" , "fdivr" , "fdivrp" , "femms" , "feni" , "ffree" , "ffreep" , "fiadd" , "ficom" , "ficomp" , "fidiv" , "fidivr" , "fild" , "fimul" , "fincstp" , "finit" , "fist" , "fistp" , "fisttp" , "fisub" , "fisubr" , "fld" , "fld1" , "fldcw" , "fldenv" , "fldl2e" , "fldl2t" , "fldlg2" , "fldln2" , "fldpi" , "fldz" , "fmul" , "fmulp" , "fnclex" , "fndisi" , "fneni" , "fninit" , "fnop" , "fnsave" , "fnstcw" , "fnstenv" , "fnstsw" , "fnwait" , "fpatan" , "fprem" , "fprem1" , "fptan" , "frndint" , "frstor" , "fsave" , "fscale" , "fsetpm" , "fsin" , "fsincos" , "fsqrt" , "fst" , "fstcw" , "fstenv" , "fstp" , "fstsw" , "fsub" , "fsubp" , "fsubr" , "fsubrp" , "ftst" , "fucom" , "fucomi" , "fucomip" , "fucomp" , "fucompp" , "fwait" , "fxam" , "fxch" , "fxrstor" , "fxsave" , "fxtract" , "fyl2x" , "fyl2xp1" , "haddpd" , "haddps" , "hlt" , "hsubpd" , "hsubps" , "ibts" , "idiv" , "imul" , "in" , "inc" , "ins" , "insb" , "insd" , "insw" , "int" , "int1" , "int3" , "into" , "invd" , "invlpg" , "invlpga" , "iret" , "iretd" , "iretq" , "iretw" , "ja" , "jae" , "jb" , "jbe" , "jc" , "jcxz" , "je" , "jecxz" , "jg" , "jge" , "jl" , "jle" , "jmp" , "jna" , "jnae" , "jnb" , "jnbe" , "jnc" , "jne" , "jng" , "jnge" , "jnl" , "jnle" , "jno" , "jnp" , "jns" , "jnz" , "jo" , "jp" , "jpe" , "jpo" , "jrcxz" , "js" , "jz" , "lahf" , "lar" , "lddqu" , "ldmxcsr" , "lds" , "lea" , "leave" , "les" , "lfence" , "lfs" , "lgdt" , "lgs" , "lidt" , "lldt" , "lmsw" , "loadall" , "loadall286" , "lods" , "lodsb" , "lodsd" , "lodsq" , "lodsw" , "loop" , "loope" , "loopne" , "loopnz" , "loopz" , "lsl" , "lss" , "ltr" , "maskmovdqu" , "maskmovq" , "maxpd" , "maxps" , "maxsd" , "maxss" , "mfence" , "minpd" , "minps" , "minsd" , "minss" , "monitor" , "mov" , "movapd" , "movaps" , "movd" , "movddup" , "movdq2q" , "movdqa" , "movdqu" , "movhlps" , "movhpd" , "movhps" , "movlhps" , "movlpd" , "movlps" , "movmskpd" , "movmskps" , "movntdq" , "movnti" , "movntpd" , "movntps" , "movntq" , "movq" , "movq2dq" , "movs" , "movsb" , "movsd" , "movshdup" , "movsldup" , "movsq" , "movss" , "movsw" , "movsx" , "movsxd" , "movupd" , "movups" , "movzx" , "mul" , "mulpd" , "mulps" , "mulsd" , "mulss" , "mwait" , "neg" , "nop" , "not" , "or" , "orpd" , "orps" , "out" , "outs" , "outsb" , "outsd" , "outsw" , "packssdw" , "packsswb" , "packuswb" , "paddb" , "paddd" , "paddq" , "paddsb" , "paddsw" , "paddusb" , "paddusw" , "paddw" , "pand" , "pandn" , "pause" , "pavgb" , "pavgusb" , "pavgw" , "pcmpeqb" , "pcmpeqd" , "pcmpeqw" , "pcmpgtb" , "pcmpgtd" , "pcmpgtw" , "pdistib" , "pextrw" , "pf2id" , "pf2iw" , "pfacc" , "pfadd" , "pfcmpeq" , "pfcmpge" , "pfcmpgt" , "pfmax" , "pfmin" , "pfmul" , "pfnacc" , "pfpnacc" , "pfrcp" , "pfrcpit1" , "pfrcpit2" , "pfrsqit1" , "pfrsqrt" , "pfsub" , "pfsubr" , "pi2fd" , "pi2fw" , "pinsrw" , "pmachriw" , "pmaddwd" , "pmagw" , "pmaxsw" , "pmaxub" , "pminsw" , "pminub" , "pmovmskb" , "pmulhrw" , "pmulhuw" , "pmulhw" , "pmullw" , "pmuludq" , "pmvgezb" , "pmvlzb" , "pmvnzb" , "pmvzb" , "pop" , "popa" , "popad" , "popaw" , "popf" , "popfd" , "popfq" , "popfw" , "por" , "prefetch" , "prefetchnta" , "prefetcht0" , "prefetcht1" , "prefetcht2" , "prefetchw" , "psadbw" , "pshufd" , "pshufhw" , "pshuflw" , "pshufw" , "pslld" , "pslldq" , "psllq" , "psllw" , "psrad" , "psraw" , "psrld" , "psrldq" , "psrlq" , "psrlw" , "psubb" , "psubd" , "psubq" , "psubsb" , "psubsiw" , "psubsw" , "psubusb" , "psubusw" , "psubw" , "pswapd" , "punpckhbw" , "punpckhdq" , "punpckhqdq" , "punpckhwd" , "punpcklbw" , "punpckldq" , "punpcklqdq" , "punpcklwd" , "push" , "pusha" , "pushad" , "pushaw" , "pushf" , "pushfd" , "pushfq" , "pushfw" , "pxor" , "rcl" , "rcpps" , "rcpss" , "rcr" , "rdmsr" , "rdpmc" , "rdshr" , "rdtsc" , "rdtscp" , "ret" , "retf" , "retn" , "rol" , "ror" , "rsdc" , "rsldt" , "rsm" , "rsqrtps" , "rsqrtss" , "rsts" , "sahf" , "sal" , "salc" , "sar" , "sbb" , "scas" , "scasb" , "scasd" , "scasq" , "scasw" , "seta" , "setae" , "setb" , "setbe" , "setc" , "sete" , "setg" , "setge" , "setl" , "setle" , "setna" , "setnae" , "setnb" , "setnbe" , "setnc" , "setne" , "setng" , "setnge" , "setnl" , "setnle" , "setno" , "setnp" , "setns" , "setnz" , "seto" , "setp" , "setpe" , "setpo" , "sets" , "setz" , "sfence" , "sgdt" , "shl" , "shld" , "shr" , "shrd" , "shufpd" , "shufps" , "sidt" , "skinit" , "sldt" , "smi" , "smint" , "smintold" , "smsw" , "sqrtpd" , "sqrtps" , "sqrtsd" , "sqrtss" , "stc" , "std" , "stgi" , "sti" , "stmxcsr" , "stos" , "stosb" , "stosd" , "stosq" , "stosw" , "str" , "sub" , "subpd" , "subps" , "subsd" , "subss" , "svdc" , "svldt" , "svts" , "swapgs" , "syscall" , "sysenter" , "sysexit" , "sysret" , "test" , "ucomisd" , "ucomiss" , "ud0" , "ud1" , "ud2" , "umov" , "unpckhpd" , "unpckhps" , "unpcklpd" , "unpcklps" , "verr" , "verw" , "vmload" , "vmmcall" , "vmrun" , "vmsave" , "wait" , "wbinvd" , "wrmsr" , "wrshr" , "xadd" , "xbts" , "xchg" , "xlat" , "xlatb" , "xor" , "xorpd" , "xorps" ]) , rAttribute = BuiltInTok , 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 [ "align" , "data" , "entry" , "extrn" , "format" , "from" , "heap" , "include" , "invoke" , "load" , "org" , "proc" , "public" , "section" , "segment" , "stack" , "store" , "use16" , "use32" , "use64" ]) , rAttribute = BuiltInTok , 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 [ "append" , "at" , "break" , "common" , "display" , "else" , "end" , "equ" , "fix" , "foward" , "if" , "irp" , "irps" , "label" , "local" , "macro" , "match" , "purge" , "repeat" , "rept" , "restore" , "reverse" , "struc" , "times" , "virtual" , "while" ]) , rAttribute = PreprocessorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar ';' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Intel x86 (FASM)" , "Comment" ) ] } , Rule { rMatcher = AnyChar "\"'" , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Intel x86 (FASM)" , "String" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\s*[A-Za-z0-9@_.$?]+:" , reCompiled = Just (compileRegex True "\\s*[A-Za-z0-9@_.$?]+:") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(cmov|fcmov|j|loop|set)(a|ae|b|be|c|e|g|ge|l|le|na|nae|nb|nbe|nc|ne|ng|nge|nl|nle|no|np|ns|nz|o|p|pe|po|s|z)" , reCompiled = Just (compileRegex True "(cmov|fcmov|j|loop|set)(a|ae|b|be|c|e|g|ge|l|le|na|nae|nb|nbe|nc|ne|ng|nge|nl|nle|no|np|ns|nz|o|p|pe|po|s|z)") , reCaseSensitive = True } , rAttribute = BuiltInTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(^|[ \\t,]+)((\\$|0x){1}[0-9]+[a-f0-9]*|[a-f0-9]+h)([ \\t,]+|$)" , reCompiled = Just (compileRegex False "(^|[ \\t,]+)((\\$|0x){1}[0-9]+[a-f0-9]*|[a-f0-9]+h)([ \\t,]+|$)") , reCaseSensitive = False } , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(^|[ \\t,]+)([0-7]+(q|o)|[01]+b)([ \\t,]+|$)" , reCompiled = Just (compileRegex False "(^|[ \\t,]+)([0-7]+(q|o)|[01]+b)([ \\t,]+|$)") , reCaseSensitive = False } , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '$' , rAttribute = DecValTok , 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 = 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 = HlCChar , rAttribute = CharTok , 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 = "Intel x86 (FASM)" , cRules = [] , cAttribute = PreprocessorTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "String" , Context { cName = "String" , cSyntax = "Intel x86 (FASM)" , cRules = [ Rule { rMatcher = AnyChar "\"'" , 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 = "rCX (rCX12@yahoo.com)" , sVersion = "1" , sLicense = "GPL" , sExtensions = [ "*.asm" , "*.inc" , "*.fasm" ] , sStartingContext = "Normal" }