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 Utils

open Format

open Lustre_types

(* XXX: UNUSED *)

(* let pp_dep fmt dep =

 *   fprintf fmt "%b, %s, {%a}, %b" dep.local dep.name Printers.pp_prog

 *     dep.content dep.is_stateful

 *

 * let pp_deps fmt deps =

 *   fprintf fmt "@[<v 0>%a@ @]" (pp_comma_list pp_dep) deps *)

let header_has_code header =

  List.exists

    (fun top ->

      match top.top_decl_desc with

      | Const _ ->

        true

      | ImportedNode nd ->

        nd.nodei_in_lib = []

      | _ ->

        false)

    header

let header_libs header =

  List.fold_left

    (fun accu top ->

      match top.top_decl_desc with

      | ImportedNode nd ->

        Utils.list_union nd.nodei_in_lib accu

      | _ ->

        accu)

    []

    header

let compiled_dependencies deps =

  List.filter (fun dep -> header_has_code dep.content) deps

let lib_dependencies deps =

  List.fold_left

    (fun accu dep -> Utils.list_union (header_libs dep.content) accu)

    []

    deps

let fprintf_dependencies arrow_suffix fmt deps =

  (* eprintf "Deps: %a@." pp_deps dep; *)

  let compiled_deps = compiled_dependencies deps in

  (* eprintf "Compiled Deps: %a@." pp_deps compiled_dep; *)

  List.iter

    (fun s ->

      Log.report ~level:1 (fun fmt -> fprintf fmt "Adding dependency: %s@." s);

      fprintf fmt "\t${GCC} -I${INC} -c %s@." s)

    ("${INC}/io_frontend.c"

    :: sprintf "${INC}/arrow%s.c" arrow_suffix

    :: (* IO functions when a main function is computed *)

       List.map

         (fun dep ->

           (if dep.local then dep.name

           else Version.include_path ^ "/" ^ dep.name)

           ^ ".c")

         compiled_deps)

module type MODIFIERS_MKF = sig

  (* dep was (bool * ident * top_decl list) *)

  val other_targets : formatter -> string -> string -> dep_t list -> unit

  val pp_print_dependencies: formatter -> dep_t list -> unit

  val pp_arrow_o: formatter -> unit -> unit

end

module EmptyMod : MODIFIERS_MKF = struct

  let other_targets _ _ _ _ = ()

  let pp_print_dependencies = fprintf_dependencies ""

  let pp_arrow_o fmt () = pp_print_string fmt "arrow.o"

end

module Main =

functor

  (Mod : MODIFIERS_MKF)

  ->

  struct

    (* TODO: BEWARE OF THE BUG !! in case of very long nodename or maybe even

       basename, the string basename_nodename exceed a limit length for files on

       linux and prevent gcc to generate the binary of that name.

       To be solved (later) with - either the default name if it short - a

       shorter version if it is long (md5?) - a provided name given when calling

       the makefile so the user can control the expected name of the binary *)

    let pp_makefile basename nodename (dependencies : dep_t list) fmt =

      let binname =

        let s = basename ^ "_" ^ nodename in

        if

          String.length s > 100

          (* seems that GCC fails from 144 characters and on: File name too long

             collect2 ld error. *)

        then

          if String.length nodename > 100 then basename ^ "_run"

            (* shorter version *)

          else nodename ^ "run"

        else s

      in

      fprintf fmt "BINNAME?=%s@." binname;

      fprintf fmt "GCC=gcc -O0@.";

      fprintf fmt "LUSTREC=%s@." Sys.executable_name;

      fprintf

        fmt

        "LUSTREC_BASE=%s@."

        (Filename.dirname (Filename.dirname Sys.executable_name));

      fprintf fmt "INC=%s@." Version.include_path

      (*"${LUSTREC_BASE}/include/lustrec"*);

      fprintf fmt "@.";

      (* Main binary *)

      fprintf

        fmt

        "%s_%s: %s.c %s_main.c@."

        basename

        "run"

        (*nodename*) basename

        basename;

      fprintf fmt "\t${GCC} -I${INC} -I. -c %s.c@." basename;

      fprintf fmt "\t${GCC} -I${INC} -I. -c %s_main.c@." basename;

      Mod.pp_print_dependencies fmt dependencies;

      fprintf

        fmt

        "\t${GCC} -o ${BINNAME} io_frontend.o %a %a %s.o %s_main.o %a@."

        Mod.pp_arrow_o ()

        (pp_print_list (fun fmt dep -> fprintf fmt "%s.o" dep.name))

        (compiled_dependencies dependencies)

        basename

        (* library .o *) basename

        (* main function . o *)

        (pp_print_list (fun fmt lib -> fprintf fmt "-l%s" lib))

        (lib_dependencies dependencies);

      fprintf fmt "@.";

      fprintf fmt "clean:@.";

      fprintf fmt "\t\\rm -f *.o ${BINNAME}@.";

      fprintf fmt "@.";

      Mod.other_targets fmt basename nodename dependencies;

      fprintf fmt "@."

  end

(* Local Variables: *)

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

(* End: *)