Revision 9c4cc944
Added by Corentin Lauverjat over 1 year ago
src/mutation.ml  

10  10 
*) 
11  11  
12  12  
13 
open Lustre_types 

14 
open Corelang 

15 
open Log 

13 
open Lustrec.Lustre_types


14 
open Lustrec.Corelang


15 
open Lustrec.Log


16  16 
open Format 
17  17  
18  18 
let random_seed = ref 0 
...  ...  
30  30 
let int_consts = ref [] 
31  31  
32  32 
let rename_app id = 
33 
if List.mem id Basic_library.internal_funs  

34 
!Options.no_mutation_suffix then 

33 
if List.mem id Lustrec.Basic_library.internal_funs 


34 
!Lustrec.Options.no_mutation_suffix then


35  35 
id 
36  36 
else 
37 
let node = Corelang.node_from_name id in 

37 
let node = Lustrec.Corelang.node_from_name id in


38  38 
let is_imported = 
39  39 
match node.top_decl_desc with 
40  40 
 ImportedNode _ > true 
...  ...  
97  97  
98  98 
let rec compute_records_expr expr = 
99  99 
let boolexpr = 
100 
if Types.is_bool_type expr.expr_type then 

100 
if Lustrec.Types.is_bool_type expr.expr_type then


101  101 
{empty_records with nb_boolexpr = 1} 
102  102 
else 
103  103 
empty_records 
...  ...  
162  162 
else 
163  163 
None 
164  164  
165 
let mk_cst_expr c = mkexpr Location.dummy_loc (Expr_const c) 

165 
let mk_cst_expr c = mkexpr Lustrec.Location.dummy_loc (Expr_const c)


166  166  
167  167 
let rdm_mutate_int i = 
168  168 
if Random.int 100 > threshold_inc_int then 
...  ...  
188  188 
let eshift = 10. ** (float_of_int shift) in 
189  189 
let i = Random.int (1 + bound * (int_of_float eshift)) in 
190  190 
let f = float_of_int i /. eshift in 
191 
Real.create (string_of_int i) shift (string_of_float f) 

191 
Lustrec.Real.create (string_of_int i) shift (string_of_float f)


192  192 
else 
193  193 
r 
194  194  
...  ...  
207  207  
208  208  
209  209 
let rdm_mutate_var expr = 
210 
if Types.is_bool_type expr.expr_type then 

210 
if Lustrec.Types.is_bool_type expr.expr_type then


211  211 
(* if Random.int 100 > threshold_negate_bool_var then *) 
212  212 
let new_e = mkpredef_call expr.expr_loc "not" [expr] in 
213  213 
Some (expr, new_e), new_e 
...  ...  
296  296 
(* Other constructs are kept. 
297  297 
 Expr_fby of expr * expr 
298  298 
 Expr_array of expr list 
299 
 Expr_access of expr * Dimension.dim_expr 

300 
 Expr_power of expr * Dimension.dim_expr 

299 
 Expr_access of expr * Lustrec.Dimension.dim_expr


300 
 Expr_power of expr * Lustrec.Dimension.dim_expr


301  301 
 Expr_when of expr * ident * label 
302  302 
 Expr_merge of ident * (label * expr) list 
303  303 
 Expr_uclock of expr * int 
...  ...  
315  315 
 Eq eq > let mut, new_eq = rdm_mutate_eq eq in 
316  316 
report ~level:1 
317  317 
(fun fmt > fprintf fmt "mutation: %a becomes %a@ " 
318 
Printers.pp_node_eq eq 

319 
Printers.pp_node_eq new_eq); 

318 
Lustrec.Printers.pp_node_eq eq


319 
Lustrec.Printers.pp_node_eq new_eq);


320  320 
mut, Eq new_eq 
321  321 
 Aut aut > assert false 
322  322  
...  ...  
378  378 
 SwitchIntCst of int * int 
379  379  
380  380 
(* Denotes the parent node, the equation lhs and the location of the mutation *) 
381 
type mutation_loc = ident * ident list * Location.t 

381 
type mutation_loc = ident * ident list * Lustrec.Location.t


382  382 
let target : mutant_t option ref = ref None 
383  383  
384  384 
let mutation_info : mutation_loc option ref = ref None 
385  385 
let current_node: ident option ref = ref None 
386  386 
let current_eq_lhs : ident list option ref = ref None 
387 
let current_loc : Location.t option ref = ref None 

387 
let current_loc : Lustrec.Location.t option ref = ref None


388  388 

389  389 
let set_mutation_loc () = 
390  390 
target := None; 
...  ...  
414  414 
let print_loc_json fmt (n,eqlhs, l) = 
415  415 
Format.fprintf fmt "\"node_id\": \"%s\", \"eq_lhs\": [%a], \"loc_line\": \"%i\"" 
416  416 
n 
417 
(Utils.fprintf_list ~sep:", " (fun fmt s > Format.fprintf fmt "\"%s\"" s)) eqlhs 

418 
(Location.loc_line l) 

417 
(Lustrec.Utils.fprintf_list ~sep:", " (fun fmt s > Format.fprintf fmt "\"%s\"" s)) eqlhs


418 
(Lustrec.Location.loc_line l)


419  419 

420  420 
let fold_mutate_int i = 
421  421 
if Random.int 100 > threshold_inc_int then 
...  ...  
463  463  
464  464  
465  465 
let fold_mutate_var expr = 
466 
(* match (Types.repr expr.expr_type).Types.tdesc with *)


467 
(*  Types.Tbool > *) 

466 
(* match (Lustrec.Types.repr expr.expr_type).Lustrec.Types.tdesc with *)


467 
(*  Lustrec.Types.Tbool > *)


468  468 
(* (\* if Random.int 100 > threshold_negate_bool_var then *\) *) 
469 
(* mkpredef_unary_call Location.dummy_loc "not" expr *) 

469 
(* mkpredef_unary_call Lustrec.Location.dummy_loc "not" expr *)


470  470 
(* (\* else *\) *) 
471  471 
(* (\* expr *\) *) 
472  472 
(*  _ > 
...  ...  
538  538 
(* Other constructs are kept. 
539  539 
 Expr_fby of expr * expr 
540  540 
 Expr_array of expr list 
541 
 Expr_access of expr * Dimension.dim_expr 

542 
 Expr_power of expr * Dimension.dim_expr 

541 
 Expr_access of expr * Lustrec.Dimension.dim_expr


542 
 Expr_power of expr * Lustrec.Dimension.dim_expr


543  543 
 Expr_when of expr * ident * label 
544  544 
 Expr_merge of ident * (label * expr) list 
545  545 
 Expr_uclock of expr * int 
...  ...  
551  551 
{ expr with expr_desc = new_desc } 
552  552 
) 
553  553 
in 
554 
if Types.is_bool_type expr.expr_type then 

554 
if Lustrec.Types.is_bool_type expr.expr_type then


555  555 
fold_mutate_boolexpr new_expr 
556  556 
else 
557  557 
new_expr 
...  ...  
613  613 
assert false 
614  614 
) 
615  615 
in 
616 
(* Format.eprintf "Mutation op %s to [%a]@." op (Utils.fprintf_list ~sep:"," Format.pp_print_string) res; *) 

616 
(* Format.eprintf "Mutation op %s to [%a]@." op (Lustrec.Utils.fprintf_list ~sep:"," Format.pp_print_string) res; *)


617  617 
res 
618  618  
619  619 
let rec remains select list = 
Also available in: Unified diff
Transition to dune build system
Improvement of opam integration
Dockerfile based on Alpine
Dockerfile based on Ubuntu
Update the README.md