From mboxrd@z Thu Jan 1 00:00:00 1970 From: Alex Vong Subject: [PATCH] gnu: Add clojure. Date: Wed, 06 Jul 2016 20:54:58 +0800 Message-ID: <87r3b7gc4d.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:43037) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bKmM9-0007CJ-JM for guix-devel@gnu.org; Wed, 06 Jul 2016 08:55:13 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bKmM5-0003b4-Ak for guix-devel@gnu.org; Wed, 06 Jul 2016 08:55:09 -0400 Received: from mail-pa0-x22e.google.com ([2607:f8b0:400e:c03::22e]:35656) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bKmM4-0003at-O7 for guix-devel@gnu.org; Wed, 06 Jul 2016 08:55:05 -0400 Received: by mail-pa0-x22e.google.com with SMTP id dx3so11773845pab.2 for ; Wed, 06 Jul 2016 05:55:04 -0700 (PDT) List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: inline; filename=0001-gnu-Add-clojure.patch Content-Transfer-Encoding: quoted-printable >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+)))) =20 +(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/clojur= e/" + 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 repack= ed. + "--xz" + "--extract" + "--verbose" + "--file" (assoc-ref inputs + src-nam= e) + "--strip-components=3D1")))= ))) + (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=3Dgnu++14" "-pedanti= c" + "-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 ".ja= r") + 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.generato= rs-" + 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.generati= ve-" + 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.namespa= ce-" + 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 lang= uage, +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 +=E2=80=93 every feature supported by Clojure is supported at runtime. Cloj= ure 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 philos= ophy +and a powerful macro system. Clojure is predominantly a functional program= ming +language, and features a rich set of immutable, persistent data structures. +When mutable state is needed, Clojure offers a software transactional memo= ry +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/pac= kages/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 implie= d. ++ 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 =3D 0; ++ char** argv =3D nullptr; ++ ++ Args() {} ++ template ++ Args(A ls) ++ { ++ argc =3D length(ls); ++ argv =3D new char*[argc + 1]; ++ std::transform(std::begin(ls), std::end(ls), ++ argv, ++ lambda((auto str), return strdup(str.c_str()))); ++ argv[argc] =3D nullptr; ++ } ++ ~Args() ++ { ++ std::for_each(argv, argv + argc, ++ lambda((auto str), free(str))); ++ delete[] argv; ++ } ++ Args(Args& args) =3D delete; ++ Args& operator=3D(Args& args) =3D delete; ++ Args(Args&& args) =3D delete; ++ Args& operator=3D(Args&& args) ++ { ++ std::for_each(argv, argv + argc, ++ lambda((auto ptr), free(ptr))); ++ delete[] argv; ++ argc =3D args.argc; ++ argv =3D args.argv; ++ args.argc =3D 0; ++ args.argv =3D 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 op= erator ++ 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 implie= d. ++ 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 =3D 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 =3D 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 implie= d. ++ See the License for the specific language governing permissions and ++ limitations under the License. */ ++ ++ ++#pragma once ++ ++#define lambda(arg_ls, body) \ ++ [=3D] arg_ls {body;} ++ ++#define define(id, val) \ ++ const auto id =3D 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 implie= d. ++ 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 implie= d. ++ 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 =3D=3D 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) !=3D 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 implie= d. ++ 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 =3D -1; ++ ++ File() {} ++ File(int a_fd) ++ { ++ fd =3D a_fd; ++ } ++ ~File() ++ { ++ if (fd >=3D 0) close(fd); ++ } ++ File(File& file) =3D delete; ++ File& operator=3D(File& file) =3D delete; ++ File(File&& file) ++ { ++ fd =3D file.fd; ++ file.fd =3D -1; ++ } ++ File& operator=3D(File&& file) ++ { ++ fd =3D file.fd; ++ file.fd =3D -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 >=3D 0) close(fd))); ++ } ++ Pipe(Pipe& pipe) =3D delete; ++ Pipe& operator=3D(Pipe& pipe) =3D delete; ++ Pipe(Pipe&& pipe) =3D delete; ++ Pipe& operator=3D(Pipe&& pipe) =3D 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 descript= or"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 =3D -1; ++ } ++} ++using namespace file_and_pipe; ++ ++ ++defun(read_from_pipe, (auto& pipe), ++ if (pipe.pipefd[1] >=3D 0) ++ { ++ close(pipe.pipefd[1]); ++ pipe.pipefd[1] =3D -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 execu= table ++ 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 implie= d. ++ 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=E2=80=93eval=E2=80=93print loop by defaul= t\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 =3D 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 =3D STDOUT_FILE > STDOUT_PIPE; ++ STDERR_FILE_SV =3D 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(stdou= t_str, ++ '\n'), ++ 3)); ++ } ++ else ++ { ++ display(stdout_str); ++ } ++ display_error(stderr_str))); ++ } ++ ++ return __real_main(ARGS.argc, ARGS.argv); ++} +--=20 +2.9.0 + --=20 2.9.0 --=-=-=--