fir/alias/fir_alias_pre_loop.ml

   1 (*
   2  * Alias analysis.  I will really need to document this soon (jyh).
   3  *
   4  * We combine loop analysis with alias analysis.
   5  *
   6  * ----------------------------------------------------------------
   7  *
   8  * @begin[license]
   9  * Copyright (C) 2002 Jason Hickey, Caltech
  10  *
  11  * This program is free software; you can redistribute it and/or
  12  * modify it under the terms of the GNU General Public License
  13  * as published by the Free Software Foundation; either version 2
  14  * of the License, or (at your option) any later version.
  15  *
  16  * This program is distributed in the hope that it will be useful,
  17  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  18  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19  * GNU General Public License for more details.
  20  *
  21  * You should have received a copy of the GNU General Public License
  22  * along with this program; if not, write to the Free Software
  23  * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  24  *
  25  * Author: Jason Hickey
  26  * @email{jyh@cs.caltech.edu}
  27  * @end[license]
  28  *)
  29 open Symbol
  30 open Trace
  31 open Debug
  32
  33 open Fir
  34 open Fir_exn
  35 open Fir_pos
  36 open Fir_heap
  37 open Fir_state
  38 open Fir_depth
  39 open Fir_algebra
  40
  41 open Fir_alias
  42 open Fir_alias_env
  43 open Fir_alias_util
  44 open Fir_alias_type
  45 open Fir_alias_prog
  46 open Fir_alias_subst
  47 open Fir_alias_print
  48
  49 open Fir_alias_pre_cse
  50
  51 module Pos = MakePos (struct let name = "Fir_alias_pre_loop" end)
  52 open Pos
  53
  54 (*
  55  * Add loop arguments.
  56  *)
  57 let loop_arg gvenv aenv lenv loc v op step base =
  58    let pos = string_pos "ps_loop_arg" (var_exp_pos v) in
  59    let gvenv, _, step = cse_normalize_etree gvenv aenv pos zero_depth (add_etree op (ETVar v) step) in
  60    let lenv = SymbolTable.add lenv v (make_etree loc step, make_etree loc base) in
  61       gvenv, lenv
  62
  63 (*
  64  * In the final step, add the base and step expressions as pseudo-arguments
  65  * to the loop.
  66  *)
  67 let loop_prog gvenv aenv =
  68    let gvenv, lenv =
  69       SymbolTable.fold (fun (gvenv, lenv) _ (ac, _) ->
  70             let loc = loc_of_aclass ac in
  71                match dest_aclass_core ac with
  72                   AliasInduction (_, v, _, op, _, _, _, step, base) ->
  73                      loop_arg gvenv aenv lenv loc v op step base
  74                 | AliasExp _
  75                 | AliasAlias _ ->
  76                      gvenv, lenv) (gvenv, SymbolTable.empty) gvenv.gvenv_values
  77    in
  78       if debug debug_alias then
  79          begin
  80             Format.printf "@[<hv 3>*** FIR: alias: loop table:";
  81             SymbolTable.iter (fun v (base, step) ->
  82                   Format.printf "@ @[<hv 0>@[<hv 3> %a" pp_print_symbol v;
  83                   Format.printf " {@ @[<hv 3>base =@ %a" pp_print_etree base;
  84                   Format.printf "@];@ @[<hv 3>step =@ %a" pp_print_etree step;
  85                   Format.printf "@]@]@ }@]") lenv;
  86             Format.printf "@]@."
  87          end;
  88       gvenv, lenv
  89
  90 (*!
  91  * @docoff
  92  *
  93  * -*-
  94  * Local Variables:
  95  * Caml-master: "compile"
  96  * End:
  97  * -*-
  98  *)