Skip to content

Commit

Permalink
Remove conditionals from profiling
Browse files Browse the repository at this point in the history
  • Loading branch information
Izaakwltn committed Oct 14, 2024
1 parent 194c079 commit 83c11f4
Showing 1 changed file with 62 additions and 46 deletions.
108 changes: 62 additions & 46 deletions library/system.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -3,14 +3,16 @@
#:coalton
#:coalton-library/builtin
#:coalton-library/classes)
(:local-nicknames
(#:real #:coalton-library/math/real))
(:export
#:gc
#:time
#:sleep)
(:export
#:get-real-time
#:get-run-time
#+sbcl #:get-bytes-consed
#:monotonic-bytes-consed
#:Profile
#:capture-profile)
(:export
Expand Down Expand Up @@ -46,21 +48,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 (Integer -> Unit))
(define (sleep n)
"Sleep for `n` seconds."
Expand All @@ -74,57 +61,86 @@ While the result will always contain microseconds, some implementations may retu

(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."
(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 (Unit -> 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-in-seconds (Integer -> Double-Float))
(define (time-in-seconds t)
"Converts `internal time units` into seconds."
(real:inexact/ t (internal-time-units-per-second)))

(declare time-in-microseconds (Integer -> Integer))
(define (time-in-microseconds t)
"Converts `internal time units` into microseconds."
(real: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)

(define-struct (Profile :a)
"A profile of a run function."
"A profile of a function, containing space and timing information.."
(output
"The output of the function" :a)
"The output of the function." :a)
(run-time
"The run time of the run" UFix)
"The run time of the run in seconds." Double-Float)
(real-time
"The real time of the run" UFix)
#+sbcl
"The real time of the run in seconds" Double-Float)
(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 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-run-time))
(let value = (f))
(let end = (get-run-time))
(Tuple value (time-in-microseconds (- end start))))

(declare spacetime ((Unit -> :a) -> (Profile :a)))
(define (spacetime f)
"Runs a function, profiling space and timing information and returning a `Profile` object. Garbage collection will happen before profiling is performed."
(gc)
(let (#+sbcl
(start-bytes-consed (get-bytes-consed))
(let ((start-bytes-consed (monotonic-bytes-consed))
(start-run-time (get-run-time))
(start-real-time (get-real-time))
(value (f))
#+sbcl
(end-bytes-consed (get-bytes-consed))
(end-bytes-consed (monotonic-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)))))
(time-in-seconds (- end-run-time start-run-time))
(time-in-seconds (- end-real-time start-real-time))
(match (Tuple end-bytes-consed start-bytes-consed)
((Tuple (Some a) (Some b))
(Some (- a b)))
(_ None))))))


;;;
;;; Gathering System information
Expand Down

0 comments on commit 83c11f4

Please sign in to comment.