Updated to align with 0.9.0

This commit is contained in:
Alexander Griffith 2021-04-13 23:23:36 -04:00
commit 854e0897e3
6 changed files with 138 additions and 516 deletions

View file

@ -1038,8 +1038,32 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
return _0_, not multi, 3
else
return nil, true, 2
<<<<<<< HEAD
end
end
local function compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, local_3f, arg_name_list, arg_list, docstring)
for i = (index + 1), #ast do
compiler.compile1(ast[i], f_scope, f_chunk, {nval = (((i ~= #ast) and 0) or nil), tail = (i == #ast)})
end
local _0_
if local_3f then
_0_ = "local function %s(%s)"
else
_0_ = "%s = function(%s)"
=======
>>>>>>> technomancy/min-love2d-fennel-0.9.0
end
compiler.emit(parent, string.format(_0_, fn_name, table.concat(arg_name_list, ", ")), ast)
compiler.emit(parent, f_chunk, ast)
compiler.emit(parent, "end", ast)
set_fn_metadata(arg_list, docstring, parent, fn_name)
utils.hook("fn", ast, f_scope)
return utils.expr(fn_name, "sym")
end
local function compile_anonymous_fn(ast, f_scope, f_chunk, parent, index, arg_name_list, arg_list, docstring, scope)
local fn_name = compiler.gensym(scope)
return compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, true, arg_name_list, arg_list, docstring)
end
local function compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, local_3f, arg_name_list, arg_list, docstring)
for i = (index + 1), #ast do
compiler.compile1(ast[i], f_scope, f_chunk, {nval = (((i ~= #ast) and 0) or nil), tail = (i == #ast)})
@ -1547,6 +1571,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
_0_ = 1
else
_0_ = nil
<<<<<<< HEAD
end
subexprs = compiler.compile1(ast[i], scope, parent, {nval = _0_})
utils.map(subexprs, tostring, operands)
@ -1566,6 +1591,27 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
local function _0_(...)
return arithmetic_special((lua_name or name), zero_arity, unary_prefix, ...)
end
=======
end
subexprs = compiler.compile1(ast[i], scope, parent, {nval = _0_})
utils.map(subexprs, tostring, operands)
end
if (#operands == 1) then
if unary_prefix then
return ("(" .. unary_prefix .. padded_op .. operands[1] .. ")")
else
return operands[1]
end
else
return ("(" .. table.concat(operands, padded_op) .. ")")
end
end
end
local function define_arithmetic_special(name, zero_arity, unary_prefix, lua_name)
local function _0_(...)
return arithmetic_special((lua_name or name), zero_arity, unary_prefix, ...)
end
>>>>>>> technomancy/min-love2d-fennel-0.9.0
SPECIALS[name] = _0_
return doc_special(name, {"a", "b", "..."}, "Arithmetic operator; works the same as Lua but accepts more arguments.")
end
@ -2376,7 +2422,18 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
if ((se.type == "expression") and (se[1] ~= "nil")) then
emit(chunk, string.format("do local _ = %s end", tostring(se)), ast)
elseif (se.type == "statement") then
<<<<<<< HEAD
emit(chunk, disambiguate_parens(tostring(se), chunk), ast)
=======
local code = tostring(se)
local unambiguous_code = nil
if (code:byte() == 40) then
unambiguous_code = ("; " .. code)
else
unambiguous_code = code
end
emit(chunk, unambiguous_code, ast)
>>>>>>> technomancy/min-love2d-fennel-0.9.0
end
end
return nil
@ -3847,7 +3904,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
opts.filename = filename
return eval(source, opts, ...)
end
<<<<<<< HEAD
local mod = {["comment?"] = utils["comment?"], ["compile-stream"] = compiler["compile-stream"], ["compile-string"] = compiler["compile-string"], ["list?"] = utils["list?"], ["load-code"] = specials["load-code"], ["macro-loaded"] = specials["macro-loaded"], ["macro-searchers"] = specials["macro-searchers"], ["make-searcher"] = specials["make-searcher"], ["search-module"] = specials["search-module"], ["sequence?"] = utils["sequence?"], ["string-stream"] = parser["string-stream"], ["sym-char?"] = parser["sym-char?"], ["sym?"] = utils["sym?"], comment = utils.comment, compile = compiler.compile, compile1 = compiler.compile1, compileStream = compiler["compile-stream"], compileString = compiler["compile-string"], doc = specials.doc, dofile = dofile_2a, eval = eval, gensym = compiler.gensym, granulate = parser.granulate, list = utils.list, loadCode = specials["load-code"], macroLoaded = specials["macro-loaded"], makeSearcher = specials["make-searcher"], make_searcher = specials["make-searcher"], mangle = compiler["global-mangling"], metadata = compiler.metadata, parser = parser.parser, path = utils.path, repl = repl, scope = compiler["make-scope"], searchModule = specials["search-module"], searcher = specials["make-searcher"](), sequence = utils.sequence, stringStream = parser["string-stream"], sym = utils.sym, traceback = compiler.traceback, unmangle = compiler["global-unmangling"], varg = utils.varg, version = "0.9.1", view = view}
=======
local mod = {["comment?"] = utils["comment?"], ["compile-stream"] = compiler["compile-stream"], ["compile-string"] = compiler["compile-string"], ["list?"] = utils["list?"], ["load-code"] = specials["load-code"], ["macro-loaded"] = specials["macro-loaded"], ["macro-searchers"] = specials["macro-searchers"], ["make-searcher"] = specials["make-searcher"], ["search-module"] = specials["search-module"], ["sequence?"] = utils["sequence?"], ["string-stream"] = parser["string-stream"], ["sym-char?"] = parser["sym-char?"], ["sym?"] = utils["sym?"], comment = utils.comment, compile = compiler.compile, compile1 = compiler.compile1, compileStream = compiler["compile-stream"], compileString = compiler["compile-string"], doc = specials.doc, dofile = dofile_2a, eval = eval, gensym = compiler.gensym, granulate = parser.granulate, list = utils.list, loadCode = specials["load-code"], macroLoaded = specials["macro-loaded"], makeSearcher = specials["make-searcher"], make_searcher = specials["make-searcher"], mangle = compiler["global-mangling"], metadata = compiler.metadata, parser = parser.parser, path = utils.path, repl = repl, scope = compiler["make-scope"], searchModule = specials["search-module"], searcher = specials["make-searcher"](), sequence = utils.sequence, stringStream = parser["string-stream"], sym = utils.sym, traceback = compiler.traceback, unmangle = compiler["global-unmangling"], varg = utils.varg, version = "0.9.0", view = view}
>>>>>>> technomancy/min-love2d-fennel-0.9.0
utils["fennel-module"] = mod
do
local builtin_macros = [===[;; This module contains all the built-in Fennel macros. Unlike all the other

View file

@ -898,6 +898,16 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
else
return nil, true, 2
end
compiler.emit(parent, string.format(_0_, fn_name, table.concat(arg_name_list, ", ")), ast)
compiler.emit(parent, f_chunk, ast)
compiler.emit(parent, "end", ast)
set_fn_metadata(arg_list, docstring, parent, fn_name)
utils.hook("fn", ast, f_scope)
return utils.expr(fn_name, "sym")
end
local function compile_anonymous_fn(ast, f_scope, f_chunk, parent, index, arg_name_list, arg_list, docstring, scope)
local fn_name = compiler.gensym(scope)
return compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, true, arg_name_list, arg_list, docstring)
end
local function compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, local_3f, arg_name_list, arg_list, docstring)
for i = (index + 1), #ast do
@ -2235,7 +2245,14 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
if ((se.type == "expression") and (se[1] ~= "nil")) then
emit(chunk, string.format("do local _ = %s end", tostring(se)), ast)
elseif (se.type == "statement") then
emit(chunk, disambiguate_parens(tostring(se), chunk), ast)
local code = tostring(se)
local unambiguous_code = nil
if (code:byte() == 40) then
unambiguous_code = ("; " .. code)
else
unambiguous_code = code
end
emit(chunk, unambiguous_code, ast)
end
end
return nil
@ -3706,19 +3723,19 @@ local function dofile_2a(filename, options, ...)
opts.filename = filename
return eval(source, opts, ...)
end
local mod = {["comment?"] = utils["comment?"], ["compile-stream"] = compiler["compile-stream"], ["compile-string"] = compiler["compile-string"], ["list?"] = utils["list?"], ["load-code"] = specials["load-code"], ["macro-loaded"] = specials["macro-loaded"], ["macro-searchers"] = specials["macro-searchers"], ["make-searcher"] = specials["make-searcher"], ["search-module"] = specials["search-module"], ["sequence?"] = utils["sequence?"], ["string-stream"] = parser["string-stream"], ["sym-char?"] = parser["sym-char?"], ["sym?"] = utils["sym?"], comment = utils.comment, compile = compiler.compile, compile1 = compiler.compile1, compileStream = compiler["compile-stream"], compileString = compiler["compile-string"], doc = specials.doc, dofile = dofile_2a, eval = eval, gensym = compiler.gensym, granulate = parser.granulate, list = utils.list, loadCode = specials["load-code"], macroLoaded = specials["macro-loaded"], makeSearcher = specials["make-searcher"], make_searcher = specials["make-searcher"], mangle = compiler["global-mangling"], metadata = compiler.metadata, parser = parser.parser, path = utils.path, repl = repl, scope = compiler["make-scope"], searchModule = specials["search-module"], searcher = specials["make-searcher"](), sequence = utils.sequence, stringStream = parser["string-stream"], sym = utils.sym, traceback = compiler.traceback, unmangle = compiler["global-unmangling"], varg = utils.varg, version = "0.9.1", view = view}
local mod = {["comment?"] = utils["comment?"], ["compile-stream"] = compiler["compile-stream"], ["compile-string"] = compiler["compile-string"], ["list?"] = utils["list?"], ["load-code"] = specials["load-code"], ["macro-loaded"] = specials["macro-loaded"], ["macro-searchers"] = specials["macro-searchers"], ["make-searcher"] = specials["make-searcher"], ["search-module"] = specials["search-module"], ["sequence?"] = utils["sequence?"], ["string-stream"] = parser["string-stream"], ["sym-char?"] = parser["sym-char?"], ["sym?"] = utils["sym?"], comment = utils.comment, compile = compiler.compile, compile1 = compiler.compile1, compileStream = compiler["compile-stream"], compileString = compiler["compile-string"], doc = specials.doc, dofile = dofile_2a, eval = eval, gensym = compiler.gensym, granulate = parser.granulate, list = utils.list, loadCode = specials["load-code"], macroLoaded = specials["macro-loaded"], makeSearcher = specials["make-searcher"], make_searcher = specials["make-searcher"], mangle = compiler["global-mangling"], metadata = compiler.metadata, parser = parser.parser, path = utils.path, repl = repl, scope = compiler["make-scope"], searchModule = specials["search-module"], searcher = specials["make-searcher"](), sequence = utils.sequence, stringStream = parser["string-stream"], sym = utils.sym, traceback = compiler.traceback, unmangle = compiler["global-unmangling"], varg = utils.varg, version = "0.9.0", view = view}
utils["fennel-module"] = mod
do
local builtin_macros = [===[;; This module contains all the built-in Fennel macros. Unlike all the other
;; modules that are loaded by the old bootstrap compiler, this runs in the
;; compiler scope of the version of the compiler being defined.
;; The code for these macros is somewhat idiosyncratic because it cannot use any
;; macros which have not yet been defined.
;; TODO: some of these macros modify their arguments; we should stop doing that,
;; but in a way that preserves file/line metadata.
(fn ->* [val ...]
"Thread-first macro.
Take the first value and splice it into the second form as its first argument.
@ -3729,7 +3746,7 @@ do
(table.insert elt 2 x)
(set x elt)))
x)
(fn ->>* [val ...]
"Thread-last macro.
Same as ->, except splices the value into the last position of each form
@ -3740,7 +3757,7 @@ do
(table.insert elt x)
(set x elt)))
x)
(fn -?>* [val ...]
"Nil-safe thread-first macro.
Same as -> except will short-circuit with nil when it encounters a nil value."
@ -3755,7 +3772,7 @@ do
(if ,tmp
(-?> ,el ,(unpack els))
,tmp)))))
(fn -?>>* [val ...]
"Nil-safe thread-last macro.
Same as ->> except will short-circuit with nil when it encounters a nil value."
@ -3770,14 +3787,14 @@ do
(if ,tmp
(-?>> ,el ,(unpack els))
,tmp)))))
(fn ?dot [tbl k ...]
"Nil-safe table look up.
Same as . (dot), except will short-circuit with nil when it encounters
a nil value in any of subsequent keys."
(if (= nil k) tbl `(let [res# (. ,tbl ,k)]
(and res# (?. res# ,...)))))
(fn doto* [val ...]
"Evaluates val and splices it into the first argument of subsequent forms."
(let [name (gensym)
@ -3787,7 +3804,7 @@ do
(table.insert form elt))
(table.insert form name)
form))
(fn when* [condition body1 ...]
"Evaluate body for side-effects only when condition is truthy."
(assert body1 "expected body")
@ -3795,7 +3812,7 @@ do
(do
,body1
,...)))
(fn with-open* [closable-bindings ...]
"Like `let`, but invokes (v:close) on each binding after evaluating the body.
The body is evaluated inside `xpcall` so that bound values will be closed upon
@ -3812,13 +3829,13 @@ do
`(let ,closable-bindings
,closer
(close-handlers# (xpcall ,bodyfn ,traceback)))))
(fn collect* [iter-tbl key-value-expr ...]
"Returns a table made by running an iterator and evaluating an expression
that returns key-value pairs to be inserted sequentially into the table.
This can be thought of as a \"table comprehension\". The provided key-value
expression must return either 2 values, or nil.
For example,
(collect [k v (pairs {:apple \"red\" :orange \"orange\"})]
(values v k))
@ -3834,12 +3851,12 @@ do
(match ,key-value-expr
(k# v#) (tset tbl# k# v#)))
tbl#))
(fn icollect* [iter-tbl value-expr ...]
"Returns a sequential table made by running an iterator and evaluating an
expression that returns values to be inserted sequentially into the table.
This can be thought of as a \"list comprehension\".
For example,
(icollect [_ v (ipairs [1 2 3 4 5])] (when (> v 2) (* v v)))
returns
@ -3853,7 +3870,7 @@ do
(each ,iter-tbl
(tset tbl# (+ (length tbl#) 1) ,value-expr))
tbl#))
(fn partial* [f ...]
"Returns a function with all arguments partially applied to f."
(assert f "expected a function to partially apply")
@ -3861,10 +3878,10 @@ do
(table.insert body _VARARG)
`(fn [,_VARARG]
,body)))
(fn pick-args* [n f]
"Creates a function of arity n that applies its arguments to f.
For example,
(pick-args 2 func)
expands to
@ -3876,10 +3893,10 @@ do
(tset bindings i (gensym)))
`(fn ,bindings
(,f ,(unpack bindings)))))
(fn pick-values* [n ...]
"Like the `values` special, but emits exactly n values.
For example,
(pick-values 2 ...)
expands to
@ -3894,7 +3911,7 @@ do
(if (= n 0) `(values)
`(let [,let-syms ,let-values]
(values ,(unpack let-syms))))))
(fn lambda* [...]
"Function literal with arity checking.
Will throw an exception if a declared argument is passed in as nil, unless
@ -3921,26 +3938,26 @@ do
,(tostring a)
,(or a.filename :unknown)
,(or a.line "?"))))))
(assert (= :table (type arglist)) "expected arg list")
(each [_ a (ipairs arglist)]
(check! a))
(if empty-body?
(table.insert args (sym :nil)))
`(fn ,(unpack args))))
(fn macro* [name ...]
"Define a single macro."
(assert (sym? name) "expected symbol for macro name")
(local args [...])
`(macros {,(tostring name) (fn ,(unpack args))}))
(fn macrodebug* [form return?]
"Print the resulting form after performing macroexpansion.
With a second argument, returns expanded form as a string instead of printing."
(let [handle (if return? `do `print)]
`(,handle ,(view (macroexpand form _SCOPE)))))
(fn import-macros* [binding1 module-name1 ...]
"Binds a table of macros from each macro module according to a binding form.
Each binding form can be either a symbol or a k/v destructuring table.
@ -3971,9 +3988,9 @@ do
(tostring modname)))
(tset scope.macros import-key (. subscope.macros macro-name))))))
nil)
;;; Pattern matching
(fn match-values [vals pattern unifications match-pattern]
(let [condition `(and)
bindings []]
@ -3984,7 +4001,7 @@ do
(each [_ b (ipairs subbindings)]
(table.insert bindings b))))
(values condition bindings)))
(fn match-table [val pattern unifications match-pattern]
(let [condition `(and (= (type ,val) :table))
bindings []]
@ -4016,7 +4033,7 @@ do
(each [_ b (ipairs subbindings)]
(table.insert bindings b)))))
(values condition bindings)))
(fn match-pattern [vals pattern unifications]
"Takes the AST of values and a single pattern and returns a condition
to determine if it matches as well as a list of bindings to
@ -4056,7 +4073,7 @@ do
(match-table val pattern unifications match-pattern)
;; literal value
(values `(= ,val ,pattern) []))))
(fn match-condition [vals clauses]
"Construct the actual `if` AST for the given match values and clauses."
(if (not= 0 (% (length clauses) 2)) ; treat odd final clause as default
@ -4070,7 +4087,7 @@ do
(table.insert out `(let ,bindings
,body))))
out))
(fn match-val-syms [clauses]
"How many multi-valued clauses are there? return a list of that many gensyms."
(let [syms (list (gensym))]
@ -4080,7 +4097,7 @@ do
(if (not (. syms valnum))
(tset syms valnum (gensym))))))
syms))
(fn match* [val ...]
;; Old implementation of match macro, which doesn't directly support
;; `where' and `or'. New syntax is implemented in `match-where',
@ -4090,9 +4107,9 @@ do
;; protect against multiple evaluation of the value, bind against as
;; many values as we ever match against in the clauses.
(list `let [vals val] (match-condition vals clauses))))
;; Construction of old match syntax from new syntax
(fn partition-2 [seq]
;; Partition `seq` by 2.
;; If `seq` has odd amount of elements, the last one is dropped.
@ -4112,7 +4129,7 @@ do
(if (not= nil v2)
(table.insert res [v1 v2]))))
res))
(fn transform-or [[_ & pats] guards]
;; Transforms `(or pat pats*)` lists into match `guard` patterns.
;;
@ -4121,7 +4138,7 @@ do
(each [_ pat (ipairs pats)]
(table.insert res (list pat `? (unpack guards))))
res))
(fn transform-cond [cond]
;; Transforms `where` cond into sequence of `match` guards.
;;
@ -4136,12 +4153,12 @@ do
[(list second `? (unpack cond 3))]))
:else
[cond]))
(fn match-where [val ...]
"Perform pattern matching on val. See reference for details.
Syntax:
(match data-expression
pattern body
(where pattern guard guards*) body
@ -4157,7 +4174,7 @@ do
(if else-branch
(table.insert match-body else-branch))
(match* val (unpack match-body))))
{:-> ->*
:->> ->>*
:-?> -?>*

View file

@ -1,382 +0,0 @@
local type_order = {["function"] = 5, boolean = 2, number = 1, string = 3, table = 4, thread = 7, userdata = 6}
local function sort_keys(_0_0, _1_0)
local _1_ = _0_0
local a = _1_[1]
local _2_ = _1_0
local b = _2_[1]
local ta = type(a)
local tb = type(b)
if ((ta == tb) and ((ta == "string") or (ta == "number"))) then
return (a < b)
else
local dta = type_order[ta]
local dtb = type_order[tb]
if (dta and dtb) then
return (dta < dtb)
elseif dta then
return true
elseif dtb then
return false
else
return (ta < tb)
end
end
end
local function table_kv_pairs(t)
local assoc_3f = false
local i = 1
local kv = {}
local insert = table.insert
for k, v in pairs(t) do
if ((type(k) ~= "number") or (k ~= i)) then
assoc_3f = true
end
i = (i + 1)
insert(kv, {k, v})
end
table.sort(kv, sort_keys)
if (#kv == 0) then
return kv, "empty"
else
local function _2_()
if assoc_3f then
return "table"
else
return "seq"
end
end
return kv, _2_()
end
end
local function count_table_appearances(t, appearances)
if (type(t) == "table") then
if not appearances[t] then
appearances[t] = 1
for k, v in pairs(t) do
count_table_appearances(k, appearances)
count_table_appearances(v, appearances)
end
else
appearances[t] = ((appearances[t] or 0) + 1)
end
end
return appearances
end
local function save_table(t, seen)
local seen0 = (seen or {len = 0})
local id = (seen0.len + 1)
if not seen0[t] then
seen0[t] = id
seen0.len = id
end
return seen0
end
local function detect_cycle(t, seen, _3fk)
if ("table" == type(t)) then
seen[t] = true
local _2_0, _3_0 = next(t, _3fk)
if ((nil ~= _2_0) and (nil ~= _3_0)) then
local k = _2_0
local v = _3_0
return (seen[k] or detect_cycle(k, seen) or seen[v] or detect_cycle(v, seen) or detect_cycle(t, seen, k))
end
end
end
local function visible_cycle_3f(t, options)
return (options["detect-cycles?"] and detect_cycle(t, {}) and save_table(t, options.seen) and (1 < (options.appearances[t] or 0)))
end
local function table_indent(t, indent, id)
local opener_length = nil
if id then
opener_length = (#tostring(id) + 2)
else
opener_length = 1
end
return (indent + opener_length)
end
local pp = nil
local function concat_table_lines(elements, options, multiline_3f, indent, table_type, prefix)
local indent_str = ("\n" .. string.rep(" ", indent))
local open = nil
local function _2_()
if ("seq" == table_type) then
return "["
else
return "{"
end
end
open = ((prefix or "") .. _2_())
local close = nil
if ("seq" == table_type) then
close = "]"
else
close = "}"
end
local oneline = (open .. table.concat(elements, " ") .. close)
if (not options["one-line?"] and (multiline_3f or ((indent + #oneline) > options["line-length"]))) then
return (open .. table.concat(elements, indent_str) .. close)
else
return oneline
end
end
local function pp_associative(t, kv, options, indent, key_3f)
local multiline_3f = false
local id = options.seen[t]
if (options.level >= options.depth) then
return "{...}"
elseif (id and options["detect-cycles?"]) then
return ("@" .. id .. "{...}")
else
local visible_cycle_3f0 = visible_cycle_3f(t, options)
local id0 = (visible_cycle_3f0 and options.seen[t])
local indent0 = table_indent(t, indent, id0)
local slength = nil
local function _3_()
local _2_0 = rawget(_G, "utf8")
if _2_0 then
return _2_0.len
else
return _2_0
end
end
local function _4_(_241)
return #_241
end
slength = ((options["utf8?"] and _3_()) or _4_)
local prefix = nil
if visible_cycle_3f0 then
prefix = ("@" .. id0)
else
prefix = ""
end
local items = nil
do
local tbl_0_ = {}
for _, _6_0 in pairs(kv) do
local _7_ = _6_0
local k = _7_[1]
local v = _7_[2]
local _8_
do
local k0 = pp(k, options, (indent0 + 1), true)
local v0 = pp(v, options, (indent0 + slength(k0) + 1))
multiline_3f = (multiline_3f or k0:find("\n") or v0:find("\n"))
_8_ = (k0 .. " " .. v0)
end
tbl_0_[(#tbl_0_ + 1)] = _8_
end
items = tbl_0_
end
return concat_table_lines(items, options, multiline_3f, indent0, "table", prefix)
end
end
local function pp_sequence(t, kv, options, indent)
local multiline_3f = false
local id = options.seen[t]
if (options.level >= options.depth) then
return "[...]"
elseif (id and options["detect-cycles?"]) then
return ("@" .. id .. "[...]")
else
local visible_cycle_3f0 = visible_cycle_3f(t, options)
local id0 = (visible_cycle_3f0 and options.seen[t])
local indent0 = table_indent(t, indent, id0)
local prefix = nil
if visible_cycle_3f0 then
prefix = ("@" .. id0)
else
prefix = ""
end
local items = nil
do
local tbl_0_ = {}
for _, _3_0 in pairs(kv) do
local _4_ = _3_0
local _0 = _4_[1]
local v = _4_[2]
local _5_
do
local v0 = pp(v, options, indent0)
multiline_3f = (multiline_3f or v0:find("\n"))
_5_ = v0
end
tbl_0_[(#tbl_0_ + 1)] = _5_
end
items = tbl_0_
end
return concat_table_lines(items, options, multiline_3f, indent0, "seq", prefix)
end
end
local function concat_lines(lines, options, indent, force_multi_line_3f)
if (#lines == 0) then
if options["empty-as-sequence?"] then
return "[]"
else
return "{}"
end
else
local oneline = nil
local _2_
do
local tbl_0_ = {}
for _, line in ipairs(lines) do
tbl_0_[(#tbl_0_ + 1)] = line:gsub("^%s+", "")
end
_2_ = tbl_0_
end
oneline = table.concat(_2_, " ")
if (not options["one-line?"] and (force_multi_line_3f or oneline:find("\n") or ((indent + #oneline) > options["line-length"]))) then
return table.concat(lines, ("\n" .. string.rep(" ", indent)))
else
return oneline
end
end
end
local function pp_metamethod(t, metamethod, options, indent)
if (options.level >= options.depth) then
if options["empty-as-sequence?"] then
return "[...]"
else
return "{...}"
end
else
local _ = nil
local function _2_(_241)
return visible_cycle_3f(_241, options)
end
options["visible-cycle?"] = _2_
_ = nil
local lines, force_multi_line_3f = metamethod(t, pp, options, indent)
options["visible-cycle?"] = nil
local _3_0 = type(lines)
if (_3_0 == "string") then
return lines
elseif (_3_0 == "table") then
return concat_lines(lines, options, indent, force_multi_line_3f)
else
local _0 = _3_0
return error("__fennelview metamethod must return a table of lines")
end
end
end
local function pp_table(x, options, indent)
options.level = (options.level + 1)
local x0 = nil
do
local _2_0 = nil
if options["metamethod?"] then
local _3_0 = x
if _3_0 then
local _4_0 = getmetatable(_3_0)
if _4_0 then
_2_0 = _4_0.__fennelview
else
_2_0 = _4_0
end
else
_2_0 = _3_0
end
else
_2_0 = nil
end
if (nil ~= _2_0) then
local metamethod = _2_0
x0 = pp_metamethod(x, metamethod, options, indent)
else
local _ = _2_0
local _4_0, _5_0 = table_kv_pairs(x)
if (true and (_5_0 == "empty")) then
local _0 = _4_0
if options["empty-as-sequence?"] then
x0 = "[]"
else
x0 = "{}"
end
elseif ((nil ~= _4_0) and (_5_0 == "table")) then
local kv = _4_0
x0 = pp_associative(x, kv, options, indent)
elseif ((nil ~= _4_0) and (_5_0 == "seq")) then
local kv = _4_0
x0 = pp_sequence(x, kv, options, indent)
else
x0 = nil
end
end
end
options.level = (options.level - 1)
return x0
end
local function number__3estring(n)
local _2_0 = string.gsub(tostring(n), ",", ".")
return _2_0
end
local function colon_string_3f(s)
return s:find("^[-%w?^_!$%&*+./@|<=>]+$")
end
local function pp_string(str, options, indent)
local escs = nil
local _2_
if (options["escape-newlines?"] and (#str < (options["line-length"] - indent))) then
_2_ = "\\n"
else
_2_ = "\n"
end
local function _4_(_241, _242)
return ("\\%03d"):format(_242:byte())
end
escs = setmetatable({["\""] = "\\\"", ["\11"] = "\\v", ["\12"] = "\\f", ["\13"] = "\\r", ["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\\"] = "\\\\", ["\n"] = _2_}, {__index = _4_})
return ("\"" .. str:gsub("[%c\\\"]", escs) .. "\"")
end
local function make_options(t, options)
local defaults = {["detect-cycles?"] = true, ["empty-as-sequence?"] = false, ["escape-newlines?"] = false, ["line-length"] = 80, ["metamethod?"] = true, ["one-line?"] = false, ["prefer-colon?"] = false, ["utf8?"] = true, depth = 128}
local overrides = {appearances = count_table_appearances(t, {}), level = 0, seen = {len = 0}}
for k, v in pairs((options or {})) do
defaults[k] = v
end
for k, v in pairs(overrides) do
defaults[k] = v
end
return defaults
end
local function _2_(x, options, indent, colon_3f)
local indent0 = (indent or 0)
local options0 = (options or make_options(x))
local tv = type(x)
local function _4_()
local _3_0 = getmetatable(x)
if _3_0 then
return _3_0.__fennelview
else
return _3_0
end
end
if ((tv == "table") or ((tv == "userdata") and _4_())) then
return pp_table(x, options0, indent0)
elseif (tv == "number") then
return number__3estring(x)
else
local function _5_()
if (colon_3f ~= nil) then
return colon_3f
elseif ("function" == type(options0["prefer-colon?"])) then
return options0["prefer-colon?"](x)
else
return options0["prefer-colon?"]
end
end
if ((tv == "string") and colon_string_3f(x) and _5_()) then
return (":" .. x)
elseif (tv == "string") then
return pp_string(x, options0, indent0)
elseif ((tv == "boolean") or (tv == "nil")) then
return tostring(x)
else
return ("#<" .. tostring(x) .. ">")
end
end
end
pp = _2_
local function view(x, options)
return pp(x, make_options(x, options), 0)
end
return view

View file

@ -1,27 +1,29 @@
(require "love.event")
(local view (require "lib.fennelview"))
(local {: view} (require :lib.fennel))
;; This module exists in order to expose stdio over a channel so that it
;; can be used in a non-blocking way from another thread.
(local (event channel) ...)
(fn prompt [next-line?]
(io.write (if next-line? ".." ">> ")) (io.flush) (.. (io.read) "\n"))
(when channel
(let [prompt (fn [next-line?] (io.write (if next-line? ".." ">> ")) (io.flush) (.. (io.read) "\n"))]
((fn looper [input]
(when input
;; This is consumed by love.handlers[event]
(love.event.push event input)
(let [output (: channel :demand)
next-line (and (. output 2) (= "next-line" (. output 2)))]
;; There is probably a more efficient way of determining an error
(if next-line :ok
(and (. output 2) (= "Error:" (. output 2)))
(print (view output))
(each [_ ret (ipairs output)]
(print ret)))
(io.flush)
(looper (prompt next-line))))) (prompt))))
((fn looper [input]
(when input
;; This is consumed by love.handlers[event]
(love.event.push event input)
(let [output (: channel :demand)
next-line (and (. output 2) (= "next-line" (. output 2)))]
;; There is probably a more efficient way of determining an error
(if next-line :ok
(and (. output 2) (= "Error:" (. output 2)))
(print (view output))
(each [_ ret (ipairs output)]
(print ret)))
(io.flush)
(looper (prompt next-line))))) (prompt)))
{:start (fn start-repl []
(let [code (love.filesystem.read "lib/stdio.fnl")

View file

@ -1,76 +0,0 @@
require("love.event")
local view = require("lib.fennelview") local event, channel = ...
if channel then local prompt = nil local function _0_(next_line_3f) local function _1_() if next_line_3f then return ".." else return ">> " end end io.write(_1_()) io.flush() return (io.read() .. "\n") end prompt = _0_ local function looper(input) if input then love.event.push(event, input) local output = channel:demand() local next_line = (output[2] and ("next-line" == output[2])) if next_line then elseif (output[2] and ("Error:" == output[2])) then print(view(output)) else for _, ret in ipairs(output) do print(ret) end end io.flush() return looper(prompt(next_line)) end end looper(prompt()) end local function start_repl() local code = love.filesystem.read("lib/stdio.fnl") local luac = nil if code then luac = love.filesystem.newFileData(fennel.compileString(code), "io") else luac = love.filesystem.read("lib/stdio.lua") end local thread = love.thread.newThread(luac) local io_channel = love.thread.newChannel() local coro = coroutine.create(fennel.repl) local out = nil local function _2_(val) return io_channel:push(val) end out = _2_ local options = nil local function _3_(kind, ...) return out({kind, "Error:", ...}) end local function _4_(parser_state) if (parser_state["stack-size"] > 0) then io_channel:push({"next-line", "next-line"}) end return coroutine.yield() end options = {moduleName = "lib.fennel", onError = _3_, onValues = out, pp = view, readChunk = _4_} coroutine.resume(coro, options) thread:start("eval", io_channel) local function _5_(input) return coroutine.resume(coro, input) end love.handlers.eval = _5_ return nil end return {start = start_repl}

View file

@ -1,7 +1,7 @@
-- bootstrap the compiler
fennel = require("lib.fennel")
table.insert(package.loaders, fennel.make_searcher({correlate=true}))
pp = function(x) print(require("lib.fennelview")(x)) end
pp = function(x) print(fennel.view(x)) end
lume = require("lib.lume")
require("wrap")