Project

General

Profile

« Previous | Next » 

Revision 921230e6

Added by Christophe Garion over 4 years ago

json-parser: clean files names and directories

View differences:

Makefile.in
25 25
	@echo Compiling binary lustresf
26 26
	@make -C src lustresf
27 27

  
28
json-parser-ex:
29
	@echo Compiling binary json-parser-ex
30
	@make -C src json-parser-ex
28
json-parser:
29
	@echo Compiling binary json-parser
30
	@make -C src json-parser
31 31

  
32 32
configure: configure.ac
33 33
	@echo configure.ac has changed relaunching autoconf
src/Makefile.in
30 30
	@mkdir -p $(LOCAL_BINDIR)
31 31
	@mv _build/tools/stateflow/sf_sem.native $(LOCAL_BINDIR)/lustresf
32 32

  
33
json-parser-ex:
33
json-parser:
34 34
	@echo Compiling binary json-parser-ex
35
	@$(OCAMLBUILD) tools/stateflow/main_with_json.native
35
	@$(OCAMLBUILD) tools/stateflow/json-parser/main_parse_json_file.native
36 36
	@mkdir -p $(LOCAL_BINDIR)
37
	@mv _build/tools/stateflow/main_with_json.native $(LOCAL_BINDIR)/json-parser-ex
37
	@mv _build/tools/stateflow/json-parser/main_parse_json_file.native $(LOCAL_BINDIR)/json-parser
38 38

  
39 39
doc:
40 40
	@echo Generating doc
src/_tags.in
13 13
"tools/stateflow/common": include
14 14
"tools/stateflow/semantics": include
15 15
"tools/stateflow/models": include
16
"tools/stateflow/parser-json": include
16
"tools/stateflow/json-parser": include
17 17

  
18 18
<**/.svn>: -traverse
19 19
<**/.svn>: not_hygienic
......
24 24
<**/main_lustre_compiler.native>: use_unix
25 25
<**/main_lustre_testgen.native> : use_unix
26 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)
27
<**/json_parser.ml>             : package(logs)
28
<**/json_parser.ml>             : package(yojson)
29
<**/main_parse_json_file.*>     : package(logs)
30
<**/main_parse_json_file.*>     : package(cmdliner)
31
<**/main_parse_json_file.*>     : package(fmt.tty)
32
<**/main_parse_json_file.*>     : package(fmt.cli)
33
<**/main_parse_json_file.*>     : package(logs.fmt)
34
<**/main_parse_json_file.*>     : package(logs.cli)
35
<**/main_parse_json_file.*>     : package(yojson)
36 36

  
37 37
# Required for ocamldoc. Otherwise failed to build
38 38
<*.ml{,i}>: package(ocamlgraph)
src/tools/stateflow/json-parser/json_parser.ml
1
open Yojson
2
open Datatype
3
(* open Simulink *)
4
(* open Transformer *)
5
open Basetypes
6
open Basic
7
open Corelang
8
(* open CPS *)
9
open LustreSpec
10
open Str
11

  
12
module type ParseExt =
13
sig
14
  val parse_condition : json -> Condition.t
15
  val parse_action    : json -> Action.t
16
  val parse_event     : json -> Basetypes.event_t
17
end
18

  
19
module Parser (Ext : ParseExt) =
20
struct
21
  let path_split = String.split_on_char '/'
22
  let path_concat = String.concat (String.make 1 '/')
23

  
24
  open Util
25

  
26
  let to_list json =
27
    try
28
      json |> to_list
29
    with
30
      Type_error _ -> [ json ]
31

  
32
  let rec parse_prog json : prog_t =
33
    Logs.info  (fun m -> m "parse_prog %s" (json |> member "name" |> to_string));
34
    Program (
35
      json |> member "name"        |> to_string,
36
     (json |> member "states"      |> to_list |> List.map parse_state) @
37
     (json |> member "junctions"   |> to_list |> List.map parse_junction)
38
     @
39
     (json |> member "sffunctions" |> to_list |> List.map
40
        (fun res -> SFFunction (parse_prog res))),
41
      json |> member "data"        |> to_list |> List.map parse_variable
42
    )
43
  and parse_state json =
44
    Logs.debug (fun m -> m "parse_state");
45
    State (
46
      json |> member "path" |> parse_path,
47
      json |> parse_state_def
48
    )
49
  and parse_path json =
50
    Logs.debug (fun m -> m "parse_path %s" (json |> to_string));
51
    json |> to_string |> path_split
52
  and parse_state_def json =
53
    Logs.debug (fun m -> m "parse_state_def");
54
    {
55
      state_actions        = json |> member "state_actions"        |> parse_state_actions;
56
      outer_trans          = json |> member "outer_trans"          |> to_list |> List.map parse_transition;
57
      inner_trans          = json |> member "inner_trans"          |> to_list |> List.map parse_transition;
58
      internal_composition = json |> member "internal_composition" |> parse_internal_composition
59
    }
60
  and parse_state_actions json =
61
    Logs.debug (fun m -> m "parse_state_actions");
62
    {
63
      entry_act  = json |> member "entry_act"  |> Ext.parse_action;
64
      during_act = json |> member "during_act" |> Ext.parse_action;
65
      exit_act   = json |> member "exit_act"   |> Ext.parse_action;
66
    }
67
  and parse_transition json =
68
    Logs.debug (fun m -> m "parse_transition");
69
    {
70
      event          = json |> member "event"          |> Ext.parse_event;
71
      condition      = json |> member "condition"      |> Ext.parse_condition;
72
      condition_act  = json |> member "condition_act"  |> Ext.parse_action;
73
      transition_act = json |> member "transition_act" |> Ext.parse_action;
74
      dest           = json |> member "dest"           |> parse_dest
75
    }
76
  and parse_dest json =
77
    Logs.debug (fun m -> m "parse_dest");
78
    (json |> member "type" |> to_string |>
79
	(function
80
	| "State"    -> (fun p -> DPath p)
81
	| "Junction" -> (fun j -> DJunction (path_concat j))
82
	| _ -> assert false))
83
      (json |> member "name" |> parse_path)
84
  and parse_internal_composition json =
85
    Logs.debug (fun m -> m "parse_internal_composition");
86
    (json |> member "type" |> to_string |>
87
	(function
88
	| "EXCLUSIVE_OR" -> (fun tinit substates ->                      Or  (tinit, substates))
89
	| "PARALLEL_AND" -> (fun tinit substates -> assert (tinit = []); And (substates))
90
	| _ -> assert false))
91
      (json |> member "tinit"     |> parse_tinit)
92
      (json |> member "substates" |> to_list |> List.map to_string)
93
  and parse_tinit json =
94
    Logs.debug (fun m -> m "parse_tinit");
95
    json |> to_list |> List.map parse_transition
96
  and parse_junction json =
97
    Logs.debug (fun m -> m "parse_junction");
98
    Junction (
99
      json |> member "path"        |> to_string,
100
      json |> member "outer_trans" |> to_list |> List.map parse_transition
101
    )
102
  and scope_of_string s =
103
    match s with
104
    | "Constant"  -> Constant
105
    | "Input"     -> Input
106
    | "Local"     -> Local
107
    | "Output"    -> Output
108
    | "Parameter" -> Parameter
109
    | _           -> failwith ("Invalid scope for variable: " ^ s)
110
  and parse_real_value s =
111
    Logs.debug (fun m -> m "parse_real_value %s" s);
112
    let real_regexp_simp = regexp "-?\\([0-9][0-9]*\\)\\.\\([0-9]*\\)" in
113
    let real_regexp_e    = regexp "-?\\([0-9][0-9]*\\)\\.\\([0-9]*\\)(E|e)\\((\\+|\\-)[0-9][0-9]*\\)" in
114
    if string_match real_regexp_e s 0 then
115
      let l = matched_group 1 s in
116
      let r = matched_group 2 s in
117
      let e = matched_group 3 s in
118
      Const_real (Num.num_of_string (l ^ r),
119
                  String.length r + -1 * int_of_string e,
120
                  s)
121
    else
122
    if string_match real_regexp_simp s 0 then
123
      let l = matched_group 1 s in
124
      let r = matched_group 2 s in
125
      Const_real (Num.num_of_string (l ^ r), String.length r, s)
126
    else
127
      failwith ("Invalid real constant " ^ s)
128
  and lustre_datatype_of_json json location =
129
    let datatype      = json |> member "datatype"      |> to_string in
130
    let initial_value = json |> member "initial_value" |> to_string in
131
    match datatype with
132
    | "bool" -> (Tydec_bool, mkexpr location
133
                   (Expr_const (Const_tag
134
                                  ((fun s -> match s with
135
                                     | "true"  -> tag_true
136
                                     | "false" -> tag_false
137
                                     | _       ->
138
                                       failwith ("Invalid constant for
139
     boolean: " ^ s)) initial_value))))
140
    | "int"  -> (Tydec_int, mkexpr location
141
                   (Expr_const (Const_int (int_of_string
142
                                             initial_value))))
143
    | "real" -> (Tydec_real, mkexpr location
144
                   (Expr_const (parse_real_value initial_value)))
145
    | _      -> failwith ("Invalid datatype " ^ datatype
146
                          ^ " for variable " ^ (json |> member "name"
147
                                                |> to_string))
148
  and parse_variable json =
149
    Logs.debug (fun m -> m "parse_variable %s" (json |> member "name" |> to_string));
150
    let location                  = Location.dummy_loc in
151
    let (datatype, initial_value) = lustre_datatype_of_json json location in
152
    mkvar_decl location ~orig:true
153
      ( json |> member "name" |> to_string,
154
        {ty_dec_desc = datatype;  ty_dec_loc = location},
155
        {ck_dec_desc = Ckdec_any; ck_dec_loc = location},
156
        true,
157
        Some initial_value
158
      )
159
end
src/tools/stateflow/json-parser/main_parse_json_file.ml
1
open Basetypes
2
open Cmdliner
3
open Datatype
4
open Json_parser
5
open Sys
6

  
7
module ParseExt =
8
struct
9
  let parse_condition _ = Condition.tru
10
  let parse_action    _ = Action.nil
11
  let parse_event json  = Some Yojson.Basic.(json |> to_string)
12
end
13

  
14
module Parse = Parser (ParseExt)
15

  
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 "parse_json_file" ~doc ~exits:Term.default_exits ~man
57

  
58
(* program *)
59
let _ = Term.exit @@ Term.eval (json_parse_t, info)
src/tools/stateflow/main_with_json.ml
1
open Basetypes
2
open Cmdliner
3
open Datatype
4
open Parser_json
5
open Sys
6

  
7
module ParseExt =
8
struct
9
  let parse_condition _ = Condition.tru
10
  let parse_action    _ = Action.nil
11
  let parse_event json  = Some Yojson.Basic.(json |> to_string)
12
end
13

  
14
module Parse = Parser (ParseExt)
15

  
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 () =
59
  begin
60
    let json = Yojson.Basic.from_file Sys.argv.(1) in
61
    SF.pp_prog Format.std_formatter (Parse.parse_prog json);
62
  end
63

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

  
12
module type ParseExt =
13
sig
14
  val parse_condition : json -> Condition.t
15
  val parse_action    : json -> Action.t
16
  val parse_event     : json -> Basetypes.event_t
17
end
18

  
19
module Parser (Ext : ParseExt) =
20
struct
21
  let path_split = String.split_on_char '/'
22
  let path_concat = String.concat (String.make 1 '/')
23

  
24
  open Util
25

  
26
  let to_list json =
27
    try
28
      json |> to_list
29
    with
30
      Type_error _ -> [ json ]
31

  
32
  let rec parse_prog json : prog_t =
33
    Logs.info  (fun m -> m "parse_prog %s" (json |> member "name" |> to_string));
34
    Program (
35
      json |> member "name"        |> to_string,
36
     (json |> member "states"      |> to_list |> List.map parse_state) @
37
     (json |> member "junctions"   |> to_list |> List.map parse_junction)
38
     @
39
     (json |> member "sffunctions" |> to_list |> List.map
40
        (fun res -> SFFunction (parse_prog res))),
41
      json |> member "data"        |> to_list |> List.map parse_variable
42
    )
43
  and parse_state json =
44
    Logs.debug (fun m -> m "parse_state");
45
    State (
46
      json |> member "path" |> parse_path,
47
      json |> parse_state_def
48
    )
49
  and parse_path json =
50
    Logs.debug (fun m -> m "parse_path %s" (json |> to_string));
51
    json |> to_string |> path_split
52
  and parse_state_def json =
53
    Logs.debug (fun m -> m "parse_state_def");
54
    {
55
      state_actions        = json |> member "state_actions"        |> parse_state_actions;
56
      outer_trans          = json |> member "outer_trans"          |> to_list |> List.map parse_transition;
57
      inner_trans          = json |> member "inner_trans"          |> to_list |> List.map parse_transition;
58
      internal_composition = json |> member "internal_composition" |> parse_internal_composition
59
    }
60
  and parse_state_actions json =
61
    Logs.debug (fun m -> m "parse_state_actions");
62
    {
63
      entry_act  = json |> member "entry_act"  |> Ext.parse_action;
64
      during_act = json |> member "during_act" |> Ext.parse_action;
65
      exit_act   = json |> member "exit_act"   |> Ext.parse_action;
66
    }
67
  and parse_transition json =
68
    Logs.debug (fun m -> m "parse_transition");
69
    {
70
      event          = json |> member "event"          |> Ext.parse_event;
71
      condition      = json |> member "condition"      |> Ext.parse_condition;
72
      condition_act  = json |> member "condition_act"  |> Ext.parse_action;
73
      transition_act = json |> member "transition_act" |> Ext.parse_action;
74
      dest           = json |> member "dest"           |> parse_dest
75
    }
76
  and parse_dest json =
77
    Logs.debug (fun m -> m "parse_dest");
78
    (json |> member "type" |> to_string |>
79
	(function
80
	| "State"    -> (fun p -> DPath p)
81
	| "Junction" -> (fun j -> DJunction (path_concat j))
82
	| _ -> assert false))
83
      (json |> member "name" |> parse_path)
84
  and parse_internal_composition json =
85
    Logs.debug (fun m -> m "parse_internal_composition");
86
    (json |> member "type" |> to_string |>
87
	(function
88
	| "EXCLUSIVE_OR" -> (fun tinit substates ->                      Or  (tinit, substates))
89
	| "PARALLEL_AND" -> (fun tinit substates -> assert (tinit = []); And (substates))
90
	| _ -> assert false))
91
      (json |> member "tinit"     |> parse_tinit)
92
      (json |> member "substates" |> to_list |> List.map to_string)
93
  and parse_tinit json =
94
    Logs.debug (fun m -> m "parse_tinit");
95
    json |> to_list |> List.map parse_transition
96
  and parse_junction json =
97
    Logs.debug (fun m -> m "parse_junction");
98
    Junction (
99
      json |> member "path"        |> to_string,
100
      json |> member "outer_trans" |> to_list |> List.map parse_transition
101
    )
102
  and scope_of_string s =
103
    match s with
104
    | "Constant"  -> Constant
105
    | "Input"     -> Input
106
    | "Local"     -> Local
107
    | "Output"    -> Output
108
    | "Parameter" -> Parameter
109
    | _           -> failwith ("Invalid scope for variable: " ^ s)
110
  and parse_real_value s =
111
    Logs.debug (fun m -> m "parse_real_value %s" s);
112
    let real_regexp_simp = regexp "-?\\([0-9][0-9]*\\)\\.\\([0-9]*\\)" in
113
    let real_regexp_e    = regexp "-?\\([0-9][0-9]*\\)\\.\\([0-9]*\\)(E|e)\\((\\+|\\-)[0-9][0-9]*\\)" in
114
    if string_match real_regexp_e s 0 then
115
      let l = matched_group 1 s in
116
      let r = matched_group 2 s in
117
      let e = matched_group 3 s in
118
      Const_real (Num.num_of_string (l ^ r),
119
                  String.length r + -1 * int_of_string e,
120
                  s)
121
    else
122
    if string_match real_regexp_simp s 0 then
123
      let l = matched_group 1 s in
124
      let r = matched_group 2 s in
125
      Const_real (Num.num_of_string (l ^ r), String.length r, s)
126
    else
127
      failwith ("Invalid real constant " ^ s)
128
  and lustre_datatype_of_json json location =
129
    let datatype      = json |> member "datatype"      |> to_string in
130
    let initial_value = json |> member "initial_value" |> to_string in
131
    match datatype with
132
    | "bool" -> (Tydec_bool, mkexpr location
133
                   (Expr_const (Const_tag
134
                                  ((fun s -> match s with
135
                                     | "true"  -> tag_true
136
                                     | "false" -> tag_false
137
                                     | _       ->
138
                                       failwith ("Invalid constant for
139
     boolean: " ^ s)) initial_value))))
140
    | "int"  -> (Tydec_int, mkexpr location
141
                   (Expr_const (Const_int (int_of_string
142
                                             initial_value))))
143
    | "real" -> (Tydec_real, mkexpr location
144
                   (Expr_const (parse_real_value initial_value)))
145
    | _      -> failwith ("Invalid datatype " ^ datatype
146
                          ^ " for variable " ^ (json |> member "name"
147
                                                |> to_string))
148
  and parse_variable json =
149
    Logs.debug (fun m -> m "parse_variable %s" (json |> member "name" |> to_string));
150
    let location                  = Location.dummy_loc in
151
    let (datatype, initial_value) = lustre_datatype_of_json json location in
152
    mkvar_decl location ~orig:true
153
      ( json |> member "name" |> to_string,
154
        {ty_dec_desc = datatype;  ty_dec_loc = location},
155
        {ck_dec_desc = Ckdec_any; ck_dec_loc = location},
156
        true,
157
        Some initial_value
158
      )
159
end

Also available in: Unified diff