CristalCaveGem » LustreC

(********************************************************************)

(*                                                                  *)

(*  The LustreC compiler toolset   /  The LustreC Development Team  *)

(*  Copyright 2012 -    --   ONERA - CNRS - INPT                    *)

(*                                                                  *)

(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)

(*  under the terms of the GNU Lesser General Public License        *)

(*  version 2.1.                                                    *)

(*                                                                  *)

(********************************************************************)

open Lustre_types

open Utils

let get_node nid prog =

  List.find

    (fun t ->

      match t.top_decl_desc with Node n -> n.node_id = nid | _ -> false)

    prog

let check_external_defs x not_nodes = true

(* TODO, check whether a node, a function or an include defines this node *)

let sort prog =

  let not_nodes, nodes =

    List.partition

      (fun top -> match top.top_decl_desc with Node _ -> false | _ -> true)

      prog

  in

  let sorted =

    try

      let g = Causality.NodeDep.dependence_graph nodes in

      Causality.CycleDetection.check_cycles g;

      TopologicalDepGraph.fold

        (fun x accu ->

          try get_node x nodes :: accu

          with Not_found ->

            (* check whether it is an imported node, a function or in the

               includes *)

            if check_external_defs x not_nodes then accu

            else (

              Format.eprintf "Impossible to find node %s@.@?" x;

              failwith x))

        g []

    with Causality.Error err as exc ->

      Causality.pp_error Format.err_formatter err;

      raise exc

  in

  Log.report ~level:3 (fun fmt ->

      Format.fprintf fmt "@ @[<v 2>.. ordered list of declarations:@ %a@]@ "

        (Utils.fprintf_list ~sep:"@ " Printers.pp_short_decl)

        sorted);

  not_nodes @ sorted

let sort_node_locals nd =

  { nd with node_locals = Causality.VarClockDep.sort nd.node_locals }

let sort_nodes_locals prog =

  List.map

    (fun top ->

      match top.top_decl_desc with

      | Node nd ->

        { top with top_decl_desc = Node (sort_node_locals nd) }

      | _ ->

        top)

    prog

(* Local Variables: *)

(* compile-command:"make -C .." *)

(* End: *)