[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] gnu: Add clojure.
|
From: |
Alex Vong |
|
Subject: |
[PATCH] gnu: Add clojure. |
|
Date: |
Wed, 06 Jul 2016 20:54:58 +0800 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux) |
Hi guix,
This patch adds clojure 1.6 to 1.8.
Changes made since last email (comments appreciated):
Include clojure from 1.6 to 1.8 instead of just 1.8 because I think we
should provide all stable versions and allowed them to be
co-installed. From https://clojure.github.io/clojure/, version 1.6 to
1.8 is considered stable.
Use ant build system, this save a lot of typing, thanks Ricardo for
writing it!
Provide a native executable. It is a bit of a hack. First, the clojure
jar is compiled with gcj. Then a c++ wrapper is compiled. Finally, they
are linked together. The native executable takes half the time to start
than loading the jar using java.
There is a slight problem when inheriting package. Let's say in one of
the build phases of package A, I want to eval this expression:
(compile-jar (string-append "clojure-" ,version ".jar"))
Then I define package B which is inherited from package A, like this:
(define-public B
(package
(inherit A)
(version "2")
...
))
Now the build phases of package B still refer to the old version of
package A, in other words, the version being substitute into the build
phases is not being inherited. Any idea on how to fix this? Right now, I
resort to adding the following build phase:
(add-after 'unpack-submodule-sources 'set-clojure-version
(lambda _
(setenv "CLOJURE_VERSION" ,version)))
and replace the build phase in the inherited package. But this looks a
bit ugly to me.
Thanks.
Alex
>From 5b275a8ac0209316b89a3c35f6c76740b0ba245f Mon Sep 17 00:00:00 2001
From: Alex Vong <address@hidden>
Date: Tue, 5 Jul 2016 16:24:20 +0800
Subject: [PATCH] gnu: Add clojure.
* gnu/packages/java.scm
(remove-archives, clojure-1.6, clojure-1.7, clojure-1.8): New variables.
* gnu/packages/patches/clojure-native-executable.patch: New patch.
---
gnu/packages/java.scm | 292 ++++++++++
.../patches/clojure-native-executable.patch | 621 +++++++++++++++++++++
2 files changed, 913 insertions(+)
create mode 100644 gnu/packages/patches/clojure-native-executable.patch
diff --git a/gnu/packages/java.scm b/gnu/packages/java.scm
index 753fb77..92c70a3 100644
--- a/gnu/packages/java.scm
+++ b/gnu/packages/java.scm
@@ -41,6 +41,7 @@
#:use-module (gnu packages ghostscript) ;lcms
#:use-module (gnu packages gnome)
#:use-module (gnu packages gtk)
+ #:use-module (gnu packages haskell)
#:use-module (gnu packages image)
#:use-module (gnu packages linux) ;alsa
#:use-module (gnu packages wget)
@@ -141,6 +142,297 @@ is implemented.")
license:mpl2.0
license:lgpl2.1+))))
+(define remove-archives
+ '(begin
+ (for-each delete-file
+ (find-files "./" ".*\\.(jar|zip)"))
+ #t))
+
+(define-public clojure-1.6
+ (let ((get-version '(getenv "CLOJURE_VERSION")))
+ (package
+ (name "clojure")
+ (version "1.6.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri
+ (string-append "http://repo1.maven.org/maven2/org/clojure/clojure/";
+ version "/clojure-" version ".zip"))
+ (sha256
+ (base32 "0yv67gackrzlwn9f8cnpw14y2hwspklxhy1450rl71vdrqjahlwq"))
+ (modules '((guix build utils)))
+ (snippet remove-archives)
+ (patches (search-patches "clojure-native-executable.patch"))))
+ (build-system ant-build-system)
+ (arguments
+ `(#:modules ((guix build ant-build-system)
+ (guix build utils)
+ (ice-9 ftw)
+ (ice-9 regex)
+ (srfi srfi-1)
+ (srfi srfi-26))
+ #:test-target "test"
+ #:phases
+ (modify-phases %standard-phases
+ (add-after 'unpack 'unpack-submodule-sources
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let ((unpack
+ (lambda (src-name)
+ (and (mkdir-p src-name)
+ (with-directory-excursion src-name
+ (zero? (system* "tar"
+ ;; Use xz as src are repacked.
+ "--xz"
+ "--extract"
+ "--verbose"
+ "--file" (assoc-ref inputs
+ src-name)
+ "--strip-components=1"))))))
+ (copy (lambda (src-name)
+ (copy-recursively
+ (string-append src-name "/src/main/clojure/")
+ "src/clj/"))))
+ (every (lambda (src)
+ (unpack src)
+ (copy src))
+ '("data-generators-src" "java-classpath-src"
+ "test-check-src" "test-generative-src"
+ "tools-namespace-src" "tools-reader-src")))))
+ (add-after 'unpack-submodule-sources 'set-clojure-version
+ (lambda _
+ (setenv "CLOJURE_VERSION" ,version)))
+ (add-after 'build 'build-native
+ (lambda _
+ (let* ((compile-jar (lambda (src-name)
+ (zero? (system* "gcj"
+ "-c" "-v" "-O1"
+ "-findirect-dispatch"
+ "-fbootstrap-classes"
+ src-name))))
+ (compile-cxx (lambda (src-name)
+ (zero?
+ (system* "g++"
+ "-c" "-v" "-O3"
+ "--std=gnu++14" "-pedantic"
+ "-Wall" "-Wextra" "-Werror"
+ src-name))))
+ (link-o (lambda (target-name . object-names)
+ (zero? (apply system*
+ `("gcj"
+ "-o" ,target-name
+ "-v"
+ "-Wl,--wrap,main"
+ ,@object-names
+ "-lstdc++" "-lgij"))))))
+ (and (compile-jar (string-append "clojure-" ,get-version
".jar"))
+ (compile-cxx "wrap.cxx")
+ (link-o (string-append "clojure-" ,get-version)
+ (string-append "clojure-" ,get-version ".o")
+ "wrap.o")))))
+ (add-after 'build-native 'build-doc
+ (lambda _
+ (let* ((markdown-regex "(.*)\\.(md|markdown|txt)")
+ (gsub regexp-substitute/global)
+ (markdown->html (lambda (src-name)
+ (zero? (system*
+ "pandoc"
+ "--output" (gsub #f
+ markdown-regex
+ src-name
+ 1 ".html")
+ "--verbose"
+ "--from" "markdown_github"
+ "--to" "html"
+ src-name)))))
+ (every markdown->html
+ (find-files "./" markdown-regex)))))
+ (replace 'install
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let ((java-dir (string-append (assoc-ref outputs "out")
+ "/share/java/")))
+ ;; Do not install clojure.jar to avoid collisions.
+ (install-file (string-append "clojure-" ,get-version ".jar")
+ java-dir)
+ #t)))
+ (add-after 'install 'install-native
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let ((bin-dir (string-append (assoc-ref outputs "out")
+ "/bin/")))
+ (install-file (string-append "clojure-" ,get-version)
+ bin-dir)
+ #t)))
+ (add-after 'install-native 'install-doc
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let ((doc-dir (string-append (assoc-ref outputs "out")
+ "/share/doc/clojure-"
+ ,get-version "/"))
+ (copy-file-to-dir (lambda (file dir)
+ (copy-file file
+ (string-append dir
+ file)))))
+ (for-each delete-file
+ (find-files "doc/clojure/"
+ ".*\\.(md|markdown|txt)"))
+ (copy-recursively "doc/clojure/" doc-dir)
+ (for-each (cut copy-file-to-dir <> doc-dir)
+ (filter (cut string-match ".*\\.(html|txt)" <>)
+ (scandir "./")))
+ #t))))))
+ (native-inputs
+ `(("gcj" ,gcj)
+ ("ghc-pandoc" ,ghc-pandoc)
+ ("zlib" ,zlib)
+ ;; The native-inputs below are needed to run the tests.
+ ("data-generators-src"
+ ,(let ((version "0.1.2"))
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://github.com/clojure";
+ "/data.generators/archive/data.generators-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "0kki093jp4ckwxzfnw8ylflrfqs8b1i1wi9iapmwcsy328dmgzp1"))
+ (modules '((guix build utils)
+ (ice-9 ftw)))
+ (snippet remove-archives))))
+ ("java-classpath-src"
+ ,(let ((version "0.2.3"))
+ (origin
+ (method url-fetch)
+ (uri
+ (string-append "https://github.com/clojure";
+ "/java.classpath/archive/java.classpath-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "0sjymly9xh1lkvwn5ygygpsfwz4dabblnlq0c9bx76rkvq62fyng"))
+ (modules '((guix build utils)))
+ (snippet remove-archives))))
+ ("test-check-src"
+ ,(let ((version "0.9.0"))
+ (origin
+ (method url-fetch)
+ (uri
+ (string-append "https://github.com/clojure";
+ "/test.check/archive/test.check-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "0p0mnyhr442bzkz0s4k5ra3i6l5lc7kp6ajaqkkyh4c2k5yck1md"))
+ (modules '((guix build utils)))
+ (snippet remove-archives))))
+ ("test-generative-src"
+ ,(let ((version "0.5.2"))
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://github.com/clojure";
+ "/test.generative/archive/test.generative-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "1pjafy1i7yblc7ixmcpfq1lfbyf3jaljvkgrajn70sws9xs7a9f8"))
+ (modules '((guix build utils)))
+ (snippet remove-archives))))
+ ("tools-namespace-src"
+ ,(let ((version "0.2.11"))
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://github.com/clojure";
+ "/tools.namespace/archive/tools.namespace-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "10baak8v0hnwz2hr33bavshm7y49mmn9zsyyms1dwjz45p5ymhy0"))
+ (modules '((guix build utils)))
+ (snippet remove-archives))))
+ ("tools-reader-src"
+ ,(let ((version "0.10.0"))
+ (origin
+ (method url-fetch)
+ (uri
+ (string-append "https://github.com/clojure";
+ "/tools.reader/archive/tools.reader-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "09i3lzbhr608h76mhdjm3932gg9xi8sflscla3c5f0v1nkc28cnr"))
+ (modules '((guix build utils)))
+ (snippet remove-archives))))))
+ (home-page "https://clojure.org/";)
+ (synopsis "Lisp dialect running on the JVM")
+ (description "Clojure is a dynamic, general-purpose programming language,
+combining the approachability and interactive development of a scripting
+language with an efficient and robust infrastructure for multithreaded
+programming. Clojure is a compiled language, yet remains completely dynamic
+– every feature supported by Clojure is supported at runtime. Clojure provides
+ easy access to the Java frameworks, with optional type hints and type
+inference, to ensure that calls to Java can avoid reflection.
+
+Clojure is a dialect of Lisp, and shares with Lisp the code-as-data philosophy
+and a powerful macro system. Clojure is predominantly a functional programming
+language, and features a rich set of immutable, persistent data structures.
+When mutable state is needed, Clojure offers a software transactional memory
+system and reactive Agent system that ensure clean, correct, multithreaded
+designs.")
+ ;; Clojure is licensed under EPL1.0
+ ;; ASM bytecode manipulation library is licensed under BSD-3
+ ;; Guava Murmur3 hash implementation is licensed under under APL2.0
+ ;; src/clj/repl.clj is licensed under under CPL1.0
+ ;;
+ ;; See readme.html or readme.txt for details.
+ (license (list license:epl1.0
+ license:bsd-3
+ license:asl2.0
+ license:cpl1.0)))))
+
+(define-public clojure-1.7
+ (package
+ (inherit clojure-1.6)
+ (version "1.7.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri
+ (string-append "http://repo1.maven.org/maven2/org/clojure/clojure/";
+ version "/clojure-" version ".zip"))
+ (sha256
+ (base32 "14yg0g6vpzxjwlvs5anq9jfz9zdbd3rsl6qsgxa6qxm19mwh7qsd"))
+ (modules '((guix build utils)))
+ (snippet remove-archives)
+ (patches (search-patches "clojure-native-executable.patch"))))
+ (arguments
+ `(,@(substitute-keyword-arguments (package-arguments clojure-1.6)
+ ((#:phases phases)
+ `(modify-phases ,phases
+ (replace 'set-clojure-version
+ (lambda _
+ (setenv "CLOJURE_VERSION" ,version))))))))))
+
+(define-public clojure-1.8
+ (package
+ (inherit clojure-1.6)
+ (version "1.8.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri
+ (string-append "http://repo1.maven.org/maven2/org/clojure/clojure/";
+ version "/clojure-" version ".zip"))
+ (sha256
+ (base32 "1nip095fz5c492sw15skril60i1vd21ibg6szin4jcvyy3xr6cym"))
+ (modules '((guix build utils)))
+ (snippet remove-archives)
+ (patches (search-patches "clojure-native-executable.patch"))))
+ (arguments
+ `(,@(substitute-keyword-arguments (package-arguments clojure-1.6)
+ ((#:phases phases)
+ `(modify-phases ,phases
+ (replace 'set-clojure-version
+ (lambda _
+ (setenv "CLOJURE_VERSION" ,version))))))))))
+
(define-public ant
(package
(name "ant")
diff --git a/gnu/packages/patches/clojure-native-executable.patch
b/gnu/packages/patches/clojure-native-executable.patch
new file mode 100644
index 0000000..9503ca0
--- /dev/null
+++ b/gnu/packages/patches/clojure-native-executable.patch
@@ -0,0 +1,621 @@
+From b17453777a81e605134bbc80dd19fd6e756aeed6 Mon Sep 17 00:00:00 2001
+From: Alex Vong <address@hidden>
+Date: Sat, 25 Jun 2016 01:39:53 +0800
+Subject: [PATCH] clojure: native executable
+
+This patch wraps the main function generated by gcj to allow clojure to
+be compiled as native executable. The executable should take half the
+time to start, when compared to loading the clojure jar with java.
+---
+ args.hxx | 60 +++++++++++++++++++++++++++++++
+ base.hxx | 116 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ macro.hxx | 35 ++++++++++++++++++
+ param.hxx | 49 +++++++++++++++++++++++++
+ string.hxx | 58 ++++++++++++++++++++++++++++++
+ sys.hxx | 118 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ wrap.cxx | 115 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 7 files changed, 551 insertions(+)
+ create mode 100644 args.hxx
+ create mode 100644 base.hxx
+ create mode 100644 macro.hxx
+ create mode 100644 param.hxx
+ create mode 100644 string.hxx
+ create mode 100644 sys.hxx
+ create mode 100644 wrap.cxx
+
+diff --git a/args.hxx b/args.hxx
+new file mode 100644
+index 0000000..8fb421f
+--- /dev/null
++++ b/args.hxx
+@@ -0,0 +1,60 @@
++/* Struct for managing argument list
++ Copyright 2016 Alex Vong
++
++ Licensed under the Apache License, Version 2.0 (the "License");
++ you may not use this file except in compliance with the License.
++ You may obtain a copy of the License at
++
++ http://www.apache.org/licenses/LICENSE-2.0
++
++ Unless required by applicable law or agreed to in writing, software
++ distributed under the License is distributed on an "AS IS" BASIS,
++ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
++ See the License for the specific language governing permissions and
++ limitations under the License. */
++
++
++#pragma once
++
++#include <algorithm>
++#include <iterator>
++#include <string.h>
++#include "base.hxx"
++
++
++struct Args
++{ int argc = 0;
++ char** argv = nullptr;
++
++ Args() {}
++ template <typename A>
++ Args(A ls)
++ {
++ argc = length(ls);
++ argv = new char*[argc + 1];
++ std::transform(std::begin(ls), std::end(ls),
++ argv,
++ lambda((auto str), return strdup(str.c_str())));
++ argv[argc] = nullptr;
++ }
++ ~Args()
++ {
++ std::for_each(argv, argv + argc,
++ lambda((auto str), free(str)));
++ delete[] argv;
++ }
++ Args(Args& args) = delete;
++ Args& operator=(Args& args) = delete;
++ Args(Args&& args) = delete;
++ Args& operator=(Args&& args)
++ {
++ std::for_each(argv, argv + argc,
++ lambda((auto ptr), free(ptr)));
++ delete[] argv;
++ argc = args.argc;
++ argv = args.argv;
++ args.argc = 0;
++ args.argv = nullptr;
++ return *this;
++ }
++};
+diff --git a/base.hxx b/base.hxx
+new file mode 100644
+index 0000000..f7773bb
+--- /dev/null
++++ b/base.hxx
+@@ -0,0 +1,116 @@
++/* Basic utilities commonly found in scheme, with function composition
operator
++ Copyright 2016 Alex Vong
++
++ Licensed under the Apache License, Version 2.0 (the "License");
++ you may not use this file except in compliance with the License.
++ You may obtain a copy of the License at
++
++ http://www.apache.org/licenses/LICENSE-2.0
++
++ Unless required by applicable law or agreed to in writing, software
++ distributed under the License is distributed on an "AS IS" BASIS,
++ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
++ See the License for the specific language governing permissions and
++ limitations under the License. */
++
++
++#pragma once
++
++#include <iostream>
++#include <deque>
++#include <iterator>
++#include <numeric>
++#include <algorithm>
++#include <functional>
++#include "param.hxx"
++
++
++extern "C" int
++__real_main(int argc, char** argv);
++
++
++defun(display, (auto obj),
++ std::cout << obj);
++
++defun(display_error, (auto obj),
++ std::cerr << obj);
++
++defun(newline, (),
++ using namespace std::string_literals;
++ display("\n"s));
++
++template <typename B_to_C, typename A_to_B>
++defsubst(operator*, (B_to_C g, A_to_B f),
++ return lambda((auto x),
++ return g(f(x))));
++
++defalias(cut, std::bind);
++
++defun(null_p, (auto ls),
++ return ls.empty());
++
++defun(car, (auto ls),
++ return ls[0]);
++
++defun(cdr, (auto ls),
++ ls.pop_front();
++ return ls);
++
++defun(drop, (auto ls, auto k),
++ ls.erase(std::begin(ls), std::begin(ls) + k);
++ return ls);
++
++defun(length, (auto ls),
++ return ls.size());
++
++defun(reverse, (auto ls),
++ std::reverse(std::begin(ls), std::end(ls));
++ return ls);
++
++defun(append, (auto ls1, auto... rest),
++ decltype(ls1) nil;
++ defun(append2, (auto ls1, auto ls2),
++ decltype(ls1) ls;
++ std::move(std::begin(ls2), std::end(ls2),
++ std::back_inserter(ls1));
++ return ls1);
++ return param::fold_right(append2, nil, ls1, rest...));
++
++defun(fold, (auto proc, auto init, auto... ls),
++ using namespace std::placeholders;
++ auto ls2 = append(ls...);
++ return std::accumulate(std::begin(ls2), std::end(ls2),
++ init,
++ cut(proc, _2, _1)));
++
++defun(fold_right, (auto proc, auto init, auto... ls),
++ auto ls2 = append(ls...);
++ return fold(proc, init, reverse(ls2)));
++
++defun(concatenate, (auto ls_of_ls),
++ decltype(car(ls_of_ls)) nil;
++ return fold_right(append, nil, ls_of_ls));
++
++template <typename A_to_B, template <typename...> class List, typename A>
++defsubst(map, (A_to_B proc, List<A> ls),
++ List<decltype(proc(car(ls)))> ls2;
++ std::transform(std::begin(ls), std::end(ls),
++ std::back_inserter(ls2),
++ proc);
++ return ls2);
++
++defun(for_each, (auto proc, auto ls),
++ return std::for_each(std::begin(ls), std::end(ls), proc));
++
++defun(any, (auto pred, auto ls),
++ return std::any_of(std::begin(ls), std::end(ls), pred));
++
++template <typename A_to_Bool, template <typename...> class List, typename A>
++defsubst(partition, (A_to_Bool pred, List<A> ls),
++ List<A> ls1;
++ List<A> ls2;
++ std::partition_copy(std::begin(ls), std::end(ls),
++ std::back_inserter(ls1),
++ std::back_inserter(ls2),
++ pred);
++ return List<List<A>>({ls1, ls2}));
+diff --git a/macro.hxx b/macro.hxx
+new file mode 100644
+index 0000000..deb3b36
+--- /dev/null
++++ b/macro.hxx
+@@ -0,0 +1,35 @@
++/* Macros for reassembling the syntax of various lisps
++ Copyright 2016 Alex Vong
++
++ Licensed under the Apache License, Version 2.0 (the "License");
++ you may not use this file except in compliance with the License.
++ You may obtain a copy of the License at
++
++ http://www.apache.org/licenses/LICENSE-2.0
++
++ Unless required by applicable law or agreed to in writing, software
++ distributed under the License is distributed on an "AS IS" BASIS,
++ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
++ See the License for the specific language governing permissions and
++ limitations under the License. */
++
++
++#pragma once
++
++#define lambda(arg_ls, body) \
++ [=] arg_ls {body;}
++
++#define define(id, val) \
++ const auto id = val
++
++#define defun(id, arg_ls, body) \
++ constexpr define(id, lambda(arg_ls, body))
++
++#define defsubst(id, arg_ls, body) \
++ constexpr auto id arg_ls {body;} struct swallow
++
++#define defalias(id, fun) \
++ defun(id, (auto ...args), return fun(args...))
++
++#define ns(id, ...) \
++ namespace id {__VA_ARGS__;} struct swallow
+diff --git a/param.hxx b/param.hxx
+new file mode 100644
+index 0000000..9625016
+--- /dev/null
++++ b/param.hxx
+@@ -0,0 +1,49 @@
++/* Parameter pack (right-)folding over binary functions
++ Copyright 2016 Alex Vong
++
++ Licensed under the Apache License, Version 2.0 (the "License");
++ you may not use this file except in compliance with the License.
++ You may obtain a copy of the License at
++
++ http://www.apache.org/licenses/LICENSE-2.0
++
++ Unless required by applicable law or agreed to in writing, software
++ distributed under the License is distributed on an "AS IS" BASIS,
++ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
++ See the License for the specific language governing permissions and
++ limitations under the License. */
++
++
++#pragma once
++
++#include "macro.hxx"
++
++
++ns(param,
++ ns(tmpl,
++ template <typename A_to_B_to_B, typename B>
++ defsubst(fold, (A_to_B_to_B proc, B init),
++ return init);
++ template <typename A_to_B_to_B, typename B, typename A>
++ defsubst(fold, (A_to_B_to_B proc, B init, A e),
++ return proc(e, init));
++ template <typename A_to_B_to_B, typename B, typename A, typename... As>
++ defsubst(fold, (A_to_B_to_B proc, B init, A e, As... es),
++ return fold(proc,
++ proc(e,init),
++ es...)));
++ defalias(fold, tmpl::fold);
++
++ ns(tmpl,
++ template <typename A_to_B_to_B, typename B>
++ defsubst(fold_right, (A_to_B_to_B proc, B init),
++ return init);
++ template <typename A_to_B_to_B, typename B, typename A>
++ defsubst(fold_right, (A_to_B_to_B proc, B init, A e),
++ return proc(e, init));
++ template <typename A_to_B_to_B, typename B, typename A, typename... As>
++ defsubst(fold_right, (A_to_B_to_B proc, B init, A e, As... es),
++ return proc(e, fold_right(proc,
++ init,
++ es...))));
++ defalias(fold_right, tmpl::fold_right));
+diff --git a/string.hxx b/string.hxx
+new file mode 100644
+index 0000000..36116dd
+--- /dev/null
++++ b/string.hxx
+@@ -0,0 +1,58 @@
++/* String utilities commonly found in scheme, with string append operator
++ Copyright 2016 Alex Vong
++
++ Licensed under the Apache License, Version 2.0 (the "License");
++ you may not use this file except in compliance with the License.
++ You may obtain a copy of the License at
++
++ http://www.apache.org/licenses/LICENSE-2.0
++
++ Unless required by applicable law or agreed to in writing, software
++ distributed under the License is distributed on an "AS IS" BASIS,
++ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
++ See the License for the specific language governing permissions and
++ limitations under the License. */
++
++
++#pragma once
++
++#include <string>
++#include <sstream>
++#include "base.hxx"
++
++
++template <typename String>
++defsubst(operator*, (String str1, String str2),
++ str1.append(str2);
++ return str1);
++
++ns(string,
++ defun(length, (auto str),
++ return str.length());
++
++ defun(eq_p, (auto str1, auto str2),
++ return str1 == str2);
++
++ defun(eq_any_p, (auto str, auto str_ls),
++ using namespace std::placeholders;
++ return any(cut(eq_p, str, _1), str_ls));
++
++ defun(prefix_p, (auto prefix, auto str),
++ return !str.compare(0, length(prefix), prefix));
++
++ defun(drop, (auto str, auto n),
++ return str.erase(0, n));
++
++ template <typename A, typename String, typename Char>
++ defsubst(split, (String str, Char delim),
++ String tok;
++ std::istringstream sstream(str);
++ A accum;
++ while (std::getline(sstream, tok, delim)) accum.push_back(tok);
++ return accum);
++
++ defun(contains, (auto str1, auto str2),
++ return str1.find(str2));
++
++ defun(contains_p, (auto str1, auto str2),
++ return contains(str1, str2) != std::string::npos));
+diff --git a/sys.hxx b/sys.hxx
+new file mode 100644
+index 0000000..de698b5
+--- /dev/null
++++ b/sys.hxx
+@@ -0,0 +1,118 @@
++/* Structs for managing files desciptor and pipe, with utilities
++ Copyright 2016 Alex Vong
++
++ Licensed under the Apache License, Version 2.0 (the "License");
++ you may not use this file except in compliance with the License.
++ You may obtain a copy of the License at
++
++ http://www.apache.org/licenses/LICENSE-2.0
++
++ Unless required by applicable law or agreed to in writing, software
++ distributed under the License is distributed on an "AS IS" BASIS,
++ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
++ See the License for the specific language governing permissions and
++ limitations under the License. */
++
++
++#pragma once
++
++#include <cerrno>
++#include <iostream>
++#include <fstream>
++#include <sstream>
++#include <string>
++#include <ext/stdio_filebuf.h>
++#include <algorithm>
++#include <system_error>
++#include <unistd.h>
++#include "base.hxx"
++
++
++ns(sys,
++ defun(error, (auto errnum, auto msg),
++ throw std::system_error(errnum,
++ std::system_category(),
++ msg)));
++
++
++namespace file_and_pipe
++{ using namespace std::string_literals;
++
++ struct File
++ { int fd = -1;
++
++ File() {}
++ File(int a_fd)
++ {
++ fd = a_fd;
++ }
++ ~File()
++ {
++ if (fd >= 0) close(fd);
++ }
++ File(File& file) = delete;
++ File& operator=(File& file) = delete;
++ File(File&& file)
++ {
++ fd = file.fd;
++ file.fd = -1;
++ }
++ File& operator=(File&& file)
++ {
++ fd = file.fd;
++ file.fd = -1;
++ return *this;
++ }
++ };
++
++
++ struct Pipe
++ { int pipefd[2];
++
++ Pipe() {if(pipe(pipefd)) sys::error(errno, "cannot create pipe"s);}
++ ~Pipe()
++ {
++ std::for_each(pipefd, pipefd + 2,
++ lambda((auto fd), if (fd >= 0) close(fd)));
++ }
++ Pipe(Pipe& pipe) = delete;
++ Pipe& operator=(Pipe& pipe) = delete;
++ Pipe(Pipe&& pipe) = delete;
++ Pipe& operator=(Pipe&& pipe) = delete;
++ };
++
++
++ inline File operator>(File& file, Pipe& pipe)
++ { File file_sv(dup(file.fd));
++
++ if (file_sv.fd < 0) sys::error(errno, "cannot duplicate file
descriptor"s);
++ if (dup2(pipe.pipefd[1], file.fd) < 0)
++ sys::error(errno, "cannot redirect file descriptor to pipe"s);
++
++ return file_sv;
++ }
++
++
++ inline void operator>(File& file, File& file_sv)
++ {
++ if (dup2(file_sv.fd, file.fd) < 0)
++ sys::error(errno, "cannot restore file descriptor"s);
++
++ file.fd = -1;
++ }
++}
++using namespace file_and_pipe;
++
++
++defun(read_from_pipe, (auto& pipe),
++ if (pipe.pipefd[1] >= 0)
++ {
++ close(pipe.pipefd[1]);
++ pipe.pipefd[1] = -1;
++ }
++
++ __gnu_cxx::stdio_filebuf<char> fstream(pipe.pipefd[0], std::ios::in);
++ std::istream istream(&fstream);
++ std::stringstream sstream;
++ sstream << istream.rdbuf();
++ return sstream.str());
+diff --git a/wrap.cxx b/wrap.cxx
+new file mode 100644
+index 0000000..e3dde32
+--- /dev/null
++++ b/wrap.cxx
+@@ -0,0 +1,115 @@
++/* Wraps main function generated by gcj to allow compiled as native executable
++ Copyright 2016 Alex Vong
++
++ Licensed under the Apache License, Version 2.0 (the "License");
++ you may not use this file except in compliance with the License.
++ You may obtain a copy of the License at
++
++ http://www.apache.org/licenses/LICENSE-2.0
++
++ Unless required by applicable law or agreed to in writing, software
++ distributed under the License is distributed on an "AS IS" BASIS,
++ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
++ See the License for the specific language governing permissions and
++ limitations under the License. */
++
++
++#include <cstdlib>
++#include <deque>
++#include <string>
++#include "base.hxx"
++#include "args.hxx"
++#include "string.hxx"
++#include "sys.hxx"
++
++#define ARGS_TYPE std::deque<std::string>
++
++
++Args ARGS;
++File STDOUT_FILE(STDOUT_FILENO);
++File STDERR_FILE(STDERR_FILENO);
++File STDOUT_FILE_SV;
++File STDERR_FILE_SV;
++Pipe STDOUT_PIPE;
++Pipe STDERR_PIPE;
++
++
++extern "C" int
++__wrap_main(int argc, char** argv)
++{ using namespace std::string_literals;
++ using namespace std::placeholders;
++
++ ARGS_TYPE args(argv, argv + argc);
++
++ define(subopt_prefix, "-Wi,"s);
++ define(subopt_p, cut(string::prefix_p, subopt_prefix, _1));
++ defun(remove_prefix, (auto prefix, auto str),
++ return string::drop(str, string::length(prefix)));
++ define(remove_subopt_prefix, cut(remove_prefix, subopt_prefix, _1));
++ defun(split_subopt, (auto str),
++ return string::split<ARGS_TYPE>(str, ','));
++ define(help_string_p, cut(string::eq_any_p, _1,
++ ARGS_TYPE({"-h"s, "-?"s, "--help"s})));
++ defun(print_help, (auto prog_name),
++ display("Usage: "s *
++ prog_name *
++ " [gij-opt*] [init-opt*] [main-opt] [arg*]\n"s *
++
++ "\n"s *
++
++ " Start a read–eval–print loop by default\n"s *
++
++ "\n"s *
++
++ " gij options:\n"s *
++
++ " -Wi,<op1>,<op2>... "s *
++ "Pass comma-separated options on to gij\n"s *
++
++ " -Wi,-?\n"s *
++
++ " -Wi,--help "s *
++ "Print help for gij, then exit\n"s));
++
++ define(prog_name, car(args));
++ define(rest_args, cdr(args));
++ define(opts, partition(subopt_p, cdr(args)));
++ define(subopts, opts[0]);
++ define(otheropts, opts[1]);
++ ARGS = Args(append(ARGS_TYPE({prog_name, "-noverify"s}),
++ concatenate(map(split_subopt * remove_subopt_prefix,
++ subopts)),
++ ARGS_TYPE({"clojure.main"s}),
++ otheropts));
++
++ if(!null_p(otheropts)
++ && help_string_p(car(otheropts)))
++ {
++ STDOUT_FILE_SV = STDOUT_FILE > STDOUT_PIPE;
++ STDERR_FILE_SV = STDERR_FILE > STDERR_PIPE;
++ std::atexit(lambda((),
++ STDOUT_FILE > STDOUT_FILE_SV;
++ STDERR_FILE > STDERR_FILE_SV;
++
++ define(stdout_str, read_from_pipe(STDOUT_PIPE));
++ define(stderr_str, read_from_pipe(STDERR_PIPE));
++ if (string::contains_p(stdout_str, "clojure.main"s))
++ {
++ print_help(decltype(prog_name)(ARGS.argv[0]));
++
++ for_each(lambda((auto str),
++ display(str);
++ display("\n"s)),
++
drop(string::split<ARGS_TYPE>(stdout_str,
++ '\n'),
++ 3));
++ }
++ else
++ {
++ display(stdout_str);
++ }
++ display_error(stderr_str)));
++ }
++
++ return __real_main(ARGS.argc, ARGS.argv);
++}
+--
+2.9.0
+
--
2.9.0
- [PATCH] gnu: Add clojure.,
Alex Vong <=