From 63bf4430c2eb51bc7d69485489373a916a4b088b Mon Sep 17 00:00:00 2001 From: Izaak Walton Date: Mon, 14 Oct 2024 12:19:47 -0700 Subject: [PATCH] Removing conditionals from profiling --- library/system.lisp | 153 +++++++++++++++++++++++++++----------------- 1 file changed, 94 insertions(+), 59 deletions(-) diff --git a/library/system.lisp b/library/system.lisp index 42c733cb..680b528c 100644 --- a/library/system.lisp +++ b/library/system.lisp @@ -7,14 +7,19 @@ (#:math #:coalton-library/math)) (:export #:gc - #:time #:sleep) (:export #:get-real-time - #:get-run-time - #+sbcl #:get-bytes-consed - #:Profile - #:capture-profile) + #:internal-time-units-per-second + #:time-units->seconds + #:time-units->rounded-microseconds + #:monotonic-bytes-consed + + #:time + #:space + + #:MeteredResults + #:spacetime) (:export #:LispCondition @@ -48,21 +53,6 @@ (trivial-garbage:gc :full cl:t) Unit)) - (declare time ((Unit -> :a) -> (Tuple :a Integer))) - (define (time f) - "Run the thunk `f` and return a tuple containing its value along with the run time in microseconds. - -While the result will always contain microseconds, some implementations may return a value rounded to less precision (e.g., rounded to the nearest second or millisecond)." - (let start = (lisp Integer () (cl:get-internal-run-time))) - (let value = (f)) - (let end = (lisp Integer () (cl:get-internal-run-time))) - (Tuple value - (lisp Integer (start end) - (cl:values - (cl:round - (cl:* 1000000 (cl:- end start)) - cl:internal-time-units-per-second))))) - (declare sleep ((math:Rational :a) => :a -> Unit)) (define (sleep n) "Sleep for `n` seconds, where `n` can be of any type with an instance of `Rational`. @@ -81,57 +71,102 @@ Sleep uses type class `Rational`'s `best-approx` instead of `Real`'s `real-appro (coalton-toplevel - (declare get-run-time (Unit -> UFix)) + (declare get-run-time (Unit -> Integer)) (define (get-run-time) - "Gets the run-time." - (lisp UFix () + "Gets the run-time in internal time units. This is implementation specific: it may measure real time, run time, CPU cycles, or some other quantity. + +The difference between two successive calls to this function represents quantity accumulated during that period of time. + +This function is not exported as its output is too implementation specific." + (lisp Integer () (cl:get-internal-run-time))) - (declare get-real-time (Unit -> UFix)) + (declare get-real-time (Unit -> Integer)) (define (get-real-time) - "Gets the real-time." - (lisp UFix () + "Gets the real-time in internal time units. The difference between two successive calls to this function represents the time that has elapsed." + (lisp Integer () (cl:get-internal-real-time))) - #+sbcl - (declare get-bytes-consed (Unit -> UFix)) - #+sbcl - (define (get-bytes-consed) - "Gets the number of bytes consed (only implemented for SBCL" - (lisp UFix () - (sb-ext:get-bytes-consed))) + (declare internal-time-units-per-second Integer) + (define internal-time-units-per-second + "The number of internal time units per second. This is implementation specific." + (lisp Integer () + cl:internal-time-units-per-second)) + + (declare time-units->seconds (Integer -> Fraction)) + (define (time-units->seconds t) + "Converts internal time units into `Fraction` seconds." + (math:exact/ t internal-time-units-per-second)) + + (declare time-units->rounded-microseconds (Integer -> Integer)) + (define (time-units->rounded-microseconds t) + "Converts internal time units into an integer number of rounded microseconds." + (math:round/ (* 1000000 t) + internal-time-units-per-second)) + + (declare monotonic-bytes-consed (Unit -> (Optional Integer))) + (define (monotonic-bytes-consed) + "Returns the number of bytes consed since some unspecified point in time. + +The difference between two successive calls to this function represents the number of bytes consed in that period of time." + #+sbcl + (Some (lisp Integer () + (sb-ext:get-bytes-consed))) + #-sbcl + None) + + ;;; + ;;; Function instrumentation + ;;; + + (declare time ((Unit -> :a) -> (Tuple :a Integer))) + (define (time f) + "Run the thunk `f` and return a tuple containing its value along with the run time in microseconds. + +While the result will always contain microseconds, some implementations may return a value rounded to less precision (e.g., rounded to the nearest second or millisecond)." + (let start = (get-real-time)) + (let value = (f)) + (let end = (get-real-time)) + (Tuple value (time-units->rounded-microseconds (- end start)))) - (define-struct (Profile :a) - "A profile of a run function." + (declare space ((Unit -> :a) -> (Tuple :a (Optional Integer)))) + (define (space f) + "Run the thunk `f` and return a tuple containing its value along with the approximate number of bytes consed during the course of executing f. + +The amount of space used may be peculiar to the implementation, such as rounding to certain page boundaries. + +A garbage collection will be forced prior to invoking `f`." + (gc) + (let start = (monotonic-bytes-consed)) + (let value = (f)) + (let end = (monotonic-bytes-consed)) + (Tuple value (- end start))) + + (define-struct (MeteredResults :a) + "Function output with space and timing metedata." (output - "The output of the function" :a) - (run-time - "The run time of the run" UFix) + "The output of the function." :a) (real-time - "The real time of the run" UFix) - #+sbcl + "The real time of the run in internal time units." Integer) (bytes-consed - "The number of bytes consed during the run." UFix)) + "The number of bytes consed during the run." (Optional Integer))) - (declare capture-profile ((Unit -> :a) -> (Profile :a))) - (define (capture-profile f) - "Runs a function, recording profile information and returning a Profile object." + (declare spacetime ((Unit -> :a) -> (MeteredResults :a))) + (define (spacetime f) + "Runs a function, gathering space and timing information and returning a `MeteredResults` object. + +Garbage collection will happen before profiling is performed." (gc) - (let (#+sbcl - (start-bytes-consed (get-bytes-consed)) - (start-run-time (get-run-time)) - (start-real-time (get-real-time)) - (value (f)) - #+sbcl - (end-bytes-consed (get-bytes-consed)) - (end-run-time (get-run-time)) - (end-real-time (get-real-time))) - (Profile - value - (- end-run-time start-run-time) - (- end-real-time start-real-time) - #+sbcl - (- end-bytes-consed start-bytes-consed))))) + (let start-bytes-consed = (monotonic-bytes-consed)) + (let start-real-time = (get-real-time)) + (let value = (f)) + (let end-bytes-consed = (monotonic-bytes-consed)) + (let end-real-time = (get-real-time)) + (MeteredResults + value + (- end-real-time start-real-time) + (- end-bytes-consed start-bytes-consed)))) + ;;; ;;; Gathering System information