gnu: Add mercury.series-2558

* gnu/local.mk (GNU_SYSTEM_MODULES): Add mercury.scm
* gnu/packages/mercury.scm: New file.

2 files changed, 159 insertions, 1 deletions

diff --git a/gnu/local.mk b/gnu/local.mk
index 33cf439870..b591d98f6b 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -24,7 +24,7 @@
 # Copyright © 2019 John Soo <jsoo1@asu.edu>
 # Copyright © 2019 Jonathan Brielmaier <jonathan.brielmaier@web.de>
 # Copyright © 2019 Evan Straw <evan.straw99@gmail.com>
-# Copyright © 2019 Brett Gilio <brettg@gnu.org>
+# Copyright © 2019, 2020 Brett Gilio <brettg@gnu.org>
 # Copyright © 2019 Amin Bandali <bandali@gnu.org>
 #
 # This file is part of GNU Guix.
@@ -340,6 +340,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/mc.scm				\
   %D%/packages/mcrypt.scm			\
   %D%/packages/medical.scm			\
+  %D%/packages/mercury.scm			\
   %D%/packages/mes.scm				\
   %D%/packages/messaging.scm			\
   %D%/packages/mingw.scm			\
diff --git a/gnu/packages/mercury.scm b/gnu/packages/mercury.scm
new file mode 100644
index 0000000000..f3c0bc9fa7
--- /dev/null
+++ b/gnu/packages/mercury.scm
@@ -0,0 +1,157 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Brett Gilio <brettg@posteo.net>
+;;;
+;;; 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 mercury)
+  #:use-module (guix download)
+  #:use-module (guix git-download)
+  #:use-module (guix packages)
+  #:use-module (guix utils)
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages autotools)
+  #:use-module (gnu packages bdw-gc)
+  #:use-module (gnu packages readline)
+  #:use-module (gnu packages texinfo)
+  #:use-module (gnu packages flex)
+  #:use-module (gnu packages shells)
+  #:use-module (gnu packages bison)
+  #:use-module (gnu packages pkg-config)
+  #:use-module (ice-9 match)) ; match-lambda
+
+;; NOTE: Package `mercury` requires a specific revision and fork of
+;; upstream Boehm `libgc`. We use this method to obtain that fork
+;; and patch it into `mercury` manually.
+(define (bdwgc-mercury commit-bdwgc hash)
+  (let ((commit commit-bdwgc))
+    (package (inherit libgc)
+             (source
+              (origin
+                (method git-fetch)
+                (uri (git-reference
+                      (url "https://github.com/Mercury-Language/bdwgc.git")
+                      (commit commit)))
+                (sha256 (base32 hash))))
+             (native-inputs
+              `(("autoconf" ,autoconf)
+                ("automake" ,automake)
+                ("libtool" ,libtool)
+                ,@(package-native-inputs libgc))))))
+
+(define-public mercury
+  (package
+    (name "mercury")
+    (version "14.01.1")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "https://dl.mercurylang.org/release/mercury-srcdist-"
+                    version ".tar.gz"))
+              (sha256
+               (base32
+                "12z8qi3da8q50mcsjsy5bnr4ia6ny5lkxvzy01a3c9blgbgcpxwq"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:modules ((guix build gnu-build-system)
+                  (guix build utils)
+                  (ice-9 match))
+       #:tests? #f ; TODO: tests are cryptic. Figure it out later.
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'patch
+           (lambda _
+             (substitute*
+                 (list "Makefile"
+                       "Mmakefile"
+                       "scripts/mercury_update_interface.in"
+                       "scripts/mercury_config.in"
+                       "scripts/mmake.in"
+                       "scripts/mmake.sh"
+                       "scripts/Mmake.vars.in"
+                       "scripts/mdb.in"
+                       "scripts/rs6000_hack"
+                       "scripts/fullarch"
+                       "scripts/mmc.in"
+                       "scripts/canonical_grade"
+                       "scripts/mprof.in"
+                       "scripts/gud.el"
+                       "scripts/ml.in"
+                       "scripts/canonical_grade.in"
+                       "scripts/mdprof.in"
+                       "scripts/vpath_find"
+                       "scripts/mkfifo_using_mknod.in"
+                       "scripts/prepare_install_dir.in"
+                       "scripts/ml.sh"
+                       "scripts/mprof_merge_runs"
+                       "scripts/mtc"
+                       "scripts/mgnuc.in"
+                       "scripts/c2init.in"
+                       "bindist/bindist.Makefile")
+               (("/bin/sh") (which "sh"))
+               (("/bin/pwd") (which "pwd"))
+               (("/bin/rm") (which "rm")))
+             #t))
+         (add-after 'unpack 'replace-boehm-gc
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out"))
+                   (libgc (assoc-ref inputs "libgc"))
+                   (unpack (assoc-ref %standard-phases 'unpack))
+                   (patch-source-shebangs
+                    (assoc-ref %standard-phases 'patch-source-shebangs)))
+               (map (match-lambda
+                      ((src orig-name new-name)
+                       (with-directory-excursion "."
+                         (apply unpack (list #:source src))
+                         (apply patch-source-shebangs (list #:source src)))
+                       (delete-file-recursively new-name)
+                       (invoke "mv" orig-name new-name)))
+                    `((,libgc "source/include/gc" "boehm_gc"))))
+             #t)))))
+    (native-inputs
+     `(("texinfo" ,texinfo)
+       ("flex" ,flex)
+       ("tcsh", tcsh)
+       ("bison" ,bison)
+       ("readline" ,readline)
+       ("libatomic-ops" ,libatomic-ops)
+       ("libgc" ,(bdwgc-mercury
+                  "5287fbab8a6f2284a12beeb9e3ba592301436b98"
+                  "1crlw7zhjik39qdfqp5w317dskxdrklfw48g4jzrjzry12hkmq9y"))
+       ("pkg-config" ,pkg-config)))
+    (synopsis "A pure logic programming language")
+    (description "Mercury is a logic/functional programming language which 
+combines the clarity and expressiveness of declarative programming with advanced
+static analysis and error detection features.  Its highly optimized execution 
+algorithm delivers efficiency far in excess of existing logic programming 
+systems, and close to conventional programming systems. Mercury addresses 
+the problems of large-scale program development, allowing modularity, 
+separate compilation, and numerous optimization/time trade-offs.")
+    (home-page "https://mercurylang.org")
+    (license license:gpl2)))
+
+(define-public mercury-minimal
+  (package (inherit mercury)
+	   (name "mercury-minimal")
+	   (build-system gnu-build-system)
+	   (arguments
+            (substitute-keyword-arguments (package-arguments mercury)
+              ((#:configure-flags flags ''())
+               `(list "--enable-minimal-install"))))
+           (inputs
+            `(("gcc-toolchain" ,gcc-toolchain)))
+           (synopsis "A pure logic programming language (used only for
+compiling packages dependent on base Mercury)")))