Project

General

Profile

Revision 3b2bd83d src/stateless.ml

View differences:

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