Revision 3b2bd83d
Added by Teme Kahsai about 8 years ago
src/stateless.ml | ||
---|---|---|
13 | 13 |
open Corelang |
14 | 14 |
|
15 | 15 |
type error = |
16 |
| Stateful_kwd of ident |
|
17 |
| Stateful_imp of ident |
|
16 |
| Stateful_kwd of ident |
|
17 |
| Stateful_imp of ident |
|
18 |
| Stateful_ext_C of ident |
|
18 | 19 |
|
19 | 20 |
exception Error of Location.t * error |
20 | 21 |
|
... | ... | |
34 | 35 |
| Expr_merge (i, hl) -> List.for_all (fun (t, h) -> check_expr h) hl |
35 | 36 |
| Expr_appl (i, e', i') -> |
36 | 37 |
check_expr e' && |
37 |
(Basic_library.is_internal_fun i || check_node (node_from_name i))
|
|
38 |
(Basic_library.is_stateless_fun i || check_node (node_from_name i))
|
|
38 | 39 |
and compute_node nd = |
39 | 40 |
List.for_all (fun eq -> check_expr eq.eq_rhs) (get_node_eqs nd) |
40 | 41 |
and check_node td = |
... | ... | |
50 | 51 |
else (nd.node_dec_stateless <- stateless; stateless) |
51 | 52 |
end |
52 | 53 |
| Some stl -> stl) |
53 |
| ImportedNode nd -> nd.nodei_stateless |
|
54 |
| ImportedNode nd -> |
|
55 |
begin |
|
56 |
(if nd.nodei_prototype = Some "C" && not nd.nodei_stateless |
|
57 |
then raise (Error (td.top_decl_loc, Stateful_ext_C nd.nodei_id))); |
|
58 |
nd.nodei_stateless |
|
59 |
end |
|
54 | 60 |
| _ -> true |
55 | 61 |
|
56 | 62 |
let check_prog decls = |
57 | 63 |
List.iter (fun td -> ignore (check_node td)) decls |
58 | 64 |
|
65 |
|
|
66 |
let force_prog decls = |
|
67 |
let force_node td = |
|
68 |
match td.top_decl_desc with |
|
69 |
| Node nd -> ( |
|
70 |
nd.node_dec_stateless <- false; |
|
71 |
nd.node_stateless <- Some false) |
|
72 |
| _ -> () |
|
73 |
in |
|
74 |
List.iter (fun td -> ignore (force_node td)) decls |
|
75 |
|
|
59 | 76 |
let check_compat_decl decl = |
60 | 77 |
match decl.top_decl_desc with |
61 | 78 |
| ImportedNode nd -> |
... | ... | |
75 | 92 |
let pp_error fmt err = |
76 | 93 |
match err with |
77 | 94 |
| Stateful_kwd nd -> |
78 |
Format.fprintf fmt |
|
79 |
"node %s should be stateless but is actually stateful.@." |
|
80 |
nd |
|
95 |
Format.fprintf fmt
|
|
96 |
"node %s should be stateless but is actually stateful.@."
|
|
97 |
nd
|
|
81 | 98 |
| Stateful_imp nd -> |
82 |
Format.fprintf fmt |
|
83 |
"node %s is declared stateless but is actually stateful.@." |
|
84 |
nd |
|
99 |
Format.fprintf fmt |
|
100 |
"node %s is declared stateless but is actually stateful.@." |
|
101 |
nd |
|
102 |
| Stateful_ext_C nd -> |
|
103 |
Format.fprintf fmt |
|
104 |
"node %s with declared prototype C cannot be stateful, it has to be a function.@." |
|
105 |
nd |
|
85 | 106 |
|
86 | 107 |
(* Local Variables: *) |
87 | 108 |
(* compile-command:"make -C .." *) |
Also available in: Unified diff
updating to onera version 30f766a:2016-12-04