@@ -2,10 +2,27 @@ include Printable.StdLeaf
22
33let name () = " string"
44
5+ type string_domain = Unit | Disjoint | Flat
6+ let string_domain = ref None
7+ let string_domain_config = " ana.base.strings.domain"
8+ let parse config = match config with
9+ | "unit" -> Unit
10+ | "disjoint" -> Disjoint
11+ | "flat" -> Flat
12+ | _ -> raise @@ GobConfig. ConfigError (" Invalid option for " ^ string_domain_config)
13+
14+ let get_string_domain () =
15+ if ! string_domain = None then
16+ string_domain := Some (parse (GobConfig. get_string string_domain_config));
17+ Option. get ! string_domain
18+
19+ let reset_lazy () =
20+ string_domain := None
21+
522type t = string option [@@ deriving eq , ord , hash ]
623
724let hash x =
8- if GobConfig. get_string " ana.base.strings.domain " = " disjoint " then
25+ if get_string_domain () = Disjoint then
926 hash x
1027 else
1128 13859
@@ -22,7 +39,7 @@ include Printable.SimpleShow (
2239 )
2340
2441let of_string x =
25- if GobConfig. get_string " ana.base.strings.domain " = " unit " then
42+ if get_string_domain () = Unit then
2643 None
2744 else
2845 Some x
@@ -74,7 +91,7 @@ let join x y =
7491 | _ , None -> None
7592 | Some a , Some b when a = b -> Some a
7693 | Some a , Some b (* when a <> b *) ->
77- if GobConfig. get_string " ana.base.strings.domain " = " disjoint " then
94+ if get_string_domain () = Disjoint then
7895 raise Lattice. Uncomparable
7996 else
8097 None
@@ -85,13 +102,13 @@ let meet x y =
85102 | a , None -> a
86103 | Some a , Some b when a = b -> Some a
87104 | Some a , Some b (* when a <> b *) ->
88- if GobConfig. get_string " ana.base.strings.domain " = " disjoint " then
105+ if get_string_domain () = Disjoint then
89106 raise Lattice. Uncomparable
90107 else
91108 raise Lattice. BotValue
92109
93110let repr x =
94- if GobConfig. get_string " ana.base.strings.domain " = " disjoint " then
111+ if get_string_domain () = Disjoint then
95112 x (* everything else is kept separate, including strings if not limited *)
96113 else
97114 None (* all strings together if limited *)
0 commit comments