Skip to content

Commit

Permalink
Removing conditionals from profiling
Browse files Browse the repository at this point in the history
  • Loading branch information
@Izaakwltn
Izaakwltn committed Oct 16, 2024
1 parent 80ad3cc commit abd26d6
Showing 1 changed file with 93 additions and 58 deletions.
151 changes: 93 additions & 58 deletions library/system.lisp
View file
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
#:internal-time-units-per-second
#:time-units->seconds
#:time-units->rounded-microseconds
#:monotonic-bytes-consed

#:time
#:space

#:Profile
#:capture-profile)
#: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)
"Sleep for `n` seconds, where `n` can be of any type with an instance of `Rational`.
Expand All @@ -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:mkfraction 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
Expand Down

0 comments on commit abd26d6

Please sign in to comment.