summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.dir-locals.el2
-rw-r--r--Makefile.am3
-rw-r--r--gnu/packages.scm3
-rw-r--r--gnu/packages/bootstrap.scm4
-rw-r--r--guix/build-system/gnu.scm4
-rw-r--r--guix/build-system/python.scm4
-rw-r--r--guix/combinators.scm18
-rw-r--r--guix/derivations.scm1
-rw-r--r--guix/gnu-maintenance.scm2
-rw-r--r--guix/import/cran.scm4
-rw-r--r--guix/import/elpa.scm3
-rw-r--r--guix/memoization.scm114
-rw-r--r--guix/modules.scm4
-rw-r--r--guix/scripts/build.scm1
-rw-r--r--guix/scripts/graph.scm4
-rw-r--r--guix/scripts/lint.scm2
-rw-r--r--guix/store.scm2
-rw-r--r--guix/utils.scm2
18 files changed, 140 insertions, 37 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index adcc50c560..917fd3004a 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -52,6 +52,8 @@
(eval . (put 'with-derivation-narinfo 'scheme-indent-function 1))
(eval . (put 'with-derivation-substitute 'scheme-indent-function 2))
+ (eval . (put 'mlambda 'scheme-indent-function 1))
+ (eval . (put 'mlambdaq 'scheme-indent-function 1))
(eval . (put 'syntax-parameterize 'scheme-indent-function 1))
(eval . (put 'with-monad 'scheme-indent-function 1))
(eval . (put 'mbegin 'scheme-indent-function 1))
diff --git a/Makefile.am b/Makefile.am
index c13d0df8a4..360c356f10 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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 © 2013 Andreas Enge <andreas@enge.fr>
# Copyright © 2015 Alex Kost <alezost@gmail.com>
# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
@@ -39,6 +39,7 @@ MODULES = \
guix/pk-crypto.scm \
guix/pki.scm \
guix/combinators.scm \
+ guix/memoization.scm \
guix/utils.scm \
guix/sets.scm \
guix/modules.scm \
diff --git a/gnu/packages.scm b/gnu/packages.scm
index f55c294a18..ec2473422f 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.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 © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
@@ -24,6 +24,7 @@
#:use-module (guix packages)
#:use-module (guix ui)
#:use-module (guix utils)
+ #:use-module (guix memoization)
#:use-module (guix combinators)
#:use-module ((guix build utils)
#:select ((package-name->name+version
diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index dd922c3ae4..7cde51fff8 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.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, 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
@@ -28,7 +28,7 @@
#:use-module ((guix store) #:select (add-to-store add-text-to-store))
#:use-module ((guix derivations) #:select (derivation))
#:use-module ((guix utils) #:select (gnu-triplet->nix-system))
- #:use-module (guix combinators)
+ #:use-module (guix memoization)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
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)
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-06 12:29:23 +0000