mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
Add (guix memoization).
* guix/combinators.scm (memoize): Remove. * guix/memoization.scm: New file. * Makefile.am (MODULES): Add it. * gnu/packages.scm, gnu/packages/bootstrap.scm, guix/build-system/gnu.scm, guix/build-system/python.scm, guix/derivations.scm, guix/gnu-maintenance.scm, guix/import/cran.scm, guix/import/elpa.scm, guix/modules.scm, guix/scripts/build.scm, guix/scripts/graph.scm, guix/scripts/lint.scm, guix/store.scm, guix/utils.scm: Adjust imports accordingly.
This commit is contained in:
parent
e1a65ae57a
commit
f9704f179a
18 changed files with 140 additions and 37 deletions
|
@ -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))
|
||||
|
|
|
@ -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 \
|
||||
|
|
|
@ -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 @@ (define-module (gnu packages)
|
|||
#: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
|
||||
|
|
|
@ -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 @@ (define-module (gnu packages bootstrap)
|
|||
#: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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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 @@ (define-module (guix combinators)
|
|||
;;;
|
||||
;;; 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)
|
||||
|
|
|
@ -31,6 +31,7 @@ (define-module (guix derivations)
|
|||
#: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)
|
||||
|
|
|
@ -30,7 +30,7 @@ (define-module (guix gnu-maintenance)
|
|||
#: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)
|
||||
|
|
|
@ -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 @@ (define-module (guix import cran)
|
|||
#: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)
|
||||
|
|
|
@ -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 @@ (define-module (guix import elpa)
|
|||
#: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))
|
||||
|
|
114
guix/memoization.scm
Normal file
114
guix/memoization.scm
Normal file
|
@ -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 ...))
|
|
@ -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)
|
||||
|
|
|
@ -24,7 +24,6 @@ (define-module (guix scripts build)
|
|||
#: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))
|
||||
|
|
|
@ -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 @@ (define-module (guix scripts graph)
|
|||
#: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)
|
||||
|
|
|
@ -32,7 +32,7 @@ (define-module (guix scripts lint)
|
|||
#: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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -33,7 +33,7 @@ (define-module (guix utils)
|
|||
#: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)
|
||||
|
|
Loading…
Reference in a new issue