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: *) |