Project

General

Profile

« Previous | Next » 

Revision 37290ede

Added by Christophe Garion over 4 years ago

parser-json: correct parsing of real constants for variables

View differences:

src/tools/stateflow/parser-json/parser_json.ml
7 7
open Corelang
8 8
open CPS
9 9
open LustreSpec
10
open Str
10 11

  
11 12
module type ParseExt =
12 13
sig
......
109 110
    | "Output"    -> Output
110 111
    | "Parameter" -> Parameter
111 112
    | _           -> failwith ("Invalid scope for variable: " ^ s)
112
  and datatype_of_json json =
113
    let datatype = json |> member "datatype" |> to_string in
114
    let init_value = json |> member "initial_value" |> to_string in
115
    match datatype with
116
    | "bool" -> Bool (bool_of_string init_value)
117
    | "int"  -> Int  (int_of_string init_value)
118
    | "real" -> Real (float_of_string init_value)
119
    | _      -> failwith ("Invalid datatype " ^ datatype
120
                          ^ " for variable " ^ (json |> member "name"
121
                                                |> to_string))
113
  and parse_real_value s =
114
    let real_regexp_simp = regexp "-?\\([0-9][0-9]*\\)\\.\\([0-9]*\\)" in
115
    let real_regexp_e    = regexp "-?\\([0-9][0-9]*\\)\\.\\([0-9]*\\)(E|e)\\((\\+|\\-)[0-9][0-9]*\\)" in
116
    if string_match real_regexp_e s 0 then
117
      let l = matched_group 1 s in
118
      let r = matched_group 2 s in
119
      let e = matched_group 3 s in
120
      Const_real (Num.num_of_string (l ^ r),
121
                  String.length r + -1 * int_of_string e,
122
                  s)
123
    else
124
    if string_match real_regexp_simp s 0 then
125
      let l = matched_group 1 s in
126
      let r = matched_group 2 s in
127
      Const_real (Num.num_of_string (l ^ r), String.length r, s)
128
    else
129
      failwith ("Invalid real constant " ^ s)
122 130
  and lustre_datatype_of_json json location =
123 131
    let datatype      = json |> member "datatype"      |> to_string in
124 132
    let initial_value = json |> member "initial_value" |> to_string in
......
130 138
                   (Expr_const (Const_int (int_of_string
131 139
                                             initial_value))))
132 140
    | "real" -> (Tydec_real, mkexpr location
133
                   (Expr_const (Const_real (Num.num_of_int 0,
134
                                           0,
135
                                           initial_value))))
141
                   (Expr_const (parse_real_value initial_value)))
136 142
    | _      -> failwith ("Invalid datatype " ^ datatype
137 143
                          ^ " for variable " ^ (json |> member "name"
138 144
                                                |> to_string))

Also available in: Unified diff