bug fixed in exceptions appearing in procedures

This commit is contained in:
Pascal Brisset
2006-06-21 08:25:52 +00:00
parent 1440e578e4
commit 0c7dfff6c3
3 changed files with 20 additions and 22 deletions

View File

@@ -75,7 +75,7 @@ $(FLIGHT_PLAN_H) : $(CONF)/$(FLIGHT_PLAN) $(CONF_XML) $(TOOLS)/gen_flight_plan.o
$(Q)$(TOOLS)/gen_flight_plan.out $< > /tmp/fp.h
$(Q)mv /tmp/fp.h $@
$(FLIGHT_PLAN_XML) : $(CONF)/$(FLIGHT_PLAN) $(CONF_XML)
$(FLIGHT_PLAN_XML) : $(CONF)/$(FLIGHT_PLAN) $(CONF_XML) $(TOOLS)/gen_flight_plan.out
@echo BUILD $@
$(Q)$(TOOLS)/gen_flight_plan.out -dump $< > /tmp/fp.xml
$(Q)mv /tmp/fp.xml $@

View File

@@ -33,12 +33,6 @@
<arg name="kill_pitch" value="-0.5"/>
</include>
<exceptions>
<exception cond="And(block_time>20, dist2_to_home > 500*500)" deroute="home"/>
<exception cond="And(block_time>20, dist2_to_home > 600*600)" deroute="kill"/>
<exception cond="And(launch, gps_lost)" deroute="kill"/>
</exceptions>
<blocks>
<block NAME="wait GPS">
<while COND="!GPS_FIX_VALID(gps_mode)"/>
@@ -61,14 +55,5 @@
<block NAME="survey">
<survey_rectangle grid="70" wp1="S1" wp2="S2"/>
</block>
<block name="home">
<circle wp="HOME" radius="50"/>
</block>
<block name="kill">
<go wp="HOME" vmode="gaz" gaz="0" pitch="-0.5"/>
</block>
</blocks>
</flight_plan>

View File

@@ -114,6 +114,7 @@ let transform_values = fun attribs_not_modified affine env attribs ->
(a, v'))
attribs
let transform_waypoint = fun prefix affine xml ->
let x = ExtXml.float_attrib xml "x"
and y = ExtXml.float_attrib xml "y" in
@@ -145,6 +146,17 @@ let prefix_or_deroute = fun prefix reroutes name attribs ->
(a, v'))
attribs
let transform_exception = fun prefix reroutes affine env xml ->
match xml with
Xml.Element (tag, attribs, children) ->
assert (children=[]);
let attribs = prefix_or_deroute prefix reroutes "deroute" attribs in
let attribs = transform_values [] affine env attribs in
Xml.Element (tag, attribs, children)
| _ -> failwith "transform_exception"
let transform_attribs = fun affine attribs ->
List.map
(fun (a, v) ->
@@ -162,10 +174,7 @@ let transform_stage = fun prefix reroutes affine env xml ->
Xml.Element (tag, attribs, children) -> begin
match tag with
"exception" ->
assert (children=[]);
let attribs = prefix_or_deroute prefix reroutes "deroute" attribs in
let attribs = transform_values [] affine env attribs in
Xml.Element (tag, attribs, children)
transform_exception prefix reroutes affine env xml
| "while" ->
let attribs = transform_values [] affine env attribs in
Xml.Element (tag, attribs, List.map tr children)
@@ -258,8 +267,9 @@ let parse_include = fun dir include_xml ->
and exceptions = Xml.children (ExtXml.child proc "exceptions")
and blocks = Xml.children (ExtXml.child proc "blocks") in
let waypoints = List.map (transform_waypoint prefix affine) waypoints in
let blocks = List.map (transform_block prefix reroutes affine env) blocks in
let waypoints = List.map (transform_waypoint prefix affine) waypoints
and exceptions = List.map (transform_exception prefix reroutes affine env) exceptions
and blocks = List.map (transform_block prefix reroutes affine env) blocks in
(waypoints, exceptions, blocks)
with
Dtd.Prove_error e -> dtd_error f (Dtd.prove_error e)
@@ -304,6 +314,9 @@ let process_includes = fun dir xml ->
and inc_exceptions = List.flatten inc_exceptions
and inc_blocks = List.flatten inc_blocks in
(* FIXME (exceptions seciton is not mandatory) *)
let children = children @ [Xml.Element ("exceptions",[],[])] in
let new_children = insert_children children
["waypoints", inc_waypoints;
"exceptions", inc_exceptions;