comparison src/fftw-3.3.5/genfft/dag.ml @ 42:2cd0e3b3e1fd

Current fftw source

+(*
+ * 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
+