From ac4d2368df8ca2b07eae66dfac6ff444fba7cf03 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Tue, 26 Apr 2016 23:30:19 +0200 Subject: [PATCH 1/7] [ocaml] treat target list as a boolean expression this way, inverted selectiono should be handled correctly in all cases --- conf/modules/telemetry_transparent.xml | 2 +- sw/lib/ocaml/gen_common.ml | 108 +++++++++++++++---------- sw/lib/ocaml/gen_common.mli | 21 +++-- sw/tools/generators/gen_aircraft.ml | 4 +- 4 files changed, 81 insertions(+), 54 deletions(-) diff --git a/conf/modules/telemetry_transparent.xml b/conf/modules/telemetry_transparent.xml index ead5dac72c..7b35d6e968 100644 --- a/conf/modules/telemetry_transparent.xml +++ b/conf/modules/telemetry_transparent.xml @@ -11,7 +11,7 @@
- + diff --git a/sw/lib/ocaml/gen_common.ml b/sw/lib/ocaml/gen_common.ml index 318af5bc97..68183aa892 100644 --- a/sw/lib/ocaml/gen_common.ml +++ b/sw/lib/ocaml/gen_common.ml @@ -24,6 +24,31 @@ open Printf +(** simple boolean expressions *) +type bool_expr = + | Var of string + | Not of bool_expr + | And of bool_expr * bool_expr + | Or of bool_expr * bool_expr + +(** evaluate a boolean expression for a given value *) +let rec eval_bool v = function + | Var x -> v = x + | Not e -> not (eval_bool v e) + | And (e1, e2) -> eval_bool v e1 && eval_bool v e2 + | Or (e1, e2) -> eval_bool v e1 || eval_bool v e2 + +(** pretty print boolean expression *) +let print_bool = fun v e -> + let rec print_b v = function + | Var x -> eprintf "Var ( %s =? %s ) " x v + | Not e -> eprintf "Not ( "; (print_b v e); eprintf ") " + | And (e1, e2) -> eprintf "And ( "; print_b v e1; print_b v e2; eprintf ") " + | Or (e1, e2) -> eprintf "Or ( "; print_b v e1; print_b v e2; eprintf ") " + in + print_b v e; eprintf "\n" + + type module_conf = { name: string; xml: Xml.xml; @@ -31,7 +56,7 @@ type module_conf = { filename: string; vpath: string option;(* this field should be removed after transition phase *) param: Xml.xml list; - targets: string list + targets: bool_expr } let (//) = Filename.concat @@ -55,12 +80,21 @@ let union = fun l1 l2 -> singletonize (l1 @ l2) let union_of_lists = fun l -> singletonize (List.flatten l) (** [targets_of_field] - * Returns the targets of a makefile node in modules - * Default "ap|sim" *) + * Returns the targets expression of a makefile node in modules + * Default "ap|sim" *) let targets_of_field = + let rec expr_of_targets op = function + | [] -> Var "" + | [e] -> Var e + | l::ls -> op (Var l) (expr_of_targets op ls) + in let pipe = Str.regexp "|" in fun field default -> - Str.split pipe (ExtXml.attrib_or_default field "target" default) + let f = ExtXml.attrib_or_default field "target" default in + if String.length f > 0 && String.get f 0 = '!' then + Not (expr_of_targets (fun x y -> Or(x,y)) (Str.split pipe (String.sub f 1 ((String.length f) - 1)))) + else + expr_of_targets (fun x y -> Or(x,y)) (Str.split pipe f) (** [get_autopilot_of_airframe xml] * Returns (autopilot xml, main freq) from airframe xml file *) @@ -77,15 +111,14 @@ let get_autopilot_of_airframe = fun xml -> | _ -> failwith "Error: you have more than one 'autopilot' section in your airframe file" (** [get_targets_of_module xml] - * Returns the list of targets of a module *) + * Returns the boolean expression of targets of a module *) let get_targets_of_module = fun xml -> - let targets = Xml.map - (fun x -> - match String.lowercase (Xml.tag x) with - | "makefile" -> targets_of_field x Env.default_module_targets - | _ -> [] - ) xml in - singletonize (List.flatten targets) + Xml.fold (fun a x -> + match String.lowercase (Xml.tag x) with + | "makefile" when a = Var "" -> targets_of_field x Env.default_module_targets + | "makefile" -> Or (a, targets_of_field x Env.default_module_targets) + | _ -> a + ) (Var "") xml let module_name = fun xml -> let name = ExtXml.attrib xml "name" in @@ -103,7 +136,7 @@ let get_module = fun m global_targets -> if not (Sys.file_exists file) then raise (Subsystem file) else let xml = ExtXml.parse_file file in let targets = get_targets_of_module xml in - let targets = union global_targets targets in + let targets = Or (global_targets, targets) in { name = name; xml = xml; file = file; filename = filename; vpath = None; param = Xml.children m; targets = targets } | "load" -> (* this case should be removed after transition phase *) @@ -120,8 +153,8 @@ let get_module = fun m global_targets -> let file = dir // filename in let xml = ExtXml.parse_file file in let targets = get_targets_of_module xml in - let extra_targets = global_targets @ targets_of_field m "" in - let targets = singletonize (extra_targets @ targets) in + let extra_targets = Or (global_targets, targets_of_field m "") in + let targets = Or (extra_targets, targets) in { name = name; xml = xml; file = file; filename = filename; vpath = vpath; param = Xml.children m; targets = targets } | _ -> Xml2h.xml_error "module or load" @@ -130,23 +163,7 @@ let get_module = fun m global_targets -> * Test if [target] is allowed [targets] * Return true if target is allowed, false if target is not in list or rejected (prefixed by !) *) let test_targets = fun target targets -> - (* test for inverted selection - * FIXME: only the first target should have the invert sign ('!') - *) - let inv = - try - let hd = List.hd targets in - if String.get hd 0 = '!' then not - else (fun x -> x) - with _ -> (fun x -> x) - in - (* return inverted result if needed *) - inv (List.exists (fun t -> - let l = String.length t in - (* remove first char if invert sign *) - let t = if l > 0 && t.[0] = '!' then String.sub t 1 (l-1) else t in - t = target - ) targets) + eval_bool target targets (** [get_modules_of_airframe xml] * Returns a list of module configuration from airframe file *) @@ -177,16 +194,16 @@ let rec get_modules_of_airframe = fun ?target xml -> if tag = "modules" then targets_of_field xml "" else targets in List.fold_left (fun acc xml -> iter_modules targets acc xml) modules children in - let modules = iter_modules [] [] xml in + let modules = iter_modules (Var "") [] xml in let ap_modules = try let ap_file = fst (get_autopilot_of_airframe xml) in - iter_modules [] [] (ExtXml.parse_file ap_file) + iter_modules (Var "") [] (ExtXml.parse_file ap_file) with _ -> [] in let modules = List.rev (ap_modules @ modules) in match target with | None -> modules - | Some t -> List.filter (fun m -> test_targets t m.targets) modules + | Some t -> List.filter (fun m -> prerr_endline m.filename; test_targets t m.targets) modules (** [get_modules_of_flight_plan xml] @@ -205,7 +222,7 @@ let get_modules_of_flight_plan = fun xml -> | Xml.Element (tag, _attrs, children) -> List.fold_left (fun acc xml -> iter_modules targets acc xml) modules children in - List.rev (iter_modules [] [] xml) + List.rev (iter_modules (Var "") [] xml) (** [singletonize_modules xml] * Returns a list of singletonized modules were options are merged @@ -232,7 +249,11 @@ let singletonize_modules = fun ?(verbose=false) ?target xml -> end; let m = { name = x.name; xml = x.xml; file = x.file; filename = x.filename; vpath = x.vpath; param = List.flatten (List.map (fun m -> m.param) ([x] @ duplicates)); - targets = singletonize (List.flatten (List.map (fun m -> m.targets) ([x] @ duplicates))) } in + targets = List.fold_left (fun a x -> + match a with + | Var "" -> x.targets + | _ -> Or (a, x.targets) + ) (Var "") ([x] @ duplicates) } in m::loop rest in loop xml @@ -247,7 +268,7 @@ let get_modules_of_config = fun ?target ?verbose af_xml fp_xml -> singletonize_modules ?verbose ?target (af_modules @ fp_modules) (** [get_modules_name xml] - * Returns a list of loaded modules' name *) + * Returns a list of loaded modules' name *) let get_modules_name = fun xml -> let target = try Sys.getenv "TARGET" with _ -> "" in (* extract all modules sections for a given target *) @@ -271,8 +292,7 @@ let is_element_unselected = fun ?(verbose=false) target modules name -> let xml = ExtXml.parse_file name in match Xml.tag xml with | "settings" -> - let targets = Xml.attrib xml "target" in - let target_list = Str.split (Str.regexp "|") targets in + let target_list = targets_of_field xml "" in let unselected = not (test_targets target target_list) in if unselected && verbose then begin Printf.printf "Info: settings '%s' unloaded for target '%s'\n" name target; flush stdout end; @@ -285,10 +305,10 @@ let is_element_unselected = fun ?(verbose=false) target modules name -> if verbose then (* display possible unloading of settings when the module itself is loaded *) List.iter (fun n -> - let tag = Xml.tag n - and targets = ExtXml.attrib_or_default n "target" "" in - let valid = test_targets target (Str.split (Str.regexp "|") targets) in - if tag = "settings" && not (targets = "") && not valid then + let tag = Xml.tag n in + let target_list = targets_of_field n "" in + let valid = test_targets target target_list in + if tag = "settings" && not (ExtXml.attrib_or_default n "target" "" = "") && not valid then begin Printf.printf "Info: settings of module '%s' unloaded for target '%s'\n" name target; flush stdout end; ) (Xml.children xml) end; diff --git a/sw/lib/ocaml/gen_common.mli b/sw/lib/ocaml/gen_common.mli index 3c278de910..13c4e4e5b6 100644 --- a/sw/lib/ocaml/gen_common.mli +++ b/sw/lib/ocaml/gen_common.mli @@ -22,6 +22,13 @@ * *) +(* simple boolean expressions *) +type bool_expr = + | Var of string + | Not of bool_expr + | And of bool_expr * bool_expr + | Or of bool_expr * bool_expr + (* Module configuration: * Xml node * file (with path) @@ -30,7 +37,7 @@ * parameters * extrat targets *) -type module_conf = { name : string; xml : Xml.xml; file : string; filename : string; vpath : string option; param : Xml.xml list; targets : string list; } +type module_conf = { name : string; xml : Xml.xml; file : string; filename : string; vpath : string option; param : Xml.xml list; targets : bool_expr; } (* Modules directory *) val modules_dir : string @@ -39,13 +46,13 @@ val modules_dir : string val singletonize : ?compare: ('a -> 'a -> int) -> 'a list -> 'a list (** [targets_of_field] Xml node, default - * Returns the targets of a makefile node in modules + * Returns the targets expression of a makefile node in modules * Default "ap|sim" *) -val targets_of_field : Xml.xml -> string -> string list +val targets_of_field : Xml.xml -> string -> bool_expr exception Subsystem of string val module_name : Xml.xml -> string -val get_module : Xml.xml -> string list -> module_conf +val get_module : Xml.xml -> bool_expr -> module_conf (** [get_modules_of_airframe xml] * Returns a list of pair (modules ("load" node), targets) from airframe file *) @@ -63,10 +70,10 @@ val get_modules_of_config : ?target:string -> ?verbose:bool -> Xml.xml -> Xml.xm (** [test_targets target targets] * Test if [target] is allowed [targets] * Return true if target is allowed, false if target is not in list or rejected (prefixed by !) *) -val test_targets : string -> string list -> bool +val test_targets : string -> bool_expr -> bool -(** [get_targets_of_module xml] Returns the list of targets of a module *) -val get_targets_of_module : Xml.xml -> string list +(** [get_targets_of_module xml] Returns the boolean expression of targets of a module *) +val get_targets_of_module : Xml.xml -> bool_expr (** [get_modules_name xml] * Returns a list of loaded modules' name *) diff --git a/sw/tools/generators/gen_aircraft.ml b/sw/tools/generators/gen_aircraft.ml index 2fbe24fafa..e9f7c749b3 100644 --- a/sw/tools/generators/gen_aircraft.ml +++ b/sw/tools/generators/gen_aircraft.ml @@ -253,8 +253,8 @@ let parse_firmware = fun makefile_ac ac_xml firmware fp -> List.iter (fun def -> define_xml2mk makefile_ac def) defines; List.iter (fun def -> define_xml2mk makefile_ac def) t_defines; List.iter (module_xml2mk makefile_ac target_name firmware_name) modules; - List.iter (fallback_subsys_xml2mk makefile_ac [] firmware target_name) mods; - List.iter (fallback_subsys_xml2mk makefile_ac [] firmware target_name) t_mods; + List.iter (fallback_subsys_xml2mk makefile_ac (Gen_common.Var "") firmware target_name) mods; + List.iter (fallback_subsys_xml2mk makefile_ac (Gen_common.Var "") firmware target_name) t_mods; List.iter (subsystem_xml2mk makefile_ac firmware) t_subsystems; List.iter (subsystem_xml2mk makefile_ac firmware) subsystems; fprintf makefile_ac "\nendif # end of target '%s'\n\n" target_name From 68d9c43f09e3d692f5b364173eeabf7952cf3e19 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Tue, 26 Apr 2016 23:50:03 +0200 Subject: [PATCH 2/7] remove debug print --- sw/lib/ocaml/gen_common.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sw/lib/ocaml/gen_common.ml b/sw/lib/ocaml/gen_common.ml index 68183aa892..d3ea81c723 100644 --- a/sw/lib/ocaml/gen_common.ml +++ b/sw/lib/ocaml/gen_common.ml @@ -203,7 +203,7 @@ let rec get_modules_of_airframe = fun ?target xml -> let modules = List.rev (ap_modules @ modules) in match target with | None -> modules - | Some t -> List.filter (fun m -> prerr_endline m.filename; test_targets t m.targets) modules + | Some t -> List.filter (fun m -> test_targets t m.targets) modules (** [get_modules_of_flight_plan xml] From 4292fb9a3b97aa06b6eda7709d6d5b4d146edc2c Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Thu, 28 Apr 2016 00:45:26 +0200 Subject: [PATCH 3/7] [ocaml] filter on firmware if necessary --- sw/lib/ocaml/gen_common.ml | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/sw/lib/ocaml/gen_common.ml b/sw/lib/ocaml/gen_common.ml index d3ea81c723..8e439313bd 100644 --- a/sw/lib/ocaml/gen_common.ml +++ b/sw/lib/ocaml/gen_common.ml @@ -165,10 +165,29 @@ let get_module = fun m global_targets -> let test_targets = fun target targets -> eval_bool target targets +exception Firmware_Found of string (** [get_modules_of_airframe xml] * Returns a list of module configuration from airframe file *) let rec get_modules_of_airframe = fun ?target xml -> let is_module = fun tag -> List.mem tag [ "module"; "load" ] in + (* first, find firmware related to the target *) + let firmware = + match target with + | None -> None + | Some t -> begin try + Xml.iter (fun x -> + if Xml.tag x = "firmware" then begin + let name = ExtXml.attrib x "name" in + Xml.iter (fun x -> + if Xml.tag x = "target" then begin + if Xml.attrib x "name" = t then raise (Firmware_Found name) + end) x + end) xml; + None + with Firmware_Found f -> Some f | _ -> None + end + in + (* extract modules from xml tree *) let rec iter_modules = fun targets modules xml -> match xml with | Xml.PCData _ -> modules @@ -179,6 +198,16 @@ let rec get_modules_of_airframe = fun ?target xml -> (fun acc xml -> iter_modules targets acc xml) (m :: modules) children with Subsystem _file -> modules end + | Xml.Element (tag, _attrs, children) when tag = "firmware" -> + let name = List.assoc "name" _attrs in + begin match firmware with + | Some f when f = name -> + List.fold_left (fun acc xml -> + iter_modules targets acc xml) modules children + | None -> + List.fold_left (fun acc xml -> + iter_modules targets acc xml) modules children + | _ -> modules end (* skip wrong firmware *) | Xml.Element (tag, _attrs, children) when tag = "target" -> let target_name = Xml.attrib xml "name" in begin match target with From 056146e5db4ede9b0e4a3d5b8499df0a830b2733 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Thu, 28 Apr 2016 01:02:36 +0200 Subject: [PATCH 4/7] pick correct name, but some settings are wrongly unloaded --- sw/lib/ocaml/gen_common.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sw/lib/ocaml/gen_common.ml b/sw/lib/ocaml/gen_common.ml index 8e439313bd..f04c239837 100644 --- a/sw/lib/ocaml/gen_common.ml +++ b/sw/lib/ocaml/gen_common.ml @@ -199,7 +199,7 @@ let rec get_modules_of_airframe = fun ?target xml -> (m :: modules) children with Subsystem _file -> modules end | Xml.Element (tag, _attrs, children) when tag = "firmware" -> - let name = List.assoc "name" _attrs in + let name = Xml.attrib xml "name" in begin match firmware with | Some f when f = name -> List.fold_left (fun acc xml -> From f39d8b3007aeb0f0f7014ce3cce690641fe69656 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Thu, 28 Apr 2016 01:18:03 +0200 Subject: [PATCH 5/7] pass all modules to settings stuff not sure this is all right --- sw/lib/ocaml/gen_common.ml | 4 ++-- sw/tools/generators/gen_aircraft.ml | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/sw/lib/ocaml/gen_common.ml b/sw/lib/ocaml/gen_common.ml index f04c239837..44cfba2378 100644 --- a/sw/lib/ocaml/gen_common.ml +++ b/sw/lib/ocaml/gen_common.ml @@ -323,9 +323,9 @@ let is_element_unselected = fun ?(verbose=false) target modules name -> | "settings" -> let target_list = targets_of_field xml "" in let unselected = not (test_targets target target_list) in - if unselected && verbose then + if unselected && not (target_list = Var ("")) && verbose then begin Printf.printf "Info: settings '%s' unloaded for target '%s'\n" name target; flush stdout end; - unselected + unselected && not (target_list = Var ("")) | "module" -> let unselected = List.for_all (fun m -> m.file <> name) modules in if unselected && verbose then diff --git a/sw/tools/generators/gen_aircraft.ml b/sw/tools/generators/gen_aircraft.ml index e9f7c749b3..f0431915c8 100644 --- a/sw/tools/generators/gen_aircraft.ml +++ b/sw/tools/generators/gen_aircraft.ml @@ -346,7 +346,7 @@ let () = mkdir (aircraft_conf_dir // "telemetry"); let target = try Sys.getenv "TARGET" with _ -> "" in - let modules = Gen_common.get_modules_of_config ~target (ExtXml.parse_file abs_airframe_file) (ExtXml.parse_file abs_flight_plan_file) in + let modules = Gen_common.get_modules_of_config (ExtXml.parse_file abs_airframe_file) (ExtXml.parse_file abs_flight_plan_file) in (* normal settings *) let settings = try Env.filter_settings (value "settings") with _ -> "" in (* remove settings if not supported for the current target *) From 4ef9cc3c7e7dea4fd4e2b6d23e463a5acdac8af1 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Thu, 28 Apr 2016 21:28:00 +0200 Subject: [PATCH 6/7] finally it was better with target filtering --- sw/tools/generators/gen_aircraft.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sw/tools/generators/gen_aircraft.ml b/sw/tools/generators/gen_aircraft.ml index f0431915c8..e9f7c749b3 100644 --- a/sw/tools/generators/gen_aircraft.ml +++ b/sw/tools/generators/gen_aircraft.ml @@ -346,7 +346,7 @@ let () = mkdir (aircraft_conf_dir // "telemetry"); let target = try Sys.getenv "TARGET" with _ -> "" in - let modules = Gen_common.get_modules_of_config (ExtXml.parse_file abs_airframe_file) (ExtXml.parse_file abs_flight_plan_file) in + let modules = Gen_common.get_modules_of_config ~target (ExtXml.parse_file abs_airframe_file) (ExtXml.parse_file abs_flight_plan_file) in (* normal settings *) let settings = try Env.filter_settings (value "settings") with _ -> "" in (* remove settings if not supported for the current target *) From e5e1615f9561152d55a3a9d45e96731cea664fc5 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Fri, 29 Apr 2016 11:14:28 +0200 Subject: [PATCH 7/7] [conf] telemetry_transparent: fix targets --- conf/modules/telemetry_transparent.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/conf/modules/telemetry_transparent.xml b/conf/modules/telemetry_transparent.xml index 7b35d6e968..4347f63d4a 100644 --- a/conf/modules/telemetry_transparent.xml +++ b/conf/modules/telemetry_transparent.xml @@ -11,7 +11,7 @@
- +