let apply_fct_action proj fct_crit =
match fct_crit.T.cf_fct with
| T.FctSliced ff ->
let _ = M.get_ff_pdg ff in
let new_filters =
match fct_crit.T.cf_info with
| T.CcUserMark (T.CuSelect crit) -> apply_fct_crit ff crit
| T.CcUserMark (T.CuTop _) -> assert false
| T.CcChangeCall (call, f) ->
Fct_slice.apply_change_call proj ff call f
| T.CcChooseCall call ->
Fct_slice.apply_choose_call proj ff call
| T.CcMissingInputs (call, input_marks, more_inputs) ->
Fct_slice.apply_missing_inputs proj ff call
(input_marks, more_inputs)
| T.CcMissingOutputs (call, output_marks, more_outputs) ->
Fct_slice.apply_missing_outputs proj ff call
output_marks more_outputs
| T.CcPropagate _ -> assert false
| T.CcExamineCalls marks ->
Fct_slice.apply_examine_calls ff marks
in
SlicingParameters.debug ~level:4 "[slicingProject.apply_fct_action] result =@\n%a"
PrintSlice.print_marked_ff ff;
new_filters
| T.FctSrc fi ->
let propagate = SlicingParameters.Mode.Callers.get () in
match fct_crit.T.cf_info with
| T.CcUserMark (T.CuSelect to_select) ->
add_persistante_marks proj fi to_select true propagate []
| T.CcUserMark (T.CuTop m) ->
SlicingParameters.result ~level:1 "unable to slice %s (-> TOP)"
(M.fi_name fi);
let filters = call_src_and_remove_all_ff proj fi in
Fct_slice.add_top_mark_to_fi fi m propagate filters
| T.CcPropagate node_marks ->
add_persistante_marks proj fi node_marks false propagate []
| T.CcExamineCalls _
| _ ->
Extlib.not_yet_implemented
"This slicing criterion on source function"