maint: Remove 'cond-expand' forms for Guile 2.0.
Note: Leave 'cond-expand' forms used in the build-side modules that can run on %BOOTSTRAP-GUILE, which is currently Guile 2.0. * guix/build/compile.scm: Move 'use-modules' clause from 'cond-expand' to 'define-module' form. (%default-optimizations): Remove 'cond-expand'. * guix/build/download.scm (tls-wrap): Remove 'cond-expand'. * guix/build/syscalls.scm: Remove 'cond-expand' form around '%set-automatic-finalization-enabled?!' and 'without-automatic-finalization'. * guix/inferior.scm (port->inferior): Remove 'cond-expand'. * guix/scripts/pack.scm (wrapped-package)[build]: Remove 'cond-expand'. * guix/status.scm (build-event-output-port): Remove 'cond-expand'. * guix/store.scm (open-inet-socket): Remove 'cond-expand'. * guix/ui.scm (install-locale): Remove 'cond-expand'. * tests/status.scm ("current-build-output-port, UTF-8 + garbage"): Remove 'cond-expand'. * tests/store.scm ("current-build-output-port, UTF-8 + garbage"): Remove 'cond-expand'.
This commit is contained in:
parent
0991fd5336
commit
a65177a657
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2013, 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2013, 2014, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
|
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
@ -26,28 +26,22 @@
|
||||||
#:use-module (system base message)
|
#:use-module (system base message)
|
||||||
#:use-module (guix modules)
|
#:use-module (guix modules)
|
||||||
#:use-module (guix build utils)
|
#:use-module (guix build utils)
|
||||||
|
#:use-module (language tree-il optimize)
|
||||||
|
#:use-module (language cps optimize)
|
||||||
#:export (%default-optimizations
|
#:export (%default-optimizations
|
||||||
%lightweight-optimizations
|
%lightweight-optimizations
|
||||||
compile-files))
|
compile-files))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
;;; Support code to compile Guile code as efficiently as possible (both with
|
;;; Support code to compile Guile code as efficiently as possible (with 2.2).
|
||||||
;;; Guile 2.0 and 2.2).
|
|
||||||
;;;
|
;;;
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(cond-expand
|
|
||||||
(guile-2.2 (use-modules (language tree-il optimize)
|
|
||||||
(language cps optimize)))
|
|
||||||
(else #f))
|
|
||||||
|
|
||||||
(define %default-optimizations
|
(define %default-optimizations
|
||||||
;; Default optimization options (equivalent to -O2 on Guile 2.2).
|
;; Default optimization options (equivalent to -O2 on Guile 2.2).
|
||||||
(cond-expand
|
(append (tree-il-default-optimization-options)
|
||||||
(guile-2.2 (append (tree-il-default-optimization-options)
|
(cps-default-optimization-options)))
|
||||||
(cps-default-optimization-options)))
|
|
||||||
(else '())))
|
|
||||||
|
|
||||||
(define %lightweight-optimizations
|
(define %lightweight-optimizations
|
||||||
;; Lightweight optimizations (like -O0, but with partial evaluation).
|
;; Lightweight optimizations (like -O0, but with partial evaluation).
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
||||||
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
|
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
|
||||||
;;;
|
;;;
|
||||||
|
@ -314,9 +314,7 @@ host name without trailing dot."
|
||||||
|
|
||||||
;; Write HTTP requests line by line rather than byte by byte:
|
;; Write HTTP requests line by line rather than byte by byte:
|
||||||
;; <https://bugs.gnu.org/22966>. This is possible with Guile >= 2.2.
|
;; <https://bugs.gnu.org/22966>. This is possible with Guile >= 2.2.
|
||||||
(cond-expand
|
(setvbuf record 'line)
|
||||||
(guile-2.2 (setvbuf record 'line))
|
|
||||||
(else #f))
|
|
||||||
|
|
||||||
record)))
|
record)))
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2015 David Thompson <davet@gnu.org>
|
;;; Copyright © 2015 David Thompson <davet@gnu.org>
|
||||||
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
||||||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||||
|
@ -699,39 +699,31 @@ mounted at FILE."
|
||||||
(define CLONE_NEWPID #x20000000)
|
(define CLONE_NEWPID #x20000000)
|
||||||
(define CLONE_NEWNET #x40000000)
|
(define CLONE_NEWNET #x40000000)
|
||||||
|
|
||||||
(cond-expand
|
(define %set-automatic-finalization-enabled?!
|
||||||
(guile-2.2
|
;; When using a statically-linked Guile, for instance in the initrd, we
|
||||||
(define %set-automatic-finalization-enabled?!
|
;; cannot resolve this symbol, but most of the time we don't need it
|
||||||
;; When using a statically-linked Guile, for instance in the initrd, we
|
;; anyway. Thus, delay it.
|
||||||
;; cannot resolve this symbol, but most of the time we don't need it
|
(let ((proc (delay
|
||||||
;; anyway. Thus, delay it.
|
(pointer->procedure int
|
||||||
(let ((proc (delay
|
(dynamic-func
|
||||||
(pointer->procedure int
|
"scm_set_automatic_finalization_enabled"
|
||||||
(dynamic-func
|
(dynamic-link))
|
||||||
"scm_set_automatic_finalization_enabled"
|
(list int)))))
|
||||||
(dynamic-link))
|
(lambda (enabled?)
|
||||||
(list int)))))
|
"Switch on or off automatic finalization in a separate thread.
|
||||||
(lambda (enabled?)
|
|
||||||
"Switch on or off automatic finalization in a separate thread.
|
|
||||||
Turning finalization off shuts down the finalization thread as a side effect."
|
Turning finalization off shuts down the finalization thread as a side effect."
|
||||||
(->bool ((force proc) (if enabled? 1 0))))))
|
(->bool ((force proc) (if enabled? 1 0))))))
|
||||||
|
|
||||||
(define-syntax-rule (without-automatic-finalization exp)
|
(define-syntax-rule (without-automatic-finalization exp)
|
||||||
"Turn off automatic finalization within the dynamic extent of EXP."
|
"Turn off automatic finalization within the dynamic extent of EXP."
|
||||||
(let ((enabled? #t))
|
(let ((enabled? #t))
|
||||||
(dynamic-wind
|
(dynamic-wind
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(set! enabled? (%set-automatic-finalization-enabled?! #f)))
|
(set! enabled? (%set-automatic-finalization-enabled?! #f)))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
exp)
|
exp)
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(%set-automatic-finalization-enabled?! enabled?))))))
|
(%set-automatic-finalization-enabled?! enabled?)))))
|
||||||
|
|
||||||
(else
|
|
||||||
(define-syntax-rule (without-automatic-finalization exp)
|
|
||||||
;; Nothing to do here: Guile 2.0 does not have a separate finalization
|
|
||||||
;; thread.
|
|
||||||
exp)))
|
|
||||||
|
|
||||||
;; The libc interface to sys_clone is not useful for Scheme programs, so the
|
;; The libc interface to sys_clone is not useful for Scheme programs, so the
|
||||||
;; low-level system call is wrapped instead. The 'syscall' function is
|
;; low-level system call is wrapped instead. The 'syscall' function is
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -137,9 +137,7 @@ it's an old Guix."
|
||||||
"Given PIPE, an input/output port, return an inferior that talks over PIPE.
|
"Given PIPE, an input/output port, return an inferior that talks over PIPE.
|
||||||
PIPE is closed with CLOSE when 'close-inferior' is called on the returned
|
PIPE is closed with CLOSE when 'close-inferior' is called on the returned
|
||||||
inferior."
|
inferior."
|
||||||
(cond-expand
|
(setvbuf pipe 'line)
|
||||||
((and guile-2 (not guile-2.2)) #t)
|
|
||||||
(else (setvbuf pipe 'line)))
|
|
||||||
|
|
||||||
(match (read pipe)
|
(match (read pipe)
|
||||||
(('repl-version 0 rest ...)
|
(('repl-version 0 rest ...)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
|
;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
|
||||||
;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
|
;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
|
||||||
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
|
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
|
||||||
|
@ -553,9 +553,7 @@ please email '~a'~%")
|
||||||
"run.c" "-o" result)
|
"run.c" "-o" result)
|
||||||
(delete-file "run.c")))
|
(delete-file "run.c")))
|
||||||
|
|
||||||
(setvbuf (current-output-port)
|
(setvbuf (current-output-port) 'line)
|
||||||
(cond-expand (guile-2.2 'line)
|
|
||||||
(else _IOLBF)))
|
|
||||||
|
|
||||||
;; Link the top-level files of PACKAGE so that search paths are
|
;; Link the top-level files of PACKAGE so that search paths are
|
||||||
;; properly defined in PROFILE/etc/profile.
|
;; properly defined in PROFILE/etc/profile.
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
|
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
@ -636,9 +636,7 @@ The second return value is a thunk to retrieve the current state."
|
||||||
|
|
||||||
;; The build port actually receives Unicode strings.
|
;; The build port actually receives Unicode strings.
|
||||||
(set-port-encoding! port "UTF-8")
|
(set-port-encoding! port "UTF-8")
|
||||||
(cond-expand
|
(setvbuf port 'line)
|
||||||
((and guile-2 (not guile-2.2)) #t)
|
|
||||||
(else (setvbuf port 'line)))
|
|
||||||
(values port (lambda () %state)))
|
(values port (lambda () %state)))
|
||||||
|
|
||||||
(define (call-with-status-report on-event thunk)
|
(define (call-with-status-report on-event thunk)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
|
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
@ -404,11 +404,6 @@
|
||||||
(define (open-inet-socket host port)
|
(define (open-inet-socket host port)
|
||||||
"Connect to the Unix-domain socket at HOST:PORT and return it. Raise a
|
"Connect to the Unix-domain socket at HOST:PORT and return it. Raise a
|
||||||
'&nix-connection-error' upon error."
|
'&nix-connection-error' upon error."
|
||||||
;; Define 'TCP_NODELAY' on Guile 2.0. The value is the same on all GNU
|
|
||||||
;; systems.
|
|
||||||
(cond-expand (guile-2.2 #t)
|
|
||||||
(else (define TCP_NODELAY 1)))
|
|
||||||
|
|
||||||
(let ((sock (with-fluids ((%default-port-encoding #f))
|
(let ((sock (with-fluids ((%default-port-encoding #f))
|
||||||
;; This trick allows use of the `scm_c_read' optimization.
|
;; This trick allows use of the `scm_c_read' optimization.
|
||||||
(socket PF_UNIX SOCK_STREAM 0))))
|
(socket PF_UNIX SOCK_STREAM 0))))
|
||||||
|
|
|
@ -427,11 +427,6 @@ report them in a user-friendly way."
|
||||||
(lambda _
|
(lambda _
|
||||||
(setlocale LC_ALL ""))
|
(setlocale LC_ALL ""))
|
||||||
(lambda args
|
(lambda args
|
||||||
(cond-expand
|
|
||||||
;; Guile 2.2 already emits a warning, so let's not add a second one.
|
|
||||||
(guile-2.2 #t)
|
|
||||||
(else (warning (G_ "failed to install locale: ~a~%")
|
|
||||||
(strerror (system-error-errno args)))))
|
|
||||||
(display-hint (G_ "Consider installing the @code{glibc-utf8-locales} or
|
(display-hint (G_ "Consider installing the @code{glibc-utf8-locales} or
|
||||||
@code{glibc-locales} package and defining @code{GUIX_LOCPATH}, along these
|
@code{glibc-locales} package and defining @code{GUIX_LOCPATH}, along these
|
||||||
lines:
|
lines:
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -125,9 +125,7 @@
|
||||||
|
|
||||||
(test-equal "current-build-output-port, UTF-8 + garbage"
|
(test-equal "current-build-output-port, UTF-8 + garbage"
|
||||||
;; What about a mixture of UTF-8 + garbage?
|
;; What about a mixture of UTF-8 + garbage?
|
||||||
(let ((replacement (cond-expand
|
(let ((replacement "<22>"))
|
||||||
((and guile-2 (not guile-2.2)) "?")
|
|
||||||
(else "<22>"))))
|
|
||||||
`((build-log #f ,(string-append "garbage: " replacement "lambda: λ\n"))))
|
`((build-log #f ,(string-append "garbage: " replacement "lambda: λ\n"))))
|
||||||
(let-values (((port get-status) (build-event-output-port cons '())))
|
(let-values (((port get-status) (build-event-output-port cons '())))
|
||||||
(display "garbage: " port)
|
(display "garbage: " port)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -444,9 +444,7 @@
|
||||||
(package-derivation %store %bootstrap-guile))))
|
(package-derivation %store %bootstrap-guile))))
|
||||||
(guard (c ((nix-protocol-error? c) #t))
|
(guard (c ((nix-protocol-error? c) #t))
|
||||||
(build-derivations %store (list d))))))))
|
(build-derivations %store (list d))))))))
|
||||||
(cond-expand
|
"garbage: <20>lambda: λ"))
|
||||||
(guile-2.2 "garbage: <20>lambda: λ")
|
|
||||||
(else "garbage: ?lambda: λ"))))
|
|
||||||
|
|
||||||
(test-assert "log-file, derivation"
|
(test-assert "log-file, derivation"
|
||||||
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
|
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
|
||||||
|
|
Loading…
Reference in New Issue