let slicing_highlighter
(buffer:GSourceView.source_buffer) localizable ~start ~stop =
if Enable.get () then begin
let highlight project =
let ki = match localizable with
| Pretty_source.PStmt (_,stmt)
| Pretty_source.PCodeAnnot (_,stmt,_) -> Kstmt stmt
| Pretty_source.PLval (_,ki,_) | Pretty_source.PTermLval(_,ki,_) -> ki
| Pretty_source.PVDecl _ | Pretty_source.PGlobal _ -> Kglobal
in
if Db.Value.is_accessible ki then
let unused_code_area =
Gtk_helper.make_tag buffer ~name:"slicing_unused" [`STRIKETHROUGH true ] in
let spare_code_area =
Gtk_helper.make_tag buffer ~name:"slicing_spare" [`UNDERLINE `LOW] in
let necessary_code_area =
Gtk_helper.make_tag buffer ~name:"slicing_necessary" [`BACKGROUND "green"] in
let apply_on_one_project_and_merge_slices kf pb pe mark_of_slice =
let apply_mark mark =
if SlicingParameters.debug_atleast 1 then
SlicingParameters.debug "Got mark: %a" !Db.Slicing.Mark.pretty mark;
if !Db.Slicing.Mark.is_bottom mark then
Gtk_helper.apply_tag buffer unused_code_area pb pe;
if !Db.Slicing.Mark.is_spare mark then
Gtk_helper.apply_tag buffer spare_code_area pb pe;
if (!Db.Slicing.Mark.is_ctrl mark
|| !Db.Slicing.Mark.is_data mark
|| !Db.Slicing.Mark.is_addr mark)
then
Gtk_helper.apply_tag buffer necessary_code_area pb pe
in
let slices = !Db.Slicing.Slice.get_all project kf in
begin
match slices with
| [] ->
if !Db.Slicing.Project.is_called project kf
then begin
SlicingParameters.debug "Got source code@." ;
apply_mark (!Db.Slicing.Mark.get_from_src_func project kf)
end
else
Gtk_helper.apply_tag buffer unused_code_area pb pe
| slices ->
if !Db.Slicing.Project.is_called project kf
then begin
assert (not (kf == fst (Globals.entry_point ()))) ;
SlicingParameters.debug "Got source code" ;
apply_mark (!Db.Slicing.Mark.get_from_src_func project kf)
end ;
if SlicingParameters.debug_atleast 1 then begin
let l = List.length slices in
if l >=2 then
SlicingParameters.debug "Got %d slices" (List.length slices)
end;
let mark_slice slice =
let mark = mark_of_slice project slice in
apply_mark mark
in List.iter mark_slice slices
end
in
let tag_stmt kf stmt pb pe =
assert (Db.Value.is_accessible (Kstmt stmt)) ;
apply_on_one_project_and_merge_slices
kf
pb
pe
(fun _ slice -> !Db.Slicing.Slice.get_mark_from_stmt slice stmt)
in
let tag_vdecl kf vi pb pe =
if not vi.vglob then
apply_on_one_project_and_merge_slices
kf
pb
pe
(fun _ slice -> !Db.Slicing.Slice.get_mark_from_local_var slice vi)
in
match localizable with
| Pretty_source.PStmt (kf,stmt) -> tag_stmt kf stmt start stop
| Pretty_source.PVDecl (Some kf,vi) -> tag_vdecl kf vi start stop
| Pretty_source.PVDecl (None,_)
| Pretty_source.PLval _
| Pretty_source.PCodeAnnot _
| Pretty_source.PTermLval _
| Pretty_source.PGlobal _ -> ()
in
let slicing_project = !Db.Slicing.Project.get_project () in
Extlib.may highlight slicing_project
end