-- Copyright 1993-2004, by the Cecil Project
-- Department of Computer Science and Engineering, University of Washington
-- See the $VORTEX_HOME/notes/LICENSE file for license information.

(** debug **)

-- POINTS-TO ANALYSIS

-- An implementation of points-to analysis over the CFG.  It also
-- implements "scalar replacement," i.e., if there's an occurrence of
-- *p in the code, and p definitely points to x, then *p is replaced
-- with x.

------------------------------------------------------------------------------

-- option to turn pts-to on/off
var field pts_to(@:options):bool := true;
options.option_list.add_all_last([
      boolean_option("pts_to",
		     &&(){ options.pts_to },
		     &&(v:bool){ options.pts_to := v; },
		     "Do points-to analysis", true, 4, ["msgs"])]);

-- option to enable reporting each points-to operation
--   0: off
--   1: print a line describing the change
--   2: also print the replacement graph
--   3: also print each node that's considered
--   4: also print the analysis info for each node that's considered
var field pts_to_msgs(@:options):int := 0;
options.option_list.add_all_last([
      integer_option("pts_to_msgs",
		     &&(){ options.pts_to_msgs },
		     &&(v:int){ options.pts_to_msgs := v; },
		     "Print messages about points-to analysis", false, 4,
		     ["msgs"])]);

------------------------------------------------------------------------------
-- Analysis object definition

concrete object PtsToAnalysis isa ComposableAnalysis[PtsTo,
						     ForwardCFGAnalysisGraph];

   -- Return top information
   method top_analysis_info(@:PtsToAnalysis):PtsTo { 
       TopPtsTo }

   -- Return information to initialize CFG input edges with
   method init_analysis_info(@:PtsToAnalysis):PtsTo { 
       BottomPtsTo }

   method phase_name(@:PtsToAnalysis):string { 
       "Points-To Analysis" }

   -- Return the graph over which to run this analysis. For this analysis
   -- we return the CFG.
   method create_analysis_graph_view(analysis@:PtsToAnalysis,
                                     ir:WindIR,
                                     nested:bool
                                     ):ForwardCFGAnalysisGraph {
       let graph := new_forward_cfg_analysis_view_notnum(ir.getCFG);
       if(nested.not, { graph.assign_topo_numbers });
       graph }

   type synonym PtsToAnalysisAction =
     AnalysisAction[PtsTo, ForwardCFGAnalysisGraph];

   -- Analyze a node. First, merges all of the incoming informations
   -- into one dataflow value. Then calls pts_to_analyze to do the
   -- node-specific work.
   method analyze(analysis@:PtsToAnalysis,
                  graph:ForwardCFGAnalysisGraph,
                  node@:IRNode,
                  incoming_infos:indexed[PtsTo]
                  ):PtsToAnalysisAction {
       cond_msg(options.pts_to_msgs, 3, {
	   "== Pts-To analyzing " || node.print_string });
       cond_msg(options.pts_to_msgs, 4, {
	   new_i_vector_init[string](incoming_infos.length, &(i:int){
	       ["@@ pred ", i.print_string, ": ",
		incoming_infos.fetch(i).print_string, "\n"].flatten
	    }).flatten });
       -- merge the incoming info
       let merged_info := meet(incoming_infos, TopPtsTo);
       -- call the flow function for this kind of node
       pts_to_analyze(node, analysis, graph, merged_info) }

------------------------------------------------------------------------------
-- Lattice definitions


-- First we define locations, which are the possible sources and
-- destinations of pointers

abstract object Location isa LatticeElmt[Location], AnalysisInfo[Location],
			     hashable[Location];
  -- whether or not the location corresponds to a unique run-time
  -- location, at least during the execution of the procedure being
  -- analyzed
  signature is_single_location(Location):bool;

-- this represents a variable
template object VarLocation isa Location;
  field decl(@:VarLocation):ValDeclNode;
  method =(v1@:VarLocation, v2@:VarLocation):bool { 
      v1 == v2 | { v1.decl = v2.decl } }
  method hash(v@:VarLocation, range:int):int {
      v.decl.hash(range) }
  method print_string(v@:VarLocation):string { v.decl.id }
  method is_single_location(@:VarLocation):bool { true }
  method new_var_location(d:ValDeclNode):VarLocation {
      concrete object isa VarLocation { decl := d } }

-- this represents a field of a struct
template object FieldLocation isa Location;
  -- the struct containing this field
  field record(@:FieldLocation):Location;
  -- the name of the field
  field id(@:FieldLocation):string;
  method print_string(v@:FieldLocation):string { 
      v.record.print_string || "." || v.id }
  method =(v1@:FieldLocation, v2@:FieldLocation):bool { 
      v1 == v2 | { v1.record = v2.record & { v1.id = v2.id } } }
  method hash(v@:FieldLocation, range:int):int {
      (v.record.hash(range) + v.id.hash(range)).hash(range) }
  method is_single_location(v@:FieldLocation):bool { 
      v.record.is_single_location }
  method new_field_location(r:Location, f:string):FieldLocation {
      concrete object isa FieldLocation { record := r, id := f } }

-- a summary location represents a set of locations
abstract object SummaryLocation isa Location;
  method is_single_location(@:SummaryLocation):bool { false }

-- this summarizes all the locations allocated by a particular alloc node
template object AllocSummaryLocation isa SummaryLocation;
  field alloc(@:AllocSummaryLocation):AllocNode;
  method =(v1@:AllocSummaryLocation, v2@:AllocSummaryLocation):bool { 
      v1 == v2 | { v1.alloc = v2.alloc } }
  method hash(v@:AllocSummaryLocation, range:int):int {
      v.alloc.hash(range) }
  method print_string(v@:AllocSummaryLocation):string { v.alloc.print_string }
  method new_alloc_summary_location(alloc:AllocNode):AllocSummaryLocation {
      concrete object isa AllocSummaryLocation { alloc := alloc } }

-- this summarizes all the elements of a array
template object ArraySummaryLocation isa SummaryLocation;
  field array(@:ArraySummaryLocation):Location;
  method =(v1@:ArraySummaryLocation, v2@:ArraySummaryLocation):bool { 
      v1 == v2 | { v1.array = v2.array } }
  method hash(v@:ArraySummaryLocation, range:int):int {
      v.array.hash(range) }
  method print_string(v@:ArraySummaryLocation):string {
      v.array.print_string || "[*]" }
  method new_array_element_summary_location(array:Location
					    ):ArraySummaryLocation {
      concrete object isa ArraySummaryLocation { array := array } }


-- Next we define a lattice for sets of locations; a pointer may point
-- to one of these sets of locations

abstract object LocationSet isa LatticeElmt[LocationSet],
				AnalysisInfo[LocationSet];
  -- If the set represents a single location, return that location,
  -- otherwise return what if_not_single returns.
  signature single_location(LocationSet, if_not_single:&():`T):Location|T;
  method is_single_location(ls@:LocationSet):bool { 
      ls.single_location({ ^ false });
      true }

-- top lattice element: empty set
concrete object TopLocationSet isa SomeLocationSet { 
    locations := new_list_set[Location]() };

-- a middle lattice element: an explicit set of locations
template object SomeLocationSet isa LocationSet;
  field locations(@:SomeLocationSet):set[Location];

  method print_string(ls@:SomeLocationSet):string { 
      "{" || ls.locations.elems_print_string || "}" }

  method =(ls1@:SomeLocationSet, ls2@:SomeLocationSet):bool {
      ls1 == ls2 | { ls1.locations = ls2.locations } }

  method meet(ls1@:SomeLocationSet, ls2@:SomeLocationSet):SomeLocationSet {
      -- compute the union of the two location-sets
      -- check the easy cases:
      if(ls1.locations.includes_all(ls2.locations), { ^ ls1 });
      if(ls2.locations.includes_all(ls1.locations), { ^ ls2 });
      -- compute the union
      new_location_set(union(ls1.locations, ls2.locations)) }

  method single_location(ls@:SomeLocationSet, if_not_single:&():`T
			 ):Location|T {
      let loc := ls.locations.only({ ^ eval(if_not_single) });
      if(loc.is_single_location, { loc }, if_not_single) }

  method new_location_set(locs:collection[Location]):SomeLocationSet {
      -- convert the argument locations to a set
      let s := new_list_set[Location]();
      s.add_all(locs);
      new_location_set(s) }
  method new_location_set(locs@:set[Location]):SomeLocationSet {
      concrete object isa SomeLocationSet { locations := locs } }

-- bottom lattice element: universal set (don't represent the set explicitly!)
concrete object BottomLocationSet isa LocationSet;
  method print_string(@:BottomLocationSet):string { "BottomLocationSet" }
  method =(v1@:BottomLocationSet, v2@:BottomLocationSet):bool { true }
  method meet(@:BottomLocationSet, @:BottomLocationSet):LocationSet { 
      BottomLocationSet }
  method meet(v1@:BottomLocationSet, v2@:LocationSet):LocationSet { 
      BottomLocationSet }
  method meet(v1@:LocationSet, v2@:BottomLocationSet):LocationSet { 
      BottomLocationSet }
  method single_location(@:BottomLocationSet, if_not_single:&():`T
			 ):Location|T {
      eval(if_not_single) }

-- Finally we define a lattice mapping locations to location sets,
-- representing the set of locations that a location points to. If a
-- location is not explicitly enumerated in the map, it points to the
-- default location set.

template object PtsTo isa LatticeElmt[PtsTo], AnalysisInfo[PtsTo];
  field default(@:PtsTo):LocationSet;
  field map(@:PtsTo):m_removable_table[Location, LocationSet]
			:= new_assoc_table[Location, LocationSet]();
  -- invariant: none of the values in map are default (this enables
  -- the = method to be simple, but complicates the meet method)

  method print_string(pt@:PtsTo):string { 
      let var s:collector[string] := new_collector[string]();
      s := s && "PointsTo[";
      let var first:bool := true;
      pt.map.do_associations(&(src:Location, dest:LocationSet){
	  if(first, { first := false; }, { s := s && "; "; });
	  s := s && src.print_string && "->" && dest.print_string;
      });
      if(pt.default != TopLocationSet, {
	  s := s && " (rest=" && pt.default.print_string && ")";
      });
      s := s && "]";
      s.flat_string }

  method =(pt1@:PtsTo, pt2@:PtsTo):bool {
      pt1 == pt2 | { pt1.map = pt2.map & { pt1.default = pt2.default } } }

  method meet(pt1@:PtsTo, pt2@:PtsTo):PtsTo {
      -- TODO: implement
      BottomPtsTo }

  -- Returns the set of locations that src points to in the given
  -- points-to information.
  method lookup(pt@:PtsTo, src:Location):LocationSet {
      -- TODO: implement
      BottomLocationSet }

  -- Updates the given points-to information to record the fact that
  -- any location in the src location set may now point to any of the
  -- locations in the dest location set. The original points-to
  -- information is NOT modified; a new points-to information is
  -- returned. The dataflow analysis framework assumes that all the
  -- facts that you give it are immutable. This is why the old
  -- points-to information cannot be modified, and a new points-to
  -- information must be returned.
  signature update(PtsTo, src:LocationSet, dest:LocationSet):PtsTo;

  method update(pt@:PtsTo, src@:TopLocationSet, dest:LocationSet):PtsTo {
      -- TODO: implement
      BottomPtsTo }
  method update(pt@:PtsTo, src@:BottomLocationSet, dest@:TopLocationSet
		):PtsTo {
      -- TODO: implement
      BottomPtsTo }
  method update(pt@:PtsTo, src@:BottomLocationSet, dest@:BottomLocationSet
		):PtsTo {
      -- TODO: implement
      BottomPtsTo }
  method update(pt@:PtsTo, src@:BottomLocationSet, dest@:SomeLocationSet
		):PtsTo {
      -- TODO: implement
      BottomPtsTo }
  method update(pt@:PtsTo, src@:SomeLocationSet, dest:LocationSet):PtsTo {
      -- TODO: implement
      BottomPtsTo }

  private method new_pts_to(default:LocationSet):PtsTo { 
      concrete object isa PtsTo { default := default } }
  private method new_pts_to(map:m_removable_table[Location,LocationSet],
			    default:LocationSet):PtsTo { 
      concrete object isa PtsTo { map := map, default := default } }

-- top lattice element: all locations map to top-location-set
concrete object TopPtsTo isa PtsTo { default := TopLocationSet };

-- bottom lattice element: all locations map to bottom-location-set
concrete object BottomPtsTo isa PtsTo { default := BottomLocationSet };

------------------------------------------------------------------------------
-- Flow functions

method pts_to_analyze(node@:IRNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):PtsToAnalysisAction {
    -- by default, we assume that the points-to graph is unaffected by
    -- this IR node
    new_continue_analysis_result(analysis, incoming_info, node, graph) }

method pts_to_analyze(node@:PrimStmtNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):PtsToAnalysisAction {
    -- this instruction reads and writes some variables, which might
    -- be pointer variables.  for now, be conservative and assume the
    -- worst.
    new_continue_analysis_result(analysis, BottomPtsTo, node, graph) }

method pts_to_analyze(node@:AssnOrInitNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):PtsToAnalysisAction {
    -- TODO: implement
    new_continue_analysis_result(analysis, BottomPtsTo, node, graph) }

method pts_to_analyze(node@:FxnCallNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):PtsToAnalysisAction {
    -- TODO: implement
    new_continue_analysis_result(analysis, BottomPtsTo, node, graph) }

method pts_to_analyze(node@:StoreNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):PtsToAnalysisAction {
    -- TODO: implement

    -- This is where the transformation of *x := e into y := e will
    -- take place, if incoming_info says that x points only to y. Keep
    -- in mind that StoreNode is a sub-class of AssnOrInitNode. So you
    -- will first check to see if a replacement is possible. If so,
    -- then you return the replacement, otherwise you can use resend
    -- to call the super-class case.
    new_continue_analysis_result(analysis, BottomPtsTo, node, graph) }

-- Create the correct type of assn node depending on the original
-- store node. This function will be useful for creating a replacement
-- assignment when an assignment node is trasnformed.
signature create_assn_from_store(StoreNode, 
				 new_lhs:ResolvedIDExprNode, rhs:ValueNode
				 ):VarAssnNode;
method create_assn_from_store(@:UpdateStoreNode, 
			      new_lhs:ResolvedIDExprNode, rhs:ValueNode
			      ):VarAssnNode { 
    new_update_var_assn_node(new_lhs, rhs) }
method create_assn_from_store(@:InitStoreNode, 
			      new_lhs:ResolvedIDExprNode, rhs:ValueNode
			      ):VarAssnNode { 
    new_init_var_assn_node(new_lhs, rhs) }

-----------------------------------------------------------------------------
-- Helper function to compute the updated lvalue location set of an
--assignment/store. You will need this for the pts_to_analyze case for
--AssnOrInitNode.

signature pts_to_lvalues(node:AssnOrInitNode,
			 analysis:PtsToAnalysis,
			 graph:ForwardCFGAnalysisGraph,
			 incoming_info:PtsTo
			 ):LocationSet;

method pts_to_lvalues(node@:VarAssnNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):LocationSet {
    -- the lhs is a single variable
    new_location_set([new_var_location(node.lhs.as_id_expr_node.get_decl)]) }

method pts_to_lvalues(node@:StoreNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):LocationSet {
    -- the lhs is a pointer dereference; return the locations that the
    -- pointer points to
    node.lhs.pts_to_targets(analysis, graph, incoming_info) }

method pts_to_lvalues(node@:VarDeclInitNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):LocationSet {
    -- the lhs is the variable being declared
    new_location_set([new_var_location(node.best_decl)]) }

-----------------------------------------------------------------------------
-- Helper function to compute the pointed-to location set of an expression

method pts_to_targets(node@:ValueNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):LocationSet {
    -- by default, we don't know what the rhs expression points to, so
    -- assume the worst
    BottomLocationSet }

method pts_to_targets(node@:SetRepNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):LocationSet {
    -- This is a cast node, and it doesn't affect the computed value
    node.arg.pts_to_targets(analysis, graph, incoming_info) }


method pts_to_targets(node@:IDExprNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):LocationSet {
    -- look up the info associated with this variable
    incoming_info.lookup(new_var_location(node.get_decl)) }

method pts_to_targets(node@:VarAddrNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):LocationSet {
    -- a pointer to a particular variable
    new_location_set([new_var_location(node.target.get_decl)]) }


method pts_to_targets(node@:FxnCallNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):LocationSet {
    -- TODO: implement
    BottomLocationSet }

method pts_to_targets(node@:DerefNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):LocationSet {
    -- TODO: implement
    BottomLocationSet }

method pts_to_targets(node@:RecordAccessNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):LocationSet {
    -- TODO: implement
    BottomLocationSet }

method pts_to_targets(node@:ArrayAccessNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):LocationSet {
    -- TODO: implement
    BottomLocationSet }

method pts_to_targets(node@:AllocNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):LocationSet {
    -- TODO: implement
    BottomLocationSet }

method pts_to_targets(node@:NullLiteralNode,
		      analysis:PtsToAnalysis,
		      graph:ForwardCFGAnalysisGraph,
		      incoming_info:PtsTo
		      ):LocationSet {
    -- TODO: implement
    BottomLocationSet }