{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Ocaml (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex import qualified Data.Set syntax :: Syntax syntax = Syntax { sName = "Objective Caml" , sFilename = "ocaml.xml" , sShortname = "Ocaml" , sContexts = fromList [ ( "Camlp4 Quotation" , Context { cName = "Camlp4 Quotation" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = Detect2Chars '>' '>' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = Detect2Chars '<' '<' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Camlp4 Quotation" ) ] } , Rule { rMatcher = RegExpr RE { reString = "<:`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*<" , reCompiled = Just (compileRegex True "<:`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*<") , reCaseSensitive = True } , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Camlp4 Quotation" ) ] } , 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 = RegExpr RE { reString = "\\\\<:`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*<" , reCompiled = Just (compileRegex True "\\\\<:`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*<") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Code" , Context { cName = "Code" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = DetectChar '[' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Nested Code 1" ) ] } , Rule { rMatcher = DetectChar '{' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Nested Code 2" ) ] } , Rule { rMatcher = StringDetect "(**)" , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = StringDetect "(**" , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Ocamldoc" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\(\\*\\$(T|Q|R|=)" , reCompiled = Just (compileRegex True "\\(\\*\\$(T|Q|R|=)") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "qtest header" ) ] } , Rule { rMatcher = Detect2Chars '(' '*' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Comment" ) ] } , Rule { rMatcher = RegExpr RE { reString = "#`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*.*$" , reCompiled = Just (compileRegex True "#`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*.*$") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = True , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "String" ) ] } , Rule { rMatcher = RegExpr RE { reString = "'((\\\\[ntbr'\"\\\\]|\\\\[0-9]{3}|\\\\x[0-9A-Fa-f]{2})|[^'])'" , reCompiled = Just (compileRegex True "'((\\\\[ntbr'\"\\\\]|\\\\[0-9]{3}|\\\\x[0-9A-Fa-f]{2})|[^'])'") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '<' '<' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Camlp4 Quotation" ) ] } , Rule { rMatcher = RegExpr RE { reString = "<:`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*<" , reCompiled = Just (compileRegex True "<:`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*<") , reCaseSensitive = True } , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Camlp4 Quotation" ) ] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet True [ "and" , "as" , "asr" , "assert" , "begin" , "class" , "closed" , "constraint" , "do" , "done" , "downto" , "else" , "end" , "exception" , "external" , "false" , "for" , "fun" , "function" , "functor" , "if" , "in" , "include" , "inherit" , "land" , "lazy" , "let" , "lor" , "lsl" , "lsr" , "lxor" , "match" , "method" , "mod" , "module" , "mutable" , "new" , "object" , "of" , "open" , "or" , "parser" , "private" , "rec" , "sig" , "struct" , "then" , "to" , "true" , "try" , "type" , "val" , "virtual" , "when" , "while" , "with" ]) , 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 [ "declare" , "value" , "where" ]) , rAttribute = NormalTok , 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 [ "exit" , "failwith" , "invalid_arg" , "raise" ]) , rAttribute = DataTypeTok , 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 [ "abs" , "abs_float" , "acos" , "asin" , "at_exit" , "atan" , "atan2" , "bool_of_string" , "ceil" , "char_of_int" , "classify_float" , "close_in" , "close_in_noerr" , "close_out" , "close_out_noerr" , "compare" , "cos" , "cosh" , "decr" , "do_at_exit" , "epsilon_float" , "exp" , "float" , "float_of_int" , "float_of_string" , "floor" , "flush" , "flush_all" , "format_of_string" , "frexp" , "fst" , "ignore" , "in_channel_length" , "incr" , "infinity" , "input" , "input_binary_int" , "input_byte" , "input_char" , "input_line" , "input_value" , "int_of_char" , "int_of_float" , "int_of_string" , "ldexp" , "lnot" , "log" , "log10" , "max" , "max_float" , "max_int" , "min" , "min_float" , "min_int" , "mod_float" , "modf" , "nan" , "neg_infinity" , "not" , "open_in" , "open_in_bin" , "open_in_gen" , "open_out" , "open_out_bin" , "open_out_gen" , "out_channel_length" , "output" , "output_binary_int" , "output_byte" , "output_char" , "output_string" , "output_value" , "pos_in" , "pos_out" , "pred" , "prerr_char" , "prerr_endline" , "prerr_float" , "prerr_int" , "prerr_newline" , "prerr_string" , "print_char" , "print_endline" , "print_float" , "print_int" , "print_newline" , "print_string" , "read_float" , "read_int" , "read_line" , "really_input" , "ref" , "seek_in" , "seek_out" , "set_binary_mode_in" , "set_binary_mode_out" , "sin" , "sinh" , "snd" , "sqrt" , "stderr" , "stdin" , "stdout" , "string_of_bool" , "string_of_float" , "string_of_format" , "string_of_int" , "succ" , "tan" , "tanh" , "truncate" , "unsafe_really_input" , "valid_float_lexem" ]) , rAttribute = DataTypeTok , 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 [ "array" , "bool" , "char" , "exn" , "format4" , "fpclass" , "in_channel" , "int" , "int32" , "int64" , "lazy_t" , "list" , "nativeint" , "open_flag" , "option" , "out_channel" , "real" , "ref" , "string" , "unit" ]) , rAttribute = DataTypeTok , 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 [ "Assert_failure" , "Division_by_zero" , "End_of_file" , "Exit" , "Failure" , "Invalid_argument" , "Match_failure" , "Not_found" , "Out_of_memory" , "Stack_overflow" , "Sys_blocked_io" , "Sys_error" , "Undefined_recursive_module" ]) , rAttribute = DataTypeTok , 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 [ "FP_infinite" , "FP_nan" , "FP_normal" , "FP_subnormal" , "FP_zero" , "None" , "Open_append" , "Open_binary" , "Open_creat" , "Open_excl" , "Open_nonblock" , "Open_rdonly" , "Open_text" , "Open_trunc" , "Open_wronly" , "Some" ]) , rAttribute = DataTypeTok , 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 [ "Arg" , "Array" , "ArrayLabels" , "Buffer" , "Callback" , "Char" , "Complex" , "Digest" , "Filename" , "Format" , "Gc" , "Genlex" , "Hashtbl" , "Int32" , "Int64" , "Lazy" , "Lexing" , "List" , "ListLabels" , "Map" , "Marshal" , "MoreLabels" , "Nativeint" , "Oo" , "Parsing" , "Printexc" , "Printf" , "Queue" , "Random" , "Scanf" , "Set" , "Sort" , "Stack" , "StdLabels" , "Stream" , "String" , "StringLabels" , "Sys" , "Weak" ]) , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "[a-z\\300-\\326\\330-\\337_][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*" , reCompiled = Just (compileRegex True "[a-z\\300-\\326\\330-\\337_][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "`?[A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*" , reCompiled = Just (compileRegex True "`?[A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "-?0[xX][0-9A-Fa-f_]+" , reCompiled = Just (compileRegex True "-?0[xX][0-9A-Fa-f_]+") , reCaseSensitive = True } , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "-?0[oO][0-7_]+" , reCompiled = Just (compileRegex True "-?0[oO][0-7_]+") , reCaseSensitive = True } , 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 = RegExpr RE { reString = "-?[0-9][0-9_]*(\\.[0-9][0-9_]*([eE][-+]?[0-9][0-9_]*)?|[eE][-+]?[0-9][0-9_]*)" , reCompiled = Just (compileRegex True "-?[0-9][0-9_]*(\\.[0-9][0-9_]*([eE][-+]?[0-9][0-9_]*)?|[eE][-+]?[0-9][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 = "-?[0-9][0-9_]*" , reCompiled = Just (compileRegex True "-?[0-9][0-9_]*") , reCaseSensitive = True } , rAttribute = DecValTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Objective Caml" , "Unmatched Closing Brackets" ) , 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 } ) , ( "Comment" , Context { cName = "Comment" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = Detect2Chars '*' ')' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = Detect2Chars '(' '*' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Comment" ) ] } , Rule { rMatcher = DetectChar '"' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "String in Comment" ) ] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Nested Code 1" , Context { cName = "Nested Code 1" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = DetectChar ']' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Objective Caml" , "Code" ) , rAttribute = NormalTok , rIncludeAttribute = True , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Nested Code 2" , Context { cName = "Nested Code 2" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = DetectChar '}' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Objective Caml" , "Code" ) , rAttribute = NormalTok , rIncludeAttribute = True , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Nested Ocamldoc" , Context { cName = "Nested Ocamldoc" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = DetectChar '}' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = Detect2Chars '*' ')' , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Objective Caml" , "Ocamldoc" ) , rAttribute = NormalTok , rIncludeAttribute = True , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Ocamldoc" , Context { cName = "Ocamldoc" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = Detect2Chars '*' ')' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , 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 = StringDetect "(**)" , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = StringDetect "(**" , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Ocamldoc" ) ] } , Rule { rMatcher = Detect2Chars '(' '*' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Comment" ) ] } , Rule { rMatcher = DetectChar '"' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "String in Comment" ) ] } , Rule { rMatcher = DetectChar '[' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Ocamldoc Code" ) ] } , Rule { rMatcher = Detect2Chars '{' '[' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Ocamldoc Preformatted" ) ] } , Rule { rMatcher = Detect2Chars '{' '%' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Ocamldoc LaTeX" ) ] } , Rule { rMatcher = Detect2Chars '{' '^' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Nested Ocamldoc" ) ] } , Rule { rMatcher = RegExpr RE { reString = "[{]v(\\s|$)" , reCompiled = Just (compileRegex True "[{]v(\\s|$)") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Ocamldoc Verbatim" ) ] } , Rule { rMatcher = RegExpr RE { reString = "[{]b(\\s|$)" , reCompiled = Just (compileRegex True "[{]b(\\s|$)") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Ocamldoc Bold" ) ] } , Rule { rMatcher = RegExpr RE { reString = "[{]i(\\s|$)" , reCompiled = Just (compileRegex True "[{]i(\\s|$)") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Ocamldoc Italic" ) ] } , Rule { rMatcher = RegExpr RE { reString = "[{]e(\\s|$)" , reCompiled = Just (compileRegex True "[{]e(\\s|$)") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Ocamldoc Emphasised" ) ] } , Rule { rMatcher = RegExpr RE { reString = "[{][0-9]+(:`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*)?\\s" , reCompiled = Just (compileRegex True "[{][0-9]+(:`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*)?\\s") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Ocamldoc Heading" ) ] } , Rule { rMatcher = RegExpr RE { reString = "[{][{]:`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*[}]" , reCompiled = Just (compileRegex True "[{][{]:`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*[}]") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Ocamldoc Link" ) ] } , Rule { rMatcher = RegExpr RE { reString = "[{]!([a-z]+:)?" , reCompiled = Just (compileRegex True "[{]!([a-z]+:)?") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Ocamldoc References" ) ] } , Rule { rMatcher = RegExpr RE { reString = "[{]`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*(\\s|$)" , reCompiled = Just (compileRegex True "[{]`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*(\\s|$)") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Nested Ocamldoc" ) ] } , Rule { rMatcher = RegExpr RE { reString = "@see\\s*(<[^>]*>|\"[^\"]*\"|'[^']*')" , reCompiled = Just (compileRegex True "@see\\s*(<[^>]*>|\"[^\"]*\"|'[^']*')") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "@(param|raise)\\s*" , reCompiled = Just (compileRegex True "@(param|raise)\\s*") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Objective Caml" , "Ocamldoc Identifier" ) ] } , Rule { rMatcher = RegExpr RE { reString = "@(author|deprecated|return|since|version)" , reCompiled = Just (compileRegex True "@(author|deprecated|return|since|version)") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "@`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*" , reCompiled = Just (compileRegex True "@`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "[ ]*-\\s" , reCompiled = Just (compileRegex True "[ ]*-\\s") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Objective Caml" , "Unmatched Closing Brackets" ) , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Ocamldoc Bold" , Context { cName = "Ocamldoc Bold" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = IncludeRules ( "Objective Caml" , "Nested Ocamldoc" ) , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Ocamldoc Code" , Context { cName = "Ocamldoc Code" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = DetectChar ']' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Objective Caml" , "Code" ) , rAttribute = NormalTok , rIncludeAttribute = True , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Ocamldoc Emphasised" , Context { cName = "Ocamldoc Emphasised" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = IncludeRules ( "Objective Caml" , "Nested Ocamldoc" ) , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Ocamldoc Heading" , Context { cName = "Ocamldoc Heading" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = IncludeRules ( "Objective Caml" , "Nested Ocamldoc" ) , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Ocamldoc Identifier" , Context { cName = "Ocamldoc Identifier" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*(\\.`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*)*" , reCompiled = Just (compileRegex True "`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*(\\.`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*)*") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = Detect2Chars '*' ')' , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = DetectSpaces , 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 = False } ) , ( "Ocamldoc Italic" , Context { cName = "Ocamldoc Italic" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = IncludeRules ( "Objective Caml" , "Nested Ocamldoc" ) , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Ocamldoc LaTeX" , Context { cName = "Ocamldoc LaTeX" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = Detect2Chars '%' '}' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "LaTeX" , "" ) , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Ocamldoc Link" , Context { cName = "Ocamldoc Link" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = IncludeRules ( "Objective Caml" , "Nested Ocamldoc" ) , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Ocamldoc Preformatted" , Context { cName = "Ocamldoc Preformatted" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = Detect2Chars ']' '}' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Objective Caml" , "Code" ) , rAttribute = NormalTok , rIncludeAttribute = True , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Ocamldoc References" , Context { cName = "Ocamldoc References" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = DetectChar '}' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = Detect2Chars '*' ')' , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*(\\.`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*)*" , reCompiled = Just (compileRegex True "`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*(\\.`?[a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\377][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*)*") , reCaseSensitive = True } , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectSpaces , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = ErrorTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Ocamldoc Verbatim" , Context { cName = "Ocamldoc Verbatim" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = Detect2Chars 'v' '}' , rAttribute = OtherTok , 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 } ) , ( "String" , Context { cName = "String" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(\\\\[ntbr'\"\\\\]|\\\\[0-9]{3}|\\\\x[0-9A-Fa-f]{2})" , reCompiled = Just (compileRegex True "(\\\\[ntbr'\"\\\\]|\\\\[0-9]{3}|\\\\x[0-9A-Fa-f]{2})") , reCaseSensitive = True } , rAttribute = CharTok , 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 = [] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "String in Comment" , Context { cName = "String in Comment" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = DetectChar '"' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Objective Caml" , "String" ) , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Unmatched Closing Brackets" , Context { cName = "Unmatched Closing Brackets" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = Detect2Chars '*' ')' , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = Detect2Chars 'v' '}' , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars ']' '}' , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '%' '}' , 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 = DetectChar '}' , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "qtest" , Context { cName = "qtest" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = Detect2Chars '*' ')' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Objective Caml" , "Code" ) , rAttribute = NormalTok , rIncludeAttribute = True , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "qtest header" , Context { cName = "qtest header" , cSyntax = "Objective Caml" , cRules = [ Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet True [ "as" , "forall" , "in" ]) , rAttribute = KeywordTok , 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 = [ Push ( "Objective Caml" , "qtest param" ) ] } , Rule { rMatcher = RegExpr RE { reString = "[a-z\\300-\\326\\330-\\337_][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*" , reCompiled = Just (compileRegex True "[a-z\\300-\\326\\330-\\337_][a-z\\300-\\326\\330-\\337A-Z\\340-\\366\\370-\\3770-9_']*") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [ Push ( "Objective Caml" , "qtest" ) ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "qtest param" , Context { cName = "qtest param" , cSyntax = "Objective Caml" , cRules = [] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [ Push ( "Objective Caml" , "qtest" ) ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) ] , sAuthor = "Glyn Webster (glynwebster@orcon.net.nz) and Vincent Hugot (vincent.hugot@gmail.com)" , sVersion = "3" , sLicense = "LGPL" , sExtensions = [ "*.ml" , "*.mli" ] , sStartingContext = "Code" }