File Coverage

blib/lib/Wasm/Wasmtime/Func.pm

Criterion	Covered	Total	%
statement	52	52	100.0
branch	4	4	100.0
condition			n/a
subroutine	18	18	100.0
pod	1	1	100.0
total	75	75	100.0

package Wasm::Wasmtime::Func;

use strict;
use warnings;
use 5.008004;
use base qw( Wasm::Wasmtime::Extern );
use Ref::Util qw( is_blessed_ref is_plain_arrayref );
use Wasm::Wasmtime::FFI;
use Wasm::Wasmtime::FuncType;
use Wasm::Wasmtime::Trap;
use FFI::C::Util qw( set_array_count addressof );
use Sub::Install;
use Carp ();
use constant is_func => 1;
use constant kind => 'func';
use overload
  '&{}' => sub { my $self = shift; sub { $self->call(@_) } },
  bool => sub { 1 },
  fallback => 1;
  ;

# ABSTRACT: Wasmtime function class
our $VERSION = '0.23'; # VERSION


$ffi_prefix = 'wasm_func_';
$ffi->load_custom_type('::PtrObject' => 'wasm_func_t' => __PACKAGE__);


$ffi->attach( [ wasmtime_func_new => 'new' ] => ['wasm_store_t', 'wasm_functype_t', '(opaque,opaque,opaque)->opaque'] => 'wasm_func_t' => sub {
  my $xsub = shift;
  my $class = shift;
  if(is_blessed_ref $_[0] && $_[0]->isa('Wasm::Wasmtime::Store'))
  {
    my $store = shift;
    my($functype, $cb) = is_plain_arrayref($_[0])
       ? (Wasm::Wasmtime::FuncType->new($_[0], $_[1]), $_[2])
       : @_;

    my $param_arity  = scalar $functype->params;
    my $result_arity = scalar$functype->results;

    require Wasm::Wasmtime::Caller;
    my $wrapper = $ffi->closure(sub {
      my($caller, $params, $results) = @_;
      $caller = Wasm::Wasmtime::Caller->new($caller);
      unshift @Wasm::Wasmtime::Caller::callers, $caller;

      my @args = $param_arity ? do {
        my $args = Wasm::Wasmtime::ValVec->from_c($params);
        $args->to_perl;
      } : ();

      local $@ = '';
      my @ret = eval {
        $cb->(@args);
      };
      if(my $error = $@)
      {
        my $trap = is_blessed_ref $error && $error->isa('Wasm::Wasmtime::Trap')
          ? $error
          : Wasm::Wasmtime::Trap->new($store, "$error\0");
        delete $caller->{ptr};
        shift @Wasm::Wasmtime::Caller::callers;
        return delete $trap->{ptr};
      }
      else
      {
        if($result_arity)
        {
          $results = Wasm::Wasmtime::ValVec->from_c($results);
          my @types = $functype->results;
          foreach my $i (0..$#types)
          {
            my $kind = $types[$i]->kind;
            my $result = $results->get($i);
            $result->kind($types[$i]->kind_num);
            $result->of->$kind(shift @ret);
          }
        }
        delete $caller->{ptr};
        shift @Wasm::Wasmtime::Caller::callers;
        return undef;
      }
    });
    my $self = $xsub->($store, $functype, $wrapper);
    $self->{store} = $store;
    $self->{wrapper} = $wrapper;
    return $self;
  }
  else
  {
    my ($ptr, $owner) = @_;
    bless {
      ptr     => $ptr,
      owner   => $owner,
    }, $class;
  }
});


$ffi->attach( call => ['wasm_func_t', 'record(Wasm::Wasmtime::Vec)*', 'record(Wasm::Wasmtime::Vec)*'] => 'wasm_trap_t' => sub {
  my $xsub = shift;
  my $self = shift;
  my @params = $self->type->params;
  my $args = Wasm::Wasmtime::ValVec->from_perl(\@_, \@params);
  my $results = $self->result_arity ? Wasm::Wasmtime::ValVec->new($self->result_arity) : undef;

  my $args_vec = Wasm::Wasmtime::Vec->new(
    size => scalar @params,
    data => defined $args ? addressof($args) : undef,
  );

  my $results_vec = Wasm::Wasmtime::Vec->new(
    size => $self->result_arity,
    data => defined $results ? addressof($results) : undef,
  );

  my $trap = $xsub->($self, $args_vec, $results_vec);

  die $trap if $trap;
  return unless defined $results;
  my @results = $results->to_perl;
  wantarray ? @results : $results[0]; ## no critic (Community::Wantarray)
});


sub attach
{
  my $self    = shift;
  my $package = @_ == 2 ? shift : caller;
  my $name    = shift;
  if($package->can($name))
  {
    Carp::carp("attaching ${package}::$name replaces existing subroutine");
  }
  Sub::Install::reinstall_sub({
    code => sub { $self->call(@_) },
    into => $package,
    as   => $name,
  });
}


$ffi->attach( type => ['wasm_func_t'] => 'wasm_functype_t' => sub {
  my($xsub, $self) = @_;
  my $type = $xsub->($self);
  $type->{owner} = $self->{owner} || $self;
  $type;
});


$ffi->attach( param_arity => ['wasm_func_t'] => 'size_t' => sub {
  my($xsub, $self) = @_;
  $xsub->($self);
});


$ffi->attach( result_arity => ['wasm_func_t'] => 'size_t' => sub {
  my($xsub, $self) = @_;
  $xsub->($self);
});

__PACKAGE__->_cast(0);
_generate_destroy();

1;

__END__