diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2021-05-28 17:45:38 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-06-08 09:25:49 +0200 |
| commit | 6bd3d4fe06a65db5356f4eec43a505a47acc3934 (patch) | |
| tree | adfc7d7dc5005b862a91091374363ae492f5626b | |
| parent | 0a3c723e0771e488cad79ae7c6f20bc83023eeb0 (diff) | |
| download | guix-6bd3d4fe06a65db5356f4eec43a505a47acc3934.tar guix-6bd3d4fe06a65db5356f4eec43a505a47acc3934.tar.gz | |
grafts: Record cache lookups for profiling.
* guix/grafts.scm (record-cache-lookup!): New procedure.
(with-cache): Use it.
| -rw-r--r-- | guix/grafts.scm | 10 |
1 files changed, 8 insertions, 2 deletions
diff --git a/guix/grafts.scm b/guix/grafts.scm index fd8a108092..dff3d75b8b 100644 --- a/guix/grafts.scm +++ b/guix/grafts.scm @@ -172,10 +172,16 @@ references." items)))) (remove (cut member <> self) refs))) +(define record-cache-lookup! + (cache-lookup-recorder "derivation-graft-cache" + "Derivation graft cache")) + (define-syntax-rule (with-cache key exp ...) "Cache the value of monadic expression EXP under KEY." - (mlet %state-monad ((cache (current-state))) - (match (vhash-assoc key cache) + (mlet* %state-monad ((cache (current-state)) + (result -> (vhash-assoc key cache))) + (record-cache-lookup! result cache) + (match result ((_ . result) ;cache hit (return result)) (#f ;cache miss |