Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / automata.ml @ ef34b4ae

History | View | Annotate | Download (2.81 KB)

1
(********************************************************************)
2
(*                                                                  *)
3
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
4
(*  Copyright 2012 -    --   ONERA - CNRS - INPT                    *)
5
(*                                                                  *)
6
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
7
(*  under the terms of the GNU Lesser General Public License        *)
8
(*  version 2.1.                                                    *)
9
(*                                                                  *)
10
(********************************************************************)
11

    
12
open LustreSpec
13
open Corelang
14

    
15
let mkbool loc b =
16
 mkexpr loc (Expr_const (const_of_bool b))
17

    
18
let mkident loc id =
19
 mkexpr loc (Expr_ident id)
20

    
21
let init (loc, restart, st) =
22
 mkexpr loc (Expr_tuple [mkbool loc restart; mkident loc st])
23

    
24
let add_branch expr (loc, restart, st) cont =
25
 mkexpr loc (Expr_ite (expr, init (loc, restart, st), cont))
26

    
27
let mkhandler loc st unless until locals eqs =
28
 {hand_state = st;
29
  hand_unless = unless;
30
  hand_until = until;
31
  hand_locals = locals;
32
  hand_eqs = eqs;
33
  hand_loc = loc}
34

    
35
let mkautomata loc id handlers =
36
  {aut_id = id;
37
   aut_handlers = handlers;
38
   aut_loc = loc}
39

    
40
let pp_restart fmt restart =
41
  Format.fprintf fmt "%s" (if restart then "restart" else "resume")
42

    
43
let pp_unless fmt (expr, restart, st) =
44
  Format.fprintf fmt "unless %a %a %s"
45
    Printers.pp_expr expr
46
    pp_restart restart
47
    st
48

    
49
let pp_until fmt (expr, restart, st) =
50
  Format.fprintf fmt "until %a %a %s"
51
    Printers.pp_expr expr
52
    pp_restart restart
53
    st
54

    
55
let pp_handler fmt handler =
56
  Format.fprintf fmt "state %s -> %a %a let %a tel %a"
57
    handler.hand_state
58
    (Utils.fprintf_list ~sep:"@ " pp_unless) handler.hand_unless
59
    (fun fmt locals ->
60
      match locals with [] -> () | _ ->
61
	Format.fprintf fmt "@[<v 4>var %a@]@ " 
62
	  (Utils.fprintf_list ~sep:"@ " 
63
	     (fun fmt v -> Format.fprintf fmt "%a;" Printers.pp_node_var v))
64
	  locals)
65
    handler.hand_locals
66
    Printers.pp_node_eqs handler.hand_eqs
67
    (Utils.fprintf_list ~sep:"@ " pp_until) handler.hand_until
68

    
69
let pp_automata fmt aut =
70
  Format.fprintf fmt "automaton %s %a"
71
    aut.aut_id
72
    (Utils.fprintf_list ~sep:"@ " pp_handler) aut.aut_handlers
73

    
74
(*
75
let rec extract_node expr top_decls =
76
  match expr.expr_desc with
77
  | Expr_const _
78
  | Expr_ident _
79
  | Expr_tuple _
80
  | Expr_ite   of expr * expr * expr
81
  | Expr_arrow of expr * expr
82
  | Expr_fby of expr * expr
83
  | Expr_array of expr list
84
  | Expr_access of expr * Dimension.dim_expr
85
  | Expr_power of expr * Dimension.dim_expr
86
  | Expr_pre of expr
87
  | Expr_when of expr * ident * label
88
  | Expr_merge of ident * (label * expr) list
89
  | Expr_appl
90
*)
91

    
92
(* Local Variables: *)
93
(* compile-command:"make -C .." *)
94
(* End: *)