Skip to content

Commit

Permalink
Remove conditionals from profiling
Browse files Browse the repository at this point in the history
  • Loading branch information
@Izaakwltn
Izaakwltn committed Oct 14, 2024
1 parent 194c079 commit 65aaee3
Showing 1 changed file with 92 additions and 47 deletions.
139 changes: 92 additions & 47 deletions library/system.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,16 +3,23 @@
#:coalton
#:coalton-library/builtin
#:coalton-library/classes)
(:local-nicknames
(#:real #:coalton-library/math/real))
(:export
#:gc
#:time
#:sleep)
(:export
#:get-un-time
#:get-real-time
#:get-run-time
#+sbcl #:get-bytes-consed
#:time-units->seconds
#:time-units->rounded-microseconds
#:monotonic-bytes-consed

#:time
#:space

#:Profile
#:capture-profile)
#:spacetime)
(:export

#:LispCondition
Expand Down Expand Up @@ -46,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 (Integer -> Unit))
(define (sleep n)
"Sleep for `n` seconds."
Expand All @@ -74,57 +66,110 @@ 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-units->seconds (Integer -> Double-Float))
(define (time-units->seconds t)
"Converts internal time units into seconds."
(real:inexact/ t *internal-time-units-per-second*))

(declare time-units->rounded-microseconds (Integer -> Integer))
(define (time-units->rounded-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)

;;
;;
;;

(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-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 number of bytes consed.
Whether space information is availabel is implementation specific."
(gc)
(let start = (monotonic-bytes-consed))
(let value = (f))
(let end = (monotonic-bytes-consed))
(Tuple value (- end start)))

;;
;;
;;

(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 internal time units." Integer)
(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) -> (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)))))
(do
(a <- end-bytes-consed)
(b <- start-bytes-consed)
(pure (- a b)))))))


;;;
;;; Gathering System information
Expand Down

0 comments on commit 65aaee3

Please sign in to comment.