From mboxrd@z Thu Jan 1 00:00:00 1970 From: Alex Vong Subject: [PATCH 1/2] Add (guix build build-flags). Date: Sun, 25 Oct 2015 14:11:15 +0800 Message-ID: <20151025141115.76144454@debian> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:55979) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZqEmZ-0003HK-KA for guix-devel@gnu.org; Sun, 25 Oct 2015 02:27:57 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZqEmW-0001hR-Cc for guix-devel@gnu.org; Sun, 25 Oct 2015 02:27:55 -0400 Received: from mail-pa0-x22f.google.com ([2607:f8b0:400e:c03::22f]:34692) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZqEmW-0001hH-3V for guix-devel@gnu.org; Sun, 25 Oct 2015 02:27:52 -0400 Received: by padhk11 with SMTP id hk11so156027242pad.1 for ; Sat, 24 Oct 2015 23:27:51 -0700 (PDT) Received: from debian (pcd372091.netvigator.com. [203.218.162.91]) by smtp.gmail.com with ESMTPSA id sz9sm27254275pab.13.2015.10.24.23.27.50 for (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Sat, 24 Oct 2015 23:27:50 -0700 (PDT) List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel@gnu.org =46rom 1d7f488a8fafb7246b2f694de545c0d6842034dd Mon Sep 17 00:00:00 2001 From: Alex Vong Date: Sat, 24 Oct 2015 23:47:26 +0800 Subject: [PATCH 1/2] Add (guix build build-flags). A module to manipulate build flags, similar to dpkg-buildflags. * guix/build/build-flags.scm: New file. * Makefile.am (MODULES): Register it. --- Makefile.am | 1 + guix/build/build-flags.scm | 271 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 272 insertions(+) create mode 100644 guix/build/build-flags.scm diff --git a/Makefile.am b/Makefile.am index 1427203..fd3fe8f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -71,6 +71,7 @@ MODULES =3D \ guix/svn-download.scm \ guix/ui.scm \ guix/build/download.scm \ + guix/build/build-flags.scm \ guix/build/cmake-build-system.scm \ guix/build/emacs-build-system.scm \ guix/build/git.scm \ diff --git a/guix/build/build-flags.scm b/guix/build/build-flags.scm new file mode 100644 index 0000000..30a35a1 --- /dev/null +++ b/guix/build/build-flags.scm @@ -0,0 +1,271 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2015 Alex Vong +;;; +;;; 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 . + +(define-module (guix build build-flags) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:export (flag-list + flag-list+ + flag-list- + flag-list->string-list + default-flag-list + format-flag-list + fortify-flag-list + stackprotector-flag-list + stackprotectorstrong-flag-list + relro-flag-list + bindnow-flag-list + pie-flag-list + all-flag-list)) + +;;; Commentary: +;;; +;;; Module to manipulate build flags, similar to dpkg-buildflags. +;;; +;;; Data structure is constructed by flag-list. +;;; The constructor flag-list does something to its arguments, +;;; such as trimming white-spaces, to ensure no two arguments mean the same. +;;; +;;; Here is an example: +;;; (define default-flag-list +;;; (flag-list +;;; #:CFLAGS '("-O2" "-g") +;;; #:LDFLAGS '("-lm" "-lpthread"))) +;;; +;;; flag-list+ and flag-list- are analogous to +;;; numeric + and - but operate on . +;;; +;;; flag-list->string-list converts into +;;; configure-flags-compatible string-list. +;;; +;;; Code: + + +;;; Pair up a symbol with a procedure so that we know +;;; what identifier is bound to the procedure at macro-expand time. +(define-record-type + (cons-identifier-procedure id proc) + identifier-procedure-pair? + (id identifier) + (proc procedure)) + +(define-syntax define-record-type-with-accessor-list + (syntax-rules () + "Macro to define a srfi-9 record +with accessor list bound to accessor-list-name. +" + ((_ record-name + (constructor-name field-name* ...) + predicate-name + accessor-list-name + (field-name accessor-name) ...) + (begin + (define-record-type record-name + (constructor-name field-name* ...) + predicate-name + (field-name accessor-name) ...) + (define accessor-list-name + `(,(cons-identifier-procedure 'accessor-name + accessor-name) ...)))))) + +;;; define using define-record-type-with-accessor-list macro +(define-record-type-with-accessor-list + (make-flag-list c-flags + cpp-flags + c++-flags + fc-flags + f-flags + gcj-flags + ld-flags + objc-flags + objc++-flags) + flag-list? + flag-list-accessor-list + (c-flags CFLAGS) + (cpp-flags CPPFLAGS) + (c++-flags CXXFLAGS) + (fc-flags FCFLAGS) + (f-flags FFLAGS) + (gcj-flags GCJFLAGS) + (ld-flags LDFLAGS) + (objc-flags OBJCFLAGS) + (objc++-flags OBJCXXFLAGS)) + + +(define-syntax define*-with-keyword-list + (syntax-rules () + "Macro to define a procedure with keyword and default arguments +only with keyword list bound to keyword-list-name. +" + ((_ (proc-name keyword-list-name + (keyword default-val) ...) + body) + (begin + (define* (proc-name #:key + (keyword default-val) ...) + body) + (define keyword-list-name + (map symbol->keyword + '(keyword ...))))))) + +;;; Constructor for +;;; with keyword list bound to flag-list-keyword-list. +(define*-with-keyword-list (flag-list flag-list-keyword-list + (CFLAGS '()) + (CPPFLAGS '()) + (CXXFLAGS '()) + (FCFLAGS '()) + (FFLAGS '()) + (GCJFLAGS '()) + (LDFLAGS '()) + (OBJCFLAGS '()) + (OBJCXXFLAGS '())) + (apply make-flag-list + (map (lambda (string-list) + (map string-trim-both string-list)) + (list CFLAGS + CPPFLAGS + CXXFLAGS + FCFLAGS + FFLAGS + GCJFLAGS + LDFLAGS + OBJCFLAGS + OBJCXXFLAGS)))) + +(define (keyword-apply proc kw-list kw-arg-list by-position-arg-list) + "keyword-apply is inspired by the same-name procedure in Racket. +It applies a procedure using keyword list and keyword argument list. +" + (apply proc + (append (concatenate (zip kw-list + kw-arg-list)) + by-position-arg-list))) + + +(define (flag-list-operation lset-operation) + "Take a lset operation. +Return a procedure that takes any number of +and does the set operation on them for each flags respectively +" + (define (list-of-string-list-operation list-of-string-list) + (apply lset-operation + `(,string=3D? ,@list-of-string-list))) + (lambda list-of-flag-list + (let ((flag-list-proc-list (map procedure + flag-list-accessor-list))) + (keyword-apply flag-list + flag-list-keyword-list + (map (lambda (proc) + (list-of-string-list-operation + (map proc list-of-flag-list))) + flag-list-proc-list) + '())))) + +;;; union any number of for each flags +(define flag-list+ + (flag-list-operation lset-union)) + +;;; take the first and minus the union of the rest for each flags +(define flag-list- + (flag-list-operation lset-difference)) + +(define (flag-list->string-list flag-lst) + "Convert into configure-flags-compatible string list. +" + (map (lambda (accessor) + (let ((id (identifier accessor)) + (proc (procedure accessor))) + (string-append (symbol->string id) + "=3D" + (string-join (proc flag-lst))))) + flag-list-accessor-list)) + + +;;; build flags used in dpkg-buildflags + +(define default-flag-list + (flag-list + #:CFLAGS '("-g" "-O2") + #:CXXFLAGS '("-g" "-O2") + #:FCFLAGS '("-g" "-O2") + #:FFLAGS '("-g" "-O2") + #:GCJFLAGS '("-g" "-O2") + #:OBJCFLAGS '("-g" "-O2") + #:OBJCXXFLAGS '("-g" "-O2"))) + +(define format-flag-list + (flag-list + #:CFLAGS '("-Wformat" "-Werror=3Dformat-security") + #:CXXFLAGS '("-Wformat" "-Werror=3Dformat-security") + #:OBJCFLAGS '("-Wformat" "-Werror=3Dformat-security") + #:OBJCXXFLAGS '("-Wformat" "-Werror=3Dformat-security"))) + +(define fortify-flag-list + (flag-list + #:CPPFLAGS '("-D_FORTIFY_SOURCE=3D2"))) + +(define stackprotector-flag-list + (flag-list + #:CFLAGS '("-fstack-protector" "--param=3Dssp-buffer-size=3D4") + #:CXXFLAGS '("-fstack-protector" "--param=3Dssp-buffer-size=3D4") + #:FCFLAGS '("-fstack-protector" "--param=3Dssp-buffer-size=3D4") + #:FFLAGS '("-fstack-protector" "--param=3Dssp-buffer-size=3D4") + #:GCJFLAGS '("-fstack-protector" "--param=3Dssp-buffer-size=3D4") + #:OBJCFLAGS '("-fstack-protector" "--param=3Dssp-buffer-size=3D4") + #:OBJCXXFLAGS '("-fstack-protector" "--param=3Dssp-buffer-size=3D4"))) + +(define stackprotectorstrong-flag-list + (flag-list + #:CFLAGS '("-fstack-protector-strong") + #:CXXFLAGS '("-fstack-protector-strong") + #:FCFLAGS '("-fstack-protector-strong") + #:FFLAGS '("-fstack-protector-strong") + #:GCJFLAGS '("-fstack-protector-strong") + #:OBJCFLAGS '("-fstack-protector-strong") + #:OBJCXXFLAGS '("-fstack-protector-strong"))) + +(define relro-flag-list + (flag-list + #:LDFLAGS '("-Wl,-z,relro"))) + +(define bindnow-flag-list + (flag-list + #:LDFLAGS '("-Wl,-z,now"))) + +(define pie-flag-list + (flag-list + #:CFLAGS '("-fPIE") + #:CXXFLAGS '("-fPIE") + #:FCFLAGS '("-fPIE") + #:FFLAGS '("-fPIE") + #:GCJFLAGS '("-fPIE") + #:LDFLAGS '("-fPIE" "-pie") + #:OBJCFLAGS '("-fPIE") + #:OBJCXXFLAGS '("-fPIE"))) + +(define all-flag-list + (flag-list+ default-flag-list + format-flag-list + fortify-flag-list + stackprotectorstrong-flag-list + relro-flag-list + bindnow-flag-list + pie-flag-list)) + +;;; build-flags.scm ends here --=20 2.1.4