<commit_before>(* See copyright notice at the end of the file *)
(*****************************************************************************
 * Partial Evaluation & Constant Folding
 *
 * Soundness Assumptions:
 * (1) Whole program analysis. You may call functions that are not defined
 *     (e.g., library functions) but they may not call back. 
 * (2) An undefined function may not return the address of a function whose
 *     address is not already taken in the code I can see. 
 * (3) A function pointer call may only call a function that has its
 *     address visibly taken in the code I can see. 
 *
 * (More assumptions in the comments below)
 *****************************************************************************)
open Cil
open Pretty

(*****************************************************************************
 * A generic signature for Alias Analysis information. Used to compute the
 * call graph and do symbolic execution. 
 ****************************************************************************)
module type AliasInfo =
  sig
    val can_have_the_same_value : Cil.exp -> Cil.exp -> bool
    val resolve_function_pointer : Cil.exp -> (Cil.fundec list)
  end

(*****************************************************************************
 * A generic signature for Symbolic Execution execution algorithms. Such
 * algorithms are used below to perform constant folding and dead-code
 * elimination. You write a "basic-block" symex algorithm, we'll make it
 * a whole-program CFG-pruner. 
 ****************************************************************************)
module type Symex = 
  sig
    type t (* the type of a symex algorithm state object *)
    val empty : t                           (* all values unknown *)
    val equal : t -> t -> bool              (* are these the same? *)
    val assign : t -> Cil.lval -> Cil.exp  -> (Cil.exp * t) 
      (* incorporate an assignment, return the RHS *)
    val unassign : t -> Cil.lval -> t 
      (* lose all information about the given lvalue: assume an 
       * unknown external value has been assigned to it *)
    val assembly : t -> Cil.instr -> t      (* handle ASM *)
    val assume : t -> Cil.exp -> t          (* incorporate an assumption *) 
    val evaluate : t -> Cil.exp -> Cil.exp  (* symbolic evaluation *)
    val join : (t list) -> t                (* join a bunch of states *) 
    val call : t -> Cil.fundec -> (Cil.exp list) -> (Cil.exp list * t)
      (* we are calling the given function with the given actuals *)
    val return : t -> Cil.fundec -> t
      (* we are returning from the given function *)
    val call_to_unknown_function : t -> t 
      (* throw away information that may have been changed *) 
    val debug : t -> unit
  end

(*****************************************************************************
 * A generic signature for whole-progam call graphs. 
 ****************************************************************************)
module type CallGraph =
  sig 
    type t (* the type of a call graph *)
    val compute : Cil.file -> t (* file for which we compute the graph *)
    val can_call : t -> Cil.fundec -> (Cil.fundec list)
    val can_be_called_by : t -> Cil.fundec -> (Cil.fundec list)
    val fundec_of_varinfo : t -> Cil.varinfo -> Cil.fundec
  end

(*****************************************************************************
 * My cheap-o Alias Analysis. Assume all expressions can have the same 
 * value and any function with its address taken can be the target of
 * any function pointer. 
 *
 * Soundness Assumptions:
 * (1) Someone must call "find_all_functions_With_address_taken" before the
 *     results are valid. This is already done in the code below.
 ****************************************************************************)
let all_functions_with_address_taken = ref [] 
let find_all_functions_with_address_taken (f : Cil.file) =
  iterGlobals f (fun g -> match g with
    GFun(fd,_) -> if fd.svar.vaddrof then
      all_functions_with_address_taken := fd :: 
      !all_functions_with_address_taken
  | _ -> ())  

module EasyAlias =
  struct
    let can_have_the_same_value e1 e2 = true
    let resolve_function_pointer e1 = !all_functions_with_address_taken
  end

(*****************************************************************************
 * My particular method for computing the Call Graph. 
 ****************************************************************************)
module EasyCallGraph = functor (A : AliasInfo) -> 
  struct
    type callGraphNode = {
              fd        : Cil.fundec ;
      mutable calledBy  : Cil.fundec list ;
      mutable calls     : Cil.fundec list ;
    } 
    type t = (Cil.varinfo, callGraphNode) Hashtbl.t 

    let cgCreateNode cg fundec =
      let newnode = { fd = fundec ; calledBy = [] ; calls = [] } in
      Hashtbl.add cg fundec.svar newnode

    let cgFindNode cg svar = Hashtbl.find cg svar 

    let cgAddEdge cg caller callee = 
      try 
        let n1 = cgFindNode cg caller in
        let n2 = cgFindNode cg callee in
        n1.calls <- n2.fd :: n1.calls ;
        n1.calledBy <- n1.fd :: n1.calledBy 
      with _ -> () 

    class callGraphVisitor cg = object
      inherit nopCilVisitor 
      val the_fun = ref None  

      method vinst i = 
        let _ = match i with
          Call(_,Lval(Var(callee),NoOffset),_,_) -> begin
            (* known function call *)
            match !the_fun with
              None -> failwith "callGraphVisitor: call outside of any function"
            | Some(enclosing) -> cgAddEdge cg enclosing callee
          end
        | Call(_,e,_,_) -> begin 
            (* unknown function call *)
            match !the_fun with
              None -> failwith "callGraphVisitor: call outside of any function"
            | Some(enclosing) -> let lst = A.resolve_function_pointer e in 
                List.iter (fun possible_target_fd ->
                  cgAddEdge cg enclosing possible_target_fd.svar) lst
          end
        | _ -> () 
        in SkipChildren 

      method vfunc f = the_fun := Some(f.svar) ; DoChildren
    end 

    let compute (f : Cil.file) = 
      let cg = Hashtbl.create 511 in 
      iterGlobals f (fun g -> match g with
          GFun(fd,_) -> cgCreateNode cg fd 
        | _ -> ()
      ) ; 
      visitCilFileSameGlobals (new callGraphVisitor cg) f ;
      cg

    let can_call cg fd =
      let n = cgFindNode cg fd.svar in n.calls
    let can_be_called_by cg fd =
      let n = cgFindNode cg fd.svar in n.calledBy
    let fundec_of_varinfo cg vi = 
      let n = cgFindNode cg vi in n.fd 
  end (* END OF: module EasyCallGraph *)

(*****************************************************************************
 * Necula's Constant Folding Strategem (re-written to be applicative) 
 *
 * Soundness Assumptions:
 * (1) Inline assembly does not affect constant folding. 
 ****************************************************************************)
module OrderedInt = 
  struct 
    type t = int
    let compare = compare
  end
module IntMap = Map.Make(OrderedInt) 

module NeculaFolding = functor (A : AliasInfo) ->
  struct
    (* Register file. Maps identifiers of local variables to expressions.
     * We also remember if the expression depends on memory or depends on
     * variables that depend on memory *)
    type reg = {
      rvi : varinfo ;
      rval : exp ;
      rmem : bool
    } 
    type t = reg IntMap.t 
    let empty = IntMap.empty 
    let equal t1 t2 = (compare t1 t2 = 0) (* use OCAML here *)
    let dependsOnMem = ref false
    (* Rewrite an expression based on the current register file *)
    class rewriteExpClass (regFile : t) = object
      inherit nopCilVisitor
      method vexpr = function
        | Lval (Var v, NoOffset) -> begin
            try
              let defined = (IntMap.find v.vid regFile) in
              if (defined.rmem) then dependsOnMem := true;
              ChangeTo (defined.rval)
            with Not_found -> DoChildren
          end
        | Lval (Mem _, _) -> dependsOnMem := true; DoChildren
        | _ -> DoChildren
    end
    (* Rewrite an expression and return the new expression along with an 
     * indication of whether it depends on memory *)
    let rewriteExp r (e: exp) : exp * bool = 
      dependsOnMem := false;<commit_msg>Fixed a bug in the partial evaluation / constant folding extension. Thanks to <NAME> for this fix.<commit_after>(* See copyright notice at the end of the file *)
(*****************************************************************************
 * Partial Evaluation & Constant Folding
 *
 * Soundness Assumptions:
 * (1) Whole program analysis. You may call functions that are not defined
 *     (e.g., library functions) but they may not call back. 
 * (2) An undefined function may not return the address of a function whose
 *     address is not already taken in the code I can see. 
 * (3) A function pointer call may only call a function that has its
 *     address visibly taken in the code I can see. 
 *
 * (More assumptions in the comments below)
 *****************************************************************************)
open Cil
open Pretty

(*****************************************************************************
 * A generic signature for Alias Analysis information. Used to compute the
 * call graph and do symbolic execution. 
 ****************************************************************************)
module type AliasInfo =
  sig
    val can_have_the_same_value : Cil.exp -> Cil.exp -> bool
    val resolve_function_pointer : Cil.exp -> (Cil.fundec list)
  end

(*****************************************************************************
 * A generic signature for Symbolic Execution execution algorithms. Such
 * algorithms are used below to perform constant folding and dead-code
 * elimination. You write a "basic-block" symex algorithm, we'll make it
 * a whole-program CFG-pruner. 
 ****************************************************************************)
module type Symex = 
  sig
    type t (* the type of a symex algorithm state object *)
    val empty : t                           (* all values unknown *)
    val equal : t -> t -> bool              (* are these the same? *)
    val assign : t -> Cil.lval -> Cil.exp  -> (Cil.exp * t) 
      (* incorporate an assignment, return the RHS *)
    val unassign : t -> Cil.lval -> t 
      (* lose all information about the given lvalue: assume an 
       * unknown external value has been assigned to it *)
    val assembly : t -> Cil.instr -> t      (* handle ASM *)
    val assume : t -> Cil.exp -> t          (* incorporate an assumption *) 
    val evaluate : t -> Cil.exp -> Cil.exp  (* symbolic evaluation *)
    val join : (t list) -> t                (* join a bunch of states *) 
    val call : t -> Cil.fundec -> (Cil.exp list) -> (Cil.exp list * t)
      (* we are calling the given function with the given actuals *)
    val return : t -> Cil.fundec -> t
      (* we are returning from the given function *)
    val call_to_unknown_function : t -> t 
      (* throw away information that may have been changed *) 
    val debug : t -> unit
  end

(*****************************************************************************
 * A generic signature for whole-progam call graphs. 
 ****************************************************************************)
module type CallGraph =
  sig 
    type t (* the type of a call graph *)
    val compute : Cil.file -> t (* file for which we compute the graph *)
    val can_call : t -> Cil.fundec -> (Cil.fundec list)
    val can_be_called_by : t -> Cil.fundec -> (Cil.fundec list)
    val fundec_of_varinfo : t -> Cil.varinfo -> Cil.fundec
  end

(*****************************************************************************
 * My cheap-o Alias Analysis. Assume all expressions can have the same 
 * value and any function with its address taken can be the target of
 * any function pointer. 
 *
 * Soundness Assumptions:
 * (1) Someone must call "find_all_functions_With_address_taken" before the
 *     results are valid. This is already done in the code below.
 ****************************************************************************)
let all_functions_with_address_taken = ref [] 
let find_all_functions_with_address_taken (f : Cil.file) =
  iterGlobals f (fun g -> match g with
    GFun(fd,_) -> if fd.svar.vaddrof then
      all_functions_with_address_taken := fd :: 
      !all_functions_with_address_taken
  | _ -> ())  

module EasyAlias =
  struct
    let can_have_the_same_value e1 e2 = true
    let resolve_function_pointer e1 = !all_functions_with_address_taken
  end

(*****************************************************************************
 * My particular method for computing the Call Graph. 
 ****************************************************************************)
module EasyCallGraph = functor (A : AliasInfo) -> 
  struct
    type callGraphNode = {
              fd        : Cil.fundec ;
      mutable calledBy  : Cil.fundec list ;
      mutable calls     : Cil.fundec list ;
    } 
    type t = (Cil.varinfo, callGraphNode) Hashtbl.t 

    let cgCreateNode cg fundec =
      let newnode = { fd = fundec ; calledBy = [] ; calls = [] } in
      Hashtbl.add cg fundec.svar newnode

    let cgFindNode cg svar = Hashtbl.find cg svar 

    let cgAddEdge cg caller callee = 
      try 
        let n1 = cgFindNode cg caller in
        let n2 = cgFindNode cg callee in
        n1.calls <- n2.fd :: n1.calls ;
        n1.calledBy <- n1.fd :: n1.calledBy 
      with _ -> () 

    class callGraphVisitor cg = object
      inherit nopCilVisitor 
      val the_fun = ref None  

      method vinst i = 
        let _ = match i with
          Call(_,Lval(Var(callee),NoOffset),_,_) -> begin
            (* known function call *)
            match !the_fun with
              None -> failwith "callGraphVisitor: call outside of any function"
            | Some(enclosing) -> cgAddEdge cg enclosing callee
          end
        | Call(_,e,_,_) -> begin 
            (* unknown function call *)
            match !the_fun with
              None -> failwith "callGraphVisitor: call outside of any function"
            | Some(enclosing) -> let lst = A.resolve_function_pointer e in 
                List.iter (fun possible_target_fd ->
                  cgAddEdge cg enclosing possible_target_fd.svar) lst
          end
        | _ -> () 
        in SkipChildren 

      method vfunc f = the_fun := Some(f.svar) ; DoChildren
    end 

    let compute (f : Cil.file) = 
      let cg = Hashtbl.create 511 in 
      iterGlobals f (fun g -> match g with
          GFun(fd,_) -> cgCreateNode cg fd 
        | _ -> ()
      ) ; 
      visitCilFileSameGlobals (new callGraphVisitor cg) f ;
      cg

    let can_call cg fd =
      let n = cgFindNode cg fd.svar in n.calls
    let can_be_called_by cg fd =
      let n = cgFindNode cg fd.svar in n.calledBy
    let fundec_of_varinfo cg vi = 
      let n = cgFindNode cg vi in n.fd 
  end (* END OF: module EasyCallGraph *)

(*****************************************************************************
 * Necula's Constant Folding Strategem (re-written to be applicative) 
 *
 * Soundness Assumptions:
 * (1) Inline assembly does not affect constant folding. 
 ****************************************************************************)
module OrderedInt = 
  struct 
    type t = int
    let compare = compare
  end
module IntMap = Map.Make(OrderedInt) 

module NeculaFolding = functor (A : AliasInfo) ->
  struct
    (* Register file. Maps identifiers of local variables to expressions.
     * We also remember if the expression depends on memory or depends on
     * variables that depend on memory *)
    type reg = {
      rvi : varinfo ;
      rval : exp ;
      rmem : bool
    } 
    type t = reg IntMap.t 
    let empty = IntMap.empty 
    let equal t1 t2 = (compare t1 t2 = 0) (* use OCAML here *)
    let dependsOnMem = ref false
    (* Rewrite an expression based on the current register file *)
    class rewriteExpClass (regFile : t) = object
      inherit nopCilVisitor
      method vexpr = function
        | Lval (Var v, NoOffset) -> begin
            try
              let defined = (IntMap.find v.vid regFile) in
              if (defined.rmem) then dependsOnMem := true;
              (match defined.rval with
              | Const(x) -> ChangeTo (defined.rval)
              | _ -> DoChildren)
            with Not_found -> DoChildren
          end
        | Lval (Mem _, _) -> dependsOnMem := true; DoChildren
        | _ -> DoChildren
    end
    (* Rewrite an expression and return the new expression along with an 
     * indication of whether it depends on memory *)
    let rewriteExp r (e: exp) : exp * bool = 
      dependsOnMem := false;
{'fraction_non_alphanumeric': 0.19944070922829774, 'fraction_numerical': 0.002855952876777533, 'mean_word_length': 2.7079196999779396, 'pattern_counts': {'":': 0, '<': 8, '<?xml version=': 0, '>': 110, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5130448', 'n_tokens_mistral': 4708, 'n_tokens_neox': 4401, 'n_words': 1659}