From c490a0b03768231d15f6b9b9df70a92e8fa6a9cb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 9 Jan 2017 22:41:59 +0100 Subject: DRAFT store: Add support for build continuations. TODO: Add tests; update guix.texi. * guix/store.scm ()[continuations]: New field. (open-connection): Adjust accordingly. (set-build-continuation!, build-continuation): New procedures. (build-things): Rename to... (%build-things): ... this. (build-things, set-build-continuation): New procedures. * guix/derivations.scm (build-derivations): Add #:continuation? parameter and pass it to 'built-things'. Convert the return value to a list of store items. --- guix/derivations.scm | 29 ++++++++++++++++++++-------- guix/store.scm | 54 +++++++++++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 72 insertions(+), 11 deletions(-) diff --git a/guix/derivations.scm b/guix/derivations.scm index d5e4b5730b..c2a74b3a75 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -989,15 +989,28 @@ recursively." ;;; (define* (build-derivations store derivations - #:optional (mode (build-mode normal))) + #:optional (mode (build-mode normal)) + #:key (continuations? #t)) "Build DERIVATIONS, a list of objects or .drv file names, using -the specified MODE." - (build-things store (map (match-lambda - ((? string? file) file) - ((and drv ($ )) - (derivation-file-name drv))) - derivations) - mode)) +the specified MODE. When CONTINUATIONS? is true, run the \"build +continuations\" of each of DERIVATIONS. Return the list of store items that +were built." + (let ((things (build-things store (map (match-lambda + ((? string? file) file) + ((and drv ($ )) + (derivation-file-name drv))) + derivations) + mode))) + ;; Convert the list of .drv file names to a list of output file names. + (append-map (match-lambda + ((? derivation-path? drv) + (let ((drv (call-with-input-file drv read-derivation))) + (match (derivation->output-paths drv) + (((outputs . items) ...) + items)))) + (x + (list x))) + things))) ;;; diff --git a/guix/store.scm b/guix/store.scm index 49549d0771..98478bc38f 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -71,6 +71,8 @@ add-to-store build-things build + set-build-continuation! + set-build-continuation query-failed-paths clear-failed-paths add-temp-root @@ -312,12 +314,16 @@ (define-record-type (%make-nix-server socket major minor - ats-cache atts-cache) + continuations ats-cache atts-cache) nix-server? (socket nix-server-socket) (major nix-server-major-version) (minor nix-server-minor-version) + ;; Hash table that maps store items to a "build continuation" for that store + ;; item. + (continuations nix-server-build-continuations) + ;; Caches. We keep them per-connection, because store paths build ;; during the session are temporary GC roots kept for the duration of ;; the session. @@ -400,6 +406,7 @@ for this connection will be pinned. Return a server object." (protocol-major v) (protocol-minor v) (make-hash-table 100) + (make-hash-table 100) (make-hash-table 100)))) (let loop ((done? (process-stderr conn))) (or done? (process-stderr conn))) @@ -720,7 +727,19 @@ where FILE is the entry's absolute file name and STAT is the result of (hash-set! cache args path) path)))))) -(define build-things +(define (set-build-continuation! store item proc) + "Register PROC as a \"build continuation\" for when ITEM is built on STORE. +When 'build-things' is passed ITEM, it calls (PROC STORE ITEM), which must +return a list of store items to build." + (hash-set! (nix-server-build-continuations store) item proc)) + +(define (build-continuation store item) + "Return the procedure that implements a \"build continuation\" for ITEM, or +#f if there is none." + (hash-ref (nix-server-build-continuations store) item)) + +(define %build-things + ;; This is the raw RPC. (let ((build (operation (build-things (string-list things) (integer mode)) "Do it!" @@ -741,6 +760,29 @@ Return #t on success." (message "unsupported build mode") (status 1))))))))) +(define* (build-things store things + #:optional (mode (build-mode normal)) + #:key (continuations? #t)) + "Build THINGS, a list of store items which may be either '.drv' files or +outputs, and return when the worker is done building them. Elements of THINGS +that are not derivations can only be substituted and not built locally. When +CONTINUATIONS? is true, run the \"build continuations\" of THINGS. Return the +list of store items built." + (let loop ((things things) + (built '())) + (match things + (() + built) + (_ + (and (%build-things store things mode) + (loop (append-map (lambda (thing) + (let ((proc (build-continuation store thing))) + (if proc + (proc store thing) + '()))) + things) + things)))))) + (define-operation (add-temp-root (store-path path)) "Make PATH a temporary root for the duration of the current session. Return #t." @@ -1184,6 +1226,12 @@ where FILE is the entry's absolute file name and STAT is the result of ;; Monadic variant of 'build-things'. (store-lift build-things)) +(define (set-build-continuation item proc) + "Register monadic thunk PROC as a \"build continuation\" for ITEM." + (lambda (store) + (set-build-continuation! store item (store-lower proc)) + (values *unspecified* store))) + (define set-build-options* (store-lift set-build-options)) -- cgit 1.4.1