mirror of
https://github.com/paparazzi/paparazzi.git
synced 2026-05-10 06:59:54 +08:00
Drop old compat (#2786)
* [ocaml] drop of compat for Ocaml < 4.05 this is linked to Ubuntu 16.04 that have reached end of life * [pprzlink] update pprzlink for removed old compat
This commit is contained in:
committed by
GitHub
parent
da5b527795
commit
83a74e412f
+1
-1
Submodule sw/ext/pprzlink updated: c6e88ccbb9...bd13ad8da2
@@ -501,7 +501,7 @@ let resize = fun (widget:GObj.widget) orientation size ->
|
||||
|
||||
let rec pack_widgets = fun orientation xml widgets packing ->
|
||||
let size = try Some (ExtXml.int_attrib xml "size") with _ -> None in
|
||||
match Compat.lowercase_ascii (Xml.tag xml) with
|
||||
match String.lowercase_ascii (Xml.tag xml) with
|
||||
"widget" ->
|
||||
let name = ExtXml.attrib xml "name" in
|
||||
let widget =
|
||||
@@ -528,7 +528,7 @@ and pack_list = fun resize orientation xmls widgets packing ->
|
||||
|
||||
let rec find_widget_children = fun name xml ->
|
||||
let xmls = Xml.children xml in
|
||||
match Compat.lowercase_ascii (Xml.tag xml) with
|
||||
match String.lowercase_ascii (Xml.tag xml) with
|
||||
"widget" when ExtXml.attrib xml "name" = name -> xmls
|
||||
| "rows" | "columns" ->
|
||||
let rec loop = function
|
||||
@@ -542,7 +542,7 @@ let rec find_widget_children = fun name xml ->
|
||||
|
||||
let rec replace_widget_children = fun name children xml ->
|
||||
let xmls = Xml.children xml
|
||||
and tag = Compat.lowercase_ascii (Xml.tag xml) in
|
||||
and tag = String.lowercase_ascii (Xml.tag xml) in
|
||||
match tag with
|
||||
"widget" ->
|
||||
Xml.Element("widget",
|
||||
@@ -564,7 +564,7 @@ let rec update_widget_size = fun orientation widgets xml ->
|
||||
if orientation = `HORIZONTAL then rect.Gtk.width else rect.Gtk.height
|
||||
in
|
||||
let xmls = Xml.children xml
|
||||
and tag = Compat.lowercase_ascii (Xml.tag xml) in
|
||||
and tag = String.lowercase_ascii (Xml.tag xml) in
|
||||
match tag with
|
||||
"widget" ->
|
||||
let name = ExtXml.attrib xml "name" in
|
||||
|
||||
@@ -349,7 +349,7 @@ let mark = fun (geomap:G.widget) ac_id track plugin_frame ->
|
||||
let attributes_pretty_printer = fun attribs ->
|
||||
(* Remove the optional attributes *)
|
||||
let valid = fun a ->
|
||||
let a = Compat.lowercase_ascii a in
|
||||
let a = String.lowercase_ascii a in
|
||||
a <> "no" && a <> "strip_icon" && a <> "strip_button" && a <> "pre_call"
|
||||
&& a <> "post_call" && a <> "key" && a <> "group" in
|
||||
|
||||
|
||||
@@ -250,7 +250,7 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) ac_id packing dl_
|
||||
|
||||
(** Insert the related buttons in the strip and prepare the papgets DnD *)
|
||||
List.iter (fun x ->
|
||||
match Compat.lowercase_ascii (Xml.tag x) with
|
||||
match String.lowercase_ascii (Xml.tag x) with
|
||||
"strip_button" ->
|
||||
let label = ExtXml.attrib x "name"
|
||||
and sp_value = ExtXml.float_attrib x "value"
|
||||
@@ -294,7 +294,7 @@ let same_tag_for_all = function
|
||||
| x::xs ->
|
||||
let tag_first = Xml.tag x in
|
||||
List.iter (fun y -> assert(ExtXml.tag_is y tag_first)) xs;
|
||||
Compat.lowercase_ascii tag_first
|
||||
String.lowercase_ascii tag_first
|
||||
|
||||
|
||||
(** Build the tree of settings *)
|
||||
|
||||
@@ -7,7 +7,7 @@ let (//) = Filename.concat
|
||||
|
||||
let rec display = fun (geomap:MapCanvas.widget) r ->
|
||||
|
||||
match Compat.lowercase_ascii (Xml.tag r) with
|
||||
match String.lowercase_ascii (Xml.tag r) with
|
||||
"disc" ->
|
||||
let rad = float_of_string (ExtXml.attrib r "radius")
|
||||
and geo = Latlong.of_string (ExtXml.attrib (ExtXml.child r "point") "pos") in
|
||||
|
||||
@@ -24,7 +24,7 @@ let string_of_values = fun values ->
|
||||
(** get modes from autopilot xml file *)
|
||||
let modes_from_autopilot = fun ap_xml ->
|
||||
let ap = ExtXml.child ap_xml
|
||||
~select:(fun x -> Compat.uppercase_ascii (ExtXml.attrib_or_default x "gcs_mode" "") = "TRUE")
|
||||
~select:(fun x -> String.uppercase_ascii (ExtXml.attrib_or_default x "gcs_mode" "") = "TRUE")
|
||||
"state_machine"
|
||||
in
|
||||
let modes = List.filter (fun x -> Xml.tag x = "mode") (Xml.children ap) in
|
||||
|
||||
+4
-27
@@ -49,26 +49,12 @@ ifeq ($(LABLGTK2GNOMECANVAS),)
|
||||
LABLGTK2GNOMECANVAS = $(shell ocamlfind query -p-format lablgtk2.gnomecanvas 2>/dev/null)
|
||||
endif
|
||||
|
||||
CAMLP4_DEFS ?=
|
||||
OCAMLC_VER := $(shell ocamlc -version)
|
||||
OCAMLC_MAJOR := $(shell echo $(OCAMLC_VER) | cut -f1 -d.)
|
||||
OCAMLC_MINOR := $(shell echo $(OCAMLC_VER) | cut -f2 -d.)
|
||||
ifeq ($(shell test $(OCAMLC_MAJOR) -ge 4; echo $$?),0)
|
||||
ifeq ($(shell test $(OCAMLC_MINOR) -ge 4; echo $$?),0)
|
||||
CAMLP4_DEFS += -DOCAML_V404
|
||||
endif
|
||||
endif
|
||||
PP_OPTS = -pp "camlp4o pa_macro.cmo $(CAMLP4_DEFS)"
|
||||
|
||||
# which source files to run through caml4p
|
||||
PP_SRC = compat.ml
|
||||
|
||||
INCLUDES=
|
||||
PKGCOMMON=pprzlink,xml-light,netclient,nettls-gnutls,glibivy,lablgtk2
|
||||
XINCLUDES=
|
||||
XPKGCOMMON=pprzlink,xml-light,glibivy,$(LABLGTK2GNOMECANVAS),lablgtk2.glade
|
||||
|
||||
SRC = compat.ml fig.ml debug.ml base64.ml serial.ml ocaml_tools.ml expr_syntax.ml expr_parser.ml expr_lexer.ml extXml.ml env.ml xml2h.ml latlong.ml egm96.ml srtm.ml http.ml gm.ml iGN.ml geometry_2d.ml cserial.o ubx.ml xmlCom.ml os_calls.ml editAirframe.ml defivybus.ml fp_proc.ml quaternion.ml
|
||||
SRC = fig.ml debug.ml base64.ml serial.ml ocaml_tools.ml expr_syntax.ml expr_parser.ml expr_lexer.ml extXml.ml env.ml xml2h.ml latlong.ml egm96.ml srtm.ml http.ml gm.ml iGN.ml geometry_2d.ml cserial.o ubx.ml xmlCom.ml os_calls.ml editAirframe.ml defivybus.ml fp_proc.ml quaternion.ml
|
||||
SRC += gen_common.ml radio.ml settings.ml module.ml flight_plan.ml autopilot.ml airframe.ml telemetry.ml aircraft.ml
|
||||
CMO = $(SRC:.ml=.cmo)
|
||||
CMX = $(SRC:.ml=.cmx)
|
||||
@@ -139,19 +125,11 @@ ml_gtk_drag.o : ml_gtk_drag.c
|
||||
|
||||
%.cmo : %.ml
|
||||
@echo OC $<
|
||||
@if test $(findstring $<,$(PP_SRC)); then \
|
||||
$(OCAMLC) $(INCLUDES) $(PP_OPTS) -package $(PKGCOMMON) -c $<; \
|
||||
else \
|
||||
$(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c $<; \
|
||||
fi;
|
||||
$(Q)$(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c $<
|
||||
|
||||
%.cmx : %.ml
|
||||
@echo OOC $<
|
||||
@if test $(findstring $<,$(PP_SRC)); then \
|
||||
$(OCAMLOPT) $(INCLUDES) $(PP_OPTS) -package $(PKGCOMMON) -c $<; \
|
||||
else \
|
||||
$(OCAMLOPT) $(INCLUDES) -package $(PKGCOMMON) -c $<; \
|
||||
fi;
|
||||
$(Q)$(OCAMLOPT) $(INCLUDES) -package $(PKGCOMMON) -c $<
|
||||
|
||||
%.cmi : %.mli
|
||||
@echo OC $<
|
||||
@@ -208,8 +186,7 @@ clean :
|
||||
|
||||
.depend: Makefile $(GEN_DEP)
|
||||
@echo DEPEND $@
|
||||
$(Q)$(OCAMLDEP) $(PP_OPTS) $(PP_SRC) > .depend
|
||||
$(Q)$(OCAMLDEP) $(filter-out $(PP_SRC), $(SRC) $(XSRC)) *.mli >> .depend
|
||||
$(Q)$(OCAMLDEP) $(SRC) $(XSRC) *.mli >> .depend
|
||||
|
||||
ifneq ($(MAKECMDGOALS),clean)
|
||||
-include .depend
|
||||
|
||||
@@ -55,7 +55,7 @@ let get_sys_ap_settings = fun autopilots ->
|
||||
let dl_settings = List.fold_left (fun sl (_, autopilot) ->
|
||||
(* Filter state machines that need to be displayed *)
|
||||
let sm_filtered = List.filter (fun sm ->
|
||||
try (Compat.lowercase_ascii (Xml.attrib sm "settings_mode")) = "true" with _ -> false
|
||||
try (String.lowercase_ascii (Xml.attrib sm "settings_mode")) = "true" with _ -> false
|
||||
) (Xml.children autopilot.xml) in
|
||||
if List.length sm_filtered = 0 then sl
|
||||
else
|
||||
@@ -65,7 +65,7 @@ let get_sys_ap_settings = fun autopilots ->
|
||||
let name = Xml.attrib sm "name" in
|
||||
(* Iter on modes and store min, max and values *)
|
||||
let (_, min, max, values) = List.fold_left (fun (current, min, max, values) m ->
|
||||
let print = try Compat.lowercase_ascii (Xml.attrib m "settings") <> "hide" with _ -> true in
|
||||
let print = try String.lowercase_ascii (Xml.attrib m "settings") <> "hide" with _ -> true in
|
||||
let name = Xml.attrib m "name" in
|
||||
if print then begin
|
||||
let min = match min with
|
||||
|
||||
@@ -1,39 +0,0 @@
|
||||
(*
|
||||
* Abstract some String/Byte functions for compatibility between OCaml 3.x and 4.x
|
||||
*
|
||||
* Copyright (C) 2016 Felix Ruess <felix.ruess@gmail.com>
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
IFDEF OCAML_V404 THEN
|
||||
let lowercase_ascii = String.lowercase_ascii
|
||||
|
||||
let uppercase_ascii = String.uppercase_ascii
|
||||
|
||||
let capitalize_ascii = String.capitalize_ascii
|
||||
|
||||
ELSE
|
||||
let lowercase_ascii = String.lowercase
|
||||
|
||||
let uppercase_ascii = String.uppercase
|
||||
|
||||
let capitalize_ascii = String.capitalize
|
||||
|
||||
END
|
||||
@@ -1,27 +0,0 @@
|
||||
(*
|
||||
* Abstract some String/Byte functions for compatibility between OCaml 3.x and 4.x
|
||||
*
|
||||
* Copyright (C) 2016 Felix Ruess <felix.ruess@gmail.com>
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
val lowercase_ascii : string -> string
|
||||
val uppercase_ascii : string -> string
|
||||
val capitalize_ascii : string -> string
|
||||
@@ -82,7 +82,7 @@ let attrib_opt_map = fun xml attr f ->
|
||||
let attrib_opt_int = fun xml attr -> attrib_opt_map xml attr int_of_string
|
||||
let attrib_opt_float = fun xml attr -> attrib_opt_map xml attr float_of_string
|
||||
|
||||
let tag_is = fun x v -> Compat.lowercase_ascii (Xml.tag x) = Compat.lowercase_ascii v
|
||||
let tag_is = fun x v -> String.lowercase_ascii (Xml.tag x) = String.lowercase_ascii v
|
||||
|
||||
let attrib_or_default = fun x a default ->
|
||||
try Xml.attrib x a
|
||||
@@ -153,7 +153,7 @@ let my_to_string_fmt = fun tab_attribs x ->
|
||||
s
|
||||
|
||||
let to_string_fmt = fun ?(tab_attribs = false) xml ->
|
||||
let l = Compat.lowercase_ascii in
|
||||
let l = String.lowercase_ascii in
|
||||
let rec lower = function
|
||||
| Xml.PCData _ as x -> x
|
||||
| Xml.Element (t, ats, cs) ->
|
||||
@@ -164,7 +164,7 @@ let to_string_fmt = fun ?(tab_attribs = false) xml ->
|
||||
|
||||
|
||||
let subst_attrib = fun attrib value xml ->
|
||||
let u = Compat.uppercase_ascii in
|
||||
let u = String.uppercase_ascii in
|
||||
let uattrib = u attrib in
|
||||
match xml with
|
||||
| Xml.Element (tag, attrs, children) ->
|
||||
|
||||
@@ -72,7 +72,7 @@ let transform_values = fun attribs_not_modified env attribs ->
|
||||
List.map
|
||||
(fun (a, v) ->
|
||||
let v' =
|
||||
if List.mem (Compat.lowercase_ascii a) attribs_not_modified
|
||||
if List.mem (String.lowercase_ascii a) attribs_not_modified
|
||||
then v
|
||||
else transform_expression env (parse_expression v) in
|
||||
(a, v'))
|
||||
@@ -83,7 +83,7 @@ let prefix_or_deroute = fun prefix reroutes name attribs ->
|
||||
List.map
|
||||
(fun (a, v) ->
|
||||
let v' =
|
||||
if Compat.lowercase_ascii a = name then
|
||||
if String.lowercase_ascii a = name then
|
||||
try List.assoc v reroutes with
|
||||
Not_found -> prefix v
|
||||
else v in
|
||||
@@ -105,7 +105,7 @@ let transform_stage = fun prefix reroutes env xml ->
|
||||
let rec tr = fun xml ->
|
||||
match xml with
|
||||
Xml.Element (tag, attribs, children) -> begin
|
||||
match Compat.lowercase_ascii tag with
|
||||
match String.lowercase_ascii tag with
|
||||
"exception" ->
|
||||
transform_exception prefix reroutes env xml
|
||||
| "while" ->
|
||||
@@ -276,7 +276,7 @@ let process_includes = fun dir xml ->
|
||||
|
||||
|
||||
let remove_attribs = fun xml names ->
|
||||
List.filter (fun (x,_) -> not (List.mem (Compat.lowercase_ascii x) names)) (Xml.attribs xml)
|
||||
List.filter (fun (x,_) -> not (List.mem (String.lowercase_ascii x) names)) (Xml.attribs xml)
|
||||
|
||||
let xml_assoc_attrib = fun a v xmls ->
|
||||
List.find (fun x -> ExtXml.attrib x a = v) xmls
|
||||
@@ -327,7 +327,7 @@ let replace_from = fun stage waypoints ->
|
||||
|
||||
let process_stage = fun stage waypoints ->
|
||||
let rec do_it = fun stage ->
|
||||
match Compat.lowercase_ascii (Xml.tag stage) with
|
||||
match String.lowercase_ascii (Xml.tag stage) with
|
||||
"go" | "stay" | "circle" ->
|
||||
replace_from (replace_wp stage waypoints) waypoints
|
||||
|
||||
|
||||
@@ -34,7 +34,7 @@ let float_attr = fun xml a -> float_of_string (ExtXml.attrib xml a)
|
||||
let rec assoc_nocase at = function
|
||||
[] -> raise Not_found
|
||||
| (a, v)::avs ->
|
||||
if Compat.uppercase_ascii at = Compat.uppercase_ascii a then v else assoc_nocase at avs
|
||||
if String.uppercase_ascii at = String.uppercase_ascii a then v else assoc_nocase at avs
|
||||
|
||||
(** Returns the WGS84 coordinates of a waypoint, either from its relative x and
|
||||
y coordinates or from its lat and long *)
|
||||
@@ -203,7 +203,7 @@ let display_kml = fun ?group color geomap xml ->
|
||||
try
|
||||
let document = ExtXml.child xml "Document" in
|
||||
let rec loop = fun child ->
|
||||
let tag = Compat.lowercase_ascii (Xml.tag child) in
|
||||
let tag = String.lowercase_ascii (Xml.tag child) in
|
||||
match tag with
|
||||
| "linestring" | "linearring" ->
|
||||
let coordinates = ExtXml.child child "coordinates" in
|
||||
@@ -266,7 +266,7 @@ class flight_plan = fun ?format_attribs ?editable ~show_moved geomap color fp_dt
|
||||
let waypoints = ExtXml.child xml "waypoints" in
|
||||
try
|
||||
List.fold_left (fun l x ->
|
||||
match Compat.lowercase_ascii (Xml.tag x) with
|
||||
match String.lowercase_ascii (Xml.tag x) with
|
||||
"kml" ->
|
||||
let file = ExtXml.attrib x "file" in
|
||||
display_kml ~group:wpts_group#group color geomap (ExtXml.parse_file (Env.flight_plans_path // file));
|
||||
|
||||
@@ -151,7 +151,7 @@ type periodic = {
|
||||
let parse_periodic = fun xml ->
|
||||
let get = fun x -> ExtXml.attrib_opt xml x in
|
||||
let getf = fun x -> ExtXml.attrib_opt_float xml x in
|
||||
let call = snd (List.find (fun (a, _) -> Compat.lowercase_ascii a = "fun")
|
||||
let call = snd (List.find (fun (a, _) -> String.lowercase_ascii a = "fun")
|
||||
(Xml.attribs xml)) in
|
||||
let call_regexp = Str.regexp "\\([a-zA-Z_][a-zA-Z0-9_]*\\)\\(.*\\)" in
|
||||
let fname =
|
||||
|
||||
@@ -368,7 +368,7 @@ object (self)
|
||||
let (x, y) = item#xy in
|
||||
let attrs =
|
||||
[ "type", msg_obj#type_;
|
||||
"display", Compat.lowercase_ascii item#renderer#tag;
|
||||
"display", String.lowercase_ascii item#renderer#tag;
|
||||
"x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in
|
||||
Xml.Element ("papget", attrs, scale_prop::val_props@renderer_props)
|
||||
end
|
||||
@@ -387,7 +387,7 @@ object
|
||||
let (x, y) = item#xy in
|
||||
let attrs =
|
||||
[ "type", type_;
|
||||
"display", Compat.lowercase_ascii item#renderer#tag;
|
||||
"display", String.lowercase_ascii item#renderer#tag;
|
||||
"x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in
|
||||
Xml.Element ("papget", attrs, properties@props)
|
||||
end
|
||||
@@ -416,7 +416,7 @@ object (self)
|
||||
let (x, y) = item#xy in
|
||||
let attrs =
|
||||
[ "type", "video_plugin";
|
||||
"display", Compat.lowercase_ascii item#renderer#tag;
|
||||
"display", String.lowercase_ascii item#renderer#tag;
|
||||
"x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in
|
||||
Xml.Element ("papget", attrs, properties@props)
|
||||
initializer ignore(adj#connect#value_changed (fun () -> self#update_zoom (string_of_float adj#value)))
|
||||
|
||||
@@ -352,21 +352,21 @@ let set_attribs = fun ((model, path):node) attribs ->
|
||||
let rec replace_assoc a v = function
|
||||
[] -> [(a, v)]
|
||||
| (a', v')::l ->
|
||||
if a = Compat.uppercase_ascii a'
|
||||
if a = String.uppercase_ascii a'
|
||||
then (a, v)::l
|
||||
else (a', v')::replace_assoc a v l
|
||||
|
||||
let set_attrib = fun node (a, v) ->
|
||||
let atbs = attribs node in
|
||||
set_attribs node (replace_assoc (Compat.uppercase_ascii a) v atbs)
|
||||
set_attribs node (replace_assoc (String.uppercase_ascii a) v atbs)
|
||||
|
||||
let attrib = fun node at ->
|
||||
let at = Compat.uppercase_ascii at in
|
||||
let at = String.uppercase_ascii at in
|
||||
let ats = attribs node in
|
||||
let rec loop = function
|
||||
[] -> raise Not_found
|
||||
| (a,v)::avs ->
|
||||
if Compat.uppercase_ascii a = at then v else loop avs in
|
||||
if String.uppercase_ascii a = at then v else loop avs in
|
||||
loop ats
|
||||
|
||||
let tag = fun ((model, path):node) ->
|
||||
|
||||
@@ -165,7 +165,7 @@ let export_values = fun ?(sep="tab") ?(export_geo_pos=true) (model:GTree.tree_st
|
||||
|
||||
let lookup = fun m field ->
|
||||
try
|
||||
PprzLink.string_of_value (Hashtbl.find last_values (m,Compat.lowercase_ascii field))
|
||||
PprzLink.string_of_value (Hashtbl.find last_values (m,String.lowercase_ascii field))
|
||||
with
|
||||
Not_found -> "" in
|
||||
|
||||
|
||||
@@ -83,7 +83,7 @@ let parse_conf_xml = fun vbox ->
|
||||
let strings = ref [] in
|
||||
Hashtbl.iter (fun name _ac -> strings := name :: !strings) Utils.aircrafts;
|
||||
let compare_ignore_case = fun s1 s2 ->
|
||||
String.compare (Compat.lowercase_ascii s1) (Compat.lowercase_ascii s2) in
|
||||
String.compare (String.lowercase_ascii s1) (String.lowercase_ascii s2) in
|
||||
let ordered = List.sort compare_ignore_case ("" :: !strings) in
|
||||
Gtk_tools.combo ordered vbox
|
||||
|
||||
|
||||
@@ -84,7 +84,7 @@ module Gen_onboard = struct
|
||||
Printf.fprintf h "\n/* Messages IDs */\n";
|
||||
List.iter (fun msg ->
|
||||
if msg.id > !highest_id then highest_id := msg.id;
|
||||
Printf.fprintf h "#define ABI_%s_ID %d\n" (Compat.capitalize_ascii msg.name) msg.id
|
||||
Printf.fprintf h "#define ABI_%s_ID %d\n" (String.capitalize_ascii msg.name) msg.id
|
||||
) messages;
|
||||
!highest_id
|
||||
|
||||
@@ -109,14 +109,14 @@ module Gen_onboard = struct
|
||||
let print_callbacks = fun h messages ->
|
||||
Printf.fprintf h "\n/* Callbacks */\n";
|
||||
List.iter (fun msg ->
|
||||
Printf.fprintf h "typedef void (*abi_callback%s)" (Compat.capitalize_ascii msg.name);
|
||||
Printf.fprintf h "typedef void (*abi_callback%s)" (String.capitalize_ascii msg.name);
|
||||
print_args h msg.fields;
|
||||
Printf.fprintf h ";\n";
|
||||
) messages
|
||||
|
||||
(* Print a bind function *)
|
||||
let print_msg_bind = fun h msg ->
|
||||
let name = Compat.capitalize_ascii msg.name in
|
||||
let name = String.capitalize_ascii msg.name in
|
||||
Printf.fprintf h "\nstatic inline void AbiBindMsg%s(uint8_t sender_id, abi_event * ev, abi_callback%s cb) {\n" name name;
|
||||
Printf.fprintf h " if (abi_queues[ABI_%s_ID] == ev) return;\n" name;
|
||||
Printf.fprintf h " ev->id = sender_id;\n";
|
||||
@@ -133,7 +133,7 @@ module Gen_onboard = struct
|
||||
| [(n,_)] -> Printf.fprintf h ", %s);\n" n
|
||||
| (n,_)::l' -> Printf.fprintf h ", %s" n; args h l'
|
||||
in
|
||||
let name = Compat.capitalize_ascii msg.name in
|
||||
let name = String.capitalize_ascii msg.name in
|
||||
Printf.fprintf h "\nstatic inline void AbiSendMsg%s" name;
|
||||
print_args h msg.fields;
|
||||
Printf.fprintf h " {\n";
|
||||
|
||||
@@ -146,7 +146,7 @@ let parse_element = fun out prefix s ->
|
||||
|
||||
|
||||
let print_reverse_servo_table = fun out driver servos ->
|
||||
let d = match driver with "Default" -> "" | _ -> "_"^(Compat.uppercase_ascii driver) in
|
||||
let d = match driver with "Default" -> "" | _ -> "_"^(String.uppercase_ascii driver) in
|
||||
fprintf out "static inline int get_servo_min%s(int _idx) {\n" d;
|
||||
fprintf out " switch (_idx) {\n";
|
||||
List.iter (fun c ->
|
||||
@@ -316,8 +316,8 @@ let rec parse_section = fun out ac_id s ->
|
||||
let servos = Xml.children s in
|
||||
let nb_servos = List.fold_right (fun s m -> max (int_of_string (ExtXml.attrib s "no")) m) servos min_int + 1 in
|
||||
|
||||
define_out out (sprintf "SERVOS_%s_NB" (Compat.uppercase_ascii driver)) (string_of_int nb_servos);
|
||||
fprintf out "#include \"subsystems/actuators/actuators_%s.h\"\n" (Compat.lowercase_ascii driver);
|
||||
define_out out (sprintf "SERVOS_%s_NB" (String.uppercase_ascii driver)) (string_of_int nb_servos);
|
||||
fprintf out "#include \"subsystems/actuators/actuators_%s.h\"\n" (String.lowercase_ascii driver);
|
||||
fprintf out "\n";
|
||||
List.iter (parse_servo out driver) servos;
|
||||
print_reverse_servo_table out driver servos;
|
||||
|
||||
@@ -92,7 +92,7 @@ let print_includes = fun includes out_h ->
|
||||
) (Xml.children includes)
|
||||
|
||||
let print_mode_name = fun sm_name name ->
|
||||
String.concat "" [(Compat.uppercase_ascii sm_name); "_MODE_"; (Compat.uppercase_ascii name)]
|
||||
String.concat "" [(String.uppercase_ascii sm_name); "_MODE_"; (String.uppercase_ascii name)]
|
||||
|
||||
(** Define modes *)
|
||||
let print_modes = fun modes sm_name out_h ->
|
||||
@@ -339,7 +339,7 @@ let parse_and_gen_modes xml_file ap_name main_freq h_dir sm =
|
||||
try
|
||||
(* Get state machine name *)
|
||||
let name = Xml.attrib sm "name" in
|
||||
let name_up = Compat.uppercase_ascii name in
|
||||
let name_up = String.uppercase_ascii name in
|
||||
(* Generate start of header *)
|
||||
begin_out out_h xml_file ("AUTOPILOT_CORE_"^name_up^"_H");
|
||||
fprintf out_h "/*** %s ***/\n\n" ap_name;
|
||||
|
||||
@@ -243,7 +243,7 @@ let pprz_throttle = fun s ->
|
||||
let output_vmode = fun out stage_xml wp last_wp ->
|
||||
let pitch = try Xml.attrib stage_xml "pitch" with _ -> "0.0" in
|
||||
let t = ExtXml.attrib_or_default stage_xml "nav_type" "Nav" in
|
||||
if Compat.lowercase_ascii (Xml.tag stage_xml) <> "manual"
|
||||
if String.lowercase_ascii (Xml.tag stage_xml) <> "manual"
|
||||
then begin
|
||||
if pitch = "auto"
|
||||
then begin
|
||||
@@ -348,7 +348,7 @@ let rec index_stage = fun x ->
|
||||
end
|
||||
|
||||
|
||||
let inside_function = fun name -> "Inside" ^ Compat.capitalize_ascii name
|
||||
let inside_function = fun name -> "Inside" ^ String.capitalize_ascii name
|
||||
|
||||
(* pre call utility function *)
|
||||
let fp_pre_call = fun out x ->
|
||||
@@ -374,7 +374,7 @@ let stage_until = fun out x ->
|
||||
let rec print_stage = fun out index_of_waypoints x ->
|
||||
let stage out = incr stage; lprintf out "Stage(%d)\n" !stage; right () in
|
||||
begin
|
||||
match Compat.lowercase_ascii (Xml.tag x) with
|
||||
match String.lowercase_ascii (Xml.tag x) with
|
||||
| "return" ->
|
||||
stage out;
|
||||
lprintf out "Return(%s);\n" (ExtXml.attrib_or_default x "reset_stage" "0");
|
||||
@@ -593,9 +593,9 @@ let rec print_stage = fun out index_of_waypoints x ->
|
||||
let statement = ExtXml.attrib x "fun" in
|
||||
(* by default, function is called while returning TRUE *)
|
||||
(* otherwise, function is called once and returned value is ignored *)
|
||||
let loop = Compat.uppercase_ascii (ExtXml.attrib_or_default x "loop" "TRUE") in
|
||||
let loop = String.uppercase_ascii (ExtXml.attrib_or_default x "loop" "TRUE") in
|
||||
(* be default, go to next stage immediately *)
|
||||
let break = Compat.uppercase_ascii (ExtXml.attrib_or_default x "break" "FALSE") in
|
||||
let break = String.uppercase_ascii (ExtXml.attrib_or_default x "break" "FALSE") in
|
||||
begin match loop with
|
||||
| "TRUE" ->
|
||||
lprintf out "if (! (%s)) {\n" statement;
|
||||
@@ -628,7 +628,7 @@ let rec print_stage = fun out index_of_waypoints x ->
|
||||
stage out;
|
||||
let statement = ExtXml.attrib x "fun" in
|
||||
(* by default, go to next stage immediately *)
|
||||
let break = Compat.uppercase_ascii (ExtXml.attrib_or_default x "break" "FALSE") in
|
||||
let break = String.uppercase_ascii (ExtXml.attrib_or_default x "break" "FALSE") in
|
||||
lprintf out "%s;\n" statement;
|
||||
begin match break with
|
||||
| "TRUE" -> lprintf out "NextStageAndBreak();\n";
|
||||
@@ -812,7 +812,7 @@ let print_inside_polygon_global = fun out pts name ->
|
||||
|
||||
let print_inside_sector = fun out (s, pts) ->
|
||||
let (ids, _) = List.split pts in
|
||||
let name = "SECTOR_"^(Compat.uppercase_ascii s) in
|
||||
let name = "SECTOR_"^(String.uppercase_ascii s) in
|
||||
Xml2h.define_out out (name^"_NB") (string_of_int (List.length pts));
|
||||
Xml2h.define_out out name ("{ "^(String.concat ", " ids)^" }");
|
||||
lprintf out "static inline bool %s(float _x, float _y) {\n" (inside_function s);
|
||||
@@ -1090,7 +1090,7 @@ let print_flight_plan_h = fun xml ref0 xml_file out_file ->
|
||||
|
||||
(* print sectors *)
|
||||
let sectors_element = try ExtXml.child xml "sectors" with Not_found -> Xml.Element ("", [], []) in
|
||||
let sectors = List.filter (fun x -> Compat.lowercase_ascii (Xml.tag x) = "sector") (Xml.children sectors_element) in
|
||||
let sectors = List.filter (fun x -> String.lowercase_ascii (Xml.tag x) = "sector") (Xml.children sectors_element) in
|
||||
List.iter (fun x -> match ExtXml.attrib_opt x "type" with
|
||||
Some _ -> failwith "Error: attribute \"type\" on flight plan tag \"sector\" is deprecated and must be removed. All sectors are now dynamics.\n"
|
||||
| _ -> ()
|
||||
@@ -1174,7 +1174,7 @@ let generate = fun flight_plan ?(check=false) ?(dump=false) xml_file out_fp ->
|
||||
let waypoints = Xml.children (ExtXml.child xml "waypoints") in
|
||||
|
||||
let frame = ExtXml.attrib_or_default xml "wp_frame" "UTM" in
|
||||
let frame = match Compat.uppercase_ascii frame with
|
||||
let frame = match String.uppercase_ascii frame with
|
||||
| "UTM" -> UTM
|
||||
| "LTP" -> LTP
|
||||
| _ -> failwith ("Error: unkown wp_frame \"" ^ frame ^ "\". Use \"utm\" or \"ltp\"")
|
||||
|
||||
@@ -36,7 +36,7 @@ let (//) = Filename.concat
|
||||
|
||||
let configure2mk = fun ?(default_configure=false) f c ->
|
||||
(* all makefiles variables are forced to uppercase *)
|
||||
let name = Compat.uppercase_ascii c.Module.cname
|
||||
let name = String.uppercase_ascii c.Module.cname
|
||||
and value = get_string_opt c.Module.cvalue
|
||||
and default = get_string_opt c.Module.default
|
||||
and case = get_string_opt c.Module.case in
|
||||
@@ -109,7 +109,7 @@ let file2mk = fun f ?(arch = false) dir_name target file ->
|
||||
let module2mk = fun f target firmware m ->
|
||||
let name = m.Module.name in
|
||||
let dir = match m.Module.dir with Some d -> d | None -> name in
|
||||
let dir_name = Compat.uppercase_ascii dir ^ "_DIR" in
|
||||
let dir_name = String.uppercase_ascii dir ^ "_DIR" in
|
||||
(* iter makefile section *)
|
||||
List.iter (fun mk ->
|
||||
if Module.check_mk target firmware mk then begin
|
||||
@@ -131,7 +131,7 @@ let dump_target_conf = fun out target conf ->
|
||||
fprintf out "ifeq ($(TARGET), %s)\n\n" target;
|
||||
let dir_list = singletonize (List.fold_left (fun l (_, m) -> match m.Module.dir with
|
||||
| None -> m.Module.name::l | Some d -> d::l) [] conf.AC.modules) in
|
||||
List.iter (fun d -> fprintf out "%s_DIR = modules/%s\n" (Compat.uppercase_ascii d) d) dir_list;
|
||||
List.iter (fun d -> fprintf out "%s_DIR = modules/%s\n" (String.uppercase_ascii d) d) dir_list;
|
||||
List.iter (fun p ->
|
||||
fprintf out "VPATH += %s\n" p;
|
||||
fprintf out "$(TARGET).CFLAGS += -I%s/modules\n" p
|
||||
|
||||
@@ -74,7 +74,7 @@ let get_cap_name = fun f ->
|
||||
match name with
|
||||
| [Str.Text t]
|
||||
| [Str.Text t; Str.Delim "("; Str.Delim ")"]
|
||||
| [Str.Text t; Str.Delim "("; Str.Text _ ; Str.Delim ")"] -> Compat.uppercase_ascii t
|
||||
| [Str.Text t; Str.Delim "("; Str.Text _ ; Str.Delim ")"] -> String.uppercase_ascii t
|
||||
| _ -> failwith "Gen_modules: not a valid function name"
|
||||
|
||||
(** Computes the required modulos *)
|
||||
@@ -114,7 +114,7 @@ let print_function_freq = fun out modules ->
|
||||
fprintf out "\n";
|
||||
List.iter (fun m ->
|
||||
List.iter (fun i ->
|
||||
let fname = Compat.uppercase_ascii i.Module.fname in
|
||||
let fname = String.uppercase_ascii i.Module.fname in
|
||||
let p, f = get_period_and_freq i.Module.period_freq in
|
||||
lprintf out "#define %s_PERIOD %s\n" fname p;
|
||||
lprintf out "#define %s_FREQ %s\n" fname f;
|
||||
|
||||
@@ -108,7 +108,7 @@ let print_message_table = fun out_h xml ->
|
||||
let telemetry_types = Hashtbl.create 2 in
|
||||
(* For each process *)
|
||||
List.iter (fun process ->
|
||||
let telem_type = Compat.uppercase_ascii (ExtXml.attrib_or_default process "type" "pprz") in
|
||||
let telem_type = String.uppercase_ascii (ExtXml.attrib_or_default process "type" "pprz") in
|
||||
if not (Hashtbl.mem telemetry_types telem_type) then Hashtbl.add telemetry_types telem_type (Hashtbl.create 15);
|
||||
let messages = Hashtbl.find telemetry_types telem_type in
|
||||
(** For each mode of this process *)
|
||||
@@ -147,7 +147,7 @@ let print_process_send = fun out_h xml ->
|
||||
List.iteri
|
||||
(fun p_id process ->
|
||||
let process_name = ExtXml.attrib process "name" in
|
||||
let telem_type = Compat.uppercase_ascii (ExtXml.attrib_or_default process "type" "pprz") in
|
||||
let telem_type = String.uppercase_ascii (ExtXml.attrib_or_default process "type" "pprz") in
|
||||
let modes = Xml.children process in
|
||||
|
||||
fprintf out_h "\n/* Periodic telemetry (type %s): %s process */\n" telem_type process_name;
|
||||
@@ -168,14 +168,14 @@ let print_process_send = fun out_h xml ->
|
||||
) 0 modes in
|
||||
|
||||
fprintf out_h "\n/* Functions for %s process */\n" process_name;
|
||||
fprintf out_h "#ifdef PERIODIC_C_%s\n" (Compat.uppercase_ascii process_name);
|
||||
fprintf out_h "#ifndef TELEMETRY_MODE_%s\n" (Compat.uppercase_ascii process_name);
|
||||
fprintf out_h "#define TELEMETRY_MODE_%s 0\n" (Compat.uppercase_ascii process_name);
|
||||
fprintf out_h "#ifdef PERIODIC_C_%s\n" (String.uppercase_ascii process_name);
|
||||
fprintf out_h "#ifndef TELEMETRY_MODE_%s\n" (String.uppercase_ascii process_name);
|
||||
fprintf out_h "#define TELEMETRY_MODE_%s 0\n" (String.uppercase_ascii process_name);
|
||||
fprintf out_h "#endif\n";
|
||||
fprintf out_h "uint8_t telemetry_mode_%s = TELEMETRY_MODE_%s;\n" process_name (Compat.uppercase_ascii process_name);
|
||||
fprintf out_h "#else /* PERIODIC_C_%s not defined (general header) */\n" (Compat.uppercase_ascii process_name);
|
||||
fprintf out_h "uint8_t telemetry_mode_%s = TELEMETRY_MODE_%s;\n" process_name (String.uppercase_ascii process_name);
|
||||
fprintf out_h "#else /* PERIODIC_C_%s not defined (general header) */\n" (String.uppercase_ascii process_name);
|
||||
fprintf out_h "extern uint8_t telemetry_mode_%s;\n" process_name;
|
||||
fprintf out_h "#endif /* PERIODIC_C_%s */\n" (Compat.uppercase_ascii process_name);
|
||||
fprintf out_h "#endif /* PERIODIC_C_%s */\n" (String.uppercase_ascii process_name);
|
||||
|
||||
lprintf out_h "static inline void periodic_telemetry_send_%s(struct periodic_telemetry *telemetry, struct transport_tx *trans, struct link_device *dev) {\n" process_name;
|
||||
right ();
|
||||
|
||||
@@ -112,7 +112,7 @@ let parse_message = fun class_name m ->
|
||||
|
||||
(** Generating send function *)
|
||||
let param_type = fun f -> c_type (format f) in
|
||||
let param_name = fun f ->Compat.lowercase_ascii (field_name f) in
|
||||
let param_name = fun f ->String.lowercase_ascii (field_name f) in
|
||||
let param_name_and_type = fun f ->
|
||||
sprintf "%s ubx_%s" (param_type f) (param_name f) in
|
||||
let rec param_names = fun f r ->
|
||||
|
||||
@@ -111,7 +111,7 @@ let parse_message = fun m ->
|
||||
|
||||
(** Generating send function *)
|
||||
let gen_send_macro = fun _ ->
|
||||
let param_name = fun f -> Compat.lowercase_ascii (field_name f) in
|
||||
let param_name = fun f -> String.lowercase_ascii (field_name f) in
|
||||
let rec param_names = fun f r ->
|
||||
if Xml.tag f = "field" then
|
||||
param_name f :: r
|
||||
|
||||
Reference in New Issue
Block a user