-
-
Save menduz/b3839d82d7f235645b411c7191b8e410 to your computer and use it in GitHub Desktop.
Self-hosted Lisp using vvander's Lua browser runtime: https://cdn.rawgit.com/vvanders/wasm_lua/d68f46a8/main.html
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
environment = {{}} | |
target = "lua" | |
function nil63(x) | |
return(x == nil) | |
end | |
function is63(x) | |
return(not nil63(x)) | |
end | |
function no(x) | |
return(nil63(x) or x == false) | |
end | |
function yes(x) | |
return(not no(x)) | |
end | |
function _35(x) | |
return(#x) | |
end | |
function none63(x) | |
return(_35(x) == 0) | |
end | |
function some63(x) | |
return(_35(x) > 0) | |
end | |
function one63(x) | |
return(_35(x) == 1) | |
end | |
function two63(x) | |
return(_35(x) == 2) | |
end | |
function hd(l) | |
return(l[1]) | |
end | |
function string63(x) | |
return(type(x) == "string") | |
end | |
function number63(x) | |
return(type(x) == "number") | |
end | |
function boolean63(x) | |
return(type(x) == "boolean") | |
end | |
function function63(x) | |
return(type(x) == "function") | |
end | |
function obj63(x) | |
return(is63(x) and type(x) == "table") | |
end | |
function atom63(x) | |
return(nil63(x) or string63(x) or number63(x) or boolean63(x)) | |
end | |
nan = 0 / 0 | |
-- inf = 1 / 0 -- There's a bug in WASM preventing this from working. | |
inf = 0 / 0 -- Hack around it for now. | |
function nan63(n) | |
return(not( n == n)) | |
end | |
function inf63(n) | |
return(n == inf or n == -inf) | |
end | |
function clip(s, from, upto) | |
return(string.sub(s, from + 1, upto)) | |
end | |
function cut(x, from, upto) | |
local l = {} | |
local j = 0 | |
local _e | |
if nil63(from) or from < 0 then | |
_e = 0 | |
else | |
_e = from | |
end | |
local i = _e | |
local n = _35(x) | |
local _e1 | |
if nil63(upto) or upto > n then | |
_e1 = n | |
else | |
_e1 = upto | |
end | |
local _upto = _e1 | |
while i < _upto do | |
l[j + 1] = x[i + 1] | |
i = i + 1 | |
j = j + 1 | |
end | |
local _o = x | |
local k = nil | |
for k in next, _o do | |
local v = _o[k] | |
if not number63(k) then | |
l[k] = v | |
end | |
end | |
return(l) | |
end | |
function keys(x) | |
local t = {} | |
local _o1 = x | |
local k = nil | |
for k in next, _o1 do | |
local v = _o1[k] | |
if not number63(k) then | |
t[k] = v | |
end | |
end | |
return(t) | |
end | |
function edge(x) | |
return(_35(x) - 1) | |
end | |
function inner(x) | |
return(clip(x, 1, edge(x))) | |
end | |
function tl(l) | |
return(cut(l, 1)) | |
end | |
function char(s, n) | |
return(clip(s, n, n + 1)) | |
end | |
function code(s, n) | |
local _e2 | |
if n then | |
_e2 = n + 1 | |
end | |
return(string.byte(s, _e2)) | |
end | |
function string_literal63(x) | |
return(string63(x) and char(x, 0) == "\"") | |
end | |
function id_literal63(x) | |
return(string63(x) and char(x, 0) == "|") | |
end | |
function add(l, x) | |
return(table.insert(l, x)) | |
end | |
function drop(l) | |
return(table.remove(l)) | |
end | |
function last(l) | |
return(l[edge(l) + 1]) | |
end | |
function almost(l) | |
return(cut(l, 0, edge(l))) | |
end | |
function reverse(l) | |
local l1 = keys(l) | |
local i = edge(l) | |
while i >= 0 do | |
add(l1, l[i + 1]) | |
i = i - 1 | |
end | |
return(l1) | |
end | |
function reduce(f, x) | |
if none63(x) then | |
return(nil) | |
else | |
if one63(x) then | |
return(hd(x)) | |
else | |
return(f(hd(x), reduce(f, tl(x)))) | |
end | |
end | |
end | |
function join(...) | |
local ls = unstash({...}) | |
local r = {} | |
local _x2 = ls | |
local _i2 = 0 | |
while _i2 < _35(_x2) do | |
local l = _x2[_i2 + 1] | |
if l then | |
local n = _35(r) | |
local _o2 = l | |
local k = nil | |
for k in next, _o2 do | |
local v = _o2[k] | |
if number63(k) then | |
k = k + n | |
end | |
r[k] = v | |
end | |
end | |
_i2 = _i2 + 1 | |
end | |
return(r) | |
end | |
function find(f, t) | |
local _o3 = t | |
local _i4 = nil | |
for _i4 in next, _o3 do | |
local x = _o3[_i4] | |
local y = f(x) | |
if y then | |
return(y) | |
end | |
end | |
end | |
function first(f, l) | |
local _x3 = l | |
local _i5 = 0 | |
while _i5 < _35(_x3) do | |
local x = _x3[_i5 + 1] | |
local y = f(x) | |
if y then | |
return(y) | |
end | |
_i5 = _i5 + 1 | |
end | |
end | |
function in63(x, t) | |
return(find(function (y) | |
return(x == y) | |
end, t)) | |
end | |
function pair(l) | |
local l1 = {} | |
local i = 0 | |
while i < _35(l) do | |
add(l1, {l[i + 1], l[i + 1 + 1]}) | |
i = i + 1 | |
i = i + 1 | |
end | |
return(l1) | |
end | |
function sort(l, f) | |
table.sort(l, f) | |
return(l) | |
end | |
function map(f, x) | |
local t = {} | |
local _x5 = x | |
local _i6 = 0 | |
while _i6 < _35(_x5) do | |
local v = _x5[_i6 + 1] | |
local y = f(v) | |
if is63(y) then | |
add(t, y) | |
end | |
_i6 = _i6 + 1 | |
end | |
local _o4 = x | |
local k = nil | |
for k in next, _o4 do | |
local v = _o4[k] | |
if not number63(k) then | |
local y = f(v) | |
if is63(y) then | |
t[k] = y | |
end | |
end | |
end | |
return(t) | |
end | |
function keep(f, x) | |
return(map(function (v) | |
if yes(f(v)) then | |
return(v) | |
end | |
end, x)) | |
end | |
function keys63(t) | |
local _o5 = t | |
local k = nil | |
for k in next, _o5 do | |
local v = _o5[k] | |
if not number63(k) then | |
return(true) | |
end | |
end | |
return(false) | |
end | |
function empty63(t) | |
local _o6 = t | |
local _i9 = nil | |
for _i9 in next, _o6 do | |
local x = _o6[_i9] | |
return(false) | |
end | |
return(true) | |
end | |
function stash(args) | |
if keys63(args) then | |
local p = {} | |
local _o7 = args | |
local k = nil | |
for k in next, _o7 do | |
local v = _o7[k] | |
if not number63(k) then | |
p[k] = v | |
end | |
end | |
p._stash = true | |
add(args, p) | |
end | |
return(args) | |
end | |
function unstash(args) | |
if none63(args) then | |
return({}) | |
else | |
local l = last(args) | |
if obj63(l) and l._stash then | |
local args1 = almost(args) | |
local _o8 = l | |
local k = nil | |
for k in next, _o8 do | |
local v = _o8[k] | |
if not( k == "_stash") then | |
args1[k] = v | |
end | |
end | |
return(args1) | |
else | |
return(args) | |
end | |
end | |
end | |
function destash33(l, args1) | |
if obj63(l) and l._stash then | |
local _o9 = l | |
local k = nil | |
for k in next, _o9 do | |
local v = _o9[k] | |
if not( k == "_stash") then | |
args1[k] = v | |
end | |
end | |
else | |
return(l) | |
end | |
end | |
function search(s, pattern, start) | |
local _e3 | |
if start then | |
_e3 = start + 1 | |
end | |
local _start = _e3 | |
local i = string.find(s, pattern, _start, true) | |
return(i and i - 1) | |
end | |
function split(s, sep) | |
if s == "" or sep == "" then | |
return({}) | |
else | |
local l = {} | |
local n = _35(sep) | |
while true do | |
local i = search(s, sep) | |
if nil63(i) then | |
break | |
else | |
add(l, clip(s, 0, i)) | |
s = clip(s, i + n) | |
end | |
end | |
add(l, s) | |
return(l) | |
end | |
end | |
function cat(...) | |
local xs = unstash({...}) | |
return(reduce(function (a, b) | |
return(a .. b) | |
end, xs) or "") | |
end | |
function _43(...) | |
local xs = unstash({...}) | |
return(reduce(function (a, b) | |
return(a + b) | |
end, xs) or 0) | |
end | |
function _(...) | |
local xs = unstash({...}) | |
return(reduce(function (b, a) | |
return(a - b) | |
end, reverse(xs)) or 0) | |
end | |
function _42(...) | |
local xs = unstash({...}) | |
return(reduce(function (a, b) | |
return(a * b) | |
end, xs) or 1) | |
end | |
function _47(...) | |
local xs = unstash({...}) | |
return(reduce(function (b, a) | |
return(a / b) | |
end, reverse(xs)) or 1) | |
end | |
function _37(...) | |
local xs = unstash({...}) | |
return(reduce(function (b, a) | |
return(a % b) | |
end, reverse(xs)) or 0) | |
end | |
function _62(a, b) | |
return(a > b) | |
end | |
function _60(a, b) | |
return(a < b) | |
end | |
function _61(a, b) | |
return(a == b) | |
end | |
function _6261(a, b) | |
return(a >= b) | |
end | |
function _6061(a, b) | |
return(a <= b) | |
end | |
function number(s) | |
return(tonumber(s)) | |
end | |
function number_code63(n) | |
return(n > 47 and n < 58) | |
end | |
function numeric63(s) | |
local n = _35(s) | |
local i = 0 | |
while i < n do | |
if not number_code63(code(s, i)) then | |
return(false) | |
end | |
i = i + 1 | |
end | |
return(true) | |
end | |
function escape(s) | |
local s1 = "\"" | |
local i = 0 | |
while i < _35(s) do | |
local c = char(s, i) | |
local _e4 | |
if c == "\n" then | |
_e4 = "\\n" | |
else | |
local _e5 | |
if c == "\"" then | |
_e5 = "\\\"" | |
else | |
local _e6 | |
if c == "\\" then | |
_e6 = "\\\\" | |
else | |
_e6 = c | |
end | |
_e5 = _e6 | |
end | |
_e4 = _e5 | |
end | |
local c1 = _e4 | |
s1 = s1 .. c1 | |
i = i + 1 | |
end | |
return(s1 .. "\"") | |
end | |
function str(x, stack) | |
if nil63(x) then | |
return("nil") | |
else | |
if nan63(x) then | |
return("nan") | |
else | |
if x == inf then | |
return("inf") | |
else | |
if x == -inf then | |
return("-inf") | |
else | |
if boolean63(x) then | |
if x then | |
return("true") | |
else | |
return("false") | |
end | |
else | |
if string63(x) then | |
return(escape(x)) | |
else | |
if atom63(x) then | |
return(tostring(x)) | |
else | |
if function63(x) then | |
return("function") | |
else | |
if stack and in63(x, stack) then | |
return("circular") | |
else | |
if not( type(x) == "table") then | |
return(escape(tostring(x))) | |
else | |
local s = "(" | |
local sp = "" | |
local xs = {} | |
local ks = {} | |
local l = stack or {} | |
add(l, x) | |
local _o10 = x | |
local k = nil | |
for k in next, _o10 do | |
local v = _o10[k] | |
if number63(k) then | |
xs[k] = str(v, l) | |
else | |
add(ks, k .. ":") | |
add(ks, str(v, l)) | |
end | |
end | |
drop(l) | |
local _o11 = join(xs, ks) | |
local _i14 = nil | |
for _i14 in next, _o11 do | |
local v = _o11[_i14] | |
s = s .. sp .. v | |
sp = " " | |
end | |
return(s .. ")") | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
local values = unpack or table.unpack | |
function apply(f, args) | |
local _args = stash(args) | |
return(f(values(_args))) | |
end | |
function call(f) | |
return(f()) | |
end | |
function toplevel63() | |
return(one63(environment)) | |
end | |
function setenv(k, ...) | |
local _r69 = unstash({...}) | |
local _k = destash33(k, _r69) | |
local _id = _r69 | |
local _keys = cut(_id, 0) | |
if string63(_k) then | |
local _e7 | |
if _keys.toplevel then | |
_e7 = hd(environment) | |
else | |
_e7 = last(environment) | |
end | |
local frame = _e7 | |
local entry = frame[_k] or {} | |
local _o12 = _keys | |
local _k1 = nil | |
for _k1 in next, _o12 do | |
local v = _o12[_k1] | |
entry[_k1] = v | |
end | |
frame[_k] = entry | |
return(frame[_k]) | |
end | |
end | |
local math = math | |
abs = math.abs | |
acos = math.acos | |
asin = math.asin | |
atan = math.atan | |
atan2 = math.atan2 | |
ceil = math.ceil | |
cos = math.cos | |
floor = math.floor | |
log = math.log | |
log10 = math.log10 | |
max = math.max | |
min = math.min | |
pow = math.pow | |
random = math.random | |
sin = math.sin | |
sinh = math.sinh | |
sqrt = math.sqrt | |
tan = math.tan | |
tanh = math.tanh | |
trunc = math.floor | |
setenv("quote", {_stash = true, macro = function (form) | |
return(quoted(form)) | |
end}) | |
setenv("quasiquote", {_stash = true, macro = function (form) | |
return(quasiexpand(form, 1)) | |
end}) | |
setenv("set", {_stash = true, macro = function (...) | |
local args = unstash({...}) | |
return(join({"do"}, map(function (_x6) | |
local _id1 = _x6 | |
local lh = _id1[1] | |
local rh = _id1[2] | |
return({"%set", lh, rh}) | |
end, pair(args)))) | |
end}) | |
setenv("at", {_stash = true, macro = function (l, i) | |
if target == "lua" and number63(i) then | |
i = i + 1 | |
else | |
if target == "lua" then | |
i = {"+", i, 1} | |
end | |
end | |
return({"get", l, i}) | |
end}) | |
setenv("wipe", {_stash = true, macro = function (place) | |
if target == "lua" then | |
return({"set", place, "nil"}) | |
else | |
return({"%delete", place}) | |
end | |
end}) | |
setenv("list", {_stash = true, macro = function (...) | |
local body = unstash({...}) | |
local x = unique("x") | |
local l = {} | |
local forms = {} | |
local _o1 = body | |
local k = nil | |
for k in next, _o1 do | |
local v = _o1[k] | |
if number63(k) then | |
l[k] = v | |
else | |
add(forms, {"set", {"get", x, {"quote", k}}, v}) | |
end | |
end | |
if some63(forms) then | |
return(join({"let", x, join({"%array"}, l)}, forms, {x})) | |
else | |
return(join({"%array"}, l)) | |
end | |
end}) | |
setenv("if", {_stash = true, macro = function (...) | |
local branches = unstash({...}) | |
return(hd(expand_if(branches))) | |
end}) | |
setenv("case", {_stash = true, macro = function (expr, ...) | |
local _r13 = unstash({...}) | |
local _expr1 = destash33(expr, _r13) | |
local _id4 = _r13 | |
local clauses = cut(_id4, 0) | |
local x = unique("x") | |
local eq = function (_) | |
return({"=", {"quote", _}, x}) | |
end | |
local cl = function (_x48) | |
local _id5 = _x48 | |
local a = _id5[1] | |
local b = _id5[2] | |
if nil63(b) then | |
return({a}) | |
else | |
if string63(a) or number63(a) then | |
return({eq(a), b}) | |
else | |
if one63(a) then | |
return({eq(hd(a)), b}) | |
else | |
if _35(a) > 1 then | |
return({join({"or"}, map(eq, a)), b}) | |
end | |
end | |
end | |
end | |
end | |
return({"let", x, _expr1, join({"if"}, apply(join, map(cl, pair(clauses))))}) | |
end}) | |
setenv("when", {_stash = true, macro = function (cond, ...) | |
local _r17 = unstash({...}) | |
local _cond1 = destash33(cond, _r17) | |
local _id7 = _r17 | |
local body = cut(_id7, 0) | |
return({"if", _cond1, join({"do"}, body)}) | |
end}) | |
setenv("unless", {_stash = true, macro = function (cond, ...) | |
local _r19 = unstash({...}) | |
local _cond3 = destash33(cond, _r19) | |
local _id9 = _r19 | |
local body = cut(_id9, 0) | |
return({"if", {"not", _cond3}, join({"do"}, body)}) | |
end}) | |
setenv("obj", {_stash = true, macro = function (...) | |
local body = unstash({...}) | |
return(join({"%object"}, mapo(function (x) | |
return(x) | |
end, body))) | |
end}) | |
setenv("let", {_stash = true, macro = function (bs, ...) | |
local _r23 = unstash({...}) | |
local _bs1 = destash33(bs, _r23) | |
local _id13 = _r23 | |
local body = cut(_id13, 0) | |
if atom63(_bs1) then | |
return(join({"let", {_bs1, hd(body)}}, tl(body))) | |
else | |
if none63(_bs1) then | |
return(join({"do"}, body)) | |
else | |
local _id14 = _bs1 | |
local lh = _id14[1] | |
local rh = _id14[2] | |
local bs2 = cut(_id14, 2) | |
local _id15 = bind(lh, rh) | |
local id = _id15[1] | |
local val = _id15[2] | |
local bs1 = cut(_id15, 2) | |
local renames = {} | |
if bound63(id) or toplevel63() then | |
local id1 = unique(id) | |
renames = {id, id1} | |
id = id1 | |
else | |
setenv(id, {_stash = true, variable = true}) | |
end | |
return({"do", {"%local", id, val}, {"let-symbol", renames, join({"let", join(bs1, bs2)}, body)}}) | |
end | |
end | |
end}) | |
setenv("with", {_stash = true, macro = function (x, v, ...) | |
local _r25 = unstash({...}) | |
local _x98 = destash33(x, _r25) | |
local _v1 = destash33(v, _r25) | |
local _id17 = _r25 | |
local body = cut(_id17, 0) | |
return(join({"let", {_x98, _v1}}, body, {_x98})) | |
end}) | |
setenv("let-when", {_stash = true, macro = function (x, v, ...) | |
local _r27 = unstash({...}) | |
local _x110 = destash33(x, _r27) | |
local _v3 = destash33(v, _r27) | |
local _id19 = _r27 | |
local body = cut(_id19, 0) | |
local y = unique("y") | |
return({"let", y, _v3, {"when", {"yes", y}, join({"let", {_x110, y}}, body)}}) | |
end}) | |
setenv("define-macro", {_stash = true, macro = function (name, args, ...) | |
local _r29 = unstash({...}) | |
local _name1 = destash33(name, _r29) | |
local _args1 = destash33(args, _r29) | |
local _id21 = _r29 | |
local body = cut(_id21, 0) | |
local _x121 = {"setenv", {"quote", _name1}} | |
_x121.macro = join({"fn", _args1}, body) | |
local form = _x121 | |
eval(form) | |
return(form) | |
end}) | |
setenv("define-special", {_stash = true, macro = function (name, args, ...) | |
local _r31 = unstash({...}) | |
local _name3 = destash33(name, _r31) | |
local _args3 = destash33(args, _r31) | |
local _id23 = _r31 | |
local body = cut(_id23, 0) | |
local _x129 = {"setenv", {"quote", _name3}} | |
_x129.special = join({"fn", _args3}, body) | |
local form = join(_x129, keys(body)) | |
eval(form) | |
return(form) | |
end}) | |
setenv("define-symbol", {_stash = true, macro = function (name, expansion) | |
setenv(name, {_stash = true, symbol = expansion}) | |
local _x135 = {"setenv", {"quote", name}} | |
_x135.symbol = {"quote", expansion} | |
return(_x135) | |
end}) | |
setenv("define-reader", {_stash = true, macro = function (_x144, ...) | |
local _id26 = _x144 | |
local char = _id26[1] | |
local s = _id26[2] | |
local _r35 = unstash({...}) | |
local __x144 = destash33(_x144, _r35) | |
local _id27 = _r35 | |
local body = cut(_id27, 0) | |
return({"set", {"get", "read-table", char}, join({"fn", {s}}, body)}) | |
end}) | |
setenv("define", {_stash = true, macro = function (name, x, ...) | |
local _r37 = unstash({...}) | |
local _name5 = destash33(name, _r37) | |
local _x155 = destash33(x, _r37) | |
local _id29 = _r37 | |
local body = cut(_id29, 0) | |
setenv(_name5, {_stash = true, variable = true}) | |
if some63(body) then | |
return(join({"%local-function", _name5}, bind42(_x155, body))) | |
else | |
return({"%local", _name5, _x155}) | |
end | |
end}) | |
setenv("define-global", {_stash = true, macro = function (name, x, ...) | |
local _r39 = unstash({...}) | |
local _name7 = destash33(name, _r39) | |
local _x163 = destash33(x, _r39) | |
local _id31 = _r39 | |
local body = cut(_id31, 0) | |
setenv(_name7, {_stash = true, toplevel = true, variable = true}) | |
if some63(body) then | |
return(join({"%global-function", _name7}, bind42(_x163, body))) | |
else | |
return({"set", _name7, _x163}) | |
end | |
end}) | |
setenv("with-frame", {_stash = true, macro = function (...) | |
local body = unstash({...}) | |
local x = unique("x") | |
return({"do", {"add", "environment", {"obj"}}, {"with", x, join({"do"}, body), {"drop", "environment"}}}) | |
end}) | |
setenv("with-bindings", {_stash = true, macro = function (_x185, ...) | |
local _id34 = _x185 | |
local names = _id34[1] | |
local _r41 = unstash({...}) | |
local __x185 = destash33(_x185, _r41) | |
local _id35 = _r41 | |
local body = cut(_id35, 0) | |
local x = unique("x") | |
local _x189 = {"setenv", x} | |
_x189.variable = true | |
return(join({"with-frame", {"each", x, names, _x189}}, body)) | |
end}) | |
setenv("let-macro", {_stash = true, macro = function (definitions, ...) | |
local _r44 = unstash({...}) | |
local _definitions1 = destash33(definitions, _r44) | |
local _id37 = _r44 | |
local body = cut(_id37, 0) | |
add(environment, {}) | |
map(function (m) | |
return(macroexpand(join({"define-macro"}, m))) | |
end, _definitions1) | |
local _x195 = join({"do"}, macroexpand(body)) | |
drop(environment) | |
return(_x195) | |
end}) | |
setenv("let-symbol", {_stash = true, macro = function (expansions, ...) | |
local _r48 = unstash({...}) | |
local _expansions1 = destash33(expansions, _r48) | |
local _id40 = _r48 | |
local body = cut(_id40, 0) | |
add(environment, {}) | |
map(function (_x205) | |
local _id41 = _x205 | |
local name = _id41[1] | |
local exp = _id41[2] | |
return(macroexpand({"define-symbol", name, exp})) | |
end, pair(_expansions1)) | |
local _x204 = join({"do"}, macroexpand(body)) | |
drop(environment) | |
return(_x204) | |
end}) | |
setenv("let-unique", {_stash = true, macro = function (names, ...) | |
local _r52 = unstash({...}) | |
local _names1 = destash33(names, _r52) | |
local _id43 = _r52 | |
local body = cut(_id43, 0) | |
local bs = map(function (n) | |
return({n, {"unique", {"quote", n}}}) | |
end, _names1) | |
return(join({"let", apply(join, bs)}, body)) | |
end}) | |
setenv("fn", {_stash = true, macro = function (args, ...) | |
local _r55 = unstash({...}) | |
local _args5 = destash33(args, _r55) | |
local _id45 = _r55 | |
local body = cut(_id45, 0) | |
return(join({"%function"}, bind42(_args5, body))) | |
end}) | |
setenv("apply", {_stash = true, macro = function (f, ...) | |
local _r57 = unstash({...}) | |
local _f1 = destash33(f, _r57) | |
local _id47 = _r57 | |
local args = cut(_id47, 0) | |
if _35(args) > 1 then | |
return({{"do", "apply"}, _f1, {"join", join({"list"}, almost(args)), last(args)}}) | |
else | |
return(join({{"do", "apply"}, _f1}, args)) | |
end | |
end}) | |
setenv("guard", {_stash = true, macro = function (expr) | |
if target == "js" then | |
return({{"fn", join(), {"%try", {"list", true, expr}}}}) | |
else | |
local x = unique("x") | |
local msg = unique("msg") | |
local trace = unique("trace") | |
local _x287 = {"obj"} | |
_x287.stack = trace | |
_x287.message = msg | |
return({"let", {x, "nil", msg, "nil", trace, "nil"}, {"if", {"xpcall", {"fn", join(), {"set", x, expr}}, {"fn", {"m"}, {"set", trace, {{"get", "debug", {"quote", "traceback"}}}, msg, {"if", {"string?", "m"}, {"clip", "m", {"+", {"search", "m", "\": \""}, 2}}, {"nil?", "m"}, "\"\"", {"str", "m"}}}}}, {"list", true, x}, {"list", false, _x287}}}) | |
end | |
end}) | |
setenv("each", {_stash = true, macro = function (x, t, ...) | |
local _r61 = unstash({...}) | |
local _x304 = destash33(x, _r61) | |
local _t1 = destash33(t, _r61) | |
local _id50 = _r61 | |
local body = cut(_id50, 0) | |
local o = unique("o") | |
local n = unique("n") | |
local i = unique("i") | |
local _e5 | |
if atom63(_x304) then | |
_e5 = {i, _x304} | |
else | |
local _e6 | |
if _35(_x304) > 1 then | |
_e6 = _x304 | |
else | |
_e6 = {i, hd(_x304)} | |
end | |
_e5 = _e6 | |
end | |
local _id51 = _e5 | |
local k = _id51[1] | |
local v = _id51[2] | |
local _e7 | |
if target == "lua" then | |
_e7 = body | |
else | |
_e7 = {join({"let", k, {"if", {"numeric?", k}, {"parseInt", k}, k}}, body)} | |
end | |
return({"let", {o, _t1, k, "nil"}, {"%for", o, k, join({"let", {v, {"get", o, k}}}, _e7)}}) | |
end}) | |
setenv("for", {_stash = true, macro = function (i, to, ...) | |
local _r63 = unstash({...}) | |
local _i3 = destash33(i, _r63) | |
local _to1 = destash33(to, _r63) | |
local _id53 = _r63 | |
local body = cut(_id53, 0) | |
return({"let", _i3, 0, join({"while", {"<", _i3, _to1}}, body, {{"inc", _i3}})}) | |
end}) | |
setenv("step", {_stash = true, macro = function (v, t, ...) | |
local _r65 = unstash({...}) | |
local _v5 = destash33(v, _r65) | |
local _t3 = destash33(t, _r65) | |
local _id55 = _r65 | |
local body = cut(_id55, 0) | |
local x = unique("x") | |
local i = unique("i") | |
return({"let", {x, _t3}, {"for", i, {"#", x}, join({"let", {_v5, {"at", x, i}}}, body)}}) | |
end}) | |
setenv("set-of", {_stash = true, macro = function (...) | |
local xs = unstash({...}) | |
local l = {} | |
local _o3 = xs | |
local _i5 = nil | |
for _i5 in next, _o3 do | |
local x = _o3[_i5] | |
l[x] = true | |
end | |
return(join({"obj"}, l)) | |
end}) | |
setenv("language", {_stash = true, macro = function () | |
return({"quote", target}) | |
end}) | |
setenv("target", {_stash = true, macro = function (...) | |
local clauses = unstash({...}) | |
return(clauses[target]) | |
end}) | |
setenv("join!", {_stash = true, macro = function (a, ...) | |
local _r69 = unstash({...}) | |
local _a1 = destash33(a, _r69) | |
local _id57 = _r69 | |
local bs = cut(_id57, 0) | |
return({"set", _a1, join({"join", _a1}, bs)}) | |
end}) | |
setenv("cat!", {_stash = true, macro = function (a, ...) | |
local _r71 = unstash({...}) | |
local _a3 = destash33(a, _r71) | |
local _id59 = _r71 | |
local bs = cut(_id59, 0) | |
return({"set", _a3, join({"cat", _a3}, bs)}) | |
end}) | |
setenv("inc", {_stash = true, macro = function (n, by) | |
local _e8 | |
if nil63(by) then | |
_e8 = 1 | |
else | |
_e8 = by | |
end | |
return({"set", n, {"+", n, _e8}}) | |
end}) | |
setenv("dec", {_stash = true, macro = function (n, by) | |
local _e9 | |
if nil63(by) then | |
_e9 = 1 | |
else | |
_e9 = by | |
end | |
return({"set", n, {"-", n, _e9}}) | |
end}) | |
setenv("with-indent", {_stash = true, macro = function (form) | |
local x = unique("x") | |
return({"do", {"inc", "indent-level"}, {"with", x, form, {"dec", "indent-level"}}}) | |
end}) | |
setenv("export", {_stash = true, macro = function (...) | |
local names = unstash({...}) | |
if target == "js" then | |
return(join({"do"}, map(function (k) | |
return({"set", {"get", "exports", {"quote", k}}, k}) | |
end, names))) | |
else | |
local x = {} | |
local _o5 = names | |
local _i7 = nil | |
for _i7 in next, _o5 do | |
local k = _o5[_i7] | |
x[k] = k | |
end | |
return({"return", join({"obj"}, x)}) | |
end | |
end}) | |
setenv("when-compiling", {_stash = true, macro = function (...) | |
local body = unstash({...}) | |
return(eval(join({"do"}, body))) | |
end}) | |
local delimiters = {["("] = true, ["\n"] = true, [")"] = true, [";"] = true} | |
local whitespace = {["\n"] = true, ["\t"] = true, [" "] = true} | |
local function stream(str, more) | |
return({len = _35(str), string = str, more = more, pos = 0}) | |
end | |
local function peek_char(s) | |
local _id = s | |
local string = _id.string | |
local len = _id.len | |
local pos = _id.pos | |
if pos < len then | |
return(char(string, pos)) | |
end | |
end | |
local function read_char(s) | |
local c = peek_char(s) | |
if c then | |
s.pos = s.pos + 1 | |
return(c) | |
end | |
end | |
local function skip_non_code(s) | |
while true do | |
local c = peek_char(s) | |
if nil63(c) then | |
break | |
else | |
if whitespace[c] then | |
read_char(s) | |
else | |
if c == ";" then | |
while c and not( c == "\n") do | |
c = read_char(s) | |
end | |
skip_non_code(s) | |
else | |
break | |
end | |
end | |
end | |
end | |
end | |
local read_table = {} | |
local eof = {} | |
local function read(s) | |
skip_non_code(s) | |
local c = peek_char(s) | |
if is63(c) then | |
return((read_table[c] or read_table[""])(s)) | |
else | |
return(eof) | |
end | |
end | |
local function read_all(s) | |
local l = {} | |
while true do | |
local form = read(s) | |
if form == eof then | |
break | |
end | |
add(l, form) | |
end | |
return(l) | |
end | |
function read_string(str, more) | |
local x = read(stream(str, more)) | |
if not( x == eof) then | |
return(x) | |
end | |
end | |
local function key63(atom) | |
return(string63(atom) and _35(atom) > 1 and char(atom, edge(atom)) == ":") | |
end | |
local function flag63(atom) | |
return(string63(atom) and _35(atom) > 1 and char(atom, 0) == ":") | |
end | |
local function expected(s, c) | |
local _id1 = s | |
local more = _id1.more | |
local pos = _id1.pos | |
local _id2 = more | |
local _e | |
if _id2 then | |
_e = _id2 | |
else | |
error("Expected " .. c .. " at " .. pos) | |
_e = nil | |
end | |
return(_e) | |
end | |
local function wrap(s, x) | |
local y = read(s) | |
if y == s.more then | |
return(y) | |
else | |
return({x, y}) | |
end | |
end | |
local function maybe_number(str) | |
if number_code63(code(str, edge(str))) then | |
return(number(str)) | |
end | |
end | |
local function real63(x) | |
return(number63(x) and not nan63(x) and not inf63(x)) | |
end | |
local function valid_access63(str) | |
return(_35(str) > 2 and not( "." == char(str, 0)) and not( "." == char(str, edge(str))) and not search(str, "..")) | |
end | |
local function parse_access(str) | |
return(reduce(function (a, b) | |
local n = number(a) | |
if is63(n) then | |
return({"at", b, n}) | |
else | |
return({"get", b, {"quote", a}}) | |
end | |
end, reverse(split(str, ".")))) | |
end | |
read_table[""] = function (s) | |
local str = "" | |
local dot63 = false | |
while true do | |
local c = peek_char(s) | |
if c and (not whitespace[c] and not delimiters[c]) then | |
if c == "." then | |
dot63 = true | |
end | |
str = str .. read_char(s) | |
else | |
break | |
end | |
end | |
if str == "true" then | |
return(true) | |
else | |
if str == "false" then | |
return(false) | |
else | |
if str == "nan" then | |
return(nan) | |
else | |
if str == "-nan" then | |
return(nan) | |
else | |
if str == "inf" then | |
return(inf) | |
else | |
if str == "-inf" then | |
return(-inf) | |
else | |
local n = maybe_number(str) | |
if real63(n) then | |
return(n) | |
else | |
if dot63 and valid_access63(str) then | |
return(parse_access(str)) | |
else | |
return(str) | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
read_table["("] = function (s) | |
read_char(s) | |
local r = nil | |
local l = {} | |
while nil63(r) do | |
skip_non_code(s) | |
local c = peek_char(s) | |
if c == ")" then | |
read_char(s) | |
r = l | |
else | |
if nil63(c) then | |
r = expected(s, ")") | |
else | |
local x = read(s) | |
if key63(x) then | |
local k = clip(x, 0, edge(x)) | |
local v = read(s) | |
l[k] = v | |
else | |
if flag63(x) then | |
l[clip(x, 1)] = true | |
else | |
add(l, x) | |
end | |
end | |
end | |
end | |
end | |
return(r) | |
end | |
read_table[")"] = function (s) | |
error("Unexpected ) at " .. s.pos) | |
end | |
read_table["\""] = function (s) | |
read_char(s) | |
local r = nil | |
local str = "\"" | |
while nil63(r) do | |
local c = peek_char(s) | |
if c == "\"" then | |
r = str .. read_char(s) | |
else | |
if nil63(c) then | |
r = expected(s, "\"") | |
else | |
if c == "\\" then | |
str = str .. read_char(s) | |
end | |
str = str .. read_char(s) | |
end | |
end | |
end | |
return(r) | |
end | |
read_table["|"] = function (s) | |
read_char(s) | |
local r = nil | |
local str = "|" | |
while nil63(r) do | |
local c = peek_char(s) | |
if c == "|" then | |
r = str .. read_char(s) | |
else | |
if nil63(c) then | |
r = expected(s, "|") | |
else | |
str = str .. read_char(s) | |
end | |
end | |
end | |
return(r) | |
end | |
read_table["'"] = function (s) | |
read_char(s) | |
return(wrap(s, "quote")) | |
end | |
read_table["`"] = function (s) | |
read_char(s) | |
return(wrap(s, "quasiquote")) | |
end | |
read_table[","] = function (s) | |
read_char(s) | |
if peek_char(s) == "@" then | |
read_char(s) | |
return(wrap(s, "unquote-splicing")) | |
else | |
return(wrap(s, "unquote")) | |
end | |
end | |
reader = ({["read-all"] = read_all, ["read-string"] = read_string, stream = stream, ["read-table"] = read_table, read = read}) | |
local function getenv(k, p) | |
if string63(k) then | |
local i = edge(environment) | |
while i >= 0 do | |
local b = environment[i + 1][k] | |
if is63(b) then | |
local _e9 | |
if p then | |
_e9 = b[p] | |
else | |
_e9 = b | |
end | |
return(_e9) | |
else | |
i = i - 1 | |
end | |
end | |
end | |
end | |
local function macro_function(k) | |
return(getenv(k, "macro")) | |
end | |
local function macro63(k) | |
return(is63(macro_function(k))) | |
end | |
local function special63(k) | |
return(is63(getenv(k, "special"))) | |
end | |
local function special_form63(form) | |
return(not atom63(form) and special63(hd(form))) | |
end | |
local function statement63(k) | |
return(special63(k) and getenv(k, "stmt")) | |
end | |
local function symbol_expansion(k) | |
return(getenv(k, "symbol")) | |
end | |
local function symbol63(k) | |
return(is63(symbol_expansion(k))) | |
end | |
local function variable63(k) | |
local b = first(function (frame) | |
return(frame[k]) | |
end, reverse(environment)) | |
return(not atom63(b) and is63(b.variable)) | |
end | |
function bound63(x) | |
return(macro63(x) or special63(x) or symbol63(x) or variable63(x)) | |
end | |
function quoted(form) | |
if string63(form) then | |
return(escape(form)) | |
else | |
if atom63(form) then | |
return(form) | |
else | |
return(join({"list"}, map(quoted, form))) | |
end | |
end | |
end | |
local function literal(s) | |
if string_literal63(s) then | |
return(s) | |
else | |
return(quoted(s)) | |
end | |
end | |
local _names = {} | |
function unique(x) | |
if _names[x] then | |
local i = _names[x] | |
_names[x] = _names[x] + 1 | |
return(unique(x .. i)) | |
else | |
_names[x] = 1 | |
return("_" .. x) | |
end | |
end | |
local function stash42(args) | |
if keys63(args) then | |
local l = {"%object", "\"_stash\"", true} | |
local _o = args | |
local k = nil | |
for k in next, _o do | |
local v = _o[k] | |
if not number63(k) then | |
add(l, literal(k)) | |
add(l, v) | |
end | |
end | |
return(join(args, {l})) | |
else | |
return(args) | |
end | |
end | |
local function bias(k) | |
if number63(k) and not( target == "lua") then | |
if target == "js" then | |
k = k - 1 | |
else | |
k = k + 1 | |
end | |
end | |
return(k) | |
end | |
function bind(lh, rh) | |
if atom63(lh) then | |
return({lh, rh}) | |
else | |
local id = unique("id") | |
local bs = {id, rh} | |
local _o1 = lh | |
local k = nil | |
for k in next, _o1 do | |
local v = _o1[k] | |
local _e10 | |
if k == "rest" then | |
_e10 = {"cut", id, _35(lh)} | |
else | |
_e10 = {"get", id, {"quote", bias(k)}} | |
end | |
local x = _e10 | |
if is63(k) then | |
local _e11 | |
if v == true then | |
_e11 = k | |
else | |
_e11 = v | |
end | |
local _k = _e11 | |
bs = join(bs, bind(_k, x)) | |
end | |
end | |
return(bs) | |
end | |
end | |
setenv("arguments%", {_stash = true, macro = function (from) | |
return({{"get", {"get", {"get", "Array", {"quote", "prototype"}}, {"quote", "slice"}}, {"quote", "call"}}, "arguments", from}) | |
end}) | |
function bind42(args, body) | |
local args1 = {} | |
local function rest() | |
if target == "js" then | |
return({"unstash", {"arguments%", _35(args1)}}) | |
else | |
add(args1, "|...|") | |
return({"unstash", {"list", "|...|"}}) | |
end | |
end | |
if atom63(args) then | |
return({args1, join({"let", {args, rest()}}, body)}) | |
else | |
local bs = {} | |
local r = unique("r") | |
local _o2 = args | |
local k = nil | |
for k in next, _o2 do | |
local v = _o2[k] | |
if number63(k) then | |
if atom63(v) then | |
add(args1, v) | |
else | |
local x = unique("x") | |
add(args1, x) | |
bs = join(bs, {v, x}) | |
end | |
end | |
end | |
if keys63(args) then | |
bs = join(bs, {r, rest()}) | |
local _e12 | |
if target == "lua" then | |
_e12 = edge(args1) | |
else | |
_e12 = _35(args1) | |
end | |
local n = _e12 | |
local i = 0 | |
while i < n do | |
local v = args1[i + 1] | |
bs = join(bs, {v, {"destash!", v, r}}) | |
i = i + 1 | |
end | |
bs = join(bs, {keys(args), r}) | |
end | |
return({args1, join({"let", bs}, body)}) | |
end | |
end | |
local function quoting63(depth) | |
return(number63(depth)) | |
end | |
local function quasiquoting63(depth) | |
return(quoting63(depth) and depth > 0) | |
end | |
local function can_unquote63(depth) | |
return(quoting63(depth) and depth == 1) | |
end | |
local function quasisplice63(x, depth) | |
return(can_unquote63(depth) and not atom63(x) and hd(x) == "unquote-splicing") | |
end | |
local function expand_local(_x36) | |
local _id = _x36 | |
local x = _id[1] | |
local name = _id[2] | |
local value = _id[3] | |
return({"%local", name, macroexpand(value)}) | |
end | |
local function expand_function(_x38) | |
local _id1 = _x38 | |
local x = _id1[1] | |
local args = _id1[2] | |
local body = cut(_id1, 2) | |
add(environment, {}) | |
local _o3 = args | |
local _i3 = nil | |
for _i3 in next, _o3 do | |
local _x39 = _o3[_i3] | |
setenv(_x39, {_stash = true, variable = true}) | |
end | |
local _x40 = join({"%function", args}, macroexpand(body)) | |
drop(environment) | |
return(_x40) | |
end | |
local function expand_definition(_x42) | |
local _id2 = _x42 | |
local x = _id2[1] | |
local name = _id2[2] | |
local args = _id2[3] | |
local body = cut(_id2, 3) | |
add(environment, {}) | |
local _o4 = args | |
local _i4 = nil | |
for _i4 in next, _o4 do | |
local _x43 = _o4[_i4] | |
setenv(_x43, {_stash = true, variable = true}) | |
end | |
local _x44 = join({x, name, args}, macroexpand(body)) | |
drop(environment) | |
return(_x44) | |
end | |
local function expand_macro(form) | |
return(macroexpand(expand1(form))) | |
end | |
function expand1(_x46) | |
local _id3 = _x46 | |
local name = _id3[1] | |
local body = cut(_id3, 1) | |
return(apply(macro_function(name), body)) | |
end | |
function macroexpand(form) | |
if symbol63(form) then | |
return(macroexpand(symbol_expansion(form))) | |
else | |
if atom63(form) then | |
return(form) | |
else | |
local x = hd(form) | |
if x == "%local" then | |
return(expand_local(form)) | |
else | |
if x == "%function" then | |
return(expand_function(form)) | |
else | |
if x == "%global-function" then | |
return(expand_definition(form)) | |
else | |
if x == "%local-function" then | |
return(expand_definition(form)) | |
else | |
if macro63(x) then | |
return(expand_macro(form)) | |
else | |
return(map(macroexpand, form)) | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
local function quasiquote_list(form, depth) | |
local xs = {{"list"}} | |
local _o5 = form | |
local k = nil | |
for k in next, _o5 do | |
local v = _o5[k] | |
if not number63(k) then | |
local _e13 | |
if quasisplice63(v, depth) then | |
_e13 = quasiexpand(v[2]) | |
else | |
_e13 = quasiexpand(v, depth) | |
end | |
local _v = _e13 | |
last(xs)[k] = _v | |
end | |
end | |
local _x49 = form | |
local _i6 = 0 | |
while _i6 < _35(_x49) do | |
local x = _x49[_i6 + 1] | |
if quasisplice63(x, depth) then | |
local _x50 = quasiexpand(x[2]) | |
add(xs, _x50) | |
add(xs, {"list"}) | |
else | |
add(last(xs), quasiexpand(x, depth)) | |
end | |
_i6 = _i6 + 1 | |
end | |
local pruned = keep(function (x) | |
return(_35(x) > 1 or not( hd(x) == "list") or keys63(x)) | |
end, xs) | |
if one63(pruned) then | |
return(hd(pruned)) | |
else | |
return(join({"join"}, pruned)) | |
end | |
end | |
function quasiexpand(form, depth) | |
if quasiquoting63(depth) then | |
if atom63(form) then | |
return({"quote", form}) | |
else | |
if can_unquote63(depth) and hd(form) == "unquote" then | |
return(quasiexpand(form[2])) | |
else | |
if hd(form) == "unquote" or hd(form) == "unquote-splicing" then | |
return(quasiquote_list(form, depth - 1)) | |
else | |
if hd(form) == "quasiquote" then | |
return(quasiquote_list(form, depth + 1)) | |
else | |
return(quasiquote_list(form, depth)) | |
end | |
end | |
end | |
end | |
else | |
if atom63(form) then | |
return(form) | |
else | |
if hd(form) == "quote" then | |
return(form) | |
else | |
if hd(form) == "quasiquote" then | |
return(quasiexpand(form[2], 1)) | |
else | |
return(map(function (x) | |
return(quasiexpand(x, depth)) | |
end, form)) | |
end | |
end | |
end | |
end | |
end | |
function expand_if(_x54) | |
local _id4 = _x54 | |
local a = _id4[1] | |
local b = _id4[2] | |
local c = cut(_id4, 2) | |
if is63(b) then | |
return({join({"%if", a, b}, expand_if(c))}) | |
else | |
if is63(a) then | |
return({a}) | |
end | |
end | |
end | |
indent_level = 0 | |
function indentation() | |
local s = "" | |
local i = 0 | |
while i < indent_level do | |
s = s .. " " | |
i = i + 1 | |
end | |
return(s) | |
end | |
local reserved = {["default"] = true, ["until"] = true, ["while"] = true, ["throw"] = true, ["not"] = true, ["nil"] = true, ["typeof"] = true, ["=="] = true, ["in"] = true, ["catch"] = true, ["delete"] = true, ["instanceof"] = true, ["%"] = true, ["or"] = true, ["return"] = true, ["try"] = true, ["debugger"] = true, [">"] = true, ["<"] = true, ["true"] = true, ["var"] = true, ["continue"] = true, ["then"] = true, ["for"] = true, ["finally"] = true, ["function"] = true, ["<="] = true, ["void"] = true, ["local"] = true, ["="] = true, ["false"] = true, ["with"] = true, ["break"] = true, ["-"] = true, ["end"] = true, ["/"] = true, ["and"] = true, ["new"] = true, ["switch"] = true, ["elseif"] = true, ["case"] = true, [">="] = true, ["+"] = true, ["*"] = true, ["do"] = true, ["repeat"] = true, ["else"] = true, ["if"] = true} | |
function reserved63(x) | |
return(reserved[x]) | |
end | |
local function valid_code63(n) | |
return(number_code63(n) or n > 64 and n < 91 or n > 96 and n < 123 or n == 95) | |
end | |
function valid_id63(id) | |
if none63(id) or reserved63(id) then | |
return(false) | |
else | |
local i = 0 | |
while i < _35(id) do | |
if not valid_code63(code(id, i)) then | |
return(false) | |
end | |
i = i + 1 | |
end | |
return(true) | |
end | |
end | |
function key(k) | |
local i = inner(k) | |
if valid_id63(i) then | |
return(i) | |
else | |
if target == "js" then | |
return(k) | |
else | |
return("[" .. k .. "]") | |
end | |
end | |
end | |
function mapo(f, t) | |
local o = {} | |
local _o6 = t | |
local k = nil | |
for k in next, _o6 do | |
local v = _o6[k] | |
local x = f(v) | |
if is63(x) then | |
add(o, literal(k)) | |
add(o, x) | |
end | |
end | |
return(o) | |
end | |
local __x59 = {} | |
local _x60 = {} | |
_x60.js = "!" | |
_x60.lua = "not" | |
__x59["not"] = _x60 | |
local __x61 = {} | |
__x61["/"] = true | |
__x61["*"] = true | |
__x61["%"] = true | |
local __x62 = {} | |
__x62["-"] = true | |
__x62["+"] = true | |
local __x63 = {} | |
local _x64 = {} | |
_x64.js = "+" | |
_x64.lua = ".." | |
__x63.cat = _x64 | |
local __x65 = {} | |
__x65["<"] = true | |
__x65[">"] = true | |
__x65[">="] = true | |
__x65["<="] = true | |
local __x66 = {} | |
local _x67 = {} | |
_x67.js = "===" | |
_x67.lua = "==" | |
__x66["="] = _x67 | |
local __x68 = {} | |
local _x69 = {} | |
_x69.js = "&&" | |
_x69.lua = "and" | |
__x68["and"] = _x69 | |
local __x70 = {} | |
local _x71 = {} | |
_x71.js = "||" | |
_x71.lua = "or" | |
__x70["or"] = _x71 | |
local infix = {__x59, __x61, __x62, __x63, __x65, __x66, __x68, __x70} | |
local function unary63(form) | |
return(two63(form) and in63(hd(form), {"not", "-"})) | |
end | |
local function index(k) | |
if number63(k) then | |
return(k - 1) | |
end | |
end | |
local function precedence(form) | |
if not( atom63(form) or unary63(form)) then | |
local _o7 = infix | |
local k = nil | |
for k in next, _o7 do | |
local v = _o7[k] | |
if v[hd(form)] then | |
return(index(k)) | |
end | |
end | |
end | |
return(0) | |
end | |
local function getop(op) | |
return(find(function (level) | |
local x = level[op] | |
if x == true then | |
return(op) | |
else | |
if is63(x) then | |
return(x[target]) | |
end | |
end | |
end, infix)) | |
end | |
local function infix63(x) | |
return(is63(getop(x))) | |
end | |
local function compile_args(args) | |
local s = "(" | |
local c = "" | |
local _x73 = args | |
local _i9 = 0 | |
while _i9 < _35(_x73) do | |
local x = _x73[_i9 + 1] | |
s = s .. c .. compile(x) | |
c = ", " | |
_i9 = _i9 + 1 | |
end | |
return(s .. ")") | |
end | |
local function escape_newlines(s) | |
local s1 = "" | |
local i = 0 | |
while i < _35(s) do | |
local c = char(s, i) | |
local _e14 | |
if c == "\n" then | |
_e14 = "\\n" | |
else | |
_e14 = c | |
end | |
s1 = s1 .. _e14 | |
i = i + 1 | |
end | |
return(s1) | |
end | |
local function id(id) | |
local _e15 | |
if number_code63(code(id, 0)) then | |
_e15 = "_" | |
else | |
_e15 = "" | |
end | |
local id1 = _e15 | |
local i = 0 | |
while i < _35(id) do | |
local c = char(id, i) | |
local n = code(c) | |
local _e16 | |
if c == "-" then | |
_e16 = "_" | |
else | |
local _e17 | |
if valid_code63(n) then | |
_e17 = c | |
else | |
local _e18 | |
if i == 0 then | |
_e18 = "_" .. n | |
else | |
_e18 = n | |
end | |
_e17 = _e18 | |
end | |
_e16 = _e17 | |
end | |
local c1 = _e16 | |
id1 = id1 .. c1 | |
i = i + 1 | |
end | |
if reserved63(id1) then | |
return("_" .. id1) | |
else | |
return(id1) | |
end | |
end | |
local function compile_atom(x) | |
if x == "nil" and target == "lua" then | |
return(x) | |
else | |
if x == "nil" then | |
return("undefined") | |
else | |
if id_literal63(x) then | |
return(inner(x)) | |
else | |
if string_literal63(x) then | |
return(escape_newlines(x)) | |
else | |
if string63(x) then | |
return(id(x)) | |
else | |
if boolean63(x) then | |
if x then | |
return("true") | |
else | |
return("false") | |
end | |
else | |
if nan63(x) then | |
return("nan") | |
else | |
if x == inf then | |
return("inf") | |
else | |
if x == -inf then | |
return("-inf") | |
else | |
if number63(x) then | |
return(x .. "") | |
else | |
error("Cannot compile atom: " .. str(x)) | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
local function terminator(stmt63) | |
if not stmt63 then | |
return("") | |
else | |
if target == "js" then | |
return(";\n") | |
else | |
return("\n") | |
end | |
end | |
end | |
local function compile_special(form, stmt63) | |
local _id5 = form | |
local x = _id5[1] | |
local args = cut(_id5, 1) | |
local _id6 = getenv(x) | |
local stmt = _id6.stmt | |
local self_tr63 = _id6.tr | |
local special = _id6.special | |
local tr = terminator(stmt63 and not self_tr63) | |
return(apply(special, args) .. tr) | |
end | |
local function parenthesize_call63(x) | |
return(not atom63(x) and hd(x) == "%function" or precedence(x) > 0) | |
end | |
local function compile_call(form) | |
local f = hd(form) | |
local f1 = compile(f) | |
local args = compile_args(stash42(tl(form))) | |
if parenthesize_call63(f) then | |
return("(" .. f1 .. ")" .. args) | |
else | |
return(f1 .. args) | |
end | |
end | |
local function op_delims(parent, child, ...) | |
local _r56 = unstash({...}) | |
local _parent = destash33(parent, _r56) | |
local _child = destash33(child, _r56) | |
local _id7 = _r56 | |
local right = _id7.right | |
local _e19 | |
if right then | |
_e19 = _6261 | |
else | |
_e19 = _62 | |
end | |
if _e19(precedence(_child), precedence(_parent)) then | |
return({"(", ")"}) | |
else | |
return({"", ""}) | |
end | |
end | |
local function compile_infix(form) | |
local _id8 = form | |
local op = _id8[1] | |
local _id9 = cut(_id8, 1) | |
local a = _id9[1] | |
local b = _id9[2] | |
local _id10 = op_delims(form, a) | |
local ao = _id10[1] | |
local ac = _id10[2] | |
local _id11 = op_delims(form, b, {_stash = true, right = true}) | |
local bo = _id11[1] | |
local bc = _id11[2] | |
local _a = compile(a) | |
local _b = compile(b) | |
local _op = getop(op) | |
if unary63(form) then | |
return(_op .. ao .. " " .. _a .. ac) | |
else | |
return(ao .. _a .. ac .. " " .. _op .. " " .. bo .. _b .. bc) | |
end | |
end | |
function compile_function(args, body, ...) | |
local _r58 = unstash({...}) | |
local _args = destash33(args, _r58) | |
local _body = destash33(body, _r58) | |
local _id12 = _r58 | |
local prefix = _id12.prefix | |
local name = _id12.name | |
local _e20 | |
if name then | |
_e20 = compile(name) | |
else | |
_e20 = "" | |
end | |
local _id13 = _e20 | |
local _args1 = compile_args(_args) | |
indent_level = indent_level + 1 | |
local _x78 = compile(_body, {_stash = true, stmt = true}) | |
indent_level = indent_level - 1 | |
local _body1 = _x78 | |
local ind = indentation() | |
local _e21 | |
if prefix then | |
_e21 = prefix .. " " | |
else | |
_e21 = "" | |
end | |
local p = _e21 | |
local _e22 | |
if target == "js" then | |
_e22 = "" | |
else | |
_e22 = "end" | |
end | |
local tr = _e22 | |
if name then | |
tr = tr .. "\n" | |
end | |
if target == "js" then | |
return("function " .. _id13 .. _args1 .. " {\n" .. _body1 .. ind .. "}" .. tr) | |
else | |
return(p .. "function " .. _id13 .. _args1 .. "\n" .. _body1 .. ind .. tr) | |
end | |
end | |
local function can_return63(form) | |
return(is63(form) and (atom63(form) or not( hd(form) == "return") and not statement63(hd(form)))) | |
end | |
function compile(form, ...) | |
local _r60 = unstash({...}) | |
local _form = destash33(form, _r60) | |
local _id14 = _r60 | |
local stmt = _id14.stmt | |
if nil63(_form) then | |
return("") | |
else | |
if special_form63(_form) then | |
return(compile_special(_form, stmt)) | |
else | |
local tr = terminator(stmt) | |
local _e23 | |
if stmt then | |
_e23 = indentation() | |
else | |
_e23 = "" | |
end | |
local ind = _e23 | |
local _e24 | |
if atom63(_form) then | |
_e24 = compile_atom(_form) | |
else | |
local _e25 | |
if infix63(hd(_form)) then | |
_e25 = compile_infix(_form) | |
else | |
_e25 = compile_call(_form) | |
end | |
_e24 = _e25 | |
end | |
local _form1 = _e24 | |
return(ind .. _form1 .. tr) | |
end | |
end | |
end | |
local function lower_statement(form, tail63) | |
local hoist = {} | |
local e = lower(form, hoist, true, tail63) | |
if some63(hoist) and is63(e) then | |
return(join({"do"}, hoist, {e})) | |
else | |
if is63(e) then | |
return(e) | |
else | |
if _35(hoist) > 1 then | |
return(join({"do"}, hoist)) | |
else | |
return(hd(hoist)) | |
end | |
end | |
end | |
end | |
local function lower_body(body, tail63) | |
return(lower_statement(join({"do"}, body), tail63)) | |
end | |
local function literal63(form) | |
return(atom63(form) or hd(form) == "%array" or hd(form) == "%object") | |
end | |
local function standalone63(form) | |
return(not atom63(form) and not infix63(hd(form)) and not literal63(form) and not( "get" == hd(form)) or id_literal63(form)) | |
end | |
local function lower_do(args, hoist, stmt63, tail63) | |
local _x84 = almost(args) | |
local _i10 = 0 | |
while _i10 < _35(_x84) do | |
local x = _x84[_i10 + 1] | |
local _y = lower(x, hoist, stmt63) | |
if yes(_y) then | |
local e = _y | |
if standalone63(e) then | |
add(hoist, e) | |
end | |
end | |
_i10 = _i10 + 1 | |
end | |
local e = lower(last(args), hoist, stmt63, tail63) | |
if tail63 and can_return63(e) then | |
return({"return", e}) | |
else | |
return(e) | |
end | |
end | |
local function lower_set(args, hoist, stmt63, tail63) | |
local _id15 = args | |
local lh = _id15[1] | |
local rh = _id15[2] | |
add(hoist, {"%set", lh, lower(rh, hoist)}) | |
if not( stmt63 and not tail63) then | |
return(lh) | |
end | |
end | |
local function lower_if(args, hoist, stmt63, tail63) | |
local _id16 = args | |
local cond = _id16[1] | |
local _then = _id16[2] | |
local _else = _id16[3] | |
if stmt63 then | |
local _e27 | |
if is63(_else) then | |
_e27 = {lower_body({_else}, tail63)} | |
end | |
return(add(hoist, join({"%if", lower(cond, hoist), lower_body({_then}, tail63)}, _e27))) | |
else | |
local e = unique("e") | |
add(hoist, {"%local", e}) | |
local _e26 | |
if is63(_else) then | |
_e26 = {lower({"%set", e, _else})} | |
end | |
add(hoist, join({"%if", lower(cond, hoist), lower({"%set", e, _then})}, _e26)) | |
return(e) | |
end | |
end | |
local function lower_short(x, args, hoist) | |
local _id17 = args | |
local a = _id17[1] | |
local b = _id17[2] | |
local hoist1 = {} | |
local b1 = lower(b, hoist1) | |
if some63(hoist1) then | |
local _id18 = unique("id") | |
local _e28 | |
if x == "and" then | |
_e28 = {"%if", _id18, b, _id18} | |
else | |
_e28 = {"%if", _id18, _id18, b} | |
end | |
return(lower({"do", {"%local", _id18, a}, _e28}, hoist)) | |
else | |
return({x, lower(a, hoist), b1}) | |
end | |
end | |
local function lower_try(args, hoist, tail63) | |
return(add(hoist, {"%try", lower_body(args, tail63)})) | |
end | |
local function lower_while(args, hoist) | |
local _id19 = args | |
local c = _id19[1] | |
local body = cut(_id19, 1) | |
local pre = {} | |
local _c = lower(c, pre) | |
local _e29 | |
if none63(pre) then | |
_e29 = {"while", _c, lower_body(body)} | |
else | |
_e29 = {"while", true, join({"do"}, pre, {{"%if", {"not", _c}, {"break"}}, lower_body(body)})} | |
end | |
return(add(hoist, _e29)) | |
end | |
local function lower_for(args, hoist) | |
local _id20 = args | |
local t = _id20[1] | |
local k = _id20[2] | |
local body = cut(_id20, 2) | |
return(add(hoist, {"%for", lower(t, hoist), k, lower_body(body)})) | |
end | |
local function lower_function(args) | |
local _id21 = args | |
local a = _id21[1] | |
local body = cut(_id21, 1) | |
return({"%function", a, lower_body(body, true)}) | |
end | |
local function lower_definition(kind, args, hoist) | |
local _id22 = args | |
local name = _id22[1] | |
local _args2 = _id22[2] | |
local body = cut(_id22, 2) | |
return(add(hoist, {kind, name, _args2, lower_body(body, true)})) | |
end | |
local function lower_call(form, hoist) | |
local _form2 = map(function (x) | |
return(lower(x, hoist)) | |
end, form) | |
if some63(_form2) then | |
return(_form2) | |
end | |
end | |
local function lower_infix63(form) | |
return(infix63(hd(form)) and _35(form) > 3) | |
end | |
local function lower_infix(form, hoist) | |
local _id23 = form | |
local x = _id23[1] | |
local args = cut(_id23, 1) | |
return(lower(reduce(function (a, b) | |
return({x, b, a}) | |
end, reverse(args)), hoist)) | |
end | |
local function lower_special(form, hoist) | |
local e = lower_call(form, hoist) | |
if e then | |
return(add(hoist, e)) | |
end | |
end | |
function lower(form, hoist, stmt63, tail63) | |
if atom63(form) then | |
return(form) | |
else | |
if empty63(form) then | |
return({"%array"}) | |
else | |
if nil63(hoist) then | |
return(lower_statement(form)) | |
else | |
if lower_infix63(form) then | |
return(lower_infix(form, hoist)) | |
else | |
local _id24 = form | |
local x = _id24[1] | |
local args = cut(_id24, 1) | |
if x == "do" then | |
return(lower_do(args, hoist, stmt63, tail63)) | |
else | |
if x == "%set" then | |
return(lower_set(args, hoist, stmt63, tail63)) | |
else | |
if x == "%if" then | |
return(lower_if(args, hoist, stmt63, tail63)) | |
else | |
if x == "%try" then | |
return(lower_try(args, hoist, tail63)) | |
else | |
if x == "while" then | |
return(lower_while(args, hoist)) | |
else | |
if x == "%for" then | |
return(lower_for(args, hoist)) | |
else | |
if x == "%function" then | |
return(lower_function(args)) | |
else | |
if x == "%local-function" or x == "%global-function" then | |
return(lower_definition(x, args, hoist)) | |
else | |
if in63(x, {"and", "or"}) then | |
return(lower_short(x, args, hoist)) | |
else | |
if statement63(x) then | |
return(lower_special(form, hoist)) | |
else | |
return(lower_call(form, hoist)) | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
function expand(form) | |
return(lower(macroexpand(form))) | |
end | |
local load1 = loadstring or load | |
local function run(code) | |
local f,e = load1(code) | |
if f then | |
return(f()) | |
else | |
error(e .. " in " .. code) | |
end | |
end | |
_37result = nil | |
function eval(form) | |
local previous = target | |
target = "lua" | |
local code = compile(expand({"set", "%result", form})) | |
target = previous | |
run(code) | |
return(_37result) | |
end | |
setenv("do", {_stash = true, stmt = true, tr = true, special = function (...) | |
local forms = unstash({...}) | |
local s = "" | |
local _x119 = forms | |
local _i12 = 0 | |
while _i12 < _35(_x119) do | |
local x = _x119[_i12 + 1] | |
s = s .. compile(x, {_stash = true, stmt = true}) | |
if not atom63(x) then | |
if hd(x) == "return" or hd(x) == "break" then | |
break | |
end | |
end | |
_i12 = _i12 + 1 | |
end | |
return(s) | |
end}) | |
setenv("%if", {_stash = true, stmt = true, tr = true, special = function (cond, cons, alt) | |
local _cond1 = compile(cond) | |
indent_level = indent_level + 1 | |
local _x122 = compile(cons, {_stash = true, stmt = true}) | |
indent_level = indent_level - 1 | |
local _cons1 = _x122 | |
local _e30 | |
if alt then | |
indent_level = indent_level + 1 | |
local _x123 = compile(alt, {_stash = true, stmt = true}) | |
indent_level = indent_level - 1 | |
_e30 = _x123 | |
end | |
local _alt1 = _e30 | |
local ind = indentation() | |
local s = "" | |
if target == "js" then | |
s = s .. ind .. "if (" .. _cond1 .. ") {\n" .. _cons1 .. ind .. "}" | |
else | |
s = s .. ind .. "if " .. _cond1 .. " then\n" .. _cons1 | |
end | |
if _alt1 and target == "js" then | |
s = s .. " else {\n" .. _alt1 .. ind .. "}" | |
else | |
if _alt1 then | |
s = s .. ind .. "else\n" .. _alt1 | |
end | |
end | |
if target == "lua" then | |
return(s .. ind .. "end\n") | |
else | |
return(s .. "\n") | |
end | |
end}) | |
setenv("while", {_stash = true, stmt = true, tr = true, special = function (cond, form) | |
local _cond3 = compile(cond) | |
indent_level = indent_level + 1 | |
local _x125 = compile(form, {_stash = true, stmt = true}) | |
indent_level = indent_level - 1 | |
local body = _x125 | |
local ind = indentation() | |
if target == "js" then | |
return(ind .. "while (" .. _cond3 .. ") {\n" .. body .. ind .. "}\n") | |
else | |
return(ind .. "while " .. _cond3 .. " do\n" .. body .. ind .. "end\n") | |
end | |
end}) | |
setenv("%for", {_stash = true, stmt = true, tr = true, special = function (t, k, form) | |
local _t1 = compile(t) | |
local ind = indentation() | |
indent_level = indent_level + 1 | |
local _x127 = compile(form, {_stash = true, stmt = true}) | |
indent_level = indent_level - 1 | |
local body = _x127 | |
if target == "lua" then | |
return(ind .. "for " .. k .. " in next, " .. _t1 .. " do\n" .. body .. ind .. "end\n") | |
else | |
return(ind .. "for (" .. k .. " in " .. _t1 .. ") {\n" .. body .. ind .. "}\n") | |
end | |
end}) | |
setenv("%try", {_stash = true, stmt = true, tr = true, special = function (form) | |
local e = unique("e") | |
local ind = indentation() | |
indent_level = indent_level + 1 | |
local _x132 = compile(form, {_stash = true, stmt = true}) | |
indent_level = indent_level - 1 | |
local body = _x132 | |
local hf = {"return", {"%array", false, e}} | |
indent_level = indent_level + 1 | |
local _x135 = compile(hf, {_stash = true, stmt = true}) | |
indent_level = indent_level - 1 | |
local h = _x135 | |
return(ind .. "try {\n" .. body .. ind .. "}\n" .. ind .. "catch (" .. e .. ") {\n" .. h .. ind .. "}\n") | |
end}) | |
setenv("%delete", {_stash = true, special = function (place) | |
return(indentation() .. "delete " .. compile(place)) | |
end, stmt = true}) | |
setenv("break", {_stash = true, special = function () | |
return(indentation() .. "break") | |
end, stmt = true}) | |
setenv("%function", {_stash = true, special = function (args, body) | |
return(compile_function(args, body)) | |
end}) | |
setenv("%global-function", {_stash = true, stmt = true, tr = true, special = function (name, args, body) | |
if target == "lua" then | |
local x = compile_function(args, body, {_stash = true, name = name}) | |
return(indentation() .. x) | |
else | |
return(compile({"%set", name, {"%function", args, body}}, {_stash = true, stmt = true})) | |
end | |
end}) | |
setenv("%local-function", {_stash = true, stmt = true, tr = true, special = function (name, args, body) | |
if target == "lua" then | |
local x = compile_function(args, body, {_stash = true, prefix = "local", name = name}) | |
return(indentation() .. x) | |
else | |
return(compile({"%local", name, {"%function", args, body}}, {_stash = true, stmt = true})) | |
end | |
end}) | |
setenv("return", {_stash = true, special = function (x) | |
local _e31 | |
if nil63(x) then | |
_e31 = "return" | |
else | |
_e31 = "return(" .. compile(x) .. ")" | |
end | |
local _x145 = _e31 | |
return(indentation() .. _x145) | |
end, stmt = true}) | |
setenv("new", {_stash = true, special = function (x) | |
return("new " .. compile(x)) | |
end}) | |
setenv("typeof", {_stash = true, special = function (x) | |
return("typeof(" .. compile(x) .. ")") | |
end}) | |
setenv("error", {_stash = true, special = function (x) | |
local _e32 | |
if target == "js" then | |
_e32 = "throw " .. compile({"new", {"Error", x}}) | |
else | |
_e32 = "error(" .. compile(x) .. ")" | |
end | |
local e = _e32 | |
return(indentation() .. e) | |
end, stmt = true}) | |
setenv("%local", {_stash = true, special = function (name, value) | |
local _id26 = compile(name) | |
local value1 = compile(value) | |
local _e33 | |
if is63(value) then | |
_e33 = " = " .. value1 | |
else | |
_e33 = "" | |
end | |
local rh = _e33 | |
local _e34 | |
if target == "js" then | |
_e34 = "var " | |
else | |
_e34 = "local " | |
end | |
local keyword = _e34 | |
local ind = indentation() | |
return(ind .. keyword .. _id26 .. rh) | |
end, stmt = true}) | |
setenv("%set", {_stash = true, special = function (lh, rh) | |
local _lh1 = compile(lh) | |
local _e35 | |
if nil63(rh) then | |
_e35 = "nil" | |
else | |
_e35 = rh | |
end | |
local _rh1 = compile(_e35) | |
return(indentation() .. _lh1 .. " = " .. _rh1) | |
end, stmt = true}) | |
setenv("get", {_stash = true, special = function (t, k) | |
local _t3 = compile(t) | |
local k1 = compile(k) | |
if target == "lua" and char(_t3, 0) == "{" then | |
_t3 = "(" .. _t3 .. ")" | |
end | |
if string_literal63(k) and valid_id63(inner(k)) then | |
return(_t3 .. "." .. inner(k)) | |
else | |
return(_t3 .. "[" .. k1 .. "]") | |
end | |
end}) | |
setenv("%array", {_stash = true, special = function (...) | |
local forms = unstash({...}) | |
local _e36 | |
if target == "lua" then | |
_e36 = "{" | |
else | |
_e36 = "[" | |
end | |
local open = _e36 | |
local _e37 | |
if target == "lua" then | |
_e37 = "}" | |
else | |
_e37 = "]" | |
end | |
local close = _e37 | |
local s = "" | |
local c = "" | |
local _o9 = forms | |
local k = nil | |
for k in next, _o9 do | |
local v = _o9[k] | |
if number63(k) then | |
s = s .. c .. compile(v) | |
c = ", " | |
end | |
end | |
return(open .. s .. close) | |
end}) | |
setenv("%object", {_stash = true, special = function (...) | |
local forms = unstash({...}) | |
local s = "{" | |
local c = "" | |
local _e38 | |
if target == "lua" then | |
_e38 = " = " | |
else | |
_e38 = ": " | |
end | |
local sep = _e38 | |
local _o11 = pair(forms) | |
local k = nil | |
for k in next, _o11 do | |
local v = _o11[k] | |
if number63(k) then | |
local _id28 = v | |
local _k2 = _id28[1] | |
local _v2 = _id28[2] | |
if not string63(_k2) then | |
error("Illegal key: " .. str(_k2)) | |
end | |
s = s .. c .. key(_k2) .. sep .. compile(_v2) | |
c = ", " | |
end | |
end | |
return(s .. "}") | |
end}) | |
compiler = ({run = run, eval = eval, expand = expand, compile = compile}) | |
function str2(x, stack) | |
if nil63(x) then | |
return("nil") | |
else | |
if nan63(x) then | |
return("nan") | |
else | |
if x == inf then | |
return("inf") | |
else | |
if x == -inf then | |
return("-inf") | |
else | |
if boolean63(x) then | |
if x then | |
return("true") | |
else | |
return("false") | |
end | |
else | |
if string63(x) then | |
return(escape(x)) | |
else | |
if atom63(x) then | |
return(tostring(x)) | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
end | |
function encode(str) | |
local html = function(s) | |
return ('&#%02d;'):format(s:byte()) | |
end | |
return str:gsub('([<>&\'"])', html) | |
end | |
function prn(str) | |
print(apply(cat, map(function (line) | |
return "<pre>" .. encode(line) .. "</pre>" | |
end, split(str, "\n")))) | |
end | |
function rep(x) | |
print(str(eval(read_string("(do " .. x .. ")")))) | |
end | |
rep("(((fn (x) (fn (y) (+ x y 1 2 3 4))) 5) 6)") | |
function comp(code) | |
return compile(expand(read_string("(do " .. code .. ")"))) | |
end | |
lisp = [[ | |
(define adder (n) | |
(fn (y) | |
(+ n y))) | |
(define 1+ (adder 1)) | |
(print (1+ 41)) ; prints 42 | |
]] | |
rep(lisp) | |
-- compile to Lua. | |
prn(comp(lisp)) | |
-- let's compile the runtime to Lua. | |
runtime = [[ | |
(define-global environment (list (obj))) | |
(define-global target (language)) | |
(define-global nil? (x) | |
(target | |
js: (or (= x nil) (= x null)) | |
lua: (= x nil))) | |
(define-global is? (x) (not (nil? x))) | |
(define-global no (x) (or (nil? x) (= x false))) | |
(define-global yes (x) (not (no x))) | |
(define-global # (x) | |
(target js: (or (get x 'length) 0) lua: |#x|)) | |
(define-global none? (x) (= (# x) 0)) | |
(define-global some? (x) (> (# x) 0)) | |
(define-global one? (x) (= (# x) 1)) | |
(define-global two? (x) (= (# x) 2)) | |
(define-global hd (l) (at l 0)) | |
(target js: (define-global type (x) (typeof x))) | |
(define-global string? (x) (= (type x) 'string)) | |
(define-global number? (x) (= (type x) 'number)) | |
(define-global boolean? (x) (= (type x) 'boolean)) | |
(define-global function? (x) (= (type x) 'function)) | |
(define-global obj? (x) | |
(and (is? x) | |
(= (type x) (target lua: 'table js: 'object)))) | |
(define-global atom? (x) | |
(or (nil? x) (string? x) (number? x) (boolean? x))) | |
(define-global nan (/ 0 0)) | |
(define-global inf (/ 1 0)) | |
(define-global nan? (n) | |
(not (= n n))) | |
(define-global inf? (n) | |
(or (= n inf) (= n -inf))) | |
(define-global clip (s from upto) | |
(target js: ((get s 'substring) from upto) | |
lua: ((get string 'sub) s (+ from 1) upto))) | |
(define-global cut (x from upto) | |
(with l () | |
(let (j 0 | |
i (if (or (nil? from) (< from 0)) 0 from) | |
n (# x) | |
upto (if (or (nil? upto) (> upto n)) n upto)) | |
(while (< i upto) | |
(set (at l j) (at x i)) | |
(inc i) | |
(inc j)) | |
(each (k v) x | |
(unless (number? k) | |
(set (get l k) v)))))) | |
(define-global keys (x) | |
(with t () | |
(each (k v) x | |
(unless (number? k) | |
(set (get t k) v))))) | |
(define-global edge (x) | |
(- (# x) 1)) | |
(define-global inner (x) | |
(clip x 1 (edge x))) | |
(define-global tl (l) (cut l 1)) | |
(define-global char (s n) | |
(target js: ((get s 'charAt) n) lua: (clip s n (+ n 1)))) | |
(define-global code (s n) | |
(target | |
js: ((get s 'charCodeAt) n) | |
lua: ((get string 'byte) s (if n (+ n 1))))) | |
(define-global string-literal? (x) | |
(and (string? x) (= (char x 0) "\""))) | |
(define-global id-literal? (x) | |
(and (string? x) (= (char x 0) "|"))) | |
(define-global add (l x) | |
(target js: (do ((get l 'push) x) nil) | |
lua: ((get table 'insert) l x))) | |
(define-global drop (l) | |
(target js: ((get l 'pop)) | |
lua: ((get table 'remove) l))) | |
(define-global last (l) | |
(at l (edge l))) | |
(define-global almost (l) | |
(cut l 0 (edge l))) | |
(define-global reverse (l) | |
(with l1 (keys l) | |
(let i (edge l) | |
(while (>= i 0) | |
(add l1 (at l i)) | |
(dec i))))) | |
(define-global reduce (f x) | |
(if (none? x) nil | |
(one? x) (hd x) | |
(f (hd x) (reduce f (tl x))))) | |
(define-global join ls | |
(with r () | |
(step l ls | |
(when l | |
(let n (# r) | |
(each (k v) l | |
(if (number? k) (inc k n)) | |
(set (get r k) v))))))) | |
(define-global find (f t) | |
(each x t | |
(let y (f x) | |
(if y (return y))))) | |
(define-global first (f l) | |
(step x l | |
(let y (f x) | |
(if y (return y))))) | |
(define-global in? (x t) | |
(find (fn (y) (= x y)) t)) | |
(define-global pair (l) | |
(with l1 () | |
(for i (# l) | |
(add l1 (list (at l i) (at l (+ i 1)))) | |
(inc i)))) | |
(define-global sort (l f) | |
(target | |
lua: (do ((get table 'sort) l f) l) | |
js: ((get l 'sort) (when f (fn (a b) (if (f a b) -1 1)))))) | |
(define-global map (f x) | |
(with t () | |
(step v x | |
(let y (f v) | |
(if (is? y) | |
(add t y)))) | |
(each (k v) x | |
(unless (number? k) | |
(let y (f v) | |
(when (is? y) | |
(set (get t k) y))))))) | |
(define-global keep (f x) | |
(map (fn (v) (when (yes (f v)) v)) x)) | |
(define-global keys? (t) | |
(each (k v) t | |
(unless (number? k) | |
(return true))) | |
false) | |
(define-global empty? (t) | |
(each x t | |
(return false)) | |
true) | |
(define-global stash (args) | |
(when (keys? args) | |
(let p () | |
(each (k v) args | |
(unless (number? k) | |
(set (get p k) v))) | |
(set (get p '_stash) true) | |
(add args p))) | |
args) | |
(define-global unstash (args) | |
(if (none? args) () | |
(let l (last args) | |
(if (and (obj? l) (get l '_stash)) | |
(with args1 (almost args) | |
(each (k v) l | |
(unless (= k '_stash) | |
(set (get args1 k) v)))) | |
args)))) | |
(define-global destash! (l args1) | |
(if (and (obj? l) (get l '_stash)) | |
(each (k v) l | |
(unless (= k '_stash) | |
(set (get args1 k) v))) | |
l)) | |
(define-global search (s pattern start) | |
(target | |
js: (let i ((get s 'indexOf) pattern start) | |
(if (>= i 0) i)) | |
lua: (let (start (if start (+ start 1)) | |
i ((get string 'find) s pattern start true)) | |
(and i (- i 1))))) | |
(define-global split (s sep) | |
(if (or (= s "") (= sep "")) () | |
(with l () | |
(let n (# sep) | |
(while true | |
(let i (search s sep) | |
(if (nil? i) (break) | |
(do (add l (clip s 0 i)) | |
(set s (clip s (+ i n))))))) | |
(add l s))))) | |
(define-global cat xs | |
(or (reduce (fn (a b) (cat a b)) xs) "")) | |
(define-global + xs | |
(or (reduce (fn (a b) (+ a b)) xs) 0)) | |
(define-global - xs | |
(or (reduce (fn (b a) (- a b)) (reverse xs)) 0)) | |
(define-global * xs | |
(or (reduce (fn (a b) (* a b)) xs) 1)) | |
(define-global / xs | |
(or (reduce (fn (b a) (/ a b)) (reverse xs)) 1)) | |
(define-global % xs | |
(or (reduce (fn (b a) (% a b)) (reverse xs)) 0)) | |
(define-global > (a b) (> a b)) | |
(define-global < (a b) (< a b)) | |
(define-global = (a b) (= a b)) | |
(define-global >= (a b) (>= a b)) | |
(define-global <= (a b) (<= a b)) | |
(define-global number (s) | |
(target | |
js: (let n (parseFloat s) | |
(unless (isNaN n) n)) | |
lua: (tonumber s))) | |
(define-global number-code? (n) | |
(and (> n 47) (< n 58))) | |
(define-global numeric? (s) | |
(let n (# s) | |
(for i n | |
(unless (number-code? (code s i)) | |
(return false)))) | |
true) | |
(target js: (define tostring (x) ((get x 'toString)))) | |
(define-global escape (s) | |
(let s1 "\"" | |
(for i (# s) | |
(let (c (char s i) | |
c1 (if (= c "\n") "\\n" | |
(= c "\"") "\\\"" | |
(= c "\\") "\\\\" | |
c)) | |
(cat! s1 c1))) | |
(cat s1 "\""))) | |
(define-global str (x stack) | |
(if (nil? x) "nil" | |
(nan? x) "nan" | |
(= x inf) "inf" | |
(= x -inf) "-inf" | |
(boolean? x) (if x "true" "false") | |
(string? x) (escape x) | |
(atom? x) (tostring x) | |
(function? x) "function" | |
(and stack (in? x stack)) "circular" | |
(target js: false lua: (not (= (type x) 'table))) | |
(escape (tostring x)) | |
(let (s "(" sp "" | |
xs () ks () | |
l (or stack ())) | |
(add l x) | |
(each (k v) x | |
(if (number? k) | |
(set (get xs k) (str v l)) | |
(do (add ks (cat k ":")) | |
(add ks (str v l))))) | |
(drop l) | |
(each v (join xs ks) | |
(cat! s sp v) | |
(set sp " ")) | |
(cat s ")")))) | |
(target lua: | |
(define values (or unpack (get table 'unpack)))) | |
(define-global apply (f args) | |
(let args (stash args) | |
(target js: ((get f 'apply) f args) | |
lua: (f (values args))))) | |
(define-global call (f) (f)) | |
(define-global toplevel? () | |
(one? environment)) | |
(define-global setenv (k rest: keys) | |
(when (string? k) | |
(let (frame (if (get keys 'toplevel) | |
(hd environment) | |
(last environment)) | |
entry (or (get frame k) (obj))) | |
(each (k v) keys | |
(set (get entry k) v)) | |
(set (get frame k) entry)))) | |
(target js: | |
(define-global print (x) | |
((get console 'log) x))) | |
(define math (target js: Math lua: math)) | |
(define-global abs (get math 'abs)) | |
(define-global acos (get math 'acos)) | |
(define-global asin (get math 'asin)) | |
(define-global atan (get math 'atan)) | |
(define-global atan2 (get math 'atan2)) | |
(define-global ceil (get math 'ceil)) | |
(define-global cos (get math 'cos)) | |
(define-global floor (get math 'floor)) | |
(define-global log (get math 'log)) | |
(define-global log10 (get math 'log10)) | |
(define-global max (get math 'max)) | |
(define-global min (get math 'min)) | |
(define-global pow (get math 'pow)) | |
(define-global random (get math 'random)) | |
(define-global sin (get math 'sin)) | |
(define-global sinh (get math 'sinh)) | |
(define-global sqrt (get math 'sqrt)) | |
(define-global tan (get math 'tan)) | |
(define-global tanh (get math 'tanh)) | |
(define-global trunc (get math 'floor)) | |
]] | |
prn(comp(runtime)) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment