Project

General

Profile

Revision 9ae027f8

View differences:

src/parse.ml
18 18
  | Unfinished_string
19 19
  | Unfinished_comment
20 20
  | Syntax_error
21
  | String_Syntax_error of string
21 22
  | Unfinished_annot
22 23
  | Unfinished_node_spec 
23 24
  | Annot_error of string
......
32 33
  | Undefined_token tok   -> fprintf fmt "undefined token '%s'" tok
33 34
  | Unfinished_string        -> fprintf fmt "unfinished string"
34 35
  | Unfinished_comment  -> fprintf fmt "unfinished comment"
35
  | Syntax_error               -> fprintf fmt ""
36
  | Syntax_error               -> fprintf fmt "syntax error"
37
  | String_Syntax_error s              -> fprintf fmt "syntax error in %s" s
36 38
  | Unfinished_annot        -> fprintf fmt "unfinished annotation"
37 39
  | Unfinished_node_spec -> fprintf fmt "unfinished node specification"
38 40
  | Annot_error s              -> fprintf fmt "impossible to parse the following annotation:@.%s@.@?" s
src/tools/stateflow/common/basetypes.ml
10 10
type user_variable_name_t = string
11 11

  
12 12
(* Connected to lustrec types *)
13
type base_action_t    = { defs : LustreSpec.eq list; ident : string }
14
type base_condition_t = LustreSpec.expr
13
type base_action_t    = { defs : LustreSpec.statement list;
14
			  ainputs: LustreSpec.var_decl list;
15
			  aoutputs: LustreSpec.var_decl list;
16
			  avariables: LustreSpec.var_decl list;
17
			  (* ident: string; *)
18
			}
19
type base_condition_t = { expr: LustreSpec.expr;
20
			  cinputs: LustreSpec.var_decl list;
21
			  coutputs: LustreSpec.var_decl list;
22
			  cvariables: LustreSpec.var_decl list }
15 23

  
16 24
(* P(r)etty printers *)
17 25
let pp_state_name     = Format.pp_print_string
18 26
let pp_junction_name  = Format.pp_print_string
19 27
let pp_path fmt p     = Utils.fprintf_list ~sep:"." pp_state_name fmt p
20 28
let pp_event fmt e    = match e with None -> Format.fprintf fmt "none" | Some s -> Format.fprintf fmt "%s" s
21
let pp_base_act fmt a = Utils.fprintf_list ~sep:",@ " Printers.pp_node_eq fmt a.defs
22
let pp_base_cond      = Printers.pp_expr
29
let pp_base_act fmt a = Printers.pp_node_stmts fmt a.defs
30
let pp_base_cond fmt c= Printers.pp_expr fmt c.expr
23 31

  
24 32
(* Action and Condition types and functions. *)
25 33

  
src/tools/stateflow/json-parser/json_parser.ml
67 67
    Logs.debug (fun m -> m "parse_transition");
68 68
    {
69 69
      event          = json |> member "event"          |> Ext.parse_event;
70
      condition      = json |> member "condition"      |> Ext.parse_condition;
70
      condition      = json |> member "condition" |> Ext.parse_condition;
71 71
      condition_act  = json |> member "condition_act"  |> Ext.parse_action;
72 72
      transition_act = json |> member "transition_act" |> Ext.parse_action;
73 73
      dest           = json |> member "dest"           |> parse_dest
......
158 158
        Some initial_value
159 159
      )
160 160
end
161

  
src/tools/stateflow/json-parser/main_parse_json_file.ml
6 6

  
7 7
module ParseExt =
8 8
struct
9
  let parse_condition _ = Condition.tru
10
  let parse_action    _ = Action.nil
9
  open Yojson.Basic
10
    
11
      
12
  let remove_quotes s =
13
    let len = String.length s in
14
    if String.get s 0 = '"' && String.get s (len-1) = '"' then
15
      String.sub s 1 (len-2)
16
    else (
17
      Format.eprintf "No quotes in string %s@.@?" s;
18
      assert false
19
    )
20

  
21
  let get_vars json =
22
      let get_vdecls key json =
23
	let s = json |> Util.member key |> to_string in
24
	try
25
	  let s'= remove_quotes s in
26
	  if s' = "" then [] else  
27
	    let lexbuf = Lexing.from_string s' in
28
	    Parser_lustre.vdecl_list Lexer_lustre.token lexbuf
29
	with _ -> (Format.eprintf "Issues parsing decls for %s: %s@.@?" key s; assert false)
30
	  
31
      in
32
      let inputs = get_vdecls "inputs" json in
33
      let outputs = get_vdecls "outputs" json in
34
      let variables = get_vdecls "variables" json in
35
      inputs, outputs, variables
36
      
37
  (* Protecting the generation of condition/action in case of an empty string
38
     instead of a subtree *)
39
  let protect default parse_fun embed_fun json =
40
    try
41
      let vars = get_vars json in
42
	let actions = json |> Util.member "actions" |> to_string in
43
	if actions = "[]" || actions = "" then default (* should not happen *) else (
44
	  Format.eprintf "Parsing string: %s@." actions;
45
	  let lexbuf = Lexing.from_string (remove_quotes actions) in
46
	  try
47
	    let content = parse_fun Lexer_lustre.token lexbuf in
48
	    Parsing.clear_parser ();
49
	    embed_fun content vars
50
	  with Parsing.Parse_error ->
51
	    let loc = Location.dummy_loc in
52
	    raise (Parse.Error (loc, Parse.String_Syntax_error actions))
53
	)
54
    with Util.Type_error _ -> (
55
      Format.eprintf
56
	"Unable to explore json subtree: empty string %s@." (to_string json);
57
      default
58
    )
59
      
60
  let parse_condition =
61
    protect
62
      Condition.tru
63
      Parser_lustre.expr
64
      (fun e (in_,out_,locals_) ->
65
	(* let vars = Corelang.get_expr_vars e in *)
66
	Condition.cquote {
67
	expr =  e;
68
	cinputs = in_;
69
	coutputs = out_;
70
	cvariables = locals_;
71
	  
72
      })
73
    
74
  let parse_action =
75
    protect Action.nil Parser_lustre.stmt_list
76
      (fun (stmts, asserts, annots) (in_, out_, locals_) ->
77
	if asserts != [] || annots != [] then
78
	  assert false (* Stateflow equations should not use asserts nor define
79
			  annotations *)
80
	else
81
	  Action.aquote ({
82
	    defs = stmts;
83
	    ainputs = in_;
84
	    aoutputs = out_;
85
	    avariables = locals_;
86
	  })
87
      )
88
      
11 89
  let parse_event json  = Some Yojson.Basic.(json |> to_string)
12 90
end
13 91

  
14
module Parse = Parser (ParseExt)
92
module JParse = Parser (ParseExt)
15 93

  
16 94
(* setup for logging *)
17 95
let setup_log style_renderer level =
......
20 98
  Logs.set_reporter (Logs_fmt.reporter ());
21 99
  ()
22 100

  
101
let modular = ref 0
102

  
23 103
(* function representing the program to execute *)
24 104
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
105
  try
106
    let prog = JParse.parse_prog (Yojson.Basic.from_file file) in
107
    if pp then
108
      SF.pp_prog Format.std_formatter prog;
109

  
110
    let module Model =
111
	struct
112
	  let model = prog
113
	  let name = "toto" (* TODO find a meaningful name *)
114
	  let traces = [] (* TODO: shall we remove the traces field? *)
115
	end
116
    in
117
    let modularmode =
118
      match !modular with
119
      | 2 -> true, true, true
120
      | 1 -> false, true, false
121
      | _ (* 0 *) -> false, false ,false
122
    in
123
    let state_vars = Datatype.SF.states Model.model in
124
    let global_vars = Datatype.SF.global_vars Model.model in
125
    
126
    let module T = CPS_lustre_generator.LustrePrinter (struct
127
      let state_vars = state_vars
128
      let global_vars = global_vars 
129
    end) in
130
    let module Sem = CPS.Semantics (T) (Model) in
131
    let prog = Sem.code_gen modularmode in
132
    Options.print_dec_types := true;
133
    Format.printf "%a@." Printers.pp_prog prog;
134

  
135
    let auto_file = "sf_gen_test_auto.lus" in (* Could be changed *)
136
    let auto_out = open_out auto_file in
137
    let auto_fmt = Format.formatter_of_out_channel auto_out in
138
    Format.fprintf auto_fmt "%a@." Printers.pp_prog prog;
139

  
140
    let prog = (LustreSpec.Open ("math",false))::prog
141
    let prog, deps = Compiler_stages.stage1 prog "" "" in
142

  
143
    Format.printf "%a@." Printers.pp_prog prog;
144
    let noauto_file = "sf_gen_test_noauto.lus" in (* Could be changed *)
145
    let noauto_out = open_out noauto_file in
146
    let noauto_fmt = Format.formatter_of_out_channel noauto_out in
147
    Format.fprintf noauto_fmt "%a@." Printers.pp_prog prog
148

  
149

  
150
      
151

  
152
  with Parse.Error (l, err) -> Format.eprintf "Parse error at loc %a : %a@.@?" Location.pp_loc l Parse.pp_error err
28 153

  
29 154
(* term representing argument for file *)
30 155
let file =
......
56 181
  Term.info "parse_json_file" ~doc ~exits:Term.default_exits ~man
57 182

  
58 183
(* program *)
59
let _ = Term.exit @@ Term.eval (json_parse_t, info)
184
let _ =
185
  Term.exit @@ Term.eval (json_parse_t, info)
src/tools/stateflow/semantics/cPS_lustre_generator.ml
190 190
    match action with
191 191
    | Action.Call (c, a) -> mkcall' sin sout c a
192 192
    | Action.Quote a     ->
193
	let funname = "action_" ^ a.ident in
193
        (* TODO: check. This seems to be innappropriate *)
194
        (* let funname = "action_" ^ a.ident in
194 195
	let args = vars_to_exprl ~prefix:sin Vars.state_vars in
195 196
	let rhs = mkpredef_call funname args in
196 197
	mkstmt_eq ~prefix_lhs:sout Vars.state_vars rhs
198
	*)
199
       {
200
	 statements = a.defs;
201
	 assert_false = false
202
       }
197 203
    | Action.Open p      ->
198 204
       let vars' = ActiveStates.Vars.remove p Vars.state_vars in
199 205
       (* eq1: sout_p = true *)
......
249 255
    | Condition.Neg cond           -> mkpredef_call "not" [mkcond' sin cond]
250 256
    | Condition.And (cond1, cond2) -> mkpredef_call "&&" [mkcond' sin cond1;
251 257
							  mkcond' sin cond2]
252
    | Condition.Quote c            -> c (* TODO: shall we prefix with sin ? *)
258
    | Condition.Quote c            -> c.expr (* TODO: shall we prefix with sin ? *)
253 259

  
254 260
  let rec eval_cond condition (ok:t) ko sin sout =
255 261
    let open LustreSpec in

Also available in: Unified diff