gistfile1.txt

[<AutoOpen>] 
module PrivateEye

#r "PrivateEye.Bridge.dll"

open PrivateEye.Bridge
open PrivateEye.Bridge.profilersession
open System
open System.IO


let line = new string('-', 80)
let longline = new string('-', 105)

let left str length = 
    if String.length str > length then str.Substring(0, length)
    else str 

let tinfoHeader() = 
    sprintf "%s\n|%-42s|%10s|%15s|%8s|\n%s\n" 
        line 
        "Name" 
        "Allocs" 
        "Alloc Size" 
        "Thrown" 
        line

let tinfoFooter() = line 
let tinfoRow (info : TypeInformation) = 
    let nameShort = left info.Name 42
    sprintf "|%-42s|%10u|%15u|%8u|\n" 
        nameShort 
        info.AllocatedCount 
        info.AllocatedSize 
        info.ThrownCount

let printTypeSeq (seq : seq<TypeInformation>) =
    let x = seq |> Seq.map(tinfoRow) |> String.concat ""
    tinfoHeader() + x + tinfoFooter()

let minfoHeader() = 
    sprintf "\n%s\n|%-33s|%8s|%11s|%8s|%11s|%8s|%11s|%6s|\n%s\n" 
        longline 
        "Name" 
        "Called" 
        "Total Time" 
        "Allocs" 
        "A. Size"
        "AAlloc"
        "AA. Size"
        "Thrown" 
        longline 

let printMethodName (info : MethodInformation) =
    if info.Name.Contains("ctor") then
        let sections = info.Name.Split('.')
        sections |> 
        Seq.skip (sections.Length - 2) |> 
        String.concat ""
    else
        info.Name.Split(':') |> Seq.last

let minfoFooter() = longline
let minfoRow (info : MethodInformation) =
    let ms = decimal info.TotalTime / 1000000M
    sprintf "|%-33s|%8d|%11M|%8d|%11d|%8d|%11d|%6d|\n" 
        (left (printMethodName info) 33)
        info.CalledCount 
        (System.Math.Round(ms, 4))
        info.AllocationsMadeCount 
        info.AllocationsMadeSize 
        info.EffectiveAllocationsMadeCount
        info.EffectiveAllocationsMadeSize
        info.ExceptionsThrown

let printMethodSeq (seq : seq<MethodInformation>) =
    let txt = seq |> Seq.map(minfoRow) |> String.concat ""
    minfoHeader() + txt + minfoFooter()

let calledHeader() = line + "\n"
let calledFooter() = line + "\n"

let allocatedHeader() = line + "\n"
let allocatedFooter() = line + "\n"

let calledRow (call : MethodCallInfo) =
    sprintf "|%17d|%60s|\n"
        call.Count
        call.Method.Name

let allocatedRow (info : MethodAllocationInfo) =
    sprintf "|%17d|%60s|\n"
        info.AllocationCount
        info.Method.Name

let calledInfo (seq : seq<MethodCallInfo>) =
    let rows = seq |> Seq.map(calledRow) |> String.concat ""
    calledHeader() + rows + calledFooter()

let allocatedInfo (seq : seq<MethodAllocationInfo>) =
    let rows = seq |> Seq.map(allocatedRow) |> String.concat ""
    allocatedHeader() + rows + allocatedFooter()

let getMethodStr(x : MethodInformation) =
    let sw = new StringWriter()
    fprintfn sw "Name: %s" x.Name
    fprintfn sw "Calls : %10d\t\tTail : %15d" x.CalledCount x.TailCalls
    fprintfn sw "Allocs: %10d\t\tSize : %15d" x.AllocationsMadeCount x.AllocationsMadeSize
    fprintfn sw "Time T: %10d\t\tUnder: %15d\n" x.TotalTime x.TimeUnder
    sw.ToString()

let getTypeStr(x : TypeInformation) =
    let sw = new StringWriter()
    fprintfn sw "Name: %s" x.Name
    fprintfn sw "Allocs: %10d\t\tSize : %15d" x.AllocatedCount x.AllocatedSize
    fprintfn sw "Thrown: %10d\t\t\n" x.ThrownCount
    sw.ToString()

let printMethodInfo (x : MethodInformation) =
    let callsTo = "Calls To:\n" + calledInfo(x.GetCallsTo())
    let callsFrom = "Called From:\n" + calledInfo(x.GetCalledFrom())
    let info = getMethodStr(x) 
    info + callsTo + callsFrom

let printTypeInfo (x : TypeInformation) =
    let allocatedBy = "Allocated By:\n" + allocatedInfo(x.GetAllocatedBy())
    let info = getTypeStr(x) 
    info + allocatedBy

let addFsiPrinters() =
    fsi.AddPrinter (fun (x:seq<MethodInformation>) -> printMethodSeq x)
    fsi.AddPrinter (fun (x:seq<TypeInformation>) -> printTypeSeq x)
    fsi.AddPrinter (fun (x:MethodInformation) -> printMethodInfo x)
    fsi.AddPrinter (fun (x:TypeInformation) -> printTypeInfo x)

let inverse x = UInt64.MaxValue - x


//method helpers

let mostTimeMethods () =  
    Profiler.Data.Methods 
    |> Seq.filter (fun x-> x.CalledCount > 0UL)
    |> Seq.sortBy (fun x-> inverse x.TotalTime) 


let mostTimeUnderMethods () =  
    Profiler.Data.Methods 
    |> Seq.filter (fun x-> x.CalledCount > 0UL)
    |> Seq.sortBy (fun x-> inverse x.TimeUnder) 

let highestAfferent () =
    Profiler.Data.Methods
    |> Seq.filter (fun x-> x.CalledCount > 0UL)
    |> Seq.sortBy (fun x-> inverse x.CalledFromCount)

let highestEfferent () =
    Profiler.Data.Methods
    |> Seq.filter (fun x-> x.CalledCount > 0UL)
    |> Seq.sortBy (fun x-> inverse x.CallsToCount)

let mostCalledMethods () =  
    Profiler.Data.Methods 
    |> Seq.filter  (fun x-> x.CalledCount > 0UL) 
    |> Seq.sortBy (fun x-> inverse x.CalledCount) 

let mostActualAllocatingMethods () =  
    Profiler.Data.Methods 
    |> Seq.filter  (fun x-> x.EffectiveAllocationsMadeCount > 0UL) 
    |> Seq.sortBy (fun x-> inverse x.EffectiveAllocationsMadeSize) 


let mostAllocatingMethods () =  
    Profiler.Data.Methods 
    |> Seq.filter  (fun x-> x.AllocationsMadeCount > 0UL) 
    |> Seq.sortBy (fun x-> inverse x.AllocationsMadeSize) 


let methodsThrowingExceptions () =
    Profiler.Data.Methods
    |> Seq.filter (fun x->x.ExceptionsThrown > 0UL)
    |> Seq.sortBy (fun x-> inverse x.ExceptionsThrown)

//type helpers

let mostThrownTypes () =
    Profiler.Data.Types
    |> Seq.filter (fun x->x.ThrownCount > 0UL)
    |> Seq.sortBy (fun x->inverse x.ThrownCount)

let mostAllocatedTypes () =
    Profiler.Data.Types
    |> Seq.filter (fun x->x.AllocatedCount > 0UL)
    |> Seq.sortBy (fun x->inverse x.AllocatedSize)

let onAllocation () =
    Profiler.Data.ObjectAllocated :> System.IObservable<_>


let onMethodEnter () =
    Profiler.Data.MethodEntered :> System.IObservable<_>


let onMethodLeave () =
    Profiler.Data.MethodLeft :> System.IObservable<_>


let onMethodCalled () =
    Profiler.Data.MethodCalled :> System.IObservable<_>

let onExceptionThrown () =
    Profiler.Data.ExceptionThrown :> System.IObservable<_>


let profSummary() = 
    let x = mostThrownTypes() |> printTypeSeq
    printf "%s" x

let profilerStats() = 
    printf "Profiler statistics\n"
    printf "    Messages    : %d\n" Profiler.Data.TotalMessages
    printf "    Calls       : %d\n" Profiler.Data.MethodsCalled
    printf "    Exceptions  : %d\n" Profiler.Data.TotalExceptionCount
    printf "    Allocations : %d\n" Profiler.Data.TotalAllocations
    printf "    Type Defs   : %d\n" Profiler.Data.TypeDefinitions
    printf "    Method Defs : %d\n" Profiler.Data.MethodDefinitions

let resetProfiler() =
    Profiler.ResetProfilerSession()

let resetSession() = 
    Profiler.ResetData()

//commands
let enableGCTracking() = 
    Profiler.EnableGCTracking()

let disableGCTracking() = 
    Profiler.DisableGCTracking()

let enableAllocationTracking() = 
    Profiler.EnableAllocationTracking()

let disableAllocationTracking() = 
    Profiler.DisableAllocationTracking()

let enableMethodTracking() = 
    Profiler.EnableMethodTracking()

let disableMethodTracking() = 
    Profiler.DisableMethodTracking()

let enableExceptionTracking() = 
    Profiler.EnableExceptionTracking()

let disableExceptionTracking() = 
    Profiler.DisableExceptionTracking()

//self profiling

let profile x = 
    printf "starting self profile\n"
    Profiler.SelfStartProfiling()
    printf "done.\n"
    printf "calling code\n"
    let ret = x()
    printf "done calling code\n"
    printf "calling stop self\n"
    Profiler.SelfStopProfiling 5
    printf "stop self done\n"
    ret



//example
//connect to a remote profiler start remote profiler first
//Profiler.ConnectTo(new IPEndPoint (new IPAddress(...), 4444)

//Start listening after this you would start the profiler which connects
//Profiler.StartListening()

//now you are connected and can run something like this:
//
//Profiler.Data.Methods 
//      |> Seq.filter  (fun x-> x.AllocationsMadeCount > 0UL) 
//      |> Seq.sortBy (fun x-> x.CalledCount) 
//      |> Seq.take 50 
//      |> Seq.iter dump_minfo