From 3b8565c33b58196ffe2e3dd8f23a73de57a268f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 9 Mar 2020 23:47:05 +0100 Subject: Sprinkled in some time prints. --- module/entry-points/html.scm | 4 ++++ module/main.scm | 2 ++ module/util/time.scm | 16 ++++++++++++++++ module/vcomponent/load.scm | 5 +++++ module/vcomponent/parse.scm | 3 +++ 5 files changed, 30 insertions(+) create mode 100644 module/util/time.scm diff --git a/module/entry-points/html.scm b/module/entry-points/html.scm index c08dd72d..55fb0c94 100644 --- a/module/entry-points/html.scm +++ b/module/entry-points/html.scm @@ -2,6 +2,7 @@ :export (main) :use-module (output html) :use-module (util) + :use-module (util time) :use-module (vcomponent) :use-module (datetime) :use-module (datetime util) @@ -32,6 +33,9 @@ calendar-files: (cond [(option-ref opts 'file #f) => list] [else (calendar-files)]) )) + + (report-time! "Calendars loaded") + (if (option-ref opts 'chunked #f) (html-chunked-main count calendars events start) (html-generate calendars events start end render-calendar))) diff --git a/module/main.scm b/module/main.scm index 15079dc5..bb3fa041 100755 --- a/module/main.scm +++ b/module/main.scm @@ -13,6 +13,7 @@ exec guile -e main -s $0 "$@" (util) (util io) + (util time) ((entry-points html) :prefix html-) ((entry-points terminal) :prefix terminal-) @@ -84,6 +85,7 @@ exec guile -e main -s $0 "$@" (use-modules (system vm frame)) (define (main args) + (report-time! "Program start") (with-throw-handler #t (lambda () (wrapped-main args)) (lambda (err . args) diff --git a/module/util/time.scm b/module/util/time.scm new file mode 100644 index 00000000..004cb6dc --- /dev/null +++ b/module/util/time.scm @@ -0,0 +1,16 @@ +(define-module (util time) + :export (report-time!)) + + +(define report-time! + (let ((last 0)) + (lambda (fmt . args) + (let ((run (get-internal-run-time)) + ; (real (get-internal-real-time)) + ) + (format (current-error-port) "~7,4fs (+ ~,4fs) │ ~?~%" + (/ run internal-time-units-per-second) + (/ (- run last) internal-time-units-per-second) + ;; (/ real internal-time-units-per-second) + fmt args) + (set! last run))))) diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm index 0cb03b42..e3e6f192 100644 --- a/module/vcomponent/load.scm +++ b/module/vcomponent/load.scm @@ -1,6 +1,7 @@ (define-module (vcomponent load) :export (load-calendars load-calendars*) :use-module (util) + :use-module (util time) :use-module (srfi srfi-1) :use-module (datetime) :use-module (datetime util) @@ -17,7 +18,9 @@ ;; Reads all calendar files from disk, generate recurence-sets for all repeating events, ;; and returns a list of calendars, and a stream of all events "ready" for display. (define* (load-calendars #:key (calendar-files (calendar-files))) + (report-time! "Parsing ~a calendars" (length calendar-files)) (let* ((calendars regular repeating (load-calendars* #:calendar-files calendar-files))) + (report-time! "Calendars loaded, interleaving and reccurring") (values calendars (interleave-streams @@ -39,8 +42,10 @@ (children cal))) calendars))) + (report-time! "Parse done, partitioning...") (let* ((repeating regular (partition repeating? events))) + (report-time! "Sorting") ;; NOTE There might be instances where we don't care if the ;; collection if sorted, but for the time beieng it's much ;; easier to always sort it. diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm index 32b368c7..ef31cbd0 100644 --- a/module/vcomponent/parse.scm +++ b/module/vcomponent/parse.scm @@ -11,6 +11,7 @@ :use-module ((ice-9 ftw) :select (scandir ftw)) :use-module (util) + :use-module (util time) :use-module (util strbuf) :use-module (vcomponent base) :use-module (vcomponent datetime) @@ -92,6 +93,7 @@ ;; Reads a vcomponent from the given port. (define-public (parse-calendar port) + ;; (report-time! "Parsing ~a" port) (with-input-from-port port (lambda () (let ((component (make-vcomponent)) @@ -359,6 +361,7 @@ row ~a column ~a ctx = ~a (set! (attr comp 'X-HNH-SOURCETYPE) "file") comp) ] [(directory) + (report-time! "Parsing ~a" path) (let ((comp (parse-vdir path))) (set! (attr comp 'X-HNH-SOURCETYPE) "vdir") comp)] -- cgit v1.2.3