[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] gnu: Add Mlucas.
|
From: |
Alex Vong |
|
Subject: |
[PATCH] gnu: Add Mlucas. |
|
Date: |
Mon, 5 Oct 2015 13:01:23 +0800 |
From e5155b52f636bfee849268b19b81f5b6608540fd Mon Sep 17 00:00:00 2001
From: Alex Vong <address@hidden>
Date: Mon, 5 Oct 2015 12:49:49 +0800
Subject: [PATCH] gnu: Add Mlucas.
* gnu/packages/mlucas.scm: New file.
* gnu-system.am (GNU_SYSTEM_MODULES): Register it.
---
gnu-system.am | 1 +
gnu/packages/mlucas.scm | 283 ++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 284 insertions(+)
create mode 100644 gnu/packages/mlucas.scm
diff --git a/gnu-system.am b/gnu-system.am
index 577c6e8..2a5ec03 100644
--- a/gnu-system.am
+++ b/gnu-system.am
@@ -215,6 +215,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/mg.scm \
gnu/packages/miscfiles.scm \
gnu/packages/mit-krb5.scm \
+ gnu/packages/mlucas.scm \
gnu/packages/moe.scm \
gnu/packages/moreutils.scm \
gnu/packages/mpd.scm \
diff --git a/gnu/packages/mlucas.scm b/gnu/packages/mlucas.scm
new file mode 100644
index 0000000..ff641f2
--- /dev/null
+++ b/gnu/packages/mlucas.scm
@@ -0,0 +1,283 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Alex Vong <address@hidden>
+;;;
+;;; 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 (gnu packages mlucas)
+ #:use-module (srfi srfi-1)
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu)
+ #:use-module (guix licenses)
+ #:use-module (gnu packages autogen)
+ #:use-module (gnu packages autotools)
+ #:use-module (gnu packages perl))
+
+
+;;; Procedures to manupulate build flags, similar to dpkg-buildflags.
+;;;
+;;; The data strcture flag-list is constrcuted by (flag-list <flag-sublist>...)
+;;; The constructor flag-list does something to the argument,
+;;; such as trimming whitespaces, to ensure no two arguments mean the same.
+;;;
+;;; The data structure flag-sublist is in fact an ordinary list
+;;; with the following structure (<flag-type-symbol> <flag-string>...)
+;;;
+;;; Here is an example:
+;;; (flag-list
+;;; '(CFLAGS "-O2" "-g")
+;;; '(LDFLAGS "-lm" "-lpthread"))
+;;;
+;;; flag-list+ and flag-list- are analogous to
+;;; numberic + and - but operate on flag-list.
+;;;
+;;; flag-list->string-list converts flag-list into
+;;; configure-flags-compatible string-list.
+;;;
+
+;;; selectors of flag-sublist
+(define (flag-type flag-sublist)
+ (car flag-sublist))
+(define (flag-string-list flag-sublist)
+ (cdr flag-sublist))
+
+;;; constructor of flag-list
+(define (flag-list . flag-lst)
+ ;; Trim leading and trailing whitespaces of all flag-string
+ ;; in flag-list.
+ (define (trim-flag-string flag-lst)
+ (map (λ(flag-sublist)
+ (cons (flag-type flag-sublist)
+ (map string-trim-both
+ (flag-string-list flag-sublist))))
+ flag-lst))
+ ;; Sort flag-list using flag-type of flag-sublist,
+ ;; this will make it easier to add two flag-list together.
+ (define (sort-flag-list flag-lst)
+ (sort-list flag-lst
+ (λ(a b)
+ (string<? (symbol->string (flag-type a))
+ (symbol->string (flag-type b))))))
+ ;; Given a sorted flag-list,
+ ;; combine flag-sublist which have the same flag-type.
+ (define (merge-sorted-flag-list flag-lst)
+ (letrec ( ; append 2 flag-sublist and make sure no duplicate flag-string
+ (append-flag-sublist
+ (λ(flag-sublist1 flag-sublist2)
+ (cond ((null? flag-sublist1) flag-sublist2)
+ ((null? flag-sublist2) flag-sublist1)
+ (else
+ (cons (flag-type flag-sublist1)
+ (lset-union string=?
+ (flag-string-list flag-sublist1)
+ (flag-string-list flag-sublist2)))))))
+ ;; join list of flag-sublist using append-flag-sublist
+ (join-flag-sublist
+ (λ(list-of-flag-sublist)
+ (fold append-flag-sublist '() list-of-flag-sublist))))
+ (if (null? flag-lst)
+ '()
+ (let* ((current-type (flag-type (car flag-lst)))
+ (same-type? (λ(flag-sublist)
+ (eq? (flag-type flag-sublist)
+ current-type))))
+ (cons (join-flag-sublist
+ (take-while same-type? flag-lst))
+ (merge-sorted-flag-list
+ (drop-while same-type? flag-lst)))))))
+ ((compose merge-sorted-flag-list
+ sort-flag-list
+ trim-flag-string)
+ flag-lst))
+
+;;; set-like operators for flag-list
+(define (flag-list+ . list-of-flag-list)
+ (apply flag-list (concatenate list-of-flag-list)))
+(define (flag-list- flag-list1 . list-of-flag-list)
+ (define (flag-list-difference flag-sublist1 flag-list)
+ (let ((found (find (λ(flag-sublist2)
+ (eq? (flag-type flag-sublist1)
+ (flag-type flag-sublist2)))
+ flag-list)))
+ (if (eq? found #f)
+ flag-sublist1
+ (cons (flag-type flag-sublist1)
+ (lset-difference string=?
+ (flag-string-list flag-sublist1)
+ (flag-string-list found))))))
+ (let ((flag-list2 (apply flag-list+ list-of-flag-list)))
+ (map (λ(flag-sublist)
+ (flag-list-difference flag-sublist flag-list2))
+ flag-list1)))
+
+;;; convert flag-list to string-list
+(define (flag-list->string-list flag-lst)
+ (map (λ(flag-sublist)
+ (let ((environment-variable
+ (string-append (symbol->string
+ (flag-type flag-sublist))
+ "=")))
+ (string-join (cons environment-variable
+ (flag-string-list flag-sublist)))))
+ flag-lst))
+
+
+;;; build flags used in dpkg-buildflags
+
+(define default-flag-list
+ (flag-list
+ '(CFLAGS "-g" "-O2")))
+
+(define format-flag-list
+ (flag-list
+ '(CFLAGS "-Wformat" "-Werror=format-security")))
+
+(define fortify-flag-list
+ (flag-list
+ '(CPPFLAGS "-D_FORTIFY_SOURCE=2")))
+
+(define stackprotectorstrong-flag-list
+ (flag-list
+ '(CFLAGS "-fstack-protector-strong")))
+
+(define relro-flag-list
+ (flag-list
+ '(LDFLAGS "-Wl,-z,relro")))
+
+(define bind-now-flag-list
+ (flag-list
+ '(LDFLAGS "-Wl,-z,now")))
+
+(define pie-flag-list
+ (flag-list
+ '(CFLAGS "-fPIE")
+ '(LDFLAGS "-fPIE" "-pie")))
+
+(define all-flag-list
+ (flag-list+ default-flag-list
+ format-flag-list
+ fortify-flag-list
+ stackprotectorstrong-flag-list
+ relro-flag-list
+ bind-now-flag-list
+ pie-flag-list))
+
+
+;;; implement the bootstrap-build-system using syntax-case macro
+;;; bootstrap-build-system use a bootstrap script
+;;; to run autoreconf and generate documentation.
+(define-syntax package*
+ (lambda(x)
+ ;; add autoconf, automake and perl as build dependencies
+ ;; Modify the gnu-build-system
+ ;; by adding bootstrap phase before configure phase.
+ (define (extend-fields s-exp)
+ (cond ((eq? (car s-exp) 'inputs)
+ (list 'inputs
+ (list 'quasiquote
+ (append '(("autoconf" ,autoconf)
+ ("automake" ,automake)
+ ("perl" ,perl))
+ (cadadr s-exp)))))
+ ((eq? (car s-exp) 'arguments)
+ (list
+ 'arguments
+ (list
+ 'quasiquote
+ (append
+ '(#:phases
+ (modify-phases %standard-phases
+ (add-before 'configure
+ 'bootstrap
+ (λ _
+ (zero?
+ (system "./bootstrap"))))))
+ (cadadr s-exp)))))
+ (else s-exp)))
+ (syntax-case x ()
+ ((_ . lst)
+ (if (any (λ(sublist)
+ (equal? sublist
+ '(build-system
+ bootstrap-build-system)))
+ (syntax->datum #'lst))
+ #`(package (build-system gnu-build-system)
+ #,@(datum->syntax
+ x
+ (map extend-fields
+ (remove (λ(sublist)
+ (equal? sublist
+ '(build-system
+ bootstrap-build-system)))
+ (syntax->datum #'lst)))))
+ #`(package #,@ #'lst))))))
+
+
+(define-public mlucas
+ ;; descriptions of the package
+ (let ((short-description
+ "Program to perform Lucas-Lehmer test on a Mersenne number")
+ (long-description
+ "mlucas is an open-source (and free/libre) program
+for performing Lucas-Lehmer test on prime-exponent Mersenne numbers,
+that is, integers of the form 2 ^ p - 1, with prime exponent p.
+In short, everything you need to search for world-record Mersenne primes!
+It has been used in the verification of various Mersenne primes,
+including the 45th, 46th and 48th found Mersenne prime.
+
+You may use it to test any suitable number as you wish,
+but it is preferable that you do so in a coordinated fashion,
+as part of the Great Internet Mersenne Prime Search (GIMPS).
+For more information on GIMPS,
+see <http://www.mersenne.org/prime.html> for details.
+")
+ ;; some dpkg-buildflags and custom build flags presented as flag-list
+ (custom-flag-list
+ (flag-list-
+ (flag-list+ all-flag-list
+ (flag-list
+ '(CFLAGS "-Ofast"
+ "-pipe"
+ "-flto"
+ "-fno-aggressive-loop-optimizations")
+ '(LDFLAGS "-Wl,--as-needed")))
+ default-flag-list)))
+ ;; start package definition
+ (package*
+ (name "mlucas")
+ (version "14.1")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "http://hogranch.com/mayer/src/C/mlucas-";
+ version
+ ".tar.xz"))
+ (sha256
+ (base32
+ "1i6j1479icxfwp3ixs6dk65qilv9hn7213q3iibndlgwjfmh0gb4"))))
+ (build-system bootstrap-build-system)
+ (arguments
+ `(#:configure-flags
+ '("--disable-NORMAL-CFLAGS"
+ "--disable-TRICKY-CFLAGS"
+ "--enable-MLUCAS-DEFAULT-PATH"
+ "--enable-verbose-compiler"
+ ,@(flag-list->string-list custom-flag-list))))
+ (inputs `(("autogen" ,autogen)))
+ (synopsis short-description)
+ (description long-description)
+ (home-page "http://hogranch.com/mayer/README.html";)
+ (license gpl2+))))
--
2.6.0