unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] gnu: Add Mlucas.
@ 2015-10-05  5:01 Alex Vong
  2015-10-05 10:46 ` Mathieu Lirzin
  2015-10-05 16:42 ` Alex Kost
  0 siblings, 2 replies; 12+ messages in thread
From: Alex Vong @ 2015-10-05  5:01 UTC (permalink / raw)
  To: guix-devel

From e5155b52f636bfee849268b19b81f5b6608540fd Mon Sep 17 00:00:00 2001
From: Alex Vong <alexvong1995@gmail.com>
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 <alexvong1995@gmail.com>
+;;;
+;;; 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

^ permalink raw reply related	[flat|nested] 12+ messages in thread

end of thread, other threads:[~2015-10-06 19:31 UTC | newest]

Thread overview: 12+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2015-10-05  5:01 [PATCH] gnu: Add Mlucas Alex Vong
2015-10-05 10:46 ` Mathieu Lirzin
2015-10-06  3:13   ` Alex Vong
2015-10-06 10:04     ` Ludovic Courtès
2015-10-06 13:58       ` Alex Vong
2015-10-06 19:31         ` Ludovic Courtès
2015-10-06 15:06     ` Mathieu Lirzin
2015-10-06 15:31       ` Alex Kost
2015-10-05 16:42 ` Alex Kost
2015-10-06 13:43   ` Alex Vong
2015-10-06 14:40     ` Alex Kost
2015-10-06 19:28       ` Ludovic Courtès

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).