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