CristalCaveGem » LustreC

(* An application that loads json provided input and produces Lustre

Usage:

lustrei -vhdl myvhdl.json -gen_lustre

lustrei -scade myscademodel.json -gen_lustre

  will produce a lustre file that can be compiled and analyzed

VHDL is handled in a double way: as a backend and as an import language

In a first step, lustrei -vhdl -print myvhdl.json shall print the VHDL model in stdout

 *)

open Yojson.Safe

open Mini_vhdl_to_lustre

open Vhdl_ast_utils

open Vhdl_ast_map

open Vhdl_ast

open Mini_vhdl_ast

open Mini_vhdl_ast_pp

open Vhdl_ast_pp

open Vhdl_ast_yojson

open Mini_vhdl_check

open Printf

open Printers

open Format

type input = VHDL | None

type output = Stdout | File

type mode = GenVHDL | GenMiniVHDL | GenLus | Check

let input_mode = ref None

let output_mode = ref Stdout

let mode = ref GenLus

let output_file_name = ref ""

let set_input_mode m =

  input_mode := m

let set_output_mode m =

  output_mode := m

let set_output_file_name s =

  set_output_mode File;

  output_file_name := s

let set_mode m =

  mode := m

let options = [

  "-vhdl", Arg.Unit (fun _ -> set_input_mode VHDL), " parse VHDL Json as input";

  "-print", Arg.Unit (fun _ -> set_output_mode Stdout), " print the output to stdout";

  "-o", Arg.String set_output_file_name, "<file>  prints the output to file";

  "-check", Arg.Unit (fun _ -> set_mode Check), " checks VHDL model correction";

  "-gen_vhdl", Arg.Unit (fun _ -> set_mode GenVHDL), " generate VHDL model";

  "-gen_minivhdl", Arg.Unit (fun _ -> set_mode GenMiniVHDL), " generate MiniVHDL model";

  "-gen_lustre", Arg.Unit (fun _ -> set_mode GenLus), " generate lustre model (does nothing)"

]

let usage =

  "lustrei -vhdl [OPTIONS] [JSON file] takes as input a VHDL model in the JSON format.\n"^

    "Backends are either the VHDL code generator, the MiniVHDL code generator or the lustre code generator."

let output_result s =

  match !output_mode with

  | Stdout -> (

    Format.printf "\n%s\n" s;

  )

  | File -> (

    let oc = open_out !output_file_name in

    Printf.fprintf oc "%s" s;

    close_out oc;

  )

let _ =

  Arg.parse options (fun _ -> ()) usage;

  match !input_mode with

  | VHDL -> (

    (* Load model with Yojson *)

    (* let vhdl_json = from_file Sys.argv.(1) in *)

    let vhdl_json = from_file Sys.argv.(Array.length (Sys.argv) -1) in

    (* Create VHDL values *)

    let vhdl = vhdl_file_t_of_yojson vhdl_json in

    match vhdl with

      Ok x -> (

        (* Fold Op vhdl_expr_t values *)

        let folded = replace_op_expr#vhdl_file_t x in

        match !mode with

        | GenVHDL -> (

          let vhdl_value = show_vhdl_file_t folded in

          output_result vhdl_value;

          ()

         )

        | GenMiniVHDL -> (

          let mini_vhdl = to_mini_vhdl#vhdl_design_file_t folded.design_file in

          let mini_vhdl_value = show_mini_vhdl_design_file_t mini_vhdl in

          output_result mini_vhdl_value;

          ()

        )

        | Check -> (

          let mini_vhdl = to_mini_vhdl#vhdl_design_file_t folded.design_file in

          check_mini_vhdl to_mini_vhdl#get_db to_mini_vhdl#to_string_vhdl_name_t

        )

        | GenLus -> (

          let mini_vhdl = to_mini_vhdl#vhdl_design_file_t folded.design_file in

          let program = to_lustre#mini_vhdl_design_file_t mini_vhdl in

          (* Pretty print lustre value *)

          Printers.pp_prog str_formatter program;

          output_result (Format.flush_str_formatter ());

          ()

        )

      )

      | Error e -> failwith (Format.sprintf "Error: %s\n" e)

  )

  | None -> ()