Revision ca7ff3f7
Added by Lélio Brun 7 months 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