Merge pull request #1471 from paparazzi/load_modules_from_firmware

[build] Modules can be used like subsystems in airframe files

conf/airframes/airframe.dtd

@@ -21,12 +21,13 @@
 <!ELEMENT define EMPTY>
 <!ELEMENT linear EMPTY>
 <!ELEMENT makefile (#PCDATA)>
-<!ELEMENT modules (load)*>
+<!ELEMENT modules (load|module)*>
 <!ELEMENT load (configure|define)*>
 <!ELEMENT configure EMPTY>
-<!ELEMENT firmware (target|subsystem|configure|define)*>
-<!ELEMENT target (subsystem|configure|define)*>
+<!ELEMENT firmware (target|subsystem|module|configure|define)*>
+<!ELEMENT target (subsystem|module|configure|define)*>
 <!ELEMENT subsystem (configure|define)*>
+<!ELEMENT module (configure|define)*>
 <!ELEMENT autopilot EMPTY>
 
 <!ATTLIST include
@@ -132,3 +133,8 @@ target CDATA #IMPLIED>
 name CDATA #REQUIRED
 target CDATA #IMPLIED
 dir CDATA #IMPLIED>
+
+<!ATTLIST module
+name CDATA #REQUIRED
+type CDATA #IMPLIED
+dir CDATA #IMPLIED>

conf/airframes/examples/microjet.xml

@@ -158,52 +158,51 @@
 
   <firmware name="fixedwing">
     <target name="sim" 			board="pc" />
-    <target name="ap" 			board="tiny_1.1"/>
+    <target name="ap" 			board="tiny_1.1">
+      <module name="tune_airspeed"/>
+      <module name="digital_cam" type="servo">
+        <define name="DC_SHUTTER_SERVO" value="COMMAND_SHUTTER" />
+      </module>
+      <module name="openlog"/>
+    </target>
 
     <define name="AGR_CLIMB" />
     <define name="LOITER_TRIM" />
 
-    <subsystem name="radio_control" type="ppm"/>
+    <module name="radio_control" type="ppm"/>
 
     <!-- Communication -->
-    <subsystem name="telemetry" 	type="xbee_api">
+    <module name="telemetry" 	type="xbee_api">
       <configure name="MODEM_BAUD" 		value="B9600"/>
-    </subsystem>
+    </module>
 
-    <subsystem name="control"/>
     <!-- Sensors -->
-    <subsystem name="imu"       type="analog">
+    <module name="imu"       type="analog">
       <configure name="GYRO_P" value="ADC_3"/>
-    </subsystem>
-    <subsystem name="gps"       type="ublox_utm"/>
-    <subsystem name="navigation"/>
-    <subsystem name="ins" type="alt_float"/>
+    </module>
+    <module name="gps"       type="ublox_utm"/>
+    <module name="infrared_adc"/>
+    <module name="ahrs" type="infrared"/>
+    <module name="ins" type="alt_float"/>
+
+    <module name="control"/>
+    <module name="navigation"/>
+    <module name="nav" type="survey_polygon"/>
+    <module name="nav" type="line_border"/>
+    <module name="nav" type="line"/>
+    <module name="nav" type="smooth"/>
+    <module name="nav" type="flower"/>
+    <module name="nav" type="line_osam"/>
+    <module name="nav" type="survey_poly_osam"/>
+    <module name="nav" type="vertical_raster"/>
+    <module name="nav" type="bungee_takeoff"/>
+
   </firmware>
 
   <section name="GCS">
     <define name="AC_ICON" value="flyingwing"/>
   </section>
 
-  <modules>
-    <load name="openlog.xml"/>
-    <load name="nav_survey_polygon.xml"/>
-    <load name="nav_line_border.xml"/>
-    <load name="nav_line.xml"/>
-    <load name="nav_smooth.xml"/>
-    <load name="nav_flower.xml"/>
-    <load name="nav_line_osam.xml"/>
-    <load name="nav_survey_poly_osam.xml"/>
-    <load name="nav_vertical_raster.xml"/>
-    <load name="nav_bungee_takeoff.xml"/>
-    <load name="infrared_adc.xml"/>
-    <load name="ahrs_infrared.xml"/>
-    <load name="tune_airspeed.xml"/>
-    <load name="digital_cam_servo.xml">
-      <define name="DC_SHUTTER_SERVO" value="COMMAND_SHUTTER" />
-    </load>
-  </modules>
-
-
   <firmware name="setup">
     <target name="tunnel"           board="tiny_1.1" />
     <target name="usb_tunnel"       board="tiny_1.1">

sw/lib/ocaml/extXml.ml

@@ -28,58 +28,57 @@ exception Error of string
 
 let sep = Str.regexp "\\."
 
-let child xml ?select c =
+let child = fun xml ?select c ->
   let rec find = function
-  Xml.Element (tag, _attributes, _children) as elt :: elts ->
-    if tag = c then
-      match select with
-          None -> elt
-        | Some p ->
-          if p elt then elt else find elts
-    else
-      find elts
+    | Xml.Element (tag, _attributes, _children) as elt :: elts ->
+	if tag = c then
+	  match select with
+          | None -> elt
+          | Some p -> if p elt then elt else find elts
+	else find elts
     | _ :: elts -> find elts
     | [] -> raise Not_found in
 
-
   let children = Xml.children xml in
 
   (* Let's try with a numeric index *)
-  try (Array.of_list children).(int_of_string c) with
-      Failure "int_of_string" -> (* Bad luck. Go through the children *)
-        find children
+  try (Array.of_list children).(int_of_string c)
+  with Failure "int_of_string" -> (* Bad luck. Go through the children *)
+    find children
 
 
 let get xml path =
   let p = Str.split sep path in
   let rec iter xml = function
-  [] -> failwith "ExtXml.get: empty path"
-    | [x] -> ( try if Xml.tag xml <> x then raise Not_found else xml with _ -> raise Not_found )
-    | x::xs -> iter (child xml x) xs in
+    | [] -> failwith "ExtXml.get: empty path"
+    | [x] -> begin
+	try if Xml.tag xml <> x then raise Not_found else xml
+	with _ -> raise Not_found end
+    | x :: xs -> iter (child xml x) xs in
   iter xml p
 
-let get_attrib xml path attr =
-  Xml.attrib (get xml path) attr
+let get_attrib = fun xml path attr -> Xml.attrib (get xml path) attr
 
 let sprint_fields = fun () l ->
   "<"^
     List.fold_right (fun (a, b) -> (^) (Printf.sprintf "%s=\"%s\" " a b)) l ">"
 
-let attrib = fun x a ->
-  try
-    Xml.attrib x a
-  with
-      Xml.No_attribute _ ->
-        raise (Error (Printf.sprintf "Error: Attribute '%s' expected in <%a>" a sprint_fields (Xml.attribs x)))
-
-let tag_is = fun x v ->
-  String.lowercase (Xml.tag x) = String.lowercase v
+let attrib = fun xml attr ->
+  try Xml.attrib xml attr
+  with Xml.No_attribute _ ->
+    let msg = Printf.sprintf "Error: Attribute '%s' expected in <%a>"
+	attr sprint_fields (Xml.attribs xml) in
+    raise (Error msg)
 
+let attrib_option = fun xml attr ->
+  try Some (Xml.attrib xml attr)
+  with Xml.No_attribute _ -> None
 
+let tag_is = fun x v -> String.lowercase (Xml.tag x) = String.lowercase v
 
 let attrib_or_default = fun x a default ->
-  try Xml.attrib x a with _ -> default
-
+  try Xml.attrib x a
+  with Xml.No_attribute _ | Xml.Not_element _ -> default
 
 (** Code patched from xml.ml from xml-light package: PC Data formatting removed *)
 let tmp = Buffer.create 200
@@ -150,11 +149,11 @@ let my_to_string_fmt = fun tab_attribs x ->
 let to_string_fmt = fun ?(tab_attribs = false) xml ->
   let l = String.lowercase in
   let rec lower = function
-  Xml.PCData _ as x -> x
+    | Xml.PCData _ as x -> x
     | Xml.Element (t, ats, cs) ->
-      Xml.Element(l t,
-                  List.map (fun (a,v) -> (l a, v)) ats,
-                  List.map lower cs) in
+	Xml.Element(l t,
+                    List.map (fun (a,v) -> (l a, v)) ats,
+                    List.map lower cs) in
   my_to_string_fmt tab_attribs (lower xml)
 
 
@@ -162,63 +161,68 @@ let subst_attrib = fun attrib value xml ->
   let u = String.uppercase in
   let uattrib = u attrib in
   match xml with
-      Xml.Element (tag, attrs, children) ->
-        let rec loop = function
-        [] -> [(attrib, value)]
-          | (a,_v) as c::ats ->
+  | Xml.Element (tag, attrs, children) ->
+      let rec loop = function
+          [] -> [(attrib, value)]
+        | (a,_v) as c::ats ->
             if u a = uattrib then loop ats else c::loop ats in
-        Xml.Element (tag,
-                     loop attrs,
-                     children)
-    | Xml.PCData _ -> xml
+      Xml.Element (tag,
+                   loop attrs,
+                   children)
+  | Xml.PCData _ -> xml
 
 
 let subst_child = fun ?(select= fun _ -> true) t x xml ->
   match xml with
-      Xml.Element (tag, attrs, children) ->
-        let found = ref false in
-        let new_children =
-          List.map
-            (fun xml -> if tag_is xml t && select xml then (found := true; x) else xml)
-            children in
-        if !found then
-          Xml.Element (tag, attrs, new_children)
-        else
-          raise Not_found
-    | Xml.PCData _ -> xml
+  | Xml.Element (tag, attrs, children) ->
+      let found = ref false in
+      let new_children =
+        List.map
+          (fun xml -> if tag_is xml t && select xml then (found := true; x) else xml)
+          children in
+      if !found then
+        Xml.Element (tag, attrs, new_children)
+      else
+        raise Not_found
+  | Xml.PCData _ -> xml
 
 
 let subst_or_add_child = fun t x xml ->
   try subst_child t x xml with Not_found ->
     match xml with
-        Xml.Element (tag, attrs, children) ->
-          Xml.Element (tag, attrs, x::children)
-      |  Xml.PCData _ -> xml
+    | Xml.Element (tag, attrs, children) ->
+	Xml.Element (tag, attrs, x :: children)
+    |  Xml.PCData _ -> xml
 
 
 let remove_child = fun ?(select= fun _ -> true) t xml ->
   match xml with
-      Xml.Element (tag, attrs, children) ->
-        Xml.Element (tag,
-                     attrs,
-                     List.fold_right (fun xml rest -> if tag_is xml t && select xml then rest else xml::rest) children [])
-    | Xml.PCData _ -> xml
+  | Xml.Element (tag, attrs, children) ->
+      Xml.Element (tag,
+                   attrs,
+                   List.fold_right (fun xml rest -> if tag_is xml t && select xml then rest else xml::rest) children [])
+  | Xml.PCData _ -> xml
 
 
 let float_attrib = fun xml a ->
   let v = attrib xml a in
-  try
-    float_of_string v
-  with
-      _ -> failwith (Printf.sprintf "Error: float expected in '%s'" v)
+  try float_of_string v
+  with _ -> failwith (Printf.sprintf "Error: float expected in '%s'" v)
 
 let int_attrib = fun xml a ->
   let v = attrib xml a in
-  try
-    int_of_string v
-  with
-      _ -> failwith (Printf.sprintf "Error: integer expected in '%s'" v)
+  try int_of_string v
+  with _ -> failwith (Printf.sprintf "Error: integer expected in '%s'" v)
 
+let iter_tag = fun tag f xml -> Xml.iter (fun x -> if tag_is x tag then f x) xml
+
+let filter_tag = fun tag xml ->
+  Xml.fold (fun acc x -> if tag_is x tag then x :: acc else acc) [] xml
+
+let partition_tag = fun tag xmls ->
+  List.fold_left
+    (fun (yes, no) x -> if tag_is x tag then x :: yes, no else yes, x:: no
+    ) ([], []) xmls
 
 (* When an .xml is coming through http, the dtd is not available. We disable
    the DTD proving feature in this case. FIXME: We should use the resolve
@@ -231,19 +235,17 @@ let my_xml_parse_file =
 
 
 let parse_file = fun ?(noprovedtd = false) file ->
-  try
-    (if noprovedtd then my_xml_parse_file else Xml.parse_file) file
+  try (if noprovedtd then my_xml_parse_file else Xml.parse_file) file
   with
-      Xml.Error e -> failwith (sprintf "%s: %s" file (Xml.error e))
-    | Xml.File_not_found f -> failwith (sprintf "File not found: %s" f)
-    | Dtd.Prove_error e -> failwith (sprintf "%s: %s" file (Dtd.prove_error e))
-    | Dtd.Check_error e -> failwith (sprintf "%s: %s" file (Dtd.check_error e))
-    | Dtd.Parse_error e -> failwith (sprintf "%s: %s" file (Dtd.parse_error e))
+  | Xml.Error e -> failwith (sprintf "%s: %s" file (Xml.error e))
+  | Xml.File_not_found f -> failwith (sprintf "File not found: %s" f)
+  | Dtd.Prove_error e -> failwith (sprintf "%s: %s" file (Dtd.prove_error e))
+  | Dtd.Check_error e -> failwith (sprintf "%s: %s" file (Dtd.check_error e))
+  | Dtd.Parse_error e -> failwith (sprintf "%s: %s" file (Dtd.parse_error e))
 
 
 
-let digest = fun xml ->
-  Digest.string (Xml.to_string xml)
+let digest = fun xml -> Digest.string (Xml.to_string xml)
 
 let predefined_general_entities =
   [ Str.regexp "&amp;", "&";

sw/lib/ocaml/extXml.mli

@@ -43,6 +43,8 @@ val float_attrib : Xml.xml -> string -> float
 val tag_is : Xml.xml -> string -> bool
 (** [tag_is xml s] Case safe test *)
 
+val attrib_option : Xml.xml -> string -> string option
+
 val attrib_or_default : Xml.xml -> string -> string -> string
 (** [get xml attribute_name default_value] *)
 
@@ -65,6 +67,18 @@ val remove_child :
     ?select:(Xml.xml -> bool) -> string -> Xml.xml -> Xml.xml
 (** [delete_child ?select child_tag xml] Returns [xml] if not found *)
 
+val iter_tag : string -> (Xml.xml -> unit) -> Xml.xml -> unit
+(** [iter_tag f tag xml] applies function [f] to every child of [xml] with
+    tag [tag]  *)
+
+val filter_tag : string -> Xml.xml -> Xml.xml list
+(** [filter_tag tag xml] returns all children of [xml]
+    which are [tag] elements *)
+
+val partition_tag : string -> Xml.xml list -> Xml.xml list * Xml.xml list
+(** [partion_tag tag xmls] returns two lists [l1] and [l2], with [l1] containing
+    all of [xmls] which are [tag] elements, and [l2] all other elements *)
+
 val parse_file : ?noprovedtd:bool -> string -> Xml.xml
 (** Identical to Xml.parse_file with Failure exceptions. [nodtdprove] default is false. *)
 

sw/lib/ocaml/gen_common.ml

@@ -24,7 +24,15 @@
 
 open Printf
 
-type module_conf = { xml : Xml.xml; file : string; filename : string; vpath : string option; param : Xml.xml list; extra_targets : string list; }
+type module_conf = {
+    name: string;
+    xml: Xml.xml;
+    file: string;
+    filename: string;
+    vpath: string option;(* this field should be removed after transition phase *)
+    param: Xml.xml list;
+    targets: string list
+  }
 
 let (//) = Filename.concat
 
@@ -33,34 +41,26 @@ let modules_dir = paparazzi_conf // "modules"
 let autopilot_dir = paparazzi_conf // "autopilot"
 
 (** remove all duplicated elements of a list *)
-let singletonize = fun l ->
+let singletonize = fun ?(compare = Pervasives.compare) l ->
   let rec loop = fun l ->
     match l with
-        [] | [_] -> l
-      | x::((x'::_) as xs) ->
-        if x = x' then loop xs else x::loop xs in
+    | [] | [_] -> l
+    | x::((x'::_) as xs) -> if compare x x' = 0 then loop xs else x::loop xs in
   loop (List.sort compare l)
 
 (** union of two lists *)
-let union = fun l1 l2 ->
-  let l = l1 @ l2 in
-  let sl = List.sort compare l in
-  singletonize sl
+let union = fun l1 l2 -> singletonize (l1 @ l2)
 
 (** union of a list of list *)
-let union_of_lists = fun l ->
-  let sl = List.sort compare (List.flatten l) in
-  singletonize sl
+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" *)
-let pipe_regexp = Str.regexp "|"
-let targets_of_field = fun field default ->
-  try
-    Str.split pipe_regexp (ExtXml.attrib_or_default field "target" default)
-  with
-      _ -> []
+let targets_of_field =
+  let pipe = Str.regexp "|" in
+  fun field default ->
+    Str.split pipe (ExtXml.attrib_or_default field "target" default)
 
 (** [get_autopilot_of_airframe xml]
     * Returns (autopilot xml, main freq) from airframe xml file *)
@@ -76,79 +76,115 @@ let get_autopilot_of_airframe = fun xml ->
     | [] -> raise Not_found
     | _ -> failwith "Error: you have more than one 'autopilot' section in your airframe file"
 
-(** [get_modules_of_airframe xml]
-    * Returns a list of module configuration from airframe file *)
-let rec get_modules_of_airframe = fun xml ->
-  (* extract all "modules" sections *)
-  let section = List.filter (fun s -> compare (Xml.tag s) "modules" = 0) (Xml.children xml) in
-  (* get autopilot file if any *)
-  let ap_file = try
-                  let (ap, _) = get_autopilot_of_airframe xml in
-                  ap
-    with _ -> "" in
-  (* Raise error if more than one modules section *)
-  match section with
-      [modules] ->
-      (* if only one section, returns a list of configuration *)
-        let t_global = targets_of_field modules "" in
-        let get_module = fun m t ->
-          (* extract dir name if any and add paparazzi_home path if dir path is not global *)
-          let (dir, vpath) = try
-            let dir = ExtXml.attrib m "dir" in
-            let dir = if Filename.is_relative dir then Env.paparazzi_home // dir else "" in
-            (dir, Some dir)
-          with _ -> (modules_dir, None) in
-          let filename = ExtXml.attrib m "name" in
-          let file = dir // filename in
-          let targets = singletonize (t @ targets_of_field m "") in
-          { xml = ExtXml.parse_file file; file = file; filename = filename; vpath = vpath; param = Xml.children m; extra_targets = targets }
-        in
-        let modules_list = List.map (fun m ->
-          if compare (Xml.tag m) "load" <> 0 then Xml2h.xml_error "load";
-          get_module m t_global
-        ) (Xml.children modules) in
-        let ap_modules = try
-                           get_modules_of_airframe (ExtXml.parse_file ap_file)
-          with _ -> [] in
-        modules_list @ ap_modules
-    | [] -> []
-    | _ -> failwith "Error: you have more than one 'modules' section in your airframe file"
-
 (** [get_targets_of_module xml]
     * Returns the list of targets of a module *)
-let get_targets_of_module = fun conf ->
-  let targets = List.map (fun x ->
-    match String.lowercase (Xml.tag x) with
-        "makefile" -> targets_of_field x Env.default_module_targets
-      | _ -> []
-  ) (Xml.children conf.xml) in
-  let targets = (List.flatten targets) @ conf.extra_targets in
-  (* return a singletonized list *)
-  singletonize (List.sort compare targets)
+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)
 
-(** [unload_unused_modules modules ?print_error]
-    * Returns a list of [modules] where unused modules are removed
-    * If [print_error] is true, a warning is printed *)
-let unload_unused_modules = fun modules print_error ->
-  let target = try Sys.getenv "TARGET" with _ -> "" in
-  let is_target_in_module = fun m ->
-    let target_is_in_module = List.exists (fun x -> String.compare target x = 0) (get_targets_of_module m) in
-    if print_error && not target_is_in_module then
-      Printf.fprintf stderr "Info: Module %s unloaded, target %s not supported\n" (Xml.attrib m.xml "name") target;
-    target_is_in_module
-  in
-  if String.length target = 0 then
-    modules
+let module_name = fun xml ->
+  let name = ExtXml.attrib xml "name" in
+  try Filename.chop_extension name with _ -> name
+
+exception Subsystem of string
+let get_module = fun m global_targets ->
+  match Xml.tag m with
+  | "module" ->
+      let name = module_name m in
+      let filename =
+        let modtype = ExtXml.attrib_or_default m "type" "" in
+        name ^ (if modtype = "" then "" else "_") ^ modtype ^ ".xml" in
+      let file = modules_dir // filename in
+      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
+      { 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 *)
+      let dir, vpath =
+        try
+          let dir = ExtXml.attrib m "dir" in
+          let dir =
+            if Filename.is_relative dir then Env.paparazzi_home // dir
+            else dir in
+          (dir, Some dir)
+        with _ -> modules_dir, None in
+      let filename = ExtXml.attrib m "name" in
+      let name = Filename.chop_extension filename in
+      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
+      { name = name; xml = xml; file = file; filename = filename; vpath = vpath;
+        param = Xml.children m; targets = targets }
+  | _ -> Xml2h.xml_error "module or load"
+
+(** [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 !) *)
+let test_targets = fun target targets ->
+  List.exists (fun t ->
+  let l = String.length t in
+  (* test for inverted selection *)
+  if l > 0 && t.[0] = '!' then
+  not ((String.sub t 1 (l-1)) = target)
   else
-    List.find_all is_target_in_module modules
+  t = target
+  ) targets
+
+(** [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
+  let rec iter_modules = fun targets modules xml ->
+    match xml with
+    | Xml.PCData _ -> modules
+    | Xml.Element (tag, _attrs, children) when is_module tag ->
+        begin try
+          let m = get_module xml targets in
+          List.fold_left
+            (fun acc xml -> iter_modules targets acc xml)
+            (m :: modules) children
+        with Subsystem _file -> modules end
+    | Xml.Element (tag, _attrs, children) when tag = "target" ->
+        let target_name = Xml.attrib xml "name" in
+        begin match target with
+        | None ->
+            List.fold_left
+              (fun acc xml -> iter_modules targets acc xml) modules children
+        | Some t when t = target_name ->
+            List.fold_left
+              (fun acc xml -> iter_modules targets acc xml) modules children
+        | _ -> modules end
+    | Xml.Element (tag, _attrs, children) ->
+        let targets =
+          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 ap_modules =
+    try
+      let ap_file = fst (get_autopilot_of_airframe xml) in
+      iter_modules [] [] (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
 
 (** [get_modules_name xml]
     * Returns a list of loaded modules' name *)
 let get_modules_name = fun xml ->
-  (* extract all "modules" sections *)
-  let modules = get_modules_of_airframe xml in
-  (* filter the list if target is not supported *)
-  let modules = unload_unused_modules modules false in
+  let target = try Sys.getenv "TARGET" with _ -> "" in
+  (* extract all modules sections for a given target *)
+  let modules = get_modules_of_airframe ~target xml in
   (* return a list of modules name *)
   List.map (fun m -> ExtXml.attrib m.xml "name") modules
 
@@ -158,20 +194,11 @@ let get_modules_dir = fun modules ->
   let dir = List.map (fun m -> try Xml.attrib m.xml "dir" with _ -> ExtXml.attrib m.xml "name") modules in
   singletonize (List.sort compare dir)
 
-(** [is_element_unselected target file]
- * Returns True if [target] is supported the element [file],
+(** [is_element_unselected target modules file]
+ * Returns True if [target] is supported in the element [file] and, if it is
+ * a module, that it is loaded,
  * [file] being the file name of an Xml file (module or setting) *)
-let is_element_unselected = fun ?(verbose=false) target name ->
-  let test_targets = fun targets ->
-    List.exists (fun t ->
-      let l = String.length t in
-      (* test for inverted selection *)
-      if l > 0 && t.[0] = '!' then
-        not ((String.sub t 1 (l-1)) = target)
-      else
-        t = target
-    ) targets
-  in
+let is_element_unselected = fun ?(verbose=false) target modules name ->
   try
     let name = (Env.paparazzi_home // "conf" // name) in
     let xml = Xml.parse_file name in
@@ -179,20 +206,12 @@ let is_element_unselected = fun ?(verbose=false) target name ->
     | "settings" ->
         let targets = Xml.attrib xml "target" in
         let target_list = Str.split (Str.regexp "|") targets in
-        let unselected = not (test_targets target_list) 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;
         unselected
     | "module" ->
-        let targets = List.map (fun x ->
-          match String.lowercase (Xml.tag x) with
-          | "makefile" -> targets_of_field x Env.default_module_targets
-          | _ -> []
-          ) (Xml.children xml) in
-        let targets = (List.flatten targets) in
-        (* singletonized list *)
-        let targets = singletonize (List.sort compare targets) in
-        let unselected = not (test_targets targets) in
+        let unselected = List.for_all (fun m -> m.file <> name) modules in
         if unselected && verbose then
           begin Printf.printf "Info: module '%s' unloaded for target '%s'\n" name target; flush stdout end;
         unselected

sw/lib/ocaml/gen_common.mli

@@ -30,30 +30,34 @@
   * parameters
   * extrat targets
   *)
-type module_conf = { xml : Xml.xml; file : string; filename : string; vpath : string option; param : Xml.xml list; extra_targets : string list; }
+type module_conf = { name : string; xml : Xml.xml; file : string; filename : string; vpath : string option; param : Xml.xml list; targets : string list; }
 
 (* Modules directory *)
 val modules_dir : string
 
 (** remove all duplicated elements of a list *)
-val singletonize : 'a list -> 'a list
+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
  * Default "ap|sim" *)
 val targets_of_field : Xml.xml -> string -> string list
 
+exception Subsystem of string
+val module_name : Xml.xml -> string
+val get_module : Xml.xml -> string list -> module_conf
+
 (** [get_modules_of_airframe xml]
  * Returns a list of pair (modules ("load" node), targets) from airframe file *)
-val get_modules_of_airframe : Xml.xml -> module_conf list
+val get_modules_of_airframe : ?target: string -> Xml.xml -> module_conf list
+
+(** [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
 
 (** [get_targets_of_module xml] Returns the list of targets of a module *)
-val get_targets_of_module : module_conf -> string list
-
-(** [unload_unused_modules modules ?print_error]
- * Returns a list of [modules] where unused modules are removed
- * If [print_error] is true, a warning is printed *)
-val unload_unused_modules : module_conf list -> bool -> module_conf list
+val get_targets_of_module : Xml.xml -> string list
 
 (** [get_modules_name xml]
  * Returns a list of loaded modules' name *)
@@ -69,8 +73,9 @@ val get_modules_dir : module_conf list -> string list
  * Fail if more than one *)
 val get_autopilot_of_airframe : Xml.xml -> (string * string option)
 
-(** [is_element_unselected target file]
- * Returns True if [target] is supported the element [file],
+(** [is_element_unselected target modules file]
+ * Returns True if [target] is supported in the element [file] and, if it is
+ * a module, that it is loaded,
  * [file] being the file name of an Xml file (module or setting) *)
-val is_element_unselected : ?verbose:bool -> string -> string -> bool
+val is_element_unselected : ?verbose:bool -> string -> module_conf list -> string -> bool
 

sw/tools/generators/gen_airframe.ml

@@ -86,11 +86,17 @@ let convert_value_with_code_unit_coef_of_xml = function xml ->
   (* if unit equals code unit, don't convert as that would always result in a float *)
   if u = cu then failwith "Not converting";
   (* default value for code_unit is rad[/s] when unit is deg[/s] *)
-  let conv = try (Pprz.scale_of_units u cu) with
-    | Pprz.Unit_conversion_error s -> prerr_endline (sprintf "Unit conversion error: %s" s); flush stderr; exit 1
-    | Pprz.Unknown_conversion (su, scu) -> prerr_endline (sprintf "Warning: unknown unit conversion: from %s to %s" su scu); flush stderr; failwith "Unknown unit conversion"
-    | Pprz.No_automatic_conversion _ | _ -> failwith "Unit conversion error" in
-  let v = try ExtXml.float_attrib xml "value" with _ -> prerr_endline (sprintf "Error: Unit conversion of parameter %s impossible because '%s' is not a float" (Xml.attrib xml "name") (Xml.attrib xml "value")); flush stderr; exit 1 in
+  let conv = try Pprz.scale_of_units u cu with
+  | Pprz.Unit_conversion_error s ->
+      eprintf "Unit conversion error: %s\n%!" s;
+      exit 1
+  | Pprz.Unknown_conversion (su, scu) ->
+      eprintf "Warning: unknown unit conversion: from %s to %s\n%!" su scu;
+      failwith "Unknown unit conversion"
+  | Pprz.No_automatic_conversion _ | _ -> failwith "Unit conversion error" in
+  let v =
+    try ExtXml.float_attrib xml "value"
+    with _ -> prerr_endline (sprintf "Error: Unit conversion of parameter %s impossible because '%s' is not a float" (Xml.attrib xml "name") (Xml.attrib xml "value")); flush stderr; exit 1 in
   v *. conv
 
 let array_sep = Str.regexp "[,;]"

sw/tools/generators/gen_modules.ml

@@ -402,8 +402,13 @@ let () =
     fprintf out_h "#endif";
     nl ();
     (* Extract modules list *)
-    let modules = GC.get_modules_of_airframe xml in
-    let modules = GC.unload_unused_modules modules true in
+    let modules =
+      try
+        let target = Sys.getenv "TARGET" in
+        GC.get_modules_of_airframe ~target xml
+      with
+      | Not_found -> failwith "TARTGET env needs to be specified to generate modules files"
+    in
     (* Extract modules names (file name and module name) *)
     let modules_name =
       (List.map (fun m -> try Xml.attrib m.GC.xml "name" with _ -> "") modules) @