Script Library: 1227 scripts


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- Core- 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 ] ]
halt ;; to terminate script if DO'ne from webpage