annotate src/fftw-3.3.5/genfft/dag.ml @ 83:ae30d91d2ffe

Replace these with versions built using an older toolset (so as to avoid ABI compatibilities when linking on Ubuntu 14.04 for packaging purposes)
author Chris Cannam
date Fri, 07 Feb 2020 11:51:13 +0000
parents 2cd0e3b3e1fd
children
rev   line source
Chris@42 1 (*
Chris@42 2 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
Chris@42 3 * Copyright (c) 2003, 2007-14 Matteo Frigo
Chris@42 4 * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
Chris@42 5 *
Chris@42 6 * This program is free software; you can redistribute it and/or modify
Chris@42 7 * it under the terms of the GNU General Public License as published by
Chris@42 8 * the Free Software Foundation; either version 2 of the License, or
Chris@42 9 * (at your option) any later version.
Chris@42 10 *
Chris@42 11 * This program is distributed in the hope that it will be useful,
Chris@42 12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
Chris@42 13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
Chris@42 14 * GNU General Public License for more details.
Chris@42 15 *
Chris@42 16 * You should have received a copy of the GNU General Public License
Chris@42 17 * along with this program; if not, write to the Free Software
Chris@42 18 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
Chris@42 19 *
Chris@42 20 *)
Chris@42 21
Chris@42 22 open Util
Chris@42 23
Chris@42 24 (* Here, we have functions to transform a sequence of assignments
Chris@42 25 (variable = expression) into a DAG (a directed, acyclic graph).
Chris@42 26 The nodes of the DAG are the assignments, and the edges indicate
Chris@42 27 dependencies. (The DAG is analyzed in the scheduler to find an
Chris@42 28 efficient ordering of the assignments.)
Chris@42 29
Chris@42 30 This file also contains utilities to manipulate the DAG in various
Chris@42 31 ways. *)
Chris@42 32
Chris@42 33 (********************************************
Chris@42 34 * Dag structure
Chris@42 35 ********************************************)
Chris@42 36 type color = RED | BLUE | BLACK | YELLOW
Chris@42 37
Chris@42 38 type dagnode =
Chris@42 39 { assigned: Variable.variable;
Chris@42 40 mutable expression: Expr.expr;
Chris@42 41 input_variables: Variable.variable list;
Chris@42 42 mutable successors: dagnode list;
Chris@42 43 mutable predecessors: dagnode list;
Chris@42 44 mutable label: int;
Chris@42 45 mutable color: color}
Chris@42 46
Chris@42 47 type dag = Dag of (dagnode list)
Chris@42 48
Chris@42 49 (* true if node uses v *)
Chris@42 50 let node_uses v node =
Chris@42 51 List.exists (Variable.same v) node.input_variables
Chris@42 52
Chris@42 53 (* true if assignment of v clobbers any input of node *)
Chris@42 54 let node_clobbers node v =
Chris@42 55 List.exists (Variable.same_location v) node.input_variables
Chris@42 56
Chris@42 57 (* true if nodeb depends on nodea *)
Chris@42 58 let depends_on nodea nodeb =
Chris@42 59 node_uses nodea.assigned nodeb ||
Chris@42 60 node_clobbers nodea nodeb.assigned
Chris@42 61
Chris@42 62 (* transform an assignment list into a dag *)
Chris@42 63 let makedag alist =
Chris@42 64 let dag = List.map
Chris@42 65 (fun assignment ->
Chris@42 66 let (v, x) = assignment in
Chris@42 67 { assigned = v;
Chris@42 68 expression = x;
Chris@42 69 input_variables = Expr.find_vars x;
Chris@42 70 successors = [];
Chris@42 71 predecessors = [];
Chris@42 72 label = 0;
Chris@42 73 color = BLACK })
Chris@42 74 alist
Chris@42 75 in begin
Chris@42 76 for_list dag (fun i ->
Chris@42 77 for_list dag (fun j ->
Chris@42 78 if depends_on i j then begin
Chris@42 79 i.successors <- j :: i.successors;
Chris@42 80 j.predecessors <- i :: j.predecessors;
Chris@42 81 end));
Chris@42 82 Dag dag;
Chris@42 83 end
Chris@42 84
Chris@42 85 let map f (Dag dag) = Dag (List.map f dag)
Chris@42 86 let for_all (Dag dag) f =
Chris@42 87 (* type system loophole *)
Chris@42 88 let make_unit _ = () in
Chris@42 89 make_unit (List.map f dag)
Chris@42 90 let to_list (Dag dag) = dag
Chris@42 91
Chris@42 92 let find_node f (Dag dag) = Util.find_elem f dag
Chris@42 93
Chris@42 94 (* breadth-first search *)
Chris@42 95 let rec bfs (Dag dag) node init_label =
Chris@42 96 let _ = node.label <- init_label in
Chris@42 97 let rec loop = function
Chris@42 98 [] -> ()
Chris@42 99 | node :: rest ->
Chris@42 100 let neighbors = node.predecessors @ node.successors in
Chris@42 101 let m = min_list (List.map (fun node -> node.label) neighbors) in
Chris@42 102 if (node.label > m + 1) then begin
Chris@42 103 node.label <- m + 1;
Chris@42 104 loop (rest @ neighbors);
Chris@42 105 end else
Chris@42 106 loop rest
Chris@42 107 in let neighbors = node.predecessors @ node.successors in
Chris@42 108 loop neighbors
Chris@42 109