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:
Ludovic Courtès 2019-01-06 22:02:40 +01:00
parent 0991fd5336
commit a65177a657
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
10 changed files with 43 additions and 79 deletions

View File

@ -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).

View File

@ -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)))

View File

@ -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

View File

@ -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 ...)

View File

@ -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.

View File

@ -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)

View File

@ -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))))

View File

@ -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:

View File

@ -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)

View File

@ -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" '()))