package mopsa

  1. Overview
  2. Docs
package mopsa
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file route.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
(****************************************************************************)
(*                                                                          *)
(* This file is part of MOPSA, a Modular Open Platform for Static Analysis. *)
(*                                                                          *)
(* Copyright (C) 2017-2019 The MOPSA Project.                               *)
(*                                                                          *)
(* This program is free software: you can redistribute it and/or modify     *)
(* it under the terms of the GNU Lesser General Public License as published *)
(* by the Free Software Foundation, either version 3 of the License, or     *)
(* (at your option) any later version.                                      *)
(*                                                                          *)
(* This program is distributed in the hope that it will be useful,          *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of           *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            *)
(* GNU Lesser General Public License for more details.                      *)
(*                                                                          *)
(* You should have received a copy of the GNU Lesser General Public License *)
(* along with this program.  If not, see <http://www.gnu.org/licenses/>.    *)
(*                                                                          *)
(****************************************************************************)

open Ast.Semantic
open Mopsa_utils


type domain = string

type route =
  | Below of domain
  | Semantic of semantic

let compare_route r1 r2 =
  match r1, r2 with
  | Below dom1, Below dom2 -> String.compare dom1 dom2
  | Semantic sem1, Semantic sem2 -> String.compare sem1 sem2
  | _ -> compare r1 r2

let pp_route fmt = function
  | Below dom    -> Format.fprintf fmt "below(%s)" dom
  | Semantic sem -> pp_semantic fmt sem


let toplevel = Semantic any_semantic

module DomainSet = SetExt.StringSet

module Map =
  MapExt.Make
    (struct
      type t = route
      let compare = compare_route
    end)

type routing_table = DomainSet.t Map.t

let empty_routing_table = Map.empty

let resolve_route route map = Map.find route map

let add_route selector domain map =
  let old = try Map.find selector map with Not_found -> DomainSet.empty in
  Map.add selector (DomainSet.add domain old) map

let add_routes selector domains map =
  let old = try Map.find selector map with Not_found -> DomainSet.empty in
  Map.add selector (DomainSet.union domains old) map

let get_routes map = Map.bindings map |> List.map fst

let join_routing_table m1 m2 =
  Map.map2zo
    (fun sem1 domains1 -> domains1)
    (fun sem2 domains2 -> domains2)
    (fun sem domains1 domains2 -> DomainSet.union domains1 domains2)
    m1 m2

let pp_routing_table fmt m =
  Format.(fprintf fmt "@[<v>%a@]"
            (pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt "@,")
               (fun fmt (route,domains) ->
                  fprintf fmt "%a -> {%a}"
                    pp_route route
                    (pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt ", ") pp_print_string) (DomainSet.elements domains)
               )
            ) (Map.bindings m)
         )
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct