Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scopes.ml @ 29f59e36

History | View | Annotate | Download (3.53 KB)

1
open LustreSpec 
2
open Corelang 
3
open Machine_code
4

    
5

    
6

    
7
let rec compute_scopes ?(is_first=true) prog main_node : var_decl list list =
8
  try
9
    let node = node_of_top (node_from_name main_node) in
10
    let full_local_vars = get_node_vars node in
11
    let local_vars =if is_first then full_local_vars else node.node_inputs @node.node_locals in
12
    let local_scopes = List.map (fun x -> [x]) local_vars in
13
    let sub_scopes =
14
      let sub_nodes =
15
	List.fold_left 
16
	  (fun res eq -> 
17
	    match eq.eq_rhs.expr_desc with 
18
	      | Expr_appl (id, _, _) -> (* Obtaining the var_del associated to the first var of eq_lhs *)
19
		let vid = List.find (fun v -> v.var_id = List.hd eq.eq_lhs) full_local_vars in
20
		(id, vid)::res 
21
	    | _ -> res
22
	  ) [] (get_node_eqs node)
23
      in
24
      List.map (fun (id, vid) ->
25
      let scopes = compute_scopes ~is_first:false prog id in
26
      List.map (fun s -> vid :: s) scopes
27
      ) sub_nodes
28
    in
29
    local_scopes @ (List.flatten sub_scopes) 
30
  with Not_found -> []
31

    
32

    
33
let print_scopes =
34
  Utils.fprintf_list ~sep:"@." 
35
    (fun fmt vl -> 
36
      Format.fprintf fmt "%a: %a"
37
	(Utils.fprintf_list ~sep:"." (fun fmt v -> Format.fprintf fmt "%s" v.var_id)) vl
38
	Types.print_ty ((List.hd (List.rev vl)).var_type)
39
    ) 
40

    
41
let print_path fmt p = 
42
  Utils.fprintf_list ~sep:"." (fun fmt (id, _) -> Format.pp_print_string fmt id) fmt p
43

    
44
let scope_path main_node_name prog machines all_scopes sl : (string * node_desc) list * var_decl =
45
  let rec get_path node id_list (accu: (string * node_desc) list) =
46
    match id_list with
47
      | [id] -> 
48
	let last_node = snd (List.hd accu) in
49
	let id_vdecl = get_node_var id last_node in
50
	List.rev accu, id_vdecl
51
      | id::id_list_tl ->
52
	let e_machine = Utils.desome (get_machine_opt node.node_id machines) in 
53
	Format.eprintf "Machine %a@." Machine_code.pp_machine e_machine;
54
	let instance = 
55
	  List.find 
56
	    (fun i -> match i with | MStep(p, o, _) -> List.exists (fun x -> x.var_id = id) p | _ -> false) 
57
	    e_machine.mstep.step_instrs 
58
	in
59
	let instance_id, instance_node_id = 
60
	  match instance with 
61
	  | MStep(_, o, _) -> o , (
62
	    let n, _ = List.assoc o e_machine.minstances in
63
	    (* node_name *) (node_name n:string)
64
	  )
65
	    | _ -> assert false
66
	in
67
	
68
	let next_node: node_desc = node_of_top (node_from_name (instance_node_id)) in
69
	let accu = (instance_id, next_node)::accu in
70
	get_path next_node id_list_tl accu
71
      | [] -> assert false
72
  in
73
  let all_scopes_as_strings = List.map (List.map (fun v -> v.var_id)) all_scopes in
74
  if not (List.mem sl all_scopes_as_strings) then (
75
    Format.eprintf "%s is an invalid scope.@." (String.concat "." sl);
76
    exit 1
77
  )
78
  else (
79
    Format.eprintf "@.@.Required path: %s@." (String.concat "." sl); 
80
    let main_node = node_from_name main_node_name in
81
    let path, flow = (* Special treatment of first level flow *)
82
      match sl with 
83
	| [flow] -> let flow_var = get_node_var flow (node_of_top main_node) in
84
		    [], flow_var 
85
	| _ -> get_path (node_of_top main_node) sl [] in
86
    Format.eprintf "computed path: %a.%s@." print_path path flow.var_id;
87
    path, flow
88
  )
89

    
90
let all_scopes = ref []
91

    
92
let compute_all_scopes prog = 
93
  all_scopes := compute_scopes prog !Options.main_node 
94
  
95
let print_all_scopes fmt () =
96
  print_scopes fmt !all_scopes
97

    
98
let checked_scopes = ref []
99

    
100
let check_scopes prog machines =
101
 let scopes = !Options.scopes in
102
 let main_node_name = !Options.main_node in
103
 checked_scopes :=
104
   List.map
105
    (fun sl ->
106
      sl, scope_path main_node_name prog machines !all_scopes sl 
107
    ) scopes
108
    
109
(* Local Variables: *)
110
(* compile-command:"make -C .." *)
111
(* End: *)