aynish/melee-roguelite
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Merge branch '0.9.1' into 'master'

Browse source 
Update to 0.9.1

See merge request alexjgriffith/min-love2d-fennel!10
This commit is contained in:
Alexander Griffith 2021-04-14 13:42:11 +00:00
parent 6ca50f19fe d124a52904
commit 0b04501302
2 changed files with 41 additions and 119 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
lib/fennel
View file

@ -1038,32 +1038,8 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
return _0_, not multi, 3 return _0_, not multi, 3
else else
return nil, true, 2 return nil, true, 2
<<<<<<< HEAD
end end
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) 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 for i = (index + 1), #ast do
compiler.compile1(ast[i], f_scope, f_chunk, {nval = (((i ~= #ast) and 0) or nil), tail = (i == #ast)}) compiler.compile1(ast[i], f_scope, f_chunk, {nval = (((i ~= #ast) and 0) or nil), tail = (i == #ast)})
@ -1571,7 +1547,6 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
_0_ = 1 _0_ = 1
else else
_0_ = nil _0_ = nil
<<<<<<< HEAD
end end
subexprs = compiler.compile1(ast[i], scope, parent, {nval = _0_}) subexprs = compiler.compile1(ast[i], scope, parent, {nval = _0_})
utils.map(subexprs, tostring, operands) utils.map(subexprs, tostring, operands)
@ -1591,27 +1566,6 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
local function _0_(...) local function _0_(...)
return arithmetic_special((lua_name or name), zero_arity, unary_prefix, ...) return arithmetic_special((lua_name or name), zero_arity, unary_prefix, ...)
end 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_ SPECIALS[name] = _0_
return doc_special(name, {"a", "b", "..."}, "Arithmetic operator; works the same as Lua but accepts more arguments.") return doc_special(name, {"a", "b", "..."}, "Arithmetic operator; works the same as Lua but accepts more arguments.")
end end
@ -2422,18 +2376,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
if ((se.type == "expression") and (se[1] ~= "nil")) then if ((se.type == "expression") and (se[1] ~= "nil")) then
emit(chunk, string.format("do local _ = %s end", tostring(se)), ast) emit(chunk, string.format("do local _ = %s end", tostring(se)), ast)
elseif (se.type == "statement") then elseif (se.type == "statement") then
<<<<<<< HEAD
emit(chunk, disambiguate_parens(tostring(se), chunk), ast) 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
end end
return nil return nil
@ -3904,11 +3847,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
opts.filename = filename opts.filename = filename
return eval(source, opts, ...) return eval(source, opts, ...)
end 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.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 utils["fennel-module"] = mod
do do
local builtin_macros = [===[;; This module contains all the built-in Fennel macros. Unlike all the other local builtin_macros = [===[;; This module contains all the built-in Fennel macros. Unlike all the other

99
lib/fennel.lua
View file

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