From 5b275a8ac0209316b89a3c35f6c76740b0ba245f Mon Sep 17 00:00:00 2001 From: Alex Vong 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 +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 ++#include ++#include ++#include "base.hxx" ++ ++ ++struct Args ++{ int argc = 0; ++ char** argv = nullptr; ++ ++ Args() {} ++ template ++ 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 ++#include ++#include ++#include ++#include ++#include ++#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 ++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 class List, typename A> ++defsubst(map, (A_to_B proc, List ls), ++ List 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 class List, typename A> ++defsubst(partition, (A_to_Bool pred, List ls), ++ List ls1; ++ List ls2; ++ std::partition_copy(std::begin(ls), std::end(ls), ++ std::back_inserter(ls1), ++ std::back_inserter(ls2), ++ pred); ++ return List>({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 ++ defsubst(fold, (A_to_B_to_B proc, B init), ++ return init); ++ template ++ defsubst(fold, (A_to_B_to_B proc, B init, A e), ++ return proc(e, init)); ++ template ++ 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 ++ defsubst(fold_right, (A_to_B_to_B proc, B init), ++ return init); ++ template ++ defsubst(fold_right, (A_to_B_to_B proc, B init, A e), ++ return proc(e, init)); ++ template ++ 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 ++#include ++#include "base.hxx" ++ ++ ++template ++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 ++ 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 ++#include ++#include ++#include ++#include ++#include ++#include ++#include ++#include ++#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 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 ++#include ++#include ++#include "base.hxx" ++#include "args.hxx" ++#include "string.hxx" ++#include "sys.hxx" ++ ++#define ARGS_TYPE std::deque ++ ++ ++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(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,,... "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(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