Project

General

Profile

Revision a33a345a

View differences:

src/tools/importer/main_lustre_importer.ml
18 18
open Mini_vhdl_ast_pp
19 19
open Vhdl_ast_pp
20 20
open Vhdl_ast_yojson
21
open Mini_vhdl_check
21 22
open Printf
22 23
open Printers
23 24
open Format
24 25

  
25 26
type input = VHDL | None
26 27
type output = Stdout | File
27
type mode = GenVHDL | GenMiniVHDL | GenLus
28
type mode = GenVHDL | GenMiniVHDL | GenLus | Check
28 29

  
29 30
let input_mode = ref None
30 31
let output_mode = ref Stdout
......
45 46
  "-vhdl", Arg.Unit (fun _ -> set_input_mode VHDL), " parse VHDL Json as input";
46 47
  "-print", Arg.Unit (fun _ -> set_output_mode Stdout), " print the output to stdout";
47 48
  "-o", Arg.String set_output_file_name, "<file>  prints the output to file";
49
  "-check", Arg.Unit (fun _ -> set_mode Check), " checks VHDL model correction";
48 50
  "-gen_vhdl", Arg.Unit (fun _ -> set_mode GenVHDL), " generate VHDL model";
49 51
  "-gen_minivhdl", Arg.Unit (fun _ -> set_mode GenMiniVHDL), " generate MiniVHDL model";
50 52
  "-gen_lustre", Arg.Unit (fun _ -> set_mode GenLus), " generate lustre model (does nothing)"
......
91 93
          output_result mini_vhdl_value;
92 94
          ()
93 95
        )
96
        | Check -> (
97
          let mini_vhdl = to_mini_vhdl#vhdl_design_file_t folded.design_file in
98
          check_mini_vhdl to_mini_vhdl#get_db to_mini_vhdl#to_string_vhdl_name_t
99
        )
94 100
        | GenLus -> (
95 101
          let mini_vhdl = to_mini_vhdl#vhdl_design_file_t folded.design_file in
96 102
          let program = to_lustre#mini_vhdl_design_file_t mini_vhdl in
src/tools/importer/mini_vhdl_check.ml
1
open Vhdl_ast
2
open Mini_vhdl_ast
3
open Vhdl_2_mini_vhdl_map
4

  
5
(*
6
type db_tuple_t =
7
  {
8
    mutable entity: vhdl_entity_t;
9
    mutable architecture: vhdl_architecture_t;
10
    mutable architecture_signals: mini_vhdl_declaration_t list;
11
    mutable architecture_ports: vhdl_port_t list;
12
    mutable architecture_generics: vhdl_port_t list;
13
    mutable assigned_names: vhdl_name_t list;
14
    mutable contexts: vhdl_load_t list;
15
  }
16
*)
17

  
18
let mini_vhdl_declaration_t_names decl=
19
  match decl with
20
  | SigDecl { names; typ; init_val } -> names
21
  | _ -> []
22

  
23
let check_mini_vhdl db to_string_name =
24
  let disp : db_tuple_t -> unit=
25
    fun {entity; architecture; architecture_signals; architecture_ports; architecture_generics; assigned_names; contexts} ->
26
      Printf.printf "Architecture: %s | " (to_string_name architecture.name);
27
      Printf.printf "Entity: %s\n" (to_string_name entity.name);
28
      let sigs_names = List.flatten (List.map mini_vhdl_declaration_t_names architecture_signals) in
29
      let get_names : vhdl_port_t -> vhdl_name_t list= fun x -> x.names in
30
      let rec get_ports: vhdl_port_t list -> vhdl_port_mode_t -> vhdl_port_t list= 
31
        fun l -> fun m -> match l with 
32
        | [] -> [] 
33
        | hd::tl -> if hd.mode = m then hd::(get_ports tl m) else get_ports tl m in
34
      let in_ports_names = List.flatten (List.map get_names (get_ports architecture_ports InPort)) in
35
      let out_ports_names = List.flatten (List.map get_names (get_ports architecture_ports OutPort)) in
36
      let inout_ports_names = List.flatten (List.map get_names (get_ports architecture_ports InoutPort)) in
37
      let generics_names = List.flatten (List.map get_names architecture_generics) in
38
      let filter_display s l = match l with
39
      | [] -> ()
40
      | _ -> Printf.printf "\t%s: %s\n" s (String.concat ", " (List.map to_string_name l)) in
41
      filter_display "Signals" sigs_names;
42
      filter_display "In ports" in_ports_names;
43
      filter_display "InOut ports" inout_ports_names;
44
      filter_display "Out ports" out_ports_names;
45
      filter_display "Generics" generics_names;
46
      filter_display "Assigned names" assigned_names in
47
  List.iter disp db

Also available in: Unified diff