Fixes for RISC evaluation
This commit is contained in:
@ -20,6 +20,7 @@ end
|
||||
module NodeMap = struct
|
||||
include Map.Make(Node)
|
||||
|
||||
(* adds the input to the tail of the list for the associated node *)
|
||||
let add_to_list_last x data m =
|
||||
let add = function None -> Some [data]
|
||||
| Some l -> Some (l @ [data]) in
|
||||
@ -80,12 +81,14 @@ module Make (M: PrintableType) = struct
|
||||
nodes = NodeSet.union cfg1.nodes cfg2.nodes |>
|
||||
NodeSet.add entryNode |>
|
||||
NodeSet.add exitNode;
|
||||
edges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
|
||||
edges = NodeMap.union
|
||||
(fun _ -> failwith "Failed merging edges of cfg.")
|
||||
cfg1.edges cfg2.edges |>
|
||||
NodeMap.add entryNode (cfg1initial, Some cfg2initial) |>
|
||||
NodeMap.add cfg1terminal (exitNode, None) |>
|
||||
NodeMap.add cfg2terminal (exitNode, None);
|
||||
reverseEdges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
|
||||
reverseEdges = NodeMap.union
|
||||
(fun _ -> failwith "Failed merging edges of cfg.")
|
||||
cfg1.reverseEdges cfg2.reverseEdges |>
|
||||
NodeMap.add_to_list cfg1initial entryNode |>
|
||||
NodeMap.add_to_list cfg2initial entryNode |>
|
||||
@ -95,7 +98,8 @@ module Make (M: PrintableType) = struct
|
||||
inputOutputVar = cfg1.inputOutputVar;
|
||||
initial = Some entryNode;
|
||||
terminal = Some exitNode;
|
||||
content = NodeMap.union (fun _ -> failwith "Failed merging code of cfg.")
|
||||
content = NodeMap.union
|
||||
(fun _ -> failwith "Failed merging code of cfg.")
|
||||
cfg1.content cfg2.content
|
||||
}
|
||||
|
||||
@ -110,17 +114,20 @@ module Make (M: PrintableType) = struct
|
||||
let cfg2terminal = Option.get cfg2.terminal in
|
||||
{ empty = false;
|
||||
nodes = NodeSet.union cfg1.nodes cfg2.nodes;
|
||||
edges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
|
||||
cfg1.edges cfg2.edges |>
|
||||
edges = NodeMap.union
|
||||
(fun _ -> failwith "Failed merging edges of cfg.")
|
||||
cfg1.edges cfg2.edges |>
|
||||
NodeMap.add cfg1terminal (cfg2initial, None);
|
||||
reverseEdges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
|
||||
reverseEdges = NodeMap.union
|
||||
(fun _ -> failwith "Failed merging edges of cfg.")
|
||||
cfg1.reverseEdges cfg2.reverseEdges |>
|
||||
NodeMap.add_to_list cfg2initial cfg1terminal;
|
||||
inputVal = cfg1.inputVal;
|
||||
inputOutputVar = cfg1.inputOutputVar;
|
||||
initial = Some cfg1initial;
|
||||
terminal = Some cfg2terminal;
|
||||
content = NodeMap.union (fun _ -> failwith "Failed merging code of cfg.")
|
||||
content = NodeMap.union
|
||||
(fun _ -> failwith "Failed merging code of cfg.")
|
||||
cfg1.content cfg2.content
|
||||
}
|
||||
|
||||
@ -147,14 +154,18 @@ module Make (M: PrintableType) = struct
|
||||
|
||||
let pp (ppf) (c: t) : unit =
|
||||
Printf.fprintf ppf "Nodes' ids: ";
|
||||
List.iter (fun (x : Node.t) -> Printf.fprintf ppf "%d " x.id) (NodeSet.to_list c.nodes);
|
||||
List.iter
|
||||
(fun (x : Node.t) -> Printf.fprintf ppf "%d " x.id)
|
||||
(NodeSet.to_list c.nodes);
|
||||
Printf.fprintf ppf "\n";
|
||||
|
||||
Printf.fprintf ppf "Nodes' edges:\n";
|
||||
List.iter (fun ((n, (a, b)) : (Node.t * (Node.t * Node.t option))) : unit ->
|
||||
match b with None -> Printf.fprintf ppf "\t%d -> %d\n" n.id a.id
|
||||
| Some b -> Printf.fprintf ppf "\t%d -> %d, %d\n" n.id a.id b.id
|
||||
) (NodeMap.to_list c.edges);
|
||||
List.iter
|
||||
(fun ((n, (a, b)) : (Node.t * (Node.t * Node.t option))) : unit ->
|
||||
match b with
|
||||
None -> Printf.fprintf ppf "\t%d -> %d\n" n.id a.id
|
||||
| Some b -> Printf.fprintf ppf "\t%d -> %d, %d\n" n.id a.id b.id )
|
||||
(NodeMap.to_list c.edges);
|
||||
Printf.fprintf ppf "\n";
|
||||
|
||||
Printf.fprintf ppf "Nodes' back edges:\n";
|
||||
|
||||
@ -18,7 +18,11 @@ module type C = sig
|
||||
val from_cfg : cfgt -> t
|
||||
val to_cfg : t -> cfgt
|
||||
|
||||
val fixed_point : ?init:(elt list -> internalnode) -> ?update:(t -> Cfg.Node.t -> internalnode) -> t -> t
|
||||
val fixed_point :
|
||||
?init:(elt list -> internalnode) ->
|
||||
?update:(t -> Cfg.Node.t -> internalnode) ->
|
||||
t ->
|
||||
t
|
||||
|
||||
val pp : out_channel -> t -> unit
|
||||
end
|
||||
|
||||
Reference in New Issue
Block a user