git.m455.casa

fa

clone url: git://git.m455.casa/fa


esperbuild/espersrc/fennel-0.7.0/src/fennel/binary.fnl

1 ;; This module compiles Fennel modules into standalone executable programs.
2 ;; It can be considered "downstream" of the rest of the compiler and is somewhat
3 ;; independent.
4
5 ;; based on https://github.com/ers35/luastatic/
6 (local fennel (require :fennel))
7
8 (fn shellout [command]
9 (let [f (io.popen command)
10 stdout (f:read :*all)]
11 (and (f:close) stdout)))
12
13 (fn execute [cmd]
14 (match (os.execute cmd)
15 0 true
16 true true))
17
18 (fn string->c-hex-literal [characters]
19 (let [hex []]
20 (each [character (characters:gmatch ".")]
21 (table.insert hex (: "0x%02x" :format (string.byte character))))
22 (table.concat hex ", ")))
23
24 (local c-shim
25 "#ifdef __cplusplus
26 extern \"C\" {
27 #endif
28 #include <lauxlib.h>
29 #include <lua.h>
30 #include <lualib.h>
31 #ifdef __cplusplus
32 }
33 #endif
34 #include <signal.h>
35 #include <stdio.h>
36 #include <stdlib.h>
37 #include <string.h>
38
39 #if LUA_VERSION_NUM == 501
40 #define LUA_OK 0
41 #endif
42
43 /* Copied from lua.c */
44
45 static lua_State *globalL = NULL;
46
47 static void lstop (lua_State *L, lua_Debug *ar) {
48 (void)ar; /* unused arg. */
49 lua_sethook(L, NULL, 0, 0); /* reset hook */
50 luaL_error(L, \"interrupted!\");
51 }
52
53 static void laction (int i) {
54 signal(i, SIG_DFL); /* if another SIGINT happens, terminate process */
55 lua_sethook(globalL, lstop, LUA_MASKCALL | LUA_MASKRET | LUA_MASKCOUNT, 1);
56 }
57
58 static void createargtable (lua_State *L, char **argv, int argc, int script) {
59 int i, narg;
60 if (script == argc) script = 0; /* no script name? */
61 narg = argc - (script + 1); /* number of positive indices */
62 lua_createtable(L, narg, script + 1);
63 for (i = 0; i < argc; i++) {
64 lua_pushstring(L, argv[i]);
65 lua_rawseti(L, -2, i - script);
66 }
67 lua_setglobal(L, \"arg\");
68 }
69
70 static int msghandler (lua_State *L) {
71 const char *msg = lua_tostring(L, 1);
72 if (msg == NULL) { /* is error object not a string? */
73 if (luaL_callmeta(L, 1, \"__tostring\") && /* does it have a metamethod */
74 lua_type(L, -1) == LUA_TSTRING) /* that produces a string? */
75 return 1; /* that is the message */
76 else
77 msg = lua_pushfstring(L, \"(error object is a %%s value)\",
78 luaL_typename(L, 1));
79 }
80 /* Call debug.traceback() instead of luaL_traceback() for Lua 5.1 compat. */
81 lua_getglobal(L, \"debug\");
82 lua_getfield(L, -1, \"traceback\");
83 /* debug */
84 lua_remove(L, -2);
85 lua_pushstring(L, msg);
86 /* original msg */
87 lua_remove(L, -3);
88 lua_pushinteger(L, 2); /* skip this function and traceback */
89 lua_call(L, 2, 1); /* call debug.traceback */
90 return 1; /* return the traceback */
91 }
92
93 static int docall (lua_State *L, int narg, int nres) {
94 int status;
95 int base = lua_gettop(L) - narg; /* function index */
96 lua_pushcfunction(L, msghandler); /* push message handler */
97 lua_insert(L, base); /* put it under function and args */
98 globalL = L; /* to be available to 'laction' */
99 signal(SIGINT, laction); /* set C-signal handler */
100 status = lua_pcall(L, narg, nres, base);
101 signal(SIGINT, SIG_DFL); /* reset C-signal handler */
102 lua_remove(L, base); /* remove message handler from the stack */
103 return status;
104 }
105
106 int main(int argc, char *argv[]) {
107 lua_State *L = luaL_newstate();
108 luaL_openlibs(L);
109 createargtable(L, argv, argc, 0);
110
111 static const unsigned char lua_loader_program[] = {
112 %s
113 };
114 if(luaL_loadbuffer(L, (const char*)lua_loader_program,
115 sizeof(lua_loader_program), \"%s\") != LUA_OK) {
116 fprintf(stderr, \"luaL_loadbuffer: %%s\\n\", lua_tostring(L, -1));
117 lua_close(L);
118 return 1;
119 }
120
121 /* lua_bundle */
122 lua_newtable(L);
123 static const unsigned char lua_require_1[] = {
124 %s
125 };
126 lua_pushlstring(L, (const char*)lua_require_1, sizeof(lua_require_1));
127 lua_setfield(L, -2, \"%s\");
128
129 %s
130
131 if (docall(L, 1, LUA_MULTRET)) {
132 const char *errmsg = lua_tostring(L, 1);
133 if (errmsg) {
134 fprintf(stderr, \"%%s\\n\", errmsg);
135 }
136 lua_close(L);
137 return 1;
138 }
139 lua_close(L);
140 return 0;
141 }")
142
143 (macro loader []
144 `(do (local bundle# ...)
145 (fn loader# [name#]
146 (match (or (. bundle# name#) (. bundle# (.. name# ".init")))
147 (mod# ? (= :function (type mod#))) mod#
148 (mod# ? (= :string (type mod#))) (assert
149 (if (= _VERSION "Lua 5.1")
150 (loadstring mod# name#)
151 (load mod# name#)))
152 nil (values nil (: "\n\tmodule '%%s' not found in fennel bundle"
153 :format name#))))
154 (table.insert (or package.loaders package.searchers) 2 loader#)
155 ((assert (loader# "%s")) ((or unpack table.unpack) arg))))
156
157 (fn compile-fennel [filename options]
158 (let [f (if (= filename "-")
159 io.stdin
160 (assert (io.open filename :rb)))
161 lua-code (fennel.compile-string (f:read :*a) options)]
162 (f:close)
163 lua-code))
164
165 (fn native-loader [native]
166 (let [nm (or (os.getenv "NM") "nm")
167 out [" /* native libraries */"]]
168 (each [_ path (ipairs native)]
169 (each [open (: (shellout (.. nm " " path))
170 :gmatch "[^dDt] _?luaopen_([%a%p%d]+)")]
171 (table.insert out (: " int luaopen_%s(lua_State *L);" :format open))
172 (table.insert out (: " lua_pushcfunction(L, luaopen_%s);" :format open))
173 (table.insert out (: " lua_setfield(L, -2, \"%s\");\n"
174 ;; changing initial underscore breaks luaossl
175 :format (.. (open:sub 1 1)
176 (-> (open:sub 2)
177 (: :gsub "_" ".")))))))
178 (table.concat out "\n")))
179
180 (fn fennel->c [filename native options]
181 (let [basename (filename:gsub "(.*[\\/])(.*)" "%2")
182 basename-noextension (or (basename:match "(.+)%.") basename)
183 dotpath (-> filename
184 (: :gsub "^%.%/" "")
185 (: :gsub "[\\/]" "."))
186 dotpath-noextension (or (dotpath:match "(.+)%.") dotpath)
187 fennel-loader (: (macrodebug (loader) :do) :format dotpath-noextension)
188 lua-loader (fennel.compile-string fennel-loader)]
189 (c-shim:format (string->c-hex-literal lua-loader)
190 basename-noextension
191 (string->c-hex-literal (compile-fennel filename options))
192 dotpath-noextension
193 (native-loader native))))
194
195 (fn write-c [filename native options]
196 (let [out-filename (.. filename "_binary.c")
197 f (assert (io.open out-filename "w+"))]
198 (f:write (fennel->c filename native options))
199 (f:close)
200 out-filename))
201
202 (fn compile-binary [lua-c-path executable-name static-lua lua-include-dir native]
203 (let [cc (or (os.getenv "CC") "cc")
204 ;; http://lua-users.org/lists/lua-l/2009-05/msg00147.html
205 (rdynamic bin-extension ldl?) (if (: (shellout (.. cc " -dumpmachine"))
206 :match "mingw")
207 (values "" ".exe" false)
208 (values "-rdynamic" "" true))
209 compile-command [cc "-Os" ; optimize for size
210 lua-c-path
211 (table.concat native " ")
212 static-lua
213 rdynamic
214 "-lm"
215 (if ldl? "-ldl" "")
216 "-o" (.. executable-name bin-extension)
217 "-I" lua-include-dir
218 (os.getenv "CC_OPTS")]]
219 (when (os.getenv "FENNEL_DEBUG")
220 (print "Compiling with" (table.concat compile-command " ")))
221 (when (not (execute (table.concat compile-command " ")))
222 (print :failed: (table.concat compile-command " "))
223 (os.exit 1))
224 (when (not (os.getenv "FENNEL_DEBUG"))
225 (os.remove lua-c-path))
226 (os.exit 0)))
227
228 (fn native-path? [path]
229 (match (path:match "%.(%a+)$")
230 :a path :o path :so path :dylib path
231 _ false))
232
233 (fn extract-native-args [args]
234 ;; all native libraries go in libraries; those with lua code go in modules too
235 (let [native {:modules [] :libraries []}]
236 (for [i (# args) 1 -1]
237 (when (= "--native-module" (. args i))
238 (let [path (assert (native-path? (table.remove args (+ i 1))))]
239 (table.insert native.modules 1 path)
240 (table.insert native.libraries 1 path)
241 (table.remove args i)))
242 (when (= "--native-library" (. args i))
243 (table.insert native.libraries 1
244 (assert (native-path? (table.remove args (+ i 1)))))
245 (table.remove args i)))
246 (when (< 0 (# args))
247 (print (table.concat args " "))
248 (error (.. "Unknown args: " (table.concat args " "))))
249 native))
250
251 (fn compile [filename executable-name static-lua lua-include-dir options args]
252 (let [{: modules : libraries} (extract-native-args args)]
253 (compile-binary (write-c filename modules options) executable-name
254 static-lua lua-include-dir libraries)))
255
256 (local help (: "
257 Usage: %s --compile-binary FILE OUT STATIC_LUA_LIB LUA_INCLUDE_DIR
258
259 Compile a binary from your Fennel program. This functionality is VERY
260 experimental and subject to change in future versions!
261
262 Requires a C compiler, a copy of liblua, and Lua's dev headers. Implies
263 the --require-as-include option.
264
265 FILE: the Fennel source being compiled.
266 OUT: the name of the executable to generate
267 STATIC_LUA_LIB: the path to the Lua library to use in the executable
268 LUA_INCLUDE_DIR: the path to the directory of Lua C header files
269
270 For example, on a Debian system, to compile a file called program.fnl using
271 Lua 5.3, you would use this:
272
273 $ %s --compile-binary program.fnl program \\
274 /usr/lib/x86_64-linux-gnu/liblua5.3.a /usr/include/lua5.3
275
276 The program will be compiled to Lua, then compiled to C, then compiled to
277 machine code. You can set the CC environment variable to change the compiler
278 used (default: cc) or set CC_OPTS to pass in compiler options. For example
279 set CC_OPTS=-static to generate a binary with static linking.
280
281 To include C libraries that contain Lua modules, add --native-module path/to.so,
282 and to include C libraries without modules, use --native-library path/to.so.
283 These options are unstable, barely tested, and even more likely to break.
284
285 This method is currently limited to programs do not transitively require Lua
286 modules. Requiring a Lua module directly will work, but requiring a Lua module
287 which requires another will fail." :format (. arg 0) (. arg 0)))
288
289 {: compile : help}