Project

General

Profile

Revision bc7b6c62

View differences:

src/automata.ml
61 61 
      | Aut aut -> List.fold_left handler_write write aut.aut_handlers) writes handler.hand_stmts
62 62 
  in ISet.diff allvars locals
63 63 

  		




  64
  
  
    
let node_of_handler node aut_id handler =


  		




  
  64
  
    
let node_of_handler nused node aut_id handler =


  		




  65
  65
  
    
  let inputs = handler_read ISet.empty handler in


  		




  66
  66
  
    
  let outputs = handler_write ISet.empty handler in


  		




  67
  67
  
    
  {


  		




  68
  
  
    
    node_id = Format.sprintf "%s_%s_handler" aut_id handler.hand_state;


  		




  
  68
  
    
    node_id = mk_new_name nused (Format.sprintf "%s_%s_handler" aut_id handler.hand_state);


  		




  69
  69
  
    
    node_type = Types.new_var ();


  		




  70
  70
  
    
    node_clock = Clocks.new_var true;


  		




  71
  71
  
    
    node_inputs = List.map (fun v -> get_node_var v node) (ISet.elements inputs);


  		




  ......




  95
  95
  
    
  let assign_eq = mkeq loc (List.map (fun v -> v.var_id) outputs, assign_expr) in


  		




  96
  96
  
    
  assign_eq


  		




  97
  97
  
    

  		




  98
  
  
    
let typedef_of_automata node aut =


  		




  
  98
  
    
let typedef_of_automata aut =


  		




  99
  99
  
    
  let tname = Format.sprintf "%s_type" aut.aut_id in


  		




  100
  100
  
    
  { tydef_id = tname;


  		




  101
  101
  
    
    tydef_desc = Tydec_enum (List.map (fun h -> h.hand_state) aut.aut_handlers)


  		




  102
  102
  
    
  }


  		




  103
  
  
    
(*


  		




  104
  
  
    
let expand_automata_stmt (top_decls, locals, eqs) stmt =


  		




  105
  
  
    
  match stmt with


  		




  106
  
  
    
  | Eq eq -> (top_decls, locals, eq::eqs)


  		




  107
  
  
    
  | Aut aut ->


  		




  108
  103
  
    

  		




  109
  
  
    

  		




  110
  
  
    
let expand_automata top_node aut =


  		




  111
  
  
    
  let node = node_of_top top_node in


  		




  112
  
  
    
  let owner = top_node.top_decl_owner in


  		




  113
  
  
    
  let typedef = typedef_of_automata node aut in


  		




  
  104
  
    
let expand_automata nused used owner typedef node aut =


  		




  114
  105
  
    
  let initial = (List.hd aut.aut_handlers).hand_state in


  		




  115
  
  
    
  let incoming_r = mk_new_name (get_node_vars node) (aut.aut_id ^ "__restart_in") in


  		




  116
  
  
    
  let incoming_s = mk_new_name (get_node_vars node) (aut.aut_id ^ "__state_in") in


  		




  117
  
  
    
  let actual_r = mk_new_name (get_node_vars node) (aut.aut_id ^ "__restart_act") in


  		




  118
  
  
    
  let actual_s = mk_new_name (get_node_vars node) (aut.aut_id ^ "__state_act") in


  		




  
  106
  
    
  let incoming_r = mk_new_name used (aut.aut_id ^ "__restart_in") in


  		




  
  107
  
    
  let incoming_s = mk_new_name used (aut.aut_id ^ "__state_in") in


  		




  
  108
  
    
  let actual_r = mk_new_name used (aut.aut_id ^ "__restart_act") in


  		




  
  109
  
    
  let actual_s = mk_new_name used (aut.aut_id ^ "__state_act") in


  		




  119
  110
  
    
  let unless_handlers = List.map (fun h -> (h.hand_state, expr_of_exit h.hand_loc incoming_r incoming_s h.hand_unless h.hand_state)) aut.aut_handlers in


  		




  120
  111
  
    
  let unless_expr = mkexpr aut.aut_loc (Expr_merge (incoming_s, unless_handlers)) in


  		




  121
  112
  
    
  let unless_eq = mkeq aut.aut_loc ([actual_r; actual_s], unless_expr) in


  		




  ......




  123
  114
  
    
  let until_expr = mkexpr aut.aut_loc (Expr_merge (actual_s, until_handlers)) in


  		




  124
  115
  
    
  let fby_until_expr = mkfby aut.aut_loc (init aut.aut_loc tag_false initial) until_expr in


  		




  125
  116
  
    
  let until_eq = mkeq aut.aut_loc ([incoming_r; incoming_s], fby_until_expr) in


  		




  126
  
  
    
  let hnodes = List.map (fun h -> (h.hand_state, node_of_handler node aut.aut_id h)) aut.aut_handlers in


  		




  
  117
  
    
  let hnodes = List.map (fun h -> (h.hand_state, node_of_handler nused node aut.aut_id h)) aut.aut_handlers in


  		




  127
  118
  
    
  let assign_eq = assign_aut_handlers aut.aut_loc actual_r actual_s hnodes in


  		




  128
  119
  
    
  let tydec_bool = { ty_dec_desc = Tydec_bool; ty_dec_loc = aut.aut_loc } in


  		




  129
  120
  
    
  let tydec_const id = { ty_dec_desc = Tydec_const id; ty_dec_loc = aut.aut_loc } in


  		




  ......




  133
  124
  
    
                 mkvar_decl aut.aut_loc (incoming_s, tydec_const typedef.tydef_id, ckdec_any, false);


  		




  134
  125
  
    
                 mkvar_decl aut.aut_loc (actual_s  , tydec_const typedef.tydef_id, ckdec_any, false)] in


  		




  135
  126
  
    
  let eqs' = [Eq unless_eq; Eq assign_eq; Eq until_eq] in


  		




  136
  
  
    
  let node' = { node with node_locals = locals'@node.node_locals; node_stmts = eqs'@node.node_stmts } in


  		




  137
  
  
    
  (mktop_decl aut.aut_loc owner false (TypeDef typedef)) ::


  		




  138
  
  
    
  { top_node with top_decl_desc = Node node' } ::


  		




  139
  
  
    
  (List.map2 (fun h (hs, n) -> mktop_decl h.hand_loc owner false (Node n)) aut.aut_handlers hnodes)


  		




  140
  
  
    
*)


  		




  141
  
  
    
let rec node_extract_automata top_decl =


  		




  142
  
  
    
  match top_decl.top_decl_desc with


  		




  143
  
  
    
  | Node nd -> []


  		




  144
  
  
    
  | _ -> [top_decl]


  		




  145
  
  
    
(*


  		




  146
  
  
    
let extract_automata top_decls =


  		




  147
  
  
    
 List.fold_left (fun top_decls top_decl -> ) top_decls


  		




  148
  
  
    
*)


  		




  
  127
  
    
  (List.map2 (fun h (hs, n) -> mktop_decl h.hand_loc owner false (Node n)) aut.aut_handlers hnodes,


  		




  
  128
  
    
  locals',


  		




  
  129
  
    
  eqs')


  		




  
  130
  
    

  		




  
  131
  
    
let expand_node_stmt nused used owner node (top_types, top_nodes, locals, eqs) stmt =


  		




  
  132
  
    
  match stmt with


  		




  
  133
  
    
  | Eq eq -> (top_types, top_nodes, locals, (Eq eq)::eqs)


  		




  
  134
  
    
  | Aut aut ->


  		




  
  135
  
    
    let typedef = typedef_of_automata aut in


  		




  
  136
  
    
    let used' name = used name || List.exists (fun v -> v.var_id = name) locals in


  		




  
  137
  
    
    let nused' name =


  		




  
  138
  
    
      nused name ||


  		




  
  139
  
    
      List.exists (fun t -> match t.top_decl_desc with


  		




  
  140
  
    
      | ImportedNode nd -> nd.nodei_id = name | Node nd -> nd.node_id = name


  		




  
  141
  
    
      | _ -> false) top_nodes in


  		




  
  142
  
    
    let (top_decls', locals', eqs') = expand_automata nused' used' owner typedef node aut in


  		




  
  143
  
    
    let top_typedef = mktop_decl aut.aut_loc owner false (TypeDef typedef) in


  		




  
  144
  
    
    (top_typedef :: top_types, top_decls'@top_nodes, locals'@locals, eqs'@eqs)


  		




  
  145
  
    

  		




  
  146
  
    
let expand_node_stmts nused used loc owner node =


  		




  
  147
  
    
  let (top_types', top_nodes', locals', eqs') =


  		




  
  148
  
    
    List.fold_left (expand_node_stmt nused used owner node) ([], [], [], []) node.node_stmts in


  		




  
  149
  
    
  let node' = 


  		




  
  150
  
    
    { node with node_locals = locals'@node.node_locals; node_stmts = eqs' } in


  		




  
  151
  
    
  let top_node = mktop_decl loc owner false (Node node') in


  		




  
  152
  
    
  top_types', top_node, top_nodes'


  		




  
  153
  
    

  		




  
  154
  
    
let rec expand_decls_rec nused top_decls =


  		




  
  155
  
    
  match top_decls with


  		




  
  156
  
    
  | [] -> []


  		




  
  157
  
    
  | top_decl::q ->


  		




  
  158
  
    
    match top_decl.top_decl_desc with


  		




  
  159
  
    
    | Node nd ->


  		




  
  160
  
    
      let used name =


  		




  
  161
  
    
	   List.exists (fun v -> v.var_id = name) nd.node_inputs


  		




  
  162
  
    
	|| List.exists (fun v -> v.var_id = name) nd.node_outputs


  		




  
  163
  
    
	|| List.exists (fun v -> v.var_id = name) nd.node_locals in


  		




  
  164
  
    
      let (top_types', top_decl', top_nodes') = expand_node_stmts nused used top_decl.top_decl_loc top_decl.top_decl_owner nd in


  		




  
  165
  
    
      top_types' @ (top_decl' :: expand_decls_rec nused (top_nodes'@q))


  		




  
  166
  
    
    | _       -> top_decl :: expand_decls_rec nused q


  		




  
  167
  
    

  		




  
  168
  
    
let expand_decls top_decls =


  		




  
  169
  
    
  let top_names = List.fold_left (fun names t -> match t.top_decl_desc with


  		




  
  170
  
    
    | Node nd         -> ISet.add nd.node_id names


  		




  
  171
  
    
    | ImportedNode nd -> ISet.add nd.nodei_id names


  		




  
  172
  
    
    | _               -> names) ISet.empty top_decls in


  		




  
  173
  
    
  let nused name = ISet.mem name top_names in


  		




  
  174
  
    
  expand_decls_rec nused top_decls


  		




  
  175
  
    

  		




  149
  176
  
    
(* Local Variables: *)


  		




  150
  177
  
    
(* compile-command:"make -C .." *)


  		




  151
  178
  
    
(* End: *)


  		




  
  179
  
    

  		












  

    
      src/main_lustre_compiler.ml
    
  





  89
  89
  
    

  		




  90
  90
  
    
  (* Extracting dependencies *)


  		




  91
  91
  
    
  let dependencies, type_env, clock_env = import_dependencies prog in


  		




  92
  
  
    
 


  		




  
  92
  
    

  		




  
  93
  
    
  (* Removing automata *) 


  		




  
  94
  
    
  (*let prog = Automata.expand_decls prog in*)


  		




  
  95
  
    

  		




  
  96
  
    
  (*Printers.pp_prog Format.std_formatter prog;*)


  		




  93
  97
  
    
  (* Sorting nodes *)


  		




  94
  98
  
    
  let prog = SortProg.sort prog in


  		




  95
  99
  
    

  		












  

    
      src/parser_lustre.mly
    
  





  259
  259
  
    
| automaton stmt_list {let eql, assertl, annotl = $2 in ((Aut $1)::eql), assertl, annotl}


  		




  260
  260
  
    

  		




  261
  261
  
    
automaton:


  		




  262
  
  
    
 AUTOMATON type_ident handler_list { (Automata.mkautomata (get_loc ()) $2 $3); failwith "not implemented" }


  		




  
  262
  
    
 AUTOMATON type_ident handler_list { Automata.mkautomata (get_loc ()) $2 $3 }


  		




  263
  263
  
    

  		




  264
  264
  
    
handler_list:


  		




  265
  265
  
    
     { [] }


  		












Also available in:  Unified diff