Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / tools / importer / main_lustre_importer.ml @ 12946cbe

History | View | Annotate | Download (4.11 KB)

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

    
3
Usage:
4
lustrei -vhdl myvhdl.json -gen_lustre
5
lustrei -scade myscademodel.json -gen_lustre
6
  will produce a lustre file that can be compiled and analyzed
7

    
8
VHDL is handled in a double way: as a backend and as an import language
9
In a first step, lustrei -vhdl -print myvhdl.json shall print the VHDL model in stdout
10

    
11
 *)
12
open Yojson.Safe
13
open Vhdl_ast
14
open Vhdl_ast_pp
15
open Vhdl_ast_transform
16
open Vhdl_ast_utils
17
open Mini_vhdl_ast
18
open Mini_vhdl_ast_pp
19
open Mini_vhdl_ast_transform
20
open Mini_vhdl_ast_utils
21
open Mini_vhdl_check
22
open Vhdl_to_mini_vhdl
23
open Mini_vhdl_to_lustre
24
open Ppxlib_traverse_builtins
25
open Printf
26
open Printers
27
open Format
28

    
29
type input = VHDL | None
30
type output = Stdout | File
31
type mode = GenVHDL | GenMiniVHDL | GenLus | Check
32

    
33
let input_mode = ref None
34
let output_mode = ref Stdout
35
let mode = ref GenLus
36
let output_file_name = ref ""
37

    
38
let set_input_mode m =
39
  input_mode := m
40
let set_output_mode m =
41
  output_mode := m
42
let set_output_file_name s =
43
  set_output_mode File;
44
  output_file_name := s
45
let set_mode m =
46
  mode := m
47

    
48
let options = [
49
  "-vhdl", Arg.Unit (fun _ -> set_input_mode VHDL), " parse VHDL Json as input";
50
  "-print", Arg.Unit (fun _ -> set_output_mode Stdout), " print the output to stdout";
51
  "-o", Arg.String set_output_file_name, "<file>  prints the output to file";
52
  "-check", Arg.Unit (fun _ -> set_mode Check), " checks VHDL model correction";
53
  "-gen_vhdl", Arg.Unit (fun _ -> set_mode GenVHDL), " generate VHDL model";
54
  "-gen_minivhdl", Arg.Unit (fun _ -> set_mode GenMiniVHDL), " generate MiniVHDL model";
55
  "-gen_lustre", Arg.Unit (fun _ -> set_mode GenLus), " generate lustre model (does nothing)"
56
]
57

    
58
let usage =
59
  "lustrei -vhdl [OPTIONS] [JSON file] takes as input a VHDL model in the JSON format.\n"^
60
    "Backends are either the VHDL code generator, the MiniVHDL code generator or the lustre code generator."
61

    
62
let output_result s =
63
  match !output_mode with
64
  | Stdout -> (
65
    Format.printf "\n%s\n" s;
66
  )
67
  | File -> (
68
    let oc = open_out !output_file_name in
69
    Printf.fprintf oc "%s" s;
70
    close_out oc;
71
  )
72

    
73
let to_lustre = object (self)
74
  inherit Ppxlib_traverse_builtins.map
75
  inherit mini_vhdl_to_lustre_map as super
76

    
77
  method unit: unit T.map = any
78
end
79

    
80
let to_mini_vhdl = object (self)
81
  inherit Ppxlib_traverse_builtins.map
82
  inherit vhdl_to_mini_vhdl_map as super
83

    
84
  method unit: unit T.map = any
85
end
86

    
87
let vhdl_df_to_mini_vhdl_df df =
88
  let mini_vhdl = to_mini_vhdl#vhdl_design_file_t df in
89
  let mini_vhdl = flatten_components_instantiations#visit_mini_vhdl_design_file_t () mini_vhdl in
90
  let mini_vhdl = generate_wait_stmt_for_sensible_processes#visit_mini_vhdl_design_file_t () mini_vhdl in
91
  mini_vhdl
92

    
93
let _ =
94
  Arg.parse options (fun _ -> ()) usage;
95
  match !input_mode with
96
  | VHDL -> (
97
    (* Load model with Yojson *)
98
    (* let vhdl_json = from_file Sys.argv.(1) in *)
99
    let vhdl_json = from_file Sys.argv.(Array.length (Sys.argv) -1) in
100
    (* Create VHDL values *)
101
    let vhdl = vhdl_file_t_of_yojson vhdl_json in
102

    
103
    match vhdl with
104
      Ok x -> (
105
        (* Fold Op vhdl_expr_t values *)
106
        let folded = replace_op_expr#visit_vhdl_file_t () x in
107
        (* Generate MiniVHDL *)
108
        let mini_vhdl = vhdl_df_to_mini_vhdl_df folded.design_file in
109
        match !mode with
110
        | GenVHDL -> (
111
          let vhdl_value = show_vhdl_file_t folded in
112
          output_result vhdl_value;
113
          ()
114
         )
115
        | GenMiniVHDL -> (
116
          let mini_vhdl_value = show_mini_vhdl_design_file_t mini_vhdl in
117
          output_result mini_vhdl_value;
118
          ()
119
        )
120
        | Check -> (
121
          let mini_vhdl_value = show_mini_vhdl_design_file_t mini_vhdl in
122
          output_result mini_vhdl_value;
123
          check_mini_vhdl to_mini_vhdl#get_db to_string_vhdl_name_t
124
        )
125
        | GenLus -> (
126
          let program = to_lustre#mini_vhdl_design_file_t mini_vhdl in
127
          (* Pretty print lustre value *)
128
          Printers.pp_prog str_formatter program;
129
          output_result (Format.flush_str_formatter ());
130
          ()
131
        )
132
      )
133
      | Error e -> failwith (Format.sprintf "Error: %s\n" e)
134
  )
135
  | None -> ()