@@ -458,7 +458,7 @@ module FromSpec (S:Spec) (Cfg:CfgBackward) (I: Increment)
458458 and module GVar = GVarF (S. V )
459459 and module D = S. D
460460 and module G = GVarG (S. G ) (S. C )
461- val tf : MyCFG .node * S .C .t -> (Cil .location * MyCFG .edge ) list * MyCFG .node -> D .t -> ((MyCFG .node * S .C .t) -> S .D .t) -> (MyCFG .node * S .C .t -> S .D .t -> unit ) -> (GVar .t -> G .t ) -> (GVar .t -> G .t -> unit ) -> D .t
461+ val tf : MyCFG .node * S .C .t -> (Cil .location * MyCFG .edge ) list * MyCFG .node -> ((MyCFG .node * S .C .t) -> S .D .t) -> (MyCFG .node * S .C .t -> S .D .t -> unit ) -> (GVar .t -> G .t ) -> (GVar .t -> G .t -> unit ) -> D .t
462462 end
463463=
464464struct
@@ -705,12 +705,12 @@ struct
705705 d
706706 )
707707
708- let tf (v ,c ) (edges , u ) pval getl sidel getg sideg =
709- (* let pval = getl (u,c) in *)
708+ let tf (v ,c ) (edges , u ) getl sidel getg sideg =
709+ let pval = getl (u,c) in
710710 let _, locs = List. fold_right (fun (f ,e ) (t ,xs ) -> f, (f,t)::xs) edges (Node. location v,[] ) in
711711 List. fold_left2 (|> ) pval (List. map (tf (v,Obj. repr (fun () -> c)) getl sidel getg sideg u) edges) locs
712712
713- let tf (v ,c ) (e ,u ) pval getl sidel getg sideg =
713+ let tf (v ,c ) (e ,u ) getl sidel getg sideg =
714714 let old_node = ! current_node in
715715 let old_context = ! M. current_context in
716716 current_node := Some u;
@@ -719,7 +719,7 @@ struct
719719 current_node := old_node;
720720 M. current_context := old_context
721721 ) (fun () ->
722- let d = tf (v,c) (e,u) pval getl sidel getg sideg in
722+ let d = tf (v,c) (e,u) getl sidel getg sideg in
723723 d
724724 )
725725
@@ -729,30 +729,25 @@ struct
729729 None
730730 | _ ->
731731 let tf getl sidel getg sideg =
732- let get_pval (_ , u ) = getl (u, c) in
733- let tf' eu pval = tf (v,c) eu pval getl sidel getg sideg in
732+ let tf' eu = tf (v,c) eu getl sidel getg sideg in
734733
735734 match NodeH. find_option CfgTools. node_scc_global v with
736735 | Some scc when NodeH. mem scc.prev v && NodeH. length scc.prev = 1 ->
737736 (* Limited to loops with only one entry node. Otherwise unsound as is. *)
738737 (* TODO: Is it possible to do soundly for multi-entry loops? *)
739738 let stricts = NodeH. find_default scc.prev v [] in
740- let pvals_stricts = List. map get_pval stricts in (* get pvals before executing any tf to maximize abort *)
741- let xs_stricts = List. map2 tf' stricts pvals_stricts in
739+ let xs_stricts = List. map tf' stricts in
742740 if List. for_all S.D. is_bot xs_stricts then
743741 S.D. bot ()
744742 else
745743 let xs_strict = List. fold_left S.D. join (S.D. bot () ) xs_stricts in
746744 let equal = [% eq: (CilType.Location. t * Edge. t) list * Node. t] in
747745 let is_strict eu = List. exists (equal eu) stricts in
748746 let non_stricts = List. filter (neg is_strict) (Cfg. prev v) in
749- let pvals_non_stricts = List. map get_pval non_stricts in (* get pvals before executing any tf to maximize abort *)
750- let xs_non_stricts = List. map2 tf' non_stricts pvals_non_stricts in
747+ let xs_non_stricts = List. map tf' non_stricts in
751748 List. fold_left S.D. join xs_strict xs_non_stricts
752749 | _ ->
753- let prevs = Cfg. prev v in
754- let pvals = List. map get_pval prevs in (* get pvals before executing any tf to maximize abort *)
755- let xs = List. map2 tf' prevs pvals in
750+ let xs = List. map tf' (Cfg. prev v) in
756751 List. fold_left S.D. join (S.D. bot () ) xs
757752 in
758753 Some tf
0 commit comments