diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build-system/gnu.scm | 4 | ||||
| -rw-r--r-- | guix/build-system/python.scm | 4 | ||||
| -rw-r--r-- | guix/combinators.scm | 18 | ||||
| -rw-r--r-- | guix/derivations.scm | 1 | ||||
| -rw-r--r-- | guix/gnu-maintenance.scm | 2 | ||||
| -rw-r--r-- | guix/import/cran.scm | 4 | ||||
| -rw-r--r-- | guix/import/elpa.scm | 3 | ||||
| -rw-r--r-- | guix/memoization.scm | 114 | ||||
| -rw-r--r-- | guix/modules.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/build.scm | 1 | ||||
| -rw-r--r-- | guix/scripts/graph.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/lint.scm | 2 | ||||
| -rw-r--r-- | guix/store.scm | 2 | ||||
| -rw-r--r-- | guix/utils.scm | 2 |
14 files changed, 132 insertions, 33 deletions
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index f6df183da4..f05ddf91f5 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,7 +19,7 @@ (define-module (guix build-system gnu) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix derivations) #:use-module (guix search-paths) #:use-module (guix build-system) diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index d4d3d28f2a..bfe0eca9f6 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; @@ -21,7 +21,7 @@ (define-module (guix build-system python) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix search-paths) diff --git a/guix/combinators.scm b/guix/combinators.scm index 9e4689ba9c..11cad62ccf 100644 --- a/guix/combinators.scm +++ b/guix/combinators.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; ;;; This file is part of GNU Guix. @@ -20,8 +20,7 @@ (define-module (guix combinators) #:use-module (ice-9 match) #:use-module (ice-9 vlist) - #:export (memoize - fold2 + #:export (fold2 fold-tree fold-tree-leaves compile-time-value)) @@ -33,19 +32,6 @@ ;;; ;;; Code: -(define (memoize proc) - "Return a memoizing version of PROC." - (let ((cache (make-hash-table))) - (lambda args - (let ((results (hash-ref cache args))) - (if results - (apply values results) - (let ((results (call-with-values (lambda () - (apply proc args)) - list))) - (hash-set! cache args results) - (apply values results))))))) - (define fold2 (case-lambda ((proc seed1 seed2 lst) diff --git a/guix/derivations.scm b/guix/derivations.scm index b712c508e5..056b1163b4 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -31,6 +31,7 @@ #:use-module (ice-9 vlist) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix memoization) #:use-module (guix combinators) #:use-module (guix monads) #:use-module (guix hash) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index e4151c652c..05ea19236b 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -30,7 +30,7 @@ #:use-module (guix http-client) #:use-module (guix ftp-client) #:use-module (guix utils) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix records) #:use-module (guix upstream) #:use-module (guix packages) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 463a25514e..40cdea029b 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net> -;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,7 +27,7 @@ #:use-module (srfi srfi-41) #:use-module (ice-9 receive) #:use-module (web uri) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix http-client) #:use-module (guix hash) #:use-module (guix store) diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index 96cf5bbae6..c0b0c415cf 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> -;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -35,7 +35,6 @@ #:use-module (guix base32) #:use-module (guix upstream) #:use-module (guix packages) - #:use-module ((guix combinators) #:select (memoize)) #:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:export (elpa->guix-package %elpa-updater)) diff --git a/guix/memoization.scm b/guix/memoization.scm new file mode 100644 index 0000000000..d64f60fe9c --- /dev/null +++ b/guix/memoization.scm @@ -0,0 +1,114 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix memoization) + #:export (memoize + mlambda + mlambdaq)) + +(define-syntax-rule (call/mv thunk) + (call-with-values thunk list)) +(define-syntax-rule (return/mv lst) + (apply values lst)) + +(define-syntax-rule (call/1 thunk) + (thunk)) +(define-syntax-rule (return/1 value) + value) + +(define %nothing ;nothingness + (list 'this 'is 'nothing)) + +(define-syntax define-cache-procedure + (syntax-rules () + "Define a procedure NAME that implements a cache using HASH-REF and +HASH-SET!. Use CALL to invoke the thunk and RETURN to return its value; CALL +and RETURN are used to distinguish between multiple-value and single-value +returns." + ((_ name hash-ref hash-set! call return) + (define (name cache key thunk) + "Cache the result of THUNK under KEY in CACHE, or return the +already-cached result." + (let ((results (hash-ref cache key %nothing))) + (if (eq? results %nothing) + (let ((results (call thunk))) + (hash-set! cache key results) + (return results)) + (return results))))) + ((_ name hash-ref hash-set!) + (define-cache-procedure name hash-ref hash-set! + call/mv return/mv)))) + +(define-cache-procedure cached/mv hash-ref hash-set!) +(define-cache-procedure cachedq/mv hashq-ref hashq-set!) +(define-cache-procedure cached hash-ref hash-set! call/1 return/1) +(define-cache-procedure cachedq hashq-ref hashq-set! call/1 return/1) + +(define (memoize proc) + "Return a memoizing version of PROC. + +This is a generic version of 'mlambda' what works regardless of the arity of +'proc'. It is more expensive since the argument list is always allocated, and +the result is returned via (apply values results)." + (let ((cache (make-hash-table))) + (lambda args + (cached/mv cache args + (lambda () + (apply proc args)))))) + +(define-syntax %mlambda + (syntax-rules () + "Return a memoizing lambda. This is restricted to procedures that return +exactly one value." + ((_ cached () body ...) + ;; The zero-argument case is equivalent to a promise. + (let ((result #f) (cached? #f)) + (lambda () + (unless cached? + (set! result (begin body ...)) + (set! cached? #t)) + result))) + + ;; Optimize the fixed-arity case such that there's no argument list + ;; allocated. XXX: We can't really avoid the closure allocation since + ;; Guile 2.0's compiler will always keep it. + ((_ cached (arg) body ...) ;one argument + (let ((cache (make-hash-table)) + (proc (lambda (arg) body ...))) + (lambda (arg) + (cached cache arg (lambda () (proc arg)))))) + ((_ _ (args ...) body ...) ;two or more arguments + (let ((cache (make-hash-table)) + (proc (lambda (args ...) body ...))) + (lambda (args ...) + ;; XXX: Always use 'cached', which uses 'equal?', to compare the + ;; argument lists. + (cached cache (list args ...) + (lambda () + (proc args ...)))))))) + +(define-syntax-rule (mlambda formals body ...) + "Define a memoizing lambda. The lambda's arguments are compared with +'equal?', and BODY is expected to yield a single return value." + (%mlambda cached formals body ...)) + +(define-syntax-rule (mlambdaq formals body ...) + "Define a memoizing lambda. If FORMALS lists a single argument, it is +compared using 'eq?'; otherwise, the argument list is compared using 'equal?'. +BODY is expected to yield a single return value." + (%mlambda cachedq formals body ...)) diff --git a/guix/modules.scm b/guix/modules.scm index 24f613ff4e..2ff94007b5 100644 --- a/guix/modules.scm +++ b/guix/modules.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,7 +17,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix modules) - #:use-module ((guix utils) #:select (memoize)) + #:use-module (guix memoization) #:use-module (guix sets) #:use-module (srfi srfi-26) #:use-module (ice-9 match) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index d7d71b7ab9..68402fda18 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -24,7 +24,6 @@ #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix grafts) - #:use-module (guix combinators) ;; Use the procedure that destructures "NAME-VERSION" forms. #:use-module ((guix utils) #:hide (package-name->name+version)) diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 79ce503a2e..8c82d8978c 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,12 +21,12 @@ #:use-module (guix graph) #:use-module (guix grafts) #:use-module (guix scripts) - #:use-module (guix combinators) #:use-module (guix packages) #:use-module (guix monads) #:use-module (guix store) #:use-module (guix gexp) #:use-module (guix derivations) + #:use-module (guix memoization) #:use-module ((guix build-system gnu) #:select (standard-packages)) #:use-module (gnu packages) #:use-module (guix sets) diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index afc1369ad1..cb64dc8b2b 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -32,7 +32,7 @@ #:use-module (guix records) #:use-module (guix ui) #:use-module (guix utils) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix scripts) #:use-module (guix gnu-maintenance) #:use-module (guix monads) diff --git a/guix/store.scm b/guix/store.scm index 7152a5556a..491cd5ac06 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -19,7 +19,7 @@ (define-module (guix store) #:use-module (guix utils) #:use-module (guix config) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix serialization) #:use-module (guix monads) #:autoload (guix base32) (bytevector->base32-string) diff --git a/guix/utils.scm b/guix/utils.scm index ee06e47fe9..8aa2cb734d 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -33,7 +33,7 @@ #:use-module (ice-9 binary-ports) #:autoload (rnrs io ports) (make-custom-binary-input-port) #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!)) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module ((guix build utils) #:select (dump-port)) #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync)) #:use-module (ice-9 vlist) |