furnace/extern/fftw/genfft/dag.ml

110 lines
3.3 KiB
OCaml
Raw Normal View History

(*
* Copyright (c) 1997-1999 Massachusetts Institute of Technology
* Copyright (c) 2003, 2007-14 Matteo Frigo
* Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*
*)
open Util
(* Here, we have functions to transform a sequence of assignments
(variable = expression) into a DAG (a directed, acyclic graph).
The nodes of the DAG are the assignments, and the edges indicate
dependencies. (The DAG is analyzed in the scheduler to find an
efficient ordering of the assignments.)
This file also contains utilities to manipulate the DAG in various
ways. *)
(********************************************
* Dag structure
********************************************)
type color = RED | BLUE | BLACK | YELLOW
type dagnode =
{ assigned: Variable.variable;
mutable expression: Expr.expr;
input_variables: Variable.variable list;
mutable successors: dagnode list;
mutable predecessors: dagnode list;
mutable label: int;
mutable color: color}
type dag = Dag of (dagnode list)
(* true if node uses v *)
let node_uses v node =
List.exists (Variable.same v) node.input_variables
(* true if assignment of v clobbers any input of node *)
let node_clobbers node v =
List.exists (Variable.same_location v) node.input_variables
(* true if nodeb depends on nodea *)
let depends_on nodea nodeb =
node_uses nodea.assigned nodeb ||
node_clobbers nodea nodeb.assigned
(* transform an assignment list into a dag *)
let makedag alist =
let dag = List.map
(fun assignment ->
let (v, x) = assignment in
{ assigned = v;
expression = x;
input_variables = Expr.find_vars x;
successors = [];
predecessors = [];
label = 0;
color = BLACK })
alist
in begin
for_list dag (fun i ->
for_list dag (fun j ->
if depends_on i j then begin
i.successors <- j :: i.successors;
j.predecessors <- i :: j.predecessors;
end));
Dag dag;
end
let map f (Dag dag) = Dag (List.map f dag)
let for_all (Dag dag) f =
(* type system loophole *)
let make_unit _ = () in
make_unit (List.map f dag)
let to_list (Dag dag) = dag
let find_node f (Dag dag) = Util.find_elem f dag
(* breadth-first search *)
let rec bfs (Dag dag) node init_label =
let _ = node.label <- init_label in
let rec loop = function
[] -> ()
| node :: rest ->
let neighbors = node.predecessors @ node.successors in
let m = min_list (List.map (fun node -> node.label) neighbors) in
if (node.label > m + 1) then begin
node.label <- m + 1;
loop (rest @ neighbors);
end else
loop rest
in let neighbors = node.predecessors @ node.successors in
loop neighbors