Project

General

Profile

Revision bb2ca5f4 src/machine_code.ml

View differences:

src/machine_code.ml
377 377

  
378 378
  | p  , Expr_appl (f, arg, r) when not (Basic_library.is_internal_fun f) ->
379 379
    let var_p = List.map (fun v -> get_node_var v node) p in
380
    let el =
381
      match arg.expr_desc with
382
      | Expr_tuple el -> el
383
      | _             -> [arg] in
380
    let el = expr_list_of_expr arg in
384 381
    let vl = List.map (translate_expr node args) el in
385 382
    let node_f = node_from_name f in
386 383
    let call_f =
......
504 501
      | None -> if m.mname.node_id = name then Some m else None)
505 502
    None machines
506 503
    
504
(* variable substitution for optimizing purposes *)
505

  
506
(* checks whether an [instr] is skip and can be removed from program *)
507
let rec instr_is_skip instr =
508
  match instr with
509
  | MLocalAssign (i, LocalVar v) when i = v -> true
510
  | MStateAssign (i, StateVar v) when i = v -> true
511
  | MBranch (g, hl) -> List.for_all (fun (_, il) -> instrs_are_skip il) hl
512
  | _               -> false
513
and instrs_are_skip instrs =
514
  List.for_all instr_is_skip instrs
515

  
516
let rec instr_remove_skip instr cont =
517
  match instr with
518
  | MLocalAssign (i, LocalVar v) when i = v -> cont
519
  | MStateAssign (i, StateVar v) when i = v -> cont
520
  | MBranch (g, hl) -> MBranch (g, List.map (fun (h, il) -> (h, instrs_remove_skip il [])) hl) :: cont
521
  | _               -> instr::cont
522

  
523
and instrs_remove_skip instrs cont =
524
  List.fold_right instr_remove_skip instrs cont
525

  
526
let rec value_replace_var fvar value =
527
  match value with
528
  | Cst c -> value
529
  | LocalVar v -> LocalVar (fvar v)
530
  | StateVar v -> value
531
  | Fun (id, args) -> Fun (id, List.map (value_replace_var fvar) args) 
532
  | Array vl -> Array (List.map (value_replace_var fvar) vl)
533
  | Access (t, i) -> Access(value_replace_var fvar t, i)
534
  | Power (v, n) -> Power(value_replace_var fvar v, n)
535

  
536
let rec instr_replace_var fvar instr =
537
  match instr with
538
  | MLocalAssign (i, v) -> MLocalAssign (fvar i, value_replace_var fvar v)
539
  | MStateAssign (i, v) -> MStateAssign (i, value_replace_var fvar v)
540
  | MReset i            -> instr
541
  | MStep (il, i, vl)   -> MStep (List.map fvar il, i, List.map (value_replace_var fvar) vl)
542
  | MBranch (g, hl)     -> MBranch (value_replace_var fvar g, List.map (fun (h, il) -> (h, instrs_replace_var fvar il)) hl)
543

  
544
and instrs_replace_var fvar instrs =
545
  List.map (instr_replace_var fvar) instrs
546

  
547
let step_replace_var fvar step =
548
  { step with
549
    step_checks = List.map (fun (l, v) -> (l, value_replace_var fvar v)) step.step_checks;
550
    step_locals = Utils.remove_duplicates (List.map fvar step.step_locals);
551
    step_instrs = instrs_replace_var fvar step.step_instrs;
552
}
553

  
554
let rec machine_replace_var fvar m =
555
  { m with
556
    mstep = step_replace_var fvar m.mstep
557
  }
558

  
559
let machine_reuse_var m reuse =
560
  let reuse_vdecl = Hashtbl.create 23 in
561
  begin
562
    Hashtbl.iter (fun v v' -> Hashtbl.add reuse_vdecl (get_node_var v m.mname) (get_node_var v' m.mname)) reuse;
563
    let fvar v =
564
      try
565
	Hashtbl.find reuse_vdecl v
566
      with Not_found -> v in
567
    machine_replace_var fvar m
568
  end
569

  
570
let prog_reuse_var prog node_schs =
571
  List.map 
572
    (fun m -> 
573
      machine_reuse_var m (Utils.IMap.find m.mname.node_id node_schs).Scheduling.reuse_table
574
    ) prog
507 575

  
508 576
(* Local Variables: *)
509 577
(* compile-command:"make -C .." *)

Also available in: Unified diff