Skip to content

Commit

Permalink
new module conf allow to add global targets
Browse files Browse the repository at this point in the history
  • Loading branch information
@gautierhattenberger
gautierhattenberger committed Jan 30, 2011
1 parent 5863200 commit e2256bf
Show file tree
Hide file tree
Showing 4 changed files with 67 additions and 56 deletions.
23 changes: 11 additions & 12 deletions sw/tools/gen_aircraft.ml
View file
Expand Up @@ -62,12 +62,12 @@ let check_unique_id_and_name = fun conf ->

(** [get_modules dir xml]
* [dir] is the conf directory for modules, [xml] is the parsed airframe.xml *)
let get_modules = fun dir xml ->
(*let get_modules = fun dir xml ->
let modules = Gen_common.get_modules_of_airframe xml in
(* build a list (file name, (xml, xml list of flags)) *)
let extract = List.map Gen_common.get_full_module_conf modules in
(* return a list of name and a list of pairs (xml, xml list) *)
List.split extract
List.split extract*)

(**
Search and dump the module section :
Expand All @@ -76,7 +76,7 @@ let get_modules = fun dir xml ->
**)
let dump_module_section = fun xml f ->
(* get modules *)
let (files, modules) = get_modules Gen_common.modules_dir xml in
let modules = Gen_common.get_modules_of_airframe xml in
(* print modules directories and includes for all targets *)
fprintf f "\n####################################################\n";
fprintf f "# modules makefile section\n";
Expand All @@ -92,13 +92,12 @@ let dump_module_section = fun xml f ->
fprintf f "$(TARGET).CFLAGS += -I modules -I arch/$(ARCH)/modules\n";
List.iter (fun dir -> let dir_name = (String.uppercase dir)^"_DIR" in fprintf f "%s = modules/%s\n" dir_name dir) dir_list;
(* parse each module *)
List.iter (fun (m, flags, extra_targets) ->
let name = ExtXml.attrib m "name" in
let dir = try Xml.attrib m "dir" with _ -> name in
List.iter (fun m ->
let name = ExtXml.attrib m.xml "name" in
let dir = try Xml.attrib m.xml "dir" with _ -> name in
let dir_name = (String.uppercase dir)^"_DIR" in
(* get the list of all the targets for this module and concat the extra targets *)
let module_target_list = Gen_common.singletonize (
Gen_common.get_targets_of_module m @ extra_targets) in
let module_target_list = Gen_common.get_targets_of_module m in
(* print global flags as compilation defines and flags *)
fprintf f "\n# makefile for module %s in modules/%s\n" name dir;
List.iter (fun flag ->
Expand All @@ -114,12 +113,12 @@ let dump_module_section = fun xml f ->
fprintf f "%s.CFLAGS += -D%s%s\n" target name value
) module_target_list
| _ -> ()
) flags;
) m.param;
(* Look for makefile section *)
List.iter (fun l ->
if ExtXml.tag_is l "makefile" then begin
(* add extra targets only if default is used *)
let et = try ignore(Xml.attrib l "target"); [] with _ -> extra_targets in
let et = try ignore(Xml.attrib l "target"); [] with _ -> m.extra_targets in
let targets = Gen_common.singletonize (
Gen_common.targets_of_field l Gen_common.default_module_targets @ et) in
(* Look for defines, flags, files, ... *)
Expand Down Expand Up @@ -154,10 +153,10 @@ let dump_module_section = fun xml f ->
end
| _ -> ()
) (Xml.children l)
end) (Xml.children m)
end) (Xml.children m.xml)
) modules;
(** returns a list of modules file name *)
files
List.map (fun m -> m.file) modules

(**
Search and dump the makefile sections
Expand Down
63 changes: 30 additions & 33 deletions sw/tools/gen_common.ml
View file
Expand Up @@ -26,6 +26,8 @@

open Printf

type module_conf = { xml : Xml.xml; file : string; param : Xml.xml list; extra_targets : string list; }

let (//) = Filename.concat

let paparazzi_conf = Env.paparazzi_home // "conf"
Expand Down Expand Up @@ -64,43 +66,51 @@ let targets_of_field = fun field default ->
_ -> []

(** [get_modules_of_airframe xml]
* Returns a list of pair (modules ("load" node), targets) from airframe file *)
* Returns a list of module configuration from airframe file *)
let get_modules_of_airframe = fun xml ->
(* extract all "modules" sections *)
let modules = List.map (fun x ->
match String.lowercase (Xml.tag x) with
"modules" ->
let targets = targets_of_field x "" in
List.map (fun m -> (m,targets)) (Xml.children x)
| _ -> []
) (Xml.children xml) in
(* flatten the list (result is a list of "load" xml nodes) *)
List.flatten modules
let section = List.filter (fun s -> compare (Xml.tag s) "modules" = 0) (Xml.children xml) 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
List.map (fun m ->
if compare (Xml.tag m) "load" <> 0 then Xml2h.xml_error "load";
let file = modules_dir // ExtXml.attrib m "name" in
let targets = singletonize (t_global @ targets_of_field m "") in
{ xml = ExtXml.parse_file file; file = file; param = Xml.children m; extra_targets = targets }
) (Xml.children modules)
| [] -> []
| _ -> failwith "Error: you have more than one 'modules' section in your airframe file"

(** [get_full_module_conf module] Parse module configuration file (with extra targets)
* Returns module file name and a triple (xml, xml list, targets): parsed file, children, extra targets *)
let get_full_module_conf = fun (m, t) ->
(*let get_full_module_conf = fun (m, t) ->
match Xml.tag m with
"load" -> let file = modules_dir // ExtXml.attrib m "name" in
let targets = targets_of_field m "" in
(file, (ExtXml.parse_file file, Xml.children m, t @ targets))
| _ -> Xml2h.xml_error "load"

*)
(** [get_module_conf module] Parse module configuration file
* Returns parsed xml file *)
let get_module_conf = fun m ->
(*let get_module_conf = fun m ->
let (_ , (conf, _, _)) = get_full_module_conf (m, []) in
conf
*)

(** [get_targets_of_module xml] Returns the list of targets of a module *)
let get_targets_of_module = fun m ->
(** [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 default_module_targets
| _ -> []
) (Xml.children m) in
) (Xml.children conf.xml) in
let targets = (List.flatten targets) @ conf.extra_targets in
(* return a singletonized list *)
singletonize (List.sort compare (List.flatten targets))
singletonize (List.sort compare targets)

(** [unload_unused_modules modules ?print_error]
* Returns a list of [modules] where unused modules are removed
Expand All @@ -110,7 +120,7 @@ let unload_unused_modules = fun modules print_error ->
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 "Module %s unloaded, target %s not supported\n" (Xml.attrib m "name") target;
Printf.fprintf stderr "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
Expand All @@ -123,27 +133,14 @@ let unload_unused_modules = fun modules print_error ->
let get_modules_name = fun xml ->
(* extract all "modules" sections *)
let modules = get_modules_of_airframe xml in
(* parse modules *)
let modules = List.map (fun (m,_) -> ExtXml.parse_file (modules_dir // ExtXml.attrib m "name")) modules in
(* filter the list if target is not supported *)
let modules = unload_unused_modules modules false in
(* return a list of modules name *)
List.map (fun m -> ExtXml.attrib m "name") modules

(** [get_targets_of_module xml]
* Returns the list of targets of a module *)
let get_targets_of_module = fun m ->
let targets = List.map (fun x ->
match String.lowercase (Xml.tag x) with
"makefile" -> targets_of_field x default_module_targets
| _ -> []
) (Xml.children m) in
(* return a singletonized list *)
singletonize (List.sort compare (List.flatten targets))
List.map (fun m -> ExtXml.attrib m.xml "name") modules

(** [get_modules_dir xml]
* Returns the list of modules directories *)
let get_modules_dir = fun modules ->
let dir = List.map (fun (m, _, _) -> try Xml.attrib m "dir" with _ -> ExtXml.attrib m "name") modules in
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)

24 changes: 17 additions & 7 deletions sw/tools/gen_common.mli
View file
Expand Up @@ -24,42 +24,52 @@
*
*)

(* Module configuration:
* Xml node
* file name
* parameters
* extrat targets
*)
type module_conf = { xml : Xml.xml; file : string; param : Xml.xml list; extra_targets : string list; }

(* Modules directory *)
val modules_dir : string
(* Default targets for modules *)
val default_module_targets : string

(** remove all duplicated elements of a list *)
val singletonize : 'a list -> 'a list

(** [targets_of_field]
(** [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

(** [get_modules_of_airframe xml]
* Returns a list of pair (modules ("load" node), targets) from airframe file *)
val get_modules_of_airframe : Xml.xml -> (Xml.xml * string list) list
val get_modules_of_airframe : Xml.xml -> module_conf list

(** [get_full_module_conf module] Parse module configuration file (with extra targets)
* Returns module file name and a pair (xml, xml list, targets): parsed file, children, extra targets *)
val get_full_module_conf : (Xml.xml * string list) -> (string * (Xml.xml * Xml.xml list * string list))
(*val get_full_module_conf : (Xml.xml * string list) -> module_conf*)

(** [get_module_conf module] Parse module configuration file
* Returns parsed xml file *)
val get_module_conf : Xml.xml -> Xml.xml
(*val get_module_conf : Xml.xml -> Xml.xml*)

(** [get_targets_of_module xml] Returns the list of targets of a module *)
val get_targets_of_module : Xml.xml -> string list
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 : Xml.xml list -> bool -> Xml.xml list
val unload_unused_modules : module_conf list -> bool -> module_conf list

(** [get_modules_name xml]
* Returns a list of loaded modules' name *)
val get_modules_name : Xml.xml -> string list

(** [get_modules_dir xml]
* Returns the list of modules directories *)
val get_modules_dir : (Xml.xml * 'a * 'b) list -> string list
val get_modules_dir : module_conf list -> string list

13 changes: 9 additions & 4 deletions sw/tools/gen_modules.ml
View file
Expand Up @@ -328,14 +328,19 @@ let () =
fprintf out_h "#define EXTERN_MODULES extern\n";
fprintf out_h "#endif";
nl ();
(* Extract main_freq parameter *)
let modules = try (ExtXml.child xml "modules") with _ -> Xml.Element("modules",[],[]) in
let main_freq = try (int_of_string (Xml.attrib modules "main_freq")) with _ -> !freq in
freq := main_freq;
let modules_list = List.map GC.get_module_conf (Xml.children modules) in
let modules_list = GC.unload_unused_modules modules_list false in
(* Extract modules list *)
let modules = GC.get_modules_of_airframe xml in
let modules = GC.unload_unused_modules modules true in
(* Extract modules names (file name and module name) *)
let modules_name =
(List.map (fun l -> try Xml.attrib l "name" with _ -> "") (Xml.children modules)) @
(List.map (fun m -> try Xml.attrib m "name" with _ -> "") modules_list) in
(List.map (fun m -> try Xml.attrib m.GC.xml "name" with _ -> "") modules) @
(List.map (fun m -> m.GC.file) modules) in
(* Extract xml modules nodes *)
let modules_list = List.map (fun m -> m.GC.xml) modules in
check_dependencies modules_list modules_name;
parse_modules modules_list;
finish h_name;
Expand Down

0 comments on commit e2256bf

Please sign in to comment.