From 4f53f6fdfc86681893edef02e766b678741d19f9 Mon Sep 17 00:00:00 2001 From: Steffen Juilf Smolka Date: Tue, 8 Sep 2015 23:04:10 -0400 Subject: [PATCH] renamed: compile -> compile_local --- async/Frenetic_Compile_Server.ml | 4 ++-- async/Frenetic_NetKAT_Controller.ml | 4 ++-- async/Frenetic_OpenFlow0x04_Controller.ml | 4 ++-- async/Frenetic_Shell.ml | 14 ++++++------- integration/FastFailTest_Controller.ml | 2 +- lib/Frenetic_NetKAT_Compiler.ml | 10 +++------- lib/Frenetic_NetKAT_Compiler.mli | 4 ++-- lib_test/Test_Frenetic_NetKAT.ml | 10 +++++----- .../Test_Frenetic_NetKAT_Local_Compiler.ml | 20 +++++++++---------- 9 files changed, 34 insertions(+), 38 deletions(-) diff --git a/async/Frenetic_Compile_Server.ml b/async/Frenetic_Compile_Server.ml index 898abb91b..9203228eb 100644 --- a/async/Frenetic_Compile_Server.ml +++ b/async/Frenetic_Compile_Server.ml @@ -13,7 +13,7 @@ let current_compiler_options = ref { Comp.default_compiler_options with optimize let compile_respond pol = (* Compile pol to tables and time everything. *) let (time, tbls) = profile (fun () -> - let fdd = Comp.compile ~options:!current_compiler_options pol in + let fdd = Comp.compile_local ~options:!current_compiler_options pol in let sws = let sws = Frenetic_NetKAT_Semantics.switches_of_policy pol in if List.length sws = 0 then [0L] else sws in @@ -51,7 +51,7 @@ let handle_request Cohttp_async.Server.respond `OK) | `GET, [switchId; "flow_table"] -> let sw = Int64.of_string switchId in - Comp.compile ~options:!current_compiler_options !policy |> + Comp.compile_local ~options:!current_compiler_options !policy |> Comp.to_table ~options:!current_compiler_options sw |> Frenetic_NetKAT_SDN_Json.flowTable_to_json |> Yojson.Basic.to_string ~std:true |> diff --git a/async/Frenetic_NetKAT_Controller.ml b/async/Frenetic_NetKAT_Controller.ml index 6aa38be06..a4abb5264 100644 --- a/async/Frenetic_NetKAT_Controller.ml +++ b/async/Frenetic_NetKAT_Controller.ml @@ -141,7 +141,7 @@ module type CONTROLLER = sig end module Make : CONTROLLER = struct - let fdd = ref (Frenetic_NetKAT_Compiler.compile drop) + let fdd = ref (Frenetic_NetKAT_Compiler.compile_local drop) let current_compiler_options = ref (Frenetic_NetKAT_Compiler.default_compiler_options) let stats : (string, Int64.t * Int64.t) Hashtbl.Poly.t = Hashtbl.Poly.create () let (pol_reader, pol_writer) = Pipe.create () @@ -251,7 +251,7 @@ module Make : CONTROLLER = struct Hashtbl.Poly.set stats qname stat) >>= fun () -> (* Actually update things *) - fdd := Frenetic_NetKAT_Compiler.compile ~options:!current_compiler_options pol; + fdd := Frenetic_NetKAT_Compiler.compile_local ~options:!current_compiler_options pol; Upd.BestEffortUpdate.set_current_compiler_options !current_compiler_options; Upd.BestEffortUpdate.implement_policy !fdd diff --git a/async/Frenetic_OpenFlow0x04_Controller.ml b/async/Frenetic_OpenFlow0x04_Controller.ml index 175fbe790..125dd5f2b 100644 --- a/async/Frenetic_OpenFlow0x04_Controller.ml +++ b/async/Frenetic_OpenFlow0x04_Controller.ml @@ -121,7 +121,7 @@ let main (of_port : int) (pol_file : string) let pol_str = In_channel.read_all pol_file in let pol = Frenetic_NetKAT_Parser.policy_from_string pol_str in let compiler_opts = {default_compiler_options with field_order = `Static (List.concat layout)} in - let fdd = compile pol ~options:compiler_opts in + let fdd = compile_local pol ~options:compiler_opts in let _ = Tcp.Server.create ~on_handler_error:`Raise (Tcp.on_port of_port) (fun _ reader writer -> let message_sender = send_message writer in @@ -138,7 +138,7 @@ let fault_tolerant_main (of_port : int) (pol_file : string) Log.info "Starting OpenFlow 1.3 fault tolerant controller"; let pol_str = In_channel.read_all pol_file in let pol = Frenetic_NetKAT_Parser.policy_from_string pol_str in - let fdd = Frenetic_NetKAT_Compiler.compile pol in + let fdd = Frenetic_NetKAT_Compiler.compile_local pol in let topo = Frenetic_NetKAT_Net.Net.Topology.empty () in (* let topo = Frenetic_NetKAT_Net.Net.Parse.from_dotfile topo_file in *) let _ = Tcp.Server.create ~on_handler_error:`Raise (Tcp.on_port of_port) diff --git a/async/Frenetic_Shell.ml b/async/Frenetic_Shell.ml index a18869ac0..44add8311 100644 --- a/async/Frenetic_Shell.ml +++ b/async/Frenetic_Shell.ml @@ -3,7 +3,7 @@ open Async.Std open Frenetic_NetKAT module Controller = Frenetic_NetKAT_Controller.Make -module LC = Frenetic_NetKAT_Compiler +module Comp = Frenetic_NetKAT_Compiler module Field = Frenetic_Fdd.Field module Log = Frenetic_Log @@ -35,7 +35,7 @@ type command = * default - Uses the default ordering as specified in NetKAT_LocalCompiler * f_1 < f_2 [ < f_3 < ... < f_n ] - Given two or more fields, ensures the * order of the specified fields is maintained. *) - | Order of LC.order + | Order of Comp.order (* usage: remove_tail_drops * Remove any drop rules at the end of each flow table. Toggles setting. *) @@ -170,14 +170,14 @@ end let compose f g x = f (g x) (* TODO(jcollard): The cache flag here is actually a problem. Changing ordering won't work as expected. *) -let current_compiler_options = ref { LC.default_compiler_options with cache_prepare = `Keep } +let current_compiler_options = ref { Comp.default_compiler_options with cache_prepare = `Keep } let set_field_order ord : unit = current_compiler_options := { !current_compiler_options with field_order = ord } (* Prints the current ordering mode. *) let print_order () : unit = - printf "Ordering Mode: %s\n%!" (LC.field_order_to_string (!current_compiler_options).field_order) + printf "Ordering Mode: %s\n%!" (Comp.field_order_to_string (!current_compiler_options).field_order) (* Convenience function that checks that an ordering doesn't contain * duplicates. This is used in favor of List.contains_dup so a better @@ -195,7 +195,7 @@ let rec check_duplicates (fs : Field.t list) (acc : Field.t list) : bool = (* Given an ordering, sets the order reference. * If a Static ordering is given with duplicates, the ordering * is not updated and an error message is printed *) -let set_order (o : LC.order) : unit = +let set_order (o : Comp.order) : unit = match o with | `Heuristic -> set_field_order `Heuristic; @@ -232,11 +232,11 @@ let print_policy () = (* Given a policy, returns a pretty ascii table for each switch *) let string_of_policy (pol : policy) : string = - let bdd = LC.compile ~options:(!current_compiler_options) pol in + let bdd = Comp.compile_local ~options:(!current_compiler_options) pol in let switches = Frenetic_NetKAT_Semantics.switches_of_policy pol in let switches' = if List.is_empty switches then [0L] else switches in let tbls = List.map switches' - (fun sw_id -> LC.to_table ~options:(!current_compiler_options) sw_id bdd |> + (fun sw_id -> Comp.to_table ~options:(!current_compiler_options) sw_id bdd |> Frenetic_OpenFlow.string_of_flowTable ~label:(Int64.to_string sw_id)) in String.concat ~sep:"\n\n" tbls diff --git a/integration/FastFailTest_Controller.ml b/integration/FastFailTest_Controller.ml index b69a27ec4..e16735ec8 100644 --- a/integration/FastFailTest_Controller.ml +++ b/integration/FastFailTest_Controller.ml @@ -28,7 +28,7 @@ let main () = Frenetic_Log.info "Starting controller"; let layout = Frenetic_Fdd.Field.all_fields in let compiler_opts = {default_compiler_options with field_order = `Default} in - let fdd = compile pol ~options:compiler_opts in + let fdd = compile_local pol ~options:compiler_opts in let _ = Tcp.Server.create ~on_handler_error:`Raise (Tcp.on_port 6633) (fun _ reader writer -> let message_sender = send_message writer in diff --git a/lib/Frenetic_NetKAT_Compiler.ml b/lib/Frenetic_NetKAT_Compiler.ml index d563cb6b4..37a5042a8 100644 --- a/lib/Frenetic_NetKAT_Compiler.ml +++ b/lib/Frenetic_NetKAT_Compiler.ml @@ -185,7 +185,7 @@ let default_compiler_options = { optimize = true; } -let compile ?(options=default_compiler_options) pol = +let compile_local ?(options=default_compiler_options) pol = (match options.cache_prepare with | `Keep -> () | `Empty -> FDK.clear_cache Int.Set.empty @@ -790,12 +790,8 @@ module NetKAT_Automaton = struct end let compile_global (pol : Frenetic_NetKAT.policy) : FDK.t = - let open NetKAT_Automaton in - let a = of_policy ~dedup:true pol in - let t = to_local Field.Vlan a in - t - -(* NetKAT_Automaton.(to_local Field.Vlan (of_policy ~dedup:true pol)) *) + NetKAT_Automaton.of_policy ~dedup:true pol + |> NetKAT_Automaton.to_local Field.Vlan (* multitable *) diff --git a/lib/Frenetic_NetKAT_Compiler.mli b/lib/Frenetic_NetKAT_Compiler.mli index 413835d1d..4f47ead65 100644 --- a/lib/Frenetic_NetKAT_Compiler.mli +++ b/lib/Frenetic_NetKAT_Compiler.mli @@ -36,8 +36,8 @@ exception Non_local val default_compiler_options : compiler_options -val compile : ?options:compiler_options -> policy -> t -(** [compile p] returns the intermediate representation of the policy [p]. +val compile_local : ?options:compiler_options -> policy -> t +(** [compile_local p] returns the intermediate representation of the local policy [p]. You can generate a flowtable from [t] by passing it to the {!to_table} function below. *) diff --git a/lib_test/Test_Frenetic_NetKAT.ml b/lib_test/Test_Frenetic_NetKAT.ml index 357f0303e..4af1c448d 100644 --- a/lib_test/Test_Frenetic_NetKAT.ml +++ b/lib_test/Test_Frenetic_NetKAT.ml @@ -5,7 +5,7 @@ open Frenetic_NetKAT open Frenetic_NetKAT_Pretty let test_compile lhs rhs = - let tbl = Frenetic_NetKAT_Compiler.(restrict (Switch 0L) (compile lhs)) in + let tbl = Frenetic_NetKAT_Compiler.(restrict (Switch 0L) (compile_local lhs)) in let rhs' = Frenetic_NetKAT_Compiler.to_local_pol tbl in if rhs' = rhs then true @@ -17,7 +17,7 @@ let test_compile lhs rhs = let test_compile_table pol tbl = let open Frenetic_NetKAT_Compiler in - let tbl' = to_table 0L (compile pol) in + let tbl' = to_table 0L (compile_local pol) in if tbl = tbl' then true else @@ -324,8 +324,8 @@ let compare_eval_output p q pkt = let compare_compiler_output p q pkt = let open Frenetic_NetKAT_Semantics in PacketSet.compare - (Flowterp.Packet.eval pkt (Frenetic_NetKAT_Compiler.(to_table pkt.switch (compile p)))) - (Flowterp.Packet.eval pkt (Frenetic_NetKAT_Compiler.(to_table pkt.switch (compile q)))) + (Flowterp.Packet.eval pkt (Frenetic_NetKAT_Compiler.(to_table pkt.switch (compile_local p)))) + (Flowterp.Packet.eval pkt (Frenetic_NetKAT_Compiler.(to_table pkt.switch (compile_local q)))) = 0 let check gen_fn compare_fn = @@ -401,7 +401,7 @@ TEST "semantics agree with flowtable" = PacketSet.compare (Frenetic_NetKAT_Semantics.eval pkt (Frenetic_NetKAT_Optimize.specialize_policy pkt.switch p')) (Flowterp.Packet.eval pkt - (Frenetic_NetKAT_Compiler.(to_table pkt.switch (compile p')))) + (Frenetic_NetKAT_Compiler.(to_table pkt.switch (compile_local p')))) = 0 in check gen_pol_1 prop_compile_ok diff --git a/lib_test/Test_Frenetic_NetKAT_Local_Compiler.ml b/lib_test/Test_Frenetic_NetKAT_Local_Compiler.ml index 531e4852f..1b8a0bef9 100644 --- a/lib_test/Test_Frenetic_NetKAT_Local_Compiler.ml +++ b/lib_test/Test_Frenetic_NetKAT_Local_Compiler.ml @@ -7,33 +7,33 @@ open Frenetic_NetKAT_Compiler TEST "Can test locations, even when they are set to pipes" = let p = Filter (Test (Location (Pipe "web"))) in let opt = { default_compiler_options with remove_tail_drops = false } in - List.length (to_table 0L ~options:opt (compile ~options:opt p)) == 1 (* that drops everything *) + List.length (to_table 0L ~options:opt (compile_local ~options:opt p)) == 1 (* that drops everything *) TEST "clearing cache fails" = let a = Test (IPProto 1) in let b = Test (EthType 0x800) in - let fdd1 = compile (Filter a) in + let fdd1 = compile_local (Filter a) in let compiler_options_empty = { default_compiler_options with cache_prepare = `Empty } in let compiler_options_keep = { default_compiler_options with cache_prepare = `Keep } in - let fdd2 = compile ~options:compiler_options_empty (Filter b) in + let fdd2 = compile_local ~options:compiler_options_empty (Filter b) in try - seq fdd1 fdd2 != compile ~options:compiler_options_keep (Filter (And (a, b))) + seq fdd1 fdd2 != compile_local ~options:compiler_options_keep (Filter (And (a, b))) with Not_found -> true TEST "keeping cache_prepare works" = let a = Test (IPProto 1) in let b = Test (EthType 0x800) in - let fdd1 = compile (Filter a) in + let fdd1 = compile_local (Filter a) in let compiler_options_keep = { default_compiler_options with cache_prepare = `Keep } in - let fdd2 = compile ~options:compiler_options_keep (Filter b) in - seq fdd1 fdd2 = compile ~options:compiler_options_keep (Filter (And (a, b))) + let fdd2 = compile_local ~options:compiler_options_keep (Filter b) in + seq fdd1 fdd2 = compile_local ~options:compiler_options_keep (Filter (And (a, b))) TEST "keeping reachable nodes in cache_prepare works" = let a = Test (IPProto 1) in let b = Test (EthType 0x800) in - let fdd1 = compile (Filter a) in + let fdd1 = compile_local (Filter a) in let compiler_options_keep = { default_compiler_options with cache_prepare = `Keep } in let compiler_options_preserve = { default_compiler_options with cache_prepare = `Preserve fdd1 } in - let fdd2 = compile ~options:compiler_options_preserve (Filter b) in - seq fdd1 fdd2 = compile ~options:compiler_options_keep (Filter (And (a, b))) + let fdd2 = compile_local ~options:compiler_options_preserve (Filter b) in + seq fdd1 fdd2 = compile_local ~options:compiler_options_keep (Filter (And (a, b)))