[al] precompute regexps

Summary: This should make it faster to use embarassingly big regexps in AL.

Reviewed By: mbouaziz

Differential Revision: D5462938

fbshipit-source-id: 0431730

infer/src/clang/ALVar.ml

@@ -13,9 +13,14 @@ type keyword = Doc_url | Message | Mode | Name | Report_when | Severity | Sugges
 
 type formula_id = Formula_id of string [@@deriving compare]
 
+(** a regexp and its cached compiled version *)
+type cached_regexp = {string: string; regexp: Str.regexp Lazy.t}
+
+let compare_cached_regexp {string= s1} {string= s2} = String.compare s1 s2
+
 type alexp =
   | Const of string
-  | Regexp of string
+  | Regexp of cached_regexp
   | Var of string
   | FId of formula_id
   [@@deriving compare]
@@ -28,9 +33,9 @@ let formula_id_to_string fid =
   match fid
   with Formula_id s -> s
 
-let alexp_to_string e =
-  match e
-  with Const s | Regexp s | Var s | FId Formula_id s -> s
+let alexp_to_string = function
+  | Const string | Regexp {string} | Var string | FId Formula_id string
+   -> string
 
 let keyword_to_string k =
   match k with
@@ -63,23 +68,21 @@ let is_doc_url_keyword k = match k with Doc_url -> true | _ -> false
 
 let is_name_keyword k = match k with Name -> true | _ -> false
 
-(* true if and only if a substring of container matches the regular
-   expression defined by contained
-*)
-let str_match_regex container re =
-  let rexp = Str.regexp re in
-  try Str.search_forward rexp container 0 >= 0
+(** true if and only if a substring of container matches the regular expression *)
+let str_match_forward container regexp =
+  try Str.search_forward regexp container 0 >= 0
   with Not_found -> false
 
 let compare_str_with_alexp s ae =
   match ae with
   | Const s' | Var s'
    -> String.equal s s'
-  | Regexp re
-   -> str_match_regex s re
+  | Regexp {regexp}
+   -> str_match_forward s (Lazy.force regexp)
   | _
    -> L.(debug Linters Medium)
-        "[WARNING]: ALVAR expression '%s' is not a constant/var or regexp@\n" (alexp_to_string ae) ;
+        "[WARNING]: ALVAR expression '%s' is not a constant, variable, or regexp@\n"
+        (alexp_to_string ae) ;
       false
 
 module FormulaIdMap = Caml.Map.Make (struct

infer/src/clang/ALVar.mli

@@ -13,7 +13,15 @@ type keyword = Doc_url | Message | Mode | Name | Report_when | Severity | Sugges
 
 type formula_id = Formula_id of string
 
-type alexp = Const of string | Regexp of string | Var of string | FId of formula_id
+(** a regexp and its cached compiled version *)
+type cached_regexp = {string: string; regexp: Str.regexp Lazy.t} [@@deriving compare]
+
+type alexp =
+  | Const of string
+  | Regexp of cached_regexp
+  | Var of string
+  | FId of formula_id
+  [@@deriving compare]
 
 type t = alexp
 
@@ -39,7 +47,7 @@ val is_doc_url_keyword : keyword -> bool
 
 val is_name_keyword : keyword -> bool
 
-val str_match_regex : string -> string -> bool
+val str_match_forward : string -> Str.regexp -> bool
 
 val compare_str_with_alexp : string -> alexp -> bool
 

infer/src/clang/cPredicates.ml

@@ -424,12 +424,20 @@ let is_class an re =
   | _
    -> false
 
-let should_use_iphoneos_target_sdk_version (cxt: CLintersContext.context) =
-  let source_file = cxt.translation_unit_context.source_file in
-  not
-    (List.exists
-       ~f:(fun path -> ALVar.str_match_regex (SourceFile.to_rel_path source_file) path)
-       Config.iphoneos_target_sdk_version_skip_path)
+let should_use_iphoneos_target_sdk_version =
+  let f =
+    ( lazy
+    ( match Config.iphoneos_target_sdk_version_skip_path with
+    | []
+     -> fun _ -> true
+    | _ :: _ as skip_paths
+     -> (* pre-compute the regexp because it is expensive *)
+        let paths_regexp = String.concat ~sep:"\\|" skip_paths |> Str.regexp in
+        (* return a closure so that the regexp is computed only once *)
+        fun {CLintersContext.translation_unit_context= {source_file}} ->
+          not (ALVar.str_match_forward (SourceFile.to_rel_path source_file) paths_regexp) ) )
+  in
+  fun ctx -> Lazy.force f ctx
 
 let decl_unavailable_in_supported_ios_sdk (cxt: CLintersContext.context) an =
   let config_iphoneos_target_sdk_version =

infer/src/clang/ctl_parser.mly

@@ -290,7 +290,7 @@ alexp_const: STRING
 
 alexp_regex:  REGEXP LEFT_PAREN STRING RIGHT_PAREN
           { L.(debug Linters Verbose) "\tParsed regular expression '%s'@\n" $3;
-            ALVar.Regexp $3 }
+            ALVar.Regexp {string=$3; regexp=lazy (Str.regexp $3)} }
 
 alexp_var: identifier { is_defined_identifier $1; ALVar.Var $1 }
 

infer/src/clang/types_parser.mly

@@ -159,7 +159,7 @@ simple_type_specifier:
               ALVar.Const $1 }
    | REGEXP LEFT_PAREN REARG RIGHT_PAREN
             { L.(debug Linters Verbose) "\tParsed regular expression '%s' @\n" $3;
-              ALVar.Regexp $3 }
+              ALVar.Regexp {string=$3; regexp=lazy (Str.regexp $3)} }
    | IDENTIFIER { ALVar.Var $1 }
    ;