-
Notifications
You must be signed in to change notification settings - Fork 1.1k
/
gen_common.ml
146 lines (130 loc) · 5.21 KB
/
gen_common.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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
(*
* $Id$
*
* generic tools for modules
*
* Copyright (C) 2010 Gautier Hattenberger
*
* This file is part of paparazzi.
*
* paparazzi is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* paparazzi 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with paparazzi; see the file COPYING. If not, write to
* the Free Software Foundation, 59 Temple Place - Suite 330,
* Boston, MA 02111-1307, USA.
*
*)
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"
let modules_dir = paparazzi_conf // "modules"
let default_module_targets = "ap|sim"
(** remove all duplicated elements of a list *)
let singletonize = fun 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
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
(** union of a list of list *)
let union_of_lists = fun l ->
let sl = List.sort compare (List.flatten l) in
singletonize sl
(** [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
_ -> []
(** [get_modules_of_airframe xml]
* Returns a list of module configuration from airframe file *)
let 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
(* 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) ->
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 (_ , (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 conf ->
let targets = List.map (fun x ->
match String.lowercase (Xml.tag x) with
"makefile" -> targets_of_field x 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)
(** [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 "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
else
List.find_all is_target_in_module 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
(* return a list of modules name *)
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.xml "dir" with _ -> ExtXml.attrib m.xml "name") modules in
singletonize (List.sort compare dir)