{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Curry (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex import qualified Data.Set syntax :: Syntax syntax = Syntax { sName = "Curry" , sFilename = "curry.xml" , sShortname = "Curry" , sContexts = fromList [ ( "Char" , Context { cName = "Char" , cSyntax = "Curry" , cRules = [ Rule { rMatcher = DetectChar '\'' , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = DetectChar '\\' , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "CharEscape" ) ] } , 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 = [ Push ( "Curry" , "CharEnd" ) ] } ] , cAttribute = CharTok , cLineEmptyContext = [] , cLineEndContext = [ Push ( "Curry" , "CharSyntaxError" ) ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "CharEnd" , Context { cName = "CharEnd" , cSyntax = "Curry" , cRules = [ Rule { rMatcher = DetectChar '\'' , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = RegExpr RE { reString = "." , reCompiled = Just (compileRegex True ".") , reCaseSensitive = True } , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = CharTok , cLineEmptyContext = [] , cLineEndContext = [ Pop , Push ( "Curry" , "CharSyntaxError" ) ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "CharEscape" , Context { cName = "CharEscape" , cSyntax = "Curry" , cRules = [ Rule { rMatcher = AnyChar "abfnrtv\\\"'" , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Push ( "Curry" , "CharEnd" ) ] } , Rule { rMatcher = RegExpr RE { reString = "o[0-7]+" , reCompiled = Just (compileRegex True "o[0-7]+") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Push ( "Curry" , "CharEnd" ) ] } , Rule { rMatcher = RegExpr RE { reString = "[0-9]+" , reCompiled = Just (compileRegex True "[0-9]+") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Push ( "Curry" , "CharEnd" ) ] } , Rule { rMatcher = RegExpr RE { reString = "x[0-9a-fA-F]+" , reCompiled = Just (compileRegex True "x[0-9a-fA-F]+") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Push ( "Curry" , "CharEnd" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\^[A-Z@\\[\\\\\\]\\^_]" , reCompiled = Just (compileRegex True "\\^[A-Z@\\[\\\\\\]\\^_]") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Push ( "Curry" , "CharEnd" ) ] } , Rule { rMatcher = RegExpr RE { reString = "NUL|SOH|STX|ETX|EOT|ENQ|ACK|BEL|BS|HT|LF|VT|FF|CR|SO|SI|DLE|DC1|DC2|DC3|DC4|NAK|SYN|ETB|CAN|EM|SUB|ESC|FS|GS|RS|US|SP|DEL" , reCompiled = Just (compileRegex True "NUL|SOH|STX|ETX|EOT|ENQ|ACK|BEL|BS|HT|LF|VT|FF|CR|SO|SI|DLE|DC1|DC2|DC3|DC4|NAK|SYN|ETB|CAN|EM|SUB|ESC|FS|GS|RS|US|SP|DEL") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Push ( "Curry" , "CharEnd" ) ] } , Rule { rMatcher = RegExpr RE { reString = "." , reCompiled = Just (compileRegex True ".") , reCaseSensitive = True } , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Push ( "Curry" , "CharEnd" ) ] } ] , cAttribute = CharTok , cLineEmptyContext = [] , cLineEndContext = [ Pop , Push ( "Curry" , "CharSyntaxError" ) ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "CharSyntaxError" , Context { cName = "CharSyntaxError" , cSyntax = "Curry" , cRules = [ Rule { rMatcher = DetectChar '\'' , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } ] , cAttribute = ErrorTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Comment" , Context { cName = "Comment" , cSyntax = "Curry" , cRules = [] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Currydoc" , Context { cName = "Currydoc" , cSyntax = "Curry" , cRules = [] , cAttribute = DocumentationTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Import" , Context { cName = "Import" , cSyntax = "Curry" , cRules = [ Rule { rMatcher = StringDetect "{-#" , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "Pragma" ) ] } , Rule { rMatcher = Detect2Chars '{' '-' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "Multiline Comment" ) ] } , Rule { rMatcher = StringDetect "---" , rAttribute = DocumentationTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "Currydoc" ) ] } , Rule { rMatcher = Detect2Chars '-' '-' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "Comment" ) ] } , Rule { rMatcher = RegExpr RE { reString = "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*" , reCompiled = Just (compileRegex True "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*") , reCaseSensitive = True } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars 'a' 's' , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = StringDetect "hiding" , 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 = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "\\S+" , reCompiled = Just (compileRegex True "\\S+") , reCaseSensitive = True } , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Infix" , Context { cName = "Infix" , cSyntax = "Curry" , cRules = [ Rule { rMatcher = DetectChar '`' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = OtherTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Multiline Comment" , Context { cName = "Multiline Comment" , cSyntax = "Curry" , cRules = [ 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 } ) , ( "Normal" , Context { cName = "Normal" , cSyntax = "Curry" , cRules = [ Rule { rMatcher = StringDetect "{-#" , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "Pragma" ) ] } , Rule { rMatcher = Detect2Chars '{' '-' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "Multiline Comment" ) ] } , Rule { rMatcher = StringDetect "---" , rAttribute = DocumentationTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "Currydoc" ) ] } , Rule { rMatcher = Detect2Chars '-' '-' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "Comment" ) ] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet True [ "case" , "data" , "do" , "else" , "external" , "fcase" , "free" , "if" , "in" , "infix" , "infixl" , "infixr" , "let" , "module" , "of" , "then" , "type" , "where" ]) , 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 [ "all" , "and" , "any" , "appendFile" , "best" , "break" , "browse" , "browseList" , "chr" , "concat" , "concatMap" , "const" , "curry" , "div" , "doSolve" , "done" , "drop" , "dropWhile" , "either" , "elem" , "ensureNotFree" , "ensureSpine" , "enumFrom" , "enumFromThen" , "enumFromThenTo" , "enumFromTo" , "error" , "failed" , "filter" , "findall" , "flip" , "foldl" , "foldl1" , "foldr" , "foldr1" , "fst" , "getChar" , "getLine" , "head" , "id" , "if_then_else" , "iterate" , "length" , "lines" , "lookup" , "map" , "mapIO" , "mapIO_" , "max" , "maybe" , "min" , "mod" , "negate" , "not" , "notElem" , "null" , "once" , "or" , "ord" , "otherwise" , "print" , "putChar" , "putStr" , "putStrLn" , "readFile" , "repeat" , "replicate" , "return" , "reverse" , "seq" , "sequenceIO" , "sequenceIO_" , "show" , "snd" , "solveAll" , "span" , "splitAt" , "success" , "tail" , "take" , "takeWhile" , "try" , "uncurry" , "unknown" , "unlines" , "unpack" , "until" , "unwords" , "unzip" , "unzip3" , "words" , "writeFile" , "zip" , "zip3" , "zipWith" , "zipWith3" ]) , rAttribute = FunctionTok , 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 [ "Bool" , "Char" , "Either" , "Float" , "IO" , "Int" , "Maybe" , "Ordering" , "String" , "Success" ]) , 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 [ "EQ" , "False" , "GT" , "Just" , "LT" , "Left" , "Nothing" , "Right" , "True" ]) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "import\\s+(qualified)?" , reCompiled = Just (compileRegex True "import\\s+(qualified)?") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "Import" ) ] } , Rule { rMatcher = Float , rAttribute = FloatTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "0(o|O)[0-7]+" , reCompiled = Just (compileRegex True "0(o|O)[0-7]+") , reCaseSensitive = True } , 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 = Int , rAttribute = DecValTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '\'' , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "Char" ) ] } , Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "String" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(::|:=|:>|\\->|<\\-|\\.\\.)" , reCompiled = Just (compileRegex True "(::|:=|:>|\\->|<\\-|\\.\\.)") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\s*([a-z][a-zA-Z0-9_']*|\\([~!@#\\$%\\^&\\*\\+\\-=<>\\?\\./\\|\\\\:]+\\))\\s*(,\\s*([a-z][a-zA-Z0-9_']*|\\([~!@#\\$%\\^&\\*\\+\\-=<>\\?\\./\\|\\\\:]+\\)))*\\s*(?=::[^~!@#\\$%\\^&\\*\\+\\-=<>\\?\\./\\|\\\\:])" , reCompiled = Just (compileRegex True "\\s*([a-z][a-zA-Z0-9_']*|\\([~!@#\\$%\\^&\\*\\+\\-=<>\\?\\./\\|\\\\:]+\\))\\s*(,\\s*([a-z][a-zA-Z0-9_']*|\\([~!@#\\$%\\^&\\*\\+\\-=<>\\?\\./\\|\\\\:]+\\)))*\\s*(?=::[^~!@#\\$%\\^&\\*\\+\\-=<>\\?\\./\\|\\\\:])") , 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][a-zA-Z0-9_']*\\.)*[a-z][a-zA-Z0-9_']*" , reCompiled = Just (compileRegex True "([A-Z][a-zA-Z0-9_']*\\.)*[a-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 = RegExpr RE { reString = "([A-Z][a-zA-Z0-9_']*\\.)*[~!@#\\$%\\^&\\*\\+\\-=<>\\?\\./\\|\\\\:]+" , reCompiled = Just (compileRegex True "([A-Z][a-zA-Z0-9_']*\\.)*[~!@#\\$%\\^&\\*\\+\\-=<>\\?\\./\\|\\\\:]+") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*" , reCompiled = Just (compileRegex True "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*") , reCaseSensitive = True } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '`' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "Infix" ) ] } , Rule { rMatcher = DetectChar '(' , 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 = [] } , Rule { rMatcher = DetectChar '[' , 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 = [] } , Rule { rMatcher = DetectChar '{' , 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 = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Pragma" , Context { cName = "Pragma" , cSyntax = "Curry" , cRules = [ Rule { rMatcher = StringDetect "#-}" , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = OtherTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "String" , Context { cName = "String" , cSyntax = "Curry" , cRules = [ Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = DetectChar '\\' , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "StringEscape" ) ] } , Rule { rMatcher = RegExpr RE { reString = "[^\"\\\\]*" , reCompiled = Just (compileRegex True "[^\"\\\\]*") , reCaseSensitive = True } , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [ Push ( "Curry" , "StringSyntaxError" ) ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "StringEscape" , Context { cName = "StringEscape" , cSyntax = "Curry" , cRules = [ Rule { rMatcher = AnyChar "abfnrtv\\\"'&" , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "o[0-7]+" , reCompiled = Just (compileRegex True "o[0-7]+") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "[0-9]+" , reCompiled = Just (compileRegex True "[0-9]+") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "x[0-9a-fA-F]+" , reCompiled = Just (compileRegex True "x[0-9a-fA-F]+") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "\\^[A-Z@\\[\\\\\\]\\^_]" , reCompiled = Just (compileRegex True "\\^[A-Z@\\[\\\\\\]\\^_]") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "NUL|SOH|STX|ETX|EOT|ENQ|ACK|BEL|BS|HT|LF|VT|FF|CR|SO|SI|DLE|DC1|DC2|DC3|DC4|NAK|SYN|ETB|CAN|EM|SUB|ESC|FS|GS|RS|US|SP|DEL" , reCompiled = Just (compileRegex True "NUL|SOH|STX|ETX|EOT|ENQ|ACK|BEL|BS|HT|LF|VT|FF|CR|SO|SI|DLE|DC1|DC2|DC3|DC4|NAK|SYN|ETB|CAN|EM|SUB|ESC|FS|GS|RS|US|SP|DEL") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = DetectSpaces , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Curry" , "StringGap" ) ] } , Rule { rMatcher = RegExpr RE { reString = "." , reCompiled = Just (compileRegex True ".") , reCaseSensitive = True } , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [ Push ( "Curry" , "StringGap" ) ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "StringGap" , Context { cName = "StringGap" , cSyntax = "Curry" , cRules = [ Rule { rMatcher = DetectSpaces , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '\\' , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop , Pop , Push ( "Curry" , "String" ) ] } , Rule { rMatcher = DetectChar '"' , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop , Pop ] } , Rule { rMatcher = RegExpr RE { reString = "." , reCompiled = Just (compileRegex True ".") , reCaseSensitive = True } , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "StringSyntaxError" , Context { cName = "StringSyntaxError" , cSyntax = "Curry" , cRules = [ Rule { rMatcher = DetectChar '"' , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } ] , cAttribute = ErrorTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) ] , sAuthor = "Bj\246rn Peem\246ller (bjp@informatik.uni-kiel.de)" , sVersion = "1" , sLicense = "LGPL" , sExtensions = [ "*.curry" ] , sStartingContext = "Normal" }