# This file is a part of Julia. License is MIT: http://julialang.org/license

module MPFR3

export
    BigFloat,
    setprecision,
    big_str

import
    Base: @big_str, *, +, -, /, <, <=, ==, >, >=, ^,
          besselj, besselj0, besselj1, bessely, bessely0, bessely1,
          ceil, cmp, convert, copysign, div, cbrt, typemax, typemin,
          unsafe_trunc, realmin, realmax, rounding,
          cosh, sinh, tanh, sech, csch, coth, acosh, asinh, atanh, atan2,
          eps, signbit, sin, cos, tan, sec, csc, cot, acos, asin, atan,
          exp, exp2, exponent, factorial, floor, fma, hypot, isinteger,
          gamma, lgamma, digamma, erf, erfc, zeta, eta, airyai,
          isfinite, isinf, isnan, ldexp, log, log2, log10, log1p, exp10, expm1,
          max, min, mod, modf, nextfloat, prevfloat, promote_rule, rem, round,
          show, setrounding, maxintfloat, widen, significand, frexp, tryparse,
          sum, sqrt, string, print, trunc, precision, setprecision

import Base.Rounding: rounding_raw, setrounding_raw

import Base.GMP: ClongMax, CulongMax, CdoubleMax, Limb

import Base.Math.lgamma_r

function __init__()
    try
        # set exponent to full range by default
        set_emin!(get_emin_min())
        set_emax!(get_emax_max())
    catch ex
        Base.showerror_nostdio(ex,
            "WARNING: Error during initialization of module MPFR")
    end
end

const ROUNDING_MODE = Ref{Cint}(0)
const DEFAULT_PRECISION = [256]

# Basic type and initialization definitions

type BigFloat{P} <: AbstractFloat
    prec::Clong
    sign::Cint
    exp::Clong
    d::Ptr{Limb}
    function BigFloat()
    N = Clong(P)
    z = BigFloat{P}(zero(Clong), zero(Cint), zero(Clong), C_NULL)
    ccall((:mpfr_init2,:libmpfr), Void, (Ptr{BigFloat}, Clong), &z, N)
    finalizer(z, cglobal((:mpfr_clear, :libmpfr)))
    return z
    end
    # Not recommended for general use
    function BigFloat(prec::Clong, sign::Cint, exp::Clong, d::Ptr{Void})
        new(prec, sign, exp, d)
    end
end

precision{P}(::Type{BigFloat{P}}) = P
precision{P}(x::BigFloat{P}) = P

function initializer{P}(::Type{BigFloat{P}})
    N = Clong(P)
    z = BigFloat{P}(zero(Clong), zero(Cint), zero(Clong), C_NULL)
    ccall((:mpfr_init2,:libmpfr), Void, (Ptr{BigFloat}, Clong), &z, N)
    finalizer(z, cglobal((:mpfr_clear, :libmpfr)))
    return z
end
initializer(::Type{BigFloat}) = initializer(BigFloat{precision(BigFloat)})

BigFloat{P}(::Type{BigFloat{P}}) = initializer(BigFloat{P})
BigFloat() = initializer(BigFloat)
function BigFloat(prec::Int64, sign::Int32, exp::Int64, d::Ptr{Void})
    P = Int(prec)
    return BigFloat{P}(prec, sign, exp, d)
end

widen(::Type{Float64}) = BigFloat
widen(::Type{BigFloat}) = BigFloat

convert{BF<:BigFloat}(::Type{BF}, x::BF) = x

# convert to BF
for (fJ, fC) in ((:si,:Clong), (:ui,:Culong), (:d,:Float64))
    @eval begin
        function convert{BF<:BigFloat}(::Type{BF}, x::($fC))
            z = BF()
            ccall(($(string(:mpfr_set_,fJ)), :libmpfr), Int32, (Ptr{BF}, ($fC), Int32), &z, x, ROUNDING_MODE[])
            return z
        end
    end
end

function convert{BF<:BigFloat}(::Type{BF}, x::BigInt)
    z = BF()
    ccall((:mpfr_set_z, :libmpfr), Int32, (Ptr{BF}, Ptr{BigInt}, Int32), &z, &x, ROUNDING_MODE[])
    return z
end

convert{BF<:BigFloat}(::Type{BF}, x::Integer) = BF(BigInt(x))

convert{BF<:BigFloat}(::Type{BF}, x::Union{Bool,Int8,Int16,Int32}) = BF(convert(Clong,x))
convert{BF<:BigFloat}(::Type{BF}, x::Union{UInt8,UInt16,UInt32}) = BF(convert(Culong,x))

convert{BF<:BigFloat}(::Type{BF}, x::Union{Float16,Float32}) = BF(Float64(x))
convert{BF<:BigFloat}(::Type{BF}, x::Rational) = BF(num(x)) / BF(den(x))

function tryparse{BF<:BigFloat}(::Type{BF}, s::AbstractString, base::Int=0)
    z = BF()
    err = ccall((:mpfr_set_str, :libmpfr), Int32, (Ptr{BF}, Cstring, Int32, Int32), &z, s, base, ROUNDING_MODE[])
    err == 0 ? Nullable(z) : Nullable{BF}()
end

convert{BF<:BigFloat}(::Type{Rational}, x::BF) = convert(Rational{BigInt}, x)
convert(::Type{AbstractFloat}, x::BigInt) = BigFloat(x)

## BF -> Integer
function unsafe_cast{BF<:BigFloat}(::Type{Int64}, x::BF, ri::Cint)
    ccall((:__gmpfr_mpfr_get_sj,:libmpfr), Cintmax_t,
          (Ptr{BF}, Cint), &x, ri)
end
function unsafe_cast{BF<:BigFloat}(::Type{UInt64}, x::BF, ri::Cint)
    ccall((:__gmpfr_mpfr_get_uj,:libmpfr), Cuintmax_t,
          (Ptr{BF}, Cint), &x, ri)
end

function unsafe_cast{T<:Signed,BF<:BigFloat}(::Type{T}, x::BF, ri::Cint)
    unsafe_cast(Int64, x, ri) % T
end
function unsafe_cast{T<:Unsigned,BF<:BigFloat}(::Type{T}, x::BF, ri::Cint)
    unsafe_cast(UInt64, x, ri) % T
end

function unsafe_cast{BF<:BigFloat}(::Type{BigInt}, x::BF, ri::Cint)
    # actually safe, just keep naming consistent
    z = BigInt()
    ccall((:mpfr_get_z, :libmpfr), Int32, (Ptr{BigInt}, Ptr{BF}, Int32),
          &z, &x, ri)
    z
end
unsafe_cast{BF<:BigFloat}(::Type{Int128}, x::BF, ri::Cint) = Int128(unsafe_cast(BigInt,x,ri))
unsafe_cast{BF<:BigFloat}(::Type{UInt128}, x::BF, ri::Cint) = UInt128(unsafe_cast(BigInt,x,ri))
unsafe_cast{T<:Integer,BF<:BigFloat}(::Type{T}, x::BF, r::RoundingMode) = unsafe_cast(T,x,to_mpfr(r))

unsafe_trunc{T<:Integer,BF<:BigFloat}(::Type{T}, x::BF) = unsafe_cast(T,x,RoundToZero)

function trunc{T<:Union{Signed,Unsigned},BF<:BigFloat}(::Type{T}, x::BF)
    (typemin(T) <= x <= typemax(T)) || throw(InexactError())
    unsafe_cast(T,x,RoundToZero)
end
function floor{T<:Union{Signed,Unsigned},BF<:BigFloat}(::Type{T}, x::BF)
    (typemin(T) <= x <= typemax(T)) || throw(InexactError())
    unsafe_cast(T,x,RoundDown)
end
function ceil{T<:Union{Signed,Unsigned},BF<:BigFloat}(::Type{T}, x::BF)
    (typemin(T) <= x <= typemax(T)) || throw(InexactError())
    unsafe_cast(T,x,RoundUp)
end

function round{T<:Union{Signed,Unsigned},BF<:BigFloat}(::Type{T}, x::BF)
    (typemin(T) <= x <= typemax(T)) || throw(InexactError())
    unsafe_cast(T,x,ROUNDING_MODE[])
end

trunc{BF<:BigFloat}(::Type{BigInt}, x::BF) = unsafe_cast(BigInt, x, RoundToZero)
floor{BF<:BigFloat}(::Type{BigInt}, x::BF) = unsafe_cast(BigInt, x, RoundDown)
ceil{BF<:BigFloat}(::Type{BigInt}, x::BF) = unsafe_cast(BigInt, x, RoundUp)
round{BF<:BigFloat}(::Type{BigInt}, x::BF) = unsafe_cast(BigInt, x, ROUNDING_MODE[])

# convert/round/trunc/floor/ceil(Integer, x) should return a BigInt
trunc{BF<:BigFloat}(::Type{Integer}, x::BF) = trunc(BigInt, x)
floor{BF<:BigFloat}(::Type{Integer}, x::BF) = floor(BigInt, x)
ceil{BF<:BigFloat}(::Type{Integer}, x::BF) = ceil(BigInt, x)
round{BF<:BigFloat}(::Type{Integer}, x::BF) = round(BigInt, x)

convert{BF<:BigFloat}(::Type{Bool}, x::BF) = x==0 ? false : x==1 ? true : throw(InexactError())
function convert{BF<:BigFloat}(::Type{BigInt},x::BF)
    isinteger(x) || throw(InexactError())
    trunc(BigInt,x)
end

function convert{T<:Integer,BF<:BigFloat}(::Type{T},x::BF)
    isinteger(x) || throw(InexactError())
    trunc(T,x)
end

## BF -> AbstractFloat
convert{BF<:BigFloat}(::Type{Float64}, x::BF) =
    ccall((:mpfr_get_d,:libmpfr), Float64, (Ptr{BF},Int32), &x, ROUNDING_MODE[])
convert{BF<:BigFloat}(::Type{Float32}, x::BF) =
    ccall((:mpfr_get_flt,:libmpfr), Float32, (Ptr{BF},Int32), &x, ROUNDING_MODE[])
# TODO: avoid double rounding
convert{BF<:BigFloat}(::Type{Float16}, x::BF) = convert(Float16, convert(Float32, x))

(::Type{Float64}){BF<:BigFloat}(x::BF, r::RoundingMode) =
    ccall((:mpfr_get_d,:libmpfr), Float64, (Ptr{BF},Int32), &x, to_mpfr(r))
(::Type{Float32}){BF<:BigFloat}(x::BF, r::RoundingMode) =
    ccall((:mpfr_get_flt,:libmpfr), Float32, (Ptr{BF},Int32), &x, to_mpfr(r))
# TODO: avoid double rounding
(::Type{Float16}){BF<:BigFloat}(x::BF, r::RoundingMode) =
    convert(Float16, Float32(x, r))

promote_rule(::Type{BigInt},::Type{BigFloat}) = BigFloat
promote_rule{T<:Real}(::Type{BigFloat}, ::Type{T}) = BigFloat
promote_rule{T<:AbstractFloat}(::Type{BigInt},::Type{T}) = BigFloat
promote_rule{T<:AbstractFloat}(::Type{BigFloat},::Type{T}) = BigFloat

promote_rule{P}(::Type{BigInt},::Type{BigFloat{P}}) = BigFloat{P}
promote_rule{BF<:BigFloat}(::Type{BigInt},::Type{BF}) = BF
promote_rule{T<:Real,BF<:BigFloat}(::Type{BF}, ::Type{T}) = BF
promote_rule{T<:AbstractFloat,BF<:BigFloat}(::Type{BF},::Type{T}) = BF

function convert(::Type{Rational{BigInt}}, x::AbstractFloat)
    if isnan(x); return zero(BigInt)//zero(BigInt); end
    if isinf(x); return copysign(one(BigInt),x)//zero(BigInt); end
    if x == 0;   return zero(BigInt) // one(BigInt); end
    s = max(precision(x) - exponent(x), 0)
    BigInt(ldexp(x,s)) // (BigInt(1) << s)
end

# Basic arithmetic without promotion
for (fJ, fC) in ((:+,:add), (:*,:mul))
    @eval begin
        # BF
        function ($fJ){BF<:BigFloat}(x::BF, y::BF)
            z = BF()
            ccall(($(string(:mpfr_,fC)),:libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &x, &y, ROUNDING_MODE[])
            return z
        end

        # Unsigned Integer
        function ($fJ){BF<:BigFloat}(x::BF, c::CulongMax)
            z = BF()
            ccall(($(string(:mpfr_,fC,:_ui)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Culong, Int32), &z, &x, c, ROUNDING_MODE[])
            return z
        end
        ($fJ){BF<:BigFloat}(c::CulongMax, x::BF) = ($fJ)(x,c)

        # Signed Integer
        function ($fJ){BF<:BigFloat}(x::BF, c::ClongMax)
            z = BF()
            ccall(($(string(:mpfr_,fC,:_si)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Clong, Int32), &z, &x, c, ROUNDING_MODE[])
            return z
        end
        ($fJ){BF<:BigFloat}(c::ClongMax, x::BF) = ($fJ)(x,c)

        # Float32/Float64
        function ($fJ){BF<:BigFloat}(x::BF, c::CdoubleMax)
            z = BF()
            ccall(($(string(:mpfr_,fC,:_d)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Cdouble, Int32), &z, &x, c, ROUNDING_MODE[])
            return z
        end
        ($fJ){BF<:BigFloat}(c::CdoubleMax, x::BF) = ($fJ)(x,c)

        # BigInt
        function ($fJ){BF<:BigFloat}(x::BF, c::BigInt)
            z = BF()
            ccall(($(string(:mpfr_,fC,:_z)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BigInt}, Int32), &z, &x, &c, ROUNDING_MODE[])
            return z
        end
        ($fJ){BF<:BigFloat}(c::BigInt, x::BF) = ($fJ)(x,c)
    end
end

for (fJ, fC) in ((:-,:sub), (:/,:div))
    @eval begin
        # BF
        function ($fJ){BF<:BigFloat}(x::BF, y::BF)
            z = BF()
            ccall(($(string(:mpfr_,fC)),:libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &x, &y, ROUNDING_MODE[])
            return z
        end

        # Unsigned Int
        function ($fJ){BF<:BigFloat}(x::BF, c::CulongMax)
            z = BF()
            ccall(($(string(:mpfr_,fC,:_ui)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Culong, Int32), &z, &x, c, ROUNDING_MODE[])
            return z
        end
        function ($fJ){BF<:BigFloat}(c::CulongMax, x::BF)
            z = BF()
            ccall(($(string(:mpfr_,:ui_,fC)), :libmpfr), Int32, (Ptr{BF}, Culong, Ptr{BF}, Int32), &z, c, &x, ROUNDING_MODE[])
            return z
        end

        # Signed Integer
        function ($fJ){BF<:BigFloat}(x::BF, c::ClongMax)
            z = BF()
            ccall(($(string(:mpfr_,fC,:_si)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Clong, Int32), &z, &x, c, ROUNDING_MODE[])
            return z
        end
        function ($fJ){BF<:BigFloat}(c::ClongMax, x::BF)
            z = BF()
            ccall(($(string(:mpfr_,:si_,fC)), :libmpfr), Int32, (Ptr{BF}, Clong, Ptr{BF}, Int32), &z, c, &x, ROUNDING_MODE[])
            return z
        end

        # Float32/Float64
        function ($fJ){BF<:BigFloat}(x::BF, c::CdoubleMax)
            z = BF()
            ccall(($(string(:mpfr_,fC,:_d)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Cdouble, Int32), &z, &x, c, ROUNDING_MODE[])
            return z
        end
        function ($fJ){BF<:BigFloat}(c::CdoubleMax, x::BF)
            z = BF()
            ccall(($(string(:mpfr_,:d_,fC)), :libmpfr), Int32, (Ptr{BF}, Cdouble, Ptr{BF}, Int32), &z, c, &x, ROUNDING_MODE[])
            return z
        end

        # BigInt
        function ($fJ){BF<:BigFloat}(x::BF, c::BigInt)
            z = BF()
            ccall(($(string(:mpfr_,fC,:_z)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BigInt}, Int32), &z, &x, &c, ROUNDING_MODE[])
            return z
        end
        # no :mpfr_z_div function
    end
end

function -{BF<:BigFloat}(c::BigInt, x::BF)
    z = BF()
    ccall((:mpfr_z_sub, :libmpfr), Int32, (Ptr{BF}, Ptr{BigInt}, Ptr{BF}, Int32), &z, &c, &x, ROUNDING_MODE[])
    return z
end

function fma{BF<:BigFloat}(x::BF, y::BF, z::BF)
    r = BF()
    ccall(("mpfr_fma",:libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &r, &x, &y, &z, ROUNDING_MODE[])
    return r
end

# div
# BF
function div{BF<:BigFloat}(x::BF, y::BF)
    z = BF()
    ccall((:mpfr_div,:libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &x, &y, to_mpfr(RoundToZero))
    ccall((:mpfr_trunc, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &z, &z)
    return z
end

# Unsigned Int
function div{BF<:BigFloat}(x::BF, c::CulongMax)
    z = BF()
    ccall((:mpfr_div_ui, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Culong, Int32), &z, &x, c, to_mpfr(RoundToZero))
    ccall((:mpfr_trunc, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &z, &z)
    return z
end
function div{BF<:BigFloat}(c::CulongMax, x::BF)
    z = BF()
    ccall((:mpfr_ui_div, :libmpfr), Int32, (Ptr{BF}, Culong, Ptr{BF}, Int32), &z, c, &x, to_mpfr(RoundToZero))
    ccall((:mpfr_trunc, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &z, &z)
    return z
end

# Signed Integer
function div{BF<:BigFloat}(x::BF, c::ClongMax)
    z = BF()
    ccall((:mpfr_div_si, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Clong, Int32), &z, &x, c, to_mpfr(RoundToZero))
    ccall((:mpfr_trunc, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &z, &z)
    return z
end
function div{BF<:BigFloat}(c::ClongMax, x::BF)
    z = BF()
    ccall((:mpfr_si_div, :libmpfr), Int32, (Ptr{BF}, Clong, Ptr{BF}, Int32), &z, c, &x, to_mpfr(RoundToZero))
    ccall((:mpfr_trunc, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &z, &z)
    return z
end

# Float32/Float64
function div{BF<:BigFloat}(x::BF, c::CdoubleMax)
    z = BF()
    ccall((:mpfr_div_d, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Cdouble, Int32), &z, &x, c, to_mpfr(RoundToZero))
    ccall((:mpfr_trunc, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &z, &z)
    return z
end
function div{BF<:BigFloat}(c::CdoubleMax, x::BF)
    z = BF()
    ccall((:mpfr_d_div, :libmpfr), Int32, (Ptr{BF}, Cdouble, Ptr{BF}, Int32), &z, c, &x, to_mpfr(RoundToZero))
    ccall((:mpfr_trunc, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &z, &z)
    return z
end

# BigInt
function div{BF<:BigFloat}(x::BF, c::BigInt)
    z = BF()
    ccall((:mpfr_div_z, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BigInt}, Int32), &z, &x, &c, to_mpfr(RoundToZero))
    ccall((:mpfr_trunc, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &z, &z)
    return z
end

# More efficient commutative operations
for (fJ, fC, fI) in ((:+, :add, 0), (:*, :mul, 1))
    @eval begin
        function ($fJ){BF<:BigFloat}(a::BF, b::BF, c::BF)
            z = BF()
            ccall(($(string(:mpfr_,fC)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &a, &b, ROUNDING_MODE[])
            ccall(($(string(:mpfr_,fC)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &z, &c, ROUNDING_MODE[])
            return z
        end
        function ($fJ){BF<:BigFloat}(a::BF, b::BF, c::BF, d::BF)
            z = BF()
            ccall(($(string(:mpfr_,fC)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &a, &b, ROUNDING_MODE[])
            ccall(($(string(:mpfr_,fC)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &z, &c, ROUNDING_MODE[])
            ccall(($(string(:mpfr_,fC)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &z, &d, ROUNDING_MODE[])
            return z
        end
        function ($fJ){BF<:BigFloat}(a::BF, b::BF, c::BF, d::BF, e::BF)
            z = BF()
            ccall(($(string(:mpfr_,fC)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &a, &b, ROUNDING_MODE[])
            ccall(($(string(:mpfr_,fC)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &z, &c, ROUNDING_MODE[])
            ccall(($(string(:mpfr_,fC)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &z, &d, ROUNDING_MODE[])
            ccall(($(string(:mpfr_,fC)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &z, &e, ROUNDING_MODE[])
            return z
        end
    end
end

function -{BF<:BigFloat}(x::BF)
    z = BF()
    ccall((:mpfr_neg, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Int32), &z, &x, ROUNDING_MODE[])
    return z
end

function sqrt{BF<:BigFloat}(x::BF)
    isnan(x) && return x
    z = BF()
    ccall((:mpfr_sqrt, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Int32), &z, &x, ROUNDING_MODE[])
    if isnan(z)
        throw(DomainError())
    end
    return z
end

sqrt(x::BigInt) = sqrt(BF(x))

function ^{BF<:BigFloat}(x::BF, y::BF)
    z = BF()
    ccall((:mpfr_pow, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &x, &y, ROUNDING_MODE[])
    return z
end

function ^{BF<:BigFloat}(x::BF, y::CulongMax)
    z = BF()
    ccall((:mpfr_pow_ui, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Culong, Int32), &z, &x, y, ROUNDING_MODE[])
    return z
end

function ^{BF<:BigFloat}(x::BF, y::ClongMax)
    z = BF()
    ccall((:mpfr_pow_si, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Clong, Int32), &z, &x, y, ROUNDING_MODE[])
    return z
end

function ^{BF<:BigFloat}(x::BF, y::BigInt)
    z = BF()
    ccall((:mpfr_pow_z, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BigInt}, Int32), &z, &x, &y, ROUNDING_MODE[])
    return z
end

^{BF<:BigFloat}(x::BF, y::Integer)  = typemin(Clong)  <= y <= typemax(Clong)  ? x^Clong(y)  : x^BigInt(y)
^{BF<:BigFloat}(x::BF, y::Unsigned) = typemin(Culong) <= y <= typemax(Culong) ? x^Culong(y) : x^BigInt(y)

for f in (:exp, :exp2, :exp10, :expm1, :digamma, :erf, :erfc, :zeta,
          :cosh,:sinh,:tanh,:sech,:csch,:coth, :cbrt)
    @eval function $f{BF<:BigFloat}(x::BF)
        z = BF()
        ccall(($(string(:mpfr_,f)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Int32), &z, &x, ROUNDING_MODE[])
        return z
    end
end

# return log(2)
function big_ln2()
    c = BF()
    ccall((:mpfr_const_log2, :libmpfr), Cint, (Ptr{BF}, Int32),
          &c, MPFR.ROUNDING_MODE[])
    return c
end

function eta{BF<:BigFloat}(x::BF)
    x == 1 && return big_ln2()
    return -zeta(x) * expm1(big_ln2()*(1-x))
end

function airyai{BF<:BigFloat}(x::BF)
    z = BF()
    ccall((:mpfr_ai, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Int32), &z, &x, ROUNDING_MODE[])
    return z
end
airy{BF<:BigFloat}(x::BF) = airyai(x)

function ldexp{BF<:BigFloat}(x::BF, n::Clong)
    z = BF()
    ccall((:mpfr_mul_2si, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Clong, Int32), &z, &x, n, ROUNDING_MODE[])
    return z
end
function ldexp{BF<:BigFloat}(x::BF, n::Culong)
    z = BF()
    ccall((:mpfr_mul_2ui, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Culong, Int32), &z, &x, n, ROUNDING_MODE[])
    return z
end
ldexp{BF<:BigFloat}(x::BF, n::ClongMax) = ldexp(x, convert(Clong, n))
ldexp{BF<:BigFloat}(x::BF, n::CulongMax) = ldexp(x, convert(Culong, n))
ldexp{BF<:BigFloat}(x::BF, n::Integer) = x*exp2(BF(n))

function besselj0{BF<:BigFloat}(x::BF)
    z = BF()
    ccall((:mpfr_j0, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Int32), &z, &x, ROUNDING_MODE[])
    return z
end

function besselj1{BF<:BigFloat}(x::BF)
    z = BF()
    ccall((:mpfr_j1, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Int32), &z, &x, ROUNDING_MODE[])
    return z
end

function besselj{BF<:BigFloat}(n::Integer, x::BF)
    z = BF()
    ccall((:mpfr_jn, :libmpfr), Int32, (Ptr{BF}, Clong, Ptr{BF}, Int32), &z, n, &x, ROUNDING_MODE[])
    return z
end

function bessely0{BF<:BigFloat}(x::BF)
    if x < 0
        throw(DomainError())
    end
    z = BF()
    ccall((:mpfr_y0, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Int32), &z, &x, ROUNDING_MODE[])
    return z
end

function bessely1{BF<:BigFloat}(x::BF)
    if x < 0
        throw(DomainError())
    end
    z = BF()
    ccall((:mpfr_y1, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Int32), &z, &x, ROUNDING_MODE[])
    return z
end

function bessely{BF<:BigFloat}(n::Integer, x::BF)
    if x < 0
        throw(DomainError())
    end
    z = BF()
    ccall((:mpfr_yn, :libmpfr), Int32, (Ptr{BF}, Clong, Ptr{BF}, Int32), &z, n, &x, ROUNDING_MODE[])
    return z
end

function factorial{BF<:BigFloat}(x::BF)
    if x < 0 || !isinteger(x)
        throw(DomainError())
    end
    ui = convert(Culong, x)
    z = BF()
    ccall((:mpfr_fac_ui, :libmpfr), Int32, (Ptr{BF}, Culong, Int32), &z, ui, ROUNDING_MODE[])
    return z
end

function hypot{BF<:BigFloat}(x::BF, y::BF)
    z = BF()
    ccall((:mpfr_hypot, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &x, &y, ROUNDING_MODE[])
    return z
end

for f in (:log, :log2, :log10)
    @eval function $f{BF<:BigFloat}(x::BF)
        if x < 0
            throw(DomainError())
        end
        z = BF()
        ccall(($(string(:mpfr_,f)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Int32), &z, &x, ROUNDING_MODE[])
        return z
    end
end

function log1p{BF<:BigFloat}(x::BF)
    if x < -1
        throw(DomainError())
    end
    z = BF()
    ccall((:mpfr_log1p, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Int32), &z, &x, ROUNDING_MODE[])
    return z
end

function max{BF<:BigFloat}(x::BF, y::BF)
    z = BF()
    ccall((:mpfr_max, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &x, &y, ROUNDING_MODE[])
    return z
end

function min{BF<:BigFloat}(x::BF, y::BF)
    z = BF()
    ccall((:mpfr_min, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &x, &y, ROUNDING_MODE[])
    return z
end

function modf{BF<:BigFloat}(x::BF)
    if isinf(x)
        return (BF(NaN), x)
    end
    zint = BF()
    zfloat = BF()
    ccall((:mpfr_modf, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &zint, &zfloat, &x, ROUNDING_MODE[])
    return (zfloat, zint)
end

function rem{BF<:BigFloat}(x::BF, y::BF)
    z = BF()
    ccall((:mpfr_fmod, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &x, &y, ROUNDING_MODE[])
    return z
end

function sum{BF<:BigFloat}(arr::AbstractArray{BF})
    z = BF(0)
    for i in arr
        ccall((:mpfr_add, :libmpfr), Int32,
            (Ptr{BF}, Ptr{BF}, Ptr{BF}, Cint),
            &z, &z, &i, 0)
    end
    return z
end

# Functions for which NaN results are converted to DomainError, following Base
for f in (:sin,:cos,:tan,:sec,:csc,
          :acos,:asin,:atan,:acosh,:asinh,:atanh, :gamma)
    @eval begin
        function ($f){BF<:BigFloat}(x::BF)
            if isnan(x)
                return x
            end
            z = BF()
            ccall(($(string(:mpfr_,f)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Int32), &z, &x, ROUNDING_MODE[])
            if isnan(z)
                throw(DomainError())
            end
            return z
        end
    end
end

# log of absolute value of gamma function
const lgamma_signp = Array{Cint}(1)
function lgamma{BF<:BigFloat}(x::BF)
    z = BF()
    ccall((:mpfr_lgamma,:libmpfr), Cint, (Ptr{BF}, Ptr{Cint}, Ptr{BF}, Int32), &z, lgamma_signp, &x, ROUNDING_MODE[])
    return z
end

lgamma_r{BF<:BigFloat}(x::BF) = (lgamma(x), lgamma_signp[1])

function atan2{BF<:BigFloat}(y::BF, x::BF)
    z = BF()
    ccall((:mpfr_atan2, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &y, &x, ROUNDING_MODE[])
    return z
end

# Utility functions
=={BF<:BigFloat}(x::BF, y::BF) = ccall((:mpfr_equal_p, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &x, &y) != 0
<={BF<:BigFloat}(x::BF, y::BF) = ccall((:mpfr_lessequal_p, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &x, &y) != 0
>={BF<:BigFloat}(x::BF, y::BF) = ccall((:mpfr_greaterequal_p, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &x, &y) != 0
<{BF<:BigFloat}(x::BF, y::BF) = ccall((:mpfr_less_p, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &x, &y) != 0
>{BF<:BigFloat}(x::BF, y::BF) = ccall((:mpfr_greater_p, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &x, &y) != 0

function cmp{BF<:BigFloat}(x::BF, y::BigInt)
    isnan(x) && throw(DomainError())
    ccall((:mpfr_cmp_z, :libmpfr), Int32, (Ptr{BF}, Ptr{BigInt}), &x, &y)
end
function cmp{BF<:BigFloat}(x::BF, y::ClongMax)
    isnan(x) && throw(DomainError())
    ccall((:mpfr_cmp_si, :libmpfr), Int32, (Ptr{BF}, Clong), &x, y)
end
function cmp{BF<:BigFloat}(x::BF, y::CulongMax)
    isnan(x) && throw(DomainError())
    ccall((:mpfr_cmp_ui, :libmpfr), Int32, (Ptr{BF}, Culong), &x, y)
end
cmp{BF<:BigFloat}(x::BF, y::Integer) = cmp(x,big(y))
cmp{BF<:BigFloat}(x::Integer, y::BF) = -cmp(y,x)

function cmp{BF<:BigFloat}(x::BF, y::CdoubleMax)
    (isnan(x) || isnan(y)) && throw(DomainError())
    ccall((:mpfr_cmp_d, :libmpfr), Int32, (Ptr{BF}, Cdouble), &x, y)
end
cmp{BF<:BigFloat}(x::CdoubleMax, y::BF) = -cmp(y,x)

=={BF<:BigFloat}(x::BF, y::Integer)   = !isnan(x) && cmp(x,y) == 0
=={BF<:BigFloat}(x::Integer, y::BF)   = y == x
=={BF<:BigFloat}(x::BF, y::CdoubleMax) = !isnan(x) && !isnan(y) && cmp(x,y) == 0
=={BF<:BigFloat}(x::CdoubleMax, y::BF) = y == x

<{BF<:BigFloat}(x::BF, y::Integer)   = !isnan(x) && cmp(x,y) < 0
<{BF<:BigFloat}(x::Integer, y::BF)   = !isnan(y) && cmp(y,x) > 0
<{BF<:BigFloat}(x::BF, y::CdoubleMax) = !isnan(x) && !isnan(y) && cmp(x,y) < 0
<{BF<:BigFloat}(x::CdoubleMax, y::BF) = !isnan(x) && !isnan(y) && cmp(y,x) > 0

<={BF<:BigFloat}(x::BF, y::Integer)   = !isnan(x) && cmp(x,y) <= 0
<={BF<:BigFloat}(x::Integer, y::BF)   = !isnan(y) && cmp(y,x) >= 0
<={BF<:BigFloat}(x::BF, y::CdoubleMax) = !isnan(x) && !isnan(y) && cmp(x,y) <= 0
<={BF<:BigFloat}(x::CdoubleMax, y::BF) = !isnan(x) && !isnan(y) && cmp(y,x) >= 0

signbit{BF<:BigFloat}(x::BF) = ccall((:mpfr_signbit, :libmpfr), Int32, (Ptr{BF},), &x) != 0

function precision{BF<:BigFloat}(x::BF)  # precision of an object of type BF
    return ccall((:mpfr_get_prec, :libmpfr), Clong, (Ptr{BF},), &x)
end

precision{BF<:BigFloat}(::Type{BF}) = DEFAULT_PRECISION[end]  # precision of the type BF itself

"""
    setprecision([T=BF,] precision::Int)

Set the precision (in bits) to be used for `T` arithmetic.
"""
function setprecision(::Type{BigFloat}, precision::Int)
    if precision < 2
        throw(DomainError())
    end
    DEFAULT_PRECISION[end] = precision
end

setprecision(precision::Int) = setprecision(BigFloat, precision)

maxintfloat{BF<:BigFloat}(x::BF) = BF(2)^precision(x)
maxintfloat{BF<:BigFloat}(::Type{BF}) = BF(2)^precision(BF)

to_mpfr(::RoundingMode{:Nearest}) = Cint(0)
to_mpfr(::RoundingMode{:ToZero}) = Cint(1)
to_mpfr(::RoundingMode{:Up}) = Cint(2)
to_mpfr(::RoundingMode{:Down}) = Cint(3)
to_mpfr(::RoundingMode{:FromZero}) = Cint(4)

function from_mpfr(c::Integer)
    if c == 0
        return RoundNearest
    elseif c == 1
        return RoundToZero
    elseif c == 2
        return RoundUp
    elseif c == 3
        return RoundDown
    elseif c == 4
        return RoundFromZero
    else
        throw(ArgumentError("invalid MPFR rounding mode code: $c"))
    end
    RoundingMode(c)
end

rounding_raw{BF<:BigFloat}(::Type{BF}) = ROUNDING_MODE[]
setrounding_raw{BF<:BigFloat}(::Type{BF},i::Integer) = ROUNDING_MODE[] = i

rounding{BF<:BigFloat}(::Type{BF}) = from_mpfr(rounding_raw(BF))
setrounding{BF<:BigFloat}(::Type{BF},r::RoundingMode) = setrounding_raw(BF,to_mpfr(r))

function copysign{BF<:BigFloat}(x::BF, y::BF)
    z = BF()
    ccall((:mpfr_copysign, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Ptr{BF}, Int32), &z, &x, &y, ROUNDING_MODE[])
    return z
end

function exponent{BF<:BigFloat}(x::BF)
    if x == 0 || !isfinite(x)
        throw(DomainError())
    end
    # The '- 1' is to make it work as Base.exponent
    return ccall((:mpfr_get_exp, :libmpfr), Clong, (Ptr{BF},), &x) - 1
end

function frexp{BF<:BigFloat}(x::BF)
    z = BF()
    c = Ref{Clong}()
    ccall((:mpfr_frexp, :libmpfr), Int32, (Ptr{Clong}, Ptr{BF}, Ptr{BF}, Cint), c, &z, &x, ROUNDING_MODE[])
    return (z, c[])
end

function significand{BF<:BigFloat}(x::BF)
    z = BF()
    c = Ref{Clong}()
    ccall((:mpfr_frexp, :libmpfr), Int32, (Ptr{Clong}, Ptr{BF}, Ptr{BF}, Cint), c, &z, &x, ROUNDING_MODE[])
    # Double the significand to make it work as Base.significand
    ccall((:mpfr_mul_si, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Clong, Int32), &z, &z, 2, ROUNDING_MODE[])
    return z
end

function isinteger{BF<:BigFloat}(x::BF)
    return ccall((:mpfr_integer_p, :libmpfr), Int32, (Ptr{BF},), &x) != 0
end

for f in (:ceil, :floor, :trunc)
    @eval begin
        function ($f){BF<:BigFloat}(x::BF)
            z = BF()
            ccall(($(string(:mpfr_,f)), :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &z, &x)
            return z
        end
    end
end

function round{BF<:BigFloat}(x::BF)
    z = BF()
    ccall((:mpfr_rint, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Cint), &z, &x, ROUNDING_MODE[])
    return z
end
function round{BF<:BigFloat}(x::BF,::RoundingMode{:NearestTiesAway})
    z = BF()
    ccall((:mpfr_round, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}), &z, &x)
    return z
end

function isinf{BF<:BigFloat}(x::BF)
    return ccall((:mpfr_inf_p, :libmpfr), Int32, (Ptr{BF},), &x) != 0
end

function isnan{BF<:BigFloat}(x::BF)
    return ccall((:mpfr_nan_p, :libmpfr), Int32, (Ptr{BF},), &x) != 0
end

isfinite{BF<:BigFloat}(x::BF) = !isinf(x) && !isnan(x)

@eval typemax(::Type{BigFloat}) = $(BigFloat( Inf))
@eval typemin(::Type{BigFloat}) = $(BigFloat(-Inf))
typemax{BF<:BigFloat}(::Type{BF}) = BF( Inf)
typemin{BF<:BigFloat}(::Type{BF}) = BF(-Inf)

function nextfloat{BF<:BigFloat}(x::BF)
    z = BF()
    ccall((:mpfr_set, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Int32),
          &z, &x, ROUNDING_MODE[])
    ccall((:mpfr_nextabove, :libmpfr), Int32, (Ptr{BF},), &z) != 0
    return z
end

function prevfloat{BF<:BigFloat}(x::BF)
    z = BF()
    ccall((:mpfr_set, :libmpfr), Int32, (Ptr{BF}, Ptr{BF}, Int32),
          &z, &x, ROUNDING_MODE[])
    ccall((:mpfr_nextbelow, :libmpfr), Int32, (Ptr{BF},), &z) != 0
    return z
end

eps{BF<:BigFloat}(::Type{BF}) = nextfloat(BF(1)) - BF(1)

realmin{BF<:BigFloat}(::Type{BF}) = nextfloat(zero(BF))
realmax{BF<:BigFloat}(::Type{BF}) = prevfloat(BF(Inf))

"""
    setprecision(f::Function, [T=BF,] precision::Integer)

Change the `T` arithmetic precision (in bits) for the duration of `f`.
It is logically equivalent to:

    old = precision(BF)
    setprecision(BF, precision)
    f()
    setprecision(BF, old)

Often used as `setprecision(T, precision) do ... end`
"""
function setprecision{T}(f::Function, ::Type{T}, prec::Integer)
    old_prec = precision(T)
    setprecision(T, prec)
    try
        return f()
    finally
        setprecision(T, old_prec)
    end
end

setprecision(f::Function, precision::Integer) = setprecision(f, BigFloat, precision)

function string(x::BigFloat)
    # In general, the number of decimal places needed to read back the number exactly
    # is, excluding the most significant, ceil(log(10, 2^precision(x)))
    k = ceil(Int32, precision(x) * 0.3010299956639812)
    lng = k + Int32(8) # Add space for the sign, the most significand digit, the dot and the exponent
    buf = Array{UInt8}(lng + 1)
    # format strings are guaranteed to contain no NUL, so we don't use Cstring
    lng = ccall((:mpfr_snprintf,:libmpfr), Int32, (Ptr{UInt8}, Culong, Ptr{UInt8}, Ptr{BigFloat}...), buf, lng + 1, "%.Re", &x)
    if lng < k + 5 # print at least k decimal places
        lng = ccall((:mpfr_sprintf,:libmpfr), Int32, (Ptr{UInt8}, Ptr{UInt8}, Ptr{BigFloat}...), buf, "%.$(k)Re", &x)
    elseif lng > k + 8
        buf = Array{UInt8}(lng + 1)
        lng = ccall((:mpfr_snprintf,:libmpfr), Int32, (Ptr{UInt8}, Culong, Ptr{UInt8}, Ptr{BigFloat}...), buf, lng + 1, "%.Re", &x)
    end
    n = (1 <= x < 10 || -10 < x <= -1 || x == 0) ? lng - 4 : lng
    return String(buf[1:n])
end

function string{BF<:BigFloat}(x::BF)
    # In general, the number of decimal places needed to read back the number exactly
    # is, excluding the most significant, ceil(log(10, 2^precision(x)))
    k = ceil(Int32, precision(x) * 0.3010299956639812)
    lng = k + Int32(8) # Add space for the sign, the most significand digit, the dot and the exponent
    buf = Array{UInt8}(lng + 1)
    # format strings are guaranteed to contain no NUL, so we don't use Cstring
    lng = ccall((:mpfr_snprintf,:libmpfr), Int32, (Ptr{UInt8}, Culong, Ptr{UInt8}, Ptr{BF}...), buf, lng + 1, "%.Re", &x)
    if lng < k + 5 # print at least k decimal places
        lng = ccall((:mpfr_sprintf,:libmpfr), Int32, (Ptr{UInt8}, Ptr{UInt8}, Ptr{BF}...), buf, "%.$(k)Re", &x)
    elseif lng > k + 8
        buf = Array{UInt8}(lng + 1)
        lng = ccall((:mpfr_snprintf,:libmpfr), Int32, (Ptr{UInt8}, Culong, Ptr{UInt8}, Ptr{BF}...), buf, lng + 1, "%.Re", &x)
    end
    n = (1 <= x < 10 || -10 < x <= -1 || x == 0) ? lng - 4 : lng
    return String(buf[1:n])
end

print(io::IO, b::BigFloat) = print(io, string(b))
show(io::IO, b::BigFloat) = print(io, string(b))
print{BF<:BigFloat}(io::IO, b::BF) = print(io, string(b))
show{BF<:BigFloat}(io::IO, b::BF) = print(io, string(b))

# get/set exponent min/max
get_emax() = ccall((:mpfr_get_emax, :libmpfr), Clong, ())
get_emax_min() = ccall((:mpfr_get_emax_min, :libmpfr), Clong, ())
get_emax_max() = ccall((:mpfr_get_emax_max, :libmpfr), Clong, ())

get_emin() = ccall((:mpfr_get_emin, :libmpfr), Clong, ())
get_emin_min() = ccall((:mpfr_get_emin_min, :libmpfr), Clong, ())
get_emin_max() = ccall((:mpfr_get_emin_max, :libmpfr), Clong, ())

set_emax!(x) = ccall((:mpfr_set_emax, :libmpfr), Void, (Clong,), x)
set_emin!(x) = ccall((:mpfr_set_emin, :libmpfr), Void, (Clong,), x)

function Base.deepcopy_internal(x::BigFloat, stackdict::ObjectIdDict)
    if haskey(stackdict, x)
        return stackdict[x]
    end
    N = precision(x)
    y = BigFloat(zero(Clong), zero(Cint), zero(Clong), C_NULL)
    ccall((:mpfr_init2,:libmpfr), Void, (Ptr{BigFloat}, Clong), &y, N)
    finalizer(y, cglobal((:mpfr_clear, :libmpfr)))
    ccall((:mpfr_set, :libmpfr), Int32, (Ptr{BigFloat}, Ptr{BigFloat}, Int32),
          &y, &x, ROUNDING_MODE[])
    stackdict[x] = y
    return y
end

convert{BF<:BigFloat}(::Type{BF}, x::BF) = x
function convert{BF1<:BigFloat, BF2<:BigFloat}(::Type{BF1}, x::BF2)
    return parse(BF1, string(x))
end
function promote_rule{BF1<:BigFloat, BF2<:BigFloat}(::Type{BF1}, ::Type{BF2})
    return ifelse(precision(BF1) > precision(BF2), BF2, BF1)
end

(+){BF1<:BigFloat, BF2<:BigFloat}(a::BF1, b::BF2) = (+)(promote(a,b)...)
(-){BF1<:BigFloat, BF2<:BigFloat}(a::BF1, b::BF2) = (-)(promote(a,b)...)
(*){BF1<:BigFloat, BF2<:BigFloat}(a::BF1, b::BF2) = (*)(promote(a,b)...)
(/){BF1<:BigFloat, BF2<:BigFloat}(a::BF1, b::BF2) = (/)(promote(a,b)...)
(hypot){BF1<:BigFloat, BF2<:BigFloat}(a::BF1, b::BF2) = (hypot)(promote(a,b)...)
(^){BF1<:BigFloat, BF2<:BigFloat}(a::BF1, b::BF2) = (^)(promote(a,b)...)

end #module


import Base: ==, convert, Dict

const zklmTuple = NamedTuple{(:z, :k, :l, :m), Tuple{Int16, IntS, IntS, IntS}}

"""
`AList` : datastructure to help compute the A_zklm density projections

* `i2zklm` : list of all admissible `(z,k,l,m)` tuples
* `zklm2i` : dictionary with (z,k,l,m) keys to compute  the map `(z,k,l,m) -> i`
* `firstz` : `firstz[iz]` stores the first index in the A_zklm array for with
             z = zi. This can be used to iterate over all A entries for which
             z = zi. (they are sorted by z first)
"""
struct AList
   i2zklm::Vector{zklmTuple}
   zklm2i::Dict{zklmTuple, IntS}
   firstz::Vector{IntS}
end

# --------------(de-)serialisation----------------------------------------
Dict(alist::AList) = Dict("__id__" => "SHIPs_AList",
                           "i2zklm" => zklm2vec.(alist.i2zklm))
AList(D::Dict) = AList(vec2zklm.(D["i2zklm"]))
zklm2vec(t) = [t.z, t.k, t.l, t.m]
vec2zklm(v) = (z=Int16(v[1]), k=IntS(v[2]), l=IntS(v[3]), m=IntS(v[4]))
==(al1::AList, al2::AList) = (al1.i2zklm == al2.i2zklm)
# ------------------------------------------------------------------------

Base.length(alist::AList) = length(alist.i2zklm)
Base.getindex(alist::AList, i::Integer) = alist.i2zklm[i]
Base.getindex(alist::AList, zklm::zklmTuple) = alist.zklm2i[zklm]

alloc_A(alist::AList, T=Float64) = zeros(Complex{T}, length(alist))

function AList(zklmlist::AbstractVector{zklmTuple})
   # sort the tuples - by z, then k, then l, then m
   i2zklm = sort(zklmlist)
   # create the inverse mapping
   zklm2i = Dict{zklmTuple, IntS}()
   for i = 1:length(i2zklm)
      zklm2i[i2zklm[i]] = IntS(i)
   end
   # find the first index for each z
   zmax = maximum( a.z for a in i2zklm )
   firstz = [ findfirst([a.z == iz for a in i2zklm])
              for iz = 1:zmax ]
   return AList( i2zklm, zklm2i, [firstz; length(i2zklm)+1] )
end

"""
This fills the A-array stored in tmp with the A_zklm density projections in
the order specified by AList. It also evaluates the radial and angular basis
functions along the way.
"""
function precompute_A!(A, tmp, alist, Rs, Zs, ship)
   fill!(A, 0)
   for (R, Z) in zip(Rs, Zs)
      # evaluate the r-basis and the R̂-basis for the current neighbour at R
      eval_basis!(tmp.J, tmp.tmpJ, ship.J, norm(R))
      eval_basis!(tmp.Y, tmp.tmpY, ship.SH, R)
      # add the contributions to the A_zklm
      iz = z2i(ship, Z)
      for i = alist.firstz[iz]:(alist.firstz[iz+1]-1)
         zklm = alist[i]
         A[i] += tmp.J[zklm.k+1] * tmp.Y[index_y(zklm.l, zklm.m)]
      end
   end
   return A
end

function precompute_dA!(A, dA, tmp, alist, Rs, Zs, ship)
   fill!(A, 0)
   fill!(dA, zero(eltype(dA)))
   for (iR, (R, Z)) in enumerate(zip(Rs, Zs))
      # precompute the derivatives of the Jacobi polynomials and Ylms
      eval_basis_d!(tmp.J, tmp.dJ, tmp.tmpJ, ship.J, norm(R))
      eval_basis_d!(tmp.Y, tmp.dY, tmp.tmpY, ship.SH, R)
      # deduce the A and dA values
      iz = z2i(ship, Z)
      R̂ = R / norm(R)
      for i = alist.firstz[iz]:(alist.firstz[iz+1]-1)
         zklm = alist[i]
         ik = zklm.k+1; iy = index_y(zklm.l, zklm.m)
         A[i] += tmp.J[ik] * tmp.Y[iy]
         # and into dA # grad_phi_Rj(R, iR, zklm, tmp)
         ∇ϕ_zklm = tmp.dJ[ik] * tmp.Y[iy] * R̂ + tmp.J[ik] * tmp.dY[iy]
         dA[iR, i] = ∇ϕ_zklm
      end
   end
   return dA
end

# ---------

"""
`AAList` : datastructure to help compute the A_𝐳𝐤𝐥𝐦 = ∏ A_zklm

* `i2Aidx` : indices in AList of the zklms to avoid the Dict lookup
* `len`    : len[i] is the number of relevant entries of i2zklm[i,:]
             i.e. the body-order of this entry
* `zklm2i` : dictionary of all (z,k,l,m) tuples to compute  the
             map `(zz,kk,ll,mm) -> i`
* `firstz` : `firstz[iz]` stores the first index in the A_zklm array for with
             z = zi. This can be used to iterate over all A entries for which
             z = zi. (they are sorted by z first)
"""
struct AAList
   i2Aidx::Matrix{IntS}    # where in A can we find these
   len::Vector{IntS}       # body-order
   zklm2i::Dict{Any, IntS} # inverse mapping
end

# --------------(de-)serialisation----------------------------------------

==
function Dict(aalist::AAList)
   ZKLM_list = Vector{Any}(undef, length(aalist))
   for (zzkkllmm, i) in aalist.zklm2i
      ZKLM_list[i] = zzkkllmm
   end
   return Dict("__id__" => "SHIPs_AAList", "ZKLM_list" => ZKLM_list)
end
zzkkllmm2vec(zzkkllmm) = Vector.([zzkkllmm...])
vec2zzkkllmm(v) = (SVector(Int16.(v[1])...),
                   SVector(IntS.(v[2])...),
                   SVector(IntS.(v[3])...),
                   SVector(IntS.(v[4])...))
AAList(D::Dict, alist) = AAList(vec2zzkkllmm.(D["ZKLM_list"]), alist)
==(aal1::AAList, aal2::AAList) = (aal1.i2Aidx == aal2.i2Aidx)
# ------------------------------------------------------------------------

bodyorder(aalist::AAList) = maximum(aalist.len) + 1

Base.length(aalist::AAList) = length(aalist.len)

Base.getindex(aalist::AAList, t::Tuple) = aalist.zklm2i[t]

alloc_AA(aalist::AAList, T = Float64) = zeros(Complex{T}, length(aalist))

"""
`AAList(ZKLM_list, alist)` : standard AAList constructor,
* `ZKLM_list` : a collection of (izz=?, kk=?, ll=?, mm=?) tuples
* `alist` a compatible `AList`
"""
function AAList(ZKLM_list, alist)
   BO = maximum(ν -> length(ν[1]), ZKLM_list)  # body-order -> size of iAidx

   # create arrays to construct AAList
   iAidx = IntS[]
   len = IntS[]
   zklm2i = Dict{Any, IntS}()

   idx = 0
   for (izz, kk, ll, mm) in ZKLM_list
      # store in the index of the current row in the reverse map
      idx += 1
      zklm2i[(izz, kk, ll, mm)] = idx
      # store the body-order of the current ∏A function
      push!(len, length(ll))

      # fill the row of the i2Aidx matrix
      for α = 1:length(ll)
         zklm = (z=izz[α], k=kk[α], l=ll[α], m=IntS(mm[α]))
         iA = alist[zklm]
         push!(iAidx, iA)
      end
      # fill up the iAidx vector with zeros up to the body-order
      # this will create 0 entries in the matrix after reshaping
      for α = (length(ll)+1):BO
         push!(iAidx, 0)
      end
   end
   return AAList( reshape(iAidx, (BO, idx))', len, zklm2i )
end

function precompute_AA!(AA, A, aalist) # tmp, ship::SHIPBasis{T}, iz0) where {T}
   fill!(AA, 1)
   for i = 1:length(aalist)
      for α = 1:aalist.len[i]
         iA = aalist.i2Aidx[i, α]
         AA[i] *= A[iA]
      end
   end
   return nothing
end

# --------------------------------------------------------
# this section of functions is for computing
#  ∂∏A / ∂R_j

# function grad_phi_Rj(Rj, j, zklm, tmp)
#    ik = zklm.k + 1
#    iy = index_y(zklm.l, zklm.m)
#    return ( tmp.dJJ[j, ik] *  tmp.YY[j, iy] * (Rj/norm(Rj))
#            + tmp.JJ[j, ik] * tmp.dYY[j, iy] )
# end

function grad_AA_Ab(iAA, b, alist, aalist, A)
   g = one(eltype(A))
   for a = 1:aalist.len[iAA]
      if a != b
         iA = aalist.i2Aidx[iAA, a]
         g *= A[iA]
      end
   end
   return g
end

function grad_AAi_Rj(iAA, j, Rj::JVec{T}, izj::Integer,
                     alist, aalist, A, AA, dA, tmp) where {T}
   g = zero(JVec{Complex{T}})
   for b = 1:aalist.len[iAA] # body-order
      # A_{n_b} = A[iA]
      iA = aalist.i2Aidx[iAA, b]
      # daa_dab = ∂(∏A_{n_a}) / ∂A_{n_b}
      daa_dab = grad_AA_Ab(iAA, b, alist, aalist, A)
      zklm = alist[iA] # (zklm corresponding to A_{n_b})
      ∇ϕ_zklm = dA[j, iA] # grad_phi_Rj(Rj, j, zklm, tmp)
      g += daa_dab * ∇ϕ_zklm
   end
   return g
end

function grad_AA_Rj!(tmp, ship, j, Rs, Zs, iz0) where {T}
   for iAA = 1:length(ship.aalists[iz0])
      # g = ∂(∏_a A_a) / ∂Rj
      tmp.dAAj[iz0][iAA] = grad_AAi_Rj(iAA, j, Rs[j], z2i(ship, Zs[j]),
                                       ship.alists[iz0], ship.aalists[iz0],
                                       tmp.A[iz0], tmp.AA[iz0], tmp.dA[iz0],
                                       tmp)
   end
   return tmp.dAAj[iz0]
end

# --------------------------------------------------------

"""
convert the "old" `(NuZ, ZKL)` format into the simpler (zz, kk, ll, mm)
format, and at the same time extract the one-particle basis (z, k, l, m)
"""
function alists_from_bgrps(bgrps::Tuple)
   NZ = length(bgrps)
   zzkkllmm_list = [ Tuple[] for _=1:NZ ]
   zklm_set = [ Set() for _=1:NZ ]
   for iz0 = 1:NZ
      for (izz, kk, ll) in bgrps[iz0], mm in _mrange(ll)
         push!(zzkkllmm_list[iz0], (izz, kk, ll, IntS.(mm)))
         for α = 1:length(ll)
            zklm = (z=izz[α], k=kk[α], l=ll[α], m=IntS(mm[α]))
            push!(zklm_set[iz0], zklm)
         end
      end
   end

   alist =  ntuple(iz0 -> AList([ zklm for zklm in collect(zklm_set[iz0]) ]), NZ)
   aalist = ntuple(iz0 -> AAList(zzkkllmm_list[iz0], alist[iz0]), NZ)
   return alist, aalist
end

# --------------------------------------------------------

using SparseArrays: SparseMatrixCSC

function _my_mul!(C::AbstractVector, A::SparseMatrixCSC, B::AbstractVector)
   A.n == length(B) || throw(DimensionMismatch())
   A.m == length(C) || throw(DimensionMismatch())
   nzv = A.nzval
   rv = A.rowval
   fill!(C, zero(eltype(C)))
   @inbounds for col = 1:A.n
      b = B[col]
      for j = A.colptr[col]:(A.colptr[col + 1] - 1)
         C[rv[j]] += nzv[j] * b
      end
   end
   return C
end


# By default, Julia/LLVM does not use fused multiply-add operations (FMAs).
# Since these FMAs can increase the performance of many numerical algorithms,
# we need to opt-in explicitly.
# See https://ranocha.de/blog/Optimizing_EC_Trixi for further details.
@muladd begin

# TODO: Taal refactor
# - analysis_interval part as PeriodicCallback called after a certain amount of simulation time
"""
    AnalysisCallback(semi; interval=0,
                           save_analysis=false,
                           output_directory="out",
                           analysis_filename="analysis.dat",
                           extra_analysis_errors=Symbol[],
                           extra_analysis_integrals=())

Analyze a numerical solution every `interval` time steps and print the
results to the screen. If `save_analysis`, the results are also saved in
`joinpath(output_directory, analysis_filename)`.

Additional errors can be computed, e.g. by passing `extra_analysis_errors = [:primitive]`.

Further scalar functions `func` in `extra_analysis_integrals` are applied to the numerical
solution and integrated over the computational domain.
See `Trixi.analyze`, `Trixi.pretty_form_utf`, `Trixi.pretty_form_ascii` for further
information on how to create custom analysis quantities.
"""
mutable struct AnalysisCallback{Analyzer, AnalysisIntegrals, InitialStateIntegrals, Cache}
  start_time::Float64
  interval::Int
  save_analysis::Bool
  output_directory::String
  analysis_filename::String
  analyzer::Analyzer
  analysis_errors::Vector{Symbol}
  analysis_integrals::AnalysisIntegrals
  initial_state_integrals::InitialStateIntegrals
  cache::Cache
end

# TODO: Taal bikeshedding, implement a method with less information and the signature
# function Base.show(io::IO, analysis_callback::AnalysisCallback)
# end
function Base.show(io::IO, ::MIME"text/plain", cb::DiscreteCallback{<:Any, <:AnalysisCallback})
  @nospecialize cb # reduce precompilation time

  if get(io, :compact, false)
    show(io, cb)
  else
    analysis_callback = cb.affect!

    setup = Pair{String,Any}[
             "interval" => analysis_callback.interval,
             "analyzer" => analysis_callback.analyzer,
            ]
    for (idx, error) in enumerate(analysis_callback.analysis_errors)
      push!(setup, "│ error " * string(idx) => error)
    end
    for (idx, integral) in enumerate(analysis_callback.analysis_integrals)
      push!(setup, "│ integral " * string(idx) => integral)
    end
    push!(setup, "save analysis to file" => analysis_callback.save_analysis ? "yes" : "no")
    if analysis_callback.save_analysis
      push!(setup, "│ filename" => analysis_callback.analysis_filename)
      push!(setup, "│ output directory" => abspath(normpath(analysis_callback.output_directory)))
    end
    summary_box(io, "AnalysisCallback", setup)
  end
end

function AnalysisCallback(semi::AbstractSemidiscretization; kwargs...)
  mesh, equations, solver, cache = mesh_equations_solver_cache(semi)
  AnalysisCallback(mesh, equations, solver, cache; kwargs...)
end

function AnalysisCallback(mesh, equations::AbstractEquations, solver, cache;
                          interval=0,
                          save_analysis=false,
                          output_directory="out",
                          analysis_filename="analysis.dat",
                          extra_analysis_errors=Symbol[],
                          analysis_errors=union(default_analysis_errors(equations), extra_analysis_errors),
                          extra_analysis_integrals=(),
                          analysis_integrals=union(default_analysis_integrals(equations), extra_analysis_integrals),
                          RealT=real(solver),
                          uEltype=eltype(cache.elements),
                          kwargs...)
  # Decide when the callback is activated.
  # With error-based step size control, some steps can be rejected. Thus,
  #   `integrator.iter >= integrator.destats.naccept`
  #    (total #steps)       (#accepted steps)
  # We need to check the number of accepted steps since callbacks are not
  # activated after a rejected step.
  condition = (u, t, integrator) -> interval > 0 && ( (integrator.destats.naccept % interval == 0 &&
                                                       !(integrator.destats.naccept == 0 && integrator.iter > 0)) ||
                                                     isfinished(integrator))

  analyzer = SolutionAnalyzer(solver; kwargs...)
  cache_analysis = create_cache_analysis(analyzer, mesh, equations, solver, cache, RealT, uEltype)

  analysis_callback = AnalysisCallback(0.0, interval, save_analysis, output_directory, analysis_filename,
                                       analyzer,
                                       analysis_errors, Tuple(analysis_integrals),
                                       SVector(ntuple(_ -> zero(uEltype), Val(nvariables(equations)))),
                                       cache_analysis)

  DiscreteCallback(condition, analysis_callback,
                   save_positions=(false,false),
                   initialize=initialize!)
end

function initialize!(cb::DiscreteCallback{Condition,Affect!}, u_ode, t, integrator) where {Condition, Affect!<:AnalysisCallback}
  semi = integrator.p
  initial_state_integrals = integrate(u_ode, semi)
  _, equations, _, _ = mesh_equations_solver_cache(semi)

  analysis_callback = cb.affect!
  analysis_callback.initial_state_integrals = initial_state_integrals
  @unpack save_analysis, output_directory, analysis_filename, analysis_errors, analysis_integrals = analysis_callback

  if save_analysis && mpi_isroot()
    mkpath(output_directory)

    # write header of output file
    open(joinpath(output_directory, analysis_filename), "w") do io
      @printf(io, "#%-8s", "timestep")
      @printf(io, "  %-14s", "time")
      @printf(io, "  %-14s", "dt")
      if :l2_error in analysis_errors
        for v in varnames(cons2cons, equations)
          @printf(io, "   %-14s", "l2_" * v)
        end
      end
      if :linf_error in analysis_errors
        for v in varnames(cons2cons, equations)
          @printf(io, "   %-14s", "linf_" * v)
        end
      end
      if :conservation_error in analysis_errors
        for v in varnames(cons2cons, equations)
          @printf(io, "   %-14s", "cons_" * v)
        end
      end
      if :residual in analysis_errors
        for v in varnames(cons2cons, equations)
          @printf(io, "   %-14s", "res_" * v)
        end
      end
      if :l2_error_primitive in analysis_errors
        for v in varnames(cons2prim, equations)
          @printf(io, "   %-14s", "l2_" * v)
        end
      end
      if :linf_error_primitive in analysis_errors
        for v in varnames(cons2prim, equations)
          @printf(io, "   %-14s", "linf_" * v)
        end
      end

      for quantity in analysis_integrals
        @printf(io, "   %-14s", pretty_form_ascii(quantity))
      end

      println(io)
    end

  end

  analysis_callback.start_time = time_ns()
  analysis_callback(integrator)
  return nothing
end

# TODO: Taal refactor, allow passing an IO object (which could be devnull to avoid cluttering the console)
function (analysis_callback::AnalysisCallback)(integrator)
  semi = integrator.p
  mesh, equations, solver, cache = mesh_equations_solver_cache(semi)
  @unpack dt, t = integrator
  iter = integrator.destats.naccept

  runtime_absolute = 1.0e-9 * (time_ns() - analysis_callback.start_time)
  runtime_relative = 1.0e-9 * take!(semi.performance_counter) / ndofs(semi)

  @trixi_timeit timer() "analyze solution" begin
    # General information
    mpi_println()
    mpi_println("─"^100)
    # TODO: Taal refactor, polydeg is specific to DGSEM
    mpi_println(" Simulation running '", get_name(equations), "' with ", summary(solver))
    mpi_println("─"^100)
    mpi_println(" #timesteps:     " * @sprintf("% 14d", iter) *
                "               " *
                " run time:       " * @sprintf("%10.8e s", runtime_absolute))
    mpi_println(" Δt:             " * @sprintf("%10.8e", dt) *
                "               " *
                " time/DOF/rhs!:  " * @sprintf("%10.8e s", runtime_relative))
    mpi_println(" sim. time:      " * @sprintf("%10.8e", t))
    mpi_println(" #DOF:           " * @sprintf("% 14d", ndofs(semi)))
    mpi_println(" #elements:      " * @sprintf("% 14d", nelements(mesh, solver, cache)))

    # Level information (only show for AMR)
    print_amr_information(integrator.opts.callback, mesh, solver, cache)
    mpi_println()

    # Open file for appending and store time step and time information
    if mpi_isroot() && analysis_callback.save_analysis
      io = open(joinpath(analysis_callback.output_directory, analysis_callback.analysis_filename), "a")
      @printf(io, "% 9d", iter)
      @printf(io, "  %10.8e", t)
      @printf(io, "  %10.8e", dt)
    else
      io = devnull
    end

    # Calculate current time derivative (needed for semidiscrete entropy time derivative, residual, etc.)
    du_ode = first(get_tmp_cache(integrator))
    @notimeit timer() rhs!(du_ode, integrator.u, semi, t)
    u  = wrap_array(integrator.u, mesh, equations, solver, cache)
    du = wrap_array(du_ode,       mesh, equations, solver, cache)
    l2_error, linf_error = analysis_callback(io, du, u, integrator.u, t, semi)

    mpi_println("─"^100)
    mpi_println()

    # Add line break and close analysis file if it was opened
    if mpi_isroot() && analysis_callback.save_analysis
      # This resolves a possible type instability introduced above, since `io`
      # can either be an `IOStream` or `devnull`, but we know that it must be
      # an `IOStream here`.
      println(io::IOStream)
      close(io::IOStream)
    end
  end

  # avoid re-evaluating possible FSAL stages
  u_modified!(integrator, false)

  # Return errors for EOC analysis
  return l2_error, linf_error
end

# This method is just called internally from `(analysis_callback::AnalysisCallback)(integrator)`
# and serves as a function barrier. Additionally, it makes the code easier to profile and optimize.
function (analysis_callback::AnalysisCallback)(io, du, u, u_ode, t, semi)
  @unpack analyzer, analysis_errors, analysis_integrals = analysis_callback
  cache_analysis = analysis_callback.cache
  _, equations, _, _ = mesh_equations_solver_cache(semi)

  # Calculate and print derived quantities (error norms, entropy etc.)
  # Variable names required for L2 error, Linf error, and conservation error
  if any(q in analysis_errors for q in
         (:l2_error, :linf_error, :conservation_error, :residual)) && mpi_isroot()
    print(" Variable:    ")
    for v in eachvariable(equations)
      @printf("   %-14s", varnames(cons2cons, equations)[v])
    end
    println()
  end

  # Calculate L2/Linf errors, which are also returned
  l2_error, linf_error = calc_error_norms(u_ode, t, analyzer, semi, cache_analysis)

  if mpi_isroot()
    # L2 error
    if :l2_error in analysis_errors
      print(" L2 error:    ")
      for v in eachvariable(equations)
        @printf("  % 10.8e", l2_error[v])
        @printf(io, "  % 10.8e", l2_error[v])
      end
      println()
    end

    # Linf error
    if :linf_error in analysis_errors
      print(" Linf error:  ")
      for v in eachvariable(equations)
        @printf("  % 10.8e", linf_error[v])
        @printf(io, "  % 10.8e", linf_error[v])
      end
      println()
    end
  end

  # Conservation errror
  if :conservation_error in analysis_errors
    @unpack initial_state_integrals = analysis_callback
    state_integrals = integrate(u_ode, semi)

    if mpi_isroot()
      print(" |∑U - ∑U₀|:  ")
      for v in eachvariable(equations)
        err = abs(state_integrals[v] - initial_state_integrals[v])
        @printf("  % 10.8e", err)
        @printf(io, "  % 10.8e", err)
      end
      println()
    end
  end

  # Residual (defined here as the vector maximum of the absolute values of the time derivatives)
  if :residual in analysis_errors
    mpi_print(" max(|Uₜ|):   ")
    for v in eachvariable(equations)
      # Calculate maximum absolute value of Uₜ
      res = maximum(abs, view(du, v, ..))
      if mpi_isparallel()
        # TODO: Debugging, here is a type instability
        global_res = MPI.Reduce!(Ref(res), max, mpi_root(), mpi_comm())
        if mpi_isroot()
          res::eltype(du) = global_res[]
        end
      end
      if mpi_isroot()
        @printf("  % 10.8e", res)
        @printf(io, "  % 10.8e", res)
      end
    end
    mpi_println()
  end

  # L2/L∞ errors of the primitive variables
  if :l2_error_primitive in analysis_errors || :linf_error_primitive in analysis_errors
    l2_error_prim, linf_error_prim = calc_error_norms(cons2prim, u_ode, t, analyzer, semi, cache_analysis)

    if mpi_isroot()
      print(" Variable:    ")
      for v in eachvariable(equations)
        @printf("   %-14s", varnames(cons2prim, equations)[v])
      end
      println()

      # L2 error
      if :l2_error_primitive in analysis_errors
        print(" L2 error prim.: ")
        for v in eachvariable(equations)
          @printf("%10.8e   ", l2_error_prim[v])
          @printf(io, "  % 10.8e", l2_error_prim[v])
        end
        println()
      end

      # L∞ error
      if :linf_error_primitive in analysis_errors
        print(" Linf error pri.:")
        for v in eachvariable(equations)
          @printf("%10.8e   ", linf_error_prim[v])
          @printf(io, "  % 10.8e", linf_error_prim[v])
        end
        println()
      end
    end
  end

  # additional integrals
  analyze_integrals(analysis_integrals, io, du, u, t, semi)

  return l2_error, linf_error
end

# Print level information only if AMR is enabled
function print_amr_information(callbacks, mesh, solver, cache)

  # Return early if there is nothing to print
  uses_amr(callbacks) || return nothing

  levels = Vector{Int}(undef, nelements(solver, cache))
  min_level = typemax(Int)
  max_level = typemin(Int)
  for element in eachelement(solver, cache)
    current_level = mesh.tree.levels[cache.elements.cell_ids[element]]
    levels[element] = current_level
    min_level = min(min_level, current_level)
    max_level = max(max_level, current_level)
  end

  for level = max_level:-1:min_level+1
    mpi_println(" ├── level $level:    " * @sprintf("% 14d", count(==(level), levels)))
  end
  mpi_println(" └── level $min_level:    " * @sprintf("% 14d", count(==(min_level), levels)))

  return nothing
end

# Print level information only if AMR is enabled
function print_amr_information(callbacks, mesh::P4estMesh, solver, cache)

  # Return early if there is nothing to print
  uses_amr(callbacks) || return nothing

  elements_per_level = zeros(P4EST_MAXLEVEL + 1)

  for tree in unsafe_wrap_sc(p4est_tree_t, mesh.p4est.trees)
    elements_per_level .+= tree.quadrants_per_level
  end

  min_level = findfirst(i -> i > 0, elements_per_level) - 1
  max_level = findlast(i -> i > 0, elements_per_level) - 1

  for level = max_level:-1:min_level+1
    mpi_println(" ├── level $level:    " * @sprintf("% 14d", elements_per_level[level + 1]))
  end
  mpi_println(" └── level $min_level:    " * @sprintf("% 14d", elements_per_level[min_level + 1]))

  return nothing
end

# Iterate over tuples of analysis integrals in a type-stable way using "lispy tuple programming".
function analyze_integrals(analysis_integrals::NTuple{N,Any}, io, du, u, t, semi) where {N}

  # Extract the first analysis integral and process it; keep the remaining to be processed later
  quantity = first(analysis_integrals)
  remaining_quantities = Base.tail(analysis_integrals)

  res = analyze(quantity, du, u, t, semi)
  if mpi_isroot()
    @printf(" %-12s:", pretty_form_utf(quantity))
    @printf("  % 10.8e", res)
    @printf(io, "  % 10.8e", res)
  end
  mpi_println()

  # Recursively call this method with the unprocessed integrals
  analyze_integrals(remaining_quantities, io, du, u, t, semi)
  return nothing
end

# terminate the type-stable iteration over tuples
function analyze_integrals(analysis_integrals::Tuple{}, io, du, u, t, semi)
  nothing
end

# used for error checks and EOC analysis
function (cb::DiscreteCallback{Condition,Affect!})(sol) where {Condition, Affect!<:AnalysisCallback}
  analysis_callback = cb.affect!
  semi = sol.prob.p
  @unpack analyzer = analysis_callback
  cache_analysis = analysis_callback.cache

  l2_error, linf_error = calc_error_norms(sol.u[end], sol.t[end], analyzer, semi, cache_analysis)
  (; l2=l2_error, linf=linf_error)
end

# some common analysis_integrals
# to support another analysis integral, you can overload
# Trixi.analyze, Trixi.pretty_form_utf, Trixi.pretty_form_ascii
function analyze(quantity, du, u, t, semi::AbstractSemidiscretization)
  mesh, equations, solver, cache = mesh_equations_solver_cache(semi)
  analyze(quantity, du, u, t, mesh, equations, solver, cache)
end
function analyze(quantity, du, u, t, mesh, equations, solver, cache)
  integrate(quantity, u, mesh, equations, solver, cache, normalize=true)
end
pretty_form_utf(quantity) = get_name(quantity)
pretty_form_ascii(quantity) = get_name(quantity)

function entropy_timederivative end
pretty_form_utf(::typeof(entropy_timederivative)) = "∑∂S/∂U ⋅ Uₜ"
pretty_form_ascii(::typeof(entropy_timederivative)) = "dsdu_ut"

pretty_form_utf(::typeof(entropy)) = "∑S"

pretty_form_utf(::typeof(energy_total)) = "∑e_total"
pretty_form_ascii(::typeof(energy_total)) = "e_total"

pretty_form_utf(::typeof(energy_kinetic)) = "∑e_kinetic"
pretty_form_ascii(::typeof(energy_kinetic)) = "e_kinetic"

pretty_form_utf(::typeof(energy_kinetic_nondimensional)) = "∑e_kinetic*"
pretty_form_ascii(::typeof(energy_kinetic_nondimensional)) = "e_kinetic*"

pretty_form_utf(::typeof(energy_internal)) = "∑e_internal"
pretty_form_ascii(::typeof(energy_internal)) = "e_internal"

pretty_form_utf(::typeof(energy_magnetic)) = "∑e_magnetic"
pretty_form_ascii(::typeof(energy_magnetic)) = "e_magnetic"

pretty_form_utf(::typeof(cross_helicity)) = "∑v⋅B"
pretty_form_ascii(::typeof(cross_helicity)) = "v_dot_B"

pretty_form_utf(::Val{:l2_divb}) = "L2 ∇⋅B"
pretty_form_ascii(::Val{:l2_divb}) = "l2_divb"

pretty_form_utf(::Val{:linf_divb}) = "L∞ ∇⋅B"
pretty_form_ascii(::Val{:linf_divb}) = "linf_divb"

pretty_form_utf(::typeof(lake_at_rest_error)) = "∑|H₀-(h+b)|"
pretty_form_ascii(::typeof(lake_at_rest_error)) = "|H0-(h+b)|"

# specialized implementations specific to some solvers
include("analysis_dg1d.jl")
include("analysis_dg2d.jl")
include("analysis_dg2d_parallel.jl")
include("analysis_dg3d.jl")
include("analysis_dg3d_parallel.jl")

end # @muladd


function codegen(::Type{Val{:iterate}}, ::Type{HMC}, job::BasicMCJob)
  result::Expr
  update = []
  noupdate = []
  burninbody = []
  ifburninbody = []
  body = []
  dindex::Integer

  vform = variate_form(job.pstate)
  if vform != Univariate && vform != Multivariate
    error("Only univariate or multivariate parameter states allowed in HMC code generation")
  end

  if isa(job.tuner, DualAveragingMCTuner)
    push!(body, :(_job.sstate.count += 1))
  end

  if (isa(job.tuner, VanillaMCTuner) && job.tuner.verbose) ||
    isa(job.tuner, AcceptanceRateMCTuner) ||
    (isa(job.tuner, DualAveragingMCTuner) && job.tuner.verbose)
    push!(body, :(_job.sstate.tune.proposed += 1))
  end

  if vform == Univariate
    push!(body, :(_job.sstate.momentum = randn()))
  elseif vform == Multivariate
    push!(body, :(_job.sstate.momentum[:] = randn(_job.pstate.size)))
  end

  push!(body, :(_job.sstate.oldhamiltonian = hamiltonian(_job.pstate.logtarget, _job.sstate.momentum)))

  if vform == Univariate
    push!(body, :(_job.sstate.pstate.value = _job.pstate.value))
    push!(body, :(_job.sstate.pstate.gradlogtarget = _job.pstate.gradlogtarget))
  elseif vform == Multivariate
    push!(body, :(_job.sstate.pstate.value = copy(_job.pstate.value)))
    push!(body, :(_job.sstate.pstate.gradlogtarget = copy(_job.pstate.gradlogtarget)))
  end

  if isa(job.tuner, DualAveragingMCTuner)
    push!(body, :(_job.sstate.nleaps = max(1, Int(round(_job.sstate.tune.λ/_job.sstate.tune.step)))))
  end

  if vform == Univariate
    push!(body, :(
      for i in 1:_job.sstate.nleaps
        _job.sstate.momentum =
          leapfrog!(
            _job.sstate.pstate,
            _job.sstate.pstate,
            _job.sstate.momentum,
            _job.sstate.tune.step,
            _job.parameter.gradlogtarget!
          )
      end
    ))
  elseif vform == Multivariate
    push!(body, :(
      for i in 1:_job.sstate.nleaps
        leapfrog!(
          _job.sstate.pstate,
          _job.sstate.momentum,
          _job.sstate.pstate,
          _job.sstate.momentum,
          _job.sstate.tune.step,
          _job.parameter.gradlogtarget!
        )
      end
    ))
  end

  push!(body, :(_job.parameter.logtarget!(_job.sstate.pstate)))

  push!(body, :(_job.sstate.newhamiltonian = hamiltonian(_job.sstate.pstate.logtarget, _job.sstate.momentum)))

  push!(body, :(_job.sstate.ratio = _job.sstate.newhamiltonian-_job.sstate.oldhamiltonian))

  push!(body, :(_job.sstate.a = min(1., exp(_job.sstate.ratio))))

  if vform == Univariate
    push!(update, :(_job.pstate.value = _job.sstate.pstate.value))
    push!(update, :(_job.pstate.gradlogtarget = _job.sstate.pstate.gradlogtarget))
    if in(:gradloglikelihood, job.outopts[:monitor]) && job.parameter.gradloglikelihood! != nothing
      push!(update, :(_job.pstate.gradloglikelihood = _job.sstate.pstate.gradloglikelihood))
    end
    if in(:gradlogprior, job.outopts[:monitor]) && job.parameter.gradlogprior! != nothing
      push!(update, :(_job.pstate.gradlogprior = _job.sstate.pstate.gradlogprior))
    end
  elseif vform == Multivariate
    push!(update, :(_job.pstate.value = copy(_job.sstate.pstate.value)))
    push!(update, :(_job.pstate.gradlogtarget = copy(_job.sstate.pstate.gradlogtarget)))
    if in(:gradloglikelihood, job.outopts[:monitor]) && job.parameter.gradloglikelihood! != nothing
      push!(update, :(_job.pstate.gradloglikelihood = copy(_job.sstate.pstate.gradloglikelihood)))
    end
    if in(:gradlogprior, job.outopts[:monitor]) && job.parameter.gradlogprior! != nothing
      push!(update, :(_job.pstate.gradlogprior = copy(_job.sstate.pstate.gradlogprior)))
    end
  end
  push!(update, :(_job.pstate.logtarget = _job.sstate.pstate.logtarget))
  if in(:loglikelihood, job.outopts[:monitor]) && job.parameter.loglikelihood! != nothing
    push!(update, :(_job.pstate.loglikelihood = _job.sstate.pstate.loglikelihood))
  end
  if in(:logprior, job.outopts[:monitor]) && job.parameter.logprior! != nothing
    push!(update, :(_job.pstate.logprior = _job.sstate.pstate.logprior))
  end
  dindex = findfirst(job.outopts[:diagnostics], :accept)
  if dindex != 0
    push!(update, :(_job.pstate.diagnosticvalues[$dindex] = true))
    push!(noupdate, :(_job.pstate.diagnosticvalues[$dindex] = false))
  end
  if (isa(job.tuner, VanillaMCTuner) && job.tuner.verbose) ||
    isa(job.tuner, AcceptanceRateMCTuner) ||
    (isa(job.tuner, DualAveragingMCTuner) && job.tuner.verbose)
    push!(update, :(_job.sstate.tune.accepted += 1))
  end

  push!(body, Expr(:if, :(rand() < _job.sstate.a), Expr(:block, update...), noupdate...))

  if (isa(job.tuner, VanillaMCTuner) && job.tuner.verbose) || isa(job.tuner, AcceptanceRateMCTuner)
    push!(burninbody, :(rate!(_job.sstate.tune)))

    if isa(job.tuner, AcceptanceRateMCTuner)
      push!(burninbody, :(tune!(_job.sstate.tune, _job.tuner)))
    end

    if job.tuner.verbose
      fmt_iter = format_iteration(ndigits(job.range.burnin))
      fmt_perc = format_percentage()

      push!(burninbody, :(println(
        "Burnin iteration ",
        $(fmt_iter)(_job.sstate.tune.totproposed),
        " of ",
        _job.range.burnin,
        ": ",
        $(fmt_perc)(100*_job.sstate.tune.rate),
        " % acceptance rate"
      )))
    end

    push!(burninbody, :(reset_burnin!(_job.sstate.tune)))

    push!(
      body,
      Expr(
        :if,
        :(_job.sstate.tune.totproposed <= _job.range.burnin && mod(_job.sstate.tune.proposed, _job.tuner.period) == 0),
        Expr(:block, burninbody...)
      )
    )
  elseif isa(job.tuner, DualAveragingMCTuner)
    push!(burninbody, :(tune!(_job.sstate.tune, _job.tuner, _job.sstate.count, _job.sstate.a)))

    if job.tuner.verbose
      fmt_iter = format_iteration(ndigits(job.tuner.nadapt))
      fmt_perc = format_percentage()

      push!(ifburninbody, :(rate!(_job.sstate.tune)))

      push!(ifburninbody, :(println(
        "Burnin iteration ",
        $(fmt_iter)(_job.sstate.tune.totproposed),
        " of ",
        _job.tuner.nadapt,
        ": ",
        $(fmt_perc)(100*_job.sstate.tune.rate),
        " % acceptance rate"
      )))

      push!(ifburninbody, :(reset_burnin!(_job.sstate.tune)))

      push!(burninbody, Expr(:if, :(mod(_job.sstate.tune.proposed, _job.tuner.period) == 0), Expr(:block, ifburninbody...)))
    end

    push!(
      body,
      Expr(
        :if,
        :(_job.sstate.count <= _job.tuner.nadapt),
        Expr(:block, burninbody...),
        :(_job.sstate.tune.step = _job.sstate.tune.εbar)
      )
    )
  end

  if !job.plain
    push!(body, :(produce()))
  end

  @gensym _iterate

  result = quote
    function $_iterate(_job::BasicMCJob)
      $(body...)
    end
  end

  result
end


mutable struct DQMCStack{
        GreensElType <: Number,
        HoppingElType <: Number,
        GreensMatType <: AbstractArray{GreensElType},
        HoppingMatType <: AbstractArray{HoppingElType},
        InteractionMatType <: AbstractArray
    } <: AbstractDQMCStack

    u_stack::Vector{GreensMatType}
    d_stack::Vector{Vector{Float64}}
    t_stack::Vector{GreensMatType}

    Ul::GreensMatType
    Ur::GreensMatType
    Dl::Vector{Float64}
    Dr::Vector{Float64}
    Tl::GreensMatType
    Tr::GreensMatType
    pivot::Vector{Int64}
    tempv::Vector{GreensElType}
    tempvf::Vector{Float64}

    greens::GreensMatType
    greens_temp::GreensMatType

    tmp1::GreensMatType
    tmp2::GreensMatType

    ranges::Array{UnitRange, 1}
    n_elements::Int
    current_slice::Int # running internally over 0:mc.parameters.slices+1, where 0 and mc.parameters.slices+1 are artifcial to prepare next sweep direction.
    direction::Int

    # # -------- Global update backup
    # gb_u_stack::Array{GreensElType, 3}
    # gb_d_stack::Matrix{Float64}
    # gb_t_stack::Array{GreensElType, 3}

    # gb_greens::GreensMatType
    # gb_log_det::Float64

    # gb_conf::Array{Float64, 3}
    # # --------

    # preallocated, reused arrays
    curr_U::GreensMatType
    eV::InteractionMatType

    # hopping matrices (mu included)
    hopping_matrix::HoppingMatType
    hopping_matrix_exp::HoppingMatType
    hopping_matrix_exp_inv::HoppingMatType
    hopping_matrix_exp_squared::HoppingMatType
    hopping_matrix_exp_inv_squared::HoppingMatType

    # checkerboard hopping matrices
    checkerboard::Matrix{Int} # src, trg, bondid
    groups::Vector{UnitRange}
    n_groups::Int
    chkr_hop_half::Vector{SparseMatrixCSC{HoppingElType, Int64}}
    chkr_hop_half_inv::Vector{SparseMatrixCSC{HoppingElType, Int64}}
    chkr_hop_half_dagger::Vector{SparseMatrixCSC{HoppingElType, Int64}}
    chkr_hop::Vector{SparseMatrixCSC{HoppingElType, Int64}} # without prefactor 0.5 in matrix exponentials
    chkr_hop_inv::Vector{SparseMatrixCSC{HoppingElType, Int64}}
    chkr_hop_dagger::Vector{SparseMatrixCSC{HoppingElType, Int64}}
    chkr_mu_half::SparseMatrixCSC{HoppingElType, Int64}
    chkr_mu_half_inv::SparseMatrixCSC{HoppingElType, Int64}
    chkr_mu::SparseMatrixCSC{HoppingElType, Int64}
    chkr_mu_inv::SparseMatrixCSC{HoppingElType, Int64}

    function DQMCStack{GET, HET, GMT, HMT, IMT}() where {
            GET<:Number, HET<:Number,
            GMT<:AbstractArray{GET}, HMT<:AbstractArray{HET}, IMT<:AbstractArray
        }
        @assert isconcretetype(GET);
        @assert isconcretetype(HET);
        @assert isconcretetype(GMT);
        @assert isconcretetype(HMT);
        @assert isconcretetype(IMT);
        @assert eltype(GMT) == GET;
        @assert eltype(HMT) == HET;
        new{GET, HET, GMT, HMT, IMT}()
    end
end

# type helpers
geltype(::DQMCStack{GET, HET, GMT, HMT, IMT}) where {GET, HET, GMT, HMT, IMT} = GET
heltype(::DQMCStack{GET, HET, GMT, HMT, IMT}) where {GET, HET, GMT, HMT, IMT} = HET
gmattype(::DQMCStack{GET, HET, GMT, HMT, IMT}) where {GET, HET, GMT, HMT, IMT} = GMT
hmattype(::DQMCStack{GET, HET, GMT, HMT, IMT}) where {GET, HET, GMT, HMT, IMT} = HMT
imattype(::DQMCStack{GET, HET, GMT, HMT, IMT}) where {GET, HET, GMT, HMT, IMT} = IMT

geltype(mc::DQMC) = geltype(mc.stack)
heltype(mc::DQMC) = heltype(mc.stack)
gmattype(mc::DQMC) = gmattype(mc.stack)
hmattype(mc::DQMC) = hmattype(mc.stack)
imattype(mc::DQMC) = imattype(mc.stack)

################################################################################
### Stack Initialization
################################################################################

function initialize_stack(mc::DQMC, ::DQMCStack)
    GreensElType = geltype(mc)
    GreensMatType = gmattype(mc)
    HoppingElType = heltype(mc)
    N = length(lattice(mc))
    flv = nflavors(mc.model)

    mc.stack.n_elements = convert(Int, mc.parameters.slices / mc.parameters.safe_mult) + 1

    mc.stack.u_stack = [GreensMatType(undef, flv*N, flv*N) for _ in 1:mc.stack.n_elements]
    mc.stack.d_stack = [zeros(Float64, flv*N) for _ in 1:mc.stack.n_elements]
    mc.stack.t_stack = [GreensMatType(undef, flv*N, flv*N) for _ in 1:mc.stack.n_elements]

    mc.stack.greens = GreensMatType(undef, flv*N, flv*N)
    mc.stack.greens_temp = GreensMatType(undef, flv*N, flv*N)

    # used in calculate_greens
    # do not change in slice_matrices.jl or interaction_matrix_exp!
    mc.stack.Ul = GreensMatType(I, flv*N, flv*N)
    mc.stack.Ur = GreensMatType(I, flv*N, flv*N)
    mc.stack.Tl = GreensMatType(I, flv*N, flv*N)
    mc.stack.Tr = GreensMatType(I, flv*N, flv*N)
    mc.stack.Dl = ones(Float64, flv*N)
    mc.stack.Dr = ones(Float64, flv*N)
    # can be changed anywhere
    mc.stack.pivot = Vector{Int64}(undef, flv*N)
    mc.stack.tempv = Vector{GreensElType}(undef, flv*N)
    mc.stack.tempvf = Vector{Float64}(undef, flv*N)

    # can be changed anywhere
    mc.stack.tmp1 = GreensMatType(undef, flv*N, flv*N)
    mc.stack.tmp2 = GreensMatType(undef, flv*N, flv*N)

    # # Global update backup
    # mc.stack.gb_u_stack = zero(mc.stack.u_stack)
    # mc.stack.gb_d_stack = zero(mc.stack.d_stack)
    # mc.stack.gb_t_stack = zero(mc.stack.t_stack)
    # mc.stack.gb_greens = zero(mc.stack.greens)
    # mc.stack.gb_log_det = 0.
    # mc.stack.gb_conf = zero(mc.conf)

    mc.stack.ranges = UnitRange[]

    for i in 1:mc.stack.n_elements - 1
        push!(mc.stack.ranges, 1 + (i - 1) * mc.parameters.safe_mult:i * mc.parameters.safe_mult)
    end

    mc.stack.curr_U = GreensMatType(undef, flv*N, flv*N)
    mc.stack.eV = init_interaction_matrix(mc.model)

    nothing
end

# hopping
function init_hopping_matrices(mc::DQMC{M,CB}, m::Model) where {M, CB<:Checkerboard}
    init_hopping_matrix_exp(mc, m)
    CB <: CheckerboardTrue && init_checkerboard_matrices(mc, m)
    nothing
end
function init_hopping_matrix_exp(mc::DQMC, m::Model)
    N = length(lattice(m))
    flv = nflavors(m)
    dtau = mc.parameters.delta_tau

    T = hopping_matrix(mc, m)
    size(T) == (flv*N, flv*N) || error("Hopping matrix should have size "*
                                "$((flv*N, flv*N)) but has size $(size(T)) .")
    mc.stack.hopping_matrix = T
    mc.stack.hopping_matrix_exp = exp(-0.5 * dtau * T)
    mc.stack.hopping_matrix_exp_inv = exp(0.5 * dtau * T)
    mc.stack.hopping_matrix_exp_squared = mc.stack.hopping_matrix_exp * mc.stack.hopping_matrix_exp
    mc.stack.hopping_matrix_exp_inv_squared = mc.stack.hopping_matrix_exp_inv * mc.stack.hopping_matrix_exp_inv
    nothing
end

# checkerboard
rem_eff_zeros!(X::AbstractArray) = map!(e -> abs.(e)<1e-15 ? zero(e) : e,X,X)
function init_checkerboard_matrices(mc::DQMC, m::Model)
    s = mc.stack
    l = lattice(m)
    flv = nflavors(m)
    H = heltype(mc)
    N = length(l)
    dtau = mc.parameters.delta_tau
    mu = m.mu

    s.checkerboard, s.groups, s.n_groups = build_checkerboard(l)
    n_grps = s.n_groups
    cb = s.checkerboard

    T = reshape(hopping_matrix(mc, m), (N, flv, N, flv))

    s.chkr_hop_half = Vector{SparseMatrixCSC{H, Int}}(undef, n_grps)
    s.chkr_hop_half_inv = Vector{SparseMatrixCSC{H, Int}}(undef, n_grps)
    s.chkr_hop = Vector{SparseMatrixCSC{H, Int}}(undef, n_grps)
    s.chkr_hop_inv = Vector{SparseMatrixCSC{H, Int}}(undef, n_grps)

    for (g, gr) in enumerate(s.groups)
        Tg = zeros(H, N, flv, N, flv)
        for i in gr
            src, trg = cb[1:2,i]
            for f1 in 1:flv, f2 in 1:flv
                Tg[trg, f1, src, f2] = T[trg, f1, src, f2]
            end
        end

        Tgg = reshape(Tg, (N*flv, N*flv))
        s.chkr_hop_half[g] = sparse(rem_eff_zeros!(exp(-0.5 * dtau * Tgg)))
        s.chkr_hop_half_inv[g] = sparse(rem_eff_zeros!(exp(0.5 * dtau * Tgg)))
        s.chkr_hop[g] = sparse(rem_eff_zeros!(exp(- dtau * Tgg)))
        s.chkr_hop_inv[g] = sparse(rem_eff_zeros!(exp(dtau * Tgg)))
    end

    s.chkr_hop_half_dagger = adjoint.(s.chkr_hop_half)
    s.chkr_hop_dagger = adjoint.(s.chkr_hop)

    mus = diag(reshape(T, (N*flv, N*flv)))
    s.chkr_mu_half = spdiagm(0 => exp.(-0.5 * dtau * mus))
    s.chkr_mu_half_inv = spdiagm(0 => exp.(0.5 * dtau * mus))
    s.chkr_mu = spdiagm(0 => exp.(-dtau * mus))
    s.chkr_mu_inv = spdiagm(0 => exp.(dtau * mus))

    # hop_mat_exp_chkr = foldl(*,s.chkr_hop_half) * sqrt.(s.chkr_mu)
    # r = effreldiff(s.hopping_matrix_exp,hop_mat_exp_chkr)
    # r[find(x->x==zero(x),hop_mat_exp_chkr)] = 0.
    # println("Checkerboard - Exact ≈ ", round(maximum(absdiff(s.hopping_matrix_exp,hop_mat_exp_chkr)), 4))
    nothing
end

"""
    build_stack(mc::DQMC)

Build slice matrix stack from scratch.
"""
@bm function build_stack(mc::DQMC, ::DQMCStack)
    copyto!(mc.stack.u_stack[1], I)
    mc.stack.d_stack[1] .= one(eltype(mc.stack.d_stack[1]))
    copyto!(mc.stack.t_stack[1], I)

    @inbounds for i in 1:length(mc.stack.ranges)
        add_slice_sequence_left(mc, i)
    end

    mc.stack.current_slice = mc.parameters.slices + 1
    mc.stack.direction = -1

    nothing
end

@bm function reverse_build_stack(mc::DQMC, ::DQMCStack)
    copyto!(mc.stack.u_stack[end], I)
    mc.stack.d_stack[end] .= one(eltype(mc.stack.d_stack[end]))
    copyto!(mc.stack.t_stack[end], I)

    @inbounds for i in length(mc.stack.ranges):-1:1
        add_slice_sequence_right(mc, i)
    end

    mc.stack.current_slice = 0
    mc.stack.direction = 1

    nothing
end

################################################################################
### Slice matrix stack manipulations/updates
################################################################################

"""
    add_slice_sequence_left(mc::DQMC, idx)

Computes the next `mc.parameters.safe_mult` slice matrix products from the current `idx`
and writes them to `idx+1`. The index `idx` does not refer to the slice index,
but `mc.parameters.safe_mult` times the slice index.
"""
@bm function add_slice_sequence_left(mc::DQMC, idx::Int)
    @inbounds begin
        copyto!(mc.stack.curr_U, mc.stack.u_stack[idx])

        # println("Adding slice seq left $idx = ", mc.stack.ranges[idx])
        for slice in mc.stack.ranges[idx]
            multiply_slice_matrix_left!(mc, mc.model, slice, mc.stack.curr_U)
        end

        vmul!(mc.stack.tmp1, mc.stack.curr_U, Diagonal(mc.stack.d_stack[idx]))
        udt_AVX_pivot!(
            mc.stack.u_stack[idx + 1], mc.stack.d_stack[idx + 1], mc.stack.tmp1,
            mc.stack.pivot, mc.stack.tempv
        )
        vmul!(mc.stack.t_stack[idx + 1], mc.stack.tmp1, mc.stack.t_stack[idx])
    end
end

"""
    add_slice_sequence_right(mc::DQMC, idx)

Computes the next `mc.parameters.safe_mult` slice matrix products from the current
`idx+1` and writes them to `idx`. The index `idx` does not refer to the slice
index, but `mc.parameters.safe_mult` times the slice index.
"""
@bm function add_slice_sequence_right(mc::DQMC, idx::Int)
    @inbounds begin
        copyto!(mc.stack.curr_U, mc.stack.u_stack[idx + 1])

        for slice in reverse(mc.stack.ranges[idx])
            multiply_daggered_slice_matrix_left!(mc, mc.model, slice, mc.stack.curr_U)
        end

        vmul!(mc.stack.tmp1, mc.stack.curr_U, Diagonal(mc.stack.d_stack[idx + 1]))
        udt_AVX_pivot!(
            mc.stack.u_stack[idx], mc.stack.d_stack[idx], mc.stack.tmp1, mc.stack.pivot, mc.stack.tempv
        )
        vmul!(mc.stack.t_stack[idx], mc.stack.tmp1, mc.stack.t_stack[idx + 1])
    end
end

################################################################################
### Green's function calculation
################################################################################

"""
    calculate_greens_AVX!(Ul, Dl, Tl, Ur, Dr, Tr, G[, pivot, temp])

Calculates the effective Greens function matrix `G` from two UDT decompositions
`Ul, Dl, Tl` and `Ur, Dr, Tr`. Additionally a `pivot` vector can be given. Note
that all inputs will be overwritten.

The UDT should follow from a set of slice_matrix multiplications, such that
`Ur, Dr, Tr = udt(B(slice)' ⋯ B(M)')` and `Ul, Dl, Tl = udt(B(slice-1) ⋯ B(1))`.
The computed Greens function is then given as `G = inv(I + Ul Dl Tl Tr Dr Ur)`
and computed here.

`Ul, Tl, Ur, Tr, G` should be square matrices, `Dl, Dr` real Vectors (from
Diagonal matrices), `pivot` an integer Vector and `temp` a Vector with the same
element type as the matrices.
"""
@bm function calculate_greens_AVX!(
        Ul, Dl, Tl, Ur, Dr, Tr, G::AbstractArray{T},
        pivot = Vector{Int64}(undef, length(Dl)),
        temp = Vector{T}(undef, length(Dl))
    ) where T
    # @bm "B1" begin
        # Used: Ul, Dl, Tl, Ur, Dr, Tr
        # TODO: [I + Ul Dl Tl Tr^† Dr Ur^†]^-1
        # Compute: Dl * ((Tl * Tr) * Dr) -> Tr * Dr * G   (UDT)
        vmul!(G, Tl, adjoint(Tr))
        vmul!(Tr, G, Diagonal(Dr))
        vmul!(G, Diagonal(Dl), Tr)
        udt_AVX_pivot!(Tr, Dr, G, pivot, temp, Val(false)) # Dl available
    # end

    # @bm "B2" begin
        # Used: Ul, Ur, G, Tr, Dr  (Ul, Ur, Tr unitary (inv = adjoint))
        # TODO: [I + Ul Tr Dr G Ur^†]^-1
        #     = [(Ul Tr) ((Ul Tr)^-1 (G Ur^†) + Dr) (G Ur)]^-1
        #     = Ur G^-1 [(Ul Tr)^† Ur G^-1 + Dr]^-1 (Ul Tr)^†
        # Compute: Ul Tr -> Tl
        #          (Ur G^-1) -> Ur
        #          ((Ul Tr)^† Ur G^-1) -> Tr
        vmul!(Tl, Ul, Tr)
        rdivp!(Ur, G, Ul, pivot) # requires unpivoted udt decompostion (Val(false))
        vmul!(Tr, adjoint(Tl), Ur)
    # end

    # @bm "B3" begin
        # Used: Tl, Ur, Tr, Dr
        # TODO: Ur [Tr + Dr]^-1 Tl^† -> Ur [Tr]^-1 Tl^†
        rvadd!(Tr, Diagonal(Dr))
    # end

    # @bm "B4" begin
        # Used: Ur, Tr, Tl
        # TODO: Ur [Tr]^-1 Tl^† -> Ur [Ul Dr Tr]^-1 Tl^†
        #    -> Ur Tr^-1 Dr^-1 Ul^† Tl^† -> Ur Tr^-1 Dr^-1 (Tl Ul)^†
        # Compute: Ur Tr^-1 -> Ur,  Tl Ul -> Tr
        udt_AVX_pivot!(Ul, Dr, Tr, pivot, temp, Val(false)) # Dl available
        rdivp!(Ur, Tr, G, pivot) # requires unpivoted udt decompostion (false)
        vmul!(Tr, Tl, Ul)
    # end

    # @bm "B5" begin
        @turbo for i in eachindex(Dr)
            Dl[i] = 1.0 / Dr[i]
        end
    # end

    # @bm "B6" begin
        # Used: Ur, Tr, Dl, Ul, Tl
        # TODO: (Ur Dl) Tr^† -> G
        vmul!(Ul, Ur, Diagonal(Dl))
        vmul!(G, Ul, adjoint(Tr))
    # end
end

"""
    calculate_greens(mc::DQMC)

Computes the effective greens function from the current state of the stack and
saves the result to `mc.stack.greens`.

This assumes the `mc.stack.Ul, mc.stack.Dl, mc.stack.Tl = udt(B(slice-1) ⋯ B(1))` and
`mc.stack.Ur, mc.stack.Dr, mc.stack.Tr = udt(B(slice)' ⋯ B(M)')`.

This should only used internally.
"""
@bm function calculate_greens(mc::DQMC, output::AbstractMatrix = mc.stack.greens)
    calculate_greens_AVX!(
        mc.stack.Ul, mc.stack.Dl, mc.stack.Tl,
        mc.stack.Ur, mc.stack.Dr, mc.stack.Tr,
        output, mc.stack.pivot, mc.stack.tempv
    )
    output
end

"""
    calculate_greens(mc::DQMC, slice[, output=mc.stack.greens, safe_mult])

Compute the effective equal-time greens function from scratch at a given `slice`.

This does not invalidate the stack, but it does overwrite `mc.stack.greens`.
"""
@bm function calculate_greens(
        mc::DQMC, slice::Int, output::AbstractMatrix = mc.stack.greens,
        conf::AbstractArray = mc.conf, safe_mult::Int = mc.parameters.safe_mult
    )
    copyto!(mc.stack.curr_U, I)
    copyto!(mc.stack.Ur, I)
    mc.stack.Dr .= one(eltype(mc.stack.Dr))
    copyto!(mc.stack.Tr, I)

    # Calculate Ur,Dr,Tr=B(slice)' ... B(M)'
    if slice+1 <= mc.parameters.slices
        start = slice+1
        stop = mc.parameters.slices
        for k in reverse(start:stop)
            if mod(k,safe_mult) == 0
                multiply_daggered_slice_matrix_left!(mc, mc.model, k, mc.stack.curr_U, conf)
                vmul!(mc.stack.tmp1, mc.stack.curr_U, Diagonal(mc.stack.Dr))
                udt_AVX_pivot!(mc.stack.curr_U, mc.stack.Dr, mc.stack.tmp1, mc.stack.pivot, mc.stack.tempv)
                copyto!(mc.stack.tmp2, mc.stack.Tr)
                vmul!(mc.stack.Tr, mc.stack.tmp1, mc.stack.tmp2)
            else
                multiply_daggered_slice_matrix_left!(mc, mc.model, k, mc.stack.curr_U, conf)
            end
        end
        vmul!(mc.stack.tmp1, mc.stack.curr_U, Diagonal(mc.stack.Dr))
        udt_AVX_pivot!(mc.stack.Ur, mc.stack.Dr, mc.stack.tmp1, mc.stack.pivot, mc.stack.tempv)
        copyto!(mc.stack.tmp2, mc.stack.Tr)
        vmul!(mc.stack.Tr, mc.stack.tmp1, mc.stack.tmp2)
    end

    copyto!(mc.stack.curr_U, I)
    copyto!(mc.stack.Ul, I)
    mc.stack.Dl .= one(eltype(mc.stack.Dl))
    copyto!(mc.stack.Tl, I)

    # Calculate Ul,Dl,Tl=B(slice-1) ... B(1)
    if slice >= 1
        start = 1
        stop = slice
        for k in start:stop
            if mod(k,safe_mult) == 0
                multiply_slice_matrix_left!(mc, mc.model, k, mc.stack.curr_U, conf)
                vmul!(mc.stack.tmp1, mc.stack.curr_U, Diagonal(mc.stack.Dl))
                udt_AVX_pivot!(mc.stack.curr_U, mc.stack.Dl, mc.stack.tmp1, mc.stack.pivot, mc.stack.tempv)
                copyto!(mc.stack.tmp2, mc.stack.Tl)
                vmul!(mc.stack.Tl, mc.stack.tmp1, mc.stack.tmp2)
            else
                multiply_slice_matrix_left!(mc, mc.model, k, mc.stack.curr_U, conf)
            end
        end
        vmul!(mc.stack.tmp1, mc.stack.curr_U, Diagonal(mc.stack.Dl))
        udt_AVX_pivot!(mc.stack.Ul, mc.stack.Dl, mc.stack.tmp1, mc.stack.pivot, mc.stack.tempv)
        copyto!(mc.stack.tmp2, mc.stack.Tl)
        vmul!(mc.stack.Tl, mc.stack.tmp1, mc.stack.tmp2)
    end

    return calculate_greens(mc, output)
end

################################################################################
### Stack update
################################################################################

# Green's function propagation
@inline @bm function wrap_greens!(mc::DQMC, gf, curr_slice::Int, direction::Int)
    if direction == -1
        multiply_slice_matrix_inv_left!(mc, mc.model, curr_slice - 1, gf)
        multiply_slice_matrix_right!(mc, mc.model, curr_slice - 1, gf)
    else
        multiply_slice_matrix_left!(mc, mc.model, curr_slice, gf)
        multiply_slice_matrix_inv_right!(mc, mc.model, curr_slice, gf)
    end
    nothing
end

@bm function propagate(mc::DQMC)
    @inbounds if mc.stack.direction == 1
        if mod(mc.stack.current_slice, mc.parameters.safe_mult) == 0
            mc.stack.current_slice +=1 # slice we are going to
            if mc.stack.current_slice == 1
                copyto!(mc.stack.Ur, mc.stack.u_stack[1])
                copyto!(mc.stack.Dr, mc.stack.d_stack[1])
                copyto!(mc.stack.Tr, mc.stack.t_stack[1])
                copyto!(mc.stack.u_stack[1], I)
                mc.stack.d_stack[1] .= one(eltype(mc.stack.d_stack[1]))
                copyto!(mc.stack.t_stack[1], I)
                copyto!(mc.stack.Ul, mc.stack.u_stack[1])
                copyto!(mc.stack.Dl, mc.stack.d_stack[1])
                copyto!(mc.stack.Tl, mc.stack.t_stack[1])

                calculate_greens(mc) # greens_1 ( === greens_{m+1} )

            elseif 1 < mc.stack.current_slice <= mc.parameters.slices
                idx = Int((mc.stack.current_slice - 1)/mc.parameters.safe_mult)

                copyto!(mc.stack.Ur, mc.stack.u_stack[idx+1])
                copyto!(mc.stack.Dr, mc.stack.d_stack[idx+1])
                copyto!(mc.stack.Tr, mc.stack.t_stack[idx+1])
                add_slice_sequence_left(mc, idx)
                copyto!(mc.stack.Ul, mc.stack.u_stack[idx+1])
                copyto!(mc.stack.Dl, mc.stack.d_stack[idx+1])
                copyto!(mc.stack.Tl, mc.stack.t_stack[idx+1])

                if mc.parameters.check_propagation_error
                    copyto!(mc.stack.greens_temp, mc.stack.greens)
                end

                # Should this be mc.stack.greens_temp?
                # If so, shouldn't this only run w/ mc.parameters.all_checks = true?
                wrap_greens!(mc, mc.stack.greens_temp, mc.stack.current_slice - 1, 1)

                calculate_greens(mc) # greens_{slice we are propagating to}

                if mc.parameters.check_propagation_error
                    # OPT: could probably be optimized through explicit loop
                    greensdiff = maximum(abs.(mc.stack.greens_temp - mc.stack.greens))
                    if greensdiff > 1e-7
                        push!(mc.analysis.propagation_error, greensdiff)
                        mc.parameters.silent || @printf(
                            "->%d \t+1 Propagation instability\t %.1e\n",
                            mc.stack.current_slice, greensdiff
                        )
                    end
                end

            else # we are going to mc.parameters.slices+1
                idx = mc.stack.n_elements - 1
                add_slice_sequence_left(mc, idx)
                mc.stack.direction = -1
                mc.stack.current_slice = mc.parameters.slices+1 # redundant
                propagate(mc)
            end

        else
            # Wrapping
            wrap_greens!(mc, mc.stack.greens, mc.stack.current_slice, 1)
            mc.stack.current_slice += 1
        end

    else # mc.stack.direction == -1
        if mod(mc.stack.current_slice-1, mc.parameters.safe_mult) == 0
            mc.stack.current_slice -= 1 # slice we are going to
            if mc.stack.current_slice == mc.parameters.slices
                copyto!(mc.stack.Ul, mc.stack.u_stack[end])
                copyto!(mc.stack.Dl, mc.stack.d_stack[end])
                copyto!(mc.stack.Tl, mc.stack.t_stack[end])
                copyto!(mc.stack.u_stack[end], I)
                mc.stack.d_stack[end] .= one(eltype(mc.stack.d_stack[end]))
                copyto!(mc.stack.t_stack[end], I)
                copyto!(mc.stack.Ur, mc.stack.u_stack[end])
                copyto!(mc.stack.Dr, mc.stack.d_stack[end])
                copyto!(mc.stack.Tr, mc.stack.t_stack[end])

                calculate_greens(mc) # greens_{mc.parameters.slices+1} === greens_1

                # wrap to greens_{mc.parameters.slices}
                wrap_greens!(mc, mc.stack.greens, mc.stack.current_slice + 1, -1)

            elseif 0 < mc.stack.current_slice < mc.parameters.slices
                idx = Int(mc.stack.current_slice / mc.parameters.safe_mult) + 1

                copyto!(mc.stack.Ul, mc.stack.u_stack[idx])
                copyto!(mc.stack.Dl, mc.stack.d_stack[idx])
                copyto!(mc.stack.Tl, mc.stack.t_stack[idx])
                add_slice_sequence_right(mc, idx)
                copyto!(mc.stack.Ur, mc.stack.u_stack[idx])
                copyto!(mc.stack.Dr, mc.stack.d_stack[idx])
                copyto!(mc.stack.Tr, mc.stack.t_stack[idx])

                if mc.parameters.check_propagation_error
                    copyto!(mc.stack.greens_temp, mc.stack.greens)
                end

                calculate_greens(mc)

                if mc.parameters.check_propagation_error
                    # OPT: could probably be optimized through explicit loop
                    greensdiff = maximum(abs.(mc.stack.greens_temp - mc.stack.greens))
                    if greensdiff > 1e-7
                        push!(mc.analysis.propagation_error, greensdiff)
                        mc.parameters.silent || @printf(
                            "->%d \t-1 Propagation instability\t %.1e\n",
                            mc.stack.current_slice, greensdiff
                        )
                    end
                end

                wrap_greens!(mc, mc.stack.greens, mc.stack.current_slice + 1, -1)

            else # we are going to 0
                idx = 1
                add_slice_sequence_right(mc, idx)
                mc.stack.direction = 1
                mc.stack.current_slice = 0 # redundant
                propagate(mc)
            end

        else
            # Wrapping
            wrap_greens!(mc, mc.stack.greens, mc.stack.current_slice, -1)
            mc.stack.current_slice -= 1
        end
    end
    nothing
end