Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Remove conditionals from profiling #1302

Merged
merged 1 commit into from
Oct 17, 2024
Merged

Remove conditionals from profiling #1302

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
160 changes: 99 additions & 61 deletions library/system.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

#:MeteredResult
#:spacetime)
(:export

#:LispCondition
Expand Down Expand Up @@ -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)
Izaakwltn marked this conversation as resolved.
Show resolved Hide resolved
"Sleep for `n` seconds, where `n` can be of any type with an instance of `Rational`.
Expand All @@ -81,57 +71,105 @@ 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)))
Izaakwltn marked this conversation as resolved.
Show resolved Hide resolved

(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)))

(define-struct (Profile :a)
"A profile of a run function."
(output
"The output of the function" :a)
(run-time
"The run time of the run" UFix)
(real-time
"The real time of the run" UFix)
(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."
Izaakwltn marked this conversation as resolved.
Show resolved Hide resolved
#+sbcl
(Some (lisp Integer ()
(sb-ext:get-bytes-consed)))
#-sbcl
None)

;;;
;;; Function instrumentation
;;;

(declare time ((Unit -> :a) -> (Tuple :a Integer)))
(define (time f)
Izaakwltn marked this conversation as resolved.
Show resolved Hide resolved
"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))))

(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 (MeteredResult :a)
"Function output with space and timing metedata."
(result
"The result of the function." :a)
(time-elapsed
"The real time elapsed running the function (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) -> (MeteredResult :a)))
(define (spacetime f)
"Runs a function, gathering space and timing information and returning a `MeteredResults` object.
Izaakwltn marked this conversation as resolved.
Show resolved Hide resolved

Garbage collection will be performed 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)))))
Izaakwltn marked this conversation as resolved.
Show resolved Hide resolved
;; The order of these bindings ensures that slight inaccuracy of
;; the measurements is shared across both bytes consed and
;; elapsed time.
(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))
(MeteredResult
value
(- end-real-time start-real-time)
(- end-bytes-consed start-bytes-consed))))


;;;
;;; Gathering System information
Expand Down
Loading