use strict;
use warnings;

package Clownfish::Binding::Core::Method;
use Clownfish::Util qw( a_isa_b );
use Carp;

sub method_def {
    my ( undef,   %args )  = @_;
    my ( $method, $class ) = @args{qw( method class )};
    confess("Not a Method")
        unless a_isa_b( $method, "Clownfish::Method" );
    confess("Not a Class")
        unless a_isa_b( $class, "Clownfish::Class" );
    if ( $method->final ) {
        return _final_method_def( $method, $class );
    }
    else {
        return _virtual_method_def( $method, $class );
    }
}

sub _virtual_method_def {
    my ( $method, $class ) = @_;
    my $cnick           = $class->get_cnick;
    my $param_list      = $method->get_param_list;
    my $invoker_struct  = $class->full_struct_sym;
    my $common_struct   = $method->self_type->get_specifier;
    my $full_method_sym = $method->full_method_sym($cnick);
    my $full_offset_sym = $method->full_offset_sym($cnick);
    my $typedef         = $method->full_typedef;
    my $arg_names       = $param_list->name_list;
    $arg_names =~ s/\s*\w+/self/;

    # Prepare the parameter list for the inline function.
    my $params = $param_list->to_c;
    $params =~ s/^.*?\*\s*\w+/const $invoker_struct *self/
        or confess("no match: $params");

    # Prepare a return statement... or not.
    my $return_type = $method->get_return_type->to_c;
    my $maybe_return = $method->get_return_type->is_void ? '' : 'return ';

    return <<END_STUFF;
extern size_t $full_offset_sym;
static CHY_INLINE $return_type
$full_method_sym($params)
{
    char *const method_address = *(char**)self + $full_offset_sym;
    const $typedef method = *(($typedef*)method_address);
    ${maybe_return}method(($common_struct*)$arg_names);
}
END_STUFF
}

# Create a macro definition that aliases to a function name directly, since
# this method may not be overridden.
sub _final_method_def {
    my ( $method, $class ) = @_;
    my $cnick           = $class->get_cnick;
    my $macro_sym       = $method->get_macro_sym;
    my $self_type       = $method->self_type->to_c;
    my $full_method_sym = $method->full_method_sym($cnick);
    my $full_func_sym   = $method->full_func_sym;
    my $arg_names       = $method->get_param_list->name_list;

    return <<END_STUFF;
#define $full_method_sym($arg_names) \\
    $full_func_sym(($self_type)$arg_names)
END_STUFF
}

sub typedef_dec {
    my ( undef, $method ) = @_;
    my $params      = $method->get_param_list->to_c;
    my $return_type = $method->get_return_type->to_c;
    my $typedef     = $method->full_typedef;
    return <<END_STUFF;
typedef $return_type
(*$typedef)($params);
END_STUFF
}

sub callback_dec {
    my ( undef, $method ) = @_;
    my $callback_sym = $method->full_callback_sym;
    return qq|extern cfish_Callback $callback_sym;\n|;
}

sub callback_obj_def {
    my ( undef, %args ) = @_;
    my $method       = $args{method};
    my $offset       = $args{offset};
    my $macro_sym    = $method->get_macro_sym;
    my $len          = length($macro_sym);
    my $func_sym     = $method->full_override_sym;
    my $callback_sym = $method->full_callback_sym;
    return qq|cfish_Callback $callback_sym = |
        . qq|{"$macro_sym", $len, (cfish_method_t)$func_sym, $offset};\n|;
}

sub callback_def {
    my ( undef, $method ) = @_;
    my $return_type = $method->get_return_type;
    my $params      = _callback_params($method);
    if ( !$params ) {
        # Can't map vars, because there's at least one type in the argument
        # list we don't yet support.  Return a callback wrapper that throws an
        # error error.
        return _invalid_callback_def( $method, $params );
    }
    elsif ( $return_type->is_void ) {
        return _void_callback_def( $method, $params );
    }
    elsif ( $return_type->is_object ) {
        return _obj_callback_def( $method, $params );
    }
    else {
        return _primitive_callback_def( $method, $params );
    }
}

# Return a string which maps arguments to various arg wrappers conforming
# to Host's callback interface.  For instance, (int32_t foo, Obj *bar)
# produces the following:
#
#   CFISH_ARG_I32("foo", foo),
#   CFISH_ARG_OBJ("bar", bar)
#
sub _callback_params {
    my $method     = shift;
    my $micro_sym  = $method->micro_sym;
    my $param_list = $method->get_param_list;
    my $num_params = $param_list->num_vars - 1;
    my $arg_vars   = $param_list->get_variables;
    my @params;

    # Iterate over arguments, mapping them to various arg wrappers which
    # conform to Host's callback interface.
    for my $var ( @$arg_vars[ 1 .. $#$arg_vars ] ) {
        my $name = $var->micro_sym;
        my $type = $var->get_type;
        my $param;
        if ( $type->is_string_type ) {
            $param = qq|CFISH_ARG_STR("$name", $name)|;
        }
        elsif ( $type->is_object ) {
            $param = qq|CFISH_ARG_OBJ("$name", $name)|;
        }
        elsif ( $type->is_integer ) {
            $param
                = $type->sizeof > 4
                ? qq|CFISH_ARG_I64("$name", $name)|
                : qq|CFISH_ARG_I32("$name", $name)|;
        }
        elsif ( $type->is_floating ) {
            $param = qq|CFISH_ARG_F64("$name", $name)|;
        }
        else {
            # Can't map variable type.  Signal to caller.
            return undef;
        }
        push @params, $param;
    }
    return join( ', ', 'self', qq|"$micro_sym"|, $num_params, @params );
}

# Return a function which throws a runtime error indicating which variable
# couldn't be mapped.  TODO: it would be better to resolve all these cases at
# compile-time.
sub _invalid_callback_def {
    my ( $method, $callback_params ) = @_;
    my $full_method_sym
        = $method->full_method_sym( $method->get_class_cnick );
    my $override_sym = $method->full_override_sym;
    my $params       = $method->get_param_list->to_c;
    my $unused       = '';
    for my $var ( @{ $method->get_param_list->get_variables } ) {
        my $var_name = $var->micro_sym;
        $unused .= "CHY_UNUSED_VAR($var_name); ";
    }
    return <<END_CALLBACK_DEF;
void
$override_sym($params)
{
    $unused;
    CFISH_THROW(CFISH_ERR, "Can't override $full_method_sym via binding");
}
END_CALLBACK_DEF
}

# Create a callback for a method which operates in a void context.
sub _void_callback_def {
    my ( $method, $callback_params ) = @_;
    my $override_sym = $method->full_override_sym;
    my $params       = $method->get_param_list->to_c;
    return <<END_CALLBACK_DEF;
void
$override_sym($params)
{
    cfish_Host_callback($callback_params);
}
END_CALLBACK_DEF
}

# Create a callback which returns a primitive type.
sub _primitive_callback_def {
    my ( $method, $callback_params ) = @_;
    my $override_sym    = $method->full_override_sym;
    my $params          = $method->get_param_list->to_c;
    my $return_type     = $method->get_return_type;
    my $return_type_str = $return_type->to_c;
    my $nat_func
        = $return_type->is_floating ? "cfish_Host_callback_f64"
        : $return_type->is_integer  ? "cfish_Host_callback_i64"
        : $return_type_str eq 'void*' ? "cfish_Host_callback_host"
        :   confess("unrecognized type: $return_type_str");
    return <<END_CALLBACK_DEF;
$return_type_str
$override_sym($params)
{
    return ($return_type_str)$nat_func($callback_params);
}
END_CALLBACK_DEF
}

# Create a callback which returns an object type -- either a generic object or
# a string.
sub _obj_callback_def {
    my ( $method, $callback_params ) = @_;
    my $override_sym    = $method->full_override_sym;
    my $params          = $method->get_param_list->to_c;
    my $return_type     = $method->get_return_type;
    my $return_type_str = $return_type->to_c;
    my $cb_func_name
        = $return_type->is_string_type
        ? "cfish_Host_callback_str"
        : "cfish_Host_callback_obj";

    my $nullable_check = "";
    if ( !$return_type->nullable ) {
        my $macro_sym = $method->get_macro_sym;
        $nullable_check
            = qq|if (!retval) { CFISH_THROW(CFISH_ERR, |
            . qq|"$macro_sym() for class '%o' cannot return NULL", |
            . qq|Cfish_Obj_Get_Class_Name((cfish_Obj*)self)); }\n    |;
    }

    my $decrement = "";
    if ( !$return_type->incremented ) {
        $decrement = "KINO_DECREF(retval);\n    ";
    }

    return <<END_CALLBACK_DEF;
$return_type_str
$override_sym($params)
{
    $return_type_str retval = ($return_type_str)$cb_func_name($callback_params);
    ${nullable_check}${decrement}return retval;
}
END_CALLBACK_DEF
}

# Create a function which throws a runtime error indicating that a method is
# abstract.  This serves as the implementation for methods which are
# declared as "abstract" in a Clownfish header file.
sub abstract_method_def {
    my ( undef, $method ) = @_;
    my $params          = $method->get_param_list->to_c;
    my $full_func_sym   = $method->full_func_sym;
    my $vtable          = uc( $method->self_type->get_specifier );
    my $return_type     = $method->get_return_type;
    my $return_type_str = $return_type->to_c;
    my $macro_sym       = $method->get_macro_sym;

    # Build list of unused params and create an unreachable return statement
    # if necessary, in order to thwart compiler warnings.
    my $param_vars = $method->get_param_list->get_variables;
    my $unused     = "";
    for ( my $i = 1; $i < @$param_vars; $i++ ) {
        my $var_name = $param_vars->[$i]->micro_sym;
        $unused .= "\n    CHY_UNUSED_VAR($var_name);";
    }
    my $ret_statement = '';
    if ( !$return_type->is_void ) {
        $ret_statement = "\n    CHY_UNREACHABLE_RETURN($return_type_str);";
    }

    return <<END_ABSTRACT_DEF;
$return_type_str
$full_func_sym($params)
{
    cfish_CharBuf *klass = self ? Cfish_Obj_Get_Class_Name((cfish_Obj*)self) : $vtable->name;$unused
    CFISH_THROW(CFISH_ERR, "Abstract method '$macro_sym' not defined by %o", klass);$ret_statement
}
END_ABSTRACT_DEF
}

1;

__END__

__POD__

=head1 NAME

Clownfish::Binding::Core::Method - Generate core C code for a method.

=head1 DESCRIPTION

Clownfish::Method is an abstract specification; this class generates C code
which implements the specification.

=head1 METHODS

=head2 method_def

    my $c_code = Clownfish::Binding::Core::Method->method_def(
        method => $method,
        $class => $class,
    );

Return C code for the static inline vtable method invocation function.  

=over

=item * B<method> - A L<Clownfish::Method>.

=item * B<class> - The L<Clownfish::Class> which will be invoking the method -
LobsterClaw needs its own method invocation function even if the method was
defined in Claw.

=back

=head2 typedef_dec

    my $c_code = Clownfish::Binding::Core::Method->typedef_dec($method);

Return C code expressing a typedef declaration for the method.

=head2 callback_dec

    my $c_code = Clownfish::Binding::Core::Method->callback_dec($method);

Return C code declaring the Callback object for this method.

=head2 callback_obj_def

    my $c_code 
        = Clownfish::Binding::Core::Method->callback_obj_def($method);

Return C code defining the Callback object for this method, which stores
introspection data and a pointer to the callback function.

=head2 callback_def

    my $c_code = Clownfish::Binding::Core::Method->callback_def($method);

Return C code implementing a callback to the Host for this method.  This code
is used when a Host method has overridden a method in a Clownfish class.

=head2 abstract_method_def

    my $c_code 
        = Clownfish::Binding::Core::Method->abstract_method_def($method);

Return C code implementing a version of the method which throws an "abstract
method" error at runtime.

=head1 COPYRIGHT AND LICENSE

Copyright 2008-2010 Marvin Humphrey

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut