module MacroExpandJL

export macroexpand_jl

macroexpand_jl(io::IO, ex::Expr) = (show_unquoted(io, macroexpand(ex)); print(io, "\n"))

function macroexpand_jl(outfilename, infilename)
    str = readall(infilename)
    open(outfilename, "w") do file
        println(file, "# Auto-generated by MacroExpandJL")
        println(file, "# DO NOT EDIT---instead, edit the source file $infilename")
        indx = 1
        while indx < length(str)
            ex, indx = parse(str, indx)
            macroexpand_jl(file, ex)
        end
    end
end

function macroexpand_jl(infilename)
    base, ext = splitext(infilename)
    outfilename = string(base, "_expanded", ext)
    macroexpand_jl(outfilename, infilename)
end

### The code below is a lightly-edited version of what's in base/show.jl

## Abstract Syntax Tree (AST) printing ##

# Summary:
#   print(io, ex) defers to show_unquoted(io, ex)
#   show(io, ex) defers to show_unquoted(io, QuoteNode(ex))
#   show_unquoted(io, ex) does the heavy lifting
#
# AST printing should follow two rules:
#   1. parse(string(ex)) == ex
#   2. eval(parse(repr(ex))) == ex
#
# Rule 1 means that printing an expression should generate Julia code which
# could be reparsed to obtain the original expression. This code should be
# unambiguous and as readable as possible.
#
# Rule 2 means that showing an expression should generate a quoted version of
# print’s output. Parsing and then evaling this output should return the
# original expression.
#
# This is consistent with many other show methods, i.e.:
#   show(Set([1,2,3]))                # ==> "Set{Int64}([2,3,1])"
#   eval(parse("Set{Int64}([2,3,1])”) # ==> An actual set
# While this isn’t true of ALL show methods, it is of all ASTs.

typealias ExprNode Union{Expr, QuoteNode, SymbolNode, LineNumberNode,
                         LabelNode, GotoNode, TopNode}
show_unquoted(io::IO, ex)              = show_unquoted(io, ex, 0, 0)
show_unquoted(io::IO, ex, indent::Int) = show_unquoted(io, ex, indent, 0)
show_unquoted(io::IO, ex, ::Int,::Int) = show(io, ex)

## AST printing constants ##

const indent_width = 4
const quoted_syms = Set{Symbol}([:(:),:(::),:(:=),:(=),:(==),:(===),:(=>)])
const uni_ops = Set{Symbol}([:(+), :(-), :(!), :(~), :(<:), :(>:)])
const bin_ops_by_prec = [
    "= := += -= *= /= //= .//= .*= ./= \\= .\\= ^= .^= %= .%= |= &= \$= => <<= >>= >>>= ~ .+= .-=",
    "?",
    "||",
    "&&",
    "-- -->",
    "> < >= <= == === != !== .> .< .>= .<= .== .!= .= .! <: >:",
    "|> <|",
    ": ..",
    "+ - .+ .- | \$",
    "<< >> >>> .<< .>> .>>>",
    "* / ./ % .% & .* \\ .\\",
    "// .//",
    "^ .^",
    "::",
    "."
]
const bin_op_precs = Dict{Symbol,Int}(merge([Dict{Any, Any}([symbol(op)=>i for op=split(bin_ops_by_prec[i])]) for i=1:length(bin_ops_by_prec)]...))
const bin_ops = Set{Symbol}(keys(bin_op_precs))
const expr_infix_wide = Set([:(=), :(+=), :(-=), :(*=), :(/=), :(\=), :(&=),
    :(|=), :($=), :(>>>=), :(>>=), :(<<=), :(&&), :(||)])
const expr_infix = Set([:(:), :(<:), :(->), :(=>), symbol("::")])
const expr_calls  = Dict(:call =>('(',')'), :ref =>('[',']'), :curly =>('{','}'))
const expr_parens = Dict(:tuple=>('(',')'), :vcat=>('[',']'), :cell1d=>('{','}'),
                     :hcat =>('[',']'), :row =>('[',']'))

## AST decoding helpers ##

is_id_start_char(c::Char) = ccall(:jl_id_start_char, Cint, (UInt32,), c) != 0
is_id_char(c::Char) = ccall(:jl_id_char, Cint, (UInt32,), c) != 0
function isidentifier(s::AbstractString)
    i = start(s)
    done(s, i) && return false
    (c, i) = next(s, i)
    is_id_start_char(c) || return false
    while !done(s, i)
        (c, i) = next(s, i)
        is_id_char(c) || return false
    end
    return true
end
isoperator(s::ByteString) = ccall(:jl_is_operator, Cint, (Ptr{UInt8},), s) != 0
isoperator(s::AbstractString) = isoperator(bytestring(s))

is_expr(ex, head::Symbol)         = (isa(ex, Expr) && (ex.head == head))
is_expr(ex, head::Symbol, n::Int) = is_expr(ex, head) && length(ex.args) == n

is_linenumber(ex::LineNumberNode) = true
is_linenumber(ex::Expr)           = is(ex.head, :line)
is_linenumber(ex)                 = false

is_quoted(ex)            = false
is_quoted(ex::QuoteNode) = true
is_quoted(ex::Expr)      = is_expr(ex, :quote, 1)

unquoted(ex::QuoteNode)  = ex.value
unquoted(ex::Expr)       = ex.args[1]

## AST printing helpers ##

const indent_width = 4

function show_expr_type(io::IO, ty)
    if !is(ty, Any)
        if is(ty, Function)
            print(io, "::F")
        elseif is(ty, IntrinsicFunction)
            print(io, "::I")
        else
            print(io, "::$ty")
        end
    end
end

show_linenumber(io::IO, line)       = print(io," # line ",line,':')
show_linenumber(io::IO, line, file) = print(io," # ",file,", line ",line,':')

# show a block, e g if/for/etc
function show_block(io::IO, head, args::Vector, body, indent::Int)
    print(io, head, ' ')
    show_list(io, args, ", ", indent)

    ind = is(head, :module) ? indent : indent + indent_width
    local exs
    if is_expr(body, :block) || is_expr(body, :body)
        if !isempty(body.args) && isa(body.args[1], Expr) && (body.args[1]::Expr).head == :boundscheck
            # Print as @inbounds ...
            exblock = copy(body.args[2])
            pop!(exblock.args)  # remove the Expr(:boundscheck, :(Base.pop))
            if (body.args[1]::Expr).args[1] == false
                print(io, '\n', " "^(indent+indent_width), "@inbounds ")
            end
            show_block(io, "begin", exblock, indent+indent_width)
            print(io, "end", '\n', " "^indent)
            return
        end
        exs = body.args
    else
        exs = Any[body]
    end
    for ex in exs
        if !is_linenumber(ex); print(io, '\n', " "^ind); end
        show_unquoted(io, ex, ind)
    end
    print(io, '\n', " "^indent)
end
show_block(io::IO,head,block,i::Int) = show_block(io,head,Any[],block,i)
function show_block(io::IO, head, arg, block, i::Int)
    if is_expr(arg, :block)
        show_block(io, head, arg.args, block, i)
    else
        show_block(io, head, Any[arg], block, i)
    end
end

# show an indented list
function show_list(io::IO, items, sep, indent::Int, prec::Int=0)
    n = length(items)
    if n == 0; return end
    indent += indent_width
    show_unquoted(io, items[1], indent, prec)
    for item in items[2:end]
        print(io, sep)
        show_unquoted(io, item, indent, prec)
    end
end
# show an indented list inside the parens (op, cl)
function show_enclosed_list(io::IO, op, items, sep, cl, indent, prec=0)
    print(io, op); show_list(io, items, sep, indent, prec); print(io, cl)
end

## AST printing ##

show_unquoted(io::IO, sym::Symbol, ::Int, ::Int)        = print(io, sym)
show_unquoted(io::IO, ex::LineNumberNode, ::Int, ::Int) = show_linenumber(io, ex.line)
show_unquoted(io::IO, ex::LabelNode, ::Int, ::Int)      = print(io, ex.label, ": ")
show_unquoted(io::IO, ex::GotoNode, ::Int, ::Int)       = print(io, "goto ", ex.label)
show_unquoted(io::IO, ex::TopNode, ::Int, ::Int)        = print(io,"top(",ex.name,')')

function show_unquoted(io::IO, ex::SymbolNode, ::Int, ::Int)
    print(io, ex.name)
    show_expr_type(io, ex.typ)
end

show_unquoted(io::IO, ex::QuoteNode, indent::Int, prec::Int) =
    show_unquoted_quote_expr(io, ex.value, indent, prec)

function show_unquoted_quote_expr(io::IO, value, indent::Int, prec::Int)
    if isa(value, Symbol) && !(value in quoted_syms)
        s = string(value)
        if (isidentifier(s) || isoperator(s)) && s != "end"
            print(io, ":")
            print(io, value)
        else
            print(io, "symbol(\"", escape_string(s), "\")")
        end
    else
        if isa(value,Expr) && value.head === :block
            show_block(io, "quote", value, indent)
            print(io, "end")
        else
            print(io, ":(")
            show_unquoted(io, value, indent+indent_width, 0)
            print(io, ")")
        end
    end
end

# TODO: implement interpolated strings
function show_unquoted(io::IO, ex::Expr, indent::Int, prec::Int)
    head, args, nargs = ex.head, ex.args, length(ex.args)

    # dot (i.e. "x.y")
    if is(head, :(.))
        show_unquoted(io, args[1], indent + indent_width)
        print(io, '.')
        if is_quoted(args[2])
            show_unquoted(io, unquoted(args[2]), indent + indent_width)
        else
            print(io, '(')
            show_unquoted(io, args[2], indent + indent_width)
            print(io, ')')
        end

    # infix (i.e. "x<:y" or "x = y")
    elseif (head in expr_infix && nargs==2) || (is(head,:(:)) && nargs==3)
        show_list(io, args, head, indent)
    elseif head in expr_infix_wide && nargs == 2
        func_prec = get(bin_op_precs, head, 0)
        if func_prec < prec
            show_enclosed_list(io, '(', args, " $head ", ')', indent, func_prec)
        else
            show_list(io, args, " $head ", indent, func_prec)
        end

    # list (i.e. "(1,2,3)" or "[1,2,3]")
    elseif haskey(expr_parens, head)               # :tuple/:vcat/:cell1d
        op, cl = expr_parens[head]
        if head === :vcat && !isempty(args) && is_expr(args[1], :row)
            sep = ";"
        elseif head === :hcat || head === :row
            sep = " "
        else
            sep = ","
        end
        head !== :row && print(io, op)
        show_list(io, args, sep, indent)
        if is(head, :tuple) && nargs == 1; print(io, ','); end
        head !== :row && print(io, cl)

    # function call
    elseif haskey(expr_calls, head) && nargs >= 1  # :call/:ref/:curly
        func = args[1]
        func_prec = get(bin_op_precs, func, 0)
        func_args = args[2:end]

        # scalar multiplication (i.e. "100x")
        if func == :(*) && length(func_args)==2 && isa(func_args[1], Real) && isa(func_args[2], Symbol)
            if func_prec <= prec
                show_enclosed_list(io, '(', func_args, "", ')', indent, func_prec)
            else
                show_list(io, func_args, "", indent, func_prec)
            end

        # unary operator (i.e. "!z")
        elseif func in uni_ops && length(func_args) == 1
            show_unquoted(io, func, indent)
            if isa(func_args[1], Expr) || length(func_args) > 1
                show_enclosed_list(io, '(', func_args, ",", ')', indent, func_prec)
            else
                show_unquoted(io, func_args[1])
            end

        # binary operator (i.e. "x + y")
        elseif func in bin_ops
            if length(func_args) > 1
                sep = func_prec >= bin_op_precs[:(^)] ? "$func" : " $func "
                if func_prec <= prec
                    show_enclosed_list(io, '(', func_args, sep, ')', indent, func_prec)
                else
                    show_list(io, func_args, sep, indent, func_prec)
                end
            else
                # 1-argument call to normally-binary operator
                op, cl = expr_calls[head]
                print(io, "(")
                show_unquoted(io, func, indent)
                print(io, ")")
                show_enclosed_list(io, op, func_args, ",", cl, indent)
            end

        # normal function (i.e. "f(x,y)")
        else
            op, cl = expr_calls[head]
            show_unquoted(io, func, indent)
            show_enclosed_list(io, op, func_args, ",", cl, indent)
        end
    elseif is(head, :ccall)
        show_unquoted(io, :ccall, indent)
        show_enclosed_list(io, '(', args, ",", ')', indent)

    # comparison (i.e. "x < y < z")
    elseif is(head, :comparison) && nargs >= 3 && (nargs&1==1)
        comp_prec = minimum([get(bin_op_precs, comp, 0) for comp=args[2:2:end]])
        if comp_prec <= prec
            show_enclosed_list(io, '(', args, " ", ')', indent, comp_prec)
        else
            show_list(io, args, " ", indent, comp_prec)
        end

    # block with argument
    elseif head in (:for,:while,:function,:if) && nargs==2
        show_block(io, head, args[1], args[2], indent); print(io, "end")

    elseif head == :module
        modulesym = args[2]
        args[1] ? println(io, "module ", string(args[2])) : println(io, "baremodule ", string(modulesym))
        modulebody = args[3]
        if length(modulebody.args) > 2
            # Skip the initial `eval(x) = top(Core).eval($modulesym,x)` and the scoped version
            ex1 = modulebody.args[1]
            if isa(ex1, Expr) && (ex1::Expr).head == :(=)
                ex2 = (ex1::Expr).args[1]
                if isa(ex2, Expr) && (ex2::Expr).head == :call && (ex2::Expr).args[1] == :eval
                    # Starts with `eval(x) = ...`, good enough
                    modulebody = copy(modulebody)
                    deleteat!(modulebody.args, (1,2))
                end
            end
        end
        show_unquoted(io, modulebody)
        println(io, "end")

    # type declaration
    elseif is(head, :type) && nargs==3
        show_block(io, args[1] ? :type : :immutable, args[2], args[3], indent)
        print(io, "end")

    # empty return (i.e. "function f() return end")
    elseif is(head, :return) && nargs == 1 && is(args[1], nothing)
        print(io, head)

    # type annotation (i.e. "::Int")
    elseif is(head, symbol("::")) && nargs == 1
        print(io, "::")
        show_unquoted(io, args[1], indent)

    # var-arg declaration or expansion
    # (i.e. "function f(L...) end" or "f(B...)")
    elseif is(head, :(...)) && nargs == 1
        show_unquoted(io, args[1], indent)
        print(io, "...")

    elseif (nargs == 1 && head in (:return, :abstract, :const)) ||
                          head in (:local,  :global)
        print(io, head, ' ')
        show_list(io, args, ", ", indent)
    elseif is(head, :macrocall) && nargs >= 1
        show_list(io, args, ' ', indent)
    elseif is(head, :typealias) && nargs == 2
        print(io, "typealias ")
        show_list(io, args, ' ', indent)
    elseif is(head, :line) && 1 <= nargs <= 2
        show_linenumber(io, args...)
    elseif is(head, :if) && nargs == 3           # if/else
        show_block(io, "if",   args[1], args[2], indent)
        show_block(io, "else", args[3], indent)
        print(io, "end")
    elseif is(head, :try) && 3 <= nargs <= 4
        show_block(io, "try", args[1], indent)
        if is_expr(args[3], :block)
            show_block(io, "catch", is(args[2], false) ? [] : args[2], args[3], indent)
        end
        if nargs >= 4 && is_expr(args[4], :block)
            show_block(io, "finally", [], args[4], indent)
        end
        print(io, "end")
    elseif is(head, :let) && nargs >= 1
        show_block(io, "let", args[2:end], args[1], indent); print(io, "end")
    elseif is(head, :block) || is(head, :body)
        show_block(io, "begin", ex, indent); print(io, "end")
    elseif is(head, :quote) && nargs == 1
        show_unquoted_quote_expr(io, args[1], indent, 0)
    elseif is(head, :gotoifnot) && nargs == 2
        print(io, "unless ")
        show_list(io, args, " goto ", indent)
    elseif is(head, :string) && nargs == 1 && isa(args[1], AbstractString)
        show(io, args[1])
    elseif is(head, :null)
        print(io, "nothing")
    elseif is(head, :kw) && length(args)==2
        show_unquoted(io, args[1], indent+indent_width)
        print(io, '=')
        show_unquoted(io, args[2], indent+indent_width)
    elseif is(head, :string)
        a = map(args) do x
            if !isa(x,AbstractString)
                if isa(x,Symbol) && !(x in quoted_syms)
                    string("\$", x)
                else
                    string("\$(", sprint(show_unquoted,x), ")")
                end
            else
                sprint(print_escaped, x, "\"\$")
            end
        end
        print(io, '"', a..., '"')

    elseif is(head, :&) && length(args) == 1
        print(io, '&')
        show_unquoted(io, args[1])

    # print anything else as "Expr(head, args...)"
    else
        print(io, "\$(Expr(")
        show(io, ex.head)
        for arg in args
            print(io, ", ")
            if isa(arg, ExprNode)
                show_unquoted(io, arg)
            else
                show(io, arg)
            end
        end
        print(io, "))")
    end

    show_expr_type(io, ex.typ)
end
end
