Vous avez reçu un message "Your GitLab account has been locked ..." ? Pas d'inquiétude : lisez cet article https://docs.gricad-pages.univ-grenoble-alpes.fr/help/unlock/

lutinRun.ml 4.52 KB
Newer Older
1
(* Time-stamp: <modified the 10/04/2019 (at 10:10) by Erwan Jahier> *)
2
(**********************************************************************************)
3
type vars = (string * Data.t) list
4

5
6
let (var_to_var_pair: Exp.var -> string * Data.t) =
  fun v -> Var.name v, Type.to_data_t (Var.typ v)
7

8
let (to_subst_list : (string * Data.t) list -> Value.OfIdent.t -> Data.subst list) =
9
  fun var_decl vals -> 
10
11
    try List.map (fun (n,_) -> n, Value.to_data_val (Value.OfIdent.get vals n)) var_decl
    with Not_found -> assert false
12

13
14
15
16
17
18
19
(* ditto, but without taking care of variable order *)
let (from_vals : Value.OfIdent.t -> Data.subst list) = fun vals -> 
  Value.OfIdent.fold (fun id v acc -> (id,Value.to_data_val v)::acc) vals []

let (to_vals : Data.subst list -> Value.OfIdent.t) =
  List.fold_left
    (fun acc (n,v) -> Value.OfIdent.add acc (n, Value.from_data_val v))
20
    Value.OfIdent.empty
21

22
open RdbgPlugin
23
24
type ctx = Event.t
type e = Event.t
25

26

27
let make argv =
28
  let opt = MainArg.parse argv in
29
  let prog = MainArg.infile opt
30
  and node = MainArg.main_node opt
31
  in
32
  let seed = MainArg.seed opt in
33
  let lut_mach = LutExe.make opt prog node in
34
35
  let lut_in  = List.map var_to_var_pair (LutExe.in_var_list  lut_mach) in 
  let lut_out = List.map var_to_var_pair (LutExe.out_var_list lut_mach) in 
36
  let lut_memories =
37
38
39
    (*     if LtopArg.args.LtopArg.delay_env_outputs then *)
    (*       LutExe.get_init_pres lut_mach *)
    (*     else *)
40
    Value.OfIdent.empty
41
42
43
  in
  let ctrl_state = ref (LutExe.get_init_state lut_mach) in
  let data_state = ref
44
45
46
47
      { LutExe.ins = Value.OfIdent.empty;
        LutExe.outs = lut_memories;
        LutExe.mems = LutExe.get_init_pres lut_mach
      }
48
  in
49
50
  let ss_table = Hashtbl.create 10 in

51
52
53
  let lut_step sl =
    let _ = data_state := { !data_state with LutExe.ins = to_vals sl } in
    let new_cs, new_ds =  LutExe.step lut_mach !ctrl_state !data_state in
54
55
56
    ctrl_state := new_cs;
    data_state := new_ds;
    to_subst_list lut_out new_ds.LutExe.outs
57
  in
58
  let (lut_step_dbg: 
59
60
         Data.subst list -> ctx ->       
       (Data.subst list -> ctx -> Event.t) -> Event.t) =
61
    fun sl ctx cont -> 
62
      let cont_lut_step ctx = 
63
64
65
66
67
        fun new_cs new_ds -> 
          ctrl_state := new_cs;
          data_state := new_ds;
          cont (to_subst_list lut_out new_ds.LutExe.outs) ctx
      in
68
69
      data_state := { !data_state with LutExe.ins = to_vals sl };
      LutExe.step_ldbg ctx node lut_mach !ctrl_state !data_state cont_lut_step
70
  in
71
72
73
  let mems_in = 
    List.fold_left
      (fun acc (vn,_vt) -> 
74
75
76
77
         try 
           let v = Value.OfIdent.get lut_memories vn in
           (vn, Value.to_data_val v)::acc
         with Not_found -> acc
78
79
80
81
82
83
84
      )
      []
      lut_in
  in
  let mems_out = 
    List.fold_left
      (fun acc (vn,_vt) -> 
85
86
87
88
         try 
           let v = Value.OfIdent.get lut_memories vn in
           (vn, Value.to_data_val v)::acc
         with Not_found -> acc
89
90
91
92
      )
      []
      lut_out
  in
93
94
95
96
97
98
99
  let argv_list = Array.to_list argv in 
  let argv_str = String.concat " " argv_list in
  let id =
    if List.mem "-seed" argv_list then argv_str else
      argv_str ^ " -seed " ^ (string_of_int seed)
  in
  let version = Printf.sprintf "with lutin Version %s (\"%s\")" Version.str Version.sha in
100
  {
101
    id = Printf.sprintf "%s (%s)" id version;
102
103
    inputs = lut_in;
    outputs= lut_out;
104
105
106
107
108
109
110
111
    reset = (fun () -> (
          ctrl_state := (LutExe.get_init_state lut_mach);
          data_state := 
            { LutExe.ins = Value.OfIdent.empty;
              LutExe.outs = lut_memories;
              LutExe.mems = LutExe.get_init_pres lut_mach
            }
        ));
112
    kill=(fun _ -> ());
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
    save_state = (fun i ->
        let prgs = Random.get_state () in
        if Verbose.level() > 0 then (
          Printf.eprintf "Save  state %i from Lutin (%i)\n" i
            (Random.State.bits (Random.State.copy prgs));
          flush stderr);
        Hashtbl.replace ss_table i (!ctrl_state, !data_state, prgs)
      );
    restore_state = (fun i ->
        match Hashtbl.find_opt ss_table i with
        | Some (cs, ds, prgs) ->
          if Verbose.level() > 0 then (          
            Printf.eprintf "Restore state %i from Lutin (%i)\n" i
              (Random.State.bits (Random.State.copy prgs));
            flush stderr
          );
          ctrl_state := cs; data_state := ds;
          Random.set_state prgs;
        | None  -> Printf.eprintf "Cannot restore state %i from Lutin\n" i; flush stderr 
      );
133
134
135
136
137
    init_inputs=mems_in;
    init_outputs=mems_out;
    step=lut_step;     
    step_dbg=lut_step_dbg;
  }
138
139


140

141