Script Library: profiler.r

Script Library: 1240 scripts
profiler.r

REBOL [
    Title: "Rebol Profiler"
    Author: "Ingo Hohmann"
    Date: 2003-10-10
    Purpose: {For profiling parts of Rebol scripts}
    file: %profiler.r
    library: [
        level: 'intermediate
        platform: 'all
        type: [tool]
        domain: [all]
                support: none
                license: gpl
        tested-under: [View-2.8.1.4.2 Core-2.5.6.4.2 and-others]
    ]
    Usage: {
        I use it mostly to check runtime effect of little rebol snippets, e.g.
        profiler/test [do reduce [1 = 0]] 1000000
        against
          profiler/test [first reduce [1 = 0]] 1000000
        }
]

profiler: context [
    markers: []
    
    mark: func [
    "adds a profiler mark"
        marker [word!]
    ] [
        insert tail markers reduce [ marker now/time/precise ]
    ]

    

    show: func [
    "shows time since setting a profiler mark"
        marker [word!]
        /local t walk ret-val last-val tmp-val
    ] [
        ret: copy []
        t: now/time/precise
        if walk: find markers marker [
            walk: next walk
            last-val: first walk
            while [walk: find walk marker] [
                walk: next walk
                append ret (first walk) - last-val
                last-val: first walk
            ]
        ]
        ret
    ]

    test: func [
        {tests a block for speed *!* clears the markers block *!*}
        block [block!]
        times [integer!]
    ] [
        block: copy/deep block
        clear
        mark 't
        loop times [do block]
        mark 't
        show 't
    ]
    
    clear: func [
        "Clears all markers"
        /only marker [word!]
        /local walk
    ] [
        either only [
            walk: find markers marker
            until [
                remove/part walk 2
                not found? find walk marker
            ]
        ] [
            system/words/clear markers
        ]
    ]

    ;
    ; EXPERIMENTAL CODE FOLLOWING
    ;

    next-marker: 1
    
    _func: function!
    ;
    ; ToDo:
    ; create a list of marks, find a way to name the functions
    ;
    profiling-func: func [
        {Adds profiling data to a normal function}
            [catch] 
    spec [block!] {Help string (opt) followed by arg words (and opt type and string)} 
    body [block!] "The body block of the function"
        /local pre post
    ][
        pre: copy [catch/name ]
        post: copy ['profiling-return]
        insert body compose [profiler/mark (to-word join 'm next-marker)]
        next-marker: next-marker + 1
        insert tail insert/only tail pre body post
        probe pre
    ]
    
    install: func [
        {Installs a profiling 'func
            every new func after this will create a profiling function}
    ][
        _func: :func
        func: :profiling-func
    ]
    
]