Revision ca7ff3f7
Added by Lélio Brun over 1 year ago
src/tools/stateflow/json-parser/json_parser.ml | ||
---|---|---|
6 | 6 |
open Yojson |
7 | 7 |
open Basic |
8 | 8 |
|
9 |
module type ParseExt = |
|
10 |
sig |
|
9 |
module type ParseExt = sig |
|
11 | 10 |
val parse_condition : json -> Condition.t |
12 |
val parse_action : json -> Action.t |
|
13 |
val parse_event : json -> Basetypes.event_t |
|
11 |
|
|
12 |
val parse_action : json -> Action.t |
|
13 |
|
|
14 |
val parse_event : json -> Basetypes.event_t |
|
14 | 15 |
end |
15 | 16 |
|
16 |
module Parser (Ext : ParseExt) = |
|
17 |
struct |
|
17 |
module Parser (Ext : ParseExt) = struct |
|
18 | 18 |
exception JSON_parse_error of string |
19 | 19 |
|
20 | 20 |
let path_split = String.split_on_char '/' |
21 |
|
|
21 | 22 |
let path_concat = String.concat (String.make 1 '/') |
22 | 23 |
|
23 | 24 |
open Util |
24 | 25 |
|
25 |
let to_list json = |
|
26 |
try |
|
27 |
json |> to_list |
|
28 |
with |
|
29 |
Type_error _ -> [ json ] |
|
26 |
let to_list json = try json |> to_list with Type_error _ -> [ json ] |
|
30 | 27 |
|
31 | 28 |
let rec parse_prog json : prog_t = |
32 |
Logs.info (fun m -> m "parse_prog %s" (json |> member "name" |> to_string)); |
|
33 |
Program ( |
|
34 |
json |> member "name" |> to_string, |
|
35 |
(json |> member "states" |> to_list |> List.map parse_state) @ |
|
36 |
(json |> member "junctions" |> to_list |> List.map parse_junction) |
|
37 |
@ |
|
38 |
(json |> member "sffunctions" |> to_list |> List.map |
|
39 |
(fun res -> SFFunction (parse_prog res))), |
|
40 |
json |> member "data" |> to_list |> List.map parse_variable |
|
41 |
) |
|
29 |
Logs.info (fun m -> m "parse_prog %s" (json |> member "name" |> to_string)); |
|
30 |
Program |
|
31 |
( json |> member "name" |> to_string, |
|
32 |
(json |> member "states" |> to_list |> List.map parse_state) |
|
33 |
@ (json |> member "junctions" |> to_list |> List.map parse_junction) |
|
34 |
@ (json |> member "sffunctions" |> to_list |
|
35 |
|> List.map (fun res -> SFFunction (parse_prog res))), |
|
36 |
json |> member "data" |> to_list |> List.map parse_variable ) |
|
37 |
|
|
42 | 38 |
and parse_state json = |
43 | 39 |
Logs.debug (fun m -> m "parse_state"); |
44 |
State ( |
|
45 |
json |> member "path" |> parse_path, |
|
46 |
json |> parse_state_def |
|
47 |
) |
|
40 |
State (json |> member "path" |> parse_path, json |> parse_state_def) |
|
41 |
|
|
48 | 42 |
and parse_path json = |
49 | 43 |
Logs.debug (fun m -> m "parse_path %s" (json |> to_string)); |
50 | 44 |
json |> to_string |> path_split |
45 |
|
|
51 | 46 |
and parse_state_def json = |
52 | 47 |
Logs.debug (fun m -> m "parse_state_def"); |
53 | 48 |
{ |
54 |
state_actions = json |> member "state_actions" |> parse_state_actions; |
|
55 |
outer_trans = json |> member "outer_trans" |> to_list |> List.map parse_transition; |
|
56 |
inner_trans = json |> member "inner_trans" |> to_list |> List.map parse_transition; |
|
57 |
internal_composition = json |> member "internal_composition" |> parse_internal_composition |
|
49 |
state_actions = json |> member "state_actions" |> parse_state_actions; |
|
50 |
outer_trans = |
|
51 |
json |> member "outer_trans" |> to_list |> List.map parse_transition; |
|
52 |
inner_trans = |
|
53 |
json |> member "inner_trans" |> to_list |> List.map parse_transition; |
|
54 |
internal_composition = |
|
55 |
json |> member "internal_composition" |> parse_internal_composition; |
|
58 | 56 |
} |
57 |
|
|
59 | 58 |
and parse_state_actions json = |
60 | 59 |
Logs.debug (fun m -> m "parse_state_actions"); |
61 | 60 |
{ |
62 |
entry_act = json |> member "entry_act" |> Ext.parse_action;
|
|
61 |
entry_act = json |> member "entry_act" |> Ext.parse_action;
|
|
63 | 62 |
during_act = json |> member "during_act" |> Ext.parse_action; |
64 |
exit_act = json |> member "exit_act" |> Ext.parse_action;
|
|
63 |
exit_act = json |> member "exit_act" |> Ext.parse_action;
|
|
65 | 64 |
} |
65 |
|
|
66 | 66 |
and parse_transition json = |
67 | 67 |
Logs.debug (fun m -> m "parse_transition"); |
68 | 68 |
{ |
69 |
event = json |> member "event" |> Ext.parse_event;
|
|
70 |
condition = json |> member "condition" |> Ext.parse_condition;
|
|
71 |
condition_act = json |> member "condition_act" |> Ext.parse_action;
|
|
69 |
event = json |> member "event" |> Ext.parse_event;
|
|
70 |
condition = json |> member "condition" |> Ext.parse_condition; |
|
71 |
condition_act = json |> member "condition_act" |> Ext.parse_action;
|
|
72 | 72 |
transition_act = json |> member "transition_act" |> Ext.parse_action; |
73 |
dest = json |> member "dest" |> parse_dest
|
|
73 |
dest = json |> member "dest" |> parse_dest;
|
|
74 | 74 |
} |
75 |
|
|
75 | 76 |
and parse_dest json = |
76 | 77 |
Logs.debug (fun m -> m "parse_dest"); |
77 | 78 |
let dest_type = json |> member "type" |> to_string in |
78 |
(dest_type |> |
|
79 |
(function |
|
80 |
| "State" -> (fun p -> DPath p) |
|
81 |
| "Junction" -> (fun j -> DJunction (path_concat j)) |
|
82 |
| _ -> raise (JSON_parse_error ("Invalid destination type: " ^ dest_type)))) |
|
79 |
(dest_type |> function |
|
80 |
| "State" -> |
|
81 |
fun p -> DPath p |
|
82 |
| "Junction" -> |
|
83 |
fun j -> DJunction (path_concat j) |
|
84 |
| _ -> |
|
85 |
raise (JSON_parse_error ("Invalid destination type: " ^ dest_type))) |
|
83 | 86 |
(json |> member "name" |> parse_path) |
87 |
|
|
84 | 88 |
and parse_internal_composition json = |
85 | 89 |
Logs.debug (fun m -> m "parse_internal_composition"); |
86 | 90 |
let state_type = json |> member "type" |> to_string in |
87 |
(state_type |> |
|
88 |
(function |
|
89 |
| "EXCLUSIVE_OR" -> (fun tinit substates -> Or (tinit, substates)) |
|
90 |
| "PARALLEL_AND" -> (fun tinit substates -> assert (tinit = []); And (substates)) |
|
91 |
| _ -> raise (JSON_parse_error ("Invalid state type: " ^ state_type)))) |
|
92 |
(json |> member "tinit" |> parse_tinit) |
|
91 |
(state_type |> function |
|
92 |
| "EXCLUSIVE_OR" -> |
|
93 |
fun tinit substates -> Or (tinit, substates) |
|
94 |
| "PARALLEL_AND" -> |
|
95 |
fun tinit substates -> |
|
96 |
assert (tinit = []); |
|
97 |
And substates |
|
98 |
| _ -> |
|
99 |
raise (JSON_parse_error ("Invalid state type: " ^ state_type))) |
|
100 |
(json |> member "tinit" |> parse_tinit) |
|
93 | 101 |
(json |> member "substates" |> to_list |> List.map to_string) |
102 |
|
|
94 | 103 |
and parse_tinit json = |
95 | 104 |
Logs.debug (fun m -> m "parse_tinit"); |
96 | 105 |
json |> to_list |> List.map parse_transition |
106 |
|
|
97 | 107 |
and parse_junction json = |
98 | 108 |
Logs.debug (fun m -> m "parse_junction"); |
99 |
Junction (
|
|
100 |
json |> member "path" |> to_string,
|
|
101 |
json |> member "outer_trans" |> to_list |> List.map parse_transition
|
|
102 |
) |
|
109 |
Junction |
|
110 |
( json |> member "path" |> to_string,
|
|
111 |
json |> member "outer_trans" |> to_list |> List.map parse_transition )
|
|
112 |
|
|
103 | 113 |
and scope_of_string s = |
104 | 114 |
match s with |
105 |
| "Constant" -> Constant |
|
106 |
| "Input" -> Input |
|
107 |
| "Local" -> Local |
|
108 |
| "Output" -> Output |
|
109 |
| "Parameter" -> Parameter |
|
110 |
| _ -> raise (JSON_parse_error ("Invalid scope for variable: " ^ s)) |
|
115 |
| "Constant" -> |
|
116 |
Constant |
|
117 |
| "Input" -> |
|
118 |
Input |
|
119 |
| "Local" -> |
|
120 |
Local |
|
121 |
| "Output" -> |
|
122 |
Output |
|
123 |
| "Parameter" -> |
|
124 |
Parameter |
|
125 |
| _ -> |
|
126 |
raise (JSON_parse_error ("Invalid scope for variable: " ^ s)) |
|
127 |
|
|
111 | 128 |
and parse_real_value s = |
112 | 129 |
Logs.debug (fun m -> m "parse_real_value %s" s); |
113 | 130 |
let real_regexp_simp = regexp "\\(-?[0-9][0-9]*\\)\\.\\([0-9]*\\)" in |
114 |
let real_regexp_e = regexp "\\(-?[0-9][0-9]*\\)\\.\\([0-9]*\\)\\(E\\|e\\)\\(\\(\\+\\|\\-\\)[0-9][0-9]*\\)" in |
|
131 |
let real_regexp_e = |
|
132 |
regexp |
|
133 |
"\\(-?[0-9][0-9]*\\)\\.\\([0-9]*\\)\\(E\\|e\\)\\(\\(\\+\\|\\-\\)[0-9][0-9]*\\)" |
|
134 |
in |
|
115 | 135 |
if string_match real_regexp_e s 0 then |
116 | 136 |
let l = matched_group 1 s in |
117 | 137 |
let r = matched_group 2 s in |
118 | 138 |
let e = matched_group 4 s in |
119 |
Const_real (Num.num_of_string (l ^ r), |
|
120 |
String.length r + (-1 * int_of_string e), |
|
121 |
s) |
|
122 |
else |
|
123 |
if string_match real_regexp_simp s 0 then |
|
139 |
Const_real |
|
140 |
(Num.num_of_string (l ^ r), String.length r + (-1 * int_of_string e), s) |
|
141 |
else if string_match real_regexp_simp s 0 then |
|
124 | 142 |
let l = matched_group 1 s in |
125 | 143 |
let r = matched_group 2 s in |
126 | 144 |
Const_real (Num.num_of_string (l ^ r), String.length r, s) |
127 |
else |
|
128 |
raise (JSON_parse_error ("Invalid real constant " ^ s)) |
|
145 |
else raise (JSON_parse_error ("Invalid real constant " ^ s))
|
|
146 |
|
|
129 | 147 |
and lustre_datatype_of_json json location = |
130 |
let datatype = json |> member "datatype" |> to_string in
|
|
148 |
let datatype = json |> member "datatype" |> to_string in
|
|
131 | 149 |
let initial_value = json |> member "initial_value" |> to_string in |
132 | 150 |
match datatype with |
133 |
| "bool" -> (Tydec_bool, mkexpr location |
|
134 |
(Expr_const (Const_tag |
|
135 |
((fun s -> match s with |
|
136 |
| "true" -> tag_true |
|
137 |
| "false" -> tag_false |
|
138 |
| _ -> |
|
139 |
raise (JSON_parse_error ("Invalid constant for |
|
140 |
boolean: " ^ s))) initial_value)))) |
|
141 |
| "int" -> (Tydec_int, mkexpr location |
|
142 |
(Expr_const (Const_int (int_of_string |
|
143 |
initial_value)))) |
|
144 |
| "real" -> (Tydec_real, mkexpr location |
|
145 |
(Expr_const (parse_real_value initial_value))) |
|
146 |
| _ -> raise (JSON_parse_error ("Invalid datatype " ^ datatype |
|
147 |
^ " for variable " ^ (json |> member "name" |
|
148 |
|> to_string))) |
|
151 |
| "bool" -> |
|
152 |
( Tydec_bool, |
|
153 |
mkexpr location |
|
154 |
(Expr_const |
|
155 |
(Const_tag |
|
156 |
((fun s -> |
|
157 |
match s with |
|
158 |
| "true" -> |
|
159 |
tag_true |
|
160 |
| "false" -> |
|
161 |
tag_false |
|
162 |
| _ -> |
|
163 |
raise |
|
164 |
(JSON_parse_error |
|
165 |
("Invalid constant for\n boolean: " ^ s))) |
|
166 |
initial_value))) ) |
|
167 |
| "int" -> |
|
168 |
( Tydec_int, |
|
169 |
mkexpr location (Expr_const (Const_int (int_of_string initial_value))) ) |
|
170 |
| "real" -> |
|
171 |
Tydec_real, mkexpr location (Expr_const (parse_real_value initial_value)) |
|
172 |
| _ -> |
|
173 |
raise |
|
174 |
(JSON_parse_error |
|
175 |
("Invalid datatype " ^ datatype ^ " for variable " |
|
176 |
^ (json |> member "name" |> to_string))) |
|
177 |
|
|
149 | 178 |
and parse_variable json = |
150 |
Logs.debug (fun m -> m "parse_variable %s" (json |> member "name" |> to_string)); |
|
151 |
let location = Location.dummy_loc in |
|
152 |
let (datatype, initial_value) = lustre_datatype_of_json json location in |
|
179 |
Logs.debug (fun m -> |
|
180 |
m "parse_variable %s" (json |> member "name" |> to_string)); |
|
181 |
let location = Location.dummy_loc in |
|
182 |
let datatype, initial_value = lustre_datatype_of_json json location in |
|
153 | 183 |
mkvar_decl location ~orig:true |
154 | 184 |
( json |> member "name" |> to_string, |
155 |
{ty_dec_desc = datatype; ty_dec_loc = location},
|
|
156 |
{ck_dec_desc = Ckdec_any; ck_dec_loc = location},
|
|
185 |
{ ty_dec_desc = datatype; ty_dec_loc = location },
|
|
186 |
{ ck_dec_desc = Ckdec_any; ck_dec_loc = location },
|
|
157 | 187 |
true, |
158 |
Some initial_value |
|
159 |
) |
|
188 |
Some initial_value ) |
|
160 | 189 |
end |
161 |
|
Also available in: Unified diff
reformatting