{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Fortran (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex import qualified Data.Set syntax :: Syntax syntax = Syntax { sName = "Fortran" , sFilename = "fortran.xml" , sShortname = "Fortran" , sContexts = fromList [ ( "default" , Context { cName = "default" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = IncludeRules ( "Fortran" , "find_strings" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_decls" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_intrinsics" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_io_stmnts" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_op_and_log" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_numbers" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_preprocessor" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_comments" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_symbols" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_begin_stmnts" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_end_stmnts" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_mid_stmnts" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "end_of_string" , Context { cName = "end_of_string" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = DetectSpaces , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "&\\s*$" , reCompiled = Just (compileRegex False "&\\s*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '&' , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = True , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "(!.*)?$" , reCompiled = Just (compileRegex False "(!.*)?$") , reCaseSensitive = False } , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = True , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = True , cFallthroughContext = [ Pop , Pop ] , cDynamic = False } ) , ( "find_begin_stmnts" , Context { cName = "find_begin_stmnts" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "\\bmodule\\s+procedure\\b" , reCompiled = Just (compileRegex False "\\bmodule\\s+procedure\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(subroutine|function|block\\s*data)\\b" , reCompiled = Just (compileRegex False "\\b(subroutine|function|block\\s*data)\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(program|module|block\\s*data)\\b" , reCompiled = Just (compileRegex False "\\b(program|module|block\\s*data)\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(then|do)\\b" , reCompiled = Just (compileRegex False "\\b(then|do)\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "find_comments" , Context { cName = "find_comments" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "[cC\\*].*$" , reCompiled = Just (compileRegex False "[cC\\*].*$") , reCaseSensitive = False } , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "!.*$" , reCompiled = Just (compileRegex False "!.*$") , reCaseSensitive = False } , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "find_decls" , Context { cName = "find_decls" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "\\binteger[\\*]\\d{1,2}" , reCompiled = Just (compileRegex False "\\binteger[\\*]\\d{1,2}") , reCaseSensitive = False } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\breal[\\*]\\d{1,2}" , reCompiled = Just (compileRegex False "\\breal[\\*]\\d{1,2}") , reCaseSensitive = False } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bcomplex[\\*]\\d{1,2}" , reCompiled = Just (compileRegex False "\\bcomplex[\\*]\\d{1,2}") , reCaseSensitive = False } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend\\s*type\\b" , reCompiled = Just (compileRegex False "\\bend\\s*type\\b") , reCaseSensitive = False } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "allocatable" , "double" , "optional" , "parameter" , "pointer" , "precision" , "private" , "public" , "save" , "sequence" , "target" ]) , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\s*data\\b" , reCompiled = Just (compileRegex False "\\s*data\\b") , reCaseSensitive = False } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\s*real\\s*[(]" , reCompiled = Just (compileRegex False "\\s*real\\s*[(]") , reCaseSensitive = False } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [ Push ( "Fortran" , "find_paren" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\s*real(?![\\w\\*])" , reCompiled = Just (compileRegex False "\\s*real(?![\\w\\*])") , reCaseSensitive = False } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bcharacter[*][0-9]+\\b" , reCompiled = Just (compileRegex False "\\bcharacter[*][0-9]+\\b") , reCaseSensitive = False } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b(type|integer|complex|character|logical|intent|dimension)\\b\\s*[(]" , reCompiled = Just (compileRegex False "\\b(type|integer|complex|character|logical|intent|dimension)\\b\\s*[(]") , reCaseSensitive = False } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "find_paren" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\b(type|integer|complex|character|logical|intent|dimension)\\b" , reCompiled = Just (compileRegex False "\\b(type|integer|complex|character|logical|intent|dimension)\\b") , reCaseSensitive = False } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars ':' ':' , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "find_end_stmnts" , Context { cName = "find_end_stmnts" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "\\bend\\s*(subroutine|function|block\\s*data)\\b" , reCompiled = Just (compileRegex False "\\bend\\s*(subroutine|function|block\\s*data)\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend\\s*(program|module)\\b" , reCompiled = Just (compileRegex False "\\bend\\s*(program|module)\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend\\s*(do|if)\\b" , reCompiled = Just (compileRegex False "\\bend\\s*(do|if)\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend\\s*(select|where|forall|interface)\\b" , reCompiled = Just (compileRegex False "\\bend\\s*(select|where|forall|interface)\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\belse\\s*if\\b" , reCompiled = Just (compileRegex False "\\belse\\s*if\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bend\\b" , reCompiled = Just (compileRegex False "\\bend\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "find_intrinsics" , Context { cName = "find_intrinsics" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "allocate" , "assignment" , "break" , "call" , "case" , "common" , "continue" , "cycle" , "deallocate" , "default" , "elemental" , "elsewhere" , "entry" , "equivalence" , "exit" , "external" , "for" , "forall" , "go" , "goto" , "if" , "implicit" , "include" , "interface" , "intrinsic" , "namelist" , "none" , "nullify" , "only" , "operator" , "pause" , "procedure" , "pure" , "record" , "recursive" , "result" , "return" , "select" , "selectcase" , "stop" , "to" , "use" , "where" , "while" ]) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "abs" , "achar" , "acos" , "adjustl" , "adjustr" , "aimag" , "aint" , "alog" , "alog10" , "amax0" , "amax1" , "amin0" , "amin1" , "amod" , "anint" , "aprime" , "asin" , "atan" , "atan2" , "btest" , "cabs" , "ccos" , "ceiling" , "cexp" , "char" , "clog" , "cmplx" , "conjg" , "cos" , "cosh" , "csin" , "csqrt" , "dabs" , "dacos" , "dasin" , "datan" , "datan2" , "dble" , "dcmplx" , "dconjg" , "dcos" , "dcosh" , "ddim" , "ddmim" , "dexp" , "dfloat" , "dim" , "dimag" , "dint" , "dlog" , "dlog10" , "dmax1" , "dmin1" , "dmod" , "dnint" , "dprod" , "dreal" , "dsign" , "dsin" , "dsinh" , "dsqrt" , "dtan" , "dtanh" , "exp" , "exponent" , "float" , "floor" , "fraction" , "iabs" , "iachar" , "iand" , "ibclr" , "ibits" , "ibset" , "ichar" , "idim" , "idint" , "idnint" , "ieor" , "ifix" , "index" , "int" , "ior" , "ishft" , "ishftc" , "isign" , "len_trim" , "lge" , "lgt" , "lle" , "llt" , "log" , "log10" , "logical" , "max" , "max0" , "max1" , "merge" , "min" , "min0" , "min1" , "mod" , "modulo" , "mvbits" , "nearest" , "nint" , "not" , "rand" , "real" , "rrspacing" , "scale" , "scan" , "set_exponent" , "sign" , "sin" , "sinh" , "sngl" , "spacing" , "sqrt" , "tan" , "tanh" , "verify" ]) , rAttribute = BuiltInTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "allocated" , "associated" , "bit_size" , "digits" , "epsilon" , "huge" , "kind" , "lbound" , "len" , "maxexponent" , "minexponent" , "precision" , "present" , "radix" , "range" , "shape" , "size" , "tiny" , "ubound" ]) , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "all" , "any" , "count" , "cshift" , "dot_product" , "eoshift" , "matmul" , "maxloc" , "maxval" , "minloc" , "minval" , "pack" , "product" , "repeat" , "reshape" , "selected_int_kind" , "selected_real_kind" , "spread" , "sum" , "transfer" , "transpose" , "trim" , "unpack" ]) , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "date_and_time" , "random_number" , "random_seed" , "system_clock" ]) , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "find_io_paren" , Context { cName = "find_io_paren" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = DetectChar '*' , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "inside_func_paren" ) ] } , Rule { rMatcher = DetectChar ')' , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "advance" , "end" , "eor" , "err" , "fmt" , "iostat" , "size" , "status" , "unit" ]) , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "access" , "action" , "blank" , "delim" , "direct" , "err" , "exist" , "file" , "form" , "formatted" , "iostat" , "name" , "named" , "nextrec" , "number" , "opened" , "pad" , "position" , "read" , "readwrite" , "recl" , "sequential" , "unformatted" , "unit" , "write" ]) , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "access" , "action" , "blank" , "delim" , "err" , "file" , "form" , "iostat" , "pad" , "position" , "recl" , "status" , "unit" ]) , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_strings" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_intrinsics" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_numbers" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_symbols" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "find_io_stmnts" , Context { cName = "find_io_stmnts" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "\\b(read|write|backspace|rewind|end\\s*file|close)\\s*[(]" , reCompiled = Just (compileRegex False "\\b(read|write|backspace|rewind|end\\s*file|close)\\s*[(]") , reCaseSensitive = False } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "find_io_paren" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\bopen\\s*[(]" , reCompiled = Just (compileRegex False "\\bopen\\s*[(]") , reCaseSensitive = False } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "find_io_paren" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\binquire\\s*[(]" , reCompiled = Just (compileRegex False "\\binquire\\s*[(]") , reCaseSensitive = False } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "find_io_paren" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\bformat\\s*[(]" , reCompiled = Just (compileRegex False "\\bformat\\s*[(]") , reCaseSensitive = False } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "format_stmnt" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\bend\\s*file\\b" , reCompiled = Just (compileRegex False "\\bend\\s*file\\b") , reCaseSensitive = False } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = False , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet False [ "access" , "backspace" , "close" , "format" , "inquire" , "open" , "print" , "read" , "rewind" , "write" ]) , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "find_mid_stmnts" , Context { cName = "find_mid_stmnts" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "\\belse\\b" , reCompiled = Just (compileRegex False "\\belse\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\bcontains\\b" , reCompiled = Just (compileRegex False "\\bcontains\\b") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "find_numbers" , Context { cName = "find_numbers" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "[0-9]*\\.[0-9]+([de][+-]?[0-9]+)?([_]([0-9]+|[a-z][\\w_]*))?" , reCompiled = Just (compileRegex False "[0-9]*\\.[0-9]+([de][+-]?[0-9]+)?([_]([0-9]+|[a-z][\\w_]*))?") , reCaseSensitive = False } , rAttribute = FloatTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b[0-9]+\\.[0-9]*([de][+-]?[0-9]+)?([_]([0-9]+|[a-z][\\w_]*))?(?![a-z])" , reCompiled = Just (compileRegex False "\\b[0-9]+\\.[0-9]*([de][+-]?[0-9]+)?([_]([0-9]+|[a-z][\\w_]*))?(?![a-z])") , reCaseSensitive = False } , rAttribute = FloatTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b[0-9]+[de][+-]?[0-9]+([_]([0-9]+|[a-z][\\w_]*))?" , reCompiled = Just (compileRegex False "\\b[0-9]+[de][+-]?[0-9]+([_]([0-9]+|[a-z][\\w_]*))?") , reCaseSensitive = False } , rAttribute = FloatTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b[0-9]+([_]([0-9]+|[a-zA-Z][\\w_]*))?" , reCompiled = Just (compileRegex False "\\b[0-9]+([_]([0-9]+|[a-zA-Z][\\w_]*))?") , reCaseSensitive = False } , rAttribute = DecValTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b[bozx](['][0-9a-f]+[']|[\"][0-9a-f]+[\"])" , reCompiled = Just (compileRegex False "\\b[bozx](['][0-9a-f]+[']|[\"][0-9a-f]+[\"])") , reCaseSensitive = False } , rAttribute = DecValTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "find_op_and_log" , Context { cName = "find_op_and_log" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "\\.(true|false)\\." , reCompiled = Just (compileRegex False "\\.(true|false)\\.") , reCaseSensitive = False } , rAttribute = ConstantTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\.[A-Za-z]+\\." , reCompiled = Just (compileRegex False "\\.[A-Za-z]+\\.") , reCaseSensitive = False } , rAttribute = OperatorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(==|/=|<|<=|>|>=)" , reCompiled = Just (compileRegex False "(==|/=|<|<=|>|>=)") , reCaseSensitive = False } , rAttribute = OperatorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "find_paren" , Context { cName = "find_paren" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = DetectChar '(' , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "find_paren" ) ] } , Rule { rMatcher = DetectChar ')' , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = DataTypeTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "find_preprocessor" , Context { cName = "find_preprocessor" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "(#|cDEC\\$|CDEC\\$).*$" , reCompiled = Just (compileRegex False "(#|cDEC\\$|CDEC\\$).*$") , reCaseSensitive = False } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "find_strings" , Context { cName = "find_strings" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = DetectChar '\'' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "string_1" ) ] } , Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "string_2" ) ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "find_symbols" , Context { cName = "find_symbols" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = Detect2Chars '*' '*' , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '(' '/' , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '/' ')' , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = AnyChar "&+-*/=?[]^{|}~" , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = AnyChar "()," , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "format_stmnt" , Context { cName = "format_stmnt" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = DetectChar '(' , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "format_stmnt" ) ] } , Rule { rMatcher = DetectChar ')' , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "[0-9]*/" , reCompiled = Just (compileRegex False "[0-9]*/") , reCaseSensitive = False } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = AnyChar ":" , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_strings" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_symbols" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "inside_func_paren" , Context { cName = "inside_func_paren" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = DetectChar '(' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "inside_func_paren" ) ] } , Rule { rMatcher = DetectChar ')' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_strings" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_intrinsics" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Fortran" , "find_numbers" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "string_1" , Context { cName = "string_1" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "[^']*'" , reCompiled = Just (compileRegex False "[^']*'") , reCaseSensitive = False } , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "&\\s*$" , reCompiled = Just (compileRegex False "&\\s*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "end_of_string" ) ] } , Rule { rMatcher = RegExpr RE { reString = ".*(?=&\\s*$)" , reCompiled = Just (compileRegex False ".*(?=&\\s*$)") , reCaseSensitive = False } , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "end_of_string" ) ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = True , cFallthroughContext = [ Pop ] , cDynamic = False } ) , ( "string_2" , Context { cName = "string_2" , cSyntax = "Fortran" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "[^\"]*\"" , reCompiled = Just (compileRegex False "[^\"]*\"") , reCaseSensitive = False } , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "&\\s*$" , reCompiled = Just (compileRegex False "&\\s*$") , reCaseSensitive = False } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "end_of_string" ) ] } , Rule { rMatcher = RegExpr RE { reString = ".*(?=&\\s*$)" , reCompiled = Just (compileRegex False ".*(?=&\\s*$)") , reCaseSensitive = False } , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = False , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Fortran" , "end_of_string" ) ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = True , cFallthroughContext = [ Pop ] , cDynamic = False } ) ] , sAuthor = "Franchin Matteo (fnch@libero.it)" , sVersion = "2" , sLicense = "LGPL" , sExtensions = [ "*.f" , "*.F" , "*.for" , "*.FOR" , "*.f90" , "*.F90" , "*.fpp" , "*.FPP" , "*.f95" , "*.F95" ] , sStartingContext = "default" }