diff --git a/bin/compiler.R b/bin/compiler.R new file mode 100644 index 0000000..dbbd937 --- /dev/null +++ b/bin/compiler.R @@ -0,0 +1,1516 @@ +getenv <- function (k, p, env) { + V__env <- env || get_environment() + if (string63(k)) { + V__i <- edge(V__env) + while (V__i >= 0) { + V__b <- V__env[[V__i + 1]][[k]] + if (is63(V__b)) { + V__e29 + if (p) { + V__e29 <- V__b[[p]] + } else { + V__e29 <- V__b + } + return V__e29 + } else { + V__i <- V__i - 1 + } + } + } +} +macro_function <- function (k) { + getenv(k, "macro") +} +macro63 <- function (k) { + is63(macro_function(k)) +} +special63 <- function (k) { + is63(getenv(k, "special")) +} +special_form63 <- function (form) { + ! atom63(form) && special63(hd(form)) +} +statement63 <- function (k) { + special63(k) && getenv(k, "stmt") +} +symbol_expansion <- function (k) { + getenv(k, "symbol") +} +symbol63 <- function (k) { + is63(symbol_expansion(k)) +} +variable63 <- function (k) { + is63(getenv(k, "variable")) +} +bound63 <- function (x) { + macro63(x) || special63(x) || symbol63(x) || variable63(x) +} +quoted <- function (form) { + if (string63(form)) { + escape(form) + } else { + if (atom63(form)) { + form + } else { + join(list("list"), map(quoted, form)) + } + } +} +literal <- function (s) { + if (string_literal63(s)) { + s + } else { + quoted(s) + } +} +stash42 <- function (args) { + if (keys63(args)) { + V__l <- list("%stash") + V__V__o <- args + V__k <- NULL + for (V__k in indices(V__V__o)) { + V__v <- V__V__o[[V__k]] + if (! number63(V__k)) { + add(V__l, list(literal(V__k), V__v)) + } + } + join(args, list(V__l)) + } else { + args + } +} +bias <- function (k) { + if (number63(k) && !( target == "r")) { + if (target == "js") { + k <- k - 1 + } else { + k <- k + 1 + } + } + k +} +bind <- function (lh, rh) { + if (atom63(lh)) { + list(lh, rh) + } else { + V__id <- unique("id") + V__bs <- list(V__id, rh) + V__V__o1 <- lh + V__k1 <- NULL + for (V__k1 in indices(V__V__o1)) { + V__v1 <- V__V__o1[[V__k1]] + V__e30 + if (V__k1 == "rest") { + V__e30 <- list("cut", V__id, V_35(lh)) + } else { + V__e30 <- list("get", V__id, list("quote", bias(V__k1))) + } + V__x <- V__e30 + if (is63(V__k1)) { + V__e31 + if (V__v1 == TRUE) { + V__e31 <- V__k1 + } else { + V__e31 <- V__v1 + } + V__k2 <- V__e31 + V__bs <- join(V__bs, bind(V__k2, V__x)) + } + } + V__bs + } +} +setenv("arguments%", + macro = function (from) { + list(list("get", list("get", list("get", "Array", list("quote", "prototype")), list("quote", "slice")), list("quote", "call")), "arguments", from) + }) +bind42 <- function (args, body) { + V__args1 <- list() + rest <- function () { + V__args1[["rest"]] <<- TRUE + if (target == "js") { + list("unstash", list("arguments%", V_35(V__args1))) + } else { + if (target == "r") { + list("list", "|...|") + } else { + list("unstash", list("list", "|...|")) + } + } + } + if (atom63(args)) { + list(V__args1, join(list("let", list(args, rest())), body)) + } else { + V__bs1 <- list() + V__r19 <- unique("r") + V__V__o2 <- args + V__k3 <- NULL + for (V__k3 in indices(V__V__o2)) { + V__v2 <- V__V__o2[[V__k3]] + if (number63(V__k3)) { + if (atom63(V__v2)) { + add(V__args1, V__v2) + } else { + V__x8 <- unique("x") + add(V__args1, V__x8) + V__bs1 <- join(V__bs1, list(V__v2, V__x8)) + } + } + } + if (keys63(args)) { + V__bs1 <- join(V__bs1, list(V__r19, rest())) + if (!( target == "r")) { + V__n3 <- V_35(V__args1) + V__i4 <- 0 + while (V__i4 < V__n3) { + V__v3 <- V__args1[[V__i4 + 1]] + V__bs1 <- join(V__bs1, list(V__v3, list("destash!", V__v3, V__r19))) + V__i4 <- V__i4 + 1 + } + } + V__bs1 <- join(V__bs1, list(keys(args), V__r19)) + } + list(V__args1, join(list("let", V__bs1), body)) + } +} +quoting63 <- function (depth) { + number63(depth) +} +quasiquoting63 <- function (depth) { + quoting63(depth) && depth > 0 +} +can_unquote63 <- function (depth) { + quoting63(depth) && depth == 1 +} +quasisplice63 <- function (x, depth) { + can_unquote63(depth) && ! atom63(x) && hd(x) == "unquote-splicing" +} +expand_local <- function (V__x9) { + V__V__id1 <- V__x9 + V__x10 <- V__V__id1[[1]] + V__name <- V__V__id1[[2]] + V__value <- V__V__id1[[3]] + setenv(V__name, + variable = TRUE) + list("%local", V__name, macroexpand(V__value)) +} +expand_function <- function (V__x11) { + V__V__id2 <- V__x11 + V__x12 <- V__V__id2[[1]] + V__args <- V__V__id2[[2]] + V__body <- cut(V__V__id2, 2) + add(get_environment(), list()) + V__V__o3 <- V__args + V__V__i5 <- NULL + for (V__V__i5 in indices(V__V__o3)) { + V__V__x13 <- V__V__o3[[V__V__i5]] + setenv(V__V__x13, + variable = TRUE) + } + V__V__x14 <- join(list("%function", V__args), macroexpand(V__body)) + drop(get_environment()) + V__V__x14 +} +expand_definition <- function (V__x15) { + V__V__id3 <- V__x15 + V__x16 <- V__V__id3[[1]] + V__name1 <- V__V__id3[[2]] + V__args11 <- V__V__id3[[3]] + V__body1 <- cut(V__V__id3, 3) + add(get_environment(), list()) + V__V__o4 <- V__args11 + V__V__i6 <- NULL + for (V__V__i6 in indices(V__V__o4)) { + V__V__x17 <- V__V__o4[[V__V__i6]] + setenv(V__V__x17, + variable = TRUE) + } + V__V__x18 <- join(list(V__x16, V__name1, V__args11), macroexpand(V__body1)) + drop(get_environment()) + V__V__x18 +} +expand_macro <- function (form) { + macroexpand(expand1(form)) +} +expand1 <- function (V__x19) { + V__V__id4 <- V__x19 + V__name2 <- V__V__id4[[1]] + V__body2 <- cut(V__V__id4, 1) + apply(macro_function(V__name2), V__body2) +} +macroexpand <- function (form) { + if (symbol63(form)) { + macroexpand(symbol_expansion(form)) + } else { + if (atom63(form)) { + form + } else { + V__x20 <- hd(form) + if (V__x20 == "%local") { + expand_local(form) + } else { + if (V__x20 == "%function") { + expand_function(form) + } else { + if (V__x20 == "%global-function") { + expand_definition(form) + } else { + if (V__x20 == "%local-function") { + expand_definition(form) + } else { + if (macro63(V__x20)) { + expand_macro(form) + } else { + map(macroexpand, form) + } + } + } + } + } + } + } +} +quasiquote_list <- function (form, depth) { + V__xs <- list(list("list")) + V__V__o5 <- form + V__k4 <- NULL + for (V__k4 in indices(V__V__o5)) { + V__v4 <- V__V__o5[[V__k4]] + if (! number63(V__k4)) { + V__e32 + if (quasisplice63(V__v4, depth)) { + V__e32 <- quasiexpand(V__v4[[2]]) + } else { + V__e32 <- quasiexpand(V__v4, depth) + } + V__v5 <- V__e32 + last(V__xs)[[V__k4]] <<- V__v5 + } + } + V__V__x21 <- form + V__V__i8 <- 0 + while (V__V__i8 < V_35(V__V__x21)) { + V__x22 <- V__V__x21[[V__V__i8 + 1]] + if (quasisplice63(V__x22, depth)) { + V__x23 <- quasiexpand(V__x22[[2]]) + add(V__xs, V__x23) + add(V__xs, list("list")) + } else { + add(last(V__xs), quasiexpand(V__x22, depth)) + } + V__V__i8 <- V__V__i8 + 1 + } + V__pruned <- keep(function (x) { + V_35(x) > 1 || !( hd(x) == "list") || keys63(x) + }, V__xs) + if (one63(V__pruned)) { + hd(V__pruned) + } else { + join(list("join"), V__pruned) + } +} +quasiexpand <- function (form, depth) { + if (quasiquoting63(depth)) { + if (atom63(form)) { + list("quote", form) + } else { + if (can_unquote63(depth) && hd(form) == "unquote") { + quasiexpand(form[[2]]) + } else { + if (hd(form) == "unquote" || hd(form) == "unquote-splicing") { + quasiquote_list(form, depth - 1) + } else { + if (hd(form) == "quasiquote") { + quasiquote_list(form, depth + 1) + } else { + quasiquote_list(form, depth) + } + } + } + } + } else { + if (atom63(form)) { + form + } else { + if (hd(form) == "quote") { + form + } else { + if (hd(form) == "quasiquote") { + quasiexpand(form[[2]], 1) + } else { + map(function (x) { + quasiexpand(x, depth) + }, form) + } + } + } + } +} +expand_if <- function (V__x24) { + V__V__id5 <- V__x24 + V__a <- V__V__id5[[1]] + V__b1 <- V__V__id5[[2]] + V__c <- cut(V__V__id5, 2) + if (is63(V__b1)) { + list(join(list("%if", V__a, V__b1), expand_if(V__c))) + } else { + if (is63(V__a)) { + list(V__a) + } + } +} +indent_level <- 0 +indentation <- function () { + V__s <- "" + V__i9 <- 0 + while (V__i9 < indent_level) { + V__s <- cat(V__s, " ") + V__i9 <- V__i9 + 1 + } + V__s +} +reserved <- list("=" = TRUE, "==" = TRUE, "+" = TRUE, "-" = TRUE, "%" = TRUE, "*" = TRUE, "/" = TRUE, "<" = TRUE, ">" = TRUE, "<=" = TRUE, ">=" = TRUE, "break" = TRUE, "case" = TRUE, "catch" = TRUE, "class" = TRUE, "const" = TRUE, "continue" = TRUE, "debugger" = TRUE, "default" = TRUE, "delete" = TRUE, "do" = TRUE, "else" = TRUE, "eval" = TRUE, "finally" = TRUE, "for" = TRUE, "function" = TRUE, "if" = TRUE, "import" = TRUE, "in" = TRUE, "instanceof" = TRUE, "let" = TRUE, "new" = TRUE, "return" = TRUE, "switch" = TRUE, "throw" = TRUE, "try" = TRUE, "typeof" = TRUE, "var" = TRUE, "void" = TRUE, "with" = TRUE, "and" = TRUE, "end" = TRUE, "load" = TRUE, "repeat" = TRUE, "while" = TRUE, "false" = TRUE, "local" = TRUE, "nil" = TRUE, "then" = TRUE, "not" = TRUE, "true" = TRUE, "elseif" = TRUE, "or" = TRUE, "until" = TRUE) +reserved63 <- function (x) { + has63(reserved, x) +} +valid_code63 <- function (n) { + number_code63(n) || n > 64 && n < 91 || n > 96 && n < 123 || n == 95 +} +accessor_prefix <- list("." = TRUE, "@" = TRUE, "$" = TRUE, "\\" = TRUE, ":" = TRUE) +accessor_id63 <- function (x) { + string63(x) && accessor_prefix[[char(x, 0)]] && some63(char(x, 1)) && ! accessor_prefix[[char(x, 1)]] +} +prefix <- function (id) { + if (target == "r") { + cat("V", id) + } else { + id + } +} +compile_id <- function (id, raw63) { + V__e33 + if (raw63) { + V__e33 <- id + } else { + V__e34 + if (accessor_id63(id)) { + V__e34 <- clip(id, 1) + } else { + V__e34 <- id + } + V__e33 <- V__e34 + } + V__id0 <- V__e33 + V__e35 + if (raw63) { + V__e35 <- "" + } else { + V__e36 + if (number_code63(code(V__id0, 0))) { + V__e36 <- prefix("_") + } else { + V__e36 <- "" + } + V__e35 <- V__e36 + } + V__id11 <- V__e35 + V__i10 <- 0 + while (V__i10 < V_35(V__id0)) { + V__c1 <- char(V__id0, V__i10) + V__n7 <- code(V__c1) + V__e37 + if (V__c1 == "-" && !( V__id0 == "-")) { + V__e37 <- "_" + } else { + V__e38 + if (valid_code63(V__n7)) { + V__e38 <- V__c1 + } else { + V__e39 + if (V__i10 == 0) { + V__e39 <- cat(prefix("_"), V__n7) + } else { + V__e39 <- V__n7 + } + V__e38 <- V__e39 + } + V__e37 <- V__e38 + } + V__c11 <- V__e37 + V__id11 <- cat(V__id11, V__c11) + V__i10 <- V__i10 + 1 + } + V__e40 + if (reserved63(V__id11)) { + V__e40 <- cat(prefix("_"), V__id11) + } else { + V__e40 <- V__id11 + } + V__id21 <- V__e40 + if (id == V__id0) { + V__id21 + } else { + cat(char(id, 0), V__id21) + } +} +valid_id63 <- function (x) { + some63(x) && x == compile_id(x, "raw") +} +V__names <- list() +unique <- function (x) { + V__x25 <- compile_id(x) + if (V__names[[V__x25]]) { + V__i11 <- V__names[[V__x25]] + V__names[[V__x25]] <<- V__names[[V__x25]] + 1 + unique(cat(V__x25, V__i11)) + } else { + V__names[[V__x25]] <<- 1 + cat(prefix("__"), V__x25) + } +} +key <- function (k) { + V__i12 <- inner(k) + if (valid_id63(V__i12)) { + V__i12 + } else { + if (target == "js") { + k + } else { + if (target == "r") { + k + } else { + cat("[", k, "]") + } + } + } +} +mapo <- function (f, t) { + V__o6 <- list() + V__V__o7 <- t + V__k5 <- NULL + for (V__k5 in indices(V__V__o7)) { + V__v6 <- V__V__o7[[V__k5]] + V__x26 <- f(V__v6) + if (is63(V__x26)) { + add(V__o6, literal(V__k5)) + add(V__o6, V__x26) + } + } + V__o6 +} +infix <- list(list( + not = list( + r = "!", + js = "!", + lua = "not")), list( + * = TRUE, + / = TRUE, + % = TRUE), list( + cat = list( + js = "+", + lua = "..")), list( + + = TRUE, + - = TRUE), list( + < = TRUE, + > = TRUE, + <= = TRUE, + >= = TRUE), list( + = = list( + r = "==", + js = "===", + lua = "==")), list( + and = list( + r = "&&", + js = "&&", + lua = "and")), list( + or = list( + r = "||", + js = "||", + lua = "or"))) +unary63 <- function (form) { + two63(form) && in63(hd(form), list("not", "-")) +} +index <- function (k) { + if (number63(k)) { + k - 1 + } +} +precedence <- function (form) { + if (!( atom63(form) || unary63(form))) { + V__V__o8 <- infix + V__k6 <- NULL + for (V__k6 in indices(V__V__o8)) { + V__v7 <- V__V__o8[[V__k6]] + if (V__v7[[hd(form)]]) { + return index(V__k6) + } + } + } + 0 +} +getop <- function (op) { + find(function (level) { + V__x27 <- level[[op]] + if (V__x27 == TRUE) { + op + } else { + if (is63(V__x27)) { +V__x27[[target]] + } + } + }, infix) +} +infix63 <- function (x) { + is63(getop(x)) +} +infix_operator63 <- function (x) { + obj63(x) && infix63(hd(x)) +} +compile_args <- function (args) { + V__s1 <- "(" + V__c2 <- "" + V__V__x28 <- args + V__V__i15 <- 0 + while (V__V__i15 < V_35(V__V__x28)) { + V__x29 <- V__V__x28[[V__V__i15 + 1]] + V__s1 <- cat(V__s1, V__c2, compile(V__x29)) + V__c2 <- ", " + V__V__i15 <- V__V__i15 + 1 + } + cat(V__s1, ")") +} +escape_newlines <- function (s) { + V__s11 <- "" + V__i16 <- 0 + while (V__i16 < V_35(s)) { + V__c3 <- char(s, V__i16) + V__e41 + if (V__c3 == "\n") { + V__e41 <- "\\n" + } else { + V__e42 + if (V__c3 == "\r") { + V__e42 <- "\\r" + } else { + V__e42 <- V__c3 + } + V__e41 <- V__e42 + } + V__s11 <- cat(V__s11, V__e41) + V__i16 <- V__i16 + 1 + } + V__s11 +} +compile_nil <- function (x) { + if (target == "lua") { + "nil" + } else { + if (target == "js") { + "undefined" + } else { + if (target == "r") { + "NULL" + } else { + "nil" + } + } + } +} +compile_boolean <- function (x) { + if (target == "r") { + if (x) { + "TRUE" + } else { + "FALSE" + } + } else { + if (x) { + "true" + } else { + "false" + } + } +} +compile_atom <- function (x) { + if (x == "nil") { + compile_nil(x) + } else { + if (id_literal63(x)) { + inner(x) + } else { + if (string_literal63(x)) { + escape_newlines(x) + } else { + if (string63(x)) { + compile_id(x) + } else { + if (boolean63(x)) { + compile_boolean(x) + } else { + if (nan63(x)) { + "nan" + } else { + if (x == inf) { + "inf" + } else { + if (x == _inf) { + "-inf" + } else { + if (number63(x)) { + cat(x, "") + } else { + error(cat("Cannot compile atom: ", str(x))) + } + } + } + } + } + } + } + } + } +} +terminator <- function (stmt63) { + if (! stmt63) { + "" + } else { + if (target == "js") { + ";\n" + } else { + "\n" + } + } +} +compile_special <- function (form, stmt63) { + V__V__id6 <- form + V__x30 <- V__V__id6[[1]] + V__args2 <- cut(V__V__id6, 1) + V__V__id7 <- getenv(V__x30) + V__special <- V__V__id7[["special"]] + V__stmt <- V__V__id7[["stmt"]] + V__self_tr63 <- V__V__id7[["tr"]] + V__tr <- terminator(stmt63 && ! V__self_tr63) + cat(apply(V__special, V__args2), V__tr) +} +parenthesize_call63 <- function (x) { + ! atom63(x) && hd(x) == "%function" || precedence(x) > 0 +} +compile_call <- function (form) { + V__f <- hd(form) + V__f1 <- compile(V__f) + V__args3 <- compile_args(stash42(tl(form))) + if (parenthesize_call63(V__f)) { + cat("(", V__f1, ")", V__args3) + } else { + cat(V__f1, V__args3) + } +} +op_delims <- function (parent, child, ...) { + V__V__r61 <- list(...) + V__V__id8 <- V__V__r61 + V__right <- V__V__id8[["right"]] + V__e43 + if (V__right) { + V__e43 <- V_6261 + } else { + V__e43 <- V_62 + } + if (V__e43(precedence(child), precedence(parent))) { + list("(", ")") + } else { + list("", "") + } +} +compile_infix <- function (form) { + V__V__id9 <- form + V__op <- V__V__id9[[1]] + V__V__id10 <- cut(V__V__id9, 1) + V__a1 <- V__V__id10[[1]] + V__b2 <- V__V__id10[[2]] + V__V__id111 <- op_delims(form, V__a1) + V__ao <- V__V__id111[[1]] + V__ac <- V__V__id111[[2]] + V__V__id12 <- op_delims(form, V__b2, + right = TRUE) + V__bo <- V__V__id12[[1]] + V__bc <- V__V__id12[[2]] + V__a2 <- compile(V__a1) + V__b3 <- compile(V__b2) + V__op1 <- getop(V__op) + if (unary63(form)) { + cat(V__op1, V__ao, " ", V__a2, V__ac) + } else { + cat(V__ao, V__a2, V__ac, " ", V__op1, " ", V__bo, V__b3, V__bc) + } +} +compile_function <- function (args, body, ...) { + V__V__r63 <- list(...) + V__V__id13 <- V__V__r63 + V__name3 <- V__V__id13[["name"]] + V__prefix <- V__V__id13[["prefix"]] + V__e44 + if (V__name3) { + V__e44 <- compile(V__name3) + } else { + V__e44 <- "" + } + V__id14 <- V__e44 + V__e45 + if ((target == "lua" || target == "r") && args[["rest"]]) { + V__e45 <- join(args, list("|...|")) + } else { + V__e45 <- args + } + V__args12 <- V__e45 + V__args4 <- compile_args(V__args12) + indent_level <- indent_level + 1 + V__V__x31 <- compile(body, + stmt = TRUE) + indent_level <- indent_level - 1 + V__body3 <- V__V__x31 + V__ind <- indentation() + V__e46 + if (V__prefix) { + V__e46 <- cat(V__prefix, " ") + } else { + V__e46 <- "" + } + V__p <- V__e46 + V__e47 + if (target == "lua") { + V__e47 <- "end" + } else { + V__e47 <- "" + } + V__tr1 <- V__e47 + if (V__name3) { + V__tr1 <- cat(V__tr1, "\n") + } + if (target == "lua") { + cat(V__p, "function ", V__id14, V__args4, "\n", V__body3, V__ind, V__tr1) + } else { + cat("function ", V__id14, V__args4, " {\n", V__body3, V__ind, "}", V__tr1) + } +} +can_return63 <- function (form) { + is63(form) && !( target == "r") && (atom63(form) || !( hd(form) == "return") && ! statement63(hd(form))) +} +compile <- function (form, ...) { + V__V__r65 <- list(...) + V__V__id15 <- V__V__r65 + V__stmt1 <- V__V__id15[["stmt"]] + if (nil63(form)) { + "" + } else { + if (special_form63(form)) { + compile_special(form, V__stmt1) + } else { + V__tr2 <- terminator(V__stmt1) + V__e48 + if (V__stmt1) { + V__e48 <- indentation() + } else { + V__e48 <- "" + } + V__ind1 <- V__e48 + V__e49 + if (atom63(form)) { + V__e49 <- compile_atom(form) + } else { + V__e50 + if (infix63(hd(form))) { + V__e50 <- compile_infix(form) + } else { + V__e50 <- compile_call(form) + } + V__e49 <- V__e50 + } + V__form <- V__e49 + cat(V__ind1, V__form, V__tr2) + } + } +} +lower_statement <- function (form, tail63) { + V__hoist <- list() + V__e <- lower(form, V__hoist, TRUE, tail63) + V__e51 + if (some63(V__hoist) && is63(V__e)) { + V__e51 <- join(list("do"), V__hoist, list(V__e)) + } else { + V__e52 + if (is63(V__e)) { + V__e52 <- V__e + } else { + V__e53 + if (V_35(V__hoist) > 1) { + V__e53 <- join(list("do"), V__hoist) + } else { + V__e53 <- hd(V__hoist) + } + V__e52 <- V__e53 + } + V__e51 <- V__e52 + } + either(V__e51, list("do")) +} +lower_body <- function (body, tail63) { + lower_statement(join(list("do"), body), tail63) +} +lower_block <- function (body, tail63) { + join(list("%block"), tl(lower_body(body, tail63))) +} +literal63 <- function (form) { + atom63(form) || hd(form) == "%array" || hd(form) == "%object" +} +standalone63 <- function (form) { + ! atom63(form) && ! infix63(hd(form)) && ! literal63(form) && !( "get" == hd(form)) || id_literal63(form) +} +lower_do <- function (args, hoist, stmt63, tail63) { + V__V__x32 <- almost(args) + V__V__i17 <- 0 + while (V__V__i17 < V_35(V__V__x32)) { + V__x33 <- V__V__x32[[V__V__i17 + 1]] + V__V__y <- lower(V__x33, hoist, stmt63) + if (yes(V__V__y)) { + V__e1 <- V__V__y + if (standalone63(V__e1)) { + add(hoist, V__e1) + } + } + V__V__i17 <- V__V__i17 + 1 + } + V__e2 <- lower(last(args), hoist, stmt63, tail63) + if (tail63 && can_return63(V__e2)) { + list("return", V__e2) + } else { + V__e2 + } +} +lower_set <- function (args, hoist, stmt63, tail63) { + V__V__id16 <- args + V__lh <- V__V__id16[[1]] + V__rh <- V__V__id16[[2]] + V__lh1 <- lower(V__lh, hoist) + V__rh1 <- lower(V__rh, hoist) + add(hoist, list("%set", V__lh1, V__rh1)) + if (!( stmt63 && ! tail63)) { + V__lh1 + } +} +lower_if <- function (args, hoist, stmt63, tail63) { + V__V__id17 <- args + V__cond <- V__V__id17[[1]] + V__V_then <- V__V__id17[[2]] + V__V_else <- V__V__id17[[3]] + if (stmt63) { + V__e55 + if (is63(V__V_else)) { + V__e55 <- list(lower_body(list(V__V_else), tail63)) + } + add(hoist, join(list("%if", lower(V__cond, hoist), lower_body(list(V__V_then), tail63)), V__e55)) + } else { + V__e3 <- unique("e") + add(hoist, list("%local", V__e3)) + V__e54 + if (is63(V__V_else)) { + V__e54 <- list(lower(list("%set", V__e3, V__V_else))) + } + add(hoist, join(list("%if", lower(V__cond, hoist), lower(list("%set", V__e3, V__V_then))), V__e54)) + V__e3 + } +} +lower_short <- function (x, args, hoist) { + V__V__id18 <- args + V__a3 <- V__V__id18[[1]] + V__b4 <- V__V__id18[[2]] + V__hoist1 <- list() + V__b11 <- lower(V__b4, V__hoist1) + if (some63(V__hoist1)) { + V__id19 <- unique("id") + V__e56 + if (x == "and") { + V__e56 <- list("%if", V__id19, V__b4, V__id19) + } else { + V__e56 <- list("%if", V__id19, V__id19, V__b4) + } + lower(list("do", list("%local", V__id19, V__a3), V__e56), hoist) + } else { + list(x, lower(V__a3, hoist), V__b11) + } +} +lower_try <- function (args, hoist, tail63) { + add(hoist, list("%try", lower_body(args, tail63))) +} +lower_while <- function (args, hoist) { + V__V__id20 <- args + V__c4 <- V__V__id20[[1]] + V__body4 <- cut(V__V__id20, 1) + V__pre <- list() + V__c5 <- lower(V__c4, V__pre) + V__e57 + if (none63(V__pre)) { + V__e57 <- list("while", V__c5, lower_body(V__body4)) + } else { + V__e57 <- list("while", TRUE, join(list("do"), V__pre, list(list("%if", list("not", V__c5), list("break")), lower_body(V__body4)))) + } + add(hoist, V__e57) +} +lower_for <- function (args, hoist) { + V__V__id211 <- args + V__t <- V__V__id211[[1]] + V__k7 <- V__V__id211[[2]] + V__body5 <- cut(V__V__id211, 2) + add(hoist, list("%for", lower(V__t, hoist), V__k7, lower_body(V__body5))) +} +lower_function <- function (args) { + V__V__id22 <- args + V__a4 <- V__V__id22[[1]] + V__body6 <- cut(V__V__id22, 1) + list("%function", V__a4, lower_body(V__body6, TRUE)) +} +lower_definition <- function (kind, args, hoist) { + V__V__id23 <- args + V__name4 <- V__V__id23[[1]] + V__args5 <- V__V__id23[[2]] + V__body7 <- cut(V__V__id23, 2) + add(hoist, list(kind, V__name4, V__args5, lower_body(V__body7, TRUE))) +} +lower_call <- function (form, hoist) { + V__form1 <- map(function (x) { + lower(x, hoist) + }, form) + if (some63(V__form1)) { + V__form1 + } +} +pairwise63 <- function (form) { + in63(hd(form), list("<", "<=", "=", ">=", ">")) +} +lower_pairwise <- function (form) { + if (pairwise63(form)) { + V__e4 <- list() + V__V__id24 <- form + V__x34 <- V__V__id24[[1]] + V__args6 <- cut(V__V__id24, 1) + reduce(function (a, b) { + add(V__e4, list(V__x34, a, b)) + a + }, V__args6) + join(list("and"), reverse(V__e4)) + } else { + form + } +} +lower_infix63 <- function (form) { + infix63(hd(form)) && V_35(form) > 3 +} +lower_infix <- function (form, hoist) { + V__form2 <- lower_pairwise(form) + V__V__id25 <- V__form2 + V__x35 <- V__V__id25[[1]] + V__args7 <- cut(V__V__id25, 1) + lower(reduce(function (a, b) { + list(V__x35, b, a) + }, reverse(V__args7)), hoist) +} +lower_special <- function (form, hoist) { + V__e5 <- lower_call(form, hoist) + if (V__e5) { + add(hoist, V__e5) + } +} +lower <- function (form, hoist, stmt63, tail63) { + if (atom63(form)) { + form + } else { + if (empty63(form)) { + list("%array") + } else { + if (nil63(hoist)) { + lower_statement(form) + } else { + if (lower_infix63(form)) { + lower_infix(form, hoist) + } else { + V__V__id26 <- form + V__x36 <- V__V__id26[[1]] + V__args8 <- cut(V__V__id26, 1) + if (V__x36 == "do") { + lower_do(V__args8, hoist, stmt63, tail63) + } else { + if (V__x36 == "%block") { + lower_block(V__args8, tail63) + } else { + if (V__x36 == "%call") { + lower(V__args8, hoist, stmt63, tail63) + } else { + if (V__x36 == "%set") { + lower_set(V__args8, hoist, stmt63, tail63) + } else { + if (V__x36 == "%if") { + lower_if(V__args8, hoist, stmt63, tail63) + } else { + if (V__x36 == "%try") { + lower_try(V__args8, hoist, tail63) + } else { + if (V__x36 == "while") { + lower_while(V__args8, hoist) + } else { + if (V__x36 == "%for") { + lower_for(V__args8, hoist) + } else { + if (V__x36 == "%function") { + lower_function(V__args8) + } else { + if (V__x36 == "%local-function" || V__x36 == "%global-function") { + lower_definition(V__x36, V__args8, hoist) + } else { + if (in63(V__x36, list("and", "or"))) { + lower_short(V__x36, V__args8, hoist) + } else { + if (statement63(V__x36)) { + lower_special(form, hoist) + } else { + lower_call(form, hoist) + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } +} +expand <- function (form) { + lower(macroexpand(form)) +} +V_37result <- NULL +V_eval <- function (form) { + V__previous <- target + target <- "r" + V__code <- compile(expand(list("set", "%result", form))) + target <- V__previous + run(V__code) + V_37result +} +immediate_call63 <- function (x) { + obj63(x) && obj63(hd(x)) && hd(hd(x)) == "%function" +} +setenv("do", + special = function (...) { + V__forms1 <- list(...) + V__s3 <- "" + V__V__x39 <- V__forms1 + V__V__i19 <- 0 + while (V__V__i19 < V_35(V__V__x39)) { + V__x40 <- V__V__x39[[V__V__i19 + 1]] + if (target == "lua" && immediate_call63(V__x40) && "\n" == char(V__s3, edge(V__s3))) { + V__s3 <- cat(clip(V__s3, 0, edge(V__s3)), ";\n") + } + V__s3 <- cat(V__s3, compile(V__x40, + stmt = TRUE)) + if (! atom63(V__x40)) { + if (hd(V__x40) == "return" || hd(V__x40) == "break") { + break + } + } + V__V__i19 <- V__V__i19 + 1 + } + V__s3 + }, + stmt = TRUE, + tr = TRUE) +setenv("%block", + special = function (...) { + V__forms3 <- list(...) + V__s5 <- "{\n" + indent_level <- indent_level + 1 + V__V__x45 <- V__forms3 + V__V__i21 <- 0 + while (V__V__i21 < V_35(V__V__x45)) { + V__x46 <- V__V__x45[[V__V__i21 + 1]] + V__s5 <- cat(V__s5, compile(V__x46, + stmt = TRUE)) + V__V__i21 <- V__V__i21 + 1 + } + V__V__x44 + indent_level <- indent_level - 1 + V__s5 <- cat(V__s5, indentation(), "}") + V__s5 + }) +setenv("%if", + special = function (cond, cons, alt) { + V__cond2 <- compile(cond) + indent_level <- indent_level + 1 + V__V__x49 <- compile(cons, + stmt = TRUE) + indent_level <- indent_level - 1 + V__cons1 <- V__V__x49 + V__e58 + if (alt) { + indent_level <- indent_level + 1 + V__V__x50 <- compile(alt, + stmt = TRUE) + indent_level <- indent_level - 1 + V__e58 <- V__V__x50 + } + V__alt1 <- V__e58 + V__ind3 <- indentation() + V__s7 <- "" + if (target == "lua") { + V__s7 <- cat(V__s7, V__ind3, "if ", V__cond2, " then\n", V__cons1) + } else { + V__s7 <- cat(V__s7, V__ind3, "if (", V__cond2, ") {\n", V__cons1, V__ind3, "}") + } + if (V__alt1 && target == "lua") { + V__s7 <- cat(V__s7, V__ind3, "else\n", V__alt1) + } else { + if (V__alt1) { + V__s7 <- cat(V__s7, " else {\n", V__alt1, V__ind3, "}") + } + } + if (target == "lua") { + cat(V__s7, V__ind3, "end\n") + } else { + cat(V__s7, "\n") + } + }, + stmt = TRUE, + tr = TRUE) +setenv("while", + special = function (cond, form) { + V__cond4 <- compile(cond) + indent_level <- indent_level + 1 + V__V__x52 <- compile(form, + stmt = TRUE) + indent_level <- indent_level - 1 + V__body9 <- V__V__x52 + V__ind5 <- indentation() + if (target == "lua") { + cat(V__ind5, "while ", V__cond4, " do\n", V__body9, V__ind5, "end\n") + } else { + cat(V__ind5, "while (", V__cond4, ") {\n", V__body9, V__ind5, "}\n") + } + }, + stmt = TRUE, + tr = TRUE) +setenv("%for", + special = function (t, k, form) { + V__t2 <- compile(t) + V__ind7 <- indentation() + indent_level <- indent_level + 1 + V__V__x54 <- compile(form, + stmt = TRUE) + indent_level <- indent_level - 1 + V__body11 <- V__V__x54 + if (target == "lua") { + cat(V__ind7, "for ", k, " in next, ", V__t2, " do\n", V__body11, V__ind7, "end\n") + } else { + cat(V__ind7, "for (", k, " in ", V__t2, ") {\n", V__body11, V__ind7, "}\n") + } + }, + stmt = TRUE, + tr = TRUE) +setenv("%try", + special = function (form) { + V__e8 <- unique("e") + V__ind9 <- indentation() + indent_level <- indent_level + 1 + V__V__x59 <- compile(form, + stmt = TRUE) + indent_level <- indent_level - 1 + V__body13 <- V__V__x59 + V__hf1 <- list("return", list("%array", FALSE, V__e8)) + indent_level <- indent_level + 1 + V__V__x60 <- compile(V__hf1, + stmt = TRUE) + indent_level <- indent_level - 1 + V__h1 <- V__V__x60 + cat(V__ind9, "try {\n", V__body13, V__ind9, "}\n", V__ind9, "catch (", V__e8, ") {\n", V__h1, V__ind9, "}\n") + }, + stmt = TRUE, + tr = TRUE) +setenv("%delete", + special = function (place) { + cat(indentation(), "delete ", compile(place)) + }, + stmt = TRUE) +setenv("break", + special = function () { + cat(indentation(), "break") + }, + stmt = TRUE) +setenv("%function", + special = function (args, body) { + compile_function(args, body) + }) +setenv("%global-function", + special = function (name, args, body) { + if (target == "lua") { + V__x64 <- compile_function(args, body, + name = name) + cat(indentation(), V__x64) + } else { + compile(list("%set", name, list("%function", args, body)), + stmt = TRUE) + } + }, + stmt = TRUE, + tr = TRUE) +setenv("%local-function", + special = function (name, args, body) { + if (target == "lua") { + V__x68 <- compile_function(args, body, + name = name, + prefix = "local") + cat(indentation(), V__x68) + } else { + compile(list("%local", name, list("%function", args, body)), + stmt = TRUE) + } + }, + stmt = TRUE, + tr = TRUE) +setenv("return", + special = function (x) { + V__e59 + if (nil63(x)) { + V__e59 <- "return" + } else { + V__e59 <- cat("return ", compile(x)) + } + V__x70 <- V__e59 + cat(indentation(), V__x70) + }, + stmt = TRUE) +setenv("new", + special = function (x) { + cat("new ", compile(x)) + }) +setenv("typeof", + special = function (x) { + cat("typeof(", compile(x), ")") + }) +setenv("throw", + special = function (x) { + V__e60 + if (target == "js") { + V__e60 <- cat("throw ", compile(x)) + } else { + V__e60 <- cat("error(", compile(x), ")") + } + V__e12 <- V__e60 + cat(indentation(), V__e12) + }, + stmt = TRUE) +setenv("%local", + special = function (name, value) { + V__id28 <- compile(name) + V__value11 <- compile(value) + V__e61 + if (target == "r") { + V__e61 <- " <- " + } else { + V__e61 <- " = " + } + V__sep1 <- V__e61 + V__e62 + if (is63(value)) { + V__e62 <- cat(V__sep1, V__value11) + } else { + V__e62 <- "" + } + V__rh2 <- V__e62 + V__e63 + if (target == "js") { + V__e63 <- "var " + } else { + V__e64 + if (target == "lua") { + V__e64 <- "local " + } else { + V__e64 <- "" + } + V__e63 <- V__e64 + } + V__keyword1 <- V__e63 + V__ind11 <- indentation() + cat(V__ind11, V__keyword1, V__id28, V__rh2) + }, + stmt = TRUE) +setenv("%set", + special = function (lh, rh) { + V__lh12 <- compile(lh) + V__e65 + if (nil63(rh)) { + V__e65 <- "nil" + } else { + V__e65 <- rh + } + V__rh13 <- compile(V__e65) + V__e66 + if (target == "r") { + V__e67 + if (hd63(lh, "get")) { + V__e67 <- " <<- " + } else { + V__e67 <- " <- " + } + V__e66 <- V__e67 + } else { + V__e66 <- " = " + } + V__sep3 <- V__e66 + cat(indentation(), V__lh12, V__sep3, V__rh13) + }, + stmt = TRUE) +setenv("get", + special = function (t, k) { + V__t12 <- compile(t) + V__k12 <- compile(k) + if (target == "lua" && char(V__t12, 0) == "{" || infix_operator63(t)) { + V__t12 <- cat("(", V__t12, ")") + } + if (accessor_id63(k)) { + cat(V__t12, V__k12) + } else { + if (target == "r") { + cat(V__t12, "[[", V__k12, "]]") + } else { + cat(V__t12, "[", V__k12, "]") + } + } + }) +setenv("%array", + special = function (...) { + V__forms5 <- list(...) + V__e68 + if (target == "r") { + V__e68 <- "list(" + } else { + V__e69 + if (target == "lua") { + V__e69 <- "{" + } else { + V__e69 <- "[" + } + V__e68 <- V__e69 + } + V__open1 <- V__e68 + V__e70 + if (target == "r") { + V__e70 <- ")" + } else { + V__e71 + if (target == "lua") { + V__e71 <- "}" + } else { + V__e71 <- "]" + } + V__e70 <- V__e71 + } + V__close1 <- V__e70 + V__s9 <- "" + V__c7 <- "" + V__V__o10 <- V__forms5 + V__k10 <- NULL + for (V__k10 in indices(V__V__o10)) { + V__v9 <- V__V__o10[[V__k10]] + if (number63(V__k10)) { + V__s9 <- cat(V__s9, V__c7, compile(V__v9)) + V__c7 <- ", " + } + } + cat(V__open1, V__s9, V__close1) + }) +setenv("%object", + special = function (...) { + V__forms7 <- list(...) + V__e72 + if (target == "r") { + V__e72 <- "list(" + } else { + V__e72 <- "{" + } + V__s111 <- V__e72 + V__c9 <- "" + V__e73 + if (target == "js") { + V__e73 <- ": " + } else { + V__e73 <- " = " + } + V__sep5 <- V__e73 + V__V__o12 <- pair(V__forms7) + V__k14 <- NULL + for (V__k14 in indices(V__V__o12)) { + V__v12 <- V__V__o12[[V__k14]] + if (number63(V__k14)) { + V__V__id30 <- V__v12 + V__k15 <- V__V__id30[[1]] + V__v13 <- V__V__id30[[2]] + if (! string63(V__k15)) { + error(cat("Illegal key: ", str(V__k15))) + } + V__s111 <- cat(V__s111, V__c9, key(V__k15), V__sep5, compile(V__v13)) + V__c9 <- ", " + } + } + V__e74 + if (target == "r") { + V__e74 <- ")" + } else { + V__e74 <- "}" + } + cat(V__s111, V__e74) + }) +setenv("%literal", + special = function (...) { + V__args10 <- list(...) + apply(cat, map(compile, V__args10)) + }) +setenv("%stash", + special = function (...) { + V__args121 <- list(...) + if (target == "r") { + indent_level <- indent_level + 1 + V__ind13 <- indentation() + V__s13 <- "" + V__c111 <- "" + V__V__x76 <- V__args121 + V__V__i28 <- 0 + while (V__V__i28 < V_35(V__V__x76)) { + V__V__id33 <- V__V__x76[[V__V__i28 + 1]] + V__k18 <- V__V__id33[[1]] + V__v16 <- V__V__id33[[2]] + V__s13 <- cat(V__s13, V__c111, "\n", V__ind13, inner(compile(V__k18)), " = ", compile(V__v16)) + V__c111 <- "," + V__V__i28 <- V__V__i28 + 1 + } + V__V__x75 <- V__s13 + indent_level <- indent_level - 1 + V__V__x75 + } else { + V__l2 <- list("%object", "\"_stash\"", TRUE) + V__V__x77 <- V__args121 + V__V__i29 <- 0 + while (V__V__i29 < V_35(V__V__x77)) { + V__V__id34 <- V__V__x77[[V__V__i29 + 1]] + V__k19 <- V__V__id34[[1]] + V__v17 <- V__V__id34[[2]] + add(V__l2, literal(V__k19)) + add(V__l2, V__v17) + V__V__i29 <- V__V__i29 + 1 + } + compile(V__l2) + } + }) +return list(run = run, "eval" = V_eval, expand = expand, compile = compile) diff --git a/bin/compiler.js b/bin/compiler.js index f0ca439..0b12906 100644 --- a/bin/compiler.js +++ b/bin/compiler.js @@ -1,17 +1,17 @@ -var reader = require("reader"); -var getenv = function (k, p) { +var getenv = function (k, p, env) { + var __env = env || get_environment(); if (string63(k)) { - var __i = edge(environment); + var __i = edge(__env); while (__i >= 0) { - var __b = environment[__i][k]; + var __b = __env[__i][k]; if (is63(__b)) { - var __e21; + var __e29; if (p) { - __e21 = __b[p]; + __e29 = __b[p]; } else { - __e21 = __b; + __e29 = __b; } - return __e21; + return __e29; } else { __i = __i - 1; } @@ -56,7 +56,7 @@ quoted = function (form) { } } }; -var literal = function (s) { +literal = function (s) { if (string_literal63(s)) { return s; } else { @@ -65,21 +65,20 @@ var literal = function (s) { }; var stash42 = function (args) { if (keys63(args)) { - var __l = ["%object", "\"_stash\"", true]; + var __l = ["%stash"]; var ____o = args; var __k = undefined; for (__k in ____o) { var __v = ____o[__k]; - var __e22; + var __e30; if (numeric63(__k)) { - __e22 = parseInt(__k); + __e30 = parseInt(__k); } else { - __e22 = __k; + __e30 = __k; } - var __k1 = __e22; + var __k1 = __e30; if (! number63(__k1)) { - add(__l, literal(__k1)); - add(__l, __v); + add(__l, [literal(__k1), __v]); } } return join(args, [__l]); @@ -107,29 +106,29 @@ bind = function (lh, rh) { var __k2 = undefined; for (__k2 in ____o1) { var __v1 = ____o1[__k2]; - var __e23; + var __e31; if (numeric63(__k2)) { - __e23 = parseInt(__k2); + __e31 = parseInt(__k2); } else { - __e23 = __k2; + __e31 = __k2; } - var __k3 = __e23; - var __e24; + var __k3 = __e31; + var __e32; if (__k3 === "rest") { - __e24 = ["cut", __id, _35(lh)]; + __e32 = ["cut", __id, _35(lh)]; } else { - __e24 = ["get", __id, ["quote", bias(__k3)]]; + __e32 = ["get", __id, ["quote", bias(__k3)]]; } - var __x5 = __e24; + var __x6 = __e32; if (is63(__k3)) { - var __e25; + var __e33; if (__v1 === true) { - __e25 = __k3; + __e33 = __k3; } else { - __e25 = __v1; + __e33 = __v1; } - var __k4 = __e25; - __bs = join(__bs, bind(__k4, __x5)); + var __k4 = __e33; + __bs = join(__bs, bind(__k4, __x6)); } } return __bs; @@ -141,11 +140,15 @@ setenv("arguments%", {_stash: true, macro: function (from) { bind42 = function (args, body) { var __args1 = []; var rest = function () { - __args1.rest = true; + __args1["rest"] = true; if (target === "js") { return ["unstash", ["arguments%", _35(__args1)]]; } else { - return ["unstash", ["list", "|...|"]]; + if (target === "r") { + return ["list", "|...|"]; + } else { + return ["unstash", ["list", "|...|"]]; + } } }; if (atom63(args)) { @@ -157,31 +160,33 @@ bind42 = function (args, body) { var __k5 = undefined; for (__k5 in ____o2) { var __v2 = ____o2[__k5]; - var __e26; + var __e34; if (numeric63(__k5)) { - __e26 = parseInt(__k5); + __e34 = parseInt(__k5); } else { - __e26 = __k5; + __e34 = __k5; } - var __k6 = __e26; + var __k6 = __e34; if (number63(__k6)) { if (atom63(__v2)) { add(__args1, __v2); } else { - var __x30 = unique("x"); - add(__args1, __x30); - __bs1 = join(__bs1, [__v2, __x30]); + var __x32 = unique("x"); + add(__args1, __x32); + __bs1 = join(__bs1, [__v2, __x32]); } } } if (keys63(args)) { __bs1 = join(__bs1, [__r19, rest()]); - var __n3 = _35(__args1); - var __i4 = 0; - while (__i4 < __n3) { - var __v3 = __args1[__i4]; - __bs1 = join(__bs1, [__v3, ["destash!", __v3, __r19]]); - __i4 = __i4 + 1; + if (!( target === "r")) { + var __n3 = _35(__args1); + var __i4 = 0; + while (__i4 < __n3) { + var __v3 = __args1[__i4]; + __bs1 = join(__bs1, [__v3, ["destash!", __v3, __r19]]); + __i4 = __i4 + 1; + } } __bs1 = join(__bs1, [keys(args), __r19]); } @@ -200,66 +205,66 @@ var can_unquote63 = function (depth) { var quasisplice63 = function (x, depth) { return can_unquote63(depth) && ! atom63(x) && hd(x) === "unquote-splicing"; }; -var expand_local = function (__x38) { - var ____id1 = __x38; - var __x39 = ____id1[0]; +var expand_local = function (__x40) { + var ____id1 = __x40; + var __x41 = ____id1[0]; var __name = ____id1[1]; var __value = ____id1[2]; setenv(__name, {_stash: true, variable: true}); return ["%local", __name, macroexpand(__value)]; }; -var expand_function = function (__x41) { - var ____id2 = __x41; - var __x42 = ____id2[0]; +var expand_function = function (__x43) { + var ____id2 = __x43; + var __x44 = ____id2[0]; var __args = ____id2[1]; var __body = cut(____id2, 2); - add(environment, {}); + add(get_environment(), {}); var ____o3 = __args; var ____i5 = undefined; for (____i5 in ____o3) { - var ____x43 = ____o3[____i5]; - var __e27; + var ____x45 = ____o3[____i5]; + var __e35; if (numeric63(____i5)) { - __e27 = parseInt(____i5); + __e35 = parseInt(____i5); } else { - __e27 = ____i5; + __e35 = ____i5; } - var ____i51 = __e27; - setenv(____x43, {_stash: true, variable: true}); + var ____i51 = __e35; + setenv(____x45, {_stash: true, variable: true}); } - var ____x44 = join(["%function", __args], macroexpand(__body)); - drop(environment); - return ____x44; + var ____x46 = join(["%function", __args], macroexpand(__body)); + drop(get_environment()); + return ____x46; }; -var expand_definition = function (__x46) { - var ____id3 = __x46; - var __x47 = ____id3[0]; +var expand_definition = function (__x48) { + var ____id3 = __x48; + var __x49 = ____id3[0]; var __name1 = ____id3[1]; var __args11 = ____id3[2]; var __body1 = cut(____id3, 3); - add(environment, {}); + add(get_environment(), {}); var ____o4 = __args11; var ____i6 = undefined; for (____i6 in ____o4) { - var ____x48 = ____o4[____i6]; - var __e28; + var ____x50 = ____o4[____i6]; + var __e36; if (numeric63(____i6)) { - __e28 = parseInt(____i6); + __e36 = parseInt(____i6); } else { - __e28 = ____i6; + __e36 = ____i6; } - var ____i61 = __e28; - setenv(____x48, {_stash: true, variable: true}); + var ____i61 = __e36; + setenv(____x50, {_stash: true, variable: true}); } - var ____x49 = join([__x47, __name1, __args11], macroexpand(__body1)); - drop(environment); - return ____x49; + var ____x51 = join([__x49, __name1, __args11], macroexpand(__body1)); + drop(get_environment()); + return ____x51; }; var expand_macro = function (form) { return macroexpand(expand1(form)); }; -expand1 = function (__x51) { - var ____id4 = __x51; +expand1 = function (__x53) { + var ____id4 = __x53; var __name2 = ____id4[0]; var __body2 = cut(____id4, 1); return apply(macro_function(__name2), __body2); @@ -271,20 +276,20 @@ macroexpand = function (form) { if (atom63(form)) { return form; } else { - var __x52 = hd(form); - if (__x52 === "%local") { + var __x54 = hd(form); + if (__x54 === "%local") { return expand_local(form); } else { - if (__x52 === "%function") { + if (__x54 === "%function") { return expand_function(form); } else { - if (__x52 === "%global-function") { + if (__x54 === "%global-function") { return expand_definition(form); } else { - if (__x52 === "%local-function") { + if (__x54 === "%local-function") { return expand_definition(form); } else { - if (macro63(__x52)) { + if (macro63(__x54)) { return expand_macro(form); } else { return map(macroexpand, form); @@ -302,34 +307,34 @@ var quasiquote_list = function (form, depth) { var __k7 = undefined; for (__k7 in ____o5) { var __v4 = ____o5[__k7]; - var __e29; + var __e37; if (numeric63(__k7)) { - __e29 = parseInt(__k7); + __e37 = parseInt(__k7); } else { - __e29 = __k7; + __e37 = __k7; } - var __k8 = __e29; + var __k8 = __e37; if (! number63(__k8)) { - var __e30; + var __e38; if (quasisplice63(__v4, depth)) { - __e30 = quasiexpand(__v4[1]); + __e38 = quasiexpand(__v4[1]); } else { - __e30 = quasiexpand(__v4, depth); + __e38 = quasiexpand(__v4, depth); } - var __v5 = __e30; + var __v5 = __e38; last(__xs)[__k8] = __v5; } } - var ____x55 = form; + var ____x57 = form; var ____i8 = 0; - while (____i8 < _35(____x55)) { - var __x56 = ____x55[____i8]; - if (quasisplice63(__x56, depth)) { - var __x57 = quasiexpand(__x56[1]); - add(__xs, __x57); + while (____i8 < _35(____x57)) { + var __x58 = ____x57[____i8]; + if (quasisplice63(__x58, depth)) { + var __x59 = quasiexpand(__x58[1]); + add(__xs, __x59); add(__xs, ["list"]); } else { - add(last(__xs), quasiexpand(__x56, depth)); + add(last(__xs), quasiexpand(__x58, depth)); } ____i8 = ____i8 + 1; } @@ -379,8 +384,8 @@ quasiexpand = function (form, depth) { } } }; -expand_if = function (__x61) { - var ____id5 = __x61; +expand_if = function (__x63) { + var ____id5 = __x63; var __a = ____id5[0]; var __b1 = ____id5[1]; var __c = cut(____id5, 2); @@ -409,59 +414,96 @@ reserved63 = function (x) { var valid_code63 = function (n) { return number_code63(n) || n > 64 && n < 91 || n > 96 && n < 123 || n === 95; }; -var id = function (id) { - var __e31; - if (number_code63(code(id, 0))) { - __e31 = "_"; +var accessor_prefix = {".": true, "@": true, "$": true, "\\": true, ":": true}; +accessor_id63 = function (x) { + return string63(x) && accessor_prefix[char(x, 0)] && some63(char(x, 1)) && ! accessor_prefix[char(x, 1)]; +}; +var prefix = function (id) { + if (target === "r") { + return "V" + id; } else { - __e31 = ""; + return id; + } +}; +compile_id = function (id, raw63) { + var __e39; + if (raw63) { + __e39 = id; + } else { + var __e40; + if (accessor_id63(id)) { + __e40 = clip(id, 1); + } else { + __e40 = id; + } + __e39 = __e40; } - var __id11 = __e31; + var __id0 = __e39; + var __e41; + if (raw63) { + __e41 = ""; + } else { + var __e42; + if (number_code63(code(__id0, 0))) { + __e42 = prefix("_"); + } else { + __e42 = ""; + } + __e41 = __e42; + } + var __id11 = __e41; var __i10 = 0; - while (__i10 < _35(id)) { - var __c1 = char(id, __i10); + while (__i10 < _35(__id0)) { + var __c1 = char(__id0, __i10); var __n7 = code(__c1); - var __e32; - if (__c1 === "-" && !( id === "-")) { - __e32 = "_"; + var __e43; + if (__c1 === "-" && !( __id0 === "-")) { + __e43 = "_"; } else { - var __e33; + var __e44; if (valid_code63(__n7)) { - __e33 = __c1; + __e44 = __c1; } else { - var __e34; + var __e45; if (__i10 === 0) { - __e34 = "_" + __n7; + __e45 = prefix("_") + __n7; } else { - __e34 = __n7; + __e45 = __n7; } - __e33 = __e34; + __e44 = __e45; } - __e32 = __e33; + __e43 = __e44; } - var __c11 = __e32; + var __c11 = __e43; __id11 = __id11 + __c11; __i10 = __i10 + 1; } + var __e46; if (reserved63(__id11)) { - return "_" + __id11; + __e46 = prefix("_") + __id11; + } else { + __e46 = __id11; + } + var __id21 = __e46; + if (id === __id0) { + return __id21; } else { - return __id11; + return char(id, 0) + __id21; } }; valid_id63 = function (x) { - return some63(x) && x === id(x); + return some63(x) && x === compile_id(x, "raw"); }; var __names = {}; unique = function (x) { - var __x65 = id(x); - if (__names[__x65]) { - var __i11 = __names[__x65]; - __names[__x65] = __names[__x65] + 1; - return unique(__x65 + __i11); + var __x67 = compile_id(x); + if (__names[__x67]) { + var __i11 = __names[__x67]; + __names[__x67] = __names[__x67] + 1; + return unique(__x67 + __i11); } else { - __names[__x65] = 1; - return "__" + __x65; + __names[__x67] = 1; + return prefix("__") + __x67; } }; key = function (k) { @@ -472,7 +514,11 @@ key = function (k) { if (target === "js") { return k; } else { - return "[" + k + "]"; + if (target === "r") { + return k; + } else { + return "[" + k + "]"; + } } } }; @@ -482,59 +528,63 @@ mapo = function (f, t) { var __k9 = undefined; for (__k9 in ____o7) { var __v6 = ____o7[__k9]; - var __e35; + var __e47; if (numeric63(__k9)) { - __e35 = parseInt(__k9); + __e47 = parseInt(__k9); } else { - __e35 = __k9; + __e47 = __k9; } - var __k10 = __e35; - var __x66 = f(__v6); - if (is63(__x66)) { + var __k10 = __e47; + var __x68 = f(__v6); + if (is63(__x68)) { add(__o6, literal(__k10)); - add(__o6, __x66); + add(__o6, __x68); } } return __o6; }; -var ____x68 = []; -var ____x69 = []; -____x69.js = "!"; -____x69.lua = "not"; -____x68["not"] = ____x69; var ____x70 = []; -____x70["*"] = true; -____x70["/"] = true; -____x70["%"] = true; var ____x71 = []; +____x71["r"] = "!"; +____x71["js"] = "!"; +____x71["lua"] = "not"; +____x70["not"] = ____x71; var ____x72 = []; -____x72.js = "+"; -____x72.lua = ".."; -____x71.cat = ____x72; +____x72["*"] = true; +____x72["/"] = true; +____x72["%"] = true; var ____x73 = []; -____x73["+"] = true; -____x73["-"] = true; var ____x74 = []; -____x74["<"] = true; -____x74[">"] = true; -____x74["<="] = true; -____x74[">="] = true; +____x74["js"] = "+"; +____x74["lua"] = ".."; +____x73["cat"] = ____x74; var ____x75 = []; +____x75["+"] = true; +____x75["-"] = true; var ____x76 = []; -____x76.js = "==="; -____x76.lua = "=="; -____x75["="] = ____x76; +____x76["<"] = true; +____x76[">"] = true; +____x76["<="] = true; +____x76[">="] = true; var ____x77 = []; var ____x78 = []; -____x78.js = "&&"; -____x78.lua = "and"; -____x77["and"] = ____x78; +____x78["r"] = "=="; +____x78["js"] = "==="; +____x78["lua"] = "=="; +____x77["="] = ____x78; var ____x79 = []; var ____x80 = []; -____x80.js = "||"; -____x80.lua = "or"; -____x79["or"] = ____x80; -var infix = [____x68, ____x70, ____x71, ____x73, ____x74, ____x75, ____x77, ____x79]; +____x80["r"] = "&&"; +____x80["js"] = "&&"; +____x80["lua"] = "and"; +____x79["and"] = ____x80; +var ____x81 = []; +var ____x82 = []; +____x82["r"] = "||"; +____x82["js"] = "||"; +____x82["lua"] = "or"; +____x81["or"] = ____x82; +var infix = [____x70, ____x72, ____x73, ____x75, ____x76, ____x77, ____x79, ____x81]; var unary63 = function (form) { return two63(form) && in63(hd(form), ["not", "-"]); }; @@ -547,13 +597,13 @@ var precedence = function (form) { var __k11 = undefined; for (__k11 in ____o8) { var __v7 = ____o8[__k11]; - var __e36; + var __e48; if (numeric63(__k11)) { - __e36 = parseInt(__k11); + __e48 = parseInt(__k11); } else { - __e36 = __k11; + __e48 = __k11; } - var __k12 = __e36; + var __k12 = __e48; if (__v7[hd(form)]) { return index(__k12); } @@ -563,12 +613,12 @@ var precedence = function (form) { }; var getop = function (op) { return find(function (level) { - var __x82 = level[op]; - if (__x82 === true) { + var __x84 = level[op]; + if (__x84 === true) { return op; } else { - if (is63(__x82)) { - return __x82[target]; + if (is63(__x84)) { + return __x84[target]; } } }, infix); @@ -579,14 +629,14 @@ var infix63 = function (x) { infix_operator63 = function (x) { return obj63(x) && infix63(hd(x)); }; -var compile_args = function (args) { +compile_args = function (args) { var __s1 = "("; var __c2 = ""; - var ____x83 = args; + var ____x85 = args; var ____i15 = 0; - while (____i15 < _35(____x83)) { - var __x84 = ____x83[____i15]; - __s1 = __s1 + __c2 + compile(__x84); + while (____i15 < _35(____x85)) { + var __x86 = ____x85[____i15]; + __s1 = __s1 + __c2 + compile(__x86); __c2 = ", "; ____i15 = ____i15 + 1; } @@ -597,60 +647,82 @@ var escape_newlines = function (s) { var __i16 = 0; while (__i16 < _35(s)) { var __c3 = char(s, __i16); - var __e37; + var __e49; if (__c3 === "\n") { - __e37 = "\\n"; + __e49 = "\\n"; } else { - var __e38; + var __e50; if (__c3 === "\r") { - __e38 = "\\r"; + __e50 = "\\r"; } else { - __e38 = __c3; + __e50 = __c3; } - __e37 = __e38; + __e49 = __e50; } - __s11 = __s11 + __e37; + __s11 = __s11 + __e49; __i16 = __i16 + 1; } return __s11; }; -var compile_atom = function (x) { - if (x === "nil" && target === "lua") { - return x; +var compile_nil = function (x) { + if (target === "lua") { + return "nil"; } else { - if (x === "nil") { + if (target === "js") { return "undefined"; } else { - if (id_literal63(x)) { - return inner(x); + if (target === "r") { + return "NULL"; } else { - if (string_literal63(x)) { - return escape_newlines(x); + return "nil"; + } + } + } +}; +var compile_boolean = function (x) { + if (target === "r") { + if (x) { + return "TRUE"; + } else { + return "FALSE"; + } + } else { + if (x) { + return "true"; + } else { + return "false"; + } + } +}; +var compile_atom = function (x) { + if (x === "nil") { + return compile_nil(x); + } else { + if (id_literal63(x)) { + return inner(x); + } else { + if (string_literal63(x)) { + return escape_newlines(x); + } else { + if (string63(x)) { + return compile_id(x); } else { - if (string63(x)) { - return id(x); + if (boolean63(x)) { + return compile_boolean(x); } else { - if (boolean63(x)) { - if (x) { - return "true"; - } else { - return "false"; - } + if (nan63(x)) { + return "nan"; } else { - if (nan63(x)) { - return "nan"; + if (x === inf) { + return "inf"; } else { - if (x === inf) { - return "inf"; + if (x === _inf) { + return "-inf"; } else { - if (x === _inf) { - return "-inf"; + if (number63(x)) { + return x + ""; } else { - if (number63(x)) { - return x + ""; - } else { - return error("Cannot compile atom: " + str(x)); - } + return error("Cannot compile atom: " + str(x)); } } } @@ -674,12 +746,12 @@ var terminator = function (stmt63) { }; var compile_special = function (form, stmt63) { var ____id6 = form; - var __x85 = ____id6[0]; + var __x87 = ____id6[0]; var __args2 = cut(____id6, 1); - var ____id7 = getenv(__x85); - var __special = ____id7.special; - var __stmt = ____id7.stmt; - var __self_tr63 = ____id7.tr; + var ____id7 = getenv(__x87); + var __special = ____id7["special"]; + var __stmt = ____id7["stmt"]; + var __self_tr63 = ____id7["tr"]; var __tr = terminator(stmt63 && ! __self_tr63); return apply(__special, __args2) + __tr; }; @@ -697,18 +769,18 @@ var compile_call = function (form) { } }; var op_delims = function (parent, child) { - var ____r57 = unstash(Array.prototype.slice.call(arguments, 2)); - var __parent = destash33(parent, ____r57); - var __child = destash33(child, ____r57); - var ____id8 = ____r57; - var __right = ____id8.right; - var __e39; + var ____r61 = unstash(Array["prototype"]["slice"]["call"](arguments, 2)); + var __parent = destash33(parent, ____r61); + var __child = destash33(child, ____r61); + var ____id8 = ____r61; + var __right = ____id8["right"]; + var __e51; if (__right) { - __e39 = _6261; + __e51 = _6261; } else { - __e39 = _62; + __e51 = _62; } - if (__e39(precedence(__child), precedence(__parent))) { + if (__e51(precedence(__child), precedence(__parent))) { return ["(", ")"]; } else { return ["", ""]; @@ -736,63 +808,63 @@ var compile_infix = function (form) { } }; compile_function = function (args, body) { - var ____r59 = unstash(Array.prototype.slice.call(arguments, 2)); - var __args4 = destash33(args, ____r59); - var __body3 = destash33(body, ____r59); - var ____id13 = ____r59; - var __name3 = ____id13.name; - var __prefix = ____id13.prefix; - var __e40; + var ____r63 = unstash(Array["prototype"]["slice"]["call"](arguments, 2)); + var __args4 = destash33(args, ____r63); + var __body3 = destash33(body, ____r63); + var ____id13 = ____r63; + var __name3 = ____id13["name"]; + var __prefix = ____id13["prefix"]; + var __e52; if (__name3) { - __e40 = compile(__name3); + __e52 = compile(__name3); } else { - __e40 = ""; + __e52 = ""; } - var __id14 = __e40; - var __e41; - if (target === "lua" && __args4.rest) { - __e41 = join(__args4, ["|...|"]); + var __id14 = __e52; + var __e53; + if ((target === "lua" || target === "r") && __args4["rest"]) { + __e53 = join(__args4, ["|...|"]); } else { - __e41 = __args4; + __e53 = __args4; } - var __args12 = __e41; + var __args12 = __e53; var __args5 = compile_args(__args12); indent_level = indent_level + 1; - var ____x89 = compile(__body3, {_stash: true, stmt: true}); + var ____x91 = compile(__body3, {_stash: true, stmt: true}); indent_level = indent_level - 1; - var __body4 = ____x89; + var __body4 = ____x91; var __ind = indentation(); - var __e42; + var __e54; if (__prefix) { - __e42 = __prefix + " "; + __e54 = __prefix + " "; } else { - __e42 = ""; + __e54 = ""; } - var __p = __e42; - var __e43; - if (target === "js") { - __e43 = ""; + var __p = __e54; + var __e55; + if (target === "lua") { + __e55 = "end"; } else { - __e43 = "end"; + __e55 = ""; } - var __tr1 = __e43; + var __tr1 = __e55; if (__name3) { __tr1 = __tr1 + "\n"; } - if (target === "js") { - return "function " + __id14 + __args5 + " {\n" + __body4 + __ind + "}" + __tr1; - } else { + if (target === "lua") { return __p + "function " + __id14 + __args5 + "\n" + __body4 + __ind + __tr1; + } else { + return "function " + __id14 + __args5 + " {\n" + __body4 + __ind + "}" + __tr1; } }; var can_return63 = function (form) { - return is63(form) && (atom63(form) || !( hd(form) === "return") && ! statement63(hd(form))); + return is63(form) && !( target === "r") && (atom63(form) || !( hd(form) === "return") && ! statement63(hd(form))); }; compile = function (form) { - var ____r61 = unstash(Array.prototype.slice.call(arguments, 1)); - var __form = destash33(form, ____r61); - var ____id15 = ____r61; - var __stmt1 = ____id15.stmt; + var ____r65 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); + var __form = destash33(form, ____r65); + var ____id15 = ____r65; + var __stmt1 = ____id15["stmt"]; if (nil63(__form)) { return ""; } else { @@ -800,26 +872,26 @@ compile = function (form) { return compile_special(__form, __stmt1); } else { var __tr2 = terminator(__stmt1); - var __e44; + var __e56; if (__stmt1) { - __e44 = indentation(); + __e56 = indentation(); } else { - __e44 = ""; + __e56 = ""; } - var __ind1 = __e44; - var __e45; + var __ind1 = __e56; + var __e57; if (atom63(__form)) { - __e45 = compile_atom(__form); + __e57 = compile_atom(__form); } else { - var __e46; + var __e58; if (infix63(hd(__form))) { - __e46 = compile_infix(__form); + __e58 = compile_infix(__form); } else { - __e46 = compile_call(__form); + __e58 = compile_call(__form); } - __e45 = __e46; + __e57 = __e58; } - var __form1 = __e45; + var __form1 = __e57; return __ind1 + __form1 + __tr2; } } @@ -827,29 +899,32 @@ compile = function (form) { var lower_statement = function (form, tail63) { var __hoist = []; var __e = lower(form, __hoist, true, tail63); - var __e47; + var __e59; if (some63(__hoist) && is63(__e)) { - __e47 = join(["do"], __hoist, [__e]); + __e59 = join(["do"], __hoist, [__e]); } else { - var __e48; + var __e60; if (is63(__e)) { - __e48 = __e; + __e60 = __e; } else { - var __e49; + var __e61; if (_35(__hoist) > 1) { - __e49 = join(["do"], __hoist); + __e61 = join(["do"], __hoist); } else { - __e49 = hd(__hoist); + __e61 = hd(__hoist); } - __e48 = __e49; + __e60 = __e61; } - __e47 = __e48; + __e59 = __e60; } - return either(__e47, ["do"]); + return either(__e59, ["do"]); }; var lower_body = function (body, tail63) { return lower_statement(join(["do"], body), tail63); }; +var lower_block = function (body, tail63) { + return join(["%block"], tl(lower_body(body, tail63))); +}; var literal63 = function (form) { return atom63(form) || hd(form) === "%array" || hd(form) === "%object"; }; @@ -857,11 +932,11 @@ var standalone63 = function (form) { return ! atom63(form) && ! infix63(hd(form)) && ! literal63(form) && !( "get" === hd(form)) || id_literal63(form); }; var lower_do = function (args, hoist, stmt63, tail63) { - var ____x95 = almost(args); + var ____x98 = almost(args); var ____i17 = 0; - while (____i17 < _35(____x95)) { - var __x96 = ____x95[____i17]; - var ____y = lower(__x96, hoist, stmt63); + while (____i17 < _35(____x98)) { + var __x99 = ____x98[____i17]; + var ____y = lower(__x99, hoist, stmt63); if (yes(____y)) { var __e1 = ____y; if (standalone63(__e1)) { @@ -894,19 +969,19 @@ var lower_if = function (args, hoist, stmt63, tail63) { var ___then = ____id17[1]; var ___else = ____id17[2]; if (stmt63) { - var __e51; + var __e63; if (is63(___else)) { - __e51 = [lower_body([___else], tail63)]; + __e63 = [lower_body([___else], tail63)]; } - return add(hoist, join(["%if", lower(__cond, hoist), lower_body([___then], tail63)], __e51)); + return add(hoist, join(["%if", lower(__cond, hoist), lower_body([___then], tail63)], __e63)); } else { var __e3 = unique("e"); add(hoist, ["%local", __e3]); - var __e50; + var __e62; if (is63(___else)) { - __e50 = [lower(["%set", __e3, ___else])]; + __e62 = [lower(["%set", __e3, ___else])]; } - add(hoist, join(["%if", lower(__cond, hoist), lower(["%set", __e3, ___then])], __e50)); + add(hoist, join(["%if", lower(__cond, hoist), lower(["%set", __e3, ___then])], __e62)); return __e3; } }; @@ -918,13 +993,13 @@ var lower_short = function (x, args, hoist) { var __b11 = lower(__b4, __hoist1); if (some63(__hoist1)) { var __id19 = unique("id"); - var __e52; + var __e64; if (x === "and") { - __e52 = ["%if", __id19, __b4, __id19]; + __e64 = ["%if", __id19, __b4, __id19]; } else { - __e52 = ["%if", __id19, __id19, __b4]; + __e64 = ["%if", __id19, __id19, __b4]; } - return lower(["do", ["%local", __id19, __a3], __e52], hoist); + return lower(["do", ["%local", __id19, __a3], __e64], hoist); } else { return [x, lower(__a3, hoist), __b11]; } @@ -938,19 +1013,19 @@ var lower_while = function (args, hoist) { var __body5 = cut(____id20, 1); var __pre = []; var __c5 = lower(__c4, __pre); - var __e53; + var __e65; if (none63(__pre)) { - __e53 = ["while", __c5, lower_body(__body5)]; + __e65 = ["while", __c5, lower_body(__body5)]; } else { - __e53 = ["while", true, join(["do"], __pre, [["%if", ["not", __c5], ["break"]], lower_body(__body5)])]; + __e65 = ["while", true, join(["do"], __pre, [["%if", ["not", __c5], ["break"]], lower_body(__body5)])]; } - return add(hoist, __e53); + return add(hoist, __e65); }; var lower_for = function (args, hoist) { - var ____id21 = args; - var __t = ____id21[0]; - var __k13 = ____id21[1]; - var __body6 = cut(____id21, 2); + var ____id211 = args; + var __t = ____id211[0]; + var __k13 = ____id211[1]; + var __body6 = cut(____id211, 2); return add(hoist, ["%for", lower(__t, hoist), __k13, lower_body(__body6)]); }; var lower_function = function (args) { @@ -981,10 +1056,10 @@ var lower_pairwise = function (form) { if (pairwise63(form)) { var __e4 = []; var ____id24 = form; - var __x125 = ____id24[0]; + var __x128 = ____id24[0]; var __args7 = cut(____id24, 1); reduce(function (a, b) { - add(__e4, [__x125, a, b]); + add(__e4, [__x128, a, b]); return a; }, __args7); return join(["and"], reverse(__e4)); @@ -998,10 +1073,10 @@ var lower_infix63 = function (form) { var lower_infix = function (form, hoist) { var __form3 = lower_pairwise(form); var ____id25 = __form3; - var __x128 = ____id25[0]; + var __x131 = ____id25[0]; var __args8 = cut(____id25, 1); return lower(reduce(function (a, b) { - return [__x128, b, a]; + return [__x131, b, a]; }, reverse(__args8)), hoist); }; var lower_special = function (form, hoist) { @@ -1024,42 +1099,46 @@ lower = function (form, hoist, stmt63, tail63) { return lower_infix(form, hoist); } else { var ____id26 = form; - var __x131 = ____id26[0]; + var __x134 = ____id26[0]; var __args9 = cut(____id26, 1); - if (__x131 === "do") { + if (__x134 === "do") { return lower_do(__args9, hoist, stmt63, tail63); } else { - if (__x131 === "%call") { - return lower(__args9, hoist, stmt63, tail63); + if (__x134 === "%block") { + return lower_block(__args9, tail63); } else { - if (__x131 === "%set") { - return lower_set(__args9, hoist, stmt63, tail63); + if (__x134 === "%call") { + return lower(__args9, hoist, stmt63, tail63); } else { - if (__x131 === "%if") { - return lower_if(__args9, hoist, stmt63, tail63); + if (__x134 === "%set") { + return lower_set(__args9, hoist, stmt63, tail63); } else { - if (__x131 === "%try") { - return lower_try(__args9, hoist, tail63); + if (__x134 === "%if") { + return lower_if(__args9, hoist, stmt63, tail63); } else { - if (__x131 === "while") { - return lower_while(__args9, hoist); + if (__x134 === "%try") { + return lower_try(__args9, hoist, tail63); } else { - if (__x131 === "%for") { - return lower_for(__args9, hoist); + if (__x134 === "while") { + return lower_while(__args9, hoist); } else { - if (__x131 === "%function") { - return lower_function(__args9); + if (__x134 === "%for") { + return lower_for(__args9, hoist); } else { - if (__x131 === "%local-function" || __x131 === "%global-function") { - return lower_definition(__x131, __args9, hoist); + if (__x134 === "%function") { + return lower_function(__args9); } else { - if (in63(__x131, ["and", "or"])) { - return lower_short(__x131, __args9, hoist); + if (__x134 === "%local-function" || __x134 === "%global-function") { + return lower_definition(__x134, __args9, hoist); } else { - if (statement63(__x131)) { - return lower_special(form, hoist); + if (in63(__x134, ["and", "or"])) { + return lower_short(__x134, __args9, hoist); } else { - return lower_call(form, hoist); + if (statement63(__x134)) { + return lower_special(form, hoist); + } else { + return lower_call(form, hoist); + } } } } @@ -1079,7 +1158,7 @@ lower = function (form, hoist, stmt63, tail63) { expand = function (form) { return lower(macroexpand(form)); }; -global.require = require; +global["require"] = require; var run = eval; _37result = undefined; _eval = function (form) { @@ -1094,18 +1173,18 @@ immediate_call63 = function (x) { return obj63(x) && obj63(hd(x)) && hd(hd(x)) === "%function"; }; setenv("do", {_stash: true, special: function () { - var __forms1 = unstash(Array.prototype.slice.call(arguments, 0)); + var __forms1 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); var __s3 = ""; - var ____x136 = __forms1; + var ____x139 = __forms1; var ____i19 = 0; - while (____i19 < _35(____x136)) { - var __x137 = ____x136[____i19]; - if (target === "lua" && immediate_call63(__x137) && "\n" === char(__s3, edge(__s3))) { + while (____i19 < _35(____x139)) { + var __x140 = ____x139[____i19]; + if (target === "lua" && immediate_call63(__x140) && "\n" === char(__s3, edge(__s3))) { __s3 = clip(__s3, 0, edge(__s3)) + ";\n"; } - __s3 = __s3 + compile(__x137, {_stash: true, stmt: true}); - if (! atom63(__x137)) { - if (hd(__x137) === "return" || hd(__x137) === "break") { + __s3 = __s3 + compile(__x140, {_stash: true, stmt: true}); + if (! atom63(__x140)) { + if (hd(__x140) === "return" || hd(__x140) === "break") { break; } } @@ -1113,60 +1192,76 @@ setenv("do", {_stash: true, special: function () { } return __s3; }, stmt: true, tr: true}); +setenv("%block", {_stash: true, special: function () { + var __forms3 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); + var __s5 = "{\n"; + indent_level = indent_level + 1; + var ____x145 = __forms3; + var ____i21 = 0; + while (____i21 < _35(____x145)) { + var __x146 = ____x145[____i21]; + __s5 = __s5 + compile(__x146, {_stash: true, stmt: true}); + ____i21 = ____i21 + 1; + } + var ____x144; + indent_level = indent_level - 1; + __s5 = __s5 + indentation() + "}"; + return __s5; +}}); setenv("%if", {_stash: true, special: function (cond, cons, alt) { var __cond2 = compile(cond); indent_level = indent_level + 1; - var ____x140 = compile(cons, {_stash: true, stmt: true}); + var ____x149 = compile(cons, {_stash: true, stmt: true}); indent_level = indent_level - 1; - var __cons1 = ____x140; - var __e54; + var __cons1 = ____x149; + var __e66; if (alt) { indent_level = indent_level + 1; - var ____x141 = compile(alt, {_stash: true, stmt: true}); + var ____x150 = compile(alt, {_stash: true, stmt: true}); indent_level = indent_level - 1; - __e54 = ____x141; + __e66 = ____x150; } - var __alt1 = __e54; + var __alt1 = __e66; var __ind3 = indentation(); - var __s5 = ""; - if (target === "js") { - __s5 = __s5 + __ind3 + "if (" + __cond2 + ") {\n" + __cons1 + __ind3 + "}"; + var __s7 = ""; + if (target === "lua") { + __s7 = __s7 + __ind3 + "if " + __cond2 + " then\n" + __cons1; } else { - __s5 = __s5 + __ind3 + "if " + __cond2 + " then\n" + __cons1; + __s7 = __s7 + __ind3 + "if (" + __cond2 + ") {\n" + __cons1 + __ind3 + "}"; } - if (__alt1 && target === "js") { - __s5 = __s5 + " else {\n" + __alt1 + __ind3 + "}"; + if (__alt1 && target === "lua") { + __s7 = __s7 + __ind3 + "else\n" + __alt1; } else { if (__alt1) { - __s5 = __s5 + __ind3 + "else\n" + __alt1; + __s7 = __s7 + " else {\n" + __alt1 + __ind3 + "}"; } } if (target === "lua") { - return __s5 + __ind3 + "end\n"; + return __s7 + __ind3 + "end\n"; } else { - return __s5 + "\n"; + return __s7 + "\n"; } }, stmt: true, tr: true}); setenv("while", {_stash: true, special: function (cond, form) { var __cond4 = compile(cond); indent_level = indent_level + 1; - var ____x143 = compile(form, {_stash: true, stmt: true}); + var ____x152 = compile(form, {_stash: true, stmt: true}); indent_level = indent_level - 1; - var __body10 = ____x143; + var __body10 = ____x152; var __ind5 = indentation(); - if (target === "js") { - return __ind5 + "while (" + __cond4 + ") {\n" + __body10 + __ind5 + "}\n"; - } else { + if (target === "lua") { return __ind5 + "while " + __cond4 + " do\n" + __body10 + __ind5 + "end\n"; + } else { + return __ind5 + "while (" + __cond4 + ") {\n" + __body10 + __ind5 + "}\n"; } }, stmt: true, tr: true}); setenv("%for", {_stash: true, special: function (t, k, form) { var __t2 = compile(t); var __ind7 = indentation(); indent_level = indent_level + 1; - var ____x145 = compile(form, {_stash: true, stmt: true}); + var ____x154 = compile(form, {_stash: true, stmt: true}); indent_level = indent_level - 1; - var __body12 = ____x145; + var __body12 = ____x154; if (target === "lua") { return __ind7 + "for " + k + " in next, " + __t2 + " do\n" + __body12 + __ind7 + "end\n"; } else { @@ -1177,14 +1272,14 @@ setenv("%try", {_stash: true, special: function (form) { var __e8 = unique("e"); var __ind9 = indentation(); indent_level = indent_level + 1; - var ____x150 = compile(form, {_stash: true, stmt: true}); + var ____x159 = compile(form, {_stash: true, stmt: true}); indent_level = indent_level - 1; - var __body14 = ____x150; + var __body14 = ____x159; var __hf1 = ["return", ["%array", false, __e8]]; indent_level = indent_level + 1; - var ____x153 = compile(__hf1, {_stash: true, stmt: true}); + var ____x162 = compile(__hf1, {_stash: true, stmt: true}); indent_level = indent_level - 1; - var __h1 = ____x153; + var __h1 = ____x162; return __ind9 + "try {\n" + __body14 + __ind9 + "}\n" + __ind9 + "catch (" + __e8 + ") {\n" + __h1 + __ind9 + "}\n"; }, stmt: true, tr: true}); setenv("%delete", {_stash: true, special: function (place) { @@ -1198,29 +1293,29 @@ setenv("%function", {_stash: true, special: function (args, body) { }}); setenv("%global-function", {_stash: true, special: function (name, args, body) { if (target === "lua") { - var __x157 = compile_function(args, body, {_stash: true, name: name}); - return indentation() + __x157; + var __x166 = compile_function(args, body, {_stash: true, name: name}); + return indentation() + __x166; } else { return compile(["%set", name, ["%function", args, body]], {_stash: true, stmt: true}); } }, stmt: true, tr: true}); setenv("%local-function", {_stash: true, special: function (name, args, body) { if (target === "lua") { - var __x163 = compile_function(args, body, {_stash: true, name: name, prefix: "local"}); - return indentation() + __x163; + var __x172 = compile_function(args, body, {_stash: true, name: name, prefix: "local"}); + return indentation() + __x172; } else { return compile(["%local", name, ["%function", args, body]], {_stash: true, stmt: true}); } }, stmt: true, tr: true}); setenv("return", {_stash: true, special: function (x) { - var __e55; + var __e67; if (nil63(x)) { - __e55 = "return"; + __e67 = "return"; } else { - __e55 = "return " + compile(x); + __e67 = "return " + compile(x); } - var __x167 = __e55; - return indentation() + __x167; + var __x176 = __e67; + return indentation() + __x176; }, stmt: true}); setenv("new", {_stash: true, special: function (x) { return "new " + compile(x); @@ -1229,45 +1324,71 @@ setenv("typeof", {_stash: true, special: function (x) { return "typeof(" + compile(x) + ")"; }}); setenv("throw", {_stash: true, special: function (x) { - var __e56; + var __e68; if (target === "js") { - __e56 = "throw " + compile(x); + __e68 = "throw " + compile(x); } else { - __e56 = "error(" + compile(x) + ")"; + __e68 = "error(" + compile(x) + ")"; } - var __e12 = __e56; + var __e12 = __e68; return indentation() + __e12; }, stmt: true}); setenv("%local", {_stash: true, special: function (name, value) { var __id28 = compile(name); var __value11 = compile(value); - var __e57; + var __e69; + if (target === "r") { + __e69 = " <- "; + } else { + __e69 = " = "; + } + var __sep1 = __e69; + var __e70; if (is63(value)) { - __e57 = " = " + __value11; + __e70 = __sep1 + __value11; } else { - __e57 = ""; + __e70 = ""; } - var __rh2 = __e57; - var __e58; + var __rh2 = __e70; + var __e71; if (target === "js") { - __e58 = "var "; + __e71 = "var "; } else { - __e58 = "local "; + var __e72; + if (target === "lua") { + __e72 = "local "; + } else { + __e72 = ""; + } + __e71 = __e72; } - var __keyword1 = __e58; + var __keyword1 = __e71; var __ind11 = indentation(); return __ind11 + __keyword1 + __id28 + __rh2; }, stmt: true}); setenv("%set", {_stash: true, special: function (lh, rh) { - var __lh2 = compile(lh); - var __e59; + var __lh12 = compile(lh); + var __e73; if (nil63(rh)) { - __e59 = "nil"; + __e73 = "nil"; + } else { + __e73 = rh; + } + var __rh13 = compile(__e73); + var __e74; + if (target === "r") { + var __e75; + if (hd63(lh, "get")) { + __e75 = " <<- "; + } else { + __e75 = " <- "; + } + __e74 = __e75; } else { - __e59 = rh; + __e74 = " = "; } - var __rh4 = compile(__e59); - return indentation() + __lh2 + " = " + __rh4; + var __sep3 = __e74; + return indentation() + __lh12 + __sep3 + __rh13; }, stmt: true}); setenv("get", {_stash: true, special: function (t, k) { var __t12 = compile(t); @@ -1275,70 +1396,92 @@ setenv("get", {_stash: true, special: function (t, k) { if (target === "lua" && char(__t12, 0) === "{" || infix_operator63(t)) { __t12 = "(" + __t12 + ")"; } - if (string_literal63(k) && valid_id63(inner(k))) { - return __t12 + "." + inner(k); + if (accessor_id63(k)) { + return __t12 + __k121; } else { - return __t12 + "[" + __k121 + "]"; + if (target === "r") { + return __t12 + "[[" + __k121 + "]]"; + } else { + return __t12 + "[" + __k121 + "]"; + } } }}); setenv("%array", {_stash: true, special: function () { - var __forms3 = unstash(Array.prototype.slice.call(arguments, 0)); - var __e60; - if (target === "lua") { - __e60 = "{"; + var __forms5 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); + var __e76; + if (target === "r") { + __e76 = "list("; } else { - __e60 = "["; + var __e77; + if (target === "lua") { + __e77 = "{"; + } else { + __e77 = "["; + } + __e76 = __e77; } - var __open1 = __e60; - var __e61; - if (target === "lua") { - __e61 = "}"; + var __open1 = __e76; + var __e78; + if (target === "r") { + __e78 = ")"; } else { - __e61 = "]"; + var __e79; + if (target === "lua") { + __e79 = "}"; + } else { + __e79 = "]"; + } + __e78 = __e79; } - var __close1 = __e61; - var __s7 = ""; + var __close1 = __e78; + var __s9 = ""; var __c7 = ""; - var ____o10 = __forms3; + var ____o10 = __forms5; var __k16 = undefined; for (__k16 in ____o10) { var __v9 = ____o10[__k16]; - var __e62; + var __e80; if (numeric63(__k16)) { - __e62 = parseInt(__k16); + __e80 = parseInt(__k16); } else { - __e62 = __k16; + __e80 = __k16; } - var __k17 = __e62; + var __k17 = __e80; if (number63(__k17)) { - __s7 = __s7 + __c7 + compile(__v9); + __s9 = __s9 + __c7 + compile(__v9); __c7 = ", "; } } - return __open1 + __s7 + __close1; + return __open1 + __s9 + __close1; }}); setenv("%object", {_stash: true, special: function () { - var __forms5 = unstash(Array.prototype.slice.call(arguments, 0)); - var __s9 = "{"; + var __forms7 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); + var __e81; + if (target === "r") { + __e81 = "list("; + } else { + __e81 = "{"; + } + var __s111 = __e81; var __c9 = ""; - var __e63; - if (target === "lua") { - __e63 = " = "; + var __e82; + if (target === "js") { + __e82 = ": "; } else { - __e63 = ": "; + __e82 = " = "; } - var __sep1 = __e63; - var ____o12 = pair(__forms5); + var __sep5 = __e82; + var ____o12 = pair(__forms7); var __k21 = undefined; for (__k21 in ____o12) { var __v12 = ____o12[__k21]; - var __e64; + var __e83; if (numeric63(__k21)) { - __e64 = parseInt(__k21); + __e83 = parseInt(__k21); } else { - __e64 = __k21; + __e83 = __k21; } - var __k22 = __e64; + var __k22 = __e83; if (number63(__k22)) { var ____id30 = __v12; var __k23 = ____id30[0]; @@ -1346,17 +1489,58 @@ setenv("%object", {_stash: true, special: function () { if (! string63(__k23)) { error("Illegal key: " + str(__k23)); } - __s9 = __s9 + __c9 + key(__k23) + __sep1 + compile(__v13); + __s111 = __s111 + __c9 + key(__k23) + __sep5 + compile(__v13); __c9 = ", "; } } - return __s9 + "}"; + var __e84; + if (target === "r") { + __e84 = ")"; + } else { + __e84 = "}"; + } + return __s111 + __e84; }}); setenv("%literal", {_stash: true, special: function () { - var __args111 = unstash(Array.prototype.slice.call(arguments, 0)); + var __args111 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return apply(cat, map(compile, __args111)); }}); -exports.run = run; +setenv("%stash", {_stash: true, special: function () { + var __args13 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); + if (target === "r") { + indent_level = indent_level + 1; + var __ind13 = indentation(); + var __s13 = ""; + var __c111 = ""; + var ____x182 = __args13; + var ____i28 = 0; + while (____i28 < _35(____x182)) { + var ____id33 = ____x182[____i28]; + var __k26 = ____id33[0]; + var __v16 = ____id33[1]; + __s13 = __s13 + __c111 + "\n" + __ind13 + inner(compile(__k26)) + " = " + compile(__v16); + __c111 = ","; + ____i28 = ____i28 + 1; + } + var ____x181 = __s13; + indent_level = indent_level - 1; + return ____x181; + } else { + var __l2 = ["%object", "\"_stash\"", true]; + var ____x184 = __args13; + var ____i29 = 0; + while (____i29 < _35(____x184)) { + var ____id34 = ____x184[____i29]; + var __k27 = ____id34[0]; + var __v17 = ____id34[1]; + add(__l2, literal(__k27)); + add(__l2, __v17); + ____i29 = ____i29 + 1; + } + return compile(__l2); + } +}}); +exports["run"] = run; exports["eval"] = _eval; -exports.expand = expand; -exports.compile = compile; +exports["expand"] = expand; +exports["compile"] = compile; diff --git a/bin/compiler.lua b/bin/compiler.lua index 6768275..103f351 100644 --- a/bin/compiler.lua +++ b/bin/compiler.lua @@ -1,17 +1,17 @@ -local reader = require("reader") -local function getenv(k, p) +local function getenv(k, p, env) + local __env = env or get_environment() if string63(k) then - local __i = edge(environment) + local __i = edge(__env) while __i >= 0 do - local __b = environment[__i + 1][k] + local __b = __env[__i + 1][k] if is63(__b) then - local __e21 + local __e29 if p then - __e21 = __b[p] + __e29 = __b[p] else - __e21 = __b + __e29 = __b end - return __e21 + return __e29 else __i = __i - 1 end @@ -56,7 +56,7 @@ function quoted(form) end end end -local function literal(s) +function literal(s) if string_literal63(s) then return s else @@ -65,14 +65,13 @@ local function literal(s) end local function stash42(args) if keys63(args) then - local __l = {"%object", "\"_stash\"", true} + local __l = {"%stash"} 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) + add(__l, {literal(__k), __v}) end end return join(args, {__l}) @@ -100,22 +99,22 @@ function bind(lh, rh) local __k1 = nil for __k1 in next, ____o1 do local __v1 = ____o1[__k1] - local __e22 + local __e30 if __k1 == "rest" then - __e22 = {"cut", __id, _35(lh)} + __e30 = {"cut", __id, _35(lh)} else - __e22 = {"get", __id, {"quote", bias(__k1)}} + __e30 = {"get", __id, {"quote", bias(__k1)}} end - local __x5 = __e22 + local __x6 = __e30 if is63(__k1) then - local __e23 + local __e31 if __v1 == true then - __e23 = __k1 + __e31 = __k1 else - __e23 = __v1 + __e31 = __v1 end - local __k2 = __e23 - __bs = join(__bs, bind(__k2, __x5)) + local __k2 = __e31 + __bs = join(__bs, bind(__k2, __x6)) end end return __bs @@ -127,11 +126,15 @@ end}) function bind42(args, body) local __args1 = {} local function rest() - __args1.rest = true + __args1["rest"] = true if target == "js" then return {"unstash", {"arguments%", _35(__args1)}} else - return {"unstash", {"list", "|...|"}} + if target == "r" then + return {"list", "|...|"} + else + return {"unstash", {"list", "|...|"}} + end end end if atom63(args) then @@ -147,20 +150,22 @@ function bind42(args, body) if atom63(__v2) then add(__args1, __v2) else - local __x30 = unique("x") - add(__args1, __x30) - __bs1 = join(__bs1, {__v2, __x30}) + local __x32 = unique("x") + add(__args1, __x32) + __bs1 = join(__bs1, {__v2, __x32}) end end end if keys63(args) then __bs1 = join(__bs1, {__r19, rest()}) - local __n3 = _35(__args1) - local __i4 = 0 - while __i4 < __n3 do - local __v3 = __args1[__i4 + 1] - __bs1 = join(__bs1, {__v3, {"destash!", __v3, __r19}}) - __i4 = __i4 + 1 + if not( target == "r") then + local __n3 = _35(__args1) + local __i4 = 0 + while __i4 < __n3 do + local __v3 = __args1[__i4 + 1] + __bs1 = join(__bs1, {__v3, {"destash!", __v3, __r19}}) + __i4 = __i4 + 1 + end end __bs1 = join(__bs1, {keys(args), __r19}) end @@ -179,52 +184,52 @@ end local function quasisplice63(x, depth) return can_unquote63(depth) and not atom63(x) and hd(x) == "unquote-splicing" end -local function expand_local(__x38) - local ____id1 = __x38 - local __x39 = ____id1[1] +local function expand_local(__x40) + local ____id1 = __x40 + local __x41 = ____id1[1] local __name = ____id1[2] local __value = ____id1[3] setenv(__name, {_stash = true, variable = true}) return {"%local", __name, macroexpand(__value)} end -local function expand_function(__x41) - local ____id2 = __x41 - local __x42 = ____id2[1] +local function expand_function(__x43) + local ____id2 = __x43 + local __x44 = ____id2[1] local __args = ____id2[2] local __body = cut(____id2, 2) - add(environment, {}) + add(get_environment(), {}) local ____o3 = __args local ____i5 = nil for ____i5 in next, ____o3 do - local ____x43 = ____o3[____i5] - setenv(____x43, {_stash = true, variable = true}) + local ____x45 = ____o3[____i5] + setenv(____x45, {_stash = true, variable = true}) end - local ____x44 = join({"%function", __args}, macroexpand(__body)) - drop(environment) - return ____x44 + local ____x46 = join({"%function", __args}, macroexpand(__body)) + drop(get_environment()) + return ____x46 end -local function expand_definition(__x46) - local ____id3 = __x46 - local __x47 = ____id3[1] +local function expand_definition(__x48) + local ____id3 = __x48 + local __x49 = ____id3[1] local __name1 = ____id3[2] local __args11 = ____id3[3] local __body1 = cut(____id3, 3) - add(environment, {}) + add(get_environment(), {}) local ____o4 = __args11 local ____i6 = nil for ____i6 in next, ____o4 do - local ____x48 = ____o4[____i6] - setenv(____x48, {_stash = true, variable = true}) + local ____x50 = ____o4[____i6] + setenv(____x50, {_stash = true, variable = true}) end - local ____x49 = join({__x47, __name1, __args11}, macroexpand(__body1)) - drop(environment) - return ____x49 + local ____x51 = join({__x49, __name1, __args11}, macroexpand(__body1)) + drop(get_environment()) + return ____x51 end local function expand_macro(form) return macroexpand(expand1(form)) end -function expand1(__x51) - local ____id4 = __x51 +function expand1(__x53) + local ____id4 = __x53 local __name2 = ____id4[1] local __body2 = cut(____id4, 1) return apply(macro_function(__name2), __body2) @@ -236,20 +241,20 @@ function macroexpand(form) if atom63(form) then return form else - local __x52 = hd(form) - if __x52 == "%local" then + local __x54 = hd(form) + if __x54 == "%local" then return expand_local(form) else - if __x52 == "%function" then + if __x54 == "%function" then return expand_function(form) else - if __x52 == "%global-function" then + if __x54 == "%global-function" then return expand_definition(form) else - if __x52 == "%local-function" then + if __x54 == "%local-function" then return expand_definition(form) else - if macro63(__x52) then + if macro63(__x54) then return expand_macro(form) else return map(macroexpand, form) @@ -268,26 +273,26 @@ local function quasiquote_list(form, depth) for __k4 in next, ____o5 do local __v4 = ____o5[__k4] if not number63(__k4) then - local __e24 + local __e32 if quasisplice63(__v4, depth) then - __e24 = quasiexpand(__v4[2]) + __e32 = quasiexpand(__v4[2]) else - __e24 = quasiexpand(__v4, depth) + __e32 = quasiexpand(__v4, depth) end - local __v5 = __e24 + local __v5 = __e32 last(__xs)[__k4] = __v5 end end - local ____x55 = form + local ____x57 = form local ____i8 = 0 - while ____i8 < _35(____x55) do - local __x56 = ____x55[____i8 + 1] - if quasisplice63(__x56, depth) then - local __x57 = quasiexpand(__x56[2]) - add(__xs, __x57) + while ____i8 < _35(____x57) do + local __x58 = ____x57[____i8 + 1] + if quasisplice63(__x58, depth) then + local __x59 = quasiexpand(__x58[2]) + add(__xs, __x59) add(__xs, {"list"}) else - add(last(__xs), quasiexpand(__x56, depth)) + add(last(__xs), quasiexpand(__x58, depth)) end ____i8 = ____i8 + 1 end @@ -337,8 +342,8 @@ function quasiexpand(form, depth) end end end -function expand_if(__x61) - local ____id5 = __x61 +function expand_if(__x63) + local ____id5 = __x63 local __a = ____id5[1] local __b1 = ____id5[2] local __c = cut(____id5, 2) @@ -367,59 +372,96 @@ 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 -local function id(id) - local __e25 - if number_code63(code(id, 0)) then - __e25 = "_" +local accessor_prefix = {["."] = true, ["@"] = true, ["$"] = true, ["\\"] = true, [":"] = true} +function accessor_id63(x) + return string63(x) and accessor_prefix[char(x, 0)] and some63(char(x, 1)) and not accessor_prefix[char(x, 1)] +end +local function prefix(id) + if target == "r" then + return "V" .. id + else + return id + end +end +function compile_id(id, raw63) + local __e33 + if raw63 then + __e33 = id + else + local __e34 + if accessor_id63(id) then + __e34 = clip(id, 1) + else + __e34 = id + end + __e33 = __e34 + end + local __id0 = __e33 + local __e35 + if raw63 then + __e35 = "" else - __e25 = "" + local __e36 + if number_code63(code(__id0, 0)) then + __e36 = prefix("_") + else + __e36 = "" + end + __e35 = __e36 end - local __id11 = __e25 + local __id11 = __e35 local __i10 = 0 - while __i10 < _35(id) do - local __c1 = char(id, __i10) + while __i10 < _35(__id0) do + local __c1 = char(__id0, __i10) local __n7 = code(__c1) - local __e26 - if __c1 == "-" and not( id == "-") then - __e26 = "_" + local __e37 + if __c1 == "-" and not( __id0 == "-") then + __e37 = "_" else - local __e27 + local __e38 if valid_code63(__n7) then - __e27 = __c1 + __e38 = __c1 else - local __e28 + local __e39 if __i10 == 0 then - __e28 = "_" .. __n7 + __e39 = prefix("_") .. __n7 else - __e28 = __n7 + __e39 = __n7 end - __e27 = __e28 + __e38 = __e39 end - __e26 = __e27 + __e37 = __e38 end - local __c11 = __e26 + local __c11 = __e37 __id11 = __id11 .. __c11 __i10 = __i10 + 1 end + local __e40 if reserved63(__id11) then - return "_" .. __id11 + __e40 = prefix("_") .. __id11 else - return __id11 + __e40 = __id11 + end + local __id21 = __e40 + if id == __id0 then + return __id21 + else + return char(id, 0) .. __id21 end end function valid_id63(x) - return some63(x) and x == id(x) + return some63(x) and x == compile_id(x, "raw") end local __names = {} function unique(x) - local __x65 = id(x) - if __names[__x65] then - local __i11 = __names[__x65] - __names[__x65] = __names[__x65] + 1 - return unique(__x65 .. __i11) + local __x67 = compile_id(x) + if __names[__x67] then + local __i11 = __names[__x67] + __names[__x67] = __names[__x67] + 1 + return unique(__x67 .. __i11) else - __names[__x65] = 1 - return "__" .. __x65 + __names[__x67] = 1 + return prefix("__") .. __x67 end end function key(k) @@ -430,7 +472,11 @@ function key(k) if target == "js" then return k else - return "[" .. k .. "]" + if target == "r" then + return k + else + return "[" .. k .. "]" + end end end end @@ -440,52 +486,56 @@ function mapo(f, t) local __k5 = nil for __k5 in next, ____o7 do local __v6 = ____o7[__k5] - local __x66 = f(__v6) - if is63(__x66) then + local __x68 = f(__v6) + if is63(__x68) then add(__o6, literal(__k5)) - add(__o6, __x66) + add(__o6, __x68) end end return __o6 end -local ____x68 = {} -local ____x69 = {} -____x69.js = "!" -____x69.lua = "not" -____x68["not"] = ____x69 local ____x70 = {} -____x70["*"] = true -____x70["/"] = true -____x70["%"] = true local ____x71 = {} +____x71["r"] = "!" +____x71["js"] = "!" +____x71["lua"] = "not" +____x70["not"] = ____x71 local ____x72 = {} -____x72.js = "+" -____x72.lua = ".." -____x71.cat = ____x72 +____x72["*"] = true +____x72["/"] = true +____x72["%"] = true local ____x73 = {} -____x73["+"] = true -____x73["-"] = true local ____x74 = {} -____x74["<"] = true -____x74[">"] = true -____x74["<="] = true -____x74[">="] = true +____x74["js"] = "+" +____x74["lua"] = ".." +____x73["cat"] = ____x74 local ____x75 = {} +____x75["+"] = true +____x75["-"] = true local ____x76 = {} -____x76.js = "===" -____x76.lua = "==" -____x75["="] = ____x76 +____x76["<"] = true +____x76[">"] = true +____x76["<="] = true +____x76[">="] = true local ____x77 = {} local ____x78 = {} -____x78.js = "&&" -____x78.lua = "and" -____x77["and"] = ____x78 +____x78["r"] = "==" +____x78["js"] = "===" +____x78["lua"] = "==" +____x77["="] = ____x78 local ____x79 = {} local ____x80 = {} -____x80.js = "||" -____x80.lua = "or" -____x79["or"] = ____x80 -local infix = {____x68, ____x70, ____x71, ____x73, ____x74, ____x75, ____x77, ____x79} +____x80["r"] = "&&" +____x80["js"] = "&&" +____x80["lua"] = "and" +____x79["and"] = ____x80 +local ____x81 = {} +local ____x82 = {} +____x82["r"] = "||" +____x82["js"] = "||" +____x82["lua"] = "or" +____x81["or"] = ____x82 +local infix = {____x70, ____x72, ____x73, ____x75, ____x76, ____x77, ____x79, ____x81} local function unary63(form) return two63(form) and in63(hd(form), {"not", "-"}) end @@ -509,12 +559,12 @@ local function precedence(form) end local function getop(op) return find(function (level) - local __x82 = level[op] - if __x82 == true then + local __x84 = level[op] + if __x84 == true then return op else - if is63(__x82) then - return __x82[target] + if is63(__x84) then + return __x84[target] end end end, infix) @@ -525,14 +575,14 @@ end function infix_operator63(x) return obj63(x) and infix63(hd(x)) end -local function compile_args(args) +function compile_args(args) local __s1 = "(" local __c2 = "" - local ____x83 = args + local ____x85 = args local ____i15 = 0 - while ____i15 < _35(____x83) do - local __x84 = ____x83[____i15 + 1] - __s1 = __s1 .. __c2 .. compile(__x84) + while ____i15 < _35(____x85) do + local __x86 = ____x85[____i15 + 1] + __s1 = __s1 .. __c2 .. compile(__x86) __c2 = ", " ____i15 = ____i15 + 1 end @@ -543,60 +593,82 @@ local function escape_newlines(s) local __i16 = 0 while __i16 < _35(s) do local __c3 = char(s, __i16) - local __e29 + local __e41 if __c3 == "\n" then - __e29 = "\\n" + __e41 = "\\n" else - local __e30 + local __e42 if __c3 == "\r" then - __e30 = "\\r" + __e42 = "\\r" else - __e30 = __c3 + __e42 = __c3 end - __e29 = __e30 + __e41 = __e42 end - __s11 = __s11 .. __e29 + __s11 = __s11 .. __e41 __i16 = __i16 + 1 end return __s11 end -local function compile_atom(x) - if x == "nil" and target == "lua" then - return x +local function compile_nil(x) + if target == "lua" then + return "nil" else - if x == "nil" then + if target == "js" then return "undefined" else - if id_literal63(x) then - return inner(x) + if target == "r" then + return "NULL" + else + return "nil" + end + end + end +end +local function compile_boolean(x) + if target == "r" then + if x then + return "TRUE" + else + return "FALSE" + end + else + if x then + return "true" + else + return "false" + end + end +end +local function compile_atom(x) + if x == "nil" then + return compile_nil(x) + else + if id_literal63(x) then + return inner(x) + else + if string_literal63(x) then + return escape_newlines(x) else - if string_literal63(x) then - return escape_newlines(x) + if string63(x) then + return compile_id(x) else - if string63(x) then - return id(x) + if boolean63(x) then + return compile_boolean(x) else - if boolean63(x) then - if x then - return "true" - else - return "false" - end + if nan63(x) then + return "nan" else - if nan63(x) then - return "nan" + if x == inf then + return "inf" else - if x == inf then - return "inf" + if x == _inf then + return "-inf" else - if x == _inf then - return "-inf" + if number63(x) then + return x .. "" else - if number63(x) then - return x .. "" - else - return error("Cannot compile atom: " .. str(x)) - end + return error("Cannot compile atom: " .. str(x)) end end end @@ -620,12 +692,12 @@ local function terminator(stmt63) end local function compile_special(form, stmt63) local ____id6 = form - local __x85 = ____id6[1] + local __x87 = ____id6[1] local __args2 = cut(____id6, 1) - local ____id7 = getenv(__x85) - local __special = ____id7.special - local __stmt = ____id7.stmt - local __self_tr63 = ____id7.tr + local ____id7 = getenv(__x87) + local __special = ____id7["special"] + local __stmt = ____id7["stmt"] + local __self_tr63 = ____id7["tr"] local __tr = terminator(stmt63 and not __self_tr63) return apply(__special, __args2) .. __tr end @@ -643,18 +715,18 @@ local function compile_call(form) end end local function op_delims(parent, child, ...) - local ____r57 = unstash({...}) - local __parent = destash33(parent, ____r57) - local __child = destash33(child, ____r57) - local ____id8 = ____r57 - local __right = ____id8.right - local __e31 + local ____r61 = unstash({...}) + local __parent = destash33(parent, ____r61) + local __child = destash33(child, ____r61) + local ____id8 = ____r61 + local __right = ____id8["right"] + local __e43 if __right then - __e31 = _6261 + __e43 = _6261 else - __e31 = _62 + __e43 = _62 end - if __e31(precedence(__child), precedence(__parent)) then + if __e43(precedence(__child), precedence(__parent)) then return {"(", ")"} else return {"", ""} @@ -682,63 +754,63 @@ local function compile_infix(form) end end function compile_function(args, body, ...) - local ____r59 = unstash({...}) - local __args4 = destash33(args, ____r59) - local __body3 = destash33(body, ____r59) - local ____id13 = ____r59 - local __name3 = ____id13.name - local __prefix = ____id13.prefix - local __e32 + local ____r63 = unstash({...}) + local __args4 = destash33(args, ____r63) + local __body3 = destash33(body, ____r63) + local ____id13 = ____r63 + local __name3 = ____id13["name"] + local __prefix = ____id13["prefix"] + local __e44 if __name3 then - __e32 = compile(__name3) + __e44 = compile(__name3) else - __e32 = "" + __e44 = "" end - local __id14 = __e32 - local __e33 - if target == "lua" and __args4.rest then - __e33 = join(__args4, {"|...|"}) + local __id14 = __e44 + local __e45 + if (target == "lua" or target == "r") and __args4["rest"] then + __e45 = join(__args4, {"|...|"}) else - __e33 = __args4 + __e45 = __args4 end - local __args12 = __e33 + local __args12 = __e45 local __args5 = compile_args(__args12) indent_level = indent_level + 1 - local ____x91 = compile(__body3, {_stash = true, stmt = true}) + local ____x93 = compile(__body3, {_stash = true, stmt = true}) indent_level = indent_level - 1 - local __body4 = ____x91 + local __body4 = ____x93 local __ind = indentation() - local __e34 + local __e46 if __prefix then - __e34 = __prefix .. " " + __e46 = __prefix .. " " else - __e34 = "" + __e46 = "" end - local __p = __e34 - local __e35 - if target == "js" then - __e35 = "" + local __p = __e46 + local __e47 + if target == "lua" then + __e47 = "end" else - __e35 = "end" + __e47 = "" end - local __tr1 = __e35 + local __tr1 = __e47 if __name3 then __tr1 = __tr1 .. "\n" end - if target == "js" then - return "function " .. __id14 .. __args5 .. " {\n" .. __body4 .. __ind .. "}" .. __tr1 - else + if target == "lua" then return __p .. "function " .. __id14 .. __args5 .. "\n" .. __body4 .. __ind .. __tr1 + else + return "function " .. __id14 .. __args5 .. " {\n" .. __body4 .. __ind .. "}" .. __tr1 end end local function can_return63(form) - return is63(form) and (atom63(form) or not( hd(form) == "return") and not statement63(hd(form))) + return is63(form) and not( target == "r") and (atom63(form) or not( hd(form) == "return") and not statement63(hd(form))) end function compile(form, ...) - local ____r61 = unstash({...}) - local __form = destash33(form, ____r61) - local ____id15 = ____r61 - local __stmt1 = ____id15.stmt + local ____r65 = unstash({...}) + local __form = destash33(form, ____r65) + local ____id15 = ____r65 + local __stmt1 = ____id15["stmt"] if nil63(__form) then return "" else @@ -746,26 +818,26 @@ function compile(form, ...) return compile_special(__form, __stmt1) else local __tr2 = terminator(__stmt1) - local __e36 + local __e48 if __stmt1 then - __e36 = indentation() + __e48 = indentation() else - __e36 = "" + __e48 = "" end - local __ind1 = __e36 - local __e37 + local __ind1 = __e48 + local __e49 if atom63(__form) then - __e37 = compile_atom(__form) + __e49 = compile_atom(__form) else - local __e38 + local __e50 if infix63(hd(__form)) then - __e38 = compile_infix(__form) + __e50 = compile_infix(__form) else - __e38 = compile_call(__form) + __e50 = compile_call(__form) end - __e37 = __e38 + __e49 = __e50 end - local __form1 = __e37 + local __form1 = __e49 return __ind1 .. __form1 .. __tr2 end end @@ -773,29 +845,32 @@ end local function lower_statement(form, tail63) local __hoist = {} local __e = lower(form, __hoist, true, tail63) - local __e39 + local __e51 if some63(__hoist) and is63(__e) then - __e39 = join({"do"}, __hoist, {__e}) + __e51 = join({"do"}, __hoist, {__e}) else - local __e40 + local __e52 if is63(__e) then - __e40 = __e + __e52 = __e else - local __e41 + local __e53 if _35(__hoist) > 1 then - __e41 = join({"do"}, __hoist) + __e53 = join({"do"}, __hoist) else - __e41 = hd(__hoist) + __e53 = hd(__hoist) end - __e40 = __e41 + __e52 = __e53 end - __e39 = __e40 + __e51 = __e52 end - return either(__e39, {"do"}) + return either(__e51, {"do"}) end local function lower_body(body, tail63) return lower_statement(join({"do"}, body), tail63) end +local function lower_block(body, tail63) + return join({"%block"}, tl(lower_body(body, tail63))) +end local function literal63(form) return atom63(form) or hd(form) == "%array" or hd(form) == "%object" end @@ -803,11 +878,11 @@ 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 ____x98 = almost(args) + local ____x101 = almost(args) local ____i17 = 0 - while ____i17 < _35(____x98) do - local __x99 = ____x98[____i17 + 1] - local ____y = lower(__x99, hoist, stmt63) + while ____i17 < _35(____x101) do + local __x102 = ____x101[____i17 + 1] + local ____y = lower(__x102, hoist, stmt63) if yes(____y) then local __e1 = ____y if standalone63(__e1) then @@ -840,19 +915,19 @@ local function lower_if(args, hoist, stmt63, tail63) local ___then = ____id17[2] local ___else = ____id17[3] if stmt63 then - local __e43 + local __e55 if is63(___else) then - __e43 = {lower_body({___else}, tail63)} + __e55 = {lower_body({___else}, tail63)} end - return add(hoist, join({"%if", lower(__cond, hoist), lower_body({___then}, tail63)}, __e43)) + return add(hoist, join({"%if", lower(__cond, hoist), lower_body({___then}, tail63)}, __e55)) else local __e3 = unique("e") add(hoist, {"%local", __e3}) - local __e42 + local __e54 if is63(___else) then - __e42 = {lower({"%set", __e3, ___else})} + __e54 = {lower({"%set", __e3, ___else})} end - add(hoist, join({"%if", lower(__cond, hoist), lower({"%set", __e3, ___then})}, __e42)) + add(hoist, join({"%if", lower(__cond, hoist), lower({"%set", __e3, ___then})}, __e54)) return __e3 end end @@ -864,13 +939,13 @@ local function lower_short(x, args, hoist) local __b11 = lower(__b4, __hoist1) if some63(__hoist1) then local __id19 = unique("id") - local __e44 + local __e56 if x == "and" then - __e44 = {"%if", __id19, __b4, __id19} + __e56 = {"%if", __id19, __b4, __id19} else - __e44 = {"%if", __id19, __id19, __b4} + __e56 = {"%if", __id19, __id19, __b4} end - return lower({"do", {"%local", __id19, __a3}, __e44}, hoist) + return lower({"do", {"%local", __id19, __a3}, __e56}, hoist) else return {x, lower(__a3, hoist), __b11} end @@ -884,19 +959,19 @@ local function lower_while(args, hoist) local __body5 = cut(____id20, 1) local __pre = {} local __c5 = lower(__c4, __pre) - local __e45 + local __e57 if none63(__pre) then - __e45 = {"while", __c5, lower_body(__body5)} + __e57 = {"while", __c5, lower_body(__body5)} else - __e45 = {"while", true, join({"do"}, __pre, {{"%if", {"not", __c5}, {"break"}}, lower_body(__body5)})} + __e57 = {"while", true, join({"do"}, __pre, {{"%if", {"not", __c5}, {"break"}}, lower_body(__body5)})} end - return add(hoist, __e45) + return add(hoist, __e57) end local function lower_for(args, hoist) - local ____id21 = args - local __t = ____id21[1] - local __k7 = ____id21[2] - local __body6 = cut(____id21, 2) + local ____id211 = args + local __t = ____id211[1] + local __k7 = ____id211[2] + local __body6 = cut(____id211, 2) return add(hoist, {"%for", lower(__t, hoist), __k7, lower_body(__body6)}) end local function lower_function(args) @@ -927,10 +1002,10 @@ local function lower_pairwise(form) if pairwise63(form) then local __e4 = {} local ____id24 = form - local __x128 = ____id24[1] + local __x131 = ____id24[1] local __args7 = cut(____id24, 1) reduce(function (a, b) - add(__e4, {__x128, a, b}) + add(__e4, {__x131, a, b}) return a end, __args7) return join({"and"}, reverse(__e4)) @@ -944,10 +1019,10 @@ end local function lower_infix(form, hoist) local __form3 = lower_pairwise(form) local ____id25 = __form3 - local __x131 = ____id25[1] + local __x134 = ____id25[1] local __args8 = cut(____id25, 1) return lower(reduce(function (a, b) - return {__x131, b, a} + return {__x134, b, a} end, reverse(__args8)), hoist) end local function lower_special(form, hoist) @@ -970,42 +1045,46 @@ function lower(form, hoist, stmt63, tail63) return lower_infix(form, hoist) else local ____id26 = form - local __x134 = ____id26[1] + local __x137 = ____id26[1] local __args9 = cut(____id26, 1) - if __x134 == "do" then + if __x137 == "do" then return lower_do(__args9, hoist, stmt63, tail63) else - if __x134 == "%call" then - return lower(__args9, hoist, stmt63, tail63) + if __x137 == "%block" then + return lower_block(__args9, tail63) else - if __x134 == "%set" then - return lower_set(__args9, hoist, stmt63, tail63) + if __x137 == "%call" then + return lower(__args9, hoist, stmt63, tail63) else - if __x134 == "%if" then - return lower_if(__args9, hoist, stmt63, tail63) + if __x137 == "%set" then + return lower_set(__args9, hoist, stmt63, tail63) else - if __x134 == "%try" then - return lower_try(__args9, hoist, tail63) + if __x137 == "%if" then + return lower_if(__args9, hoist, stmt63, tail63) else - if __x134 == "while" then - return lower_while(__args9, hoist) + if __x137 == "%try" then + return lower_try(__args9, hoist, tail63) else - if __x134 == "%for" then - return lower_for(__args9, hoist) + if __x137 == "while" then + return lower_while(__args9, hoist) else - if __x134 == "%function" then - return lower_function(__args9) + if __x137 == "%for" then + return lower_for(__args9, hoist) else - if __x134 == "%local-function" or __x134 == "%global-function" then - return lower_definition(__x134, __args9, hoist) + if __x137 == "%function" then + return lower_function(__args9) else - if in63(__x134, {"and", "or"}) then - return lower_short(__x134, __args9, hoist) + if __x137 == "%local-function" or __x137 == "%global-function" then + return lower_definition(__x137, __args9, hoist) else - if statement63(__x134) then - return lower_special(form, hoist) + if in63(__x137, {"and", "or"}) then + return lower_short(__x137, __args9, hoist) else - return lower_call(form, hoist) + if statement63(__x137) then + return lower_special(form, hoist) + else + return lower_call(form, hoist) + end end end end @@ -1049,16 +1128,16 @@ end setenv("do", {_stash = true, special = function (...) local __forms1 = unstash({...}) local __s3 = "" - local ____x140 = __forms1 + local ____x143 = __forms1 local ____i19 = 0 - while ____i19 < _35(____x140) do - local __x141 = ____x140[____i19 + 1] - if target == "lua" and immediate_call63(__x141) and "\n" == char(__s3, edge(__s3)) then + while ____i19 < _35(____x143) do + local __x144 = ____x143[____i19 + 1] + if target == "lua" and immediate_call63(__x144) and "\n" == char(__s3, edge(__s3)) then __s3 = clip(__s3, 0, edge(__s3)) .. ";\n" end - __s3 = __s3 .. compile(__x141, {_stash = true, stmt = true}) - if not atom63(__x141) then - if hd(__x141) == "return" or hd(__x141) == "break" then + __s3 = __s3 .. compile(__x144, {_stash = true, stmt = true}) + if not atom63(__x144) then + if hd(__x144) == "return" or hd(__x144) == "break" then break end end @@ -1066,60 +1145,76 @@ setenv("do", {_stash = true, special = function (...) end return __s3 end, stmt = true, tr = true}) +setenv("%block", {_stash = true, special = function (...) + local __forms3 = unstash({...}) + local __s5 = "{\n" + indent_level = indent_level + 1 + local ____x150 = __forms3 + local ____i21 = 0 + while ____i21 < _35(____x150) do + local __x151 = ____x150[____i21 + 1] + __s5 = __s5 .. compile(__x151, {_stash = true, stmt = true}) + ____i21 = ____i21 + 1 + end + local ____x149 + indent_level = indent_level - 1 + __s5 = __s5 .. indentation() .. "}" + return __s5 +end}) setenv("%if", {_stash = true, special = function (cond, cons, alt) local __cond2 = compile(cond) indent_level = indent_level + 1 - local ____x144 = compile(cons, {_stash = true, stmt = true}) + local ____x154 = compile(cons, {_stash = true, stmt = true}) indent_level = indent_level - 1 - local __cons1 = ____x144 - local __e46 + local __cons1 = ____x154 + local __e58 if alt then indent_level = indent_level + 1 - local ____x145 = compile(alt, {_stash = true, stmt = true}) + local ____x155 = compile(alt, {_stash = true, stmt = true}) indent_level = indent_level - 1 - __e46 = ____x145 + __e58 = ____x155 end - local __alt1 = __e46 + local __alt1 = __e58 local __ind3 = indentation() - local __s5 = "" - if target == "js" then - __s5 = __s5 .. __ind3 .. "if (" .. __cond2 .. ") {\n" .. __cons1 .. __ind3 .. "}" + local __s7 = "" + if target == "lua" then + __s7 = __s7 .. __ind3 .. "if " .. __cond2 .. " then\n" .. __cons1 else - __s5 = __s5 .. __ind3 .. "if " .. __cond2 .. " then\n" .. __cons1 + __s7 = __s7 .. __ind3 .. "if (" .. __cond2 .. ") {\n" .. __cons1 .. __ind3 .. "}" end - if __alt1 and target == "js" then - __s5 = __s5 .. " else {\n" .. __alt1 .. __ind3 .. "}" + if __alt1 and target == "lua" then + __s7 = __s7 .. __ind3 .. "else\n" .. __alt1 else if __alt1 then - __s5 = __s5 .. __ind3 .. "else\n" .. __alt1 + __s7 = __s7 .. " else {\n" .. __alt1 .. __ind3 .. "}" end end if target == "lua" then - return __s5 .. __ind3 .. "end\n" + return __s7 .. __ind3 .. "end\n" else - return __s5 .. "\n" + return __s7 .. "\n" end end, stmt = true, tr = true}) setenv("while", {_stash = true, special = function (cond, form) local __cond4 = compile(cond) indent_level = indent_level + 1 - local ____x147 = compile(form, {_stash = true, stmt = true}) + local ____x157 = compile(form, {_stash = true, stmt = true}) indent_level = indent_level - 1 - local __body10 = ____x147 + local __body10 = ____x157 local __ind5 = indentation() - if target == "js" then - return __ind5 .. "while (" .. __cond4 .. ") {\n" .. __body10 .. __ind5 .. "}\n" - else + if target == "lua" then return __ind5 .. "while " .. __cond4 .. " do\n" .. __body10 .. __ind5 .. "end\n" + else + return __ind5 .. "while (" .. __cond4 .. ") {\n" .. __body10 .. __ind5 .. "}\n" end end, stmt = true, tr = true}) setenv("%for", {_stash = true, special = function (t, k, form) local __t2 = compile(t) local __ind7 = indentation() indent_level = indent_level + 1 - local ____x149 = compile(form, {_stash = true, stmt = true}) + local ____x159 = compile(form, {_stash = true, stmt = true}) indent_level = indent_level - 1 - local __body12 = ____x149 + local __body12 = ____x159 if target == "lua" then return __ind7 .. "for " .. k .. " in next, " .. __t2 .. " do\n" .. __body12 .. __ind7 .. "end\n" else @@ -1130,14 +1225,14 @@ setenv("%try", {_stash = true, special = function (form) local __e8 = unique("e") local __ind9 = indentation() indent_level = indent_level + 1 - local ____x154 = compile(form, {_stash = true, stmt = true}) + local ____x164 = compile(form, {_stash = true, stmt = true}) indent_level = indent_level - 1 - local __body14 = ____x154 + local __body14 = ____x164 local __hf1 = {"return", {"%array", false, __e8}} indent_level = indent_level + 1 - local ____x157 = compile(__hf1, {_stash = true, stmt = true}) + local ____x167 = compile(__hf1, {_stash = true, stmt = true}) indent_level = indent_level - 1 - local __h1 = ____x157 + local __h1 = ____x167 return __ind9 .. "try {\n" .. __body14 .. __ind9 .. "}\n" .. __ind9 .. "catch (" .. __e8 .. ") {\n" .. __h1 .. __ind9 .. "}\n" end, stmt = true, tr = true}) setenv("%delete", {_stash = true, special = function (place) @@ -1151,29 +1246,29 @@ setenv("%function", {_stash = true, special = function (args, body) end}) setenv("%global-function", {_stash = true, special = function (name, args, body) if target == "lua" then - local __x161 = compile_function(args, body, {_stash = true, name = name}) - return indentation() .. __x161 + local __x171 = compile_function(args, body, {_stash = true, name = name}) + return indentation() .. __x171 else return compile({"%set", name, {"%function", args, body}}, {_stash = true, stmt = true}) end end, stmt = true, tr = true}) setenv("%local-function", {_stash = true, special = function (name, args, body) if target == "lua" then - local __x167 = compile_function(args, body, {_stash = true, name = name, prefix = "local"}) - return indentation() .. __x167 + local __x177 = compile_function(args, body, {_stash = true, name = name, prefix = "local"}) + return indentation() .. __x177 else return compile({"%local", name, {"%function", args, body}}, {_stash = true, stmt = true}) end end, stmt = true, tr = true}) setenv("return", {_stash = true, special = function (x) - local __e47 + local __e59 if nil63(x) then - __e47 = "return" + __e59 = "return" else - __e47 = "return " .. compile(x) + __e59 = "return " .. compile(x) end - local __x171 = __e47 - return indentation() .. __x171 + local __x181 = __e59 + return indentation() .. __x181 end, stmt = true}) setenv("new", {_stash = true, special = function (x) return "new " .. compile(x) @@ -1182,45 +1277,71 @@ setenv("typeof", {_stash = true, special = function (x) return "typeof(" .. compile(x) .. ")" end}) setenv("throw", {_stash = true, special = function (x) - local __e48 + local __e60 if target == "js" then - __e48 = "throw " .. compile(x) + __e60 = "throw " .. compile(x) else - __e48 = "error(" .. compile(x) .. ")" + __e60 = "error(" .. compile(x) .. ")" end - local __e12 = __e48 + local __e12 = __e60 return indentation() .. __e12 end, stmt = true}) setenv("%local", {_stash = true, special = function (name, value) local __id28 = compile(name) local __value11 = compile(value) - local __e49 + local __e61 + if target == "r" then + __e61 = " <- " + else + __e61 = " = " + end + local __sep1 = __e61 + local __e62 if is63(value) then - __e49 = " = " .. __value11 + __e62 = __sep1 .. __value11 else - __e49 = "" + __e62 = "" end - local __rh2 = __e49 - local __e50 + local __rh2 = __e62 + local __e63 if target == "js" then - __e50 = "var " + __e63 = "var " else - __e50 = "local " + local __e64 + if target == "lua" then + __e64 = "local " + else + __e64 = "" + end + __e63 = __e64 end - local __keyword1 = __e50 + local __keyword1 = __e63 local __ind11 = indentation() return __ind11 .. __keyword1 .. __id28 .. __rh2 end, stmt = true}) setenv("%set", {_stash = true, special = function (lh, rh) - local __lh2 = compile(lh) - local __e51 + local __lh12 = compile(lh) + local __e65 if nil63(rh) then - __e51 = "nil" + __e65 = "nil" else - __e51 = rh + __e65 = rh + end + local __rh13 = compile(__e65) + local __e66 + if target == "r" then + local __e67 + if hd63(lh, "get") then + __e67 = " <<- " + else + __e67 = " <- " + end + __e66 = __e67 + else + __e66 = " = " end - local __rh4 = compile(__e51) - return indentation() .. __lh2 .. " = " .. __rh4 + local __sep3 = __e66 + return indentation() .. __lh12 .. __sep3 .. __rh13 end, stmt = true}) setenv("get", {_stash = true, special = function (t, k) local __t12 = compile(t) @@ -1228,53 +1349,75 @@ setenv("get", {_stash = true, special = function (t, k) if target == "lua" and char(__t12, 0) == "{" or infix_operator63(t) then __t12 = "(" .. __t12 .. ")" end - if string_literal63(k) and valid_id63(inner(k)) then - return __t12 .. "." .. inner(k) + if accessor_id63(k) then + return __t12 .. __k12 else - return __t12 .. "[" .. __k12 .. "]" + if target == "r" then + return __t12 .. "[[" .. __k12 .. "]]" + else + return __t12 .. "[" .. __k12 .. "]" + end end end}) setenv("%array", {_stash = true, special = function (...) - local __forms3 = unstash({...}) - local __e52 - if target == "lua" then - __e52 = "{" + local __forms5 = unstash({...}) + local __e68 + if target == "r" then + __e68 = "list(" else - __e52 = "[" + local __e69 + if target == "lua" then + __e69 = "{" + else + __e69 = "[" + end + __e68 = __e69 end - local __open1 = __e52 - local __e53 - if target == "lua" then - __e53 = "}" + local __open1 = __e68 + local __e70 + if target == "r" then + __e70 = ")" else - __e53 = "]" + local __e71 + if target == "lua" then + __e71 = "}" + else + __e71 = "]" + end + __e70 = __e71 end - local __close1 = __e53 - local __s7 = "" + local __close1 = __e70 + local __s9 = "" local __c7 = "" - local ____o10 = __forms3 + local ____o10 = __forms5 local __k10 = nil for __k10 in next, ____o10 do local __v9 = ____o10[__k10] if number63(__k10) then - __s7 = __s7 .. __c7 .. compile(__v9) + __s9 = __s9 .. __c7 .. compile(__v9) __c7 = ", " end end - return __open1 .. __s7 .. __close1 + return __open1 .. __s9 .. __close1 end}) setenv("%object", {_stash = true, special = function (...) - local __forms5 = unstash({...}) - local __s9 = "{" + local __forms7 = unstash({...}) + local __e72 + if target == "r" then + __e72 = "list(" + else + __e72 = "{" + end + local __s111 = __e72 local __c9 = "" - local __e54 - if target == "lua" then - __e54 = " = " + local __e73 + if target == "js" then + __e73 = ": " else - __e54 = ": " + __e73 = " = " end - local __sep1 = __e54 - local ____o12 = pair(__forms5) + local __sep5 = __e73 + local ____o12 = pair(__forms7) local __k14 = nil for __k14 in next, ____o12 do local __v12 = ____o12[__k14] @@ -1285,14 +1428,55 @@ setenv("%object", {_stash = true, special = function (...) if not string63(__k15) then error("Illegal key: " .. str(__k15)) end - __s9 = __s9 .. __c9 .. key(__k15) .. __sep1 .. compile(__v13) + __s111 = __s111 .. __c9 .. key(__k15) .. __sep5 .. compile(__v13) __c9 = ", " end end - return __s9 .. "}" + local __e74 + if target == "r" then + __e74 = ")" + else + __e74 = "}" + end + return __s111 .. __e74 end}) setenv("%literal", {_stash = true, special = function (...) local __args111 = unstash({...}) return apply(cat, map(compile, __args111)) end}) +setenv("%stash", {_stash = true, special = function (...) + local __args13 = unstash({...}) + if target == "r" then + indent_level = indent_level + 1 + local __ind13 = indentation() + local __s13 = "" + local __c111 = "" + local ____x191 = __args13 + local ____i28 = 0 + while ____i28 < _35(____x191) do + local ____id33 = ____x191[____i28 + 1] + local __k18 = ____id33[1] + local __v16 = ____id33[2] + __s13 = __s13 .. __c111 .. "\n" .. __ind13 .. inner(compile(__k18)) .. " = " .. compile(__v16) + __c111 = "," + ____i28 = ____i28 + 1 + end + local ____x190 = __s13 + indent_level = indent_level - 1 + return ____x190 + else + local __l2 = {"%object", "\"_stash\"", true} + local ____x193 = __args13 + local ____i29 = 0 + while ____i29 < _35(____x193) do + local ____id34 = ____x193[____i29 + 1] + local __k19 = ____id34[1] + local __v17 = ____id34[2] + add(__l2, literal(__k19)) + add(__l2, __v17) + ____i29 = ____i29 + 1 + end + return compile(__l2) + end +end}) return {run = run, ["eval"] = _eval, expand = expand, compile = compile} diff --git a/bin/lumen.R b/bin/lumen.R new file mode 100644 index 0000000..1c993b2 --- /dev/null +++ b/bin/lumen.R @@ -0,0 +1,1191 @@ +environment <- list(list()) +target <- "r" +get_environment <- function () { + environment +} +nil63 <- function (x) { + is.null(x) +} +is63 <- function (x) { + ! nil63(x) +} +no <- function (x) { + nil63(x) || x == FALSE +} +yes <- function (x) { + ! no(x) +} +either <- function (x, y) { + if (is63(x)) { + x + } else { + y + } +} +has63 <- function (l, k) { +k %in% names(l) +} +indices <- function (l) { + Map(function (k, i) { + if (k == "") { + i + } else { + k + } + }, names(l), seq_len(length(l))) +} +V_35 <- function (x) { + if (is.character(x)) { + nchar(x) + } else { + length(x) - length(Filter(nchar, names(x))) + } +} +none63 <- function (x) { + V_35(x) == 0 +} +some63 <- function (x) { + V_35(x) > 0 +} +one63 <- function (x) { + V_35(x) == 1 +} +two63 <- function (x) { + V_35(x) == 2 +} +hd <- function (l) { +l[[1]] +} +type <- function (x) { + mode(x) +} +string63 <- function (x) { + type(x) == "character" +} +number63 <- function (x) { + type(x) == "numeric" +} +boolean63 <- function (x) { + type(x) == "logical" +} +function63 <- function (x) { + type(x) == "function" +} +obj63 <- function (x) { + is63(x) && type(x) == "list" +} +atom63 <- function (x) { + nil63(x) || string63(x) || number63(x) || boolean63(x) +} +hd63 <- function (l, x) { + obj63(l) && hd(l) == x +} +nan <- 0 / 0 +inf <- 1 / 0 +_inf <- - inf +nan63 <- function (n) { + is.nan(n) +} +inf63 <- function (n) { + ! is.finite(n) +} +clip <- function (s, from, upto) { + substr(s, from + 1, upto) +} +cut <- function (x, from, upto) { + V__l <- list() + V__j <- 0 + V__e + if (nil63(from) || from < 0) { + V__e <- 0 + } else { + V__e <- from + } + V__i <- V__e + V__n <- V_35(x) + V__e1 + if (nil63(upto) || upto > V__n) { + V__e1 <- V__n + } else { + V__e1 <- upto + } + V__upto <- V__e1 + while (V__i < V__upto) { + V__l[[V__j + 1]] <<- x[[V__i + 1]] + V__i <- V__i + 1 + V__j <- V__j + 1 + } + V__V__o <- x + V__k <- NULL + for (V__k in indices(V__V__o)) { + V__v <- V__V__o[[V__k]] + if (! number63(V__k)) { + V__l[[V__k]] <<- V__v + } + } + V__l +} +keys <- function (x) { + V__t <- list() + V__V__o1 <- x + V__k1 <- NULL + for (V__k1 in indices(V__V__o1)) { + V__v1 <- V__V__o1[[V__k1]] + if (! number63(V__k1)) { + V__t[[V__k1]] <<- V__v1 + } + } + V__t +} +edge <- function (x) { + V_35(x) - 1 +} +inner <- function (x) { + clip(x, 1, edge(x)) +} +tl <- function (l) { + cut(l, 1) +} +char <- function (s, n) { +} +code <- function (s, n) { +} +string_literal63 <- function (x) { + string63(x) && char(x, 0) == "\"" +} +id_literal63 <- function (x) { + string63(x) && char(x, 0) == "|" +} +add <- function (l, x) { +} +drop <- function (l) { +} +last <- function (l) { +l[[edge(l) + 1]] +} +almost <- function (l) { + cut(l, 0, edge(l)) +} +reverse <- function (l) { + V__l1 <- keys(l) + V__i3 <- edge(l) + while (V__i3 >= 0) { + add(V__l1, l[[V__i3 + 1]]) + V__i3 <- V__i3 - 1 + } + V__l1 +} +reduce <- function (f, x) { + if (none63(x)) { + NULL + } else { + if (one63(x)) { + hd(x) + } else { + f(hd(x), reduce(f, tl(x))) + } + } +} +join <- function (...) { + V__ls <- list(...) + V__r41 <- list() + V__V__x <- V__ls + V__V__i4 <- 0 + while (V__V__i4 < V_35(V__V__x)) { + V__l11 <- V__V__x[[V__V__i4 + 1]] + if (V__l11) { + V__n3 <- V_35(V__r41) + V__V__o2 <- V__l11 + V__k2 <- NULL + for (V__k2 in indices(V__V__o2)) { + V__v2 <- V__V__o2[[V__k2]] + if (number63(V__k2)) { + V__k2 <- V__k2 + V__n3 + } + V__r41[[V__k2]] <<- V__v2 + } + } + V__V__i4 <- V__V__i4 + 1 + } + V__r41 +} +find <- function (f, t) { + V__V__o3 <- t + V__V__i6 <- NULL + for (V__V__i6 in indices(V__V__o3)) { + V__x1 <- V__V__o3[[V__V__i6]] + V__y <- f(V__x1) + if (V__y) { + return V__y + } + } +} +first <- function (f, l) { + V__V__x2 <- l + V__V__i7 <- 0 + while (V__V__i7 < V_35(V__V__x2)) { + V__x3 <- V__V__x2[[V__V__i7 + 1]] + V__y1 <- f(V__x3) + if (V__y1) { + return V__y1 + } + V__V__i7 <- V__V__i7 + 1 + } +} +in63 <- function (x, t) { + find(function (y) { + x == y + }, t) +} +pair <- function (l) { + V__l12 <- list() + V__i8 <- 0 + while (V__i8 < V_35(l)) { + add(V__l12, list(l[[V__i8 + 1]], l[[V__i8 + 1 + 1]])) + V__i8 <- V__i8 + 1 + V__i8 <- V__i8 + 1 + } + V__l12 +} +sort <- function (l, f) { +} +map <- function (f, x) { + V__t1 <- list() + V__V__x4 <- x + V__V__i9 <- 0 + while (V__V__i9 < V_35(V__V__x4)) { + V__v3 <- V__V__x4[[V__V__i9 + 1]] + V__y2 <- f(V__v3) + if (is63(V__y2)) { + add(V__t1, V__y2) + } + V__V__i9 <- V__V__i9 + 1 + } + V__V__o4 <- x + V__k3 <- NULL + for (V__k3 in indices(V__V__o4)) { + V__v4 <- V__V__o4[[V__k3]] + if (! number63(V__k3)) { + V__y3 <- f(V__v4) + if (is63(V__y3)) { + V__t1[[V__k3]] <<- V__y3 + } + } + } + V__t1 +} +keep <- function (f, x) { + map(function (v) { + if (yes(f(v))) { + v + } + }, x) +} +keys63 <- function (t) { + V__V__o5 <- t + V__k4 <- NULL + for (V__k4 in indices(V__V__o5)) { + V__v5 <- V__V__o5[[V__k4]] + if (! number63(V__k4)) { + return TRUE + } + } + FALSE +} +empty63 <- function (t) { + V__V__o6 <- t + V__V__i12 <- NULL + for (V__V__i12 in indices(V__V__o6)) { + V__x5 <- V__V__o6[[V__V__i12]] + return FALSE + } + TRUE +} +stash <- function (args) { + if (keys63(args)) { + V__p <- list() + V__V__o7 <- args + V__k5 <- NULL + for (V__k5 in indices(V__V__o7)) { + V__v6 <- V__V__o7[[V__k5]] + if (! number63(V__k5)) { + V__p[[V__k5]] <<- V__v6 + } + } + V__p[["_stash"]] <<- TRUE + add(args, V__p) + } + args +} +unstash <- function (args) { + if (none63(args)) { +list() + } else { + V__l2 <- last(args) + if (obj63(V__l2) && V__l2[["_stash"]]) { + V__args1 <- almost(args) + V__V__o8 <- V__l2 + V__k6 <- NULL + for (V__k6 in indices(V__V__o8)) { + V__v7 <- V__V__o8[[V__k6]] + if (!( V__k6 == "_stash")) { + V__args1[[V__k6]] <<- V__v7 + } + } + V__args1 + } else { + args + } + } +} +destash33 <- function (l, args1) { + if (obj63(l) && l[["_stash"]]) { + V__V__o9 <- l + V__k7 <- NULL + for (V__k7 in indices(V__V__o9)) { + V__v8 <- V__V__o9[[V__k7]] + if (!( V__k7 == "_stash")) { + args1[[V__k7]] <<- V__v8 + } + } + } else { + l + } +} +search <- function (s, pattern, start) { +} +split <- function (s, sep) { + if (s == "" || sep == "") { +list() + } else { + V__l3 <- list() + V__n12 <- V_35(sep) + while (TRUE) { + V__i16 <- search(s, sep) + if (nil63(V__i16)) { + break + } else { + add(V__l3, clip(s, 0, V__i16)) + s <- clip(s, V__i16 + V__n12) + } + } + add(V__l3, s) + V__l3 + } +} +cat <- function (...) { + V__xs <- list(...) + either(reduce(function (a, b) { + cat(a, b) + }, V__xs), "") +} +V_43 <- function (...) { + V__xs1 <- list(...) + either(reduce(function (a, b) { + a + b + }, V__xs1), 0) +} +V_45 <- function (...) { + V__xs2 <- list(...) + either(reduce(function (b, a) { + a - b + }, reverse(V__xs2)), 0) +} +V_42 <- function (...) { + V__xs3 <- list(...) + either(reduce(function (a, b) { + a * b + }, V__xs3), 1) +} +V_47 <- function (...) { + V__xs4 <- list(...) + either(reduce(function (b, a) { + a / b + }, reverse(V__xs4)), 1) +} +V_37 <- function (...) { + V__xs5 <- list(...) + either(reduce(function (b, a) { + a % b + }, reverse(V__xs5)), 0) +} +pairwise <- function (f, xs) { + V__i17 <- 0 + while (V__i17 < edge(xs)) { + V__a <- xs[[V__i17 + 1]] + V__b <- xs[[V__i17 + 1 + 1]] + if (! f(V__a, V__b)) { + return FALSE + } + V__i17 <- V__i17 + 1 + } + return TRUE +} +V_60 <- function (...) { + V__xs6 <- list(...) + pairwise(function (a, b) { + a < b + }, V__xs6) +} +V_62 <- function (...) { + V__xs7 <- list(...) + pairwise(function (a, b) { + a > b + }, V__xs7) +} +V_61 <- function (...) { + V__xs8 <- list(...) + pairwise(function (a, b) { + a == b + }, V__xs8) +} +V_6061 <- function (...) { + V__xs9 <- list(...) + pairwise(function (a, b) { + a <= b + }, V__xs9) +} +V_6261 <- function (...) { + V__xs10 <- list(...) + pairwise(function (a, b) { + a >= b + }, V__xs10) +} +number <- function (s) { +} +number_code63 <- function (n) { + n > 47 && n < 58 +} +numeric63 <- function (s) { + V__n13 <- V_35(s) + V__i18 <- 0 + while (V__i18 < V__n13) { + if (! number_code63(code(s, V__i18))) { + return FALSE + } + V__i18 <- V__i18 + 1 + } + some63(s) +} +escape <- function (s) { + V__s1 <- "\"" + V__i19 <- 0 + while (V__i19 < V_35(s)) { + V__c <- char(s, V__i19) + V__e2 + if (V__c == "\n") { + V__e2 <- "\\n" + } else { + V__e3 + if (V__c == "\r") { + V__e3 <- "\\r" + } else { + V__e4 + if (V__c == "\"") { + V__e4 <- "\\\"" + } else { + V__e5 + if (V__c == "\\") { + V__e5 <- "\\\\" + } else { + V__e5 <- V__c + } + V__e4 <- V__e5 + } + V__e3 <- V__e4 + } + V__e2 <- V__e3 + } + V__c1 <- V__e2 + V__s1 <- cat(V__s1, V__c1) + V__i19 <- V__i19 + 1 + } + cat(V__s1, "\"") +} +str <- function (x, stack) { + if (nil63(x)) { + "nil" + } else { + if (nan63(x)) { + "nan" + } else { + if (x == inf) { + "inf" + } else { + if (x == _inf) { + "-inf" + } else { + if (boolean63(x)) { + if (x) { + "true" + } else { + "false" + } + } else { + if (string63(x)) { + escape(x) + } else { + if (atom63(x)) { + tostring(x) + } else { + if (function63(x)) { + "function" + } else { + if (stack && in63(x, stack)) { + "circular" + } else { + if (escape(tostring(x))) { + V__s <- "(" + V__sp <- "" + V__xs11 <- list() + V__ks <- list() + V__l4 <- stack || list() + add(V__l4, x) + V__V__o10 <- x + V__k8 <- NULL + for (V__k8 in indices(V__V__o10)) { + V__v9 <- V__V__o10[[V__k8]] + if (number63(V__k8)) { + V__xs11[[V__k8]] <<- str(V__v9, V__l4) + } else { + add(V__ks, cat(V__k8, ":")) + add(V__ks, str(V__v9, V__l4)) + } + } + drop(V__l4) + V__V__o11 <- join(V__xs11, V__ks) + V__V__i21 <- NULL + for (V__V__i21 in indices(V__V__o11)) { + V__v10 <- V__V__o11[[V__V__i21]] + V__s <- cat(V__s, V__sp, V__v10) + V__sp <- " " + } + cat(V__s, ")") + } + } + } + } + } + } + } + } + } + } +} +apply <- function (f, args) { + V__args <- stash(args) +} +call <- function (f, ...) { + V__V__r76 <- list(...) + V__V__id <- V__V__r76 + V__args11 <- cut(V__V__id, 0) + apply(f, V__args11) +} +setenv <- function (k, ...) { + V__V__r77 <- list(...) + V__V__id1 <- V__V__r77 + V__keys <- cut(V__V__id1, 0) + V__env <- get_environment() + if (string63(k)) { + V__e6 + if (V__keys[["toplevel"]]) { + V__e6 <- hd(V__env) + } else { + V__e6 <- last(V__env) + } + V__frame <- V__e6 + V__entry <- V__frame[[k]] || list() + V__V__o12 <- V__keys + V__k9 <- NULL + for (V__k9 in indices(V__V__o12)) { + V__v11 <- V__V__o12[[V__k9]] + V__entry[[V__k9]] <<- V__v11 + } + V__frame[[k]] <<- V__entry +V__frame[[k]] + } +} +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", macro = function (form) { + quoted(form) +}) +setenv("quasiquote", macro = function (form) { + quasiexpand(form, 1) +}) +setenv("set", macro = function (...) { + V__args1 <- list(...) + join(list("do"), map(function (V__x3) { + V__V__id1 <- V__x3 + V__lh1 <- V__V__id1[[1]] + V__rh1 <- V__V__id1[[2]] + list("%set", V__lh1, V__rh1) + }, pair(V__args1))) +}) +setenv("at", macro = function (l, i) { + if ((target == "lua" || target == "r") && number63(i)) { + i <- i + 1 + } else { + if (target == "lua" || target == "r") { + i <- list("+", i, 1) + } + } + list("get", l, i) +}) +setenv("wipe", macro = function (place) { + if (target == "lua" || target == "r") { + list("set", place, "nil") + } else { + list("%delete", place) + } +}) +setenv("list", macro = function (...) { + V__body1 <- list(...) + if (target == "r") { + join(list("%call", "list"), V__body1) + } else { + V__x17 <- unique("x") + V__l1 <- list() + V__forms1 <- list() + V__V__o1 <- V__body1 + V__k2 <- NULL + for (V__k2 in indices(V__V__o1)) { + V__v1 <- V__V__o1[[V__k2]] + if (number63(V__k2)) { + V__l1[[V__k2]] <<- V__v1 + } else { + add(V__forms1, list("set", list("get", V__x17, list("quote", V__k2)), V__v1)) + } + } + if (some63(V__forms1)) { + join(list("let", V__x17, join(list("%array"), V__l1)), V__forms1, list(V__x17)) + } else { + join(list("%array"), V__l1) + } + } +}) +setenv("if", macro = function (...) { + V__branches1 <- list(...) + hd(expand_if(V__branches1)) +}) +setenv("case", macro = function (expr, ...) { + V__V__r13 <- list(...) + V__V__id4 <- V__V__r13 + V__clauses1 <- cut(V__V__id4, 0) + V__x29 <- unique("x") + V__eq1 <- function (_) { + list("=", list("quote", _), V__x29) + } + V__cl1 <- function (V__x30) { + V__V__id5 <- V__x30 + V__a1 <- V__V__id5[[1]] + V__b1 <- V__V__id5[[2]] + if (nil63(V__b1)) { + list(V__a1) + } else { + if (string63(V__a1) || number63(V__a1)) { + list(V__eq1(V__a1), V__b1) + } else { + if (one63(V__a1)) { + list(V__eq1(hd(V__a1)), V__b1) + } else { + if (V_35(V__a1) > 1) { + list(join(list("or"), map(V__eq1, V__a1)), V__b1) + } + } + } + } + } + list("let", V__x29, expr, join(list("if"), apply(join, map(V__cl1, pair(V__clauses1))))) +}) +setenv("when", macro = function (cond, ...) { + V__V__r17 <- list(...) + V__V__id7 <- V__V__r17 + V__body3 <- cut(V__V__id7, 0) + list("if", cond, join(list("do"), V__body3)) +}) +setenv("unless", macro = function (cond, ...) { + V__V__r19 <- list(...) + V__V__id9 <- V__V__r19 + V__body5 <- cut(V__V__id9, 0) + list("if", list("not", cond), join(list("do"), V__body5)) +}) +setenv("obj", macro = function (...) { + V__body7 <- list(...) + join(list("%object"), mapo(function (x) { + x + }, V__body7)) +}) +setenv("let", macro = function (bs, ...) { + V__V__r23 <- list(...) + V__V__id14 <- V__V__r23 + V__body9 <- cut(V__V__id14, 0) + if (atom63(bs)) { + join(list("let", list(bs, hd(V__body9))), tl(V__body9)) + } else { + if (none63(bs)) { + join(list("do"), V__body9) + } else { + V__V__id15 <- bs + V__lh3 <- V__V__id15[[1]] + V__rh3 <- V__V__id15[[2]] + V__bs21 <- cut(V__V__id15, 2) + V__V__id16 <- bind(V__lh3, V__rh3) + V__id17 <- V__V__id16[[1]] + V__val1 <- V__V__id16[[2]] + V__bs11 <- cut(V__V__id16, 2) + V__renames1 <- list() + if (! id_literal63(V__id17)) { + V__id121 <- unique(V__id17) + V__renames1 <- list(V__id17, V__id121) + V__id17 <- V__id121 + } + list("do", list("%local", V__id17, V__val1), list("let-symbol", V__renames1, join(list("let", join(V__bs11, V__bs21)), V__body9))) + } + } +}) +setenv("with", macro = function (x, v, ...) { + V__V__r25 <- list(...) + V__V__id19 <- V__V__r25 + V__body11 <- cut(V__V__id19, 0) + join(list("let", list(x, v)), V__body11, list(x)) +}) +setenv("let-when", macro = function (x, v, ...) { + V__V__r27 <- list(...) + V__V__id21 <- V__V__r27 + V__body13 <- cut(V__V__id21, 0) + V__y1 <- unique("y") + list("let", V__y1, v, list("when", list("yes", V__y1), join(list("let", list(x, V__y1)), V__body13))) +}) +setenv("define-macro", macro = function (name, args, ...) { + V__V__r29 <- list(...) + V__V__id23 <- V__V__r29 + V__body15 <- cut(V__V__id23, 0) + V__form1 <- list("setenv", list("quote", name), macro = join(list("fn", args), V__body15)) + V_eval(V__form1) + V__form1 +}) +setenv("define-special", macro = function (name, args, ...) { + V__V__r31 <- list(...) + V__V__id25 <- V__V__r31 + V__body17 <- cut(V__V__id25, 0) + V__form3 <- join(list("setenv", list("quote", name), special = join(list("fn", args), V__body17)), keys(V__body17)) + V_eval(V__form3) + V__form3 +}) +setenv("define-symbol", macro = function (name, expansion) { + setenv(name, symbol = expansion) + list("setenv", list("quote", name), symbol = list("quote", expansion)) +}) +setenv("define-reader", macro = function (V__x69, ...) { + V__V__id28 <- V__x69 + V__char1 <- V__V__id28[[1]] + V__s1 <- V__V__id28[[2]] + V__V__r35 <- list(...) + V__V__id29 <- V__V__r35 + V__body19 <- cut(V__V__id29, 0) + list("set", list("get", "read-table", V__char1), join(list("fn", list(V__s1)), V__body19)) +}) +setenv("define", macro = function (name, x, ...) { + V__V__r37 <- list(...) + V__V__id31 <- V__V__r37 + V__body21 <- cut(V__V__id31, 0) + setenv(name, variable = TRUE) + if (some63(V__body21)) { + join(list("%local-function", name), bind42(x, V__body21)) + } else { + list("%local", name, x) + } +}) +setenv("define-global", macro = function (name, x, ...) { + V__V__r39 <- list(...) + V__V__id33 <- V__V__r39 + V__body23 <- cut(V__V__id33, 0) + setenv(name, toplevel = TRUE, variable = TRUE) + if (some63(V__body23)) { + join(list("%global-function", name), bind42(x, V__body23)) + } else { + list("set", name, x) + } +}) +setenv("with-frame", macro = function (...) { + V__body25 <- list(...) + V__x85 <- unique("x") + list("do", list("add", list("get-environment"), list("obj")), list("with", V__x85, join(list("do"), V__body25), list("drop", list("get-environment")))) +}) +setenv("with-bindings", macro = function (V__x91, ...) { + V__V__id36 <- V__x91 + V__names1 <- V__V__id36[[1]] + V__V__r41 <- list(...) + V__V__id37 <- V__V__r41 + V__body27 <- cut(V__V__id37, 0) + V__x92 <- unique("x") + join(list("with-frame", list("each", V__x92, V__names1, list("setenv", V__x92, variable = TRUE))), V__body27) +}) +setenv("let-macro", macro = function (definitions, ...) { + V__V__r44 <- list(...) + V__V__id39 <- V__V__r44 + V__body29 <- cut(V__V__id39, 0) + add(get_environment(), list()) + map(function (m) { + macroexpand(join(list("define-macro"), m)) + }, definitions) + V__V__x96 <- join(list("do"), macroexpand(V__body29)) + drop(get_environment()) + V__V__x96 +}) +setenv("let-symbol", macro = function (expansions, ...) { + V__V__r48 <- list(...) + V__V__id42 <- V__V__r48 + V__body31 <- cut(V__V__id42, 0) + add(get_environment(), list()) + map(function (V__x102) { + V__V__id43 <- V__x102 + V__name5 <- V__V__id43[[1]] + V__exp1 <- V__V__id43[[2]] + macroexpand(list("define-symbol", V__name5, V__exp1)) + }, pair(expansions)) + V__V__x101 <- join(list("do"), macroexpand(V__body31)) + drop(get_environment()) + V__V__x101 +}) +setenv("let-unique", macro = function (names, ...) { + V__V__r52 <- list(...) + V__V__id45 <- V__V__r52 + V__body33 <- cut(V__V__id45, 0) + V__bs22 <- map(function (n) { + list(n, list("unique", list("quote", n))) + }, names) + join(list("let", apply(join, V__bs22)), V__body33) +}) +setenv("fn", macro = function (args, ...) { + V__V__r55 <- list(...) + V__V__id47 <- V__V__r55 + V__body35 <- cut(V__V__id47, 0) + join(list("%function"), bind42(args, V__body35)) +}) +setenv("apply", macro = function (f, ...) { + V__V__r57 <- list(...) + V__V__id49 <- V__V__r57 + V__args6 <- cut(V__V__id49, 0) + if (V_35(V__args6) > 1) { + list("%call", "apply", f, list("join", join(list("list"), almost(V__args6)), last(V__args6))) + } else { + join(list("%call", "apply", f), V__args6) + } +}) +setenv("guard", macro = function (expr) { + if (target == "js") { + list(list("fn", join(), list("%try", list("list", TRUE, expr)))) + } else { + list("list", list("xpcall", list("fn", join(), expr), list("fn", list("m"), list("if", list("obj?", "m"), "m", list("obj", stack = list(list("get", "debug", list("quote", "traceback"))), message = list("if", list("string?", "m"), list("clip", "m", list("+", list("or", list("search", "m", "\": \""), -2), 2)), list("nil?", "m"), "\"\"", list("str", "m"))))))) + } +}) +setenv("each", macro = function (x, t, ...) { + V__V__r61 <- list(...) + V__V__id52 <- V__V__r61 + V__body37 <- cut(V__V__id52, 0) + V__o3 <- unique("o") + V__n3 <- unique("n") + V__i3 <- unique("i") + V__e9 + if (atom63(x)) { + V__e9 <- list(V__i3, x) + } else { + V__e10 + if (V_35(x) > 1) { + V__e10 <- x + } else { + V__e10 <- list(V__i3, hd(x)) + } + V__e9 <- V__e10 + } + V__V__id53 <- V__e9 + V__k4 <- V__V__id53[[1]] + V__v5 <- V__V__id53[[2]] + V__e11 + if (target == "r") { + V__e11 <- list("indices", V__o3) + } else { + V__e11 <- V__o3 + } + V__e12 + if (target == "lua" || target == "r") { + V__e12 <- V__body37 + } else { + V__e12 <- list(join(list("let", V__k4, list("if", list("numeric?", V__k4), list("parseInt", V__k4), V__k4)), V__body37)) + } + list("let", list(V__o3, t, V__k4, "nil"), list("%for", V__e11, V__k4, join(list("let", list(V__v5, list("get", V__o3, V__k4))), V__e12))) +}) +setenv("for", macro = function (i, to, ...) { + V__V__r63 <- list(...) + V__V__id55 <- V__V__r63 + V__body39 <- cut(V__V__id55, 0) + list("let", i, 0, join(list("while", list("<", i, to)), V__body39, list(list("inc", i)))) +}) +setenv("step", macro = function (v, t, ...) { + V__V__r65 <- list(...) + V__V__id57 <- V__V__r65 + V__body41 <- cut(V__V__id57, 0) + V__x163 <- unique("x") + V__i6 <- unique("i") + list("let", list(V__x163, t), list("for", V__i6, list("#", V__x163), join(list("let", list(v, list("at", V__x163, V__i6))), V__body41))) +}) +setenv("set-of", macro = function (...) { + V__xs1 <- list(...) + V__l3 <- list() + V__V__o5 <- V__xs1 + V__V__i8 <- NULL + for (V__V__i8 in indices(V__V__o5)) { + V__x166 <- V__V__o5[[V__V__i8]] + V__l3[[V__x166]] <<- TRUE + } + join(list("obj"), V__l3) +}) +setenv("language", macro = function () { + list("quote", target) +}) +setenv("target", macro = function (...) { + V__clauses3 <- list(...) +V__clauses3[[target]] +}) +setenv("join!", macro = function (a, ...) { + V__V__r69 <- list(...) + V__V__id59 <- V__V__r69 + V__bs4 <- cut(V__V__id59, 0) + list("set", a, join(list("join", a), V__bs4)) +}) +setenv("cat!", macro = function (a, ...) { + V__V__r71 <- list(...) + V__V__id61 <- V__V__r71 + V__bs6 <- cut(V__V__id61, 0) + list("set", a, join(list("cat", a), V__bs6)) +}) +setenv("inc", macro = function (n, by) { + V__e13 + if (nil63(by)) { + V__e13 <- 1 + } else { + V__e13 <- by + } + list("set", n, list("+", n, V__e13)) +}) +setenv("dec", macro = function (n, by) { + V__e14 + if (nil63(by)) { + V__e14 <- 1 + } else { + V__e14 <- by + } + list("set", n, list("-", n, V__e14)) +}) +setenv("with-indent", macro = function (form) { + V__x181 <- unique("x") + list("do", list("inc", "indent-level"), list("with", V__x181, form, list("dec", "indent-level"))) +}) +setenv("export", macro = function (...) { + V__names4 <- list(...) + if (target == "js") { + join(list("do"), map(function (k) { + list("set", list("get", "exports", list("quote", k)), k) + }, V__names4)) + } else { + V__x189 <- list() + V__V__o7 <- V__names4 + V__V__i10 <- NULL + for (V__V__i10 in indices(V__V__o7)) { + V__k6 <- V__V__o7[[V__V__i10]] + V__x189[[V__k6]] <<- V__k6 + } + list("return", join(list("%object"), mapo(function (x) { + x + }, V__x189))) + } +}) +setenv("when-compiling", macro = function (...) { + V__body43 <- list(...) + V_eval(join(list("do"), V__body43)) +}) +setenv("during-compilation", macro = function (...) { + V__body45 <- list(...) + V__form5 <- join(list("do"), V__body45) + V_eval(V__form5) + V__form5 +}) +reader <- require("reader") +compiler <- require("compiler") +system <- require("system") +eval_print <- function (form) { + V__V__id <- list(xpcall(function () { + compiler[["eval"]](form) + }, function (m) { + if (obj63(m)) { + m + } else { + V__e + if (string63(m)) { + V__e <- clip(m, (search(m, ": ") || -2) + 2) + } else { + V__e1 + if (nil63(m)) { + V__e1 <- "" + } else { + V__e1 <- str(m) + } + V__e <- V__e1 + } +list(stack = debug[["traceback"]](), message = V__e) + } + })) + V__ok <- V__V__id[[1]] + V__v <- V__V__id[[2]] + if (! V__ok) { + if (is63(V__v)) { + print(str(V__v)) + } + } +} +rep <- function (s) { + eval_print(reader[["read-string"]](s)) +} +repl <- function () { + V__buf <- "" + rep1 <- function (s) { + V__buf <- cat(V__buf, s) + V__more <- list() + V__form <- reader[["read-string"]](V__buf, V__more) + if (!( V__form == V__more)) { + eval_print(V__form) + V__buf <- "" + system[["write"]]("> ") + } + } + system[["write"]]("> ") +} +compile_file <- function (path) { + V__s <- reader[["stream"]](system[["read-file"]](path)) + V__body <- reader[["read-all"]](V__s) + V__form1 <- compiler[["expand"]](join(list("do"), V__body)) + compiler[["compile"]](V__form1, stmt = TRUE) +} +V_load <- function (path) { + V__previous <- target + target <- "r" + V__code <- compile_file(path) + target <- V__previous + compiler[["run"]](V__code) +} +script_file63 <- function (path) { + !( "-" == char(path, 0) || ".js" == clip(path, V_35(path) - 3) || ".lua" == clip(path, V_35(path) - 4)) +} +run_file <- function (path) { + if (script_file63(path)) { + V_load(path) + } else { + compiler[["run"]](system[["read-file"]](path)) + } +} +usage <- function () { + print("usage: lumen [ | options ]") + print(" \t\tProgram read from script file") + print(" \tPassed to program in system.argv") + print(" \tLoaded before compiling ") + print("options:") + print(" -c \tCompile input file") + print(" -o \tOutput file") + print(" -t \tTarget language (default: lua)") + print(" -e \tExpression to evaluate") +} +main <- function () { + V__arg <- hd(system[["argv"]]) + if (V__arg && script_file63(V__arg)) { + V_load(V__arg) + } else { + if (V__arg == "-h" || V__arg == "--help") { + usage() + } else { + V__pre <- list() + V__input <- NULL + V__output <- NULL + V__target1 <- NULL + V__expr <- NULL + V__argv <- system[["argv"]] + V__i <- 0 + while (V__i < V_35(V__argv)) { + V__a <- V__argv[[V__i + 1]] + if (V__a == "-c" || V__a == "-o" || V__a == "-t" || V__a == "-e") { + if (V__i == edge(V__argv)) { + print(cat("missing argument for ", V__a)) + } else { + V__i <- V__i + 1 + V__val <- V__argv[[V__i + 1]] + if (V__a == "-c") { + V__input <- V__val + } else { + if (V__a == "-o") { + V__output <- V__val + } else { + if (V__a == "-t") { + V__target1 <- V__val + } else { + if (V__a == "-e") { + V__expr <- V__val + } + } + } + } + } + } else { + if (!( "-" == char(V__a, 0))) { + add(V__pre, V__a) + } + } + V__i <- V__i + 1 + } + V__V__x <- V__pre + V__V__i1 <- 0 + while (V__V__i1 < V_35(V__V__x)) { + V__file <- V__V__x[[V__V__i1 + 1]] + run_file(V__file) + V__V__i1 <- V__V__i1 + 1 + } + if (nil63(V__input)) { + if (V__expr) { + rep(V__expr) + } else { + repl() + } + } else { + if (V__target1) { + target <- V__target1 + } + V__code1 <- compile_file(V__input) + if (nil63(V__output) || V__output == "-") { + print(V__code1) + } else { + system[["write-file"]](V__output, V__code1) + } + } + } + } +} +main() diff --git a/bin/lumen.js b/bin/lumen.js index 59047e4..56f17e9 100644 --- a/bin/lumen.js +++ b/bin/lumen.js @@ -1,5 +1,8 @@ -environment = [{}]; +var environment = [{}]; target = "js"; +get_environment = function () { + return environment; +}; nil63 = function (x) { return x === undefined || x === null; }; @@ -74,7 +77,7 @@ inf63 = function (n) { return n === inf || n === _inf; }; clip = function (s, from, upto) { - return s.substring(from, upto); + return s["substring"](from, upto); }; cut = function (x, from, upto) { var __l = []; @@ -145,10 +148,10 @@ tl = function (l) { return cut(l, 1); }; char = function (s, n) { - return s.charAt(n); + return s["charAt"](n); }; code = function (s, n) { - return s.charCodeAt(n); + return s["charCodeAt"](n); }; string_literal63 = function (x) { return string63(x) && char(x, 0) === "\""; @@ -157,11 +160,11 @@ id_literal63 = function (x) { return string63(x) && char(x, 0) === "|"; }; add = function (l, x) { - l.push(x); + l["push"](x); return undefined; }; drop = function (l) { - return l.pop(); + return l["pop"](); }; last = function (l) { return l[edge(l)]; @@ -190,14 +193,14 @@ reduce = function (f, x) { } }; join = function () { - var __ls = unstash(Array.prototype.slice.call(arguments, 0)); - var __r38 = []; + var __ls = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); + var __r39 = []; var ____x1 = __ls; var ____i4 = 0; while (____i4 < _35(____x1)) { var __l11 = ____x1[____i4]; if (__l11) { - var __n3 = _35(__r38); + var __n3 = _35(__r39); var ____o2 = __l11; var __k4 = undefined; for (__k4 in ____o2) { @@ -212,12 +215,12 @@ join = function () { if (number63(__k5)) { __k5 = __k5 + __n3; } - __r38[__k5] = __v2; + __r39[__k5] = __v2; } } ____i4 = ____i4 + 1; } - return __r38; + return __r39; }; find = function (f, t) { var ____o3 = t; @@ -275,7 +278,7 @@ sort = function (l, f) { } }; } - return l.sort(__e6); + return l["sort"](__e6); }; map = function (f, x) { var __t1 = []; @@ -368,7 +371,7 @@ stash = function (args) { __p[__k11] = __v6; } } - __p._stash = true; + __p["_stash"] = true; add(args, __p); } return args; @@ -378,7 +381,7 @@ unstash = function (args) { return []; } else { var __l2 = last(args); - if (obj63(__l2) && __l2._stash) { + if (obj63(__l2) && __l2["_stash"]) { var __args1 = almost(args); var ____o8 = __l2; var __k12 = undefined; @@ -402,7 +405,7 @@ unstash = function (args) { } }; destash33 = function (l, args1) { - if (obj63(l) && l._stash) { + if (obj63(l) && l["_stash"]) { var ____o9 = l; var __k14 = undefined; for (__k14 in ____o9) { @@ -423,7 +426,7 @@ destash33 = function (l, args1) { } }; search = function (s, pattern, start) { - var __i16 = s.indexOf(pattern, start); + var __i16 = s["indexOf"](pattern, start); if (__i16 >= 0) { return __i16; } @@ -448,37 +451,37 @@ split = function (s, sep) { } }; cat = function () { - var __xs = unstash(Array.prototype.slice.call(arguments, 0)); + var __xs = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return either(reduce(function (a, b) { return a + b; }, __xs), ""); }; _43 = function () { - var __xs1 = unstash(Array.prototype.slice.call(arguments, 0)); + var __xs1 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return either(reduce(function (a, b) { return a + b; }, __xs1), 0); }; _45 = function () { - var __xs2 = unstash(Array.prototype.slice.call(arguments, 0)); + var __xs2 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return either(reduce(function (b, a) { return a - b; }, reverse(__xs2)), 0); }; _42 = function () { - var __xs3 = unstash(Array.prototype.slice.call(arguments, 0)); + var __xs3 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return either(reduce(function (a, b) { return a * b; }, __xs3), 1); }; _47 = function () { - var __xs4 = unstash(Array.prototype.slice.call(arguments, 0)); + var __xs4 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return either(reduce(function (b, a) { return a / b; }, reverse(__xs4)), 1); }; _37 = function () { - var __xs5 = unstash(Array.prototype.slice.call(arguments, 0)); + var __xs5 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return either(reduce(function (b, a) { return a % b; }, reverse(__xs5)), 0); @@ -496,31 +499,31 @@ var pairwise = function (f, xs) { return true; }; _60 = function () { - var __xs6 = unstash(Array.prototype.slice.call(arguments, 0)); + var __xs6 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return pairwise(function (a, b) { return a < b; }, __xs6); }; _62 = function () { - var __xs7 = unstash(Array.prototype.slice.call(arguments, 0)); + var __xs7 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return pairwise(function (a, b) { return a > b; }, __xs7); }; _61 = function () { - var __xs8 = unstash(Array.prototype.slice.call(arguments, 0)); + var __xs8 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return pairwise(function (a, b) { return a === b; }, __xs8); }; _6061 = function () { - var __xs9 = unstash(Array.prototype.slice.call(arguments, 0)); + var __xs9 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return pairwise(function (a, b) { return a <= b; }, __xs9); }; _6261 = function () { - var __xs10 = unstash(Array.prototype.slice.call(arguments, 0)); + var __xs10 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return pairwise(function (a, b) { return a >= b; }, __xs10); @@ -546,7 +549,7 @@ numeric63 = function (s) { return some63(s); }; var tostring = function (x) { - return x.toString(); + return x["toString"](); }; escape = function (s) { var __s1 = "\""; @@ -671,26 +674,27 @@ str = function (x, stack) { }; apply = function (f, args) { var __args = stash(args); - return f.apply(f, __args); + return f["apply"](f, __args); }; call = function (f) { - var ____r75 = unstash(Array.prototype.slice.call(arguments, 1)); - var __f = destash33(f, ____r75); - var ____id = ____r75; + var ____r76 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); + var __f = destash33(f, ____r76); + var ____id = ____r76; var __args11 = cut(____id, 0); return apply(__f, __args11); }; setenv = function (k) { - var ____r76 = unstash(Array.prototype.slice.call(arguments, 1)); - var __k18 = destash33(k, ____r76); - var ____id1 = ____r76; + var ____r77 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); + var __k18 = destash33(k, ____r77); + var ____id1 = ____r77; var __keys = cut(____id1, 0); + var __env = get_environment(); if (string63(__k18)) { var __e19; - if (__keys.toplevel) { - __e19 = hd(environment); + if (__keys["toplevel"]) { + __e19 = hd(__env); } else { - __e19 = last(environment); + __e19 = last(__env); } var __frame = __e19; var __entry = __frame[__k18] || {}; @@ -712,32 +716,32 @@ setenv = function (k) { } }; print = function (x) { - return console.log(x); + return console["log"](x); }; error = function (x) { throw new Error(x); }; var 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; +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); }}); @@ -745,7 +749,7 @@ setenv("quasiquote", {_stash: true, macro: function (form) { return quasiexpand(form, 1); }}); setenv("set", {_stash: true, macro: function () { - var __args1 = unstash(Array.prototype.slice.call(arguments, 0)); + var __args1 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return join(["do"], map(function (__x4) { var ____id1 = __x4; var __lh1 = ____id1[0]; @@ -754,65 +758,69 @@ setenv("set", {_stash: true, macro: function () { }, pair(__args1))); }}); setenv("at", {_stash: true, macro: function (l, i) { - if (target === "lua" && number63(i)) { + if ((target === "lua" || target === "r") && number63(i)) { i = i + 1; } else { - if (target === "lua") { + if (target === "lua" || target === "r") { i = ["+", i, 1]; } } return ["get", l, i]; }}); setenv("wipe", {_stash: true, macro: function (place) { - if (target === "lua") { + if (target === "lua" || target === "r") { return ["set", place, "nil"]; } else { return ["%delete", place]; } }}); setenv("list", {_stash: true, macro: function () { - var __body1 = unstash(Array.prototype.slice.call(arguments, 0)); - var __x22 = unique("x"); - var __l1 = []; - var __forms1 = []; - var ____o1 = __body1; - var __k2 = undefined; - for (__k2 in ____o1) { - var __v1 = ____o1[__k2]; - var __e8; - if (numeric63(__k2)) { - __e8 = parseInt(__k2); - } else { - __e8 = __k2; + var __body1 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); + if (target === "r") { + return join(["%call", "list"], __body1); + } else { + var __x24 = unique("x"); + var __l1 = []; + var __forms1 = []; + var ____o1 = __body1; + var __k2 = undefined; + for (__k2 in ____o1) { + var __v1 = ____o1[__k2]; + var __e9; + if (numeric63(__k2)) { + __e9 = parseInt(__k2); + } else { + __e9 = __k2; + } + var __k3 = __e9; + if (number63(__k3)) { + __l1[__k3] = __v1; + } else { + add(__forms1, ["set", ["get", __x24, ["quote", __k3]], __v1]); + } } - var __k3 = __e8; - if (number63(__k3)) { - __l1[__k3] = __v1; + if (some63(__forms1)) { + return join(["let", __x24, join(["%array"], __l1)], __forms1, [__x24]); } else { - add(__forms1, ["set", ["get", __x22, ["quote", __k3]], __v1]); + return join(["%array"], __l1); } } - if (some63(__forms1)) { - return join(["let", __x22, join(["%array"], __l1)], __forms1, [__x22]); - } else { - return join(["%array"], __l1); - } }}); setenv("if", {_stash: true, macro: function () { - var __branches1 = unstash(Array.prototype.slice.call(arguments, 0)); + var __branches1 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return hd(expand_if(__branches1)); }}); setenv("case", {_stash: true, macro: function (expr) { - var ____r13 = unstash(Array.prototype.slice.call(arguments, 1)); + var ____r13 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); var __expr1 = destash33(expr, ____r13); var ____id4 = ____r13; var __clauses1 = cut(____id4, 0); - var __x41 = unique("x"); + var __x43 = unique("x"); var __eq1 = function (_) { - return ["=", ["quote", _], __x41]; + return ["=", ["quote", _], __x43]; }; - var __cl1 = function (__x44) { - var ____id5 = __x44; + var __cl1 = function (__x46) { + var ____id5 = __x46; var __a1 = ____id5[0]; var __b1 = ____id5[1]; if (nil63(__b1)) { @@ -831,30 +839,30 @@ setenv("case", {_stash: true, macro: function (expr) { } } }; - return ["let", __x41, __expr1, join(["if"], apply(join, map(__cl1, pair(__clauses1))))]; + return ["let", __x43, __expr1, join(["if"], apply(join, map(__cl1, pair(__clauses1))))]; }}); setenv("when", {_stash: true, macro: function (cond) { - var ____r17 = unstash(Array.prototype.slice.call(arguments, 1)); + var ____r17 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); var __cond1 = destash33(cond, ____r17); var ____id7 = ____r17; var __body3 = cut(____id7, 0); return ["if", __cond1, join(["do"], __body3)]; }}); setenv("unless", {_stash: true, macro: function (cond) { - var ____r19 = unstash(Array.prototype.slice.call(arguments, 1)); + var ____r19 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); var __cond3 = destash33(cond, ____r19); var ____id9 = ____r19; var __body5 = cut(____id9, 0); return ["if", ["not", __cond3], join(["do"], __body5)]; }}); setenv("obj", {_stash: true, macro: function () { - var __body7 = unstash(Array.prototype.slice.call(arguments, 0)); + var __body7 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return join(["%object"], mapo(function (x) { return x; }, __body7)); }}); setenv("let", {_stash: true, macro: function (bs) { - var ____r23 = unstash(Array.prototype.slice.call(arguments, 1)); + var ____r23 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); var __bs11 = destash33(bs, ____r23); var ____id14 = ____r23; var __body9 = cut(____id14, 0); @@ -883,136 +891,136 @@ setenv("let", {_stash: true, macro: function (bs) { } }}); setenv("with", {_stash: true, macro: function (x, v) { - var ____r25 = unstash(Array.prototype.slice.call(arguments, 2)); - var __x84 = destash33(x, ____r25); + var ____r25 = unstash(Array["prototype"]["slice"]["call"](arguments, 2)); + var __x86 = destash33(x, ____r25); var __v3 = destash33(v, ____r25); var ____id19 = ____r25; var __body11 = cut(____id19, 0); - return join(["let", [__x84, __v3]], __body11, [__x84]); + return join(["let", [__x86, __v3]], __body11, [__x86]); }}); setenv("let-when", {_stash: true, macro: function (x, v) { - var ____r27 = unstash(Array.prototype.slice.call(arguments, 2)); - var __x94 = destash33(x, ____r27); + var ____r27 = unstash(Array["prototype"]["slice"]["call"](arguments, 2)); + var __x96 = destash33(x, ____r27); var __v5 = destash33(v, ____r27); var ____id21 = ____r27; var __body13 = cut(____id21, 0); var __y1 = unique("y"); - return ["let", __y1, __v5, ["when", ["yes", __y1], join(["let", [__x94, __y1]], __body13)]]; + return ["let", __y1, __v5, ["when", ["yes", __y1], join(["let", [__x96, __y1]], __body13)]]; }}); setenv("define-macro", {_stash: true, macro: function (name, args) { - var ____r29 = unstash(Array.prototype.slice.call(arguments, 2)); + var ____r29 = unstash(Array["prototype"]["slice"]["call"](arguments, 2)); var __name1 = destash33(name, ____r29); var __args3 = destash33(args, ____r29); var ____id23 = ____r29; var __body15 = cut(____id23, 0); - var ____x103 = ["setenv", ["quote", __name1]]; - ____x103.macro = join(["fn", __args3], __body15); - var __form1 = ____x103; + var ____x105 = ["setenv", ["quote", __name1]]; + ____x105["macro"] = join(["fn", __args3], __body15); + var __form1 = ____x105; _eval(__form1); return __form1; }}); setenv("define-special", {_stash: true, macro: function (name, args) { - var ____r31 = unstash(Array.prototype.slice.call(arguments, 2)); + var ____r31 = unstash(Array["prototype"]["slice"]["call"](arguments, 2)); var __name3 = destash33(name, ____r31); var __args5 = destash33(args, ____r31); var ____id25 = ____r31; var __body17 = cut(____id25, 0); - var ____x109 = ["setenv", ["quote", __name3]]; - ____x109.special = join(["fn", __args5], __body17); - var __form3 = join(____x109, keys(__body17)); + var ____x111 = ["setenv", ["quote", __name3]]; + ____x111["special"] = join(["fn", __args5], __body17); + var __form3 = join(____x111, keys(__body17)); _eval(__form3); return __form3; }}); setenv("define-symbol", {_stash: true, macro: function (name, expansion) { setenv(name, {_stash: true, symbol: expansion}); - var ____x115 = ["setenv", ["quote", name]]; - ____x115.symbol = ["quote", expansion]; - return ____x115; + var ____x117 = ["setenv", ["quote", name]]; + ____x117["symbol"] = ["quote", expansion]; + return ____x117; }}); -setenv("define-reader", {_stash: true, macro: function (__x123) { - var ____id28 = __x123; +setenv("define-reader", {_stash: true, macro: function (__x125) { + var ____id28 = __x125; var __char1 = ____id28[0]; var __s1 = ____id28[1]; - var ____r35 = unstash(Array.prototype.slice.call(arguments, 1)); - var ____x123 = destash33(__x123, ____r35); + var ____r35 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); + var ____x125 = destash33(__x125, ____r35); var ____id29 = ____r35; var __body19 = cut(____id29, 0); return ["set", ["get", "read-table", __char1], join(["fn", [__s1]], __body19)]; }}); setenv("define", {_stash: true, macro: function (name, x) { - var ____r37 = unstash(Array.prototype.slice.call(arguments, 2)); + var ____r37 = unstash(Array["prototype"]["slice"]["call"](arguments, 2)); var __name5 = destash33(name, ____r37); - var __x131 = destash33(x, ____r37); + var __x133 = destash33(x, ____r37); var ____id31 = ____r37; var __body21 = cut(____id31, 0); setenv(__name5, {_stash: true, variable: true}); if (some63(__body21)) { - return join(["%local-function", __name5], bind42(__x131, __body21)); + return join(["%local-function", __name5], bind42(__x133, __body21)); } else { - return ["%local", __name5, __x131]; + return ["%local", __name5, __x133]; } }}); setenv("define-global", {_stash: true, macro: function (name, x) { - var ____r39 = unstash(Array.prototype.slice.call(arguments, 2)); + var ____r39 = unstash(Array["prototype"]["slice"]["call"](arguments, 2)); var __name7 = destash33(name, ____r39); - var __x137 = destash33(x, ____r39); + var __x139 = destash33(x, ____r39); var ____id33 = ____r39; var __body23 = cut(____id33, 0); setenv(__name7, {_stash: true, toplevel: true, variable: true}); if (some63(__body23)) { - return join(["%global-function", __name7], bind42(__x137, __body23)); + return join(["%global-function", __name7], bind42(__x139, __body23)); } else { - return ["set", __name7, __x137]; + return ["set", __name7, __x139]; } }}); setenv("with-frame", {_stash: true, macro: function () { - var __body25 = unstash(Array.prototype.slice.call(arguments, 0)); - var __x147 = unique("x"); - return ["do", ["add", "environment", ["obj"]], ["with", __x147, join(["do"], __body25), ["drop", "environment"]]]; + var __body25 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); + var __x151 = unique("x"); + return ["do", ["add", ["get-environment"], ["obj"]], ["with", __x151, join(["do"], __body25), ["drop", ["get-environment"]]]]; }}); -setenv("with-bindings", {_stash: true, macro: function (__x159) { - var ____id36 = __x159; +setenv("with-bindings", {_stash: true, macro: function (__x165) { + var ____id36 = __x165; var __names1 = ____id36[0]; - var ____r41 = unstash(Array.prototype.slice.call(arguments, 1)); - var ____x159 = destash33(__x159, ____r41); + var ____r41 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); + var ____x165 = destash33(__x165, ____r41); var ____id37 = ____r41; var __body27 = cut(____id37, 0); - var __x160 = unique("x"); - var ____x163 = ["setenv", __x160]; - ____x163.variable = true; - return join(["with-frame", ["each", __x160, __names1, ____x163]], __body27); + var __x166 = unique("x"); + var ____x169 = ["setenv", __x166]; + ____x169["variable"] = true; + return join(["with-frame", ["each", __x166, __names1, ____x169]], __body27); }}); setenv("let-macro", {_stash: true, macro: function (definitions) { - var ____r44 = unstash(Array.prototype.slice.call(arguments, 1)); + var ____r44 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); var __definitions1 = destash33(definitions, ____r44); var ____id39 = ____r44; var __body29 = cut(____id39, 0); - add(environment, {}); + add(get_environment(), {}); map(function (m) { return macroexpand(join(["define-macro"], m)); }, __definitions1); - var ____x167 = join(["do"], macroexpand(__body29)); - drop(environment); - return ____x167; + var ____x173 = join(["do"], macroexpand(__body29)); + drop(get_environment()); + return ____x173; }}); setenv("let-symbol", {_stash: true, macro: function (expansions) { - var ____r48 = unstash(Array.prototype.slice.call(arguments, 1)); + var ____r48 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); var __expansions1 = destash33(expansions, ____r48); var ____id42 = ____r48; var __body31 = cut(____id42, 0); - add(environment, {}); - map(function (__x175) { - var ____id43 = __x175; + add(get_environment(), {}); + map(function (__x181) { + var ____id43 = __x181; var __name9 = ____id43[0]; var __exp1 = ____id43[1]; return macroexpand(["define-symbol", __name9, __exp1]); }, pair(__expansions1)); - var ____x174 = join(["do"], macroexpand(__body31)); - drop(environment); - return ____x174; + var ____x180 = join(["do"], macroexpand(__body31)); + drop(get_environment()); + return ____x180; }}); setenv("let-unique", {_stash: true, macro: function (names) { - var ____r52 = unstash(Array.prototype.slice.call(arguments, 1)); + var ____r52 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); var __names3 = destash33(names, ____r52); var ____id45 = ____r52; var __body33 = cut(____id45, 0); @@ -1022,14 +1030,14 @@ setenv("let-unique", {_stash: true, macro: function (names) { return join(["let", apply(join, __bs3)], __body33); }}); setenv("fn", {_stash: true, macro: function (args) { - var ____r55 = unstash(Array.prototype.slice.call(arguments, 1)); + var ____r55 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); var __args7 = destash33(args, ____r55); var ____id47 = ____r55; var __body35 = cut(____id47, 0); return join(["%function"], bind42(__args7, __body35)); }}); setenv("apply", {_stash: true, macro: function (f) { - var ____r57 = unstash(Array.prototype.slice.call(arguments, 1)); + var ____r57 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); var __f1 = destash33(f, ____r57); var ____id49 = ____r57; var __args9 = cut(____id49, 0); @@ -1043,46 +1051,52 @@ setenv("guard", {_stash: true, macro: function (expr) { if (target === "js") { return [["fn", join(), ["%try", ["list", true, expr]]]]; } else { - var ____x230 = ["obj"]; - ____x230.stack = [["get", "debug", ["quote", "traceback"]]]; - ____x230.message = ["if", ["string?", "m"], ["clip", "m", ["+", ["or", ["search", "m", "\": \""], -2], 2]], ["nil?", "m"], "\"\"", ["str", "m"]]; - return ["list", ["xpcall", ["fn", join(), expr], ["fn", ["m"], ["if", ["obj?", "m"], "m", ____x230]]]]; + var ____x236 = ["obj"]; + ____x236["stack"] = [["get", "debug", ["quote", "traceback"]]]; + ____x236["message"] = ["if", ["string?", "m"], ["clip", "m", ["+", ["or", ["search", "m", "\": \""], -2], 2]], ["nil?", "m"], "\"\"", ["str", "m"]]; + return ["list", ["xpcall", ["fn", join(), expr], ["fn", ["m"], ["if", ["obj?", "m"], "m", ____x236]]]]; } }}); setenv("each", {_stash: true, macro: function (x, t) { - var ____r61 = unstash(Array.prototype.slice.call(arguments, 2)); - var __x256 = destash33(x, ____r61); + var ____r61 = unstash(Array["prototype"]["slice"]["call"](arguments, 2)); + var __x263 = destash33(x, ____r61); var __t1 = destash33(t, ____r61); var ____id52 = ____r61; var __body37 = cut(____id52, 0); var __o3 = unique("o"); var __n3 = unique("n"); var __i3 = unique("i"); - var __e9; - if (atom63(__x256)) { - __e9 = [__i3, __x256]; + var __e10; + if (atom63(__x263)) { + __e10 = [__i3, __x263]; } else { - var __e10; - if (_35(__x256) > 1) { - __e10 = __x256; + var __e11; + if (_35(__x263) > 1) { + __e11 = __x263; } else { - __e10 = [__i3, hd(__x256)]; + __e11 = [__i3, hd(__x263)]; } - __e9 = __e10; + __e10 = __e11; } - var ____id53 = __e9; + var ____id53 = __e10; var __k5 = ____id53[0]; var __v7 = ____id53[1]; - var __e11; - if (target === "lua") { - __e11 = __body37; + var __e12; + if (target === "r") { + __e12 = ["indices", __o3]; } else { - __e11 = [join(["let", __k5, ["if", ["numeric?", __k5], ["parseInt", __k5], __k5]], __body37)]; + __e12 = __o3; } - return ["let", [__o3, __t1, __k5, "nil"], ["%for", __o3, __k5, join(["let", [__v7, ["get", __o3, __k5]]], __e11)]]; + var __e13; + if (target === "lua" || target === "r") { + __e13 = __body37; + } else { + __e13 = [join(["let", __k5, ["if", ["numeric?", __k5], ["parseInt", __k5], __k5]], __body37)]; + } + return ["let", [__o3, __t1, __k5, "nil"], ["%for", __e12, __k5, join(["let", [__v7, ["get", __o3, __k5]]], __e13)]]; }}); setenv("for", {_stash: true, macro: function (i, to) { - var ____r63 = unstash(Array.prototype.slice.call(arguments, 2)); + var ____r63 = unstash(Array["prototype"]["slice"]["call"](arguments, 2)); var __i5 = destash33(i, ____r63); var __to1 = destash33(to, ____r63); var ____id55 = ____r63; @@ -1090,30 +1104,30 @@ setenv("for", {_stash: true, macro: function (i, to) { return ["let", __i5, 0, join(["while", ["<", __i5, __to1]], __body39, [["inc", __i5]])]; }}); setenv("step", {_stash: true, macro: function (v, t) { - var ____r65 = unstash(Array.prototype.slice.call(arguments, 2)); + var ____r65 = unstash(Array["prototype"]["slice"]["call"](arguments, 2)); var __v9 = destash33(v, ____r65); var __t3 = destash33(t, ____r65); var ____id57 = ____r65; var __body41 = cut(____id57, 0); - var __x288 = unique("x"); + var __x296 = unique("x"); var __i7 = unique("i"); - return ["let", [__x288, __t3], ["for", __i7, ["#", __x288], join(["let", [__v9, ["at", __x288, __i7]]], __body41)]]; + return ["let", [__x296, __t3], ["for", __i7, ["#", __x296], join(["let", [__v9, ["at", __x296, __i7]]], __body41)]]; }}); setenv("set-of", {_stash: true, macro: function () { - var __xs1 = unstash(Array.prototype.slice.call(arguments, 0)); + var __xs1 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); var __l3 = []; var ____o5 = __xs1; var ____i9 = undefined; for (____i9 in ____o5) { - var __x298 = ____o5[____i9]; - var __e12; + var __x306 = ____o5[____i9]; + var __e14; if (numeric63(____i9)) { - __e12 = parseInt(____i9); + __e14 = parseInt(____i9); } else { - __e12 = ____i9; + __e14 = ____i9; } - var ____i91 = __e12; - __l3[__x298] = true; + var ____i91 = __e14; + __l3[__x306] = true; } return join(["obj"], __l3); }}); @@ -1121,77 +1135,77 @@ setenv("language", {_stash: true, macro: function () { return ["quote", target]; }}); setenv("target", {_stash: true, macro: function () { - var __clauses3 = unstash(Array.prototype.slice.call(arguments, 0)); + var __clauses3 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return __clauses3[target]; }}); setenv("join!", {_stash: true, macro: function (a) { - var ____r69 = unstash(Array.prototype.slice.call(arguments, 1)); + var ____r69 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); var __a3 = destash33(a, ____r69); var ____id59 = ____r69; var __bs5 = cut(____id59, 0); return ["set", __a3, join(["join", __a3], __bs5)]; }}); setenv("cat!", {_stash: true, macro: function (a) { - var ____r71 = unstash(Array.prototype.slice.call(arguments, 1)); + var ____r71 = unstash(Array["prototype"]["slice"]["call"](arguments, 1)); var __a5 = destash33(a, ____r71); var ____id61 = ____r71; var __bs7 = cut(____id61, 0); return ["set", __a5, join(["cat", __a5], __bs7)]; }}); setenv("inc", {_stash: true, macro: function (n, by) { - var __e13; + var __e15; if (nil63(by)) { - __e13 = 1; + __e15 = 1; } else { - __e13 = by; + __e15 = by; } - return ["set", n, ["+", n, __e13]]; + return ["set", n, ["+", n, __e15]]; }}); setenv("dec", {_stash: true, macro: function (n, by) { - var __e14; + var __e16; if (nil63(by)) { - __e14 = 1; + __e16 = 1; } else { - __e14 = by; + __e16 = by; } - return ["set", n, ["-", n, __e14]]; + return ["set", n, ["-", n, __e16]]; }}); setenv("with-indent", {_stash: true, macro: function (form) { - var __x323 = unique("x"); - return ["do", ["inc", "indent-level"], ["with", __x323, form, ["dec", "indent-level"]]]; + var __x331 = unique("x"); + return ["do", ["inc", "indent-level"], ["with", __x331, form, ["dec", "indent-level"]]]; }}); setenv("export", {_stash: true, macro: function () { - var __names5 = unstash(Array.prototype.slice.call(arguments, 0)); + var __names5 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); if (target === "js") { return join(["do"], map(function (k) { return ["set", ["get", "exports", ["quote", k]], k]; }, __names5)); } else { - var __x339 = {}; + var __x347 = {}; var ____o7 = __names5; var ____i11 = undefined; for (____i11 in ____o7) { var __k7 = ____o7[____i11]; - var __e15; + var __e17; if (numeric63(____i11)) { - __e15 = parseInt(____i11); + __e17 = parseInt(____i11); } else { - __e15 = ____i11; + __e17 = ____i11; } - var ____i111 = __e15; - __x339[__k7] = __k7; + var ____i111 = __e17; + __x347[__k7] = __k7; } return ["return", join(["%object"], mapo(function (x) { return x; - }, __x339))]; + }, __x347))]; } }}); setenv("when-compiling", {_stash: true, macro: function () { - var __body43 = unstash(Array.prototype.slice.call(arguments, 0)); + var __body43 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return _eval(join(["do"], __body43)); }}); setenv("during-compilation", {_stash: true, macro: function () { - var __body45 = unstash(Array.prototype.slice.call(arguments, 0)); + var __body45 = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); var __form5 = join(["do"], __body45); _eval(__form5); return __form5; @@ -1211,7 +1225,7 @@ var eval_print = function (form) { var __ok = ____id[0]; var __v = ____id[1]; if (! __ok) { - return print(__v.stack); + return print(__v["stack"]); } else { if (is63(__v)) { return print(str(__v)); @@ -1230,26 +1244,26 @@ var repl = function () { if (!( __form === __more)) { eval_print(__form); __buf = ""; - return system.write("> "); + return system["write"]("> "); } }; - system.write("> "); - var ___in = process.stdin; - ___in.setEncoding("utf8"); - return ___in.on("data", rep1); + system["write"]("> "); + var ___in = process["stdin"]; + ___in["setEncoding"]("utf8"); + return ___in["on"]("data", rep1); }; compile_file = function (path) { - var __s = reader.stream(system["read-file"](path)); + var __s = reader["stream"](system["read-file"](path)); var __body = reader["read-all"](__s); - var __form1 = compiler.expand(join(["do"], __body)); - return compiler.compile(__form1, {_stash: true, stmt: true}); + var __form1 = compiler["expand"](join(["do"], __body)); + return compiler["compile"](__form1, {_stash: true, stmt: true}); }; _load = function (path) { var __previous = target; target = "js"; var __code = compile_file(path); target = __previous; - return compiler.run(__code); + return compiler["run"](__code); }; var script_file63 = function (path) { return !( "-" === char(path, 0) || ".js" === clip(path, _35(path) - 3) || ".lua" === clip(path, _35(path) - 4)); @@ -1258,7 +1272,7 @@ var run_file = function (path) { if (script_file63(path)) { return _load(path); } else { - return compiler.run(system["read-file"](path)); + return compiler["run"](system["read-file"](path)); } }; var usage = function () { @@ -1273,7 +1287,7 @@ var usage = function () { return print(" -e \tExpression to evaluate"); }; var main = function () { - var __arg = hd(system.argv); + var __arg = hd(system["argv"]); if (__arg && script_file63(__arg)) { return _load(__arg); } else { @@ -1285,7 +1299,7 @@ var main = function () { var __output = undefined; var __target1 = undefined; var __expr = undefined; - var __argv = system.argv; + var __argv = system["argv"]; var __i = 0; while (__i < _35(__argv)) { var __a = __argv[__i]; diff --git a/bin/lumen.lua b/bin/lumen.lua index 8d54a7c..af06086 100644 --- a/bin/lumen.lua +++ b/bin/lumen.lua @@ -1,5 +1,8 @@ -environment = {{}} +local environment = {{}} target = "lua" +function get_environment() + return environment +end function nil63(x) return x == nil end @@ -71,7 +74,7 @@ function inf63(n) return n == inf or n == _inf end function clip(s, from, upto) - return string.sub(s, from + 1, upto) + return string["sub"](s, from + 1, upto) end function cut(x, from, upto) local __l = {} @@ -135,7 +138,7 @@ function code(s, n) if n then __e2 = n + 1 end - return string.byte(s, __e2) + return string["byte"](s, __e2) end function string_literal63(x) return string63(x) and char(x, 0) == "\"" @@ -144,10 +147,10 @@ function id_literal63(x) return string63(x) and char(x, 0) == "|" end function add(l, x) - return table.insert(l, x) + return table["insert"](l, x) end function drop(l) - return table.remove(l) + return table["remove"](l) end function last(l) return l[edge(l) + 1] @@ -177,13 +180,13 @@ function reduce(f, x) end function join(...) local __ls = unstash({...}) - local __r37 = {} + local __r38 = {} local ____x2 = __ls local ____i4 = 0 while ____i4 < _35(____x2) do local __l11 = ____x2[____i4 + 1] if __l11 then - local __n3 = _35(__r37) + local __n3 = _35(__r38) local ____o2 = __l11 local __k2 = nil for __k2 in next, ____o2 do @@ -191,12 +194,12 @@ function join(...) if number63(__k2) then __k2 = __k2 + __n3 end - __r37[__k2] = __v2 + __r38[__k2] = __v2 end end ____i4 = ____i4 + 1 end - return __r37 + return __r38 end function find(f, t) local ____o3 = t @@ -237,7 +240,7 @@ function pair(l) return __l12 end function sort(l, f) - table.sort(l, f) + table["sort"](l, f) return l end function map(f, x) @@ -303,7 +306,7 @@ function stash(args) __p[__k5] = __v6 end end - __p._stash = true + __p["_stash"] = true add(args, __p) end return args @@ -313,7 +316,7 @@ function unstash(args) return {} else local __l2 = last(args) - if obj63(__l2) and __l2._stash then + if obj63(__l2) and __l2["_stash"] then local __args1 = almost(args) local ____o8 = __l2 local __k6 = nil @@ -330,7 +333,7 @@ function unstash(args) end end function destash33(l, args1) - if obj63(l) and l._stash then + if obj63(l) and l["_stash"] then local ____o9 = l local __k7 = nil for __k7 in next, ____o9 do @@ -349,7 +352,7 @@ function search(s, pattern, start) __e3 = start + 1 end local __start = __e3 - local __i16 = string.find(s, pattern, __start, true) + local __i16 = string["find"](s, pattern, __start, true) return __i16 and __i16 - 1 end function split(s, sep) @@ -576,29 +579,30 @@ function str(x, stack) end end end -local values = unpack or table.unpack +local values = unpack or table["unpack"] function apply(f, args) local __args = stash(args) return f(values(__args)) end function call(f, ...) - local ____r72 = unstash({...}) - local __f = destash33(f, ____r72) - local ____id = ____r72 + local ____r73 = unstash({...}) + local __f = destash33(f, ____r73) + local ____id = ____r73 local __args11 = cut(____id, 0) return apply(__f, __args11) end function setenv(k, ...) - local ____r73 = unstash({...}) - local __k9 = destash33(k, ____r73) - local ____id1 = ____r73 + local ____r74 = unstash({...}) + local __k9 = destash33(k, ____r74) + local ____id1 = ____r74 local __keys = cut(____id1, 0) + local __env = get_environment() if string63(__k9) then local __e8 - if __keys.toplevel then - __e8 = hd(environment) + if __keys["toplevel"] then + __e8 = hd(__env) else - __e8 = last(environment) + __e8 = last(__env) end local __frame = __e8 local __entry = __frame[__k9] or {} @@ -613,26 +617,26 @@ function setenv(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 +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}) @@ -649,17 +653,17 @@ setenv("set", {_stash = true, macro = function (...) end, pair(__args1))) end}) setenv("at", {_stash = true, macro = function (l, i) - if target == "lua" and number63(i) then + if (target == "lua" or target == "r") and number63(i) then i = i + 1 else - if target == "lua" then + if target == "lua" or target == "r" then i = {"+", i, 1} end end return {"get", l, i} end}) setenv("wipe", {_stash = true, macro = function (place) - if target == "lua" then + if target == "lua" or target == "r" then return {"set", place, "nil"} else return {"%delete", place} @@ -667,24 +671,28 @@ setenv("wipe", {_stash = true, macro = function (place) end}) setenv("list", {_stash = true, macro = function (...) local __body1 = unstash({...}) - local __x24 = unique("x") - local __l1 = {} - local __forms1 = {} - local ____o1 = __body1 - local __k2 = nil - for __k2 in next, ____o1 do - local __v1 = ____o1[__k2] - if number63(__k2) then - __l1[__k2] = __v1 + if target == "r" then + return join({"%call", "list"}, __body1) + else + local __x26 = unique("x") + local __l1 = {} + local __forms1 = {} + local ____o1 = __body1 + local __k2 = nil + for __k2 in next, ____o1 do + local __v1 = ____o1[__k2] + if number63(__k2) then + __l1[__k2] = __v1 + else + add(__forms1, {"set", {"get", __x26, {"quote", __k2}}, __v1}) + end + end + if some63(__forms1) then + return join({"let", __x26, join({"%array"}, __l1)}, __forms1, {__x26}) else - add(__forms1, {"set", {"get", __x24, {"quote", __k2}}, __v1}) + return join({"%array"}, __l1) end end - if some63(__forms1) then - return join({"let", __x24, join({"%array"}, __l1)}, __forms1, {__x24}) - else - return join({"%array"}, __l1) - end end}) setenv("if", {_stash = true, macro = function (...) local __branches1 = unstash({...}) @@ -695,12 +703,12 @@ setenv("case", {_stash = true, macro = function (expr, ...) local __expr1 = destash33(expr, ____r13) local ____id4 = ____r13 local __clauses1 = cut(____id4, 0) - local __x45 = unique("x") + local __x47 = unique("x") local __eq1 = function (_) - return {"=", {"quote", _}, __x45} + return {"=", {"quote", _}, __x47} end - local __cl1 = function (__x48) - local ____id5 = __x48 + local __cl1 = function (__x50) + local ____id5 = __x50 local __a1 = ____id5[1] local __b1 = ____id5[2] if nil63(__b1) then @@ -719,7 +727,7 @@ setenv("case", {_stash = true, macro = function (expr, ...) end end end - return {"let", __x45, __expr1, join({"if"}, apply(join, map(__cl1, pair(__clauses1))))} + return {"let", __x47, __expr1, join({"if"}, apply(join, map(__cl1, pair(__clauses1))))} end}) setenv("when", {_stash = true, macro = function (cond, ...) local ____r17 = unstash({...}) @@ -772,20 +780,20 @@ setenv("let", {_stash = true, macro = function (bs, ...) end}) setenv("with", {_stash = true, macro = function (x, v, ...) local ____r25 = unstash({...}) - local __x93 = destash33(x, ____r25) + local __x95 = destash33(x, ____r25) local __v3 = destash33(v, ____r25) local ____id19 = ____r25 local __body11 = cut(____id19, 0) - return join({"let", {__x93, __v3}}, __body11, {__x93}) + return join({"let", {__x95, __v3}}, __body11, {__x95}) end}) setenv("let-when", {_stash = true, macro = function (x, v, ...) local ____r27 = unstash({...}) - local __x104 = destash33(x, ____r27) + local __x106 = destash33(x, ____r27) local __v5 = destash33(v, ____r27) local ____id21 = ____r27 local __body13 = cut(____id21, 0) local __y1 = unique("y") - return {"let", __y1, __v5, {"when", {"yes", __y1}, join({"let", {__x104, __y1}}, __body13)}} + return {"let", __y1, __v5, {"when", {"yes", __y1}, join({"let", {__x106, __y1}}, __body13)}} end}) setenv("define-macro", {_stash = true, macro = function (name, args, ...) local ____r29 = unstash({...}) @@ -793,9 +801,9 @@ setenv("define-macro", {_stash = true, macro = function (name, args, ...) local __args3 = destash33(args, ____r29) local ____id23 = ____r29 local __body15 = cut(____id23, 0) - local ____x114 = {"setenv", {"quote", __name1}} - ____x114.macro = join({"fn", __args3}, __body15) - local __form1 = ____x114 + local ____x116 = {"setenv", {"quote", __name1}} + ____x116["macro"] = join({"fn", __args3}, __body15) + local __form1 = ____x116 _eval(__form1) return __form1 end}) @@ -805,24 +813,24 @@ setenv("define-special", {_stash = true, macro = function (name, args, ...) local __args5 = destash33(args, ____r31) local ____id25 = ____r31 local __body17 = cut(____id25, 0) - local ____x121 = {"setenv", {"quote", __name3}} - ____x121.special = join({"fn", __args5}, __body17) - local __form3 = join(____x121, keys(__body17)) + local ____x123 = {"setenv", {"quote", __name3}} + ____x123["special"] = join({"fn", __args5}, __body17) + local __form3 = join(____x123, keys(__body17)) _eval(__form3) return __form3 end}) setenv("define-symbol", {_stash = true, macro = function (name, expansion) setenv(name, {_stash = true, symbol = expansion}) - local ____x127 = {"setenv", {"quote", name}} - ____x127.symbol = {"quote", expansion} - return ____x127 + local ____x129 = {"setenv", {"quote", name}} + ____x129["symbol"] = {"quote", expansion} + return ____x129 end}) -setenv("define-reader", {_stash = true, macro = function (__x135, ...) - local ____id28 = __x135 +setenv("define-reader", {_stash = true, macro = function (__x137, ...) + local ____id28 = __x137 local __char1 = ____id28[1] local __s1 = ____id28[2] local ____r35 = unstash({...}) - local ____x135 = destash33(__x135, ____r35) + local ____x137 = destash33(__x137, ____r35) local ____id29 = ____r35 local __body19 = cut(____id29, 0) return {"set", {"get", "read-table", __char1}, join({"fn", {__s1}}, __body19)} @@ -830,74 +838,74 @@ end}) setenv("define", {_stash = true, macro = function (name, x, ...) local ____r37 = unstash({...}) local __name5 = destash33(name, ____r37) - local __x145 = destash33(x, ____r37) + local __x147 = destash33(x, ____r37) local ____id31 = ____r37 local __body21 = cut(____id31, 0) setenv(__name5, {_stash = true, variable = true}) if some63(__body21) then - return join({"%local-function", __name5}, bind42(__x145, __body21)) + return join({"%local-function", __name5}, bind42(__x147, __body21)) else - return {"%local", __name5, __x145} + return {"%local", __name5, __x147} end end}) setenv("define-global", {_stash = true, macro = function (name, x, ...) local ____r39 = unstash({...}) local __name7 = destash33(name, ____r39) - local __x152 = destash33(x, ____r39) + local __x154 = destash33(x, ____r39) local ____id33 = ____r39 local __body23 = cut(____id33, 0) setenv(__name7, {_stash = true, toplevel = true, variable = true}) if some63(__body23) then - return join({"%global-function", __name7}, bind42(__x152, __body23)) + return join({"%global-function", __name7}, bind42(__x154, __body23)) else - return {"set", __name7, __x152} + return {"set", __name7, __x154} end end}) setenv("with-frame", {_stash = true, macro = function (...) local __body25 = unstash({...}) - local __x163 = unique("x") - return {"do", {"add", "environment", {"obj"}}, {"with", __x163, join({"do"}, __body25), {"drop", "environment"}}} + local __x167 = unique("x") + return {"do", {"add", {"get-environment"}, {"obj"}}, {"with", __x167, join({"do"}, __body25), {"drop", {"get-environment"}}}} end}) -setenv("with-bindings", {_stash = true, macro = function (__x175, ...) - local ____id36 = __x175 +setenv("with-bindings", {_stash = true, macro = function (__x181, ...) + local ____id36 = __x181 local __names1 = ____id36[1] local ____r41 = unstash({...}) - local ____x175 = destash33(__x175, ____r41) + local ____x181 = destash33(__x181, ____r41) local ____id37 = ____r41 local __body27 = cut(____id37, 0) - local __x177 = unique("x") - local ____x180 = {"setenv", __x177} - ____x180.variable = true - return join({"with-frame", {"each", __x177, __names1, ____x180}}, __body27) + local __x183 = unique("x") + local ____x186 = {"setenv", __x183} + ____x186["variable"] = true + return join({"with-frame", {"each", __x183, __names1, ____x186}}, __body27) end}) setenv("let-macro", {_stash = true, macro = function (definitions, ...) local ____r44 = unstash({...}) local __definitions1 = destash33(definitions, ____r44) local ____id39 = ____r44 local __body29 = cut(____id39, 0) - add(environment, {}) + add(get_environment(), {}) map(function (m) return macroexpand(join({"define-macro"}, m)) end, __definitions1) - local ____x185 = join({"do"}, macroexpand(__body29)) - drop(environment) - return ____x185 + local ____x191 = join({"do"}, macroexpand(__body29)) + drop(get_environment()) + return ____x191 end}) setenv("let-symbol", {_stash = true, macro = function (expansions, ...) local ____r48 = unstash({...}) local __expansions1 = destash33(expansions, ____r48) local ____id42 = ____r48 local __body31 = cut(____id42, 0) - add(environment, {}) - map(function (__x194) - local ____id43 = __x194 + add(get_environment(), {}) + map(function (__x200) + local ____id43 = __x200 local __name9 = ____id43[1] local __exp1 = ____id43[2] return macroexpand({"define-symbol", __name9, __exp1}) end, pair(__expansions1)) - local ____x193 = join({"do"}, macroexpand(__body31)) - drop(environment) - return ____x193 + local ____x199 = join({"do"}, macroexpand(__body31)) + drop(get_environment()) + return ____x199 end}) setenv("let-unique", {_stash = true, macro = function (names, ...) local ____r52 = unstash({...}) @@ -931,43 +939,49 @@ setenv("guard", {_stash = true, macro = function (expr) if target == "js" then return {{"fn", join(), {"%try", {"list", true, expr}}}} else - local ____x252 = {"obj"} - ____x252.stack = {{"get", "debug", {"quote", "traceback"}}} - ____x252.message = {"if", {"string?", "m"}, {"clip", "m", {"+", {"or", {"search", "m", "\": \""}, -2}, 2}}, {"nil?", "m"}, "\"\"", {"str", "m"}} - return {"list", {"xpcall", {"fn", join(), expr}, {"fn", {"m"}, {"if", {"obj?", "m"}, "m", ____x252}}}} + local ____x258 = {"obj"} + ____x258["stack"] = {{"get", "debug", {"quote", "traceback"}}} + ____x258["message"] = {"if", {"string?", "m"}, {"clip", "m", {"+", {"or", {"search", "m", "\": \""}, -2}, 2}}, {"nil?", "m"}, "\"\"", {"str", "m"}} + return {"list", {"xpcall", {"fn", join(), expr}, {"fn", {"m"}, {"if", {"obj?", "m"}, "m", ____x258}}}} end end}) setenv("each", {_stash = true, macro = function (x, t, ...) local ____r61 = unstash({...}) - local __x279 = destash33(x, ____r61) + local __x286 = destash33(x, ____r61) local __t1 = destash33(t, ____r61) local ____id52 = ____r61 local __body37 = cut(____id52, 0) local __o3 = unique("o") local __n3 = unique("n") local __i3 = unique("i") - local __e8 - if atom63(__x279) then - __e8 = {__i3, __x279} + local __e9 + if atom63(__x286) then + __e9 = {__i3, __x286} else - local __e9 - if _35(__x279) > 1 then - __e9 = __x279 + local __e10 + if _35(__x286) > 1 then + __e10 = __x286 else - __e9 = {__i3, hd(__x279)} + __e10 = {__i3, hd(__x286)} end - __e8 = __e9 + __e9 = __e10 end - local ____id53 = __e8 + local ____id53 = __e9 local __k4 = ____id53[1] local __v7 = ____id53[2] - local __e10 - if target == "lua" then - __e10 = __body37 + local __e11 + if target == "r" then + __e11 = {"indices", __o3} else - __e10 = {join({"let", __k4, {"if", {"numeric?", __k4}, {"parseInt", __k4}, __k4}}, __body37)} + __e11 = __o3 end - return {"let", {__o3, __t1, __k4, "nil"}, {"%for", __o3, __k4, join({"let", {__v7, {"get", __o3, __k4}}}, __e10)}} + local __e12 + if target == "lua" or target == "r" then + __e12 = __body37 + else + __e12 = {join({"let", __k4, {"if", {"numeric?", __k4}, {"parseInt", __k4}, __k4}}, __body37)} + end + return {"let", {__o3, __t1, __k4, "nil"}, {"%for", __e11, __k4, join({"let", {__v7, {"get", __o3, __k4}}}, __e12)}} end}) setenv("for", {_stash = true, macro = function (i, to, ...) local ____r63 = unstash({...}) @@ -983,9 +997,9 @@ setenv("step", {_stash = true, macro = function (v, t, ...) local __t3 = destash33(t, ____r65) local ____id57 = ____r65 local __body41 = cut(____id57, 0) - local __x313 = unique("x") + local __x321 = unique("x") local __i7 = unique("i") - return {"let", {__x313, __t3}, {"for", __i7, {"#", __x313}, join({"let", {__v9, {"at", __x313, __i7}}}, __body41)}} + return {"let", {__x321, __t3}, {"for", __i7, {"#", __x321}, join({"let", {__v9, {"at", __x321, __i7}}}, __body41)}} end}) setenv("set-of", {_stash = true, macro = function (...) local __xs1 = unstash({...}) @@ -993,8 +1007,8 @@ setenv("set-of", {_stash = true, macro = function (...) local ____o5 = __xs1 local ____i9 = nil for ____i9 in next, ____o5 do - local __x324 = ____o5[____i9] - __l3[__x324] = true + local __x332 = ____o5[____i9] + __l3[__x332] = true end return join({"obj"}, __l3) end}) @@ -1020,26 +1034,26 @@ setenv("cat!", {_stash = true, macro = function (a, ...) return {"set", __a5, join({"cat", __a5}, __bs7)} end}) setenv("inc", {_stash = true, macro = function (n, by) - local __e11 + local __e13 if nil63(by) then - __e11 = 1 + __e13 = 1 else - __e11 = by + __e13 = by end - return {"set", n, {"+", n, __e11}} + return {"set", n, {"+", n, __e13}} end}) setenv("dec", {_stash = true, macro = function (n, by) - local __e12 + local __e14 if nil63(by) then - __e12 = 1 + __e14 = 1 else - __e12 = by + __e14 = by end - return {"set", n, {"-", n, __e12}} + return {"set", n, {"-", n, __e14}} end}) setenv("with-indent", {_stash = true, macro = function (form) - local __x352 = unique("x") - return {"do", {"inc", "indent-level"}, {"with", __x352, form, {"dec", "indent-level"}}} + local __x360 = unique("x") + return {"do", {"inc", "indent-level"}, {"with", __x360, form, {"dec", "indent-level"}}} end}) setenv("export", {_stash = true, macro = function (...) local __names5 = unstash({...}) @@ -1048,16 +1062,16 @@ setenv("export", {_stash = true, macro = function (...) return {"set", {"get", "exports", {"quote", k}}, k} end, __names5)) else - local __x369 = {} + local __x377 = {} local ____o7 = __names5 local ____i11 = nil for ____i11 in next, ____o7 do local __k6 = ____o7[____i11] - __x369[__k6] = __k6 + __x377[__k6] = __k6 end return {"return", join({"%object"}, mapo(function (x) return x - end, __x369))} + end, __x377))} end end}) setenv("when-compiling", {_stash = true, macro = function (...) @@ -1092,13 +1106,13 @@ local function eval_print(form) end __e = __e1 end - return {stack = debug.traceback(), message = __e} + return {stack = debug["traceback"](), message = __e} end end)} local __ok = ____id[1] local __v = ____id[2] if not __ok then - return print("error: " .. __v.message .. "\n" .. __v.stack) + return print("error: " .. __v["message"] .. "\n" .. __v["stack"]) else if is63(__v) then return print(str(__v)) @@ -1117,12 +1131,12 @@ local function repl() if not( __form == __more) then eval_print(__form) __buf = "" - return system.write("> ") + return system["write"]("> ") end end - system.write("> ") + system["write"]("> ") while true do - local __s = io.read() + local __s = io["read"]() if __s then rep1(__s .. "\n") else @@ -1131,17 +1145,17 @@ local function repl() end end function compile_file(path) - local __s1 = reader.stream(system["read-file"](path)) + local __s1 = reader["stream"](system["read-file"](path)) local __body = reader["read-all"](__s1) - local __form1 = compiler.expand(join({"do"}, __body)) - return compiler.compile(__form1, {_stash = true, stmt = true}) + local __form1 = compiler["expand"](join({"do"}, __body)) + return compiler["compile"](__form1, {_stash = true, stmt = true}) end function _load(path) local __previous = target target = "lua" local __code = compile_file(path) target = __previous - return compiler.run(__code) + return compiler["run"](__code) end local function script_file63(path) return not( "-" == char(path, 0) or ".js" == clip(path, _35(path) - 3) or ".lua" == clip(path, _35(path) - 4)) @@ -1150,7 +1164,7 @@ local function run_file(path) if script_file63(path) then return _load(path) else - return compiler.run(system["read-file"](path)) + return compiler["run"](system["read-file"](path)) end end local function usage() @@ -1165,7 +1179,7 @@ local function usage() return print(" -e \tExpression to evaluate") end local function main() - local __arg = hd(system.argv) + local __arg = hd(system["argv"]) if __arg and script_file63(__arg) then return _load(__arg) else @@ -1177,7 +1191,7 @@ local function main() local __output = nil local __target1 = nil local __expr = nil - local __argv = system.argv + local __argv = system["argv"] local __i = 0 while __i < _35(__argv) do local __a = __argv[__i + 1] diff --git a/bin/reader.R b/bin/reader.R new file mode 100644 index 0000000..bae7570 --- /dev/null +++ b/bin/reader.R @@ -0,0 +1,235 @@ +delimiters <- list("(" = TRUE, ")" = TRUE, ";" = TRUE, "\r" = TRUE, "\n" = TRUE) +whitespace <- list(" " = TRUE, "\t" = TRUE, "\r" = TRUE, "\n" = TRUE) +stream <- function (str, more) { +list(pos = 0, string = str, len = V_35(str), more = more) +} +peek_char <- function (s) { + V__V__id <- s + V__pos <- V__V__id[["pos"]] + V__len <- V__V__id[["len"]] + V__string <- V__V__id[["string"]] + if (V__pos < V__len) { + char(V__string, V__pos) + } +} +read_char <- function (s) { + V__c <- peek_char(s) + if (V__c) { + s[["pos"]] <<- s[["pos"]] + 1 + V__c + } +} +skip_non_code <- function (s) { + while (TRUE) { + V__c1 <- peek_char(s) + if (nil63(V__c1)) { + break + } else { + if (whitespace[[V__c1]]) { + read_char(s) + } else { + if (V__c1 == ";") { + while (V__c1 && !( V__c1 == "\n")) { + V__c1 <- read_char(s) + } + skip_non_code(s) + } else { + break + } + } + } + } +} +read_table <- list() +eof <- list() +read <- function (s) { + skip_non_code(s) + V__c2 <- peek_char(s) + if (is63(V__c2)) { + (read_table[[V__c2]] || read_table[[""]])(s) + } else { + eof + } +} +read_all <- function (s) { + V__l <- list() + while (TRUE) { + V__form <- read(s) + if (V__form == eof) { + break + } + add(V__l, V__form) + } + V__l +} +read_string <- function (str, more) { + V__x <- read(stream(str, more)) + if (!( V__x == eof)) { + V__x + } +} +key63 <- function (atom) { + string63(atom) && V_35(atom) > 1 && char(atom, edge(atom)) == ":" +} +flag63 <- function (atom) { + string63(atom) && V_35(atom) > 1 && char(atom, 0) == ":" +} +expected <- function (s, c) { + V__V__id1 <- s + V__more <- V__V__id1[["more"]] + V__pos1 <- V__V__id1[["pos"]] + V__more || error(cat("Expected ", c, " at ", V__pos1)) +} +wrap <- function (s, x) { + V__y <- read(s) + if (V__y == s[["more"]]) { + V__y + } else { + list(x, V__y) + } +} +hex_prefix63 <- function (str) { + V__e + if (code(str, 0) == 45) { + V__e <- 1 + } else { + V__e <- 0 + } + V__i <- V__e + V__id2 <- code(str, V__i) == 48 + V__e1 + if (V__id2) { + V__i <- V__i + 1 + V__n <- code(str, V__i) + V__e1 <- V__n == 120 || V__n == 88 + } else { + V__e1 <- V__id2 + } + V__e1 +} +maybe_number <- function (str) { + if (hex_prefix63(str)) { + if (number_code63(code(str, edge(str)))) { + number(str) + } + } +} +real63 <- function (x) { + number63(x) && ! nan63(x) && ! inf63(x) +} +read_table[[""]] <<- function (s) { + V__str <- "" + while (TRUE) { + V__c3 <- peek_char(s) + if (V__c3 && (! whitespace[[V__c3]] && ! delimiters[[V__c3]])) { + V__str <- cat(V__str, read_char(s)) + } else { + break + } + } + if (V__str == "true") { + TRUE + } else { + if (V__str == "false") { + FALSE + } else { + V__n1 <- maybe_number(V__str) + if (real63(V__n1)) { + V__n1 + } else { + V__str + } + } + } +} +read_table[["("]] <<- function (s) { + read_char(s) + V__r16 <- NULL + V__l1 <- list() + while (nil63(V__r16)) { + skip_non_code(s) + V__c4 <- peek_char(s) + if (V__c4 == ")") { + read_char(s) + V__r16 <- V__l1 + } else { + if (nil63(V__c4)) { + V__r16 <- expected(s, ")") + } else { + V__x1 <- read(s) + if (key63(V__x1)) { + V__k <- clip(V__x1, 0, edge(V__x1)) + V__v <- read(s) + V__l1[[V__k]] <<- V__v + } else { + if (flag63(V__x1)) { + V__l1[[clip(V__x1, 1)]] <<- TRUE + } else { + add(V__l1, V__x1) + } + } + } + } + } + V__r16 +} +read_table[[")"]] <<- function (s) { + error(cat("Unexpected ) at ", s[["pos"]])) +} +read_table[["\""]] <<- function (s) { + read_char(s) + V__r19 <- NULL + V__str1 <- "\"" + while (nil63(V__r19)) { + V__c5 <- peek_char(s) + if (V__c5 == "\"") { + V__r19 <- cat(V__str1, read_char(s)) + } else { + if (nil63(V__c5)) { + V__r19 <- expected(s, "\"") + } else { + if (V__c5 == "\\") { + V__str1 <- cat(V__str1, read_char(s)) + } + V__str1 <- cat(V__str1, read_char(s)) + } + } + } + V__r19 +} +read_table[["|"]] <<- function (s) { + read_char(s) + V__r21 <- NULL + V__str2 <- "|" + while (nil63(V__r21)) { + V__c6 <- peek_char(s) + if (V__c6 == "|") { + V__r21 <- cat(V__str2, read_char(s)) + } else { + if (nil63(V__c6)) { + V__r21 <- expected(s, "|") + } else { + V__str2 <- cat(V__str2, read_char(s)) + } + } + } + V__r21 +} +read_table[["'"]] <<- function (s) { + read_char(s) + wrap(s, "quote") +} +read_table[["`"]] <<- function (s) { + read_char(s) + wrap(s, "quasiquote") +} +read_table[[","]] <<- function (s) { + read_char(s) + if (peek_char(s) == "@") { + read_char(s) + wrap(s, "unquote-splicing") + } else { + wrap(s, "unquote") + } +} +return list(stream = stream, read = read, "read-all" = read_all, "read-string" = read_string, "read-table" = read_table) diff --git a/bin/reader.js b/bin/reader.js index b98c64e..1c191d3 100644 --- a/bin/reader.js +++ b/bin/reader.js @@ -5,9 +5,9 @@ var stream = function (str, more) { }; var peek_char = function (s) { var ____id = s; - var __pos = ____id.pos; - var __len = ____id.len; - var __string = ____id.string; + var __pos = ____id["pos"]; + var __len = ____id["len"]; + var __string = ____id["string"]; if (__pos < __len) { return char(__string, __pos); } @@ -15,7 +15,7 @@ var peek_char = function (s) { var read_char = function (s) { var __c = peek_char(s); if (__c) { - s.pos = s.pos + 1; + s["pos"] = s["pos"] + 1; return __c; } }; @@ -76,13 +76,13 @@ var flag63 = function (atom) { }; var expected = function (s, c) { var ____id1 = s; - var __more = ____id1.more; - var __pos1 = ____id1.pos; + var __more = ____id1["more"]; + var __pos1 = ____id1["pos"]; return __more || error("Expected " + c + " at " + __pos1); }; var wrap = function (s, x) { var __y = read(s); - if (__y === s.more) { + if (__y === s["more"]) { return __y; } else { return [x, __y]; @@ -176,7 +176,7 @@ read_table["("] = function (s) { return __r16; }; read_table[")"] = function (s) { - return error("Unexpected ) at " + s.pos); + return error("Unexpected ) at " + s["pos"]); }; read_table["\""] = function (s) { read_char(s); @@ -234,8 +234,8 @@ read_table[","] = function (s) { return wrap(s, "unquote"); } }; -exports.stream = stream; -exports.read = read; +exports["stream"] = stream; +exports["read"] = read; exports["read-all"] = read_all; exports["read-string"] = read_string; exports["read-table"] = read_table; diff --git a/bin/reader.lua b/bin/reader.lua index 6ccf399..0f66d5c 100644 --- a/bin/reader.lua +++ b/bin/reader.lua @@ -5,9 +5,9 @@ local function stream(str, more) end local function peek_char(s) local ____id = s - local __pos = ____id.pos - local __len = ____id.len - local __string = ____id.string + local __pos = ____id["pos"] + local __len = ____id["len"] + local __string = ____id["string"] if __pos < __len then return char(__string, __pos) end @@ -15,7 +15,7 @@ end local function read_char(s) local __c = peek_char(s) if __c then - s.pos = s.pos + 1 + s["pos"] = s["pos"] + 1 return __c end end @@ -76,13 +76,13 @@ local function flag63(atom) end local function expected(s, c) local ____id1 = s - local __more = ____id1.more - local __pos1 = ____id1.pos + local __more = ____id1["more"] + local __pos1 = ____id1["pos"] return __more or error("Expected " .. c .. " at " .. __pos1) end local function wrap(s, x) local __y = read(s) - if __y == s.more then + if __y == s["more"] then return __y else return {x, __y} @@ -176,7 +176,7 @@ read_table["("] = function (s) return __r16 end read_table[")"] = function (s) - return error("Unexpected ) at " .. s.pos) + return error("Unexpected ) at " .. s["pos"]) end read_table["\""] = function (s) read_char(s) diff --git a/bin/system.R b/bin/system.R new file mode 100644 index 0000000..cecb9a8 --- /dev/null +++ b/bin/system.R @@ -0,0 +1,29 @@ +read_file <- function (path) { +} +write_file <- function (path, data) { +} +file_exists63 <- function (path) { +} +directory_exists63 <- function (path) { +} +path_separator +path_join <- function (...) { + V__parts <- list(...) + reduce(function (x, y) { + cat(x, path_separator, y) + }, V__parts) || "" +} +get_environment_variable <- function (name) { +} +write <- function (x) { +} +exit <- function (code) { +} +argv +reload <- function (module) { + NULL <- NULL + require(module) +} +run <- function (command) { +} +return list("read-file" = read_file, "write-file" = write_file, "file-exists?" = file_exists63, "directory-exists?" = directory_exists63, "path-separator" = path_separator, "path-join" = path_join, "get-environment-variable" = get_environment_variable, write = write, exit = exit, argv = argv, reload = reload, run = run) diff --git a/bin/system.js b/bin/system.js index 0bbb2f5..5a52aec 100644 --- a/bin/system.js +++ b/bin/system.js @@ -1,41 +1,41 @@ var fs = require("fs"); var child_process = require("child_process"); var read_file = function (path) { - return fs.readFileSync(path, "utf8"); + return fs["readFileSync"](path, "utf8"); }; var write_file = function (path, data) { - return fs.writeFileSync(path, data, "utf8"); + return fs["writeFileSync"](path, data, "utf8"); }; var file_exists63 = function (path) { - return fs.existsSync(path, "utf8") && fs.statSync(path).isFile(); + return fs["existsSync"](path, "utf8") && fs["statSync"](path)["isFile"](); }; var directory_exists63 = function (path) { - return fs.existsSync(path, "utf8") && fs.statSync(path).isDirectory(); + return fs["existsSync"](path, "utf8") && fs["statSync"](path)["isDirectory"](); }; -var path_separator = require("path").sep; +var path_separator = require("path")["sep"]; var path_join = function () { - var __parts = unstash(Array.prototype.slice.call(arguments, 0)); + var __parts = unstash(Array["prototype"]["slice"]["call"](arguments, 0)); return reduce(function (x, y) { return x + path_separator + y; }, __parts) || ""; }; var get_environment_variable = function (name) { - return process.env[name]; + return process["env"][name]; }; var write = function (x) { - var __out = process.stdout; - return __out.write(x); + var __out = process["stdout"]; + return __out["write"](x); }; var exit = function (code) { - return process.exit(code); + return process["exit"](code); }; -var argv = cut(process.argv, 2); +var argv = cut(process["argv"], 2); var reload = function (module) { - delete require.cache[require.resolve(module)]; + delete require["cache"][require["resolve"](module)]; return require(module); }; var run = function (command) { - return child_process.execSync(command).toString(); + return child_process["execSync"](command)["toString"](); }; exports["read-file"] = read_file; exports["write-file"] = write_file; @@ -44,8 +44,8 @@ exports["directory-exists?"] = directory_exists63; exports["path-separator"] = path_separator; exports["path-join"] = path_join; exports["get-environment-variable"] = get_environment_variable; -exports.write = write; -exports.exit = exit; -exports.argv = argv; -exports.reload = reload; -exports.run = run; +exports["write"] = write; +exports["exit"] = exit; +exports["argv"] = argv; +exports["reload"] = reload; +exports["run"] = run; diff --git a/bin/system.lua b/bin/system.lua index eea1a33..b4b4ee2 100644 --- a/bin/system.lua +++ b/bin/system.lua @@ -1,29 +1,29 @@ local function call_with_file(f, path, mode) - local h,e = io.open(path, mode) + local h,e = io["open"](path, mode) if not h then error(e) end local __x = f(h) - h.close(h) + h["close"](h) return __x end local function read_file(path) return call_with_file(function (f) - return f.read(f, "*a") + return f["read"](f, "*a") end, path) end local function write_file(path, data) return call_with_file(function (f) - return f.write(f, data) + return f["write"](f, data) end, path, "w") end local function file_exists63(path) - local __f = io.open(path) + local __f = io["open"](path) local __id = is63(__f) local __e if __id then - local __r6 = is63(__f.read(__f, 0)) or 0 == __f.seek(__f, "end") - __f.close(__f) + local __r6 = is63(__f["read"](__f, 0)) or 0 == __f["seek"](__f, "end") + __f["close"](__f) __e = __r6 else __e = __id @@ -31,19 +31,19 @@ local function file_exists63(path) return __e end local function directory_exists63(path) - local __f1 = io.open(path) + local __f1 = io["open"](path) local __id1 = is63(__f1) local __e1 if __id1 then - local __r8 = not __f1.read(__f1, 0) and not( 0 == __f1.seek(__f1, "end")) - __f1.close(__f1) + local __r8 = not __f1["read"](__f1, 0) and not( 0 == __f1["seek"](__f1, "end")) + __f1["close"](__f1) __e1 = __r8 else __e1 = __id1 end return __e1 end -local path_separator = char(_G.package.config, 0) +local path_separator = char(_G["package"]["config"], 0) local function path_join(...) local __parts = unstash({...}) return reduce(function (x, y) @@ -51,23 +51,23 @@ local function path_join(...) end, __parts) or "" end local function get_environment_variable(name) - return os.getenv(name) + return os["getenv"](name) end local function write(x) - return io.write(x) + return io["write"](x) end local function exit(code) - return os.exit(code) + return os["exit"](code) end local argv = arg local function reload(module) - package.loaded[module] = nil + package["loaded"][module] = nil return require(module) end local function run(command) - local __f2 = io.popen(command) - local __x2 = __f2.read(__f2, "*all") - __f2.close(__f2) + local __f2 = io["popen"](command) + local __x2 = __f2["read"](__f2, "*all") + __f2["close"](__f2) return __x2 end return {["read-file"] = read_file, ["write-file"] = write_file, ["file-exists?"] = file_exists63, ["directory-exists?"] = directory_exists63, ["path-separator"] = path_separator, ["path-join"] = path_join, ["get-environment-variable"] = get_environment_variable, write = write, exit = exit, argv = argv, reload = reload, run = run} diff --git a/compiler.l b/compiler.l index bdaa4e7..e83ba80 100644 --- a/compiler.l +++ b/compiler.l @@ -1,13 +1,12 @@ -(define reader (require 'reader)) - -(define getenv (k p) - (when (string? k) - (let i (edge environment) - (while (>= i 0) - (let b (get (at environment i) k) - (if (is? b) - (return (if p (get b p) b)) - (dec i))))))) +(define getenv (k p env) + (let env (or env (get-environment)) + (when (string? k) + (let i (edge env) + (while (>= i 0) + (let b (get (at env i) k) + (if (is? b) + (return (if p (get b p) b)) + (dec i)))))))) (define macro-function (k) (getenv k 'macro)) @@ -44,16 +43,15 @@ (atom? form) form `(list ,@(map quoted form)))) -(define literal (s) +(define-global literal (s) (if (string-literal? s) s (quoted s))) (define stash* (args) (if (keys? args) - (let l '(%object "_stash" true) + (let l '(%stash) (each (k v) args (unless (number? k) - (add l (literal k)) - (add l v))) + (add l (list (literal k) v)))) (join args (list l))) args)) @@ -86,6 +84,8 @@ (set (get args1 'rest) true) (if (= target 'js) `(unstash (arguments% ,(# args1))) + (= target 'r) + '(list |...|) '(unstash (list |...|)))) (if (atom? args) (list args1 `(let ,(list args (rest)) ,@body)) @@ -99,10 +99,11 @@ (join! bs (list v x)))))) (when (keys? args) (join! bs (list r (rest))) - (let n (# args1) - (for i n - (let v (at args1 i) - (join! bs (list v `(destash! ,v ,r)))))) + (unless (= target 'r) + (let n (# args1) + (for i n + (let v (at args1 i) + (join! bs (list v `(destash! ,v ,r))))))) (join! bs (list (keys args) r)))) (list args1 `(let ,bs ,@body)))))) @@ -232,39 +233,51 @@ (and (> n 96) (< n 123)) ; a-z (= n 95))) ; _ -(define id (id) - (let id1 (if (number-code? (code id 0)) "_" "") - (for i (# id) - (let (c (char id i) +(define accessor-prefix (set-of "." "@" "$" "\\" ":")) + +(define-global accessor-id? (x) + (and (string? x) + (get accessor-prefix (char x 0)) + (some? (char x 1)) + (not (get accessor-prefix (char x 1))))) + +(define prefix (id) + (if (= target 'r) (cat "V" id) id)) + +(define-global compile-id (id raw?) + (let (id0 (if raw? id (accessor-id? id) (clip id 1) id) + id1 (if raw? "" (number-code? (code id0 0)) (prefix "_") "")) + (for i (# id0) + (let (c (char id0 i) n (code c) c1 (if (and (= c "-") - (not (= id "-"))) + (not (= id0 "-"))) "_" (valid-code? n) c - (= i 0) (cat "_" n) + (= i 0) (cat (prefix "_") n) n)) (cat! id1 c1))) - (if (reserved? id1) - (cat "_" id1) - id1))) + (let id2 (if (reserved? id1) (cat (prefix "_") id1) id1) + (if (= id id0) id2 (cat (char id 0) id2))))) (define-global valid-id? (x) - (and (some? x) (= x (id x)))) + (and (some? x) (= x (compile-id x 'raw)))) (let (names (obj)) (define-global unique (x) - (let x (id x) + (let x (compile-id x) (if (get names x) (let i (get names x) (inc (get names x)) (unique (cat x i))) (do (set (get names x) 1) - (cat "__" x)))))) + (cat (prefix "__") x)))))) (define-global key (k) (let i (inner k) (if (valid-id? i) i (= target 'js) k + (= target 'r) k (cat "[" k "]")))) (define-global mapo (f t) @@ -276,20 +289,22 @@ (add o x)))))) (define infix - `((not: (js: ! lua: ,"not")) + `((not: (r: ! js: ! lua: ,"not")) (:* :/ :%) (cat: (js: + lua: ..)) (:+ :-) (:< :> :<= :>=) - (=: (js: === lua: ==)) - (and: (js: && lua: and)) - (or: (js: ,"||" lua: or)))) + (=: (r: == js: === lua: ==)) + (and: (r: && js: && lua: and)) + (or: (r: ,"||" js: ,"||" lua: or)))) (define unary? (form) (and (two? form) (in? (hd form) '(not -)))) (define index (k) - (target js: k lua: (when (number? k) (- k 1)))) + (target js: k + lua: (when (number? k) (- k 1)) + r: (when (number? k) (- k 1)))) (define precedence (form) (unless (or (atom? form) (unary? form)) @@ -310,7 +325,7 @@ (define-global infix-operator? (x) (and (obj? x) (infix? (hd x)))) -(define compile-args (args) +(define-global compile-args (args) (let (s "(" c "") (step x args (cat! s c (compile x)) @@ -325,13 +340,23 @@ (= c "\r") "\\r" c)))))) +(define compile-nil (x) + (if (= target 'lua) "nil" + (= target 'js) "undefined" + (= target 'r) "NULL" + "nil")) + +(define compile-boolean (x) + (if (= target 'r) + (if x "TRUE" "FALSE") + (if x "true" "false"))) + (define compile-atom (x) - (if (and (= x "nil") (= target 'lua)) x - (= x "nil") "undefined" + (if (= x "nil") (compile-nil x) (id-literal? x) (inner x) (string-literal? x) (escape-newlines x) - (string? x) (id x) - (boolean? x) (if x "true" "false") + (string? x) (compile-id x) + (boolean? x) (compile-boolean x) (nan? x) "nan" (= x inf) "inf" (= x -inf) "-inf" @@ -382,7 +407,8 @@ (define-global compile-function (args body :name :prefix) (let (id (if name (compile name) "") - args1 (if (and (= target 'lua) + args1 (if (and (or (= target 'lua) + (= target 'r)) (get args 'rest)) `(,@args |...|) args) @@ -390,14 +416,15 @@ body (with-indent (compile body :stmt)) ind (indentation) p (if prefix (cat prefix " ") "") - tr (if (= target 'js) "" "end")) + tr (if (= target 'lua) "end" "")) (if name (cat! tr "\n")) - (if (= target 'js) - (cat "function " id args " {\n" body ind "}" tr) - (cat p "function " id args "\n" body ind tr)))) + (if (= target 'lua) + (cat p "function " id args "\n" body ind tr) + (cat "function " id args " {\n" body ind "}" tr)))) (define can-return? (form) (and (is? form) + (not (= target 'r)) (or (atom? form) (and (not (= (hd form) 'return)) (not (statement? (hd form))))))) @@ -426,6 +453,9 @@ (define lower-body (body tail?) (lower-statement `(do ,@body) tail?)) +(define lower-block (body tail?) + `(%block ,@(tl (lower-body body tail?)))) + (define literal? (form) (or (atom? form) (= (hd form) '%array) @@ -553,6 +583,7 @@ (lower-infix? form) (lower-infix form hoist) (let ((x rest: args) form) (if (= x 'do) (lower-do args hoist stmt? tail?) + (= x '%block) (lower-block args tail?) (= x '%call) (lower args hoist stmt? tail?) (= x '%set) (lower-set args hoist stmt? tail?) (= x '%if) (lower-if args hoist stmt? tail?) @@ -606,18 +637,25 @@ (= (hd x) 'break)) (break)))))) +(define-special %block forms + (with s "{\n" + (with-indent + (step x forms + (cat! s (compile x :stmt)))) + (cat! s (indentation) "}"))) + (define-special %if (cond cons alt) :stmt :tr (let (cond (compile cond) cons (with-indent (compile cons :stmt)) alt (if alt (with-indent (compile alt :stmt))) ind (indentation) s "") - (if (= target 'js) - (cat! s ind "if (" cond ") {\n" cons ind "}") - (cat! s ind "if " cond " then\n" cons)) - (if (and alt (= target 'js)) - (cat! s " else {\n" alt ind "}") - alt (cat! s ind "else\n" alt)) + (if (= target 'lua) + (cat! s ind "if " cond " then\n" cons) + (cat! s ind "if (" cond ") {\n" cons ind "}")) + (if (and alt (= target 'lua)) + (cat! s ind "else\n" alt) + alt (cat! s " else {\n" alt ind "}")) (if (= target 'lua) (cat s ind "end\n") (cat s "\n")))) @@ -626,9 +664,9 @@ (let (cond (compile cond) body (with-indent (compile form :stmt)) ind (indentation)) - (if (= target 'js) - (cat ind "while (" cond ") {\n" body ind "}\n") - (cat ind "while " cond " do\n" body ind "end\n")))) + (if (= target 'lua) + (cat ind "while " cond " do\n" body ind "end\n") + (cat ind "while (" cond ") {\n" body ind "}\n")))) (define-special %for (t k form) :stmt :tr (let (t (compile t) @@ -689,15 +727,17 @@ (define-special %local (name value) :stmt (let (id (compile name) value1 (compile value) - rh (if (is? value) (cat " = " value1) "") - keyword (if (= target 'js) "var " "local ") + sep (if (= target 'r) " <- " " = ") + rh (if (is? value) (cat sep value1) "") + keyword (if (= target 'js) "var " (= target 'lua) "local " "") ind (indentation)) (cat ind keyword id rh))) (define-special %set (lh rh) :stmt - (let (lh (compile lh) - rh (compile (if (nil? rh) 'nil rh))) - (cat (indentation) lh " = " rh))) + (let (lh1 (compile lh) + rh1 (compile (if (nil? rh) 'nil rh)) + sep (if (= target 'r) (if (hd? lh 'get) " <<- " " <- ") " = ")) + (cat (indentation) lh1 sep rh1))) (define-special get (t k) (let (t1 (compile t) @@ -706,14 +746,15 @@ (= (char t1 0) "{")) (infix-operator? t)) (set t1 (cat "(" t1 ")"))) - (if (and (string-literal? k) - (valid-id? (inner k))) - (cat t1 "." (inner k)) + (if (accessor-id? k) + (cat t1 k1) + (= target 'r) + (cat t1 "[[" k1 "]]") (cat t1 "[" k1 "]")))) (define-special %array forms - (let (open (if (= target 'lua) "{" "[") - close (if (= target 'lua) "}" "]") + (let (open (if (= target 'r) "list(" (= target 'lua) "{" "[") + close (if (= target 'r) ")" (= target 'lua) "}" "]") s "" c "") (each (k v) forms (when (number? k) @@ -722,8 +763,8 @@ (cat open s close))) (define-special %object forms - (let (s "{" c "" - sep (if (= target 'lua) " = " ": ")) + (let (s (if (= target 'r) "list(" "{") c "" + sep (if (= target 'js) ": " " = ")) (each (k v) (pair forms) (when (number? k) (let ((k v) v) @@ -731,11 +772,26 @@ (error (cat "Illegal key: " (str k)))) (cat! s c (key k) sep (compile v)) (set c ", ")))) - (cat s "}"))) + (cat s (if (= target 'r) ")" "}")))) (define-special %literal args (apply cat (map compile args))) +(define-special %stash args + (if (= target 'r) + (with-indent + (let ind (indentation) + (with s "" + (let c "" + (step (k v) args + (cat! s c "\n" ind (inner (compile k)) " = " (compile v)) + (set c ",")))))) + (let l '(%object "_stash" true) + (step (k v) args + (add l (literal k)) + (add l v)) + (compile l)))) + (export run eval expand diff --git a/macros.l b/macros.l index bac6bd6..972ef1b 100644 --- a/macros.l +++ b/macros.l @@ -9,27 +9,29 @@ (pair args)))) (define-macro at (l i) - (if (and (= target 'lua) (number? i)) + (if (and (or (= target 'lua) (= target 'r)) (number? i)) (inc i) - (= target 'lua) + (or (= target 'lua) (= target 'r)) (set i `(+ ,i 1))) `(get ,l ,i)) (define-macro wipe (place) - (if (= target 'lua) + (if (or (= target 'lua) (= target 'r)) `(set ,place nil) `(%delete ,place))) (define-macro list body - (let-unique (x) - (let (l () forms ()) - (each (k v) body - (if (number? k) - (set (get l k) v) - (add forms `(set (get ,x ',k) ,v)))) - (if (some? forms) - `(let ,x (%array ,@l) ,@forms ,x) - `(%array ,@l))))) + (if (= target 'r) + `(%call list ,@body) + (let-unique (x) + (let (l () forms ()) + (each (k v) body + (if (number? k) + (set (get l k) v) + (add forms `(set (get ,x ',k) ,v)))) + (if (some? forms) + `(let ,x (%array ,@l) ,@forms ,x) + `(%array ,@l)))))) (define-macro if branches (hd (expand-if branches))) @@ -109,9 +111,9 @@ (define-macro with-frame body (let-unique (x) - `(do (add environment (obj)) + `(do (add (get-environment) (obj)) (with ,x (do ,@body) - (drop environment))))) + (drop (get-environment)))))) (define-macro with-bindings ((names) rest: body) (let-unique (x) @@ -167,9 +169,11 @@ (if (> (# x) 1) x (list i (hd x))))) `(let (,o ,t ,k nil) - (%for ,o ,k + (%for ,(if (= target 'r) `(indices ,o) o) ,k (let (,v (get ,o ,k)) - ,@(if (= target 'lua) body + ,@(if (or (= target 'lua) + (= target 'r)) + body `((let ,k (if (numeric? ,k) (parseInt ,k) ,k) diff --git a/makefile b/makefile index 4f71c7c..b92a25c 100644 --- a/makefile +++ b/makefile @@ -2,6 +2,7 @@ LUMEN_LUA ?= lua LUMEN_NODE ?= node +LUMEN_R ?= r LUMEN_HOST ?= $(LUMEN_LUA) LUMEN := LUMEN_HOST="$(LUMEN_HOST)" bin/lumen @@ -15,11 +16,11 @@ MODS := bin/lumen.x \ bin/compiler.x \ bin/system.x -all: $(MODS:.x=.js) $(MODS:.x=.lua) +all: $(MODS:.x=.js) $(MODS:.x=.lua) $(MODS:.x=.R) clean: - @git checkout bin/*.js - @git checkout bin/*.lua + @git checkout -f bin/*.js + @git checkout -f bin/*.lua @rm -f obj/* bin/lumen.js: $(OBJS:.o=.js) @@ -32,6 +33,11 @@ bin/lumen.lua: $(OBJS:.o=.lua) @cat $^ > $@.tmp @mv $@.tmp $@ +bin/lumen.R: $(OBJS:.o=.R) + @echo $@ + @cat $^ > $@.tmp + @mv $@.tmp $@ + obj/%.js : %.l @echo " $@" @$(LUMEN) -c $< -o $@ -t js @@ -40,6 +46,10 @@ obj/%.lua : %.l @echo " $@" @$(LUMEN) -c $< -o $@ -t lua +obj/%.R : %.l + @echo " $@" + @$(LUMEN) -c $< -o $@ -t r + bin/%.js : %.l @echo $@ @$(LUMEN) -c $< -o $@ -t js @@ -48,6 +58,10 @@ bin/%.lua : %.l @echo $@ @$(LUMEN) -c $< -o $@ -t lua +bin/%.R : %.l + @echo $@ + @$(LUMEN) -c $< -o $@ -t r + test: all @echo js: @LUMEN_HOST=$(LUMEN_NODE) ./test.l diff --git a/obj/.gitignore b/obj/.gitignore index bf714ba..1d11a2e 100644 --- a/obj/.gitignore +++ b/obj/.gitignore @@ -1,2 +1,3 @@ *.js *.lua +*.R diff --git a/runtime.l b/runtime.l index 50951c8..d38d612 100644 --- a/runtime.l +++ b/runtime.l @@ -1,10 +1,14 @@ -(define-global environment (list (obj))) +(define environment (list (obj))) (define-global target (language)) +(define-global get-environment () + environment) + (define-global nil? (x) (target js: (or (= x nil) (= x null)) - lua: (= x nil))) + lua: (= x nil) + r: ((get is .null) x))) (define-global is? (x) (not (nil? x))) @@ -13,11 +17,23 @@ (define-global either (x y) (if (is? x) x y)) (define-global has? (l k) - (target js: ((get l 'hasOwnProperty) k) - lua: (is? (get l k)))) + (target js: ((get l .hasOwnProperty) k) + lua: (is? (get l k)) + r: (%literal k | %in% | (names l)))) + +(target r: +(define-global indices (l) + (Map (fn (k i) (if (= k "") i k)) + (names l) + (seq_len (length l))))) (define-global # (x) - (target js: (or (get x 'length) 0) lua: |#x|)) + (target js: (or (get x .length) 0) + lua: (%literal |#| x) + r: (if ((get is .character) x) + (nchar x) + (- (length x) + (length (Filter nchar (names x))))))) (define-global none? (x) (= (# x) 0)) (define-global some? (x) (> (# x) 0)) @@ -27,15 +43,16 @@ (define-global hd (l) (at l 0)) (target js: (define-global type (x) (typeof x))) +(target r: (define-global type (x) (mode x))) -(define-global string? (x) (= (type x) 'string)) -(define-global number? (x) (= (type x) 'number)) -(define-global boolean? (x) (= (type x) 'boolean)) +(define-global string? (x) (= (type x) (target r: 'character js: 'string lua: 'string))) +(define-global number? (x) (= (type x) (target r: 'numeric js: 'number lua: 'number))) +(define-global boolean? (x) (= (type x) (target r: 'logical js: 'boolean lua: 'boolean))) (define-global function? (x) (= (type x) 'function)) (define-global obj? (x) (and (is? x) - (= (type x) (target lua: 'table js: 'object)))) + (= (type x) (target r: 'list lua: 'table js: 'object)))) (define-global atom? (x) (or (nil? x) (string? x) (number? x) (boolean? x))) @@ -48,13 +65,20 @@ (define-global -inf (- inf)) (define-global nan? (n) - (not (= n n))) + (target + r: ((get is .nan) n) + js: (not (= n n)) + lua: (not (= n n)))) (define-global inf? (n) - (or (= n inf) (= n -inf))) + (target + r: (not ((get is .finite) n)) + js: (or (= n inf) (= n -inf)) + lua: (or (= n inf) (= n -inf)))) (define-global clip (s from upto) - (target js: ((get s 'substring) from upto) + (target r: (substr s (+ from 1) upto) + js: ((get s 'substring) from upto) lua: ((get string 'sub) s (+ from 1) upto))) (define-global cut (x from upto) @@ -334,14 +358,15 @@ (apply f args)) (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)))) + (let env (get-environment) + (when (string? k) + (let (frame (if (get keys 'toplevel) + (hd env) + (last env)) + 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)