Source

Opifex / src / Analysis / CWCPS / CWCPS_VariableUsageAnalysis.ml

Full commit
(*
 * Opifex
 *
 * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
 *)

open CWCPS_AST
open CWCPS_Transformation
open Batteries
open Algebra_Monoid
open DataModuleTypes

(*************************************************************************************************
 * Usage counting
 *
 * VariableUsageCount_FunMonoid
 *      Variable -> Monoid<Z, +, 0>
 ************************************************************************************************)


module UsageCountingAnalysis = struct

    module FunMonoid = PreparedMonoids.SumInt_FunMonoid(VariableOrderedType)

    let handle_values xs =
        xs
        |> List.filter_map get_variable
        |> FunMonoid.from_arg_list_with_val 1

    let __analyze = function
        | EXPR_App (label, fun_val, arg_vals) ->
            fun_val::arg_vals
            |> handle_values

        | EXPR_Switch (label, sel_val, default_branch, branches) ->
            [sel_val]
            |> handle_values

        | EXPR_Fix (reclabel, definitions, in_expr) ->
            FunMonoid.neutral

        | EXPR_ArithmeticBinaryPrimOp (label, primop, arg1, arg2, result, in_expr) ->
            [arg1; arg2]
            |> handle_values

        | EXPR_ArithmeticUnaryPrimOp (label, primop, arg, result, in_expr) ->
            [arg]
            |> handle_values

        | EXPR_ConditionPrimOp (label, primop, arg1, arg2, then_branch, else_branch) ->
            [arg1; arg2]
            |> handle_values

    let analyze tm =
        let module M = MonoidBased(FunMonoid) in
        M.Gather.gather __analyze tm
        |> FunMonoid.call

end

(*************************************************************************************************
 * Escaping variables
 *
 * EscapingVariable_FunMonoid
 *      Variable -> Monoid<Bool, or, false>
 ************************************************************************************************)


module EscapingVariablesAnalysis = struct

    module FunMonoid = PreparedMonoids.SumBool_FunMonoid(VariableOrderedType)

    let handle_values xs =
        xs
        |> List.filter_map get_variable
        |> FunMonoid.from_arg_list_with_val true

    let __analyze = function
        | EXPR_App (label, fun_val, arg_vals) ->
            arg_vals
            |> handle_values

        | _ ->
            FunMonoid.neutral

    let analyze =
        let module M = MonoidBased(FunMonoid) in
        M.Gather.gather __analyze

end

(*************************************************************************************************
 * BoundBy analysis
 *
 * BoundBy_FunMonoid
 *      Variable -> OneShotPartialMonoid<BoundBy>
 ************************************************************************************************)

module BoundByAnalysis = struct

    module Type = struct

        type t =
            BoundBy_FixDef of label * variable list * expression

        let equal (a : t) b = a = b

    end

    module FunMonoid = FunMonoid(VariableOrderedType)(OneShotPartialMonoid(Type))

    include Type

    let from_list xs =
        xs
        |> List.map (fun (a,b) -> (a, Some b))
        |> FunMonoid.from_list

    let __analyze = function
        | EXPR_Fix (reclabel, definitions, in_expr) ->
            let f (deflabel, defname, defargs, defbody) =
                (defname, BoundBy_FixDef (deflabel, defargs, defbody))
                in

            List.map f definitions
            |> from_list

        | _ ->
            FunMonoid.neutral

    let analyze tm = 
        let module M = MonoidBased(FunMonoid) in
        M.Gather.gather __analyze tm
        |> FunMonoid.call

end

(*************************************************************************************************
 ************************************************************************************************)

module Combined = struct

    type t =
        { usage_count : variable -> int
        ; escapes     : variable -> bool
        ; known       : variable -> bool
        ; bound_by    : variable -> BoundByAnalysis.t option
        }

    module Monoid = Tuple3Monoid
            (UsageCountingAnalysis.FunMonoid)
            (EscapingVariablesAnalysis.FunMonoid)
            (BoundByAnalysis.FunMonoid)

    let __analyze = Monoid.combine
        UsageCountingAnalysis.__analyze
        EscapingVariablesAnalysis.__analyze
        BoundByAnalysis.__analyze

    let analyze tm =
        let module M = MonoidBased(Monoid) in
        let (mon_usage_count, mon_escapes, mon_bound_by) = M.Gather.gather __analyze tm in

        { usage_count   = UsageCountingAnalysis.FunMonoid.call      mon_usage_count
        ; escapes       = EscapingVariablesAnalysis.FunMonoid.call  mon_escapes
        ; known         = EscapingVariablesAnalysis.FunMonoid.call  mon_escapes |- not
        ; bound_by      = BoundByAnalysis.FunMonoid.call    mon_bound_by
        }

end

(*************************************************************************************************
 ************************************************************************************************)

include Combined

let analyze = Combined.analyze