diff --git a/base/boot.jl b/base/boot.jl index a9f33562ee481..cd37dd5f14070 100644 --- a/base/boot.jl +++ b/base/boot.jl @@ -526,7 +526,7 @@ function (g::GeneratedFunctionStub)(@nospecialize args...) return body end lam = Expr(:lambda, g.argnames, - Expr(Symbol("scope-block"), + Expr(:scope_block, Expr(:block, LineNumberNode(g.line, g.file), Expr(:meta, :push_loc, g.file, Symbol("@generated body")), @@ -535,7 +535,7 @@ function (g::GeneratedFunctionStub)(@nospecialize args...) if g.spnames === nothing return lam else - return Expr(Symbol("with-static-parameters"), lam, g.spnames...) + return Expr(:with_static_parameters, lam, g.spnames...) end end diff --git a/base/compiler/lowering/desugar.jl b/base/compiler/lowering/desugar.jl new file mode 100644 index 0000000000000..c126bd36f821c --- /dev/null +++ b/base/compiler/lowering/desugar.jl @@ -0,0 +1,515 @@ +# Lowering pass 1: Syntax desugaring +# +# In this pass, we simplify the AST by transforming much of the rich surface +# syntax into a smaller core syntax containing fewer expression heads. +# +# Some of this core syntax is also part of the surface syntax, but some is +# unique to the lowered code. For example, `Expr(:scope_block, ...)` all +# scoping in the core syntax is +# handled by the scope_block + +using Core: SSAValue + +# AST predicates +#--------------- + +isquoted(ex) = ex isa QuoteNode || (ex isa Expr && + ex.head in (:quote, :top, :core, :globalref, + :outerref, :break, :inert, :meta)) + +issymbollike(ex) = ex isa Symbol || ex isa SSAValue + +isassignment(ex) = ex isa Expr && ex.head == :(=) + +isdecl(ex) = ex isa Expr && ex.head == :(::) + +# True if `ex` is trivially free of side effects (and hence safe to repeat) +iseffectfree(ex) = !(ex isa Expr) || isquoted(ex) + +# True if `ex` is lhs of short-form function definition +# f(args...) +is_eventually_call(ex) = ex isa Expr && + (ex.head == :call || (ex.head in (:where, :(::)) && + is_eventually_call(ex.args[1]))) + +# Symbol `s` occurs in ex, excluding expression heads and quoted Exprs +function occursin_ex(s::Symbol, ex) + s === ex || (ex isa Expr && !isquoted(ex) && any(e->occursin_ex(s, e), ex.args)) +end + +# As above, but test each expression with predicate `pred`. Optionally, filter +# expressions with `filt`. +function occursin_ex(pred::Function, ex; filt=e->true) + filt(ex) && (pred(ex) || (ex isa Expr && !isquoted(ex) && + any(e->occursin_ex(pred, e, filt=filt), ex.args))) +end + +# Check for `f(args...; pars...)` syntax +has_parameters(ex::Expr) = length(ex.args) >= 2 && ex.args[2] isa Expr && + ex.args[2].head === :parameters + +# has_assignment(args) = any(isassignment, args) + +# AST matching +#------------- + +decl_var(ex) = isdecl(ex) ? ex.args[1] : ex + +# Given a complex assignment LHS, return the symbol that will ultimately be assigned to +function assigned_name(ex) + if ex isa Expr && ex.head in (:call, :curly, :where) || (ex.head == :(::) && + is_eventually_call(ex)) + assigned_name(ex.args[1]) + else + ex + end +end + +# Get list of variable names on lhs of expression +lhs_vars(ex) = lhs_vars!(Symbol[], ex) +function lhs_vars!(vars, ex) + if ex isa Symbol + push!(vars, ex) + elseif isdecl(ex) + push!(vars, decl_var(ex)) + elseif ex isa Expr && ex.head == :tuple + foreach(e->lhs_vars!(vars, e), ex.args) + end + vars +end + +# Error checking utilities +#------------------------- +struct LoweringError <: Exception + msg::String + ex +end +LoweringError(msg::AbstractString) = LoweringError(msg, nothing) + +function Base.show(io::IO, err::LoweringError) + print(io, err.msg) + if err.ex !== nothing + print(io, " in `", err.ex, "`") + end +end + +function check_no_assignments(ex) + for e in ex.args + !isassignment(e) || throw(LoweringError("misplaced assignment statement", ex)) + end +end +error_unexpected_semicolon(ex) = throw(LoweringError("unexpected semicolon", ex)) + + +# Utilities for constructing lowered ASTs +#---------------------------------------- + +topcall(head, args...) = Expr(:call, Expr(:top, head), args...) +corecall(head, args...) = Expr(:call, Expr(:core, head), args...) +blockify(ex) = ex isa Expr && ex.head !== :block ? ex : Expr(:block, ex) # TODO: null Expr? +mapargs(f, ex) = ex isa Expr ? Expr(ex.head, map(f, ex.args)...) : ex + +# FIXME: Counter Should be thread local or in expansion ctx +let ssa_index = Ref(0) + global make_ssavalue() = SSAValue(ssa_index[] += 1) +end + +""" + make_ssa_if(need_ssa, ex, stmts) + +Return a name for the value of `ex` that can be used multiple times. +An extra assignment is recorded into `stmts` if necessary. +""" +function make_ssa_if(need_ssa::Bool, ex, stmts) + if need_ssa + v = make_ssavalue() + push!(stmts, Expr(:(=), v, ex)) + v + else + ex + end +end +make_ssa_if(need_ssa::Function, ex, stmts) = make_ssa_if(need_ssa(ex), ex, stmts) + + +#------------------------------------------------------------------------------- + +function find_symbolic_labels!(labels, gotos, ex) + if ex isa Expr + if ex.head == :symboliclabel + push!(labels, ex.args[1]) + elseif ex.head == :symbolicgoto + push!(gotos, ex.args[1]) + elseif !isquoted(ex) + for arg in ex.args + find_symbolic_labels!(labels, gotos, arg) + end + end + end +end + +function has_unmatched_symbolic_goto(ex) + labels = Set{Symbol}() + gotos = Set{Symbol}() + find_symbolic_labels!(labels, gotos, ex) + !all(target in labels for target in gotos) +end + +function expand_try(ex) + if length(ex.args) < 3 || length(ex.args) > 4 + throw(LoweringError("invalid `try` form", ex)) + end + try_block = ex.args[1] + exc_var = ex.args[2] + catch_block = ex.args[3] + finally_block = length(ex.args) < 4 ? false : ex.args[4] + if has_unmatched_symbolic_goto(try_block) + throw(LoweringError("goto from a try/finally block is not permitted", ex)) + end + if exc_var !== false + catch_block = Expr(:block, + Expr(:(=), exc_var, Expr(:the_exception)), + catch_block) + end + trycatch = catch_block !== false ? + Expr(:trycatch, + Expr(:scope_block, try_block), + Expr(:scope_block, catch_block)) : + Expr(:scope_block, try_block) + lowered = finally_block !== false ? + Expr(:tryfinally, + trycatch, + Expr(:scope_block, finally_block)) : trycatch + expand_forms(lowered) +end + +function expand_let(ex) + bindings = !(ex.args[1] isa Expr) ? throw(LoweringError("Invalid let syntax", ex)) : + ex.args[1].head == :block ? ex.args[1].args : [ex.args[1]] + body = isempty(bindings) ? Expr(:scope_block, blockify(ex.args[2])) : ex.args[2] + for binding in reverse(bindings) + body = + if binding isa Symbol || isdecl(binding) + # Just symbol -> add local + Expr(:scope_block, + Expr(:block, + Expr(:local, binding), + body)) + elseif binding isa Expr && binding.head == :(=) && length(binding.args) == 2 + # Some kind of assignment + lhs = binding.args[1] + rhs = binding.args[2] + if is_eventually_call(lhs) + # f() = c + Expr(:scope_block, body) # FIXME Needs expand_function to be implemented + elseif lhs isa Symbol || isdecl(lhs) + # `x = c` or `x::T = c` + varname = decl_var(lhs) + if occursin_ex(varname, rhs) + tmp = make_ssavalue() + Expr(:scope_block, + Expr(:block, + Expr(:(=), tmp, rhs), + Expr(:scope_block, + Expr(:block, + Expr(:local_def, lhs), + Expr(:(=), varname, tmp), + body)))) + else + Expr(:scope_block, + Expr(:block, + Expr(:local_def, lhs), + Expr(:(=), varname, rhs), + body)) + end + elseif lhs isa Expr && lhs.head == :tuple + # (a, b, c, ...) = rhs + vars = lhs_vars(lhs) + if occursin_ex(e->e isa Symbol && e in vars, rhs) + tmp = make_ssavalue() + Expr(:scope_block, + Expr(:block, + Expr(:(=), tmp, rhs), + Expr(:scope_block, + Expr(:block, + [Expr(:local_def, v) for v in vars]..., + Expr(:(=), lhs, tmp), + body)))) + else + Expr(:scope_block, + Expr(:block, + [Expr(:local_def, v) for v in vars]..., + binding, + body)) + end + else + throw(LoweringError("invalid binding in let syntax", binding)) + end + else + throw(LoweringError("invalid binding in let syntax", binding)) + end + end + expand_forms(body) +end + +""" +Replace `end` for the closest ref expression; don't go inside nested refs +`preceding_splats` are a list of the splatted arguments that precede index `n`. +`end`s are replaced with a call to `lastindex(a)` if `n == nothing`, or +`lastindex(a,n)`. +""" +function replace_end(ex, a, n, preceding_splats) + if ex === :end + # the appropriate computation for an `end` symbol for indexing + # the array `a` in the `n`th index. + if isempty(preceding_splats) + n === nothing ? topcall(:lastindex, a) : + topcall(:lastindex, a, n) + else + dimno = topcall(:+, n - length(preceding_splats), + map(t->:(topcall(:length, t)), preceding_splats)...) + topcall(:lastindex, a, dimno) + end + elseif !(ex isa Expr) || isquoted(ex) + ex + elseif ex.head == :ref + # Only recurse into first argument of ref, not into index list. + Expr(:ref, replace_end(ex.args[1], a, n, preceding_splats), ex.args[2:end]...) + else + mapargs(x->replace_end(x, a, n, preceding_splats), ex) + end +end + +# Expand Expr(:ref, indexable, indices...) by replacing `end` within `indices` +# as necessary +function partially_expand_ref(ex) + a = ex.args[1] + stmts = [] + arr = make_ssa_if(!iseffectfree, a, stmts) + preceding_splats = [] + new_idxs = [] + N = length(ex.args) - 1 + # go through indices and replace any embedded `end` symbols + for i = 1:N + idx = ex.args[i+1] + n = N == 1 ? nothing : i + if idx isa Expr && idx.head == :... + idx = replace_end(idx.args[1], arr, n, preceding_splats) + tosplat = make_ssa_if(issymbollike, idx, stmts) + push!(preceding_splats, tosplat) + push!(new_idxs, Expr(:..., tosplat)) + else + push!(new_idxs, replace_end(idx, arr, n, preceding_splats)) + end + end + Expr(:block, + stmts..., + topcall(:getindex, arr, new_idxs...)) +end + +function expand_hvcat(ex) + # rows inside vcat -> hvcat + lengths = Int[] + vals = [] + istyped = ex.head == :typed_vcat + for i in (istyped ? 2 : 1):length(ex.args) + e = ex.args[i] + if e isa Expr && e.head == :row + push!(lengths, length(e.args)) + append!(vals, e.args) + else + push!(lengths, 1) + push!(vals, e) + end + end + if istyped + expand_forms(topcall(:typed_hvcat, ex.args[1], Expr(:tuple, lengths...), vals...)) + else + expand_forms(topcall(:hvcat, Expr(:tuple, lengths...), vals...)) + end +end + +# Flatten nested Expr(head, args) with depth first traversal of args. +function flatten_ex_args!(args, head, ex) + if ex isa Expr && ex.head == head + for a in ex.args + flatten_ex_args!(args, head, a) + end + else + push!(args, ex) + end + args +end + +function expand_and(ex) + args = flatten_ex_args!([], :&&, ex) + @assert length(args) > 1 + e = args[end] + for i = length(args)-1:-1:1 + e = Expr(:if, args[i], e, false) + end + e +end + +function expand_or(ex) + args = flatten_ex_args!([], :||, ex) + @assert length(args) > 1 + e = args[end] + for i = length(args)-1:-1:1 + e = Expr(:if, args[i], true, e) + end + e +end + +#------------------------------------------------------------------------------- +# Expansion entry point + +function expand_todo(ex) + Expr(ex.head, map(e->expand_forms(e), ex.args)...) +end + +function expand_forms(ex) + if !(ex isa Expr) + return ex + end + head = ex.head + args = ex.args + # TODO: Use a hash table here like expand-table? + if head == :function + expand_todo(ex) # expand-function-def + elseif head == :-> + expand_todo(ex) # expand-arrow + elseif head == :let + expand_let(ex) + elseif head == :macro + expand_todo(ex) # expand-macro-def + elseif head == :struct + expand_todo(ex) # expand-struct-def + elseif head == :try + expand_try(ex) + elseif head == :lambda + expand_todo(ex) # expand-table + elseif head == :block + if length(args) == 0 + nothing + elseif length(args) == 1 && !(args[1] isa LineNumberNode) + expand_forms(args[1]) + else + Expr(:block, map(expand_forms, args)...) + end + elseif head == :. + expand_todo(ex) # expand-fuse-broadcast + elseif head == :.= + expand_todo(ex) # expand-fuse-broadcast + elseif head == :<: + expand_forms(Expr(:call, :<:, args...)) + elseif head == :>: + expand_forms(Expr(:call, :>:, args...)) + elseif head == :where + expand_todo(ex) # expand-wheres + elseif head == :const + expand_todo(ex) + elseif head == :local + expand_todo(ex) # expand-local-or-global-decl + elseif head == :global + expand_todo(ex) # expand-local-or-global-decl + elseif head == :local_def + expand_todo(ex) # expand-local-or-global-decl + elseif head == :(=) + expand_todo(ex) # expand-table + elseif head == :abstract + expand_todo(ex) # expand-table + elseif head == :primitive + expand_todo(ex) # expand-table + elseif head == :comparison + expand_todo(ex) # expand-compare-chain + elseif head == :ref + !has_parameters(ex) || error_unexpected_semicolon(ex) + expand_forms(partially_expand_ref(ex)) + elseif head == :curly + expand_todo(ex) # expand-table + elseif head == :call + expand_todo(ex) # expand-table + elseif head == :do + callex = args[1] + anonfunc = args[2] + expand_forms(has_parameters(callex) ? + Expr(:call, callex.args[1], callex.args[2], anonfunc, callex.args[3:end]...) : + Expr(:call, callex.args[1], anonfunc, callex.args[2:end]...) + ) + elseif head == :tuple + # TODO: NamedTuple lower-named-tuple + #if has_parameters(ex) + #end + expand_forms(corecall(:tuple, args...)) + elseif head == :braces + throw(LoweringError("{ } vector syntax is discontinued", ex)) + elseif head == :bracescat + throw(LoweringError("{ } matrix syntax is discontinued", ex)) + elseif head == :string + expand_forms(topcall(:string, args...)) + elseif head == :(::) + expand_todo(ex) # expand-table + elseif head == :while + Expr(:break_block, :loop_exit, + Expr(:_while, expand_forms(args[1]), + Expr(:break_block, :loop_cont, + Expr(:scope_block, + blockify(map(expand_forms, args[2:end])...))))) + elseif head == :break + isempty(args) ? Expr(:break, :loop_exit) : ex + elseif head == :continue + isempty(args) ? Expr(:break, :loop_cont) : ex + elseif head == :for + expand_todo(ex) # expand-for + elseif head == :&& + expand_forms(expand_and(ex)) + elseif head == :|| + expand_forms(expand_or(ex)) + elseif head in (:(+=), :(-=), :(*=), :(.*=), :(/=), :(./=), :(//=), :(.//=), + :(\=), :(.\=), :(.+=), :(.-=), :(^=), :(.^=), :(÷=), :(.÷=), + :(%=), :(.%=), :(|=), :(.|=), :(&=), :(.&=), :($=), :(⊻=), + :(.⊻=), :(<<=), :(.<<=), :(>>=), :(.>>=), :(>>>=), :(.>>>=)) + expand_todo(ex) # lower-update-op + elseif head == :... + throw(LoweringError("`...` expression outside call", ex)) + elseif head == :$ + throw(LoweringError("`\$` expression outside quote", ex)) + elseif head == :vect + !has_parameters(ex) || error_unexpected_semicolon(ex) + check_no_assignments(ex) + expand_forms(topcall(:vect, args...)) + elseif head == :hcat + check_no_assignments(ex) + expand_forms(topcall(:hcat, args...)) + elseif head == :vcat + check_no_assignments(ex) + if any(e->e isa Expr && e.head == :row, args) + expand_hvcat(ex) + else + expand_forms(topcall(:vcat, args...)) + end + elseif head == :typed_hcat + check_no_assignments(ex) + expand_forms(topcall(:typed_hcat, args...)) + elseif head == :typed_vcat + check_no_assignments(ex) + if any(e->e isa Expr && e.head == :row, args) + expand_hvcat(ex) + else + expand_forms(topcall(:typed_vcat, args...)) + end + elseif head == Symbol("'") + expand_forms(topcall(:adjoint, args...)) + elseif head == :generator + expand_todo(ex) # expand-generator + elseif head == :flatten + expand_todo(ex) # expand-generator + elseif head == :comprehension + expand_todo(ex) # expand-table + elseif head == :typed_comprehension + expand_todo(ex) # lower-comprehension + else + Expr(head, map(e->expand_forms(e), args)...) + end +end diff --git a/base/show.jl b/base/show.jl index 037c66ae95f50..3d3088e3a10ec 100644 --- a/base/show.jl +++ b/base/show.jl @@ -1477,13 +1477,9 @@ function show_unquoted(io::IO, ex::Expr, indent::Int, prec::Int) unhandled = true end if unhandled - print(io, "\$(Expr(") - show(io, ex.head) - for arg in args - print(io, ", ") - show(io, arg) - end - print(io, "))") + # Always shown this macro call with parens for clarity + show_call(io, :call, Symbol("@Expr"), + [QuoteNode(ex.head), ex.args...], indent) end nothing end diff --git a/src/ast.c b/src/ast.c index fe7615f540a80..f1c35e1b1ce72 100644 --- a/src/ast.c +++ b/src/ast.c @@ -154,7 +154,7 @@ value_t fl_julia_scalar(fl_context_t *fl_ctx, value_t *args, uint32_t nargs) return fl_ctx->F; } -static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *mod); +static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *mod, int formonly); value_t fl_julia_logmsg(fl_context_t *fl_ctx, value_t *args, uint32_t nargs) { @@ -426,7 +426,7 @@ static jl_value_t *scm_to_julia(fl_context_t *fl_ctx, value_t e, jl_module_t *mo jl_value_t *v = NULL; JL_GC_PUSH1(&v); JL_TRY { - v = scm_to_julia_(fl_ctx, e, mod); + v = scm_to_julia_(fl_ctx, e, mod, 0); } JL_CATCH { // if expression cannot be converted, replace with error expr @@ -440,7 +440,7 @@ static jl_value_t *scm_to_julia(fl_context_t *fl_ctx, value_t e, jl_module_t *mo extern int64_t conv_to_int64(void *data, numerictype_t tag); -static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *mod) +static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *mod, int formonly) { if (fl_isnumber(fl_ctx, e)) { int64_t i64; @@ -514,48 +514,48 @@ static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *m // nodes with special representations jl_value_t *ex = NULL, *temp = NULL; if (sym == line_sym && (n == 1 || n == 2)) { - jl_value_t *linenum = scm_to_julia_(fl_ctx, car_(e), mod); + jl_value_t *linenum = scm_to_julia_(fl_ctx, car_(e), mod, formonly); jl_value_t *file = jl_nothing; JL_GC_PUSH2(&linenum, &file); if (n == 2) - file = scm_to_julia_(fl_ctx, car_(cdr_(e)), mod); + file = scm_to_julia_(fl_ctx, car_(cdr_(e)), mod, formonly); temp = jl_new_struct(jl_linenumbernode_type, linenum, file); JL_GC_POP(); return temp; } JL_GC_PUSH1(&ex); if (sym == goto_sym) { - ex = scm_to_julia_(fl_ctx, car_(e), mod); + ex = scm_to_julia_(fl_ctx, car_(e), mod, formonly); temp = jl_new_struct(jl_gotonode_type, ex); } else if (sym == newvar_sym) { - ex = scm_to_julia_(fl_ctx, car_(e), mod); + ex = scm_to_julia_(fl_ctx, car_(e), mod, formonly); temp = jl_new_struct(jl_newvarnode_type, ex); } - else if (sym == globalref_sym) { - ex = scm_to_julia_(fl_ctx, car_(e), mod); - temp = scm_to_julia_(fl_ctx, car_(cdr_(e)), mod); + else if (sym == globalref_sym && !formonly) { + ex = scm_to_julia_(fl_ctx, car_(e), mod, formonly); + temp = scm_to_julia_(fl_ctx, car_(cdr_(e)), mod, formonly); assert(jl_is_module(ex)); assert(jl_is_symbol(temp)); temp = jl_module_globalref((jl_module_t*)ex, (jl_sym_t*)temp); } - else if (sym == top_sym) { + else if (sym == top_sym && !formonly) { assert(mod && "top should not be generated by the parser"); - ex = scm_to_julia_(fl_ctx, car_(e), mod); + ex = scm_to_julia_(fl_ctx, car_(e), mod, formonly); assert(jl_is_symbol(ex)); temp = jl_module_globalref(jl_base_relative_to(mod), (jl_sym_t*)ex); } - else if (sym == core_sym) { - ex = scm_to_julia_(fl_ctx, car_(e), mod); + else if (sym == core_sym && !formonly) { + ex = scm_to_julia_(fl_ctx, car_(e), mod, formonly); assert(jl_is_symbol(ex)); temp = jl_module_globalref(jl_core_module, (jl_sym_t*)ex); } else if (sym == inert_sym || (sym == quote_sym && (!iscons(car_(e))))) { - ex = scm_to_julia_(fl_ctx, car_(e), mod); + ex = scm_to_julia_(fl_ctx, car_(e), mod, formonly); temp = jl_new_struct(jl_quotenode_type, ex); } - else if (sym == thunk_sym) { - ex = scm_to_julia_(fl_ctx, car_(e), mod); + else if (sym == thunk_sym && !formonly) { + ex = scm_to_julia_(fl_ctx, car_(e), mod, formonly); assert(jl_is_code_info(ex)); jl_linenumber_to_lineinfo((jl_code_info_t*)ex, (jl_value_t*)jl_symbol("top-level scope")); temp = (jl_value_t*)jl_exprn(sym, 1); @@ -569,11 +569,12 @@ static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *m size_t i; for (i = 0; i < n; i++) { assert(iscons(e)); - jl_array_ptr_set(((jl_expr_t*)ex)->args, i, scm_to_julia_(fl_ctx, car_(e), mod)); + jl_array_ptr_set(((jl_expr_t*)ex)->args, i, scm_to_julia_(fl_ctx, car_(e), mod, formonly)); e = cdr_(e); } - if (sym == lambda_sym) + if (sym == lambda_sym && !formonly) { ex = (jl_value_t*)jl_new_code_info_from_ast((jl_expr_t*)ex); + } JL_GC_POP(); if (sym == list_sym) return (jl_value_t*)((jl_expr_t*)ex)->args; @@ -595,7 +596,11 @@ static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *m if (iscvalue(e) && cv_class((cvalue_t*)ptr(e)) == jl_ast_ctx(fl_ctx)->jvtype) { return *(jl_value_t**)cv_data((cvalue_t*)ptr(e)); } - jl_error("malformed tree"); + if (e == fl_ctx->T || e == fl_ctx->F) { + return e == fl_ctx->T ? jl_true : jl_false; + } + value_t e_str = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "string")), e); + jl_errorf("malformed tree %.*s", cvalue_len(e_str), (char*)cvalue_data(e_str)); } static value_t julia_to_scm_(fl_context_t *fl_ctx, jl_value_t *v); @@ -919,6 +924,35 @@ jl_value_t *jl_call_scm_on_ast(const char *funcname, jl_value_t *expr, jl_module return result; } +// Debug tool: Call given flisp function on an Expr, converting result back to +// an Expr. Does not expand lambdas and thunks to code info objects. +JL_DLLEXPORT jl_value_t *jl_call_scm_on_ast_formonly(const char *funcname, jl_value_t *expr, + jl_module_t *inmodule) +{ + jl_ast_context_t *ctx = jl_ast_ctx_enter(); + fl_context_t *fl_ctx = &ctx->fl; + JL_AST_PRESERVE_PUSH(ctx, old_roots, inmodule); + value_t arg = julia_to_scm(fl_ctx, expr); + value_t e = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, funcname)), arg); + jl_value_t *result = NULL; + JL_GC_PUSH1(&result); + int err = 0; + JL_TRY { + result = scm_to_julia_(fl_ctx, e, inmodule, 1); + } + JL_CATCH { + err = 1; + goto finally; // skip pop_exception + } +finally: + JL_AST_PRESERVE_POP(ctx, old_roots); + jl_ast_ctx_leave(ctx); + JL_GC_POP(); + if (err) + jl_rethrow(); + return result; +} + jl_value_t *jl_call_scm_on_ast_and_loc(const char *funcname, jl_value_t *expr, jl_module_t *inmodule, const char *file, int line) { diff --git a/src/ast.scm b/src/ast.scm index b9d4ac24c19ca..31990ef98ade5 100644 --- a/src/ast.scm +++ b/src/ast.scm @@ -357,7 +357,7 @@ ;; identify some expressions that are safe to repeat (define (effect-free? e) - (or (not (pair? e)) (ssavalue? e) (sym-dot? e) (quoted? e) (equal? e '(null)))) + (or (not (pair? e)) (ssavalue? e) (quoted? e) (equal? e '(null)))) ;; get the variable name part of a declaration, x::int => x (define (decl-var v) diff --git a/src/jlfrontend.scm b/src/jlfrontend.scm index 5fb59411d465c..4c07bc6554470 100644 --- a/src/jlfrontend.scm +++ b/src/jlfrontend.scm @@ -92,7 +92,7 @@ (let* ((ex (julia-expand0 ex0)) (th (julia-expand1 `(lambda () () - (scope-block + (scope_block ,(blockify ex))) file line))) (if (and (null? (cdadr (caddr th))) @@ -142,6 +142,20 @@ (error-wrap (lambda () (julia-expand-macroscope expr)))) +;; "Clean up" lambda expressions generated by the first lowering pass so that +;; they can be translated by the julia code. +(define (cleanup-lambdas e) + (if (not (pair? e)) + e + (let ((e2 (map cleanup-lambdas e))) + (if (eq? (car e) 'lambda) + `(lambda (vect ,@(cadr e2)) (vect ,@(caddr e2)) ,(cadddr e)) + e2)))) + +;; Lowering testing: call first pass only +(define (jl-expand-forms e) + (error-wrap (lambda () (cleanup-lambdas (expand-forms e))))) + ;; construct default definitions of `eval` for non-bare modules ;; called by jl_eval_module_expr (define (module-default-defs e) diff --git a/src/julia-syntax.scm b/src/julia-syntax.scm index c7270734123be..62a89a8b442ac 100644 --- a/src/julia-syntax.scm +++ b/src/julia-syntax.scm @@ -10,7 +10,7 @@ a)) (define (fix-arglist l (unused #t)) (if (any vararg? (butlast l)) - (error "invalid ... on non-final argument")) + (error "invalid `...` on non-final argument")) (map (lambda (a) (cond ((and (pair? a) (eq? (car a) 'kw)) `(kw ,(fill-missing-argname (cadr a) unused) ,(caddr a))) @@ -154,7 +154,7 @@ argl)) (body (blockify body))) `(lambda ,argl () - (scope-block + (scope_block ,(if (equal? rett '(core Any)) body (let ((meta (take-while (lambda (x) (and (pair? x) @@ -163,7 +163,7 @@ (R (make-ssavalue))) `(,(car body) ,@meta (= ,R ,rett) - (meta ret-type ,R) + (meta ret_type ,R) ,@(list-tail body (+ 1 (length meta)))))))))) ;; convert x<:T<:y etc. exprs into (name lower-bound upper-bound) @@ -172,19 +172,19 @@ (define (check-sym s) (if (symbol? s) s - (error (string "invalid type parameter name \"" (deparse s) "\"")))) + (error (string "invalid type parameter name `" (deparse s) "`")))) (cond ((atom? e) (list (check-sym e) #f #f)) - ((eq? (car e) 'var-bounds) (cdr e)) + ((eq? (car e) 'var_bounds) (cdr e)) ((and (eq? (car e) 'comparison) (length= e 6)) (cons (check-sym (cadddr e)) (cond ((and (eq? (caddr e) '|<:|) (eq? (caddr (cddr e)) '|<:|)) (list (cadr e) (last e))) - (else (error "invalid bounds in \"where\""))))) + (else (error "invalid bounds in `where`"))))) ((eq? (car e) '|<:|) (list (check-sym (cadr e)) #f (caddr e))) ((eq? (car e) '|>:|) (list (check-sym (cadr e)) (caddr e) #f)) - (else (error "invalid variable expression in \"where\"")))) + (else (error "invalid variable expression in `where`")))) (define (sparam-name-bounds params) (let ((bounds (map analyze-typevar params))) @@ -250,7 +250,7 @@ (define (replace-vars e renames) (cond ((symbol? e) (lookup e renames e)) ((or (not (pair? e)) (quoted? e)) e) - ((memq (car e) '(-> function scope-block)) e) + ((memq (car e) '(-> function scope_block)) e) (else (cons (car e) (map (lambda (x) (replace-vars x renames)) @@ -316,7 +316,7 @@ (if (any (lambda (x) (and (not (eq? x UNUSED)) (memq x names))) anames) (error "function argument and static parameter names must be distinct")) (if (or (and name (not (sym-ref? name))) (not (valid-name? name))) - (error (string "invalid function name \"" (deparse name) "\""))) + (error (string "invalid function name `" (deparse name) "`"))) (let* ((generator (if (expr-contains-p if-generated? body (lambda (x) (not (function-def? x)))) (let* ((gen (generated-version body)) (nongen (non-generated-version body)) @@ -603,8 +603,8 @@ (if (pair? invalid) (if (and (pair? (car invalid)) (eq? 'parameters (caar invalid))) (error "more than one semicolon in argument list") - (error (string "invalid keyword argument syntax \"" - (deparse (car invalid)) "\"")))))) + (error (string "invalid keyword argument syntax `" + (deparse (car invalid)) "`")))))) ; replace unassigned kw args with assignment to throw() call (forcing the caller to assign the keyword) (define (throw-unassigned-kw-args argl) @@ -662,7 +662,7 @@ `(curly ,name ,@params) name) ,@field-names) - (map (lambda (b) (cons 'var-bounds b)) bounds)) + (map (lambda (b) (cons 'var_bounds b)) bounds)) (block ,@locs (call new ,@field-names))))) @@ -688,16 +688,16 @@ (let ((field-names (safe-field-names field-names field-types))) `(function ,(with-wheres `(call ,name ,@(map make-decl field-names field-types)) - (map (lambda (b) (cons 'var-bounds b)) bounds)) + (map (lambda (b) (cons 'var_bounds b)) bounds)) (block ,@locs (call (curly ,name ,@params) ,@field-names))))) (define (new-call Tname type-params params args field-names field-types) (if (any kwarg? args) - (error "\"new\" does not accept keyword arguments")) + (error "`new` does not accept keyword arguments")) (if (length> params (length type-params)) - (error "too few type parameters specified in \"new{...}\"")) + (error "too few type parameters specified in `new{...}`")) (let ((Texpr (if (null? type-params) `(outerref ,Tname) `(curly (outerref ,Tname) @@ -834,14 +834,14 @@ defs)) (min-initialized (min (ctors-min-initialized defs) (length fields)))) (let ((dups (has-dups field-names))) - (if dups (error (string "duplicate field name: \"" (car dups) "\" is not unique")))) + (if dups (error (string "duplicate field name: `" (car dups) "` is not unique")))) (for-each (lambda (v) (if (not (symbol? v)) - (error (string "field name \"" (deparse v) "\" is not a symbol")))) + (error (string "field name `" (deparse v) "` is not a symbol")))) field-names) `(block (global ,name) (const ,name) - (scope-block + (scope_block (block ,@(map (lambda (v) `(local ,v)) params) ,@(map (lambda (n v) (make-assignment n (bounds-to-TypeVar v #t))) params bounds) @@ -849,7 +849,7 @@ (call (core svec) ,@(map quotify field-names)) ,super (call (core svec) ,@field-types) ,mut ,min-initialized))) ;; "inner" constructors - (scope-block + (scope_block (block (global ,name) ,@(map (lambda (c) @@ -869,7 +869,7 @@ (and (expr-contains-eq (car p) (cons 'list root-types)) (loop (append (cdr p) root-types) (cdr sp))))))) - `((scope-block + `((scope_block (block (global ,name) ,(default-outer-ctor name field-names field-types @@ -882,7 +882,7 @@ (params bounds) (sparam-name-bounds params) `(block (global ,name) (const ,name) - (scope-block + (scope_block (block ,@(map (lambda (v) `(local ,v)) params) ,@(map (lambda (n v) (make-assignment n (bounds-to-TypeVar v #t))) params bounds) @@ -893,7 +893,7 @@ (params bounds) (sparam-name-bounds params) `(block (global ,name) (const ,name) - (scope-block + (scope_block (block ,@(map (lambda (v) `(local ,v)) params) ,@(map (lambda (n v) (make-assignment n (bounds-to-TypeVar v #t))) params bounds) @@ -964,7 +964,7 @@ (define (check-lhs a) (if (expr-contains-p (lambda (e) (or (decl? e) (assignment? e) (kwarg? e))) a) - (error (string "invalid argument destructuring syntax \"" (deparse a) "\"")) + (error (string "invalid argument destructuring syntax `" (deparse a) "`")) a)) (define (transform-arg a) (cond ((and (pair? a) (eq? (car a) 'tuple)) @@ -995,7 +995,7 @@ (let ((w (flatten-where-expr name))) (begin0 (cddr w) (if (not (and (pair? (cadr w)) (memq (caadr w) '(call |::|)))) - (error (string "invalid assignment location \"" (deparse name) "\""))) + (error (string "invalid assignment location `" (deparse name) "`"))) (set! name (cadr w)))) #f)) (dcl (and (pair? name) (eq? (car name) '|::|))) @@ -1003,7 +1003,7 @@ (name (if dcl (cadr name) name))) (cond ((and (length= e 2) (or (symbol? name) (globalref? name))) (if (not (valid-name? name)) - (error (string "invalid function name \"" name "\""))) + (error (string "invalid function name `" name "`"))) `(method ,name)) ((not (pair? name)) e) ((eq? (car name) 'call) @@ -1038,7 +1038,7 @@ (expand-forms (method-def-expr name sparams argl body rett)))) (else - (error (string "invalid assignment location \"" (deparse name) "\"")))))) + (error (string "invalid assignment location `" (deparse name) "`")))))) ;; handle ( )->( ) function expressions. blocks `(a;b=1)` on the left need to be ;; converted to argument lists with kwargs. @@ -1076,7 +1076,7 @@ (expand-forms (if (null? binds) - `(scope-block (block ,ex)) + `(scope_block (block ,ex)) (let loop ((binds (reverse binds)) (blk ex)) (if (null? binds) @@ -1085,7 +1085,7 @@ ((or (symbol? (car binds)) (decl? (car binds))) ;; just symbol -> add local (loop (cdr binds) - `(scope-block + `(scope_block (block (local ,(car binds)) ,blk)))) @@ -1100,11 +1100,11 @@ (if (not (symbol? name)) (error "invalid let syntax")) (loop (cdr binds) - `(scope-block + `(scope_block (block ,(if (expr-contains-eq name (caddar binds)) `(local ,name) ;; might need a Box for recursive functions - `(local-def ,name)) + `(local_def ,name)) ,asgn ,blk))))) ((or (symbol? (cadar binds)) @@ -1113,16 +1113,16 @@ (loop (cdr binds) (if (expr-contains-eq vname (caddar binds)) (let ((tmp (make-ssavalue))) - `(scope-block + `(scope_block (block (= ,tmp ,(caddar binds)) - (scope-block + (scope_block (block - (local-def ,(cadar binds)) + (local_def ,(cadar binds)) (= ,vname ,tmp) ,blk))))) - `(scope-block + `(scope_block (block - (local-def ,(cadar binds)) + (local_def ,(cadar binds)) (= ,vname ,(caddar binds)) ,blk)))))) ;; (a, b, c, ...) = rhs @@ -1135,14 +1135,14 @@ (let ((temp (make-ssavalue))) `(block (= ,temp ,(caddr (car binds))) - (scope-block + (scope_block (block - ,@(map (lambda (v) `(local-def ,v)) vars) + ,@(map (lambda (v) `(local_def ,v)) vars) (= ,(cadr (car binds)) ,temp) ,blk)))) - `(scope-block + `(scope_block (block - ,@(map (lambda (v) `(local-def ,v)) vars) + ,@(map (lambda (v) `(local_def ,v)) vars) ,(car binds) ,blk)))))) (else (error "invalid let syntax")))) @@ -1181,7 +1181,7 @@ (cond ((or (symbol? x) (decl? x) (linenum? x)) (loop (cdr f))) ((and (assignment? x) (or (symbol? (cadr x)) (decl? (cadr x)))) - (error (string "\"" (deparse x) "\" inside type definition is reserved"))) + (error (string "`" (deparse x) "` inside type definition is reserved"))) (else '()))))) (expand-forms (receive (name params super) (analyze-type-sig sig) @@ -1223,19 +1223,19 @@ `(tryfinally ,(if (not (eq? catchb 'false)) `(try ,tryb ,var ,catchb) - `(scope-block ,tryb)) - (scope-block ,finalb))))) + `(scope_block ,tryb)) + (scope_block ,finalb))))) ((length= e 4) (expand-forms (if (and (symbol-like? var) (not (eq? var 'false))) - `(trycatch (scope-block ,tryb) - (scope-block + `(trycatch (scope_block ,tryb) + (scope_block (block (= ,var (the_exception)) ,catchb))) - `(trycatch (scope-block ,tryb) - (scope-block ,catchb))))) + `(trycatch (scope_block ,tryb) + (scope_block ,catchb))))) (else - (error "invalid \"try\" form"))))) + (error "invalid `try` form"))))) (define (expand-unionall-def name type-ex) (if (and (pair? name) @@ -1243,9 +1243,9 @@ (let ((name (cadr name)) (params (cddr name))) (if (null? params) - (error (string "empty type parameter list in \"" (deparse `(= (curly ,name) ,type-ex)) "\""))) + (error (string "empty type parameter list in `" (deparse `(= (curly ,name) ,type-ex)) "`"))) `(block - (const-if-global ,name) + (const_if_global ,name) ,(expand-forms `(= ,name (where ,type-ex ,@params))))) (expand-forms @@ -1257,9 +1257,9 @@ (if (atom? arg) e (case (car arg) - ((global local local-def) + ((global local local_def) (for-each (lambda (b) (if (not (assignment? b)) - (error "expected assignment after \"const\""))) + (error "expected assignment after `const`"))) (cdr arg)) (expand-forms (expand-decls (car arg) (cdr arg) #t))) ((= |::|) @@ -1279,10 +1279,10 @@ (assigned-name (cadr e))) (else e))) -;; local x, y=2, z => local x;local y;local z;y = 2 +;; local x, (y=2), z => local x;local y;local z;y = 2 (define (expand-decls what binds const?) (if (not (list? binds)) - (error (string "invalid \"" what "\" declaration"))) + (error (string "invalid `" what "` declaration"))) (let loop ((b binds) (vars '()) (assigns '())) @@ -1306,7 +1306,7 @@ ((symbol? x) (loop (cdr b) (cons x vars) assigns)) (else - (error (string "invalid syntax in \"" what "\" declaration")))))))) + (error (string "invalid syntax in `" what "` declaration")))))))) ;; convert (lhss...) = (tuple ...) to assignments, eliminating the tuple (define (tuple-to-assignments lhss0 x) @@ -1385,7 +1385,7 @@ (car e) (map (lambda (x) (cond ((effect-free? x) x) - ((or (eq? (car x) '...) (eq? (car x) '&)) + ((eq? (car x) '...) (if (effect-free? (cadr x)) x (let ((g (make-ssavalue))) @@ -1432,8 +1432,8 @@ `(block ,@(if (eq? f fexpr) '() `((= ,f, fexpr))) (= ,kw-container ,(lower-named-tuple kw - (lambda (name) (string "keyword argument \"" name - "\" repeated in call to \"" (deparse fexpr) "\"")) + (lambda (name) (string "keyword argument `" name + "` repeated in call to `" (deparse fexpr) "`")) "keyword argument" "keyword argument syntax")) ,(if (every vararg? kw) @@ -1457,7 +1457,7 @@ ;; if remove-argument-side-effects needed to replace an expression with ;; an ssavalue, then it can't be updated by assignment. issue #30062 (begin (if (and (ssavalue? (car a)) (not (ssavalue? (car b)))) - (error (string "invalid multiple assignment location \"" (deparse (car b)) "\""))) + (error (string "invalid multiple assignment location `" (deparse (car b)) "`"))) (loop (cdr a) (cdr b)))))) `(block ,@(cdr e) ,(if (null? declT) @@ -1467,11 +1467,9 @@ (define (partially-expand-ref e) (let ((a (cadr e)) (idxs (cddr e))) - (let* ((reuse (and (pair? a) - (contains (lambda (x) (eq? x 'end)) - idxs))) - (arr (if reuse (make-ssavalue) a)) - (stmts (if reuse `((= ,arr ,a)) '()))) + (let* ((rename (not (effect-free? a))) + (arr (if rename (make-ssavalue) a)) + (stmts (if rename `((= ,arr ,a)) '()))) (receive (new-idxs stuff) (process-indices arr idxs) `(block @@ -1496,7 +1494,7 @@ (else (if (and (pair? lhs) (eq? op= '=) (not (memq (car lhs) '(|.| tuple vcat typed_hcat typed_vcat)))) - (error (string "invalid assignment location \"" (deparse lhs) "\""))) + (error (string "invalid assignment location `" (deparse lhs) "`"))) (expand-update-operator- op op= lhs rhs declT)))) (define (lower-update-op e) @@ -1526,13 +1524,9 @@ 'false (if (null? (cdr tail)) (car tail) - (if (symbol-like? (car tail)) - `(if ,(car tail) ,(car tail) - ,(loop (cdr tail))) - (let ((g (make-ssavalue))) - `(block (= ,g ,(car tail)) - (if ,g ,g - ,(loop (cdr tail))))))))))) + `(if ,(car tail) + true + ,(loop (cdr tail)))))))) (define (expand-for lhss itrs body) (define (outer? x) (and (pair? x) (eq? (car x) 'outer))) @@ -1543,8 +1537,8 @@ (apply append (map lhs-vars (filter (lambda (x) (not (outer? x))) (butlast lhss)))))))) - `(break-block - loop-exit + `(break_block + loop_exit ,(let nest ((lhss lhss) (itrs itrs)) (if (null? lhss) @@ -1563,16 +1557,16 @@ ,(nest (cdr lhss) (cdr itrs)))) (body (if (null? (cdr lhss)) - `(break-block - loop-cont + `(break_block + loop_cont (let (block ,@(map (lambda (v) `(= ,v ,v)) copied-vars)) ,body)) - `(scope-block ,body)))) + `(scope_block ,body)))) `(block (= ,coll ,(car itrs)) (= ,next (call (top iterate) ,coll)) ;; TODO avoid `local declared twice` error from this ;;,@(if outer `((local ,lhs)) '()) - ,@(if outer `((require-existing-local ,lhs)) '()) + ,@(if outer `((require_existing_local ,lhs)) '()) (if (call (top not_int) (call (core ===) ,next (null))) (_do_while (block ,body @@ -1672,7 +1666,7 @@ (list f (cadr x) (expand-forms `(call (call (core apply_type) (top Val) ,(caddr x)))))) (make-fuse f (cdr x)))) (else - (error (string "invalid syntax \"" (deparse e) "\""))))) + (error (string "invalid syntax `" (deparse e) "`"))))) (if (and (pair? e) (eq? (car e) 'call) (dotop-named? (cadr e))) (let ((f (undotop (cadr e))) (x (cddr e))) (if (and (eq? (identifier-name f) '^) (length= x 2) (integer? (cadr x))) @@ -1726,7 +1720,7 @@ (call (core tuple) ,@values))) (define (lower-named-tuple lst - (dup-error-fn (lambda (name) (string "field name \"" name "\" repeated in named tuple"))) + (dup-error-fn (lambda (name) (string "field name `" name "` repeated in named tuple"))) (name-str "named tuple field") (syntax-str "named tuple element")) (let* ((names (apply append @@ -1760,7 +1754,7 @@ (let ((el (car L))) (cond ((or (assignment? el) (kwarg? el)) (if (not (symbol? (cadr el))) - (error (string "invalid " name-str " name \"" (deparse (cadr el)) "\""))) + (error (string "invalid " name-str " name `" (deparse (cadr el)) "`"))) (loop (cdr L) (cons (cadr el) current-names) (cons (caddr el) current-vals) @@ -1792,7 +1786,7 @@ (merge current (cadr el)) `(call (top merge) (call (top NamedTuple)) ,(cadr el)))))) (else - (error (string "invalid " syntax-str " \"" (deparse el) "\"")))))))) + (error (string "invalid " syntax-str " `" (deparse el) "`")))))))) (define (expand-forms e) (if (or (atom? e) (memq (car e) '(quote inert top core globalref outerref line module toplevel ssavalue null meta using import export))) @@ -1848,7 +1842,7 @@ 'const expand-const-decl 'local expand-local-or-global-decl 'global expand-local-or-global-decl - 'local-def expand-local-or-global-decl + 'local_def expand-local-or-global-decl '= (lambda (e) @@ -1885,7 +1879,7 @@ ((and (symbol-like? lhs) (valid-name? lhs)) `(= ,lhs ,(expand-forms (caddr e)))) ((atom? lhs) - (error (string "invalid assignment location \"" (deparse lhs) "\""))) + (error (string "invalid assignment location `" (deparse lhs) "`"))) (else (case (car lhs) ((globalref) @@ -1902,15 +1896,15 @@ (b (caddr lhs)) (rhs (caddr e))) (if (and (length= b 2) (eq? (car b) 'tuple)) - (error (string "invalid syntax \"" - (string (deparse a) ".(" (deparse (cadr b)) ") = ...") "\""))) + (error (string "invalid syntax `" + (string (deparse a) ".(" (deparse (cadr b)) ") = ...") "`"))) (let ((aa (if (symbol-like? a) a (make-ssavalue))) (bb (if (or (atom? b) (symbol-like? b) (and (pair? b) (quoted? b))) b (make-ssavalue))) (rr (if (or (symbol-like? rhs) (atom? rhs)) rhs (make-ssavalue)))) `(block ,.(if (eq? aa a) '() `((= ,aa ,(expand-forms a)))) - ,.(if (eq? bb b) '() `((= ,bb ,(expand-forms b)))) + ,.(if (eq? bb b) '() `((= ,bb ,(expand-forms b)))) ;; Obsolete ? ,.(if (eq? rr rhs) '() `((= ,rr ,(expand-forms rhs)))) (call (top setproperty!) ,aa ,bb ,rr) (unnecessary ,rr))))) @@ -1952,7 +1946,7 @@ ((typed_hcat) (error "invalid spacing in left side of indexed assignment")) ((typed_vcat) - (error "unexpected \";\" in left side of indexed assignment")) + (error "unexpected `;` in left side of indexed assignment")) ((ref) ;; (= (ref a . idxs) rhs) (let ((a (cadr lhs)) @@ -1987,9 +1981,9 @@ (= ,(car e) ,rhs)))))) ((vcat) ;; (= (vcat . args) rhs) - (error "use \"(a, b) = ...\" to assign multiple values")) + (error "use `(a, b) = ...` to assign multiple values")) (else - (error (string "invalid assignment location \"" (deparse lhs) "\""))))))) + (error (string "invalid assignment location `" (deparse lhs) "`"))))))) 'abstract (lambda (e) @@ -2019,9 +2013,9 @@ 'curly (lambda (e) (if (has-parameters? (cddr e)) - (error (string "unexpected semicolon in \"" (deparse e) "\""))) + (error (string "unexpected semicolon in `" (deparse e) "`"))) (if (any assignment? (cddr e)) - (error (string "misplaced assignment statement in \"" (deparse e) "\"" ))) + (error (string "misplaced assignment statement in `" (deparse e) "`" ))) (let* ((p (extract-implicit-whereparams e)) (curlyparams (car p)) (whereparams (cdr p))) @@ -2049,8 +2043,8 @@ (eq? (car argtypes) 'tuple))) (if (and (pair? RT) (eq? (car RT) 'tuple)) - (error "ccall argument types must be a tuple; try \"(T,)\" and check if you specified a correct return type") - (error "ccall argument types must be a tuple; try \"(T,)\""))) + (error "ccall argument types must be a tuple; try `(T,)` and check if you specified a correct return type") + (error "ccall argument types must be a tuple; try `(T,)`"))) (expand-forms (lower-ccall name RT (cdr argtypes) args (if have-cconv cconv 'ccall)))))) @@ -2121,7 +2115,7 @@ '|::| (lambda (e) (if (not (length= e 3)) - (error "invalid \"::\" syntax")) + (error "invalid `::` syntax")) (if (not (symbol-like? (cadr e))) `(call (core typeassert) ,(expand-forms (cadr e)) ,(expand-forms (caddr e))) @@ -2129,18 +2123,18 @@ 'while (lambda (e) - `(break-block loop-exit + `(break_block loop_exit (_while ,(expand-forms (cadr e)) - (break-block loop-cont - (scope-block ,(blockify (expand-forms (caddr e)))))))) + (break_block loop_cont + (scope_block ,(blockify (expand-forms (caddr e)))))))) 'break (lambda (e) (if (pair? (cdr e)) e - '(break loop-exit))) + '(break loop_exit))) - 'continue (lambda (e) '(break loop-cont)) + 'continue (lambda (e) '(break loop_cont)) 'for (lambda (e) @@ -2185,32 +2179,32 @@ '.>>>= lower-update-op '|...| - (lambda (e) (error "\"...\" expression outside call")) + (lambda (e) (error "`...` expression outside call")) '$ - (lambda (e) (error "\"$\" expression outside quote")) + (lambda (e) (error "`$` expression outside quote")) 'vect (lambda (e) (if (has-parameters? (cdr e)) (error "unexpected semicolon in array expression")) (if (any assignment? (cdr e)) - (error (string "misplaced assignment statement in \"" (deparse e) "\""))) + (error (string "misplaced assignment statement in `" (deparse e) "`"))) (expand-forms `(call (top vect) ,@(cdr e)))) 'hcat (lambda (e) (if (any assignment? (cdr e)) - (error (string "misplaced assignment statement in \"" (deparse e) "\""))) + (error (string "misplaced assignment statement in `" (deparse e) "`"))) (expand-forms `(call (top hcat) ,@(cdr e)))) 'vcat (lambda (e) (let ((a (cdr e))) (if (any assignment? a) - (error (string "misplaced assignment statement in \"" (deparse e) "\""))) + (error (string "misplaced assignment statement in `" (deparse e) "`"))) (if (has-parameters? a) - (error "unexpected semicolon in array expression") + (error "unexpected semicolon in array expression") ;; Obsolete? (expand-forms (if (any (lambda (x) (and (pair? x) (eq? (car x) 'row))) @@ -2229,7 +2223,7 @@ 'typed_hcat (lambda (e) (if (any assignment? (cddr e)) - (error (string "misplaced assignment statement in \"" (deparse e) "\""))) + (error (string "misplaced assignment statement in `" (deparse e) "`"))) (expand-forms `(call (top typed_hcat) ,@(cdr e)))) 'typed_vcat @@ -2237,7 +2231,7 @@ (let ((t (cadr e)) (a (cddr e))) (if (any assignment? (cddr e)) - (error (string "misplaced assignment statement in \"" (deparse e) "\""))) + (error (string "misplaced assignment statement in `" (deparse e) "`"))) (expand-forms (if (any (lambda (x) (and (pair? x) (eq? (car x) 'row))) @@ -2292,7 +2286,7 @@ (define (check-no-return e) (if (has-return? e) - (error "\"return\" not allowed inside comprehension or generator"))) + (error "`return` not allowed inside comprehension or generator"))) (define (has-break-or-continue? e) (expr-contains-p (lambda (x) (and (pair? x) (memq (car x) '(break continue)))) @@ -2326,7 +2320,7 @@ ,(construct-loops (cdr itrs) (cdr iv))))) (let ((overall-itr (if (length= itrs 1) (car iv) prod))) - `(scope-block + `(scope_block (block (local ,result) (local ,idx) ,.(map (lambda (v r) `(= ,v ,(caddr r))) iv itrs) @@ -2369,7 +2363,7 @@ (if (or (not (pair? e)) (quoted? e)) '() (case (car e) - ((lambda scope-block module toplevel) '()) + ((lambda scope_block module toplevel) '()) ((method) (let ((v (decl-var (method-expr-name e)))) (append! @@ -2389,7 +2383,7 @@ (define (find-decls kind e) (if (or (not (pair? e)) (quoted? e)) '() - (cond ((memq (car e) '(lambda scope-block module toplevel)) + (cond ((memq (car e) '(lambda scope_block module toplevel)) '()) ((eq? (car e) kind) (if (underscore-symbol? (cadr e)) @@ -2400,12 +2394,12 @@ e)))))) (define (find-local-decls e) (find-decls 'local e)) -(define (find-local-def-decls e) (find-decls 'local-def e)) +(define (find-local-def-decls e) (find-decls 'local_def e)) (define (find-global-decls e) (find-decls 'global e)) (define (check-valid-name e) (or (valid-name? e) - (error (string "invalid identifier name \"" e "\"")))) + (error (string "invalid identifier name `" e "`")))) (define (make-scope (lam #f) (args '()) (locals '()) (globals '()) (sp '()) (renames '()) (prev #f)) (vector lam args locals globals sp renames prev)) @@ -2458,13 +2452,13 @@ ((eq? (car e) 'global) (check-valid-name (cadr e)) e) - ((memq (car e) '(local local-def)) + ((memq (car e) '(local local_def)) (check-valid-name (cadr e)) ;; remove local decls '(null)) - ((eq? (car e) 'require-existing-local) + ((eq? (car e) 'require_existing_local) (if (not (in-scope? (cadr e) scope)) - (error "no outer local variable declaration exists for \"for outer\"")) + (error "no outer local variable declaration exists for `for outer`")) '(null)) ((eq? (car e) 'locals) (let* ((names (filter (lambda (v) @@ -2486,8 +2480,8 @@ (let* ((args (lam:vars e)) (body (resolve-scopes- (lam:body e) (make-scope e args '() '() sp '() scope)))) `(lambda ,(cadr e) ,(caddr e) ,body))) - ((eq? (car e) 'scope-block) - (let* ((blok (cadr e)) ;; body of scope-block expression + ((eq? (car e) 'scope_block) + (let* ((blok (cadr e)) ;; body of scope_block expression (lam (scope:lam scope)) (argnames (lam:vars lam)) (current-locals (caddr lam)) ;; locals created so far in our lambda @@ -2517,22 +2511,22 @@ (newnames-def (append (diff locals-def need-rename-def) renamed-def))) (for-each (lambda (v) (if (or (memq v locals-def) (memq v local-decls)) - (error (string "variable \"" v "\" declared both local and global")))) + (error (string "variable `" v "` declared both local and global")))) globals) (if (and (pair? argnames) (eq? e (lam:body lam))) (for-each (lambda (v) (if (memq v argnames) - (error (string "local variable name \"" v "\" conflicts with an argument")))) + (error (string "local variable name `" v "` conflicts with an argument")))) local-decls)) (if (eq? e (lam:body lam)) (for-each (lambda (v) (if (or (memq v locals-def) (memq v local-decls) (memq v implicit-locals)) - (error (string "local variable name \"" v "\" conflicts with a static parameter")))) + (error (string "local variable name `" v "` conflicts with a static parameter")))) (scope:sp scope))) (if lam (set-car! (cddr lam) (append (caddr lam) newnames newnames-def))) - (insert-after-meta ;; return the new, expanded scope-block + (insert-after-meta ;; return the new, expanded scope_block (blockify (resolve-scopes- blok (make-scope lam @@ -2545,15 +2539,15 @@ (map cons need-rename-def renamed-def)) scope))) (append! (map (lambda (v) `(local ,v)) newnames) - (map (lambda (v) `(local-def ,v)) newnames-def))) + (map (lambda (v) `(local_def ,v)) newnames-def))) )) ((eq? (car e) 'module) - (error "\"module\" expression not at top level")) - ((eq? (car e) 'break-block) - `(break-block ,(cadr e) ;; ignore type symbol of break-block expression - ,(resolve-scopes- (caddr e) scope))) ;; body of break-block expression - ((eq? (car e) 'with-static-parameters) - `(with-static-parameters + (error "`module` expression not at top level")) + ((eq? (car e) 'break_block) + `(break_block ,(cadr e) ;; ignore type symbol of break_block expression + ,(resolve-scopes- (caddr e) scope))) ;; body of break_block expression + ((eq? (car e) 'with_static_parameters) + `(with_static_parameters ,(resolve-scopes- (cadr e) scope (cddr e)) ,@(cddr e))) ((and (eq? (car e) 'method) (length> e 2)) @@ -2579,8 +2573,8 @@ (cond ((or (eq? e 'true) (eq? e 'false) (eq? e UNUSED) (underscore-symbol? e)) tab) ((symbol? e) (put! tab e #t)) ((and (pair? e) (eq? (car e) 'outerref)) tab) - ((and (pair? e) (eq? (car e) 'break-block)) (free-vars- (caddr e) tab)) - ((and (pair? e) (eq? (car e) 'with-static-parameters)) (free-vars- (cadr e) tab)) + ((and (pair? e) (eq? (car e) 'break_block)) (free-vars- (caddr e) tab)) + ((and (pair? e) (eq? (car e) 'with_static_parameters)) (free-vars- (cadr e) tab)) ((or (atom? e) (quoted? e)) tab) ((eq? (car e) 'lambda) (let ((bound (lambda-all-vars e))) @@ -2654,7 +2648,7 @@ (vinfo:set-read! vi #t)))) e) (case (car e) - ((local-def) ;; a local that we know has an assignment that dominates all usages + ((local_def) ;; a local that we know has an assignment that dominates all usages (let ((vi (var-info-for (cadr e) env))) (vinfo:set-never-undef! vi #t))) ((=) @@ -2677,16 +2671,16 @@ (let ((vi (var-info-for (cadr e) env))) (if vi (begin (if (not (equal? (vinfo:type vi) '(core Any))) - (error (string "multiple type declarations for \"" - (cadr e) "\""))) + (error (string "multiple type declarations for `" + (cadr e) "`"))) (if (assq (cadr e) captvars) - (error (string "type of \"" (cadr e) - "\" declared in inner scope"))) + (error (string "type of `" (cadr e) + "` declared in inner scope"))) (vinfo:set-type! vi (caddr e)))))) ((lambda) (analyze-vars-lambda e env captvars sp '())) - ((with-static-parameters) - ;; (with-static-parameters func_expr sp_1 sp_2 ...) + ((with_static_parameters) + ;; (with_static_parameters func_expr sp_1 sp_2 ...) (assert (eq? (car (cadr e)) 'lambda)) (analyze-vars-lambda (cadr e) env captvars sp (cddr e))) @@ -2866,7 +2860,7 @@ f(x) = yt(x) ((ssavalue? var) `(= ,var ,rhs0)) (else - (error (string "invalid assignment location \"" (deparse var) "\""))))) + (error (string "invalid assignment location `" (deparse var) "`"))))) (define (rename-sig-types ex namemap) (pattern-replace @@ -2889,7 +2883,7 @@ f(x) = yt(x) `(call (core svec) (call (core svec) ,@newtypes) (call (core svec) ,@(append (cddr (cadddr te)) type-sp))))) -;; collect all toplevel-butfirst expressions inside `e`, and return +;; collect all toplevel_butfirst expressions inside `e`, and return ;; (ex . stmts), where `ex` is the expression to evaluated and ;; `stmts` is a list of statements to move to the top level. (define (lift-toplevel e) @@ -2898,7 +2892,7 @@ f(x) = yt(x) (if (or (atom? e) (quoted? e)) e (let ((e (cons (car e) (map lift- (cdr e))))) - (if (eq? (car e) 'toplevel-butfirst) + (if (eq? (car e) 'toplevel_butfirst) (begin (set! top (cons (cddr e) top)) (cadr e)) e)))) @@ -2956,10 +2950,10 @@ f(x) = yt(x) (lambda (x) (and (pair? x) (not (eq? (car x) 'lambda))))))) (define lambda-opt-ignored-exprs - (Set '(quote top core line inert local local-def unnecessary copyast + (Set '(quote top core line inert local local_def unnecessary copyast meta inbounds boundscheck loopinfo decl aliasscope popaliasscope - struct_type abstract_type primitive_type thunk with-static-parameters - global globalref outerref const-if-global + struct_type abstract_type primitive_type thunk with_static_parameters + global globalref outerref const_if_global const null ssavalue isdefined toplevel module lambda error gc_preserve_begin gc_preserve_end import using export))) @@ -3018,11 +3012,11 @@ f(x) = yt(x) #f) ((lambda-opt-ignored-exprs (car e)) #f) - ((eq? (car e) 'scope-block) + ((eq? (car e) 'scope_block) (visit (cadr e))) ((memq (car e) '(block call new splatnew _do_while)) (eager-any visit (cdr e))) - ((eq? (car e) 'break-block) + ((eq? (car e) 'break_block) (visit (caddr e))) ((eq? (car e) 'return) (begin0 (visit (cadr e)) @@ -3152,7 +3146,7 @@ f(x) = yt(x) (let ((var (cadr e)) (rhs (cl-convert (caddr e) fname lam namemap defined toplevel interp))) (convert-assignment var rhs fname lam interp))) - ((local-def) ;; make new Box for local declaration of defined variable + ((local_def) ;; make new Box for local declaration of defined variable (let ((vi (assq (cadr e) (car (lam:vinfo lam))))) (if (and vi (vinfo:asgn vi) (vinfo:capt vi)) `(= ,(cadr e) (call (core Box))) @@ -3165,7 +3159,7 @@ f(x) = yt(x) '(null) `(newvar ,(cadr e)))))) ((const) e) - ((const-if-global) + ((const_if_global) (if (local-in? (cadr e) lam) '(null) `(const ,(cadr e)))) @@ -3220,8 +3214,8 @@ f(x) = yt(x) e (begin (put! defined (cadr e) #t) - `(toplevel-butfirst - ;; wrap in toplevel-butfirst so it gets moved higher along with + `(toplevel_butfirst + ;; wrap in toplevel_butfirst so it gets moved higher along with ;; closure type definitions ,e (thunk (lambda () (() () 0 ()) (block (return ,e)))))))) @@ -3244,7 +3238,7 @@ f(x) = yt(x) (let* ((exprs (lift-toplevel (convert-lambda lam2 '|#anon| #t '()))) (top-stmts (cdr exprs)) (newlam (compact-and-renumber (linearize (car exprs)) 'none 0))) - `(toplevel-butfirst + `(toplevel_butfirst (block ,@sp-inits (method ,name ,(cl-convert sig fname lam namemap defined toplevel interp) ,(julia-bq-macro newlam))) @@ -3301,8 +3295,8 @@ f(x) = yt(x) (caddr e)))) (if (has? namemap s) #f - (error (string "local variable " s - " cannot be used in closure declaration"))) + (error (string "local variable `" s + "` cannot be used in closure declaration"))) #t) #f))) (caddr e) @@ -3378,16 +3372,16 @@ f(x) = yt(x) (not (memq (car vi) moved-vars))) (car (lam:vinfo lam))))) (if (or exists (and short (pair? alldefs))) - `(toplevel-butfirst + `(toplevel_butfirst (null) ,@sp-inits ,@mk-method) (begin (put! defined name #t) - `(toplevel-butfirst + `(toplevel_butfirst ,(convert-assignment name mk-closure fname lam interp) ,@typedef - ,@(map (lambda (v) `(moved-local ,v)) moved-vars) + ,@(map (lambda (v) `(moved_local ,v)) moved-vars) ,@sp-inits ,@mk-method)))))))) ((lambda) ;; happens inside (thunk ...) and generated function bodies @@ -3416,8 +3410,8 @@ f(x) = yt(x) (if (or (symbol? (cadr e)) (and (pair? (cadr e)) (eq? (caadr e) 'outerref))) (error "type declarations on global variables are not yet supported")) (cl-convert `(call (core typeassert) ,@(cdr e)) fname lam namemap defined toplevel interp)))) - ;; `with-static-parameters` expressions can be removed now; used only by analyze-vars - ((with-static-parameters) + ;; `with_static_parameters` expressions can be removed now; used only by analyze-vars + ((with_static_parameters) (cl-convert (cadr e) fname lam namemap defined toplevel interp)) (else (if (eq? (car e) 'struct_type) @@ -3556,11 +3550,11 @@ f(x) = yt(x) (define (check-top-level e) (define (head-to-text h) (case h - ((abstract_type) "\"abstract type\"") - ((primitive_type) "\"primitive type\"") - ((struct_type) "\"struct\"") + ((abstract_type) "`abstract type`") + ((primitive_type) "`primitive type`") + ((struct_type) "`struct`") ((method) "method definition") - (else (string "\"" h "\"")))) + (else (string "`" h "`")))) (if (not (null? (cadr lam))) (error (string (head-to-text (car e)) " expression not at top level")))) ;; evaluate the arguments of a call, creating temporary locations as needed @@ -3619,7 +3613,7 @@ f(x) = yt(x) (emit `(= ,lhs ,rr))))) #f) ;; the interpreter loop. `break-labels` keeps track of the labels to jump to - ;; for all currently closing break-blocks. + ;; for all currently closing break_blocks. ;; `value` means we are in a context where a value is required; a meaningful ;; value must be returned. ;; `tail` means we are in tail position, where a value needs to be `return`ed @@ -3776,7 +3770,7 @@ f(x) = yt(x) (emit `(goto ,topl)) (mark-label endl)) (if value (compile '(null) break-labels value tail))) - ((break-block) + ((break_block) (let ((endl (make-label))) (compile (caddr e) (cons (list (cadr e) endl handler-level catch-token-stack) @@ -3792,7 +3786,7 @@ f(x) = yt(x) ((label symboliclabel) (if (eq? (car e) 'symboliclabel) (if (has? label-nesting (cadr e)) - (error (string "label \"" (cadr e) "\" defined multiple times")) + (error (string "label `" (cadr e) "` defined multiple times")) (put! label-nesting (cadr e) (list handler-level catch-token-stack)))) (let ((m (get label-map (cadr e) #f))) (if m @@ -3883,14 +3877,14 @@ f(x) = yt(x) (emit e) #f)) ((global) ; keep global declarations as statements - (if value (error "misplaced \"global\" declaration")) + (if value (error "misplaced `global` declaration")) (let ((vname (cadr e))) (if (var-info-for vname vi) ;; issue #7264 (error (string "`global " vname "`: " vname " is a local variable in its enclosing scope")) (emit e)))) - ((local-def) #f) + ((local_def) #f) ((local) #f) - ((moved-local) + ((moved_local) (set-car! (lam:vinfo lam) (append (car (lam:vinfo lam)) `((,(cadr e) Any 2)))) #f) ((const) @@ -3907,7 +3901,7 @@ f(x) = yt(x) ((method) (if (not (null? (cadr lam))) (error (string "Global method definition" (linenode-string current-loc) - " needs to be placed at the top level, or use \"eval\"."))) + " needs to be placed at the top level, or use `eval`."))) (if (length> e 2) (let* ((sig (let ((sig (compile (caddr e) break-labels #t #f))) (if (valid-ir-argument? sig) @@ -3985,7 +3979,7 @@ f(x) = yt(x) (emit e)) ;; strip filenames out of non-initial line nodes (emit `(line ,(cadr e))))) - ((and (eq? (car e) 'meta) (length> e 2) (eq? (cadr e) 'ret-type)) + ((and (eq? (car e) 'meta) (length> e 2) (eq? (cadr e) 'ret_type)) (assert (or (not value) tail)) (assert (not rett)) (set! rett (caddr e))) @@ -3997,7 +3991,7 @@ f(x) = yt(x) ((error) (error (cadr e))) (else - (error (string "invalid syntax " (deparse e))))))) + (error (string "invalid syntax `" (deparse e) "`")))))) ;; introduce new slots for assigned arguments (for-each (lambda (v) (if (vinfo:asgn v) @@ -4014,10 +4008,10 @@ f(x) = yt(x) (lab (cadddr x))) (let ((target-nesting (get label-nesting lab #f))) (if (not target-nesting) - (error (string "label \"" lab "\" referenced but not defined"))) + (error (string "label `" lab "` referenced but not defined"))) (let ((target-level (car target-nesting))) (cond ((> target-level hl) - (error (string "cannot goto label \"" lab "\" inside try/catch block"))) + (error (string "cannot goto label `" lab "` inside try/catch block"))) ((= target-level hl) (set-cdr! point (cddr point))) ;; remove empty slot (else diff --git a/test/choosetests.jl b/test/choosetests.jl index 50cd3d39311e6..a4d1671fbdcf7 100644 --- a/test/choosetests.jl +++ b/test/choosetests.jl @@ -108,7 +108,7 @@ function choosetests(choices = []) end compilertests = ["compiler/inference", "compiler/validation", "compiler/ssair", "compiler/irpasses", - "compiler/codegen", "compiler/inline", "compiler/contextual"] + "compiler/codegen", "compiler/inline", "compiler/contextual", "compiler/lowering"] if "compiler" in skip_tests filter!(x -> (x != "compiler" && !(x in compilertests)), tests) diff --git a/test/compiler/lowering.jl b/test/compiler/lowering.jl new file mode 100644 index 0000000000000..4a66a314d1113 --- /dev/null +++ b/test/compiler/lowering.jl @@ -0,0 +1,1449 @@ +include("lowering_tools.jl") + +# Tests are organized by the Expr head which needs to be lowered. +@testset "Lowering" begin + +@testset_desugar "ref end" begin + # Indexing + a[i] + Top.getindex(a, i) + + a[i,j] + Top.getindex(a, i, j) + + # Indexing with `end` + a[end] + Top.getindex(a, Top.lastindex(a)) + + a[i,end] + Top.getindex(a, i, Top.lastindex(a,2)) + + # Nesting of `end` + a[[end]] + Top.getindex(a, Top.vect(Top.lastindex(a))) + + a[b[end] + end] + Top.getindex(a, Top.getindex(b, Top.lastindex(b)) + Top.lastindex(a)) + + a[f(end) + 1] + Top.getindex(a, f(Top.lastindex(a)) + 1) + + # array expr is only emitted once if it can have side effects + (f(x))[end] + begin + ssa1 = f(x) + Top.getindex(ssa1, Top.lastindex(ssa1)) + end + + a[end][b[i]] + begin + ssa1 = Top.getindex(a, Top.lastindex(a)) + Top.getindex(ssa1, Top.getindex(b, i)) + end + + # `end` replacment for first agument of Expr(:ref) + a[f(end)[i]] + Top.getindex(a, begin + ssa1 = f(Top.lastindex(a)) + Top.getindex(ssa1, i) + end) + + # Interaction of `end` with splatting + a[I..., end, J..., end] + Core._apply(Top.getindex, Core.tuple(a), + I, + Core.tuple(Top.lastindex(a, Top.:+(1, Top.length(I)))), + J, + Core.tuple(Top.lastindex(a, Top.:+(2, Top.length(J), Top.length(I))))) + + a[f(x)..., end] + begin + ssa1 = f(x) + Core._apply(Top.getindex, Core.tuple(a), + ssa1, + Core.tuple(Top.lastindex(a, Top.:+(1, Top.length(ssa1))))) + end +end + +@testset_desugar "vect" begin + # flisp: (in expand-table) + [a,b] + Top.vect(a,b) + + [a,b;c] + @Expr(:error, "unexpected semicolon in array expression") + + [a=b,c] + @Expr(:error, "misplaced assignment statement in `[a = b, c]`") +end + +@testset_desugar "hcat vcat hvcat" begin + # flisp: (lambda in expand-table) + [a b] + Top.hcat(a,b) + + [a; b] + Top.vcat(a,b) + + T[a b] + Top.typed_hcat(T, a,b) + + T[a; b] + Top.typed_vcat(T, a,b) + + [a b; c] + Top.hvcat(Core.tuple(2,1), a, b, c) + + T[a b; c] + Top.typed_hvcat(T, Core.tuple(2,1), a, b, c) + + [a b=c] + @Expr(:error, "misplaced assignment statement in `[a b = c]`") + + [a; b=c] + @Expr(:error, "misplaced assignment statement in `[a; b = c]`") + + T[a b=c] + @Expr(:error, "misplaced assignment statement in `T[a b = c]`") + + T[a; b=c] + @Expr(:error, "misplaced assignment statement in `T[a; b = c]`") +end + +@testset_desugar "tuple" begin + (x,y) + Core.tuple(x,y) + + (x=a,y=b) + Core.apply_type(Core.NamedTuple, Core.tuple(:x, :y))(Core.tuple(a, b)) + + # Expr(:parameters) version also works + (;x=a,y=b) + Core.apply_type(Core.NamedTuple, Core.tuple(:x, :y))(Core.tuple(a, b)) + + # Mixed tuple + named tuple + (1; x=a, y=b) + @Expr(:error, "unexpected semicolon in tuple") +end + +@testset_desugar "comparison" begin + # flisp: (expand-compare-chain) + a < b < c + if a < b + b < c + else + false + end + + # Nested + a < b > d <= e + if a < b + if b > d + d <= e + else + false + end + else + false + end + + # Subexpressions + a < b+c < d + if (ssa1 = b+c; a < ssa1) + ssa1 < d + else + false + end + + # Interaction with broadcast syntax + a < b .< c + Top.materialize(Top.broadcasted(&, a < b, Top.broadcasted(<, b, c))) + + a .< b+c < d + Top.materialize(Top.broadcasted(&, + begin + ssa1 = b+c + # Is this a bug? + Top.materialize(Top.broadcasted(<, a, ssa1)) + end, + ssa1 < d)) + + a < b+c .< d + Top.materialize(Top.broadcasted(&, + begin + ssa1 = b+c + a < ssa1 + end, + Top.broadcasted(<, ssa1, d))) +end + +@testset_desugar "|| &&" begin + # flisp: (expand-or) + a || b + if a + true + else + b + end + + f(a) || f(b) || f(c) + if f(a) + true + else + if f(b) + true + else + f(c) + end + end + + # flisp: (expand-and) + a && b + if a + b + else + false + end + + f(a) && f(b) && f(c) + if f(a) + if f(b) + f(c) + else + false + end + else + false + end +end + +@testset_desugar "' <: :>" begin + a' + Top.adjoint(a) + + # <: and >: are special Expr heads which need to be turned into Expr(:call) + # when used as operators + a <: b + $(Expr(:call, :(<:), :a, :b)) + + a >: b + $(Expr(:call, :(>:), :a, :b)) + +end + +@testset_desugar "\$ ... {}" begin + $(Expr(:$, :x)) + @Expr(:error, "`\$` expression outside quote") + + x... + @Expr(:error, "`...` expression outside call") + + {a, b} + @Expr(:error, "{ } vector syntax is discontinued") + + {a; b} + @Expr(:error, "{ } matrix syntax is discontinued") +end + +@testset_desugar ". .=" begin + # flisp: (expand-fuse-broadcast) + + # Property access + a.b + Top.getproperty(a, :b) + + a.b.c + Top.getproperty(Top.getproperty(a, :b), :c) + + # Broadcast + # Basic + x .+ y + Top.materialize(Top.broadcasted(+, x, y)) + + f.(x) + Top.materialize(Top.broadcasted(f, x)) + + # Fusing + f.(x) .+ g.(y) + Top.materialize(Top.broadcasted(+, Top.broadcasted(f, x), Top.broadcasted(g, y))) + + # Keywords don't participate + f.(x, a=1) + Top.materialize( + begin + ssa1 = Top.broadcasted_kwsyntax + ssa2 = Core.apply_type(Core.NamedTuple, Core.tuple(:a))(Core.tuple(1)) + Core.kwfunc(ssa1)(ssa2, ssa1, f, x) + end + ) + + # Nesting + f.(g(x)) + Top.materialize(Top.broadcasted(f, g(x))) + + f.(g(h.(x))) + Top.materialize(Top.broadcasted(f, g(Top.materialize(Top.broadcasted(h, x))))) + + # In place + x .= a + Top.materialize!(x, Top.broadcasted(Top.identity, a)) + + x .= f.(a) + Top.materialize!(x, Top.broadcasted(f, a)) + + x .+= a + Top.materialize!(x, Top.broadcasted(+, x, a)) +end + +@testset_desugar "call" begin + # zero arg call + g[i]() + Top.getindex(g, i)() + + # splatting + f(i, j, v..., k) + Core._apply(f, Core.tuple(i,j), v, Core.tuple(k)) + + # keyword arguments + f(x, a=1) + begin + ssa1 = Core.apply_type(Core.NamedTuple, Core.tuple(:a))(Core.tuple(1)) + Core.kwfunc(f)(ssa1, f, x) + end + + f(x; a=1) + begin + ssa1 = (Core.apply_type(Core.NamedTuple, Core.tuple(:a)))(Core.tuple(1)) + (Core.kwfunc(f))(ssa1, f, x) + end +end + +@testset_desugar "ccall" begin +end + +@testset_desugar "do" begin + f(x) do y + body(y) + end + f(begin + local gsym1 + begin + @Expr(:method, gsym1) + @Expr(:method, gsym1, Core.svec(Core.svec(Core.Typeof(gsym1), Core.Any), Core.svec()), @Expr(:lambda, [_self_, y], [], @Expr(:scope_block, body(y)))) + maybe_unused(gsym1) + end + end, x) + + f(x; a=1) do y + body(y) + end + begin + ssa1 = begin + local gsym1 + begin + @Expr(:method, gsym1) + @Expr(:method, gsym1, Core.svec(Core.svec(Core.Typeof(gsym1), Core.Any), Core.svec()), @Expr(:lambda, [_self_, y], [], @Expr(:scope_block, body(y)))) + maybe_unused(gsym1) + end + end + begin + ssa2 = (Core.apply_type(Core.NamedTuple, Core.tuple(:a)))(Core.tuple(1)) + (Core.kwfunc(f))(ssa2, f, ssa1, x) + end + end +end + +@testset_desugar "+= .+= etc" begin + # flisp: (lower-update-op) + x += a + x = x+a + + x::Int += a + x = x::Int + a + + x[end] += a + begin + ssa1 = Top.lastindex(x) + begin + ssa2 = Top.getindex(x, ssa1) + a + Top.setindex!(x, ssa2, ssa1) + maybe_unused(ssa2) + end + end + + x[f(y)] += a + begin + ssa1 = f(y) + begin + ssa2 = Top.getindex(x, ssa1) + a + Top.setindex!(x, ssa2, ssa1) + maybe_unused(ssa2) + end + end + + # getproperty(x,y) only eval'd once. + x.y.z += a + begin + ssa1 = Top.getproperty(x, :y) + begin + ssa2 = Top.getproperty(ssa1, :z) + a + Top.setproperty!(ssa1, :z, ssa2) + maybe_unused(ssa2) + end + end + + (x,y) .+= a + begin + ssa1 = Core.tuple(x, y) + Top.materialize!(ssa1, Top.broadcasted(+, ssa1, a)) + end + + [x y] .+= a + begin + ssa1 = Top.hcat(x, y) + Top.materialize!(ssa1, Top.broadcasted(+, ssa1, a)) + end + + (x+y) += 1 + @Expr(:error, "invalid assignment location `(x + y)`") +end + +@testset_desugar "=" begin + # flisp: (lambda in expand-table) + + # property notation + a.b = c + begin + Top.setproperty!(a, :b, c) + maybe_unused(c) + end + + a.b.c = d + begin + ssa1 = Top.getproperty(a, :b) + Top.setproperty!(ssa1, :c, d) + maybe_unused(d) + end + + # setindex + a[i] = b + begin + Top.setindex!(a, b, i) + maybe_unused(b) + end + + a[i,end] = b+c + begin + ssa1 = b+c + Top.setindex!(a, ssa1, i, Top.lastindex(a,2)) + maybe_unused(ssa1) + end + + # Assignment chain; nontrivial rhs + x = y = f(a) + begin + ssa1 = f(a) + y = ssa1 + x = ssa1 + maybe_unused(ssa1) + end + + # Multiple Assignment + + # Simple multiple assignment exact match + (x,y) = (a,b) + begin + x = a + y = b + maybe_unused(Core.tuple(a,b)) + end + + # Destructuring + (x,y) = a + begin + begin + ssa1 = Top.indexed_iterate(a, 1) + x = Core.getfield(ssa1, 1) + gsym1 = Core.getfield(ssa1, 2) + ssa1 + end + begin + ssa2 = Top.indexed_iterate(a, 2, gsym1) + y = Core.getfield(ssa2, 1) + ssa2 + end + maybe_unused(a) + end + + # Nested destructuring + (x,(y,z)) = a + begin + begin + ssa1 = Top.indexed_iterate(a, 1) + x = Core.getfield(ssa1, 1) + gsym1 = Core.getfield(ssa1, 2) + ssa1 + end + begin + ssa2 = Top.indexed_iterate(a, 2, gsym1) + begin + ssa3 = Core.getfield(ssa2, 1) + begin + ssa4 = Top.indexed_iterate(ssa3, 1) + y = Core.getfield(ssa4, 1) + gsym2 = Core.getfield(ssa4, 2) + ssa4 + end + begin + ssa5 = Top.indexed_iterate(ssa3, 2, gsym2) + z = Core.getfield(ssa5, 1) + ssa5 + end + maybe_unused(ssa3) + end + ssa2 + end + maybe_unused(a) + end + + # type decl + x::T = a + begin + @Expr :decl x T + x = a + end + + # type aliases + A{T} = B{T} + begin + @Expr :const_if_global A + A = @Expr(:scope_block, + begin + @Expr :local_def T + T = Core.TypeVar(:T) + Core.UnionAll(T, Core.apply_type(B, T)) + end) + end + + # Short form function definitions + f(x) = body(x) + begin + @Expr(:method, f) + @Expr(:method, f, + Core.svec(Core.svec(Core.Typeof(f), Core.Any), Core.svec()), + @Expr(:lambda, [_self_, x], [], + @Expr(:scope_block, + body(x)))) + maybe_unused(f) + end + + # Invalid assignments + 1 = a + @Expr(:error, "invalid assignment location `1`") + + true = a + @Expr(:error, "invalid assignment location `true`") + + "str" = a + @Expr(:error, "invalid assignment location `\"str\"`") + + [x y] = c + @Expr(:error, "invalid assignment location `[x y]`") + + a[x y] = c + @Expr(:error, "invalid spacing in left side of indexed assignment") + + a[x;y] = c + @Expr(:error, "unexpected `;` in left side of indexed assignment") + + [x;y] = c + @Expr(:error, "use `(a, b) = ...` to assign multiple values") + + # Old deprecation (6575e12ba46) + x.(y)=c + @Expr(:error, "invalid syntax `x.(y) = ...`") +end + +@testset_desugar "const local global" begin + # flisp: (expand-decls) (expand-local-or-global-decl) (expand-const-decl) + # const + const x=a + begin + @Expr :const x # `const x` is invalid surface syntax + x = a + end + + const x,y = a,b + begin + @Expr :const x + @Expr :const y + begin + x = a + y = b + maybe_unused(Core.tuple(a,b)) + end + end + + # local + local x, y + begin + local y + local x + end + + # Locals with initialization. Note parentheses are needed for this to parse + # as individual assignments rather than multiple assignment. + local (x=a), (y=b), z + begin + local z + local y + local x + x = a + y = b + end + + # Multiple assignment form + begin + local x,y = a,b + end + begin + local x + local y + begin + x = a + y = b + maybe_unused(Core.tuple(a,b)) + end + end + + # global + global x, (y=a) + begin + global y + global x + y = a + end +end + +@testset_desugar "where" begin + A{T} where T + @Expr(:scope_block, begin + @Expr(:local_def, T) + T = Core.TypeVar(:T) + Core.UnionAll(T, Core.apply_type(A, T)) + end) + + A{T} where T <: S + @Expr(:scope_block, begin + @Expr(:local_def, T) + T = Core.TypeVar(:T, S) + Core.UnionAll(T, Core.apply_type(A, T)) + end) + + A{T} where T >: S + @Expr(:scope_block, begin + @Expr(:local_def, T) + T = Core.TypeVar(:T, S, Core.Any) + Core.UnionAll(T, Core.apply_type(A, T)) + end) + + A{T} where S' <: T <: V' + @Expr(:scope_block, begin + @Expr(:local_def, T) + T = Core.TypeVar(:T, Top.adjoint(S), Top.adjoint(V)) + Core.UnionAll(T, Core.apply_type(A, T)) + end) + + A{T} where S <: T <: V <: W + @Expr(:error, "invalid variable expression in `where`") + + A{T} where S <: T < V + @Expr(:error, "invalid bounds in `where`") + + A{T} where S < T <: V + @Expr(:error, "invalid bounds in `where`") + + T where a <: T(x) <: b + @Expr(:error, "invalid type parameter name `T(x)`") +end + +@testset_desugar "let" begin + # flisp: (expand-let) + let x::Int + body + end + @Expr(:scope_block, begin + begin + local x + @Expr(:decl, x, Int) + end + body + end) + + # Let without assignment + let x,y + body + end + @Expr(:scope_block, + begin + local x + @Expr(:scope_block, + begin + local y + body + end) + end) + + # Let with assignment + let x=a, y=b + body + end + @Expr(:scope_block, + begin + @Expr :local_def x + x = a + @Expr(:scope_block, + begin + @Expr :local_def y + y = b + body + end) + end) + + # Let with function declaration + let f(x) = 1 + body + end + @Expr(:scope_block, + begin + @Expr(:local_def, f) + begin + @Expr(:method, f) + @Expr(:method, f, + Core.svec(Core.svec(Core.Typeof(f), Core.Any), Core.svec()), + @Expr(:lambda, [_self_, x], [], @Expr(:scope_block, 1))) + end + body + end) + + # Local recursive function + let f(x) = f(x) + body + end + @Expr(:scope_block, begin + local f + begin + @Expr(:method, f) + @Expr(:method, f, + Core.svec(Core.svec(Core.Typeof(f), Core.Any), Core.svec()), + @Expr(:lambda, [_self_, x], [], @Expr(:scope_block, f(x)))) + end + body + end) + + # Let with existing var on rhs + let x = x + a + body + end + @Expr(:scope_block, begin + ssa1 = x + a + @Expr(:scope_block, begin + @Expr(:local_def, x) + x = ssa1 + body + end) + end) + + # Destructuring + let (a, b) = (c, d) + body + end + @Expr(:scope_block, + begin + @Expr(:local_def, a) + @Expr(:local_def, b) + begin + a = c + b = d + maybe_unused(Core.tuple(c, d)) + end + body + end) + + # Destructuring with existing vars on rhs + let (a, b) = (a, d) + body + end + begin + ssa1 = Core.tuple(a, d) + @Expr(:scope_block, + begin + @Expr(:local_def, a) + @Expr(:local_def, b) + begin + begin + ssa2 = Top.indexed_iterate(ssa1, 1) + a = Core.getfield(ssa2, 1) + gsym1 = Core.getfield(ssa2, 2) + ssa2 + end + begin + ssa3 = Top.indexed_iterate(ssa1, 2, gsym1) + b = Core.getfield(ssa3, 1) + ssa3 + end + maybe_unused(ssa1) + end + body + end) + end + + # Other expressions in the variable list should produce an error + let f(x) + body + end + @Expr(:error, "invalid let syntax") + + let x[i] = a + end + @Expr(:error, "invalid let syntax") +end + +@testset_desugar "block" begin + $(Expr(:block)) + $nothing + + $(Expr(:block, :a)) + a +end + +@testset_desugar "while for" begin + # flisp: (expand-for) (lambda in expand-forms) + while cond' + body1' + continue + body2 + break + body3 + end + @Expr(:break_block, loop_exit, + @Expr(:_while, Top.adjoint(cond), + @Expr(:break_block, loop_cont, + @Expr(:scope_block, begin + Top.adjoint(body1) + @Expr :break loop_cont + body2 + @Expr :break loop_exit + body3 + end)))) + + for i = a + body1 + continue + body2 + break + end + @Expr(:break_block, loop_exit, + begin + ssa1 = a + gsym1 = Top.iterate(ssa1) + if Top.not_int(Core.:(===)(gsym1, $nothing)) + @Expr(:_do_while, + begin + @Expr(:break_block, loop_cont, + @Expr(:scope_block, + begin + local i + begin + ssa2 = gsym1 + i = Core.getfield(ssa2, 1) + ssa3 = Core.getfield(ssa2, 2) + ssa2 + end + begin + body1 + @Expr :break loop_cont + body2 + @Expr :break loop_exit + end + end)) + gsym1 = Top.iterate(ssa1, ssa3) + end, + Top.not_int(Core.:(===)(gsym1, $nothing))) + end + end) + + # For loops with `outer` + for outer i = a + body + end + @Expr(:break_block, loop_exit, + begin + ssa1 = a + gsym1 = Top.iterate(ssa1) + @Expr(:require_existing_local, i) + if Top.not_int(Core.:(===)(gsym1, $nothing)) + @Expr(:_do_while, + begin + @Expr(:break_block, loop_cont, + @Expr(:scope_block, + begin + begin + ssa2 = gsym1 + i = Core.getfield(ssa2, 1) + ssa3 = Core.getfield(ssa2, 2) + ssa2 + end + body + end)) + gsym1 = Top.iterate(ssa1, ssa3) + end, + Top.not_int(Core.:(===)(gsym1, $nothing))) + end + end) +end + +@testset_desugar "try catch finally" begin + # flisp: expand-try + try + a + catch + b + end + @Expr(:trycatch, + @Expr(:scope_block, begin a end), + @Expr(:scope_block, begin b end)) + + try + a + catch exc + b + end + @Expr(:trycatch, + @Expr(:scope_block, begin a end), + @Expr(:scope_block, + begin + exc = @Expr(:the_exception) + b + end)) + + try + catch exc + end + @Expr(:trycatch, + @Expr(:scope_block, $nothing), + @Expr(:scope_block, begin + exc = @Expr(:the_exception) + begin + end + end)) + + try + a + finally + b + end + @Expr(:tryfinally, + @Expr(:scope_block, begin a end), + @Expr(:scope_block, begin b end)) + + try + a + catch + b + finally + c + end + @Expr(:tryfinally, + @Expr(:trycatch, + @Expr(:scope_block, begin a end), + @Expr(:scope_block, begin b end)), + @Expr(:scope_block, begin c end)) + + # goto with label anywhere within try block is ok + try + begin + let + $(Expr(:symbolicgoto, :x)) # @goto x + end + end + begin + $(Expr(:symboliclabel, :x)) # @label x + end + finally + end + @Expr(:tryfinally, + @Expr(:scope_block, + begin + begin + @Expr(:scope_block, + @Expr(:symbolicgoto, x)) + end + begin + @Expr(:symboliclabel, x) + end + end), + @Expr(:scope_block, + begin + end)) + + # goto not allowed without associated label in try/finally + try + begin + let + $(Expr(:symbolicgoto, :x)) # @goto x + end + end + finally + end + @Expr(:error, "goto from a try/finally block is not permitted") + + $(Expr(:try, :a, :b, :c, :d, :e)) + @Expr(:error, "invalid `try` form") +end + +@testset_desugar "function" begin + # Long form with argument annotations + function f(x::T, y) + body(x) + end + begin + @Expr(:method, f) + @Expr(:method, f, + Core.svec(Core.svec(Core.Typeof(f), T, Core.Any), Core.svec()), + @Expr(:lambda, [_self_, x, y], [], + @Expr(:scope_block, + body(x)))) + maybe_unused(f) + end + + # Default arguments + function f(x=a, y=b) + body(x,y) + end + begin + begin + @Expr(:method, f) + @Expr(:method, f, + Core.svec(Core.svec(Core.Typeof(f)), Core.svec()), + @Expr(:lambda, [_self_], [], + @Expr(:scope_block, _self_(a, b)))) + maybe_unused(f) + end + begin + @Expr(:method, f) + @Expr(:method, f, + Core.svec(Core.svec(Core.Typeof(f), Core.Any), Core.svec()), + @Expr(:lambda, [_self_, x], [], + @Expr(:scope_block, _self_(x, b)))) + maybe_unused(f) + end + begin + @Expr(:method, f) + @Expr(:method, f, + Core.svec(Core.svec(Core.Typeof(f), Core.Any, Core.Any), Core.svec()), + @Expr(:lambda, [_self_, x, y], [], + @Expr(:scope_block, body(x, y)))) + maybe_unused(f) + end + end + + # Varargs + function f(x, args...) + body(x, args) + end + begin + @Expr(:method, f) + @Expr(:method, f, + Core.svec(Core.svec(Core.Typeof(f), Core.Any, + Core.apply_type(Vararg, Core.Any)), Core.svec()), + @Expr(:lambda, [_self_, x, args], [], + @Expr(:scope_block, body(x, args)))) + maybe_unused(f) + end + + # Keyword arguments + function f(x; k1=v1, k2=v2) + body + end + Core.ifelse(false, false, + begin + @Expr(:method, f) + begin + @Expr(:method, gsym1) + @Expr(:method, gsym1, + Core.svec(Core.svec(Core.typeof(gsym1), Core.Any, Core.Any, Core.Typeof(f), Core.Any), Core.svec()), + @Expr(:lambda, [gsym1, k1, k2, _self_, x], [], + @Expr(:scope_block, body))) + maybe_unused(gsym1) + end + begin + @Expr(:method, f) + @Expr(:method, f, + Core.svec(Core.svec(Core.Typeof(f), Core.Any), Core.svec()), + @Expr(:lambda, [_self_, x], [], + @Expr(:scope_block, return gsym1(v1, v2, _self_, x)))) + maybe_unused(f) + end + begin + @Expr(:method, f) + @Expr(:method, f, + Core.svec(Core.svec(Core.kwftype(Core.Typeof(f)), Core.Any, Core.Typeof(f), Core.Any), Core.svec()), + @Expr(:lambda, [gsym2, gsym3, _self_, x], [], + @Expr(:scope_block, + @Expr(:scope_block, + begin + @Expr(:local_def, k1) + k1 = if Top.haskey(gsym3, :k1) + Top.getindex(gsym3, :k1) + else + v1 + end + @Expr(:scope_block, begin + @Expr(:local_def, k2) + k2 = if Top.haskey(gsym3, :k2) + Top.getindex(gsym3, :k2) + else + v2 + end + begin + ssa1 = Top.pairs(Top.structdiff(gsym3, Core.apply_type(Core.NamedTuple, Core.tuple(:k1, :k2)))) + if Top.isempty(ssa1) + $nothing + else + Top.kwerr(gsym3, _self_, x) + end + return gsym1(k1, k2, _self_, x) + end + end) + end)))) + maybe_unused(f) + end + f + end) + + # Return type declaration + function f(x)::T + body(x) + end + begin + @Expr(:method, f) + @Expr(:method, f, + Core.svec(Core.svec(Core.Typeof(f), Core.Any), Core.svec()), + @Expr(:lambda, [_self_, x], [], + @Expr(:scope_block, + begin + ssa1 = T + @Expr(:meta, ret_type, ssa1) + body(x) + end))) + maybe_unused(f) + end + + # Anon functions + (x,y)->body(x,y) + begin + local gsym1 + begin + @Expr(:method, gsym1) + @Expr(:method, gsym1, + Core.svec(Core.svec(Core.Typeof(gsym1), Core.Any, Core.Any), Core.svec()), + @Expr(:lambda, [_self_, x, y], [], + @Expr(:scope_block, body(x, y)))) + maybe_unused(gsym1) + end + end + + # Where syntax + function f(x::T, y::S) where {T <: S, S <: U} + body(x, y) + end + begin + @Expr(:method, f) + @Expr(:method, f, + begin + ssa1 = Core.TypeVar(:T, S) + ssa2 = Core.TypeVar(:S, U) + Core.svec(Core.svec(Core.Typeof(f), ssa1, ssa2), Core.svec(ssa1, ssa2)) + end, + @Expr(:lambda, [_self_, x, y], [], @Expr(:scope_block, body(x, y)))) + maybe_unused(f) + end + + # Type constraints + #= + function f(x::T{<:S}) + body(x, y) + end + begin + @Expr(:method, f) + @Expr(:method, f, + Core.svec(Core.svec(Core.Typeof(f), + @Expr(:scope_block, + begin + @Expr(:local_def, gsym1) + gsym1 = Core.TypeVar(Symbol("#s167"), S) + Core.UnionAll(gsym1, Core.apply_type(T, gsym1)) + end)), Core.svec()), + @Expr(:lambda, [_self_, x], [], @Expr(:scope_block, body(x, y)))) + maybe_unused(f) + end + FIXME + =# + + # Invalid function names + ccall(x)=body + @Expr(:error, "invalid function name `ccall`") + + cglobal(x)=body + @Expr(:error, "invalid function name `cglobal`") + + true(x)=body + @Expr(:error, "invalid function name `true`") + + false(x)=body + @Expr(:error, "invalid function name `false`") +end + +ln = LineNumberNode(@__LINE__()+3, Symbol(@__FILE__)) +@testset_desugar "@generated function" begin + function f(x) + body1(x) + if $(Expr(:generated)) + gen_body1(x) + else + normal_body1(x) + end + body2 + if $(Expr(:generated)) + gen_body2 + else + normal_body2 + end + end + begin + begin + global gsym1 + begin + @Expr(:method, gsym1) + @Expr(:method, gsym1, + Core.svec(Core.svec(Core.Typeof(gsym1), Core.Any, Core.Any), Core.svec()), + @Expr(:lambda, [_self_, gsym2, x], [], + @Expr(:scope_block, + begin + @Expr(:meta, nospecialize, gsym2, x) + Core._expr(:block, + $(QuoteNode(LineNumberNode(ln.line, ln.file))), + @Expr(:copyast, $(QuoteNode(:(body1(x))))), + # FIXME: These line numbers seem buggy? + $(QuoteNode(LineNumberNode(ln.line+1, ln.file))), + gen_body1(x), + $(QuoteNode(LineNumberNode(ln.line+6, ln.file))), + :body2, + $(QuoteNode(LineNumberNode(ln.line+7, ln.file))), + gen_body2) + end))) + maybe_unused(gsym1) + end + end + @Expr(:method, f) + @Expr(:method, f, + Core.svec(Core.svec(Core.Typeof(f), Core.Any), Core.svec()), + @Expr(:lambda, [_self_, x], [], + @Expr(:scope_block, + begin + @Expr(:meta, generated, + @Expr(:new, + Core.GeneratedFunctionStub, + gsym1, $([:_self_, :x]), + nothing, + $(ln.line), + $(QuoteNode(ln.file)), + false)) + body1(x) + normal_body1(x) + body2 + normal_body2 + end))) + maybe_unused(f) + end +end + +@testset_desugar "macro" begin + macro foo + end + @Expr(:method, $(Symbol("@foo"))) + + macro foo(ex) + body(ex) + end + begin + @Expr(:method, $(Symbol("@foo"))) + @Expr(:method, $(Symbol("@foo")), + Core.svec(Core.svec(Core.Typeof($(Symbol("@foo"))), Core.LineNumberNode, Core.Module, Core.Any), Core.svec()), + @Expr(:lambda, [_self_, __source__, __module__, ex], [], + @Expr(:scope_block, + begin + @Expr(:meta, nospecialize, ex) + body(ex) + end))) + maybe_unused($(Symbol("@foo"))) + end + + macro foo(ex; x=a) + body(ex) + end + @Expr(:error, "macros cannot accept keyword arguments") + + macro () + end + @Expr(:error, "invalid macro definition") +end + +@testset "Forms without desugaring" begin + # (expand-forms) + # The following Expr heads are currently not touched by desugaring + for head in [:quote, :top, :core, :globalref, :outerref, :module, :toplevel, :null, :meta, :using, :import, :export] + ex = Expr(head, Expr(:foobar, :junk, nothing, 42)) + @test _expand_forms(ex) == ex + end + # flisp: inert,line have special representations on the julia side + @test _expand_forms(QuoteNode(Expr(:$, :x))) == QuoteNode(Expr(:$, :x)) # flisp: `(inert ,expr) + @test _expand_forms(LineNumberNode(1, :foo)) == LineNumberNode(1, :foo) # flisp: `(line ,line ,file) +end + +end + +#------------------------------------------------------------------------------- +# Julia AST Notes +# +# Broadly speaking there's three categories of `Expr` expression heads: +# * Forms which represent normal julia surface syntax +# * Special forms which are emitted by macros in the public API, but which +# have no normal syntax. +# * Forms which are used internally as part of lowering + +# Here's the forms which are transformed as part of the desugaring pass in +# expand-table: +# +# function expand-function-def +# -> expand-arrow +# let expand-let +# macro expand-macro-def +# struct expand-struct-def +# try expand-try +# lambda expand-table +# block expand-table +# . expand-fuse-broadcast +# .= expand-fuse-broadcast +# <: expand-table +# >: expand-table +# where expand-wheres +# const expand-const-decl +# local expand-local-or-global-decl +# global expand-local-or-global-decl +# local_def expand-local-or-global-decl +# = expand-table +# abstract expand-table +# primitive expand-table +# comparison expand-compare-chain +# ref partially-expand-ref +# curly expand-table +# call expand-table +# do expand-table +# tuple lower-named-tuple +# braces expand-table +# bracescat expand-table +# string expand-table +# :: expand-table +# while expand-table +# break expand-table +# continue expand-table +# for expand-for +# && expand-and +# || expand-or +# += -= *= .*= /= ./= lower-update-op +# //= .//= \\= .\\= +# .+= .-= ^= .^= ÷= +# .÷= %= .%= |= .|= +# &= .&= $= ⊻= .⊻= +# <<= .<<= >>= .>>= +# >>>= .>>>= +# ... expand-table +# $ expand-table +# vect expand-table +# hcat expand-table +# vcat expand-table +# typed_hcat expand-table +# typed_vcat expand-table +# ' expand-table +# generator expand-generator +# flatten expand-generator +# comprehension expand-table +# typed_comprehension lower-comprehension + +# Heads of internal AST forms (incomplete) +# +# Emitted by public macros: +# inbounds @inbounds +# boundscheck @boundscheck +# isdefined @isdefined +# generated @generated +# locals Base.@locals +# meta @inline, @noinline, ... +# symbolicgoto @goto +# symboliclabel @label +# gc_preserve_begin GC.@preserve +# gc_preserve_end GC.@preserve +# foreigncall ccall +# loopinfo @simd +# +# Scoping and variables: +# scope_block +# toplevel_butfirst +# toplevel +# aliasscope +# popaliasscope +# require_existing_local +# local_def +# const_if_global +# top +# core +# globalref +# outerref +# +# Looping: +# _while +# _do_while +# break_block +# +# Types: +# new +# splatnew +# +# Functions: +# lambda +# method +# ret_type +# +# Errors: +# error +# incomplete +# +# Other (TODO) +# with_static_parameters + +# IR: +# +# Exceptions: +# enter +# leave +# pop_exception +# gotoifnot +# +# SSAIR: +# throw_undef_if_not +# unreachable +# undefcheck +# invoke + diff --git a/test/compiler/lowering_tools.jl b/test/compiler/lowering_tools.jl new file mode 100644 index 0000000000000..59301a22208cb --- /dev/null +++ b/test/compiler/lowering_tools.jl @@ -0,0 +1,277 @@ +using Core: SSAValue +using Base: remove_linenums! + +# Call into lowering stage 1; syntax desugaring +function fl_expand_forms(ex) + ccall(:jl_call_scm_on_ast_formonly, Any, (Cstring, Any, Any), "jl-expand-forms", ex, Main) +end + +include("../../base/compiler/lowering/desugar.jl") + +# Make it easy to swap fl_expand_forms with the julia version. +if !isdefined(@__MODULE__, :use_flisp) + use_flisp = true +end +function _expand_forms(ex) + if use_flisp + fl_expand_forms(ex) + else + try + expand_forms(ex) + catch exc + exc isa LoweringError || rethrow() + # Hack: show only msg for more compatibility with flisp error forms + return Expr(:error, exc.msg) + #return Expr(:error, sprint(show, exc)) + end + end +end + +function lift_lowered_expr!(ex, nextids, valmap, lift_full) + if ex isa SSAValue + # Rename SSAValues into renumbered symbols + return get!(valmap, ex) do + newid = nextids[1] + nextids[1] = newid+1 + Symbol("ssa$newid") + end + end + if ex isa Symbol + if ex == Symbol("#self#") + return :_self_ + end + # Rename gensyms + name = string(ex) + if startswith(name, "#") + return get!(valmap, ex) do + newid = nextids[2] + nextids[2] = newid+1 + Symbol("gsym$newid") + end + end + end + if ex isa Expr + if ex.head == :block && length(ex.args) == 1 + # Remove trivial blocks + return lift_lowered_expr!(ex.args[1], nextids, valmap, lift_full) + end + map!(ex.args, ex.args) do e + lift_lowered_expr!(e, nextids, valmap, lift_full) + end + if lift_full + # Lift exotic Expr heads into standard julia syntax for ease in + # writing test case expressions. + if ex.head == :top || ex.head == :core + # Special global refs renamed to look like modules + newhead = ex.head == :top ? :Top : :Core + return Expr(:(.), newhead, QuoteNode(ex.args[1])) + elseif ex.head == :unnecessary + # `unnecessary` marks expressions generated by lowering that + # do not need to be evaluated if their value is unused. + return Expr(:call, :maybe_unused, ex.args...) + #= + elseif ex.head in [:_while, :_do_while, :scope_block, :break_block, + :break, :local_def, :require_existing_local] + return Expr(:macrocall, Symbol("@Expr"), nothing, + QuoteNode(ex.head), ex.args...) + =# + end + end + elseif ex isa Vector # Occasional case of lambdas + map!(ex, ex) do e + lift_lowered_expr!(e, nextids, valmap, lift_full) + end + end + return ex +end + +""" +Clean up an `Expr` into an equivalent form which can be easily entered by +hand + +* Replacing `SSAValue(id)` with consecutively numbered symbols :ssa\$i +* Remove trivial blocks +""" +function lift_lowered_expr(ex; lift_full=false) + valmap = Dict{Union{Symbol,SSAValue},Symbol}() + lift_lowered_expr!(remove_linenums!(deepcopy(ex)), ones(Int,2), valmap, lift_full) +end + +""" +Very slight lowering of reference expressions to allow comparison with +desugared forms. + +* Remove trivial blocks +* Translate psuedo-module expressions Top.x and Core.x to Expr(:top) and + Expr(:core) +""" +function lower_ref_expr!(ex) + if ex isa Expr + map!(lower_ref_expr!, ex.args, ex.args) + if ex.head == :block && length(ex.args) == 1 + # Remove trivial blocks + return lower_ref_expr!(ex.args[1]) + end + # Translate a selection of special expressions into the exotic Expr + # heads used in lowered code. + if ex.head == :(.) && length(ex.args) >= 1 && (ex.args[1] == :Top || + ex.args[1] == :Core) + if !(length(ex.args) == 2 && ex.args[2] isa QuoteNode) + throw("Unexpected top/core expression $(sprint(dump, ex))") + end + return Expr(ex.args[1] == :Top ? :top : :core, ex.args[2].value) + elseif ex.head == :call && length(ex.args) >= 1 && ex.args[1] == :maybe_unused + return Expr(:unnecessary, ex.args[2:end]...) + elseif ex.head == :macrocall && ex.args[1] == Symbol("@Expr") + head = ex.args[3] + head isa QuoteNode || throw(ArgumentError("`head` argument to @Expr should be quoted")) + return Expr(head.value, ex.args[4:end]...) + end + end + return ex +end +lower_ref_expr(ex) = lower_ref_expr!(remove_linenums!(deepcopy(ex))) + + +function diffdump(io::IOContext, ex1, ex2, n, prefix, indent) + if ex1 == ex2 + isempty(prefix) || print(io, prefix) + dump(io, ex1, 2, indent) + else + if ex1 isa Expr && ex2 isa Expr && ex1.head == ex2.head && length(ex1.args) == length(ex2.args) + isempty(prefix) || print(io, prefix) + println(io, "Expr") + println(io, indent, " head: ", ex1.head) + println(io, indent, " args: Array{Any}(", size(ex1.args), ")") + for i in 1:length(ex1.args) + prefix = string(indent, " ", i, ": ") + diffdump(io, ex1.args[i], ex2.args[i], 4, prefix, string(" ", indent)) + i < length(ex1.args) && println(io) + end + else + printstyled(io, string(prefix, sprint(dump, ex1, 4, indent; context=io)), color=:green) + println() + printstyled(io, string(prefix, sprint(dump, ex2, 4, indent; context=io)), color=:red) + end + end +end + +""" +Display colored differences between two expressions `ex1` and `ex2` using the +`dump` format. +""" +function diffdump(ex1, ex2; maxdepth=20) + mod = get(stdout, :module, Main) + diffdump(IOContext(stdout, :limit => true, :module => mod), ex1, ex2, maxdepth, "", "") + println(stdout) +end + +# For interactive convenience in constructing test cases with flisp based lowering +function desugar(ex; lift=:full) + expanded = _expand_forms(ex) + if lift == :full || lift == :partial + lift_lowered_expr(expanded; lift_full=(lift == :full)) + else + expanded + end +end + +# Macro for producing exotic `Expr`s found in lowered ASTs +# +# Note that this is provided for convenience/reference but in practice we +# expand it "manually" inside lower_ref_expr! +macro Expr(head, args...) + head isa QuoteNode || throw(ArgumentError("`head` argument to @Expr should be quoted")) + esc(Expr(head.value, args...)) +end + +""" + @desugar ex [kws...] + +Convenience macro, equivalent to `desugar(:(ex), kws...)`. +""" +macro desugar(ex, kws...) + quote + desugar($(Expr(:quote, ex)); $(map(esc, kws)...)) + end +end + +# Convenience macro to print code for a test case +macro maketest(ex) + Base.remove_linenums!(ex) + quote + print($(QuoteNode(ex)), "\n") + print(desugar($(Expr(:quote, ex))), "\n") + end +end + +""" + @testset_desugar(name, exprs) + +Test that a set of expressions lower correctly to desugared AST form. This +creates a new `@testset` with the given `name`. The statements in the block +`exprs` are interpreted as a flat list of any number of `input_expr`, +`ref_expr` pairs, where `input_expr` should be transformed by lowering into +`ref_expr` by the desugaring pass. For example, + +``` +@testset_desugar "Property notation" begin + # flisp: (expand-fuse-broadcast) + a.b + Top.getproperty(a, :b) + + a.b.c + Top.getproperty(Top.getproperty(a, :b), :c) +end +``` +""" +macro testset_desugar(name, block) + if !(block isa Expr && block.head == :block) + throw(ArgumentError("@testset_desugar requires a block as the second argument")) + end + loc = nothing + tests = [] + i = 1 + while i <= length(block.args) + if block.args[i] isa LineNumberNode + loc = block.args[i] + i += 1 + continue + end + exs = [] + while i <= length(block.args) && length(exs) < 2 + if !(block.args[i] isa LineNumberNode) + push!(exs, block.args[i]) + end + i += 1 + end + if length(exs) == 0 + break + end + if length(exs) == 1 + throw(ArgumentError("List of expressions to @testset_desugar must consist of input,ref pairs")) + end + input = exs[1] + ref = exs[2] + ex = quote + expanded = lift_lowered_expr(_expand_forms($(Expr(:quote, input)))) + reference = lower_ref_expr($(Expr(:quote, ref))) + @test expanded == reference + if expanded != reference + # Kinda crude. Would be much neater if Test supported custom/more + # capable diffing for failed tests. + println("Diff dump:") + diffdump(expanded, reference) + end + end + # Attribute the test to the correct line number + @assert ex.args[6].args[1] == Symbol("@test") + ex.args[6].args[2] = loc + push!(tests, ex) + end + quote + @testset $name begin + $(tests...) + end + end +end