Project

General

Profile

Revision 7ecfca04 src/mutation.ml

View differences:

src/mutation.ml
1 1
open Corelang
2
open LustreSpec
2 3
open Log
3 4
open Format
4 5

  
......
102 103

  
103 104
let compute_records_eq eq = compute_records_expr eq.eq_rhs
104 105

  
106
let compute_records_stmt s =
107
  match s with
108
  | Eq eq -> compute_records_expr eq.eq_rhs
109
  | _ -> empty_records (* Automata should have been desintegrate by now *)
110

  
105 111
let compute_records_node nd = 
106
  merge_records (List.map compute_records_eq nd.node_eqs)
112
  merge_records (List.map compute_records_stmt nd.node_stmts)
107 113

  
108 114
let compute_records_top_decl td =
109 115
  match td.top_decl_desc with
110 116
  | Node nd -> compute_records_node nd
111
  | Consts constsl -> merge_records (List.map (fun c -> compute_records_const_value c.const_value) constsl)
117
  | Const const -> compute_records_const_value const.const_value
112 118
  | _ -> empty_records
113 119

  
114 120
let compute_records prog = 
......
188 194
let rdm_mutate_const_value c =
189 195
  match c with
190 196
  | Const_int i -> Const_int (rdm_mutate_int i)
191
  | Const_real s ->  Const_real s (* those are string, let's leave them *)
192
  | Const_float f -> Const_float (rdm_mutate_float f)
197
  | Const_real (num, npow, s) as c ->  c
198
  (* OTOD: mutation disable here, should look at rdm_mutate_float f and adapt it *)
193 199
  | Const_array _
194
  | Const_tag _ -> c
200
  | Const_tag _
201
  | Const_string _
202
  |Const_struct _  -> c
195 203

  
196 204
let rdm_mutate_const c =
197 205
  let new_const = rdm_mutate_const_value c.const_value in
......
268 276
  mutation, { eq with eq_rhs = new_rhs }
269 277

  
270 278
let rdm_mutate_node nd = 
271
  let mutation, new_node_eqs =       
279
  let mutation, new_node_stmts =
272 280
    select_in_list 
273
      nd.node_eqs 
274
      (fun eq -> let mut, new_eq = rdm_mutate_eq eq in
275
		 report ~level:1 
276
		   (fun fmt -> fprintf fmt "mutation: %a becomes %a@." 
277
		     Printers.pp_node_eq eq
278
		     Printers.pp_node_eq new_eq);
279
		 mut, new_eq )
281
      nd.node_stmts 
282
      (fun stmt ->match stmt with
283
      | Eq eq -> let mut, new_eq = rdm_mutate_eq eq in
284
		  report ~level:1 
285
		    (fun fmt -> fprintf fmt "mutation: %a becomes %a@." 
286
		      Printers.pp_node_eq eq
287
		      Printers.pp_node_eq new_eq);
288
		  mut, Eq new_eq
289
      | _ -> assert false (* shold have been removed by now *) )
280 290
  in
281
  mutation, { nd with node_eqs = new_node_eqs }
291
  mutation, { nd with node_stmts = new_node_stmts }
282 292

  
283 293
let rdm_mutate_top_decl td =
284 294
  match td.top_decl_desc with
285 295
  | Node nd -> 
286 296
    let mutation, new_node = rdm_mutate_node nd in 
287 297
    mutation, { td with top_decl_desc = Node new_node}
288
  | Consts constsl -> 
289
    let mut, new_constsl = select_in_list constsl rdm_mutate_const in
290
    mut, { td with top_decl_desc = Consts new_constsl }
298
  | Const const -> 
299
    let mut, new_const = rdm_mutate_const const in
300
    mut, { td with top_decl_desc = Const new_const }
291 301
  | _ -> None, td
292 302
    
293 303
(* Create a single mutant with the provided random seed *)
......
474 484
let fold_mutate_eq eq =
475 485
  { eq with eq_rhs = fold_mutate_expr eq.eq_rhs }
476 486

  
487
let fold_mutate_stmt s =
488
  match s with
489
  | Eq eq -> Eq { eq with eq_rhs = fold_mutate_expr eq.eq_rhs }
490
  | _ -> assert false (* should have been removed by now *)
491

  
477 492
let fold_mutate_node nd = 
478 493
  { nd with 
479
    node_eqs = 
480
      List.fold_right (fun e res -> (fold_mutate_eq e)::res) nd.node_eqs [];
494
    node_stmts = 
495
      List.fold_right (fun e res -> (fold_mutate_stmt e)::res) nd.node_stmts [];
481 496
    node_id = rename_app nd.node_id
482 497
  }
483 498

  
484 499
let fold_mutate_top_decl td =
485 500
  match td.top_decl_desc with
486 501
  | Node nd -> { td with top_decl_desc = Node (fold_mutate_node nd)}
487
  | Consts constsl -> { td with top_decl_desc = Consts (List.fold_right (fun e res -> (fold_mutate_const e)::res) constsl [])}
502
  | Const const -> { td with top_decl_desc = Const (fold_mutate_const const)}
488 503
  | _ -> td
489 504
    
490 505
(* Create a single mutant with the provided random seed *)

Also available in: Unified diff