(* * Copyright (c) 1997-1999, 2003 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * *) (* $Id: dag.ml,v 1.17 2003/03/16 23:43:46 stevenj Exp $ *) 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.clobbers v) node.input_variables (* true if nodeb depends on nodea *) let depends_on nodea nodeb = node_uses nodea.assigned nodeb or 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