Project

General

Profile

Revision df94cd73

View differences:

src/corelang.ml
719 719
(*        Renaming / Copying                                                      *)
720 720

  
721 721
let copy_var_decl vdecl =
722
  mkvar_decl vdecl.var_loc ~orig:vdecl.var_orig (vdecl.var_id, vdecl.var_dec_type, vdecl.var_dec_clock, vdecl.var_dec_const, vdecl.var_dec_value, vdecl.var_parent_nodeid)
722
  mkvar_decl
723
    vdecl.var_loc
724
    ~orig:vdecl.var_orig
725
    (
726
      vdecl.var_id,
727
      vdecl.var_dec_type,
728
      vdecl.var_dec_clock,
729
      vdecl.var_dec_const,
730
      vdecl.var_dec_value,
731
      vdecl.var_parent_nodeid
732
    )
723 733

  
724 734
let copy_const cdecl =
725 735
  { cdecl with const_type = Types.new_var () }
......
802 812
     Expr_merge (f_var i, List.map (fun (t, h) -> (t, re h)) hl)
803 813
   | Expr_appl (i, e', i') -> 
804 814
     Expr_appl (f_node i, re e', Utils.option_map re i')
805

  
806
 let rename_dec_type f_node f_var t = t (* TODO : do we really want to rename a declared type ? 
807
						     Types.rename_dim_type (Dimension.rename f_node f_var) t*)
808

  
809
 let rename_dec_clock f_node f_var c = c (* TODO : do we really want to rename a declared clock ? assert false  
810
					  Clocks.rename_clock_expr f_var c*)
811 815
   
812 816
 let rename_var f_node f_var v = {
813 817
     (copy_var_decl v) with
814 818
     var_id = f_var v.var_id;
815
     var_dec_type = rename_dec_type f_node f_var v.var_dec_type;
816
     var_dec_clock = rename_dec_clock f_node f_var v.var_dec_clock
819
     var_type = v.var_type;
820
     var_clock = v.var_clock;
817 821
 } 
818 822

  
819 823
 let rename_vars f_node f_var = List.map (rename_var f_node f_var) 
src/lustre_types.ml
127 127
  annot_loc: Location.t}
128 128

  
129 129
type contract_mode =
130
  { mode_id: ident; require: eexpr list; ensure: eexpr list; mode_loc: Location.t}
130
  {
131
    mode_id: ident;
132
    require: eexpr list;
133
    ensure: eexpr list;
134
    mode_loc: Location.t
135
  }
131 136

  
132 137
type contract_import =
133 138
  { import_nodeid: ident;
src/mutation.ml
30 30
let int_consts = ref []
31 31

  
32 32
let rename_app id =
33
  let node = Corelang.node_from_name id in
34
  let is_imported =
35
    match node.top_decl_desc with
36
    | ImportedNode _ -> true
37
    | _ -> false
38
  in
39
  if !Options.no_mutation_suffix || is_imported then
33
  if List.mem id Basic_library.internal_funs ||
34
       !Options.no_mutation_suffix then
40 35
    id
41 36
  else
42
    id ^ "_mutant"
37
    let node = Corelang.node_from_name id in
38
    let is_imported =
39
      match node.top_decl_desc with
40
      | ImportedNode _ -> true
41
      | _ -> false
42
    in
43
    if is_imported then
44
      id
45
    else
46
      id ^ "_mutant"
43 47

  
44 48
(************************************************************************************)
45 49
(*                    Gathering constants in the code                               *)
......
455 459
    target := Some (Op(op_orig, n-1, op_new));
456 460
    op
457 461
  )
458
  | _ -> if List.mem op Basic_library.internal_funs then op else rename_app op
462
  | _ -> op
459 463

  
460 464

  
461 465
let fold_mutate_var expr = 
......
491 495
  )
492 496
  | _ -> Expr_pre e
493 497
    
494
let fold_mutate_const_value c = 
495
match c with
496
| Const_int i -> (
497
  match !target with
498
  | Some (IncrIntCst 0) -> (set_mutation_loc (); Const_int (i+1))
499
  | Some (DecrIntCst 0) -> (set_mutation_loc (); Const_int (i-1))
500
  | Some (SwitchIntCst (0, id)) ->
501
     (set_mutation_loc (); Const_int id) 
502
  | Some (IncrIntCst n) -> (target := Some (IncrIntCst (n-1)); c)
503
  | Some (DecrIntCst n) -> (target := Some (DecrIntCst (n-1)); c)
504
  | Some (SwitchIntCst (n, id)) -> (target := Some (SwitchIntCst (n-1, id)); c)
505
  | _ -> c)
506
| _ -> c
498
let fold_mutate_const_value c =
499
  match c with
500
  | Const_int i -> (
501
    match !target with
502
    | Some (IncrIntCst 0) -> (set_mutation_loc (); Const_int (i+1))
503
    | Some (DecrIntCst 0) -> (set_mutation_loc (); Const_int (i-1))
504
    | Some (SwitchIntCst (0, id)) ->
505
       (set_mutation_loc (); Const_int id) 
506
    | Some (IncrIntCst n) -> (target := Some (IncrIntCst (n-1)); c)
507
    | Some (DecrIntCst n) -> (target := Some (DecrIntCst (n-1)); c)
508
    | Some (SwitchIntCst (n, id)) -> (target := Some (SwitchIntCst (n-1, id)); c)
509
    | _ -> c)
510
  | _ -> c
507 511

  
508 512
(*
509 513
  match c with
......
561 565
  | Eq eq   -> Eq (fold_mutate_eq eq)
562 566
  | Aut aut -> assert false
563 567

  
564
let mutate_contract c =
565
  { c with
566
    (* TODO: translate other fields. Do not mutate them, just rename
567
       the calls with the _mutant suffix *)
568
    imports = List.map (fun ci -> { ci with import_nodeid = rename_app ci.import_nodeid }) c.imports;
569
  }
570
  
571
let mutate_spec spec =
572
  match spec with
573
  | Contract c -> Contract (mutate_contract c)
574
  | NodeSpec id -> NodeSpec (rename_app id)
575
                 
568

  
576 569
let fold_mutate_node nd =
577 570
  current_node := Some nd.node_id;
578
  { nd with 
579
    node_stmts = 
580
      List.fold_right (fun stmt res -> (fold_mutate_stmt stmt)::res) nd.node_stmts [];
581
    node_spec = (
582
      match nd.node_spec with
583
      | None -> None
584
      | Some spec -> Some (mutate_spec spec)); 
585
    node_id = rename_app nd.node_id
586
  }
571
  let nd =
572
    { nd with 
573
      node_stmts = 
574
        List.fold_right (fun stmt res -> (fold_mutate_stmt stmt)::res) nd.node_stmts [];
575
    }
576
  in
577
  rename_node rename_app (fun x -> x) nd 
587 578

  
588 579
let fold_mutate_top_decl td =
589 580
  match td.top_decl_desc with

Also available in: Unified diff