Project

General

Profile

« Previous | Next » 

Revision 5a71ed25

Added by Christophe Garion over 4 years ago

json-parser: use Logs and Cmdliner librairies

View differences:

src/_tags.in
19 19
<**/.svn>: not_hygienic
20 20

  
21 21
# packages
22
<**/*.native>        : package(ocamlgraph)
23
<**/*.native>        : use_str
24
<**/*.native>        : use_unix
25
<**/*.native>        : package(num)
26
<**/parser_json.ml>  : package(yojson)
27
<**/main_with_json.*>: package(yojson)
22
<**/*.native>                   : package(ocamlgraph)
23
<**/*.native>                   : use_str
24
<**/main_lustre_compiler.native>: use_unix
25
<**/main_lustre_testgen.native> : use_unix
26
<**/*.native>                   : package(num)
27
<**/parser_json.ml>             : package(logs)
28
<**/parser_json.ml>             : package(yojson)
29
<**/main_with_json.*>           : package(logs)
30
<**/main_with_json.*>           : package(cmdliner)
31
<**/main_with_json.*>           : package(fmt.tty)
32
<**/main_with_json.*>           : package(fmt.cli)
33
<**/main_with_json.*>           : package(logs.fmt)
34
<**/main_with_json.*>           : package(logs.cli)
35
<**/main_with_json.*>           : package(yojson)
28 36

  
29 37
# Required for ocamldoc. Otherwise failed to build
30 38
<*.ml{,i}>: package(ocamlgraph)
src/tools/stateflow/main_with_json.ml
1 1
open Basetypes
2
open Cmdliner
2 3
open Datatype
3 4
open Parser_json
4 5
open Sys
......
12 13

  
13 14
module Parse = Parser (ParseExt)
14 15

  
15
let main ()  =
16
(* setup for logging *)
17
let setup_log style_renderer level =
18
  Fmt_tty.setup_std_outputs ?style_renderer ();
19
  Logs.set_level level;
20
  Logs.set_reporter (Logs_fmt.reporter ());
21
  ()
22

  
23
(* function representing the program to execute *)
24
let json_parse _ file pp =
25
  let prog = Parse.parse_prog (Yojson.Basic.from_file file) in
26
  if pp then
27
    SF.pp_prog Format.std_formatter prog
28

  
29
(* term representing argument for file *)
30
let file =
31
  let doc = "The file to parse." in
32
  let env = Arg.env_var "JSON_FILE" ~doc in
33
  let doc = "The file to parse." in
34
  Arg.(required & pos 0 (some string) None & info [] ~env ~docv:"FILE" ~doc)
35

  
36
(* term representing argument for flag for pretty printing the program *)
37
let pp =
38
  let doc = "Pretty print the resulting program" in
39
  Arg.(value & flag & info ["pp"; "pretty-print"] ~docv:"PP" ~doc)
40

  
41
(* term for argument for logging *)
42
let setup_log_arg =
43
  let env = Arg.env_var "TOOL_VERBOSITY" in
44
  Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ~env ())
45

  
46
(* term representing the program to execute *)
47
let json_parse_t = Term.(const json_parse $ setup_log_arg $ file $ pp)
48

  
49
(* term info for manpages etc. *)
50
let info =
51
  let doc = "parse a JSON file representing a Stateflow model" in
52
  let man = [
53
    `S Manpage.s_bugs;
54
    `P "Report bug to Github issues tracking." ]
55
  in
56
  Term.info "json-parser-example" ~doc ~exits:Term.default_exits ~man
57

  
58
let main () =
16 59
  begin
17 60
    let json = Yojson.Basic.from_file Sys.argv.(1) in
18 61
    SF.pp_prog Format.std_formatter (Parse.parse_prog json);
19 62
  end
20 63

  
21
let _ = main ()
64
(* program *)
65
let _ = Term.exit @@ Term.eval (json_parse_t, info)
src/tools/stateflow/parser-json/parser_json.ml
5 5
open Basetypes
6 6
open Basic
7 7
open Corelang
8
open CPS
8
(* open CPS *)
9 9
open LustreSpec
10 10
open Str
11 11

  
......
30 30
      Type_error _ -> [ json ]
31 31

  
32 32
  let rec parse_prog json : prog_t =
33
     (*Format.printf "parse_prog@.";*)
33
    Logs.info  (fun m -> m "parse_prog %s" (json |> member "name" |> to_string));
34 34
    Program (
35 35
      json |> member "name"        |> to_string,
36 36
     (json |> member "states"      |> to_list |> List.map parse_state) @
......
40 40
        (fun res -> SFFunction (parse_prog res))),
41 41
      json |> member "data"        |> to_list |> List.map parse_variable
42 42
    )
43
  (*   json |> member "data"       |> to_list |> List.map parse_variable *)
44 43
  and parse_state json =
45
    (*Format.printf "parse_state@.";*)
44
    Logs.debug (fun m -> m "parse_state");
46 45
    State (
47 46
      json |> member "path" |> parse_path,
48 47
      json |> parse_state_def
49 48
    )
50 49
  and parse_path json =
51
      (*Format.printf "parse_path@.";*)
52
      json |> to_string |> path_split
50
    Logs.debug (fun m -> m "parse_path %s" (json |> to_string));
51
    json |> to_string |> path_split
53 52
  and parse_state_def json =
54
    (*Format.printf "parse_state_def@.";*)
53
    Logs.debug (fun m -> m "parse_state_def");
55 54
    {
56 55
      state_actions        = json |> member "state_actions"        |> parse_state_actions;
57 56
      outer_trans          = json |> member "outer_trans"          |> to_list |> List.map parse_transition;
......
59 58
      internal_composition = json |> member "internal_composition" |> parse_internal_composition
60 59
    }
61 60
  and parse_state_actions json =
62
    (*Format.printf "parse_state_actions@.";*)
61
    Logs.debug (fun m -> m "parse_state_actions");
63 62
    {
64 63
      entry_act  = json |> member "entry_act"  |> Ext.parse_action;
65 64
      during_act = json |> member "during_act" |> Ext.parse_action;
66 65
      exit_act   = json |> member "exit_act"   |> Ext.parse_action;
67 66
    }
68 67
  and parse_transition json =
69
    (*Format.printf "parse_transition@.";*)
68
    Logs.debug (fun m -> m "parse_transition");
70 69
    {
71 70
      event          = json |> member "event"          |> Ext.parse_event;
72 71
      condition      = json |> member "condition"      |> Ext.parse_condition;
......
75 74
      dest           = json |> member "dest"           |> parse_dest
76 75
    }
77 76
  and parse_dest json =
78
    (*Format.printf "parse_dest@.";*)
77
    Logs.debug (fun m -> m "parse_dest");
79 78
    (json |> member "type" |> to_string |>
80 79
	(function
81 80
	| "State"    -> (fun p -> DPath p)
......
83 82
	| _ -> assert false))
84 83
      (json |> member "name" |> parse_path)
85 84
  and parse_internal_composition json =
86
    (*Format.printf "parse_internal_composition@.";*)
85
    Logs.debug (fun m -> m "parse_internal_composition");
87 86
    (json |> member "type" |> to_string |>
88 87
	(function
89 88
	| "EXCLUSIVE_OR" -> (fun tinit substates ->                      Or  (tinit, substates))
......
92 91
      (json |> member "tinit"     |> parse_tinit)
93 92
      (json |> member "substates" |> to_list |> List.map to_string)
94 93
  and parse_tinit json =
95
    (*Format.printf "parse_tinit@.";*)
94
    Logs.debug (fun m -> m "parse_tinit");
96 95
    json |> to_list |> List.map parse_transition
97 96
  and parse_junction json =
98
    (*Format.printf "parse_junction@.";*)
97
    Logs.debug (fun m -> m "parse_junction");
99 98
    Junction (
100 99
      json |> member "path"        |> to_string,
101 100
      json |> member "outer_trans" |> to_list |> List.map parse_transition
......
109 108
    | "Parameter" -> Parameter
110 109
    | _           -> failwith ("Invalid scope for variable: " ^ s)
111 110
  and parse_real_value s =
111
    Logs.debug (fun m -> m "parse_real_value %s" s);
112 112
    let real_regexp_simp = regexp "-?\\([0-9][0-9]*\\)\\.\\([0-9]*\\)" in
113 113
    let real_regexp_e    = regexp "-?\\([0-9][0-9]*\\)\\.\\([0-9]*\\)(E|e)\\((\\+|\\-)[0-9][0-9]*\\)" in
114 114
    if string_match real_regexp_e s 0 then
......
146 146
                          ^ " for variable " ^ (json |> member "name"
147 147
                                                |> to_string))
148 148
  and parse_variable json =
149
    (*Format.printf "parse_variable@.";*)
149
    Logs.debug (fun m -> m "parse_variable %s" (json |> member "name" |> to_string));
150 150
    let location                  = Location.dummy_loc in
151 151
    let (datatype, initial_value) = lustre_datatype_of_json json location in
152 152
    mkvar_decl location ~orig:true

Also available in: Unified diff